4
5
6
7
8
9
10
11
12
13
14
15
16
22
24# ifdef DISTRIBUTE
25
27# endif
28
29 implicit none
30
31
32
33 integer, intent(in) :: model
34
35
36
37 logical :: Lwrite
38 logical :: Lvalue(1)
39
40 integer :: Npts, Nval, i, ic, io_err, j, inp, ng, out, status
41 integer :: Ivalue(1)
42
43 real(r8), dimension(nRval) :: Rval
44
45 real(r8), allocatable :: MyRval(:)
46
47 character (len=40 ) :: KeyWord
48 character (len=256) :: io_errmsg, line
49 character (len=256) :: Cname
50 character (len=256), dimension(nCval) :: Cval
51
52
53
54
55
56
57
58
59# ifdef DISTRIBUTE
61 inp=1
63
67 WRITE(
stdout,*)
'Coupled Input File name = ', trim(cname)
68 END IF
69 OPEN (inp, file=trim(cname), form='formatted', status='old', &
70 & iostat=io_err, iomsg=io_errmsg)
71 IF (io_err.ne.0) THEN
74 RETURN
75 10 FORMAT (/,' READ_COUPLEPAR - Unable to open coupling input', &
76 & ' script.',/18x,'ERROR: ',a,/, &
77 & /,18x,'In distributed-memory applications, the input', &
78 & /,18x,'script file is processed in parallel. The Unix', &
79 & /,18x,'routine GETARG is used to get script file name.',&
80 & /,18x,'For example, in MPI applications make sure that',&
81 & /,18x,'command line is something like:',/, &
82 & /,18x,'mpirun -np 4 romsM coupling.in',/, &
83 & /,18x,'and not',/, &
84 & /,18x,'mpirun -np 4 romsM < coupling.in',/)
85 END IF
86# else
90# endif
91
92
93
94
95
96
97 DO WHILE (.true.)
98 READ (inp,
'(a)',
err=20,
END=30) line
100 IF (status.gt.0) THEN
101 SELECT CASE (trim(keyword))
102 CASE ('Nmodels')
103 npts=
load_i(nval, rval, 1, ivalue)
105 IF (.not.allocated(myrval) ) THEN
107 END IF
110 END IF
114 END IF
118 END IF
119 IF (.not.
allocated(
inpname) )
THEN
121 END IF
122 IF (.not.
allocated(
nexport) )
THEN
125 END IF
126 IF (.not.
allocated(
nimport) )
THEN
129 END IF
130 CASE ('Lreport')
131 npts=
load_l(nval, cval, 1, lvalue)
133 CASE ('OrderLabel')
135 IF (i.eq.nval) THEN
137 IF (index(trim(
orderlabel(i)),
'ocean').ne.0)
THEN
139 ELSE IF (index(trim(
orderlabel(i)),
'waves').ne.0)
THEN
141 ELSE IF (index(trim(
orderlabel(i)),
'atmos').ne.0)
THEN
143 END IF
144 END IF
145 END DO
146 CASE ('Nthreads(ocean)')
148 npts=
load_i(nval, rval, 1, ivalue)
150 END IF
151 CASE ('Nthreads(waves)')
153 npts=
load_i(nval, rval, 1, ivalue)
155 END IF
156 CASE ('Nthreads(atmos)')
158 npts=
load_i(nval, rval, 1, ivalue)
160 END IF
161 CASE ('TimeInterval')
163 ic=0
166 IF (i.gt.j) THEN
167 ic=ic+1
170 END IF
171 END DO
172 END DO
173 CASE ('INPname(ocean)')
177 END IF
178 CASE ('INPname(waves)')
181 END IF
182 CASE ('INPname(atmos)')
185 END IF
186 CASE ('CPLname')
187 cplname=trim(adjustl(cval(nval)))
188 CASE ('Nexport(ocean)')
190 npts=
load_i(nval, rval, 1, ivalue)
192 END IF
193 CASE ('Nexport(waves)')
195 npts=
load_i(nval, rval, 1, ivalue)
197 END IF
198 CASE ('Nexport(atmos)')
200 npts=
load_i(nval, rval, 1, ivalue)
202 END IF
203 CASE ('Export(ocean)')
204 IF (.not.
allocated(
export))
THEN
209 END DO
210 END IF
214 END IF
215 END IF
216 CASE ('Export(waves)')
217 IF (.not.
allocated(
export))
THEN
222 END DO
223 END IF
227 END IF
228 END IF
229 CASE ('Export(atmos)')
230 IF (.not.
allocated(
export))
THEN
235 END DO
236 END IF
240 END IF
241 END IF
242 CASE ('Nimport(ocean)')
244 npts=
load_i(nval, rval, 1, ivalue)
246 END IF
247 CASE ('Nimport(waves)')
249 npts=
load_i(nval, rval, 1, ivalue)
251 END IF
252 CASE ('Nimport(atmos)')
254 npts=
load_i(nval, rval, 1, ivalue)
256 END IF
257 CASE ('Import(ocean)')
258 IF (.not.
allocated(
import))
THEN
263 END DO
264 END IF
268 END IF
269 END IF
270 CASE ('Import(waves)')
271 IF (.not.
allocated(
import))
THEN
276 END DO
277 END IF
281 END IF
282 END IF
283 CASE ('Import(atmos)')
284 IF (.not.
allocated(
import))
THEN
289 END DO
290 END IF
294 END IF
295 END IF
296 END SELECT
297 END IF
298 END DO
299 20
IF (
master)
WRITE (out,40) line
301 RETURN
302 30 CLOSE (inp)
303
304 40 FORMAT (/,' READ_CouplePar - Error while processing line: ',/,a)
305
306 RETURN
subroutine my_getarg(iarg, carg)
integer function decode_line(line_text, keyword, nval, cval, rval)
character(len=20), dimension(:), allocatable orderlabel
character(len=256) cplname
integer, dimension(:), allocatable nexport
type(t_string), dimension(:), allocatable export
integer, dimension(:), allocatable nthreads
type(t_string), dimension(:), allocatable import
integer, dimension(:), allocatable nimport
character(len=256), dimension(:), allocatable inpname
real(r8), dimension(:,:), allocatable timeinterval
type(t_io), dimension(:), allocatable err