eesupp/src/mdsfindunit.F

d7dd491794 Jean*0001 #include "CPP_EEOPTIONS.h"
                0002
3c96e10a2a Jean*0003       SUBROUTINE MDSFINDUNIT( ioUnit, myThid )
d7dd491794 Jean*0004 C OUT:
3c96e10a2a Jean*0005 C     ioUnit  (integer) :: unit number
d7dd491794 Jean*0006 C
                0007 C MDSFINDUNIT 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
3c96e10a2a Jean*0013       IMPLICIT NONE
d7dd491794 Jean*0014
                0015 #include "EEPARAMS.h"
                0016
                0017 C Arguments
3c96e10a2a Jean*0018       INTEGER ioUnit
                0019       INTEGER myThid
d7dd491794 Jean*0020 C Local
3c96e10a2a Jean*0021       INTEGER ii
                0022       LOGICAL op
                0023       INTEGER ios
                0024       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0025 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
d7dd491794 Jean*0026
                0027 C Sweep through a valid range of unit numbers
3c96e10a2a Jean*0028       ioUnit=-1
7727ad69a9 Dimi*0029 #ifdef HACK_FOR_GMAO_CPL
                0030       DO ii=31,999
                0031 #else /* HACK_FOR_GMAO_CPL */
3c96e10a2a Jean*0032       DO ii=9,999
7727ad69a9 Dimi*0033 #endif /* HACK_FOR_GMAO_CPL */
3c96e10a2a Jean*0034        IF ( ioUnit.EQ.-1 ) THEN
                0035 C- skip reserved unit numbers
                0036         IF (       ii.NE.errorMessageUnit
                0037      &       .AND. ii.NE.standardMessageUnit
                0038      &       .AND. ii.NE.scrUnit1   .AND. ii.NE.scrUnit2
                0039      &       .AND. ii.NE.eeDataUnit .AND. ii.NE.modelDataUnit
                0040      &     ) THEN
                0041           INQUIRE(unit=ii,iostat=ios,opened=op)
                0042           IF ( ios.NE.0 ) THEN
                0043             WRITE(msgBuf,'(A,I4)')
                0044      &        ' MDSFINDUNIT: inquiring unit number =', ii
                0045             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0046      &                          SQUEEZE_RIGHT, myThid )
                0047             WRITE(msgBuf,'(A)')
d7dd491794 Jean*0048      &        ' MDSFINDUNIT: inquire statement failed!'
3c96e10a2a Jean*0049             CALL PRINT_ERROR( msgBuf, myThid )
                0050             STOP 'ABNORMAL END: S/R MDSFINDUNIT'
                0051           ENDIF
                0052           IF ( .NOT.op ) THEN
                0053             ioUnit=ii
                0054           ENDIF
                0055         ENDIF
                0056        ENDIF
                0057       ENDDO
d7dd491794 Jean*0058
                0059 C Was there an available unit number
3c96e10a2a Jean*0060       IF ( ioUnit.EQ.-1 ) THEN
                0061         WRITE(msgBuf,'(A)')
d7dd491794 Jean*0062      &    ' MDSFINDUNIT: could not find an available unit number!'
3c96e10a2a Jean*0063         CALL PRINT_ERROR( msgBuf, myThid )
                0064         STOP 'ABNORMAL END: S/R MDSFINDUNIT'
                0065       ENDIF
d7dd491794 Jean*0066
3c96e10a2a Jean*0067       RETURN
                0068       END