close_file Subroutine

public subroutine close_file(unit_number, file_status, keep_preconnection)

Close an open file given by its logical unit number. Optionally, keep the file and unit preconnected.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: unit_number
character(len=*), intent(in), optional :: file_status
logical, intent(in), optional :: keep_preconnection

Source Code

   SUBROUTINE close_file(unit_number, file_status, keep_preconnection)
      !! Close an open file given by its logical unit number.
      !! Optionally, keep the file and unit preconnected.

      INTEGER, INTENT(IN)                                :: unit_number
      CHARACTER(LEN=*), INTENT(IN), OPTIONAL             :: file_status
      LOGICAL, INTENT(IN), OPTIONAL                      :: keep_preconnection

      CHARACTER(LEN=2*default_path_length)               :: message
      CHARACTER(LEN=6)                                   :: status_string
      CHARACTER(LEN=default_path_length)                 :: file_name
      INTEGER                                            :: istat
      LOGICAL                                            :: exists, is_open, keep_file_connection

      keep_file_connection = .FALSE.
      IF (PRESENT(keep_preconnection)) keep_file_connection = keep_preconnection

      INQUIRE (UNIT=unit_number, EXIST=exists, OPENED=is_open, IOSTAT=istat)

      IF (istat /= 0) THEN
         WRITE (UNIT=message, FMT="(A,I0,A,I0,A)") &
            "An error occurred inquiring the unit with the number ", unit_number, &
            " (IOSTAT = ", istat, ")"
         DBCSR_ABORT(TRIM(message))
      ELSE IF (.NOT. exists) THEN
         WRITE (UNIT=message, FMT="(A,I0,A)") &
            "The specified unit number ", unit_number, &
            " cannot be closed, because it does not exist."
         DBCSR_ABORT(TRIM(message))
      END IF

      ! Close the specified file

      IF (is_open) THEN
         ! Refuse to close any preconnected system unit
         IF (unit_number == default_input_unit) THEN
            WRITE (UNIT=message, FMT="(A,I0)") &
               "Attempt to close the default input unit number ", unit_number
            DBCSR_ABORT(TRIM(message))
         END IF
         IF (unit_number == default_output_unit) THEN
            WRITE (UNIT=message, FMT="(A,I0)") &
               "Attempt to close the default output unit number ", unit_number
            DBCSR_ABORT(TRIM(message))
         END IF
         ! Define status after closing the file
         IF (PRESENT(file_status)) THEN
            status_string = TRIM(ADJUSTL(file_status))
         ELSE
            status_string = "KEEP"
         END IF
         ! Optionally, keep this unit preconnected
         INQUIRE (UNIT=unit_number, NAME=file_name, IOSTAT=istat)
         IF (istat /= 0) THEN
            WRITE (UNIT=message, FMT="(A,I0,A,I0,A)") &
               "An error occurred inquiring the unit with the number ", unit_number, &
               " (IOSTAT = ", istat, ")"
            DBCSR_ABORT(TRIM(message))
         END IF
         ! Manage preconnections
         IF (keep_file_connection) THEN
            CALL assign_preconnection(file_name, unit_number)
         ELSE
            CALL delete_preconnection(file_name, unit_number)
            CLOSE (UNIT=unit_number, IOSTAT=istat, STATUS=TRIM(status_string))
            IF (istat /= 0) THEN
               WRITE (UNIT=message, FMT="(A,I0,A,I0,A)") &
                  "An error occurred closing the file with the logical unit number ", &
                  unit_number, " (IOSTAT = ", istat, ")"
               DBCSR_ABORT(TRIM(message))
            END IF
         END IF
      END IF

   END SUBROUTINE close_file