source: LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phyetat0.F90 @ 4284

Last change on this file since 4284 was 4170, checked in by dcugnet, 2 years ago

The variable "types_trac" is the equivalent of "type_trac" in case multiple sections must be read
and used in "tracer.def" file.
Tests on the "type_trac" were replaced with tests on the vector "types_trac".
Most of the time, there are two components: 'lmdz' and a second one. The later has priority on 'lmdz'
and must be used for the tests. For more components, care must be taken to execute specific parts
of the code on the right tracers ; the tracers(:)%component has been created in that respect.

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