Context Navigation

phyetat0.F @ 1081

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

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

Download in other formats:

Original Format