Opens the requested file using a free unit number
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | file_name | |||
character(len=*), | intent(in), | optional | :: | file_status | ||
character(len=*), | intent(in), | optional | :: | file_form | ||
character(len=*), | intent(in), | optional | :: | file_action | ||
character(len=*), | intent(in), | optional | :: | file_position | ||
character(len=*), | intent(in), | optional | :: | file_pad | ||
integer, | intent(inout) | :: | unit_number | |||
integer, | intent(in), | optional | :: | debug | ||
logical, | intent(in), | optional | :: | skip_get_unit_number | ||
character(len=*), | intent(in), | optional | :: | file_access |
file access mode |
SUBROUTINE open_file(file_name, file_status, file_form, file_action, & file_position, file_pad, unit_number, debug, & skip_get_unit_number, file_access) !! Opens the requested file using a free unit number CHARACTER(LEN=*), INTENT(IN) :: file_name CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: file_status, file_form, file_action, & file_position, file_pad INTEGER, INTENT(INOUT) :: unit_number INTEGER, INTENT(IN), OPTIONAL :: debug LOGICAL, INTENT(IN), OPTIONAL :: skip_get_unit_number CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: file_access !! file access mode CHARACTER(LEN=*), PARAMETER :: routineN = 'open_file' CHARACTER(LEN=11) :: access_string, action_string, current_action, current_form, & form_string, pad_string, position_string, status_string CHARACTER(LEN=2*default_path_length) :: message CHARACTER(LEN=default_path_length) :: cwd, iomsgstr INTEGER :: debug_unit, istat LOGICAL :: exists, get_a_new_unit, is_open IF (PRESENT(file_access)) THEN access_string = TRIM(file_access) ELSE access_string = "SEQUENTIAL" END IF IF (PRESENT(file_status)) THEN status_string = TRIM(file_status) ELSE status_string = "OLD" END IF IF (PRESENT(file_form)) THEN form_string = TRIM(file_form) ELSE form_string = "FORMATTED" END IF IF (PRESENT(file_pad)) THEN pad_string = file_pad IF (form_string == "UNFORMATTED") THEN WRITE (UNIT=message, FMT="(A)") & "The PAD specifier is not allowed for an UNFORMATTED file" DBCSR_ABORT(TRIM(message)) END IF ELSE pad_string = "YES" END IF IF (PRESENT(file_action)) THEN action_string = TRIM(file_action) ELSE action_string = "READ" END IF IF (PRESENT(file_position)) THEN position_string = TRIM(file_position) ELSE position_string = "REWIND" END IF IF (PRESENT(debug)) THEN debug_unit = debug ELSE debug_unit = 0 ! use default_output_unit for debugging END IF ! Check the specified input file name INQUIRE (FILE=TRIM(file_name), EXIST=exists, OPENED=is_open, IOSTAT=istat) IF (istat /= 0) THEN WRITE (UNIT=message, FMT="(A,I0,A)") & "An error occurred inquiring the file <"//TRIM(file_name)// & "> (IOSTAT = ", istat, ")" DBCSR_ABORT(TRIM(message)) ELSE IF (status_string == "OLD") THEN IF (.NOT. exists) THEN WRITE (UNIT=message, FMT="(A)") & "The specified file <"//TRIM(ADJUSTL(file_name))// & "> cannot be opened. It does not exist. " DBCSR_ABORT(TRIM(message)) END IF END IF ! Open the specified input file IF (is_open) THEN INQUIRE (FILE=TRIM(file_name), NUMBER=unit_number, & ACTION=current_action, FORM=current_form) IF (TRIM(position_string) == "REWIND") REWIND (UNIT=unit_number) IF (TRIM(status_string) == "NEW") THEN CALL dbcsr_abort(__LOCATION__, & "Attempt to re-open the existing OLD file <"// & TRIM(file_name)//"> with status attribute NEW.") END IF IF (TRIM(current_form) /= TRIM(form_string)) THEN CALL dbcsr_abort(__LOCATION__, & "Attempt to re-open the existing "// & TRIM(current_form)//" file <"//TRIM(file_name)// & "> as "//TRIM(form_string)//" file.") END IF IF (TRIM(current_action) /= TRIM(action_string)) THEN CALL dbcsr_abort(__LOCATION__, & "Attempt to re-open the existing file <"// & TRIM(file_name)//"> with the modified ACTION attribute "// & TRIM(action_string)//". The current ACTION attribute is "// & TRIM(current_action)//".") END IF ELSE ! Find an unused unit number get_a_new_unit = .TRUE. IF (PRESENT(skip_get_unit_number)) THEN IF (skip_get_unit_number) get_a_new_unit = .FALSE. END IF IF (get_a_new_unit) unit_number = get_unit_number(TRIM(file_name)) IF (unit_number < 1) THEN WRITE (UNIT=message, FMT="(A)") & "Cannot open the file <"//TRIM(ADJUSTL(file_name))// & ">, because no unused logical unit number could be obtained." DBCSR_ABORT(TRIM(message)) END IF IF (TRIM(form_string) == "FORMATTED") THEN OPEN (UNIT=unit_number, & FILE=TRIM(file_name), & STATUS=TRIM(status_string), & ACCESS=TRIM(access_string), & FORM=TRIM(form_string), & POSITION=TRIM(position_string), & ACTION=TRIM(action_string), & PAD=TRIM(pad_string), & IOMSG=iomsgstr, & IOSTAT=istat) ELSE OPEN (UNIT=unit_number, & FILE=TRIM(file_name), & STATUS=TRIM(status_string), & ACCESS=TRIM(access_string), & FORM=TRIM(form_string), & POSITION=TRIM(position_string), & ACTION=TRIM(action_string), & IOMSG=iomsgstr, & IOSTAT=istat) END IF IF (istat /= 0) THEN CALL m_getcwd(cwd) WRITE (UNIT=message, FMT="(A,I0,A,I0,A)") & "An error occurred opening the file '"//TRIM(ADJUSTL(file_name))// & "' (UNIT = ", unit_number, ", IOSTAT = ", istat, "). "//TRIM(iomsgstr)//". "// & "Current working directory: "//TRIM(cwd) DBCSR_ABORT(TRIM(message)) END IF END IF IF (debug_unit > 0) THEN INQUIRE (FILE=TRIM(file_name), OPENED=is_open, NUMBER=unit_number, & POSITION=position_string, NAME=message, ACCESS=access_string, & FORM=form_string, ACTION=action_string) WRITE (UNIT=debug_unit, FMT="(T2,A)") "BEGIN DEBUG "//TRIM(ADJUSTL(routineN)) WRITE (UNIT=debug_unit, FMT="(T3,A,I0)") "NUMBER : ", unit_number WRITE (UNIT=debug_unit, FMT="(T3,A,L1)") "OPENED : ", is_open WRITE (UNIT=debug_unit, FMT="(T3,A)") "NAME : "//TRIM(ADJUSTL(message)) WRITE (UNIT=debug_unit, FMT="(T3,A)") "POSITION: "//TRIM(ADJUSTL(position_string)) WRITE (UNIT=debug_unit, FMT="(T3,A)") "ACCESS : "//TRIM(ADJUSTL(access_string)) WRITE (UNIT=debug_unit, FMT="(T3,A)") "FORM : "//TRIM(ADJUSTL(form_string)) WRITE (UNIT=debug_unit, FMT="(T3,A)") "ACTION : "//TRIM(ADJUSTL(action_string)) WRITE (UNIT=debug_unit, FMT="(T2,A)") "END DEBUG "//TRIM(ADJUSTL(routineN)) CALL print_preconnection_list(debug_unit) END IF END SUBROUTINE open_file