Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

inipar_alloc.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: 43.6 KB

Line
1	SUBROUTINE inipar_alloc
2	C****
3	C *****************************
4	C * OASIS ROUTINE - LEVEL 0 *
5	C * ------------- ------- *
6	C *****************************
7	C
8	C**** inipar_alloc - Get main run parameters to allocate arrays
9	C
10	C Purpose:
11	C -------
12	C Reads out run parameters.
13	C
14	C** Interface:
15	C ---------
16	C CALL inipar_alloc
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 2.5 A. Caubel 02/04/02 created from inipar.f
43	C
44	C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
45	C
46	C* -----------------Include files and use of modules---------------------------
47	C
48	USE mod_kinds_oasis
49	USE mod_parameter
50	USE mod_parallel
51	USE mod_string
52	USE mod_analysis
53	USE mod_anais
54	USE mod_rainbow
55	USE mod_extrapol
56	USE mod_unitncdf
57	USE mod_experiment
58	USE mod_timestep
59	USE mod_coast
60	#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
61	USE mod_clim
62	#endif
63	USE mod_calendar
64	USE mod_gauss
65	USE mod_hardware
66	USE mod_unit
67	USE mod_label
68	USE mod_printing
69	INCLUDE 'netcdf.inc'
70	C
71	C* ---------------------------- Local declarations --------------------
72	C
73	CHARACTER*80 clline, clline_aux, clvari
74	CHARACTER*9 clword, clfield, clstring, clmod, clchan
75	CHARACTER*3 clind
76	CHARACTER*2 cldeb
77	CHARACTER*1 clequa
78	CHARACTER*8 clwork
79	CHARACTER*8 clstrg
80	CHARACTER*7 cl_bsend
81
82	CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: cl_aux
83	INTEGER (kind=ip_intwp_p) il_varid, il_len, il_err, il_maxanal
84	INTEGER (kind=ip_intwp_p) nlonbf_notnc, nlatbf_notnc,
85	$ nlonaf_notnc, nlataf_notnc
86	INTEGER (kind=ip_intwp_p) iind, il_redu, ib, il_aux, il_auxbf,
87	$ il_auxaf, istatus, il_id
88	C
89	C* ---------------------------- Poema verses --------------------------
90	C
91	C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
92	C
93	C* 1. Get basic info for the simulation
94	C ---------------------------------
95	C
96	WRITE (UNIT = nulou,FMT = *) ' '
97	WRITE (UNIT = nulou,FMT = *) ' '
98	WRITE (UNIT = nulou,FMT = *)
99	$ ' ROUTINE inipar_alloc - Level 0'
100	WRITE (UNIT = nulou,FMT = *)
101	$ ' ******************* *****'
102	WRITE (UNIT = nulou,FMT = *) ' '
103	WRITE (UNIT = nulou,FMT = *) ' Initialization of main run
104	$ parameters'
105	WRITE (UNIT = nulou,FMT = *) ' '
106	WRITE (UNIT = nulou,FMT = *) ' Reading input file namcouple'
107	WRITE (UNIT = nulou,FMT = *) ' '
108	WRITE (UNIT = nulou,FMT = *) ' '
109
110	C
111	C* Initialization
112	cchan = ' '
113	ig_direct_nfield = 0
114	ig_nfield = 0
115	lg_oasis_field = .true.
116	lg_vector = .FALSE.
117	C* Initialize character keywords to locate appropriate input
118	C
119	clfield = ' $NFIELDS'
120	clchan = ' $CHANNEL'
121	clstring = ' $STRINGS'
122	clmod = ' $NBMODEL'
123	C
124	C* Get number of models involved in this simulation
125	C
126	REWIND nulin
127	100 CONTINUE
128	READ (UNIT = nulin,FMT = 1001,END = 110) clword
129	IF (clword .NE. clmod) GO TO 100
130	READ (UNIT = nulin,FMT = 1002) clline
131	CALL parse (clline, clvari, 1, jpeighty, ilen)
132	IF (ilen .LE. 0) THEN
133	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
134	WRITE (UNIT = nulou,FMT = *)
135	$ ' Nothing on input for $NBMODEL '
136	WRITE (UNIT = nulou,FMT = *) ' Default value will be used '
137	WRITE (UNIT = nulou,FMT = *) ' '
138	ELSE IF (ilen .GT. 1) THEN
139	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
140	WRITE (UNIT = nulou,FMT = *)
141	$ ' Input variable length is incorrect'
142	WRITE (UNIT = nulou,FMT = *) ' There are too many models '
143	WRITE (UNIT = nulou,FMT = *) ' ilen = ', ilen
144	WRITE (UNIT = nulou,FMT = *)
145	$ ' Check $NBMODEL variable spelling '
146	WRITE (UNIT = nulou,FMT = *) ' Default value will be used '
147	ELSE
148	READ (clvari,FMT = 1003) ig_nmodel
149	ENDIF
150	C
151	C* Print out the number of models
152	C
153	CALL prtout
154	$ ('The number of models for this run is nmodel =', ig_nmodel,
155	$ 1)
156	C
157	C --> Get the message passing technique we are using
158	C
159	REWIND nulin
160	120 CONTINUE
161	READ (UNIT = nulin,FMT = 1001,END = 130) clword
162	IF (clword .NE. clchan) GO TO 120
163	READ (UNIT = nulin,FMT = 1002) clline
164	CALL parse (clline, clvari, 1, jpeighty, ilen)
165	IF (ilen .LE. 0) THEN
166	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
167	WRITE (UNIT = nulou,FMT = *)
168	$ ' Nothing on input for $CHANNEL '
169	CALL HALTE('STOP in inipar')
170	ELSE IF (ilen .GT. 0 .AND. ilen .NE. 4) THEN
171	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
172	WRITE (UNIT = nulou,FMT = *)
173	$ ' Input variable length is incorrect'
174	WRITE (UNIT = nulou,FMT = *) ' ilen = ', ilen
175	WRITE (UNIT = nulou,FMT = *)
176	$ ' Check $CHANNEL variable spelling '
177	CALL HALTE('STOP in inipar')
178	ELSE
179	cchan = clvari(1:4)
180	C
181	IF (cchan .EQ. 'MPI1' .or. cchan .EQ. 'MPI2') THEN
182	CALL parse (clline, clvari, 2, jpeighty, ilen)
183	#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
184	IF (ilen .eq. 0) THEN
185	lg_bsend = .true.
186	ELSE
187	cl_bsend = clvari(1:7)
188	IF (cl_bsend .eq. 'NOBSEND') THEN
189	lg_bsend = .false.
190	ELSE
191	lg_bsend = .true.
192	ENDIF
193	ENDIF
194	#endif
195	ELSE IF(cchan .EQ. 'PVM3') THEN
196	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
197	WRITE (UNIT = nulou,FMT = *)
198	$ ' PVM3 no longer supported in Oasis 2.5'
199	WRITE (UNIT = nulou,FMT = *)
200	$ ' Please keep on using Oasis 2.4'
201	CALL HALTE('STOP in inipar')
202	ENDIF
203	C
204	C* Print out the message passing technique
205	C
206	CALL prcout
207	$ (' The message passing used in OASIS is cchan =', cchan, 1)
208	ENDIF
209	C
210	C* Formats
211	C
212	1001 FORMAT(A9)
213	1002 FORMAT(A80)
214	1003 FORMAT(I1)
215
216	C
217	C* 2. Get field information
218	C ---------------------
219	C
220	C* Read total number of fields exchanged
221	C
222	REWIND nulin
223	200 CONTINUE
224	READ (UNIT = nulin,FMT = 2001,END = 210) clword
225	IF (clword .NE. clfield) GO TO 200
226	READ (UNIT = nulin,FMT = 2002) clline
227	CALL parse(clline, clvari, 1, jpeighty, ilen)
228	IF (ilen .LE. 0) THEN
229	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
230	WRITE (UNIT = nulou,FMT = *)
231	$ ' Nothing on input for $NFIELDS '
232	WRITE (UNIT = nulou,FMT = *) ' Default value will be used '
233	WRITE (UNIT = nulou,FMT = *) ' '
234	ELSE
235	READ (clvari,FMT = 2003) ig_total_nfield
236	ENDIF
237	C
238	C* Print out the total number of fields exchanged
239	C
240	CALL prtout
241	$ ('The number of exchanged fields is nfield =',
242	$ ig_total_nfield, 1)
243	C
244	C* Alloc field number array
245	C
246	ALLOCATE (ig_number_field(ig_total_nfield),stat=il_err)
247	IF (il_err.NE.0) CALL prtout
248	$ ('Error: ig_number_field allocation of inipar_alloc',il_err,1)
249	ig_number_field(:)=0
250	C
251	C* Alloc field status array (logical indicating if the field goes through
252	C* Oasis or not)
253	C
254	ALLOCATE (lg_state(ig_total_nfield), stat=il_err)
255	IF (il_err.NE.0) CALL prtout
256	$ ('Error: lg_state allocation of inipar_alloc',il_err,1)
257	lg_state(:)=.false.
258	C
259	C* Alloc status of all the fields
260	C
261	ALLOCATE (ig_total_state(ig_total_nfield), stat=il_err)
262	IF (il_err.NE.0) CALL prtout
263	$ ('Error: ig_total_state allocation of inipar_alloc',il_err,1)
264	ig_total_state(:)=0
265	C
266	C* Alloc input field name array
267	C
268	ALLOCATE (cg_output_field(ig_total_nfield), stat=il_err)
269	IF (il_err.NE.0) CALL prtout
270	$ ('Error: cg_output_field allocation of inipar_alloc',il_err,1)
271	cg_output_field(:)=' '
272	C
273	C* Alloc number of analyses array
274	C
275	ALLOCATE (ig_total_ntrans(ig_total_nfield),stat=il_err)
276	IF (il_err.NE.0) CALL prtout
277	$ ('Error: ig_total_ntrans"allocation of inipar_alloc',il_err,1)
278	ig_total_ntrans (:) = 0
279	C
280	C* Alloc array of restart file names, input and output file names
281	C
282	ALLOCATE (cg_restart_file(ig_total_nfield),stat=il_err)
283	IF (il_err.NE.0) CALL prtout
284	$ ('Error: cg_restart_FILE allocation of inipar_alloc',il_err,1)
285	cg_restart_file(:)=' '
286	ALLOCATE (cg_input_file(ig_total_nfield), stat=il_err)
287	IF (il_err.NE.0) CALL prtout
288	$ ('Error in "cg_input_file"allocation of inipar_alloc',il_err,1)
289	cg_input_file(:)=' '
290	C
291	C* Alloc array of source and target locator prefix
292	C
293	ALLOCATE (cga_locatorbf(ig_total_nfield),stat=il_err)
294	IF (il_err.NE.0) CALL prtout
295	$ ('Error: cga_locatorbf allocation of inipar_alloc',il_err,1)
296	cga_locatorbf(:)=' '
297
298	ALLOCATE (cga_locatoraf(ig_total_nfield),stat=il_err)
299	IF (il_err.NE.0) CALL prtout
300	$ ('Error: cga_locatoraf allocation of inipar_alloc',il_err,1)
301	cga_locatoraf(:)=' '
302	C
303	C* Get the SSCS for all fields
304	C
305	REWIND nulin
306	220 CONTINUE
307	READ (UNIT = nulin,FMT = 2001,END = 230) clword
308	IF (clword .NE. clstring) GO TO 220
309	C
310	C* Loop on total number of fields (NoF)
311	C
312	DO 240 jf = 1, ig_total_nfield
313	C
314	C* First line
315	C
316	READ (UNIT = nulin,FMT = 2002) clline
317	C* Get output field symbolic name
318	CALL parse(clline, clvari, 2, jpeighty, ilen)
319	cg_output_field(jf) = clvari
320	C* Get total number of analysis
321	CALL parse(clline, clvari, 5, jpeighty, ilen)
322	READ (clvari,FMT = 2003) ig_total_ntrans(jf)
323	C* Get field STATUS for OUTPUT fields
324	CALL parse(clline, clvari, 6, jpeighty, ilen)
325	IF (clvari(1:6) .eq. 'OUTPUT') THEN
326	ig_direct_nfield = ig_direct_nfield + 1
327	lg_state(jf) = .false.
328	ig_total_state(jf) = ip_output
329	ELSE
330	C* Get field status (direct or through oasis) and the number
331	C* of direct and indirect fields if not PIPE nor NONE
332	IF (cchan .ne. 'PIPE' .and. cchan .ne. 'NONE') THEN
333	CALL parse(clline, clvari, 7, jpeighty, ilen)
334	IF (clvari(1:8).eq.'EXPORTED') THEN
335	ig_nfield = ig_nfield + 1
336	lg_state(jf) = .true.
337	ig_number_field(jf) = ig_nfield
338	ig_total_state(jf) = ip_exported
339	C* Get restart file name
340	CALL parse(clline, clvari, 6, jpeighty, ilen)
341	cg_restart_file(jf) = clvari
342	ELSEIF (clvari(1:7) .eq. 'IGNORED' ) THEN
343	ig_direct_nfield = ig_direct_nfield + 1
344	lg_state(jf) = .false.
345	ig_total_state(jf) = ip_ignored
346	CALL parse(clline, clvari, 6, jpeighty, ilen)
347	C* Get restart file name
348	cg_restart_file(jf) = clvari
349	ELSEIF (clvari(1:6) .eq. 'EXPOUT') THEN
350	ig_nfield = ig_nfield + 1
351	lg_state(jf) = .true.
352	ig_number_field(jf) = ig_nfield
353	ig_total_state(jf) = ip_expout
354	CALL parse(clline, clvari, 6, jpeighty, ilen)
355	C* Get restart file name
356	cg_restart_file(jf) = clvari
357	ELSEIF (clvari(1:6) .eq. 'IGNOUT' ) THEN
358	ig_direct_nfield = ig_direct_nfield + 1
359	lg_state(jf) = .false.
360	ig_total_state(jf) = ip_ignout
361	CALL parse(clline, clvari, 6, jpeighty, ilen)
362	C* Get restart file name
363	cg_restart_file(jf) = clvari
364	ELSEIF (clvari(1:9).eq. 'AUXILARY') THEN
365	ig_nfield = ig_nfield + 1
366	lg_state(jf) = .true.
367	ig_number_field(jf) = ig_nfield
368	ig_total_state(jf) = ip_auxilary
369	CALL parse(clline, clvari, 6, jpeighty, ilen)
370	C* Get restart file name
371	cg_restart_file(jf) = clvari
372	ELSEIF (clvari(1:5) .eq. 'INPUT') THEN
373	ig_direct_nfield = ig_direct_nfield + 1
374	lg_state(jf) = .false.
375	ig_total_state(jf) = ip_input
376	CALL parse(clline, clvari, 6, jpeighty, ilen)
377	C* Get input file name
378	cg_input_file(jf) = clvari
379	ENDIF
380	ELSE
381	C* Get field status if PIPE or NONE
382	CALL parse(clline, clvari, 8, jpeighty, ilen)
383	IF (clvari .ne. 'EXPORTED' .and. clvari .ne. 'AUXILARY')
384	$ THEN
385	CALL prtout
386	$ ('Error in namcouple for status of field',jf,1)
387	WRITE (UNIT = nulou,FMT = *)
388	$ '==> Must be EXPORTED or AUXILARY'
389	IF (clvari(1:7) .eq. 'IGNORED')
390	$ WRITE (UNIT = nulou,FMT = *)
391	$ 'Direct communication is only for CLIM/MPI1 or MPI2'
392	WRITE (UNIT = nulou,FMT = *)
393	$ 'Maybe you forgot the output FILE name which'
394	WRITE (UNIT = nulou,FMT = *)
395	$ 'is mandatory for PIPE or NONE techniques'
396	CALL HALTE('STOP in inipar')
397	ELSE IF (clvari .eq. 'EXPORTED') THEN
398	ig_nfield = ig_nfield + 1
399	lg_state(jf) = .true.
400	ig_number_field(jf) = ig_nfield
401	ig_total_state(jf) = ip_exported
402	C* Get restart file name
403	CALL parse(clline, clvari, 6, jpeighty, ilen)
404	cg_restart_file(jf) = clvari
405	ELSE IF (clvari .eq. 'AUXILARY') THEN
406	ig_nfield = ig_nfield + 1
407	lg_state(jf) = .true.
408	ig_number_field(jf) = ig_nfield
409	ig_total_state(jf) = ip_auxilary
410	C* Get restart file name
411	CALL parse(clline, clvari, 6, jpeighty, ilen)
412	cg_restart_file(jf) = clvari
413	ENDIF
414	ENDIF
415	ENDIF
416	IF (lg_state(jf)) THEN
417	IF (ig_total_ntrans(jf) .eq. 0) THEN
418	WRITE (UNIT = nulou,FMT = *)
419	$ 'If there is no analysis for the field',jf,
420	$ 'then the status must not be "EXPORTED"'
421	WRITE (UNIT = nulou,FMT = *)' "AUXILARY" or "EXPOUT" '
422	CALL HALTE('STOP in inipar_alloc')
423	ENDIF
424	READ (UNIT = nulin,FMT = 2002) clline
425	CALL skip(clline, jpeighty)
426	READ (UNIT = nulin,FMT = 2002) clline
427	CALL skip(clline, jpeighty)
428	READ (UNIT = nulin,FMT = 2002)clline_aux
429	DO ja=1,ig_total_ntrans(jf)
430	CALL parse(clline_aux, clvari, ja, jpeighty, ilen)
431	IF (clvari.eq.'CORRECT'.or.clvari.eq.'BLASOLD'.
432	$ or.clvari.eq.'BLASNEW') THEN
433	READ (UNIT = nulin,FMT = 2002) clline
434	CALL parse(clline, clvari, 2, jpeighty, ilen)
435	READ(clvari,FMT = 2003) il_aux
436	DO ib = 1, il_aux
437	READ (UNIT = nulin,FMT = 2002) clline
438	CALL skip(clline, jpeighty)
439	ENDDO
440	ELSE IF (clvari.eq.'NOINTERP') THEN
441	CONTINUE
442	ELSE
443	READ (UNIT = nulin,FMT = 2002) clline
444	CALL skip(clline, jpeighty)
445	ENDIF
446	ENDDO
447	ELSE
448	IF (ig_total_state(jf) .ne. ip_input) THEN
449	READ (UNIT = nulin,FMT = 2002) clline
450	CALL skip(clline, jpeighty)
451	ENDIF
452	IF (ig_total_state(jf) .ne. ip_input .and.
453	$ ig_total_ntrans(jf) .gt. 0 ) THEN
454	READ (UNIT = nulin,FMT = 2002) clline
455	CALL parse(clline, clvari, 1, jpeighty, ilen)
456	IF (clvari(1:8) .ne. 'LOCTRANS') THEN
457	WRITE (UNIT = nulou,FMT = *)
458	$ 'You want a transformation which is not available !'
459	WRITE (UNIT = nulou,FMT = *)
460	$ 'Only local transformations are available for '
461	WRITE (UNIT = nulou,FMT = *)
462	$ 'fields exchanged directly or output fields '
463	CALL HALTE('STOP in inipar_alloc')
464	ENDIF
465	DO ja=1,ig_total_ntrans(jf)
466	READ (UNIT = nulin,FMT = 2002) clline
467	CALL skip(clline, jpeighty)
468	ENDDO
469	ENDIF
470	ENDIF
471
472	240 CONTINUE
473	IF (ig_nfield.eq.0) THEN
474	lg_oasis_field = .false.
475	WRITE (nulou,*)'==> All the fields are exchanged directly'
476	ENDIF
477
478	C
479	C* Number of different restart files
480	C
481	allocate (cl_aux(ig_total_nfield))
482	cl_aux(:)=' '
483	DO jf = 1,ig_total_nfield
484	IF (jf.eq.1) THEN
485	cl_aux(1) = cg_restart_file(1)
486	il_aux = 1
487	ELSEIF (jf.gt.1) THEN
488	IF (ALL(cl_aux.ne.cg_restart_file(jf))) THEN
489	il_aux = il_aux + 1
490	cl_aux(il_aux) = cg_restart_file(jf)
491	ENDIF
492	ENDIF
493	ENDDO
494	deallocate(cl_aux)
495	ig_nbr_rstfile = il_aux
496
497	IF (lg_oasis_field) THEN
498	C
499	C* Alloc array needed for INTERP and initialize them
500	C
501	ALLOCATE (cintmet(ig_nfield),stat=il_err)
502	IF (il_err.NE.0) CALL prtout
503	$ ('Error: cintmet allocation of inipar_alloc',il_err,1)
504	ALLOCATE (naismfl(ig_nfield),stat=il_err)
505	IF (il_err.NE.0) CALL prtout
506	$ ('Error: naismfl allocation of inipar_alloc',il_err,1)
507	ALLOCATE (naismvoi(ig_nfield),stat=il_err)
508	IF (il_err.NE.0) CALL prtout
509	$ ('Error: naismvoi allocation of inipar_alloc',il_err,1)
510	ALLOCATE (naisgfl(ig_nfield),stat=il_err)
511	IF (il_err.NE.0) CALL prtout
512	$ ('Error: naisgfl allocation of inipar_alloc',il_err,1)
513	ALLOCATE (naisgvoi(ig_nfield),stat=il_err)
514	IF (il_err.NE.0) CALL prtout
515	$ ('Error: naisgvoi allocation of inipar_alloc',il_err,1)
516	cintmet(:)=' '
517	naismfl(:) = 1
518	naismvoi(:) = 1
519	naisgfl(:) = 1
520	naisgvoi(:) = 1
521	C
522	C* Alloc arrays needed for EXTRAP and initialize them
523	C
524	ALLOCATE (cextmet(ig_nfield),stat=il_err)
525	IF (il_err.NE.0) CALL prtout
526	$ ('Error: cextmet allocation of inipar_alloc',il_err,1)
527	ALLOCATE (nninnfl(ig_nfield),stat=il_err)
528	IF (il_err.NE.0) CALL prtout
529	$ ('Error: nninnfl allocation of inipar_alloc',il_err,1)
530	ALLOCATE (nninnflg(ig_nfield),stat=il_err)
531	IF (il_err.NE.0) CALL prtout
532	$ ('Error: nninnflg allocation of inipar_alloc',il_err,1)
533	ALLOCATE (neighbor(ig_nfield), stat=il_err)
534	IF (il_err.NE.0) CALL prtout
535	$ ('Error: neighbor allocation of inipar_alloc',il_err,1)
536	ALLOCATE (nextfl(ig_nfield),stat=il_err)
537	IF (il_err.NE.0) CALL prtout
538	$ ('Error: nextfl allocation of inipar_alloc',il_err,1)
539	cextmet(:)=' '
540	nninnfl(:) = 1
541	nninnflg(:) = 1
542	neighbor(:) = 1
543	nextfl(:) = 1
544	C
545	C* Alloc arrays needed for BLAS... analyses and initialize them
546	C
547	ALLOCATE (nbofld(ig_nfield), stat=il_err)
548	IF (il_err.NE.0) CALL prtout
549	$ ('Error: nbofld allocation of inipar_alloc',il_err,1)
550	ALLOCATE (nbnfld(ig_nfield), stat=il_err)
551	IF (il_err.NE.0) CALL prtout
552	$ ('Error: nbnfld allocation of inipar_alloc',il_err,1)
553	nbofld(:) = 1
554	nbnfld(:) = 1
555	C
556	C* Alloc arrays needed for MOZAIC and initialize them
557	C
558	ALLOCATE (nmapvoi(ig_nfield),stat=il_err)
559	IF (il_err.NE.0) CALL prtout
560	$ ('Error: nmapvoi allocation of inipar_alloc',il_err,1)
561	ALLOCATE (nmapfl(ig_nfield),stat=il_err)
562	IF (il_err.NE.0) CALL prtout
563	$ ('Error: nmapfl allocation of inipar_alloc',il_err,1)
564	nmapvoi(:) = 1
565	nmapfl(:) = 1
566	C
567	C* Alloc arrays needed for SUBGRID and initialize them
568	C
569	ALLOCATE (nsubfl(ig_nfield),stat=il_err)
570	IF (il_err.NE.0) CALL prtout
571	$ ('Error: nsubfl allocation of inipar_alloc',il_err,1)
572	ALLOCATE (nsubvoi(ig_nfield),stat=il_err)
573	IF (il_err.NE.0) CALL prtout
574	$ ('Error: nsubvoi allocation of inipar_alloc',il_err,1)
575	nsubfl(:) = 1
576	nsubvoi(:) = 1
577	C
578	C* Alloc arrays needed for GLORED and REDGLO and initialize them
579	C
580	ALLOCATE (ntronca(ig_nfield), stat=il_err)
581	IF (il_err.NE.0) CALL prtout
582	$ ('Error: ntronca allocation of inipar_alloc',il_err,1)
583	ntronca(:) = 0
584
585	C
586	C* Alloc array needed for analyses parameters
587	C
588	ALLOCATE (cficbf(ig_nfield),stat=il_err)
589	IF (il_err.NE.0) CALL prtout
590	$ ('Error: cficbf allocation of inipar_alloc',il_err,1)
591	cficbf(:)=' '
592	ALLOCATE (cficaf(ig_nfield),stat=il_err)
593	IF (il_err.NE.0) CALL prtout
594	$ ('Error: cficaf allocation of inipar_alloc',il_err,1)
595	cficaf(:)=' '
596	C
597	C* Alloc arrays needed for grid dimensions of direct fields and
598	C* indirect fields
599	C
600	ALLOCATE (nlonbf(ig_nfield),stat=il_err)
601	IF (il_err.NE.0) CALL prtout
602	$ ('Error: nlonbf allocation of inipar_alloc',il_err,1)
603	nlonbf(:)=0
604	ALLOCATE (nlatbf(ig_nfield),stat=il_err)
605	IF (il_err.NE.0) CALL prtout
606	$ ('Error: nlatbf allocation of inipar_alloc',il_err,1)
607	nlatbf(:)=0
608	ALLOCATE (nlonaf(ig_nfield),stat=il_err)
609	IF (il_err.NE.0) CALL prtout
610	$ ('Error: nlonaf allocation of inipar_alloc',il_err,1)
611	nlonaf(:)=0
612	ALLOCATE (nlataf(ig_nfield),stat=il_err)
613	IF (il_err.NE.0) CALL prtout
614	$ ('Error: nlataf allocation of inipar_alloc',il_err,1)
615	nlataf(:)=0
616	C
617	C* Alloc arrays needed for grid number associated to each field
618	C
619	ALLOCATE (ig_grid_nbrbf(ig_nfield),stat=il_err)
620	IF (il_err.NE.0) CALL prtout
621	$ ('Error: ig_grid_nbrbf allocation of inipar_alloc',il_err,1)
622	ig_grid_nbrbf(:)=0
623	ALLOCATE (ig_grid_nbraf(ig_nfield),stat=il_err)
624	IF (il_err.NE.0) CALL prtout
625	$ ('Error: ig_grid_nbraf allocation of inipar_alloc',il_err,1)
626	ig_grid_nbraf(:)=0
627
628	C
629	C* Alloc number of analyses array
630	C
631	ALLOCATE (ig_ntrans(ig_nfield),stat=il_err)
632	IF (il_err.NE.0) CALL prtout
633	$ ('Error: ig_ntrans allocation of inipar_alloc',il_err,1)
634	ig_ntrans(:)=0
635	DO ib = 1, ig_total_nfield
636	IF (lg_state(ib))
637	$ ig_ntrans(ig_number_field(ib))=ig_total_ntrans(ib)
638	ENDDO
639	C
640	C* Maximum number of analyses
641	C
642	il_maxanal = imaxim(ig_ntrans,ig_nfield)
643	C
644	C* Alloc array of restart file names
645	C
646	ALLOCATE (cficinp(ig_nfield), stat=il_err)
647	IF (il_err.NE.0) CALL prtout
648	$ ('Error: cficinp allocation of inipar_alloc',il_err,1)
649	cficinp(:)=' '
650	DO ib = 1, ig_total_nfield
651	IF (lg_state(ib))
652	$ cficinp(ig_number_field(ib))=cg_restart_file(ib)
653	END DO
654	istatus=NF_OPEN(cg_restart_file(1), NF_NOWRITE, il_id)
655	IF (istatus .ne. NF_NOERR) THEN
656	lncdfrst = .false.
657	ELSE
658	lncdfrst = .true.
659	ENDIF
660	WRITE(nulou, *) 'lncdfrst =', lncdfrst
661	C
662	C* Alloc array needed to get analysis names
663	C
664	ALLOCATE (canal(il_maxanal,ig_nfield),stat=il_err)
665	IF (il_err.NE.0) CALL prtout
666	$ ('Error: canal allocation of inipar_alloc',il_err,1)
667	canal(:,:)=' '
668	ENDIF
669	C
670	C* Get analysis parameters
671	C
672	REWIND nulin
673	221 CONTINUE
674	READ (UNIT = nulin,FMT = 2001,END = 230) clword
675	IF (clword .NE. clstring) GO TO 221
676	C
677	C* Loop on total number of fields (NoF)
678	C
679	DO 250 jf=1,ig_total_nfield
680	C
681	C* Initialization
682	C
683	nlonbf_notnc = 0
684	nlatbf_notnc = 0
685	nlonaf_notnc = 0
686	nlataf_notnc = 0
687	C
688	C* Skip first line read before
689	C
690	READ (UNIT = nulin,FMT = 2002) clline
691	CALL skip(clline, jpeighty)
692	C
693	C* Second line
694	C
695	C* In the indirect case, reading of second, third, fourth line and analyses
696	C* lines
697	C
698	IF (ig_total_state(jf) .ne. ip_input) THEN
699	READ (UNIT = nulin,FMT = 2002) clline
700	C* First determine what information is on the line
701	CALL parse(clline, clvari, 3, jpeighty, ilen)
702	IF (ilen .lt. 0) THEN
703	C*
704	C* IF only two words on the line, then they are the locator
705	C* prefixes and the grids file must be in NetCDF format
706	CALL parse(clline, clvari, 1, jpeighty, ilen)
707	IF (lg_state(jf))
708	$ cficbf(ig_number_field(jf)) = clvari
709	cga_locatorbf(jf) = clvari(1:4)
710	CALL parse(clline, clvari, 2, jpeighty, ilen)
711	IF (lg_state(jf))
712	$ cficaf(ig_number_field(jf)) = clvari
713	cga_locatoraf(jf) = clvari(1:4)
714	lncdfgrd = .true.
715	ELSE
716	READ(clvari,FMT = 2010) clind, clequa, iind
717	IF (clind .EQ. 'SEQ' .or. clind .EQ. 'DEL' .or.
718	$ clind .eq. 'XTS' .or. clind .eq. 'LAG' .and.
719	$ clequa .EQ. '=') THEN
720
721	C* If 3rd word is an index, then first two words are
722	C* locator prefixes and grids file must be NetCDF format
723	CALL parse(clline, clvari, 1, jpeighty, ilen)
724	IF (lg_state(jf))
725	$ cficbf(ig_number_field(jf)) = clvari
726	cga_locatorbf(jf) = clvari(1:4)
727	CALL parse(clline, clvari, 2, jpeighty, ilen)
728	IF (lg_state(jf))
729	$ cficaf(ig_number_field(jf)) = clvari
730	cga_locatoraf(jf) = clvari(1:4)
731	lncdfgrd = .true.
732	ELSE
733	C* If not, the first 4 words are grid dimensions and next
734	C* 2 words are locator prefixes, and grids file may be or
735	C* not in NetCDF format
736	CALL parse(clline, clvari, 1, jpeighty, ilen)
737	C* Get number of longitudes for initial field
738	READ(clvari,FMT = 2004) nlonbf_notnc
739	CALL parse(clline, clvari, 2, jpeighty, ilen)
740	C* Get number of latitudes for initial field
741	READ(clvari,FMT = 2004) nlatbf_notnc
742	CALL parse(clline, clvari, 3, jpeighty, ilen)
743	C* Get number of longitudes for final field
744	READ(clvari,FMT = 2004) nlonaf_notnc
745	CALL parse(clline, clvari, 4, jpeighty, ilen)
746	C* Get number of latitudes for final field
747	READ(clvari,FMT = 2004) nlataf_notnc
748	CALL parse(clline, clvari, 5, jpeighty, ilen)
749	C* Get root name grid-related files (initial field)
750	IF (lg_state(jf))
751	$ cficbf(ig_number_field(jf)) = clvari
752	cga_locatorbf(jf) = clvari(1:4)
753	CALL parse(clline, clvari, 6, jpeighty, ilen)
754	C* Get root name for grid-related files (final field)
755	IF (lg_state(jf))
756	$ cficaf(ig_number_field(jf)) = clvari
757	cga_locatoraf(jf) = clvari(1:4)
758	nlonbf(ig_number_field(jf)) = nlonbf_notnc
759	nlatbf(ig_number_field(jf)) = nlatbf_notnc
760	nlonaf(ig_number_field(jf)) = nlonaf_notnc
761	nlataf(ig_number_field(jf)) = nlataf_notnc
762	C
763	ENDIF
764	ENDIF
765	C
766	C* Read the P 2 P 0 line for exported, expout or auxilary
767	C
768	IF (lg_state(jf)) THEN
769	READ (UNIT = nulin,FMT = 2002) clline
770	CALL skip(clline, jpeighty)
771	ENDIF
772	C
773	C* Read next line of strings
774	C --->>> Stuff related to field transformation
775	C
776	IF (ig_total_ntrans(jf) .gt. 0) then
777	READ (UNIT = nulin,FMT = 2002) clline
778	CALL skip(clline, jpeighty)
779	DO 260 ja = 1, ig_total_ntrans(jf)
780	CALL parse(clline, clvari, ja, jpeighty, ilen)
781	C* Get the whole set of analysis to be performed
782	IF (lg_state(jf))
783	$ canal(ja,ig_number_field(jf)) = clvari
784	260 CONTINUE
785	C
786	C* Now read specifics for each transformation
787	C
788	DO 270 ja = 1, ig_total_ntrans(jf)
789	C
790	C* Read next line unless if analysis is NOINTERP (no input)
791	C
792	IF (lg_state(jf)) THEN
793	C For EXPORTED, AUXILARY, or EXPOUT:
794	IF(canal(ja,ig_number_field(jf)) .NE. 'NOINTERP') THEN
795	READ (UNIT = nulin,FMT = 2002) clline
796	CALL skip(clline, jpeighty)
797	ENDIF
798	IF (canal(ja,ig_number_field(jf)) .EQ. 'MOZAIC') THEN
799	CALL parse(clline, clvari, 3, jpeighty, ilen)
800	C* Get dataset number
801	READ(clvari,FMT = 2005) nmapfl(ig_number_field(jf))
802	CALL parse(clline, clvari, 4, jpeighty, ilen)
803	C* Get max nbr of neighbors for the grids associated to current field
804	READ(clvari,FMT = 2003) nmapvoi(ig_number_field(jf))
805	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'EXTRAP')THEN
806	CALL parse(clline, clvari, 1, jpeighty, ilen)
807	C* Get extrapolation method
808	cextmet(ig_number_field(jf)) = clvari
809	C* If choice is NINENN, read one more data
810	IF (cextmet(ig_number_field(jf)) .EQ. 'NINENN') THEN
811	CALL parse(clline, clvari, 4, jpeighty, ilen)
812	C* Get NINENN dataset identificator
813	READ(clvari,FMT = 2005)
814	$ nninnfl(ig_number_field(jf))
815	IF (nninnfl(ig_number_field(jf)) .EQ. 0) THEN
816	WRITE(UNIT = nulou,FMT = )' WARNING*'
817	WRITE(UNIT = nulou,FMT = *)
818	$ ' WARNING The EXTRAP/NINENN dataset id cannot be 0'
819	CALL HALTE('STOP in inipar')
820	ENDIF
821	C* If choice is WEIGHT, read more data
822	ELSE IF (cextmet(ig_number_field(jf)) .EQ. 'WEIGHT')
823	$ THEN
824	CALL parse(clline, clvari, 2, jpeighty, ilen)
825	C Get number of neighbors used in extrapolation
826	C If extrapolation method is NINENN, next variable is the MINIMUM
827	C number of neighbors required (among the 8 closest) to perform
828	C the extrapolation (cannot be greater than 4 for convergence).
829	C In case it is WEIGHT, it is the MAXIMUM number
830	C of neighbors required by the extrapolation operation.
831	C
832	READ(clvari,FMT = 2003)
833	$ neighbor(ig_number_field(jf))
834	CALL parse(clline, clvari, 5, jpeighty, ilen)
835	C* Get dataset number
836	READ(clvari,FMT = 2005)
837	$ nextfl(ig_number_field(jf))
838	ENDIF
839	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'INTERP')THEN
840	CALL parse(clline, clvari, 1, jpeighty, ilen)
841	C* Get interpolation method
842	cintmet(ig_number_field(jf)) = clvari
843	C* If interpolation uses ANAIS(G-M), read in more data
844	IF (cintmet(ig_number_field(jf)) .EQ. 'SURFMESH') THEN
845	CALL parse(clline, clvari, 4, jpeighty, ilen)
846	C* Get Anaism dataset identificator
847	READ(clvari,FMT = 2005)
848	$ naismfl(ig_number_field(jf))
849	CALL parse(clline, clvari, 5, jpeighty, ilen)
850	C* Get max number of neighbors for the grids related to current field
851	READ(clvari,FMT = 2003)
852	$ naismvoi(ig_number_field(jf))
853	ENDIF
854	IF (cintmet(ig_number_field(jf)) .EQ. 'GAUSSIAN') THEN
855	CALL parse(clline, clvari, 4, jpeighty, ilen)
856	C* Get Anaisg dataset identificator
857	READ(clvari,FMT = 2005)
858	$ naisgfl(ig_number_field(jf))
859	CALL parse(clline, clvari, 5, jpeighty, ilen)
860	C* Get max number of neighbors for the grids related to current field
861	READ(clvari,FMT = 2003)
862	$ naisgvoi(ig_number_field(jf))
863	ENDIF
864	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'SCRIPR')THEN
865	C* Get field type (scalar/vector)
866	CALL parse(clline, clvari, 3, jpeighty, ilen)
867	READ(clvari,FMT = 2009) clstrg
868	IF(clstrg .EQ. 'VECTOR_I' .OR. clstrg .EQ. 'VECTOR_J')THEN
869	lg_vector = .TRUE.
870	ENDIF
871	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'REDGLO')THEN
872	CALL parse(clline, clvari, 1, jpeighty, ilen)
873	C* Get half the nbr of lats for reduced<->global gaussian grid switch
874	READ(clvari,FMT = 2008) cldeb,
875	$ ntronca(ig_number_field(jf))
876	IF (cldeb .NE. 'NO') THEN
877	CALL prcout
878	$ ('ERROR in namcouple for analysis',
879	$ canal(ja,ig_number_field(jf)), 1)
880	WRITE (UNIT = nulou,FMT = *)
881	$ 'Since version 2.3, the information on the reduced'
882	WRITE (UNIT = nulou,FMT = *)
883	$ 'grid in namcouple has to be NOxx WHERE xx is half'
884	WRITE (UNIT = nulou,FMT = *)
885	$ 'the number of latitude lines.'
886	CALL HALTE ('STOP in inipar')
887	ENDIF
888	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'GLORED')THEN
889	CALL parse(clline, clvari, 1, jpeighty, ilen)
890	C* Get gaussian troncature for reduced <-> global gaussian grid switch
891	READ(clvari,FMT = 2008) cldeb,
892	$ ntronca(ig_number_field(jf))
893	IF (cldeb .NE. 'NO') THEN
894	CALL prcout
895	$ ('ERROR in namcouple for analysis',
896	$ canal(ja,ig_number_field(jf)), 1)
897	WRITE (UNIT = nulou,FMT = *)
898	$ 'Since version 2.3, the information on the reduced'
899	WRITE (UNIT = nulou,FMT = *)
900	$ 'grid in namcouple has to be NOxx WHERE xx is half'
901	WRITE (UNIT = nulou,FMT = *)
902	$ 'the number of latitude lines.'
903	CALL HALTE ('STOP in inipar')
904	ENDIF
905	CALL parse(clline, clvari, 4, jpeighty, ilen)
906	C* Get NINENN dataset identificator
907	READ(clvari,FMT = 2005) nninnflg(ig_number_field(jf))
908	IF (nninnflg(ig_number_field(jf)) .EQ. 0) THEN
909	WRITE(UNIT = nulou,FMT = *)
910	$ 'WARNING The EXTRAP/NINENN dataset identificator in GLORED'
911	WRITE(UNIT = nulou,FMT = *)
912	$ 'cannot be 0'
913	CALL HALTE('STOP in inipar')
914	ENDIF
915	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASOLD')
916	$ THEN
917	CALL parse(clline, clvari, 2, jpeighty, ilen)
918	C* Get number of additional fields in linear formula
919	READ(clvari,FMT = 2003) nbofld (ig_number_field(jf))
920	DO ib = 1,nbofld (ig_number_field(jf))
921	READ (UNIT = nulin,FMT = 2002) clline
922	CALL skip(clline, jpeighty)
923	ENDDO
924	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASNEW')
925	$ THEN
926	CALL parse(clline, clvari, 2, jpeighty, ilen)
927	C* Get number of additional fields in linear formula
928	READ(clvari,FMT = 2003) nbnfld (ig_number_field(jf))
929	DO ib = 1,nbnfld (ig_number_field(jf))
930	READ (UNIT = nulin,FMT = 2002) clline
931	CALL skip(clline, jpeighty)
932	ENDDO
933	C* Get fields to restore subgrid variability
934	ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'SUBGRID')
935	$ THEN
936	CALL parse(clline, clvari, 3, jpeighty, ilen)
937	C* Get dataset number
938	READ(clvari,FMT = 2005) nsubfl(ig_number_field(jf))
939	CALL parse(clline, clvari, 4, jpeighty, ilen)
940	C* Get max number of neighbors for the grids related to current field
941	READ(clvari,FMT = 2003) nsubvoi(ig_number_field(jf))
942	ENDIF
943	ELSE
944	C For IGNORED, IGNOUT and OUTPUT, only one line for LOCTRANS
945	READ (UNIT = nulin,FMT = 2002) clline
946	CALL skip(clline, jpeighty)
947	ENDIF
948	270 CONTINUE
949	ENDIF
950	ENDIF
951	C
952	C* End of loop on NoF
953	C
954	250 CONTINUE
955	C
956	IF (lg_oasis_field) THEN
957	C
958	C* Search maximum number of fields to be combined in the BLASxxx analyses
959	C
960	ig_maxcomb = imaxim(nbofld,ig_nfield)
961	IF (imaxim(nbnfld,ig_nfield).gt.ig_maxcomb)
962	$ ig_maxcomb = imaxim(nbnfld,ig_nfield)
963	C
964	C* Search maximum number of underlying neighbors for SURFMESH interpolation
965	C
966	ig_maxwoa = imaxim(naismvoi,ig_nfield)
967	WRITE(nulou,*)
968	$ 'Max number of underlying neighbors for SURFMESH : ',
969	$ ig_maxwoa
970	WRITE(nulou,*)' '
971	C
972	C* Search maximum number of neighbors for GAUSSIAN interpolation
973	C
974	ig_maxnoa = imaxim(naisgvoi,ig_nfield)
975	WRITE(nulou,*)
976	$ 'Max number of neighbors for GAUSSIAN interp : ',
977	$ ig_maxnoa
978	WRITE(nulou,*)' '
979	C
980	C* Search maximum number of underlying neighbors for MOZAIC interpolation
981	C
982	ig_maxmoa = imaxim(nmapvoi,ig_nfield)
983	WRITE(nulou,*)
984	$ 'Maximum number of underlying neighbors for MOZAIC interp: ',
985	$ ig_maxmoa
986	WRITE(nulou,*)' '
987	C
988	C* Search maximum number of overlaying neighbors for SUBGRID interpolation
989	C
990	ig_maxsoa = imaxim(nsubvoi,ig_nfield)
991	WRITE(nulou,*)
992	$ 'Maximum number of overlaying neighbors for SUBGRID interp :',
993	$ ig_maxsoa
994	WRITE(nulou,*)' '
995	C
996	C* Search maximum number of different SURFMESH interpolations
997	C
998	ig_maxnfm = imaxim(naismfl,ig_nfield)
999	WRITE(nulou,*)
1000	$ 'Maximum number of different SURFMESH interpolations : ',
1001	$ ig_maxnfm
1002	WRITE(nulou,*)' '
1003	C
1004	C* Search maximum number of different GAUSSIAN interpolations
1005	C
1006	ig_maxnfg = imaxim(naisgfl,ig_nfield)
1007	WRITE(nulou,*)
1008	$ 'Maximum number of different GAUSSIAN interpolations : ',
1009	$ ig_maxnfg
1010	WRITE(nulou,*)' '
1011	C
1012	C* Search maximum number of different MOZAIC interpolations
1013	C
1014	ig_maxnfp = imaxim(nmapfl,ig_nfield)
1015	WRITE(nulou,*)
1016	$ 'Maximum number of different MOZAIC interpolations : ',
1017	$ ig_maxnfp
1018	WRITE(nulou,*)' '
1019	C
1020	C* Search maximum number of different SUBGRID interpolations
1021	C
1022	ig_maxnfs = imaxim(nsubfl,ig_nfield)
1023	WRITE(nulou,*)
1024	$ 'Maximum number of different SUBGRID interpolations : ',
1025	$ ig_maxnfs
1026	WRITE(nulou,*)' '
1027	C
1028	C* Search maximum number of different NINENN extrapolations
1029	C
1030	ig_maxnfn = imaxim(nninnfl,ig_nfield)
1031	IF (imaxim(nninnflg,ig_nfield).gt.ig_maxnfn)
1032	$ ig_maxnfn = imaxim(nninnflg,ig_nfield)
1033	WRITE(nulou,*)
1034	$ 'Maximum number of different NINENN extrapolations : ',
1035	$ ig_maxnfn
1036	WRITE(nulou,*)' '
1037	C
1038	C* Search maximum number of neighbors for extrapolation
1039	C
1040	ig_maxext = imaxim(neighbor,ig_nfield)
1041	WRITE(nulou,*)
1042	$ 'Maximum number of neighbors for extrapolation : ',
1043	$ ig_maxext
1044	WRITE(nulou,*)' '
1045	C
1046	C* Search maximum number of different extrapolation
1047	C
1048	ig_maxnbn = imaxim(nextfl,ig_nfield)
1049	C
1050	ENDIF
1051	C* Formats
1052	C
1053	2001 FORMAT(A9)
1054	2002 FORMAT(A80)
1055	2003 FORMAT(I4)
1056	2004 FORMAT(I8)
1057	2005 FORMAT(I2)
1058	2008 FORMAT(A2,I4)
1059	2009 FORMAT(A8)
1060	2010 FORMAT(A3,A1,I2)
1061	C
1062	C* 3. End of routine
1063	C --------------
1064	C
1065	WRITE(UNIT = nulou,FMT = *) ' '
1066	WRITE(UNIT = nulou,FMT = *)
1067	$ ' ---------- End of routine inipar_alloc ---------'
1068	CALL FLUSH (nulou)
1069	RETURN
1070	C
1071	C* Error branch output
1072	C
1073	110 CONTINUE
1074	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1075	WRITE (UNIT = nulou,FMT = *)
1076	$ ' No active $NBMODEL data found in input file namcouple'
1077	WRITE (UNIT = nulou,FMT = *) ' '
1078	WRITE (UNIT = nulou,FMT = *) ' '
1079	WRITE (UNIT = nulou,FMT = *)
1080	$ ' We STOP!!! Check the file namcouple'
1081	WRITE (UNIT = nulou,FMT = *) ' '
1082	CALL HALTE ('STOP in inipar_alloc')
1083	130 CONTINUE
1084	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1085	WRITE (UNIT = nulou,FMT = *)
1086	$ ' No active $MACHINE data found in input file namcouple'
1087	WRITE (UNIT = nulou,FMT = *) ' '
1088	WRITE (UNIT = nulou,FMT = *) ' '
1089	WRITE (UNIT = nulou,FMT = *)
1090	$ ' We STOP!!! Check the file namcouple'
1091	WRITE (UNIT = nulou,FMT = *) ' '
1092	CALL HALTE ('STOP in inipar')
1093	210 CONTINUE
1094	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1095	WRITE (UNIT = nulou,FMT = *)
1096	$ ' No active $FIELDS data found in input file namcouple'
1097	WRITE (UNIT = nulou,FMT = *) ' '
1098	WRITE (UNIT = nulou,FMT = *) ' '
1099	WRITE (UNIT = nulou,FMT = *)
1100	$ ' We STOP!!! Check the file namcouple'
1101	WRITE (UNIT = nulou,FMT = *) ' '
1102	CALL HALTE ('STOP in inipar_alloc')
1103	230 CONTINUE
1104	WRITE (UNIT = nulou,FMT = ) ' WARNING*'
1105	WRITE (UNIT = nulou,FMT = *)
1106	$ ' No active $STRING data found in input file namcouple'
1107	WRITE (UNIT = nulou,FMT = *) ' '
1108	WRITE (UNIT = nulou,FMT = *) ' '
1109	WRITE (UNIT = nulou,FMT = *)
1110	$ ' We STOP!!! Check the file namcouple'
1111	WRITE (UNIT = nulou,FMT = *) ' '
1112	CALL HALTE ('STOP in inipar_alloc')
1113
1114	END
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130

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

Context Navigation

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

Download in other formats: