pkg/profiles/profiles_findunit.F

4caf2dc194 Gael*0001 #include "CPP_EEOPTIONS.h"
                0002
                0003       SUBROUTINE PROFILES_FINDUNIT( ioUnit, myThid )
                0004 C OUT:
                0005 C     ioUnit  (integer) :: unit number
                0006 C
                0007 C PROFILES_FINDUNIT returns a valid, unused unit number for f77 I/O
                0008 C The routine stops the program is an error occurs in the process
                0009 C of searching the I/O channels.
                0010 C
                0011 C Created: 03/20/99 adcroft@mit.edu
                0012
                0013       IMPLICIT NONE
                0014
                0015 #include "EEPARAMS.h"
                0016
                0017 C Arguments
                0018       INTEGER ioUnit
                0019       INTEGER myThid
                0020 C Local
                0021       INTEGER ii
                0022       LOGICAL op
                0023       INTEGER ios
                0024       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0025 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0026
                0027 C Sweep through a valid range of unit numbers
                0028       ioUnit=-1
                0029       DO ii=2000,9999
                0030        IF ( ioUnit.EQ.-1 ) THEN
                0031 C- skip reserved unit numbers
                0032         IF (       ii.NE.errorMessageUnit
                0033      &       .AND. ii.NE.standardMessageUnit
                0034      &       .AND. ii.NE.scrUnit1   .AND. ii.NE.scrUnit2
                0035      &       .AND. ii.NE.eeDataUnit .AND. ii.NE.modelDataUnit
                0036      &     ) THEN
                0037           INQUIRE(unit=ii,iostat=ios,opened=op)
                0038           IF ( ios.NE.0 ) THEN
                0039             WRITE(msgBuf,'(A,I4)')
                0040      &        ' PROFILES_FINDUNIT: inquiring unit number =', ii
                0041             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0042      &                          SQUEEZE_RIGHT, myThid )
                0043             WRITE(msgBuf,'(A)')
                0044      &        ' PROFILES_FINDUNIT: inquire statement failed!'
                0045             CALL PRINT_ERROR( msgBuf, myThid )
b00d6c1700 Gael*0046             CALL ALL_PROC_DIE( myThid )
4caf2dc194 Gael*0047             STOP 'ABNORMAL END: S/R PROFILES_FINDUNIT'
                0048           ENDIF
                0049           IF ( .NOT.op ) THEN
                0050             ioUnit=ii
                0051           ENDIF
                0052         ENDIF
                0053        ENDIF
                0054       ENDDO
                0055
                0056 C Was there an available unit number
                0057       IF ( ioUnit.EQ.-1 ) THEN
                0058         WRITE(msgBuf,'(A)')
                0059      &    ' PROFILES_FINDUNIT: could not find an available unit number!'
                0060         CALL PRINT_ERROR( msgBuf, myThid )
b00d6c1700 Gael*0061         CALL ALL_PROC_DIE( myThid )
4caf2dc194 Gael*0062         STOP 'ABNORMAL END: S/R PROFILES_FINDUNIT'
                0063       ENDIF
                0064
                0065       RETURN
                0066       END