open_file Subroutine

public 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

Arguments

TypeIntentOptionalAttributesName
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


Contents

Source Code


Source Code

   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