Context Navigation

phyetat0.F @ 1010

Last change on this file since 1010 was 1001, checked in by Laurent Fairhead, 16 years ago

Modifs sur le parallelisme: masquage dans la physique
Inclusion strato
mise en coherence etat0
le mode offline fonctionne maintenant en parallele,
les fichiers de la dynamiques sont correctement sortis et peuvent etre reconstruit avec rebuild
la version parallele de la dynamique peut s'executer sans MPI (sur 1 proc)
L'OPENMP fonctionne maintenant sans la parallelisation MPI.

YM
LF

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

File size: 27.5 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(:,nsrf),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	c
756
757	clwcon=0.
758	CALL get_field("CLWCON",clwcon(:,1),found)
759	IF (.NOT. found) THEN
760	PRINT*, "phyetat0: Le champ CLWCON est absent"
761	PRINT*, "Depart legerement fausse. Mais je continue"
762	ENDIF
763	xmin = 1.0E+20
764	xmax = -1.0E+20
765	xmin = MINval(clwcon)
766	xmax = MAXval(clwcon)
767	PRINT*,'Eau liquide convective (ecart-type) clwcon:', xmin, xmax
768	c
769	rnebcon = 0.
770	CALL get_field("RNEBCON",rnebcon(:,1),found)
771	IF (.NOT. found) THEN
772	PRINT*, "phyetat0: Le champ RNEBCON est absent"
773	PRINT*, "Depart legerement fausse. Mais je continue"
774	ENDIF
775	xmin = 1.0E+20
776	xmax = -1.0E+20
777	xmin = MINval(rnebcon)
778	xmax = MAXval(rnebcon)
779	PRINT*,'Nebulosite convective (ecart-type) rnebcon:', xmin, xmax
780
781	c
782	c Lecture ratqs
783	c
784	ratqs=0.
785	CALL get_field("RATQS",ratqs(:,1),found)
786	IF (.NOT. found) THEN
787	PRINT*, "phyetat0: Le champ <RATQS> est absent"
788	PRINT*, "Depart legerement fausse. Mais je continue"
789	ENDIF
790	xmin = 1.0E+20
791	xmax = -1.0E+20
792	xmin = MINval(ratqs)
793	xmax = MAXval(ratqs)
794	PRINT*,'(ecart-type) ratqs:', xmin, xmax
795	c
796	c Lecture run_off_lic_0
797	c
798	CALL get_field("RUNOFFLIC0",run_off_lic_0,found)
799	IF (.NOT. found) THEN
800	PRINT*, "phyetat0: Le champ <RUNOFFLIC0> est absent"
801	PRINT*, "Depart legerement fausse. Mais je continue"
802	run_off_lic_0 = 0.
803	ENDIF
804	xmin = 1.0E+20
805	xmax = -1.0E+20
806	xmin = MINval(run_off_lic_0)
807	xmax = MAXval(run_off_lic_0)
808	PRINT*,'(ecart-type) run_off_lic_0:', xmin, xmax
809
810
811	c Lecture de l'energie cinetique turbulente
812	c
813
814	IF (iflag_pbl>1) then
815	DO nsrf = 1, nbsrf
816	IF (nsrf.GT.99) THEN
817	PRINT*, "Trop de sous-mailles"
818	CALL abort
819	ENDIF
820	WRITE(str2,'(i2.2)') nsrf
821	CALL get_field("TKE"//str2,pbl_tke(:,1:klev,nsrf),found)
822	IF (.NOT. found) THEN
823	PRINT*, "phyetat0: <TKE"//str2//"> est absent"
824	pbl_tke(:,:,nsrf)=1.e-8
825	ENDIF
826	xmin = 1.0E+20
827	xmax = -1.0E+20
828	DO k = 1, klev
829	DO i = 1, klon
830	xmin = MIN(pbl_tke(i,k,nsrf),xmin)
831	xmax = MAX(pbl_tke(i,k,nsrf),xmax)
832	ENDDO
833	ENDDO
834	PRINT,'Temperature du sol TKE*:', nsrf, xmin, xmax
835	ENDDO
836	ENDIF
837	c
838	c zmax0
839	CALL get_field("ZMAX0",zmax0,found)
840	IF (.NOT. found) THEN
841	PRINT*, "phyetat0: Le champ <ZMAX0> est absent"
842	PRINT*, "Depart legerement fausse. Mais je continue"
843	zmax0=40.
844	ENDIF
845	xmin = 1.0E+20
846	xmax = -1.0E+20
847	xmin = MINval(zmax0)
848	xmax = MAXval(zmax0)
849	PRINT*,'(ecart-type) zmax0:', xmin, xmax
850	c
851	c f0(ig)=1.e-5
852	c f0
853	CALL get_field("f0",f0,found)
854	IF (.NOT. found) THEN
855	PRINT*, "phyetat0: Le champ <f0> est absent"
856	PRINT*, "Depart legerement fausse. Mais je continue"
857	f0=1.e-5
858	ENDIF
859	xmin = 1.0E+20
860	xmax = -1.0E+20
861	xmin = MINval(f0)
862	xmax = MAXval(f0)
863	PRINT*,'(ecart-type) f0:', xmin, xmax
864	c
865	c ema_work1
866	c
867	CALL get_field("EMA_WORK1",ema_work1,found)
868	IF (.NOT. found) THEN
869	PRINT*, "phyetat0: Le champ <EMA_WORK1> est absent"
870	PRINT*, "Depart legerement fausse. Mais je continue"
871	ema_work1=0.
872	ELSE
873	xmin = 1.0E+20
874	xmax = -1.0E+20
875	DO k = 1, klev
876	DO i = 1, klon
877	xmin = MIN(ema_work1(i,k),xmin)
878	xmax = MAX(ema_work1(i,k),xmax)
879	ENDDO
880	ENDDO
881	PRINT*,'ema_work1:', xmin, xmax
882	ENDIF
883	c
884	c ema_work2
885	c
886	CALL get_field("EMA_WORK2",ema_work2,found)
887	IF (.NOT. found) THEN
888	PRINT*, "phyetat0: Le champ <EMA_WORK2> est absent"
889	PRINT*, "Depart legerement fausse. Mais je continue"
890	ema_work2=0.
891	ELSE
892	xmin = 1.0E+20
893	xmax = -1.0E+20
894	DO k = 1, klev
895	DO i = 1, klon
896	xmin = MIN(ema_work2(i,k),xmin)
897	xmax = MAX(ema_work2(i,k),xmax)
898	ENDDO
899	ENDDO
900	PRINT*,'ema_work2:', xmin, xmax
901	ENDIF
902	c
903	c wake_deltat
904	c
905	CALL get_field("WAKE_DELTAT",wake_deltat,found)
906	IF (.NOT. found) THEN
907	PRINT*, "phyetat0: Le champ <WAKE_DELTAT> est absent"
908	PRINT*, "Depart legerement fausse. Mais je continue"
909	wake_deltat=0.
910	ELSE
911	xmin = 1.0E+20
912	xmax = -1.0E+20
913	DO k = 1, klev
914	DO i = 1, klon
915	xmin = MIN(wake_deltat(i,k),xmin)
916	xmax = MAX(wake_deltat(i,k),xmax)
917	ENDDO
918	ENDDO
919	PRINT*,'wake_deltat:', xmin, xmax
920	ENDIF
921	c
922	c wake_deltaq
923	c
924	CALL get_field("WAKE_DELTAQ",wake_deltaq,found)
925	IF (.NOT. found) THEN
926	PRINT*, "phyetat0: Le champ <WAKE_DELTAQ> est absent"
927	PRINT*, "Depart legerement fausse. Mais je continue"
928	wake_deltaq=0.
929	ELSE
930	xmin = 1.0E+20
931	xmax = -1.0E+20
932	DO k = 1, klev
933	DO i = 1, klon
934	xmin = MIN(wake_deltaq(i,k),xmin)
935	xmax = MAX(wake_deltaq(i,k),xmax)
936	ENDDO
937	ENDDO
938	PRINT*,'wake_deltaq:', xmin, xmax
939	ENDIF
940	c
941	c wake_s
942	c
943	CALL get_field("WAKE_S",wake_s,found)
944	IF (.NOT. found) THEN
945	PRINT*, "phyetat0: Le champ <WAKE_S> est absent"
946	PRINT*, "Depart legerement fausse. Mais je continue"
947	wake_s=0.
948	ENDIF
949	xmin = 1.0E+20
950	xmax = -1.0E+20
951	xmin = MINval(wake_s)
952	xmax = MAXval(wake_s)
953	PRINT*,'(ecart-type) wake_s:', xmin, xmax
954	c
955	c wake_cstar
956	c
957	CALL get_field("WAKE_CSTAR",wake_cstar,found)
958	IF (.NOT. found) THEN
959	PRINT*, "phyetat0: Le champ <WAKE_CSTAR> est absent"
960	PRINT*, "Depart legerement fausse. Mais je continue"
961	wake_cstar=0.
962	ENDIF
963	xmin = 1.0E+20
964	xmax = -1.0E+20
965	xmin = MINval(wake_cstar)
966	xmax = MAXval(wake_cstar)
967	PRINT*,'(ecart-type) wake_cstar:', xmin, xmax
968	c
969	c wake_fip
970	c
971	CALL get_field("WAKE_FIP",wake_fip,found)
972	IF (.NOT. found) THEN
973	PRINT*, "phyetat0: Le champ <WAKE_FIP> est absent"
974	PRINT*, "Depart legerement fausse. Mais je continue"
975	wake_fip=0.
976	ENDIF
977	xmin = 1.0E+20
978	xmax = -1.0E+20
979	xmin = MINval(wake_fip)
980	xmax = MAXval(wake_fip)
981	PRINT*,'(ecart-type) wake_fip:', xmin, xmax
982	c
983
984	c on ferme le fichier
985	CALL close_startphy
986
987	CALL init_iophy_new(rlat,rlon)
988
989
990	c
991	c Initialize module pbl_surface_mod
992	c
993	CALL pbl_surface_init(qsol, fder, snow, qsurf,
994	$ evap, frugs, agesno, tsoil)
995
996	c Initialize module ocean_cpl_mod for the case of coupled ocean
997	IF ( type_ocean == 'couple' ) THEN
998	CALL ocean_cpl_init(dtime, rlon, rlat)
999	ENDIF
1000	c
1001	c Initilialize module fonte_neige_mod
1002	c
1003	CALL fonte_neige_init(run_off_lic_0)
1004
1005	RETURN
1006	END

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

Download in other formats:

Original Format