Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

mod_oasis_namcouple.F90 @ 6331

Last change on this file since 6331 was 6331, checked in by aclsce, 17 months ago
Moved oasis-mct_5.0 in oasis3-mct/branches directory.
File size: 164.4 KB

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

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: CPL/oasis3-mct/branches/OASIS3-MCT_5.0_branch/lib/psmile/src/mod_oasis_namcouple.F90 @ 6331

Download in other formats: