Context Navigation

phyetat0.F @ 1377

Last change on this file since 1377 was 1319, checked in by Laurent Fairhead, 15 years ago

Modifications to the start and limit creation routines to account for different

calendars

Modification to phyetat0 to force the mask read in the start files to match the

surface fractions read in the limit file

Force readaerosol.F90 to read in aerosols file with 12 timesteps

Modifications aux routines de créations des fichiers start et limit pour prendre

en compte différents calendriers

Modification à phyetat0 pour forcer le masque lu dans le fichier start à être

compatible avec les fractions de surface lu dans le fichier limit

Forcer readaerosol à ne lire que des fichiers à 12 pas de temps

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 28.9 KB

Line
1	!
2	! $Header$
3	!
4	c
5	c
6	SUBROUTINE phyetat0 (fichnom,
7	. clesphy0,
8	. tabcntr0)
9
10	USE dimphy
11	USE mod_grid_phy_lmdz
12	USE mod_phys_lmdz_para
13	USE iophy
14	USE ocean_cpl_mod, ONLY : ocean_cpl_init
15	USE fonte_neige_mod, ONLY : fonte_neige_init
16	USE pbl_surface_mod, ONLY : pbl_surface_init
17	USE surface_data, ONLY : type_ocean
18	USE phys_state_var_mod
19	USE iostart
20	USE write_field_phy
21	USE infotrac
22	USE traclmdz_mod, ONLY : traclmdz_from_restart
23	USE carbon_cycle_mod,ONLY : carbon_cycle_tr, carbon_cycle_cpl
24
25	IMPLICIT none
26	c======================================================================
27	c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
28	c Objet: Lecture de l'etat initial pour la physique
29	c======================================================================
30	#include "dimensions.h"
31	#include "netcdf.inc"
32	#include "indicesol.h"
33	#include "dimsoil.h"
34	#include "clesphys.h"
35	#include "temps.h"
36	#include "thermcell.h"
37	#include "compbl.h"
38	c======================================================================
39	CHARACTER() fichnom
40
41	c les variables globales lues dans le fichier restart
42
43	REAL tsoil(klon,nsoilmx,nbsrf)
44	REAL tslab(klon), seaice(klon)
45	REAL qsurf(klon,nbsrf)
46	REAL qsol(klon)
47	REAL snow(klon,nbsrf)
48	REAL evap(klon,nbsrf)
49	real fder(klon)
50	REAL frugs(klon,nbsrf)
51	REAL agesno(klon,nbsrf)
52	REAL run_off_lic_0(klon)
53	REAL fractint(klon)
54	REAL trs(klon,nbtr)
55
56	CHARACTER*6 ocean_in
57	LOGICAL ok_veget_in
58
59	INTEGER longcles
60	PARAMETER ( longcles = 20 )
61	REAL clesphy0( longcles )
62	c
63	REAL xmin, xmax
64	c
65	INTEGER nid, nvarid
66	INTEGER ierr, i, nsrf, isoil ,k
67	INTEGER length
68	PARAMETER (length=100)
69	INTEGER it, iiq
70	REAL tab_cntrl(length), tabcntr0(length)
71	CHARACTER*7 str7
72	CHARACTER*2 str2
73	LOGICAL :: found
74
75	c FH1D
76	c real iolat(jjm+1)
77	real iolat(jjm+1-1/iim)
78	c
79	c Ouvrir le fichier contenant l'etat initial:
80	c
81
82
83	CALL open_startphy(fichnom)
84
85
86	c
87	c Lecture des parametres de controle:
88	c
89	CALL get_var("controle",tab_cntrl)
90
91	c
92	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
93	! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
94	! Les constantes de la physiques sont lues dans la physique seulement.
95	! Les egalites du type
96	! tab_cntrl( 5 )=clesphy0(1)
97	! sont remplacees par
98	! clesphy0(1)=tab_cntrl( 5 )
99	! On inverse aussi la logique.
100	! On remplit les tab_cntrl avec les parametres lus dans les .def
101	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
102
103	DO i = 1, length
104	tabcntr0( i ) = tab_cntrl( i )
105	ENDDO
106	c
107	tab_cntrl(1)=dtime
108	tab_cntrl(2)=radpas
109
110	c co2_ppm : value from the previous time step
111	IF (carbon_cycle_tr .OR. carbon_cycle_cpl) THEN
112	co2_ppm = tab_cntrl(3)
113	RCO2 = co2_ppm * 1.0e-06 * 44.011/28.97
114	c ELSE : keep value from .def
115	END IF
116
117	c co2_ppm0 : initial value of atmospheric CO2 (from create_etat0_limit.e .def)
118	co2_ppm0 = tab_cntrl(16)
119
120	solaire_etat0 = tab_cntrl(4)
121	tab_cntrl(5)=iflag_con
122	tab_cntrl(6)=nbapp_rad
123
124	if (cycle_diurne) tab_cntrl( 7) =1.
125	if (soil_model) tab_cntrl( 8) =1.
126	if (new_oliq) tab_cntrl( 9) =1.
127	if (ok_orodr) tab_cntrl(10) =1.
128	if (ok_orolf) tab_cntrl(11) =1.
129	if (ok_limitvrai) tab_cntrl(12) =1.
130
131
132	itau_phy = tab_cntrl(15)
133
134
135
136	IF( clesphy0(1).NE.tab_cntrl( 5 ) ) THEN
137	clesphy0(1)=tab_cntrl( 5 )
138	ENDIF
139
140	IF( clesphy0(2).NE.tab_cntrl( 6 ) ) THEN
141	clesphy0(2)=tab_cntrl( 6 )
142	ENDIF
143
144	IF( clesphy0(3).NE.tab_cntrl( 7 ) ) THEN
145	clesphy0(3)=tab_cntrl( 7 )
146	ENDIF
147
148	IF( clesphy0(4).NE.tab_cntrl( 8 ) ) THEN
149	clesphy0(4)=tab_cntrl( 8 )
150	ENDIF
151
152	IF( clesphy0(5).NE.tab_cntrl( 9 ) ) THEN
153	clesphy0(5)=tab_cntrl( 9 )
154	ENDIF
155
156	IF( clesphy0(6).NE.tab_cntrl( 10 ) ) THEN
157	clesphy0(6)=tab_cntrl( 10 )
158	ENDIF
159
160	IF( clesphy0(7).NE.tab_cntrl( 11 ) ) THEN
161	clesphy0(7)=tab_cntrl( 11 )
162	ENDIF
163
164	IF( clesphy0(8).NE.tab_cntrl( 12 ) ) THEN
165	clesphy0(8)=tab_cntrl( 12 )
166	ENDIF
167
168
169	c
170	c Lecture des latitudes (coordonnees):
171	c
172	CALL get_field("latitude",rlat)
173
174	c
175	c Lecture des longitudes (coordonnees):
176	c
177	CALL get_field("longitude",rlon)
178
179	C
180	C
181	C Lecture du masque terre mer
182	C
183	CALL get_field("masque",zmasq,found)
184	IF (.NOT. found) THEN
185	PRINT*, 'phyetat0: Le champ <masque> est absent'
186	PRINT *, 'fichier startphy non compatible avec phyetat0'
187	ENDIF
188
189
190	C Lecture des fractions pour chaque sous-surface
191	C
192	C initialisation des sous-surfaces
193	C
194	pctsrf = 0.
195	C
196	C fraction de terre
197	C
198
199	CALL get_field("FTER",pctsrf(:,is_ter),found)
200	IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FTER> est absent'
201
202	C
203	C fraction de glace de terre
204	C
205	CALL get_field("FLIC",pctsrf(:,is_lic),found)
206	IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FLIC> est absent'
207
208	C
209	C fraction d'ocean
210	C
211	CALL get_field("FOCE",pctsrf(:,is_oce),found)
212	IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FOCE> est absent'
213
214	C
215	C fraction glace de mer
216	C
217	CALL get_field("FSIC",pctsrf(:,is_sic),found)
218	IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FSIC> est absent'
219
220	C
221	C Verification de l'adequation entre le masque et les sous-surfaces
222	C
223	fractint( 1 : klon) = pctsrf(1 : klon, is_ter)
224	$ + pctsrf(1 : klon, is_lic)
225	DO i = 1 , klon
226	IF ( abs(fractint(i) - zmasq(i) ) .GT. EPSFRA ) THEN
227	WRITE(,) 'phyetat0: attention fraction terre pas ',
228	$ 'coherente ', i, zmasq(i), pctsrf(i, is_ter)
229	$ ,pctsrf(i, is_lic)
230	zmasq(i) = fractint(i)
231	ENDIF
232	END DO
233	fractint (1 : klon) = pctsrf(1 : klon, is_oce)
234	$ + pctsrf(1 : klon, is_sic)
235	DO i = 1 , klon
236	IF ( abs( fractint(i) - (1. - zmasq(i))) .GT. EPSFRA ) THEN
237	WRITE(,) 'phyetat0 attention fraction ocean pas ',
238	$ 'coherente ', i, zmasq(i) , pctsrf(i, is_oce)
239	$ ,pctsrf(i, is_sic)
240	zmasq(i) = fractint(i)
241	ENDIF
242	END DO
243
244	C
245	c Lecture des temperatures du sol:
246	c
247
248	CALL get_field("TS",ftsol(:,1),found)
249	IF (.NOT. found) THEN
250	PRINT*, 'phyetat0: Le champ <TS> est absent'
251	PRINT, ' Mais je vais essayer de lire TS*'
252	DO nsrf = 1, nbsrf
253	IF (nsrf.GT.99) THEN
254	PRINT*, "Trop de sous-mailles"
255	CALL abort
256	ENDIF
257	WRITE(str2,'(i2.2)') nsrf
258	CALL get_field("TS"//str2,ftsol(:,nsrf))
259
260	xmin = 1.0E+20
261	xmax = -1.0E+20
262	DO i = 1, klon
263	xmin = MIN(ftsol(i,nsrf),xmin)
264	xmax = MAX(ftsol(i,nsrf),xmax)
265	ENDDO
266	PRINT,'Temperature du sol TS*:', nsrf, xmin, xmax
267	ENDDO
268	ELSE
269	PRINT*, 'phyetat0: Le champ <TS> est present'
270	PRINT, ' J ignore donc les autres temperatures TS*'
271	xmin = 1.0E+20
272	xmax = -1.0E+20
273	DO i = 1, klon
274	xmin = MIN(ftsol(i,1),xmin)
275	xmax = MAX(ftsol(i,1),xmax)
276	ENDDO
277	PRINT*,'Temperature du sol <TS>', xmin, xmax
278	DO nsrf = 2, nbsrf
279	DO i = 1, klon
280	ftsol(i,nsrf) = ftsol(i,1)
281	ENDDO
282	ENDDO
283	ENDIF
284
285	c
286	c Lecture des temperatures du sol profond:
287	c
288	DO nsrf = 1, nbsrf
289	DO isoil=1, nsoilmx
290	IF (isoil.GT.99 .AND. nsrf.GT.99) THEN
291	PRINT*, "Trop de couches ou sous-mailles"
292	CALL abort
293	ENDIF
294	WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
295
296	CALL get_field('Tsoil'//str7,tsoil(:,isoil,nsrf),found)
297	IF (.NOT. found) THEN
298	PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
299	PRINT*, " Il prend donc la valeur de surface"
300	DO i=1, klon
301	tsoil(i,isoil,nsrf)=ftsol(i,nsrf)
302	ENDDO
303	ENDIF
304	ENDDO
305	ENDDO
306	c
307	c Lecture de l'humidite de l'air juste au dessus du sol:
308	c
309
310	CALL get_field("QS",qsurf(:,1),found)
311	IF (.NOT. found) THEN
312	PRINT*, 'phyetat0: Le champ <QS> est absent'
313	PRINT, ' Mais je vais essayer de lire QS*'
314	DO nsrf = 1, nbsrf
315	IF (nsrf.GT.99) THEN
316	PRINT*, "Trop de sous-mailles"
317	CALL abort
318	ENDIF
319	WRITE(str2,'(i2.2)') nsrf
320	CALL get_field("QS"//str2,qsurf(:,nsrf))
321	xmin = 1.0E+20
322	xmax = -1.0E+20
323	DO i = 1, klon
324	xmin = MIN(qsurf(i,nsrf),xmin)
325	xmax = MAX(qsurf(i,nsrf),xmax)
326	ENDDO
327	PRINT,'Humidite pres du sol QS*:', nsrf, xmin, xmax
328	ENDDO
329	ELSE
330	PRINT*, 'phyetat0: Le champ <QS> est present'
331	PRINT, ' J ignore donc les autres humidites QS*'
332	xmin = 1.0E+20
333	xmax = -1.0E+20
334	DO i = 1, klon
335	xmin = MIN(qsurf(i,1),xmin)
336	xmax = MAX(qsurf(i,1),xmax)
337	ENDDO
338	PRINT*,'Humidite pres du sol <QS>', xmin, xmax
339	DO nsrf = 2, nbsrf
340	DO i = 1, klon
341	qsurf(i,nsrf) = qsurf(i,1)
342	ENDDO
343	ENDDO
344	ENDIF
345
346	C
347	C Eau dans le sol (pour le modele de sol "bucket")
348	C
349	CALL get_field("QSOL",qsol,found)
350	IF (.NOT. found) THEN
351	PRINT*, 'phyetat0: Le champ <QSOL> est absent'
352	PRINT*, ' Valeur par defaut nulle'
353	qsol(:)=0.
354	ENDIF
355
356	xmin = 1.0E+20
357	xmax = -1.0E+20
358	DO i = 1, klon
359	xmin = MIN(qsol(i),xmin)
360	xmax = MAX(qsol(i),xmax)
361	ENDDO
362	PRINT*,'Eau dans le sol (mm) <QSOL>', xmin, xmax
363
364	c
365	c Lecture de neige au sol:
366	c
367
368	CALL get_field("SNOW",snow(:,1),found)
369	IF (.NOT. found) THEN
370	PRINT*, 'phyetat0: Le champ <SNOW> est absent'
371	PRINT, ' Mais je vais essayer de lire SNOW*'
372	DO nsrf = 1, nbsrf
373	IF (nsrf.GT.99) THEN
374	PRINT*, "Trop de sous-mailles"
375	CALL abort
376	ENDIF
377	WRITE(str2,'(i2.2)') nsrf
378	CALL get_field( "SNOW"//str2,snow(:,nsrf))
379	xmin = 1.0E+20
380	xmax = -1.0E+20
381	DO i = 1, klon
382	xmin = MIN(snow(i,nsrf),xmin)
383	xmax = MAX(snow(i,nsrf),xmax)
384	ENDDO
385	PRINT,'Neige du sol SNOW*:', nsrf, xmin, xmax
386	ENDDO
387	ELSE
388	PRINT*, 'phyetat0: Le champ <SNOW> est present'
389	PRINT, ' J ignore donc les autres neiges SNOW*'
390	xmin = 1.0E+20
391	xmax = -1.0E+20
392	DO i = 1, klon
393	xmin = MIN(snow(i,1),xmin)
394	xmax = MAX(snow(i,1),xmax)
395	ENDDO
396	PRINT*,'Neige du sol <SNOW>', xmin, xmax
397	DO nsrf = 2, nbsrf
398	DO i = 1, klon
399	snow(i,nsrf) = snow(i,1)
400	ENDDO
401	ENDDO
402	ENDIF
403	c
404	c Lecture de albedo de l'interval visible au sol:
405	c
406	CALL get_field("ALBE",falb1(:,1),found)
407	IF (.NOT. found) THEN
408	PRINT*, 'phyetat0: Le champ <ALBE> est absent'
409	PRINT, ' Mais je vais essayer de lire ALBE*'
410	DO nsrf = 1, nbsrf
411	IF (nsrf.GT.99) THEN
412	PRINT*, "Trop de sous-mailles"
413	CALL abort
414	ENDIF
415	WRITE(str2,'(i2.2)') nsrf
416	CALL get_field("ALBE"//str2,falb1(:,nsrf))
417	xmin = 1.0E+20
418	xmax = -1.0E+20
419	DO i = 1, klon
420	xmin = MIN(falb1(i,nsrf),xmin)
421	xmax = MAX(falb1(i,nsrf),xmax)
422	ENDDO
423	PRINT,'Albedo du sol ALBE*:', nsrf, xmin, xmax
424	ENDDO
425	ELSE
426	PRINT*, 'phyetat0: Le champ <ALBE> est present'
427	PRINT, ' J ignore donc les autres ALBE*'
428	xmin = 1.0E+20
429	xmax = -1.0E+20
430	DO i = 1, klon
431	xmin = MIN(falb1(i,1),xmin)
432	xmax = MAX(falb1(i,1),xmax)
433	ENDDO
434	PRINT*,'Neige du sol <ALBE>', xmin, xmax
435	DO nsrf = 2, nbsrf
436	DO i = 1, klon
437	falb1(i,nsrf) = falb1(i,1)
438	ENDDO
439	ENDDO
440	ENDIF
441
442	c
443	c Lecture de albedo au sol dans l'interval proche infra-rouge:
444	c
445	CALL get_field("ALBLW",falb2(:,1),found)
446	IF (.NOT. found) THEN
447	PRINT*, 'phyetat0: Le champ <ALBLW> est absent'
448	PRINT, ' Mais je vais prendre ALBE*'
449	DO nsrf = 1, nbsrf
450	DO i = 1, klon
451	falb2(i,nsrf) = falb1(i,nsrf)
452	ENDDO
453	ENDDO
454	ELSE
455	PRINT*, 'phyetat0: Le champ <ALBLW> est present'
456	PRINT, ' J ignore donc les autres ALBLW*'
457	xmin = 1.0E+20
458	xmax = -1.0E+20
459	DO i = 1, klon
460	xmin = MIN(falb2(i,1),xmin)
461	xmax = MAX(falb2(i,1),xmax)
462	ENDDO
463	PRINT*,'Neige du sol <ALBLW>', xmin, xmax
464	DO nsrf = 2, nbsrf
465	DO i = 1, klon
466	falb2(i,nsrf) = falb2(i,1)
467	ENDDO
468	ENDDO
469	ENDIF
470	c
471	c Lecture de evaporation:
472	c
473	CALL get_field("EVAP",evap(:,1),found)
474	IF (.NOT. found) THEN
475	PRINT*, 'phyetat0: Le champ <EVAP> est absent'
476	PRINT, ' Mais je vais essayer de lire EVAP*'
477	DO nsrf = 1, nbsrf
478	IF (nsrf.GT.99) THEN
479	PRINT*, "Trop de sous-mailles"
480	CALL abort
481	ENDIF
482	WRITE(str2,'(i2.2)') nsrf
483	CALL get_field("EVAP"//str2, evap(:,nsrf))
484	xmin = 1.0E+20
485	xmax = -1.0E+20
486	DO i = 1, klon
487	xmin = MIN(evap(i,nsrf),xmin)
488	xmax = MAX(evap(i,nsrf),xmax)
489	ENDDO
490	PRINT,'evap du sol EVAP*:', nsrf, xmin, xmax
491	ENDDO
492	ELSE
493	PRINT*, 'phyetat0: Le champ <EVAP> est present'
494	PRINT, ' J ignore donc les autres EVAP*'
495	xmin = 1.0E+20
496	xmax = -1.0E+20
497	DO i = 1, klon
498	xmin = MIN(evap(i,1),xmin)
499	xmax = MAX(evap(i,1),xmax)
500	ENDDO
501	PRINT*,'Evap du sol <EVAP>', xmin, xmax
502	DO nsrf = 2, nbsrf
503	DO i = 1, klon
504	evap(i,nsrf) = evap(i,1)
505	ENDDO
506	ENDDO
507	ENDIF
508	c
509	c Lecture precipitation liquide:
510	c
511	CALL get_field("rain_f",rain_fall)
512	xmin = 1.0E+20
513	xmax = -1.0E+20
514	DO i = 1, klon
515	xmin = MIN(rain_fall(i),xmin)
516	xmax = MAX(rain_fall(i),xmax)
517	ENDDO
518	PRINT*,'Precipitation liquide rain_f:', xmin, xmax
519	c
520	c Lecture precipitation solide:
521	c
522	CALL get_field("snow_f",snow_fall)
523	xmin = 1.0E+20
524	xmax = -1.0E+20
525	DO i = 1, klon
526	xmin = MIN(snow_fall(i),xmin)
527	xmax = MAX(snow_fall(i),xmax)
528	ENDDO
529	PRINT*,'Precipitation solide snow_f:', xmin, xmax
530	c
531	c Lecture rayonnement solaire au sol:
532	c
533	CALL get_field("solsw",solsw,found)
534	IF (.NOT. found) THEN
535	PRINT*, 'phyetat0: Le champ <solsw> est absent'
536	PRINT*, 'mis a zero'
537	solsw(:) = 0.
538	ENDIF
539	xmin = 1.0E+20
540	xmax = -1.0E+20
541	DO i = 1, klon
542	xmin = MIN(solsw(i),xmin)
543	xmax = MAX(solsw(i),xmax)
544	ENDDO
545	PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
546	c
547	c Lecture rayonnement IF au sol:
548	c
549	CALL get_field("sollw",sollw,found)
550	IF (.NOT. found) THEN
551	PRINT*, 'phyetat0: Le champ <sollw> est absent'
552	PRINT*, 'mis a zero'
553	sollw = 0.
554	ENDIF
555	xmin = 1.0E+20
556	xmax = -1.0E+20
557	DO i = 1, klon
558	xmin = MIN(sollw(i),xmin)
559	xmax = MAX(sollw(i),xmax)
560	ENDDO
561	PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
562
563	c
564	c Lecture derive des flux:
565	c
566	CALL get_field("fder",fder,found)
567	IF (.NOT. found) THEN
568	PRINT*, 'phyetat0: Le champ <fder> est absent'
569	PRINT*, 'mis a zero'
570	fder = 0.
571	ENDIF
572	xmin = 1.0E+20
573	xmax = -1.0E+20
574	DO i = 1, klon
575	xmin = MIN(fder(i),xmin)
576	xmax = MAX(fder(i),xmax)
577	ENDDO
578	PRINT*,'Derive des flux fder:', xmin, xmax
579
580	c
581	c Lecture du rayonnement net au sol:
582	c
583	CALL get_field("RADS",radsol)
584	xmin = 1.0E+20
585	xmax = -1.0E+20
586	DO i = 1, klon
587	xmin = MIN(radsol(i),xmin)
588	xmax = MAX(radsol(i),xmax)
589	ENDDO
590	PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
591	c
592	c Lecture de la longueur de rugosite
593	c
594	c
595	CALL get_field("RUG",frugs(:,1),found)
596	IF (.NOT. found) THEN
597	PRINT*, 'phyetat0: Le champ <RUG> est absent'
598	PRINT, ' Mais je vais essayer de lire RUG*'
599	DO nsrf = 1, nbsrf
600	IF (nsrf.GT.99) THEN
601	PRINT*, "Trop de sous-mailles"
602	CALL abort
603	ENDIF
604	WRITE(str2,'(i2.2)') nsrf
605	CALL get_field("RUG"//str2,frugs(:,nsrf))
606	xmin = 1.0E+20
607	xmax = -1.0E+20
608	DO i = 1, klon
609	xmin = MIN(frugs(i,nsrf),xmin)
610	xmax = MAX(frugs(i,nsrf),xmax)
611	ENDDO
612	PRINT,'rugosite du sol RUG*:', nsrf, xmin, xmax
613	ENDDO
614	ELSE
615	PRINT*, 'phyetat0: Le champ <RUG> est present'
616	PRINT, ' J ignore donc les autres RUG*'
617	xmin = 1.0E+20
618	xmax = -1.0E+20
619	DO i = 1, klon
620	xmin = MIN(frugs(i,1),xmin)
621	xmax = MAX(frugs(i,1),xmax)
622	ENDDO
623	PRINT*,'rugosite <RUG>', xmin, xmax
624	DO nsrf = 2, nbsrf
625	DO i = 1, klon
626	frugs(i,nsrf) = frugs(i,1)
627	ENDDO
628	ENDDO
629	ENDIF
630
631	c
632	c Lecture de l'age de la neige:
633	c
634	CALL get_field("AGESNO",agesno(:,1),found)
635	IF (.NOT. found) THEN
636	PRINT*, 'phyetat0: Le champ <AGESNO> est absent'
637	PRINT, ' Mais je vais essayer de lire AGESNO*'
638	DO nsrf = 1, nbsrf
639	IF (nsrf.GT.99) THEN
640	PRINT*, "Trop de sous-mailles"
641	CALL abort
642	ENDIF
643	WRITE(str2,'(i2.2)') nsrf
644	CALL get_field("AGESNO"//str2,agesno(:,nsrf),found)
645	IF (.NOT. found) THEN
646	PRINT*, "phyetat0: Le champ <AGESNO"//str2//"> est absent"
647	agesno = 50.0
648	ENDIF
649	xmin = 1.0E+20
650	xmax = -1.0E+20
651	DO i = 1, klon
652	xmin = MIN(agesno(i,nsrf),xmin)
653	xmax = MAX(agesno(i,nsrf),xmax)
654	ENDDO
655	PRINT,'Age de la neige AGESNO*:', nsrf, xmin, xmax
656	ENDDO
657	ELSE
658	PRINT*, 'phyetat0: Le champ <AGESNO> est present'
659	PRINT, ' J ignore donc les autres AGESNO*'
660	xmin = 1.0E+20
661	xmax = -1.0E+20
662	DO i = 1, klon
663	xmin = MIN(agesno(i,1),xmin)
664	xmax = MAX(agesno(i,1),xmax)
665	ENDDO
666	PRINT*,'Age de la neige <AGESNO>', xmin, xmax
667	DO nsrf = 2, nbsrf
668	DO i = 1, klon
669	agesno(i,nsrf) = agesno(i,1)
670	ENDDO
671	ENDDO
672	ENDIF
673
674	c
675	CALL get_field("ZMEA", zmea)
676	xmin = 1.0E+20
677	xmax = -1.0E+20
678	DO i = 1, klon
679	xmin = MIN(zmea(i),xmin)
680	xmax = MAX(zmea(i),xmax)
681	ENDDO
682	PRINT*,'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
683	c
684	c
685	CALL get_field("ZSTD",zstd)
686	xmin = 1.0E+20
687	xmax = -1.0E+20
688	DO i = 1, klon
689	xmin = MIN(zstd(i),xmin)
690	xmax = MAX(zstd(i),xmax)
691	ENDDO
692	PRINT*,'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
693	c
694	c
695	CALL get_field("ZSIG",zsig)
696	xmin = 1.0E+20
697	xmax = -1.0E+20
698	DO i = 1, klon
699	xmin = MIN(zsig(i),xmin)
700	xmax = MAX(zsig(i),xmax)
701	ENDDO
702	PRINT*,'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
703	c
704	c
705	CALL get_field("ZGAM",zgam)
706	xmin = 1.0E+20
707	xmax = -1.0E+20
708	DO i = 1, klon
709	xmin = MIN(zgam(i),xmin)
710	xmax = MAX(zgam(i),xmax)
711	ENDDO
712	PRINT*,'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
713	c
714	c
715	CALL get_field("ZTHE",zthe)
716	xmin = 1.0E+20
717	xmax = -1.0E+20
718	DO i = 1, klon
719	xmin = MIN(zthe(i),xmin)
720	xmax = MAX(zthe(i),xmax)
721	ENDDO
722	PRINT*,'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
723	c
724	c
725	CALL get_field("ZPIC",zpic)
726	xmin = 1.0E+20
727	xmax = -1.0E+20
728	DO i = 1, klon
729	xmin = MIN(zpic(i),xmin)
730	xmax = MAX(zpic(i),xmax)
731	ENDDO
732	PRINT*,'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
733	c
734	CALL get_field("ZVAL",zval)
735	xmin = 1.0E+20
736	xmax = -1.0E+20
737	DO i = 1, klon
738	xmin = MIN(zval(i),xmin)
739	xmax = MAX(zval(i),xmax)
740	ENDDO
741	PRINT*,'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
742	c
743	c
744	CALL get_field("RUGSREL",rugoro)
745	xmin = 1.0E+20
746	xmax = -1.0E+20
747	DO i = 1, klon
748	xmin = MIN(rugoro(i),xmin)
749	xmax = MAX(rugoro(i),xmax)
750	ENDDO
751	PRINT*,'Rugosite relief (ecart-type) rugsrel:', xmin, xmax
752	c
753	c
754
755	c
756	ancien_ok = .TRUE.
757
758	CALL get_field("TANCIEN",t_ancien,found)
759	IF (.NOT. found) THEN
760	PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
761	PRINT*, "Depart legerement fausse. Mais je continue"
762	ancien_ok = .FALSE.
763	ENDIF
764
765
766	CALL get_field("QANCIEN",q_ancien,found)
767	IF (.NOT. found) THEN
768	PRINT*, "phyetat0: Le champ <QANCIEN> est absent"
769	PRINT*, "Depart legerement fausse. Mais je continue"
770	ancien_ok = .FALSE.
771	ENDIF
772
773	u_ancien = 0.0 !AXC: We don't have u_ancien and v_ancien in the start
774	v_ancien = 0.0 !AXC: files, therefore they have to be initialized.
775	c
776
777	clwcon=0.
778	CALL get_field("CLWCON",clwcon(:,1),found)
779	IF (.NOT. found) THEN
780	PRINT*, "phyetat0: Le champ CLWCON est absent"
781	PRINT*, "Depart legerement fausse. Mais je continue"
782	ENDIF
783	xmin = 1.0E+20
784	xmax = -1.0E+20
785	xmin = MINval(clwcon)
786	xmax = MAXval(clwcon)
787	PRINT*,'Eau liquide convective (ecart-type) clwcon:', xmin, xmax
788	c
789	rnebcon = 0.
790	CALL get_field("RNEBCON",rnebcon(:,1),found)
791	IF (.NOT. found) THEN
792	PRINT*, "phyetat0: Le champ RNEBCON est absent"
793	PRINT*, "Depart legerement fausse. Mais je continue"
794	ENDIF
795	xmin = 1.0E+20
796	xmax = -1.0E+20
797	xmin = MINval(rnebcon)
798	xmax = MAXval(rnebcon)
799	PRINT*,'Nebulosite convective (ecart-type) rnebcon:', xmin, xmax
800
801	c
802	c Lecture ratqs
803	c
804	ratqs=0.
805	CALL get_field("RATQS",ratqs(:,1),found)
806	IF (.NOT. found) THEN
807	PRINT*, "phyetat0: Le champ <RATQS> est absent"
808	PRINT*, "Depart legerement fausse. Mais je continue"
809	ENDIF
810	xmin = 1.0E+20
811	xmax = -1.0E+20
812	xmin = MINval(ratqs)
813	xmax = MAXval(ratqs)
814	PRINT*,'(ecart-type) ratqs:', xmin, xmax
815	c
816	c Lecture run_off_lic_0
817	c
818	CALL get_field("RUNOFFLIC0",run_off_lic_0,found)
819	IF (.NOT. found) THEN
820	PRINT*, "phyetat0: Le champ <RUNOFFLIC0> est absent"
821	PRINT*, "Depart legerement fausse. Mais je continue"
822	run_off_lic_0 = 0.
823	ENDIF
824	xmin = 1.0E+20
825	xmax = -1.0E+20
826	xmin = MINval(run_off_lic_0)
827	xmax = MAXval(run_off_lic_0)
828	PRINT*,'(ecart-type) run_off_lic_0:', xmin, xmax
829
830
831	c Lecture de l'energie cinetique turbulente
832	c
833
834	IF (iflag_pbl>1) then
835	DO nsrf = 1, nbsrf
836	IF (nsrf.GT.99) THEN
837	PRINT*, "Trop de sous-mailles"
838	CALL abort
839	ENDIF
840	WRITE(str2,'(i2.2)') nsrf
841	CALL get_field("TKE"//str2,pbl_tke(:,1:klev,nsrf),found)
842	IF (.NOT. found) THEN
843	PRINT*, "phyetat0: <TKE"//str2//"> est absent"
844	pbl_tke(:,:,nsrf)=1.e-8
845	ENDIF
846	xmin = 1.0E+20
847	xmax = -1.0E+20
848	DO k = 1, klev
849	DO i = 1, klon
850	xmin = MIN(pbl_tke(i,k,nsrf),xmin)
851	xmax = MAX(pbl_tke(i,k,nsrf),xmax)
852	ENDDO
853	ENDDO
854	PRINT,'Temperature du sol TKE*:', nsrf, xmin, xmax
855	ENDDO
856	ENDIF
857	c
858	c zmax0
859	CALL get_field("ZMAX0",zmax0,found)
860	IF (.NOT. found) THEN
861	PRINT*, "phyetat0: Le champ <ZMAX0> est absent"
862	PRINT*, "Depart legerement fausse. Mais je continue"
863	zmax0=40.
864	ENDIF
865	xmin = 1.0E+20
866	xmax = -1.0E+20
867	xmin = MINval(zmax0)
868	xmax = MAXval(zmax0)
869	PRINT*,'(ecart-type) zmax0:', xmin, xmax
870	c
871	c f0(ig)=1.e-5
872	c f0
873	CALL get_field("F0",f0,found)
874	IF (.NOT. found) THEN
875	PRINT*, "phyetat0: Le champ <f0> est absent"
876	PRINT*, "Depart legerement fausse. Mais je continue"
877	f0=1.e-5
878	ENDIF
879	xmin = 1.0E+20
880	xmax = -1.0E+20
881	xmin = MINval(f0)
882	xmax = MAXval(f0)
883	PRINT*,'(ecart-type) f0:', xmin, xmax
884	c
885	c ema_work1
886	c
887	CALL get_field("EMA_WORK1",ema_work1,found)
888	IF (.NOT. found) THEN
889	PRINT*, "phyetat0: Le champ <EMA_WORK1> est absent"
890	PRINT*, "Depart legerement fausse. Mais je continue"
891	ema_work1=0.
892	ELSE
893	xmin = 1.0E+20
894	xmax = -1.0E+20
895	DO k = 1, klev
896	DO i = 1, klon
897	xmin = MIN(ema_work1(i,k),xmin)
898	xmax = MAX(ema_work1(i,k),xmax)
899	ENDDO
900	ENDDO
901	PRINT*,'ema_work1:', xmin, xmax
902	ENDIF
903	c
904	c ema_work2
905	c
906	CALL get_field("EMA_WORK2",ema_work2,found)
907	IF (.NOT. found) THEN
908	PRINT*, "phyetat0: Le champ <EMA_WORK2> est absent"
909	PRINT*, "Depart legerement fausse. Mais je continue"
910	ema_work2=0.
911	ELSE
912	xmin = 1.0E+20
913	xmax = -1.0E+20
914	DO k = 1, klev
915	DO i = 1, klon
916	xmin = MIN(ema_work2(i,k),xmin)
917	xmax = MAX(ema_work2(i,k),xmax)
918	ENDDO
919	ENDDO
920	PRINT*,'ema_work2:', xmin, xmax
921	ENDIF
922	c
923	c wake_deltat
924	c
925	CALL get_field("WAKE_DELTAT",wake_deltat,found)
926	IF (.NOT. found) THEN
927	PRINT*, "phyetat0: Le champ <WAKE_DELTAT> est absent"
928	PRINT*, "Depart legerement fausse. Mais je continue"
929	wake_deltat=0.
930	ELSE
931	xmin = 1.0E+20
932	xmax = -1.0E+20
933	DO k = 1, klev
934	DO i = 1, klon
935	xmin = MIN(wake_deltat(i,k),xmin)
936	xmax = MAX(wake_deltat(i,k),xmax)
937	ENDDO
938	ENDDO
939	PRINT*,'wake_deltat:', xmin, xmax
940	ENDIF
941	c
942	c wake_deltaq
943	c
944	CALL get_field("WAKE_DELTAQ",wake_deltaq,found)
945	IF (.NOT. found) THEN
946	PRINT*, "phyetat0: Le champ <WAKE_DELTAQ> est absent"
947	PRINT*, "Depart legerement fausse. Mais je continue"
948	wake_deltaq=0.
949	ELSE
950	xmin = 1.0E+20
951	xmax = -1.0E+20
952	DO k = 1, klev
953	DO i = 1, klon
954	xmin = MIN(wake_deltaq(i,k),xmin)
955	xmax = MAX(wake_deltaq(i,k),xmax)
956	ENDDO
957	ENDDO
958	PRINT*,'wake_deltaq:', xmin, xmax
959	ENDIF
960	c
961	c wake_s
962	c
963	CALL get_field("WAKE_S",wake_s,found)
964	IF (.NOT. found) THEN
965	PRINT*, "phyetat0: Le champ <WAKE_S> est absent"
966	PRINT*, "Depart legerement fausse. Mais je continue"
967	wake_s=0.
968	ENDIF
969	xmin = 1.0E+20
970	xmax = -1.0E+20
971	xmin = MINval(wake_s)
972	xmax = MAXval(wake_s)
973	PRINT*,'(ecart-type) wake_s:', xmin, xmax
974	c
975	c wake_cstar
976	c
977	CALL get_field("WAKE_CSTAR",wake_cstar,found)
978	IF (.NOT. found) THEN
979	PRINT*, "phyetat0: Le champ <WAKE_CSTAR> est absent"
980	PRINT*, "Depart legerement fausse. Mais je continue"
981	wake_cstar=0.
982	ENDIF
983	xmin = 1.0E+20
984	xmax = -1.0E+20
985	xmin = MINval(wake_cstar)
986	xmax = MAXval(wake_cstar)
987	PRINT*,'(ecart-type) wake_cstar:', xmin, xmax
988	c
989	c wake_fip
990	c
991	CALL get_field("WAKE_FIP",wake_fip,found)
992	IF (.NOT. found) THEN
993	PRINT*, "phyetat0: Le champ <WAKE_FIP> est absent"
994	PRINT*, "Depart legerement fausse. Mais je continue"
995	wake_fip=0.
996	ENDIF
997	xmin = 1.0E+20
998	xmax = -1.0E+20
999	xmin = MINval(wake_fip)
1000	xmax = MAXval(wake_fip)
1001	PRINT*,'(ecart-type) wake_fip:', xmin, xmax
1002	c
1003	c Read and send field trs to traclmdz
1004	c
1005	IF (type_trac == 'lmdz') THEN
1006	DO it=1,nbtr
1007	iiq=niadv(it+2)
1008	CALL get_field("trs_"//tname(iiq),trs(:,it),found)
1009	IF (.NOT. found) THEN
1010	PRINT*,
1011	$ "phyetat0: Le champ <trs_"//tname(iiq)//"> est absent"
1012	PRINT*, "Depart legerement fausse. Mais je continue"
1013	trs(:,it) = 0.
1014	ENDIF
1015	xmin = 1.0E+20
1016	xmax = -1.0E+20
1017	xmin = MINval(trs(:,it))
1018	xmax = MAXval(trs(:,it))
1019	PRINT*,"(ecart-type) trs_"//tname(iiq)//" :", xmin, xmax
1020
1021	END DO
1022
1023	CALL traclmdz_from_restart(trs)
1024	END IF
1025
1026
1027	c on ferme le fichier
1028	CALL close_startphy
1029
1030	CALL init_iophy_new(rlat,rlon)
1031
1032
1033	c
1034	c Initialize module pbl_surface_mod
1035	c
1036	CALL pbl_surface_init(qsol, fder, snow, qsurf,
1037	$ evap, frugs, agesno, tsoil)
1038
1039	c Initialize module ocean_cpl_mod for the case of coupled ocean
1040	IF ( type_ocean == 'couple' ) THEN
1041	CALL ocean_cpl_init(dtime, rlon, rlat)
1042	ENDIF
1043	c
1044	c Initilialize module fonte_neige_mod
1045	c
1046	CALL fonte_neige_init(run_off_lic_0)
1047
1048
1049	RETURN
1050	END

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

Download in other formats:

Original Format