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