source: LMDZ4/trunk/libf/phylmd/phyetat0.F @ 1160

Last change on this file since 1160 was 1054, checked in by lmdzadmin, 16 years ago

Ajout sorties tendances dynamiques histLES
ACA/FH/IM

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