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

Last change on this file since 2536 was 2499, checked in by oboucher, 8 years ago

Various changes to diagnose properly 2D tendency in q, ql, qs from dynamics
as previous diagnostics were incorrect.
Cleaned up all such diagnostics in physiq_mod.F90 as well

  • 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: 19.7 KB
RevLine 
[1403]1! $Id: phyetat0.F90 2499 2016-04-24 10:38:19Z oboucher $
[782]2
[1827]3SUBROUTINE phyetat0 (fichnom, clesphy0, tabcntr0)
[1279]4
[2057]5  USE dimphy, only: klon, zmasq, klev, nslay
[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, &
[2499]19       wake_s, zgam, zmax0, zmea, zpic, zsig, &
[2069]20       zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl
[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
[2209]27  USE ocean_slab_mod, ONLY: 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
262!===================================================================
[1827]263  ! Lecture des temperatures du sol profond:
[2252]264!===================================================================
[524]265
[2252]266   DO isoil=1, nsoilmx
267        IF (isoil.GT.99) THEN
268           PRINT*, "Trop de couches "
[2311]269           call abort_physic("phyetat0", "", 1)
[1827]270        ENDIF
[2252]271        WRITE(str2,'(i2.2)') isoil
272        found=phyetat0_srf(1,tsoil(:, isoil,:),"Tsoil"//str2//"srf","Temp soil",0.)
[1827]273        IF (.NOT. found) THEN
274           PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
275           PRINT*, "          Il prend donc la valeur de surface"
[2252]276           tsoil(:, isoil, :)=ftsol(:, :)
[1827]277        ENDIF
[2252]278   ENDDO
[524]279
[2252]280!=======================================================================
281! Lecture precipitation/evaporation
282!=======================================================================
[1001]283
[2252]284  found=phyetat0_srf(1,qsurf,"QS","Near surface hmidity",0.)
285  found=phyetat0_get(1,qsol,"QSOL","Surface hmidity / bucket",0.)
286  found=phyetat0_srf(1,snow,"SNOW","Surface snow",0.)
287  found=phyetat0_srf(1,fevap,"EVAP","evaporation",0.)
288  found=phyetat0_get(1,snow_fall,"snow_f","snow fall",0.)
289  found=phyetat0_get(1,rain_fall,"rain_f","rain fall",0.)
[1001]290
[2252]291!=======================================================================
292! Radiation
293!=======================================================================
[1001]294
[2252]295  found=phyetat0_get(1,solsw,"solsw","net SW radiation surf",0.)
296  found=phyetat0_get(1,sollw,"sollw","net LW radiation surf",0.)
297  found=phyetat0_get(1,sollwdown,"sollwdown","down LW radiation surf",0.)
[1827]298  IF (.NOT. found) THEN
[2252]299     sollwdown = 0. ;  zts=0.
[2188]300     do nsrf=1,nbsrf
301        zts(:)=zts(:)+ftsol(:,nsrf)*pctsrf(:,nsrf)
302     enddo
303     sollwdown(:)=sollw(:)+RSIGMA*zts(:)**4
304  ENDIF
305
[2252]306  found=phyetat0_get(1,radsol,"RADS","Solar radiation",0.)
307  found=phyetat0_get(1,fder,"fder","Flux derivative",0.)
[2188]308
[1827]309
310  ! Lecture de la longueur de rugosite
[2243]311  found=phyetat0_srf(1,z0m,"RUG","Z0m ancien",0.001)
312  IF (found) THEN
313     z0h(:,1:nbsrf)=z0m(:,1:nbsrf)
[1827]314  ELSE
[2243]315     found=phyetat0_srf(1,z0m,"Z0m","Roughness length, momentum ",0.001)
316     found=phyetat0_srf(1,z0h,"Z0h","Roughness length, enthalpy ",0.001)
[1827]317  ENDIF
318
319  ! Lecture de l'age de la neige:
[2252]320  found=phyetat0_srf(1,agesno,"AGESNO","SNOW AGE",0.001)
[1827]321
[2252]322  ancien_ok=.true.
323  ancien_ok=ancien_ok.AND.phyetat0_get(klev,t_ancien,"TANCIEN","TANCIEN",0.)
324  ancien_ok=ancien_ok.AND.phyetat0_get(klev,q_ancien,"QANCIEN","QANCIEN",0.)
[2497]325  ancien_ok=ancien_ok.AND.phyetat0_get(klev,ql_ancien,"QLANCIEN","QLANCIEN",0.)
326  ancien_ok=ancien_ok.AND.phyetat0_get(klev,qs_ancien,"QSANCIEN","QSANCIEN",0.)
[2252]327  ancien_ok=ancien_ok.AND.phyetat0_get(klev,u_ancien,"UANCIEN","UANCIEN",0.)
328  ancien_ok=ancien_ok.AND.phyetat0_get(klev,v_ancien,"VANCIEN","VANCIEN",0.)
[2499]329  ancien_ok=ancien_ok.AND.phyetat0_get(1,prw_ancien,"PRWANCIEN","PRWANCIEN",0.)
330  ancien_ok=ancien_ok.AND.phyetat0_get(1,prlw_ancien,"PRLWANCIEN","PRLWANCIEN",0.)
331  ancien_ok=ancien_ok.AND.phyetat0_get(1,prsw_ancien,"PRSWANCIEN","PRSWANCIEN",0.)
[1827]332
[2494]333  ! Ehouarn: addtional tests to check if t_ancien, q_ancien contain
334  !          dummy values (as is the case when generated by ce0l,
335  !          or by iniaqua)
[2499]336  if ( (maxval(q_ancien).eq.minval(q_ancien))       .or. &
337       (maxval(ql_ancien).eq.minval(ql_ancien))     .or. &
338       (maxval(qs_ancien).eq.minval(qs_ancien))     .or. &
339       (maxval(prw_ancien).eq.minval(prw_ancien))   .or. &
340       (maxval(prlw_ancien).eq.minval(prlw_ancien)) .or. &
341       (maxval(prsw_ancien).eq.minval(prsw_ancien)) .or. &
[2494]342       (maxval(t_ancien).eq.minval(t_ancien)) ) then
343    ancien_ok=.false.
344  endif
345
[2252]346  found=phyetat0_get(klev,clwcon,"CLWCON","CLWCON",0.)
347  found=phyetat0_get(klev,rnebcon,"RNEBCON","RNEBCON",0.)
348  found=phyetat0_get(klev,ratqs,"RATQS","RATQS",0.)
[1827]349
[2252]350  found=phyetat0_get(1,run_off_lic_0,"RUNOFFLIC0","RUNOFFLIC0",0.)
[1827]351
[2252]352!==================================
353!  TKE
354!==================================
355!
[1827]356  IF (iflag_pbl>1) then
[2252]357     found=phyetat0_srf(klev+1,pbl_tke,"TKE","Turb. Kinetic. Energ. ",1.e-8)
[1827]358  ENDIF
[1403]359
[2252]360  IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1 ) then
361    found=phyetat0_srf(klev+1,wake_delta_pbl_tke,"DELTATKE","Del TKE wk/env",0.)
362    found=phyetat0_srf(1,delta_tsurf,"DELTA_TSURF","Delta Ts wk/env ",0.)
[2159]363  ENDIF   !(iflag_pbl>1 .AND. iflag_wake>=1 .AND. iflag_pbl_split >=1 )
364
[2251]365!==================================
366!  thermiques, poches, convection
367!==================================
[1403]368
[2252]369! Emanuel
370  found=phyetat0_get(klev,sig1,"sig1","sig1",0.)
371  found=phyetat0_get(klev,w01,"w01","w01",0.)
[1403]372
[2252]373! Wake
[2251]374  found=phyetat0_get(klev,wake_deltat,"WAKE_DELTAT","Delta T wake/env",0.)
[2243]375  found=phyetat0_get(klev,wake_deltaq,"WAKE_DELTAQ","Delta hum. wake/env",0.)
[2252]376  found=phyetat0_get(1,wake_s,"WAKE_S","WAKE_S",0.)
377  found=phyetat0_get(1,wake_cstar,"WAKE_CSTAR","WAKE_CSTAR",0.)
378  found=phyetat0_get(1,wake_pe,"WAKE_PE","WAKE_PE",0.)
379  found=phyetat0_get(1,wake_fip,"WAKE_FIP","WAKE_FIP",0.)
[879]380
[2252]381! Thermiques
[2251]382  found=phyetat0_get(1,zmax0,"ZMAX0","ZMAX0",40.)
383  found=phyetat0_get(1,f0,"F0","F0",1.e-5)
[2252]384  found=phyetat0_get(klev+1,fm_therm,"FM_THERM","Thermals mass flux",0.)
[2251]385  found=phyetat0_get(klev,entr_therm,"ENTR_THERM","Thermals Entrain.",0.)
386  found=phyetat0_get(klev,detr_therm,"DETR_THERM","Thermals Detrain.",0.)
[782]387
[2252]388! ALE/ALP
[2251]389  found=phyetat0_get(1,ale_bl,"ALE_BL","ALE BL",0.)
390  found=phyetat0_get(1,ale_bl_trig,"ALE_BL_TRIG","ALE BL_TRIG",0.)
391  found=phyetat0_get(1,alp_bl,"ALP_BL","ALP BL",0.)
[1279]392
[2251]393!===========================================
[1827]394  ! Read and send field trs to traclmdz
[2251]395!===========================================
[1827]396
397  IF (type_trac == 'lmdz') THEN
[2265]398     DO it=1, nbtr                                                                 
399!!        iiq=niadv(it+2)                                                           ! jyg
400        iiq=niadv(it+nqo)                                                           ! jyg
[2252]401        found=phyetat0_get(1,trs(:,it),"trs_"//tname(iiq), &
402              "Surf trac"//tname(iiq),0.)
[1827]403     END DO
404     CALL traclmdz_from_restart(trs)
405
406     IF (carbon_cycle_cpl) THEN
[2252]407        ALLOCATE(co2_send(klon), stat=ierr)
[2311]408        IF (ierr /= 0) CALL abort_physic('phyetat0', 'pb allocation co2_send', 1)
[2251]409        found=phyetat0_get(1,co2_send,"co2_send","co2 send",0.)
[1827]410     END IF
411  END IF
412
[2251]413!===========================================
[2252]414!  ondes de gravite / relief
[2251]415!===========================================
416
[2252]417!  ondes de gravite non orographiques
[2333]418  if (ok_gwd_rando) found = &
419       phyetat0_get(klev,du_gwd_rando,"du_gwd_rando","du_gwd_rando",0.)
420  IF (.not. ok_hines .and. ok_gwd_rando) found &
421       = phyetat0_get(klev,du_gwd_front,"du_gwd_front","du_gwd_front",0.)
[1938]422
[2252]423!  prise en compte du relief sous-maille
424  found=phyetat0_get(1,zmea,"ZMEA","sub grid orography",0.)
425  found=phyetat0_get(1,zstd,"ZSTD","sub grid orography",0.)
426  found=phyetat0_get(1,zsig,"ZSIG","sub grid orography",0.)
427  found=phyetat0_get(1,zgam,"ZGAM","sub grid orography",0.)
428  found=phyetat0_get(1,zthe,"ZTHE","sub grid orography",0.)
429  found=phyetat0_get(1,zpic,"ZPIC","sub grid orography",0.)
430  found=phyetat0_get(1,zval,"ZVAL","sub grid orography",0.)
431  found=phyetat0_get(1,zmea,"ZMEA","sub grid orography",0.)
432  found=phyetat0_get(1,rugoro,"RUGSREL","sub grid orography",0.)
433
[2251]434!===========================================
435! Initialize ocean
436!===========================================
437
[2057]438  IF ( type_ocean == 'slab' ) THEN
[2209]439      CALL ocean_slab_init(dtime, pctsrf)
[2251]440      found=phyetat0_get(nslay,tslab,"tslab","tslab",0.)
[2057]441      IF (.NOT. found) THEN
442          PRINT*, "phyetat0: Le champ <tslab> est absent"
443          PRINT*, "Initialisation a tsol_oce"
444          DO i=1,nslay
[2209]445              tslab(:,i)=MAX(ftsol(:,is_oce),271.35)
[2057]446          END DO
447      END IF
[2251]448
[2209]449      ! Sea ice variables
[2251]450      found=phyetat0_get(1,tice,"slab_tice","slab_tice",0.)
[2209]451      IF (version_ocean == 'sicINT') THEN
452          IF (.NOT. found) THEN
453              PRINT*, "phyetat0: Le champ <tice> est absent"
454              PRINT*, "Initialisation a tsol_sic"
455                  tice(:)=ftsol(:,is_sic)
456          END IF
457          IF (.NOT. found) THEN
458              PRINT*, "phyetat0: Le champ <seaice> est absent"
459              PRINT*, "Initialisation a 0/1m suivant fraction glace"
460              seaice(:)=0.
461              WHERE (pctsrf(:,is_sic).GT.EPSFRA)
462                  seaice=917.
463              END WHERE
464          END IF
465      END IF !sea ice INT
[2057]466  END IF ! Slab       
467
[1827]468  ! on ferme le fichier
469  CALL close_startphy
470
471  ! Initialize module pbl_surface_mod
472
[2243]473  CALL pbl_surface_init(fder, snow, qsurf, tsoil)
[1827]474
475  ! Initialize module ocean_cpl_mod for the case of coupled ocean
476  IF ( type_ocean == 'couple' ) THEN
[2399]477     CALL ocean_cpl_init(dtime, longitude_deg, latitude_deg)
[1827]478  ENDIF
479
[2399]480  CALL init_iophy_new(latitude_deg, longitude_deg)
[2054]481
[1827]482  ! Initilialize module fonte_neige_mod     
483  CALL fonte_neige_init(run_off_lic_0)
484
485END SUBROUTINE phyetat0
[2243]486
487!===================================================================
488FUNCTION phyetat0_get(nlev,field,name,descr,default)
489!===================================================================
490! Lecture d'un champ avec contrôle
491! Function logique dont le resultat indique si la lecture
492! s'est bien passée
493! On donne une valeur par defaut dans le cas contraire
494!===================================================================
495
496USE iostart, ONLY : get_field
497USE dimphy, only: klon
[2311]498USE print_control_mod, ONLY: lunout
[2243]499
500IMPLICIT NONE
501
502LOGICAL phyetat0_get
503
504! arguments
505INTEGER,INTENT(IN) :: nlev
506CHARACTER*(*),INTENT(IN) :: name,descr
507REAL,INTENT(IN) :: default
508REAL,DIMENSION(klon,nlev),INTENT(INOUT) :: field
509
510! Local variables
511LOGICAL found
512
513   CALL get_field(name, field, found)
514   IF (.NOT. found) THEN
515     WRITE(lunout,*) "phyetat0: Le champ <",name,"> est absent"
516     WRITE(lunout,*) "Depart legerement fausse. Mais je continue"
517     field(:,:)=default
518   ENDIF
519   WRITE(lunout,*) name, descr, MINval(field),MAXval(field)
520   phyetat0_get=found
521
522RETURN
523END FUNCTION phyetat0_get
524
525!================================================================
526FUNCTION phyetat0_srf(nlev,field,name,descr,default)
527!===================================================================
528! Lecture d'un champ par sous-surface avec contrôle
529! Function logique dont le resultat indique si la lecture
530! s'est bien passée
531! On donne une valeur par defaut dans le cas contraire
532!===================================================================
533
534USE iostart, ONLY : get_field
535USE dimphy, only: klon
536USE indice_sol_mod, only: nbsrf
[2311]537USE print_control_mod, ONLY: lunout
[2243]538
539IMPLICIT NONE
540
541LOGICAL phyetat0_srf
542! arguments
543INTEGER,INTENT(IN) :: nlev
544CHARACTER*(*),INTENT(IN) :: name,descr
545REAL,INTENT(IN) :: default
546REAL,DIMENSION(klon,nlev,nbsrf),INTENT(INOUT) :: field
547
548! Local variables
549LOGICAL found,phyetat0_get
550INTEGER nsrf
551CHARACTER*2 str2
552 
553     IF (nbsrf.GT.99) THEN
554        WRITE(lunout,*) "Trop de sous-mailles"
[2311]555        call abort_physic("phyetat0", "", 1)
[2243]556     ENDIF
557
558     DO nsrf = 1, nbsrf
559        WRITE(str2, '(i2.2)') nsrf
560        found= phyetat0_get(nlev,field(:,:, nsrf), &
561        name//str2,descr//" srf:"//str2,default)
562     ENDDO
563
564     phyetat0_srf=found
565
566RETURN
567END FUNCTION phyetat0_srf
568
Note: See TracBrowser for help on using the repository browser.