Context Navigation

phyetat0.F @ 919

Last change on this file since 919 was 787, checked in by aslmd, 12 years ago

LMDZ.GENERIC. (Sorry for long text but this is a quite major commit)

Paving the path for parallel computations. And moving towards a more flexible code.

Automatic allocation is used within all routines in phystd. No further mention to ngridmx and nqmx.

ngridmx and nqmx are still used in LMDZ.GENERIC in the dyn3d part
if the LMDZ4/LMDZ5 dynamical core is used, there is no more fixed dimensions ngridmx and nqmx --> a fully flexible parallel implementation is now possible (e.g. no need to recompile when changing numbers of processors)

The important stuff :

Compilation checked with ifort. OK with and without debug mode. No errors. Checked for: gcm, newstart, rcm1d, kcm1d
RUN GCM: Running an Earth test case. Comparison with previous revision --> debug mode : perfect match. bit by bit (diff command). checked with plots --> O1 mode : close match (checked with plots) --> O2 mode : sometimes up to 0.5 K departure.... BUT in this new version O2 and O1 are quite close while in previous version O1 and O2 differed by about, well, typically 0.5 K (pictures available on request)
RUN NEWSTART : perfect match (bit-by-bit) in either debug or normal mode.
RUN RCM1D : perfect match in normal mode.
RUN KCM1D : not tested (I don't know what is the use of kcm1d)

List of main changes :

Additional arguments to some subroutines (ngrid and nq)
F77 include strategy is obsolete and replaced by F90 module strategy In this new strategy arrays are allocatable and allocated once at first use This has to be done for all common featuring arrays defined with ngridmx or nqmx

surfdat.h >> surfdat_h.F90
tracer.h >> tracer_h.F90
comsaison.h >> comsaison_h.F90
comgeomfi.h >> comgeomfi_h.F90
comsoil.h >> comsoil_h.F90
comdiurn.h >> comdiurn_h.F90
fisice.h >> DELETED. was not used. probably a fossil.
watercap.h >> DELETED. variable put in surfdat_h.F90

F77 'save' strategy is obsolete and replaced by F90 'allocatable save' strategy (see previous point and e.g. new version of physiq.F90)
Suppressing any mention to advtrac.h which is a common in the dynamics and needs nqmx This was easily solved by adding an argument with tracer names, coming from the dynamics This is probably not a definitive solution, ... but this allows for generic physics to work easily with either LMDZ.GENERIC or LMDZ dynamical cores
Removing consistency tests between nq and nqmx ; and ngrid and ngridmx. No use now!
Adaptation of rcm1d, kcm1d, newstart given above-mentioned changes

A note on phyetat0 and soil_setting:

Now written so that a slice of horizontal size 'ngrid' starting at grid point 'cursor' is read in startfi.nc 'cursor' is defined in dimphys.h and initialized by inifis (or in newstart) this is useful for parallel computations. default behavior is the usual one : sequential runs, cursor is 1, size ngrid is the whole global domain

A note on an additional change :

nueffrad is now an argument to callcorrk as is the case for reffrad both are saved in physiq this is for consistency and lisibility (previously nueffrad was saved in callcorrk) ... but there is a call to a function which modifies nueffrad in physiq ... previously this was not modifying nueffrad (although it was quite cumbersome to detect this) ... to be conservative I kept this behaviour and highlighted it with an array nueffrad_dummy ... I added a comment because someone might want to change this

File size: 20.2 KB

Line
1	SUBROUTINE phyetat0 (ngrid,fichnom,tab0,Lmodif,nsoil,nq,
2	. day_ini,time,
3	. tsurf,tsoil,emis,q2,qsurf,cloudfrac,totcloudfrac,hice)
4
5	USE surfdat_h
6	USE comgeomfi_h
7	USE tracer_h
8
9	implicit none
10
11	c======================================================================
12	c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
13	c Adaptation à Mars : Yann Wanherdrick
14	c Objet: Lecture de l etat initial pour la physique
15	c======================================================================
16	#include "netcdf.inc"
17	#include "dimensions.h"
18	#include "dimphys.h"
19	#include "planete.h"
20	#include "comcstfi.h"
21
22	INTEGER ngrid
23	c======================================================================
24	INTEGER nbsrf !Mars nbsrf a 1 au lieu de 4
25	PARAMETER (nbsrf=1) ! nombre de sous-fractions pour une maille
26	!======================================================================
27	! Arguments:
28	! ---------
29	! inputs:
30	character() fichnom ! "startfi.nc" file
31	integer tab0
32	integer Lmodif
33	integer nsoil ! # of soil layers
34	integer nq
35	integer day_ini
36	real time
37
38	! outputs:
39	real tsurf(ngrid,nbsrf) ! surface temperature
40	real tsoil(ngrid,nsoil,nbsrf) ! soil temperature
41	real emis(ngrid) ! surface emissivity
42	real q2(ngrid, llm+1) !
43	real qsurf(ngrid,nq) ! tracers on surface
44	! real co2ice(ngrid) ! co2 ice cover
45	real cloudfrac(ngrid,nlayermx)
46	real hice(ngrid), totcloudfrac(ngrid)
47
48
49	!======================================================================
50	! Local variables:
51
52	! INTEGER radpas
53	! REAL co2_ppm
54	! REAL solaire
55
56	real xmin,xmax ! to display min and max of a field
57	c
58	INTEGER ig,iq,lmax
59	INTEGER nid, nvarid
60	INTEGER ierr, i, nsrf
61	! integer isoil
62	! INTEGER length
63	! PARAMETER (length=100)
64	CHARACTER*7 str7
65	CHARACTER*2 str2
66	CHARACTER*1 yes
67	c
68	REAL p_rad,p_omeg,p_g,p_cpp,p_mugaz,p_daysec
69	INTEGER nqold
70
71	! flag which identifies if 'startfi.nc' file is using old names (qsurf01,...)
72	logical :: oldtracernames=.false.
73	integer :: count
74	character(len=30) :: txt ! to store some text
75
76	!! added variables by AS to allow to read only slices of startfi
77	real :: toto(ngrid)
78	integer :: sta !! subscript in starti where we start to read
79	integer, dimension(2) :: sta2d
80	integer, dimension(2) :: siz2d
81
82	c AS: get the cursor that is stored in dimphys.h
83	c ... this allows to read only a part of startfi horiz grid
84	sta = cursor
85
86	c
87	c ALLOCATE ARRAYS IN surfdat_h
88	c
89	IF (.not. ALLOCATED(albedodat)) ALLOCATE(albedodat(ngrid))
90	IF (.not. ALLOCATED(phisfi)) ALLOCATE(phisfi(ngrid))
91	IF (.not. ALLOCATED(zmea)) ALLOCATE(zmea(ngrid))
92	IF (.not. ALLOCATED(zstd)) ALLOCATE(zstd(ngrid))
93	IF (.not. ALLOCATED(zsig)) ALLOCATE(zsig(ngrid))
94	IF (.not. ALLOCATED(zgam)) ALLOCATE(zgam(ngrid))
95	IF (.not. ALLOCATED(zthe)) ALLOCATE(zthe(ngrid))
96
97	c
98	c Ouvrir le fichier contenant l etat initial:
99	c
100
101	ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
102	IF (ierr.NE.NF_NOERR) THEN
103	write(6,*)' Pb d''ouverture du fichier '//fichnom
104	CALL ABORT
105	ENDIF
106
107	! Preliminary stuff: check if tracers follow old naming convention (qsurf01,
108	! qsurf02, ...)
109	count=0
110	do iq=1,nq
111	txt= " "
112	write(txt,'(a5,i2.2)')'qsurf',iq
113	ierr=NF_INQ_VARID(nid,txt,nvarid)
114	if (ierr.ne.NF_NOERR) then
115	! did not find old tracer name
116	exit ! might as well stop here
117	else
118	! found old tracer name
119	count=count+1
120	endif
121	enddo
122	if (count.eq.nq) then
123	write(,) "phyetat0:tracers seem to follow old naming ",
124	& "convention (qsurf01,qsurf02,...)"
125	write(,) " => will work for now ... "
126	write(,) " but you should run newstart to rename them"
127	oldtracernames=.true.
128	endif
129
130	c modifications possibles des variables de tab_cntrl
131	write(,) 'TABFI de phyeta0',Lmodif,tab0
132	call tabfi (ngrid,nid,Lmodif,tab0,day_ini,lmax,p_rad,
133	. p_omeg,p_g,p_cpp,p_mugaz,p_daysec,time)
134
135	c
136	c Lecture des latitudes (coordonnees):
137	c
138	ierr = NF_INQ_VARID (nid, "latitude", nvarid)
139	IF (ierr.NE.NF_NOERR) THEN
140	PRINT*, 'phyetat0: Le champ <latitude> est absent'
141	CALL abort
142	ENDIF
143	#ifdef NC_DOUBLE
144	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta,ngrid,lati)
145	#else
146	ierr = NF_GET_VARA_REAL(nid,nvarid,sta,ngrid,lati)
147	#endif
148	IF (ierr.NE.NF_NOERR) THEN
149	PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
150	CALL abort
151	ENDIF
152	c
153	c Lecture des longitudes (coordonnees):
154	c
155	ierr = NF_INQ_VARID (nid, "longitude", nvarid)
156	IF (ierr.NE.NF_NOERR) THEN
157	PRINT*, 'phyetat0: Le champ <longitude> est absent'
158	CALL abort
159	ENDIF
160	#ifdef NC_DOUBLE
161	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta,ngrid,long)
162	#else
163	ierr = NF_GET_VARA_REAL(nid,nvarid,sta,ngrid,long)
164	#endif
165	IF (ierr.NE.NF_NOERR) THEN
166	PRINT*, 'phyetat0: Lecture echouee pour <longitude>'
167	CALL abort
168	ENDIF
169	c
170	c Lecture des aires des mailles:
171	c
172	ierr = NF_INQ_VARID (nid, "area", nvarid)
173	IF (ierr.NE.NF_NOERR) THEN
174	PRINT*, 'phyetat0: Le champ <area> est absent'
175	CALL abort
176	ENDIF
177	#ifdef NC_DOUBLE
178	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta,ngrid,area)
179	#else
180	ierr = NF_GET_VARA_REAL(nid,nvarid,sta,ngrid,area)
181	#endif
182	IF (ierr.NE.NF_NOERR) THEN
183	PRINT*, 'phyetat0: Lecture echouee pour <area>'
184	CALL abort
185	ENDIF
186	xmin = 1.0E+20
187	xmax = -1.0E+20
188	xmin = MINVAL(area)
189	xmax = MAXVAL(area)
190	PRINT*,'Aires des mailles <area>:', xmin, xmax
191	c
192	c Lecture du geopotentiel au sol:
193	c
194	ierr = NF_INQ_VARID (nid, "phisfi", nvarid)
195	IF (ierr.NE.NF_NOERR) THEN
196	PRINT*, 'phyetat0: Le champ <phisfi> est absent'
197	CALL abort
198	ENDIF
199	#ifdef NC_DOUBLE
200	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta,ngrid,phisfi)
201	#else
202	ierr = NF_GET_VARA_REAL(nid,nvarid,sta,ngrid,phisfi)
203	#endif
204	IF (ierr.NE.NF_NOERR) THEN
205	PRINT*, 'phyetat0: Lecture echouee pour <phisfi>'
206	CALL abort
207	ENDIF
208	xmin = 1.0E+20
209	xmax = -1.0E+20
210	xmin = MINVAL(phisfi)
211	xmax = MAXVAL(phisfi)
212	PRINT*,'Geopotentiel au sol <phisfi>:', xmin, xmax
213	c
214	c Lecture de l''albedo du sol nu:
215	c
216	ierr = NF_INQ_VARID (nid, "albedodat", nvarid)
217	IF (ierr.NE.NF_NOERR) THEN
218	PRINT*, 'phyetat0: Le champ <albedodat> est absent'
219	CALL abort
220	ENDIF
221	#ifdef NC_DOUBLE
222	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta,ngrid,albedodat)
223	#else
224	ierr = NF_GET_VARA_REAL(nid,nvarid,sta,ngrid,albedodat)
225	#endif
226	IF (ierr.NE.NF_NOERR) THEN
227	PRINT*, 'phyetat0: Lecture echouee pour <albedodat>'
228	CALL abort
229	ENDIF
230	xmin = 1.0E+20
231	xmax = -1.0E+20
232	xmin = MINVAL(albedodat)
233	xmax = MAXVAL(albedodat)
234	PRINT*,'Albedo du sol nu <albedodat>:', xmin, xmax
235	c
236	c ZMEA
237	c
238	ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
239	IF (ierr.NE.NF_NOERR) THEN
240	PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
241	CALL abort
242	ENDIF
243	#ifdef NC_DOUBLE
244	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta,ngrid,zmea)
245	#else
246	ierr = NF_GET_VARA_REAL(nid,nvarid,sta,ngrid,zmea)
247	#endif
248	IF (ierr.NE.NF_NOERR) THEN
249	PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
250	CALL abort
251	ENDIF
252	xmin = 1.0E+20
253	xmax = -1.0E+20
254	DO i = 1, ngrid
255	xmin = MIN(zmea(i),xmin)
256	xmax = MAX(zmea(i),xmax)
257	ENDDO
258	PRINT*,'<zmea>:', xmin, xmax
259	c
260	c ZSTD
261	c
262	ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
263	IF (ierr.NE.NF_NOERR) THEN
264	PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
265	CALL abort
266	ENDIF
267	#ifdef NC_DOUBLE
268	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta,ngrid,zstd)
269	#else
270	ierr = NF_GET_VARA_REAL(nid,nvarid,sta,ngrid,zstd)
271	#endif
272	IF (ierr.NE.NF_NOERR) THEN
273	PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
274	CALL abort
275	ENDIF
276	xmin = 1.0E+20
277	xmax = -1.0E+20
278	DO i = 1, ngrid
279	xmin = MIN(zstd(i),xmin)
280	xmax = MAX(zstd(i),xmax)
281	ENDDO
282	PRINT*,'<zstd>:', xmin, xmax
283	c
284	c ZSIG
285	c
286	ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
287	IF (ierr.NE.NF_NOERR) THEN
288	PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
289	CALL abort
290	ENDIF
291	#ifdef NC_DOUBLE
292	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta,ngrid,zsig)
293	#else
294	ierr = NF_GET_VARA_REAL(nid,nvarid,sta,ngrid,zsig)
295	#endif
296	IF (ierr.NE.NF_NOERR) THEN
297	PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
298	CALL abort
299	ENDIF
300	xmin = 1.0E+20
301	xmax = -1.0E+20
302	DO i = 1, ngrid
303	xmin = MIN(zsig(i),xmin)
304	xmax = MAX(zsig(i),xmax)
305	ENDDO
306	PRINT*,'<zsig>:', xmin, xmax
307	c
308	c ZGAM
309	c
310	ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
311	IF (ierr.NE.NF_NOERR) THEN
312	PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
313	CALL abort
314	ENDIF
315	#ifdef NC_DOUBLE
316	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta,ngrid,zgam)
317	#else
318	ierr = NF_GET_VARA_REAL(nid,nvarid,sta,ngrid,zgam)
319	#endif
320	IF (ierr.NE.NF_NOERR) THEN
321	PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
322	CALL abort
323	ENDIF
324	xmin = 1.0E+20
325	xmax = -1.0E+20
326	DO i = 1, ngrid
327	xmin = MIN(zgam(i),xmin)
328	xmax = MAX(zgam(i),xmax)
329	ENDDO
330	PRINT*,'<zgam>:', xmin, xmax
331	c
332	c ZTHE
333	c
334	ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
335	IF (ierr.NE.NF_NOERR) THEN
336	PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
337	CALL abort
338	ENDIF
339	#ifdef NC_DOUBLE
340	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta,ngrid,zthe)
341	#else
342	ierr = NF_GET_VARA_REAL(nid,nvarid,sta,ngrid,zthe)
343	#endif
344	IF (ierr.NE.NF_NOERR) THEN
345	PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
346	CALL abort
347	ENDIF
348	xmin = 1.0E+20
349	xmax = -1.0E+20
350	DO i = 1, ngrid
351	xmin = MIN(zthe(i),xmin)
352	xmax = MAX(zthe(i),xmax)
353	ENDDO
354	PRINT*,'<zthe>:', xmin, xmax
355	c
356	c CO2 ice cover
357	c
358	! Ehouarn: from now on, there is no "co2ice" standalone field; it is supposed
359	! to be with stored in qsurf(i_co2_ice)
360	! ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
361	! IF (ierr.NE.NF_NOERR) THEN
362	! PRINT*, 'phyetat0: Le champ <co2ice> est absent'
363	! CALL abort
364	! ENDIF
365	!#ifdef NC_DOUBLE
366	! ierr = NF_GET_VAR_DOUBLE(nid, nvarid, co2ice)
367	!#else
368	! ierr = NF_GET_VAR_REAL(nid, nvarid, co2ice)
369	!#endif
370	! IF (ierr.NE.NF_NOERR) THEN
371	! PRINT*, 'phyetat0: Lecture echouee pour <co2ice>'
372	! CALL abort
373	! ENDIF
374	! xmin = 1.0E+20
375	! xmax = -1.0E+20
376	! xmin = MINVAL(co2ice)
377	! xmax = MAXVAL(co2ice)
378	! PRINT*,'CO2 ice cover <co2ice>:', xmin, xmax
379	c
380	c Lecture des temperatures du sol:
381	c
382	ierr = NF_INQ_VARID (nid, "tsurf", nvarid)
383	IF (ierr.NE.NF_NOERR) THEN
384	PRINT*, 'phyetat0: Le champ <tsurf> est absent'
385	PRINT, ' Mais je vais essayer de lire TS*'
386	IF (nbsrf.GT.99) THEN
387	PRINT*, "Trop de sous-mailles"
388	CALL abort
389	ENDIF
390	DO nsrf = 1, nbsrf
391	WRITE(str2,'(i2.2)') nsrf
392	ierr = NF_INQ_VARID (nid, "TS"//str2, nvarid)
393	IF (ierr.NE.NF_NOERR) THEN
394	PRINT*, "phyetat0: Le champ <TS"//str2//"> est absent"
395	CALL abort
396	ENDIF
397	#ifdef NC_DOUBLE
398	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsurf(1,nsrf))
399	#else
400	ierr = NF_GET_VAR_REAL(nid, nvarid, tsurf(1,nsrf))
401	#endif
402	IF (ierr.NE.NF_NOERR) THEN
403	PRINT*, "phyetat0: Lecture echouee pour <TS"//str2//">"
404	CALL abort
405	ENDIF
406	xmin = 1.0E+20
407	xmax = -1.0E+20
408	xmin = MINVAL(tsurf)
409	xmax = MAXVAL(tsurf)
410	PRINT,'Temperature du sol TS*:', nsrf, xmin, xmax
411	ENDDO
412	ELSE
413	PRINT*, 'phyetat0: Le champ <tsurf> est present'
414	PRINT, ' J ignore donc les autres temperatures TS*'
415	#ifdef NC_DOUBLE
416	ierr = NF_GET_VARA_DOUBLE(nid, nvarid, sta, ngrid, tsurf)
417	#else
418	ierr = NF_GET_VARA_REAL(nid, nvarid, sta, ngrid, tsurf)
419	#endif
420	IF (ierr.NE.NF_NOERR) THEN
421	PRINT*, "phyetat0: Lecture echouee pour <TSURF>"
422	CALL abort
423	ENDIF
424	xmin = 1.0E+20
425	xmax = -1.0E+20
426	xmin = MINVAL(tsurf)
427	xmax = MAXVAL(tsurf)
428	PRINT*,'Temperature du sol <tsurf>', xmin, xmax
429	IF (nbsrf >= 2) THEN
430	DO nsrf = 2, nbsrf
431	DO i = 1, ngrid
432	tsurf(i,nsrf) = tsurf(i,1)
433	ENDDO
434	ENDDO
435	ENDIF
436	ENDIF
437	c
438	c Lecture des temperatures du sol profond:
439	c
440	! IF (nsoil.GT.99 .OR. nbsrf.GT.99) THEN
441	! PRINT*, "Trop de couches ou sous-mailles"
442	! CALL abort
443	! ENDIF
444	! DO nsrf = 1, nbsrf
445	! DO isoil=1, nsoil
446	! WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
447	! ierr = NF_INQ_VARID (nid, 'tsoil', nvarid)
448	! IF (ierr.NE.NF_NOERR) THEN
449	! PRINT*, "phyetat0: Le champ <tsoil> est absent"
450	! PRINT*, " Il prend donc la valeur de surface"
451	! DO i=1, ngrid
452	! tsoil(i,isoil,nsrf)=tsurf(i,nsrf)
453	! ENDDO
454	! ELSE
455	!#ifdef NC_DOUBLE
456	! ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,1,nsrf))
457	!#else
458	! ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,1,nsrf))
459	!#endif
460	! IF (ierr.NE.NF_NOERR) THEN
461	! PRINT*, "Lecture echouee pour <tsoil>"
462	! CALL abort
463	! ENDIF
464	! ENDIF
465	! ENDDO
466	! ENDDO
467	! xmin = 1.0E+20
468	! xmax = -1.0E+20
469	! xmin = MINVAL(tsoil)
470	! xmax = MAXVAL(tsoil)
471	! PRINT*,'Temperatures du sol profond <tsoil>', xmin, xmax
472	c
473	c Surface emissivity
474	c
475	ierr = NF_INQ_VARID (nid, "emis", nvarid)
476	IF (ierr.NE.NF_NOERR) THEN
477	PRINT*, 'phyetat0: Le champ <emis> est absent'
478	CALL abort
479	ENDIF
480	#ifdef NC_DOUBLE
481	ierr = NF_GET_VARA_DOUBLE(nid, nvarid, sta,ngrid, emis)
482	#else
483	ierr = NF_GET_VARA_REAL(nid, nvarid,sta,ngrid, emis)
484	#endif
485	IF (ierr.NE.NF_NOERR) THEN
486	PRINT*, 'phyetat0: Lecture echouee pour <emis>'
487	CALL abort
488	ENDIF
489	xmin = 1.0E+20
490	xmax = -1.0E+20
491	xmin = MINVAL(emis)
492	xmax = MAXVAL(emis)
493	PRINT*,'Surface emissivity <emis>:', xmin, xmax
494
495	c
496	c Cloud fraction (added by BC 2010)
497	c
498	ierr = NF_INQ_VARID (nid, "cloudfrac", nvarid)
499	IF (ierr.NE.NF_NOERR) THEN
500	PRINT*, 'phyetat0: Le champ <cloudfrac> est absent'
501	cloudfrac(:,:)=0.5
502	! CALL abort
503	ENDIF
504	sta2d = (/sta,1/)
505	siz2d = (/ngrid, nlayermx/)
506	#ifdef NC_DOUBLE
507	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta2d,siz2d,cloudfrac)
508	#else
509	ierr = NF_GET_VARA_REAL(nid,nvarid,sta2d,siz2d,cloudfrac)
510	#endif
511	IF (ierr.NE.NF_NOERR) THEN
512	PRINT*, 'phyetat0: Lecture echouee pour <cloudfrac>'
513	CALL abort
514	ENDIF
515	xmin = 1.0E+20
516	xmax = -1.0E+20
517	xmin = MINVAL(cloudfrac)
518	xmax = MAXVAL(cloudfrac)
519	PRINT*,'Cloud fraction <cloudfrac>:', xmin, xmax
520
521
522	c
523	c Total cloud fraction (added by BC 2010)
524	c
525	ierr = NF_INQ_VARID (nid, "totcloudfrac", nvarid)
526	! ierr = NF_INQ_VARID (nid, "totalfrac", nvarid)
527	IF (ierr.NE.NF_NOERR) THEN
528	PRINT*, 'phyetat0: Le champ <totcloudfrac> est absent'
529	totcloudfrac(:)=0.5
530	! CALL abort
531	ENDIF
532	#ifdef NC_DOUBLE
533	ierr = NF_GET_VARA_DOUBLE(nid, nvarid,sta,ngrid, totcloudfrac)
534	#else
535	ierr = NF_GET_VARA_REAL(nid, nvarid,sta,ngrid, totcloudfrac)
536	#endif
537	IF (ierr.NE.NF_NOERR) THEN
538	PRINT*, 'phyetat0: Lecture echouee pour <totcloudfrac>'
539	!CALL abort
540	ENDIF
541	xmin = 1.0E+20
542	xmax = -1.0E+20
543	xmin = MINVAL(totcloudfrac)
544	xmax = MAXVAL(totcloudfrac)
545	PRINT*,'Cloud fraction <totcloudfrac>:', xmin, xmax
546
547
548
549	c
550	c Height of oceanic ice (added by BC 2010)
551	c
552	ierr = NF_INQ_VARID (nid, "hice", nvarid)
553	IF (ierr.NE.NF_NOERR) THEN
554	PRINT*, 'phyetat0: Le champ <hice> est absent'
555	CALL abort
556	ENDIF
557	#ifdef NC_DOUBLE
558	ierr = NF_GET_VARA_DOUBLE(nid, nvarid,sta,ngrid, hice)
559	#else
560	ierr = NF_GET_VARA_REAL(nid, nvarid,sta,ngrid, hice)
561	#endif
562	IF (ierr.NE.NF_NOERR) THEN
563	PRINT*, 'phyetat0: Lecture echouee pour <hice>'
564	CALL abort
565	ENDIF
566	xmin = 1.0E+20
567	xmax = -1.0E+20
568	xmin = MINVAL(hice)
569	xmax = MAXVAL(hice)
570	PRINT*,'Height of oceanic ice <hice>:', xmin, xmax
571
572
573	c
574	c pbl wind variance
575	c
576	ierr = NF_INQ_VARID (nid, "q2", nvarid)
577	IF (ierr.NE.NF_NOERR) THEN
578	PRINT*, 'phyetat0: Le champ <q2> est absent'
579	CALL abort
580	ENDIF
581	sta2d = (/sta,1/)
582	siz2d = (/ngrid, llm+1/)
583	#ifdef NC_DOUBLE
584	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta2d,siz2d,q2)
585	#else
586	ierr = NF_GET_VARA_REAL(nid,nvarid,sta2d,siz2d,q2)
587	#endif
588	IF (ierr.NE.NF_NOERR) THEN
589	PRINT*, 'phyetat0: Lecture echouee pour <q2>'
590	CALL abort
591	ENDIF
592	xmin = 1.0E+20
593	xmax = -1.0E+20
594	xmin = MINVAL(q2)
595	xmax = MAXVAL(q2)
596	PRINT*,'pbl wind variance <q2>:', xmin, xmax
597	c
598	c tracer on surface
599	c
600
601	IF(nq.GE.1) THEN
602	nqold=nq
603	DO iq=1,nq
604	! str7(1:5)='qsurf'
605	! WRITE(str7(6:7),'(i2.2)') iq
606	! ierr = NF_INQ_VARID (nid,str7,nvarid)
607	IF (oldtracernames) THEN
608	txt=" "
609	write(txt,'(a5,i2.2)')'qsurf',iq
610	ELSE
611	txt=noms(iq)
612	! if (txt.eq."h2o_vap") then
613	! There is no surface tracer for h2o_vap;
614	! "h2o_ice" should be loaded instead
615	! txt="h2o_ice"
616	! write(,) 'phyetat0: loading surface tracer',
617	! & ' h2o_ice instead of h2o_vap'
618	! endif
619	ENDIF ! of IF (oldtracernames) THEN
620	ierr=NF_INQ_VARID(nid,txt,nvarid)
621	IF (ierr.NE.NF_NOERR) THEN
622	write(,) 'PHYETAT0: WARNING : surface tracer',trim(txt),
623	& ' not found in file'
624	write(,) trim(txt), ' set to 0'
625	do ig=1,ngrid
626	qsurf(ig,iq)=0.
627	end do
628	nqold=min(iq-1,nqold)
629	ELSE
630	toto(:) = 0.
631	#ifdef NC_DOUBLE
632	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta,ngrid,toto)
633	#else
634	ierr = NF_GET_VARA_REAL(nid,nvarid,sta,ngrid,toto)
635	#endif
636	IF (ierr.NE.NF_NOERR) THEN
637	PRINT*, 'phyetat0: Lecture echouee pour <',trim(txt),'>'
638	CALL abort
639	ENDIF
640	qsurf(1:ngrid,iq) = toto(1:ngrid)
641	ENDIF
642	xmin = 1.0E+20
643	xmax = -1.0E+20
644	xmin = MINVAL(qsurf(1:ngrid,iq))
645	xmax = MAXVAL(qsurf(1:ngrid,iq))
646	PRINT*,'tracer on surface <',trim(txt),'>:',xmin,xmax
647	ENDDO
648	if ((nqold.lt.nq).and.(nqold.ge.1)) then
649	c case when new tracer are added in addition to old ones
650	write(,)'qsurf 1 to ', nqold,'were already present'
651	write(,)'qsurf ', nqold+1,' to ', nq,'are new'
652	write(,)' and initialized to zero'
653	qsurf(:,nqold+1:nq)=0.0
654	! yes=' '
655	! do while ((yes.ne.'y').and.(yes.ne.'n'))
656	! write(,) 'Would you like to reindex qsurf # 1 ->',nqold
657	! write(,) 'to #',nq-nqold+1,'->', nq,' (y or n) ?'
658	! read(*,fmt='(a)') yes
659	! end do
660	! if (yes.eq.'y') then
661	! write(,) 'OK, let s reindex qsurf'
662	! do ig=1,ngrid
663	! do iq=nq,nq-nqold+1,-1
664	! qsurf(ig,iq)=qsurf(ig,iq-nq+nqold)
665	! end do
666	! do iq=nq-nqold,1,-1
667	! qsurf(ig,iq)= 0.
668	! end do
669	! end do
670	! end if
671	end if ! of if ((nqold.lt.nq).and.(nqold.ge.1))
672	ENDIF ! of IF(nq.GE.1)
673
674	! Call to soil_settings, in order to read soil temperatures,
675	! as well as thermal inertia and volumetric heat capacity
676
677	PRINT*,'SOIL INIT'
678	call soil_settings(nid,ngrid,nsoil,tsurf,tsoil)
679	c
680	c Fermer le fichier:
681	c
682	ierr = NF_CLOSE(nid)
683	c
684
685	RETURN
686	END

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

Download in other formats:

Original Format