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

Last change on this file since 1307 was 1279, checked in by Laurent Fairhead, 15 years ago

Merged LMDZ4-dev branch changes r1241:1278 into the trunk
Running trunk and LMDZ4-dev in LMDZOR configuration on local
machine (sequential) and SX8 (4-proc) yields identical results
(restart and restartphy are identical binarily)
Log history from r1241 to r1278 is available by switching to
source:LMDZ4/branches/LMDZ4-dev-20091210

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 28.9 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
[1279]21      USE infotrac
22      USE traclmdz_mod,    ONLY : traclmdz_from_restart
23      USE carbon_cycle_mod,ONLY : carbon_cycle_tr, carbon_cycle_cpl
24
[524]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"
[878]36#include "thermcell.h"
37#include "compbl.h"
[524]38c======================================================================
39      CHARACTER*(*) fichnom
[967]40
41c les variables globales lues dans le fichier restart
[524]42
[1001]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)
[1279]54      REAL trs(klon,nbtr)
[1001]55
[782]56      CHARACTER*6 ocean_in
57      LOGICAL ok_veget_in
[651]58
[524]59      INTEGER        longcles
60      PARAMETER    ( longcles = 20 )
61      REAL clesphy0( longcles )
62c
63      REAL xmin, xmax
64c
65      INTEGER nid, nvarid
[878]66      INTEGER ierr, i, nsrf, isoil ,k
[524]67      INTEGER length
68      PARAMETER (length=100)
[1279]69      INTEGER it, iiq
[524]70      REAL tab_cntrl(length), tabcntr0(length)
71      CHARACTER*7 str7
72      CHARACTER*2 str2
[1001]73      LOGICAL :: found
[879]74
75c FH1D
76c     real iolat(jjm+1)
77      real iolat(jjm+1-1/iim)
[524]78c
79c Ouvrir le fichier contenant l'etat initial:
80c
[766]81
[1001]82     
83      CALL open_startphy(fichnom)
84     
[766]85
[524]86c
87c Lecture des parametres de controle:
88c
[1001]89      CALL get_var("controle",tab_cntrl)
[766]90       
[524]91c
[956]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
[524]103         DO i = 1, length
104           tabcntr0( i ) = tab_cntrl( i )
105         ENDDO
106c
[956]107         tab_cntrl(1)=dtime
108         tab_cntrl(2)=radpas
[1279]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
[956]120         solaire_etat0      = tab_cntrl(4)
121         tab_cntrl(5)=iflag_con
122         tab_cntrl(6)=nbapp_rad
[524]123
[956]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.
[524]130
[956]131
132      itau_phy = tab_cntrl(15)
133
134       
135
[524]136         IF( clesphy0(1).NE.tab_cntrl( 5 ) )  THEN
[956]137             clesphy0(1)=tab_cntrl( 5 )
[524]138         ENDIF
139
140         IF( clesphy0(2).NE.tab_cntrl( 6 ) )  THEN
[956]141             clesphy0(2)=tab_cntrl( 6 )
[524]142         ENDIF
143
144         IF( clesphy0(3).NE.tab_cntrl( 7 ) )  THEN
[956]145             clesphy0(3)=tab_cntrl( 7 )
[524]146         ENDIF
147
148         IF( clesphy0(4).NE.tab_cntrl( 8 ) )  THEN
[956]149             clesphy0(4)=tab_cntrl( 8 )
[524]150         ENDIF
151
152         IF( clesphy0(5).NE.tab_cntrl( 9 ) )  THEN
[956]153             clesphy0(5)=tab_cntrl( 9 )
[524]154         ENDIF
155
156         IF( clesphy0(6).NE.tab_cntrl( 10 ) )  THEN
[956]157             clesphy0(6)=tab_cntrl( 10 )
[524]158         ENDIF
159
160         IF( clesphy0(7).NE.tab_cntrl( 11 ) )  THEN
[956]161             clesphy0(7)=tab_cntrl( 11 )
[524]162         ENDIF
163
164         IF( clesphy0(8).NE.tab_cntrl( 12 ) )  THEN
[956]165             clesphy0(8)=tab_cntrl( 12 )
[524]166         ENDIF
167
168
169c
170c Lecture des latitudes (coordonnees):
171c
[1001]172      CALL get_field("latitude",rlat)
[766]173
[524]174c
175c Lecture des longitudes (coordonnees):
176c
[1001]177      CALL get_field("longitude",rlon)
178
[524]179C
180C
181C Lecture du masque terre mer
182C
[1001]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'
[524]187      ENDIF
[766]188
189       
[524]190C Lecture des fractions pour chaque sous-surface
191C
192C initialisation des sous-surfaces
193C
194      pctsrf = 0.
195C
196C fraction de terre
197C
[766]198
[1001]199      CALL get_field("FTER",pctsrf(:,is_ter),found)
200      IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FTER> est absent'
[766]201
[524]202C
203C fraction de glace de terre
204C
[1001]205      CALL get_field("FLIC",pctsrf(:,is_lic),found)
206      IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FLIC> est absent'
207
[524]208C
209C fraction d'ocean
210C
[1001]211      CALL get_field("FOCE",pctsrf(:,is_oce),found)
212      IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FOCE> est absent'
[766]213
[524]214C
215C fraction glace de mer
216C
[1001]217      CALL get_field("FSIC",pctsrf(:,is_sic),found)
218      IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FSIC> est absent'
[766]219
[524]220C
221C  Verification de l'adequation entre le masque et les sous-surfaces
222C
[1001]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
[524]227            WRITE(*,*) 'phyetat0: attention fraction terre pas ',
[1001]228     $          'coherente ', i, zmasq(i), pctsrf(i, is_ter)
229     $          ,pctsrf(i, is_lic)
[524]230        ENDIF
231      END DO
[1001]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
[524]236            WRITE(*,*) 'phyetat0 attention fraction ocean pas ',
[1001]237     $          'coherente ', i, zmasq(i) , pctsrf(i, is_oce)
238     $          ,pctsrf(i, is_sic)
[524]239        ENDIF
240      END DO
[766]241
[524]242C
243c Lecture des temperatures du sol:
244c
[766]245
[1001]246       CALL get_field("TS",ftsol(:,1),found)
247       IF (.NOT. found) THEN
[524]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
[1001]256           CALL get_field("TS"//str2,ftsol(:,nsrf))
[766]257
[524]258           xmin = 1.0E+20
259           xmax = -1.0E+20
[1001]260           DO i = 1, klon
261              xmin = MIN(ftsol(i,nsrf),xmin)
262              xmax = MAX(ftsol(i,nsrf),xmax)
[524]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
[1001]271         DO i = 1, klon
272            xmin = MIN(ftsol(i,1),xmin)
273            xmax = MAX(ftsol(i,1),xmax)
[524]274         ENDDO
275         PRINT*,'Temperature du sol <TS>', xmin, xmax
276         DO nsrf = 2, nbsrf
[1001]277         DO i = 1, klon
278            ftsol(i,nsrf) = ftsol(i,1)
[524]279         ENDDO
280         ENDDO
281      ENDIF
[766]282
[524]283c
284c Lecture des temperatures du sol profond:
285c
286      DO nsrf = 1, nbsrf
[1001]287        DO isoil=1, nsoilmx
288          IF (isoil.GT.99 .AND. nsrf.GT.99) THEN
289            PRINT*, "Trop de couches ou sous-mailles"
[524]290            CALL abort
[1001]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
[524]303      ENDDO
304c
305c Lecture de l'humidite de l'air juste au dessus du sol:
306c
[1001]307
308      CALL get_field("QS",qsurf(:,1),found)
309      IF (.NOT. found) THEN
[524]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
[1001]318           CALL get_field("QS"//str2,qsurf(:,nsrf))
[524]319           xmin = 1.0E+20
320           xmax = -1.0E+20
[1001]321           DO i = 1, klon
[524]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
[1001]332         DO i = 1, klon
[524]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
[1001]338           DO i = 1, klon
339             qsurf(i,nsrf) = qsurf(i,1)
340           ENDDO
[524]341         ENDDO
342      ENDIF
[1001]343
[524]344C
345C Eau dans le sol (pour le modele de sol "bucket")
346C
[1001]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'
[524]351          qsol(:)=0.
352      ENDIF
[1001]353
[524]354      xmin = 1.0E+20
355      xmax = -1.0E+20
[1001]356      DO i = 1, klon
[524]357        xmin = MIN(qsol(i),xmin)
358        xmax = MAX(qsol(i),xmax)
359      ENDDO
360      PRINT*,'Eau dans le sol (mm) <QSOL>', xmin, xmax
[1001]361
[524]362c
363c Lecture de neige au sol:
364c
[1001]365
[1053]366      CALL get_field("SNOW",snow(:,1),found)
[1001]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
[524]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
[1001]390         DO i = 1, klon
[524]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
[1001]396         DO i = 1, klon
[524]397            snow(i,nsrf) = snow(i,1)
398         ENDDO
399         ENDDO
400      ENDIF
401c
[888]402c Lecture de albedo de l'interval visible au sol:
[524]403c
[1001]404      CALL get_field("ALBE",falb1(:,1),found)
405      IF (.NOT. found) THEN
[524]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
[1001]414           CALL get_field("ALBE"//str2,falb1(:,nsrf))
[524]415           xmin = 1.0E+20
416           xmax = -1.0E+20
[1001]417           DO i = 1, klon
418              xmin = MIN(falb1(i,nsrf),xmin)
419              xmax = MAX(falb1(i,nsrf),xmax)
[524]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
[1001]428         DO i = 1, klon
429            xmin = MIN(falb1(i,1),xmin)
430            xmax = MAX(falb1(i,1),xmax)
[524]431         ENDDO
432         PRINT*,'Neige du sol <ALBE>', xmin, xmax
433         DO nsrf = 2, nbsrf
[1001]434           DO i = 1, klon
435            falb1(i,nsrf) = falb1(i,1)
436           ENDDO
[524]437         ENDDO
438      ENDIF
439
440c
[888]441c Lecture de albedo au sol dans l'interval proche infra-rouge:
[524]442c
[1001]443      CALL get_field("ALBLW",falb2(:,1),found)
444      IF (.NOT. found) THEN
[524]445         PRINT*, 'phyetat0: Le champ <ALBLW> est absent'
446         PRINT*, '          Mais je vais prendre ALBE**'
447         DO nsrf = 1, nbsrf
[1001]448           DO i = 1, klon
449             falb2(i,nsrf) = falb1(i,nsrf)
[524]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
[1001]457         DO i = 1, klon
458            xmin = MIN(falb2(i,1),xmin)
459            xmax = MAX(falb2(i,1),xmax)
[524]460         ENDDO
461         PRINT*,'Neige du sol <ALBLW>', xmin, xmax
462         DO nsrf = 2, nbsrf
[1001]463           DO i = 1, klon
464             falb2(i,nsrf) = falb2(i,1)
465           ENDDO
[524]466         ENDDO
467      ENDIF
468c
469c Lecture de evaporation: 
470c
[1001]471      CALL get_field("EVAP",evap(:,1),found)
472      IF (.NOT. found) THEN
[524]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
[1001]481           CALL get_field("EVAP"//str2, evap(:,nsrf))
[524]482           xmin = 1.0E+20
483           xmax = -1.0E+20
[1001]484           DO i = 1, klon
[524]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
[1001]495         DO i = 1, klon
[524]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
[1001]501         DO i = 1, klon
[524]502            evap(i,nsrf) = evap(i,1)
503         ENDDO
504         ENDDO
505      ENDIF
506c
507c Lecture precipitation liquide:
508c
[1001]509      CALL get_field("rain_f",rain_fall)
[524]510      xmin = 1.0E+20
511      xmax = -1.0E+20
[1001]512      DO i = 1, klon
513         xmin = MIN(rain_fall(i),xmin)
514         xmax = MAX(rain_fall(i),xmax)
[524]515      ENDDO
516      PRINT*,'Precipitation liquide rain_f:', xmin, xmax
517c
518c Lecture precipitation solide:
519c
[1001]520      CALL get_field("snow_f",snow_fall)
[524]521      xmin = 1.0E+20
522      xmax = -1.0E+20
[1001]523      DO i = 1, klon
524         xmin = MIN(snow_fall(i),xmin)
525         xmax = MAX(snow_fall(i),xmax)
[524]526      ENDDO
527      PRINT*,'Precipitation solide snow_f:', xmin, xmax
528c
529c Lecture rayonnement solaire au sol:
530c
[1001]531      CALL get_field("solsw",solsw,found)
532      IF (.NOT. found) THEN
[524]533         PRINT*, 'phyetat0: Le champ <solsw> est absent'
534         PRINT*, 'mis a zero'
[1001]535         solsw(:) = 0.
[524]536      ENDIF
537      xmin = 1.0E+20
538      xmax = -1.0E+20
[1001]539      DO i = 1, klon
540         xmin = MIN(solsw(i),xmin)
541         xmax = MAX(solsw(i),xmax)
[524]542      ENDDO
543      PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
544c
545c Lecture rayonnement IF au sol:
546c
[1001]547      CALL get_field("sollw",sollw,found)
548      IF (.NOT. found) THEN
[524]549         PRINT*, 'phyetat0: Le champ <sollw> est absent'
550         PRINT*, 'mis a zero'
[1001]551         sollw = 0.
[524]552      ENDIF
553      xmin = 1.0E+20
554      xmax = -1.0E+20
[1001]555      DO i = 1, klon
556         xmin = MIN(sollw(i),xmin)
557         xmax = MAX(sollw(i),xmax)
[524]558      ENDDO
559      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
[776]560     
[524]561c
562c Lecture derive des flux:
563c
[1001]564      CALL get_field("fder",fder,found)
565      IF (.NOT. found) THEN
[524]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
[1001]572      DO i = 1, klon
[524]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
[1001]581      CALL get_field("RADS",radsol)
[524]582      xmin = 1.0E+20
583      xmax = -1.0E+20
[1001]584      DO i = 1, klon
585         xmin = MIN(radsol(i),xmin)
586         xmax = MAX(radsol(i),xmax)
[524]587      ENDDO
588      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
589c
590c Lecture de la longueur de rugosite
591c
592c
[1001]593      CALL get_field("RUG",frugs(:,1),found)
594      IF (.NOT. found) THEN
[524]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
[1001]603           CALL get_field("RUG"//str2,frugs(:,nsrf))
[524]604           xmin = 1.0E+20
605           xmax = -1.0E+20
[1001]606           DO i = 1, klon
[524]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
[1001]617         DO i = 1, klon
[524]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
[1001]623         DO i = 1, klon
[524]624            frugs(i,nsrf) = frugs(i,1)
625         ENDDO
626         ENDDO
627      ENDIF
628
629c
630c Lecture de l'age de la neige:
631c
[1001]632      CALL get_field("AGESNO",agesno(:,1),found)
633      IF (.NOT. found) THEN
[524]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
[1001]642           CALL get_field("AGESNO"//str2,agesno(:,nsrf),found)
643           IF (.NOT. found) THEN
[524]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
[1001]649           DO i = 1, klon
[524]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
[1001]660         DO i = 1, klon
[524]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
[1001]666         DO i = 1, klon
[524]667            agesno(i,nsrf) = agesno(i,1)
668         ENDDO
669         ENDDO
670      ENDIF
671
672c
[1001]673      CALL get_field("ZMEA", zmea)
[524]674      xmin = 1.0E+20
675      xmax = -1.0E+20
[1001]676      DO i = 1, klon
677         xmin = MIN(zmea(i),xmin)
678         xmax = MAX(zmea(i),xmax)
[524]679      ENDDO
680      PRINT*,'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
681c
682c
[1001]683      CALL get_field("ZSTD",zstd)
[524]684      xmin = 1.0E+20
685      xmax = -1.0E+20
[1001]686      DO i = 1, klon
687         xmin = MIN(zstd(i),xmin)
688         xmax = MAX(zstd(i),xmax)
[524]689      ENDDO
690      PRINT*,'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
691c
692c
[1001]693      CALL get_field("ZSIG",zsig)
[524]694      xmin = 1.0E+20
695      xmax = -1.0E+20
[1001]696      DO i = 1, klon
697         xmin = MIN(zsig(i),xmin)
698         xmax = MAX(zsig(i),xmax)
[524]699      ENDDO
700      PRINT*,'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
701c
702c
[1001]703      CALL get_field("ZGAM",zgam)
[524]704      xmin = 1.0E+20
705      xmax = -1.0E+20
[1001]706      DO i = 1, klon
707         xmin = MIN(zgam(i),xmin)
708         xmax = MAX(zgam(i),xmax)
[524]709      ENDDO
710      PRINT*,'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
711c
712c
[1001]713      CALL get_field("ZTHE",zthe)
[524]714      xmin = 1.0E+20
715      xmax = -1.0E+20
[1001]716      DO i = 1, klon
717         xmin = MIN(zthe(i),xmin)
718         xmax = MAX(zthe(i),xmax)
[524]719      ENDDO
720      PRINT*,'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
721c
722c
[1001]723      CALL get_field("ZPIC",zpic)
[524]724      xmin = 1.0E+20
725      xmax = -1.0E+20
[1001]726      DO i = 1, klon
727         xmin = MIN(zpic(i),xmin)
728         xmax = MAX(zpic(i),xmax)
[524]729      ENDDO
730      PRINT*,'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
731c
[1001]732      CALL get_field("ZVAL",zval)
[524]733      xmin = 1.0E+20
734      xmax = -1.0E+20
[1001]735      DO i = 1, klon
736         xmin = MIN(zval(i),xmin)
737         xmax = MAX(zval(i),xmax)
[524]738      ENDDO
739      PRINT*,'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
740c
741c
[1001]742      CALL get_field("RUGSREL",rugoro)
[524]743      xmin = 1.0E+20
744      xmax = -1.0E+20
[1001]745      DO i = 1, klon
746         xmin = MIN(rugoro(i),xmin)
747         xmax = MAX(rugoro(i),xmax)
[524]748      ENDDO
749      PRINT*,'Rugosite relief (ecart-type) rugsrel:', xmin, xmax
750c
751c
[1001]752     
[524]753c
[1001]754      ancien_ok = .TRUE.
755
756      CALL get_field("TANCIEN",t_ancien,found)
757      IF (.NOT. found) THEN
[524]758         PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
759         PRINT*, "Depart legerement fausse. Mais je continue"
[1001]760         ancien_ok = .FALSE.
[524]761      ENDIF
[1001]762
763
764      CALL get_field("QANCIEN",q_ancien,found)
765      IF (.NOT. found) THEN
[524]766         PRINT*, "phyetat0: Le champ <QANCIEN> est absent"
767         PRINT*, "Depart legerement fausse. Mais je continue"
[1001]768         ancien_ok = .FALSE.
[524]769      ENDIF
[1001]770
[1054]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.
[524]773c
[1001]774
775      clwcon=0.
776      CALL get_field("CLWCON",clwcon(:,1),found)
777      IF (.NOT. found) THEN
[524]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
[1001]783      xmin = MINval(clwcon)
784      xmax = MAXval(clwcon)
[524]785      PRINT*,'Eau liquide convective (ecart-type) clwcon:', xmin, xmax
786c
[1001]787      rnebcon = 0.
788      CALL get_field("RNEBCON",rnebcon(:,1),found)
789      IF (.NOT. found) THEN
[524]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
[1001]795      xmin = MINval(rnebcon)
796      xmax = MAXval(rnebcon)
[524]797      PRINT*,'Nebulosite convective (ecart-type) rnebcon:', xmin, xmax
798
799c
800c Lecture ratqs
801c
[1001]802      ratqs=0.
803      CALL get_field("RATQS",ratqs(:,1),found)
804      IF (.NOT. found) THEN
[524]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
[1001]810      xmin = MINval(ratqs)
811      xmax = MAXval(ratqs)
[524]812      PRINT*,'(ecart-type) ratqs:', xmin, xmax
813c
814c Lecture run_off_lic_0
815c
[1001]816      CALL get_field("RUNOFFLIC0",run_off_lic_0,found)
817      IF (.NOT. found) THEN
[524]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
[878]827
828
829c Lecture de l'energie cinetique turbulente
[524]830c
[878]831
832      IF (iflag_pbl>1) then
[1001]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
[878]854      ENDIF
855c
[927]856c zmax0
[1001]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.
[927]862      ENDIF
863      xmin = 1.0E+20
864      xmax = -1.0E+20
[1001]865      xmin = MINval(zmax0)
866      xmax = MAXval(zmax0)
[927]867      PRINT*,'(ecart-type) zmax0:', xmin, xmax
868c
869c           f0(ig)=1.e-5
870c f0
[1279]871      CALL get_field("F0",f0,found)
[1001]872      IF (.NOT. found) THEN
[927]873         PRINT*, "phyetat0: Le champ <f0> est absent"
874         PRINT*, "Depart legerement fausse. Mais je continue"
[1001]875         f0=1.e-5
[927]876      ENDIF
877      xmin = 1.0E+20
878      xmax = -1.0E+20
[1001]879      xmin = MINval(f0)
880      xmax = MAXval(f0)
[927]881      PRINT*,'(ecart-type) f0:', xmin, xmax
882c
[937]883c ema_work1
884c
[1001]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.
[937]890      ELSE
[1001]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
[937]900      ENDIF
901c
902c ema_work2
903c
[1001]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.
[937]909      ELSE
[1001]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
[937]919      ENDIF
920c
[973]921c wake_deltat
922c
[1001]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.
[973]928      ELSE
[1001]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
[973]938      ENDIF
939c
940c wake_deltaq
[1001]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.
[973]947      ELSE
[1001]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
[973]957      ENDIF
958c
959c wake_s
960c
[1001]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.
[973]966      ENDIF
967      xmin = 1.0E+20
968      xmax = -1.0E+20
[1001]969      xmin = MINval(wake_s)
970      xmax = MAXval(wake_s)
[973]971      PRINT*,'(ecart-type) wake_s:', xmin, xmax
972c
973c wake_cstar
974c
[1001]975      CALL get_field("WAKE_CSTAR",wake_cstar,found)
976      IF (.NOT. found) THEN
[973]977         PRINT*, "phyetat0: Le champ <WAKE_CSTAR> est absent"
978         PRINT*, "Depart legerement fausse. Mais je continue"
[1001]979         wake_cstar=0.
[973]980      ENDIF
981      xmin = 1.0E+20
982      xmax = -1.0E+20
[1001]983      xmin = MINval(wake_cstar)
984      xmax = MAXval(wake_cstar)
[973]985      PRINT*,'(ecart-type) wake_cstar:', xmin, xmax
986c
987c wake_fip
988c
[1001]989      CALL get_field("WAKE_FIP",wake_fip,found)
990      IF (.NOT. found) THEN
[973]991         PRINT*, "phyetat0: Le champ <WAKE_FIP> est absent"
992         PRINT*, "Depart legerement fausse. Mais je continue"
[1001]993         wake_fip=0.
[973]994      ENDIF
995      xmin = 1.0E+20
996      xmax = -1.0E+20
[1001]997      xmin = MINval(wake_fip)
998      xmax = MAXval(wake_fip)
[973]999      PRINT*,'(ecart-type) wake_fip:', xmin, xmax
1000c
[1279]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
[766]1018
[1279]1019         END DO
1020         
1021         CALL traclmdz_from_restart(trs)
1022      END IF
1023
1024
[1001]1025c on ferme le fichier
1026      CALL close_startphy
[879]1027
[1001]1028      CALL init_iophy_new(rlat,rlon)
[766]1029       
1030
[782]1031c
1032c Initialize module pbl_surface_mod
1033c
[1001]1034      CALL pbl_surface_init(qsol, fder, snow, qsurf,
1035     $     evap, frugs, agesno, tsoil)
[782]1036
[996]1037c Initialize module ocean_cpl_mod for the case of coupled ocean
1038      IF ( type_ocean == 'couple' ) THEN
[967]1039         CALL ocean_cpl_init(dtime, rlon, rlat)
[782]1040      ENDIF
1041c
1042c Initilialize module fonte_neige_mod     
1043c
[1001]1044      CALL fonte_neige_init(run_off_lic_0)
[782]1045
[1279]1046
[524]1047      RETURN
1048      END
Note: See TracBrowser for help on using the repository browser.