Oasis3-MCT
mod_oasis_namcouple.F90
Go to the documentation of this file.
1 
2 !> Reads the namcouple file for use in OASIS
3 
4 !> This code reads in the namcouple file and sets several variables
5 !> that are available to the rest of OASIS. Some of this code
6 !> is obsolete, and several input settings are deprecated.
7 !> This code is based on the original Oasis3 version and
8 !> will be rewritten at some point.
9 
11 
12 ! - - - - - - - - - - - - - - - - - - - - - - - - - - -
13 
14  USE mod_oasis_kinds
15  USE mod_oasis_data
17  USE mod_oasis_sys
18  USE mod_oasis_mpi
20 
21  IMPLICIT NONE
22 
23  private
24 
26 
27 ! NAMCOUPLE PUBLIC DATA
28 
29  INTEGER (kind=ip_intwp_p),PARAMETER :: jpeighty = 5000 !< max number of characters to be read
30  !< in each line of the file namcouple
31  CHARACTER(len=*),parameter :: rform = '(A5000)' !< formatted line read format
32 
33  CHARACTER(len=*),parameter :: nmapdec_default = 'decomp_1d' ! decomp_wghtfile or decomp_1d
34 ! CHARACTER(len=*),parameter :: nmapdec_default = 'decomp_wghtfile' ! decomp_wghtfile or decomp_1d
35 
36 ! CHARACTER(len=*),parameter :: nmatxrd_default = 'orig' ! ceg or orig
37  CHARACTER(len=*),parameter :: nmatxrd_default = 'ceg' ! ceg or orig
38 
39  CHARACTER(len=*),parameter :: nwgtopt_default = 'abort_on_bad_index' ! weights handling
40 ! CHARACTER(len=*),parameter :: nwgtopt_default = 'ignore_bad_index' ! weights handling
41 ! CHARACTER(len=*),parameter :: nwgtopt_default = 'ignore_bad_index_silently' ! weights handling
42 ! CHARACTER(len=*),parameter :: nwgtopt_default = 'use_bad_index' ! weights handling
43 
44  INTEGER(kind=ip_i4_p) ,public :: nnamcpl !< number of namcouple inputs
45  INTEGER(kind=ip_i4_p) ,public :: namruntim !< namcouple runtime
46  INTEGER(kind=ip_i4_p) ,public :: namlogprt !< namcouple nlogprt value
47  INTEGER(kind=ip_i4_p) ,public :: namtlogprt !< namcouple ntlogprt value
48  INTEGER(kind=ip_i4_p) ,public :: namuntmin !< namcouple min IO unit value
49  INTEGER(kind=ip_i4_p) ,public :: namuntmax !< namcouple max IO unit value
50  LOGICAL ,public :: namnorest !< namcouple allow no restarts
51  CHARACTER(len=ic_med) ,public :: nammapdec !< namcouple map decomp value
52  CHARACTER(len=ic_med) ,public :: nammatxrd !< namcouple matrix read option
53  CHARACTER(len=ic_med) ,public :: namwgtopt !< namcouple weights handling option
54 
55  CHARACTER(len=jpeighty) ,public,pointer :: namsrcfld(:) !< list of src fields
56  CHARACTER(len=jpeighty) ,public,pointer :: namdstfld(:) !< list of dst fields
57  CHARACTER(len=ic_lvar) ,public,pointer :: namsrcgrd(:) !< src grid name
58  INTEGER(kind=ip_i4_p) ,public,pointer :: namsrc_nx(:) !< src nx grid size
59  INTEGER(kind=ip_i4_p) ,public,pointer :: namsrc_ny(:) !< src ny grid size
60  CHARACTER(len=ic_lvar) ,public,pointer :: namdstgrd(:) !< dst grid name
61  INTEGER(kind=ip_i4_p) ,public,pointer :: namdst_nx(:) !< dst nx grid size
62  INTEGER(kind=ip_i4_p) ,public,pointer :: namdst_ny(:) !< dst ny grid size
63  INTEGER(kind=ip_i4_p) ,public,pointer :: namfldseq(:) !< SEQ value
64  INTEGER(kind=ip_i4_p) ,public,pointer :: namfldops(:) !< operation, ip_expout,...
65  INTEGER(kind=ip_i4_p) ,public,pointer :: namflddti(:) !< coupling period (secs)
66  INTEGER(kind=ip_i4_p) ,public,pointer :: namfldlag(:) !< coupling lag (secs)
67  INTEGER(kind=ip_i4_p) ,public,pointer :: namfldtrn(:) !< fields transform, ip_instant,...
68  INTEGER(kind=ip_i4_p) ,public,pointer :: namfldcon(:) !< conserv fld operation
69  CHARACTER(len=ic_med) ,public,pointer :: namfldcoo(:) !< conserv fld option (bfb, opt)
70  CHARACTER(len=ic_long) ,public,pointer :: nammapfil(:) !< mapping file name
71  CHARACTER(len=ic_med) ,public,pointer :: nammaploc(:) !< mapping location (src or dst pes)
72  CHARACTER(len=ic_med) ,public,pointer :: nammapopt(:) !< mapping option (bfb, sum, or opt)
73  CHARACTER(len=ic_med) ,public,pointer :: namrstfil(:) !< restart file name
74  CHARACTER(len=ic_med) ,public,pointer :: naminpfil(:) !< input file name
75  LOGICAL ,public,pointer :: namchecki(:) !< checkin flag
76  LOGICAL ,public,pointer :: namchecko(:) !< checkout flag
77  REAL (kind=ip_realwp_p) ,public,pointer :: namfldsmu(:) !< src multiplier term
78  REAL (kind=ip_realwp_p) ,public,pointer :: namfldsad(:) !< src additive term
79  REAL (kind=ip_realwp_p) ,public,pointer :: namflddmu(:) !< dst multipler term
80  REAL (kind=ip_realwp_p) ,public,pointer :: namflddad(:) !< dst additive term
81 
82  CHARACTER(len=ic_med) ,public,pointer :: namscrmet(:) !< scrip method (CONSERV, DISTWGT, BILINEAR, BICUBIC, GAUSWGT)
83  CHARACTER(len=ic_med) ,public,pointer :: namscrnor(:) !< scrip conserv normalization (FRACAREA, DESTAREA, FRACNNEI)
84  CHARACTER(len=ic_med) ,public,pointer :: namscrtyp(:) !< scrip mapping type (SCALAR, VECTOR)
85  CHARACTER(len=ic_med) ,public,pointer :: namscrord(:) !< scrip conserve order (FIRST, SECOND)
86  CHARACTER(len=ic_med) ,public,pointer :: namscrres(:) !< scrip search restriction (LATLON, LATITUDE)
87  REAL (kind=ip_realwp_p) ,public,pointer :: namscrvam(:) !< scrip gauss weight distance weighting for GAUSWGT
88  INTEGER(kind=ip_i4_p) ,public,pointer :: namscrnbr(:) !< scrip number of neighbors for GAUSWGT and DISTWGT
89  INTEGER(kind=ip_i4_p) ,public,pointer :: namscrbin(:) !< script number of search bins
90 
91  !--- derived ---
92  INTEGER(kind=ip_i4_p) ,public,pointer :: namsort2nn(:) !< sorted namcpl for sort, define nn order, computed later
93  INTEGER(kind=ip_i4_p) ,public,pointer :: namnn2sort(:) !< sorted namcpl for nn, define sort number, computed later
94 
95 !----------------------------------------------------------------
96 ! LOCAL ONLY BELOW HERE
97 !----------------------------------------------------------------
98 
99  INTEGER(kind=ip_i4_p) :: nulin ! namcouple IO unit number
100  CHARACTER(len=*),parameter :: cl_namcouple = 'namcouple'
101 
102 ! --- alloc_src
103  INTEGER (kind=ip_intwp_p) :: il_err
104 ! --- mod_unitncdf
105  LOGICAL :: lncdfgrd
106  LOGICAL :: lncdfrst
107 ! --- mod_label
108  CHARACTER(len=5), PARAMETER :: cgrdnam = 'grids'
109  CHARACTER(len=5), PARAMETER :: cmsknam = 'masks'
110  CHARACTER(len=5), PARAMETER :: csurnam = 'areas'
111  CHARACTER(len=5), PARAMETER :: crednam = 'maskr'
112  CHARACTER(len=4), PARAMETER :: cglonsuf = '.lon'
113  CHARACTER(len=4), PARAMETER :: cglatsuf = '.lat'
114  CHARACTER(len=4), PARAMETER :: crnlonsuf = '.clo'
115  CHARACTER(len=4), PARAMETER :: crnlatsuf = '.cla'
116  CHARACTER(len=4), PARAMETER :: cmsksuf = '.msk'
117  CHARACTER(len=4), PARAMETER :: csursuf = '.srf'
118  CHARACTER(len=4), PARAMETER :: cangsuf = '.ang'
119 ! --- mod_rainbow
120  LOGICAL,DIMENSION(:),ALLOCATABLE :: lmapp
121  LOGICAL,DIMENSION(:),ALLOCATABLE :: lsubg
122 ! --- mod_coast
123  INTEGER (kind=ip_intwp_p) :: nfcoast
124  LOGICAL :: lcoast
125 ! --- mod_timestep
126  INTEGER (kind=ip_intwp_p) :: ntime
127  INTEGER (kind=ip_intwp_p) :: niter
128  INTEGER (kind=ip_intwp_p) :: nitfn
129  INTEGER (kind=ip_intwp_p) :: nstep
130 ! --- mod_parameter
131  INTEGER (kind=ip_intwp_p) :: ig_nfield ! number of oasis coupled fields
132  INTEGER (kind=ip_intwp_p) :: ig_direct_nfield ! number of direct coupled fields
133  INTEGER (kind=ip_intwp_p) :: ig_total_nfield ! estimate of total fields
134  INTEGER (kind=ip_intwp_p) :: ig_final_nfield ! number of final fields
135  LOGICAL :: lg_oasis_field
136  INTEGER (kind=ip_intwp_p) :: ig_maxcomb
137  INTEGER (kind=ip_intwp_p) :: ig_maxnoa
138  INTEGER (kind=ip_intwp_p) :: ig_maxnfg
139 ! --- mod_printing
140  INTEGER(kind=ip_intwp_p) :: nlogprt
141 !---- Time statistics level printing
142  INTEGER(kind=ip_intwp_p) :: ntlogprt
143 !---- min and max unit numbers
144  INTEGER(kind=ip_intwp_p) :: nuntmin
145  INTEGER(kind=ip_intwp_p) :: nuntmax
146 !---- allow no restart files
147  LOGICAL :: nnorest
148 !---- specify mapping decomp
149  CHARACTER(len=ic_med) :: nmapdec
150  CHARACTER(len=ic_med) :: nmatxrd
151  CHARACTER(len=ic_med) :: nwgtopt
152 ! --- mod_string
153  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: numlab
154  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_numlab
155  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nfexch
156  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_ntrans
157  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_total_ntrans
158  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nlonbf
159  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nlatbf
160  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nlonaf
161  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nlataf
162  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nseqn
163  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_total_nseqn
164  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_freq
165  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_lag
166  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nlagn
167  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_invert
168  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_reverse
169  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_number_field
170  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_no_rstfile
171  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_total_state
172  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_local_trans
173  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_grid_nbrbf
174  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_grid_nbraf
175  INTEGER (kind=ip_intwp_p) :: ig_nbr_rstfile
176  INTEGER (kind=ip_intwp_p) :: ig_total_frqmin
177  LOGICAL ,DIMENSION(:),ALLOCATABLE :: lg_state
178  CHARACTER(len=jpeighty) ,DIMENSION(:),ALLOCATABLE :: cnaminp
179  CHARACTER(len=jpeighty) ,DIMENSION(:),ALLOCATABLE :: cnamout
180  CHARACTER(len=8) ,DIMENSION(:,:),ALLOCATABLE :: canal
181  CHARACTER(len=8) :: cg_c
182  CHARACTER(len=32) ,DIMENSION(:),ALLOCATABLE :: cg_name_rstfile
183  CHARACTER(len=32) ,DIMENSION(:),ALLOCATABLE :: cg_restart_file
184  CHARACTER(len=32) ,DIMENSION(:),ALLOCATABLE :: cficinp
185  CHARACTER(len=8) ,DIMENSION(:),ALLOCATABLE :: cficout
186  CHARACTER(len=32) ,DIMENSION(:),ALLOCATABLE :: cg_input_file
187  CHARACTER(len=jpeighty) ,DIMENSION(:),ALLOCATABLE :: cg_input_field
188  CHARACTER(len=jpeighty) ,DIMENSION(:),ALLOCATABLE :: cg_output_field
189  CHARACTER(len=8) ,DIMENSION(:),ALLOCATABLE :: cficbf
190  CHARACTER(len=8) ,DIMENSION(:),ALLOCATABLE :: cficaf
191  CHARACTER(len=8) ,DIMENSION(:),ALLOCATABLE :: cstate
192  CHARACTER(len=4) ,DIMENSION(:),ALLOCATABLE :: cga_locatorbf
193  CHARACTER(len=4) ,DIMENSION(:),ALLOCATABLE :: cga_locatoraf
194 ! --- mod_analysis
195  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: neighbor
196  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: ntronca
197  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: ncofld
198  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: neighborg
199  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nbofld
200  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nbnfld
201  INTEGER (kind=ip_intwp_p), DIMENSION(:,:), ALLOCATABLE :: nludat
202  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nlufil
203  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nlumap
204  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nmapfl
205  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nmapvoi
206  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nlusub
207  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nsubfl
208  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nsubvoi
209  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nluext
210  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nextfl
211  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nosper
212  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: notper
213  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nbins
214  INTEGER (kind=ip_intwp_p) :: nlucor
215  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nscripvoi
216  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: amskval
217  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: amskvalnew
218  REAL (kind=ip_realwp_p), DIMENSION(:,:), ALLOCATABLE :: acocoef
219  REAL (kind=ip_realwp_p), DIMENSION(:,:), ALLOCATABLE :: abocoef
220  REAL (kind=ip_realwp_p), DIMENSION(:,:), ALLOCATABLE :: abncoef
221  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: afldcoef
222  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: afldcobo
223  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: afldcobn
224  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cxordbf
225  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cyordbf
226  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cxordaf
227  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cyordaf
228  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cextmet
229  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cintmet
230  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cgrdtyp
231  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfldtyp
232  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfilfic
233  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfilmet
234  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cconmet
235  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cconopt
236  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfldcoa
237  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfldfin
238  CHARACTER(len=8), DIMENSION(:,:),ALLOCATABLE :: ccofld
239  CHARACTER(len=8), DIMENSION(:,:),ALLOCATABLE :: cbofld
240  CHARACTER(len=8), DIMENSION(:,:),ALLOCATABLE :: cbnfld
241  CHARACTER(len=8), DIMENSION(:,:),ALLOCATABLE :: ccofic
242  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cdqdt
243  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cgrdmap
244  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cmskrd
245  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cgrdsub
246  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: ctypsub
247  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cgrdext
248  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: csper
249  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: ctper
250  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cmap_method
251  CHARACTER(len=ic_long), DIMENSION(:),ALLOCATABLE :: cmap_file
252  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cmaptyp
253  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cmapopt
254  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: corder
255  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cnorm_opt
256  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfldtype
257  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: crsttype
258  CHARACTER(len=8) :: cfldcor
259  LOGICAL, DIMENSION(:),ALLOCATABLE :: lsurf
260 ! --- mod_anais
261  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: naismfl
262  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: naisgfl
263  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: naismvoi
264  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: naisgvoi
265  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: niwtm
266  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: niwtg
267  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: varmul
268  LOGICAL, DIMENSION(:), ALLOCATABLE :: linit
269 ! --- mod extrapol
270  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: niwtn
271  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nninnfl
272  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: niwtng
273  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nninnflg
274  LOGICAL, DIMENSION(:), ALLOCATABLE :: lextra
275  LOGICAL, DIMENSION(:), ALLOCATABLE :: lweight
276 !--- local reuse values
277  CHARACTER*9, parameter :: &
278  clfield = '$NFIELDS ', &
279  clchan = '$CHANNEL ', &
280  clstring = '$STRINGS ', &
281  clmod = '$NBMODEL ', &
282  cljob = '$JOBNAME ', &
283  cltime = '$RUNTIME ', &
284  clseq = '$SEQMODE ', &
285  cldate = '$INIDATE ', &
286  clhead = '$MODINFO ', &
287  clprint = '$NLOGPRT ', &
288  clmapdec = '$NMAPDEC ', &
289  clmatxrd = '$NMATXRD ', &
290  clwgtopt = '$NWGTOPT ', &
291  clunit = '$NUNITNO ', &
292  clrest = '$NNOREST ', &
293  clcal = '$CALTYPE ', &
294  clend = '$END '
295  INTEGER (kind=ip_intwp_p),parameter :: nkeywords = 17
296  CHARACTER*9, parameter :: keyword_list(nkeywords) = &
299  clcal, clend, clwgtopt /)
300  CHARACTER*512 :: tmpstr1, tmpstr2, tmpstr3, tmpstr4
301 
302 
303 !------------------------------------------------------------
304 CONTAINS
305 !------------------------------------------------------------
306 
307 !> Reads the namcouple
308 
309 SUBROUTINE oasis_namcouple_init()
311  IMPLICIT NONE
312 
313  !-----------------------------------------------------------
314  INTEGER(kind=ip_i4_p) :: n, nv, n1, n2, loc
315  INTEGER(kind=ip_i4_p) :: ja, jf, jc
316  INTEGER(kind=ip_i4_p) :: il_iost
317  INTEGER(kind=ip_i4_p) :: maxunit
318  CHARACTER(len=*),parameter :: subname='(oasis_namcouple_init)'
319  !-----------------------------------------------------------
320 
321  CALL oasis_unitget(nulin)
322  OPEN (nulin,file =cl_namcouple,status='OLD', form ='FORMATTED', iostat = il_iost)
323 
324  IF (mpi_rank_global == 0) THEN
325  IF (il_iost .NE. 0) THEN
326  WRITE(tmpstr1,*) ' ERROR opening namcouple file ',trim(cl_namcouple),' with unit number ',nulin
327  CALL namcouple_abort(subname,__line__,tmpstr1)
328  ELSE
329  WRITE(nulprt1,*) subname,' open namcouple file ',trim(cl_namcouple),' with unit number ',nulin
330  ENDIF
331  ENDIF
332 
333  CALL inipar_alloc()
334  CALL alloc()
335  CALL inipar()
336  !
337  ! Close namcouple unit
338  close(nulin)
339 
340  CALL oasis_unitfree(nulin)
341 
342  IF (mpi_rank_global == 0) THEN
343  WRITE(nulprt1,*) subname,' allocating ig_final_nfield',ig_final_nfield
344  CALL oasis_flush(nulprt1)
345  ENDIF
346 
347  allocate(namsrcfld(ig_final_nfield), stat=il_err)
348  IF (il_err.NE.0) CALL prtout('Error in "namsrcfld" allocation of experiment module',il_err,1)
349 
350  allocate(namdstfld(ig_final_nfield), stat=il_err)
351  IF (il_err.NE.0) CALL prtout('Error in "namdstfld" allocation of experiment module',il_err,1)
352 
353  allocate(namsrcgrd(ig_final_nfield), stat=il_err)
354  IF (il_err.NE.0) CALL prtout('Error in "namsrcgrd" allocation of experiment module',il_err,1)
355 
356  allocate(namsrc_nx(ig_final_nfield), stat=il_err)
357  IF (il_err.NE.0) CALL prtout('Error in "namsrc_nx" allocation of experiment module',il_err,1)
358 
359  allocate(namsrc_ny(ig_final_nfield), stat=il_err)
360  IF (il_err.NE.0) CALL prtout('Error in "namsrc_ny" allocation of experiment module',il_err,1)
361 
362  allocate(namdstgrd(ig_final_nfield), stat=il_err)
363  IF (il_err.NE.0) CALL prtout('Error in "namdstgrd" allocation of experiment module',il_err,1)
364 
365  allocate(namdst_nx(ig_final_nfield), stat=il_err)
366  IF (il_err.NE.0) CALL prtout('Error in "namdst_nx" allocation of experiment module',il_err,1)
367 
368  allocate(namdst_ny(ig_final_nfield), stat=il_err)
369  IF (il_err.NE.0) CALL prtout('Error in "namdst_ny" allocation of experiment module',il_err,1)
370 
371  allocate(namfldseq(ig_final_nfield), stat=il_err)
372  IF (il_err.NE.0) CALL prtout('Error in "namfldseq" allocation of experiment module',il_err,1)
373 
374  allocate(namfldops(ig_final_nfield), stat=il_err)
375  IF (il_err.NE.0) CALL prtout('Error in "namfldops" allocation of experiment module',il_err,1)
376 
377  allocate(namfldtrn(ig_final_nfield), stat=il_err)
378  IF (il_err.NE.0) CALL prtout('Error in "namfldtrn" allocation of experiment module',il_err,1)
379 
380  allocate(namfldcon(ig_final_nfield), stat=il_err)
381  IF (il_err.NE.0) CALL prtout('Error in "namfldcon" allocation of experiment module',il_err,1)
382 
383  allocate(namfldcoo(ig_final_nfield), stat=il_err)
384  IF (il_err.NE.0) CALL prtout('Error in "namfldcoo" allocation of experiment module',il_err,1)
385 
386  allocate(namflddti(ig_final_nfield), stat=il_err)
387  IF (il_err.NE.0) CALL prtout('Error in "namflddti" allocation of experiment module',il_err,1)
388 
389  allocate(namfldlag(ig_final_nfield), stat=il_err)
390  IF (il_err.NE.0) CALL prtout('Error in "namfldlag" allocation of experiment module',il_err,1)
391 
392  allocate(nammapfil(ig_final_nfield), stat=il_err)
393  IF (il_err.NE.0) CALL prtout('Error in "nammapfil" allocation of experiment module',il_err,1)
394 
395  allocate(nammaploc(ig_final_nfield), stat=il_err)
396  IF (il_err.NE.0) CALL prtout('Error in "nammaploc" allocation of experiment module',il_err,1)
397 
398  allocate(nammapopt(ig_final_nfield), stat=il_err)
399  IF (il_err.NE.0) CALL prtout('Error in "nammapopt" allocation of experiment module',il_err,1)
400 
401  allocate(namrstfil(ig_final_nfield), stat=il_err)
402  IF (il_err.NE.0) CALL prtout('Error in "namrstfil" allocation of experiment module',il_err,1)
403 
404  allocate(naminpfil(ig_final_nfield), stat=il_err)
405  IF (il_err.NE.0) CALL prtout('Error in "naminpfil" allocation of experiment module',il_err,1)
406 
407  allocate(namsort2nn(ig_final_nfield), stat=il_err)
408  IF (il_err.NE.0) CALL prtout('Error in "namsort2nn" allocation of experiment module',il_err,1)
409 
410  allocate(namnn2sort(ig_final_nfield), stat=il_err)
411  IF (il_err.NE.0) CALL prtout('Error in "namnn2sort" allocation of experiment module',il_err,1)
412 
413  allocate(namchecki(ig_final_nfield), stat=il_err)
414  IF (il_err.NE.0) CALL prtout('Error in "namchecki" allocation of experiment module',il_err,1)
415 
416  allocate(namchecko(ig_final_nfield), stat=il_err)
417  IF (il_err.NE.0) CALL prtout('Error in "namchecko" allocation of experiment module',il_err,1)
418 
419  allocate(namfldsmu(ig_final_nfield), stat=il_err)
420  IF (il_err.NE.0) CALL prtout('Error in "namfldsmu" allocation of experiment module',il_err,1)
421 
422  allocate(namfldsad(ig_final_nfield), stat=il_err)
423  IF (il_err.NE.0) CALL prtout('Error in "namfldsad" allocation of experiment module',il_err,1)
424 
425  allocate(namflddmu(ig_final_nfield), stat=il_err)
426  IF (il_err.NE.0) CALL prtout('Error in "namflddmu" allocation of experiment module',il_err,1)
427 
428  allocate(namflddad(ig_final_nfield), stat=il_err)
429  IF (il_err.NE.0) CALL prtout('Error in "namflddad" allocation of experiment module',il_err,1)
430 
431  allocate(namscrmet(ig_final_nfield), stat=il_err)
432  IF (il_err.NE.0) CALL prtout('Error in "namscrmet" allocation of experiment module',il_err,1)
433 
434  allocate(namscrnor(ig_final_nfield), stat=il_err)
435  IF (il_err.NE.0) CALL prtout('Error in "namscrnor" allocation of experiment module',il_err,1)
436 
437  allocate(namscrtyp(ig_final_nfield), stat=il_err)
438  IF (il_err.NE.0) CALL prtout('Error in "namscrtyp" allocation of experiment module',il_err,1)
439 
440  allocate(namscrord(ig_final_nfield), stat=il_err)
441  IF (il_err.NE.0) CALL prtout('Error in "namscrord" allocation of experiment module',il_err,1)
442 
443  allocate(namscrres(ig_final_nfield), stat=il_err)
444  IF (il_err.NE.0) CALL prtout('Error in "namscrres" allocation of experiment module',il_err,1)
445 
446  allocate(namscrvam(ig_final_nfield), stat=il_err)
447  IF (il_err.NE.0) CALL prtout('Error in "namscrvam" allocation of experiment module',il_err,1)
448 
449  allocate(namscrnbr(ig_final_nfield), stat=il_err)
450  IF (il_err.NE.0) CALL prtout('Error in "namscrnbr" allocation of experiment module',il_err,1)
451 
452  allocate(namscrbin(ig_final_nfield), stat=il_err)
453  IF (il_err.NE.0) CALL prtout('Error in "namscrbin" allocation of experiment module',il_err,1)
454 
455  namsrcfld(:) = trim(cspval)
456  namdstfld(:) = trim(cspval)
457  namsrcgrd(:) = trim(cspval)
458  namsrc_nx(:) = 0
459  namsrc_ny(:) = 0
460  namdstgrd(:) = trim(cspval)
461  namdst_nx(:) = 0
462  namdst_ny(:) = 0
463  namfldseq(:) = -1
464  namfldops(:) = -1
465  namfldtrn(:) = ip_instant
466  namfldcon(:) = ip_cnone
467  namfldcoo(:) = "bfb"
468  namflddti(:) = -1
469  namfldlag(:) = 0
470  nammapfil(:) = "idmap"
471  nammaploc(:) = "src"
472  nammapopt(:) = "bfb"
473  namrstfil(:) = trim(cspval)
474  naminpfil(:) = trim(cspval)
475  namchecki(:) = .false.
476  namchecko(:) = .false.
477  namfldsmu(:) = 1.0_ip_realwp_p
478  namfldsad(:) = 0.0_ip_realwp_p
479  namflddmu(:) = 1.0_ip_realwp_p
480  namflddad(:) = 0.0_ip_realwp_p
481 
482  namscrmet(:) = trim(cspval)
483  namscrnor(:) = trim(cspval)
484  namscrtyp(:) = trim(cspval)
485  namscrord(:) = trim(cspval)
486  namscrres(:) = trim(cspval)
487  namscrvam(:) = 1.0_ip_realwp_p
488  namscrnbr(:) = -1
489  namscrbin(:) = -1
490 
491 ! maxunit = max(maxval(iga_unitmod),1024)
492 ! maxunit = 1024
493 ! IF (mpi_rank_global == 0) THEN
494 ! WRITE(nulprt1,*) subname,' maximum unit number = ',maxunit
495 ! CALL oasis_flush(nulprt1)
496 ! ENDIF
497 ! CALL oasis_unitsetmin(maxunit)
498 
500  namruntim = ntime
509  DO jf = 1,ig_final_nfield
510  namsrcfld(jf) = cg_input_field(jf)
511  namdstfld(jf) = cg_output_field(jf)
512  namfldseq(jf) = ig_total_nseqn(jf)
513  namfldops(jf) = ig_total_state(jf)
514  IF (namfldops(jf) == ip_auxilary) THEN
515  WRITE(tmpstr1,*) jf,' ERROR: AUXILARY NOT SUPPORTED'
516  CALL namcouple_abort(subname,__line__,tmpstr1)
517  ENDIF
518  IF (namfldops(jf) == ip_ignored) THEN
519  namfldops(jf) = ip_exported
520  IF (mpi_rank_global == 0) THEN
521  WRITE(nulprt1,*) subname,jf,'WARNING: IGNORED converted to EXPORTED'
522  CALL oasis_flush(nulprt1)
523  ENDIF
524  ENDIF
525  IF (namfldops(jf) == ip_ignout) THEN
526  namfldops(jf) = ip_expout
527  IF (mpi_rank_global == 0) THEN
528  WRITE(nulprt1,*) subname,jf,'WARNING: IGNOUT converted to EXPOUT'
529  CALL oasis_flush(nulprt1)
530  ENDIF
531  ENDIF
532  namflddti(jf) = ig_freq(jf)
533  namfldlag(jf) = ig_lag(jf)
534  namfldtrn(jf) = ig_local_trans(jf)
535  namrstfil(jf) = trim(cg_restart_file(jf))
536  naminpfil(jf) = trim(cg_input_file(jf))
537  IF (ig_number_field(jf) > 0) THEN
538  namsrcgrd(jf) = trim(cficbf(ig_number_field(jf)))
539  namsrc_nx(jf) = nlonbf(ig_number_field(jf))
540  namsrc_ny(jf) = nlatbf(ig_number_field(jf))
541  namdstgrd(jf) = trim(cficaf(ig_number_field(jf)))
542  namdst_nx(jf) = nlonaf(ig_number_field(jf))
543  namdst_ny(jf) = nlataf(ig_number_field(jf))
544  DO ja = 1, ig_ntrans(ig_number_field(jf))
545 
546  IF (canal(ja,ig_number_field(jf)) .EQ. 'SCRIPR') THEN
547  namscrmet(jf) = trim(cmap_method(ig_number_field(jf)))
548  namscrnor(jf) = trim(cnorm_opt(ig_number_field(jf)))
549  namscrtyp(jf) = trim(cfldtype(ig_number_field(jf)))
550  namscrord(jf) = trim(corder(ig_number_field(jf)))
551  namscrres(jf) = trim(crsttype(ig_number_field(jf)))
552  namscrvam(jf) = varmul(ig_number_field(jf))
554  namscrbin(jf) = nbins(ig_number_field(jf))
555  IF (trim(namscrtyp(jf)) /= 'SCALAR') THEN
556  WRITE(tmpstr1,*) subname,jf,'WARNING: SCRIPR weights generation &
557  & supported only for SCALAR mapping, not '//trim(namscrtyp(jf))
558  CALL namcouple_abort(subname,__line__,tmpstr1)
559  ENDIF
560 
561  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'MAPPING') THEN
562  nammapfil(jf) = trim(cmap_file(ig_number_field(jf)))
563  nammaploc(jf) = trim(cmaptyp(ig_number_field(jf)))
564  nammapopt(jf) = trim(cmapopt(ig_number_field(jf)))
565 
566  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'CONSERV') THEN
567  namfldcon(jf) = ip_cnone
568  namfldcoo(jf) = trim(cconopt(ig_number_field(jf)))
569  IF (cconmet(ig_number_field(jf)) .EQ. 'GLOBAL') namfldcon(jf) = ip_cglobal
570  IF (cconmet(ig_number_field(jf)) .EQ. 'GLBPOS') namfldcon(jf) = ip_cglbpos
571  IF (cconmet(ig_number_field(jf)) .EQ. 'BASBAL') namfldcon(jf) = ip_cbasbal
572  IF (cconmet(ig_number_field(jf)) .EQ. 'BASPOS') namfldcon(jf) = ip_cbaspos
573  IF (namfldcon(jf) .EQ. ip_cnone) THEN
574  WRITE(tmpstr1,*) subname,jf,'WARNING: CONSERV option not supported: '//&
575  &trim(cconmet(ig_number_field(jf)))
576  CALL namcouple_abort(subname,__line__,tmpstr1)
577  ENDIF
578 
579  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKIN' ) THEN
580  namchecki(jf) = .true.
581 
582  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKOUT') THEN
583  namchecko(jf) = .true.
584 
585  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'BLASOLD') THEN
587  DO jc = 1, nbofld(ig_number_field(jf))
588  IF (trim(cbofld(jc,ig_number_field(jf))) == 'CONSTANT') THEN
589  namfldsad(jf) = abocoef(jc,ig_number_field(jf))
590  ELSE
591  WRITE(tmpstr1,*) subname,jf,'ERROR: BLASOLD only supports CONSTANT: '//&
592  &trim(cbofld(jc,ig_number_field(jf)))
593  CALL namcouple_abort(subname,__line__,tmpstr1)
594  ENDIF
595  ENDDO
596 
597  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'BLASNEW') THEN
599  DO jc = 1, nbnfld(ig_number_field(jf))
600  IF (trim(cbnfld(jc,ig_number_field(jf))) == 'CONSTANT') THEN
601  namflddad(jf) = abncoef(jc,ig_number_field(jf))
602  ELSE
603  WRITE(tmpstr1,*) subname,jf,'ERROR: BLASNEW only supports CONSTANTS: '//&
604  &trim(cbofld(jc,ig_number_field(jf)))
605  CALL namcouple_abort(subname,__line__,tmpstr1)
606  ENDIF
607  ENDDO
608 
609  ENDIF ! canal
610  ENDDO ! ig_ntrans
611  ENDIF ! ig_number_field
612  ENDDO ! ig_final_nfield
613 
614  IF (mpi_rank_global == 0) THEN
615  WRITE(nulprt1,*) ' '
616  WRITE(nulprt1,*) subname,'namlogprt,t ',namlogprt, namtlogprt
617  WRITE(nulprt1,*) subname,'namuntmin,max ',namuntmin, namuntmax
618  WRITE(nulprt1,*) subname,'namnorest ',namnorest
619  WRITE(nulprt1,*) subname,'nammapdec ',trim(nammapdec)
620  WRITE(nulprt1,*) subname,'nammatxrd ',trim(nammatxrd)
621  WRITE(nulprt1,*) subname,'namwgtopt ',trim(namwgtopt)
622  WRITE(nulprt1,*) ' '
623  DO n = 1,nnamcpl
624  WRITE(nulprt1,*) subname,n,'namsrcfld ',trim(namsrcfld(n))
625  WRITE(nulprt1,*) subname,n,'namdstfld ',trim(namdstfld(n))
626  WRITE(nulprt1,*) subname,n,'namsrcgrd ',trim(namsrcgrd(n))
627  WRITE(nulprt1,*) subname,n,'namsrc_nx ',namsrc_nx(n)
628  WRITE(nulprt1,*) subname,n,'namsrc_ny ',namsrc_ny(n)
629  WRITE(nulprt1,*) subname,n,'namdstgrd ',trim(namdstgrd(n))
630  WRITE(nulprt1,*) subname,n,'namdst_nx ',namdst_nx(n)
631  WRITE(nulprt1,*) subname,n,'namdst_ny ',namdst_ny(n)
632  WRITE(nulprt1,*) subname,n,'namfldseq ',namfldseq(n)
633  WRITE(nulprt1,*) subname,n,'namfldops ',namfldops(n)
634  WRITE(nulprt1,*) subname,n,'namfldtrn ',namfldtrn(n)
635  WRITE(nulprt1,*) subname,n,'namfldcon ',namfldcon(n)
636  WRITE(nulprt1,*) subname,n,'namfldcoo ',trim(namfldcoo(n))
637  WRITE(nulprt1,*) subname,n,'namflddti ',namflddti(n)
638  WRITE(nulprt1,*) subname,n,'namfldlag ',namfldlag(n)
639  WRITE(nulprt1,*) subname,n,'nammapfil ',trim(nammapfil(n))
640  WRITE(nulprt1,*) subname,n,'nammaploc ',trim(nammaploc(n))
641  WRITE(nulprt1,*) subname,n,'nammapopt ',trim(nammapopt(n))
642  WRITE(nulprt1,*) subname,n,'namrstfil ',trim(namrstfil(n))
643  WRITE(nulprt1,*) subname,n,'naminpfil ',trim(naminpfil(n))
644  WRITE(nulprt1,*) subname,n,'namchecki ',namchecki(n)
645  WRITE(nulprt1,*) subname,n,'namchecko ',namchecko(n)
646  WRITE(nulprt1,*) subname,n,'namfldsmu ',namfldsmu(n)
647  WRITE(nulprt1,*) subname,n,'nbofld ',nbofld(n)
648  WRITE(nulprt1,*) subname,n,'namfldsad ',namfldsad(n)
649  WRITE(nulprt1,*) subname,n,'namflddmu ',namflddmu(n)
650  WRITE(nulprt1,*) subname,n,'nbnfld ',nbnfld(n)
651  WRITE(nulprt1,*) subname,n,'namflddad ',namflddad(n)
652  WRITE(nulprt1,*) subname,n,'namscrmet ',trim(namscrmet(n))
653  WRITE(nulprt1,*) subname,n,'namscrnor ',trim(namscrnor(n))
654  WRITE(nulprt1,*) subname,n,'namscrtyp ',trim(namscrtyp(n))
655  WRITE(nulprt1,*) subname,n,'namscrord ',trim(namscrord(n))
656  WRITE(nulprt1,*) subname,n,'namscrres ',trim(namscrres(n))
657  WRITE(nulprt1,*) subname,n,'namscrvam ',namscrvam(n)
658  WRITE(nulprt1,*) subname,n,'namscrnbr ',namscrnbr(n)
659  WRITE(nulprt1,*) subname,n,'namscrbin ',namscrbin(n)
660  WRITE(nulprt1,*) ' '
661  CALL oasis_flush(nulprt1)
662  ENDDO
663  ENDIF
664 
665  !--- compute seq sort ---
666  namsort2nn(:) = -1
667  DO nv = 1,nnamcpl
668  loc = nv ! default at end
669  n1 = 1
670  DO WHILE (loc == nv .and. n1 < nv)
671  IF (namfldseq(nv) < namfldseq(namsort2nn(n1))) loc = n1
672  n1 = n1 + 1
673  ENDDO
674  ! nv goes into loc location, shift THEN set
675  DO n1 = nv,loc+1,-1
676  namsort2nn(n1) = namsort2nn(n1-1)
677  ENDDO
678  namsort2nn(loc) = nv
679  ENDDO
680 
681  DO nv = 1,nnamcpl
682  namnn2sort(namsort2nn(nv)) = nv
683  ENDDO
684 
685  IF (mpi_rank_global == 0) THEN
686  DO nv = 1,nnamcpl
687  n1 = namsort2nn(nv)
688  n2 = namnn2sort(nv)
689  WRITE(nulprt1,*) subname,' sort ',nv,n1,n2,namfldseq(n1)
690  CALL oasis_flush(nulprt1)
691  ENDDO
692  ENDIF
693 
694  !--- check they are sorted ---
695  DO n = 2,nnamcpl
696  IF (namfldseq(namsort2nn(n)) < namfldseq(namsort2nn(n-1))) THEN
697  CALL namcouple_abort(subname,__line__,' ERROR in seq sort')
698  ENDIF
699  ENDDO
700 
701  CALL dealloc()
702 
703  ! CALL oasis_debug_exit(subname)
704 
705 END SUBROUTINE oasis_namcouple_init
706 
707 !===============================================================================
708 
709 !> Reads the namcouple to allocate arrays
710 
711 SUBROUTINE inipar_alloc()
713 !****
714 ! *****************************
715 ! * OASIS ROUTINE - LEVEL 0 *
716 ! * ------------- ------- *
717 ! *****************************
718 
719 !**** *inipar_alloc* - Get main run parameters to allocate arrays
720 
721 ! Purpose:
722 ! -------
723 ! Reads out run parameters.
724 
725 !** Interface:
726 ! ---------
727 ! *CALL* *inipar_alloc*
728 
729 ! Input:
730 ! -----
731 ! None
732 
733 ! Output:
734 ! ------
735 ! None
736 !
737 ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
738 
739  IMPLICIT NONE
740 
741  !* ---------------------------- Local declarations --------------------
742 
743  CHARACTER*5000 clline, clline_aux, clvari
744  CHARACTER*3 clind
745  CHARACTER*2 cldeb
746  CHARACTER*1 clequa
747  CHARACTER*8 clwork
748  CHARACTER*8 clstrg
749  CHARACTER*7 cl_bsend
750 
751  CHARACTER(len=32), DIMENSION(:), ALLOCATABLE :: cl_aux
752  CHARACTER(len=32) :: keyword
753  INTEGER (kind=ip_intwp_p) il_varid, il_len, il_err, il_maxanal
754  INTEGER (kind=ip_intwp_p) nlonbf_notnc, nlatbf_notnc, &
755  nlonaf_notnc, nlataf_notnc
756  INTEGER (kind=ip_intwp_p) iind, il_redu, ib, il_aux, il_auxbf, &
757  il_auxaf, istatus, il_id
758  INTEGER (kind=ip_intwp_p) :: ja,jz,jm,jf,ILEN,n,ios
759  INTEGER (kind=ip_intwp_p) :: ig_clim_maxport
760  LOGICAL :: lg_bsend,endflag
761  LOGICAL :: found, readfile
762  CHARACTER(len=*),parameter :: subname='(mod_oasis_namcouple:inipar_alloc)'
763 
764  !* ---------------------------- Poema verses --------------------------
765 
766  ! CALL oasis_debug_enter(subname)
767 
768  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
769 
770  !* 1. Get basic info for the simulation
771  ! ---------------------------------
772 
773  IF (mpi_rank_global == 0) THEN
774  WRITE(nulprt1,*)' '
775  WRITE(nulprt1,*) subname
776  WRITE(nulprt1,*)' ROUTINE inipar_alloc - Level 0'
777  WRITE(nulprt1,*)' ******************** *******'
778  WRITE(nulprt1,*)' '
779  WRITE(nulprt1,*)' Initialization of run parameters'
780  WRITE(nulprt1,*)' '
781  WRITE(nulprt1,*)' Reading input file namcouple'
782  WRITE(nulprt1,*)' '
783  WRITE(nulprt1,*)' '
784  CALL oasis_flush(nulprt1)
785  ENDIF
786 
787  !* Initialization
788  ig_direct_nfield = 0
789  ig_nfield = 0
790  lg_oasis_field = .true.
791 
792  !* Check for typos in keywords, read all lines until file is at end
793 
794  IF (mpi_rank_global == 0) THEN
795  WRITE(nulprt1,*) ' Executing valid keyword check '
796  CALL oasis_flush(nulprt1)
797  ENDIF
798  readfile = .true.
799  DO WHILE (readfile)
800  READ(nulin, fmt=rform, end=501) clline
801  CALL skip(clline, jpeighty, ios=ios)
802  IF (ios == 0) THEN
803  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
804  IF (clvari(1:1) == "$") THEN
805  found = .false.
806  DO n = 1, nkeywords
807  IF (clvari == keyword_list(n)) found = .true.
808  ENDDO
809  IF (.NOT. found) THEN
810  IF (mpi_rank_global == 0) THEN
811  WRITE(nulprt1,*) ' Found invalid keyword = '//trim(clvari)
812  CALL oasis_flush(nulprt1)
813  ENDIF
814  CALL namcouple_abort(subname,__line__,' ERROR: invalid keyword = '//trim(clvari))
815  ELSE
816  IF (mpi_rank_global == 0) THEN
817  WRITE(nulprt1,*) ' Found valid keyword = '//trim(clvari)
818  CALL oasis_flush(nulprt1)
819  ENDIF
820  ENDIF
821  ENDIF
822  ELSE
823  GOTO 501
824  ENDIF
825  ENDDO
826 501 CONTINUE
827 
828  if (mpi_rank_global == 0) WRITE(nulprt1,*) ' '
829 
830  !* Get number of models involved in this simulation
831 
832  keyword = clmod
833  CALL findkeyword (keyword, clline, found)
834  IF (found .and. mpi_rank_global == 0) THEN
835  WRITE(nulprt1,*) ' ***WARNING*** '//trim(keyword)//' is obsolete in OASIS3-MCT'
836  CALL oasis_flush(nulprt1)
837  ENDIF
838 
839  keyword = clchan
840  CALL findkeyword (keyword, clline, found)
841  IF (found .and. mpi_rank_global == 0) THEN
842  WRITE(nulprt1,*) ' ***WARNING*** '//trim(keyword)//' is obsolete in OASIS3-MCT'
843  CALL oasis_flush(nulprt1)
844  ENDIF
845 
846  !* 2. Get field information
847  ! --------------------
848 
849  !* Read total number of fields exchanged by this OASIS process
850 
851  keyword = clfield
852  CALL findkeyword (keyword, clline, found)
853  IF (found) THEN
854  READ(nulin, fmt=rform) clline
855  CALL skip(clline, jpeighty, ios=ios)
856  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
857  IF (ilen > 0) THEN
858  READ(clvari, fmt=2003) ig_total_nfield
859  ELSE
860  IF (mpi_rank_global == 0) THEN
861  WRITE(nulprt1,*) ' ***WARNING*** Nothing on input for '//trim(keyword)
862  WRITE(nulprt1,*) ' Default value will be used '
863  WRITE(nulprt1,*) ' '
864  CALL oasis_flush(nulprt1)
865  ENDIF
866  ENDIF
867  ELSE
868  WRITE(tmpstr1,*) trim(keyword)//' not found in namcouple'
869  CALL namcouple_abort(subname,__line__,tmpstr1)
870  ENDIF
871 
872  !* Print out the total number of fields exchanged by this OASIS process
873 
874  CALL prtout('The maximum number of exchanged fields set in namcouple is nfield =',ig_total_nfield, 1)
875 
876  !* Alloc field number array
877 
878  ALLOCATE (ig_number_field(ig_total_nfield),stat=il_err)
879  IF (il_err.NE.0) CALL prtout('Error: ig_number_field allocation of '//trim(subname),il_err,1)
880  ig_number_field(:)=0
881 
882  !* Alloc field status array (LOGICAL indicating if the field goes through
883  !* Oasis or not)
884 
885  ALLOCATE (lg_state(ig_total_nfield), stat=il_err)
886  IF (il_err.NE.0) CALL prtout('Error: lg_state allocation of '//trim(subname),il_err,1)
887  lg_state(:)=.false.
888 
889  !* Alloc status of all the fields
890 
891  ALLOCATE (ig_total_state(ig_total_nfield), stat=il_err)
892  IF (il_err.NE.0) CALL prtout('Error: ig_total_state allocation of '//trim(subname),il_err,1)
893  ig_total_state(:)=0
894 
895  !* Alloc input field name array
896 
897  ALLOCATE (cg_output_field(ig_total_nfield), stat=il_err)
898  IF (il_err.NE.0) CALL prtout('Error: cg_output_field allocation of '//trim(subname),il_err,1)
899  cg_output_field(:)=' '
900 
901  !* Alloc number of analyses array
902 
903  ALLOCATE (ig_total_ntrans(ig_total_nfield),stat=il_err)
904  IF (il_err.NE.0) CALL prtout('Error: ig_total_ntrans"allocation of '//trim(subname),il_err,1)
905  ig_total_ntrans(:) = 0
906 
907  !* Alloc array of restart file names, input and output file names
908 
909  ALLOCATE (cg_restart_file(ig_total_nfield),stat=il_err)
910  IF (il_err.NE.0) CALL prtout('Error: cg_restart_FILE allocation of '//trim(subname),il_err,1)
911  cg_restart_file(:)=' '
912  ALLOCATE (cg_input_file(ig_total_nfield), stat=il_err)
913  IF (il_err.NE.0) CALL prtout('Error in "cg_input_file"allocation of '//trim(subname),il_err,1)
914  cg_input_file(:)=' '
915 
916  !* Alloc array of source and target locator prefix
917 
918  ALLOCATE (cga_locatorbf(ig_total_nfield),stat=il_err)
919  IF (il_err.NE.0) CALL prtout('Error: cga_locatorbf allocation of '//trim(subname),il_err,1)
920  cga_locatorbf(:)=' '
921 
922  ALLOCATE (cga_locatoraf(ig_total_nfield),stat=il_err)
923  IF (il_err.NE.0) CALL prtout('Error: cga_locatoraf allocation of '//trim(subname),il_err,1)
924  cga_locatoraf(:)=' '
925 
926  !* Get information for all fields
927 
928  keyword = clstring
929  CALL findkeyword (keyword, clline, found)
930  IF (.not.found) THEN
931  WRITE(tmpstr1,*) trim(keyword)//' not found in namcouple'
932  CALL namcouple_abort(subname,__line__,tmpstr1)
933  ENDIF
934 
935  !* Loop on total number of fields
936 
937  ig_final_nfield = 0
938  endflag = .false.
939  jf = 0
940 
941  DO WHILE (.not. endflag .and. jf < ig_total_nfield)
942  jf = jf + 1
943 
944  !* First line
945 
946  READ(nulin, fmt=rform, end=241) clline
947  IF (mpi_rank_global == 0) THEN
948  WRITE(nulprt1,*) subname,'1 Read line: ',trim(clline)
949  CALL oasis_flush(nulprt1)
950  ENDIF
951  CALL skip(clline, jpeighty, ios=ios)
952  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
953  IF (trim(clvari) .eq. "$END") endflag = .true.
954 
955  IF (trim(clvari) .EQ. " ") THEN
956  WRITE(tmpstr1,*) ' size clline smaller than the size of the names of the fields on the line'
957  WRITE(tmpstr2,*) ' increase jpeighty and change the associated format A(jpeighty) and cline'
958  CALL namcouple_abort(subname,__line__,tmpstr1,tmpstr2)
959  ENDIF
960 
961  IF (.not. endflag) THEN
962 
963  !* Get output field symbolic name
964  CALL parse(clline, clvari, 2, jpeighty, ilen, __line__)
965  cg_output_field(jf) = clvari
966 
967  !* Get total number of analysis
968  CALL parse(clline, clvari, 5, jpeighty, ilen, __line__)
969  IF (mpi_rank_global == 0) THEN
970  WRITE(nulprt1,*) subname,'parsing 1 Read line, clvari in 5 position: ',trim(clline),trim(clvari)
971  CALL oasis_flush(nulprt1)
972  ENDIF
973  READ(clvari,fmt=2003) ig_total_ntrans(jf)
974 
975  !* Get field STATUS for OUTPUT fields
976  CALL parse(clline, clvari, 6, jpeighty, ilen, __line__)
977  IF (clvari(1:6) .EQ. 'OUTPUT') THEN
979  lg_state(jf) = .false.
981  ELSE
982  !* Get field status (direct or through oasis) and the number
983  !* of direct and indirect fields if not PIPE nor NONE
984  CALL parse(clline, clvari, 7, jpeighty, ilen, __line__)
985  IF (clvari(1:8).eq.'EXPORTED') THEN
986  ig_nfield = ig_nfield + 1
987  lg_state(jf) = .true.
990  CALL parse(clline, clvari, 6, jpeighty, ilen, __line__)
991  !* Get restart file name
992  cg_restart_file(jf) = clvari
993  !* Get restart file name
994  ELSEIF (clvari(1:6) .eq. 'OUTPUT' ) THEN
996  lg_state(jf) = .false.
998  CALL parse(clline, clvari, 6, jpeighty, ilen, __line__)
999  cg_restart_file(jf) = clvari
1000  ELSEIF (clvari(1:7) .eq. 'IGNORED' ) THEN
1002  lg_state(jf) = .false.
1004  CALL parse(clline, clvari, 6, jpeighty, ilen, __line__)
1005  !* Get restart file name
1006  cg_restart_file(jf) = clvari
1007  ELSEIF (clvari(1:6) .eq. 'EXPOUT') THEN
1008  ig_nfield = ig_nfield + 1
1009  lg_state(jf) = .true.
1012  CALL parse(clline, clvari, 6, jpeighty, ilen, __line__)
1013  !* Get restart file name
1014  cg_restart_file(jf) = clvari
1015  ELSEIF (clvari(1:6) .eq. 'IGNOUT' ) THEN
1017  lg_state(jf) = .false.
1019  CALL parse(clline, clvari, 6, jpeighty, ilen, __line__)
1020  !* Get restart file name
1021  cg_restart_file(jf) = clvari
1022  ELSEIF (clvari(1:9).eq. 'AUXILARY') THEN
1023  ig_nfield = ig_nfield + 1
1024  lg_state(jf) = .true.
1027  CALL parse(clline, clvari, 6, jpeighty, ilen, __line__)
1028  !* Get restart file name
1029  cg_restart_file(jf) = clvari
1030  ELSEIF (clvari(1:5) .eq. 'INPUT') THEN
1032  lg_state(jf) = .false.
1033  ig_total_state(jf) = ip_input
1034  CALL parse(clline, clvari, 6, jpeighty, ilen, __line__)
1035  !* Get input file name
1036  cg_input_file(jf) = clvari
1037  ENDIF
1038  ENDIF
1039 
1040  if (mpi_rank_global == 0) then
1041  WRITE(nulprt1,*) subname,'field jf : ',jf,' lg_state(jf) : ',lg_state(jf)
1042  WRITE(nulprt1,*) subname,'field jf : ',jf,' endflag : ',endflag
1043  endif
1044 
1045  IF (lg_state(jf)) THEN
1046 ! IF (ig_total_ntrans(jf) .eq. 0) THEN
1047  ! WRITE(tmpstr1,*) 'If there is no analysis for the field',jf, &
1048  ! 'THEN the status must not be EXPORTED, AUXILIARY, or EXPOUT'
1049  ! CALL namcouple_abort(subname,__LINE__,tmpstr1)
1050  ! ENDIF
1051 
1052  READ(nulin, fmt=rform) clline
1053  IF (mpi_rank_global == 0) THEN
1054  WRITE(nulprt1,*) subname,'2 Read line: ',trim(clline)
1055  CALL oasis_flush(nulprt1)
1056  ENDIF
1057  CALL skip(clline, jpeighty, ios=ios)
1058  READ(nulin, fmt=rform) clline
1059  IF (mpi_rank_global == 0) THEN
1060  WRITE(nulprt1,*) subname,'3 Read line: ',trim(clline)
1061  CALL oasis_flush(nulprt1)
1062  ENDIF
1063  CALL skip(clline, jpeighty, ios=ios)
1064 ! MODIF LC quand il n'y a pas de transformations
1065  IF (ig_total_ntrans(jf) .GT. 0) THEN
1066  READ(nulin, fmt=rform) clline_aux
1067  IF (mpi_rank_global == 0) THEN
1068  WRITE(nulprt1,*) subname,'4 Read line_aux: ',trim(clline_aux)
1069  CALL oasis_flush(nulprt1)
1070  ENDIF
1071  CALL skip(clline_aux, jpeighty, ios=ios)
1072  DO ja=1,ig_total_ntrans(jf)
1073  CALL parse(clline_aux, clvari, ja, jpeighty, ilen, __line__)
1074  IF (clvari.eq.'CORRECT'.or.clvari.eq.'BLASOLD'.or. &
1075  clvari.eq.'BLASNEW') THEN
1076  READ(nulin, fmt=rform) clline
1077  CALL skip(clline, jpeighty, ios=ios)
1078  CALL parse(clline, clvari, 2, jpeighty, ilen, __line__)
1079  READ(clvari, fmt=2003) il_aux
1080  DO ib = 1, il_aux
1081  READ(nulin, fmt=rform) clline
1082  CALL skip(clline, jpeighty, ios=ios)
1083  ENDDO
1084  ELSEIF (clvari.eq.'NOINTERP') THEN
1085  CONTINUE
1086  ELSE
1087  READ(nulin, fmt=rform) clline
1088  IF (mpi_rank_global == 0) THEN
1089  WRITE(nulprt1,*) subname,'5 Read line: ',trim(clline)
1090  CALL oasis_flush(nulprt1)
1091  ENDIF
1092  CALL skip(clline, jpeighty, ios=ios)
1093  ENDIF
1094  ENDDO
1095 ! MODIF LC
1096  ENDIF
1097  ELSE
1098  IF (ig_total_state(jf) .ne. ip_input) THEN
1099  READ(nulin, fmt=rform) clline
1100  IF (mpi_rank_global == 0) THEN
1101  WRITE(nulprt1,*) subname,'6 Read line : ',trim(clline)
1102  CALL oasis_flush(nulprt1)
1103  ENDIF
1104  CALL skip(clline, jpeighty, ios=ios)
1105  ENDIF
1106  IF (ig_total_state(jf) .ne. ip_input .and. &
1107  ig_total_ntrans(jf) .gt. 0 ) THEN
1108  READ(nulin, fmt=rform) clline
1109  IF (mpi_rank_global == 0) THEN
1110  WRITE(nulprt1,*) subname,'7 Read line: ',trim(clline)
1111  CALL oasis_flush(nulprt1)
1112  ENDIF
1113  CALL skip(clline, jpeighty, ios=ios)
1114  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
1115  IF (clvari(1:8) .ne. 'LOCTRANS') THEN
1116  WRITE(tmpstr1,*) 'You want a transformation which is not available !'
1117  WRITE(tmpstr2,*) 'Only local transformations are available for '
1118  WRITE(tmpstr3,*) 'fields exchanged directly or output fields '
1119  CALL namcouple_abort(subname,__line__,tmpstr1,tmpstr2,tmpstr3)
1120  ENDIF
1121  DO ja=1,ig_total_ntrans(jf)
1122  READ(nulin, fmt=rform) clline
1123  IF (mpi_rank_global == 0) THEN
1124  WRITE(nulprt1,*) subname,'8 Read line: ',trim(clline)
1125  CALL oasis_flush(nulprt1)
1126  ENDIF
1127  CALL skip(clline, jpeighty, ios=ios)
1128  ENDDO
1129  ENDIF
1130  ENDIF
1131 
1133 
1134  ENDIF ! endflag
1135 
1136  ENDDO ! DO jf
1137 
1138  !* Verify we're at the end of the namcouple, if not STOP (tcraig, june 2012)
1139  !* The only thing that should be found is a $END, anything ELSE is wrong
1140 
1141  ios=0
1142  DO WHILE (ios .eq. 0)
1143  READ(nulin, fmt=rform, end=241) clline
1144  CALL skip(clline, jpeighty,ios=ios)
1145  IF (ios .EQ. 0) THEN
1146  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
1147  IF (trim(clvari) /= "$END") THEN
1148  WRITE(tmpstr1,*) ' NFIELDS too small, increase it in namcouple'
1149  WRITE(nulprt1,*) ' NFIELDS too small, increase it in namcouple'
1150  CALL oasis_flush(nulprt1)
1151  CALL namcouple_abort(subname,__line__,tmpstr1)
1152  ENDIF
1153  ELSE
1154  GOTO 241
1155  ENDIF
1156  ENDDO
1157 
1158 241 CONTINUE
1159  IF (mpi_rank_global == 0) THEN
1160  WRITE(nulprt1,'(a,i6)') ' found namcouple couplings = ',ig_final_nfield
1161  ENDIF
1162 
1163  IF (ig_nfield.eq.0) THEN
1164  lg_oasis_field = .false.
1165  IF (mpi_rank_global == 0) THEN
1166  WRITE(nulprt1,*)'==> No fields are exchanged via the coupler'
1167  CALL oasis_flush(nulprt1)
1168  ENDIF
1169  ENDIF
1170 
1171  !* Number of different restart files
1172 
1173  allocate (cl_aux(ig_final_nfield))
1174  cl_aux(:)=' '
1175  DO jf = 1,ig_final_nfield
1176  IF (jf.eq.1) THEN
1177  cl_aux(1) = cg_restart_file(1)
1178  il_aux = 1
1179  ELSEIF (jf.gt.1) THEN
1180  IF (all(cl_aux.ne.cg_restart_file(jf))) THEN
1181  il_aux = il_aux + 1
1182  cl_aux(il_aux) = cg_restart_file(jf)
1183  ENDIF
1184  ENDIF
1185  ENDDO
1186  deallocate(cl_aux)
1187  ig_nbr_rstfile = il_aux
1188 
1189  IF (lg_oasis_field) THEN
1190 
1191  !* Alloc array needed for INTERP and initialize them
1192 
1193  ALLOCATE (cintmet(ig_nfield),stat=il_err)
1194  IF (il_err.NE.0) CALL prtout('Error: cintmet allocation of '//trim(subname),il_err,1)
1195  ALLOCATE (naismfl(ig_nfield),stat=il_err)
1196  IF (il_err.NE.0) CALL prtout('Error: naismfl allocation of '//trim(subname),il_err,1)
1197  ALLOCATE (naismvoi(ig_nfield),stat=il_err)
1198  IF (il_err.NE.0) CALL prtout('Error: naismvoi allocation of '//trim(subname),il_err,1)
1199  ALLOCATE (naisgfl(ig_nfield),stat=il_err)
1200  IF (il_err.NE.0) CALL prtout('Error: naisgfl allocation of '//trim(subname),il_err,1)
1201  ALLOCATE (naisgvoi(ig_nfield),stat=il_err)
1202  IF (il_err.NE.0) CALL prtout('Error: naisgvoi allocation of '//trim(subname),il_err,1)
1203  cintmet(:)=' '
1204  naismfl(:) = 1
1205  naismvoi(:) = 1
1206  naisgfl(:) = 1
1207  naisgvoi(:) = 1
1208 
1209  !* Alloc arrays needed for EXTRAP and initialize them
1210 
1211  ALLOCATE (cextmet(ig_nfield),stat=il_err)
1212  IF (il_err.NE.0) CALL prtout('Error: cextmet allocation of '//trim(subname),il_err,1)
1213  ALLOCATE (nninnfl(ig_nfield),stat=il_err)
1214  IF (il_err.NE.0) CALL prtout('Error: nninnfl allocation of '//trim(subname),il_err,1)
1215  ALLOCATE (nninnflg(ig_nfield),stat=il_err)
1216  IF (il_err.NE.0) CALL prtout('Error: nninnflg allocation of '//trim(subname),il_err,1)
1217  ALLOCATE (neighbor(ig_nfield), stat=il_err)
1218  IF (il_err.NE.0) CALL prtout('Error: neighbor allocation of '//trim(subname),il_err,1)
1219  ALLOCATE (nextfl(ig_nfield),stat=il_err)
1220  IF (il_err.NE.0) CALL prtout('Error: nextfl allocation of '//trim(subname),il_err,1)
1221  cextmet(:)=' '
1222  nninnfl(:) = 1
1223  nninnflg(:) = 1
1224  neighbor(:) = 1
1225  nextfl(:) = 1
1226 
1227  !* Alloc arrays needed for BLAS... analyses and initialize them
1228 
1229  ALLOCATE (nbofld(ig_nfield), stat=il_err)
1230  IF (il_err.NE.0) CALL prtout('Error: nbofld allocation of '//trim(subname),il_err,1)
1231  ALLOCATE (nbnfld(ig_nfield), stat=il_err)
1232  IF (il_err.NE.0) CALL prtout('Error: nbnfld allocation of '//trim(subname),il_err,1)
1233  nbofld(:) = 1
1234  nbnfld(:) = 1
1235 
1236  !* Alloc arrays needed for MOZAIC and initialize them
1237 
1238  ALLOCATE (nmapvoi(ig_nfield),stat=il_err)
1239  IF (il_err.NE.0) CALL prtout('Error: nmapvoi allocation of '//trim(subname),il_err,1)
1240  ALLOCATE (nmapfl(ig_nfield),stat=il_err)
1241  IF (il_err.NE.0) CALL prtout('Error: nmapfl allocation of '//trim(subname),il_err,1)
1242  nmapvoi(:) = 1
1243  nmapfl(:) = 1
1244 
1245  !* Alloc arrays needed for SUBGRID and initialize them
1246 
1247  ALLOCATE (nsubfl(ig_nfield),stat=il_err)
1248  IF (il_err.NE.0) CALL prtout('Error: nsubfl allocation of '//trim(subname),il_err,1)
1249  ALLOCATE (nsubvoi(ig_nfield),stat=il_err)
1250  IF (il_err.NE.0) CALL prtout('Error: nsubvoi allocation of '//trim(subname),il_err,1)
1251  nsubfl(:) = 1
1252  nsubvoi(:) = 1
1253 
1254  !* Alloc arrays needed for GLORED and REDGLO and initialize them
1255 
1256  ALLOCATE (ntronca(ig_nfield), stat=il_err)
1257  IF (il_err.NE.0) CALL prtout('Error: ntronca allocation of '//trim(subname),il_err,1)
1258  ntronca(:) = 0
1259 
1260  !* Alloc array needed for analyses parameters
1261 
1262  ALLOCATE (cficbf(ig_nfield),stat=il_err)
1263  IF (il_err.NE.0) CALL prtout('Error: cficbf allocation of '//trim(subname),il_err,1)
1264  cficbf(:)=' '
1265  ALLOCATE (cficaf(ig_nfield),stat=il_err)
1266  IF (il_err.NE.0) CALL prtout('Error: cficaf allocation of '//trim(subname),il_err,1)
1267  cficaf(:)=' '
1268 
1269  !* Alloc arrays needed for grid dimensions of direct fields and
1270  !* indirect fields
1271 
1272  ALLOCATE (nlonbf(ig_nfield),stat=il_err)
1273  IF (il_err.NE.0) CALL prtout('Error: nlonbf allocation of '//trim(subname),il_err,1)
1274  nlonbf(:)=0
1275  ALLOCATE (nlatbf(ig_nfield),stat=il_err)
1276  IF (il_err.NE.0) CALL prtout('Error: nlatbf allocation of '//trim(subname),il_err,1)
1277  nlatbf(:)=0
1278  ALLOCATE (nlonaf(ig_nfield),stat=il_err)
1279  IF (il_err.NE.0) CALL prtout('Error: nlonaf allocation of '//trim(subname),il_err,1)
1280  nlonaf(:)=0
1281  ALLOCATE (nlataf(ig_nfield),stat=il_err)
1282  IF (il_err.NE.0) CALL prtout('Error: nlataf allocation of '//trim(subname),il_err,1)
1283  nlataf(:)=0
1284 
1285  !* Alloc arrays needed for grid number associated to each field
1286 
1287  ALLOCATE (ig_grid_nbrbf(ig_nfield),stat=il_err)
1288  IF (il_err.NE.0) CALL prtout('Error: ig_grid_nbrbf allocation of '//trim(subname),il_err,1)
1289  ig_grid_nbrbf(:)=0
1290  ALLOCATE (ig_grid_nbraf(ig_nfield),stat=il_err)
1291  IF (il_err.NE.0) CALL prtout('Error: ig_grid_nbraf allocation of '//trim(subname),il_err,1)
1292  ig_grid_nbraf(:)=0
1293 
1294  !* Alloc number of analyses array
1295 
1296  ALLOCATE (ig_ntrans(ig_nfield),stat=il_err)
1297  IF (il_err.NE.0) CALL prtout('Error: ig_ntrans allocation of '//trim(subname),il_err,1)
1298  ig_ntrans(:)=0
1299  DO ib = 1, ig_final_nfield
1301  ENDDO
1302 
1303  !* Maximum number of analyses
1304 
1305  il_maxanal = maxval(ig_ntrans)
1306 
1307  !* Alloc array of restart file names
1308 
1309  ALLOCATE (cficinp(ig_nfield), stat=il_err)
1310  IF (il_err.NE.0) CALL prtout('Error: cficinp allocation of '//trim(subname),il_err,1)
1311  cficinp(:)=' '
1312  DO ib = 1, ig_final_nfield
1314  ENDDO
1315 #ifdef use_netCDF
1316  !tcx?
1317  ! istatus=NF_OPEN(cg_restart_file(1), NF_NOWRITE, il_id)
1318  ! IF (istatus .eq. NF_NOERR) THEN
1319  ! lncdfrst = .true.
1320  ! ELSE
1321 #endif
1322  lncdfrst = .false.
1323 #ifdef use_netCDF
1324  ! ENDIF
1325  ! istatus=NF_CLOSE(il_id)
1326 #endif
1327  IF (mpi_rank_global == 0) THEN
1328  WRITE(nulprt1, *) 'lncdfrst =', lncdfrst
1329  CALL oasis_flush(nulprt1)
1330  ENDIF
1331 
1332  !* Alloc array needed to get analysis names
1333 
1334  ALLOCATE (canal(il_maxanal,ig_nfield),stat=il_err)
1335  IF (il_err.NE.0) CALL prtout('Error: canal allocation of '//trim(subname),il_err,1)
1336  canal(:,:)=' '
1337  ENDIF
1338 
1339  !* Get analysis parameters
1340 
1341  keyword = clstring
1342  CALL findkeyword (keyword, clline, found)
1343  IF (.not.found) THEN
1344  WRITE(tmpstr1,*) trim(keyword)//' not found'
1345  CALL namcouple_abort(subname,__line__,tmpstr1)
1346  ENDIF
1347 
1348  !* Loop on total number of fields (NoF)
1349 
1350  DO jf=1,ig_final_nfield
1351 
1352  !* Initialization
1353 
1354  nlonbf_notnc = 0
1355  nlatbf_notnc = 0
1356  nlonaf_notnc = 0
1357  nlataf_notnc = 0
1358 
1359  !* Skip first line read before
1360 
1361  READ(nulin, fmt=rform) clline
1362  CALL skip(clline, jpeighty, ios=ios)
1363 
1364  !* Second line
1365 
1366  !* In the indirect case, reading of second, third, fourth line and analyses
1367  !* lines
1368 
1369  IF (ig_total_state(jf) .NE. ip_input) THEN
1370  READ(nulin, fmt=rform) clline
1371  !* First determine what information is on the line
1372  CALL skip(clline, jpeighty, ios=ios)
1373  CALL parse(clline, clvari, 3, jpeighty, ilen, __line__)
1374  IF (ilen .LT. 0) THEN
1375  !* IF only two words on the line, THEN they are the locator
1376  !* prefixes and the grids file must be in NetCDF format
1377  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
1378  IF (lg_state(jf)) cficbf(ig_number_field(jf)) = clvari
1379  cga_locatorbf(jf) = clvari(1:4)
1380  CALL parse(clline, clvari, 2, jpeighty, ilen, __line__)
1381  IF (lg_state(jf)) cficaf(ig_number_field(jf)) = clvari
1382  cga_locatoraf(jf) = clvari(1:4)
1383  lncdfgrd = .true.
1384  ELSE
1385  READ(clvari, fmt=2010) clind, clequa, iind
1386  IF (clind .EQ. 'SEQ' .OR. clind .EQ. 'LAG' .AND. clequa .EQ. '=') THEN
1387  !* If 3rd word is an index, THEN first two words are
1388  !* locator prefixes and grids file must be NetCDF format
1389  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
1390  IF (lg_state(jf)) cficbf(ig_number_field(jf)) = clvari
1391  cga_locatorbf(jf) = clvari(1:4)
1392  CALL parse(clline, clvari, 2, jpeighty, ilen, __line__)
1393  IF (lg_state(jf)) cficaf(ig_number_field(jf)) = clvari
1394  cga_locatoraf(jf) = clvari(1:4)
1395  lncdfgrd = .true.
1396  ELSE
1397  !* If not, the first 4 words are grid dimensions and next
1398  !* 2 words are locator prefixes, and grids file may be or
1399  !* not in NetCDF format
1400  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
1401  !* Get number of longitudes for initial field
1402  IF (mpi_rank_global == 0) THEN
1403  WRITE(nulprt1,*)'CLVARI=',trim(clvari)
1404  CALL oasis_flush(nulprt1)
1405  ENDIF
1406  READ(clvari, fmt=2004) nlonbf_notnc
1407  CALL parse(clline, clvari, 2, jpeighty, ilen, __line__)
1408  !* Get number of latitudes for initial field
1409  READ(clvari, fmt=2004) nlatbf_notnc
1410  CALL parse(clline, clvari, 3, jpeighty, ilen, __line__)
1411  !* Get number of longitudes for final field
1412  READ(clvari, fmt=2004) nlonaf_notnc
1413  CALL parse(clline, clvari, 4, jpeighty, ilen, __line__)
1414  !* Get number of latitudes for final field
1415  READ(clvari, fmt=2004) nlataf_notnc
1416  CALL parse(clline, clvari, 5, jpeighty, ilen, __line__)
1417  !* Get root name grid-related files (initial field)
1418  IF (lg_state(jf)) cficbf(ig_number_field(jf)) = clvari
1419  cga_locatorbf(jf) = clvari(1:4)
1420  CALL parse(clline, clvari, 6, jpeighty, ilen, __line__)
1421  !* Get root name for grid-related files (final field)
1422  IF (lg_state(jf)) cficaf(ig_number_field(jf)) = clvari
1423  cga_locatoraf(jf) = clvari(1:4)
1424  nlonbf(ig_number_field(jf)) = nlonbf_notnc
1425  nlatbf(ig_number_field(jf)) = nlatbf_notnc
1426  nlonaf(ig_number_field(jf)) = nlonaf_notnc
1427  nlataf(ig_number_field(jf)) = nlataf_notnc
1428 
1429  ENDIF
1430  ENDIF
1431 
1432  !* Read the P 2 P 0 line for exported, expout or auxilary
1433 
1434  IF (lg_state(jf)) THEN
1435  READ(nulin, fmt=rform) clline
1436  CALL skip(clline, jpeighty, ios=ios)
1437  ENDIF
1438 
1439  !* Read next line of strings
1440  ! --->>> Stuff related to field transformation
1441 
1442  IF (ig_total_ntrans(jf) .GT. 0) THEN
1443  READ(nulin, fmt=rform) clline
1444  CALL skip(clline, jpeighty, ios=ios)
1445  DO ja = 1, ig_total_ntrans(jf)
1446  CALL parse(clline, clvari, ja, jpeighty, ilen, __line__)
1447  !* Get the whole set of analysis to be performed
1448  IF (lg_state(jf)) canal(ja,ig_number_field(jf)) = clvari
1449  ENDDO
1450 
1451  DO ja = 1, ig_total_ntrans(jf)
1452  IF (lg_state(jf)) THEN
1453  cg_c=canal(ja,ig_number_field(jf))
1454  IF (mpi_rank_global == 0) THEN
1455  WRITE(nulprt1,*)'LG_STATE cg_c=', trim(clline)
1456  CALL oasis_flush(nulprt1)
1457  ENDIF
1458  IF (cg_c .EQ. 'NOINTERP' .OR. cg_c .EQ. 'REDGLO' .OR. cg_c .EQ. 'INVERT' .OR. &
1459  cg_c .EQ. 'MASK' .OR. cg_c .EQ. 'EXTRAP' .OR. cg_c .EQ. 'CORRECT' .OR. &
1460  cg_c .EQ. 'REDGLO' .OR. cg_c .EQ. 'INTERP' .OR. cg_c .EQ. 'MOZAIC' .OR. &
1461  cg_c .EQ. 'FILLING' .OR. cg_c .EQ. 'MASKP' .OR. cg_c .EQ. 'REVERSE' .OR. &
1462  cg_c .EQ. 'GLORED') THEN
1463  WRITE(tmpstr1,*)' OBSOLETE OPERATION= ',trim(cg_c),' specified in namcouple'
1464  CALL namcouple_abort(subname,__line__,tmpstr1)
1465  ENDIF
1466  READ(nulin, fmt=rform) clline
1467  CALL skip(clline, jpeighty, ios=ios)
1468  IF (canal(ja,ig_number_field(jf)) .EQ. 'SCRIPR')THEN
1469  !* Get field type (scalar/vector)
1470  CALL parse(clline, clvari, 3, jpeighty, ilen, __line__)
1471  READ(clvari, fmt=2009) clstrg
1472  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'BLASOLD') THEN
1473  CALL parse(clline, clvari, 2, jpeighty, ilen, __line__)
1474  !* Get number of additional fields in linear formula
1475  READ(clvari, fmt=2003) nbofld(ig_number_field(jf))
1476  DO ib = 1,nbofld(ig_number_field(jf))
1477  READ(nulin, fmt=rform) clline
1478  CALL skip(clline, jpeighty, ios=ios)
1479  ENDDO
1480  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'BLASNEW') THEN
1481  CALL parse(clline, clvari, 2, jpeighty, ilen, __line__)
1482  !* Get number of additional fields in linear formula
1483  READ(clvari, fmt=2003) nbnfld(ig_number_field(jf))
1484  DO ib = 1,nbnfld(ig_number_field(jf))
1485  READ(nulin, fmt=rform) clline
1486  CALL skip(clline, jpeighty, ios=ios)
1487  ENDDO
1488  ENDIF
1489  ELSE
1490  ! For IGNORED, IGNOUT and OUTPUT, only one line for LOCTRANS
1491  READ(nulin, fmt=rform) clline
1492  CALL skip(clline, jpeighty, ios=ios)
1493  IF (mpi_rank_global == 0) THEN
1494  WRITE(nulprt1,*)'OUTPUT clline=', trim(clline)
1495  CALL oasis_flush(nulprt1)
1496  ENDIF
1497  ENDIF
1498  ENDDO ! DO ja
1499  ENDIF ! IF (ig_total_ntrans(jf) .GT. 0) THEN
1500  ENDIF !IF (ig_total_state(jf) .NE. ip_input) THEN
1501  ENDDO ! DO jf
1502 
1503  IF (lg_oasis_field) THEN
1504 
1505  !* Search maximum number of fields to be combined in the BLASxxx analyses
1506 
1507  ig_maxcomb = maxval(nbofld)
1508  IF (maxval(nbnfld).GT.ig_maxcomb) ig_maxcomb = maxval(nbnfld)
1509 
1510  !* Search maximum number of neighbors for GAUSSIAN interpolation
1511 
1512  ig_maxnoa = maxval(naisgvoi)
1513  IF (mpi_rank_global == 0) THEN
1514  WRITE(nulprt1,*) 'Max number of neighbors for GAUSSIAN interp : ',ig_maxnoa
1515  WRITE(nulprt1,*)' '
1516  CALL oasis_flush(nulprt1)
1517  ENDIF
1518 
1519  !* Search maximum number of different GAUSSIAN interpolations
1520 
1521  ig_maxnfg = maxval(naisgfl)
1522  IF (mpi_rank_global == 0) THEN
1523  WRITE(nulprt1,*) 'Maximum number of different GAUSSIAN interpolations : ',ig_maxnfg
1524  WRITE(nulprt1,*)' '
1525  CALL oasis_flush(nulprt1)
1526  ENDIF
1527 
1528  ENDIF
1529 
1530  !* Formats
1531 
1532 2001 FORMAT(a9)
1533 2003 FORMAT(i4)
1534 2004 FORMAT(i8)
1535 2009 FORMAT(a8)
1536 2010 FORMAT(a3,a1,i2)
1537 
1538  !* 3. End of routine
1539  ! --------------
1540 
1541  IF (mpi_rank_global == 0) THEN
1542  WRITE(nulprt1,*)' '
1543  WRITE(nulprt1,*) subname,'-- End of ROUTINE --'
1544  CALL oasis_flush (nulprt1)
1545  ENDIF
1546 
1547 ! CALL oasis_debug_exit(subname)
1548  RETURN
1549 
1550 END SUBROUTINE inipar_alloc
1551 
1552 !===============================================================================
1553 
1554 !> Reads, sets, and prints the namcouple file
1555 
1556 SUBROUTINE inipar
1558 !****
1559 ! *****************************
1560 ! * OASIS ROUTINE - LEVEL 0 *
1561 ! * ------------- ------- *
1562 ! *****************************
1563 
1564 !**** *inipar* - Get run parameters
1565 
1566 ! Purpose:
1567 ! -------
1568 ! Reads and prints out run parameters.
1569 
1570 !** Interface:
1571 ! ---------
1572 ! *CALL* *inipar*
1573 
1574 ! Input:
1575 ! -----
1576 ! None
1577 
1578 ! Output:
1579 ! ------
1580 ! None
1581 !
1582 ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1583 
1584  IMPLICIT NONE
1585 
1586 !* ---------------------------- Local declarations --------------------
1587 
1588  CHARACTER*5000 clline, clvari
1589  CHARACTER*9 clword
1590  CHARACTER*8 cl_print_trans, cl_print_state
1591  CHARACTER*3 clinfo, clind
1592  CHARACTER*1 clequa
1593  CHARACTER*64 cl_cfname,cl_cfunit
1594  CHARACTER(len=15) :: cvarmul,cafldcobo,cabocoef,cafldcobn,cabncoef
1595  INTEGER (kind=ip_intwp_p) iind, il_aux
1596  INTEGER (kind=ip_intwp_p) il_file_unit, id_error
1597  INTEGER (kind=ip_intwp_p) il_max_entry_id, il_no_of_entries
1598  INTEGER (kind=ip_intwp_p) il_i, il_pos
1599  LOGICAL llseq, lllag, ll_exist
1600  INTEGER lastplace
1601  INTEGER (kind=ip_intwp_p) :: ib,ilind1,ilind2,ilind
1602  INTEGER (kind=ip_intwp_p) :: ja,jf,jfn,jz,jm,ilen,idum
1603  INTEGER (kind=ip_intwp_p) :: ifca,ifcb,ilab,jff,jc
1604  INTEGER (kind=ip_intwp_p) :: icofld,imodel, ios
1605  INTEGER (kind=ip_intwp_p) :: ivarmul,iafldcobo,iabocoef,iafldcobn,iabncoef
1606  CHARACTER(len=32) :: keyword
1607  LOGICAL :: found
1608  CHARACTER(len=*),parameter :: subname='(mod_oasis_namcouple:inipar)'
1609 
1610 !* ---------------------------- Poema verses --------------------------
1611 
1612 ! CALL oasis_debug_enter(subname)
1613 
1614 ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1615 
1616 !* 1. Get basic info for the simulation
1617 ! ---------------------------------
1618 
1619  IF (mpi_rank_global == 0) THEN
1620  WRITE(nulprt1,*)' '
1621  WRITE(nulprt1,*) trim(subname)
1622  WRITE(nulprt1,*)' ROUTINE inipar - Level 0'
1623  WRITE(nulprt1,*)' ************** *******'
1624  WRITE(nulprt1,*)' '
1625  WRITE(nulprt1,*)' Initialization of run parameters'
1626  WRITE(nulprt1,*)' Reading input file namcouple'
1627  WRITE(nulprt1,*)' '
1628  CALL oasis_flush(nulprt1)
1629  ENDIF
1630 
1631 !* Initialize CHARACTER keywords to locate appropriate input
1632 
1633  !* Initialize some variables
1634  ntime = 0 ; niter = 5
1635  nstep = 86400 ; nitfn=4
1636 
1637  !* First get experiment name
1638 
1639  keyword = cljob
1640  CALL findkeyword (keyword, clline, found)
1641  IF (found .and. mpi_rank_global == 0) THEN
1642  WRITE(nulprt1,*) ' ***WARNING*** '//trim(keyword)//' is obsolete in OASIS3-MCT'
1643  ENDIF
1644 
1645  !* Get number of models involved in this simulation
1646 
1647  keyword = clmod
1648  CALL findkeyword (keyword, clline, found)
1649  IF (found .and. mpi_rank_global == 0) THEN
1650  WRITE(nulprt1,*) ' ***WARNING*** '//trim(keyword)//' is obsolete in OASIS3-MCT'
1651  ENDIF
1652 
1653  !* Get hardware info for this OASIS simulation
1654 
1655  keyword = clchan
1656  CALL findkeyword (keyword, clline, found)
1657  IF (found .and. mpi_rank_global == 0) THEN
1658  WRITE(nulprt1,*) ' ***WARNING*** '//trim(keyword)//' is obsolete in OASIS3-MCT'
1659  ENDIF
1660 
1661  !* Get total time for this simulation
1662 
1663  keyword = cltime
1664  CALL findkeyword (keyword, clline, found)
1665  IF (found) THEN
1666  READ(nulin, fmt=rform) clline
1667  CALL skip(clline, jpeighty, ios=ios)
1668  CALL parse (clline, clvari, 1, jpeighty, ilen, __line__)
1669  IF (ilen > 0) THEN
1670  READ(clvari, fmt=1004) ntime
1671  ELSE
1672  WRITE(tmpstr1,*) ' ERROR with value associated with '//trim(keyword)
1673  CALL namcouple_abort(subname,__line__,tmpstr1)
1674  ENDIF
1675  ELSE
1676  WRITE(tmpstr1,*) trim(keyword)//' not found in namcouple'
1677  CALL namcouple_abort(subname,__line__,tmpstr1)
1678  ENDIF
1679 
1680  !* Print out total time
1681 
1682  CALL prtout('The total time for this run is ntime =', ntime, 1)
1683 
1684  !* Get initial date for this simulation
1685 
1686  keyword = cldate
1687  CALL findkeyword (keyword, clline, found)
1688  IF (found .and. mpi_rank_global == 0) THEN
1689  WRITE(nulprt1,*) ' ***WARNING*** '//trim(keyword)//' is obsolete in OASIS3-MCT'
1690  ENDIF
1691 
1692  !* Get number of sequential models involved in this simulation
1693 
1694  keyword = clseq
1695  CALL findkeyword (keyword, clline, found)
1696  IF (found .and. mpi_rank_global == 0) THEN
1697  WRITE(nulprt1,*) ' ***WARNING*** '//trim(keyword)//' is obsolete in OASIS3-MCT'
1698  ENDIF
1699 
1700  !* Get the information mode for this simulation
1701 
1702  keyword = clhead
1703  CALL findkeyword (keyword, clline, found)
1704  IF (found .and. mpi_rank_global == 0) THEN
1705  WRITE(nulprt1,*) ' ***WARNING*** '//trim(keyword)//' is obsolete in OASIS3-MCT'
1706  ENDIF
1707 
1708  !* Get the printing level for this simulation
1709 
1710  nlogprt = 2
1711  ntlogprt=0
1712  keyword = clprint
1713  CALL findkeyword (keyword, clline, found)
1714  IF (found) THEN
1715  READ(nulin, fmt=rform) clline
1716  CALL skip(clline, jpeighty, ios=ios)
1717  CALL parse (clline, clvari, 1, jpeighty, ilen, __line__)
1718 
1719  IF (ilen .LE. 0) THEN
1720  IF (mpi_rank_global == 0) THEN
1721  WRITE(nulprt1,*) ' ***WARNING*** Nothing on input for '//trim(keyword)
1722  WRITE(nulprt1,*) ' Default value 2 will be used '
1723  WRITE(nulprt1,*) ' '
1724  CALL oasis_flush(nulprt1)
1725  ENDIF
1726  ELSE
1727  READ(clvari, fmt=1004) nlogprt
1728  CALL parse (clline, clvari, 2, jpeighty, ilen, __line__)
1729  IF (ilen > 0) THEN
1730  READ(clvari, fmt=1004) ntlogprt
1731  ELSE
1732  IF (mpi_rank_global == 0) THEN
1733  WRITE(nulprt1,*) ' ***WARNING*** Nothing on input for time statistic for '//trim(keyword)
1734  WRITE(nulprt1,*) ' Default value 0 will be used '
1735  WRITE(nulprt1,*) ' '
1736  CALL oasis_flush(nulprt1)
1737  ENDIF
1738  ENDIF
1739  ENDIF
1740  ENDIF ! found
1741 
1742  !* Print out the printing level
1743 
1744  CALL prtout('The printing level is nlogprt =', nlogprt, 1)
1745  CALL prtout('The time statistics level is ntlogprt =', ntlogprt, 1)
1746 
1747  !* Get the calendar type for this simulation
1748 
1749  keyword = clcal
1750  CALL findkeyword (keyword, clline, found)
1751  IF (found .and. mpi_rank_global == 0) THEN
1752  WRITE(nulprt1,*) ' ***WARNING*** '//trim(keyword)//' is obsolete in OASIS3-MCT'
1753  ENDIF
1754 
1755  !* Get the allow no restart flag value
1756 
1757  nnorest = .false.
1758  keyword = clrest
1759  CALL findkeyword (keyword, clline, found)
1760  IF (found) THEN
1761  READ(nulin, fmt=rform) clline
1762  CALL skip(clline, jpeighty, ios=ios)
1763  CALL parse (clline, clvari, 1, jpeighty, ilen, __line__)
1764  IF (ilen .LE. 0) THEN
1765  nnorest = .false.
1766  IF (mpi_rank_global == 0) THEN
1767  WRITE(nulprt1,*) ' ***WARNING*** Nothing on input for '//trim(keyword)
1768  WRITE(nulprt1,*) ' Default value false will be used '
1769  WRITE(nulprt1,*) ' '
1770  CALL oasis_flush(nulprt1)
1771  ENDIF
1772  ELSE
1773  IF (clvari(1:1) == 't' .or. clvari(1:1) == 'T' .or. &
1774  clvari(1:2) == '.t' .or. clvari(1:2) == '.T') then
1775  nnorest = .true.
1776  ENDIF
1777  IF (mpi_rank_global == 0) THEN
1778  WRITE(nulprt1,*) ' read '//trim(clvari)//' for '//trim(keyword)
1779  WRITE(nulprt1,*) ' set value to ',nnorest
1780  WRITE(nulprt1,*) ' '
1781  CALL oasis_flush(nulprt1)
1782  ENDIF
1783  ENDIF
1784  ENDIF ! found
1785 
1786  !* Print out the allow no restart flag
1787 
1788  if (nnorest) then
1789  CALL prtout('The allow_no_restart flag is set to true ',1,1)
1790  else
1791  CALL prtout('The allow_no_restart flag is set to false ',0,1)
1792  endif
1793 
1794  rewind nulin
1795 
1796  !* Get the unit map decomp value
1797 
1799  keyword = clmapdec
1800  CALL findkeyword (keyword, clline, found)
1801  IF (found) THEN
1802  READ(nulin, fmt=rform) clline
1803  CALL skip(clline, jpeighty, ios=ios)
1804  CALL parse (clline, clvari, 1, jpeighty, ilen, __line__)
1805  IF (ilen .LE. 0) THEN
1806  IF (mpi_rank_global == 0) THEN
1807  WRITE(nulprt1,*) ' ***WARNING*** Nothing on input for '//trim(keyword)
1808  WRITE(nulprt1,*) ' Default value wght will be used '
1809  WRITE(nulprt1,*) ' '
1810  CALL oasis_flush(nulprt1)
1811  ENDIF
1812  ELSE
1813  IF (trim(clvari) == 'decomp_1d' .or. &
1814  trim(clvari) == 'decomp_wghtfile') THEN
1815  nmapdec = clvari
1816  ELSE
1817  CALL prtout('ERROR in namcouple '//trim(keyword)//' argument',jf,1)
1818  WRITE(tmpstr1,*) 'ERROR in namcouple '//trim(keyword)//' argument '//trim(clvari)
1819  CALL namcouple_abort(subname,__line__,tmpstr1)
1820  ENDIF
1821  ENDIF
1822  ENDIF ! found
1823 
1824  !* Print out the mapdec value
1825 
1826  IF (mpi_rank_global == 0) THEN
1827  write(nulprt1,*) ' The mapdec value is nmapdec = ',trim(nmapdec)
1828  endif
1829 
1830  !* Get the unit matrix read value
1831 
1833  keyword = clmatxrd
1834  CALL findkeyword (keyword, clline, found)
1835  IF (found) THEN
1836  READ(nulin, fmt=rform) clline
1837  CALL skip(clline, jpeighty, ios=ios)
1838  CALL parse (clline, clvari, 1, jpeighty, ilen, __line__)
1839  IF (ilen .LE. 0) THEN
1840  IF (mpi_rank_global == 0) THEN
1841  WRITE(nulprt1,*) ' ***WARNING*** Nothing on input for '//trim(keyword)
1842  WRITE(nulprt1,*) ' Default value wght will be used '
1843  WRITE(nulprt1,*) ' '
1844  CALL oasis_flush(nulprt1)
1845  ENDIF
1846  ELSE
1847  IF (trim(clvari) == 'orig' .or. &
1848  trim(clvari) == 'ceg') THEN
1849  nmatxrd = clvari
1850  ELSE
1851  CALL prtout('ERROR in namcouple '//trim(keyword)//' argument',jf,1)
1852  WRITE(tmpstr1,*) 'ERROR in namcouple '//trim(keyword)//' argument '//trim(clvari)
1853  CALL namcouple_abort(subname,__line__,tmpstr1)
1854  ENDIF
1855  ENDIF
1856  ENDIF ! found
1857 
1858  !* Print out the matxrd value
1859 
1860  IF (mpi_rank_global == 0) THEN
1861  write(nulprt1,*) ' The matxrd value is nmatxrd = ',trim(nmatxrd)
1862  endif
1863 
1864  !* Get the unit weights handling option
1865 
1867  keyword = clwgtopt
1868  CALL findkeyword (keyword, clline, found)
1869  IF (found) THEN
1870  READ(nulin, fmt=rform) clline
1871  CALL skip(clline, jpeighty, ios=ios)
1872  CALL parse (clline, clvari, 1, jpeighty, ilen, __line__)
1873  IF (ilen .LE. 0) THEN
1874  IF (mpi_rank_global == 0) THEN
1875  WRITE(nulprt1,*) ' ***WARNING*** Nothing on input for '//trim(keyword)
1876  WRITE(nulprt1,*) ' Default value wght will be used '
1877  WRITE(nulprt1,*) ' '
1878  CALL oasis_flush(nulprt1)
1879  ENDIF
1880  ELSE
1881  IF (trim(clvari) == 'abort_on_bad_index' .or. &
1882  trim(clvari) == 'ignore_bad_index' .or. &
1883  trim(clvari) == 'ignore_bad_index_silently' .or. &
1884  trim(clvari) == 'use_bad_index') THEN
1885  nwgtopt = clvari
1886  ELSE
1887  CALL prtout('ERROR in namcouple '//trim(keyword)//' argument',jf,1)
1888  WRITE(tmpstr1,*) 'ERROR in namcouple '//trim(keyword)//' argument '//trim(clvari)
1889  CALL namcouple_abort(subname,__line__,tmpstr1)
1890  ENDIF
1891  ENDIF
1892  ENDIF ! found
1893 
1894  !* Print out the wgtopt value
1895 
1896  IF (mpi_rank_global == 0) THEN
1897  write(nulprt1,*) ' The wgtopt value is nwgtopt = ',trim(nwgtopt)
1898  endif
1899 
1900  !* Get the unit min/max values
1901 
1902  nuntmin = 1024
1903  nuntmax = 9999
1904  keyword = clunit
1905  CALL findkeyword (keyword, clline, found)
1906  IF (found) THEN
1907  READ(nulin, fmt=rform) clline
1908  CALL skip(clline, jpeighty, ios=ios)
1909  CALL parse (clline, clvari, 1, jpeighty, ilen, __line__)
1910  IF (ilen .LE. 0) THEN
1911  IF (mpi_rank_global == 0) THEN
1912  WRITE(nulprt1,*) ' ***WARNING*** Nothing on input for '//trim(keyword)
1913  WRITE(nulprt1,*) ' Default values 1024 and 9999 will be used '
1914  WRITE(nulprt1,*) ' '
1915  CALL oasis_flush(nulprt1)
1916  ENDIF
1917  ELSE
1918  READ(clvari, fmt=1004) nuntmin
1919  CALL parse (clline, clvari, 2, jpeighty, ilen, __line__)
1920  IF (ilen > 0) THEN
1921  READ(clvari, fmt=1004) nuntmax
1922  ELSE
1923  IF (mpi_rank_global == 0) THEN
1924  WRITE(nulprt1,*) ' ***WARNING*** Nothing on input for '//trim(keyword)//' max'
1925  WRITE(nulprt1,*) ' Default value 9999 will be used '
1926  WRITE(nulprt1,*) ' '
1927  CALL oasis_flush(nulprt1)
1928  ENDIF
1929  ENDIF
1930  ENDIF
1931  ENDIF ! found
1932 
1933  !* Print out the unit number values
1934 
1935  CALL prtout('The min IO unit number is nuntmin =', nuntmin, 1)
1936  CALL prtout('The max IO unit number is nuntmax =', nuntmax, 1)
1937 
1938  rewind nulin
1939 
1940  !* Formats
1941 
1942 1004 FORMAT(i12)
1943 
1944  !* 2. Get field information
1945  ! ---------------------
1946 
1947  !* Init. array needed for local transformation
1948 
1949  ig_local_trans(:) = ip_instant
1950 
1951 !SV More cleaning is needed form here on.
1952 
1953 !* Init. arrays needed for ANAIS(G-M),mapping and subgrid interpolation
1954 
1955  IF (lg_oasis_field) THEN
1956  lcoast = .true.
1957  DO jz = 1, ig_nfield
1958  linit(jz) = .true.
1959  lmapp(jz) = .true.
1960  lsubg(jz) = .true.
1961  lextra(jz) = .true.
1962  varmul(jz) = 1.
1963  lsurf(jz) = .false.
1964  ENDDO
1965  ENDIF
1966 
1967 !* Get the SSCS for all fields
1968 
1969  keyword = clstring
1970  CALL findkeyword (keyword, clline, found)
1971  IF (.not.found) THEN
1972  WRITE(tmpstr1,*) trim(keyword)//' not found in namcouple'
1973  CALL namcouple_abort(subname,__line__,tmpstr1)
1974  ENDIF
1975 
1976 ! Initialize restart name index
1977 
1978  il_aux = 0
1979 
1980 !* Loop on total number of fields (NoF)
1981 
1982  DO jf = 1, ig_final_nfield
1983 
1984 !* Read first two lines of strings for field n = 1,2...,ig_final_nfield
1985 ! --->>> Main CHARACTERistics of fields
1986 
1987 !* First line
1988  READ(nulin, fmt=rform) clline
1989  CALL skip(clline, jpeighty, ios=ios)
1990  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
1991 !* Get output field symbolic name
1992  cg_input_field(jf) = clvari
1993  IF (lg_state(jf)) cnaminp(ig_number_field(jf)) = cg_input_field(jf)
1994  IF (lg_state(jf)) cnamout(ig_number_field(jf)) = cg_output_field(jf)
1995  CALL parse(clline, clvari, 3, jpeighty, ilen, __line__)
1996 !* Get field label number
1997  READ(clvari, fmt=2003) ig_numlab(jf)
1998  IF (lg_state(jf)) numlab(ig_number_field(jf)) = ig_numlab(jf)
1999  CALL parse(clline, clvari, 4, jpeighty, ilen, __line__)
2000 !* Get field exchange frequency
2001  IF (clvari(1:4) .EQ. 'ONCE') THEN
2002 
2003 !* The case 'ONCE' means that the coupling period will be equal to the
2004 !* time of the simulation
2005 
2006  ig_freq(jf) = ntime
2007  ELSE
2008  READ(clvari, fmt=2004) ig_freq(jf)
2009  IF (ig_freq(jf) .EQ. 0) THEN
2010 
2011  IF (mpi_rank_global == 0) THEN
2012  WRITE(nulprt1,*) ' '
2013  ENDIF
2014  CALL prtout('ERROR in namcouple for field', jf, 1)
2015  WRITE(tmpstr1,*) 'The coupling period must not be 0 !'
2016  WRITE(tmpstr2,*) 'If you DO not want to exchange this field at all'
2017  WRITE(tmpstr3,*) 'give a coupling period longer than the total run time.'
2018  CALL namcouple_abort(subname,__line__,tmpstr1,tmpstr2,tmpstr3)
2019 
2020  ELSEIF (ig_freq(jf) .gt. ntime) THEN
2021  IF (mpi_rank_global == 0) THEN
2022  WRITE(nulprt1,*) ' ***WARNING*** The coupling period of the field ',jf
2023  WRITE(nulprt1,*) ' is greater than the time of the simulation '
2024  WRITE(nulprt1,*) ' This field will not be exchanged !'
2025  CALL oasis_flush(nulprt1)
2026  ENDIF
2027  ENDIF
2028  ENDIF
2029 
2030  IF (lg_state(jf)) nfexch(ig_number_field(jf)) = ig_freq(jf)
2031 !* Fill up restart file number and restart file name arrays
2032  IF (cg_restart_file(jf).ne.' ') THEN
2033  IF (jf.eq.1) THEN
2034  il_aux = il_aux + 1
2035  ig_no_rstfile(jf) = il_aux
2037  ELSEIF (jf.gt.1) THEN
2038  IF (all(cg_name_rstfile.ne.cg_restart_file(jf))) THEN
2039  il_aux = il_aux + 1
2040  ig_no_rstfile(jf) = il_aux
2042  ELSE
2043  DO ib = 1, jf - 1
2044  IF (cg_name_rstfile(ig_no_rstfile(ib)).eq.cg_restart_file(jf)) THEN
2045  ig_no_rstfile(jf) = ig_no_rstfile(ib)
2046  ENDIF
2047  ENDDO
2048  ENDIF
2049  ENDIF
2050  ENDIF
2051  CALL parse(clline, clvari, 7, jpeighty, ilen, __line__)
2052 !*
2053 !* Get the field STATUS
2054  IF (clvari(1:8).eq.'EXPORTED' .or. &
2055  clvari(1:8).eq.'AUXILARY') THEN
2056  cstate(ig_number_field(jf)) = clvari
2057  ELSEIF (clvari(1:6) .eq. 'EXPOUT') THEN
2058  cstate(ig_number_field(jf)) = 'EXPORTED'
2059  ENDIF
2060 !*
2061 !* Second line
2062 ! XXX Modif Graham ?
2063 
2064  IF (ig_total_state(jf) .ne. ip_input) THEN
2065  READ(nulin, fmt=rform) clline
2066 ! * First determine what information is on the line
2067  CALL skip(clline, jpeighty, ios=ios)
2068  CALL parse(clline, clvari, 3, jpeighty, ilen, __line__)
2069  IF (ilen .lt. 0) THEN
2070 ! * IF only two words on the line, THEN they are the locator
2071 ! * prefixes and the grids file must be in NetCDF format
2072  ig_lag(jf)=0
2073  ig_total_nseqn(jf)=1
2074  IF (lg_state(jf)) THEN
2075  nseqn(ig_number_field(jf)) = 1
2076  nlagn(ig_number_field(jf)) = 0
2077  ENDIF
2078  llseq=.false.
2079  lllag=.false.
2080  IF (mpi_rank_global == 0) THEN
2081  WRITE(nulprt1, fmt=3043) jf
2082  ENDIF
2083  ELSE
2084  READ(clvari, fmt=2011) clind, clequa, iind
2085  IF (clind .EQ. 'SEQ' .or. clind .EQ. 'LAG' .and. &
2086  clequa .EQ. '=') THEN
2087 ! * If 3rd word is an index, THEN first two words are
2088 ! * locator prefixes and grids file must be NetCDF format
2089  ilind1=3
2090  ilind2=6
2091  ELSE
2092 ! * If not, the first 4 words are grid dimensions and next
2093 ! * 2 words are locator prefixes, and grids file may be or
2094 ! * not in NetCDF FORMAT.
2095  ilind1=7
2096  ilind2=10
2097  ENDIF
2098 ! * Get possibly additional indices
2099  ig_lag(jf)=0
2100  ig_total_nseqn(jf)=1
2101  IF (lg_state(jf)) THEN
2102  nseqn(ig_number_field(jf)) = 1
2103  nlagn(ig_number_field(jf)) = 0
2104  ENDIF
2105  llseq=.false.
2106  lllag=.false.
2107 
2108  DO ilind=ilind1, ilind2
2109  CALL parse(clline, clvari, ilind, jpeighty, ilen, __line__)
2110  IF (ilen .eq. -1) THEN
2111  IF (mpi_rank_global == 0) THEN
2112  IF (nlogprt .GE. 0) THEN
2113  IF (.NOT. lllag) WRITE(nulprt1, fmt=3043) jf
2114  ENDIF
2115  ENDIF
2116  GO TO 247
2117  ELSE
2118  READ(clvari, fmt=2011) clind, clequa, iind
2119  IF (clind .EQ. 'SEQ') THEN
2120  ig_total_nseqn(jf)=iind
2121  IF (lg_state(jf)) nseqn(ig_number_field(jf)) = iind
2122  llseq=.true.
2123  ELSEIF (clind .eq. 'LAG') THEN
2124  ig_lag(jf)=iind
2125  IF (lg_state(jf)) nlagn(ig_number_field(jf)) = iind
2126  lllag=.true.
2127  IF (mpi_rank_global == 0) THEN
2128  WRITE(nulprt1, fmt=3044)jf,ig_lag(jf)
2129  ENDIF
2130  ENDIF
2131  ENDIF
2132  ENDDO ! DO ilind
2133  ENDIF
2134  ENDIF
2135 
2136  247 CONTINUE
2137 
2138 !* Third line
2139 
2140  IF (lg_state(jf)) THEN
2141  READ(nulin, fmt=rform) clline
2142  IF (mpi_rank_global == 0) THEN
2143  WRITE(nulprt1,*) subname,'9 Read line: ',trim(clline)
2144  CALL oasis_flush(nulprt1)
2145  ENDIF
2146  CALL skip(clline, jpeighty, ios=ios)
2147  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
2148  IF (mpi_rank_global == 0) THEN
2149  WRITE(nulprt1,*) subname,'9 Read line :',trim(clline),' clvari in 1 position: ',trim(clvari)
2150  CALL oasis_flush(nulprt1)
2151  ENDIF
2152  ! * Get source grid periodicity type
2153  csper(ig_number_field(jf)) = clvari
2154  IF (csper(ig_number_field(jf)) .NE. 'P' .AND. &
2155  csper(ig_number_field(jf)) .NE. 'R') THEN
2156  CALL prtout('ERROR in namcouple for source grid type of field', jf, 1)
2157  WRITE(tmpstr1,*) '==> must be P or R'
2158  CALL namcouple_abort(subname,__line__,tmpstr1)
2159  ENDIF
2160 
2161  CALL parse(clline, clvari, 2, jpeighty, ilen, __line__)
2162 ! * Get nbr of overlapped longitudes for the Periodic type source grid
2163  READ(clvari, fmt=2005) nosper(ig_number_field(jf))
2164  CALL parse(clline, clvari, 3, jpeighty, ilen, __line__)
2165 ! * Get target grid periodicity type
2166  ctper(ig_number_field(jf)) = clvari
2167  IF (ctper(ig_number_field(jf)) .NE. 'P' .AND. &
2168  ctper(ig_number_field(jf)) .NE. 'R') THEN
2169  CALL prtout('ERROR in namcouple for target grid type of field', jf, 1)
2170  WRITE(tmpstr1,*) '==> must be P or R'
2171  CALL namcouple_abort(subname,__line__,tmpstr1)
2172  ENDIF
2173 
2174  CALL parse(clline, clvari, 4, jpeighty, ilen, __line__)
2175 ! * Get nbr of overlapped longitudes for the Periodic type target grid
2176  READ(clvari, fmt=2005) notper(ig_number_field(jf))
2177 !
2178  ENDIF
2179 
2180  !* Get the local transformation
2181 
2182  IF (.NOT. lg_state(jf)) THEN
2183  IF (ig_total_state(jf) .ne. ip_input .and. &
2184  ig_total_ntrans(jf) .gt. 0 ) THEN
2185  READ(nulin, fmt=rform) clline
2186  CALL skip(clline, jpeighty, ios=ios)
2187  DO ja=1,ig_total_ntrans(jf)
2188  READ(nulin, fmt=rform) clline
2189  CALL skip(clline, jpeighty, ios=ios)
2190  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
2191  IF (clvari(1:7) .eq. 'INSTANT') THEN
2192  ig_local_trans(jf) = ip_instant
2193  ELSEIF (clvari(1:7) .eq. 'AVERAGE') THEN
2194  ig_local_trans(jf) = ip_average
2195  ELSEIF (clvari(1:7) .eq. 'ACCUMUL') THEN
2196  ig_local_trans(jf) = ip_accumul
2197  ELSEIF (clvari(1:5) .eq. 'T_MIN') THEN
2198  ig_local_trans(jf) = ip_min
2199  ELSEIF (clvari(1:5) .eq. 'T_MAX') THEN
2200  ig_local_trans(jf) = ip_max
2201  ELSE
2202  CALL prtout('ERROR in namcouple for local transformations of field', jf, 1)
2203  WRITE(tmpstr1,*) '==> Must be INSTANT, AVERAGE, ACCUMUL, T_MIN or T_MAX'
2204  CALL namcouple_abort(subname,__line__,tmpstr1)
2205  ENDIF
2206  ENDDO ! ja
2207  ENDIF
2208  ELSE
2209 ! MODIF LC
2210  IF (ig_total_ntrans(jf) .GT. 0 ) THEN
2211  READ(nulin, fmt=rform) clline
2212  CALL skip(clline, jpeighty, ios=ios)
2213 
2214 ! * Now read specifics for each transformation
2215 
2216  DO ja = 1, ig_ntrans(ig_number_field(jf))
2217 
2218 ! * Read next line unless if analysis is NOINTERP (no input)
2219 
2220  READ(nulin, fmt=rform) clline
2221  CALL skip(clline, jpeighty, ios=ios)
2222  IF (canal(ja,ig_number_field(jf)) .EQ. 'LOCTRANS') THEN
2223  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
2224  IF (clvari(1:7) .eq. 'INSTANT') THEN
2225  ig_local_trans(jf) = ip_instant
2226  ELSEIF (clvari(1:7) .eq. 'AVERAGE') THEN
2227  ig_local_trans(jf) = ip_average
2228  ELSEIF (clvari(1:7) .eq. 'ACCUMUL') THEN
2229  ig_local_trans(jf) = ip_accumul
2230  ELSEIF (clvari(1:5) .eq. 'T_MIN') THEN
2231  ig_local_trans(jf) = ip_min
2232  ELSEIF (clvari(1:5) .eq. 'T_MAX') THEN
2233  ig_local_trans(jf) = ip_max
2234  ELSE
2235  CALL prtout('ERROR in namcouple for local transformations of field', jf, 1)
2236  WRITE(tmpstr1,*) '==> Must be INSTANT, AVERAGE, ACCUMUL, T_MIN or T_MAX'
2237  CALL namcouple_abort(subname,__line__,tmpstr1)
2238  ENDIF
2239  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKIN')THEN
2240  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
2241  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKOUT') THEN
2242  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
2243  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'MAPPING') THEN
2244 !* Get mapping filename
2245  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
2246  cmap_file(ig_number_field(jf)) = trim(clvari)
2247 !* Get mapping location and/or mapping optimization; src (default), dst; bfb (default), sum, opt
2248  cmaptyp(ig_number_field(jf)) = 'src'
2249  cmapopt(ig_number_field(jf)) = 'bfb'
2250  DO idum = 2,3
2251  CALL parse(clline, clvari, idum, jpeighty, ilen, __line__)
2252  IF (ilen > 0) THEN
2253  IF (trim(clvari) == 'src' .or. trim(clvari) == 'dst') THEN
2254  cmaptyp(ig_number_field(jf)) = trim(clvari)
2255  ELSEIF (trim(clvari) == 'opt' .or. trim(clvari) == 'bfb' .or. &
2256  trim(clvari) == 'sum') THEN
2257  cmapopt(ig_number_field(jf)) = trim(clvari)
2258  ELSE
2259  CALL prtout('ERROR in namcouple mapping argument',jf,1)
2260  WRITE(tmpstr1,*) 'ERROR in namcouple mapping argument ',trim(clvari),' cmaptyp or loc'
2261  CALL namcouple_abort(subname,__line__,tmpstr1)
2262  ENDIF
2263  ENDIF
2264  ENDDO ! DO idum
2265  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'SCRIPR') THEN
2266 !* Get Scrip remapping method
2267  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
2268  READ(clvari, fmt=2009) cmap_method(ig_number_field(jf))
2269 !* Get source grid type
2270  CALL parse(clline, clvari, 2, jpeighty, ilen, __line__)
2271  READ(clvari, fmt=2009) cgrdtyp(ig_number_field(jf))
2272  IF (cmap_method(ig_number_field(jf)) .eq. 'BICUBIC' &
2273  .and. cgrdtyp(ig_number_field(jf)) .ne. 'LR' &
2274  .and. cgrdtyp(ig_number_field(jf)) .ne. 'D') THEN
2275  IF (mpi_rank_global == 0) THEN
2276  WRITE(nulprt1,*) ' '
2277  ENDIF
2278  CALL prtout('ERROR in namcouple for type of field', jf, 1)
2279  WRITE(tmpstr1,*) 'BICUBIC interpolation cannot be used if grid is not LR or D'
2280  CALL namcouple_abort(subname,__line__,tmpstr1)
2281  ENDIF
2282  IF (cmap_method(ig_number_field(jf)) .eq. 'BILINEAR' &
2283  .and. cgrdtyp(ig_number_field(jf)) .ne. 'LR' &
2284  .and. cgrdtyp(ig_number_field(jf)) .ne. 'D') THEN
2285  IF (mpi_rank_global == 0) THEN
2286  WRITE(nulprt1,*) ' '
2287  ENDIF
2288  CALL prtout('ERROR in namcouple for type of field', jf, 1)
2289  WRITE(tmpstr1,*) 'BILINEAR interpolation cannot be used if grid is not LR or D'
2290  CALL namcouple_abort(subname,__line__,tmpstr1)
2291  ENDIF
2292 !* Get field type (scalar/vector)
2293  CALL parse(clline, clvari, 3, jpeighty, ilen, __line__)
2294  READ(clvari, fmt=2009) cfldtype(ig_number_field(jf))
2295  IF (cfldtype(ig_number_field(jf)) .EQ. 'VECTOR') cfldtype(ig_number_field(jf))='SCALAR'
2296  IF (cfldtype(ig_number_field(jf)) .NE. 'SCALAR') THEN
2297  IF (mpi_rank_global == 0) THEN
2298  WRITE(nulprt1,*) ' '
2299  ENDIF
2300  CALL prtout('ERROR in namcouple for type of field', jf, 1)
2301  WRITE(tmpstr1,*) '==> must be SCALAR, VECTOR'
2302  CALL namcouple_abort(subname,__line__,tmpstr1)
2303  ENDIF
2304 !* Get restriction type for SCRIP search
2305  CALL parse(clline, clvari, 4, jpeighty, ilen, __line__)
2306  READ(clvari, fmt=2009) crsttype(ig_number_field(jf))
2307  IF (cgrdtyp(ig_number_field(jf)) .EQ. 'D') THEN
2308  IF (cmap_method(ig_number_field(jf)) .EQ. 'BILINEAR' .or. &
2309  cmap_method(ig_number_field(jf)) .EQ. 'BICUBIC') THEN
2310  IF (crsttype(ig_number_field(jf)) .NE. 'LATITUDE') THEN
2311  IF (mpi_rank_global == 0) THEN
2312  WRITE(nulprt1,*) ' '
2313  ENDIF
2314  CALL prtout('ERROR in namcouple for restriction of field',jf,1)
2315  WRITE(tmpstr1,*) '==> LATITUDE must be chosen for reduced grids (D)'
2316  CALL namcouple_abort(subname,__line__,tmpstr1)
2317  ELSE
2318  crsttype(ig_number_field(jf)) = 'REDUCED'
2319  ENDIF
2320  ENDIF
2321  ENDIF
2322 
2323  IF (crsttype(ig_number_field(jf)) .NE. 'LATITUDE' .AND. &
2324  crsttype(ig_number_field(jf)) .NE. 'LATLON' .AND. &
2325  crsttype(ig_number_field(jf)) .NE. 'REDUCED') THEN
2326  IF (mpi_rank_global == 0) THEN
2327  WRITE(nulprt1,*) ' '
2328  ENDIF
2329  CALL prtout('ERROR in namcouple for restriction of field',jf,1)
2330  WRITE(tmpstr1,*) '==> must be LATITUDE or LATLON'
2331  CALL namcouple_abort(subname,__line__,tmpstr1)
2332  ENDIF
2333 !*
2334 !* Get number of search bins for SCRIP search
2335  CALL parse(clline, clvari, 5, jpeighty, ilen, __line__)
2336  READ(clvari, fmt=2003) nbins(ig_number_field(jf))
2337 !* Get normalize option for CONSERV
2338  IF (cmap_method(ig_number_field(jf)) .EQ. 'CONSERV') THEN
2339  CALL parse(clline, clvari, 6, jpeighty, ilen, __line__)
2340  READ(clvari, fmt=2009)cnorm_opt(ig_number_field(jf))
2341  IF (cnorm_opt(ig_number_field(jf)) .NE. 'FRACAREA' .AND. &
2342  cnorm_opt(ig_number_field(jf)) .NE. 'DESTAREA' .AND. &
2343  cnorm_opt(ig_number_field(jf)) .NE. 'FRACNNEI') THEN
2344  IF (mpi_rank_global == 0) THEN
2345  WRITE(nulprt1,*) ' '
2346  ENDIF
2347  CALL prtout('ERROR in namcouple for normalize option of field',jf,1)
2348  WRITE(tmpstr1, *) '==> must be FRACAREA, DESTAREA, or FRACNNEI'
2349  CALL namcouple_abort(subname,__line__,tmpstr1)
2350  ENDIF
2351 !* Get order of remapping for CONSERV
2352  CALL parse(clline, clvari, 7, jpeighty, ilen, __line__)
2353  IF (ilen .LE. 0) THEN
2354  IF (mpi_rank_global == 0) THEN
2355  WRITE(nulprt1,*) ' '
2356  ENDIF
2357  CALL prtout('ERROR in namcouple for CONSERV for field',jf,1)
2358  WRITE(tmpstr1,*) '==> FIRST must be indicated at end of line'
2359  CALL namcouple_abort(subname,__line__,tmpstr1)
2360  ENDIF
2361  READ(clvari, fmt=2009) corder(ig_number_field(jf))
2362  ELSE
2363  cnorm_opt(ig_number_field(jf))='NONORM'
2364  ENDIF
2365 !* Get number of neighbours for DISTWGT and GAUSWGT
2366  IF (cmap_method(ig_number_field(jf)) .EQ. 'DISTWGT' .or. &
2367  cmap_method(ig_number_field(jf)) .EQ. 'GAUSWGT') THEN
2368  CALL parse(clline, clvari, 6, jpeighty, ilen, __line__)
2369  IF (ilen .LE. 0) THEN
2370  IF (mpi_rank_global == 0) THEN
2371  WRITE(nulprt1,*) ' '
2372  ENDIF
2373  CALL prtout('ERROR in namcouple for field',jf,1)
2374  WRITE(tmpstr1,*) '==> Number of neighbours must be indicated on the line'
2375  CALL namcouple_abort(subname,__line__,tmpstr1)
2376  ELSE
2377  READ(clvari, fmt=2003)nscripvoi(ig_number_field(jf))
2378  ENDIF
2379  ENDIF
2380 !* Get gaussian variance for GAUSWGT
2381  IF (cmap_method(ig_number_field(jf)) .EQ. 'GAUSWGT') THEN
2382  CALL parse(clline, clvari, 7, jpeighty, ilen, __line__)
2383  IF (ilen .LE. 0) THEN
2384  IF (mpi_rank_global == 0) THEN
2385  WRITE(nulprt1,*) ' '
2386  ENDIF
2387  CALL prtout('ERROR in namcouple for GAUSWGT for field',jf,1)
2388  WRITE(tmpstr1,*) '==> Variance must be indicated at end of line'
2389  CALL namcouple_abort(subname,__line__,tmpstr1)
2390  ELSE
2391  ! Read a string
2392  READ(clvari, fmt=2012) cvarmul
2393  ! and convert it accordingly
2394  IF ( index(cvarmul,'.') == 0 ) then
2395  READ(cvarmul,fmt=2013) ivarmul
2396  varmul(ig_number_field(jf)) = REAL(ivarmul)
2397  ELSE
2398  READ(cvarmul,fmt=2006) varmul(ig_number_field(jf))
2399  ENDIF
2400  ENDIF
2401  ENDIF
2402 
2403  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'FILLING') THEN
2404  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
2405 ! * Get data file name (used to complete the initial field array)
2406  cfilfic(ig_number_field(jf)) = clvari
2407  CALL parse(clline, clvari, 2, jpeighty, ilen, __line__)
2408 ! * Get logical unit connected to previous file
2409  READ(clvari, fmt=2005) nlufil(ig_number_field(jf))
2410  CALL parse(clline, clvari, 3, jpeighty, ilen, __line__)
2411 ! * Get filling method
2412  cfilmet(ig_number_field(jf)) = clvari
2413 ! * If current field is SST
2414  IF (cfilmet(ig_number_field(jf))(4:6) .EQ. 'SST') THEN
2415  CALL parse(clline, clvari, 4, jpeighty, ilen, __line__)
2416 ! * Get flag for coast mismatch correction
2417  READ(clvari, fmt=2005) nfcoast
2418  IF (cfilmet(ig_number_field(jf))(1:3) .EQ. 'SMO') THEN
2419  CALL parse(clline, clvari, 5, jpeighty, ilen, __line__)
2420 ! * Get field name for flux corrective term
2421  cfldcor = clvari
2422  CALL parse(clline, clvari, 6, jpeighty, ilen, __line__)
2423 ! * Get logical unit used to write flux corrective term
2424  READ(clvari, fmt=2005) nlucor
2425  ENDIF
2426  ENDIF
2427  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'CONSERV') THEN
2428  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
2429 ! * Get conservation method
2430  cconmet(ig_number_field(jf)) = clvari
2431  lsurf(ig_number_field(jf)) = .true.
2432  CALL parse(clline, clvari, 2, jpeighty, ilen, __line__)
2433  cconopt(ig_number_field(jf)) = 'bfb'
2434  IF (ilen > 0) THEN
2435  IF (trim(clvari) == 'bfb' .or. trim(clvari) == 'opt' .or. &
2436  trim(clvari) == 'lsum8' .or. trim(clvari) == 'lsum16' .or. &
2437  trim(clvari) == 'gather' .or. trim(clvari) == 'ddpdd' .or. &
2438  trim(clvari) == 'reprosum') THEN
2439  cconopt(ig_number_field(jf)) = clvari
2440  ELSE
2441  CALL prtout('ERROR in namcouple conserv argument',jf,1)
2442  WRITE(tmpstr1,*) 'ERROR in namcouple conserv argument '//trim(clvari)
2443  CALL namcouple_abort(subname,__line__,tmpstr1)
2444  ENDIF
2445  ENDIF
2446  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'BLASOLD')THEN
2447 ! * Get linear combination parameters for initial fields
2448  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
2449 ! * Get main field multiplicative coefficient
2450  READ(clvari, fmt=2012) cafldcobo
2451  ! and convert it accordingly
2452  IF ( index(cafldcobo,'.') == 0 ) then
2453  READ(cafldcobo,fmt=2013) iafldcobo
2454  afldcobo(ig_number_field(jf)) = REAL(iafldcobo)
2455  ELSE
2456  READ(cafldcobo,fmt=2006) afldcobo(ig_number_field(jf))
2457  ENDIF
2458  DO jc = 1, nbofld(ig_number_field(jf))
2459  READ(nulin, fmt=rform) clline
2460  CALL skip(clline, jpeighty)
2461  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
2462 ! * Get symbolic names for additional fields
2463  cbofld(jc,ig_number_field(jf)) = clvari
2464  CALL parse(clline, clvari, 2, jpeighty, ilen, __line__)
2465 ! * Get multiplicative coefficients for additional fields
2466  READ(clvari, fmt=2012) cabocoef
2467  IF ( index(cabocoef,'.') == 0 ) THEN
2468  READ(cabocoef,fmt=2013) iabocoef
2469  abocoef(jc,ig_number_field(jf)) = REAL(iabocoef)
2470  ELSE
2471  READ(cabocoef,fmt=2006) abocoef(jc,ig_number_field(jf))
2472  ENDIF
2473  ENDDO ! DO jc
2474  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'BLASNEW')THEN
2475 ! * Get linear combination parameters for final fields
2476  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
2477 ! * Get main field multiplicative coefficient
2478  READ(clvari, fmt=2012) cafldcobn
2479  ! and convert it accordingly
2480  IF ( index(cafldcobn,'.') == 0 ) then
2481  READ(cafldcobn,fmt=2013) iafldcobn
2482  afldcobn(ig_number_field(jf)) = REAL(iafldcobn)
2483  ELSE
2484  READ(cafldcobn,fmt=2006) afldcobn(ig_number_field(jf))
2485  ENDIF
2486  DO jc = 1, nbnfld(ig_number_field(jf))
2487  READ(nulin, fmt=rform) clline
2488  CALL skip(clline, jpeighty)
2489  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
2490 ! * Get symbolic names for additional fields
2491  cbnfld(jc,ig_number_field(jf)) = clvari
2492  CALL parse(clline, clvari, 2, jpeighty, ilen, __line__)
2493 ! * Get multiplicative coefficients for additional fields
2494  READ(clvari, fmt=2012) cabncoef
2495  IF ( index(cabncoef,'.') == 0 ) THEN
2496  READ(cabncoef,fmt=2013) iabncoef
2497  abncoef(jc,ig_number_field(jf)) = REAL(iabncoef)
2498  ELSE
2499  READ(cabncoef,fmt=2006) abncoef(jc,ig_number_field(jf))
2500  ENDIF
2501  ENDDO ! DO jc
2502  ELSE
2503  WRITE(tmpstr1,*) ' Type of analysis not implemented yet '
2504  WRITE(tmpstr2,*) ' The analysis required in OASIS is :'
2505  WRITE(tmpstr3,*) ' canal = ', canal(ja,ig_number_field(jf))
2506  WRITE(tmpstr4,*) ' with ja = ', ja, ' jf = ', jf
2507  CALL namcouple_abort(subname,__line__,tmpstr1,tmpstr2,tmpstr3,tmpstr4)
2508  ENDIF
2509  ENDDO ! DO ja
2510 ! MODIF LC
2511  ENDIF
2512  ENDIF
2513 
2514 !* End of loop on NoF
2515 
2516  ENDDO ! DO jf
2517 
2518 !* Minimum coupling period
2519 
2520  ig_total_frqmin = minval(ig_freq)
2521 
2522 !* Formats
2523 
2524 2001 FORMAT(a9)
2525 2003 FORMAT(i4)
2526 2004 FORMAT(i8)
2527 2005 FORMAT(i2)
2528 2006 FORMAT(e15.6)
2529 2008 FORMAT(a2,i4)
2530 2009 FORMAT(a8)
2531 2010 FORMAT(a3,a1,i2)
2532 2011 FORMAT(a3,a1,i8)
2533 2012 FORMAT(a15)
2534 2013 FORMAT(i10)
2535 
2536 !* 3. Printing
2537 ! --------
2538  IF (mpi_rank_global == 0) THEN
2539  IF (nlogprt .GE. 0) THEN
2540  DO jf = 1, ig_final_nfield
2541  IF (ig_total_state(jf) .eq. ip_exported ) THEN
2542  cl_print_state = 'EXPORTED'
2543  ELSEIF (ig_total_state(jf) .eq. ip_ignored ) THEN
2544  cl_print_state = 'IGNORED'
2545  ELSEIF (ig_total_state(jf) .eq. ip_ignout ) THEN
2546  cl_print_state = 'IGNOUT'
2547  ELSEIF (ig_total_state(jf) .eq. ip_expout ) THEN
2548  cl_print_state = 'EXPOUT'
2549  ELSEIF (ig_total_state(jf) .eq. ip_input ) THEN
2550  cl_print_state = 'INPUT'
2551  ELSEIF (ig_total_state(jf) .eq. ip_output ) THEN
2552  cl_print_state = 'OUTPUT'
2553  ELSEIF (ig_total_state(jf) .eq. ip_auxilary ) THEN
2554  cl_print_state = 'AUXILARY'
2555  ENDIF
2556 
2557  IF (ig_local_trans(jf) .eq. ip_instant) THEN
2558  cl_print_trans = 'INSTANT'
2559  ELSEIF (ig_local_trans(jf) .eq. ip_average) THEN
2560  cl_print_trans = 'AVERAGE'
2561  ELSEIF (ig_local_trans(jf) .eq. ip_accumul) THEN
2562  cl_print_trans = 'ACCUMUL'
2563  ELSEIF (ig_local_trans(jf) .eq. ip_min) THEN
2564  cl_print_trans = 'T_MIN'
2565  ELSEIF (ig_local_trans(jf) .eq. ip_max) THEN
2566  cl_print_trans = 'T_MAX'
2567  ENDIF
2568 
2569 !* Local indexes
2570  IF (.NOT. lg_state(jf)) THEN
2571  ilab = ig_numlab(jf)
2572  WRITE(nulprt1, fmt=3001) jf
2573  WRITE(nulprt1, fmt=3002)
2574  WRITE(nulprt1, fmt=3003)
2575  WRITE(nulprt1, fmt=3004)
2576  IF (ig_total_state(jf) .eq. ip_input .or. &
2577  ig_total_state(jf) .eq. ip_output) THEN
2578  WRITE(nulprt1, fmt=3121) &
2579  cg_input_field(jf), cg_output_field(jf), &
2580  ig_freq(jf), cl_print_trans, &
2581  cl_print_state, ig_total_ntrans(jf)
2582  ELSE
2583  WRITE(nulprt1, fmt=3116) &
2584  cg_input_field(jf), cg_output_field(jf), &
2585  ig_freq(jf), cl_print_trans, ig_total_nseqn(jf), &
2586  ig_lag(jf), cl_print_state, ig_total_ntrans(jf)
2587  ENDIF
2588  ELSE
2589  ilab = numlab(ig_number_field(jf))
2590  ifcb = len_trim(cficbf(ig_number_field(jf)))
2591  ifca = len_trim(cficaf(ig_number_field(jf)))
2592  WRITE(nulprt1, fmt=3001) jf
2593  WRITE(nulprt1, fmt=3002)
2594  WRITE(nulprt1, fmt=3003)
2595  WRITE(nulprt1, fmt=3004)
2596  WRITE(nulprt1, fmt=3005) &
2597  trim(cnaminp(ig_number_field(jf))), &
2598  trim(cnamout(ig_number_field(jf))), &
2599  nfexch(ig_number_field(jf)), &
2600  nseqn(ig_number_field(jf)), &
2601  ig_lag(jf), &
2602  cl_print_state, &
2604  ENDIF
2605 
2606  IF (.not. lg_state(jf)) THEN
2607  IF (ig_total_state(jf) .eq. ip_ignored .or. &
2608  ig_total_state(jf) .eq. ip_ignout ) THEN
2609  WRITE(nulprt1, fmt=3117) cg_restart_file(jf)
2610  ELSEIF (ig_total_state(jf) .eq. ip_input) THEN
2611  WRITE(nulprt1, fmt=3118) cg_input_file(jf)
2612  ENDIF
2613  ELSE
2614  IF (ig_total_state(jf) .eq. ip_exported .or. &
2615  ig_total_state(jf) .eq. ip_expout .or. &
2616  ig_total_state(jf) .eq. ip_auxilary ) &
2617  WRITE(nulprt1, fmt=3117) cg_restart_file(jf)
2618 
2619  WRITE(nulprt1, fmt=3007) &
2622  WRITE(nulprt1, fmt=3008) &
2623  cficbf(ig_number_field(jf))(1:ifcb)//cglonsuf, &
2624  cficbf(ig_number_field(jf))(1:ifcb)//cglatsuf, &
2625  cficbf(ig_number_field(jf))(1:ifcb)//cmsksuf, &
2626  cficbf(ig_number_field(jf))(1:ifcb)//csursuf, &
2627  cficaf(ig_number_field(jf))(1:ifca)//cglonsuf, &
2628  cficaf(ig_number_field(jf))(1:ifca)//cglatsuf, &
2629  cficaf(ig_number_field(jf))(1:ifca)//cmsksuf, &
2630  cficaf(ig_number_field(jf))(1:ifca)//csursuf
2631  WRITE(nulprt1, fmt=3009)
2632  WRITE(nulprt1, fmt=3010)
2633  DO ja = 1, ig_ntrans(ig_number_field(jf))
2634  WRITE(nulprt1, fmt=3011) ja, canal(ja,ig_number_field(jf))
2635  IF (canal(ja,ig_number_field(jf)) .EQ. 'MAPPING') THEN
2636  write(nulprt1, fmt=3048) &
2637  trim(cmap_file(ig_number_field(jf))), &
2638  trim(cmaptyp(ig_number_field(jf))), &
2639  trim(cmapopt(ig_number_field(jf)))
2640  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'SCRIPR') THEN
2641  WRITE(nulprt1, fmt=3045) &
2643  cfldtype(ig_number_field(jf)), &
2644  cnorm_opt(ig_number_field(jf)), &
2645  crsttype(ig_number_field(jf)), &
2646  nbins(ig_number_field(jf))
2647  IF (cmap_method(ig_number_field(jf)) .EQ. 'CONSERV') THEN
2648  WRITE(nulprt1, fmt=3046) corder(ig_number_field(jf))
2649  ENDIF
2650  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'CONSERV') THEN
2651  WRITE(nulprt1, fmt=3025) &
2652  cconmet(ig_number_field(jf)), &
2654  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'BLASOLD') THEN
2655  WRITE(nulprt1, fmt=3027) &
2656  trim(cnaminp(ig_number_field(jf))), &
2658  WRITE(nulprt1, fmt=3028) nbofld(ig_number_field(jf))
2659  DO jc = 1, nbofld(ig_number_field(jf))
2660  WRITE(nulprt1, fmt=3030) &
2661  cbofld(jc,ig_number_field(jf)), &
2662  abocoef(jc,ig_number_field(jf))
2663  ENDDO
2664  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'BLASNEW') THEN
2665  WRITE(nulprt1, fmt=3027) &
2666  trim(cnamout(ig_number_field(jf))), &
2668  WRITE(nulprt1, fmt=3028) nbnfld(ig_number_field(jf))
2669  DO jc = 1, nbnfld(ig_number_field(jf))
2670  WRITE(nulprt1, fmt=3030) &
2671  cbnfld(jc,ig_number_field(jf)), &
2672  abncoef(jc,ig_number_field(jf))
2673  ENDDO
2674  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKIN') THEN
2675  WRITE(nulprt1,*) ' '
2676  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKOUT') THEN
2677  WRITE(nulprt1,*) ' '
2678  ELSEIF (canal(ja,ig_number_field(jf)) .EQ. 'LOCTRANS') THEN
2679  WRITE(nulprt1, fmt=3047) cl_print_trans
2680  ELSE
2681  WRITE(tmpstr1,*) ' Type of analysis not implemented yet '
2682  WRITE(tmpstr2,*) ' The analysis required in OASIS is :'
2683  WRITE(tmpstr3,*) ' canal = ',canal(ja,ig_number_field(jf))
2684  WRITE(tmpstr4,*) ' with ja = ', ja, ' jf = ', jf
2685  CALL namcouple_abort(subname,__line__,tmpstr1,tmpstr2,tmpstr3,tmpstr4)
2686  ENDIF
2687  ENDDO ! DO ja
2688  ENDIF
2689  ENDDO ! DO jf
2690  ENDIF
2691  ENDIF
2692 
2693 !* 4. End of routine
2694 ! --------------
2695 
2696  IF (mpi_rank_global == 0) THEN
2697  IF (nlogprt .GE. 0) THEN
2698  WRITE(nulprt1,*)' '
2699  WRITE(nulprt1,*) subname,'-- End of ROUTINE --'
2700  CALL oasis_flush (nulprt1)
2701  ENDIF
2702  ENDIF
2703 ! CALL oasis_debug_exit(subname)
2704  RETURN
2705 
2706 !* Formats
2707 
2708  3001 FORMAT(//,15x,' FIELD NUMBER ',i3)
2709  3002 FORMAT(15x,' ************ ')
2710  3003 FORMAT(/,10x,' Field parameters ')
2711  3004 FORMAT(10x,' **************** ',/)
2712  3005 FORMAT(/,10x,' Input field symbolic name = ',a, &
2713  /,10x,' Output field symbolic name = ',a, &
2714  /,10x,' Field exchange frequency = ',i8, &
2715  /,10x,' Model sequential index = ',i2, &
2716  /,10x,' Field Lag = ',i8, &
2717  /,10x,' Field I/O status = ',a8, &
2718  /,10x,' Number of basic operations = ',i4, /)
2719  3116 FORMAT(/,10x,' Input field symbolic name = ',a8, &
2720  /,10x,' Output field symbolic name = ',a8, &
2721  /,10x,' Field exchange frequency = ',i8, &
2722  /,10x,' Local transformation = ',a8, &
2723  /,10x,' Model sequential index = ',i2, &
2724  /,10x,' Field Lag = ',i8, &
2725  /,10x,' Field I/O status = ',a8, &
2726  /,10x,' Number of basic operations = ',i4,/)
2727  3117 FORMAT(/,10x,' Restart file name = ',a32,/)
2728  3118 FORMAT(/,10x,' Input file name = ',a32,/)
2729  3121 FORMAT(/,10x,' Input field symbolic name = ',a8, &
2730  /,10x,' Output field symbolic name = ',a8, &
2731  /,10x,' Field exchange frequency = ',i8, &
2732  /,10x,' Local transformation = ',a8, &
2733  /,10x,' Field I/O status = ',a8, &
2734  /,10x,' Number of basic operations = ',i4,/)
2735  3007 FORMAT( &
2736  /,10x,' Source grid periodicity type is = ',a8, &
2737  /,10x,' Number of overlapped grid points is = ',i2, &
2738  /,10x,' Target grid periodicity type is = ',a8, &
2739  /,10x,' Number of overlapped grid points is = ',i2,/)
2740  3008 FORMAT(/,10x,' Source longitude file string = ',a8, &
2741  /,10x,' Source latitude file string = ',a8, &
2742  /,10x,' Source mask file string = ',a8, &
2743  /,10x,' Source surface file string = ',a8, &
2744  /,10x,' Target longitude file string = ',a8, &
2745  /,10x,' Target latitude file string = ',a8, &
2746  /,10x,' Target mask file string = ',a8, &
2747  /,10x,' Target surface file string = ',a8,/)
2748  3009 FORMAT(/,10x,' ANALYSIS PARAMETERS ')
2749  3010 FORMAT(10x,' ******************* ',/)
2750  3011 FORMAT(/,5x,' ANALYSIS number ',i2,' is ',a8, &
2751  /,5x,' *************** ',/)
2752  3025 FORMAT(5x,' Conservation method for field is = ',a8, &
2753  /,5x,' Conservation option is = ',a8)
2754  3027 FORMAT(5x,' Field ',a,' is multiplied by Cst = ',e15.6)
2755  3028 FORMAT(5x,' It is combined with N fields N = ',i2)
2756  3030 FORMAT(5x,' With field ',a8,' coefficient = ',e15.6)
2757  3043 FORMAT(/,5x,'No lag in namcouple for the field', i3, &
2758  /,5x,' Default value LAG=0 will be used ')
2759  3044 FORMAT(/,5x,'The lag for the field ',i3,3x,'is : ',i8)
2760  3045 FORMAT(5x,' Remapping method is = ',a8, &
2761  /,5x,' Field type is = ',a8, &
2762  /,5x,' Normalization option is = ',a8, &
2763  /,5x,' Seach restriction type is = ',a8, &
2764  /,5x,' Number of search bins is = ',i4)
2765  3046 FORMAT(5x,' Order of remapping is = ',a8)
2766  3047 FORMAT(5x,' Local transformation = ',a8)
2767  3048 FORMAT(5x,' Remapping filename is = ',a, &
2768  /,5x,' Mapping location is = ',a8, &
2769  /,5x,' Mapping optimization is = ',a8)
2770 
2771 END SUBROUTINE inipar
2772 
2773 !===============================================================================
2774 
2775 !> Allocates temporary arrays for namcouple input
2776 
2777 SUBROUTINE alloc()
2779  IMPLICIT NONE
2780 
2781  CHARACTER(len=*),parameter :: subname='(mod_oasis_namcouple:alloc)'
2782 
2783 ! CALL oasis_debug_enter(subname)
2784 
2785  !--- alloc_anais1
2786  ALLOCATE (varmul(ig_nfield), stat=il_err)
2787  IF (il_err.NE.0) CALL prtout('Error in "varmul"allocation of anais module',il_err,1)
2788  varmul(:)=0.
2789  ALLOCATE (niwtm(ig_nfield), stat=il_err)
2790  IF (il_err.NE.0) CALL prtout('Error in "niwtm"allocation of anais module',il_err,1)
2791  niwtm(:)=0
2792  ALLOCATE (niwtg(ig_nfield), stat=il_err)
2793  IF (il_err.NE.0) CALL prtout('Error in "niwtg"allocation of anais module',il_err,1)
2794  niwtg(:)=0
2795  allocate (linit(ig_nfield), stat=il_err)
2796  IF (il_err.ne.0) CALL prtout('error in "linit"allocation of anais module',il_err,1)
2797  linit(:)=.false.
2798 
2799  !--- alloc_analysis
2800  ALLOCATE (ncofld(ig_nfield), stat=il_err)
2801  IF (il_err.NE.0) CALL prtout('Error in "ncofld"allocation of analysis module',il_err,1)
2802  ncofld(:)=0
2803  ALLOCATE (neighborg(ig_nfield), stat=il_err)
2804  IF (il_err.NE.0) CALL prtout('Error in "neighborg"allocation of analysis module',il_err,1)
2805  neighborg(:)=0
2806  ALLOCATE (nludat(ig_maxcomb,ig_nfield), stat=il_err)
2807  IF (il_err.NE.0) CALL prtout('Error in "nludat"allocation of analysis module',il_err,1)
2808  nludat(:,:)=0
2809  ALLOCATE (nlufil(ig_nfield), stat=il_err)
2810  IF (il_err.NE.0) CALL prtout('Error in "nlufil"allocation of analysis module',il_err,1)
2811  nlufil(:)=0
2812  ALLOCATE (nlumap(ig_nfield), stat=il_err)
2813  IF (il_err.NE.0) CALL prtout('Error in "nlumap"allocation of analysis module',il_err,1)
2814  nlumap(:)=0
2815  ALLOCATE (nlusub(ig_nfield), stat=il_err)
2816  IF (il_err.NE.0) CALL prtout('Error in "nlusub"allocation of analysis module',il_err,1)
2817  nlusub(:)=0
2818  ALLOCATE (nluext(ig_nfield), stat=il_err)
2819  IF (il_err.NE.0) CALL prtout('Error in "nluext"allocation of analysis module',il_err,1)
2820  nluext(:)=0
2821  ALLOCATE (nosper(ig_nfield), stat=il_err)
2822  IF (il_err.NE.0) CALL prtout('Error in "nosper"allocation of analysis module',il_err,1)
2823  nosper(:)=0
2824  ALLOCATE (notper(ig_nfield), stat=il_err)
2825  IF (il_err.NE.0) CALL prtout('Error in "notper"allocation of analysis module',il_err,1)
2826  notper(:)=0
2827  ALLOCATE (amskval(ig_nfield), stat=il_err)
2828  IF (il_err.NE.0) CALL prtout('Error in "amskval"allocation of analysis module',il_err,1)
2829  amskval(:)=0
2830  ALLOCATE (amskvalnew(ig_nfield), stat=il_err)
2831  IF (il_err.NE.0) CALL prtout('Error in "amskvalnew"allocation of analysis module',il_err,1)
2832  amskvalnew(:)=0
2833  ALLOCATE (acocoef(ig_maxcomb,ig_nfield), stat=il_err)
2834  IF (il_err.NE.0) CALL prtout('Error in "acocoef"allocation of analysis module',il_err,1)
2835  acocoef(:,:)=0
2836  ALLOCATE (abocoef(ig_maxcomb,ig_nfield), stat=il_err)
2837  IF (il_err.NE.0) CALL prtout('Error in "abocoef"allocation of analysis module',il_err,1)
2838  abocoef(:,:)=0
2839  ALLOCATE (abncoef(ig_maxcomb,ig_nfield), stat=il_err)
2840  IF (il_err.NE.0) CALL prtout('Error in "abncoef"allocation of analysis module',il_err,1)
2841  abncoef(:,:)=0
2842  ALLOCATE (afldcoef(ig_nfield), stat=il_err)
2843  IF (il_err.NE.0) CALL prtout('Error in "afldcoef"allocation of analysis module',il_err,1)
2844  afldcoef(:)=0
2845  ALLOCATE (afldcobo(ig_nfield), stat=il_err)
2846  IF (il_err.NE.0) CALL prtout('Error in "afldcobo"allocation of analysis module',il_err,1)
2847  afldcobo(:)=0
2848  ALLOCATE (afldcobn(ig_nfield), stat=il_err)
2849  IF (il_err.NE.0) CALL prtout('Error in "afldcobn"allocation of analysis module',il_err,1)
2850  afldcobn(:)=0
2851  ALLOCATE (cxordbf(ig_nfield), stat=il_err)
2852  IF (il_err.NE.0) CALL prtout('Error in "cxordbf"allocation of analysis module',il_err,1)
2853  cxordbf(:)=' '
2854  ALLOCATE (cyordbf(ig_nfield), stat=il_err)
2855  IF (il_err.NE.0) CALL prtout('Error in "cyordbf"allocation of analysis module',il_err,1)
2856  cyordbf(:)=' '
2857  ALLOCATE (cxordaf(ig_nfield), stat=il_err)
2858  IF (il_err.NE.0) CALL prtout('Error in "cxordaf"allocation of analysis module',il_err,1)
2859  cxordaf(:)=' '
2860  ALLOCATE (cyordaf(ig_nfield), stat=il_err)
2861  IF (il_err.NE.0) CALL prtout('Error in "cyordaf"allocation of analysis module',il_err,1)
2862  cyordaf(:)=' '
2863  ALLOCATE (cgrdtyp(ig_nfield), stat=il_err)
2864  IF (il_err.NE.0) CALL prtout('Error in "cgrdtyp"allocation of analysis module',il_err,1)
2865  cgrdtyp(:)=' '
2866  ALLOCATE (cfldtyp(ig_nfield), stat=il_err)
2867  IF (il_err.NE.0) CALL prtout('Error in "cfldtyp"allocation of analysis module',il_err,1)
2868  cfldtyp(:)=' '
2869  ALLOCATE (cfilfic(ig_nfield), stat=il_err)
2870  IF (il_err.NE.0) CALL prtout('Error in "cfilfic"allocation of analysis module',il_err,1)
2871  cfilfic(:)=' '
2872  ALLOCATE (cfilmet(ig_nfield), stat=il_err)
2873  IF (il_err.NE.0) CALL prtout('Error in "cfilmet"allocation of analysis module',il_err,1)
2874  cfilmet(:)=' '
2875  ALLOCATE (cconmet(ig_nfield), stat=il_err)
2876  IF (il_err.NE.0) CALL prtout('Error in "cconmet"allocation of analysis module',il_err,1)
2877  cconmet(:)=' '
2878  ALLOCATE (cconopt(ig_nfield), stat=il_err)
2879  IF (il_err.NE.0) CALL prtout('Error in "cconopt"allocation of analysis module',il_err,1)
2880  cconopt(:)=' '
2881  ALLOCATE (cfldcoa(ig_nfield), stat=il_err)
2882  IF (il_err.NE.0) CALL prtout('Error in "cfldcoa"allocation of analysis module',il_err,1)
2883  cfldcoa(:)=' '
2884  ALLOCATE (cfldfin(ig_nfield), stat=il_err)
2885  IF (il_err.NE.0) CALL prtout('Error in "cfldfin"allocation of analysis module',il_err,1)
2886  cfldfin(:)=' '
2887  ALLOCATE (ccofld(ig_maxcomb,ig_nfield), stat=il_err)
2888  IF (il_err.NE.0) CALL prtout('Error in "ccofld"allocation of analysis module',il_err,1)
2889  ccofld(:,:)=' '
2890  ALLOCATE (cbofld(ig_maxcomb,ig_nfield), stat=il_err)
2891  IF (il_err.NE.0) CALL prtout('Error in "cbofld"allocation of analysis module',il_err,1)
2892  cbofld(:,:)=' '
2893  ALLOCATE (cbnfld(ig_maxcomb,ig_nfield), stat=il_err)
2894  IF (il_err.NE.0) CALL prtout('Error in "cbnfld"allocation of analysis module',il_err,1)
2895  cbnfld(:,:)=' '
2896  ALLOCATE (ccofic(ig_maxcomb,ig_nfield), stat=il_err)
2897  IF (il_err.NE.0) CALL prtout('Error in "ccofic"allocation of analysis module',il_err,1)
2898  ccofic(:,:)=' '
2899  ALLOCATE (cdqdt(ig_nfield), stat=il_err)
2900  IF (il_err.NE.0) CALL prtout('Error in "cdqdt"allocation of analysis module',il_err,1)
2901  cdqdt(:)=' '
2902  ALLOCATE (cgrdmap(ig_nfield), stat=il_err)
2903  IF (il_err.NE.0) CALL prtout('Error in "cgrdmap"allocation of analysis module',il_err,1)
2904  cgrdmap(:)=' '
2905  ALLOCATE (cmskrd(ig_nfield), stat=il_err)
2906  IF (il_err.NE.0) CALL prtout('Error in "cmskrd"allocation of analysis module',il_err,1)
2907  cmskrd(:)=' '
2908  ALLOCATE (cgrdsub(ig_nfield), stat=il_err)
2909  IF (il_err.NE.0) CALL prtout('Error in "cgrdsub"allocation of analysis module',il_err,1)
2910  cgrdsub(:)=' '
2911  ALLOCATE (ctypsub(ig_nfield), stat=il_err)
2912  IF (il_err.NE.0) CALL prtout('Error in "ctypsub"allocation of analysis module',il_err,1)
2913  ctypsub(:)=' '
2914  ALLOCATE (cgrdext(ig_nfield), stat=il_err)
2915  IF (il_err.NE.0) CALL prtout('Error in "cgrdext"allocation of analysis module',il_err,1)
2916  cgrdext(:)=' '
2917  ALLOCATE (csper(ig_nfield), stat=il_err)
2918  IF (il_err.NE.0) CALL prtout('Error in "csper"allocation of analysis module',il_err,1)
2919  csper(:)=' '
2920  ALLOCATE (ctper(ig_nfield), stat=il_err)
2921  IF (il_err.NE.0) CALL prtout('Error in "ctper"allocation of analysis module',il_err,1)
2922  ctper(:)=' '
2923  ALLOCATE (lsurf(ig_nfield), stat=il_err)
2924  IF (il_err.NE.0) CALL prtout('Error in "lsurf"allocation of analysis module',il_err,1)
2925  lsurf(:)=.false.
2926  ALLOCATE (nscripvoi(ig_nfield), stat=il_err)
2927  IF (il_err.NE.0) CALL prtout('Error in nscripvoi allocation of analysis module',il_err,1)
2928  nscripvoi(:)=0
2929 !
2930 !* Alloc array needed for SCRIP
2931 !
2932  ALLOCATE (cmap_method(ig_nfield),stat=il_err)
2933  IF (il_err.NE.0) CALL prtout('Error in "cmap_method" allocation of '//trim(subname),il_err,1)
2934  cmap_method(:)=' '
2935  ALLOCATE (cmap_file(ig_nfield),stat=il_err)
2936  IF (il_err.NE.0) CALL prtout('Error in "cmap_file" allocation of '//trim(subname),il_err,1)
2937  cmap_file(:)=' '
2938  ALLOCATE (cmaptyp(ig_nfield),stat=il_err)
2939  IF (il_err.NE.0) CALL prtout('Error in "cmaptyp" allocation of '//trim(subname),il_err,1)
2940  cmaptyp(:)=' '
2941  ALLOCATE (cmapopt(ig_nfield),stat=il_err)
2942  IF (il_err.NE.0) CALL prtout('Error in "cmapopt" allocation of '//trim(subname),il_err,1)
2943  cmapopt(:)=' '
2944  ALLOCATE (cfldtype(ig_nfield),stat=il_err)
2945  IF (il_err.NE.0) CALL prtout('Error in "cfldtype"allocation of '//trim(subname),il_err,1)
2946  cfldtype(:)=' '
2947  ALLOCATE (crsttype(ig_nfield),stat=il_err)
2948  IF (il_err.NE.0) CALL prtout('Error in "crsttype"allocation of '//trim(subname),il_err,1)
2949  crsttype(:)=' '
2950  ALLOCATE (nbins(ig_nfield),stat=il_err)
2951  IF (il_err.NE.0) CALL prtout('Error in "nbins"allocation of '//trim(subname),il_err,1)
2952  nbins(:)=0
2953  ALLOCATE (cnorm_opt(ig_nfield),stat=il_err)
2954  IF (il_err.NE.0) CALL prtout('Error in "cnorm_opt"allocation of '//trim(subname),il_err,1)
2955  cnorm_opt(:)=' '
2956  ALLOCATE (corder(ig_nfield),stat=il_err)
2957  IF (il_err.NE.0) CALL prtout('Error in "corder"allocation of '//trim(subname),il_err,1)
2958  corder(:)=' '
2959 !
2960  !--- alloc_extrapol1
2961  ALLOCATE (niwtn(ig_nfield), stat=il_err)
2962  IF (il_err.NE.0) CALL prtout('Error in "niwtn"allocation of extrapol module',il_err,1)
2963  niwtn(:)=0
2964  ALLOCATE (niwtng(ig_nfield), stat=il_err)
2965  IF (il_err.NE.0) CALL prtout('Error in "niwtng"allocation of extrapol module',il_err,1)
2966  niwtng(:)=0
2967  ALLOCATE (lextra(ig_nfield), stat=il_err)
2968  IF (il_err.NE.0) CALL prtout('Error in "lextra"allocation of extrapol module',il_err,1)
2969  lextra(:)=.false.
2970  ALLOCATE (lweight(ig_nfield), stat=il_err)
2971  IF (il_err.NE.0) CALL prtout('Error in "lweight"allocation of extrapol module',il_err,1)
2972  lweight(:)=.false.
2973 
2974  !--- alloc_rainbow1
2975  ALLOCATE (lmapp(ig_nfield), stat=il_err)
2976  IF (il_err.NE.0) CALL prtout('Error in "lmapp"allocation of rainbow module',il_err,1)
2977  lmapp(:)=.false.
2978  ALLOCATE (lsubg(ig_nfield), stat=il_err)
2979  IF (il_err.NE.0) CALL prtout('Error in "lsubg"allocation of rainbow module',il_err,1)
2980  lsubg(:)=.false.
2981 
2982  !--- alloc_string
2983  ALLOCATE (cg_name_rstfile(ig_nbr_rstfile), stat=il_err)
2984  IF (il_err.NE.0) CALL prtout('Error in "cg_name_rstfile"allocation of string module',il_err,1)
2985  cg_name_rstfile(:)=' '
2986  ALLOCATE (ig_lag(ig_total_nfield), stat=il_err)
2987  IF (il_err.NE.0) CALL prtout('Error in "ig_lag"allocation of string module',il_err,1)
2988  ig_lag(:)=0
2989  ALLOCATE (ig_no_rstfile(ig_total_nfield), stat=il_err)
2990  IF (il_err.NE.0) CALL prtout('Error in "ig_no_rstfile"allocation of string module',il_err,1)
2991  ig_no_rstfile(:)=1
2992  ALLOCATE (cg_input_field(ig_total_nfield), stat=il_err)
2993  IF (il_err.NE.0) CALL prtout('Error in "cg_input_field"allocation of string module',il_err,1)
2994  cg_input_field(:)=' '
2995  ALLOCATE (ig_numlab(ig_total_nfield), stat=il_err)
2996  IF (il_err.NE.0) CALL prtout('Error in "ig_numlab"allocation of string module',il_err,1)
2997  ig_numlab(:)=0
2998  ALLOCATE (ig_freq(ig_total_nfield), stat=il_err)
2999  IF (il_err.NE.0) CALL prtout('Error in "ig_freq"allocation of string module',il_err,1)
3000  ig_freq(:)=0
3001  ALLOCATE (ig_total_nseqn(ig_total_nfield), stat=il_err)
3002  IF (il_err.NE.0) CALL prtout('Error in "ig_total_nseqn"allocation of string module',il_err,1)
3003  ig_total_nseqn(:)=0
3004  ALLOCATE (ig_local_trans(ig_total_nfield), stat=il_err)
3005  IF (il_err.NE.0) CALL prtout('Error in "ig_local_trans"allocation of string module',il_err,1)
3006  ig_local_trans(:)=0
3007  ALLOCATE (ig_invert(ig_total_nfield), stat=il_err)
3008  IF (il_err.NE.0) CALL prtout('Error in "ig_invert" allocation of string module',il_err,1)
3009  ig_invert(:)=0
3010  ALLOCATE (ig_reverse(ig_total_nfield), stat=il_err)
3011  IF (il_err.NE.0) CALL prtout('Error in "ig_reverse" allocation of string module',il_err,1)
3012  ig_reverse(:)=0
3013 !
3014 !** + Allocate following arrays only if one field (at least) goes
3015 ! through Oasis
3016 !
3017  IF (lg_oasis_field) THEN
3018  ALLOCATE (numlab(ig_nfield), stat=il_err)
3019  IF (il_err.NE.0) CALL prtout('Error in "numlab"allocation of string module',il_err,1)
3020  numlab(:)=0
3021  ALLOCATE (nfexch(ig_nfield), stat=il_err)
3022  IF (il_err.NE.0) CALL prtout('Error in "nfexch"allocation of string module',il_err,1)
3023  nfexch(:)=0
3024  ALLOCATE (nseqn(ig_nfield), stat=il_err)
3025  IF (il_err.NE.0) CALL prtout('Error in "nseqn"allocation of string module',il_err,1)
3026  nseqn(:)=0
3027  ALLOCATE (nlagn(ig_nfield), stat=il_err)
3028  IF (il_err.NE.0) CALL prtout('Error in "nlagn" allocation of string module',il_err,1)
3029  nlagn(:)=0
3030  ALLOCATE (cnaminp(ig_nfield), stat=il_err)
3031  IF (il_err.NE.0) CALL prtout('Error in "cnaminp"allocation of string module',il_err,1)
3032  cnaminp(:)=' '
3033  ALLOCATE (cnamout(ig_nfield), stat=il_err)
3034  IF (il_err.NE.0) CALL prtout('Error in "cnamout"allocation of string module',il_err,1)
3035  cnamout(:)=' '
3036  ALLOCATE (cficout(ig_nfield), stat=il_err)
3037  IF (il_err.NE.0) CALL prtout('Error in "cficout"allocation of string module',il_err,1)
3038  cficout(:)=' '
3039  ALLOCATE (cstate(ig_nfield), stat=il_err)
3040  IF (il_err.NE.0) CALL prtout('Error in "cstate"allocation of string module',il_err,1)
3041  cstate(:)=' '
3042  ENDIF
3043 
3044 ! CALL oasis_debug_exit(subname)
3045 
3046 END SUBROUTINE alloc
3047 
3048 !===============================================================================
3049 
3050 !> Deallocates temporary arrays for namcouple input
3051 
3052 SUBROUTINE dealloc()
3054  IMPLICIT NONE
3055 
3056  CHARACTER(len=*),parameter :: subname='(mod_oasis_namcouple:dealloc)'
3057 
3058  !--- alloc_anais1
3059  DEALLOCATE (varmul, stat=il_err)
3060  IF (il_err.NE.0) CALL prtout('Error in "varmul"deallocation of anais module',il_err,1)
3061  DEALLOCATE (niwtm, stat=il_err)
3062  IF (il_err.NE.0) CALL prtout('Error in "niwtm"deallocation of anais module',il_err,1)
3063  DEALLOCATE (niwtg, stat=il_err)
3064  IF (il_err.NE.0) CALL prtout('Error in "niwtg"deallocation of anais module',il_err,1)
3065  deallocate (linit, stat=il_err)
3066  IF (il_err.ne.0) CALL prtout('error in "linit"deallocation of anais module',il_err,1)
3067 
3068  !--- alloc_analysis
3069  DEALLOCATE (ncofld, stat=il_err)
3070  IF (il_err.NE.0) CALL prtout('Error in "ncofld"deallocation of analysis module',il_err,1)
3071  DEALLOCATE (neighborg, stat=il_err)
3072  IF (il_err.NE.0) CALL prtout('Error in "neighborg"deallocation of analysis module',il_err,1)
3073  DEALLOCATE (nludat, stat=il_err)
3074  IF (il_err.NE.0) CALL prtout('Error in "nludat"deallocation of analysis module',il_err,1)
3075  DEALLOCATE (nlufil, stat=il_err)
3076  IF (il_err.NE.0) CALL prtout('Error in "nlufil"deallocation of analysis module',il_err,1)
3077  DEALLOCATE (nlumap, stat=il_err)
3078  IF (il_err.NE.0) CALL prtout('Error in "nlumap"deallocation of analysis module',il_err,1)
3079  DEALLOCATE (nlusub, stat=il_err)
3080  IF (il_err.NE.0) CALL prtout('Error in "nlusub"deallocation of analysis module',il_err,1)
3081  DEALLOCATE (nluext, stat=il_err)
3082  IF (il_err.NE.0) CALL prtout('Error in "nluext"deallocation of analysis module',il_err,1)
3083  DEALLOCATE (nosper, stat=il_err)
3084  IF (il_err.NE.0) CALL prtout('Error in "nosper"deallocation of analysis module',il_err,1)
3085  DEALLOCATE (notper, stat=il_err)
3086  IF (il_err.NE.0) CALL prtout('Error in "notper"deallocation of analysis module',il_err,1)
3087  DEALLOCATE (amskval, stat=il_err)
3088  IF (il_err.NE.0) CALL prtout('Error in "amskval"deallocation of analysis module',il_err,1)
3089  DEALLOCATE (amskvalnew, stat=il_err)
3090  IF (il_err.NE.0) CALL prtout('Error in "amskvalnew"deallocation of analysis module',il_err,1)
3091  DEALLOCATE (acocoef, stat=il_err)
3092  IF (il_err.NE.0) CALL prtout('Error in "acocoef"deallocation of analysis module',il_err,1)
3093  DEALLOCATE (abocoef, stat=il_err)
3094  IF (il_err.NE.0) CALL prtout('Error in "abocoef"deallocation of analysis module',il_err,1)
3095  DEALLOCATE (abncoef, stat=il_err)
3096  IF (il_err.NE.0) CALL prtout('Error in "abncoef"deallocation of analysis module',il_err,1)
3097  DEALLOCATE (afldcoef, stat=il_err)
3098  IF (il_err.NE.0) CALL prtout('Error in "afldcoef"deallocation of analysis module',il_err,1)
3099  DEALLOCATE (afldcobo, stat=il_err)
3100  IF (il_err.NE.0) CALL prtout('Error in "afldcobo"deallocation of analysis module',il_err,1)
3101  DEALLOCATE (afldcobn, stat=il_err)
3102  IF (il_err.NE.0) CALL prtout('Error in "afldcobn"deallocation of analysis module',il_err,1)
3103  DEALLOCATE (cxordbf, stat=il_err)
3104  IF (il_err.NE.0) CALL prtout('Error in "cxordbf"deallocation of analysis module',il_err,1)
3105  DEALLOCATE (cyordbf, stat=il_err)
3106  IF (il_err.NE.0) CALL prtout('Error in "cyordbf"deallocation of analysis module',il_err,1)
3107  DEALLOCATE (cxordaf, stat=il_err)
3108  IF (il_err.NE.0) CALL prtout('Error in "cxordaf"deallocation of analysis module',il_err,1)
3109  DEALLOCATE (cyordaf, stat=il_err)
3110  IF (il_err.NE.0) CALL prtout('Error in "cyordaf"deallocation of analysis module',il_err,1)
3111  DEALLOCATE (cgrdtyp, stat=il_err)
3112  IF (il_err.NE.0) CALL prtout('Error in "cgrdtyp"deallocation of analysis module',il_err,1)
3113  DEALLOCATE (cfldtyp, stat=il_err)
3114  IF (il_err.NE.0) CALL prtout('Error in "cfldtyp"deallocation of analysis module',il_err,1)
3115  DEALLOCATE (cfilfic, stat=il_err)
3116  IF (il_err.NE.0) CALL prtout('Error in "cfilfic"deallocation of analysis module',il_err,1)
3117  DEALLOCATE (cfilmet, stat=il_err)
3118  IF (il_err.NE.0) CALL prtout('Error in "cfilmet"deallocation of analysis module',il_err,1)
3119  DEALLOCATE (cconmet, stat=il_err)
3120  IF (il_err.NE.0) CALL prtout('Error in "cconmet"deallocation of analysis module',il_err,1)
3121  DEALLOCATE (cconopt, stat=il_err)
3122  IF (il_err.NE.0) CALL prtout('Error in "cconopt"deallocation of analysis module',il_err,1)
3123  DEALLOCATE (cfldcoa, stat=il_err)
3124  IF (il_err.NE.0) CALL prtout('Error in "cfldcoa"deallocation of analysis module',il_err,1)
3125  DEALLOCATE (cfldfin, stat=il_err)
3126  IF (il_err.NE.0) CALL prtout('Error in "cfldfin"deallocation of analysis module',il_err,1)
3127  DEALLOCATE (ccofld, stat=il_err)
3128  IF (il_err.NE.0) CALL prtout('Error in "ccofld"deallocation of analysis module',il_err,1)
3129  DEALLOCATE (cbofld, stat=il_err)
3130  IF (il_err.NE.0) CALL prtout('Error in "cbofld"deallocation of analysis module',il_err,1)
3131  DEALLOCATE (cbnfld, stat=il_err)
3132  IF (il_err.NE.0) CALL prtout('Error in "cbnfld"deallocation of analysis module',il_err,1)
3133  DEALLOCATE (ccofic, stat=il_err)
3134  IF (il_err.NE.0) CALL prtout('Error in "ccofic"deallocation of analysis module',il_err,1)
3135  DEALLOCATE (cdqdt, stat=il_err)
3136  IF (il_err.NE.0) CALL prtout('Error in "cdqdt"deallocation of analysis module',il_err,1)
3137  DEALLOCATE (cgrdmap, stat=il_err)
3138  IF (il_err.NE.0) CALL prtout('Error in "cgrdmap"deallocation of analysis module',il_err,1)
3139  DEALLOCATE (cmskrd, stat=il_err)
3140  IF (il_err.NE.0) CALL prtout('Error in "cmskrd"deallocation of analysis module',il_err,1)
3141  DEALLOCATE (cgrdsub, stat=il_err)
3142  IF (il_err.NE.0) CALL prtout('Error in "cgrdsub"deallocation of analysis module',il_err,1)
3143  DEALLOCATE (ctypsub, stat=il_err)
3144  IF (il_err.NE.0) CALL prtout('Error in "ctypsub"deallocation of analysis module',il_err,1)
3145  DEALLOCATE (cgrdext, stat=il_err)
3146  IF (il_err.NE.0) CALL prtout('Error in "cgrdext"deallocation of analysis module',il_err,1)
3147  DEALLOCATE (csper, stat=il_err)
3148  IF (il_err.NE.0) CALL prtout('Error in "csper"deallocation of analysis module',il_err,1)
3149  DEALLOCATE (ctper, stat=il_err)
3150  IF (il_err.NE.0) CALL prtout('Error in "ctper"deallocation of analysis module',il_err,1)
3151  DEALLOCATE (lsurf, stat=il_err)
3152  IF (il_err.NE.0) CALL prtout('Error in "lsurf"deallocation of analysis module',il_err,1)
3153  DEALLOCATE (nscripvoi, stat=il_err)
3154  IF (il_err.NE.0) CALL prtout('Error in nscripvoi deallocation of analysis module',il_err,1)
3155 !
3156 !* Alloc array needed for SCRIP
3157 !
3158  DEALLOCATE (cmap_method,stat=il_err)
3159  IF (il_err.NE.0) CALL prtout('Error in "cmap_method" deallocation of scrip module',il_err,1)
3160  DEALLOCATE (cmap_file,stat=il_err)
3161  IF (il_err.NE.0) CALL prtout('Error in "cmap_file" deallocation of scrip module',il_err,1)
3162  DEALLOCATE (cmaptyp,stat=il_err)
3163  IF (il_err.NE.0) CALL prtout('Error in "cmaptyp" deallocation of scrip module',il_err,1)
3164  DEALLOCATE (cmapopt,stat=il_err)
3165  IF (il_err.NE.0) CALL prtout('Error in "cmapopt" deallocation of scrip module',il_err,1)
3166  DEALLOCATE (cfldtype,stat=il_err)
3167  IF (il_err.NE.0) CALL prtout('Error in "cfldtype"deallocation of scrip module',il_err,1)
3168  DEALLOCATE (crsttype,stat=il_err)
3169  IF (il_err.NE.0) CALL prtout('Error in "crsttype"deallocation of scrip module',il_err,1)
3170  DEALLOCATE (nbins,stat=il_err)
3171  IF (il_err.NE.0) CALL prtout('Error in "nbins"deallocation of scrip module',il_err,1)
3172  DEALLOCATE (cnorm_opt,stat=il_err)
3173  IF (il_err.NE.0) CALL prtout('Error in "cnorm_opt"deallocation of scrip module',il_err,1)
3174  DEALLOCATE (corder,stat=il_err)
3175  IF (il_err.NE.0) CALL prtout('Error in "corder"deallocation of scrip module',il_err,1)
3176  !
3177  !--- alloc_extrapol1
3178  DEALLOCATE (niwtn, stat=il_err)
3179  IF (il_err.NE.0) CALL prtout('Error in "niwtn"deallocation of extrapol module',il_err,1)
3180  DEALLOCATE (niwtng, stat=il_err)
3181  IF (il_err.NE.0) CALL prtout('Error in "niwtng"deallocation of extrapol module',il_err,1)
3182  DEALLOCATE (lextra, stat=il_err)
3183  IF (il_err.NE.0) CALL prtout('Error in "lextra"deallocation of extrapol module',il_err,1)
3184  DEALLOCATE (lweight, stat=il_err)
3185  IF (il_err.NE.0) CALL prtout('Error in "lweight"deallocation of extrapol module',il_err,1)
3186 
3187  !--- alloc_rainbow1
3188  DEALLOCATE (lmapp, stat=il_err)
3189  IF (il_err.NE.0) CALL prtout('Error in "lmapp"deallocation of rainbow module',il_err,1)
3190  DEALLOCATE (lsubg, stat=il_err)
3191  IF (il_err.NE.0) CALL prtout('Error in "lsubg"deallocation of rainbow module',il_err,1)
3192 
3193  !--- alloc_string
3194  DEALLOCATE (cg_name_rstfile, stat=il_err)
3195  IF (il_err.NE.0) CALL prtout('Error in "cg_name_rstfile"deallocation of string module',il_err,1)
3196  DEALLOCATE (ig_lag, stat=il_err)
3197  IF (il_err.NE.0) CALL prtout('Error in "ig_lag"deallocation of string module',il_err,1)
3198  DEALLOCATE (ig_no_rstfile, stat=il_err)
3199  IF (il_err.NE.0) CALL prtout('Error in "ig_no_rstfile"deallocation of string module',il_err,1)
3200  DEALLOCATE (cg_input_field, stat=il_err)
3201  IF (il_err.NE.0) CALL prtout('Error in "cg_input_field"deallocation of string module',il_err,1)
3202  DEALLOCATE (ig_numlab, stat=il_err)
3203  IF (il_err.NE.0) CALL prtout('Error in "ig_numlab"deallocation of string module',il_err,1)
3204  DEALLOCATE (ig_freq, stat=il_err)
3205  IF (il_err.NE.0) CALL prtout('Error in "ig_freq"deallocation of string module',il_err,1)
3206  DEALLOCATE (ig_total_nseqn, stat=il_err)
3207  IF (il_err.NE.0) CALL prtout('Error in "ig_total_nseqn"deallocation of string module',il_err,1)
3208  DEALLOCATE (ig_local_trans, stat=il_err)
3209  IF (il_err.NE.0) CALL prtout('Error in "ig_local_trans"deallocation of string module',il_err,1)
3210  DEALLOCATE (ig_invert, stat=il_err)
3211  IF (il_err.NE.0) CALL prtout('Error in "ig_invert" deallocation of string module',il_err,1)
3212  DEALLOCATE (ig_reverse, stat=il_err)
3213  IF (il_err.NE.0) CALL prtout('Error in "ig_reverse" deallocation of string module',il_err,1)
3214 !
3215 !** + Deallocate following arrays only if one field (at least) goes
3216 ! through Oasis
3217 !
3218  IF (lg_oasis_field) THEN
3219  DEALLOCATE (numlab, stat=il_err)
3220  IF (il_err.NE.0) CALL prtout('Error in "numlab"deallocation of string module',il_err,1)
3221  DEALLOCATE (nfexch, stat=il_err)
3222  IF (il_err.NE.0) CALL prtout('Error in "nfexch"deallocation of string module',il_err,1)
3223  DEALLOCATE (nseqn, stat=il_err)
3224  IF (il_err.NE.0) CALL prtout('Error in "nseqn"deallocation of string module',il_err,1)
3225  DEALLOCATE (nlagn, stat=il_err)
3226  IF (il_err.NE.0) CALL prtout('Error in "nlagn" deallocation of string module',il_err,1)
3227  DEALLOCATE (cnaminp, stat=il_err)
3228  IF (il_err.NE.0) CALL prtout('Error in "cnaminp"deallocation of string module',il_err,1)
3229  DEALLOCATE (cnamout, stat=il_err)
3230  IF (il_err.NE.0) CALL prtout('Error in "cnamout"deallocation of string module',il_err,1)
3231  DEALLOCATE (cficout, stat=il_err)
3232  IF (il_err.NE.0) CALL prtout('Error in "cficout"deallocation of string module',il_err,1)
3233  DEALLOCATE (cstate, stat=il_err)
3234  IF (il_err.NE.0) CALL prtout('Error in "cstate"deallocation of string module',il_err,1)
3235  ENDIF
3236 
3237 ! CALL oasis_debug_exit(subname)
3238 
3239 END SUBROUTINE dealloc
3240 
3241 !===============================================================================
3242 
3243 !> Prints information passed by argument
3244 
3245 SUBROUTINE prtout(cdtext, kvalue, kstyle)
3247 !****
3248 ! *****************************
3249 ! * OASIS ROUTINE - LEVEL 1 *
3250 ! * ------------- ------- *
3251 ! *****************************
3252 !
3253 !**** *prtout* - Print output
3254 !
3255 ! Purpose:
3256 ! -------
3257 ! Print out CHARACTER string and one INTEGER value
3258 !
3259 !** Interface:
3260 ! ---------
3261 ! *CALL* *prtout(cdtext, kvalue, kstyle)*
3262 !
3263 ! Input:
3264 ! -----
3265 ! cdtext : CHARACTER string to be printed
3266 ! kvalue : INTEGER variable to be printed
3267 ! kstyle : printing style
3268 !
3269 ! Output:
3270 ! ------
3271 ! None
3272 !
3273 ! Workspace:
3274 ! ---------
3275 !
3276 ! Externals:
3277 ! ---------
3278 ! None
3279 !
3280 ! Reference:
3281 ! ---------
3282 ! See OASIS manual (1995)
3283 !
3284 ! History:
3285 ! -------
3286 ! Version Programmer Date Description
3287 ! ------- ---------- ---- -----------
3288 ! 2.0 L. Terray 95/10/01 created
3289 ! 2.3 L. Terray 99/02/24 modified: X format for NEC
3290 !
3291 ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3292 
3293  IMPLICIT NONE
3294 !
3295 !* ---------------------------- Include files ---------------------------
3296 !
3297 !
3298 !* ---------------------------- Argument declarations ----------------------
3299 !
3300  CHARACTER(len=*),intent(in) :: cdtext !< character string to be printed
3301  INTEGER (kind=ip_intwp_p),intent(in) :: kvalue !< integer to be printed
3302  INTEGER (kind=ip_intwp_p),intent(in) :: kstyle !< printing style
3303 
3304 !* ---------------------------- Local declarations ----------------------
3305 
3306  INTEGER(kind=ip_intwp_p) :: ilen,jl
3307  CHARACTER*69 cline
3308  CHARACTER(len=*),PARAMETER :: cbase = '-'
3309  CHARACTER(len=*),PARAMETER :: cprpt = '* ===>>> :'
3310  CHARACTER(len=*),PARAMETER :: cdots = ' ------ '
3311  CHARACTER(len=*),parameter :: subname='(mod_oasis_namcouple:prtout)'
3312 
3313 !* ---------------------------- Poema verses ----------------------------
3314 
3315 ! CALL oasis_debug_enter(subname)
3316 
3317 ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3318 
3319 !* 1. Print CHARACTER string + INTEGER value
3320 ! --------------------------------------
3321 
3322  IF (mpi_rank_global == 0) THEN
3323  IF ( kstyle .EQ. 1 .OR. kstyle .EQ. 2) THEN
3324  cline = ' '
3325  ilen = len(cdtext)
3326  DO jl = 1, ilen
3327  cline(jl:jl) = cbase
3328  ENDDO
3329 
3330  IF ( kstyle .EQ. 2 ) THEN
3331  WRITE(nulprt1, fmt='(/,A,1X,A)') cdots, cline
3332  ENDIF
3333  WRITE(nulprt1, fmt='(A,1X,A,1X,I18)') cprpt, cdtext, kvalue
3334  WRITE(nulprt1, fmt='(A,1X,A,/)') cdots, cline
3335  ELSE
3336  WRITE(nulprt1, fmt='(/,A,1X,A,1X,I18,/)') cprpt, cdtext, kvalue
3337  ENDIF
3338 
3339 !* 2. End of routine
3340 ! --------------
3341 
3342  CALL oasis_flush(nulprt1)
3343  ENDIF
3344 
3345 ! CALL oasis_debug_exit(subname)
3346 
3347 END SUBROUTINE prtout
3348 
3349 !===============================================================================
3350 
3351 !> Searches for a particular keyword in the namcouple file
3352 
3353 SUBROUTINE findkeyword (keyword, line, found)
3355 !****
3356 ! *****************************
3357 ! * OASIS ROUTINE - LEVEL T *
3358 ! * ------------- ------- *
3359 ! *****************************
3360 !
3361 !**** *findkeyword* - Searches for a particular keyword in the namcouple file
3362 !
3363 ! Purpose:
3364 ! -------
3365 ! Find the line with the specified keyword
3366 !
3367 !** Interface:
3368 ! ---------
3369 ! *CALL* *findkeyword (keyword, line, found) *
3370 !
3371 ! Input:
3372 ! -----
3373 ! keyword : string to search for (CHARACTER string)
3374 !
3375 ! Output:
3376 ! ------
3377 ! line : full line that contains the keyword (CHARACTER string)
3378 ! found : flag indicating whether keyword was found (logical)
3379 !
3380 ! History:
3381 ! -------
3382 ! Version Programmer Date Description
3383 ! ------- ---------- ---- -----------
3384 ! 3.3 T. Craig 2016/08/02 created
3385 !
3386 ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3387 !
3388  IMPLICIT NONE
3389 !
3390 !* ---------------------------- Include files ---------------------------
3391 !
3392 !
3393 !* ---------------------------- Argument declarations -------------------
3394 !
3395  CHARACTER (len=*) , INTENT ( in) :: keyword !< keyword string
3396  CHARACTER (len=*) , INTENT (out) :: line !< line containing keyword
3397  LOGICAL , INTENT (out) :: found !< flag if keyword was found
3398 !
3399 !* ---------------------------- Local declarations -------------------
3400 !
3401  CHARACTER (len=jpeighty) :: clline
3402  CHARACTER (len=jpeighty) :: clvari
3403  INTEGER (kind=ip_intwp_p):: ILEN, ios, ios2
3404  CHARACTER(len=*),parameter :: subname='(mod_oasis_namcouple:findkeyword)'
3405 !
3406 !* ---------------------------- Poema verses ----------------------------
3407 
3408 ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3409 
3410 ! CALL oasis_debug_enter(subname)
3411 
3412  found = .false.
3413  ios2 = 0
3414 
3415  rewind nulin
3416  DO WHILE (.not.found)
3417  READ(nulin, fmt=rform, end=110, iostat=ios2) clline
3418  if (ios2 == 0) then
3419  CALL skip(clline,jpeighty, ios=ios)
3420 ! write(nulprt1,*) trim(subname),'tcx1: ',trim(clline)
3421  IF (ios == 0) THEN
3422  CALL parse(clline, clvari, 1, jpeighty, ilen, __line__)
3423 ! write(nulprt1,*) trim(subname),'tcx2: ',trim(clvari),trim(keyword)
3424  IF (clvari == adjustl(keyword)) THEN
3425  line = clline
3426  found = .true.
3427  ENDIF
3428  ENDIF
3429  else
3430  goto 110
3431  endif
3432  ENDDO
3433 
3434 110 CONTINUE
3435 
3436 ! CALL oasis_debug_exit(subname)
3437  return
3438 
3439 END SUBROUTINE findkeyword
3440 
3441 !===============================================================================
3442 
3443 !< Checks whether a line is a comment line
3444 
3445 LOGICAL FUNCTION checkcomment (line)
3447 !****
3448 ! *****************************
3449 ! * OASIS ROUTINE - LEVEL T *
3450 ! * ------------- ------- *
3451 ! *****************************
3452 !
3453 !**** *checkcomment* - Checks whether the line is a comment line (starts with # or is blank)
3454 !
3455 ! Purpose:
3456 ! -------
3457 ! Check whether a line is a comment line or a blank line
3458 !
3459 !** Interface:
3460 ! ---------
3461 ! flag = checkcomment (line) *
3462 !
3463 ! Input:
3464 ! -----
3465 ! line : full line to test
3466 !
3467 ! Output:
3468 ! ------
3469 ! checkcomment : flag indicating whether line is a comment line or not
3470 !
3471 ! History:
3472 ! -------
3473 ! Version Programmer Date Description
3474 ! ------- ---------- ---- -----------
3475 ! 3.3 T. Craig 2016/08/02 created
3476 !
3477 ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3478 !
3479  IMPLICIT NONE
3480 !
3481 !* ---------------------------- Include files ---------------------------
3482 !
3483 !
3484 !* ---------------------------- Argument declarations -------------------
3485 !
3486  CHARACTER (len=*) , INTENT (in) :: line !< input character line
3487 !
3488 !* ---------------------------- Local declarations -------------------
3489 !
3490  CHARACTER (len=jpeighty) :: clline
3491  CHARACTER (len=1), SAVE :: clblank = ' ', clcmt = '#'
3492  CHARACTER(len=*),parameter :: subname='(mod_oasis_namcouple:checkcomment)'
3493 !
3494 !* ---------------------------- Poema verses ----------------------------
3495 
3496 ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3497 
3498 ! CALL oasis_debug_enter(subname)
3499 
3500  checkcomment = .false.
3501 
3502  clline = adjustl(line)
3503  IF (clline(1:1) == clcmt .or. len_trim(clline) == 0) THEN
3504  checkcomment = .true.
3505  ENDIF
3506 
3507 ! CALL oasis_debug_exit(subname)
3508  return
3509 
3510 END FUNCTION checkcomment
3511 
3512 !===============================================================================
3513 
3514 !> Subroutine to parse string
3515 
3516 SUBROUTINE parse (cdone, cdtwo, knumb, klen, kleng, line)
3518 !****
3519 ! *****************************
3520 ! * OASIS ROUTINE - LEVEL T *
3521 ! * ------------- ------- *
3522 ! *****************************
3523 !
3524 !**** *parse* - Parsing routine
3525 !
3526 ! Purpose:
3527 ! -------
3528 ! Find the knumb'th string in cdone and put it in cdtwo.
3529 ! A string is defined as a continuous set of non-blanks CHARACTERs
3530 !
3531 !** Interface:
3532 ! ---------
3533 ! *CALL* *parse (cdone, cdtwo, knumb, klen, kleng)*
3534 !
3535 ! Input:
3536 ! -----
3537 ! cdone : line to be parsed (char string)
3538 ! knumb : rank within the line of the extracted string (INTEGER)
3539 ! klen : length of the input line (INTEGER)
3540 ! line : line where parse is called (INTEGER)
3541 !
3542 ! Output:
3543 ! ------
3544 ! cdtwo : extracted CHARACTER string (char string)
3545 ! kleng : length of the extracted string (INTEGER)
3546 !
3547 ! Workspace:
3548 ! ---------
3549 ! None
3550 !
3551 ! Externals:
3552 ! ---------
3553 !
3554 ! Reference:
3555 ! ---------
3556 ! See OASIS manual (1995)
3557 !
3558 ! History:
3559 ! -------
3560 ! Version Programmer Date Description
3561 ! ------- ---------- ---- -----------
3562 ! 2.0 L. Terray 95/09/01 created
3563 ! O. Marti 2000/11/08 simplify by using F90
3564 ! CHARACTER functions
3565 ! 3.3 T. Craig 2016/08/02 updated
3566 !
3567 ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3568 !
3569  IMPLICIT NONE
3570 !
3571 !* ---------------------------- Include files ---------------------------
3572 !
3573 !
3574 !* ---------------------------- Argument declarations -------------------
3575 !
3576  CHARACTER (len=*) , INTENT (inout) :: cdone !< line to parse
3577  INTEGER (kind=ip_intwp_p), INTENT ( in) :: knumb !< rank within line of extracted string
3578  INTEGER (kind=ip_intwp_p), INTENT ( in) :: klen !< length of input line
3579  INTEGER (kind=ip_intwp_p), INTENT ( in) :: line !< file line number of call
3580  CHARACTER (len=*) , INTENT (out) :: cdtwo !< extracted string
3581  INTEGER (kind=ip_intwp_p), INTENT (out) :: kleng !< length of extracted string
3582 !
3583 !* ---------------------------- Local declarations -------------------
3584 !
3585  INTEGER(kind=ip_intwp_p) :: ii,jl
3586  CHARACTER (len=klen) :: clline
3587  CHARACTER (len=klen) :: clwork
3588  CHARACTER (len=1), SAVE :: clblank = ' ', clcmt = '#'
3589  CHARACTER(len=*),parameter :: subname='(mod_oasis_namcouple:parse)'
3590 !
3591 !* ---------------------------- Poema verses ----------------------------
3592 
3593 ! CALL oasis_debug_enter(subname)
3594 !
3595 ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3596 
3597 !* - Abort if line is a comment
3598 
3599  IF (checkcomment(cdone)) THEN
3600  write(tmpstr1,*) subname,' ERROR comment line found:', trim(cdone)
3601  write(tmpstr1,*) subname,' ERROR called from :',line
3602  CALL namcouple_abort(subname,__line__,tmpstr1)
3603  ENDIF
3604 
3605 !* - DO the extraction job
3606 !* - Fill temporary string and remove leading blanks
3607 
3608  clwork = adjustl(cdone)
3609 
3610 !* - Fill cdtwo with blanks
3611 
3612  cdtwo = clblank
3613 
3614 !* - If there are no more CHARACTERs, kleng=-1
3615 
3616  IF ( len_trim( clwork) .LE. 0) THEN
3617  kleng = -1
3618 ! CALL oasis_debug_exit(subname)
3619  RETURN
3620  ENDIF
3621 
3622 !* - If this is the one we're looking for, skip
3623 ! otherwise go knumb-1 more sets of CHARACTERs
3624 
3625  IF (knumb .GE. 2) THEN
3626  DO jl = 1, knumb-1
3627  ii = index( clwork, clblank) - 1
3628  clwork( 1:ii) = clblank
3629  clwork = adjustl( clwork)
3630 
3631 !* - If there are no more CHARACTERs, kleng=-1
3632 
3633  IF (len_trim( clwork) .LE. 0) THEN
3634  kleng = -1
3635 ! CALL oasis_debug_exit(subname)
3636  RETURN
3637  ENDIF
3638  ENDDO
3639  ENDIF
3640 
3641 !* - Find the length of this set of CHARACTERs
3642 
3643  kleng = index( clwork, clblank) - 1
3644 
3645 !* - Copy to cdtwo
3646 
3647  cdtwo( 1:kleng) = clwork( 1: kleng)
3648 
3649 ! CALL oasis_debug_exit(subname)
3650 
3651  return
3652 
3653 END SUBROUTINE parse
3654 
3655 !===============================================================================
3656 
3657 !< subroutine to fine next non-comment line
3658 
3659 SUBROUTINE skip (cd_one, id_len, endflag, ios)
3661 !**** SKIP
3662 !
3663 ! Purpose:
3664 ! Find next non-comment line
3665 !
3666 ! Interface:
3667 ! CALL skip (cd_one, id_len, endflag)
3668 !
3669 ! Method:
3670 ! Read the first CHARACTER of the line and skip line if
3671 ! it is a comment
3672 !
3673 ! External:
3674 ! none
3675 !
3676 ! Files:
3677 ! none
3678 !
3679 ! References:
3680 !
3681 ! History:
3682 ! --------
3683 ! Version Programmer Date Description
3684 ! ------------------------------------------------
3685 ! 2.5 A.Caubel 2002/04/04 created
3686 ! 3.3 T. Craig 2016/08/02 updated
3687 !
3688 !*-----------------------------------------------------------------------
3689 !
3690  IMPLICIT NONE
3691 !
3692 !** + DECLARATIONS
3693 !
3694 !
3695 !** ++ Include files
3696 !
3697 !** ++ Argument declarations
3698 !
3699  CHARACTER(len=*),intent(inout) :: cd_one !< namcouple line
3700  INTEGER (kind=ip_intwp_p),intent(in) :: id_len !< length of line
3701  LOGICAL, optional, intent(inout) :: endflag !< flag indicating eof reached
3702  INTEGER (kind=ip_intwp_p), OPTIONAL, INTENT(out) :: ios !< return code
3703 !
3704 !** ++ Local declarations
3705 !
3706  CHARACTER(len=id_len) :: cl_line
3707  LOGICAL :: found
3708  CHARACTER(len=*),parameter :: subname='(mod_oasis_namcouple:skip)'
3709 !
3710 !*-----------------------------------------------------------------------
3711 !
3712 ! CALL oasis_debug_enter(subname)
3713 
3714  IF (present(endflag)) endflag = .false.
3715  IF (present(ios)) ios = 0
3716  cl_line = cd_one
3717  found = .false.
3718 
3719  DO WHILE (.not.found)
3720  IF (checkcomment(cl_line)) THEN
3721  READ(nulin, fmt=rform, end=140, iostat=ios) cl_line
3722  ELSE
3723  found = .true.
3724  ENDIF
3725  ENDDO
3726 
3727 140 CONTINUE
3728 
3729  IF (found) THEN
3730  cd_one = cl_line
3731  ELSE
3732  IF (present(endflag)) endflag = .true.
3733  IF (PRESENT(ios)) ios = -1
3734  ENDIF
3735 
3736 ! CALL oasis_debug_exit(subname)
3737  RETURN
3738 
3739 END SUBROUTINE skip
3740 
3741 !*========================================================================
3742 
3743 !> Subroutine that calls abort in this module
3744 
3745 SUBROUTINE namcouple_abort(isubname,lineno,string1,string2,string3,string4)
3747  ! * Reusable Abort routine
3748 
3749  IMPLICIT NONE
3750  CHARACTER(len=*),intent(in) :: isubname !< subroutine name of abort
3751  INTEGER ,intent(in) :: lineno !< file line number
3752  CHARACTER(len=*),intent(in),optional :: string1 !< optional output string
3753  CHARACTER(len=*),intent(in),optional :: string2 !< optional output string
3754  CHARACTER(len=*),intent(in),optional :: string3 !< optional output string
3755  CHARACTER(len=*),intent(in),optional :: string4 !< optional output string
3756 
3757 !** ++ Local declarations
3758 
3759  CHARACTER(len=*),parameter :: subname='(mod_oasis_namcouple:namcouple_abort)'
3760 
3761 !*-----------------------------------------------------------------------
3762 
3763 ! CALL oasis_debug_enter(subname)
3764 
3765  IF (mpi_rank_global == 0) THEN
3766  WRITE(nulprt1,*) ' '
3767  WRITE(nulprt1,*) subname,' calling ABORT'
3768  WRITE(nulprt1,*) ' **** ABORT from ',trim(isubname),' line number ',lineno
3769  IF (present(string1)) WRITE(nulprt1,*) ' **** ',trim(isubname),' : ',trim(string1)
3770  IF (present(string2)) WRITE(nulprt1,*) ' **** ',trim(isubname),' : ',trim(string2)
3771  IF (present(string3)) WRITE(nulprt1,*) ' **** ',trim(isubname),' : ',trim(string3)
3772  IF (present(string4)) WRITE(nulprt1,*) ' **** ',trim(isubname),' : ',trim(string4)
3773  WRITE(nulprt1,*) ' '
3774  CALL oasis_flush(nulprt1)
3775  ENDIF
3776  call oasis_abort(file=__file__,line=__line__)
3777 
3778 ! CALL oasis_debug_enter(subname)
3779 
3780  RETURN
3781 
3782 END SUBROUTINE namcouple_abort
3783 
3784 !===============================================================================
3785 !===============================================================================
3786 
3787 END MODULE mod_oasis_namcouple
3788 
3789 
character(len=8), dimension(:), allocatable cxordaf
integer(kind=ip_intwp_p), parameter ip_cglbpos
integer(kind=ip_intwp_p), dimension(:), allocatable neighborg
character(len=ic_med), dimension(:), pointer, public namfldcoo
conserv fld option (bfb, opt)
character(len=8), dimension(:), allocatable cficout
integer(kind=ip_intwp_p), parameter ip_output
character(len=jpeighty), dimension(:), pointer, public namsrcfld
list of src fields
real(kind=ip_realwp_p), dimension(:), pointer, public namfldsmu
src multiplier term
integer(kind=ip_intwp_p), dimension(:), allocatable nlagn
System type methods.
character(len=4), dimension(:), allocatable cga_locatoraf
real(kind=ip_realwp_p), dimension(:), allocatable varmul
subroutine dealloc()
Deallocates temporary arrays for namcouple input.
integer(kind=ip_intwp_p) nlogprt
integer(kind=ip_intwp_p), dimension(:), allocatable nseqn
integer(kind=ip_intwp_p), parameter jpeighty
max number of characters to be read in each line of the file namcouple
integer(kind=ip_intwp_p), dimension(:), allocatable nsubfl
logical, dimension(:), allocatable lweight
real(kind=ip_realwp_p), dimension(:), allocatable afldcobo
character(len=8), dimension(:), allocatable cdqdt
character(len=8), dimension(:,:), allocatable cbnfld
Provides a common location for several OASIS variables.
character *9, parameter clfield
integer(kind=ip_i4_p), public namuntmin
namcouple min IO unit value
character(len=8), dimension(:), allocatable cintmet
character *9, parameter clcal
character(len=8), dimension(:), allocatable cyordbf
integer(kind=ip_i4_p), public namtlogprt
namcouple ntlogprt value
integer(kind=ip_i4_p), public nnamcpl
number of namcouple inputs
real(kind=ip_realwp_p), dimension(:), pointer, public namscrvam
scrip gauss weight distance weighting for GAUSWGT
character(len=ic_lvar), dimension(:), pointer, public namdstgrd
dst grid name
integer(kind=ip_intwp_p), dimension(:), allocatable naismfl
character(len=5), parameter csurnam
character *9, parameter cljob
integer(kind=ip_intwp_p), dimension(:), allocatable nbins
character(len=ic_med) nmatxrd
character *9, parameter cldate
character(len=4), dimension(:), allocatable cga_locatorbf
integer(kind=ip_i4_p), dimension(:), pointer, public namfldseq
SEQ value.
character(len= *), parameter nmatxrd_default
integer(kind=ip_intwp_p), dimension(:), allocatable ig_reverse
character(len=4), parameter cmsksuf
character(len=4), parameter crnlonsuf
subroutine, public oasis_unitfree(uio)
Release a unit number for reuse.
integer(kind=ip_intwp_p) ig_nbr_rstfile
integer(kind=ip_i4_p), dimension(:), pointer, public namfldtrn
fields transform, ip_instant,...
real(kind=ip_realwp_p), dimension(:,:), allocatable abncoef
character(len=8), dimension(:), allocatable cgrdsub
character(len=5), parameter cmsknam
character(len=ic_med), public nammapdec
namcouple map decomp value
integer(kind=ip_intwp_p) ig_total_nfield
integer(kind=ip_intwp_p), dimension(:), allocatable nluext
character(len=ic_med), public nammatxrd
namcouple matrix read option
character(len=32), dimension(:), allocatable cg_name_rstfile
integer(kind=ip_intwp_p) nstep
character(len=8), dimension(:), allocatable corder
character *9, parameter clstring
character(len=8), dimension(:), allocatable cnorm_opt
character(len=8), dimension(:), allocatable cgrdtyp
integer(kind=ip_intwp_p) ig_nfield
character *9, parameter clchan
integer(kind=ip_intwp_p), dimension(:), allocatable notper
integer(kind=ip_intwp_p), parameter ip_expout
integer(kind=ip_intwp_p), dimension(:), allocatable naismvoi
integer(kind=ip_intwp_p), parameter ip_ignout
subroutine skip(cd_one, id_len, endflag, ios)
logical, dimension(:), allocatable lsurf
integer(kind=ip_i4_p), dimension(:), pointer, public namscrnbr
scrip number of neighbors for GAUSWGT and DISTWGT
integer(kind=ip_intwp_p), parameter ip_instant
character(len=ic_med), dimension(:), pointer, public nammaploc
mapping location (src or dst pes)
logical, dimension(:), allocatable linit
integer(kind=ip_i4_p) nulin
integer(kind=ip_i4_p), dimension(:), pointer, public namflddti
coupling period (secs)
integer(kind=ip_intwp_p), dimension(:), allocatable nextfl
character(len=4), parameter crnlatsuf
real(kind=ip_realwp_p), dimension(:), allocatable afldcobn
integer(kind=ip_intwp_p) nulprt1
integer(kind=ip_intwp_p), dimension(:), allocatable ig_total_ntrans
character *9, parameter clunit
integer(kind=ip_intwp_p), parameter ip_auxilary
integer(kind=ip_intwp_p), dimension(:,:), allocatable nludat
integer(kind=ip_intwp_p), dimension(:), allocatable ig_no_rstfile
character(len=8), dimension(:), allocatable cfldfin
character(len=jpeighty), dimension(:), pointer, public namdstfld
list of dst fields
character(len=ic_med), dimension(:), pointer, public namrstfil
restart file name
integer(kind=ip_intwp_p) niter
integer(kind=ip_intwp_p), dimension(:), allocatable ig_grid_nbrbf
integer(kind=ip_i4_p), public namlogprt
namcouple nlogprt value
integer(kind=ip_intwp_p) nuntmin
real(kind=ip_realwp_p), dimension(:), allocatable afldcoef
character *9, parameter clrest
integer(kind=ip_intwp_p), dimension(:), allocatable ncofld
character(len=4), parameter cglatsuf
character(len=8), dimension(:), allocatable cgrdmap
integer(kind=ip_i4_p), dimension(:), pointer, public namscrbin
script number of search bins
character *9, parameter clmatxrd
integer(kind=ip_i4_p), dimension(:), pointer, public namfldcon
conserv fld operation
integer(kind=ip_intwp_p), dimension(:), allocatable numlab
subroutine namcouple_abort(isubname, lineno, string1, string2, string3, string4)
Subroutine that calls abort in this module.
character(len= *), parameter cspval
character(len=8), dimension(:), allocatable cconopt
character *9, parameter clprint
character *9, parameter clmod
logical, dimension(:), allocatable lmapp
integer(kind=ip_intwp_p) ig_final_nfield
integer(kind=ip_intwp_p), dimension(:), allocatable niwtn
logical, dimension(:), allocatable lsubg
Defines kinds for OASIS.
integer(kind=ip_intwp_p), dimension(:), allocatable ig_ntrans
integer(kind=ip_intwp_p), dimension(:), allocatable neighbor
integer(kind=ip_intwp_p) il_err
character(len=8), dimension(:), allocatable cextmet
Character string manipulation methods.
character(len=8), dimension(:), allocatable cfldcoa
integer(kind=ip_intwp_p), parameter ip_exported
character *9, parameter clmapdec
Provides a generic and simpler interface into MPI calls for OASIS.
integer(kind=ip_intwp_p), dimension(:), allocatable nmapvoi
real(kind=ip_realwp_p), dimension(:,:), allocatable abocoef
character(len=8), dimension(:), allocatable cfilmet
integer(kind=ip_intwp_p) nfcoast
integer(kind=ip_intwp_p), dimension(:), allocatable nscripvoi
character(len=8), dimension(:,:), allocatable ccofic
integer(kind=ip_intwp_p), parameter ip_cbasbal
integer(kind=ip_intwp_p), dimension(:), allocatable ig_number_field
character(len=ic_med), dimension(:), pointer, public namscrord
scrip conserve order (FIRST, SECOND)
real(kind=ip_realwp_p), dimension(:,:), allocatable acocoef
integer(kind=ip_i4_p), dimension(:), pointer, public namfldops
operation, ip_expout,...
integer(kind=ip_intwp_p), dimension(:), allocatable nlusub
subroutine, public oasis_namcouple_init()
Reads the namcouple.
integer(kind=ip_intwp_p), dimension(:), allocatable ig_total_state
subroutine inipar
Reads, sets, and prints the namcouple file.
character(len=4), parameter csursuf
character(len=4), parameter cangsuf
integer(kind=ip_i4_p), public namuntmax
namcouple max IO unit value
integer(kind=ip_intwp_p) ig_maxnfg
integer(kind=ip_intwp_p), dimension(:), allocatable nbofld
character(len=8), dimension(:), allocatable cfldtyp
character(len=8), dimension(:), allocatable cyordaf
subroutine prtout(cdtext, kvalue, kstyle)
Prints information passed by argument.
character(len=ic_lvar), dimension(:), pointer, public namsrcgrd
src grid name
real(kind=ip_realwp_p), dimension(:), allocatable amskval
real(kind=ip_realwp_p), dimension(:), pointer, public namflddad
dst additive term
logical, dimension(:), pointer, public namchecki
checkin flag
integer(kind=ip_intwp_p) nitfn
integer(kind=ip_i4_p), dimension(:), pointer, public namsrc_nx
src nx grid size
integer(kind=ip_i4_p) mpi_rank_global
integer(kind=ip_intwp_p), dimension(:), allocatable ig_local_trans
subroutine inipar_alloc()
Reads the namcouple to allocate arrays.
integer(kind=ip_intwp_p), dimension(:), allocatable nlonaf
integer(kind=ip_intwp_p), dimension(:), allocatable nlumap
character(len=ic_med), public namwgtopt
namcouple weights handling option
integer(kind=ip_intwp_p), parameter nkeywords
integer(kind=ip_intwp_p) ig_direct_nfield
integer(kind=ip_intwp_p), dimension(:), allocatable nlufil
character(len=ic_med), dimension(:), pointer, public nammapopt
mapping option (bfb, sum, or opt)
character(len=ic_med), dimension(:), pointer, public namscrtyp
scrip mapping type (SCALAR, VECTOR)
character(len=ic_med), dimension(:), pointer, public namscrres
scrip search restriction (LATLON, LATITUDE)
character(len=ic_med), dimension(:), pointer, public namscrmet
scrip method (CONSERV, DISTWGT, BILINEAR, BICUBIC, GAUSWGT)
character(len=8), dimension(:), allocatable ctypsub
real(kind=ip_realwp_p), dimension(:), pointer, public namflddmu
dst multipler term
subroutine alloc()
Allocates temporary arrays for namcouple input.
character(len=32), dimension(:), allocatable cg_input_file
integer(kind=ip_i4_p), dimension(:), pointer, public namsrc_ny
src ny grid size
integer(kind=ip_intwp_p), dimension(:), allocatable ig_numlab
character(len= *), parameter rform
formatted line read format
integer(kind=ip_intwp_p) ig_maxcomb
character(len=ic_med) nmapdec
integer(kind=ip_intwp_p), dimension(:), allocatable niwtg
integer(kind=ip_intwp_p), dimension(:), allocatable nninnflg
Defines parameters for OASIS.
integer(kind=ip_intwp_p), dimension(:), allocatable nsubvoi
character(len=8), dimension(:), allocatable cstate
integer(kind=ip_intwp_p), dimension(:), allocatable nlataf
character *9, dimension(nkeywords), parameter keyword_list
character(len=8), dimension(:), allocatable cxordbf
character(len=8), dimension(:), allocatable csper
subroutine findkeyword(keyword, line, found)
Searches for a particular keyword in the namcouple file.
character(len=ic_long), dimension(:), allocatable cmap_file
real(kind=ip_realwp_p), dimension(:), allocatable amskvalnew
character(len=8), dimension(:), allocatable cfilfic
integer(kind=ip_intwp_p), dimension(:), allocatable ig_invert
integer(kind=ip_i4_p), dimension(:), pointer, public namsort2nn
sorted namcpl for sort, define nn order, computed later
real(kind=ip_realwp_p), dimension(:), pointer, public namfldsad
src additive term
subroutine, public oasis_unitget(uio)
Get a free unit number.
character(len=8), dimension(:), allocatable cficaf
integer(kind=ip_intwp_p), parameter ip_cglobal
integer(kind=ip_i4_p), dimension(:), pointer, public namfldlag
coupling lag (secs)
character(len=jpeighty), dimension(:), allocatable cg_output_field
character(len=5), parameter crednam
integer(kind=ip_intwp_p), dimension(:), allocatable nninnfl
integer(kind=ip_intwp_p) nlucor
integer(kind=ip_intwp_p), dimension(:), allocatable ig_lag
character(len=8), dimension(:), allocatable cmaptyp
character *9, parameter clseq
character(len=5), parameter cgrdnam
character(len=ic_med), dimension(:), pointer, public naminpfil
input file name
character(len= *), parameter nwgtopt_default
character(len=8), dimension(:), allocatable cmskrd
logical, dimension(:), allocatable lextra
character(len= *), parameter cl_namcouple
integer(kind=ip_intwp_p), dimension(:), allocatable ig_total_nseqn
character(len=8), dimension(:), allocatable cmapopt
character(len=jpeighty), dimension(:), allocatable cg_input_field
character(len=8), dimension(:), allocatable crsttype
character *9, parameter clwgtopt
integer(kind=ip_intwp_p), parameter ip_input
subroutine, public oasis_flush(nu)
Flushes output to file.
integer(kind=ip_intwp_p), parameter ip_ignored
subroutine parse(cdone, cdtwo, knumb, klen, kleng, line)
Subroutine to parse string.
integer(kind=ip_intwp_p) ig_total_frqmin
character(len=8), dimension(:), allocatable ctper
integer(kind=ip_intwp_p), dimension(:), allocatable ig_grid_nbraf
character(len=ic_long), dimension(:), pointer, public nammapfil
mapping file name
integer(kind=ip_intwp_p), dimension(:), allocatable nosper
character(len=jpeighty), dimension(:), allocatable cnaminp
integer(kind=ip_i4_p), dimension(:), pointer, public namdst_nx
dst nx grid size
integer(kind=ip_intwp_p), dimension(:), allocatable nfexch
character(len=8), dimension(:,:), allocatable canal
character *9, parameter clend
integer(kind=ip_i4_p), dimension(:), pointer, public namnn2sort
sorted namcpl for nn, define sort number, computed later
character(len= *), parameter nmapdec_default
integer(kind=ip_intwp_p), dimension(:), allocatable nlatbf
integer(kind=ip_intwp_p) ntime
integer(kind=ip_intwp_p), dimension(:), allocatable niwtm
logical function checkcomment(line)
character(len=jpeighty), dimension(:), allocatable cnamout
character(len=8), dimension(:), allocatable cmap_method
character *9, parameter clhead
integer(kind=ip_intwp_p), dimension(:), allocatable nbnfld
integer(kind=ip_i4_p), public namruntim
namcouple runtime
integer(kind=ip_intwp_p), dimension(:), allocatable ntronca
integer(kind=ip_intwp_p), dimension(:), allocatable nmapfl
integer(kind=ip_intwp_p) ntlogprt
character(len=4), parameter cglonsuf
character(len=8), dimension(:), allocatable cficbf
integer(kind=ip_intwp_p) nuntmax
character(len=8), dimension(:,:), allocatable cbofld
character *9, parameter cltime
integer(kind=ip_i4_p), dimension(:), pointer, public namdst_ny
dst ny grid size
character(len=8), dimension(:), allocatable cfldtype
character(len=32), dimension(:), allocatable cficinp
integer(kind=ip_intwp_p), dimension(:), allocatable ig_freq
Reads the namcouple file for use in OASIS.
logical, dimension(:), pointer, public namchecko
checkout flag
integer(kind=ip_intwp_p), dimension(:), allocatable naisgfl
integer(kind=ip_intwp_p), dimension(:), allocatable naisgvoi
logical, dimension(:), allocatable lg_state
logical, public namnorest
namcouple allow no restarts
character(len=32), dimension(:), allocatable cg_restart_file
integer(kind=ip_intwp_p), dimension(:), allocatable nlonbf
integer(kind=ip_intwp_p) ig_maxnoa
character(len=8), dimension(:,:), allocatable ccofld
integer(kind=ip_intwp_p), parameter ip_cbaspos
integer(kind=ip_intwp_p), dimension(:), allocatable niwtng
integer(kind=ip_intwp_p), parameter ip_cnone
character(len=8), dimension(:), allocatable cconmet
character(len=ic_med), dimension(:), pointer, public namscrnor
scrip conserv normalization (FRACAREA, DESTAREA, FRACNNEI)
character(len=8), dimension(:), allocatable cgrdext
character(len=ic_med) nwgtopt