Close an open file given by its logical unit number. Optionally, keep the file and unit preconnected.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | unit_number | |||
character(len=*), | intent(in), | optional | :: | file_status | ||
logical, | intent(in), | optional | :: | keep_preconnection |
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