source: LMDZ6/trunk/libf/phylmd/phyetat0.F90 @ 3241

Last change on this file since 3241 was 3080, checked in by Laurent Fairhead, 7 years ago

Adding some missing variables to the start files to get 1+1=2 when
we use the gusts parametrization
LF

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 21.3 KB
RevLine 
[1403]1! $Id: phyetat0.F90 3080 2017-11-19 10:38:51Z idelkadi $
[782]2
[1827]3SUBROUTINE phyetat0 (fichnom, clesphy0, tabcntr0)
[1279]4
[2656]5  USE dimphy, only: klon, zmasq, klev
[1938]6  USE iophy, ONLY : init_iophy_new
[1827]7  USE ocean_cpl_mod,    ONLY : ocean_cpl_init
8  USE fonte_neige_mod,  ONLY : fonte_neige_init
9  USE pbl_surface_mod,  ONLY : pbl_surface_init
[2209]10  USE surface_data,     ONLY : type_ocean, version_ocean
[1938]11  USE phys_state_var_mod, ONLY : ancien_ok, clwcon, detr_therm, dtime, &
[2243]12       qsol, fevap, z0m, z0h, agesno, &
[2333]13       du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
[2499]14       falb_dir, falb_dif, prw_ancien, prlw_ancien, prsw_ancien, &
[2497]15       ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, radpas, radsol, rain_fall, ratqs, &
[2399]16       rnebcon, rugoro, sig1, snow_fall, solaire_etat0, sollw, sollwdown, &
[1938]17       solsw, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, &
[2159]18       wake_deltat, wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
[2635]19       wake_s, wake_dens, zgam, zmax0, zmea, zpic, zsig, &
[3080]20       zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, u10m, v10m, treedrg, &
21       ale_wake, ale_bl_stat
[2952]22!FC
[2399]23  USE geometry_mod, ONLY : longitude_deg, latitude_deg
[1938]24  USE iostart, ONLY : close_startphy, get_field, get_var, open_startphy
[2320]25  USE infotrac_phy, only: nbtr, nqo, type_trac, tname, niadv
[1827]26  USE traclmdz_mod,    ONLY : traclmdz_from_restart
27  USE carbon_cycle_mod, ONLY : carbon_cycle_tr, carbon_cycle_cpl, co2_send
[1938]28  USE indice_sol_mod, only: nbsrf, is_ter, epsfra, is_lic, is_oce, is_sic
[2656]29  USE ocean_slab_mod, ONLY: nslay, tslab, seaice, tice, ocean_slab_init
[2344]30  USE time_phylmdz_mod, ONLY: init_iteration, pdtphys, itau_phy
[967]31
[1827]32  IMPLICIT none
33  !======================================================================
34  ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
35  ! Objet: Lecture de l'etat initial pour la physique
36  !======================================================================
37  include "netcdf.inc"
38  include "dimsoil.h"
39  include "clesphys.h"
40  include "thermcell.h"
41  include "compbl.h"
[2188]42  include "YOMCST.h"
[1827]43  !======================================================================
44  CHARACTER*(*) fichnom
[524]45
[1827]46  ! les variables globales lues dans le fichier restart
[1001]47
[1827]48  REAL tsoil(klon, nsoilmx, nbsrf)
49  REAL qsurf(klon, nbsrf)
50  REAL snow(klon, nbsrf)
51  real fder(klon)
52  REAL run_off_lic_0(klon)
53  REAL fractint(klon)
54  REAL trs(klon, nbtr)
[2188]55  REAL zts(klon)
[2952]56  ! pour drag arbres FC
57  REAL drg_ter(klon,klev)
[651]58
[1827]59  CHARACTER*6 ocean_in
60  LOGICAL ok_veget_in
[879]61
[1827]62  INTEGER        longcles
63  PARAMETER    ( longcles = 20 )
64  REAL clesphy0( longcles )
[766]65
[1827]66  REAL xmin, xmax
[766]67
[1827]68  INTEGER nid, nvarid
69  INTEGER ierr, i, nsrf, isoil , k
70  INTEGER length
71  PARAMETER (length=100)
[2237]72  INTEGER it, iiq, isw
[1827]73  REAL tab_cntrl(length), tabcntr0(length)
74  CHARACTER*7 str7
75  CHARACTER*2 str2
[2243]76  LOGICAL :: found,phyetat0_get,phyetat0_srf
[2399]77  REAL :: lon_startphy(klon), lat_startphy(klon)
[1827]78
79  ! FH1D
80  !     real iolat(jjm+1)
[2344]81  !real iolat(jjm+1-1/(iim*jjm))
[1827]82
83  ! Ouvrir le fichier contenant l'etat initial:
84
85  CALL open_startphy(fichnom)
86
87  ! Lecture des parametres de controle:
88
89  CALL get_var("controle", tab_cntrl)
90
[956]91!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[1827]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
[956]100!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
101
[1827]102  DO i = 1, length
103     tabcntr0( i ) = tab_cntrl( i )
104  ENDDO
[1279]105
[2344]106  tab_cntrl(1)=pdtphys
[1827]107  tab_cntrl(2)=radpas
[1279]108
[1827]109  ! co2_ppm : value from the previous time step
110  IF (carbon_cycle_tr .OR. carbon_cycle_cpl) THEN
111     co2_ppm = tab_cntrl(3)
112     RCO2    = co2_ppm * 1.0e-06  * 44.011/28.97
113     ! ELSE : keep value from .def
114  END IF
[1279]115
[1827]116  ! co2_ppm0 : initial value of atmospheric CO2 (from create_etat0_limit.e .def)
117  co2_ppm0   = tab_cntrl(16)
[524]118
[1827]119  solaire_etat0      = tab_cntrl(4)
120  tab_cntrl(5)=iflag_con
121  tab_cntrl(6)=nbapp_rad
[524]122
[1827]123  if (cycle_diurne) tab_cntrl( 7) =1.
124  if (soil_model) tab_cntrl( 8) =1.
125  if (new_oliq) tab_cntrl( 9) =1.
126  if (ok_orodr) tab_cntrl(10) =1.
127  if (ok_orolf) tab_cntrl(11) =1.
128  if (ok_limitvrai) tab_cntrl(12) =1.
[956]129
[1827]130  itau_phy = tab_cntrl(15)
[956]131
[1827]132  clesphy0(1)=tab_cntrl( 5 )
133  clesphy0(2)=tab_cntrl( 6 )
134  clesphy0(3)=tab_cntrl( 7 )
135  clesphy0(4)=tab_cntrl( 8 )
136  clesphy0(5)=tab_cntrl( 9 )
137  clesphy0(6)=tab_cntrl( 10 )
138  clesphy0(7)=tab_cntrl( 11 )
139  clesphy0(8)=tab_cntrl( 12 )
[956]140
[2344]141  ! set time iteration
142   CALL init_iteration(itau_phy)
143
[2399]144  ! read latitudes and make a sanity check (because already known from dyn)
145  CALL get_field("latitude",lat_startphy)
146  DO i=1,klon
147    IF (ABS(lat_startphy(i)-latitude_deg(i))>=1) THEN
148      WRITE(*,*) "phyetat0: Error! Latitude discrepancy wrt startphy file:",&
149                 " i=",i," lat_startphy(i)=",lat_startphy(i),&
150                 " latitude_deg(i)=",latitude_deg(i)
151      ! This is presumably serious enough to abort run
152      CALL abort_physic("phyetat0","discrepancy in latitudes!",1)
153    ENDIF
154    IF (ABS(lat_startphy(i)-latitude_deg(i))>=0.0001) THEN
155      WRITE(*,*) "phyetat0: Warning! Latitude discrepancy wrt startphy file:",&
156                 " i=",i," lat_startphy(i)=",lat_startphy(i),&
157                 " latitude_deg(i)=",latitude_deg(i)
158    ENDIF
159  ENDDO
[766]160
[2399]161  ! read longitudes and make a sanity check (because already known from dyn)
162  CALL get_field("longitude",lon_startphy)
163  DO i=1,klon
164    IF (ABS(lon_startphy(i)-longitude_deg(i))>=1) THEN
165      WRITE(*,*) "phyetat0: Error! Longitude discrepancy wrt startphy file:",&
166                 " i=",i," lon_startphy(i)=",lon_startphy(i),&
167                 " longitude_deg(i)=",longitude_deg(i)
168      ! This is presumably serious enough to abort run
169      CALL abort_physic("phyetat0","discrepancy in longitudes!",1)
170    ENDIF
171    IF (ABS(lon_startphy(i)-longitude_deg(i))>=0.0001) THEN
172      WRITE(*,*) "phyetat0: Warning! Longitude discrepancy wrt startphy file:",&
173                 " i=",i," lon_startphy(i)=",lon_startphy(i),&
174                 " longitude_deg(i)=",longitude_deg(i)
175    ENDIF
176  ENDDO
[1001]177
[1827]178  ! Lecture du masque terre mer
[766]179
[1827]180  CALL get_field("masque", zmasq, found)
181  IF (.NOT. found) THEN
182     PRINT*, 'phyetat0: Le champ <masque> est absent'
183     PRINT *, 'fichier startphy non compatible avec phyetat0'
184  ENDIF
[1001]185
[1827]186  ! Lecture des fractions pour chaque sous-surface
[766]187
[1827]188  ! initialisation des sous-surfaces
[766]189
[1827]190  pctsrf = 0.
[766]191
[1827]192  ! fraction de terre
[766]193
[1827]194  CALL get_field("FTER", pctsrf(:, is_ter), found)
195  IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FTER> est absent'
[766]196
[1827]197  ! fraction de glace de terre
[766]198
[1827]199  CALL get_field("FLIC", pctsrf(:, is_lic), found)
200  IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FLIC> est absent'
[1001]201
[1827]202  ! fraction d'ocean
[1001]203
[1827]204  CALL get_field("FOCE", pctsrf(:, is_oce), found)
205  IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FOCE> est absent'
[1001]206
[1827]207  ! fraction glace de mer
[1001]208
[1827]209  CALL get_field("FSIC", pctsrf(:, is_sic), found)
210  IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FSIC> est absent'
[1001]211
[1827]212  !  Verification de l'adequation entre le masque et les sous-surfaces
213
214  fractint( 1 : klon) = pctsrf(1 : klon, is_ter)  &
215       + pctsrf(1 : klon, is_lic)
216  DO i = 1 , klon
217     IF ( abs(fractint(i) - zmasq(i) ) .GT. EPSFRA ) THEN
218        WRITE(*, *) 'phyetat0: attention fraction terre pas ',  &
219             'coherente ', i, zmasq(i), pctsrf(i, is_ter) &
220             , pctsrf(i, is_lic)
221        WRITE(*, *) 'Je force la coherence zmasq=fractint'
222        zmasq(i) = fractint(i)
223     ENDIF
224  END DO
225  fractint (1 : klon) =  pctsrf(1 : klon, is_oce)  &
226       + pctsrf(1 : klon, is_sic)
227  DO i = 1 , klon
228     IF ( abs( fractint(i) - (1. - zmasq(i))) .GT. EPSFRA ) THEN
229        WRITE(*, *) 'phyetat0 attention fraction ocean pas ',  &
230             'coherente ', i, zmasq(i) , pctsrf(i, is_oce) &
231             , pctsrf(i, is_sic)
[2053]232        WRITE(*, *) 'Je force la coherence zmasq=1.-fractint'
[2052]233        zmasq(i) = 1. - fractint(i)
[1827]234     ENDIF
235  END DO
236
[2252]237!===================================================================
238! Lecture des temperatures du sol:
239!===================================================================
[1827]240
[2252]241  found=phyetat0_get(1,ftsol(:,1),"TS","Surface temperature",283.)
242  IF (found) THEN
243     DO nsrf=2,nbsrf
244        ftsol(:,nsrf)=ftsol(:,1)
[1827]245     ENDDO
246  ELSE
[2252]247     found=phyetat0_srf(1,ftsol,"TS","Surface temperature",283.)
[1827]248  ENDIF
[524]249
[2237]250!===================================================================
251  ! Lecture des albedo difus et direct
[2252]252!===================================================================
[2237]253
254  DO nsrf = 1, nbsrf
255     DO isw=1, nsw
[2252]256        IF (isw.GT.99) THEN
257           PRINT*, "Trop de bandes SW"
[2311]258           call abort_physic("phyetat0", "", 1)
[2237]259        ENDIF
[2252]260        WRITE(str2, '(i2.2)') isw
261        found=phyetat0_srf(1,falb_dir(:, isw,:),"A_dir_SW"//str2//"srf","Direct Albedo",0.2)
262        found=phyetat0_srf(1,falb_dif(:, isw,:),"A_dif_SW"//str2//"srf","Direct Albedo",0.2)
[2237]263     ENDDO
264  ENDDO
265
[2569]266  found=phyetat0_srf(1,u10m,"U10M","u a 10m",0.)
267  found=phyetat0_srf(1,v10m,"V10M","v a 10m",0.)
268
[2237]269!===================================================================
[1827]270  ! Lecture des temperatures du sol profond:
[2252]271!===================================================================
[524]272
[2252]273   DO isoil=1, nsoilmx
274        IF (isoil.GT.99) THEN
275           PRINT*, "Trop de couches "
[2311]276           call abort_physic("phyetat0", "", 1)
[1827]277        ENDIF
[2252]278        WRITE(str2,'(i2.2)') isoil
279        found=phyetat0_srf(1,tsoil(:, isoil,:),"Tsoil"//str2//"srf","Temp soil",0.)
[1827]280        IF (.NOT. found) THEN
281           PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
282           PRINT*, "          Il prend donc la valeur de surface"
[2252]283           tsoil(:, isoil, :)=ftsol(:, :)
[1827]284        ENDIF
[2252]285   ENDDO
[524]286
[2252]287!=======================================================================
288! Lecture precipitation/evaporation
289!=======================================================================
[1001]290
[2252]291  found=phyetat0_srf(1,qsurf,"QS","Near surface hmidity",0.)
292  found=phyetat0_get(1,qsol,"QSOL","Surface hmidity / bucket",0.)
293  found=phyetat0_srf(1,snow,"SNOW","Surface snow",0.)
294  found=phyetat0_srf(1,fevap,"EVAP","evaporation",0.)
295  found=phyetat0_get(1,snow_fall,"snow_f","snow fall",0.)
296  found=phyetat0_get(1,rain_fall,"rain_f","rain fall",0.)
[1001]297
[2252]298!=======================================================================
299! Radiation
300!=======================================================================
[1001]301
[2252]302  found=phyetat0_get(1,solsw,"solsw","net SW radiation surf",0.)
303  found=phyetat0_get(1,sollw,"sollw","net LW radiation surf",0.)
304  found=phyetat0_get(1,sollwdown,"sollwdown","down LW radiation surf",0.)
[1827]305  IF (.NOT. found) THEN
[2252]306     sollwdown = 0. ;  zts=0.
[2188]307     do nsrf=1,nbsrf
308        zts(:)=zts(:)+ftsol(:,nsrf)*pctsrf(:,nsrf)
309     enddo
310     sollwdown(:)=sollw(:)+RSIGMA*zts(:)**4
311  ENDIF
312
[2252]313  found=phyetat0_get(1,radsol,"RADS","Solar radiation",0.)
314  found=phyetat0_get(1,fder,"fder","Flux derivative",0.)
[2188]315
[1827]316
317  ! Lecture de la longueur de rugosite
[2243]318  found=phyetat0_srf(1,z0m,"RUG","Z0m ancien",0.001)
319  IF (found) THEN
320     z0h(:,1:nbsrf)=z0m(:,1:nbsrf)
[1827]321  ELSE
[2243]322     found=phyetat0_srf(1,z0m,"Z0m","Roughness length, momentum ",0.001)
323     found=phyetat0_srf(1,z0h,"Z0h","Roughness length, enthalpy ",0.001)
[1827]324  ENDIF
[2952]325!FC
[2979]326  IF (ifl_pbltree>0) THEN
[2952]327!CALL get_field("FTER", pctsrf(:, is_ter), found)
[2979]328    treedrg(:,1:klev,1:nbsrf)= 0.0
329    CALL get_field("treedrg_ter", drg_ter(:,:), found)
[2952]330!  found=phyetat0_srf(1,treedrg,"treedrg","drag from vegetation" , 0.)
[2979]331    !lecture du profile de freinage des arbres
332    IF (.not. found ) THEN
333      treedrg(:,1:klev,1:nbsrf)= 0.0
334    ELSE
335      treedrg(:,1:klev,is_ter)= drg_ter(:,:)
[2952]336!     found=phyetat0_srf(klev,treedrg,"treedrg","freinage arbres",0.)
[2979]337    ENDIF
338  ELSE
339    ! initialize treedrg(), because it will be written in restartphy.nc
340    treedrg(:,:,:) = 0.0
341  ENDIF
[1827]342
343  ! Lecture de l'age de la neige:
[2252]344  found=phyetat0_srf(1,agesno,"AGESNO","SNOW AGE",0.001)
[1827]345
[2252]346  ancien_ok=.true.
347  ancien_ok=ancien_ok.AND.phyetat0_get(klev,t_ancien,"TANCIEN","TANCIEN",0.)
348  ancien_ok=ancien_ok.AND.phyetat0_get(klev,q_ancien,"QANCIEN","QANCIEN",0.)
[2497]349  ancien_ok=ancien_ok.AND.phyetat0_get(klev,ql_ancien,"QLANCIEN","QLANCIEN",0.)
350  ancien_ok=ancien_ok.AND.phyetat0_get(klev,qs_ancien,"QSANCIEN","QSANCIEN",0.)
[2252]351  ancien_ok=ancien_ok.AND.phyetat0_get(klev,u_ancien,"UANCIEN","UANCIEN",0.)
352  ancien_ok=ancien_ok.AND.phyetat0_get(klev,v_ancien,"VANCIEN","VANCIEN",0.)
[2499]353  ancien_ok=ancien_ok.AND.phyetat0_get(1,prw_ancien,"PRWANCIEN","PRWANCIEN",0.)
354  ancien_ok=ancien_ok.AND.phyetat0_get(1,prlw_ancien,"PRLWANCIEN","PRLWANCIEN",0.)
355  ancien_ok=ancien_ok.AND.phyetat0_get(1,prsw_ancien,"PRSWANCIEN","PRSWANCIEN",0.)
[1827]356
[2494]357  ! Ehouarn: addtional tests to check if t_ancien, q_ancien contain
358  !          dummy values (as is the case when generated by ce0l,
359  !          or by iniaqua)
[2499]360  if ( (maxval(q_ancien).eq.minval(q_ancien))       .or. &
361       (maxval(ql_ancien).eq.minval(ql_ancien))     .or. &
362       (maxval(qs_ancien).eq.minval(qs_ancien))     .or. &
363       (maxval(prw_ancien).eq.minval(prw_ancien))   .or. &
364       (maxval(prlw_ancien).eq.minval(prlw_ancien)) .or. &
365       (maxval(prsw_ancien).eq.minval(prsw_ancien)) .or. &
[2494]366       (maxval(t_ancien).eq.minval(t_ancien)) ) then
367    ancien_ok=.false.
368  endif
369
[2252]370  found=phyetat0_get(klev,clwcon,"CLWCON","CLWCON",0.)
371  found=phyetat0_get(klev,rnebcon,"RNEBCON","RNEBCON",0.)
372  found=phyetat0_get(klev,ratqs,"RATQS","RATQS",0.)
[1827]373
[2252]374  found=phyetat0_get(1,run_off_lic_0,"RUNOFFLIC0","RUNOFFLIC0",0.)
[1827]375
[2252]376!==================================
377!  TKE
378!==================================
379!
[1827]380  IF (iflag_pbl>1) then
[2252]381     found=phyetat0_srf(klev+1,pbl_tke,"TKE","Turb. Kinetic. Energ. ",1.e-8)
[1827]382  ENDIF
[1403]383
[2252]384  IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1 ) then
385    found=phyetat0_srf(klev+1,wake_delta_pbl_tke,"DELTATKE","Del TKE wk/env",0.)
386    found=phyetat0_srf(1,delta_tsurf,"DELTA_TSURF","Delta Ts wk/env ",0.)
[2159]387  ENDIF   !(iflag_pbl>1 .AND. iflag_wake>=1 .AND. iflag_pbl_split >=1 )
388
[2251]389!==================================
390!  thermiques, poches, convection
391!==================================
[1403]392
[2252]393! Emanuel
394  found=phyetat0_get(klev,sig1,"sig1","sig1",0.)
395  found=phyetat0_get(klev,w01,"w01","w01",0.)
[1403]396
[2252]397! Wake
[2251]398  found=phyetat0_get(klev,wake_deltat,"WAKE_DELTAT","Delta T wake/env",0.)
[2243]399  found=phyetat0_get(klev,wake_deltaq,"WAKE_DELTAQ","Delta hum. wake/env",0.)
[2635]400  found=phyetat0_get(1,wake_s,"WAKE_S","Wake frac. area",0.)
[3000]401!jyg<
402!  Set wake_dens to -1000. when there is no restart so that the actual
403!  initialization is made in calwake.
404!!  found=phyetat0_get(1,wake_dens,"WAKE_DENS","Wake num. /unit area",0.)
405  found=phyetat0_get(1,wake_dens,"WAKE_DENS","Wake num. /unit area",-1000.)
406!>jyg
[2252]407  found=phyetat0_get(1,wake_cstar,"WAKE_CSTAR","WAKE_CSTAR",0.)
408  found=phyetat0_get(1,wake_pe,"WAKE_PE","WAKE_PE",0.)
409  found=phyetat0_get(1,wake_fip,"WAKE_FIP","WAKE_FIP",0.)
[879]410
[2252]411! Thermiques
[2251]412  found=phyetat0_get(1,zmax0,"ZMAX0","ZMAX0",40.)
413  found=phyetat0_get(1,f0,"F0","F0",1.e-5)
[2252]414  found=phyetat0_get(klev+1,fm_therm,"FM_THERM","Thermals mass flux",0.)
[2251]415  found=phyetat0_get(klev,entr_therm,"ENTR_THERM","Thermals Entrain.",0.)
416  found=phyetat0_get(klev,detr_therm,"DETR_THERM","Thermals Detrain.",0.)
[782]417
[2252]418! ALE/ALP
[2251]419  found=phyetat0_get(1,ale_bl,"ALE_BL","ALE BL",0.)
420  found=phyetat0_get(1,ale_bl_trig,"ALE_BL_TRIG","ALE BL_TRIG",0.)
421  found=phyetat0_get(1,alp_bl,"ALP_BL","ALP BL",0.)
[3080]422  found=phyetat0_get(1,ale_wake,"ALE_WAKE","ALE_WAKE",0.)
423  found=phyetat0_get(1,ale_bl_stat,"ALE_BL_STAT","ALE_BL_STAT",0.)
[1279]424
[2251]425!===========================================
[1827]426  ! Read and send field trs to traclmdz
[2251]427!===========================================
[1827]428
429  IF (type_trac == 'lmdz') THEN
[2265]430     DO it=1, nbtr                                                                 
431!!        iiq=niadv(it+2)                                                           ! jyg
432        iiq=niadv(it+nqo)                                                           ! jyg
[2252]433        found=phyetat0_get(1,trs(:,it),"trs_"//tname(iiq), &
434              "Surf trac"//tname(iiq),0.)
[1827]435     END DO
436     CALL traclmdz_from_restart(trs)
437
438     IF (carbon_cycle_cpl) THEN
[2252]439        ALLOCATE(co2_send(klon), stat=ierr)
[2311]440        IF (ierr /= 0) CALL abort_physic('phyetat0', 'pb allocation co2_send', 1)
[2251]441        found=phyetat0_get(1,co2_send,"co2_send","co2 send",0.)
[1827]442     END IF
443  END IF
444
[2251]445!===========================================
[2252]446!  ondes de gravite / relief
[2251]447!===========================================
448
[2252]449!  ondes de gravite non orographiques
[2333]450  if (ok_gwd_rando) found = &
451       phyetat0_get(klev,du_gwd_rando,"du_gwd_rando","du_gwd_rando",0.)
452  IF (.not. ok_hines .and. ok_gwd_rando) found &
453       = phyetat0_get(klev,du_gwd_front,"du_gwd_front","du_gwd_front",0.)
[1938]454
[2252]455!  prise en compte du relief sous-maille
456  found=phyetat0_get(1,zmea,"ZMEA","sub grid orography",0.)
457  found=phyetat0_get(1,zstd,"ZSTD","sub grid orography",0.)
458  found=phyetat0_get(1,zsig,"ZSIG","sub grid orography",0.)
459  found=phyetat0_get(1,zgam,"ZGAM","sub grid orography",0.)
460  found=phyetat0_get(1,zthe,"ZTHE","sub grid orography",0.)
461  found=phyetat0_get(1,zpic,"ZPIC","sub grid orography",0.)
462  found=phyetat0_get(1,zval,"ZVAL","sub grid orography",0.)
463  found=phyetat0_get(1,zmea,"ZMEA","sub grid orography",0.)
464  found=phyetat0_get(1,rugoro,"RUGSREL","sub grid orography",0.)
465
[2251]466!===========================================
467! Initialize ocean
468!===========================================
469
[2057]470  IF ( type_ocean == 'slab' ) THEN
[2209]471      CALL ocean_slab_init(dtime, pctsrf)
[2656]472      IF (nslay.EQ.1) THEN
473        found=phyetat0_get(1,tslab,"tslab01","tslab",0.)
474        IF (.NOT. found) THEN
475            found=phyetat0_get(1,tslab,"tslab","tslab",0.)
476        END IF
477      ELSE
478          DO i=1,nslay
479            WRITE(str2,'(i2.2)') i
480            found=phyetat0_get(1,tslab(:,i),"tslab"//str2,"tslab",0.) 
481          END DO
482      END IF
[2057]483      IF (.NOT. found) THEN
484          PRINT*, "phyetat0: Le champ <tslab> est absent"
485          PRINT*, "Initialisation a tsol_oce"
486          DO i=1,nslay
[2209]487              tslab(:,i)=MAX(ftsol(:,is_oce),271.35)
[2057]488          END DO
489      END IF
[2251]490
[2209]491      ! Sea ice variables
492      IF (version_ocean == 'sicINT') THEN
[2656]493          found=phyetat0_get(1,tice,"slab_tice","slab_tice",0.)
[2209]494          IF (.NOT. found) THEN
495              PRINT*, "phyetat0: Le champ <tice> est absent"
496              PRINT*, "Initialisation a tsol_sic"
497                  tice(:)=ftsol(:,is_sic)
498          END IF
[2656]499          found=phyetat0_get(1,seaice,"seaice","seaice",0.)
[2209]500          IF (.NOT. found) THEN
501              PRINT*, "phyetat0: Le champ <seaice> est absent"
502              PRINT*, "Initialisation a 0/1m suivant fraction glace"
503              seaice(:)=0.
504              WHERE (pctsrf(:,is_sic).GT.EPSFRA)
505                  seaice=917.
506              END WHERE
507          END IF
508      END IF !sea ice INT
[2057]509  END IF ! Slab       
510
[1827]511  ! on ferme le fichier
512  CALL close_startphy
513
514  ! Initialize module pbl_surface_mod
515
[2243]516  CALL pbl_surface_init(fder, snow, qsurf, tsoil)
[1827]517
518  ! Initialize module ocean_cpl_mod for the case of coupled ocean
519  IF ( type_ocean == 'couple' ) THEN
[2399]520     CALL ocean_cpl_init(dtime, longitude_deg, latitude_deg)
[1827]521  ENDIF
522
[2399]523  CALL init_iophy_new(latitude_deg, longitude_deg)
[2054]524
[1827]525  ! Initilialize module fonte_neige_mod     
526  CALL fonte_neige_init(run_off_lic_0)
527
528END SUBROUTINE phyetat0
[2243]529
530!===================================================================
531FUNCTION phyetat0_get(nlev,field,name,descr,default)
532!===================================================================
533! Lecture d'un champ avec contrôle
534! Function logique dont le resultat indique si la lecture
535! s'est bien passée
536! On donne une valeur par defaut dans le cas contraire
537!===================================================================
538
539USE iostart, ONLY : get_field
540USE dimphy, only: klon
[2311]541USE print_control_mod, ONLY: lunout
[2243]542
543IMPLICIT NONE
544
545LOGICAL phyetat0_get
546
547! arguments
548INTEGER,INTENT(IN) :: nlev
549CHARACTER*(*),INTENT(IN) :: name,descr
550REAL,INTENT(IN) :: default
551REAL,DIMENSION(klon,nlev),INTENT(INOUT) :: field
552
553! Local variables
554LOGICAL found
555
556   CALL get_field(name, field, found)
557   IF (.NOT. found) THEN
558     WRITE(lunout,*) "phyetat0: Le champ <",name,"> est absent"
559     WRITE(lunout,*) "Depart legerement fausse. Mais je continue"
560     field(:,:)=default
561   ENDIF
562   WRITE(lunout,*) name, descr, MINval(field),MAXval(field)
563   phyetat0_get=found
564
565RETURN
566END FUNCTION phyetat0_get
567
568!================================================================
569FUNCTION phyetat0_srf(nlev,field,name,descr,default)
570!===================================================================
571! Lecture d'un champ par sous-surface avec contrôle
572! Function logique dont le resultat indique si la lecture
573! s'est bien passée
574! On donne une valeur par defaut dans le cas contraire
575!===================================================================
576
577USE iostart, ONLY : get_field
578USE dimphy, only: klon
579USE indice_sol_mod, only: nbsrf
[2311]580USE print_control_mod, ONLY: lunout
[2243]581
582IMPLICIT NONE
583
584LOGICAL phyetat0_srf
585! arguments
586INTEGER,INTENT(IN) :: nlev
587CHARACTER*(*),INTENT(IN) :: name,descr
588REAL,INTENT(IN) :: default
589REAL,DIMENSION(klon,nlev,nbsrf),INTENT(INOUT) :: field
590
591! Local variables
592LOGICAL found,phyetat0_get
593INTEGER nsrf
594CHARACTER*2 str2
595 
596     IF (nbsrf.GT.99) THEN
597        WRITE(lunout,*) "Trop de sous-mailles"
[2311]598        call abort_physic("phyetat0", "", 1)
[2243]599     ENDIF
600
601     DO nsrf = 1, nbsrf
602        WRITE(str2, '(i2.2)') nsrf
603        found= phyetat0_get(nlev,field(:,:, nsrf), &
604        name//str2,descr//" srf:"//str2,default)
605     ENDDO
606
607     phyetat0_srf=found
608
609RETURN
610END FUNCTION phyetat0_srf
611
Note: See TracBrowser for help on using the repository browser.