source: LMDZ5/branches/LMDZ5V1.0-dev/libf/phylmd/phyetat0.F @ 1444

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

Modifications for carbon tracers :

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


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