source: LMDZ4/branches/LMDZ4-dev/libf/phylmd/phyetat0.F @ 1237

Last change on this file since 1237 was 1227, checked in by jghattas, 15 years ago
  • Inclusion d'un premier version du cycle de carbon dans LMDZ. Attention

!! Il s'agit d'un version ou les nouveaux cles cycle_carbon_tr et
cycle_carbon_cpl ne sont pas teste. Avec les ancinenes parametres le
modele donne les memes resultats qu'avant. L'interface avec ORCHIDEE n'a
pas encore etait modifie.

  • physiq.F, phys_cal_mod.F90 : ajout d'un nouveau module qui contient qq parametres pour le calendrier et le pas de temps acutelle de la physiq. Ce module pourrait etre elargie plus tard / LF + JG


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