pkg/profiles/profiles_findunit.F

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