Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

mod_oasis_namcouple.F90 @ 4775

Last change on this file since 4775 was 4775, checked in by aclsce, 5 years ago

Imported oasis3-mct from Cerfacs svn server (not suppotred anymore).

The version has been extracted from https://oasis3mct.cerfacs.fr/svn/branches/OASIS3-MCT_2.0_branch/oasis3-mct@1818

File size: 162.3 KB

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

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

Context Navigation

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

Download in other formats: