pkg/obsfit/obsfit_findunit.F

ad59256d7d aver*0001 #include "CPP_EEOPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: OBSFIT_FINDUNIT
                0005
                0006 C     !INTERFACE:
                0007       SUBROUTINE OBSFIT_FINDUNIT( ioUnit, myThid )
                0008
                0009 C     !DESCRIPTION:
                0010 C     ==================================================================
                0011 C     | 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     ==================================================================
                0015
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018 C     == Global variables ===
                0019 #include "EEPARAMS.h"
                0020
                0021 C     !INPUT PARAMETERS:
                0022 C     ioUnit :: unit number
                0023 C     myThid :: my thread ID number
                0024       INTEGER ioUnit
                0025       INTEGER myThid
                0026 CEOP
                0027
                0028 C     !LOCAL VARIABLES:
                0029       INTEGER ii
                0030       LOGICAL op
                0031       INTEGER ios
                0032       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0033
                0034 C Sweep through a valid range of unit numbers
                0035       ioUnit=-1
                0036       DO ii = 2000, 9999
                0037         IF ( ioUnit.EQ.-1 ) THEN
                0038 C Skip reserved unit numbers
                0039           IF ( ii.NE.errorMessageUnit .AND.
                0040      &         ii.NE.standardMessageUnit .AND.
                0041      &         ii.NE.scrUnit1 .AND. ii.NE.scrUnit2 .AND.
                0042      &         ii.NE.eeDataUnit .AND. ii.NE.modelDataUnit ) THEN
                0043             INQUIRE(unit=ii,iostat=ios,opened=op)
                0044             IF ( ios.NE.0 ) THEN
                0045               WRITE(msgBuf,'(A,I4)')
                0046      &         ' OBSFIT_FINDUNIT: inquiring unit number =', ii
                0047               CALL PRINT_MESSAGE( msgBuf,
                0048      &             standardMessageUnit, SQUEEZE_RIGHT, myThid )
                0049               WRITE(msgBuf,'(A)')
                0050      &         ' OBSFIT_FINDUNIT: inquire statement failed!'
                0051               CALL PRINT_ERROR( msgBuf, myThid )
                0052               CALL ALL_PROC_DIE( myThid )
                0053              STOP 'ABNORMAL END: S/R OBSFIT_FINDUNIT'
                0054             ENDIF
                0055
                0056             IF ( .NOT.op ) THEN
                0057               ioUnit=ii
                0058             ENDIF
                0059           ENDIF
                0060         ENDIF
                0061         ENDDO !DO ii
                0062
                0063 C Was there an available unit number
                0064       IF ( ioUnit.EQ.-1 ) THEN
                0065         WRITE(msgBuf,'(A)')
                0066      &   ' OBSFIT_FINDUNIT: no available unit number!'
                0067         CALL PRINT_ERROR( msgBuf, myThid )
                0068         CALL ALL_PROC_DIE( myThid )
                0069         STOP 'ABNORMAL END: S/R OBSFIT_FINDUNIT'
                0070       ENDIF
                0071
                0072       RETURN
                0073       END
                0074
                0075 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|