Context Navigation

phyetat0.F @ 1198

Last change on this file since 1198 was 1191, checked in by jghattas, 15 years ago

Reecriture de phytrac et les routines concernes (Anthony Jamelot)

les suffix change de F -> F90 (nflxtr.F90,cltracrn.F90,initrrnpb.F90,cvltr.F90,minmaxqfi.F90,cltrac.F90,phytrac.F90)

Traitement d'un nouveau traceur berelium (optionel, toujours pour des
tests)(Anthony Jamelot)

radiornpb.F change du nom pour radio_decay.F90 car il traite maintenant tout les traceurs radioactives
ajoute init_be.F90

Nouveau interface dans phytrac pour serparer les calculs et appels
specifique a INCA avec les traitements des traceurs specifiques au LMDZ
(JG)

ajoute tracinca_mod.F90 pour les appeles a INCA
ajoute traclmdz_mod.F90 pour les calculs des traceurs specifiques a LMDZ
enleve fichier restartrac et ajoute la variable trs dans restartphy.nc

La convergence numerique a etait rompue uniquement pour les traceurs
LMDZ RN et PB.

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

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

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

Download in other formats:

Original Format