29 INTEGER (kind=ip_intwp_p),
PARAMETER :: jpeighty = 5000
32 INTEGER(kind=ip_i4_p) ,
public :: nnamcpl
33 INTEGER(kind=ip_i4_p) ,
public :: namruntim
34 INTEGER(kind=ip_i4_p) ,
public :: namlogprt
35 INTEGER(kind=ip_i4_p) ,
public :: namtlogprt
37 character(len=jpeighty) ,
public,
pointer :: namsrcfld(:)
38 character(len=jpeighty) ,
public,
pointer :: namdstfld(:)
39 character(len=ic_lvar) ,
public,
pointer :: namsrcgrd(:)
40 integer(kind=ip_i4_p) ,
public,
pointer :: namsrc_nx(:)
41 integer(kind=ip_i4_p) ,
public,
pointer :: namsrc_ny(:)
42 character(len=ic_lvar) ,
public,
pointer :: namdstgrd(:)
43 integer(kind=ip_i4_p) ,
public,
pointer :: namdst_nx(:)
44 integer(kind=ip_i4_p) ,
public,
pointer :: namdst_ny(:)
45 INTEGER(kind=ip_i4_p) ,
public,
pointer :: namfldseq(:)
46 INTEGER(kind=ip_i4_p) ,
public,
pointer :: namfldops(:)
47 INTEGER(kind=ip_i4_p) ,
public,
pointer :: namflddti(:)
48 INTEGER(kind=ip_i4_p) ,
public,
pointer :: namfldlag(:)
49 INTEGER(kind=ip_i4_p) ,
public,
pointer :: namfldtrn(:)
50 integer(kind=ip_i4_p) ,
public,
pointer :: namfldcon(:)
51 character(len=ic_med) ,
public,
pointer :: namfldcoo(:)
52 character(len=ic_long) ,
public,
pointer :: nammapfil(:)
53 character(len=ic_med) ,
public,
pointer :: nammaploc(:)
54 character(len=ic_med) ,
public,
pointer :: nammapopt(:)
55 character(len=ic_med) ,
public,
pointer :: namrstfil(:)
56 character(len=ic_med) ,
public,
pointer :: naminpfil(:)
57 logical ,
public,
pointer :: namchecki(:)
58 logical ,
public,
pointer :: namchecko(:)
59 REAL (kind=ip_realwp_p) ,
public,
pointer :: namfldsmu(:)
60 REAL (kind=ip_realwp_p) ,
public,
pointer :: namfldsad(:)
61 REAL (kind=ip_realwp_p) ,
public,
pointer :: namflddmu(:)
62 REAL (kind=ip_realwp_p) ,
public,
pointer :: namflddad(:)
64 character(len=ic_med) ,
public,
pointer :: namscrmet(:)
65 character(len=ic_med) ,
public,
pointer :: namscrnor(:)
66 character(len=ic_med) ,
public,
pointer :: namscrtyp(:)
67 character(len=ic_med) ,
public,
pointer :: namscrord(:)
68 character(len=ic_med) ,
public,
pointer :: namscrres(:)
69 REAL (kind=ip_realwp_p) ,
public,
pointer :: namscrvam(:)
70 integer(kind=ip_i4_p) ,
public,
pointer :: namscrnbr(:)
71 integer(kind=ip_i4_p) ,
public,
pointer :: namscrbin(:)
74 INTEGER(kind=ip_i4_p) ,
public,
pointer :: namsort2nn(:)
75 INTEGER(kind=ip_i4_p) ,
public,
pointer :: namnn2sort(:)
81 integer(kind=ip_i4_p) :: nulin
82 character(len=*),
parameter :: cl_namcouple =
'namcouple'
85 INTEGER (kind=ip_intwp_p) :: il_err
90 CHARACTER(len=5),
PARAMETER :: cgrdnam =
'grids'
91 CHARACTER(len=5),
PARAMETER :: cmsknam =
'masks'
92 CHARACTER(len=5),
PARAMETER :: csurnam =
'areas'
93 CHARACTER(len=5),
PARAMETER :: crednam =
'maskr'
94 CHARACTER(len=4),
PARAMETER :: cglonsuf =
'.lon'
95 CHARACTER(len=4),
PARAMETER :: cglatsuf =
'.lat'
96 CHARACTER(len=4),
PARAMETER :: crnlonsuf =
'.clo'
97 CHARACTER(len=4),
PARAMETER :: crnlatsuf =
'.cla'
98 CHARACTER(len=4),
PARAMETER :: cmsksuf =
'.msk'
99 CHARACTER(len=4),
PARAMETER :: csursuf =
'.srf'
100 CHARACTER(len=4),
PARAMETER :: cangsuf =
'.ang'
102 LOGICAL,
DIMENSION(:),
ALLOCATABLE :: lmapp
103 LOGICAL,
DIMENSION(:),
ALLOCATABLE :: lsubg
105 INTEGER (kind=ip_intwp_p) :: nfcoast
108 INTEGER (kind=ip_intwp_p) :: ntime
109 INTEGER (kind=ip_intwp_p) :: niter
110 INTEGER (kind=ip_intwp_p) :: nitfn
111 INTEGER (kind=ip_intwp_p) :: nstep
113 INTEGER (kind=ip_intwp_p) :: ig_nfield
114 INTEGER (kind=ip_intwp_p) :: ig_direct_nfield
115 INTEGER (kind=ip_intwp_p) :: ig_total_nfield
116 INTEGER (kind=ip_intwp_p) :: ig_final_nfield
117 LOGICAL :: lg_oasis_field
118 INTEGER (kind=ip_intwp_p) :: ig_maxcomb
119 INTEGER (kind=ip_intwp_p) :: ig_maxnoa
120 INTEGER (kind=ip_intwp_p) :: ig_maxnfg
122 INTEGER(kind=ip_intwp_p) :: nlogprt
124 INTEGER(kind=ip_intwp_p) :: ntlogprt
126 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: numlab
127 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: ig_numlab
128 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nfexch
129 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: ig_ntrans
130 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: ig_total_ntrans
131 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nlonbf
132 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nlatbf
133 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nlonaf
134 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nlataf
135 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nseqn
136 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: ig_total_nseqn
137 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: ig_freq
138 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: ig_lag
139 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nlagn
140 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: ig_invert
141 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: ig_reverse
142 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: ig_number_field
143 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: ig_no_rstfile
144 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: ig_total_state
145 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: ig_local_trans
146 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: ig_grid_nbrbf
147 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: ig_grid_nbraf
148 INTEGER (kind=ip_intwp_p) :: ig_nbr_rstfile
149 INTEGER (kind=ip_intwp_p) :: ig_total_frqmin
150 LOGICAL ,
DIMENSION(:),
ALLOCATABLE :: lg_state
151 CHARACTER(len=jpeighty) ,
DIMENSION(:),
ALLOCATABLE :: cnaminp
152 CHARACTER(len=jpeighty) ,
DIMENSION(:),
ALLOCATABLE :: cnamout
153 CHARACTER(len=8) ,
DIMENSION(:,:),
ALLOCATABLE :: canal
154 CHARACTER(len=8) :: cg_c
155 CHARACTER(len=32) ,
DIMENSION(:),
ALLOCATABLE :: cg_name_rstfile
156 CHARACTER(len=32) ,
DIMENSION(:),
ALLOCATABLE :: cg_restart_file
157 CHARACTER(len=32) ,
DIMENSION(:),
ALLOCATABLE :: cficinp
158 CHARACTER(len=8) ,
DIMENSION(:),
ALLOCATABLE :: cficout
159 CHARACTER(len=32) ,
DIMENSION(:),
ALLOCATABLE :: cg_input_file
160 CHARACTER(len=jpeighty) ,
DIMENSION(:),
ALLOCATABLE :: cg_input_field
161 CHARACTER(len=jpeighty) ,
DIMENSION(:),
ALLOCATABLE :: cg_output_field
162 CHARACTER(len=8) ,
DIMENSION(:),
ALLOCATABLE :: cficbf
163 CHARACTER(len=8) ,
DIMENSION(:),
ALLOCATABLE :: cficaf
164 CHARACTER(len=8) ,
DIMENSION(:),
ALLOCATABLE :: cstate
165 CHARACTER(len=4) ,
DIMENSION(:),
ALLOCATABLE :: cga_locatorbf
166 CHARACTER(len=4) ,
DIMENSION(:),
ALLOCATABLE :: cga_locatoraf
168 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: neighbor
169 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: ntronca
170 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: ncofld
171 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: neighborg
172 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nbofld
173 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nbnfld
174 INTEGER (kind=ip_intwp_p),
DIMENSION(:,:),
ALLOCATABLE :: nludat
175 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nlufil
176 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nlumap
177 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nmapfl
178 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nmapvoi
179 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nlusub
180 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nsubfl
181 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nsubvoi
182 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nluext
183 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nextfl
184 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nosper
185 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: notper
186 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nbins
187 INTEGER (kind=ip_intwp_p) :: nlucor
188 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nscripvoi
189 REAL (kind=ip_realwp_p),
DIMENSION(:),
ALLOCATABLE :: amskval
190 REAL (kind=ip_realwp_p),
DIMENSION(:),
ALLOCATABLE :: amskvalnew
191 REAL (kind=ip_realwp_p),
DIMENSION(:,:),
ALLOCATABLE :: acocoef
192 REAL (kind=ip_realwp_p),
DIMENSION(:,:),
ALLOCATABLE :: abocoef
193 REAL (kind=ip_realwp_p),
DIMENSION(:,:),
ALLOCATABLE :: abncoef
194 REAL (kind=ip_realwp_p),
DIMENSION(:),
ALLOCATABLE :: afldcoef
195 REAL (kind=ip_realwp_p),
DIMENSION(:),
ALLOCATABLE :: afldcobo
196 REAL (kind=ip_realwp_p),
DIMENSION(:),
ALLOCATABLE :: afldcobn
197 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cxordbf
198 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cyordbf
199 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cxordaf
200 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cyordaf
201 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cextmet
202 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cintmet
203 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cgrdtyp
204 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cfldtyp
205 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cfilfic
206 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cfilmet
207 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cconmet
208 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cconopt
209 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cfldcoa
210 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cfldfin
211 CHARACTER(len=8),
DIMENSION(:,:),
ALLOCATABLE :: ccofld
212 CHARACTER(len=8),
DIMENSION(:,:),
ALLOCATABLE :: cbofld
213 CHARACTER(len=8),
DIMENSION(:,:),
ALLOCATABLE :: cbnfld
214 CHARACTER(len=8),
DIMENSION(:,:),
ALLOCATABLE :: ccofic
215 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cdqdt
216 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cgrdmap
217 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cmskrd
218 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cgrdsub
219 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: ctypsub
220 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cgrdext
221 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: csper
222 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: ctper
223 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cmap_method
224 CHARACTER(len=ic_long),
DIMENSION(:),
ALLOCATABLE :: cmap_file
225 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cmaptyp
226 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cmapopt
227 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: corder
228 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cnorm_opt
229 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: cfldtype
230 CHARACTER(len=8),
DIMENSION(:),
ALLOCATABLE :: crsttype
231 CHARACTER(len=8) :: cfldcor
232 LOGICAL,
DIMENSION(:),
ALLOCATABLE :: lsurf
234 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: naismfl
235 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: naisgfl
236 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: naismvoi
237 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: naisgvoi
238 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: niwtm
239 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: niwtg
240 REAL (kind=ip_realwp_p),
DIMENSION(:),
ALLOCATABLE :: varmul
241 LOGICAL,
DIMENSION(:),
ALLOCATABLE :: linit
243 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: niwtn
244 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nninnfl
245 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: niwtng
246 INTEGER (kind=ip_intwp_p),
DIMENSION(:),
ALLOCATABLE :: nninnflg
247 LOGICAL,
DIMENSION(:),
ALLOCATABLE :: lextra
248 LOGICAL,
DIMENSION(:),
ALLOCATABLE :: lweight
261 integer(kind=ip_i4_p) :: n, nv, n1, n2, loc
262 integer(kind=ip_i4_p) :: ja, jf, jc
263 integer(kind=ip_i4_p) :: il_iost
264 integer(kind=ip_i4_p) :: maxunit
265 character(len=*),
parameter :: subname=
'(oasis_namcouple_init)'
269 OPEN (unit = nulin,file =cl_namcouple,status=
'OLD', &
270 form =
'FORMATTED', iostat = il_iost)
272 IF (mpi_rank_global == 0)
THEN
273 IF (il_iost .NE. 0)
THEN
274 WRITE(nulprt1,*) subname,
' ERROR opening namcouple file ',trim(cl_namcouple),&
275 ' with unit number ', nulin
276 WRITE (nulprt,
'(a,i4)')
' abort by model ',compid
277 WRITE (nulprt,
'(a)')
' error = ERROR opening namcouple file'
280 WRITE(nulprt1,*) subname,
' open namcouple file ',trim(cl_namcouple),
' with unit number ', &
294 IF (mpi_rank_global == 0)
THEN
295 WRITE(nulprt1,*) subname,
' allocating ig_final_nfield',ig_final_nfield
299 allocate(namsrcfld(ig_final_nfield), stat=il_err)
300 IF (il_err.NE.0) CALL
prtout(
'Error in "namsrcfld" allocation of experiment module',il_err,1)
302 allocate(namdstfld(ig_final_nfield), stat=il_err)
303 IF (il_err.NE.0) CALL
prtout(
'Error in "namdstfld" allocation of experiment module',il_err,1)
305 allocate(namsrcgrd(ig_final_nfield), stat=il_err)
306 IF (il_err.NE.0) CALL
prtout(
'Error in "namsrcgrd" allocation of experiment module',il_err,1)
308 allocate(namsrc_nx(ig_final_nfield), stat=il_err)
309 IF (il_err.NE.0) CALL
prtout(
'Error in "namsrc_nx" allocation of experiment module',il_err,1)
311 allocate(namsrc_ny(ig_final_nfield), stat=il_err)
312 IF (il_err.NE.0) CALL
prtout(
'Error in "namsrc_ny" allocation of experiment module',il_err,1)
314 allocate(namdstgrd(ig_final_nfield), stat=il_err)
315 IF (il_err.NE.0) CALL
prtout(
'Error in "namdstgrd" allocation of experiment module',il_err,1)
317 allocate(namdst_nx(ig_final_nfield), stat=il_err)
318 IF (il_err.NE.0) CALL
prtout(
'Error in "namdst_nx" allocation of experiment module',il_err,1)
320 allocate(namdst_ny(ig_final_nfield), stat=il_err)
321 IF (il_err.NE.0) CALL
prtout(
'Error in "namdst_ny" allocation of experiment module',il_err,1)
323 allocate(namfldseq(ig_final_nfield), stat=il_err)
324 IF (il_err.NE.0) CALL
prtout(
'Error in "namfldseq" allocation of experiment module',il_err,1)
326 allocate(namfldops(ig_final_nfield), stat=il_err)
327 IF (il_err.NE.0) CALL
prtout(
'Error in "namfldops" allocation of experiment module',il_err,1)
329 allocate(namfldtrn(ig_final_nfield), stat=il_err)
330 IF (il_err.NE.0) CALL
prtout(
'Error in "namfldtrn" allocation of experiment module',il_err,1)
332 allocate(namfldcon(ig_final_nfield), stat=il_err)
333 IF (il_err.NE.0) CALL
prtout(
'Error in "namfldcon" allocation of experiment module',il_err,1)
335 allocate(namfldcoo(ig_final_nfield), stat=il_err)
336 IF (il_err.NE.0) CALL
prtout(
'Error in "namfldcoo" allocation of experiment module',il_err,1)
338 allocate(namflddti(ig_final_nfield), stat=il_err)
339 IF (il_err.NE.0) CALL
prtout(
'Error in "namflddti" allocation of experiment module',il_err,1)
341 allocate(namfldlag(ig_final_nfield), stat=il_err)
342 IF (il_err.NE.0) CALL
prtout(
'Error in "namfldlag" allocation of experiment module',il_err,1)
344 allocate(nammapfil(ig_final_nfield), stat=il_err)
345 IF (il_err.NE.0) CALL
prtout(
'Error in "nammapfil" allocation of experiment module',il_err,1)
347 allocate(nammaploc(ig_final_nfield), stat=il_err)
348 IF (il_err.NE.0) CALL
prtout(
'Error in "nammaploc" allocation of experiment module',il_err,1)
350 allocate(nammapopt(ig_final_nfield), stat=il_err)
351 IF (il_err.NE.0) CALL
prtout(
'Error in "nammapopt" allocation of experiment module',il_err,1)
353 allocate(namrstfil(ig_final_nfield), stat=il_err)
354 IF (il_err.NE.0) CALL
prtout(
'Error in "namrstfil" allocation of experiment module',il_err,1)
356 allocate(naminpfil(ig_final_nfield), stat=il_err)
357 IF (il_err.NE.0) CALL
prtout(
'Error in "naminpfil" allocation of experiment module',il_err,1)
359 allocate(namsort2nn(ig_final_nfield), stat=il_err)
360 IF (il_err.NE.0) CALL
prtout(
'Error in "namsort2nn" allocation of experiment module',il_err,1)
362 allocate(namnn2sort(ig_final_nfield), stat=il_err)
363 IF (il_err.NE.0) CALL
prtout(
'Error in "namnn2sort" allocation of experiment module',il_err,1)
365 allocate(namchecki(ig_final_nfield), stat=il_err)
366 IF (il_err.NE.0) CALL
prtout(
'Error in "namchecki" allocation of experiment module',il_err,1)
368 allocate(namchecko(ig_final_nfield), stat=il_err)
369 IF (il_err.NE.0) CALL
prtout(
'Error in "namchecko" allocation of experiment module',il_err,1)
371 allocate(namfldsmu(ig_final_nfield), stat=il_err)
372 IF (il_err.NE.0) CALL
prtout(
'Error in "namfldsmu" allocation of experiment module',il_err,1)
374 allocate(namfldsad(ig_final_nfield), stat=il_err)
375 IF (il_err.NE.0) CALL
prtout(
'Error in "namfldsad" allocation of experiment module',il_err,1)
377 allocate(namflddmu(ig_final_nfield), stat=il_err)
378 IF (il_err.NE.0) CALL
prtout(
'Error in "namflddmu" allocation of experiment module',il_err,1)
380 allocate(namflddad(ig_final_nfield), stat=il_err)
381 IF (il_err.NE.0) CALL
prtout(
'Error in "namflddad" allocation of experiment module',il_err,1)
383 allocate(namscrmet(ig_final_nfield), stat=il_err)
384 IF (il_err.NE.0) CALL
prtout(
'Error in "namscrmet" allocation of experiment module',il_err,1)
386 allocate(namscrnor(ig_final_nfield), stat=il_err)
387 IF (il_err.NE.0) CALL
prtout(
'Error in "namscrnor" allocation of experiment module',il_err,1)
389 allocate(namscrtyp(ig_final_nfield), stat=il_err)
390 IF (il_err.NE.0) CALL
prtout(
'Error in "namscrtyp" allocation of experiment module',il_err,1)
392 allocate(namscrord(ig_final_nfield), stat=il_err)
393 IF (il_err.NE.0) CALL
prtout(
'Error in "namscrord" allocation of experiment module',il_err,1)
395 allocate(namscrres(ig_final_nfield), stat=il_err)
396 IF (il_err.NE.0) CALL
prtout(
'Error in "namscrres" allocation of experiment module',il_err,1)
398 allocate(namscrvam(ig_final_nfield), stat=il_err)
399 IF (il_err.NE.0) CALL
prtout(
'Error in "namscrvam" allocation of experiment module',il_err,1)
401 allocate(namscrnbr(ig_final_nfield), stat=il_err)
402 IF (il_err.NE.0) CALL
prtout(
'Error in "namscrnbr" allocation of experiment module',il_err,1)
404 allocate(namscrbin(ig_final_nfield), stat=il_err)
405 IF (il_err.NE.0) CALL
prtout(
'Error in "namscrbin" allocation of experiment module',il_err,1)
407 namsrcfld(:) = trim(cspval)
408 namdstfld(:) = trim(cspval)
409 namsrcgrd(:) = trim(cspval)
412 namdstgrd(:) = trim(cspval)
417 namfldtrn(:) = ip_instant
418 namfldcon(:) = ip_cnone
422 nammapfil(:) =
"idmap"
425 namrstfil(:) = trim(cspval)
426 naminpfil(:) = trim(cspval)
427 namchecki(:) = .false.
428 namchecko(:) = .false.
429 namfldsmu(:) = 1.0_ip_realwp_p
430 namfldsad(:) = 0.0_ip_realwp_p
431 namflddmu(:) = 1.0_ip_realwp_p
432 namflddad(:) = 0.0_ip_realwp_p
434 namscrmet(:) = trim(cspval)
435 namscrnor(:) = trim(cspval)
436 namscrtyp(:) = trim(cspval)
437 namscrord(:) = trim(cspval)
438 namscrres(:) = trim(cspval)
439 namscrvam(:) = 1.0_ip_realwp_p
445 IF (mpi_rank_global == 0)
THEN
446 WRITE(nulprt1,*) subname,
' maximum unit number = ',maxunit
452 nnamcpl = ig_final_nfield
455 namtlogprt = ntlogprt
456 do jf = 1,ig_final_nfield
457 namsrcfld(jf) = cg_input_field(jf)
458 namdstfld(jf) = cg_output_field(jf)
459 namfldseq(jf) = ig_total_nseqn(jf)
460 namfldops(jf) = ig_total_state(jf)
461 if (namfldops(jf) == ip_auxilary)
then
462 IF (mpi_rank_global == 0)
THEN
463 WRITE(nulprt1,*) subname,jf,
'ERROR: AUXILARY NOT SUPPORTED'
464 WRITE (nulprt1,
'(a)')
' error = STOP in oasis_namcouple_init'
469 if (namfldops(jf) == ip_ignored)
then
470 namfldops(jf) = ip_exported
471 IF (mpi_rank_global == 0)
THEN
472 WRITE(nulprt1,*) subname,jf,
'WARNING: IGNORED converted to EXPORTED'
476 if (namfldops(jf) == ip_ignout)
then
477 namfldops(jf) = ip_expout
478 IF (mpi_rank_global == 0)
THEN
479 WRITE(nulprt1,*) subname,jf,
'WARNING: IGNOUT converted to EXPOUT'
483 namflddti(jf) = ig_freq(jf)
484 namfldlag(jf) = ig_lag(jf)
485 namfldtrn(jf) = ig_local_trans(jf)
486 namrstfil(jf) = trim(cg_restart_file(jf))
487 naminpfil(jf) = trim(cg_input_file(jf))
488 if (ig_number_field(jf) > 0)
then
489 namsrcgrd(jf) = trim(cficbf(ig_number_field(jf)))
490 namsrc_nx(jf) = nlonbf(ig_number_field(jf))
491 namsrc_ny(jf) = nlatbf(ig_number_field(jf))
492 namdstgrd(jf) = trim(cficaf(ig_number_field(jf)))
493 namdst_nx(jf) = nlonaf(ig_number_field(jf))
494 namdst_ny(jf) = nlataf(ig_number_field(jf))
495 do ja = 1, ig_ntrans(ig_number_field(jf))
497 if (canal(ja,ig_number_field(jf)) .EQ.
'SCRIPR')
then
498 namscrmet(jf) = trim(cmap_method(ig_number_field(jf)))
499 namscrnor(jf) = trim(cnorm_opt(ig_number_field(jf)))
500 namscrtyp(jf) = trim(cfldtype(ig_number_field(jf)))
501 namscrord(jf) = trim(corder(ig_number_field(jf)))
502 namscrres(jf) = trim(crsttype(ig_number_field(jf)))
503 namscrvam(jf) = varmul(ig_number_field(jf))
504 namscrnbr(jf) = nscripvoi(ig_number_field(jf))
505 namscrbin(jf) = nbins(ig_number_field(jf))
506 IF (trim(namscrtyp(jf)) /=
'SCALAR')
THEN
507 IF (mpi_rank_global == 0)
THEN
508 WRITE(nulprt1,*) subname,jf,
'WARNING: SCRIPR weights generation &
509 & supported only for SCALAR mapping, not '//trim(namscrtyp(jf))
510 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
511 WRITE (nulprt1,
'(a)')
' error = ERROR in SCRIPR CFTYP option'
517 elseif (canal(ja,ig_number_field(jf)) .EQ.
'MAPPING')
then
518 nammapfil(jf) = trim(cmap_file(ig_number_field(jf)))
519 nammaploc(jf) = trim(cmaptyp(ig_number_field(jf)))
520 nammapopt(jf) = trim(cmapopt(ig_number_field(jf)))
522 elseif (canal(ja,ig_number_field(jf)) .EQ.
'CONSERV')
then
523 namfldcon(jf) = ip_cnone
524 namfldcoo(jf) = trim(cconopt(ig_number_field(jf)))
525 if (cconmet(ig_number_field(jf)) .EQ.
'GLOBAL') namfldcon(jf) = ip_cglobal
526 if (cconmet(ig_number_field(jf)) .EQ.
'GLBPOS') namfldcon(jf) = ip_cglbpos
527 if (cconmet(ig_number_field(jf)) .EQ.
'BASBAL') namfldcon(jf) = ip_cbasbal
528 if (cconmet(ig_number_field(jf)) .EQ.
'BASPOS') namfldcon(jf) = ip_cbaspos
529 if (namfldcon(jf) .EQ. ip_cnone)
then
530 IF (mpi_rank_global == 0)
THEN
531 WRITE(nulprt1,*) subname,jf,
'WARNING: CONSERV option not supported: '//&
532 &trim(cconmet(ig_number_field(jf)))
533 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
534 WRITE (nulprt1,
'(a)')
' error = ERROR in CONSERV option'
540 elseif (canal(ja,ig_number_field(jf)) .EQ.
'CHECKIN' )
then
541 namchecki(jf) = .true.
543 elseif (canal(ja,ig_number_field(jf)) .EQ.
'CHECKOUT')
then
544 namchecko(jf) = .true.
546 elseif (canal(ja,ig_number_field(jf)) .EQ.
'BLASOLD')
then
547 namfldsmu(jf) = afldcobo(ig_number_field(jf))
548 do jc = 1, nbofld(ig_number_field(jf))
549 if (trim(cbofld(jc,ig_number_field(jf))) ==
'CONSTANT')
then
550 namfldsad(jf) = abocoef(jc,ig_number_field(jf))
552 IF (mpi_rank_global == 0)
THEN
553 WRITE(nulprt1,*) subname,jf,
'ERROR: BLASOLD only supports CONSTANT: '//&
554 &trim(cbofld(jc,ig_number_field(jf)))
555 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
556 WRITE (nulprt1,
'(a)')
' error = ERROR in BLASOLD option'
563 elseif (canal(ja,ig_number_field(jf)) .EQ.
'BLASNEW')
then
564 namflddmu(jf) = afldcobn(ig_number_field(jf))
565 do jc = 1, nbnfld(ig_number_field(jf))
566 if (trim(cbnfld(jc,ig_number_field(jf))) ==
'CONSTANT')
then
567 namflddad(jf) = abncoef(jc,ig_number_field(jf))
569 IF (mpi_rank_global == 0)
THEN
570 WRITE(nulprt1,*) subname,jf,
'ERROR: BLASNEW only supports CONSTANTS: '//&
571 &trim(cbofld(jc,ig_number_field(jf)))
572 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
573 WRITE (nulprt1,
'(a)')
' error = ERROR in BLASNEW option'
585 IF (mpi_rank_global == 0)
THEN
587 WRITE(nulprt1,*) subname,
'namlogprt ',namlogprt
590 WRITE(nulprt1,*) subname,n,
'namsrcfld ',trim(namsrcfld(n))
591 WRITE(nulprt1,*) subname,n,
'namdstfld ',trim(namdstfld(n))
592 WRITE(nulprt1,*) subname,n,
'namsrcgrd ',trim(namsrcgrd(n))
593 WRITE(nulprt1,*) subname,n,
'namsrc_nx ',namsrc_nx(n)
594 WRITE(nulprt1,*) subname,n,
'namsrc_ny ',namsrc_ny(n)
595 WRITE(nulprt1,*) subname,n,
'namdstgrd ',trim(namdstgrd(n))
596 WRITE(nulprt1,*) subname,n,
'namdst_nx ',namdst_nx(n)
597 WRITE(nulprt1,*) subname,n,
'namdst_ny ',namdst_ny(n)
598 WRITE(nulprt1,*) subname,n,
'namfldseq ',namfldseq(n)
599 WRITE(nulprt1,*) subname,n,
'namfldops ',namfldops(n)
600 WRITE(nulprt1,*) subname,n,
'namfldtrn ',namfldtrn(n)
601 WRITE(nulprt1,*) subname,n,
'namfldcon ',namfldcon(n)
602 WRITE(nulprt1,*) subname,n,
'namfldcoo ',trim(namfldcoo(n))
603 WRITE(nulprt1,*) subname,n,
'namflddti ',namflddti(n)
604 WRITE(nulprt1,*) subname,n,
'namfldlag ',namfldlag(n)
605 WRITE(nulprt1,*) subname,n,
'nammapfil ',trim(nammapfil(n))
606 WRITE(nulprt1,*) subname,n,
'nammaploc ',trim(nammaploc(n))
607 WRITE(nulprt1,*) subname,n,
'nammapopt ',trim(nammapopt(n))
608 WRITE(nulprt1,*) subname,n,
'namrstfil ',trim(namrstfil(n))
609 WRITE(nulprt1,*) subname,n,
'naminpfil ',trim(naminpfil(n))
610 WRITE(nulprt1,*) subname,n,
'namchecki ',namchecki(n)
611 WRITE(nulprt1,*) subname,n,
'namchecko ',namchecko(n)
612 WRITE(nulprt1,*) subname,n,
'namfldsmu ',namfldsmu(n)
613 WRITE(nulprt1,*) subname,n,
'namfldsad ',namfldsad(n)
614 WRITE(nulprt1,*) subname,n,
'namflddmu ',namflddmu(n)
615 WRITE(nulprt1,*) subname,n,
'namflddad ',namflddad(n)
616 WRITE(nulprt1,*) subname,n,
'namscrmet ',trim(namscrmet(n))
617 WRITE(nulprt1,*) subname,n,
'namscrnor ',trim(namscrnor(n))
618 WRITE(nulprt1,*) subname,n,
'namscrtyp ',trim(namscrtyp(n))
619 WRITE(nulprt1,*) subname,n,
'namscrord ',trim(namscrord(n))
620 WRITE(nulprt1,*) subname,n,
'namscrres ',trim(namscrres(n))
621 WRITE(nulprt1,*) subname,n,
'namscrvam ',namscrvam(n)
622 WRITE(nulprt1,*) subname,n,
'namscrnbr ',namscrnbr(n)
623 WRITE(nulprt1,*) subname,n,
'namscrbin ',namscrbin(n)
634 do while (loc == nv .and. n1 < nv)
635 if (namfldseq(nv) < namfldseq(namsort2nn(n1))) loc = n1
640 namsort2nn(n1) = namsort2nn(n1-1)
646 namnn2sort(namsort2nn(nv)) = nv
649 IF (mpi_rank_global == 0)
THEN
653 WRITE(nulprt1,*) subname,
' sort ',nv,n1,n2,namfldseq(n1)
661 if (namfldseq(namsort2nn(n)) < namfldseq(namsort2nn(n-1)))
then
662 IF (mpi_rank_global == 0)
THEN
663 WRITE(nulprt1,*) subname,
' ERROR in seq sort'
664 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
665 WRITE (nulprt1,
'(a)')
' error = ERROR in seq sort'
711 CHARACTER*5000 clline, clline_aux, clvari
712 CHARACTER*9 clword, clfield, clstring, clmod, clchan
720 CHARACTER(len=32),
DIMENSION(:),
ALLOCATABLE :: cl_aux
721 INTEGER (kind=ip_intwp_p) il_varid, il_len, il_err, il_maxanal
722 INTEGER (kind=ip_intwp_p) nlonbf_notnc, nlatbf_notnc, &
723 nlonaf_notnc, nlataf_notnc
724 INTEGER (kind=ip_intwp_p) iind, il_redu, ib, il_aux, il_auxbf, &
725 il_auxaf, istatus, il_id
726 integer (kind=ip_intwp_p) :: ja,jz,jm,jf,ilen
727 integer (kind=ip_intwp_p) :: ig_clim_maxport
728 logical :: lg_bsend,endflag
729 character(len=*),
parameter :: subname=
'(mod_oasis_namcouple:inipar_alloc)'
740 IF (mpi_rank_global == 0)
THEN
741 WRITE (unit = nulprt1,fmt = *)
' '
742 WRITE (unit = nulprt1,fmt = *)
' ROUTINE inipar_alloc - Level 0'
743 WRITE (unit = nulprt1,fmt = *)
' ******************** *******'
744 WRITE (unit = nulprt1,fmt = *)
' '
745 WRITE (unit = nulprt1,fmt = *)
' Initialization of run parameters'
746 WRITE (unit = nulprt1,fmt = *)
' '
747 WRITE (unit = nulprt1,fmt = *)
' Reading input file namcouple'
748 WRITE (unit = nulprt1,fmt = *)
' '
749 WRITE (unit = nulprt1,fmt = *)
' '
756 lg_oasis_field = .true.
759 clfield =
' $NFIELDS'
761 clstring =
' $STRINGS'
768 READ (unit = nulin,fmt = 1001,
END = 140) clword
769 IF (clword .NE. clmod) go to 100
770 IF (mpi_rank_global == 0)
THEN
771 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
772 WRITE (unit = nulprt1,fmt = *)
'Information below $NBMODEL'
773 WRITE (unit = nulprt1,fmt = *)
'is obsolete in OASIS3-MCT'
774 WRITE (unit = nulprt1,fmt = *)
'It will not be read and will not be used'
784 READ (unit = nulin,fmt = 1001,
END = 130) clword
785 IF (clword .NE. clchan) go to 120
786 IF (mpi_rank_global == 0)
THEN
787 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
788 WRITE (unit = nulprt1,fmt = *)
'Information below $CHANNEL'
789 WRITE (unit = nulprt1,fmt = *)
'is obsolete in OASIS3-MCT'
790 WRITE (unit = nulprt1,fmt = *)
'It will not be read and will not be used'
809 READ (unit = nulin,fmt = 2001,
END = 210) clword
810 IF (clword .NE. clfield) go to 200
811 READ (unit = nulin,fmt = 2002) clline
812 CALL
parse(clline, clvari, 1, jpeighty, ilen)
813 IF (ilen .LE. 0)
THEN
814 IF (mpi_rank_global == 0)
THEN
815 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
816 WRITE (unit = nulprt1,fmt = *) &
817 ' Nothing on input for $NFIELDS '
818 WRITE (unit = nulprt1,fmt = *)
' Default value will be used '
819 WRITE (unit = nulprt1,fmt = *)
' '
823 READ (clvari,fmt = 2003) ig_total_nfield
829 (
'The maximum number of exchanged fields set in namcouple is nfield =', &
834 ALLOCATE (ig_number_field(ig_total_nfield),stat=il_err)
835 IF (il_err.NE.0) CALL
prtout &
836 (
'Error: ig_number_field allocation of inipar_alloc',il_err,1)
842 ALLOCATE (lg_state(ig_total_nfield), stat=il_err)
843 IF (il_err.NE.0) CALL
prtout &
844 (
'Error: lg_state allocation of inipar_alloc',il_err,1)
849 ALLOCATE (ig_total_state(ig_total_nfield), stat=il_err)
850 IF (il_err.NE.0) CALL
prtout &
851 (
'Error: ig_total_state allocation of inipar_alloc',il_err,1)
856 ALLOCATE (cg_output_field(ig_total_nfield), stat=il_err)
857 IF (il_err.NE.0) CALL
prtout &
858 (
'Error: cg_output_field allocation of inipar_alloc',il_err,1)
859 cg_output_field(:)=
' '
863 ALLOCATE (ig_total_ntrans(ig_total_nfield),stat=il_err)
864 IF (il_err.NE.0) CALL
prtout &
865 (
'Error: ig_total_ntrans"allocation of inipar_alloc',il_err,1)
866 ig_total_ntrans(:) = 0
870 ALLOCATE (cg_restart_file(ig_total_nfield),stat=il_err)
871 IF (il_err.NE.0) CALL
prtout &
872 (
'Error: cg_restart_FILE allocation of inipar_alloc',il_err,1)
873 cg_restart_file(:)=
' '
874 ALLOCATE (cg_input_file(ig_total_nfield), stat=il_err)
875 IF (il_err.NE.0) CALL
prtout &
876 (
'Error in "cg_input_file"allocation of inipar_alloc',il_err,1)
881 ALLOCATE (cga_locatorbf(ig_total_nfield),stat=il_err)
882 IF (il_err.NE.0) CALL
prtout &
883 (
'Error: cga_locatorbf allocation of inipar_alloc',il_err,1)
886 ALLOCATE (cga_locatoraf(ig_total_nfield),stat=il_err)
887 IF (il_err.NE.0) CALL
prtout &
888 (
'Error: cga_locatoraf allocation of inipar_alloc',il_err,1)
895 READ (unit = nulin,fmt = 2001,
END = 230) clword
896 IF (clword .NE. clstring) go to 220
902 DO 240 jf = 1, ig_total_nfield
906 READ (unit = nulin,fmt = 2002, end=241) clline
907 CALL
parse(clline, clvari, 1, jpeighty, ilen, endflag=endflag)
908 if (endflag .EQV. .true.) goto 241
909 IF (trim(clvari) .EQ.
" ") goto 232
910 IF (trim(clvari) .eq.
"$END") goto 241
912 IF (mpi_rank_global == 0)
THEN
913 write(nulprt1,*)
'parsing: ',trim(clline)
916 CALL
parse(clline, clvari, 2, jpeighty, ilen)
917 cg_output_field(jf) = clvari
919 CALL
parse(clline, clvari, 5, jpeighty, ilen)
920 READ (clvari,fmt = 2003) ig_total_ntrans(jf)
922 CALL
parse(clline, clvari, 6, jpeighty, ilen)
923 IF (clvari(1:6) .EQ.
'OUTPUT')
THEN
924 ig_direct_nfield = ig_direct_nfield + 1
925 lg_state(jf) = .false.
926 ig_total_state(jf) = ip_output
930 CALL
parse(clline, clvari, 7, jpeighty, ilen)
931 IF (clvari(1:8).eq.
'EXPORTED')
THEN
932 ig_nfield = ig_nfield + 1
933 lg_state(jf) = .true.
934 ig_number_field(jf) = ig_nfield
935 ig_total_state(jf) = ip_exported
936 CALL
parse(clline, clvari, 6, jpeighty, ilen)
938 cg_restart_file(jf) = clvari
940 ELSEIF (clvari(1:6) .eq.
'OUTPUT' )
THEN
941 ig_direct_nfield = ig_direct_nfield + 1
942 lg_state(jf) = .false.
943 ig_total_state(jf) = ip_output
944 CALL
parse(clline, clvari, 6, jpeighty, ilen)
945 cg_restart_file(jf) = clvari
946 ELSEIF (clvari(1:7) .eq.
'IGNORED' )
THEN
947 ig_direct_nfield = ig_direct_nfield + 1
948 lg_state(jf) = .false.
949 ig_total_state(jf) = ip_ignored
950 CALL
parse(clline, clvari, 6, jpeighty, ilen)
952 cg_restart_file(jf) = clvari
953 ELSEIF (clvari(1:6) .eq.
'EXPOUT')
THEN
954 ig_nfield = ig_nfield + 1
955 lg_state(jf) = .true.
956 ig_number_field(jf) = ig_nfield
957 ig_total_state(jf) = ip_expout
958 CALL
parse(clline, clvari, 6, jpeighty, ilen)
960 cg_restart_file(jf) = clvari
961 ELSEIF (clvari(1:6) .eq.
'IGNOUT' )
THEN
962 ig_direct_nfield = ig_direct_nfield + 1
963 lg_state(jf) = .false.
964 ig_total_state(jf) = ip_ignout
965 CALL
parse(clline, clvari, 6, jpeighty, ilen)
967 cg_restart_file(jf) = clvari
968 ELSEIF (clvari(1:9).eq.
'AUXILARY')
THEN
969 ig_nfield = ig_nfield + 1
970 lg_state(jf) = .true.
971 ig_number_field(jf) = ig_nfield
972 ig_total_state(jf) = ip_auxilary
973 CALL
parse(clline, clvari, 6, jpeighty, ilen)
975 cg_restart_file(jf) = clvari
976 ELSEIF (clvari(1:5) .eq.
'INPUT')
THEN
977 ig_direct_nfield = ig_direct_nfield + 1
978 lg_state(jf) = .false.
979 ig_total_state(jf) = ip_input
980 CALL
parse(clline, clvari, 6, jpeighty, ilen)
982 cg_input_file(jf) = clvari
985 IF (lg_state(jf))
THEN
986 IF (ig_total_ntrans(jf) .eq. 0)
THEN
987 IF (mpi_rank_global == 0)
THEN
988 WRITE (unit = nulprt1,fmt = *) &
989 'If there is no analysis for the field',jf, &
990 'then the status must not be "EXPORTED"'
991 WRITE (unit = nulprt1,fmt = *)
' "AUXILARY" or "EXPOUT" '
992 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
993 WRITE (nulprt1,
'(a)')
' error = STOP in inipar_alloc'
998 READ (unit = nulin,fmt = 2002) clline
999 CALL
skip(clline, jpeighty)
1000 READ (unit = nulin,fmt = 2002) clline
1001 CALL
skip(clline, jpeighty)
1002 READ (unit = nulin,fmt = 2002)clline_aux
1003 DO ja=1,ig_total_ntrans(jf)
1004 CALL
parse(clline_aux, clvari, ja, jpeighty, ilen)
1005 IF (clvari.eq.
'CORRECT'.or.clvari.eq.
'BLASOLD'.or. &
1006 clvari.eq.
'BLASNEW')
THEN
1007 READ (unit = nulin,fmt = 2002) clline
1008 CALL
parse(clline, clvari, 2, jpeighty, ilen)
1009 READ(clvari,fmt = 2003) il_aux
1011 READ (unit = nulin,fmt = 2002) clline
1012 CALL
skip(clline, jpeighty)
1014 ELSE IF (clvari.eq.
'NOINTERP')
THEN
1017 READ (unit = nulin,fmt = 2002) clline
1018 CALL
skip(clline, jpeighty)
1022 IF (ig_total_state(jf) .ne. ip_input)
THEN
1023 READ (unit = nulin,fmt = 2002) clline
1024 CALL
skip(clline, jpeighty)
1026 IF (ig_total_state(jf) .ne. ip_input .and. &
1027 ig_total_ntrans(jf) .gt. 0 )
THEN
1028 READ (unit = nulin,fmt = 2002) clline
1029 CALL
parse(clline, clvari, 1, jpeighty, ilen)
1030 IF (clvari(1:8) .ne.
'LOCTRANS')
THEN
1031 IF (mpi_rank_global == 0)
THEN
1032 WRITE (unit = nulprt1,fmt = *) &
1033 'You want a transformation which is not available !'
1034 WRITE (unit = nulprt1,fmt = *) &
1035 'Only local transformations are available for '
1036 WRITE (unit = nulprt1,fmt = *) &
1037 'fields exchanged directly or output fields '
1038 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
1039 WRITE (nulprt1,
'(a)')
' error = STOP in inipar_alloc'
1044 DO ja=1,ig_total_ntrans(jf)
1045 READ (unit = nulin,fmt = 2002) clline
1046 CALL
skip(clline, jpeighty)
1051 ig_final_nfield = ig_final_nfield + 1
1056 243
READ (unit = nulin,fmt = 2002, end=242) clline
1057 CALL
skip(clline, jpeighty,endflag=endflag)
1058 if (endflag .EQV. .true.) goto 242
1059 CALL
parse(clline, clvari, 1, jpeighty, ilen)
1060 IF (trim(clvari) .eq.
"$END") goto 243
1062 IF (mpi_rank_global == 0)
THEN
1063 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
1064 WRITE (unit = nulprt1,fmt = *) &
1065 ' NFIELDS too small, increase it in namcouple'
1066 WRITE (unit = nulprt1,fmt = *)
' '
1067 WRITE (unit = nulprt1,fmt = *)
' '
1068 WRITE (unit = nulprt1,fmt = *) &
1069 ' We STOP!!! Check the file namcouple'
1070 WRITE (unit = nulprt1,fmt = *)
' '
1071 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
1072 WRITE (nulprt1,
'(a)')
' error = STOP in inipar_alloc'
1078 IF (mpi_rank_global == 0)
then
1079 WRITE (nulprt1,
'(a,i6)')
' found namcouple couplings = ',ig_final_nfield
1083 IF (ig_nfield.eq.0)
THEN
1084 lg_oasis_field = .false.
1085 IF (mpi_rank_global == 0)
THEN
1086 WRITE (nulprt1,*)
'==> All the fields are exchanged directly'
1094 allocate (cl_aux(ig_final_nfield))
1096 DO jf = 1,ig_final_nfield
1098 cl_aux(1) = cg_restart_file(1)
1100 ELSEIF (jf.gt.1)
THEN
1101 IF (all(cl_aux.ne.cg_restart_file(jf)))
THEN
1103 cl_aux(il_aux) = cg_restart_file(jf)
1108 ig_nbr_rstfile = il_aux
1110 IF (lg_oasis_field)
THEN
1114 ALLOCATE (cintmet(ig_nfield),stat=il_err)
1115 IF (il_err.NE.0) CALL
prtout &
1116 (
'Error: cintmet allocation of inipar_alloc',il_err,1)
1117 ALLOCATE (naismfl(ig_nfield),stat=il_err)
1118 IF (il_err.NE.0) CALL
prtout &
1119 (
'Error: naismfl allocation of inipar_alloc',il_err,1)
1120 ALLOCATE (naismvoi(ig_nfield),stat=il_err)
1121 IF (il_err.NE.0) CALL
prtout &
1122 (
'Error: naismvoi allocation of inipar_alloc',il_err,1)
1123 ALLOCATE (naisgfl(ig_nfield),stat=il_err)
1124 IF (il_err.NE.0) CALL
prtout &
1125 (
'Error: naisgfl allocation of inipar_alloc',il_err,1)
1126 ALLOCATE (naisgvoi(ig_nfield),stat=il_err)
1127 IF (il_err.NE.0) CALL
prtout &
1128 (
'Error: naisgvoi allocation of inipar_alloc',il_err,1)
1137 ALLOCATE (cextmet(ig_nfield),stat=il_err)
1138 IF (il_err.NE.0) CALL
prtout &
1139 (
'Error: cextmet allocation of inipar_alloc',il_err,1)
1140 ALLOCATE (nninnfl(ig_nfield),stat=il_err)
1141 IF (il_err.NE.0) CALL
prtout &
1142 (
'Error: nninnfl allocation of inipar_alloc',il_err,1)
1143 ALLOCATE (nninnflg(ig_nfield),stat=il_err)
1144 IF (il_err.NE.0) CALL
prtout &
1145 (
'Error: nninnflg allocation of inipar_alloc',il_err,1)
1146 ALLOCATE (neighbor(ig_nfield), stat=il_err)
1147 IF (il_err.NE.0) CALL
prtout &
1148 (
'Error: neighbor allocation of inipar_alloc',il_err,1)
1149 ALLOCATE (nextfl(ig_nfield),stat=il_err)
1150 IF (il_err.NE.0) CALL
prtout &
1151 (
'Error: nextfl allocation of inipar_alloc',il_err,1)
1160 ALLOCATE (nbofld(ig_nfield), stat=il_err)
1161 IF (il_err.NE.0) CALL
prtout &
1162 (
'Error: nbofld allocation of inipar_alloc',il_err,1)
1163 ALLOCATE (nbnfld(ig_nfield), stat=il_err)
1164 IF (il_err.NE.0) CALL
prtout &
1165 (
'Error: nbnfld allocation of inipar_alloc',il_err,1)
1171 ALLOCATE (nmapvoi(ig_nfield),stat=il_err)
1172 IF (il_err.NE.0) CALL
prtout &
1173 (
'Error: nmapvoi allocation of inipar_alloc',il_err,1)
1174 ALLOCATE (nmapfl(ig_nfield),stat=il_err)
1175 IF (il_err.NE.0) CALL
prtout &
1176 (
'Error: nmapfl allocation of inipar_alloc',il_err,1)
1182 ALLOCATE (nsubfl(ig_nfield),stat=il_err)
1183 IF (il_err.NE.0) CALL
prtout &
1184 (
'Error: nsubfl allocation of inipar_alloc',il_err,1)
1185 ALLOCATE (nsubvoi(ig_nfield),stat=il_err)
1186 IF (il_err.NE.0) CALL
prtout &
1187 (
'Error: nsubvoi allocation of inipar_alloc',il_err,1)
1193 ALLOCATE (ntronca(ig_nfield), stat=il_err)
1194 IF (il_err.NE.0) CALL
prtout &
1195 (
'Error: ntronca allocation of inipar_alloc',il_err,1)
1201 ALLOCATE (cficbf(ig_nfield),stat=il_err)
1202 IF (il_err.NE.0) CALL
prtout &
1203 (
'Error: cficbf allocation of inipar_alloc',il_err,1)
1205 ALLOCATE (cficaf(ig_nfield),stat=il_err)
1206 IF (il_err.NE.0) CALL
prtout &
1207 (
'Error: cficaf allocation of inipar_alloc',il_err,1)
1213 ALLOCATE (nlonbf(ig_nfield),stat=il_err)
1214 IF (il_err.NE.0) CALL
prtout &
1215 (
'Error: nlonbf allocation of inipar_alloc',il_err,1)
1217 ALLOCATE (nlatbf(ig_nfield),stat=il_err)
1218 IF (il_err.NE.0) CALL
prtout &
1219 (
'Error: nlatbf allocation of inipar_alloc',il_err,1)
1221 ALLOCATE (nlonaf(ig_nfield),stat=il_err)
1222 IF (il_err.NE.0) CALL
prtout &
1223 (
'Error: nlonaf allocation of inipar_alloc',il_err,1)
1225 ALLOCATE (nlataf(ig_nfield),stat=il_err)
1226 IF (il_err.NE.0) CALL
prtout &
1227 (
'Error: nlataf allocation of inipar_alloc',il_err,1)
1232 ALLOCATE (ig_grid_nbrbf(ig_nfield),stat=il_err)
1233 IF (il_err.NE.0) CALL
prtout &
1234 (
'Error: ig_grid_nbrbf allocation of inipar_alloc',il_err,1)
1236 ALLOCATE (ig_grid_nbraf(ig_nfield),stat=il_err)
1237 IF (il_err.NE.0) CALL
prtout &
1238 (
'Error: ig_grid_nbraf allocation of inipar_alloc',il_err,1)
1244 ALLOCATE (ig_ntrans(ig_nfield),stat=il_err)
1245 IF (il_err.NE.0) CALL
prtout &
1246 (
'Error: ig_ntrans allocation of inipar_alloc',il_err,1)
1248 DO ib = 1, ig_final_nfield
1250 ig_ntrans(ig_number_field(ib))=ig_total_ntrans(ib)
1255 il_maxanal = maxval(ig_ntrans)
1259 ALLOCATE (cficinp(ig_nfield), stat=il_err)
1260 IF (il_err.NE.0) CALL
prtout &
1261 (
'Error: cficinp allocation of inipar_alloc',il_err,1)
1263 DO ib = 1, ig_final_nfield
1265 cficinp(ig_number_field(ib))=cg_restart_file(ib)
1279 IF (mpi_rank_global == 0)
THEN
1280 WRITE(nulprt1, *)
'lncdfrst =', lncdfrst
1286 ALLOCATE (canal(il_maxanal,ig_nfield),stat=il_err)
1287 IF (il_err.NE.0) CALL
prtout &
1288 (
'Error: canal allocation of inipar_alloc',il_err,1)
1296 READ (unit = nulin,fmt = 2001,
END = 230) clword
1297 IF (clword .NE. clstring) go to 221
1301 DO 250 jf=1,ig_final_nfield
1312 READ (unit = nulin,fmt = 2002) clline
1313 CALL
skip(clline, jpeighty)
1320 IF (ig_total_state(jf) .NE. ip_input)
THEN
1321 READ (unit = nulin,fmt = 2002) clline
1323 CALL
parse(clline, clvari, 3, jpeighty, ilen)
1324 IF (ilen .LT. 0)
THEN
1328 CALL
parse(clline, clvari, 1, jpeighty, ilen)
1330 cficbf(ig_number_field(jf)) = clvari
1331 cga_locatorbf(jf) = clvari(1:4)
1332 CALL
parse(clline, clvari, 2, jpeighty, ilen)
1334 cficaf(ig_number_field(jf)) = clvari
1335 cga_locatoraf(jf) = clvari(1:4)
1338 READ(clvari,fmt = 2010) clind, clequa, iind
1339 IF (clind .EQ.
'SEQ' .OR. clind .EQ.
'LAG' .AND. &
1340 clequa .EQ.
'=')
THEN
1344 CALL
parse(clline, clvari, 1, jpeighty, ilen)
1346 cficbf(ig_number_field(jf)) = clvari
1347 cga_locatorbf(jf) = clvari(1:4)
1348 CALL
parse(clline, clvari, 2, jpeighty, ilen)
1350 cficaf(ig_number_field(jf)) = clvari
1351 cga_locatoraf(jf) = clvari(1:4)
1357 CALL
parse(clline, clvari, 1, jpeighty, ilen)
1359 IF (mpi_rank_global == 0)
THEN
1360 WRITE(nulprt1,*)
'CLVARI=',trim(clvari)
1363 READ(clvari,fmt = 2004) nlonbf_notnc
1364 CALL
parse(clline, clvari, 2, jpeighty, ilen)
1366 READ(clvari,fmt = 2004) nlatbf_notnc
1367 CALL
parse(clline, clvari, 3, jpeighty, ilen)
1369 READ(clvari,fmt = 2004) nlonaf_notnc
1370 CALL
parse(clline, clvari, 4, jpeighty, ilen)
1372 READ(clvari,fmt = 2004) nlataf_notnc
1373 CALL
parse(clline, clvari, 5, jpeighty, ilen)
1376 cficbf(ig_number_field(jf)) = clvari
1377 cga_locatorbf(jf) = clvari(1:4)
1378 CALL
parse(clline, clvari, 6, jpeighty, ilen)
1381 cficaf(ig_number_field(jf)) = clvari
1382 cga_locatoraf(jf) = clvari(1:4)
1383 nlonbf(ig_number_field(jf)) = nlonbf_notnc
1384 nlatbf(ig_number_field(jf)) = nlatbf_notnc
1385 nlonaf(ig_number_field(jf)) = nlonaf_notnc
1386 nlataf(ig_number_field(jf)) = nlataf_notnc
1393 IF (lg_state(jf))
THEN
1394 READ (unit = nulin,fmt = 2002) clline
1395 CALL
skip(clline, jpeighty)
1401 IF (ig_total_ntrans(jf) .GT. 0)
THEN
1402 READ (unit = nulin,fmt = 2002) clline
1403 CALL
skip(clline, jpeighty)
1404 DO 260 ja = 1, ig_total_ntrans(jf)
1405 CALL
parse(clline, clvari, ja, jpeighty, ilen)
1408 canal(ja,ig_number_field(jf)) = clvari
1410 DO 270 ja = 1, ig_total_ntrans(jf)
1412 IF (lg_state(jf))
THEN
1413 cg_c=canal(ja,ig_number_field(jf))
1414 IF (mpi_rank_global == 0)
THEN
1415 WRITE(nulprt1,*)
'LG_STATE cg_c=', trim(clline)
1418 IF (cg_c .EQ.
'NOINTERP' .OR. cg_c .EQ.
'REDGLO' .OR. cg_c .EQ.
'INVERT' .OR. &
1419 cg_c .EQ.
'MASK' .OR. cg_c .EQ.
'EXTRAP' .OR. cg_c .EQ.
'CORRECT' .OR. &
1420 cg_c .EQ.
'REDGLO' .OR. cg_c .EQ.
'INTERP' .OR. cg_c .EQ.
'MOZAIC' .OR. &
1421 cg_c .EQ.
'FILLING' .OR. cg_c .EQ.
'MASKP' .OR. cg_c .EQ.
'REVERSE' .OR. &
1422 cg_c .EQ.
'GLORED')
THEN
1423 IF (mpi_rank_global == 0)
THEN
1424 WRITE(unit = nulprt1,fmt = *)
' ***ERROR***'
1425 WRITE(unit = nulprt1,fmt = *)
' OBSOLETE OPERATION= ', cg_c
1426 WRITE(unit = nulprt1,fmt = *)
' SPECIFIED IN THE namcouple'
1427 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
1428 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
1433 READ (unit = nulin,fmt = 2002) clline
1434 CALL
skip(clline, jpeighty)
1435 IF (canal(ja,ig_number_field(jf)) .EQ.
'SCRIPR')
THEN
1437 CALL
parse(clline, clvari, 3, jpeighty, ilen)
1438 READ(clvari,fmt = 2009) clstrg
1439 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'BLASOLD')
THEN
1440 CALL
parse(clline, clvari, 2, jpeighty, ilen)
1442 READ(clvari,fmt = 2003) nbofld(ig_number_field(jf))
1443 DO ib = 1,nbofld(ig_number_field(jf))
1444 READ (unit = nulin,fmt = 2002) clline
1445 CALL
skip(clline, jpeighty)
1447 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'BLASNEW')
THEN
1448 CALL
parse(clline, clvari, 2, jpeighty, ilen)
1450 READ(clvari,fmt = 2003) nbnfld(ig_number_field(jf))
1451 DO ib = 1,nbnfld(ig_number_field(jf))
1452 READ (unit = nulin,fmt = 2002) clline
1453 CALL
skip(clline, jpeighty)
1458 READ (unit = nulin,fmt = 2002) clline
1459 IF (mpi_rank_global == 0)
THEN
1460 WRITE(nulprt1,*)
'OUTPUT clline=', clline
1463 CALL
skip(clline, jpeighty)
1472 IF (lg_oasis_field)
THEN
1476 ig_maxcomb = maxval(nbofld)
1477 IF (maxval(nbnfld).GT.ig_maxcomb) &
1478 ig_maxcomb = maxval(nbnfld)
1482 ig_maxnoa = maxval(naisgvoi)
1483 IF (mpi_rank_global == 0)
THEN
1485 'Max number of neighbors for GAUSSIAN interp : ', &
1493 ig_maxnfg = maxval(naisgfl)
1494 IF (mpi_rank_global == 0)
THEN
1496 'Maximum number of different GAUSSIAN interpolations : ', &
1510 2010
FORMAT(a3,a1,i2)
1515 IF (mpi_rank_global == 0)
THEN
1516 WRITE(unit = nulprt1,fmt = *)
' '
1517 WRITE(unit = nulprt1,fmt = *)
'-- End of ROUTINE inipar_alloc --'
1527 IF (mpi_rank_global == 0)
THEN
1528 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
1529 WRITE (unit = nulprt1,fmt = *) &
1530 ' Problem with $NBMODEL in input file namcouple'
1531 WRITE (unit = nulprt1,fmt = *)
' '
1532 WRITE (unit = nulprt1,fmt = *)
' '
1533 WRITE (unit = nulprt1,fmt = *) &
1534 ' We STOP!!! Check the file namcouple'
1535 WRITE (unit = nulprt1,fmt = *)
' '
1536 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
1537 WRITE (nulprt1,
'(a)')
' error = STOP in inipar_alloc'
1542 IF (mpi_rank_global == 0)
THEN
1543 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
1544 WRITE (unit = nulprt1,fmt = *) &
1545 ' No active $FIELDS data found in input file namcouple'
1546 WRITE (unit = nulprt1,fmt = *)
' '
1547 WRITE (unit = nulprt1,fmt = *)
' '
1548 WRITE (unit = nulprt1,fmt = *) &
1549 ' We STOP!!! Check the file namcouple'
1550 WRITE (unit = nulprt1,fmt = *)
' '
1551 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
1552 WRITE (nulprt1,
'(a)')
' error = STOP in inipar_alloc'
1557 IF (mpi_rank_global == 0)
THEN
1558 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
1559 WRITE (unit = nulprt1,fmt = *) &
1560 ' No active $STRING data found in input file namcouple'
1561 WRITE (unit = nulprt1,fmt = *)
' '
1562 WRITE (unit = nulprt1,fmt = *)
' '
1563 WRITE (unit = nulprt1,fmt = *) &
1564 ' We STOP!!! Check the file namcouple'
1565 WRITE (unit = nulprt1,fmt = *)
' '
1566 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
1567 WRITE (nulprt1,
'(a)')
' error = STOP in inipar_alloc'
1572 IF (mpi_rank_global == 0)
THEN
1573 WRITE (unit = nulprt1,fmt = *) subname,
': ***WARNING***'
1574 WRITE (unit = nulprt1,fmt = *) &
1575 ' size clline smaller than the size of the names of the fields on the line'
1576 WRITE (unit = nulprt1,fmt = *) &
1577 ' increase jpeighty and change the associated format A(jpeighty) and cline'
1578 WRITE (unit = nulprt1,fmt = *)
' '
1579 WRITE (unit = nulprt1,fmt = *)
' '
1580 WRITE (unit = nulprt1,fmt = *) &
1581 ' We STOP!!! Check the file namcouple'
1582 WRITE (unit = nulprt1,fmt = *)
' '
1583 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
1584 WRITE (nulprt1,
'(a)')
' error = STOP in inipar_alloc'
1624 CHARACTER*5000 clline, clvari
1625 CHARACTER*9 clword, clstring, clprint, clcal, clchan
1626 CHARACTER*9 cljob, clmod, cltime, clseq, cldate, clhead
1627 CHARACTER*8 cl_print_trans, cl_print_state
1628 CHARACTER*3 clinfo, clind
1630 CHARACTER*64 cl_cfname,cl_cfunit
1631 INTEGER (kind=ip_intwp_p) iind, il_aux
1632 INTEGER (kind=ip_intwp_p) il_file_unit, id_error
1633 INTEGER (kind=ip_intwp_p) il_max_entry_id, il_no_of_entries
1634 INTEGER (kind=ip_intwp_p) il_i, il_pos
1635 LOGICAL llseq, lllag, ll_exist
1637 integer (kind=ip_intwp_p) :: ib,ilind1,ilind2,ilind
1638 integer (kind=ip_intwp_p) :: ja,jf,jfn,jz,jm,ilen,idum
1639 integer (kind=ip_intwp_p) :: ifca,ifcb,ilab,jff,jc
1640 integer (kind=ip_intwp_p) :: icofld,imodel
1641 character(len=*),
parameter :: subname=
'(mod_oasis_namcouple:inipar)'
1652 IF (mpi_rank_global == 0)
THEN
1653 WRITE (unit = nulprt1,fmt = *)
' '
1654 WRITE (unit = nulprt1,fmt = *)
' ROUTINE inipar - Level 0'
1655 WRITE (unit = nulprt1,fmt = *)
' ************** *******'
1656 WRITE (unit = nulprt1,fmt = *)
' '
1657 WRITE (unit = nulprt1,fmt = *)
' Initialization of run parameters'
1658 WRITE (unit = nulprt1,fmt = *)
' Reading input file namcouple'
1659 WRITE (unit = nulprt1,fmt = *)
' '
1665 clstring =
' $STRINGS'
1667 clchan =
' $CHANNEL'
1669 cltime =
' $RUNTIME'
1671 cldate =
' $INIDATE'
1672 clhead =
' $MODINFO'
1673 clprint =
' $NLOGPRT'
1677 ntime = 0 ; niter = 5
1678 nstep = 86400 ; nitfn=4
1684 READ (unit = nulin,fmt = 1001,
END = 110) clword
1685 IF (clword .NE. cljob) go to 100
1686 IF (mpi_rank_global == 0)
THEN
1687 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
1688 WRITE (unit = nulprt1,fmt = *)
'Information below $JOBNAME'
1689 WRITE (unit = nulprt1,fmt = *)
'is obsolote in OASIS3-MCT'
1690 WRITE (unit = nulprt1,fmt = *)
'It will not be read and will not be used'
1700 READ (unit = nulin,fmt = 1001,
END = 140) clword
1701 IF (clword .NE. clmod) go to 120
1702 IF (mpi_rank_global == 0)
THEN
1703 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
1704 WRITE (unit = nulprt1,fmt = *)
'Information below $NBMODEL'
1705 WRITE (unit = nulprt1,fmt = *)
'is obsolete in OASIS3-MCT'
1706 WRITE (unit = nulprt1,fmt = *)
'It will not be read and will not be used'
1716 READ (unit = nulin,fmt = 1001,
END = 170) clword
1717 IF (clword .NE. clchan) go to 160
1718 IF (mpi_rank_global == 0)
THEN
1719 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
1720 WRITE (unit = nulprt1,fmt = *)
'Information below $CHANNEL'
1721 WRITE (unit = nulprt1,fmt = *)
'is obsolote in OASIS3-MCT'
1722 WRITE (unit = nulprt1,fmt = *)
'It will not be read and will not be used'
1732 READ (unit = nulin,fmt = 1001,
END = 191) clword
1733 IF (clword .NE. cltime) go to 190
1734 READ (unit = nulin,fmt = 1002) clline
1735 CALL
parse(clline, clvari, 1, jpeighty, ilen)
1736 IF (ilen .LE. 0)
THEN
1739 READ (clvari,fmt = 1004) ntime
1745 (
'The total time for this run is ntime =', ntime, 1)
1751 READ (unit = nulin,fmt = 1001,
END = 193) clword
1752 IF (clword .NE. cldate) go to 192
1753 IF (mpi_rank_global == 0)
THEN
1754 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
1755 WRITE (unit = nulprt1,fmt = *)
'Information below $INIDATE'
1756 WRITE (unit = nulprt1,fmt = *)
'is obsolete in OASIS3-MCT'
1757 WRITE (unit = nulprt1,fmt = *)
'It will not be read and will not be used'
1767 READ (unit = nulin,fmt = 1001,
END = 195) clword
1768 IF (clword .NE. clseq) go to 194
1769 IF (mpi_rank_global == 0)
THEN
1770 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
1771 WRITE (unit = nulprt1,fmt = *)
'Information below $SEQMODE'
1772 WRITE (unit = nulprt1,fmt = *)
'is obsolete in OASIS3-MCT'
1773 WRITE (unit = nulprt1,fmt = *)
'It will not be read and will not be used'
1783 READ (unit = nulin,fmt = 1001,
END = 197) clword
1784 IF (clword .NE. clhead) go to 196
1785 IF (mpi_rank_global == 0)
THEN
1786 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
1787 WRITE (unit = nulprt1,fmt = *)
'Information below $MODINFO'
1788 WRITE (unit = nulprt1,fmt = *)
'is obsolete in OASIS3-MCT'
1789 WRITE (unit = nulprt1,fmt = *)
'It will not be read and will not be used'
1798 (
'The information mode is activated ? ==>', clinfo, 1)
1804 READ (unit = nulin,fmt = 1001,
END = 199) clword
1805 IF (clword .NE. clprint) go to 198
1807 READ (unit = nulin,fmt = 1002) clline
1808 CALL
parse(clline, clvari, 1, jpeighty, ilen)
1809 IF (ilen .LE. 0)
THEN
1810 IF (mpi_rank_global == 0)
THEN
1811 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
1812 WRITE (unit = nulprt1,fmt = *) &
1813 ' Nothing on input for $NLOGPRT '
1814 WRITE (unit = nulprt1,fmt = *)
' Default value 2 will be used '
1815 WRITE (unit = nulprt1,fmt = *)
' '
1818 ELSE IF (ilen .gt. 8)
THEN
1819 IF (mpi_rank_global == 0)
THEN
1820 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
1821 WRITE (unit = nulprt1,fmt = *) &
1822 ' Input variable length is incorrect'
1823 WRITE (unit = nulprt1,fmt = *) &
1824 ' Printing level uncorrectly specified'
1825 WRITE (unit = nulprt1,fmt = *)
' ilen = ', ilen
1826 WRITE (unit = nulprt1,fmt = *) &
1827 ' Check $NLOGPRT variable spelling '
1828 WRITE (unit = nulprt1,fmt = *)
' Default value will be used '
1832 READ (clvari,fmt = 1004) nlogprt
1835 CALL
parse(clline, clvari, 2, jpeighty, ilen)
1837 READ (clvari,fmt = 1004) ntlogprt
1839 IF (mpi_rank_global == 0)
THEN
1840 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
1841 WRITE (unit = nulprt1,fmt = *) &
1842 ' Nothing on input for time statistic '
1843 WRITE (unit = nulprt1,fmt = *)
' Default value 0 will be used '
1844 WRITE (unit = nulprt1,fmt = *)
' '
1852 (
'The printing level is nlogprt =', nlogprt, 1)
1854 (
'The time statistics level is ntlogprt =', ntlogprt, 1)
1860 READ (unit = nulin,fmt = 1001,
END = 201) clword
1861 IF (clword .NE. clcal) go to 200
1862 IF (mpi_rank_global == 0)
THEN
1863 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
1864 WRITE (unit = nulprt1,fmt = *)
'Information below $CALTYPE'
1865 WRITE (unit = nulprt1,fmt = *)
'is obsolete in OASIS3-MCT'
1866 WRITE (unit = nulprt1,fmt = *)
'It will not be read and will not be used'
1884 ig_local_trans(:) = ip_instant
1890 IF (lg_oasis_field)
THEN
1892 DO 215 jz = 1, ig_nfield
1907 READ (unit = nulin,fmt = 2001,
END = 230) clword
1908 IF (clword .NE. clstring) go to 220
1916 DO 240 jf = 1, ig_final_nfield
1923 READ (unit = nulin,fmt = 2002) clline
1924 CALL
parse(clline, clvari, 1, jpeighty, ilen)
1926 cg_input_field(jf) = clvari
1927 IF (lg_state(jf)) cnaminp(ig_number_field(jf)) = cg_input_field(jf)
1928 IF (lg_state(jf)) cnamout(ig_number_field(jf)) = cg_output_field(jf)
1929 CALL
parse(clline, clvari, 3, jpeighty, ilen)
1931 READ (clvari,fmt = 2003) ig_numlab(jf)
1932 IF (lg_state(jf)) numlab(ig_number_field(jf)) = ig_numlab(jf)
1933 CALL
parse(clline, clvari, 4, jpeighty, ilen)
1935 IF (clvari(1:4) .EQ.
'ONCE')
THEN
1942 READ (clvari,fmt = 2004) ig_freq(jf)
1943 IF (ig_freq(jf) .EQ. 0)
THEN
1945 ELSEIF (ig_freq(jf) .gt. ntime)
THEN
1946 IF (mpi_rank_global == 0)
THEN
1947 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
1948 WRITE (unit = nulprt1,fmt = *) &
1949 'The coupling period of the field ',jf
1950 WRITE (unit = nulprt1,fmt = *) &
1951 'is greater than the time of the simulation '
1952 WRITE (unit = nulprt1,fmt = *) &
1953 'This field will not be exchanged !'
1958 IF (lg_state(jf)) nfexch(ig_number_field(jf)) = ig_freq(jf)
1960 IF (cg_restart_file(jf).ne.
' ')
THEN
1963 ig_no_rstfile(jf) = il_aux
1964 cg_name_rstfile(ig_no_rstfile(jf)) = &
1966 ELSEIF (jf.gt.1)
THEN
1967 IF (all(cg_name_rstfile.ne.cg_restart_file(jf)))
THEN
1969 ig_no_rstfile(jf) = il_aux
1970 cg_name_rstfile(ig_no_rstfile(jf))= &
1974 IF(cg_name_rstfile(ig_no_rstfile(ib)).eq. &
1975 cg_restart_file(jf))
THEN
1976 ig_no_rstfile(jf) = ig_no_rstfile(ib)
1982 CALL
parse(clline, clvari, 7, jpeighty, ilen)
1985 IF (clvari(1:8).eq.
'EXPORTED' .or. &
1986 clvari(1:8).eq.
'AUXILARY')
THEN
1987 cstate(ig_number_field(jf)) = clvari
1988 ELSEIF (clvari(1:6) .eq.
'EXPOUT')
THEN
1989 cstate(ig_number_field(jf)) =
'EXPORTED'
1995 IF (ig_total_state(jf) .ne. ip_input)
THEN
1996 READ (unit = nulin,fmt = 2002) clline
1998 CALL
parse(clline, clvari, 3, jpeighty, ilen)
1999 IF (ilen .lt. 0)
THEN
2003 ig_total_nseqn(jf)=1
2004 IF (lg_state(jf))
then
2005 nseqn(ig_number_field(jf)) = 1
2006 nlagn(ig_number_field(jf)) = 0
2010 IF (mpi_rank_global == 0)
THEN
2011 WRITE (unit=nulprt1,fmt=3043) jf
2014 READ(clvari,fmt = 2011) clind, clequa, iind
2015 IF (clind .EQ.
'SEQ' .or. clind .EQ.
'LAG' .and. &
2016 clequa .EQ.
'=')
THEN
2030 ig_total_nseqn(jf)=1
2031 IF (lg_state(jf))
then
2032 nseqn(ig_number_field(jf)) = 1
2033 nlagn(ig_number_field(jf)) = 0
2038 DO 245 ilind=ilind1, ilind2
2039 CALL
parse(clline, clvari, ilind, jpeighty, ilen)
2040 IF(ilen .eq. -1)
THEN
2041 IF (mpi_rank_global == 0)
THEN
2042 IF (nlogprt .GE. 0)
THEN
2043 IF(.NOT. lllag)
WRITE (unit=nulprt1,fmt=3043) jf
2048 READ(clvari,fmt = 2011) clind, clequa, iind
2049 IF (clind .EQ.
'SEQ')
THEN
2050 ig_total_nseqn(jf)=iind
2052 nseqn(ig_number_field(jf)) = iind
2054 ELSE IF (clind .eq.
'LAG')
THEN
2057 nlagn(ig_number_field(jf)) = iind
2059 IF (mpi_rank_global == 0)
THEN
2060 WRITE (unit = nulprt1,fmt = 3044)jf,ig_lag(jf)
2073 IF (lg_state(jf))
THEN
2074 READ (unit = nulin,fmt = 2002) clline
2075 CALL
parse(clline, clvari, 1, jpeighty, ilen)
2077 csper(ig_number_field(jf)) = clvari
2078 IF(csper(ig_number_field(jf)) .NE.
'P' .AND. &
2079 csper(ig_number_field(jf)) .NE.
'R')
THEN
2081 (
'ERROR in namcouple for source grid type of field', jf, 1)
2082 IF (mpi_rank_global == 0)
THEN
2083 WRITE (unit = nulprt1,fmt = *)
'==> must be P or R'
2084 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2085 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2091 CALL
parse(clline, clvari, 2, jpeighty, ilen)
2093 READ(clvari,fmt = 2005) nosper(ig_number_field(jf))
2094 CALL
parse(clline, clvari, 3, jpeighty, ilen)
2096 ctper(ig_number_field(jf)) = clvari
2097 IF(ctper(ig_number_field(jf)) .NE.
'P' .AND. &
2098 ctper(ig_number_field(jf)) .NE.
'R')
THEN
2100 (
'ERROR in namcouple for target grid type of field', jf, 1)
2101 IF (mpi_rank_global == 0)
THEN
2102 WRITE (unit = nulprt1,fmt = *)
'==> must be P or R'
2103 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2104 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2110 CALL
parse(clline, clvari, 4, jpeighty, ilen)
2112 READ(clvari,fmt = 2005) notper(ig_number_field(jf))
2118 IF (.NOT. lg_state(jf))
THEN
2119 IF (ig_total_state(jf) .ne. ip_input .and. &
2120 ig_total_ntrans(jf) .gt. 0 )
THEN
2121 READ (unit = nulin,fmt = 2002) clline
2122 CALL
skip(clline, jpeighty)
2123 DO ja=1,ig_total_ntrans(jf)
2124 READ (unit = nulin,fmt = 2002) clline
2125 CALL
parse(clline, clvari, 1, jpeighty, ilen)
2126 IF (clvari(1:7) .eq.
'INSTANT')
THEN
2127 ig_local_trans(jf) = ip_instant
2128 ELSEIF (clvari(1:7) .eq.
'AVERAGE')
THEN
2129 ig_local_trans(jf) = ip_average
2130 ELSEIF (clvari(1:7) .eq.
'ACCUMUL')
THEN
2131 ig_local_trans(jf) = ip_accumul
2132 ELSEIF (clvari(1:5) .eq.
'T_MIN')
THEN
2133 ig_local_trans(jf) = ip_min
2134 ELSEIF (clvari(1:5) .eq.
'T_MAX')
THEN
2135 ig_local_trans(jf) = ip_max
2138 (
'ERROR in namcouple for local transformations of field', jf, 1)
2139 IF (mpi_rank_global == 0)
THEN
2140 WRITE (unit = nulprt1,fmt = *) &
2141 '==> Must be INSTANT, AVERAGE, ACCUMUL, T_MIN or T_MAX'
2142 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2143 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2151 READ (unit = nulin,fmt = 2002) clline
2152 CALL
skip(clline, jpeighty)
2156 DO 270 ja = 1, ig_ntrans(ig_number_field(jf))
2160 READ (unit = nulin,fmt = 2002) clline
2161 CALL
skip(clline, jpeighty)
2162 IF (canal(ja,ig_number_field(jf)) .EQ.
'LOCTRANS')
THEN
2163 CALL
parse(clline, clvari, 1, jpeighty, ilen)
2164 IF (clvari(1:7) .eq.
'INSTANT')
THEN
2165 ig_local_trans(jf) = ip_instant
2166 ELSEIF (clvari(1:7) .eq.
'AVERAGE')
THEN
2167 ig_local_trans(jf) = ip_average
2168 ELSEIF (clvari(1:7) .eq.
'ACCUMUL')
THEN
2169 ig_local_trans(jf) = ip_accumul
2170 ELSEIF (clvari(1:5) .eq.
'T_MIN')
THEN
2171 ig_local_trans(jf) = ip_min
2172 ELSEIF (clvari(1:5) .eq.
'T_MAX')
THEN
2173 ig_local_trans(jf) = ip_max
2176 (
'ERROR in namcouple for local transformations of field', jf, 1)
2177 IF (mpi_rank_global == 0)
THEN
2178 WRITE (unit = nulprt1,fmt = *) &
2179 '==> Must be INSTANT, AVERAGE, ACCUMUL, T_MIN or T_MAX'
2180 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2181 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2186 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'CHECKIN')
THEN
2187 CALL
parse(clline, clvari, 1, jpeighty, ilen)
2188 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'CHECKOUT')
THEN
2189 CALL
parse(clline, clvari, 1, jpeighty, ilen)
2190 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'MAPPING')
THEN
2192 CALL
parse(clline, clvari, 1, jpeighty, ilen)
2193 cmap_file(ig_number_field(jf)) = trim(clvari)
2195 cmaptyp(ig_number_field(jf)) =
'src'
2196 cmapopt(ig_number_field(jf)) =
'bfb'
2198 CALL
parse(clline, clvari, idum, jpeighty, ilen)
2200 if (trim(clvari) ==
'src' .or. trim(clvari) ==
'dst')
then
2201 cmaptyp(ig_number_field(jf)) = trim(clvari)
2202 elseif (trim(clvari) ==
'opt' .or. trim(clvari) ==
'bfb' &
2203 .or. trim(clvari) ==
'sum')
then
2204 cmapopt(ig_number_field(jf)) = trim(clvari)
2206 call
prtout(
'ERROR in namcouple mapping argument',jf,1)
2207 IF (mpi_rank_global == 0)
THEN
2208 WRITE(nulprt1,*)
'ERROR in namcouple mapping argument ',&
2210 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2211 WRITE (nulprt1,
'(a)')
' error = STOP in inipar cmaptyp or loc'
2218 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'SCRIPR')
THEN
2220 CALL
parse(clline, clvari, 1, jpeighty, ilen)
2221 READ(clvari,fmt = 2009) cmap_method(ig_number_field(jf))
2223 CALL
parse(clline, clvari, 2, jpeighty, ilen)
2224 READ(clvari,fmt = 2009) cgrdtyp(ig_number_field(jf))
2225 IF (cmap_method(ig_number_field(jf)) .eq.
'BICUBIC' &
2226 .and. cgrdtyp(ig_number_field(jf)) .ne.
'LR' &
2227 .and. cgrdtyp(ig_number_field(jf)) .ne.
'D')
THEN
2228 IF (mpi_rank_global == 0)
THEN
2229 WRITE (unit = nulprt1,fmt = *)
' '
2232 (
'ERROR in namcouple for type of field', jf, 1)
2233 IF (mpi_rank_global == 0)
THEN
2234 WRITE (unit = nulprt1,fmt = *) &
2235 'BICUBIC interpolation cannot be used if grid is not LR or D'
2236 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2237 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2242 IF (cmap_method(ig_number_field(jf)) .eq.
'BILINEAR' &
2243 .and. cgrdtyp(ig_number_field(jf)) .ne.
'LR' &
2244 .and. cgrdtyp(ig_number_field(jf)) .ne.
'D')
THEN
2245 IF (mpi_rank_global == 0)
THEN
2246 WRITE (unit = nulprt1,fmt = *)
' '
2249 (
'ERROR in namcouple for type of field', jf, 1)
2250 IF (mpi_rank_global == 0)
THEN
2251 WRITE (unit = nulprt1,fmt = *) &
2252 'BILINEAR interpolation cannot be used if grid is not LR or D'
2253 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2254 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2260 CALL
parse(clline, clvari, 3, jpeighty, ilen)
2261 READ(clvari,fmt = 2009) cfldtype(ig_number_field(jf))
2262 IF(cfldtype(ig_number_field(jf)) .EQ.
'VECTOR') &
2263 cfldtype(ig_number_field(jf))=
'SCALAR'
2264 IF(cfldtype(ig_number_field(jf)) .NE.
'SCALAR')
THEN
2265 IF (mpi_rank_global == 0)
THEN
2266 WRITE (unit = nulprt1,fmt = *)
' '
2269 (
'ERROR in namcouple for type of field', jf, 1)
2270 IF (mpi_rank_global == 0)
THEN
2271 WRITE (unit = nulprt1,fmt = *) &
2272 '==> must be SCALAR, VECTOR'
2273 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2274 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2280 CALL
parse(clline, clvari, 4, jpeighty, ilen)
2281 READ(clvari,fmt = 2009) crsttype(ig_number_field(jf))
2282 IF (cgrdtyp(ig_number_field(jf)) .EQ.
'D')
THEN
2283 IF (cmap_method(ig_number_field(jf)) .EQ.
'BILINEAR' .or. &
2284 cmap_method(ig_number_field(jf)) .EQ.
'BICUBIC')
THEN
2285 IF (crsttype(ig_number_field(jf)) .NE.
'LATITUDE')
THEN
2286 IF (mpi_rank_global == 0)
THEN
2287 WRITE (unit = nulprt1,fmt = *)
' '
2289 CALL
prtout(
'ERROR in namcouple for restriction of field',jf,1)
2290 IF (mpi_rank_global == 0)
THEN
2291 WRITE (unit = nulprt1,fmt = *) &
2292 '==> LATITUDE must be chosen for reduced grids (D)'
2293 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2294 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2299 crsttype(ig_number_field(jf)) =
'REDUCED'
2304 IF(crsttype(ig_number_field(jf)) .NE.
'LATITUDE' .AND. &
2305 crsttype(ig_number_field(jf)) .NE.
'LATLON' .AND. &
2306 crsttype(ig_number_field(jf)) .NE.
'REDUCED')
THEN
2307 IF (mpi_rank_global == 0)
THEN
2308 WRITE (unit = nulprt1,fmt = *)
' '
2310 CALL
prtout(
'ERROR in namcouple for restriction of field',jf,1)
2311 IF (mpi_rank_global == 0)
THEN
2312 WRITE (unit = nulprt1,fmt = *)
'==> must be LATITUDE or LATLON'
2313 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2314 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2321 CALL
parse(clline, clvari, 5, jpeighty, ilen)
2322 READ(clvari,fmt = 2003) nbins(ig_number_field(jf))
2324 IF (cmap_method(ig_number_field(jf)) .EQ.
'CONSERV')
THEN
2325 CALL
parse(clline, clvari, 6, jpeighty, ilen)
2326 READ(clvari,fmt = 2009)cnorm_opt(ig_number_field(jf))
2327 IF (cnorm_opt(ig_number_field(jf)) .NE.
'FRACAREA' .AND. &
2328 cnorm_opt(ig_number_field(jf)) .NE.
'DESTAREA' .AND. &
2329 cnorm_opt(ig_number_field(jf)) .NE.
'FRACNNEI')
THEN
2330 IF (mpi_rank_global == 0)
THEN
2331 WRITE (unit = nulprt1,fmt = *)
' '
2334 (
'ERROR in namcouple for normalize option of field',jf,1)
2335 IF (mpi_rank_global == 0)
THEN
2336 WRITE (unit = nulprt1, fmt = *) &
2337 '==> must be FRACAREA, DESTAREA, or FRACNNEI'
2338 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2339 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2345 CALL
parse(clline, clvari, 7, jpeighty, ilen)
2346 IF (ilen .LE. 0)
THEN
2347 IF (mpi_rank_global == 0)
THEN
2348 WRITE (unit = nulprt1,fmt = *)
' '
2350 CALL
prtout(
'ERROR in namcouple for CONSERV for field',jf,1)
2351 IF (mpi_rank_global == 0)
THEN
2352 WRITE (unit = nulprt1,fmt = *) &
2353 '==> FIRST must be indicated at end of line'
2354 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2355 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2360 READ(clvari,fmt = 2009) corder(ig_number_field(jf))
2362 cnorm_opt(ig_number_field(jf))=
'NONORM'
2365 IF (cmap_method(ig_number_field(jf)) .EQ.
'DISTWGT' .or. &
2366 cmap_method(ig_number_field(jf)) .EQ.
'GAUSWGT')
THEN
2367 CALL
parse(clline, clvari, 6, jpeighty, ilen)
2368 IF (ilen .LE. 0)
THEN
2369 IF (mpi_rank_global == 0)
THEN
2370 WRITE (unit = nulprt1,fmt = *)
' '
2372 CALL
prtout(
'ERROR in namcouple for field',jf,1)
2373 IF (mpi_rank_global == 0)
THEN
2374 WRITE (unit = nulprt1,fmt = *) &
2375 '==> Number of neighbours must be indicated on the line'
2376 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2377 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2382 READ(clvari,fmt=2003)nscripvoi(ig_number_field(jf))
2386 IF (cmap_method(ig_number_field(jf)) .EQ.
'GAUSWGT')
THEN
2387 CALL
parse(clline, clvari, 7, jpeighty, ilen)
2388 IF (ilen .LE. 0)
THEN
2389 IF (mpi_rank_global == 0)
THEN
2390 WRITE (unit = nulprt1,fmt = *)
' '
2392 CALL
prtout(
'ERROR in namcouple for GAUSWGT for field',jf,1)
2393 IF (mpi_rank_global == 0)
THEN
2394 WRITE (unit = nulprt1,fmt = *) &
2395 '==> Variance must be indicated at end of line'
2396 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2397 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2402 READ(clvari,fmt=2006) varmul(ig_number_field(jf))
2406 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'FILLING') &
2408 CALL
parse(clline, clvari, 1, jpeighty, ilen)
2410 cfilfic(ig_number_field(jf)) = clvari
2411 CALL
parse(clline, clvari, 2, jpeighty, ilen)
2413 READ(clvari,fmt = 2005) nlufil(ig_number_field(jf))
2414 CALL
parse(clline, clvari, 3, jpeighty, ilen)
2416 cfilmet(ig_number_field(jf)) = clvari
2418 IF(cfilmet(ig_number_field(jf))(4:6) .EQ.
'SST')
THEN
2419 CALL
parse(clline, clvari, 4, jpeighty, ilen)
2421 READ(clvari,fmt = 2005) nfcoast
2422 IF (cfilmet(ig_number_field(jf))(1:3) .EQ.
'SMO') &
2424 CALL
parse(clline, clvari, 5, jpeighty, ilen)
2427 CALL
parse(clline, clvari, 6, jpeighty, ilen)
2429 READ(clvari,fmt = 2005) nlucor
2432 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'CONSERV') &
2434 CALL
parse(clline, clvari, 1, jpeighty, ilen)
2436 cconmet(ig_number_field(jf)) = clvari
2437 lsurf(ig_number_field(jf)) = .true.
2438 CALL
parse(clline, clvari, 2, jpeighty, ilen)
2439 cconopt(ig_number_field(jf)) =
'bfb'
2441 if (trim(clvari) ==
'bfb' .or. trim(clvari) ==
'opt')
then
2442 cconopt(ig_number_field(jf)) = clvari
2444 call
prtout(
'ERROR in namcouple conserv argument',jf,1)
2445 IF (mpi_rank_global == 0)
THEN
2446 WRITE(nulprt1,*)
'ERROR in namcouple conserv argument ',&
2448 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2449 WRITE (nulprt1,
'(a)')
' error = STOP in inipar cconopt'
2455 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'BLASOLD')
THEN
2457 CALL
parse(clline, clvari, 1, jpeighty, ilen)
2459 READ(clvari,fmt = 2006) afldcobo(ig_number_field(jf))
2460 DO 290 jc = 1, nbofld(ig_number_field(jf))
2461 READ (unit = nulin,fmt = 2002) clline
2462 CALL
parse(clline, clvari, 1, jpeighty, ilen)
2464 cbofld(jc,ig_number_field(jf)) = clvari
2465 CALL
parse(clline, clvari, 2, jpeighty, ilen)
2467 READ(clvari,fmt = 2006) &
2468 abocoef(jc,ig_number_field(jf))
2470 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'BLASNEW')
THEN
2472 CALL
parse(clline, clvari, 1, jpeighty, ilen)
2474 READ(clvari,fmt = 2006) afldcobn(ig_number_field(jf))
2475 DO 291 jc = 1, nbnfld(ig_number_field(jf))
2476 READ (unit = nulin,fmt = 2002) clline
2477 CALL
parse(clline, clvari, 1, jpeighty, ilen)
2479 cbnfld(jc,ig_number_field(jf)) = clvari
2480 CALL
parse(clline, clvari, 2, jpeighty, ilen)
2482 READ(clvari,fmt = 2006) &
2483 abncoef(jc,ig_number_field(jf))
2486 IF (mpi_rank_global == 0)
THEN
2487 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
2488 WRITE (unit = nulprt1,fmt = *) &
2489 ' Type of analysis not implemented yet '
2490 WRITE (unit = nulprt1,fmt = *) &
2491 ' The analysis required in OASIS is :'
2492 WRITE (unit = nulprt1,fmt = *)
' canal = ', &
2493 canal(ja,ig_number_field(jf))
2494 WRITE (unit = nulprt1,fmt = *) &
2495 ' with ja = ', ja,
' jf = ', jf
2496 WRITE (unit = nulprt1,fmt = *)
' '
2497 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2498 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2512 ig_total_frqmin = minval(ig_freq)
2524 2010
FORMAT(a3,a1,i2)
2525 2011
FORMAT(a3,a1,i8)
2529 IF (mpi_rank_global == 0)
THEN
2531 IF (nlogprt .GE. 0)
THEN
2532 DO 310 jf = 1, ig_final_nfield
2533 IF (ig_total_state(jf) .eq. ip_exported )
THEN
2534 cl_print_state =
'EXPORTED'
2535 ELSEIF (ig_total_state(jf) .eq. ip_ignored )
THEN
2536 cl_print_state =
'IGNORED'
2537 ELSEIF (ig_total_state(jf) .eq. ip_ignout )
THEN
2538 cl_print_state =
'IGNOUT'
2539 ELSEIF (ig_total_state(jf) .eq. ip_expout )
THEN
2540 cl_print_state =
'EXPOUT'
2541 ELSEIF (ig_total_state(jf) .eq. ip_input )
THEN
2542 cl_print_state =
'INPUT'
2543 ELSEIF (ig_total_state(jf) .eq. ip_output )
THEN
2544 cl_print_state =
'OUTPUT'
2545 ELSEIF (ig_total_state(jf) .eq. ip_auxilary )
THEN
2546 cl_print_state =
'AUXILARY'
2548 IF (ig_local_trans(jf) .eq. ip_instant)
THEN
2549 cl_print_trans =
'INSTANT'
2550 ELSEIF (ig_local_trans(jf) .eq. ip_average)
THEN
2551 cl_print_trans =
'AVERAGE'
2552 ELSEIF (ig_local_trans(jf) .eq. ip_accumul)
THEN
2553 cl_print_trans =
'ACCUMUL'
2554 ELSEIF (ig_local_trans(jf) .eq. ip_min)
THEN
2555 cl_print_trans =
'T_MIN'
2556 ELSEIF (ig_local_trans(jf) .eq. ip_max)
THEN
2557 cl_print_trans =
'T_MAX'
2560 IF (.NOT. lg_state(jf))
THEN
2561 ilab = ig_numlab(jf)
2562 WRITE (unit = nulprt1,fmt = 3001) jf
2563 WRITE (unit = nulprt1,fmt = 3002)
2564 WRITE (unit = nulprt1,fmt = 3003)
2565 WRITE (unit = nulprt1,fmt = 3004)
2566 IF (ig_total_state(jf) .eq. ip_input .or. &
2567 ig_total_state(jf) .eq. ip_output)
THEN
2568 WRITE (unit = nulprt1,fmt = 3121) &
2569 cg_input_field(jf), cg_output_field(jf), &
2570 ig_freq(jf), cl_print_trans, &
2571 cl_print_state, ig_total_ntrans(jf)
2573 WRITE (unit = nulprt1,fmt = 3116) &
2574 cg_input_field(jf), cg_output_field(jf), &
2575 ig_freq(jf), cl_print_trans, ig_total_nseqn(jf), &
2576 ig_lag(jf), cl_print_state, ig_total_ntrans(jf)
2579 ilab = numlab(ig_number_field(jf))
2580 ifcb = len_trim(cficbf(ig_number_field(jf)))
2581 ifca = len_trim(cficaf(ig_number_field(jf)))
2582 WRITE (unit = nulprt1,fmt = 3001) jf
2583 WRITE (unit = nulprt1,fmt = 3002)
2584 WRITE (unit = nulprt1,fmt = 3003)
2585 WRITE (unit = nulprt1,fmt = 3004)
2586 WRITE (unit = nulprt1,fmt = 3005) &
2587 trim(cnaminp(ig_number_field(jf))), &
2588 trim(cnamout(ig_number_field(jf))), &
2589 nfexch(ig_number_field(jf)), &
2590 nseqn(ig_number_field(jf)), &
2593 ig_ntrans(ig_number_field(jf))
2597 IF (.not. lg_state(jf))
THEN
2598 IF (ig_total_state(jf) .eq. ip_ignored .or. &
2599 ig_total_state(jf) .eq. ip_ignout )
THEN
2600 WRITE (unit = nulprt1,fmt = 3117) cg_restart_file(jf)
2601 ELSEIF (ig_total_state(jf) .eq. ip_input)
THEN
2602 WRITE (unit = nulprt1,fmt = 3118) cg_input_file(jf)
2605 IF (ig_total_state(jf) .eq. ip_exported .or. &
2606 ig_total_state(jf) .eq. ip_expout .or. &
2607 ig_total_state(jf) .eq. ip_auxilary ) &
2608 WRITE (unit = nulprt1,fmt = 3117) cg_restart_file(jf)
2610 WRITE (unit = nulprt1,fmt = 3007) &
2611 csper(ig_number_field(jf)), nosper(ig_number_field(jf)), &
2612 ctper(ig_number_field(jf)), notper(ig_number_field(jf))
2613 WRITE (unit = nulprt1,fmt = 3008) &
2614 cficbf(ig_number_field(jf))(1:ifcb)//cglonsuf, &
2615 cficbf(ig_number_field(jf))(1:ifcb)//cglatsuf, &
2616 cficbf(ig_number_field(jf))(1:ifcb)//cmsksuf, &
2617 cficbf(ig_number_field(jf))(1:ifcb)//csursuf, &
2618 cficaf(ig_number_field(jf))(1:ifca)//cglonsuf, &
2619 cficaf(ig_number_field(jf))(1:ifca)//cglatsuf, &
2620 cficaf(ig_number_field(jf))(1:ifca)//cmsksuf, &
2621 cficaf(ig_number_field(jf))(1:ifca)//csursuf
2622 WRITE (unit = nulprt1,fmt = 3009)
2623 WRITE (unit = nulprt1,fmt = 3010)
2624 DO 320 ja = 1, ig_ntrans(ig_number_field(jf))
2625 WRITE (unit = nulprt1,fmt = 3011) ja, &
2626 canal(ja,ig_number_field(jf))
2627 IF (canal(ja,ig_number_field(jf)) .EQ.
'MAPPING')
THEN
2628 write(unit = nulprt1,fmt = 3048) &
2629 trim(cmap_file(ig_number_field(jf))), &
2630 trim(cmaptyp(ig_number_field(jf))), &
2631 trim(cmapopt(ig_number_field(jf)))
2632 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'SCRIPR')
THEN
2633 WRITE(unit = nulprt1,fmt = 3045) &
2634 cmap_method(ig_number_field(jf)), &
2635 cfldtype(ig_number_field(jf)), &
2636 cnorm_opt(ig_number_field(jf)), &
2637 crsttype(ig_number_field(jf)), &
2638 nbins(ig_number_field(jf))
2639 IF (cmap_method(ig_number_field(jf)) .EQ.
'CONSERV')
THEN
2640 WRITE(unit = nulprt1,fmt = 3046) &
2641 corder(ig_number_field(jf))
2643 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'CONSERV')
THEN
2644 WRITE(unit = nulprt1,fmt = 3025) &
2645 cconmet(ig_number_field(jf)), &
2646 cconopt(ig_number_field(jf))
2647 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'BLASOLD')
THEN
2648 WRITE(unit = nulprt1,fmt = 3027) &
2649 trim(cnaminp(ig_number_field(jf))), &
2650 afldcobo(ig_number_field(jf))
2651 WRITE(unit = nulprt1,fmt=3028) nbofld(ig_number_field(jf))
2652 DO 340 jc = 1, nbofld(ig_number_field(jf))
2653 WRITE (unit = nulprt1,fmt = 3030) &
2654 cbofld(jc,ig_number_field(jf)), &
2655 abocoef(jc,ig_number_field(jf))
2657 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'BLASNEW')
THEN
2658 WRITE(unit = nulprt1,fmt = 3027) &
2659 trim(cnamout(ig_number_field(jf))), &
2660 afldcobn(ig_number_field(jf))
2661 WRITE(unit = nulprt1,fmt=3028) nbnfld(ig_number_field(jf))
2662 DO 350 jc = 1, nbnfld(ig_number_field(jf))
2663 WRITE (unit = nulprt1,fmt = 3030) &
2664 cbnfld(jc,ig_number_field(jf)), &
2665 abncoef(jc,ig_number_field(jf))
2667 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'CHECKIN')
THEN
2668 WRITE(unit = nulprt1,fmt = *)
' '
2669 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'CHECKOUT')
THEN
2670 WRITE(unit = nulprt1,fmt = *)
' '
2671 ELSE IF (canal(ja,ig_number_field(jf)) .EQ.
'LOCTRANS')
THEN
2672 WRITE(unit = nulprt1,fmt = 3047) cl_print_trans
2674 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
2675 WRITE (unit = nulprt1,fmt = *) &
2676 ' Type of analysis not implemented yet '
2677 WRITE (unit = nulprt1,fmt = *) &
2678 ' The analysis required in OASIS is :'
2679 WRITE (unit = nulprt1,fmt = *)
' canal = ', &
2680 canal(ja,ig_number_field(jf))
2681 WRITE (unit = nulprt1,fmt = *) &
2682 ' with ja = ', ja,
' jf = ', jf
2683 WRITE (unit = nulprt1,fmt = *)
' '
2684 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2685 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2697 3001
FORMAT(//,15x,
' FIELD NUMBER ',i3)
2698 3002
FORMAT(15x,
' ************ ')
2699 3003
FORMAT(/,10x,
' Field parameters ')
2700 3004
FORMAT(10x,
' **************** ',/)
2701 3005
FORMAT(/,10x,
' Input field symbolic name = ',a, &
2702 /,10x,
' Output field symbolic name = ',a, &
2703 /,10x,
' Field exchange frequency = ',i8, &
2704 /,10x,
' Model sequential index = ',i2, &
2705 /,10x,
' Field Lag = ',i8, &
2706 /,10x,
' Field I/O status = ',a8, &
2707 /,10x,
' Number of basic operations = ',i4, /)
2708 3116
FORMAT(/,10x,
' Input field symbolic name = ',a8, &
2709 /,10x,
' Output field symbolic name = ',a8, &
2710 /,10x,
' Field exchange frequency = ',i8, &
2711 /,10x,
' Local transformation = ',a8, &
2712 /,10x,
' Model sequential index = ',i2, &
2713 /,10x,
' Field Lag = ',i8, &
2714 /,10x,
' Field I/O status = ',a8, &
2715 /,10x,
' Number of basic operations = ',i4,/)
2716 3117
FORMAT(/,10x,
' Restart file name = ',a32,/)
2717 3118
FORMAT(/,10x,
' Input file name = ',a32,/)
2718 3121
FORMAT(/,10x,
' Input field symbolic name = ',a8, &
2719 /,10x,
' Output field symbolic name = ',a8, &
2720 /,10x,
' Field exchange frequency = ',i8, &
2721 /,10x,
' Local transformation = ',a8, &
2722 /,10x,
' Field I/O status = ',a8, &
2723 /,10x,
' Number of basic operations = ',i4,/)
2725 /,10x,
' Source grid periodicity type is = ',a8, &
2726 /,10x,
' Number of overlapped grid points is = ',i2, &
2727 /,10x,
' Target grid periodicity type is = ',a8, &
2728 /,10x,
' Number of overlapped grid points is = ',i2,/)
2729 3008
FORMAT(/,10x,
' Source longitude file string = ',a8, &
2730 /,10x,
' Source latitude file string = ',a8, &
2731 /,10x,
' Source mask file string = ',a8, &
2732 /,10x,
' Source surface file string = ',a8, &
2733 /,10x,
' Target longitude file string = ',a8, &
2734 /,10x,
' Target latitude file string = ',a8, &
2735 /,10x,
' Target mask file string = ',a8, &
2736 /,10x,
' Target surface file string = ',a8,/)
2737 3009
FORMAT(/,10x,
' ANALYSIS PARAMETERS ')
2738 3010
FORMAT(10x,
' ******************* ',/)
2739 3011
FORMAT(/,5x,
' ANALYSIS number ',i2,
' is ',a8, &
2740 /,5x,
' *************** ',/)
2741 3025
FORMAT(5x,
' Conservation method for field is = ',a8, &
2742 /,5x,
' Conservation option is = ',a8)
2743 3027
FORMAT(5x,
' Field ',a,
' is multiplied by Cst = ',e15.6)
2744 3028
FORMAT(5x,
' It is combined with N fields N = ',i2)
2745 3030
FORMAT(5x,
' With field ',a8,
' coefficient = ',e15.6)
2746 3043
FORMAT(/,5x,
'No lag in namcouple for the field', i3, &
2747 /,5x,
' Default value LAG=0 will be used ')
2748 3044
FORMAT(/,5x,
'The lag for the field ',i3,3x,
'is : ',i8)
2749 3045
FORMAT(5x,
' Remapping method is = ',a8, &
2750 /,5x,
' Field type is = ',a8, &
2751 /,5x,
' Normalization option is = ',a8, &
2752 /,5x,
' Seach restriction type is = ',a8, &
2753 /,5x,
' Number of search bins is = ',i4)
2754 3046
FORMAT(5x,
' Order of remapping is = ',a8)
2755 3047
FORMAT(5x,
' Local transformation = ',a8)
2756 3048
FORMAT(5x,
' Remapping filename is = ',a, &
2757 /,5x,
' Mapping location is = ',a8, &
2758 /,5x,
' Mapping optimization is = ',a8)
2764 IF (mpi_rank_global == 0)
THEN
2765 IF (nlogprt .GE. 0)
THEN
2766 WRITE(unit = nulprt1,fmt = *)
' '
2767 WRITE(unit = nulprt1,fmt = *)
'------ End of ROUTINE inipar ----'
2777 IF (mpi_rank_global == 0)
THEN
2778 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
2779 WRITE (unit = nulprt1,fmt = *) &
2780 ' No active $NBMODEL data found in input file namcouple'
2781 WRITE (unit = nulprt1,fmt = *)
' '
2782 WRITE (unit = nulprt1,fmt = *)
' '
2783 WRITE (unit = nulprt1,fmt = *) &
2784 ' We STOP!!! Check the file namcouple'
2785 WRITE (unit = nulprt1,fmt = *)
' '
2786 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2787 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2793 IF (mpi_rank_global == 0)
THEN
2794 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
2795 WRITE (unit = nulprt1,fmt = *) &
2796 ' Problem with $RUNTIME in input file namcouple'
2797 WRITE (unit = nulprt1,fmt = *)
' '
2798 WRITE (unit = nulprt1,fmt = *)
' '
2799 WRITE (unit = nulprt1,fmt = *) &
2800 ' We STOP!!! Check the file namcouple'
2801 WRITE (unit = nulprt1,fmt = *)
' '
2802 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2803 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2808 IF (mpi_rank_global == 0)
THEN
2809 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
2810 WRITE (unit = nulprt1,fmt = *) &
2811 ' No active $NLOGPRT found in input file namcouple'
2812 WRITE (unit = nulprt1,fmt = *)
' '
2813 WRITE (unit = nulprt1,fmt = *)
' '
2814 WRITE (unit = nulprt1,fmt = *) &
2815 ' We STOP!!! Check the file namcouple'
2816 WRITE (unit = nulprt1,fmt = *)
' '
2817 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2818 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2823 IF (mpi_rank_global == 0)
THEN
2824 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
2825 WRITE (unit = nulprt1,fmt = *) &
2826 ' No active $FIELDS data found in input file namcouple'
2827 WRITE (unit = nulprt1,fmt = *)
' '
2828 WRITE (unit = nulprt1,fmt = *)
' '
2829 WRITE (unit = nulprt1,fmt = *) &
2830 ' We STOP!!! Check the file namcouple'
2831 WRITE (unit = nulprt1,fmt = *)
' '
2832 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2833 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2838 IF (mpi_rank_global == 0)
THEN
2839 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
2840 WRITE (unit = nulprt1,fmt = *) &
2841 ' No active $STRING data found in input file namcouple'
2842 WRITE (unit = nulprt1,fmt = *)
' '
2843 WRITE (unit = nulprt1,fmt = *)
' '
2844 WRITE (unit = nulprt1,fmt = *) &
2845 ' We STOP!!! Check the file namcouple'
2846 WRITE (unit = nulprt1,fmt = *)
' '
2847 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2848 WRITE (nulprt1,
'(a)')
' error = STOP in inipar'
2853 IF (mpi_rank_global == 0)
THEN
2854 WRITE (unit = nulprt1,fmt = *)
' '
2856 CALL
prtout(
'ERROR in namcouple for field', jf, 1)
2857 IF (mpi_rank_global == 0)
THEN
2858 WRITE (unit = nulprt1,fmt = *) &
2859 'Check the 2nd line for either the index of sequential position, &
2860 & the delay flag, or the extra timestep flag.'
2861 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2862 WRITE (nulprt1,
'(a)')
' error = STOP in inipar.f'
2867 IF (mpi_rank_global == 0)
THEN
2868 WRITE (unit = nulprt1,fmt = *)
' '
2870 CALL
prtout(
'ERROR in namcouple for field', jf, 1)
2871 IF (mpi_rank_global == 0)
THEN
2872 WRITE (unit = nulprt1,fmt = *) &
2873 'An input line with integral calculation flag'
2874 WRITE (unit = nulprt1,fmt = *) &
2875 '("INT=0" or "INT=1")'
2876 WRITE (unit = nulprt1,fmt = *) &
2877 'is now required for analysis CHECKIN or CHECKOUT'
2878 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2879 WRITE (nulprt1,
'(a)')
' error = STOP in inipar.f'
2884 IF (mpi_rank_global == 0)
THEN
2885 WRITE (unit = nulprt1,fmt = *)
' '
2887 CALL
prtout(
'ERROR in namcouple for field', jf, 1)
2888 IF (mpi_rank_global == 0)
THEN
2889 WRITE (unit = nulprt1,fmt = *) &
2890 'The coupling period must not be 0 !'
2891 WRITE (unit = nulprt1,fmt = *) &
2892 'If you do not want to exchange this field at all'
2893 WRITE (unit = nulprt1,fmt = *) &
2894 'give a coupling period longer than the total run time.'
2895 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
2896 WRITE (nulprt1,
'(a)')
' error = STOP in inipar.f'
2908 character(len=*),
parameter :: subname=
'(mod_oasis_namcouple:alloc)'
2913 ALLOCATE (varmul(ig_nfield), stat=il_err)
2914 IF (il_err.NE.0) CALL
prtout(
'Error in "varmul"allocation of anais module',il_err,1)
2916 ALLOCATE (niwtm(ig_nfield), stat=il_err)
2917 IF (il_err.NE.0) CALL
prtout(
'Error in "niwtm"allocation of anais module',il_err,1)
2919 ALLOCATE (niwtg(ig_nfield), stat=il_err)
2920 IF (il_err.NE.0) CALL
prtout(
'Error in "niwtg"allocation of anais module',il_err,1)
2922 allocate (linit(ig_nfield), stat=il_err)
2923 if (il_err.ne.0) call
prtout(
'error in "linit"allocation of anais module',il_err,1)
2927 ALLOCATE (ncofld(ig_nfield), stat=il_err)
2928 IF (il_err.NE.0) CALL
prtout(
'Error in "ncofld"allocation of analysis module',il_err,1)
2930 ALLOCATE (neighborg(ig_nfield), stat=il_err)
2931 IF (il_err.NE.0) CALL
prtout(
'Error in "neighborg"allocation of analysis module',il_err,1)
2933 ALLOCATE (nludat(ig_maxcomb,ig_nfield), stat=il_err)
2934 IF (il_err.NE.0) CALL
prtout(
'Error in "nludat"allocation of analysis module',il_err,1)
2936 ALLOCATE (nlufil(ig_nfield), stat=il_err)
2937 IF (il_err.NE.0) CALL
prtout(
'Error in "nlufil"allocation of analysis module',il_err,1)
2939 ALLOCATE (nlumap(ig_nfield), stat=il_err)
2940 IF (il_err.NE.0) CALL
prtout(
'Error in "nlumap"allocation of analysis module',il_err,1)
2942 ALLOCATE (nlusub(ig_nfield), stat=il_err)
2943 IF (il_err.NE.0) CALL
prtout(
'Error in "nlusub"allocation of analysis module',il_err,1)
2945 ALLOCATE (nluext(ig_nfield), stat=il_err)
2946 IF (il_err.NE.0) CALL
prtout(
'Error in "nluext"allocation of analysis module',il_err,1)
2948 ALLOCATE (nosper(ig_nfield), stat=il_err)
2949 IF (il_err.NE.0) CALL
prtout(
'Error in "nosper"allocation of analysis module',il_err,1)
2951 ALLOCATE (notper(ig_nfield), stat=il_err)
2952 IF (il_err.NE.0) CALL
prtout(
'Error in "notper"allocation of analysis module',il_err,1)
2954 ALLOCATE (amskval(ig_nfield), stat=il_err)
2955 IF (il_err.NE.0) CALL
prtout(
'Error in "amskval"allocation of analysis module',il_err,1)
2957 ALLOCATE (amskvalnew(ig_nfield), stat=il_err)
2958 IF (il_err.NE.0) CALL
prtout(
'Error in "amskvalnew"allocation of analysis module',il_err,1)
2960 ALLOCATE (acocoef(ig_maxcomb,ig_nfield), stat=il_err)
2961 IF (il_err.NE.0) CALL
prtout(
'Error in "acocoef"allocation of analysis module',il_err,1)
2963 ALLOCATE (abocoef(ig_maxcomb,ig_nfield), stat=il_err)
2964 IF (il_err.NE.0) CALL
prtout(
'Error in "abocoef"allocation of analysis module',il_err,1)
2966 ALLOCATE (abncoef(ig_maxcomb,ig_nfield), stat=il_err)
2967 IF (il_err.NE.0) CALL
prtout(
'Error in "abncoef"allocation of analysis module',il_err,1)
2969 ALLOCATE (afldcoef(ig_nfield), stat=il_err)
2970 IF (il_err.NE.0) CALL
prtout(
'Error in "afldcoef"allocation of analysis module',il_err,1)
2972 ALLOCATE (afldcobo(ig_nfield), stat=il_err)
2973 IF (il_err.NE.0) CALL
prtout(
'Error in "afldcobo"allocation of analysis module',il_err,1)
2975 ALLOCATE (afldcobn(ig_nfield), stat=il_err)
2976 IF (il_err.NE.0) CALL
prtout(
'Error in "afldcobn"allocation of analysis module',il_err,1)
2978 ALLOCATE (cxordbf(ig_nfield), stat=il_err)
2979 IF (il_err.NE.0) CALL
prtout(
'Error in "cxordbf"allocation of analysis module',il_err,1)
2981 ALLOCATE (cyordbf(ig_nfield), stat=il_err)
2982 IF (il_err.NE.0) CALL
prtout(
'Error in "cyordbf"allocation of analysis module',il_err,1)
2984 ALLOCATE (cxordaf(ig_nfield), stat=il_err)
2985 IF (il_err.NE.0) CALL
prtout(
'Error in "cxordaf"allocation of analysis module',il_err,1)
2987 ALLOCATE (cyordaf(ig_nfield), stat=il_err)
2988 IF (il_err.NE.0) CALL
prtout(
'Error in "cyordaf"allocation of analysis module',il_err,1)
2990 ALLOCATE (cgrdtyp(ig_nfield), stat=il_err)
2991 IF (il_err.NE.0) CALL
prtout(
'Error in "cgrdtyp"allocation of analysis module',il_err,1)
2993 ALLOCATE (cfldtyp(ig_nfield), stat=il_err)
2994 IF (il_err.NE.0) CALL
prtout(
'Error in "cfldtyp"allocation of analysis module',il_err,1)
2996 ALLOCATE (cfilfic(ig_nfield), stat=il_err)
2997 IF (il_err.NE.0) CALL
prtout(
'Error in "cfilfic"allocation of analysis module',il_err,1)
2999 ALLOCATE (cfilmet(ig_nfield), stat=il_err)
3000 IF (il_err.NE.0) CALL
prtout(
'Error in "cfilmet"allocation of analysis module',il_err,1)
3002 ALLOCATE (cconmet(ig_nfield), stat=il_err)
3003 IF (il_err.NE.0) CALL
prtout(
'Error in "cconmet"allocation of analysis module',il_err,1)
3005 ALLOCATE (cconopt(ig_nfield), stat=il_err)
3006 IF (il_err.NE.0) CALL
prtout(
'Error in "cconopt"allocation of analysis module',il_err,1)
3008 ALLOCATE (cfldcoa(ig_nfield), stat=il_err)
3009 IF (il_err.NE.0) CALL
prtout(
'Error in "cfldcoa"allocation of analysis module',il_err,1)
3011 ALLOCATE (cfldfin(ig_nfield), stat=il_err)
3012 IF (il_err.NE.0) CALL
prtout(
'Error in "cfldfin"allocation of analysis module',il_err,1)
3014 ALLOCATE (ccofld(ig_maxcomb,ig_nfield), stat=il_err)
3015 IF (il_err.NE.0) CALL
prtout(
'Error in "ccofld"allocation of analysis module',il_err,1)
3017 ALLOCATE (cbofld(ig_maxcomb,ig_nfield), stat=il_err)
3018 IF (il_err.NE.0) CALL
prtout(
'Error in "cbofld"allocation of analysis module',il_err,1)
3020 ALLOCATE (cbnfld(ig_maxcomb,ig_nfield), stat=il_err)
3021 IF (il_err.NE.0) CALL
prtout(
'Error in "cbnfld"allocation of analysis module',il_err,1)
3023 ALLOCATE (ccofic(ig_maxcomb,ig_nfield), stat=il_err)
3024 IF (il_err.NE.0) CALL
prtout(
'Error in "ccofic"allocation of analysis module',il_err,1)
3026 ALLOCATE (cdqdt(ig_nfield), stat=il_err)
3027 IF (il_err.NE.0) CALL
prtout(
'Error in "cdqdt"allocation of analysis module',il_err,1)
3029 ALLOCATE (cgrdmap(ig_nfield), stat=il_err)
3030 IF (il_err.NE.0) CALL
prtout(
'Error in "cgrdmap"allocation of analysis module',il_err,1)
3032 ALLOCATE (cmskrd(ig_nfield), stat=il_err)
3033 IF (il_err.NE.0) CALL
prtout(
'Error in "cmskrd"allocation of analysis module',il_err,1)
3035 ALLOCATE (cgrdsub(ig_nfield), stat=il_err)
3036 IF (il_err.NE.0) CALL
prtout(
'Error in "cgrdsub"allocation of analysis module',il_err,1)
3038 ALLOCATE (ctypsub(ig_nfield), stat=il_err)
3039 IF (il_err.NE.0) CALL
prtout(
'Error in "ctypsub"allocation of analysis module',il_err,1)
3041 ALLOCATE (cgrdext(ig_nfield), stat=il_err)
3042 IF (il_err.NE.0) CALL
prtout(
'Error in "cgrdext"allocation of analysis module',il_err,1)
3044 ALLOCATE (csper(ig_nfield), stat=il_err)
3045 IF (il_err.NE.0) CALL
prtout(
'Error in "csper"allocation of analysis module',il_err,1)
3047 ALLOCATE (ctper(ig_nfield), stat=il_err)
3048 IF (il_err.NE.0) CALL
prtout(
'Error in "ctper"allocation of analysis module',il_err,1)
3050 ALLOCATE (lsurf(ig_nfield), stat=il_err)
3051 IF (il_err.NE.0) CALL
prtout(
'Error in "lsurf"allocation of analysis module',il_err,1)
3053 ALLOCATE (nscripvoi(ig_nfield), stat=il_err)
3054 IF (il_err.NE.0) CALL
prtout(
'Error in nscripvoi allocation of analysis module',il_err,1)
3059 ALLOCATE (cmap_method(ig_nfield),stat=il_err)
3060 IF (il_err.NE.0) CALL
prtout(
'Error in "cmap_method" allocation of inipar_alloc',il_err,1)
3062 ALLOCATE (cmap_file(ig_nfield),stat=il_err)
3063 IF (il_err.NE.0) CALL
prtout(
'Error in "cmap_file" allocation of inipar_alloc',il_err,1)
3065 ALLOCATE (cmaptyp(ig_nfield),stat=il_err)
3066 IF (il_err.NE.0) CALL
prtout(
'Error in "cmaptyp" allocation of inipar_alloc',il_err,1)
3068 ALLOCATE (cmapopt(ig_nfield),stat=il_err)
3069 IF (il_err.NE.0) CALL
prtout(
'Error in "cmapopt" allocation of inipar_alloc',il_err,1)
3071 ALLOCATE (cfldtype(ig_nfield),stat=il_err)
3072 IF (il_err.NE.0) CALL
prtout(
'Error in "cfldtype"allocation of inipar_alloc',il_err,1)
3074 ALLOCATE (crsttype(ig_nfield),stat=il_err)
3075 IF (il_err.NE.0) CALL
prtout(
'Error in "crsttype"allocation of inipar_alloc',il_err,1)
3077 ALLOCATE (nbins(ig_nfield),stat=il_err)
3078 IF (il_err.NE.0) CALL
prtout(
'Error in "nbins"allocation of inipar_alloc',il_err,1)
3080 ALLOCATE (cnorm_opt(ig_nfield),stat=il_err)
3081 IF (il_err.NE.0) CALL
prtout(
'Error in "cnorm_opt"allocation of inipar_alloc',il_err,1)
3083 ALLOCATE (corder(ig_nfield),stat=il_err)
3084 IF (il_err.NE.0) CALL
prtout(
'Error in "corder"allocation of inipar_alloc',il_err,1)
3088 ALLOCATE (niwtn(ig_nfield), stat=il_err)
3089 IF (il_err.NE.0) CALL
prtout(
'Error in "niwtn"allocation of extrapol module',il_err,1)
3091 ALLOCATE (niwtng(ig_nfield), stat=il_err)
3092 IF (il_err.NE.0) CALL
prtout(
'Error in "niwtng"allocation of extrapol module',il_err,1)
3094 ALLOCATE (lextra(ig_nfield), stat=il_err)
3095 IF (il_err.NE.0) CALL
prtout(
'Error in "lextra"allocation of extrapol module',il_err,1)
3097 ALLOCATE (lweight(ig_nfield), stat=il_err)
3098 IF (il_err.NE.0) CALL
prtout(
'Error in "lweight"allocation of extrapol module',il_err,1)
3102 ALLOCATE (lmapp(ig_nfield), stat=il_err)
3103 IF (il_err.NE.0) CALL
prtout(
'Error in "lmapp"allocation of rainbow module',il_err,1)
3105 ALLOCATE (lsubg(ig_nfield), stat=il_err)
3106 IF (il_err.NE.0) CALL
prtout(
'Error in "lsubg"allocation of rainbow module',il_err,1)
3110 ALLOCATE (cg_name_rstfile(ig_nbr_rstfile), stat=il_err)
3111 IF (il_err.NE.0) CALL
prtout(
'Error in "cg_name_rstfile"allocation of string module',il_err,1)
3112 cg_name_rstfile(:)=
' '
3113 ALLOCATE (ig_lag(ig_total_nfield), stat=il_err)
3114 IF (il_err.NE.0) CALL
prtout(
'Error in "ig_lag"allocation of string module',il_err,1)
3116 ALLOCATE (ig_no_rstfile(ig_total_nfield), stat=il_err)
3117 IF (il_err.NE.0) CALL
prtout(
'Error in "ig_no_rstfile"allocation of string module',il_err,1)
3119 ALLOCATE (cg_input_field(ig_total_nfield), stat=il_err)
3120 IF (il_err.NE.0) CALL
prtout(
'Error in "cg_input_field"allocation of string module',il_err,1)
3121 cg_input_field(:)=
' '
3122 ALLOCATE (ig_numlab(ig_total_nfield), stat=il_err)
3123 IF (il_err.NE.0) CALL
prtout(
'Error in "ig_numlab"allocation of string module',il_err,1)
3125 ALLOCATE (ig_freq(ig_total_nfield), stat=il_err)
3126 IF (il_err.NE.0) CALL
prtout(
'Error in "ig_freq"allocation of string module',il_err,1)
3128 ALLOCATE (ig_total_nseqn(ig_total_nfield), stat=il_err)
3129 IF (il_err.NE.0) CALL
prtout(
'Error in "ig_total_nseqn"allocation of string module',il_err,1)
3131 ALLOCATE (ig_local_trans(ig_total_nfield), stat=il_err)
3132 IF (il_err.NE.0) CALL
prtout(
'Error in "ig_local_trans"allocation of string module',il_err,1)
3134 ALLOCATE (ig_invert(ig_total_nfield), stat=il_err)
3135 IF (il_err.NE.0) CALL
prtout(
'Error in "ig_invert" allocation of string module',il_err,1)
3137 ALLOCATE (ig_reverse(ig_total_nfield), stat=il_err)
3138 IF (il_err.NE.0) CALL
prtout(
'Error in "ig_reverse" allocation of string module',il_err,1)
3144 IF (lg_oasis_field)
THEN
3145 ALLOCATE (numlab(ig_nfield), stat=il_err)
3146 IF (il_err.NE.0) CALL
prtout(
'Error in "numlab"allocation of string module',il_err,1)
3148 ALLOCATE (nfexch(ig_nfield), stat=il_err)
3149 IF (il_err.NE.0) CALL
prtout(
'Error in "nfexch"allocation of string module',il_err,1)
3151 ALLOCATE (nseqn(ig_nfield), stat=il_err)
3152 IF (il_err.NE.0) CALL
prtout(
'Error in "nseqn"allocation of string module',il_err,1)
3154 ALLOCATE (nlagn(ig_nfield), stat=il_err)
3155 IF (il_err.NE.0) CALL
prtout(
'Error in "nlagn" allocation of string module',il_err,1)
3157 ALLOCATE (cnaminp(ig_nfield), stat=il_err)
3158 IF (il_err.NE.0) CALL
prtout(
'Error in "cnaminp"allocation of string module',il_err,1)
3160 ALLOCATE (cnamout(ig_nfield), stat=il_err)
3161 IF (il_err.NE.0) CALL
prtout(
'Error in "cnamout"allocation of string module',il_err,1)
3163 ALLOCATE (cficout(ig_nfield), stat=il_err)
3164 IF (il_err.NE.0) CALL
prtout(
'Error in "cficout"allocation of string module',il_err,1)
3166 ALLOCATE (cstate(ig_nfield), stat=il_err)
3167 IF (il_err.NE.0) CALL
prtout(
'Error in "cstate"allocation of string module',il_err,1)
3173 END SUBROUTINE alloc
3179 character(len=*),
parameter :: subname=
'(mod_oasis_namcouple:dealloc)'
3182 DEALLOCATE (varmul, stat=il_err)
3183 IF (il_err.NE.0) CALL
prtout(
'Error in "varmul"deallocation of anais module',il_err,1)
3184 DEALLOCATE (niwtm, stat=il_err)
3185 IF (il_err.NE.0) CALL
prtout(
'Error in "niwtm"deallocation of anais module',il_err,1)
3186 DEALLOCATE (niwtg, stat=il_err)
3187 IF (il_err.NE.0) CALL
prtout(
'Error in "niwtg"deallocation of anais module',il_err,1)
3188 deallocate (linit, stat=il_err)
3189 if (il_err.ne.0) call
prtout(
'error in "linit"deallocation of anais module',il_err,1)
3192 DEALLOCATE (ncofld, stat=il_err)
3193 IF (il_err.NE.0) CALL
prtout(
'Error in "ncofld"deallocation of analysis module',il_err,1)
3194 DEALLOCATE (neighborg, stat=il_err)
3195 IF (il_err.NE.0) CALL
prtout(
'Error in "neighborg"deallocation of analysis module',il_err,1)
3196 DEALLOCATE (nludat, stat=il_err)
3197 IF (il_err.NE.0) CALL
prtout(
'Error in "nludat"deallocation of analysis module',il_err,1)
3198 DEALLOCATE (nlufil, stat=il_err)
3199 IF (il_err.NE.0) CALL
prtout(
'Error in "nlufil"deallocation of analysis module',il_err,1)
3200 DEALLOCATE (nlumap, stat=il_err)
3201 IF (il_err.NE.0) CALL
prtout(
'Error in "nlumap"deallocation of analysis module',il_err,1)
3202 DEALLOCATE (nlusub, stat=il_err)
3203 IF (il_err.NE.0) CALL
prtout(
'Error in "nlusub"deallocation of analysis module',il_err,1)
3204 DEALLOCATE (nluext, stat=il_err)
3205 IF (il_err.NE.0) CALL
prtout(
'Error in "nluext"deallocation of analysis module',il_err,1)
3206 DEALLOCATE (nosper, stat=il_err)
3207 IF (il_err.NE.0) CALL
prtout(
'Error in "nosper"deallocation of analysis module',il_err,1)
3208 DEALLOCATE (notper, stat=il_err)
3209 IF (il_err.NE.0) CALL
prtout(
'Error in "notper"deallocation of analysis module',il_err,1)
3210 DEALLOCATE (amskval, stat=il_err)
3211 IF (il_err.NE.0) CALL
prtout(
'Error in "amskval"deallocation of analysis module',il_err,1)
3212 DEALLOCATE (amskvalnew, stat=il_err)
3213 IF (il_err.NE.0) CALL
prtout(
'Error in "amskvalnew"deallocation of analysis module',il_err,1)
3214 DEALLOCATE (acocoef, stat=il_err)
3215 IF (il_err.NE.0) CALL
prtout(
'Error in "acocoef"deallocation of analysis module',il_err,1)
3216 DEALLOCATE (abocoef, stat=il_err)
3217 IF (il_err.NE.0) CALL
prtout(
'Error in "abocoef"deallocation of analysis module',il_err,1)
3218 DEALLOCATE (abncoef, stat=il_err)
3219 IF (il_err.NE.0) CALL
prtout(
'Error in "abncoef"deallocation of analysis module',il_err,1)
3220 DEALLOCATE (afldcoef, stat=il_err)
3221 IF (il_err.NE.0) CALL
prtout(
'Error in "afldcoef"deallocation of analysis module',il_err,1)
3222 DEALLOCATE (afldcobo, stat=il_err)
3223 IF (il_err.NE.0) CALL
prtout(
'Error in "afldcobo"deallocation of analysis module',il_err,1)
3224 DEALLOCATE (afldcobn, stat=il_err)
3225 IF (il_err.NE.0) CALL
prtout(
'Error in "afldcobn"deallocation of analysis module',il_err,1)
3226 DEALLOCATE (cxordbf, stat=il_err)
3227 IF (il_err.NE.0) CALL
prtout(
'Error in "cxordbf"deallocation of analysis module',il_err,1)
3228 DEALLOCATE (cyordbf, stat=il_err)
3229 IF (il_err.NE.0) CALL
prtout(
'Error in "cyordbf"deallocation of analysis module',il_err,1)
3230 DEALLOCATE (cxordaf, stat=il_err)
3231 IF (il_err.NE.0) CALL
prtout(
'Error in "cxordaf"deallocation of analysis module',il_err,1)
3232 DEALLOCATE (cyordaf, stat=il_err)
3233 IF (il_err.NE.0) CALL
prtout(
'Error in "cyordaf"deallocation of analysis module',il_err,1)
3234 DEALLOCATE (cgrdtyp, stat=il_err)
3235 IF (il_err.NE.0) CALL
prtout(
'Error in "cgrdtyp"deallocation of analysis module',il_err,1)
3236 DEALLOCATE (cfldtyp, stat=il_err)
3237 IF (il_err.NE.0) CALL
prtout(
'Error in "cfldtyp"deallocation of analysis module',il_err,1)
3238 DEALLOCATE (cfilfic, stat=il_err)
3239 IF (il_err.NE.0) CALL
prtout(
'Error in "cfilfic"deallocation of analysis module',il_err,1)
3240 DEALLOCATE (cfilmet, stat=il_err)
3241 IF (il_err.NE.0) CALL
prtout(
'Error in "cfilmet"deallocation of analysis module',il_err,1)
3242 DEALLOCATE (cconmet, stat=il_err)
3243 IF (il_err.NE.0) CALL
prtout(
'Error in "cconmet"deallocation of analysis module',il_err,1)
3244 DEALLOCATE (cconopt, stat=il_err)
3245 IF (il_err.NE.0) CALL
prtout(
'Error in "cconopt"deallocation of analysis module',il_err,1)
3246 DEALLOCATE (cfldcoa, stat=il_err)
3247 IF (il_err.NE.0) CALL
prtout(
'Error in "cfldcoa"deallocation of analysis module',il_err,1)
3248 DEALLOCATE (cfldfin, stat=il_err)
3249 IF (il_err.NE.0) CALL
prtout(
'Error in "cfldfin"deallocation of analysis module',il_err,1)
3250 DEALLOCATE (ccofld, stat=il_err)
3251 IF (il_err.NE.0) CALL
prtout(
'Error in "ccofld"deallocation of analysis module',il_err,1)
3252 DEALLOCATE (cbofld, stat=il_err)
3253 IF (il_err.NE.0) CALL
prtout(
'Error in "cbofld"deallocation of analysis module',il_err,1)
3254 DEALLOCATE (cbnfld, stat=il_err)
3255 IF (il_err.NE.0) CALL
prtout(
'Error in "cbnfld"deallocation of analysis module',il_err,1)
3256 DEALLOCATE (ccofic, stat=il_err)
3257 IF (il_err.NE.0) CALL
prtout(
'Error in "ccofic"deallocation of analysis module',il_err,1)
3258 DEALLOCATE (cdqdt, stat=il_err)
3259 IF (il_err.NE.0) CALL
prtout(
'Error in "cdqdt"deallocation of analysis module',il_err,1)
3260 DEALLOCATE (cgrdmap, stat=il_err)
3261 IF (il_err.NE.0) CALL
prtout(
'Error in "cgrdmap"deallocation of analysis module',il_err,1)
3262 DEALLOCATE (cmskrd, stat=il_err)
3263 IF (il_err.NE.0) CALL
prtout(
'Error in "cmskrd"deallocation of analysis module',il_err,1)
3264 DEALLOCATE (cgrdsub, stat=il_err)
3265 IF (il_err.NE.0) CALL
prtout(
'Error in "cgrdsub"deallocation of analysis module',il_err,1)
3266 DEALLOCATE (ctypsub, stat=il_err)
3267 IF (il_err.NE.0) CALL
prtout(
'Error in "ctypsub"deallocation of analysis module',il_err,1)
3268 DEALLOCATE (cgrdext, stat=il_err)
3269 IF (il_err.NE.0) CALL
prtout(
'Error in "cgrdext"deallocation of analysis module',il_err,1)
3270 DEALLOCATE (csper, stat=il_err)
3271 IF (il_err.NE.0) CALL
prtout(
'Error in "csper"deallocation of analysis module',il_err,1)
3272 DEALLOCATE (ctper, stat=il_err)
3273 IF (il_err.NE.0) CALL
prtout(
'Error in "ctper"deallocation of analysis module',il_err,1)
3274 DEALLOCATE (lsurf, stat=il_err)
3275 IF (il_err.NE.0) CALL
prtout(
'Error in "lsurf"deallocation of analysis module',il_err,1)
3276 DEALLOCATE (nscripvoi, stat=il_err)
3277 IF (il_err.NE.0) CALL
prtout(
'Error in nscripvoi deallocation of analysis module',il_err,1)
3281 DEALLOCATE (cmap_method,stat=il_err)
3282 IF (il_err.NE.0) CALL
prtout(
'Error in "cmap_method" deallocation of inipar_alloc',il_err,1)
3283 DEALLOCATE (cmap_file,stat=il_err)
3284 IF (il_err.NE.0) CALL
prtout(
'Error in "cmap_file" deallocation of inipar_alloc',il_err,1)
3285 DEALLOCATE (cmaptyp,stat=il_err)
3286 IF (il_err.NE.0) CALL
prtout(
'Error in "cmaptyp" deallocation of inipar_alloc',il_err,1)
3287 DEALLOCATE (cmapopt,stat=il_err)
3288 IF (il_err.NE.0) CALL
prtout(
'Error in "cmapopt" deallocation of inipar_alloc',il_err,1)
3289 DEALLOCATE (cfldtype,stat=il_err)
3290 IF (il_err.NE.0) CALL
prtout(
'Error in "cfldtype"deallocation of inipar_alloc',il_err,1)
3291 DEALLOCATE (crsttype,stat=il_err)
3292 IF (il_err.NE.0) CALL
prtout(
'Error in "crsttype"deallocation of inipar_alloc',il_err,1)
3293 DEALLOCATE (nbins,stat=il_err)
3294 IF (il_err.NE.0) CALL
prtout(
'Error in "nbins"deallocation of inipar_alloc',il_err,1)
3295 DEALLOCATE (cnorm_opt,stat=il_err)
3296 IF (il_err.NE.0) CALL
prtout(
'Error in "cnorm_opt"deallocation of inipar_alloc',il_err,1)
3297 DEALLOCATE (corder,stat=il_err)
3298 IF (il_err.NE.0) CALL
prtout(
'Error in "corder"deallocation of inipar_alloc',il_err,1)
3301 DEALLOCATE (niwtn, stat=il_err)
3302 IF (il_err.NE.0) CALL
prtout(
'Error in "niwtn"deallocation of extrapol module',il_err,1)
3303 DEALLOCATE (niwtng, stat=il_err)
3304 IF (il_err.NE.0) CALL
prtout(
'Error in "niwtng"deallocation of extrapol module',il_err,1)
3305 DEALLOCATE (lextra, stat=il_err)
3306 IF (il_err.NE.0) CALL
prtout(
'Error in "lextra"deallocation of extrapol module',il_err,1)
3307 DEALLOCATE (lweight, stat=il_err)
3308 IF (il_err.NE.0) CALL
prtout(
'Error in "lweight"deallocation of extrapol module',il_err,1)
3311 DEALLOCATE (lmapp, stat=il_err)
3312 IF (il_err.NE.0) CALL
prtout(
'Error in "lmapp"deallocation of rainbow module',il_err,1)
3313 DEALLOCATE (lsubg, stat=il_err)
3314 IF (il_err.NE.0) CALL
prtout(
'Error in "lsubg"deallocation of rainbow module',il_err,1)
3317 DEALLOCATE (cg_name_rstfile, stat=il_err)
3318 IF (il_err.NE.0) CALL
prtout(
'Error in "cg_name_rstfile"deallocation of string module',il_err,1)
3319 DEALLOCATE (ig_lag, stat=il_err)
3320 IF (il_err.NE.0) CALL
prtout(
'Error in "ig_lag"deallocation of string module',il_err,1)
3321 DEALLOCATE (ig_no_rstfile, stat=il_err)
3322 IF (il_err.NE.0) CALL
prtout(
'Error in "ig_no_rstfile"deallocation of string module',il_err,1)
3323 DEALLOCATE (cg_input_field, stat=il_err)
3324 IF (il_err.NE.0) CALL
prtout(
'Error in "cg_input_field"deallocation of string module',il_err,1)
3325 DEALLOCATE (ig_numlab, stat=il_err)
3326 IF (il_err.NE.0) CALL
prtout(
'Error in "ig_numlab"deallocation of string module',il_err,1)
3327 DEALLOCATE (ig_freq, stat=il_err)
3328 IF (il_err.NE.0) CALL
prtout(
'Error in "ig_freq"deallocation of string module',il_err,1)
3329 DEALLOCATE (ig_total_nseqn, stat=il_err)
3330 IF (il_err.NE.0) CALL
prtout(
'Error in "ig_total_nseqn"deallocation of string module',il_err,1)
3331 DEALLOCATE (ig_local_trans, stat=il_err)
3332 IF (il_err.NE.0) CALL
prtout(
'Error in "ig_local_trans"deallocation of string module',il_err,1)
3333 DEALLOCATE (ig_invert, stat=il_err)
3334 IF (il_err.NE.0) CALL
prtout(
'Error in "ig_invert" deallocation of string module',il_err,1)
3335 DEALLOCATE (ig_reverse, stat=il_err)
3336 IF (il_err.NE.0) CALL
prtout(
'Error in "ig_reverse" deallocation of string module',il_err,1)
3341 IF (lg_oasis_field)
THEN
3342 DEALLOCATE (numlab, stat=il_err)
3343 IF (il_err.NE.0) CALL
prtout(
'Error in "numlab"deallocation of string module',il_err,1)
3344 DEALLOCATE (nfexch, stat=il_err)
3345 IF (il_err.NE.0) CALL
prtout(
'Error in "nfexch"deallocation of string module',il_err,1)
3346 DEALLOCATE (nseqn, stat=il_err)
3347 IF (il_err.NE.0) CALL
prtout(
'Error in "nseqn"deallocation of string module',il_err,1)
3348 DEALLOCATE (nlagn, stat=il_err)
3349 IF (il_err.NE.0) CALL
prtout(
'Error in "nlagn" deallocation of string module',il_err,1)
3350 DEALLOCATE (cnaminp, stat=il_err)
3351 IF (il_err.NE.0) CALL
prtout(
'Error in "cnaminp"deallocation of string module',il_err,1)
3352 DEALLOCATE (cnamout, stat=il_err)
3353 IF (il_err.NE.0) CALL
prtout(
'Error in "cnamout"deallocation of string module',il_err,1)
3354 DEALLOCATE (cficout, stat=il_err)
3355 IF (il_err.NE.0) CALL
prtout(
'Error in "cficout"deallocation of string module',il_err,1)
3356 DEALLOCATE (cstate, stat=il_err)
3357 IF (il_err.NE.0) CALL
prtout(
'Error in "cstate"deallocation of string module',il_err,1)
3420 CHARACTER(len=*),
intent(in) :: cdtext
3421 INTEGER (kind=ip_intwp_p),
intent(in) :: kvalue, kstyle
3425 integer(kind=ip_intwp_p) :: ilen,jl
3427 character(len=*),
PARAMETER :: cbase =
'-'
3428 character(len=*),
PARAMETER :: cprpt =
'* ===>>> :'
3429 character(len=*),
PARAMETER :: cdots =
' ------ '
3430 character(len=*),
parameter :: subname=
'(mod_oasis_namcouple:prtout)'
3441 IF (mpi_rank_global == 0)
THEN
3442 IF ( kstyle .EQ. 1 .OR. kstyle .EQ. 2)
THEN
3446 cline(jl:jl) = cbase
3449 IF ( kstyle .EQ. 2 )
THEN
3450 WRITE(unit = nulprt1,fmt=
'(/,A,1X,A)') cdots, cline
3452 WRITE(unit = nulprt1,fmt=
'(A,1X,A,1X,I18)') cprpt, cdtext, kvalue
3453 WRITE(unit = nulprt1,fmt=
'(A,1X,A,/)') cdots, cline
3455 WRITE(unit = nulprt1,fmt=
'(/,A,1X,A,1X,I18,/)') cprpt, cdtext, kvalue
3525 CHARACTER(len=*),
intent(in) :: cdtext, cdstring
3526 INTEGER (kind=ip_intwp_p),
intent(in) :: kstyle
3530 integer (kind=ip_intwp_p) :: ilen,jl
3532 character(len=*),
PARAMETER :: cpbase =
'-'
3533 character(len=*),
PARAMETER :: cprpt =
'* ===>>> :'
3534 character(len=*),
PARAMETER :: cpdots =
' ------ '
3535 character(len=*),
parameter :: subname=
'(mod_oasis_namcouple:prcout)'
3546 IF (mpi_rank_global == 0)
THEN
3547 IF ( kstyle .EQ. 1 .OR. kstyle .EQ. 2)
THEN
3551 cline(jl:jl) = cpbase
3553 IF ( kstyle .EQ. 2 )
THEN
3554 WRITE(unit = nulprt1,fmt=
'(/,A,1X,A)') cpdots, cline
3556 WRITE(unit = nulprt1,fmt=
'(A,1X,A,1X,A)') cprpt, cdtext, cdstring
3557 WRITE(unit = nulprt1,fmt=
'(A,1X,A,/)') cpdots, cline
3559 WRITE(unit = nulprt1,fmt=
'(/,A,1X,A,1X,A,/)') cprpt, cdtext, cdstring
3574 SUBROUTINE parse (cdone, cdtwo, knumb, klen, kleng, endflag)
3631 INTEGER (kind=ip_intwp_p),
INTENT ( in) :: knumb, klen
3632 CHARACTER (len=klen),
INTENT ( inout) :: cdone
3633 CHARACTER (len=klen),
INTENT ( out) :: cdtwo
3634 INTEGER (kind=ip_intwp_p),
INTENT ( out) :: kleng
3635 LOGICAL,
optional,
intent(inout) :: endflag
3639 integer(kind=ip_intwp_p) :: ii,jl
3640 CHARACTER (len=klen) :: clline
3641 CHARACTER (len=klen) :: clwork
3642 CHARACTER (len=1),
SAVE :: clblank =
' ', clcmt =
'#'
3643 character(len=*),
parameter :: subname=
'(mod_oasis_namcouple:parse)'
3655 if (
present(endflag)) endflag = .false.
3657 100
IF (cdone(1:1) .NE. clcmt) go to 120
3658 READ (unit = nulin, fmt = 1001, end=249) clline
3659 cdone(1:klen) = clline(1:klen)
3674 clwork = adjustl( cdone)
3678 IF ( len_trim( clwork) .LE. 0)
THEN
3687 IF (knumb .GE. 2)
THEN
3689 ii = index( clwork, clblank) - 1
3690 clwork( 1:ii) = clblank
3691 clwork = adjustl( clwork)
3695 IF (len_trim( clwork) .LE. 0)
THEN
3705 kleng = index( clwork, clblank) - 1
3709 cdtwo( 1:kleng) = clwork( 1: kleng)
3719 IF (
present(endflag))
then
3723 IF (mpi_rank_global == 0)
THEN
3724 WRITE (unit = nulprt1,fmt = *)
' ***WARNING***'
3725 WRITE (unit = nulprt1,fmt = *) &
3726 ' mod_oasis_namcouple routine parse ran out of input '
3727 WRITE (unit = nulprt1,fmt = *)
' '
3728 WRITE (unit = nulprt1,fmt = *)
' '
3729 WRITE (unit = nulprt1,fmt = *) &
3730 ' We STOP!!! Check the file namcouple'
3731 WRITE (unit = nulprt1,fmt = *)
' '
3732 WRITE (nulprt1,
'(a,i4)')
' abort by model ',compid
3733 WRITE (nulprt1,
'(a)')
' error = STOP in inipar_alloc'
3739 END SUBROUTINE parse
3795 INTEGER (kind=ip_intwp_p),
INTENT ( in) :: knumb, klen
3796 CHARACTER (len=klen),
INTENT ( inout) :: cdone
3797 CHARACTER (len=klen),
INTENT ( out) :: cdtwo
3798 INTEGER (kind=ip_intwp_p),
INTENT ( out) :: kleng
3802 INTEGER (kind=ip_intwp_p) :: ii,jl
3803 INTEGER (kind=ip_intwp_p) :: il, kleng_aux
3804 CHARACTER (len=klen) :: clline
3805 CHARACTER (len=klen) :: clwork
3806 CHARACTER (len=1),
SAVE :: clblank =
' ', clcmt =
'#'
3807 character(len=*),
parameter :: subname=
'(mod_oasis_namcouple:parseblk)'
3819 100
IF (cdone(1:1) .NE. clcmt) go to 120
3820 READ (unit = nulin, fmt = 1001) clline
3821 cdone(1:klen) = clline(1:klen)
3836 il = index( cdone, clblank)
3838 IF (index( cdone, clblank).EQ.1)
THEN
3839 DO WHILE (cdone(il+1:il+1).EQ.clblank)
3840 kleng_aux = kleng_aux +1
3842 IF (il+1.GT.klen) go to 130
3846 clwork = adjustl( cdone)
3850 IF ( len_trim( clwork) .LE. 0)
THEN
3859 IF (knumb .GE. 2)
THEN
3861 ii = index( clwork, clblank) - 1
3863 DO WHILE (clwork(il:il).EQ.clblank)
3864 kleng_aux = kleng_aux +1
3866 IF (il.GT.klen) go to 140
3869 kleng_aux = kleng_aux + ii
3870 clwork( 1:ii) = clblank
3871 clwork = adjustl( clwork)
3875 IF (len_trim( clwork) .LE. 0)
THEN
3885 kleng = klen - kleng_aux
3889 cdtwo( 1:kleng) = clwork( 1: kleng)
3900 SUBROUTINE skip (cd_one, id_len, endflag)
3939 INTEGER (kind=ip_intwp_p),
intent(in) :: id_len
3940 CHARACTER(len=*),
intent(inout) :: cd_one
3941 LOGICAL,
optional,
intent(inout) :: endflag
3945 INTEGER (kind=ip_intwp_p) :: ib
3946 CHARACTER(len=id_len) :: cl_line
3947 CHARACTER(len=1) :: cl_two
3948 character(len=*),
parameter :: subname=
'(mod_oasis_namcouple:skip)'
3955 100
IF (cd_one(1:1) .NE. cl_two) go to 120
3956 if (
present(endflag))
then
3958 READ (unit = nulin, fmt = 1001, end=140) cl_line
3960 READ (unit = nulin, fmt = 1001) cl_line
3962 cd_one = trim(cl_line)
Reads the namcouple file for use in OASIS.
subroutine prtout(cdtext, kvalue, kstyle)
Provides a generic and simpler interface into MPI calls for OASIS.
subroutine, public oasis_unitsetmin(uio)
Set the minimum unit number allowed.
Provides a common location for several OASIS variables.
subroutine, public oasis_flush(nu)
Flushes output to file.
Character string manipulation methods.
subroutine skip(cd_one, id_len, endflag)
subroutine, public oasis_unitget(uio)
Get a free unit number.
subroutine parseblk(cdone, cdtwo, knumb, klen, kleng)
subroutine, public oasis_abort(id_compid, cd_routine, cd_message)
OASIS abort method, publically available to users.
subroutine prcout(cdtext, cdstring, kstyle)
subroutine, public oasis_namcouple_init()
Reads the namcouple.
subroutine inipar_alloc()
subroutine, public oasis_unitfree(uio)
Release a unit number for reuse.
Defines parameters for OASIS.
subroutine parse(cdone, cdtwo, knumb, klen, kleng, endflag)