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	C $Header: /u/gcmpack/MITgcm/eesupp/src/mdsfindunit.F,v 1.2 2006/08/22 18:57:53 ce107 Exp $
2	C $Name: $
3
4	#include "CPP_EEOPTIONS.h"
5
6	SUBROUTINE MDSFINDUNIT( ioUnit, myThid )
7	C OUT:
8	C ioUnit (integer) :: unit number
9	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	IMPLICIT NONE
17
18	#include "EEPARAMS.h"
19
20	C Arguments
21	INTEGER ioUnit
22	INTEGER myThid
23	C Local
24	INTEGER ii
25	LOGICAL op
26	INTEGER ios
27	CHARACTER*(MAX_LEN_MBUF) msgBuf
28	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
29
30	C Sweep through a valid range of unit numbers
31	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	& ' MDSFINDUNIT: inquire statement failed!'
48	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
58	C Was there an available unit number
59	IF ( ioUnit.EQ.-1 ) THEN
60	WRITE(msgBuf,'(A)')
61	& ' MDSFINDUNIT: could not find an available unit number!'
62	CALL PRINT_ERROR( msgBuf, myThid )
63	STOP 'ABNORMAL END: S/R MDSFINDUNIT'
64	ENDIF
65
66	RETURN
67	END