eesupp/src/mdsfindunit.F

C $Header: /u/gcmpack/MITgcm/eesupp/src/mdsfindunit.F,v 1.2 2006/08/22 18:57:53 ce107 Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"

      SUBROUTINE MDSFINDUNIT( ioUnit, myThid )
C OUT:
C     ioUnit  (integer) :: unit number
C
C MDSFINDUNIT returns a valid, unused unit number for f77 I/O
C The routine stops the program is an error occurs in the process
C of searching the I/O channels.
C
C Created: 03/20/99 adcroft@mit.edu

      IMPLICIT NONE

#include "EEPARAMS.h"

C Arguments
      INTEGER ioUnit
      INTEGER myThid
C Local
      INTEGER ii
      LOGICAL op
      INTEGER ios
      CHARACTER*(MAX_LEN_MBUF) msgBuf
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

C Sweep through a valid range of unit numbers
      ioUnit=-1
      DO ii=9,999
       IF ( ioUnit.EQ.-1 ) THEN
C- skip reserved unit numbers
        IF (       ii.NE.errorMessageUnit
     &       .AND. ii.NE.standardMessageUnit
     &       .AND. ii.NE.scrUnit1   .AND. ii.NE.scrUnit2
     &       .AND. ii.NE.eeDataUnit .AND. ii.NE.modelDataUnit
     &     ) THEN
          INQUIRE(unit=ii,iostat=ios,opened=op)
          IF ( ios.NE.0 ) THEN
            WRITE(msgBuf,'(A,I4)')
     &        ' MDSFINDUNIT: inquiring unit number =', ii
            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                          SQUEEZE_RIGHT, myThid )
            WRITE(msgBuf,'(A)')
     &        ' MDSFINDUNIT: inquire statement failed!'
            CALL PRINT_ERROR( msgBuf, myThid )
            STOP 'ABNORMAL END: S/R MDSFINDUNIT'
          ENDIF
          IF ( .NOT.op ) THEN
            ioUnit=ii
          ENDIF
        ENDIF
       ENDIF
      ENDDO

C Was there an available unit number
      IF ( ioUnit.EQ.-1 ) THEN
        WRITE(msgBuf,'(A)')
     &    ' MDSFINDUNIT: could not find an available unit number!'
        CALL PRINT_ERROR( msgBuf, myThid )
        STOP 'ABNORMAL END: S/R MDSFINDUNIT'
      ENDIF

      RETURN
      END
1	jmc	1.3	C $Header: /u/gcmpack/MITgcm/eesupp/src/mdsfindunit.F,v 1.2 2006/08/22 18:57:53 ce107 Exp $
2	jmc	1.1	C $Name: $
3
4			#include "CPP_EEOPTIONS.h"
5
6	jmc	1.3	SUBROUTINE MDSFINDUNIT( ioUnit, myThid )
7	jmc	1.1	C OUT:
8	jmc	1.3	C ioUnit (integer) :: unit number
9	jmc	1.1	C
10			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
12			C of searching the I/O channels.
13			C
14			C Created: 03/20/99 adcroft@mit.edu
15
16	jmc	1.3	IMPLICIT NONE
17	jmc	1.1
18			#include "EEPARAMS.h"
19
20			C Arguments
21	jmc	1.3	INTEGER ioUnit
22			INTEGER myThid
23	jmc	1.1	C Local
24	jmc	1.3	INTEGER ii
25			LOGICAL op
26			INTEGER ios
27			CHARACTER*(MAX_LEN_MBUF) msgBuf
28			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
29	jmc	1.1
30			C Sweep through a valid range of unit numbers
31	jmc	1.3	ioUnit=-1
32			DO ii=9,999
33			IF ( ioUnit.EQ.-1 ) THEN
34			C- skip reserved unit numbers
35			IF ( ii.NE.errorMessageUnit
36			& .AND. ii.NE.standardMessageUnit
37			& .AND. ii.NE.scrUnit1 .AND. ii.NE.scrUnit2
38			& .AND. ii.NE.eeDataUnit .AND. ii.NE.modelDataUnit
39			& ) THEN
40			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	jmc	1.1	& ' MDSFINDUNIT: inquire statement failed!'
48	jmc	1.3	CALL PRINT_ERROR( msgBuf, myThid )
49			STOP 'ABNORMAL END: S/R MDSFINDUNIT'
50			ENDIF
51			IF ( .NOT.op ) THEN
52			ioUnit=ii
53			ENDIF
54			ENDIF
55			ENDIF
56			ENDDO
57	jmc	1.1
58			C Was there an available unit number
59	jmc	1.3	IF ( ioUnit.EQ.-1 ) THEN
60			WRITE(msgBuf,'(A)')
61	jmc	1.1	& ' MDSFINDUNIT: could not find an available unit number!'
62	jmc	1.3	CALL PRINT_ERROR( msgBuf, myThid )
63			STOP 'ABNORMAL END: S/R MDSFINDUNIT'
64			ENDIF
65
66			RETURN
67			END