source: LMDZ5/trunk/libf/phylmd/phyetat0.F90 @ 2898

Last change on this file since 2898 was 2656, checked in by Ehouarn Millour, 8 years ago

Making the slab work:

  • added a slab_heat_transp_mod module for horizontal diffusion and Ekman transport
  • added storage and output of relevent variables in phyredem, phyetat0, phy_output_ctrlout_mod, phys_output_write_mod
  • moved nslay (number of slab layers) out of dimphy into ocean_slab_mod.

FC

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