Context Navigation

phyetat0.F @ 1292

Last change on this file since 1292 was 1279, checked in by Laurent Fairhead, 15 years ago
Merged LMDZ4-dev branch changes r1241:1278 into the trunk Running trunk and LMDZ4-dev in LMDZOR configuration on local machine (sequential) and SX8 (4-proc) yields identical results (restart and restartphy are identical binarily) Log history from r1241 to r1278 is available by switching to source:LMDZ4/branches/LMDZ4-dev-20091210
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	ENDIF
231	END DO
232	fractint (1 : klon) = pctsrf(1 : klon, is_oce)
233	$ + pctsrf(1 : klon, is_sic)
234	DO i = 1 , klon
235	IF ( abs( fractint(i) - (1. - zmasq(i))) .GT. EPSFRA ) THEN
236	WRITE(,) 'phyetat0 attention fraction ocean pas ',
237	$ 'coherente ', i, zmasq(i) , pctsrf(i, is_oce)
238	$ ,pctsrf(i, is_sic)
239	ENDIF
240	END DO
241
242	C
243	c Lecture des temperatures du sol:
244	c
245
246	CALL get_field("TS",ftsol(:,1),found)
247	IF (.NOT. found) THEN
248	PRINT*, 'phyetat0: Le champ <TS> est absent'
249	PRINT, ' Mais je vais essayer de lire TS*'
250	DO nsrf = 1, nbsrf
251	IF (nsrf.GT.99) THEN
252	PRINT*, "Trop de sous-mailles"
253	CALL abort
254	ENDIF
255	WRITE(str2,'(i2.2)') nsrf
256	CALL get_field("TS"//str2,ftsol(:,nsrf))
257
258	xmin = 1.0E+20
259	xmax = -1.0E+20
260	DO i = 1, klon
261	xmin = MIN(ftsol(i,nsrf),xmin)
262	xmax = MAX(ftsol(i,nsrf),xmax)
263	ENDDO
264	PRINT,'Temperature du sol TS*:', nsrf, xmin, xmax
265	ENDDO
266	ELSE
267	PRINT*, 'phyetat0: Le champ <TS> est present'
268	PRINT, ' J ignore donc les autres temperatures TS*'
269	xmin = 1.0E+20
270	xmax = -1.0E+20
271	DO i = 1, klon
272	xmin = MIN(ftsol(i,1),xmin)
273	xmax = MAX(ftsol(i,1),xmax)
274	ENDDO
275	PRINT*,'Temperature du sol <TS>', xmin, xmax
276	DO nsrf = 2, nbsrf
277	DO i = 1, klon
278	ftsol(i,nsrf) = ftsol(i,1)
279	ENDDO
280	ENDDO
281	ENDIF
282
283	c
284	c Lecture des temperatures du sol profond:
285	c
286	DO nsrf = 1, nbsrf
287	DO isoil=1, nsoilmx
288	IF (isoil.GT.99 .AND. nsrf.GT.99) THEN
289	PRINT*, "Trop de couches ou sous-mailles"
290	CALL abort
291	ENDIF
292	WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
293
294	CALL get_field('Tsoil'//str7,tsoil(:,isoil,nsrf),found)
295	IF (.NOT. found) THEN
296	PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
297	PRINT*, " Il prend donc la valeur de surface"
298	DO i=1, klon
299	tsoil(i,isoil,nsrf)=ftsol(i,nsrf)
300	ENDDO
301	ENDIF
302	ENDDO
303	ENDDO
304	c
305	c Lecture de l'humidite de l'air juste au dessus du sol:
306	c
307
308	CALL get_field("QS",qsurf(:,1),found)
309	IF (.NOT. found) THEN
310	PRINT*, 'phyetat0: Le champ <QS> est absent'
311	PRINT, ' Mais je vais essayer de lire QS*'
312	DO nsrf = 1, nbsrf
313	IF (nsrf.GT.99) THEN
314	PRINT*, "Trop de sous-mailles"
315	CALL abort
316	ENDIF
317	WRITE(str2,'(i2.2)') nsrf
318	CALL get_field("QS"//str2,qsurf(:,nsrf))
319	xmin = 1.0E+20
320	xmax = -1.0E+20
321	DO i = 1, klon
322	xmin = MIN(qsurf(i,nsrf),xmin)
323	xmax = MAX(qsurf(i,nsrf),xmax)
324	ENDDO
325	PRINT,'Humidite pres du sol QS*:', nsrf, xmin, xmax
326	ENDDO
327	ELSE
328	PRINT*, 'phyetat0: Le champ <QS> est present'
329	PRINT, ' J ignore donc les autres humidites QS*'
330	xmin = 1.0E+20
331	xmax = -1.0E+20
332	DO i = 1, klon
333	xmin = MIN(qsurf(i,1),xmin)
334	xmax = MAX(qsurf(i,1),xmax)
335	ENDDO
336	PRINT*,'Humidite pres du sol <QS>', xmin, xmax
337	DO nsrf = 2, nbsrf
338	DO i = 1, klon
339	qsurf(i,nsrf) = qsurf(i,1)
340	ENDDO
341	ENDDO
342	ENDIF
343
344	C
345	C Eau dans le sol (pour le modele de sol "bucket")
346	C
347	CALL get_field("QSOL",qsol,found)
348	IF (.NOT. found) THEN
349	PRINT*, 'phyetat0: Le champ <QSOL> est absent'
350	PRINT*, ' Valeur par defaut nulle'
351	qsol(:)=0.
352	ENDIF
353
354	xmin = 1.0E+20
355	xmax = -1.0E+20
356	DO i = 1, klon
357	xmin = MIN(qsol(i),xmin)
358	xmax = MAX(qsol(i),xmax)
359	ENDDO
360	PRINT*,'Eau dans le sol (mm) <QSOL>', xmin, xmax
361
362	c
363	c Lecture de neige au sol:
364	c
365
366	CALL get_field("SNOW",snow(:,1),found)
367	IF (.NOT. found) THEN
368	PRINT*, 'phyetat0: Le champ <SNOW> est absent'
369	PRINT, ' Mais je vais essayer de lire SNOW*'
370	DO nsrf = 1, nbsrf
371	IF (nsrf.GT.99) THEN
372	PRINT*, "Trop de sous-mailles"
373	CALL abort
374	ENDIF
375	WRITE(str2,'(i2.2)') nsrf
376	CALL get_field( "SNOW"//str2,snow(:,nsrf))
377	xmin = 1.0E+20
378	xmax = -1.0E+20
379	DO i = 1, klon
380	xmin = MIN(snow(i,nsrf),xmin)
381	xmax = MAX(snow(i,nsrf),xmax)
382	ENDDO
383	PRINT,'Neige du sol SNOW*:', nsrf, xmin, xmax
384	ENDDO
385	ELSE
386	PRINT*, 'phyetat0: Le champ <SNOW> est present'
387	PRINT, ' J ignore donc les autres neiges SNOW*'
388	xmin = 1.0E+20
389	xmax = -1.0E+20
390	DO i = 1, klon
391	xmin = MIN(snow(i,1),xmin)
392	xmax = MAX(snow(i,1),xmax)
393	ENDDO
394	PRINT*,'Neige du sol <SNOW>', xmin, xmax
395	DO nsrf = 2, nbsrf
396	DO i = 1, klon
397	snow(i,nsrf) = snow(i,1)
398	ENDDO
399	ENDDO
400	ENDIF
401	c
402	c Lecture de albedo de l'interval visible au sol:
403	c
404	CALL get_field("ALBE",falb1(:,1),found)
405	IF (.NOT. found) THEN
406	PRINT*, 'phyetat0: Le champ <ALBE> est absent'
407	PRINT, ' Mais je vais essayer de lire ALBE*'
408	DO nsrf = 1, nbsrf
409	IF (nsrf.GT.99) THEN
410	PRINT*, "Trop de sous-mailles"
411	CALL abort
412	ENDIF
413	WRITE(str2,'(i2.2)') nsrf
414	CALL get_field("ALBE"//str2,falb1(:,nsrf))
415	xmin = 1.0E+20
416	xmax = -1.0E+20
417	DO i = 1, klon
418	xmin = MIN(falb1(i,nsrf),xmin)
419	xmax = MAX(falb1(i,nsrf),xmax)
420	ENDDO
421	PRINT,'Albedo du sol ALBE*:', nsrf, xmin, xmax
422	ENDDO
423	ELSE
424	PRINT*, 'phyetat0: Le champ <ALBE> est present'
425	PRINT, ' J ignore donc les autres ALBE*'
426	xmin = 1.0E+20
427	xmax = -1.0E+20
428	DO i = 1, klon
429	xmin = MIN(falb1(i,1),xmin)
430	xmax = MAX(falb1(i,1),xmax)
431	ENDDO
432	PRINT*,'Neige du sol <ALBE>', xmin, xmax
433	DO nsrf = 2, nbsrf
434	DO i = 1, klon
435	falb1(i,nsrf) = falb1(i,1)
436	ENDDO
437	ENDDO
438	ENDIF
439
440	c
441	c Lecture de albedo au sol dans l'interval proche infra-rouge:
442	c
443	CALL get_field("ALBLW",falb2(:,1),found)
444	IF (.NOT. found) THEN
445	PRINT*, 'phyetat0: Le champ <ALBLW> est absent'
446	PRINT, ' Mais je vais prendre ALBE*'
447	DO nsrf = 1, nbsrf
448	DO i = 1, klon
449	falb2(i,nsrf) = falb1(i,nsrf)
450	ENDDO
451	ENDDO
452	ELSE
453	PRINT*, 'phyetat0: Le champ <ALBLW> est present'
454	PRINT, ' J ignore donc les autres ALBLW*'
455	xmin = 1.0E+20
456	xmax = -1.0E+20
457	DO i = 1, klon
458	xmin = MIN(falb2(i,1),xmin)
459	xmax = MAX(falb2(i,1),xmax)
460	ENDDO
461	PRINT*,'Neige du sol <ALBLW>', xmin, xmax
462	DO nsrf = 2, nbsrf
463	DO i = 1, klon
464	falb2(i,nsrf) = falb2(i,1)
465	ENDDO
466	ENDDO
467	ENDIF
468	c
469	c Lecture de evaporation:
470	c
471	CALL get_field("EVAP",evap(:,1),found)
472	IF (.NOT. found) THEN
473	PRINT*, 'phyetat0: Le champ <EVAP> est absent'
474	PRINT, ' Mais je vais essayer de lire EVAP*'
475	DO nsrf = 1, nbsrf
476	IF (nsrf.GT.99) THEN
477	PRINT*, "Trop de sous-mailles"
478	CALL abort
479	ENDIF
480	WRITE(str2,'(i2.2)') nsrf
481	CALL get_field("EVAP"//str2, evap(:,nsrf))
482	xmin = 1.0E+20
483	xmax = -1.0E+20
484	DO i = 1, klon
485	xmin = MIN(evap(i,nsrf),xmin)
486	xmax = MAX(evap(i,nsrf),xmax)
487	ENDDO
488	PRINT,'evap du sol EVAP*:', nsrf, xmin, xmax
489	ENDDO
490	ELSE
491	PRINT*, 'phyetat0: Le champ <EVAP> est present'
492	PRINT, ' J ignore donc les autres EVAP*'
493	xmin = 1.0E+20
494	xmax = -1.0E+20
495	DO i = 1, klon
496	xmin = MIN(evap(i,1),xmin)
497	xmax = MAX(evap(i,1),xmax)
498	ENDDO
499	PRINT*,'Evap du sol <EVAP>', xmin, xmax
500	DO nsrf = 2, nbsrf
501	DO i = 1, klon
502	evap(i,nsrf) = evap(i,1)
503	ENDDO
504	ENDDO
505	ENDIF
506	c
507	c Lecture precipitation liquide:
508	c
509	CALL get_field("rain_f",rain_fall)
510	xmin = 1.0E+20
511	xmax = -1.0E+20
512	DO i = 1, klon
513	xmin = MIN(rain_fall(i),xmin)
514	xmax = MAX(rain_fall(i),xmax)
515	ENDDO
516	PRINT*,'Precipitation liquide rain_f:', xmin, xmax
517	c
518	c Lecture precipitation solide:
519	c
520	CALL get_field("snow_f",snow_fall)
521	xmin = 1.0E+20
522	xmax = -1.0E+20
523	DO i = 1, klon
524	xmin = MIN(snow_fall(i),xmin)
525	xmax = MAX(snow_fall(i),xmax)
526	ENDDO
527	PRINT*,'Precipitation solide snow_f:', xmin, xmax
528	c
529	c Lecture rayonnement solaire au sol:
530	c
531	CALL get_field("solsw",solsw,found)
532	IF (.NOT. found) THEN
533	PRINT*, 'phyetat0: Le champ <solsw> est absent'
534	PRINT*, 'mis a zero'
535	solsw(:) = 0.
536	ENDIF
537	xmin = 1.0E+20
538	xmax = -1.0E+20
539	DO i = 1, klon
540	xmin = MIN(solsw(i),xmin)
541	xmax = MAX(solsw(i),xmax)
542	ENDDO
543	PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
544	c
545	c Lecture rayonnement IF au sol:
546	c
547	CALL get_field("sollw",sollw,found)
548	IF (.NOT. found) THEN
549	PRINT*, 'phyetat0: Le champ <sollw> est absent'
550	PRINT*, 'mis a zero'
551	sollw = 0.
552	ENDIF
553	xmin = 1.0E+20
554	xmax = -1.0E+20
555	DO i = 1, klon
556	xmin = MIN(sollw(i),xmin)
557	xmax = MAX(sollw(i),xmax)
558	ENDDO
559	PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
560
561	c
562	c Lecture derive des flux:
563	c
564	CALL get_field("fder",fder,found)
565	IF (.NOT. found) THEN
566	PRINT*, 'phyetat0: Le champ <fder> est absent'
567	PRINT*, 'mis a zero'
568	fder = 0.
569	ENDIF
570	xmin = 1.0E+20
571	xmax = -1.0E+20
572	DO i = 1, klon
573	xmin = MIN(fder(i),xmin)
574	xmax = MAX(fder(i),xmax)
575	ENDDO
576	PRINT*,'Derive des flux fder:', xmin, xmax
577
578	c
579	c Lecture du rayonnement net au sol:
580	c
581	CALL get_field("RADS",radsol)
582	xmin = 1.0E+20
583	xmax = -1.0E+20
584	DO i = 1, klon
585	xmin = MIN(radsol(i),xmin)
586	xmax = MAX(radsol(i),xmax)
587	ENDDO
588	PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
589	c
590	c Lecture de la longueur de rugosite
591	c
592	c
593	CALL get_field("RUG",frugs(:,1),found)
594	IF (.NOT. found) THEN
595	PRINT*, 'phyetat0: Le champ <RUG> est absent'
596	PRINT, ' Mais je vais essayer de lire RUG*'
597	DO nsrf = 1, nbsrf
598	IF (nsrf.GT.99) THEN
599	PRINT*, "Trop de sous-mailles"
600	CALL abort
601	ENDIF
602	WRITE(str2,'(i2.2)') nsrf
603	CALL get_field("RUG"//str2,frugs(:,nsrf))
604	xmin = 1.0E+20
605	xmax = -1.0E+20
606	DO i = 1, klon
607	xmin = MIN(frugs(i,nsrf),xmin)
608	xmax = MAX(frugs(i,nsrf),xmax)
609	ENDDO
610	PRINT,'rugosite du sol RUG*:', nsrf, xmin, xmax
611	ENDDO
612	ELSE
613	PRINT*, 'phyetat0: Le champ <RUG> est present'
614	PRINT, ' J ignore donc les autres RUG*'
615	xmin = 1.0E+20
616	xmax = -1.0E+20
617	DO i = 1, klon
618	xmin = MIN(frugs(i,1),xmin)
619	xmax = MAX(frugs(i,1),xmax)
620	ENDDO
621	PRINT*,'rugosite <RUG>', xmin, xmax
622	DO nsrf = 2, nbsrf
623	DO i = 1, klon
624	frugs(i,nsrf) = frugs(i,1)
625	ENDDO
626	ENDDO
627	ENDIF
628
629	c
630	c Lecture de l'age de la neige:
631	c
632	CALL get_field("AGESNO",agesno(:,1),found)
633	IF (.NOT. found) THEN
634	PRINT*, 'phyetat0: Le champ <AGESNO> est absent'
635	PRINT, ' Mais je vais essayer de lire AGESNO*'
636	DO nsrf = 1, nbsrf
637	IF (nsrf.GT.99) THEN
638	PRINT*, "Trop de sous-mailles"
639	CALL abort
640	ENDIF
641	WRITE(str2,'(i2.2)') nsrf
642	CALL get_field("AGESNO"//str2,agesno(:,nsrf),found)
643	IF (.NOT. found) THEN
644	PRINT*, "phyetat0: Le champ <AGESNO"//str2//"> est absent"
645	agesno = 50.0
646	ENDIF
647	xmin = 1.0E+20
648	xmax = -1.0E+20
649	DO i = 1, klon
650	xmin = MIN(agesno(i,nsrf),xmin)
651	xmax = MAX(agesno(i,nsrf),xmax)
652	ENDDO
653	PRINT,'Age de la neige AGESNO*:', nsrf, xmin, xmax
654	ENDDO
655	ELSE
656	PRINT*, 'phyetat0: Le champ <AGESNO> est present'
657	PRINT, ' J ignore donc les autres AGESNO*'
658	xmin = 1.0E+20
659	xmax = -1.0E+20
660	DO i = 1, klon
661	xmin = MIN(agesno(i,1),xmin)
662	xmax = MAX(agesno(i,1),xmax)
663	ENDDO
664	PRINT*,'Age de la neige <AGESNO>', xmin, xmax
665	DO nsrf = 2, nbsrf
666	DO i = 1, klon
667	agesno(i,nsrf) = agesno(i,1)
668	ENDDO
669	ENDDO
670	ENDIF
671
672	c
673	CALL get_field("ZMEA", zmea)
674	xmin = 1.0E+20
675	xmax = -1.0E+20
676	DO i = 1, klon
677	xmin = MIN(zmea(i),xmin)
678	xmax = MAX(zmea(i),xmax)
679	ENDDO
680	PRINT*,'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
681	c
682	c
683	CALL get_field("ZSTD",zstd)
684	xmin = 1.0E+20
685	xmax = -1.0E+20
686	DO i = 1, klon
687	xmin = MIN(zstd(i),xmin)
688	xmax = MAX(zstd(i),xmax)
689	ENDDO
690	PRINT*,'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
691	c
692	c
693	CALL get_field("ZSIG",zsig)
694	xmin = 1.0E+20
695	xmax = -1.0E+20
696	DO i = 1, klon
697	xmin = MIN(zsig(i),xmin)
698	xmax = MAX(zsig(i),xmax)
699	ENDDO
700	PRINT*,'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
701	c
702	c
703	CALL get_field("ZGAM",zgam)
704	xmin = 1.0E+20
705	xmax = -1.0E+20
706	DO i = 1, klon
707	xmin = MIN(zgam(i),xmin)
708	xmax = MAX(zgam(i),xmax)
709	ENDDO
710	PRINT*,'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
711	c
712	c
713	CALL get_field("ZTHE",zthe)
714	xmin = 1.0E+20
715	xmax = -1.0E+20
716	DO i = 1, klon
717	xmin = MIN(zthe(i),xmin)
718	xmax = MAX(zthe(i),xmax)
719	ENDDO
720	PRINT*,'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
721	c
722	c
723	CALL get_field("ZPIC",zpic)
724	xmin = 1.0E+20
725	xmax = -1.0E+20
726	DO i = 1, klon
727	xmin = MIN(zpic(i),xmin)
728	xmax = MAX(zpic(i),xmax)
729	ENDDO
730	PRINT*,'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
731	c
732	CALL get_field("ZVAL",zval)
733	xmin = 1.0E+20
734	xmax = -1.0E+20
735	DO i = 1, klon
736	xmin = MIN(zval(i),xmin)
737	xmax = MAX(zval(i),xmax)
738	ENDDO
739	PRINT*,'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
740	c
741	c
742	CALL get_field("RUGSREL",rugoro)
743	xmin = 1.0E+20
744	xmax = -1.0E+20
745	DO i = 1, klon
746	xmin = MIN(rugoro(i),xmin)
747	xmax = MAX(rugoro(i),xmax)
748	ENDDO
749	PRINT*,'Rugosite relief (ecart-type) rugsrel:', xmin, xmax
750	c
751	c
752
753	c
754	ancien_ok = .TRUE.
755
756	CALL get_field("TANCIEN",t_ancien,found)
757	IF (.NOT. found) THEN
758	PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
759	PRINT*, "Depart legerement fausse. Mais je continue"
760	ancien_ok = .FALSE.
761	ENDIF
762
763
764	CALL get_field("QANCIEN",q_ancien,found)
765	IF (.NOT. found) THEN
766	PRINT*, "phyetat0: Le champ <QANCIEN> est absent"
767	PRINT*, "Depart legerement fausse. Mais je continue"
768	ancien_ok = .FALSE.
769	ENDIF
770
771	u_ancien = 0.0 !AXC: We don't have u_ancien and v_ancien in the start
772	v_ancien = 0.0 !AXC: files, therefore they have to be initialized.
773	c
774
775	clwcon=0.
776	CALL get_field("CLWCON",clwcon(:,1),found)
777	IF (.NOT. found) THEN
778	PRINT*, "phyetat0: Le champ CLWCON est absent"
779	PRINT*, "Depart legerement fausse. Mais je continue"
780	ENDIF
781	xmin = 1.0E+20
782	xmax = -1.0E+20
783	xmin = MINval(clwcon)
784	xmax = MAXval(clwcon)
785	PRINT*,'Eau liquide convective (ecart-type) clwcon:', xmin, xmax
786	c
787	rnebcon = 0.
788	CALL get_field("RNEBCON",rnebcon(:,1),found)
789	IF (.NOT. found) THEN
790	PRINT*, "phyetat0: Le champ RNEBCON est absent"
791	PRINT*, "Depart legerement fausse. Mais je continue"
792	ENDIF
793	xmin = 1.0E+20
794	xmax = -1.0E+20
795	xmin = MINval(rnebcon)
796	xmax = MAXval(rnebcon)
797	PRINT*,'Nebulosite convective (ecart-type) rnebcon:', xmin, xmax
798
799	c
800	c Lecture ratqs
801	c
802	ratqs=0.
803	CALL get_field("RATQS",ratqs(:,1),found)
804	IF (.NOT. found) THEN
805	PRINT*, "phyetat0: Le champ <RATQS> est absent"
806	PRINT*, "Depart legerement fausse. Mais je continue"
807	ENDIF
808	xmin = 1.0E+20
809	xmax = -1.0E+20
810	xmin = MINval(ratqs)
811	xmax = MAXval(ratqs)
812	PRINT*,'(ecart-type) ratqs:', xmin, xmax
813	c
814	c Lecture run_off_lic_0
815	c
816	CALL get_field("RUNOFFLIC0",run_off_lic_0,found)
817	IF (.NOT. found) THEN
818	PRINT*, "phyetat0: Le champ <RUNOFFLIC0> est absent"
819	PRINT*, "Depart legerement fausse. Mais je continue"
820	run_off_lic_0 = 0.
821	ENDIF
822	xmin = 1.0E+20
823	xmax = -1.0E+20
824	xmin = MINval(run_off_lic_0)
825	xmax = MAXval(run_off_lic_0)
826	PRINT*,'(ecart-type) run_off_lic_0:', xmin, xmax
827
828
829	c Lecture de l'energie cinetique turbulente
830	c
831
832	IF (iflag_pbl>1) then
833	DO nsrf = 1, nbsrf
834	IF (nsrf.GT.99) THEN
835	PRINT*, "Trop de sous-mailles"
836	CALL abort
837	ENDIF
838	WRITE(str2,'(i2.2)') nsrf
839	CALL get_field("TKE"//str2,pbl_tke(:,1:klev,nsrf),found)
840	IF (.NOT. found) THEN
841	PRINT*, "phyetat0: <TKE"//str2//"> est absent"
842	pbl_tke(:,:,nsrf)=1.e-8
843	ENDIF
844	xmin = 1.0E+20
845	xmax = -1.0E+20
846	DO k = 1, klev
847	DO i = 1, klon
848	xmin = MIN(pbl_tke(i,k,nsrf),xmin)
849	xmax = MAX(pbl_tke(i,k,nsrf),xmax)
850	ENDDO
851	ENDDO
852	PRINT,'Temperature du sol TKE*:', nsrf, xmin, xmax
853	ENDDO
854	ENDIF
855	c
856	c zmax0
857	CALL get_field("ZMAX0",zmax0,found)
858	IF (.NOT. found) THEN
859	PRINT*, "phyetat0: Le champ <ZMAX0> est absent"
860	PRINT*, "Depart legerement fausse. Mais je continue"
861	zmax0=40.
862	ENDIF
863	xmin = 1.0E+20
864	xmax = -1.0E+20
865	xmin = MINval(zmax0)
866	xmax = MAXval(zmax0)
867	PRINT*,'(ecart-type) zmax0:', xmin, xmax
868	c
869	c f0(ig)=1.e-5
870	c f0
871	CALL get_field("F0",f0,found)
872	IF (.NOT. found) THEN
873	PRINT*, "phyetat0: Le champ <f0> est absent"
874	PRINT*, "Depart legerement fausse. Mais je continue"
875	f0=1.e-5
876	ENDIF
877	xmin = 1.0E+20
878	xmax = -1.0E+20
879	xmin = MINval(f0)
880	xmax = MAXval(f0)
881	PRINT*,'(ecart-type) f0:', xmin, xmax
882	c
883	c ema_work1
884	c
885	CALL get_field("EMA_WORK1",ema_work1,found)
886	IF (.NOT. found) THEN
887	PRINT*, "phyetat0: Le champ <EMA_WORK1> est absent"
888	PRINT*, "Depart legerement fausse. Mais je continue"
889	ema_work1=0.
890	ELSE
891	xmin = 1.0E+20
892	xmax = -1.0E+20
893	DO k = 1, klev
894	DO i = 1, klon
895	xmin = MIN(ema_work1(i,k),xmin)
896	xmax = MAX(ema_work1(i,k),xmax)
897	ENDDO
898	ENDDO
899	PRINT*,'ema_work1:', xmin, xmax
900	ENDIF
901	c
902	c ema_work2
903	c
904	CALL get_field("EMA_WORK2",ema_work2,found)
905	IF (.NOT. found) THEN
906	PRINT*, "phyetat0: Le champ <EMA_WORK2> est absent"
907	PRINT*, "Depart legerement fausse. Mais je continue"
908	ema_work2=0.
909	ELSE
910	xmin = 1.0E+20
911	xmax = -1.0E+20
912	DO k = 1, klev
913	DO i = 1, klon
914	xmin = MIN(ema_work2(i,k),xmin)
915	xmax = MAX(ema_work2(i,k),xmax)
916	ENDDO
917	ENDDO
918	PRINT*,'ema_work2:', xmin, xmax
919	ENDIF
920	c
921	c wake_deltat
922	c
923	CALL get_field("WAKE_DELTAT",wake_deltat,found)
924	IF (.NOT. found) THEN
925	PRINT*, "phyetat0: Le champ <WAKE_DELTAT> est absent"
926	PRINT*, "Depart legerement fausse. Mais je continue"
927	wake_deltat=0.
928	ELSE
929	xmin = 1.0E+20
930	xmax = -1.0E+20
931	DO k = 1, klev
932	DO i = 1, klon
933	xmin = MIN(wake_deltat(i,k),xmin)
934	xmax = MAX(wake_deltat(i,k),xmax)
935	ENDDO
936	ENDDO
937	PRINT*,'wake_deltat:', xmin, xmax
938	ENDIF
939	c
940	c wake_deltaq
941	c
942	CALL get_field("WAKE_DELTAQ",wake_deltaq,found)
943	IF (.NOT. found) THEN
944	PRINT*, "phyetat0: Le champ <WAKE_DELTAQ> est absent"
945	PRINT*, "Depart legerement fausse. Mais je continue"
946	wake_deltaq=0.
947	ELSE
948	xmin = 1.0E+20
949	xmax = -1.0E+20
950	DO k = 1, klev
951	DO i = 1, klon
952	xmin = MIN(wake_deltaq(i,k),xmin)
953	xmax = MAX(wake_deltaq(i,k),xmax)
954	ENDDO
955	ENDDO
956	PRINT*,'wake_deltaq:', xmin, xmax
957	ENDIF
958	c
959	c wake_s
960	c
961	CALL get_field("WAKE_S",wake_s,found)
962	IF (.NOT. found) THEN
963	PRINT*, "phyetat0: Le champ <WAKE_S> est absent"
964	PRINT*, "Depart legerement fausse. Mais je continue"
965	wake_s=0.
966	ENDIF
967	xmin = 1.0E+20
968	xmax = -1.0E+20
969	xmin = MINval(wake_s)
970	xmax = MAXval(wake_s)
971	PRINT*,'(ecart-type) wake_s:', xmin, xmax
972	c
973	c wake_cstar
974	c
975	CALL get_field("WAKE_CSTAR",wake_cstar,found)
976	IF (.NOT. found) THEN
977	PRINT*, "phyetat0: Le champ <WAKE_CSTAR> est absent"
978	PRINT*, "Depart legerement fausse. Mais je continue"
979	wake_cstar=0.
980	ENDIF
981	xmin = 1.0E+20
982	xmax = -1.0E+20
983	xmin = MINval(wake_cstar)
984	xmax = MAXval(wake_cstar)
985	PRINT*,'(ecart-type) wake_cstar:', xmin, xmax
986	c
987	c wake_fip
988	c
989	CALL get_field("WAKE_FIP",wake_fip,found)
990	IF (.NOT. found) THEN
991	PRINT*, "phyetat0: Le champ <WAKE_FIP> est absent"
992	PRINT*, "Depart legerement fausse. Mais je continue"
993	wake_fip=0.
994	ENDIF
995	xmin = 1.0E+20
996	xmax = -1.0E+20
997	xmin = MINval(wake_fip)
998	xmax = MAXval(wake_fip)
999	PRINT*,'(ecart-type) wake_fip:', xmin, xmax
1000	c
1001	c Read and send field trs to traclmdz
1002	c
1003	IF (type_trac == 'lmdz') THEN
1004	DO it=1,nbtr
1005	iiq=niadv(it+2)
1006	CALL get_field("trs_"//tname(iiq),trs(:,it),found)
1007	IF (.NOT. found) THEN
1008	PRINT*,
1009	$ "phyetat0: Le champ <trs_"//tname(iiq)//"> est absent"
1010	PRINT*, "Depart legerement fausse. Mais je continue"
1011	trs(:,it) = 0.
1012	ENDIF
1013	xmin = 1.0E+20
1014	xmax = -1.0E+20
1015	xmin = MINval(trs(:,it))
1016	xmax = MAXval(trs(:,it))
1017	PRINT*,"(ecart-type) trs_"//tname(iiq)//" :", xmin, xmax
1018
1019	END DO
1020
1021	CALL traclmdz_from_restart(trs)
1022	END IF
1023
1024
1025	c on ferme le fichier
1026	CALL close_startphy
1027
1028	CALL init_iophy_new(rlat,rlon)
1029
1030
1031	c
1032	c Initialize module pbl_surface_mod
1033	c
1034	CALL pbl_surface_init(qsol, fder, snow, qsurf,
1035	$ evap, frugs, agesno, tsoil)
1036
1037	c Initialize module ocean_cpl_mod for the case of coupled ocean
1038	IF ( type_ocean == 'couple' ) THEN
1039	CALL ocean_cpl_init(dtime, rlon, rlat)
1040	ENDIF
1041	c
1042	c Initilialize module fonte_neige_mod
1043	c
1044	CALL fonte_neige_init(run_off_lic_0)
1045
1046
1047	RETURN
1048	END

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

Download in other formats:

Original Format