/[MITgcm]/MITgcm/eesupp/src/mdsfindunit.F
ViewVC logotype

Diff of /MITgcm/eesupp/src/mdsfindunit.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.2 by ce107, Tue Aug 22 18:57:53 2006 UTC revision 1.3 by jmc, Mon Nov 26 00:13:05 2012 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
5    
6        subroutine MDSFINDUNIT( iounit, mythid )        SUBROUTINE MDSFINDUNIT( ioUnit, myThid )
7  C OUT:  C OUT:
8  C     iounit   integer - unit number  C     ioUnit  (integer) :: unit number
9  C  C
10  C MDSFINDUNIT returns a valid, unused unit number for f77 I/O  C MDSFINDUNIT returns a valid, unused unit number for f77 I/O
11  C The routine stops the program is an error occurs in the process  C The routine stops the program is an error occurs in the process
# Line 13  C of searching the I/O channels. Line 13  C of searching the I/O channels.
13  C  C
14  C Created: 03/20/99 adcroft@mit.edu  C Created: 03/20/99 adcroft@mit.edu
15    
16        implicit none        IMPLICIT NONE
17    
18  #include "EEPARAMS.h"  #include "EEPARAMS.h"
19    
20  C Arguments  C Arguments
21        integer iounit        INTEGER ioUnit
22        integer mythid        INTEGER myThid
23  C Local  C Local
24        integer ii        INTEGER ii
25        logical op        LOGICAL op
26        integer ios        INTEGER ios
27        character*(max_len_mbuf) msgbuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
28  C     ------------------------------------------------------------------  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
29    
30  C Sweep through a valid range of unit numbers  C Sweep through a valid range of unit numbers
31        iounit=-1        ioUnit=-1
32        do ii=9,999        DO ii=9,999
33          if (iounit.eq.-1) then         IF ( ioUnit.EQ.-1 ) THEN
34            inquire(unit=ii,iostat=ios,opened=op)  C- skip reserved unit numbers
35            if (ios.ne.0) then          IF (       ii.NE.errorMessageUnit
36              write(msgbuf,'(a,i2.2)')       &       .AND. ii.NE.standardMessageUnit
37       &        ' MDSFINDUNIT: inquiring unit number = ',ii       &       .AND. ii.NE.scrUnit1   .AND. ii.NE.scrUnit2
38              call print_message( msgbuf, standardmessageunit,       &       .AND. ii.NE.eeDataUnit .AND. ii.NE.modelDataUnit
39       &                          SQUEEZE_RIGHT , mythid)       &     ) THEN
40              write(msgbuf,'(a)')            INQUIRE(unit=ii,iostat=ios,opened=op)
41              IF ( ios.NE.0 ) THEN
42                WRITE(msgBuf,'(A,I4)')
43         &        ' MDSFINDUNIT: inquiring unit number =', ii
44                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
45         &                          SQUEEZE_RIGHT, myThid )
46                WRITE(msgBuf,'(A)')
47       &        ' MDSFINDUNIT: inquire statement failed!'       &        ' MDSFINDUNIT: inquire statement failed!'
48              call print_error( msgbuf, mythid )              CALL PRINT_ERROR( msgBuf, myThid )
49              stop 'ABNORMAL END: S/R MDSFINDUNIT'              STOP 'ABNORMAL END: S/R MDSFINDUNIT'
50            endif            ENDIF
51            if (.NOT. op) then            IF ( .NOT.op ) THEN
52              iounit=ii              ioUnit=ii
53            endif            ENDIF
54          endif          ENDIF
55        enddo         ENDIF
56          ENDDO
57    
58  C Was there an available unit number  C Was there an available unit number
59        if (iounit.eq.-1) then        IF ( ioUnit.EQ.-1 ) THEN
60          write(msgbuf,'(a)')          WRITE(msgBuf,'(A)')
61       &    ' MDSFINDUNIT: could not find an available unit number!'       &    ' MDSFINDUNIT: could not find an available unit number!'
62          call print_error( msgbuf, mythid )          CALL PRINT_ERROR( msgBuf, myThid )
63          stop 'ABNORMAL END: S/R MDSFINDUNIT'          STOP 'ABNORMAL END: S/R MDSFINDUNIT'
64        endif        ENDIF
65    
66  C     ------------------------------------------------------------------        RETURN
67        return        END
       end  
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22