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