Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

inipar.F @ 1677

Last change on this file since 1677 was 1677, checked in by aclsce, 12 years ago
Imported oasis3 (tag ipslcm5a) from cvs server to svn server (igcmg project).
File size: 84.5 KB

Line
1	SUBROUTINE inipar
2	C****
3	C *****************************
4	C * OASIS ROUTINE - LEVEL 0 *
5	C * ------------- ------- *
6	C *****************************
7	C
8	C**** inipar - Get run parameters
9	C
10	C Purpose:
11	C -------
12	C Reads and prints out run parameters.
13	C
14	C** Interface:
15	C ---------
16	C CALL inipar
17	C
18	C Input:
19	C -----
20	C None
21	C
22	C Output:
23	C ------
24	C None
25	C
26	C Workspace:
27	C ---------
28	C None
29	C
30	C Externals:
31	C ---------
32	C parse
33	C
34	C Reference:
35	C ---------
36	C See OASIS manual (1995)
37	C
38	C History:
39	C -------
40	C Version Programmer Date Description
41	C ------- ---------- ---- -----------
42	C 1.0 L. Terray 94/01/01 created
43	C 1.1 L. Terray 94/08/01 modified: change in namelist
44	C nice flag + new case for nmode
45	C 1.1 L. Terray 94/10/01 modified: change printing
46	C 2.0b L. Terray 95/07/24 modified: new structure
47	C 2.0 L. Terray 96/02/01 modified: lecture of cdqdt for
48	C subgrid and add mozaic analysis
49	C Lecture of a unit for filling
50	C 2.1 L. Terray 96/09/25 Changes to mozaic and subgrid
51	C analysis, addition of nfend and
52	C nintflx, check[in-out] analysis
53	C addition of nointerp case.
54	C 2.2 L. Terray 97/02/12 Printing bug on analysis sub-
55	C grid (SOLAR) corrected
56	C 2.2 L. Terray 97/02/20 Printing bug on analysis ANAIS
57	C corrected
58	C 2.2 L. Terray 97/12/14 Add new input: MODINFO and new
59	C extrapolation technique
60	C 2.3 S. Valcke 99/03/14 cjobnam with 3 or 4 characters
61	C 2.3 S. Valcke 99/03/25 troncature as NOxxxx in namcouple
62	C 2.3 S. Valcke 99/03/30 READ/WRITE flag and dataset index
63	C for NINENN weights
64	C 2.3 S. Valcke 99/04/30 NLOGPRT for printing levels
65	C 2.3 L. Terray 99/09/15 changed periodicity variables
66	C and input them as field parameters
67	C 2.4 J. Latour 99/10/28 Add new input: CHATYPE for type of
68	C message passing : MPI2 or PVM3
69	C 2.4 S. Valcke 2K/02/04 Additional readings for CLIM/MPI2
70	C 2.5 S. Valcke 2K/09/04 Remove $MACHINE, clmach, cmach
71	C 2.5 S. Valcke 2K/09/04 $CHATYPE in $CHANNEL
72	C 2.5 S. Valcke 2K/09/05 Add input line with integral flag
73	C for check[in-out], remove nintflx
74	C 2.5 S. Valcke 2K/09/05 Remove fld 3rd input line for CLIM
75	C 2.5 S. Valcke 2K/09/08 Changed input lines for PVM3&MPI2
76	C 2.5 J. Latour 01/11/28 Add MPI1 startup
77	C 2.5 A. Caubel 02/05/15 Mods for dynamic allocation
78	C 2.5 S. Valcke 02/06/12 PVM3 no longer supported
79	C 2.5 V. Gayler 01/09/20 Scrip-Remapping
80	C 3.0 S. Legutke 03/04/24 proposal of CF compliant cfldlab entries
81	C added labels for echam5/mpi-om
82	C grouping into classes
83	C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
84	C
85	C* ---------------------------- Include files ---------------------------
86	C
87	USE mod_kinds_oasis
88	USE mod_parameter
89	USE mod_parallel
90	USE mod_string
91	USE mod_analysis
92	USE mod_anais
93	USE mod_rainbow
94	USE mod_extrapol
95	USE mod_unitncdf
96	USE mod_experiment
97	USE mod_timestep
98	USE mod_coast
99	#if defined use_comm_MPI1 \|\| defined use_comm_MPI2 \|\| !defined use_comm_MPI1 && !defined use_comm_MPI2 && !defined use_comm_SIPC && !defined use_comm_GMEM && !defined use_comm_PIPE && !defined use_comm_NONE
100	USE mod_clim
101	#endif
102	USE mod_calendar
103	USE mod_hardware
104	USE mod_unit
105	USE mod_label
106	USE mod_printing
107	INCLUDE 'netcdf.inc'
108	C
109	C* ---------------------------- Local declarations --------------------
110	C
111	CHARACTER*80 clline, clvari
112	CHARACTER*9 clword, clstring, clprint, clcal, clchan
113	CHARACTER*9 cljob, clmod, cltime, clseq, cldate, clhead
114	CHARACTER*8 cl_print_trans, cl_print_state
115	CHARACTER*3 clinfo, clind
116	CHARACTER*1 clequa
117	CHARACTER*64 cl_cfname,cl_cfunit
118	INTEGER (kind=ip_intwp_p) iind, il_aux
119	INTEGER (kind=ip_intwp_p) il_file_unit, id_error
120	INTEGER (kind=ip_intwp_p) il_max_entry_id, il_no_of_entries
121	INTEGER (kind=ip_intwp_p) il_i, il_pos
122	LOGICAL llseq, lldel, llxts, lllag, ll_exist
123	INTEGER lastplace
124	C
125	C* ---------------------------- Poema verses --------------------------
126	C
127	C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
128	C
129	C* 1. Get basic info for the simulation
130	C ---------------------------------
131	C
132	WRITE (UNIT = nulou,FMT = *) ' '
133	WRITE (UNIT = nulou,FMT = *) ' '
134	WRITE (UNIT = nulou,FMT = *)
135	$ ' ROUTINE inipar - Level 0'
136	WRITE (UNIT = nulou,FMT = *)
137	$ ' ************ *****'
138	WRITE (UNIT = nulou,FMT = *) ' '
139	WRITE (UNIT = nulou,FMT = *) ' Initialization of run parameters'
140	WRITE (UNIT = nulou,FMT = *) ' '
141	WRITE (UNIT = nulou,FMT = *) ' Reading input file namcouple'
142	WRITE (UNIT = nulou,FMT = *) ' '
143	WRITE (UNIT = nulou,FMT = *) ' '
144	C
145	C* Initialize character keywords to locate appropriate input
146	C
147	clstring = ' $STRINGS'
148	cljob = ' $JOBNAME'
149	clchan = ' $CHANNEL'
150	clmod = ' $NBMODEL'
151	cltime = ' $RUNTIME'
152	clseq = ' $SEQMODE'
153	cldate = ' $INIDATE'
154	clhead = ' $MODINFO'
155	clprint = ' $NLOGPRT'
156	clcal = ' $CALTYPE'
157	C
158	C* Initialize some variables
159	ndate = 0 ; nmseq = 1 ; ntime = 432000 ; niter = 5
160	nstep = 86400 ; nitfn=4
161	cjobnam = 'DEF'
162	lmodinf = .TRUE.
163
164	C
165	C* CF long names for exchange fields
166	INQUIRE (file='cf_name_table.txt', exist=ll_exist)
167
168	IF (ll_exist) THEN
169	WRITE (nulou,*) 'inipar: Reading CF name table!'
170	il_file_unit = 99
171	OPEN (file='cf_name_table.txt', unit=il_file_unit,
172	$ form='formatted', status='old')
173
174	READ (unit=il_file_unit,fmt=*,iostat=id_error)
175	READ (unit=il_file_unit,fmt=*,iostat=id_error)
176	$ il_max_entry_id, il_no_of_entries
177
178	IF (id_error.ne.0) THEN
179	WRITE (nulou,*) 'inipar :cf_name_table.txt:'
180	$ ,' Reading of first record failed!'
181	CALL halte('STOP in inipar')
182	ENDIF
183
184	IF (il_max_entry_id.gt.0) THEN
185	allocate (cfldlab(1:il_max_entry_id),STAT=id_error)
186	IF (id_error.ne.0) THEN
187	write(nulou,*) 'inipar: Allocation of cfldlab failed!'
188	CALL halte('STOP in inipar')
189	ENDIF
190	ELSE
191	WRITE (nulou,*) 'inipar: cf_name_table.txt:',
192	$ 'The number of entries is less than 0 !'
193	CALL halte('STOP in inipar')
194	ENDIF
195
196	READ (unit=il_file_unit,fmt=*,iostat=id_error)
197	DO il_i=1,il_no_of_entries
198	READ (unit=il_file_unit,fmt=*,iostat=id_error)
199	$ il_pos,cl_cfname,cl_cfunit
200
201	IF (id_error.eq.0) THEN
202	IF (il_pos .le. il_max_entry_id) THEN
203	cfldlab(il_pos)=trim(cl_cfname)
204	ELSE
205	WRITE (nulou,*) 'inipar: cf_name_table.txt:',
206	$ 'Record ',il_i,': numlab =',il_pos,' out of range!'
207	CALL halte('STOP in inipar')
208	ENDIF
209	ELSE
210	WRITE (nulou,*) 'inipar: cf_name_table.txt:',
211	$ 'Reading record ',il_i,' failed!'
212	CALL halte('STOP in inipar')
213	ENDIF
214	END DO
215	ELSE
216	WRITE (nulou,*) 'inipar: cf_name_table.txt missing'
217	CALL halte('STOP in inipar')
218	ENDIF
219	CLOSE(il_file_unit)
220	C
221	C* First get experiment name
222	C
223	REWIND nulin
224	100 CONTINUE
225	READ (UNIT = nulin,FMT = 1001,END = 110) clword
226	IF (clword .NE. cljob) GO TO 100
227	READ (UNIT = nulin,FMT = 1002) clline
228	CALL parse (clline, clvari, 1, jpeighty, ilen)
229	IF (ilen .LE. 0) THEN
230	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
231	WRITE (UNIT = nulou,FMT = *)
232	$ ' Nothing on input for $JOBNAME '
233	WRITE (UNIT = nulou,FMT = *) ' Default value will be used '
234	WRITE (UNIT = nulou,FMT = *) ' '
235	ELSE IF (ilen .GT. 0 .AND. ilen .NE. 3 .AND. ilen .NE .4 ) THEN
236	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
237	WRITE (UNIT = nulou,FMT = *)
238	$ ' Input variable length is incorrect'
239	WRITE (UNIT = nulou,FMT = *) ' ilen = ', ilen
240	WRITE (UNIT = nulou,FMT = *)
241	$ ' Check $JOBNAME variable spelling '
242	WRITE (UNIT = nulou,FMT = *) ' Default value will be used '
243	WRITE (UNIT = nulou,FMT = *) ' '
244	ELSE
245	IF (ilen .EQ. 3) THEN
246	WRITE (cjobnam,FMT='(A1,A3)') ' ',clvari
247	ELSE IF (ilen .EQ. 4) THEN
248	WRITE (cjobnam,FMT='(A4)') clvari
249	ENDIF
250	ENDIF
251	C
252	C* Print out experiment name
253	C
254	CALL prcout
255	$ ('The experiment name for this run is cjobnam =', cjobnam,1)
256	C
257	C* Get number of models involved in this simulation
258	C
259	REWIND nulin
260	120 CONTINUE
261	READ (UNIT = nulin,FMT = 1001,END = 130) clword
262	IF (clword .NE. clmod) GO TO 120
263	READ (UNIT = nulin,FMT = 1002) clline
264	C
265	C* Get model names
266	C
267	DO 140 jm = 1, ig_nmodel
268	imodel = jm + 1
269	CALL parse (clline, clvari, imodel, jpeighty, ilen)
270	cmodnam(jm) = clvari
271	C
272	C* Print out model names
273	C
274	WRITE (UNIT = nulou,FMT ='
275	$ ('' Name for model '',I1,'' is '',A6,/)')
276	$ jm, cmodnam(jm)
277	140 CONTINUE
278	C
279	C* Get model maximum unit number used if they appear on the line
280	C
281	DO 142 jm = 1, ig_nmodel
282	imodel = jm + 1 + ig_nmodel
283	CALL parse (clline, clvari, imodel, jpeighty, ilen)
284	IF (ilen .gt. 0) THEN
285	READ (clvari,FMT = 1004) iga_unitmod(jm)
286	C
287	C* Print out model minimum logfile unit number
288	C
289	WRITE (UNIT = nulou,FMT = *) ' '
290	WRITE (UNIT=nulou,FMT='(''The maximum Fortran unit number'',
291	$ '' used in model'', I2, '' is '', I2)')
292	$ jm, iga_unitmod(jm)
293	WRITE (UNIT = nulou,FMT = *) ' '
294	C
295	C* Verify that maximum unit number is larger than 1024;
296	C* if not, use 1024.
297	IF (iga_unitmod(jm) .lt. 1024) iga_unitmod(jm)=1024
298	ELSE
299	WRITE (UNIT = nulou, FMT = *)
300	$ ' WARNING: You did not give in the namcouple the maximum',
301	$ ' Fortran unit numbers used in your models.',
302	$ ' Oasis will suppose that units above 1024 are free !'
303	iga_unitmod(jm)=1024
304	ENDIF
305	142 CONTINUE
306	C
307	C* Get hardware info for this OASIS simulation
308	C
309	REWIND nulin
310	160 CONTINUE
311	READ (UNIT = nulin,FMT = 1001,END = 170) clword
312	IF (clword .NE. clchan) GO TO 160
313	READ (UNIT = nulin,FMT = 1002) clline
314	CALL skip(clline, jpeighty)
315	IF(cchan .EQ. 'MPI2' .OR. cchan .EQ. 'MPI1') THEN
316	C* Get one additional line for each model
317	DO 186 jm = 1, ig_nmodel
318	READ (UNIT = nulin,FMT = 1002) clline
319	C* Get the total number of processors for the model
320	CALL parse (clline, clvari, 1, jpeighty, ilen)
321	READ (clvari,FMT = 1003) nbtotproc(jm)
322	WRITE (UNIT = nulou,FMT = *) ' '
323	WRITE (UNIT=nulou,FMT='(''The total number of processors'',
324	$'' for model'', I2, '' is'', I2)')
325	$ jm, nbtotproc(jm)
326	WRITE (UNIT = nulou,FMT = *) ' '
327	C
328	C* Get the nbr of processors involved in the coupling for the model
329	CALL parse (clline, clvari, 2, jpeighty, ilen)
330	IF (ilen .LE. 0) THEN
331	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
332	WRITE (UNIT = nulou,FMT = *)
333	$ 'No input for number of processors involved in the coupling'
334	WRITE (UNIT = nulou,FMT = *) 'for model', jm
335	WRITE (UNIT = nulou,FMT = *)
336	$ 'Total number of processors will be used'
337	nbcplproc(jm)=nbtotproc(jm)
338	ELSE
339	READ (clvari,FMT = 1003) nbcplproc(jm)
340	ENDIF
341	WRITE (UNIT = nulou,FMT = *) ' '
342	WRITE (UNIT = nulou,FMT ='(''The number of processors'',
343	$'' involved in the coupling for model'', I2, '' is'', I2)')
344	$ jm, nbcplproc(jm)
345	WRITE (UNIT = nulou,FMT = *) ' '
346	C
347	C* Get the launching arguments for the model
348	C
349	CALL parseblk (clline, clvari, 3, jpeighty, ilen)
350	IF (ilen .LE. 0) THEN
351	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
352	WRITE (UNIT = nulou,FMT = *)
353	$ 'No launching argument for model', jm
354	WRITE (UNIT = nulou,FMT = *) ' '
355	cmpiarg(jm)=' '
356	ELSE
357	cmpiarg(jm)=clvari
358	WRITE (UNIT = nulou,FMT = *) ' '
359	WRITE (UNIT =nulou,FMT='
360	$ (''The launching argument for model '', I2, '' is'')') jm
361	WRITE (UNIT = nulou,FMT = *) cmpiarg(jm)
362	WRITE (UNIT = nulou,FMT = *) ' '
363	WRITE (UNIT = nulou,FMT = *) 'ilen ',ilen
364	ENDIF
365
366	C
367	186 CONTINUE
368	C
369	ENDIF
370	C
371	C* Get total time for this simulation
372	C
373	REWIND nulin
374	190 CONTINUE
375	READ (UNIT = nulin,FMT = 1001,END = 191) clword
376	IF (clword .NE. cltime) GO TO 190
377	READ (UNIT = nulin,FMT = 1002) clline
378	CALL parse (clline, clvari, 1, jpeighty, ilen)
379	IF (ilen .LE. 0) THEN
380	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
381	WRITE (UNIT = nulou,FMT = *)
382	$ ' Nothing on input for $RUNTIME '
383	WRITE (UNIT = nulou,FMT = *)
384	$ ' Default value of 5 days will be used '
385	WRITE (UNIT = nulou,FMT = *) ' '
386	ELSE
387	READ (clvari,FMT = 1004) ntime
388	ENDIF
389	C
390	C* Print out total time
391	C
392	CALL prtout
393	$ ('The total time for this run is ntime =', ntime, 1)
394	C
395	C* Get initial date for this simulation
396	C
397	REWIND nulin
398	192 CONTINUE
399	READ (UNIT = nulin,FMT = 1001,END = 193) clword
400	IF (clword .NE. cldate) GO TO 192
401	READ (UNIT = nulin,FMT = 1002) clline
402	CALL parse (clline, clvari, 1, jpeighty, ilen)
403	IF (ilen .LE. 0) THEN
404	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
405	WRITE (UNIT = nulou,FMT = *)
406	$ ' Nothing on input for $INIDATE '
407	WRITE (UNIT = nulou,FMT = *) ' Default value will be used '
408	WRITE (UNIT = nulou,FMT = *) ' '
409	ELSE
410	READ (clvari,FMT = 1004) ndate
411	ENDIF
412	C
413	C* Print out initial date
414	C
415	CALL prtout
416	$ ('The initial date for this run is ndate = ', ndate, 1)
417	C
418	C* Get number of sequential models involved in this simulation
419	C
420	REWIND nulin
421	194 CONTINUE
422	READ (UNIT = nulin,FMT = 1001,END = 195) clword
423	IF (clword .NE. clseq) GO TO 194
424	READ (UNIT = nulin,FMT = 1002) clline
425	CALL parse (clline, clvari, 1, jpeighty, ilen)
426	IF (ilen .LE. 0) THEN
427	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
428	WRITE (UNIT = nulou,FMT = *)
429	$ ' Nothing on input for $SEQMODE '
430	WRITE (UNIT = nulou,FMT = *) ' Default value will be used '
431	WRITE (UNIT = nulou,FMT = *) ' '
432	ELSE IF (ilen .GT. 1) THEN
433	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
434	WRITE (UNIT = nulou,FMT = *)
435	$ ' Input variable length is incorrect'
436	WRITE (UNIT = nulou,FMT = *)
437	$ ' Sequential models are too many'
438	WRITE (UNIT = nulou,FMT = *) ' ilen = ', ilen
439	WRITE (UNIT = nulou,FMT = *)
440	$ ' Check $SEQMODE variable spelling '
441	WRITE (UNIT = nulou,FMT = *) ' Default value will be used '
442	ELSE
443	READ (clvari,FMT = 1003) nmseq
444	ENDIF
445	C
446	C* Print out the number of sequential models
447	C
448	CALL prtout
449	$ ('The number of sequential fields is nmseq =', nmseq, 1)
450	C
451	C* Get the information mode for this simulation
452	C
453	REWIND nulin
454	196 CONTINUE
455	READ (UNIT = nulin,FMT = 1001,END = 197) clword
456	IF (clword .NE. clhead) GO TO 196
457	READ (UNIT = nulin,FMT = 1002) clline
458	CALL parse (clline, clvari, 1, jpeighty, ilen)
459	IF (ilen .LE. 0) THEN
460	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
461	WRITE (UNIT = nulou,FMT = *)
462	$ ' Nothing on input for $MODINFO '
463	WRITE (UNIT = nulou,FMT = *) ' Default value will be used '
464	WRITE (UNIT = nulou,FMT = *) ' '
465	ELSE IF (ilen .GT. 0 .AND. ilen .NE. 3) THEN
466	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
467	WRITE (UNIT = nulou,FMT = *)
468	$ ' Input variable length is incorrect'
469	WRITE (UNIT = nulou,FMT = *)
470	$ ' Info mode uncorrectly specified'
471	WRITE (UNIT = nulou,FMT = *) ' ilen = ', ilen
472	WRITE (UNIT = nulou,FMT = *)
473	$ ' Check $MODINFO variable spelling '
474	WRITE (UNIT = nulou,FMT = *) ' Default value will be used '
475	ELSE
476	clinfo = clvari
477	IF (clinfo .EQ. 'YES') THEN
478	lmodinf = .TRUE.
479	ELSE
480	lmodinf = .FALSE.
481	ENDIF
482	ENDIF
483	C
484	C* Print out the information mode
485	C
486	CALL prcout
487	$ ('The information mode is activated ? ==>', clinfo, 1)
488	C
489	C* Get the printing level for this simulation
490	C
491	REWIND nulin
492	198 CONTINUE
493	READ (UNIT = nulin,FMT = 1001,END = 199) clword
494	IF (clword .NE. clprint) GO TO 198
495	READ (UNIT = nulin,FMT = 1002) clline
496	CALL parse (clline, clvari, 1, jpeighty, ilen)
497	IF (ilen .LE. 0) THEN
498	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
499	WRITE (UNIT = nulou,FMT = *)
500	$ ' Nothing on input for $NLOGPRT '
501	WRITE (UNIT = nulou,FMT = *) ' Default value 2 will be used '
502	WRITE (UNIT = nulou,FMT = *) ' '
503	ELSE IF (ilen .NE. 1) THEN
504	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
505	WRITE (UNIT = nulou,FMT = *)
506	$ ' Input variable length is incorrect'
507	WRITE (UNIT = nulou,FMT = *)
508	$ ' Printing level uncorrectly specified'
509	WRITE (UNIT = nulou,FMT = *) ' ilen = ', ilen
510	WRITE (UNIT = nulou,FMT = *)
511	$ ' Check $NLOGPRT variable spelling '
512	WRITE (UNIT = nulou,FMT = *) ' Default value will be used '
513	ELSE
514	READ (clvari,FMT = 1003) nlogprt
515	ENDIF
516	C
517	C* Print out the printing level
518	C
519	CALL prtout
520	$ ('The printing level is nlogprt =', nlogprt, 1)
521	C
522	C* Get the calendar type for this simulation
523	C
524	REWIND nulin
525	200 CONTINUE
526	READ (UNIT = nulin,FMT = 1001,END = 201) clword
527	IF (clword .NE. clcal) GO TO 200
528	READ (UNIT = nulin,FMT = 1002) clline
529	CALL parse (clline, clvari, 1, jpeighty, ilen)
530	IF (ilen .LE. 0) THEN
531	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
532	WRITE (UNIT = nulou,FMT = *)
533	$ ' Nothing on input for $CALTYPE '
534	WRITE (UNIT = nulou,FMT = *) ' Default value 1 will be used '
535	WRITE (UNIT = nulou,FMT = *) ' '
536	ncaltype = 1
537	ELSE
538	READ (clvari,FMT = 1003) ncaltype
539	ENDIF
540	C
541	C* Print out the calendar type
542	C
543	CALL prtout
544	$ ('The calendar type is ncaltype =', ncaltype, 1)
545	IF (ncaltype .EQ. 1) THEN
546	CALL prcout
547	$ ('Gregorian calendar', ' ', 1)
548	ELSE IF (ncaltype .EQ. 0) THEN
549	CALL prcout
550	$ ('365 day calendar (no leap years)', ' ', 1)
551	ELSE
552	CALL prtout
553	$ ('The number of days per month =', ncaltype, 1)
554	ENDIF
555	C
556	C* Formats
557	C
558	1001 FORMAT(A9)
559	1002 FORMAT(A80)
560	1003 FORMAT(I3)
561	1004 FORMAT(I8)
562	C
563	C* 2. Get field information
564	C ---------------------
565	C
566	C* Init. array needed for local transformation
567	C
568	ig_local_trans(:) = ip_instant
569	C
570	C* Init. arrays needed for ANAIS(G-M),mapping and subgrid interpolation
571	C
572	IF (lg_oasis_field) THEN
573	lcoast = .TRUE.
574	DO 215 jz = 1, ig_nfield
575	linit(jz) = .TRUE.
576	lmapp(jz) = .TRUE.
577	lsubg(jz) = .TRUE.
578	lextra(jz) = .TRUE.
579	varmul(jz) = 1.
580	lsurf(jz) = .FALSE.
581	215 CONTINUE
582	C
583	C* Initialize flag indicating IF EXTRAP/NINENN parameter sets have
584	C* already been calculated or read (.TRUE.) or not (.FALSE.)
585	C
586	DO 217 jfn = 1, ig_maxnfn
587	lweight(jfn) = .FALSE.
588	217 CONTINUE
589	ENDIF
590	C
591	C* Get the SSCS for all fields
592	C
593	REWIND nulin
594	220 CONTINUE
595	READ (UNIT = nulin,FMT = 2001,END = 230) clword
596	IF (clword .NE. clstring) GO TO 220
597	C
598	C* Loop on total number of fields (NoF)
599	C
600	DO 240 jf = 1, ig_total_nfield
601	C
602	C* Read first two lines of strings for field n = 1,2...,ig_total_nfield
603	C --->>> Main characteristics of fields
604	C
605	C* First line
606	C
607	READ (UNIT = nulin,FMT = 2002) clline
608	CALL parse(clline, clvari, 1, jpeighty, ilen)
609	C* Get output field symbolic name
610	cg_input_field(jf) = clvari
611	IF (lg_state(jf)) cnaminp(ig_number_field(jf)) =
612	$ cg_input_field(jf)
613	IF (lg_state(jf)) cnamout(ig_number_field(jf)) =
614	$ cg_output_field(jf)
615	CALL parse(clline, clvari, 3, jpeighty, ilen)
616	C* Get field label number
617	READ (clvari,FMT = 2003) ig_numlab(jf)
618	IF (lg_state(jf)) numlab(ig_number_field(jf)) = ig_numlab(jf)
619	CALL parse(clline, clvari, 4, jpeighty, ilen)
620	C* Get field exchange frequency
621	IF (clvari(1:4) .eq. 'ONCE') THEN
622	C
623	C* The case 'ONCE' means that the coupling period will be equal to the
624	C* time of the simulation
625	C
626	ig_freq(jf) = ntime
627	ELSE
628	READ (clvari,FMT = 2004) ig_freq(jf)
629	IF (ig_freq(jf) .eq. 0) THEN
630	GOTO 236
631	ELSEIF (ig_freq(jf) .gt. ntime) THEN
632	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
633	WRITE (UNIT = nulou,FMT = *)
634	$ 'The coupling period of the field ',jf
635	WRITE (UNIT = nulou,FMT = *)
636	$ 'is greater than the time of the simulation '
637	WRITE (UNIT = nulou,FMT = *)
638	$ 'This field will not be exchanged !'
639	ENDIF
640	ENDIF
641	IF (lg_state(jf)) nfexch(ig_number_field(jf)) = ig_freq(jf)
642	C* Fill up restart file number and restart file name arrays
643	IF (jf.eq.1) THEN
644	il_aux = 1
645	ig_no_rstfile(jf) = 1
646	cg_name_rstfile (ig_no_rstfile(jf)) = cg_restart_file(jf)
647	ELSEIF (jf.gt.1) THEN
648	IF (ALL(cg_name_rstfile.ne.cg_restart_file(jf))) THEN
649	il_aux = il_aux + 1
650	ig_no_rstfile(jf) = il_aux
651	cg_name_rstfile (ig_no_rstfile(jf))= cg_restart_file(jf)
652	ELSE
653	DO ib = 1, jf - 1
654	IF(cg_name_rstfile(ig_no_rstfile(ib)).eq.
655	$ cg_restart_file(jf)) THEN
656	ig_no_rstfile(jf) = ig_no_rstfile(ib)
657	ENDIF
658	ENDDO
659	ENDIF
660	ENDIF
661	CALL parse(clline, clvari, 7, jpeighty, ilen)
662	C* For all techniques beside PIPE and NONE technique, get eventually
663	C* the field STATUS
664	IF (cchan .ne. 'PIPE' .and. cchan .ne. 'NONE') THEN
665	IF (clvari(1:8).eq.'EXPORTED' .or.
666	$ clvari(1:8).eq.'AUXILARY') THEN
667	cstate(ig_number_field(jf)) = clvari
668	ELSEIF (clvari(1:6) .eq. 'EXPOUT') THEN
669	cstate(ig_number_field(jf)) = 'EXPORTED'
670	ENDIF
671	C*
672	ELSE
673	IF (lg_state(jf)) cficout(ig_number_field(jf)) = clvari
674	C* Get field status
675	CALL parse(clline, clvari, 8, jpeighty, ilen)
676	IF (lg_state(jf)) cstate(ig_number_field(jf)) = clvari
677	IF (lg_state(jf)) then
678	IF (cstate(ig_number_field(jf)) .ne. 'EXPORTED'
679	$ .and. cstate(ig_number_field(jf)) .ne. 'AUXILARY') THEN
680	CALL prtout
681	$ ('Error in namcouple for status of field',jf,1)
682	WRITE (UNIT = nulou,FMT = *)
683	$ '==> Must be EXPORTED or AUXILARY'
684	WRITE (UNIT = nulou,FMT = *)
685	$ 'Maybe you forgot the output FILE name which'
686	WRITE (UNIT = nulou,FMT = *)
687	$ 'is mandatory for PIPE or NONE techniques'
688	CALL HALTE('STOP in inipar')
689	ENDIF
690	ENDIF
691	ENDIF
692	C
693	C* Second line
694	C
695	IF (ig_total_state(jf) .ne. ip_input) THEN
696	READ (UNIT = nulin,FMT = 2002) clline
697	C * First determine what information is on the line
698	CALL parse(clline, clvari, 3, jpeighty, ilen)
699	IF (ilen .lt. 0) THEN
700	C * IF only two words on the line, then they are the locator
701	C * prefixes and the grids file must be in NetCDF format
702	ig_lag(jf)=0
703	ig_total_nseqn(jf)=1
704	IF (lg_state(jf)) then
705	nseqn(ig_number_field(jf)) = 1
706	nlagn(ig_number_field(jf)) = 0
707	ENDIF
708	llseq=.FALSE.
709	lldel=.FALSE.
710	llxts=.FALSE.
711	lllag=.FALSE.
712	WRITE (UNIT=nulou,FMT=3043) jf
713	IF(nmseq .gt. 1 .and. .not. llseq) GO TO 231
714	ELSE
715	READ(clvari,FMT = 2011) clind, clequa, iind
716	IF (clind .EQ. 'SEQ' .or. clind .EQ. 'DEL' .or.
717	$ clind .eq. 'XTS' .or. clind .EQ. 'LAG' .and.
718	$ clequa .EQ. '=') THEN
719	C * If 3rd word is an index, then first two words are
720	C * locator prefixes and grids file must be NetCDF format
721	ilind1=3
722	ilind2=6
723	ELSE
724	C * If not, the first 4 words are grid dimensions and next
725	C * 2 words are locator prefixes, and grids file may be or
726	C * not in NetCDF FORMAT.
727	ilind1=7
728	ilind2=10
729	ENDIF
730	C * Get possibly additional indices
731	ig_lag(jf)=0
732	ig_total_nseqn(jf)=1
733	IF (lg_state(jf)) then
734	nseqn(ig_number_field(jf)) = 1
735	nlagn(ig_number_field(jf)) = 0
736	ENDIF
737	llseq=.FALSE.
738	lldel=.FALSE.
739	llxts=.FALSE.
740	lllag=.FALSE.
741	C
742	DO 245 ilind=ilind1, ilind2
743	CALL parse(clline, clvari, ilind, jpeighty, ilen)
744	IF(ilen .eq. -1) THEN
745	IF (nlogprt .EQ. 2) THEN
746	C IF(.not. lldel) WRITE (UNIT=nulou,FMT=3039) jf
747	C IF(.not. llxts) WRITE (UNIT=nulou,FMT=3040) jf
748	IF(.not. lllag) WRITE (UNIT=nulou,FMT=3043) jf
749	ENDIF
750	IF(nmseq .gt. 1 .and. .not. llseq) GO TO 231
751	GO TO 247
752	ELSE
753	READ(clvari,FMT = 2011) clind, clequa, iind
754	IF (clind .EQ. 'SEQ') THEN
755	IF (iind .gt. nmseq) THEN
756	GO TO 232
757	ELSE IF (iind .eq. 0) THEN
758	GO TO 234
759	ELSE
760	ig_total_nseqn(jf)=iind
761	IF (lg_state(jf))
762	$ nseqn(ig_number_field(jf)) = iind
763	llseq=.TRUE.
764	ENDIF
765	ELSE IF (clind .eq. 'LAG') THEN
766	ig_lag(jf)=iind
767	IF (lg_state(jf))
768	$ nlagn(ig_number_field(jf)) = iind
769	lllag=.TRUE.
770	WRITE (UNIT = nulou,FMT = 3044)jf,ig_lag(jf)
771	ENDIF
772	ENDIF
773	245 CONTINUE
774	ENDIF
775	ENDIF
776
777	C
778	247 CONTINUE
779	C
780	C* Third line
781	C
782	IF (lg_state(jf)) THEN
783	READ (UNIT = nulin,FMT = 2002) clline
784	CALL parse(clline, clvari, 1, jpeighty, ilen)
785	C * Get source grid periodicity type
786	csper(ig_number_field(jf)) = clvari
787	IF(csper(ig_number_field(jf)) .NE. 'P' .AND.
788	$ csper(ig_number_field(jf)) .NE. 'R') THEN
789	CALL prtout
790	$ ('ERROR in namcouple for source grid type of field', jf, 1)
791	WRITE (UNIT = nulou,FMT = *) '==> must be P or R'
792	CALL HALTE('STOP in inipar')
793	ENDIF
794	C
795	CALL parse(clline, clvari, 2, jpeighty, ilen)
796	C * Get nbr of overlapped longitudes for the Periodic type source grid
797	READ(clvari,FMT = 2005) nosper(ig_number_field(jf))
798	CALL parse(clline, clvari, 3, jpeighty, ilen)
799	C * Get target grid periodicity type
800	ctper(ig_number_field(jf)) = clvari
801	IF(ctper(ig_number_field(jf)) .NE. 'P' .AND.
802	$ ctper(ig_number_field(jf)) .NE. 'R') THEN
803	CALL prtout
804	$ ('ERROR in namcouple for target grid type of field', jf, 1)
805	WRITE (UNIT = nulou,FMT = *) '==> must be P or R'
806	CALL HALTE('STOP in inipar')
807	ENDIF
808	C
809	CALL parse(clline, clvari, 4, jpeighty, ilen)
810	C * Get nbr of overlapped longitudes for the Periodic type target grid
811	READ(clvari,FMT = 2005) notper(ig_number_field(jf))
812	C
813	C Define stuff related to parallel decomposition. For now, as oasis
814	C is always monoproc, cparal(ig_number_field(jf))='SERIAL'.
815	C
816	IF (cchan .EQ. 'MPI2' .OR. cchan .EQ. 'MPI1') THEN
817	cparal(ig_number_field(jf)) = 'SERIAL'
818	ENDIF
819	ENDIF
820	C
821	C* Get the local transformation
822	C
823	IF (.not. lg_state(jf)) THEN
824	IF (ig_total_state(jf) .ne. ip_input .and.
825	$ ig_total_ntrans(jf) .gt. 0 ) THEN
826	READ (UNIT = nulin,FMT = 2002) clline
827	CALL skip(clline, jpeighty)
828	DO ja=1,ig_total_ntrans(jf)
829	READ (UNIT = nulin,FMT = 2002) clline
830	CALL parse(clline, clvari, 1, jpeighty, ilen)
831	IF (clvari(1:7) .eq. 'INSTANT') THEN
832	ig_local_trans(jf) = ip_instant
833	ELSEIF (clvari(1:7) .eq. 'AVERAGE') THEN
834	ig_local_trans(jf) = ip_average
835	ELSEIF (clvari(1:7) .eq. 'ACCUMUL') THEN
836	ig_local_trans(jf) = ip_accumul
837	ELSEIF (clvari(1:5) .eq. 'T_MIN') THEN
838	ig_local_trans(jf) = ip_min
839	ELSEIF (clvari(1:5) .eq. 'T_MAX') THEN
840	ig_local_trans(jf) = ip_max
841	ELSE
842	CALL prtout
843	$ ('ERROR in namcouple for local transformations of field', jf, 1)
844	WRITE (UNIT = nulou,FMT = *)
845	$ '==> Must be INSTANT, AVERAGE, ACCUMUL, T_MIN or T_MAX'
846	CALL HALTE('STOP in inipar')
847	ENDIF
848	ENDDO
849	ENDIF
850	ELSE
851	READ (UNIT = nulin,FMT = 2002) clline
852	CALL skip(clline, jpeighty)
853	C
854	C * Now read specifics for each transformation
855	C
856	DO 270 ja = 1, ig_ntrans(ig_number_field(jf))
857	C
858	C * Read next line unless if analysis is NOINTERP (no input)
859	C
860	IF(canal(ja,ig_number_field(jf)) .NE. 'NOINTERP') THEN
861	READ (UNIT = nulin,FMT = 2002) clline
862	CALL skip(clline, jpeighty)
863	ENDIF
864	IF (canal(ja,ig_number_field(jf)) .EQ. 'LOCTRANS') THEN
865	CALL parse(clline, clvari, 1, jpeighty, ilen)
866	IF (clvari(1:7) .eq. 'INSTANT') THEN
867	ig_local_trans(jf) = ip_instant
868	ELSEIF (clvari(1:7) .eq. 'AVERAGE') THEN
869	ig_local_trans(jf) = ip_average
870	ELSEIF (clvari(1:7) .eq. 'ACCUMUL') THEN
871	ig_local_trans(jf) = ip_accumul
872	ELSEIF (clvari(1:5) .eq. 'T_MIN') THEN
873	ig_local_trans(jf) = ip_min
874	ELSEIF (clvari(1:5) .eq. 'T_MAX') THEN
875	ig_local_trans(jf) = ip_max
876	ELSE
877	CALL prtout
878	$ ('ERROR in namcouple for local transformations of field', jf, 1)
879	WRITE (UNIT = nulou,FMT = *)
880	$ '==> Must be INSTANT, AVERAGE, ACCUMUL, T_MIN or T_MAX'
881	CALL HALTE('STOP in inipar')
882	ENDIF
883	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'MASK') THEN
884	CALL parse(clline, clvari, 1, jpeighty, ilen)
885	C * Get mask value
886	READ(clvari,FMT = 2006) amskval(ig_number_field(jf))
887	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'MASKP') THEN
888	CALL parse(clline, clvari, 1, jpeighty, ilen)
889	C * Get the Mask value for the output field
890	READ(clvari,FMT = 2006)amskvalnew(ig_number_field(jf))
891	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'MOZAIC')THEN
892	CALL parse(clline, clvari, 1, jpeighty, ilen)
893	C * Get file name for grid mapping
894	cgrdmap(ig_number_field(jf)) = clvari
895	CALL parse(clline, clvari, 2, jpeighty, ilen)
896	C * Get related logical unit
897	READ(clvari,FMT = 2005) nlumap(ig_number_field(jf))
898	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'INVERT')THEN
899	ig_invert(jf) = 1
900	CALL parse(clline, clvari, 1, jpeighty, ilen)
901	C * Get lat-lon ordering for initial fields
902	cxordbf(ig_number_field(jf)) = clvari
903	IF(trim(adjustl(clvari)).eq.'NORSUD')
904	$ ig_invert(jf)=ig_invert(jf)+1
905	CALL parse(clline, clvari, 2, jpeighty, ilen)
906	cyordbf(ig_number_field(jf)) = clvari
907	IF(trim(adjustl(clvari)).eq.'ESTWST')
908	$ ig_invert(jf)=ig_invert(jf)+2
909	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKIN')THEN
910	C * Get field integral flag
911	CALL parse(clline, clvari, 1, jpeighty, ilen)
912	READ(clvari,FMT = 2010) clind, clequa,
913	$ ntinpflx(ig_number_field(jf))
914	IF(clind .NE. 'INT') GO TO 235
915	IF (ntinpflx(ig_number_field(jf)) .eq. 1)
916	$ lsurf(ig_number_field(jf))= .TRUE.
917	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKOUT')
918	$ THEN
919	C *Get field integral flag
920	CALL parse(clline, clvari, 1, jpeighty, ilen)
921	READ(clvari,FMT = 2010) clind, clequa,
922	$ ntoutflx(ig_number_field(jf))
923	IF(clind .NE. 'INT') GO TO 235
924	IF (ntoutflx(ig_number_field(jf)) .eq. 1)
925	$ lsurf(ig_number_field(jf))= .TRUE.
926	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'NOINTERP')
927	$ THEN
928	C * No interpolation case
929	CONTINUE
930	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'REVERSE')
931	$ THEN
932	ig_reverse(jf) = 1
933	C * Get lat-lon ordering for final fields
934	CALL parse(clline, clvari, 1, jpeighty, ilen)
935	cxordaf(ig_number_field(jf)) = clvari
936	IF(trim(adjustl(clvari)).eq.'NORSUD')
937	$ ig_reverse(jf)=ig_reverse(jf)+1
938	CALL parse(clline, clvari, 2, jpeighty, ilen)
939	cyordaf(ig_number_field(jf)) = clvari
940	IF(trim(adjustl(clvari)).eq.'ESTWST')
941	$ ig_reverse(jf)=ig_reverse(jf)+2
942	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'EXTRAP')THEN
943	CALL parse(clline, clvari, 1, jpeighty, ilen)
944	C * Get extrapolation method
945	cextmet(ig_number_field(jf)) = clvari
946	CALL parse(clline, clvari, 2, jpeighty, ilen)
947	C * Get number of neighbors used in extrapolation
948	C If extrapolation method is NINENN, next variable is the MINIMUM
949	C number of neighbors required (among the 8 closest) to perform
950	C the extrapolation (cannot be greater than 4 for convergence).
951	C In case it is WEIGHT, it is the MAXIMUM number
952	C of neighbors required by the extrapolation operation.
953	C
954	READ(clvari,FMT = 2003) neighbor(ig_number_field(jf))
955	IF (cextmet(ig_number_field(jf)) .EQ. 'NINENN' .AND.
956	$ neighbor(ig_number_field(jf)) .GT. 4) THEN
957	neighbor(ig_number_field(jf))=4
958	WRITE(UNIT = nulou,FMT = ) ' WARNING*'
959	WRITE(UNIT = nulou,FMT = *)
960	$ 'For EXTRAP/NINENN extrapolation'
961	WRITE(UNIT = nulou,FMT = *)
962	$ 'the number of neighbors has been set to 4'
963	ENDIF
964	C * If choice is NINENN, read one more data
965	IF (cextmet(ig_number_field(jf)) .EQ. 'NINENN') THEN
966	CALL parse(clline, clvari, 3, jpeighty, ilen)
967	C * Get NINENN weights read/write flag
968	READ(clvari,FMT = 2005) niwtn(ig_number_field(jf))
969	ENDIF
970	C * If choice is WEIGHT, read more data
971	IF (cextmet(ig_number_field(jf)) .EQ. 'WEIGHT') THEN
972	CALL parse(clline, clvari, 3, jpeighty, ilen)
973	C * Get file name for grid mapping
974	cgrdext(ig_number_field(jf)) = clvari
975	CALL parse(clline, clvari, 4, jpeighty, ilen)
976	C * Get related logical unit
977	READ(clvari,FMT = 2005) nluext(ig_number_field(jf))
978	ENDIF
979	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'INTERP')THEN
980	CALL parse(clline, clvari, 1, jpeighty, ilen)
981	C * Get interpolation method
982	cintmet(ig_number_field(jf)) = clvari
983	CALL parse(clline, clvari, 2, jpeighty, ilen)
984	C * Get source grid type
985	cgrdtyp(ig_number_field(jf)) = clvari
986	CALL parse(clline, clvari, 3, jpeighty, ilen)
987	C * Get field type (scalar or vector)
988	cfldtyp(ig_number_field(jf)) = clvari
989	C * If interpolation uses ANAIS(G-M), read in more data
990	IF (cintmet(ig_number_field(jf)) .EQ. 'SURFMESH') THEN
991	CALL parse(clline, clvari, 6, jpeighty, ilen)
992	C * Get Anaism weights read/write flag
993	READ(clvari,FMT = 2005) niwtm(ig_number_field(jf))
994	ENDIF
995	IF (cintmet(ig_number_field(jf)) .EQ. 'GAUSSIAN') THEN
996	CALL parse(clline, clvari, 6, jpeighty, ilen)
997	C * Read variance multiplicator for gaussian weights
998	READ(clvari,FMT = 2006) varmul(ig_number_field(jf))
999	CALL parse(clline, clvari, 7, jpeighty, ilen)
1000	C * Get Anaisg weights read/write flag
1001	READ(clvari,FMT = 2005) niwtg(ig_number_field(jf))
1002	ENDIF
1003	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'SCRIPR') THEN
1004	C* Get Scrip remapping method
1005	CALL parse(clline, clvari, 1, jpeighty, ilen)
1006	READ(clvari,FMT = 2009) cmap_method(ig_number_field(jf))
1007	C* Get source grid type
1008	CALL parse(clline, clvari, 2, jpeighty, ilen)
1009	READ(clvari,FMT = 2009) cgrdtyp(ig_number_field(jf))
1010	IF (cmap_method(ig_number_field(jf)) .eq. 'BICUBIC'
1011	$ .and. cgrdtyp(ig_number_field(jf)) .ne. 'LR'
1012	$ .and. cgrdtyp(ig_number_field(jf)) .ne. 'D') THEN
1013	WRITE (UNIT = nulou,FMT = *) ' '
1014	CALL prtout
1015	$ ('ERROR in namcouple for type of field', jf, 1)
1016	WRITE (UNIT = nulou,FMT = *)
1017	$ 'BICUBIC interpolation cannot be used if grid is not LR or D'
1018	CALL HALTE('STOP in inipar')
1019	ENDIF
1020	IF (cmap_method(ig_number_field(jf)) .eq. 'BILINEAR'
1021	$ .and. cgrdtyp(ig_number_field(jf)) .ne. 'LR'
1022	$ .and. cgrdtyp(ig_number_field(jf)) .ne. 'D') THEN
1023	WRITE (UNIT = nulou,FMT = *) ' '
1024	CALL prtout
1025	$ ('ERROR in namcouple for type of field', jf, 1)
1026	WRITE (UNIT = nulou,FMT = *)
1027	$ 'BILINEAR interpolation cannot be used if grid is not LR or D'
1028	CALL HALTE('STOP in inipar')
1029	ENDIF
1030	C* Get field type (scalar/vector)
1031	CALL parse(clline, clvari, 3, jpeighty, ilen)
1032	READ(clvari,FMT = 2009) cfldtype(ig_number_field(jf))
1033	IF(cfldtype(ig_number_field(jf)) .NE. 'SCALAR' .AND.
1034	$ cfldtype(ig_number_field(jf)) .NE. 'VECTOR' .AND.
1035	$ cfldtype(ig_number_field(jf)) .NE. 'VECTOR_I' .AND.
1036	$ cfldtype(ig_number_field(jf)) .NE. 'VECTOR_J') THEN
1037	WRITE (UNIT = nulou,FMT = *) ' '
1038	CALL prtout
1039	$ ('ERROR in namcouple for type of field', jf, 1)
1040	WRITE (UNIT = nulou,FMT = *)
1041	$ '==> must be SCALAR, VECTOR_I or VECTOR_J'
1042	CALL HALTE('STOP in inipar')
1043	ENDIF
1044	C* Get restriction type for SCRIP search
1045	CALL parse(clline, clvari, 4, jpeighty, ilen)
1046	READ(clvari,FMT = 2009) crsttype(ig_number_field(jf))
1047	IF (cgrdtyp(ig_number_field(jf)) .EQ. 'D') THEN
1048	IF (cmap_method(ig_number_field(jf)) .EQ. 'BILINEAR'
1049	$ .or.
1050	$ cmap_method(ig_number_field(jf)) .EQ. 'BICUBIC')
1051	$ THEN
1052	IF (crsttype(ig_number_field(jf)) .NE. 'LATITUDE')
1053	$ THEN
1054	WRITE (UNIT = nulou,FMT = *) ' '
1055	CALL prtout
1056	$ ('ERROR in namcouple for restriction of field',jf,1)
1057	WRITE (UNIT = nulou,FMT = *)
1058	$ '==> LATITUDE must be chosen for reduced grids (D)'
1059	CALL HALTE('STOP in inipar')
1060	ELSE
1061	crsttype(ig_number_field(jf)) = 'REDUCED'
1062	ENDIF
1063	ENDIF
1064	ENDIF
1065	C
1066	IF(crsttype(ig_number_field(jf)) .NE. 'LATITUDE' .AND.
1067	$ crsttype(ig_number_field(jf)) .NE. 'LATLON' .AND.
1068	$ crsttype(ig_number_field(jf)) .NE. 'REDUCED') THEN
1069	WRITE (UNIT = nulou,FMT = *) ' '
1070	CALL prtout
1071	$ ('ERROR in namcouple for restriction of field',jf,1)
1072	WRITE (UNIT = nulou,FMT = *)
1073	$ '==> must be LATITUDE or LATLON'
1074	CALL HALTE('STOP in inipar')
1075	ENDIF
1076	C*
1077	C* Get number of search bins for SCRIP search
1078	CALL parse(clline, clvari, 5, jpeighty, ilen)
1079	READ(clvari,FMT = 2003) nbins(ig_number_field(jf))
1080	C* Get normalize option for CONSERV
1081	IF (cmap_method(ig_number_field(jf)) .EQ. 'CONSERV') THEN
1082	CALL parse(clline, clvari, 6, jpeighty, ilen)
1083	READ(clvari,FMT = 2009)cnorm_opt(ig_number_field(jf))
1084	IF (cnorm_opt(ig_number_field(jf)) .NE. 'FRACAREA'
1085	$ .AND.
1086	$ cnorm_opt(ig_number_field(jf)) .NE. 'DESTAREA'
1087	$ .AND.
1088	$ cnorm_opt(ig_number_field(jf)) .NE. 'FRACNNEI')
1089	$ THEN
1090	WRITE (UNIT = nulou,FMT = *) ' '
1091	CALL prtout
1092	$ ('ERROR in namcouple for normalize option of field',jf,1)
1093	WRITE (UNIT = nulou, FMT = *)
1094	$ '==> must be FRACAREA, DESTAREA, or FRACNNEI'
1095	CALL HALTE('STOP in inipar')
1096	ENDIF
1097	C* Get order of remapping for CONSERV
1098	CALL parse(clline, clvari, 7, jpeighty, ilen)
1099	IF (ilen .LE. 0) THEN
1100	WRITE (UNIT = nulou,FMT = *) ' '
1101	CALL prtout
1102	$ ('ERROR in namcouple for CONSERV for field',jf,1)
1103	WRITE (UNIT = nulou,FMT = *)
1104	$ '==> SECOND or FIRST must be indicated at end of line'
1105	CALL HALTE('STOP in inipar')
1106	ENDIF
1107	READ(clvari,FMT = 2009) corder(ig_number_field(jf))
1108	ELSE
1109	cnorm_opt(ig_number_field(jf))='NONORM'
1110	ENDIF
1111	C* Get number of neighbours for DISTWGT and GAUSWGT
1112	IF (cmap_method(ig_number_field(jf)) .EQ. 'DISTWGT' .or.
1113	$ cmap_method(ig_number_field(jf)) .EQ. 'GAUSWGT') THEN
1114	CALL parse(clline, clvari, 6, jpeighty, ilen)
1115	IF (ilen .LE. 0) THEN
1116	WRITE (UNIT = nulou,FMT = *) ' '
1117	CALL prtout
1118	$ ('ERROR in namcouple for field',jf,1)
1119	WRITE (UNIT = nulou,FMT = *)
1120	$ '==> Number of neighbours must be indicated on the line'
1121	CALL HALTE('STOP in inipar')
1122	ELSE
1123	READ(clvari,FMT=2003)nscripvoi(ig_number_field(jf))
1124	ENDIF
1125	ENDIF
1126	C* Get gaussian variance for GAUSWGT
1127	IF (cmap_method(ig_number_field(jf)) .EQ. 'GAUSWGT') THEN
1128	CALL parse(clline, clvari, 7, jpeighty, ilen)
1129	IF (ilen .LE. 0) THEN
1130	WRITE (UNIT = nulou,FMT = *) ' '
1131	CALL prtout
1132	$ ('ERROR in namcouple for GAUSWGT for field',jf,1)
1133	WRITE (UNIT = nulou,FMT = *)
1134	$ '==> Variance must be indicated at end of line'
1135	CALL HALTE('STOP in inipar')
1136	ELSE
1137	READ(clvari,FMT=2006) varmul(ig_number_field(jf))
1138	ENDIF
1139	ENDIF
1140	C*Get associated file name and information about rotation to cartesien
1141	IF (cfldtype(ig_number_field(jf))=='VECTOR_I' .or.
1142	$ cfldtype(ig_number_field(jf))=='VECTOR_J') THEN
1143	IF(cmap_method(ig_number_field(jf)) .EQ. 'DISTWGT')
1144	$ lastplace=7
1145	IF(cmap_method(ig_number_field(jf)) .EQ. 'GAUSWGT')
1146	$ lastplace=8
1147	IF(cmap_method(ig_number_field(jf)) .EQ. 'BILINEAR')
1148	$ lastplace=6
1149	IF(cmap_method(ig_number_field(jf)) .EQ. 'BICUBIC')
1150	$ lastplace=6
1151	IF(cmap_method(ig_number_field(jf)) .EQ. 'CONSERV')
1152	$ lastplace=8
1153	CALL parse(clline, clvari, lastplace, jpeighty, ilen)
1154	IF (ilen .le. 0) THEN
1155	WRITE (UNIT = nulou,FMT = *) ' '
1156	WRITE (UNIT = nulou,FMT = *)
1157	$ '==> A field associated must be indicated'
1158	CALL HALTE('STOP in inipar')
1159	ENDIF
1160	cg_assoc_input_field(ig_number_field(jf))=clvari
1161	C*Rotation?
1162	CALL parse(clline, clvari, lastplace+1, jpeighty,
1163	$ ilen)
1164	IF (ilen .le. 0) THEN
1165	lrotate(ig_number_field(jf)) = .false.
1166	ELSEIF(clvari .le. 'PROJCART') THEN
1167	lrotate(ig_number_field(jf)) = .true.
1168	WRITE (UNIT = nulou,FMT = *)
1169	$ 'rotation to cartesian for field : ', jf
1170	ELSE
1171	WRITE (UNIT = nulou,FMT = *) ' '
1172	CALL prtout
1173	$ ('ERROR in namcouple for vector in SCRIPR
1174	$ for field',jf,1)
1175	WRITE (UNIT = nulou,FMT = *)
1176	$ 'must be PROJCART or nothing'
1177	CALL HALTE('STOP in inipar')
1178	ENDIF
1179	END IF
1180	C
1181	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'FILLING')
1182	$ THEN
1183	CALL parse(clline, clvari, 1, jpeighty, ilen)
1184	C * Get data file name (used to complete the initial field array)
1185	cfilfic(ig_number_field(jf)) = clvari
1186	CALL parse(clline, clvari, 2, jpeighty, ilen)
1187	C * Get logical unit connected to previous file
1188	READ(clvari,FMT = 2005) nlufil(ig_number_field(jf))
1189	CALL parse(clline, clvari, 3, jpeighty, ilen)
1190	C * Get filling method
1191	cfilmet(ig_number_field(jf)) = clvari
1192	C * If current field is SST
1193	IF(cfilmet(ig_number_field(jf))(4:6) .EQ. 'SST') THEN
1194	CALL parse(clline, clvari, 4, jpeighty, ilen)
1195	C * Get flag for coast mismatch correction
1196	READ(clvari,FMT = 2005) nfcoast
1197	IF (cfilmet(ig_number_field(jf))(1:3) .EQ. 'SMO')
1198	$ THEN
1199	CALL parse(clline, clvari, 5, jpeighty, ilen)
1200	C * Get field name for flux corrective term
1201	cfldcor = clvari
1202	CALL parse(clline, clvari, 6, jpeighty, ilen)
1203	C * Get logical unit used to write flux corrective term
1204	READ(clvari,FMT = 2005) nlucor
1205	ENDIF
1206	ENDIF
1207	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CONSERV')
1208	$ THEN
1209	CALL parse(clline, clvari, 1, jpeighty, ilen)
1210	C * Get conservation method
1211	cconmet(ig_number_field(jf)) = clvari
1212	lsurf(ig_number_field(jf)) = .TRUE.
1213	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'REDGLO') THEN
1214	C * Get extrapolation flag to go from reduced to global gaussian grid
1215	CALL parse(clline, clvari, 2, jpeighty, ilen)
1216	cmskrd(ig_number_field(jf)) = clvari
1217	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'GLORED') THEN
1218	CALL parse(clline, clvari, 2, jpeighty, ilen)
1219	C * Get number of neighbors used in EXTRAP/NINENN extrapolation always
1220	C performed within GLORED (cannot be greater than 4 for convergence).
1221	READ(clvari,FMT = 2003) neighborg(ig_number_field(jf))
1222	CALL parse(clline, clvari, 3, jpeighty, ilen)
1223	IF (neighborg(ig_number_field(jf)) .GT. 4) THEN
1224	neighborg(ig_number_field(jf))=4
1225	WRITE(UNIT = nulou,FMT = ) ' WARNING*'
1226	WRITE(UNIT = nulou,FMT = *)
1227	$ 'For EXTRAP/NINENN extrapolation in GLORED'
1228	WRITE(UNIT = nulou,FMT = *)
1229	$ 'the number of neighbors has been set to 4'
1230	ENDIF
1231	C * Get EXTRAP/NINENN weights read/write flag
1232	READ(clvari,FMT = 2005) niwtng(ig_number_field(jf))
1233	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CORRECT')
1234	$ THEN
1235	C * Get flux correction parameters
1236	CALL parse(clline, clvari, 1, jpeighty, ilen)
1237	C * Get main field multiplicative coefficient
1238	READ(clvari,FMT = 2006) afldcoef(ig_number_field(jf))
1239	CALL parse(clline, clvari, 2, jpeighty, ilen)
1240	C * Get number of auxilary fields in correction formula
1241	READ(clvari,FMT = 2003) ncofld (ig_number_field(jf))
1242	C * Read auxilary field parameters
1243	icofld = ncofld(ig_number_field(jf))
1244	DO 280 jc = 1, icofld
1245	READ (UNIT = nulin,FMT = 2002) clline
1246	CALL parse(clline, clvari, 1, jpeighty, ilen)
1247	C * Get symbolic names for additional fields
1248	ccofld(jc,ig_number_field(jf)) = clvari
1249	CALL parse(clline, clvari, 2, jpeighty, ilen)
1250	C * Get multiplicative coefficients for additional fields
1251	READ(clvari,FMT = 2006)
1252	$ acocoef (jc,ig_number_field(jf))
1253	CALL parse(clline, clvari, 3, jpeighty, ilen)
1254	C * Get file names for external data files
1255	ccofic(jc,ig_number_field(jf)) = clvari
1256	C * Get related logical units
1257	CALL parse(clline, clvari, 4, jpeighty, ilen)
1258	READ(clvari,FMT = 2005)
1259	$ nludat(jc,ig_number_field(jf))
1260	280 CONTINUE
1261	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASOLD')THEN
1262	C * Get linear combination parameters for initial fields
1263	CALL parse(clline, clvari, 1, jpeighty, ilen)
1264	C * Get main field multiplicative coefficient
1265	READ(clvari,FMT = 2006) afldcobo(ig_number_field(jf))
1266	DO 290 jc = 1, nbofld(ig_number_field(jf))
1267	READ (UNIT = nulin,FMT = 2002) clline
1268	CALL parse(clline, clvari, 1, jpeighty, ilen)
1269	C * Get symbolic names for additional fields
1270	cbofld(jc,ig_number_field(jf)) = clvari
1271	CALL parse(clline, clvari, 2, jpeighty, ilen)
1272	C * Get multiplicative coefficients for additional fields
1273	READ(clvari,FMT = 2006)
1274	$ abocoef (jc,ig_number_field(jf))
1275	290 CONTINUE
1276	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASNEW')THEN
1277	C * Get linear combination parameters for final fields
1278	CALL parse(clline, clvari, 1, jpeighty, ilen)
1279	C * Get main field multiplicative coefficient
1280	READ(clvari,FMT = 2006) afldcobn(ig_number_field(jf))
1281	DO 291 jc = 1, nbnfld(ig_number_field(jf))
1282	READ (UNIT = nulin,FMT = 2002) clline
1283	CALL parse(clline, clvari, 1, jpeighty, ilen)
1284	C * Get symbolic names for additional fields
1285	cbnfld(jc,ig_number_field(jf)) = clvari
1286	CALL parse(clline, clvari, 2, jpeighty, ilen)
1287	C * Get multiplicative coefficients for additional fields
1288	READ(clvari,FMT = 2006)
1289	$ abncoef (jc,ig_number_field(jf))
1290	291 CONTINUE
1291	C * Get fields to restore subgrid variability
1292	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'SUBGRID')THEN
1293	CALL parse(clline, clvari, 1, jpeighty, ilen)
1294	C * Get file name for subgrid interpolation
1295	cgrdsub(ig_number_field(jf)) = clvari
1296	CALL parse(clline, clvari, 2, jpeighty, ilen)
1297	C * Get related logical unit
1298	READ(clvari,FMT = 2005) nlusub(ig_number_field(jf))
1299	CALL parse(clline, clvari, 5, jpeighty, ilen)
1300	C * Get type of subgrid interpolation (solar or non solar flux)
1301	ctypsub(ig_number_field(jf)) = clvari
1302	CALL parse(clline, clvari, 6, jpeighty, ilen)
1303	C * Get additional field name on coarse grid
1304	cfldcoa(ig_number_field(jf)) = clvari
1305	CALL parse(clline, clvari, 7, jpeighty, ilen)
1306	C * Get additional field name on fine grid
1307	cfldfin(ig_number_field(jf)) = clvari
1308	IF (ctypsub(ig_number_field(jf)) .EQ. 'NONSOLAR') THEN
1309	CALL parse(clline, clvari, 8, jpeighty, ilen)
1310	C * Get coupling ratio on coarse grid
1311	cdqdt(ig_number_field(jf)) = clvari
1312	ENDIF
1313	ELSE
1314	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1315	WRITE (UNIT = nulou,FMT = *)
1316	$ ' Type of analysis not implemented yet '
1317	WRITE (UNIT = nulou,FMT = *)
1318	$ ' The analysis required in OASIS is :'
1319	WRITE (UNIT = nulou,FMT = *) ' canal = ',
1320	$ canal(ja,ig_number_field(jf))
1321	WRITE (UNIT = nulou,FMT = *)
1322	$ ' with ja = ', ja, ' jf = ', jf
1323	WRITE (UNIT = nulou,FMT = *) ' '
1324	CALL HALTE ('STOP in inipar')
1325	ENDIF
1326	270 CONTINUE
1327	ENDIF
1328	C
1329	C* End of loop on NoF
1330	C
1331	240 CONTINUE
1332	C
1333	C*Get the associated number file for case vector
1334	C
1335	DO jf = 1, ig_total_nfield
1336	IF (cfldtype(ig_number_field(jf))=='VECTOR_I' .or.
1337	$ cfldtype(ig_number_field(jf))=='VECTOR_J') THEN
1338	DO jff = 1, ig_total_nfield
1339	IF(cnaminp(ig_number_field(jff)) .eq.
1340	$ cg_assoc_input_field(ig_number_field(jf)))THEN
1341	ig_assoc_input_field(ig_number_field(jf))=
1342	$ ig_number_field(jff)
1343	exit
1344	ENDIF
1345	ENDDO
1346	C
1347	C*Verify if interpolations are the same for the 2 components of the vector field
1348	C
1349	IF(cmap_method(ig_number_field(jf)) .ne.
1350	$ cmap_method(ig_assoc_input_field(
1351	$ ig_number_field(jf)))) THEN
1352	WRITE (UNIT = nulou,FMT = *)
1353	$ 'Interpolations must be the same for the 2'
1354	WRITE (UNIT = nulou,FMT = *)
1355	$ 'components in vector case'
1356	CALL HALTE('STOP in inipar')
1357	END IF
1358	ENDIF
1359	ENDDO
1360	C
1361	C* Minimum coupling period
1362	C
1363	ig_total_frqmin = iminim(ig_freq, ig_total_nfield)
1364	C
1365	C* Formats
1366	C
1367	2001 FORMAT(A9)
1368	2002 FORMAT(A80)
1369	2003 FORMAT(I4)
1370	2004 FORMAT(I8)
1371	2005 FORMAT(I2)
1372	2006 FORMAT(E15.6)
1373	2008 FORMAT(A2,I4)
1374	2009 FORMAT(A8)
1375	2010 FORMAT(A3,A1,I2)
1376	2011 FORMAT(A3,A1,I8)
1377	C
1378	C* 3. Printing
1379	C --------
1380	C* Warning: no indentation for the next if (nightmare ...)
1381	IF (nlogprt .GE. 1) THEN
1382	DO 310 jf = 1, ig_total_nfield
1383	IF (ig_total_state(jf) .eq. ip_exported ) THEN
1384	cl_print_state = 'EXPORTED'
1385	ELSEIF (ig_total_state(jf) .eq. ip_ignored ) THEN
1386	cl_print_state = 'IGNORED'
1387	ELSEIF (ig_total_state(jf) .eq. ip_ignout ) THEN
1388	cl_print_state = 'IGNOUT'
1389	ELSEIF (ig_total_state(jf) .eq. ip_expout ) THEN
1390	cl_print_state = 'EXPOUT'
1391	ELSEIF (ig_total_state(jf) .eq. ip_input ) THEN
1392	cl_print_state = 'INPUT'
1393	ELSEIF (ig_total_state(jf) .eq. ip_output ) THEN
1394	cl_print_state = 'OUTPUT'
1395	ELSEIF (ig_total_state(jf) .eq. ip_auxilary ) THEN
1396	cl_print_state = 'AUXILARY'
1397	ENDIF
1398	IF (ig_local_trans(jf) .eq. ip_instant) THEN
1399	cl_print_trans = 'INSTANT'
1400	ELSEIF (ig_local_trans(jf) .eq. ip_average) THEN
1401	cl_print_trans = 'AVERAGE'
1402	ELSEIF (ig_local_trans(jf) .eq. ip_accumul) THEN
1403	cl_print_trans = 'ACCUMUL'
1404	ELSEIF (ig_local_trans(jf) .eq. ip_min) THEN
1405	cl_print_trans = 'T_MIN'
1406	ELSEIF (ig_local_trans(jf) .eq. ip_max) THEN
1407	cl_print_trans = 'T_MAX'
1408	ENDIF
1409	C* Local indexes
1410	IF (.not. lg_state(jf)) THEN
1411	ilab = ig_numlab(jf)
1412	WRITE (UNIT = nulou,FMT = 3001) jf
1413	WRITE (UNIT = nulou,FMT = 3002)
1414	WRITE (UNIT = nulou,FMT = 3003)
1415	WRITE (UNIT = nulou,FMT = 3004)
1416	IF (ig_total_state(jf) .eq. ip_input .or.
1417	$ ig_total_state(jf) .eq. ip_output) THEN
1418	WRITE (UNIT = nulou,FMT = 3121)
1419	$ cg_input_field(jf), cg_output_field(jf), cfldlab(ilab),
1420	$ ig_freq(jf), cl_print_trans,
1421	$ cl_print_state, ig_total_ntrans(jf)
1422	ELSE
1423	WRITE (UNIT = nulou,FMT = 3116)
1424	$ cg_input_field(jf), cg_output_field(jf), cfldlab(ilab),
1425	$ ig_freq(jf), cl_print_trans, ig_total_nseqn(jf),
1426	$ ig_lag(jf), cl_print_state, ig_total_ntrans(jf)
1427	ENDIF
1428	ELSE
1429	ilab = numlab(ig_number_field(jf))
1430	ifcb = ilenstr(cficbf(ig_number_field(jf)),jpeight)
1431	ifca = ilenstr(cficaf(ig_number_field(jf)),jpeight)
1432	WRITE (UNIT = nulou,FMT = 3001) jf
1433	WRITE (UNIT = nulou,FMT = 3002)
1434	WRITE (UNIT = nulou,FMT = 3003)
1435	WRITE (UNIT = nulou,FMT = 3004)
1436	IF (cchan .EQ. 'MPI2' .OR. cchan .EQ. 'MPI1' ) THEN
1437	WRITE (UNIT = nulou,FMT = 3005)
1438	$ cnaminp(ig_number_field(jf)),
1439	$ cnamout(ig_number_field(jf)), cfldlab(ilab),
1440	$ nfexch(ig_number_field(jf)),
1441	$ nseqn(ig_number_field(jf)),
1442	$ ig_lag(jf),
1443	$ cl_print_state,
1444	$ ig_ntrans(ig_number_field(jf)),
1445	$ cparal(ig_number_field(jf))
1446	ELSE
1447	WRITE (UNIT = nulou,FMT = 3115)
1448	$ cnaminp(ig_number_field(jf)),
1449	$ cnamout(ig_number_field(jf)), cfldlab(ilab),
1450	$ nfexch(ig_number_field(jf)),
1451	$ nseqn(ig_number_field(jf)),
1452	$ cstate(ig_number_field(jf)),
1453	$ ig_ntrans(ig_number_field(jf))
1454	ENDIF
1455	ENDIF
1456	C* Warning: no indentation for the next if (nightmare ...)
1457	IF (nlogprt .EQ. 2) THEN
1458	C* Warning: no indentation for the next if (nightmare ...)
1459	IF (.not. lg_state(jf)) THEN
1460	IF (ig_total_state(jf) .eq. ip_ignored .or.
1461	$ ig_total_state(jf) .eq. ip_ignout ) THEN
1462	WRITE (UNIT = nulou,FMT = 3117) cg_restart_file(jf)
1463	ELSEIF (ig_total_state(jf) .eq. ip_input) THEN
1464	WRITE (UNIT = nulou,FMT = 3118) cg_input_file(jf)
1465	ENDIF
1466	ELSE
1467	IF (ig_total_state(jf) .eq. ip_exported .or.
1468	$ ig_total_state(jf) .eq. ip_expout .or.
1469	$ ig_total_state(jf) .eq. ip_auxilary )
1470	$ WRITE (UNIT = nulou,FMT = 3117) cg_restart_file(jf)
1471	C* Warning: no indentation for the next if (nightmare ...)
1472	WRITE (UNIT = nulou,FMT = 3007)
1473	$ csper(ig_number_field(jf)), nosper(ig_number_field(jf)),
1474	$ ctper(ig_number_field(jf)), notper(ig_number_field(jf))
1475	WRITE (UNIT = nulou,FMT = 3008)
1476	$ cficbf(ig_number_field(jf))(1:ifcb)//cglonsuf,
1477	$ cficbf(ig_number_field(jf))(1:ifcb)//cglatsuf,
1478	$ cficbf(ig_number_field(jf))(1:ifcb)//cmsksuf,
1479	$ cficbf(ig_number_field(jf))(1:ifcb)//csursuf,
1480	$ cficaf(ig_number_field(jf))(1:ifca)//cglonsuf,
1481	$ cficaf(ig_number_field(jf))(1:ifca)//cglatsuf,
1482	$ cficaf(ig_number_field(jf))(1:ifca)//cmsksuf,
1483	$ cficaf(ig_number_field(jf))(1:ifca)//csursuf
1484	WRITE (UNIT = nulou,FMT = 3009)
1485	WRITE (UNIT = nulou,FMT = 3010)
1486	DO 320 ja = 1, ig_ntrans(ig_number_field(jf))
1487	WRITE (UNIT = nulou,FMT = 3011) ja,
1488	$ canal(ja,ig_number_field(jf))
1489	IF (canal(ja,ig_number_field(jf)) .EQ. 'MASK') THEN
1490	WRITE(UNIT = nulou,FMT = 3012)
1491	$ amskval(ig_number_field(jf))
1492	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'MASKP') THEN
1493	WRITE(UNIT = nulou,FMT = 3042)
1494	$ amskvalnew(ig_number_field(jf))
1495	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'MOZAIC') THEN
1496	WRITE(UNIT = nulou,FMT = 3013)
1497	$ cgrdmap(ig_number_field(jf)),
1498	$ nlumap(ig_number_field(jf)),
1499	$ nmapfl(ig_number_field(jf)),
1500	$ nmapvoi(ig_number_field(jf))
1501	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'INVERT') THEN
1502	WRITE(UNIT = nulou,FMT = 3014)
1503	$ cxordbf(ig_number_field(jf))
1504	WRITE(UNIT = nulou,FMT = 3015)
1505	$ cyordbf(ig_number_field(jf))
1506	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'REVERSE') THEN
1507	WRITE(UNIT = nulou,FMT = 3016)
1508	$ cxordaf(ig_number_field(jf))
1509	WRITE(UNIT = nulou,FMT = 3017)
1510	$ cyordaf(ig_number_field(jf))
1511	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'EXTRAP') THEN
1512	WRITE(UNIT = nulou,FMT = 3018)
1513	$ cextmet(ig_number_field(jf)),
1514	$ neighbor(ig_number_field(jf))
1515	IF (cextmet(ig_number_field(jf)) .EQ. 'WEIGHT') THEN
1516	WRITE(UNIT = nulou,FMT = 3019)
1517	$ cgrdext(ig_number_field(jf)),
1518	$ nluext(ig_number_field(jf)),
1519	$ nextfl(ig_number_field(jf))
1520	ELSE IF (cextmet(ig_number_field(jf)) .EQ. 'NINENN') THEN
1521	WRITE(UNIT = nulou,FMT = 3038)
1522	$ niwtn(ig_number_field(jf)),
1523	$ nninnfl(ig_number_field(jf))
1524	ENDIF
1525	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'INTERP') THEN
1526	WRITE(UNIT = nulou,FMT = 3020)
1527	$ cintmet(ig_number_field(jf)),
1528	$ cgrdtyp(ig_number_field(jf)),
1529	$ cfldtyp(ig_number_field(jf))
1530	IF (cintmet(ig_number_field(jf)) .EQ. 'SURFMESH') THEN
1531	WRITE(UNIT = nulou,FMT = 3021)
1532	$ naismfl(ig_number_field(jf)),
1533	$ naismvoi(ig_number_field(jf)),
1534	$ niwtm(ig_number_field(jf))
1535	ENDIF
1536	IF (cintmet(ig_number_field(jf)) .EQ. 'GAUSSIAN') THEN
1537	WRITE(UNIT = nulou,FMT = 3021)
1538	$ naisgfl(ig_number_field(jf)),
1539	$ naisgvoi(ig_number_field(jf)),
1540	$ niwtg(ig_number_field(jf))
1541	WRITE(UNIT = nulou,FMT = 3022)
1542	$ varmul(ig_number_field(jf))
1543	ENDIF
1544	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'SCRIPR') THEN
1545	WRITE(UNIT = nulou,FMT = 3045)
1546	$ cmap_method(ig_number_field(jf)),
1547	$ cfldtype(ig_number_field(jf)),
1548	$ cnorm_opt(ig_number_field(jf)),
1549	$ crsttype(ig_number_field(jf)),
1550	$ nbins(ig_number_field(jf))
1551	IF (cmap_method(ig_number_field(jf)) .EQ. 'CONSERV') THEN
1552	WRITE(UNIT = nulou,FMT = 3046)
1553	$ corder(ig_number_field(jf))
1554	ENDIF
1555	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'FILLING') THEN
1556	WRITE(UNIT = nulou,FMT = 3023)
1557	$ cfilfic(ig_number_field(jf)),
1558	$ nlufil(ig_number_field(jf)),
1559	$ cfilmet(ig_number_field(jf))
1560	IF(cfilmet(ig_number_field(jf))(1:6) .EQ. 'SMOSST')
1561	$ WRITE(UNIT = nulou,FMT = 3024)
1562	$ nfcoast, cfldcor, nlucor
1563	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CONSERV') THEN
1564	WRITE(UNIT = nulou,FMT = 3025)
1565	$ cconmet(ig_number_field(jf))
1566	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'REDGLO') THEN
1567	WRITE(UNIT = nulou,FMT = 3026)
1568	$ ntronca(ig_number_field(jf)),
1569	$ cmskrd(ig_number_field(jf))
1570	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CORRECT') THEN
1571	WRITE(UNIT = nulou,FMT = 3027)
1572	$ cnamout(ig_number_field(jf)),
1573	$ afldcoef(ig_number_field(jf))
1574	WRITE(UNIT = nulou,FMT=3028) ncofld(ig_number_field(jf))
1575	icofld = ncofld(ig_number_field(jf))
1576	DO 330 jc = 1, icofld
1577	WRITE(UNIT = nulou,FMT = 3029)
1578	$ ccofic(jc,ig_number_field(jf)),
1579	$ nludat(jc,ig_number_field(jf))
1580	WRITE (UNIT = nulou,FMT = 3030)
1581	$ ccofld(jc,ig_number_field(jf)),
1582	$ acocoef(jc,ig_number_field(jf))
1583	330 CONTINUE
1584	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASOLD') THEN
1585	WRITE(UNIT = nulou,FMT = 3027)
1586	$ cnaminp(ig_number_field(jf)),
1587	$ afldcobo(ig_number_field(jf))
1588	WRITE(UNIT = nulou,FMT=3028) nbofld(ig_number_field(jf))
1589	DO 340 jc = 1, nbofld(ig_number_field(jf))
1590	WRITE (UNIT = nulou,FMT = 3030)
1591	$ cbofld(jc,ig_number_field(jf)),
1592	$ abocoef (jc,ig_number_field(jf))
1593	340 CONTINUE
1594	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASNEW') THEN
1595	WRITE(UNIT = nulou,FMT = 3027)
1596	$ cnamout(ig_number_field(jf)),
1597	$ afldcobn(ig_number_field(jf))
1598	WRITE(UNIT = nulou,FMT=3028) nbnfld(ig_number_field(jf))
1599	DO 350 jc = 1, nbnfld(ig_number_field(jf))
1600	WRITE (UNIT = nulou,FMT = 3030)
1601	$ cbnfld(jc,ig_number_field(jf)),
1602	$ abncoef (jc,ig_number_field(jf))
1603	350 CONTINUE
1604	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'SUBGRID') THEN
1605	WRITE(UNIT = nulou,FMT = 3031)
1606	$ cgrdsub(ig_number_field(jf)),
1607	$ nlusub(ig_number_field(jf)),
1608	$ nsubfl(ig_number_field(jf)),
1609	$ nsubvoi(ig_number_field(jf)),
1610	$ ctypsub(ig_number_field(jf))
1611	IF (ctypsub(ig_number_field(jf)) .EQ. 'NONSOLAR') THEN
1612	WRITE(UNIT = nulou,FMT = 3032)
1613	$ cdqdt(ig_number_field(jf)),
1614	$ cfldcoa(ig_number_field(jf)),
1615	$ cfldfin(ig_number_field(jf))
1616	ELSE IF (ctypsub(ig_number_field(jf)) .EQ. 'SOLAR') THEN
1617	WRITE(UNIT = nulou,FMT = 3033)
1618	$ cfldfin(ig_number_field(jf)),
1619	$ cfldcoa(ig_number_field(jf))
1620	ENDIF
1621	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKIN') THEN
1622	WRITE(UNIT = nulou,FMT = 3034)
1623	$ ntinpflx(ig_number_field(jf))
1624	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKOUT') THEN
1625	WRITE(UNIT = nulou,FMT = 3035)
1626	$ ntoutflx(ig_number_field(jf))
1627	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'GLORED') THEN
1628	WRITE(UNIT = nulou,FMT = 3036)
1629	$ ntronca(ig_number_field(jf))
1630	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'NOINTERP') THEN
1631	WRITE(UNIT = nulou,FMT = 3037)
1632	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'LOCTRANS') THEN
1633	WRITE(UNIT = nulou,FMT = 3047) cl_print_trans
1634	ELSE
1635	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1636	WRITE (UNIT = nulou,FMT = *)
1637	$ ' Type of analysis not implemented yet '
1638	WRITE (UNIT = nulou,FMT = *)
1639	$ ' The analysis required in OASIS is :'
1640	WRITE (UNIT = nulou,FMT = *) ' canal = ',
1641	$ canal(ja,ig_number_field(jf))
1642	WRITE (UNIT = nulou,FMT = *)
1643	$ ' with ja = ', ja, ' jf = ', jf
1644	WRITE (UNIT = nulou,FMT = *) ' '
1645	CALL HALTE ('STOP in inipar')
1646	ENDIF
1647	320 CONTINUE
1648	ENDIF
1649	ENDIF
1650	310 CONTINUE
1651	ENDIF
1652	C
1653	C* Formats
1654	C
1655	3001 FORMAT(//,15X,' FIELD NUMBER ',I3)
1656	3002 FORMAT(15X,' ************ ')
1657	3003 FORMAT(/,10X,' Field parameters ')
1658	3004 FORMAT(10X,' **************** ',/)
1659	3005 FORMAT(/,10X,' Input field symbolic name = ',A8,
1660	$ /,10X,' Output field symbolic name = ',A8,
1661	$ /,10X,' Field long name = ',
1662	$ /,18X,A53,
1663	$ /,10X,' Field exchange frequency = ',I8,
1664	$ /,10X,' Model sequential index = ',I2,
1665	$ /,10X,' Field Lag = ',I8,
1666	C $ /,10X,' Model delay flag = ',I2,
1667	C $ /,10X,' Extra time step flag = ',I2,
1668	$ /,10X,' Field I/O status = ',A8,
1669	$ /,10X,' Number of basic operations = ',I4,
1670	$ /,10X,' Parallel decomposition strategy = ',A8,/)
1671	3115 FORMAT(/,10X,' Input field symbolic name = ',A8,
1672	$ /,10X,' Output field symbolic name = ',A8,
1673	$ /,10X,' Field long name = ',
1674	$ /,18XA53,
1675	$ /,10X,' Field exchange frequency = ',I8,
1676	$ /,10X,' Model sequential index = ',I2,
1677	C $ /,10X,' Model delay flag = ',I2,
1678	C $ /,10X,' Extra time step flag = ',I2,
1679	$ /,10X,' Field I/O status = ',A8,
1680	$ /,10X,' Number of basic operations = ',I4,/)
1681	3116 FORMAT(/,10X,' Input field symbolic name = ',A8,
1682	$ /,10X,' Output field symbolic name = ',A8,
1683	$ /,10X,' Field long name = ',
1684	$ /,18XA53,
1685	$ /,10X,' Field exchange frequency = ',I8,
1686	$ /,10X,' Local transformation = ',A8,
1687	$ /,10X,' Model sequential index = ',I2,
1688	$ /,10X,' Field Lag = ',I8,
1689	$ /,10X,' Field I/O status = ',A8,
1690	$ /,10X,' Number of basic operations = ',I4,/)
1691	3117 FORMAT(/,10X,' Restart file name = ',A8,/)
1692	3118 FORMAT(/,10X,' Input file name = ',A32,/)
1693	3121 FORMAT(/,10X,' Input field symbolic name = ',A8,
1694	$ /,10X,' Output field symbolic name = ',A8,
1695	$ /,10X,' Field long name = ',
1696	$ /,18XA53,
1697	$ /,10X,' Field exchange frequency = ',I8,
1698	$ /,10X,' Local transformation = ',A8,
1699	$ /,10X,' Field I/O status = ',A8,
1700	$ /,10X,' Number of basic operations = ',I4,/)
1701	3006 FORMAT(/,10X,' Input file name = ',A8,
1702	$ /,10X,' Output file name = ',A8,/)
1703	3007 FORMAT(
1704	$ /,10X,' Source grid periodicity type is = ',A8,
1705	$ /,10X,' Number of overlapped grid points is = ',I2,
1706	$ /,10X,' Target grid periodicity type is = ',A8,
1707	$ /,10X,' Number of overlapped grid points is = ',I2,/)
1708	3008 FORMAT(/,10X,' Source longitude file string = ',A8,
1709	$ /,10X,' Source latitude file string = ',A8,
1710	$ /,10X,' Source mask file string = ',A8,
1711	$ /,10X,' Source surface file string = ',A8,
1712	$ /,10X,' Target longitude file string = ',A8,
1713	$ /,10X,' Target latitude file string = ',A8,
1714	$ /,10X,' Target mask file string = ',A8,
1715	$ /,10X,' Target surface file string = ',A8,/)
1716	3009 FORMAT(/,10X,' ANALYSIS PARAMETERS ')
1717	3010 FORMAT(10X,' ******************* ',/)
1718	3011 FORMAT(/,5X,' ANALYSIS number ',I2,' is ',A8,
1719	$ /,5X,' *************** ',/)
1720	3012 FORMAT(5X,' Value for masked points is = ',E15.6)
1721	3013 FORMAT(5X,' Grid mapping file = ',A8,' linked to unit = ',I2,
1722	$ /,5X,' Dataset identificator number = ',I2,
1723	$ /,5X,' Maximum number of neighbors is = ',I4)
1724	3014 FORMAT(5X,' Source grid latitude order is = ',A8)
1725	3015 FORMAT(5X,' Source grid longitude order is = ',A8)
1726	3016 FORMAT(5X,' Target grid latitude order is = ',A8)
1727	3017 FORMAT(5X,' Target grid longitude order is = ',A8)
1728	3018 FORMAT(5X,' Extrapolation method is = ',A8,
1729	$ /,5X,' Number of neighbors used is = ',I2)
1730	3019 FORMAT(5X,' Extrapolation file = ',A8,' linked to unit = ',I2,
1731	$ /,5X,' Dataset identificator number = ',I2)
1732	3020 FORMAT(5X,' Interpolation method is = ',A8,
1733	$ /,5X,' Source grid type is = ',A8,
1734	$ /,5X,' Field type is = ',A8)
1735	3021 FORMAT(5X,' Pointer for ANAIS storage is = ',I2,
1736	$ /,5X,' Maximum number of neighbors is = ',I4,
1737	$ /,5X,' Write/Read flag for weights is = ',I2)
1738	3022 FORMAT(5X,' Variance multiplicator for ANAISG = ',E15.6)
1739	3023 FORMAT(5X,' Data to fill up field is in file = ',A8,
1740	$ /,5X,' Connected to logical unit number = ',I2,
1741	$ /,5X,' Filling method to blend field is = ',A8)
1742	3024 FORMAT(5X,' Flag for coasts mismatch is = ',I2,
1743	$ /,5X,' Name for flux correction field is = ',A8,
1744	$ /,5X,' It is written on logical unit = ',I2)
1745	3025 FORMAT(5X,' Conservation method for field is = ',A8)
1746	3026 FORMAT(5X,' Half number of latitudes for gaussian grid is = ',I3,
1747	$ /,5X,' Extrapolation flag is = ',A8)
1748	3027 FORMAT(5X,' Field ',A8,' is multiplied by Cst = ',E15.6)
1749	3028 FORMAT(5X,' It is combined with N fields N = ',I2)
1750	3029 FORMAT(5X,' Data file = ',A8,' linked to unit = ',I2)
1751	3030 FORMAT(5X,' With field ',A8,' coefficient = ',E15.6)
1752	3031 FORMAT(5X,' Subgrid data file = ',A8,' linked to unit = ',I2,
1753	$ /,5X,' Dataset identificator number = ',I2,
1754	$ /,5X,' Maximum number of neighbors is = ',I4,
1755	$ /,5X,' Type of subgrid interpolation is = ',A8)
1756	3032 FORMAT(5X,' Subgrid variability is restored with addition of',
1757	$ /,5X,A8,' x (',A8,' - ',A8,')')
1758	3033 FORMAT(5X,' Subgrid variability is restored multiplying by',
1759	$ /,5X,'( 1 - ',A8,') / ( 1 - ',A8,')')
1760	3034 FORMAT(5X,' Integral calculation flag is =', I2)
1761	3035 FORMAT(5X,' Integral calculation flag is =', I2)
1762	3036 FORMAT(5X,' Half number of latitudes for gaussian grid is = ',I3)
1763	3037 FORMAT(5X,' No interpolation for this field ')
1764	3038 FORMAT(5X,' Write/Read flag for weights is = ',I2,
1765	$ /,5X,' Dataset identificator number = ',I2)
1766	C 3039 FORMAT(/,5X,' No delay flag in namcouple for field', I3,
1767	C $ /,5X,' Default value DEL=0 will be used ')
1768	C 3040 FORMAT(/,5X,' No extra timestep flag in namcouple for field', I3,
1769	C $ /,5X,' Default value XTS=0 will be used ')
1770	3041 FORMAT(/,5X,' WARNING: Extra timestep flag > 1 for field', I3,
1771	$ /,5X,' XTS=1 will be used instead')
1772	3042 FORMAT(5X,' Value for exported masked points is = ',E15.6)
1773	3043 FORMAT(/,5X,'No lag in namcouple for the field', I3,
1774	$ /,5X,' Default value LAG=0 will be used ')
1775	3044 FORMAT(/,5X,'The lag for the field ',I3,3X,'is : ',I8)
1776	3045 FORMAT(5X,' Remapping method is = ',A8,
1777	$ /,5X,' Field type is = ',A8,
1778	$ /,5X,' Normalization option is = ',A8,
1779	$ /,5X,' Seach restriction type is = ',A8,
1780	$ /,5X,' Number of search bins is = ',I4)
1781	3046 FORMAT(5X,' Order of remapping is = ',A8)
1782	3047 FORMAT(5X,' Local transformation = ',A8)
1783
1784
1785	C
1786	C
1787	C* 4. End of routine
1788	C --------------
1789	C
1790	WRITE(UNIT = nulou,FMT = *) ' '
1791	WRITE(UNIT = nulou,FMT = *)
1792	$ ' ---------- End of routine inipar ---------'
1793	CALL FLUSH (nulou)
1794	RETURN
1795	C
1796	C* Error branch output
1797	C
1798	110 CONTINUE
1799	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1800	WRITE (UNIT = nulou,FMT = *)
1801	$ ' No active $JOBNAME data found in input file namcouple'
1802	WRITE (UNIT = nulou,FMT = *) ' '
1803	WRITE (UNIT = nulou,FMT = *) ' '
1804	WRITE (UNIT = nulou,FMT = *)
1805	$ ' We STOP!!! Check the file namcouple'
1806	WRITE (UNIT = nulou,FMT = *) ' '
1807	CALL HALTE ('STOP in inipar')
1808	130 CONTINUE
1809	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1810	WRITE (UNIT = nulou,FMT = *)
1811	$ ' No active $NBMODEL data found in input file namcouple'
1812	WRITE (UNIT = nulou,FMT = *) ' '
1813	WRITE (UNIT = nulou,FMT = *) ' '
1814	WRITE (UNIT = nulou,FMT = *)
1815	$ ' We STOP!!! Check the file namcouple'
1816	WRITE (UNIT = nulou,FMT = *) ' '
1817	CALL HALTE ('STOP in inipar')
1818	170 CONTINUE
1819	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1820	WRITE (UNIT = nulou,FMT = *)
1821	$ ' No active $MACHINE data found in input file namcouple'
1822	WRITE (UNIT = nulou,FMT = *) ' '
1823	WRITE (UNIT = nulou,FMT = *) ' '
1824	WRITE (UNIT = nulou,FMT = *)
1825	$ ' We STOP!!! Check the file namcouple'
1826	WRITE (UNIT = nulou,FMT = *) ' '
1827	CALL HALTE ('STOP in inipar')
1828
1829	181 CONTINUE
1830	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1831	WRITE (UNIT = nulou,FMT = *)
1832	$ ' No active $CHATYPE data found in input file namcouple'
1833	WRITE (UNIT = nulou,FMT = *) ' '
1834	WRITE (UNIT = nulou,FMT = *) ' '
1835	WRITE (UNIT = nulou,FMT = *)
1836	$ ' We STOP!!! Check the file namcouple'
1837	WRITE (UNIT = nulou,FMT = *) ' '
1838	CALL HALTE ('STOP inipar')
1839	191 CONTINUE
1840	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1841	WRITE (UNIT = nulou,FMT = *)
1842	$ ' No active $RUNTIME data found in input file namcouple'
1843	WRITE (UNIT = nulou,FMT = *) ' '
1844	WRITE (UNIT = nulou,FMT = *) ' '
1845	WRITE (UNIT = nulou,FMT = *)
1846	$ ' We STOP!!! Check the file namcouple'
1847	WRITE (UNIT = nulou,FMT = *) ' '
1848	CALL HALTE ('STOP in inipar')
1849	193 CONTINUE
1850	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1851	WRITE (UNIT = nulou,FMT = *)
1852	$ ' No active $INIDATE data found in input file namcouple'
1853	WRITE (UNIT = nulou,FMT = *) ' '
1854	WRITE (UNIT = nulou,FMT = *) ' '
1855	WRITE (UNIT = nulou,FMT = *)
1856	$ ' We STOP!!! Check the file namcouple'
1857	WRITE (UNIT = nulou,FMT = *) ' '
1858	CALL HALTE ('STOP in inipar')
1859	195 CONTINUE
1860	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1861	WRITE (UNIT = nulou,FMT = *)
1862	$ ' No active $SEQMODE data found in input file namcouple'
1863	WRITE (UNIT = nulou,FMT = *) ' '
1864	WRITE (UNIT = nulou,FMT = *) ' '
1865	WRITE (UNIT = nulou,FMT = *)
1866	$ ' We STOP!!! Check the file namcouple'
1867	WRITE (UNIT = nulou,FMT = *) ' '
1868	CALL HALTE ('STOP in inipar')
1869	197 CONTINUE
1870	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1871	WRITE (UNIT = nulou,FMT = *)
1872	$ ' No active $MODINFO data found in input file namcouple'
1873	WRITE (UNIT = nulou,FMT = *) ' '
1874	WRITE (UNIT = nulou,FMT = *) ' '
1875	WRITE (UNIT = nulou,FMT = *)
1876	$ ' We STOP!!! Check the file namcouple'
1877	WRITE (UNIT = nulou,FMT = *) ' '
1878	CALL HALTE ('STOP in inipar')
1879	199 CONTINUE
1880	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1881	WRITE (UNIT = nulou,FMT = *)
1882	$ ' No active $NLOGPRT found in input file namcouple'
1883	WRITE (UNIT = nulou,FMT = *) ' '
1884	WRITE (UNIT = nulou,FMT = *) ' '
1885	WRITE (UNIT = nulou,FMT = *)
1886	$ ' We STOP!!! Check the file namcouple'
1887	WRITE (UNIT = nulou,FMT = *) ' '
1888	CALL HALTE ('STOP in inipar')
1889	201 CONTINUE
1890	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1891	WRITE (UNIT = nulou,FMT = *)
1892	$ ' No active $CALTYPE found in input file namcouple'
1893	WRITE (UNIT = nulou,FMT = *) ' '
1894	WRITE (UNIT = nulou,FMT = *) ' '
1895	WRITE (UNIT = nulou,FMT = *)
1896	$ ' We STOP!!! Check the file namcouple'
1897	WRITE (UNIT = nulou,FMT = *) ' '
1898	CALL HALTE ('STOP in inipar')
1899	210 CONTINUE
1900	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1901	WRITE (UNIT = nulou,FMT = *)
1902	$ ' No active $FIELDS data found in input file namcouple'
1903	WRITE (UNIT = nulou,FMT = *) ' '
1904	WRITE (UNIT = nulou,FMT = *) ' '
1905	WRITE (UNIT = nulou,FMT = *)
1906	$ ' We STOP!!! Check the file namcouple'
1907	WRITE (UNIT = nulou,FMT = *) ' '
1908	CALL HALTE ('STOP in inipar')
1909	230 CONTINUE
1910	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1911	WRITE (UNIT = nulou,FMT = *)
1912	$ ' No active $STRING data found in input file namcouple'
1913	WRITE (UNIT = nulou,FMT = *) ' '
1914	WRITE (UNIT = nulou,FMT = *) ' '
1915	WRITE (UNIT = nulou,FMT = *)
1916	$ ' We STOP!!! Check the file namcouple'
1917	WRITE (UNIT = nulou,FMT = *) ' '
1918	CALL HALTE ('STOP in inipar')
1919	231 CONTINUE
1920	WRITE (UNIT = nulou,FMT = *) ' '
1921	CALL prtout ('ERROR in namcouple for field', jf, 1)
1922	WRITE (UNIT = nulou,FMT = *)
1923	$ 'NO index of sequential position and $SEQMODE > 1'
1924	CALL halte('STOP in inipar.f')
1925	232 CONTINUE
1926	WRITE (UNIT = nulou,FMT = *) ' '
1927	CALL prtout ('ERROR in namcouple for field', jf, 1)
1928	WRITE (UNIT = nulou,FMT = *)
1929	$ 'Index of sequential position greater than $SEQMODE'
1930	CALL halte('STOP in inipar.f')
1931	233 CONTINUE
1932	WRITE (UNIT = nulou,FMT = *) ' '
1933	CALL prtout ('ERROR in namcouple for field', jf, 1)
1934	WRITE (UNIT = nulou,FMT = *)
1935	$'Check the 2nd line for either the index of sequential position,
1936	$the delay flag, or the extra timestep flag.'
1937	CALL halte('STOP in inipar.f')
1938	234 CONTINUE
1939	WRITE (UNIT = nulou,FMT = *) ' '
1940	CALL prtout ('ERROR in namcouple for field', jf, 1)
1941	WRITE (UNIT = nulou,FMT = *)
1942	$ 'Index of sequential position equals 0'
1943	WRITE (UNIT = nulou,FMT = *)
1944	$ '(Should be 1 -default value- IF $SEQMODE=1)'
1945	CALL halte('STOP in inipar.f')
1946	235 CONTINUE
1947	WRITE (UNIT = nulou,FMT = *) ' '
1948	CALL prtout ('ERROR in namcouple for field', jf, 1)
1949	WRITE (UNIT = nulou,FMT = *)
1950	$ 'An input line with integral calculation flag'
1951	WRITE (UNIT = nulou,FMT = *)
1952	$ '("INT=0" or "INT=1")'
1953	WRITE (UNIT = nulou,FMT = *)
1954	$ 'is now required for analysis CHECKIN or CHECKOUT'
1955	CALL halte('STOP in inipar.f')
1956	236 CONTINUE
1957	WRITE (UNIT = nulou,FMT = *) ' '
1958	CALL prtout ('ERROR in namcouple for field', jf, 1)
1959	WRITE (UNIT = nulou,FMT = *)
1960	$ 'The coupling period must not be 0 !'
1961	WRITE (UNIT = nulou,FMT = *)
1962	$ 'If you do not want to exchange this field at all'
1963	WRITE (UNIT = nulou,FMT = *)
1964	$ 'give a coupling period longer than the total run time.'
1965	CALL halte('STOP in inipar.f')
1966	END

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

Context Navigation

source: CPL/oasis3/trunk/src/mod/oasis3/src/inipar.F @ 1677

Download in other formats: