1 |
C $Header: /u/gcmpack/MITgcm/eesupp/src/mdsfindunit.F,v 1.1 2005/08/23 13:21:08 jmc 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 ------------------------------------------------------------------ |
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 |
inquire(unit=ii,iostat=ios,opened=op) |
35 |
if (ios.ne.0) then |
36 |
write(msgbuf,'(a,i2.2)') |
37 |
& ' MDSFINDUNIT: inquiring unit number = ',ii |
38 |
call print_message( msgbuf, standardmessageunit, |
39 |
& SQUEEZE_RIGHT , mythid) |
40 |
write(msgbuf,'(a)') |
41 |
& ' MDSFINDUNIT: inquire statement failed!' |
42 |
call print_error( msgbuf, mythid ) |
43 |
stop 'ABNORMAL END: S/R MDSFINDUNIT' |
44 |
endif |
45 |
if (.NOT. op) then |
46 |
iounit=ii |
47 |
endif |
48 |
endif |
49 |
enddo |
50 |
|
51 |
C Was there an available unit number |
52 |
if (iounit.eq.-1) then |
53 |
write(msgbuf,'(a)') |
54 |
& ' MDSFINDUNIT: could not find an available unit number!' |
55 |
call print_error( msgbuf, mythid ) |
56 |
stop 'ABNORMAL END: S/R MDSFINDUNIT' |
57 |
endif |
58 |
|
59 |
C ------------------------------------------------------------------ |
60 |
return |
61 |
end |