Add an entry to the list of preconnected units
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | file_name | |||
integer, | intent(in) | :: | unit_number |
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