Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

iniiof.F @ 1677

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

Line
1	SUBROUTINE iniiof
2	C****
3	C *****************************
4	C * OASIS ROUTINE - LEVEL 0 *
5	C * ------------- ------- *
6	C *****************************
7	C
8	C**** iniiof - Open files
9	C
10	C Purpose:
11	C -------
12	C Open files for grid related parameters, data transfer and
13	C auxilary outputs
14	C
15	C** Interface:
16	C ---------
17	C CALL iniiof
18	C
19	C Input:
20	C -----
21	C None
22	C
23	C Output:
24	C ------
25	C None
26	C
27	C Workspace:
28	C ---------
29	C None
30	C
31	C Externals:
32	C ---------
33	C None
34	C
35	C Reference:
36	C ---------
37	C See OASIS manual (1995)
38	C
39	C History:
40	C -------
41	C Version Programmer Date Description
42	C ------- ---------- ---- -----------
43	C 1.0 L. Terray 94/01/01 created
44	C 2.0beta L. Terray 95/08/23 modified: new structure
45	C 2.0 L. Terray 96/02/01 modified: no opening of
46	C CLIM trace file within oasis
47	C 2.1 L. Terray 96/08/26 modified: open data file for
48	C SUBGRID Analysis
49	C 2.3 S. Valcke 99/03/30 modified: open data file for
50	C NINENN analysis
51	C 2.3 S. Valcke 99/04/30 added: printing levels
52	C 2.5 S. Valcke 01/03/23 removed: nulrd opening
53	C
54	C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
55	C
56	C* ---------------- Include files and USE of modules---------------------------
57	C
58	USE mod_parameter
59	USE mod_unitncdf
60	USE mod_string
61	USE mod_anais
62	USE mod_extrapol
63	USE mod_analysis
64	USE mod_unit
65	USE mod_hardware
66	USE mod_label
67	USE mod_printing
68	INCLUDE 'netcdf.inc'
69	C
70	C* ---------------------------- Local declarations ----------------------
71	C
72	CHARACTER*8 clfic
73	LOGICAL ll_areas
74	C
75	C* ---------------------------- Poema verses ----------------------------
76	C
77	C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
78	C
79	C
80	C* This routine will be called only if one field (at least) goes through Oasis
81	C
82	IF (lg_oasis_field) THEN
83	C
84	C* 1. Open files
85	C ----------
86	C
87	IF (nlogprt .GE. 1) THEN
88	WRITE (UNIT = nulou,FMT = *) ' '
89	WRITE (UNIT = nulou,FMT = *) ' '
90	WRITE (UNIT = nulou,FMT = *)
91	$ ' ROUTINE iniiof - Level 0'
92	WRITE (UNIT = nulou,FMT = *)
93	$ ' ************ *****'
94	WRITE (UNIT = nulou,FMT = *) ' '
95	WRITE (UNIT = nulou,FMT = *) ' opening grid related files'
96	WRITE (UNIT = nulou,FMT = *) ' '
97	iost = 0
98	WRITE (UNIT = nulou,FMT = *) ' opening gcms grid file '
99	WRITE (UNIT = nulou,FMT = *) ' '
100	ENDIF
101	IF (.not. lncdfgrd) THEN
102	OPEN (UNIT = nulgr,FILE = cgrdnam,STATUS='OLD',
103	$ FORM ='UNFORMATTED',ERR = 110,IOSTAT = iost)
104	IF (nlogprt .GE. 1) THEN
105	WRITE (UNIT = nulou,FMT = 1001) nulgr, cgrdnam
106	WRITE (UNIT = nulou,FMT = *) ' '
107	ENDIF
108	110 CONTINUE
109	c Try whether a new netcdf grids file was created at runtime
110	IF (iost .NE. 0) THEN
111	lncdfgrd = .true.
112	ENDIF
113	ENDIF
114	IF (lncdfgrd) THEN
115	istatus=NF_OPEN(cgrdnam//'.nc', NF_NOWRITE, nc_grdid)
116	IF (istatus .ne. NF_NOERR) THEN
117	WRITE (UNIT = nulou,FMT = *)
118	$ ' ===>>>> NO grids neither grids.nc files.'
119	CALL halte('STOP in iniiof')
120	ENDIF
121	ENDIF
122	C
123	C* Masks file
124	C
125	IF (nlogprt .GE. 1) THEN
126	WRITE (UNIT = nulou,FMT = *) ' opening gcm masks file '
127	WRITE (UNIT = nulou,FMT = *) ' '
128	ENDIF
129	IF (lncdfgrd) THEN
130	istatus=NF_OPEN(cmsknam//'.nc', NF_NOWRITE, nc_mskid)
131	IF (istatus .ne. NF_NOERR) THEN
132	WRITE (UNIT = nulou,FMT = *)
133	$ ' ===>>>> : error in opening masks.nc. We STOP!'
134	WRITE (UNIT = nulou,FMT = *) ' '
135	CALL HALTE('STOP in iniiof')
136	ENDIF
137	ELSE
138	OPEN (UNIT = nulma,FILE = cmsknam,STATUS='OLD',
139	$ FORM ='UNFORMATTED',ERR = 120,IOSTAT = iost)
140	IF (nlogprt .GE. 1) THEN
141	WRITE (UNIT = nulou,FMT = 1001) nulma, cmsknam
142	WRITE (UNIT = nulou,FMT = *) ' '
143	ENDIF
144	120 CONTINUE
145	IF (iost .ne. 0) THEN
146	WRITE (UNIT = nulou,FMT = *)
147	$ ' ===>>>> : error opening masks file'
148	WRITE (UNIT = nulou,FMT = *)
149	$ ' ======= ===== ===='
150	WRITE (UNIT = nulou,FMT = *)
151	$ ' logical unit ',nulma,' error number = ',
152	$ iost
153	WRITE (UNIT = nulou,FMT = *)
154	$ ' We STOP. Verify the file ', cmsknam
155	WRITE (UNIT = nulou,FMT = *) ' '
156	CALL HALTE('STOP in iniiof')
157	ENDIF
158	ENDIF
159	C
160	C* Surfaces file
161	C
162	DO 125 jf = 1, ig_nfield
163	IF (lsurf(jf)) ll_areas = .TRUE.
164	125 CONTINUE
165	IF (nlogprt .GE. 1) THEN
166	WRITE (UNIT = nulou,FMT = *) 'Trying open gcm surface file'
167	WRITE (UNIT = nulou,FMT = *) ' '
168	ENDIF
169	IF (lncdfgrd) THEN
170	istatus=NF_OPEN(csurnam//'.nc', NF_NOWRITE, nc_surid)
171	IF (istatus .ne. NF_NOERR .and. ll_areas) THEN
172	WRITE (UNIT = nulou,FMT = *)
173	$ ' ===>>>> : error in opening areas.nc. We STOP!'
174	WRITE (UNIT = nulou,FMT = *) ' '
175	CALL HALTE('STOP in iniiof')
176	ENDIF
177	ELSE
178	OPEN (UNIT = nulsu,FILE = csurnam,
179	$ FORM ='UNFORMATTED',ERR = 130,IOSTAT = iost)
180	IF (nlogprt .GE. 1) THEN
181	WRITE (UNIT = nulou,FMT = 1001) nulsu, csurnam
182	WRITE (UNIT = nulou,FMT = *) ' '
183	ENDIF
184	130 CONTINUE
185	IF (iost .ne. 0 .and. ll_areas) THEN
186	WRITE (UNIT = nulou,FMT = *)
187	$ ' ===>>>> : error opening surfaces file'
188	WRITE (UNIT = nulou,FMT = *)
189	$ ' ======= ===== ===='
190	WRITE (UNIT = nulou,FMT = *)
191	$ ' logical unit ',nulsu,' error number = ', iost
192	WRITE (UNIT = nulou,FMT = *)
193	$ ' We STOP. Verify the file ', csurnam
194	WRITE (UNIT = nulou,FMT = *) ' '
195	CALL HALTE ('STOP in iniiof')
196	ENDIF
197	ENDIF
198	C
199	C* Trace file for CLIM
200	C
201	IF (nlogprt .GE. 1) THEN
202	IF (cchan .EQ. 'MPI2' .or. cchan .EQ. 'MPI1' ) THEN
203	WRITE (UNIT = nulou,FMT = *)
204	$ ' The CLIM trace file is opened'
205	WRITE (UNIT = nulou,FMT = *)
206	$ ' within the CLIM program '
207	WRITE (UNIT = nulou,FMT = *)
208	$ ' The name of the file is oasis.prt '
209	WRITE (UNIT = nulou,FMT = *)
210	$ ' linked to logical unit = ', nultr
211	ENDIF
212	ENDIF
213	C
214	C* Formats
215	C
216	1001 FORMAT(10X,' open unit = ',I3,' file ',A8,' ok')
217	C
218	C
219	C* 2. Deal with restart/transfer files
220	C --------------------------------
221	C
222	C* Files for input fields
223	C
224	IF (nlogprt .GE. 1) THEN
225	WRITE (UNIT = nulou,FMT = *) ' '
226	WRITE (UNIT = nulou,FMT = *)
227	$ ' opening restart/transfer files '
228	WRITE (UNIT = nulou,FMT = *) ' '
229	ENDIF
230
231	lncdfrst = .true.
232	DO jf = 1, ig_nfield
233	isamefic=0
234	DO 215 jj = 1, jf-1
235	IF (nluinp(jf) .eq. nluinp(jj)) THEN
236	isamefic=isamefic+1
237	nc_inpid(jf)=nc_inpid(jj)
238	ENDIF
239	215 END DO
240	IF (isamefic .lt. 1) THEN
241	iunit = nluinp(jf)
242	clfic = cficinp(jf)
243	c Find the index of jf in total number of field
244	DO jj = 1, ig_total_nfield
245	if ( jf .eq. ig_number_field(jj)) ig_ind = jj
246	END DO
247	IF (ig_lag(ig_ind) .gt. 0) THEN
248	IF (lncdfrst) THEN
249	istatus=NF_OPEN(clfic, NF_NOWRITE, nc_inpid(jf))
250	IF (istatus .ne. NF_NOERR) THEN
251	OPEN (UNIT = iunit,FILE = clfic,STATUS='OLD',
252	$ FORM = 'UNFORMATTED',IOSTAT = iost)
253	IF (iost .ne. 0) THEN
254	CALL prtout
255	$ ('No restart input file for field ',
256	$ jf, 1)
257	CALL HALTE('STOP in iniiof')
258	ELSE
259	IF (nlogprt .GE. 1) THEN
260	WRITE (UNIT = nulou,FMT = 1001)iunit,clfic
261	ENDIF
262	lncdfrst = .false.
263	ENDIF
264	ELSE
265	IF (nlogprt .GE. 1) THEN
266	WRITE (UNIT = nulou,FMT = *)
267	$ ' opened netcdf restart file ', clfic
268	ENDIF
269	ENDIF
270	ELSE
271	OPEN (UNIT = iunit,FILE = clfic,STATUS='OLD',
272	$ FORM = 'UNFORMATTED',IOSTAT = iost)
273	IF (iost .ne. 0) THEN
274	CALL prtout
275	$ ('No binary restart input file for field ',
276	$ jf, 1)
277	CALL HALTE('STOP in iniiof')
278	ELSE
279	IF (nlogprt .GE. 1) THEN
280	WRITE (UNIT = nulou,FMT = 1001) iunit, clfic
281	ENDIF
282	ENDIF
283	ENDIF
284	ENDIF
285	ENDIF
286	ENDDO
287	cvg<<<
288
289	C
290	C
291	C * 3. Anais weights and output files and NINENN weight file
292	C -----------------------------------------------------
293	C
294	C * Weights file for ANAISM
295	C
296	IF (nlogprt .GE. 1) THEN
297	WRITE (UNIT = nulou,FMT = *) ' '
298	WRITE (UNIT = nulou,FMT = *)
299	$ ' open interpolation related files '
300	WRITE (UNIT = nulou,FMT = *) ' '
301	WRITE (UNIT = nulou,FMT = *)
302	$ ' need file with surface mesh weights'
303	WRITE (UNIT = nulou,FMT = *) ' '
304	ENDIF
305	OPEN (UNIT = nulcc,FILE = cwanaism,
306	$ FORM ='UNFORMATTED',ERR = 310,IOSTAT = iost)
307	IF (nlogprt .GE. 1) THEN
308	WRITE (UNIT = nulou,FMT = 1001) nulcc, cwanaism
309	WRITE (UNIT = nulou,FMT = *) ' '
310	ENDIF
311	310 CONTINUE
312	IF (iost .ne. 0) THEN
313	WRITE (UNIT = nulou,FMT = *)
314	$ ' ===>>>> : error opening surfmesh weights file'
315	WRITE (UNIT = nulou,FMT = *)
316	$ ' ======= ===== ===='
317	WRITE (UNIT = nulou,FMT = *)
318	$ ' logical unit ',nulcc,' error number = ',
319	$ iost
320	WRITE (UNIT = nulou,FMT = *)
321	$ ' We STOP. Verify the file', cwanaism
322	WRITE (UNIT = nulou,FMT = *) ' '
323	CALL HALTE ('STOP in iniiof')
324	ENDIF
325	C * Weights file for ANAISG
326	IF (nlogprt .GE. 1) THEN
327	WRITE (UNIT = nulou,FMT = *)
328	$ ' need file with curvilinear grid weights'
329	WRITE (UNIT = nulou,FMT = *) ' '
330	ENDIF
331	OPEN (UNIT = nulgg,FILE = cwanaisg,
332	$ FORM ='UNFORMATTED',ERR = 320,IOSTAT = iost)
333	IF (nlogprt .GE. 1) THEN
334	WRITE (UNIT = nulou,FMT = 1001) nulgg, cwanaisg
335	WRITE (UNIT = nulou,FMT = *) ' '
336	ENDIF
337	320 CONTINUE
338	IF (iost .ne. 0) THEN
339	WRITE (UNIT = nulou,FMT = *)
340	$ ' ===>>>> : error opening curvilinear weights file'
341	WRITE (UNIT = nulou,FMT = *)
342	$ ' ======= ===== ===='
343	WRITE (UNIT = nulou,FMT = *)
344	$ ' logical unit ',nulgg,' error number = ',
345	$ iost
346	WRITE (UNIT = nulou,FMT = *)
347	$ ' We STOP. Verify the file', cwanaisg
348	WRITE (UNIT = nulou,FMT = *) ' '
349	CALL HALTE ('STOP in iniiof')
350	ENDIF
351	C * ANAIS output FILE
352	IF (nlogprt .GE. 1) THEN
353	WRITE (UNIT = nulou,FMT = *) ' open ANAIS output file'
354	WRITE (UNIT = nulou,FMT = *) ' '
355	ENDIF
356	OPEN (UNIT = nulan,FILE = cnaisout, STATUS='NEW',
357	$ FORM ='FORMATTED',ERR = 330,IOSTAT = iost)
358	IF (nlogprt .GE. 1) THEN
359	WRITE (UNIT = nulou,FMT = 1001) nulan, cnaisout
360	WRITE (UNIT = nulou,FMT = *) ' '
361	ENDIF
362	330 CONTINUE
363	IF (iost .ne. 0) THEN
364	WRITE (UNIT = nulou,FMT = *)
365	$ ' ===>>>> : error opening ANAIS output file'
366	WRITE (UNIT = nulou,FMT = *)
367	$ ' ======= ===== ===='
368	WRITE (UNIT = nulou,FMT = *)
369	$ ' logical unit ',nulan,' error number = ',
370	$ iost
371	WRITE (UNIT = nulou,FMT = *)
372	$ ' We STOP. Verify the file', cnaisout
373	WRITE (UNIT = nulou,FMT = *) ' '
374	CALL HALTE ('STOP in iniiof')
375	ENDIF
376	C
377	C * Weights file for NINENN
378	IF (nlogprt .GE. 1) THEN
379	WRITE (UNIT = nulou,FMT = *)
380	$ 'need file with weights, address and iteration number'
381	WRITE (UNIT = nulou,FMT = *) ' '
382	ENDIF
383	#if !defined key_openmp
384	OPEN (UNIT = nulgn,FILE = cwninenn,
385	$ FORM ='UNFORMATTED',ERR = 340,IOSTAT = iost)
386	IF (nlogprt .GE. 1) THEN
387	WRITE (UNIT = nulou,FMT = 1001) nulgn, cwninenn
388	WRITE (UNIT = nulou,FMT = *) ' '
389	ENDIF
390	340 CONTINUE
391	IF (iost .ne. 0) THEN
392	WRITE (UNIT = nulou,FMT = *)
393	$ ' ===>>>> : error opening weight file'
394	WRITE (UNIT = nulou,FMT = *)
395	$ ' ======= ===== ===='
396	WRITE (UNIT = nulou,FMT = *)
397	$ ' logical unit ',nulgn,' error number = ',
398	$ iost
399	WRITE (UNIT = nulou,FMT = *)
400	$ ' We STOP. Verify the file', cwninenn
401	WRITE (UNIT = nulou,FMT = *) ' '
402	CALL HALTE ('STOP in iniiof')
403	ENDIF
404	#endif
405	C
406	C* 4. Deal with data files used in analysis routines
407	C ----------------------------------------------
408	C
409	IF (nlogprt .GE. 1) THEN
410	WRITE (UNIT = nulou,FMT = *) ' '
411	WRITE (UNIT = nulou,FMT = *) ' open analysis related files '
412	WRITE (UNIT = nulou,FMT = *) ' '
413	ENDIF
414	DO 410 jf = 1, ig_nfield
415	DO 420 ja = 1, ig_ntrans(jf)
416	IF(canal(ja,jf) .EQ. 'CORRECT') THEN
417	DO 430 jc = 1, ncofld(jf)
418	iunit = nludat(jc,jf)
419	clfic = ccofic(jc,jf)
420	OPEN(UNIT = iunit,FILE = clfic,
421	$ FORM ='UNFORMATTED',ERR = 440,IOSTAT = iost)
422	IF (nlogprt .GE. 1) THEN
423	WRITE (UNIT = nulou,FMT = 1001) iunit, clfic
424	WRITE (UNIT = nulou,FMT = *) ' '
425	ENDIF
426	440 IF (iost .ne. 0) THEN
427	WRITE (UNIT = nulou,FMT = *)
428	$ ' ===>>>> : error opening data file'
429	WRITE (UNIT = nulou,FMT = *)
430	$ ' ======= ===== ===='
431	WRITE (UNIT = nulou,FMT = *)
432	$ ' logical unit ',iunit,' error number = ',
433	$ iost
434	WRITE (UNIT = nulou,FMT = *)
435	$ ' We STOP. Verify the file ', clfic
436	WRITE (UNIT = nulou,FMT = *) ' '
437	CALL HALTE('STOP in iniiof')
438	ENDIF
439	430 CONTINUE
440	ELSE IF(canal(ja,jf) .EQ. 'MOZAIC') THEN
441	iunit = nlumap(jf)
442	clfic = cgrdmap(jf)
443	OPEN(UNIT = iunit,FILE = clfic,
444	$ FORM ='UNFORMATTED',ERR = 450,IOSTAT = iost)
445	IF (nlogprt .GE. 1) THEN
446	WRITE (UNIT = nulou,FMT = 1001) iunit, clfic
447	WRITE (UNIT = nulou,FMT = *) ' '
448	ENDIF
449	450 IF (iost .ne. 0) THEN
450	WRITE (UNIT = nulou,FMT = *)
451	$ ' ===>>>> : error opening mapping file'
452	WRITE (UNIT = nulou,FMT = *)
453	$ ' ======= ===== ===='
454	WRITE (UNIT = nulou,FMT = *)
455	$ ' logical unit ',iunit,' error number = ',
456	$ iost
457	WRITE (UNIT = nulou,FMT = *)
458	$ ' We STOP. Verify the file ', clfic
459	WRITE (UNIT = nulou,FMT = *) ' '
460	CALL HALTE('STOP in iniiof')
461	ENDIF
462	ELSE IF(canal(ja,jf) .EQ. 'FILLING') THEN
463	iunit = nlufil(jf)
464	clfic = cfilfic(jf)
465	OPEN(UNIT = iunit,FILE = clfic,
466	$ FORM ='UNFORMATTED',ERR = 460,IOSTAT = iost)
467	IF (nlogprt .GE. 1) THEN
468	WRITE (UNIT = nulou,FMT = 1001) iunit, clfic
469	WRITE (UNIT = nulou,FMT = *) ' '
470	ENDIF
471	460 IF (iost .ne. 0) THEN
472	WRITE (UNIT = nulou,FMT = *)
473	$ ' ===>>>> : error opening filling data file'
474	WRITE (UNIT = nulou,FMT = *)
475	$ ' ======= ===== ======= ===='
476	WRITE (UNIT = nulou,FMT = *)
477	$ ' logical unit ',iunit,' error number = ',
478	$ iost
479	WRITE (UNIT = nulou,FMT = *)
480	$ ' We STOP. Verify the file ', clfic
481	WRITE (UNIT = nulou,FMT = *) ' '
482	CALL HALTE('STOP in iniiof')
483	ENDIF
484	ELSE IF(canal(ja,jf) .EQ. 'SUBGRID') THEN
485	iunit = nlusub(jf)
486	clfic = cgrdsub(jf)
487	OPEN(UNIT = iunit,FILE = clfic,
488	$ FORM ='UNFORMATTED',ERR = 470,IOSTAT = iost)
489	IF (nlogprt .GE. 1) THEN
490	WRITE (UNIT = nulou,FMT = 1001) iunit, clfic
491	WRITE (UNIT = nulou,FMT = *) ' '
492	ENDIF
493	470 IF (iost .ne. 0) THEN
494	WRITE (UNIT = nulou,FMT = *)
495	$ ' ===>>>> : error opening subgrid data file'
496	WRITE (UNIT = nulou,FMT = *)
497	$ ' ======= ===== ======= ===='
498	WRITE (UNIT = nulou,FMT = *)
499	$ ' logical unit ',iunit,' error number = ',
500	$ iost
501	WRITE (UNIT = nulou,FMT = *)
502	$ ' We STOP. Verify the file ', clfic
503	WRITE (UNIT = nulou,FMT = *) ' '
504	CALL HALTE('STOP in iniiof')
505	ENDIF
506	ENDIF
507	420 CONTINUE
508	410 CONTINUE
509	C
510	C
511	C* 5. End of routine
512	C --------------
513	C
514	IF (nlogprt .GE. 1) THEN
515	WRITE(UNIT = nulou,FMT = *) ' '
516	WRITE(UNIT = nulou,FMT = *)
517	$ ' ---------- End of routine iniiof ---------'
518	CALL FLUSH (nulou)
519	ENDIF
520	ENDIF
521	RETURN
522	END

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

Context Navigation

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

Download in other formats: