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

Last change on this file since 1201 was 1191, checked in by jghattas, 15 years ago

Reecriture de phytrac et les routines concernes (Anthony Jamelot)

  • les suffix change de F -> F90 (nflxtr.F90,cltracrn.F90,initrrnpb.F90,cvltr.F90,minmaxqfi.F90,cltrac.F90,phytrac.F90)

Traitement d'un nouveau traceur berelium (optionel, toujours pour des
tests)(Anthony Jamelot)

  • radiornpb.F change du nom pour radio_decay.F90 car il traite maintenant tout les traceurs radioactives
  • ajoute init_be.F90

Nouveau interface dans phytrac pour serparer les calculs et appels
specifique a INCA avec les traitements des traceurs specifiques au LMDZ
(JG)

  • ajoute tracinca_mod.F90 pour les appeles a INCA
  • ajoute traclmdz_mod.F90 pour les calculs des traceurs specifiques a LMDZ
  • enleve fichier restartrac et ajoute la variable trs dans restartphy.nc

La convergence numerique a etait rompue uniquement pour les traceurs
LMDZ RN et PB.

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