Context Navigation

phyetat0.F @ 1444

Last change on this file since 1444 was 1444, checked in by jghattas, 14 years ago

Modifications for carbon tracers :

add possibility to read source at different frequency
add dynamic varaiable to send fluxes in interface between ORCHIDEE and LMDZ : this is still under developpment under cpp key ORCH_NEW. No compatible official ORCHIDEE version does yet exist.
add variable co2_send in restart file.
clean up and bug fixes.

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

File size: 31.1 KB

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

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

Download in other formats:

Original Format