assign_preconnection Subroutine

private subroutine assign_preconnection(file_name, unit_number)

Add an entry to the list of preconnected units

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: file_name
integer, intent(in) :: unit_number

Source Code

   SUBROUTINE assign_preconnection(file_name, unit_number)
      !! Add an entry to the list of preconnected units

      CHARACTER(LEN=*), INTENT(IN)                       :: file_name
      INTEGER, INTENT(IN)                                :: unit_number

      INTEGER                                            :: ic, islot, nc

      IF ((unit_number < 1) .OR. (unit_number > max_unit_number)) THEN
         DBCSR_ABORT("An invalid logical unit number was specified.")
      END IF

      IF (LEN_TRIM(file_name) == 0) THEN
         DBCSR_ABORT("No valid file name was specified")
      END IF

      nc = SIZE(preconnected)

      ! Check if a preconnection already exists
      DO ic = 1, nc
         IF (TRIM(preconnected(ic)%file_name) == TRIM(file_name)) THEN
            ! Return if the entry already exists
            IF (preconnected(ic)%unit_number == unit_number) THEN
               RETURN
            ELSE
               CALL print_preconnection_list()
               CALL dbcsr_abort(__LOCATION__, &
                                "Attempt to connect the already connected file <"// &
                                TRIM(ADJUSTL(file_name))//"> to another unit")
            END IF
         END IF
      END DO

      ! Search for an unused entry
      islot = -1
      DO ic = 1, nc
         IF (preconnected(ic)%unit_number == -1) THEN
            islot = ic
            EXIT
         END IF
      END DO

      IF (islot == -1) THEN
         CALL print_preconnection_list()
         DBCSR_ABORT("No free slot found in the list of preconnected units")
      END IF

      preconnected(islot)%file_name = TRIM(ADJUSTL(file_name))
      preconnected(islot)%unit_number = unit_number

   END SUBROUTINE assign_preconnection