Context Navigation

phyetat0.F @ 2198

Last change on this file since 2198 was 66, checked in by emillour, 14 years ago

EM: Mise a niveau par rapport a la version terrestre (LMDZ5V2.0-dev, rev 1487)

Mise a jour des scripts (terrestres) 'makegcm' et 'create_make_gcm'
Ajout du script 'makelmdz' (version "amelioree", en Bash, de makegcm)
Mise a jour des routines dans phylmd (sauf regr_lat_time_climoz_m.F)

disvert (dans dyn3d et dyn3dpar): passage au Fortran 90
parallel.F90 (dyn3dpar): correction bug
etat0_netcdf.F90 (dyn3d et dyn3dpar) : mise a jour mineure
ce0l.F90 (dyn3dpar) : correction bug
abort_gcm.F (dyn3dpar) : correction bug
ugeostr.F90 (dyn3d et dyn3dpar) : passage au Fortran 90
fluxstokenc_p.F (dyn3dpar) : correction bug
iniacademic.F90 (dyn3d et dyn3dpar) : passage au Fortran 90
friction_p.F (dyn3dpar) : correction bug
infotrac.F90 (dyn3d et dyn3dpar) : correction bug mineur sur lecture traceurs
caladvtrac.F (dyn3d) : modifications cosmetiques

File size: 30.5 KB

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

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

Download in other formats:

Original Format