source: LMDZ6/branches/LMDZ-tracers/libf/phylmd/phyetat0.F90 @ 3871

Last change on this file since 3871 was 3852, checked in by dcugnet, 4 years ago

Extension of the tracers management.

The tracers files can be:

1) "traceur.def": old format, with:

  • the number of tracers on the first line
  • one line for each tracer: <tracer name> <hadv> <vadv> [<parent name>]

2) "tracer.def": new format with one section each model component.
3) "tracer_<name>.def": new format with a single section.

The formats 2 and 3 reading is driven by the "type_trac" key, which can be a

coma-separated list of components.

  • Format 2: read the sections from the "tracer.def" file.
  • format 3: read one section each "tracer_<section name>.def" file.
  • the first line of a section is "&<section name>
  • the other lines start with a tracer name followed by <key>=<val> pairs.
  • the "default" tracer name is reserved ; the other tracers of the section inherit its <key>=<val>, except for the keys that are redefined locally.

This format helps keeping the tracers files compact, thanks to the "default"
special tracer and the three levels of factorization:

  • on the tracers names: a tracer name can be a coma-separated list of tracers => all the tracers of the list have the same <key>=<val> properties
  • on the parents names: the value of the "parent" property can be a coma-separated list of tracers => only possible for geographic tagging tracers
  • on the phases: the property "phases" is [g](l][s] (gas/liquid/solid)

Read information is stored in the vector "tracers(:)", of derived type "tra".

"isotopes_params.def" is a similar file, with one section each isotopes family.
It contains a database of isotopes properties ; if there are second generation
tracers (isotopes), the corresponding sections are read.

Read information is stored in the vector "isotopes(:)", of derived type "iso".

The "getKey" function helps to get the values of the parameters stored in
"tracers" or "isotopes".

  • 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: 22.6 KB
Line 
1! $Id: phyetat0.F90 3852 2021-02-22 16:28:31Z acozic $
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, 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, wake_fip, wake_pe, &
19       wake_s, wake_dens, 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
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: nbtr, nqo, type_trac, tracers, niadv
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 "thermcell.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, iiq, 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,u_ancien,"UANCIEN","UANCIEN",0.)
364  ancien_ok=ancien_ok.AND.phyetat0_get(klev,v_ancien,"VANCIEN","VANCIEN",0.)
365  ancien_ok=ancien_ok.AND.phyetat0_get(1,prw_ancien,"PRWANCIEN","PRWANCIEN",0.)
366  ancien_ok=ancien_ok.AND.phyetat0_get(1,prlw_ancien,"PRLWANCIEN","PRLWANCIEN",0.)
367  ancien_ok=ancien_ok.AND.phyetat0_get(1,prsw_ancien,"PRSWANCIEN","PRSWANCIEN",0.)
368
369  ! Ehouarn: addtional tests to check if t_ancien, q_ancien contain
370  !          dummy values (as is the case when generated by ce0l,
371  !          or by iniaqua)
372  IF ( (maxval(q_ancien).EQ.minval(q_ancien))       .OR. &
373       (maxval(ql_ancien).EQ.minval(ql_ancien))     .OR. &
374       (maxval(qs_ancien).EQ.minval(qs_ancien))     .OR. &
375       (maxval(prw_ancien).EQ.minval(prw_ancien))   .OR. &
376       (maxval(prlw_ancien).EQ.minval(prlw_ancien)) .OR. &
377       (maxval(prsw_ancien).EQ.minval(prsw_ancien)) .OR. &
378       (maxval(t_ancien).EQ.minval(t_ancien)) ) THEN
379    ancien_ok=.false.
380  ENDIF
381
382  found=phyetat0_get(klev,clwcon,"CLWCON","CLWCON",0.)
383  found=phyetat0_get(klev,rnebcon,"RNEBCON","RNEBCON",0.)
384  found=phyetat0_get(klev,ratqs,"RATQS","RATQS",0.)
385
386  found=phyetat0_get(1,run_off_lic_0,"RUNOFFLIC0","RUNOFFLIC0",0.)
387
388!==================================
389!  TKE
390!==================================
391!
392  IF (iflag_pbl>1) then
393     found=phyetat0_srf(klev+1,pbl_tke,"TKE","Turb. Kinetic. Energ. ",1.e-8)
394  ENDIF
395
396  IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1 ) then
397    found=phyetat0_srf(klev+1,wake_delta_pbl_tke,"DELTATKE","Del TKE wk/env",0.)
398    found=phyetat0_srf(1,delta_tsurf,"DELTA_TSURF","Delta Ts wk/env ",0.)
399  ENDIF   !(iflag_pbl>1 .AND. iflag_wake>=1 .AND. iflag_pbl_split >=1 )
400
401!==================================
402!  thermiques, poches, convection
403!==================================
404
405! Emanuel
406  found=phyetat0_get(klev,sig1,"sig1","sig1",0.)
407  found=phyetat0_get(klev,w01,"w01","w01",0.)
408
409! Wake
410  found=phyetat0_get(klev,wake_deltat,"WAKE_DELTAT","Delta T wake/env",0.)
411  found=phyetat0_get(klev,wake_deltaq,"WAKE_DELTAQ","Delta hum. wake/env",0.)
412  found=phyetat0_get(1,wake_s,"WAKE_S","Wake frac. area",0.)
413!jyg<
414!  Set wake_dens to -1000. when there is no restart so that the actual
415!  initialization is made in calwake.
416!!  found=phyetat0_get(1,wake_dens,"WAKE_DENS","Wake num. /unit area",0.)
417  found=phyetat0_get(1,wake_dens,"WAKE_DENS","Wake num. /unit area",-1000.)
418!>jyg
419  found=phyetat0_get(1,wake_cstar,"WAKE_CSTAR","WAKE_CSTAR",0.)
420  found=phyetat0_get(1,wake_pe,"WAKE_PE","WAKE_PE",0.)
421  found=phyetat0_get(1,wake_fip,"WAKE_FIP","WAKE_FIP",0.)
422
423! Thermiques
424  found=phyetat0_get(1,zmax0,"ZMAX0","ZMAX0",40.)
425  found=phyetat0_get(1,f0,"F0","F0",1.e-5)
426  found=phyetat0_get(klev+1,fm_therm,"FM_THERM","Thermals mass flux",0.)
427  found=phyetat0_get(klev,entr_therm,"ENTR_THERM","Thermals Entrain.",0.)
428  found=phyetat0_get(klev,detr_therm,"DETR_THERM","Thermals Detrain.",0.)
429
430! ALE/ALP
431  found=phyetat0_get(1,ale_bl,"ALE_BL","ALE BL",0.)
432  found=phyetat0_get(1,ale_bl_trig,"ALE_BL_TRIG","ALE BL_TRIG",0.)
433  found=phyetat0_get(1,alp_bl,"ALP_BL","ALP BL",0.)
434  found=phyetat0_get(1,ale_wake,"ALE_WAKE","ALE_WAKE",0.)
435  found=phyetat0_get(1,ale_bl_stat,"ALE_BL_STAT","ALE_BL_STAT",0.)
436
437!===========================================
438  ! Read and send field trs to traclmdz
439!===========================================
440
441  IF (type_trac == 'lmdz') THEN
442     DO it=1, nbtr                                                                 
443!!        iiq=niadv(it+2)                                                           ! jyg
444        iiq=niadv(it+nqo)                                                           ! jyg
445        found=phyetat0_get(1,trs(:,it),"trs_"//tracers(iiq)%name, &
446              "Surf trac"//tracers(iiq)%name,0.)
447     ENDDO
448     CALL traclmdz_from_restart(trs)
449  ENDIF
450
451!--OB now this is for co2i
452  IF (type_trac == 'co2i') 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  ENDIF
459
460!===========================================
461!  ondes de gravite / relief
462!===========================================
463
464!  ondes de gravite non orographiques
465  IF (ok_gwd_rando) found = &
466       phyetat0_get(klev,du_gwd_rando,"du_gwd_rando","du_gwd_rando",0.)
467  IF (.NOT. ok_hines .AND. ok_gwd_rando) found &
468       = phyetat0_get(klev,du_gwd_front,"du_gwd_front","du_gwd_front",0.)
469
470!  prise en compte du relief sous-maille
471  found=phyetat0_get(1,zmea,"ZMEA","sub grid orography",0.)
472  found=phyetat0_get(1,zstd,"ZSTD","sub grid orography",0.)
473  found=phyetat0_get(1,zsig,"ZSIG","sub grid orography",0.)
474  found=phyetat0_get(1,zgam,"ZGAM","sub grid orography",0.)
475  found=phyetat0_get(1,zthe,"ZTHE","sub grid orography",0.)
476  found=phyetat0_get(1,zpic,"ZPIC","sub grid orography",0.)
477  found=phyetat0_get(1,zval,"ZVAL","sub grid orography",0.)
478  found=phyetat0_get(1,zmea,"ZMEA","sub grid orography",0.)
479  found=phyetat0_get(1,rugoro,"RUGSREL","sub grid orography",0.)
480
481!===========================================
482! Initialize ocean
483!===========================================
484
485  IF ( type_ocean == 'slab' ) THEN
486      CALL ocean_slab_init(phys_tstep, pctsrf)
487      IF (nslay.EQ.1) THEN
488        found=phyetat0_get(1,tslab,"tslab01","tslab",0.)
489        IF (.NOT. found) THEN
490            found=phyetat0_get(1,tslab,"tslab","tslab",0.)
491        ENDIF
492      ELSE
493          DO i=1,nslay
494            WRITE(str2,'(i2.2)') i
495            found=phyetat0_get(1,tslab(:,i),"tslab"//str2,"tslab",0.) 
496          ENDDO
497      ENDIF
498      IF (.NOT. found) THEN
499          PRINT*, "phyetat0: Le champ <tslab> est absent"
500          PRINT*, "Initialisation a tsol_oce"
501          DO i=1,nslay
502              tslab(:,i)=MAX(ftsol(:,is_oce),271.35)
503          ENDDO
504      ENDIF
505
506      ! Sea ice variables
507      IF (version_ocean == 'sicINT') THEN
508          found=phyetat0_get(1,tice,"slab_tice","slab_tice",0.)
509          IF (.NOT. found) THEN
510              PRINT*, "phyetat0: Le champ <tice> est absent"
511              PRINT*, "Initialisation a tsol_sic"
512                  tice(:)=ftsol(:,is_sic)
513          ENDIF
514          found=phyetat0_get(1,seaice,"seaice","seaice",0.)
515          IF (.NOT. found) THEN
516              PRINT*, "phyetat0: Le champ <seaice> est absent"
517              PRINT*, "Initialisation a 0/1m suivant fraction glace"
518              seaice(:)=0.
519              WHERE (pctsrf(:,is_sic).GT.EPSFRA)
520                  seaice=917.
521              ENDWHERE
522          ENDIF
523      ENDIF !sea ice INT
524  ENDIF ! Slab       
525
526  if (activate_ocean_skin >= 1) then
527     if (activate_ocean_skin == 2 .and. type_ocean == 'couple') then
528        found = phyetat0_get(1, delta_sal, "delta_sal", &
529             "ocean-air interface salinity minus bulk salinity", 0.)
530        found = phyetat0_get(1, delta_sst, "delta_SST", &
531             "ocean-air interface temperature minus bulk SST", 0.)
532     end if
533     
534     found = phyetat0_get(1, ds_ns, "dS_ns", "delta salinity near surface", 0.)
535     found = phyetat0_get(1, dt_ns, "dT_ns", "delta temperature near surface", &
536          0.)
537
538     where (pctsrf(:, is_oce) == 0.)
539        ds_ns = missing_val
540        dt_ns = missing_val
541        delta_sst = missing_val
542        delta_sal = missing_val
543     end where
544  end if
545
546  ! on ferme le fichier
547  CALL close_startphy
548
549  ! Initialize module pbl_surface_mod
550
551  CALL pbl_surface_init(fder, snow, qsurf, tsoil)
552
553  ! Initialize module ocean_cpl_mod for the case of coupled ocean
554  IF ( type_ocean == 'couple' ) THEN
555     CALL ocean_cpl_init(phys_tstep, longitude_deg, latitude_deg)
556  ENDIF
557
558!  CALL init_iophy_new(latitude_deg, longitude_deg)
559
560  ! Initilialize module fonte_neige_mod     
561  CALL fonte_neige_init(run_off_lic_0)
562
563END SUBROUTINE phyetat0
564
565!===================================================================
566FUNCTION phyetat0_get(nlev,field,name,descr,default)
567!===================================================================
568! Lecture d'un champ avec contrôle
569! Function logique dont le resultat indique si la lecture
570! s'est bien passée
571! On donne une valeur par defaut dans le cas contraire
572!===================================================================
573
574USE iostart, ONLY : get_field
575USE dimphy, only: klon
576USE print_control_mod, ONLY: lunout
577
578IMPLICIT NONE
579
580LOGICAL phyetat0_get
581
582! arguments
583INTEGER,INTENT(IN) :: nlev
584CHARACTER*(*),INTENT(IN) :: name,descr
585REAL,INTENT(IN) :: default
586REAL,DIMENSION(klon,nlev),INTENT(INOUT) :: field
587
588! Local variables
589LOGICAL found
590
591   CALL get_field(name, field, found)
592   IF (.NOT. found) THEN
593     WRITE(lunout,*) "phyetat0: Le champ <",name,"> est absent"
594     WRITE(lunout,*) "Depart legerement fausse. Mais je continue"
595     field(:,:)=default
596   ENDIF
597   WRITE(lunout,*) name, descr, MINval(field),MAXval(field)
598   phyetat0_get=found
599
600RETURN
601END FUNCTION phyetat0_get
602
603!================================================================
604FUNCTION phyetat0_srf(nlev,field,name,descr,default)
605!===================================================================
606! Lecture d'un champ par sous-surface avec contrôle
607! Function logique dont le resultat indique si la lecture
608! s'est bien passée
609! On donne une valeur par defaut dans le cas contraire
610!===================================================================
611
612USE iostart, ONLY : get_field
613USE dimphy, only: klon
614USE indice_sol_mod, only: nbsrf
615USE print_control_mod, ONLY: lunout
616
617IMPLICIT NONE
618
619LOGICAL phyetat0_srf
620! arguments
621INTEGER,INTENT(IN) :: nlev
622CHARACTER*(*),INTENT(IN) :: name,descr
623REAL,INTENT(IN) :: default
624REAL,DIMENSION(klon,nlev,nbsrf),INTENT(INOUT) :: field
625
626! Local variables
627LOGICAL found,phyetat0_get
628INTEGER nsrf
629CHARACTER*2 str2
630 
631     IF (nbsrf.GT.99) THEN
632        WRITE(lunout,*) "Trop de sous-mailles"
633        call abort_physic("phyetat0", "", 1)
634     ENDIF
635
636     DO nsrf = 1, nbsrf
637        WRITE(str2, '(i2.2)') nsrf
638        found= phyetat0_get(nlev,field(:,:, nsrf), &
639        name//str2,descr//" srf:"//str2,default)
640     ENDDO
641
642     phyetat0_srf=found
643
644RETURN
645END FUNCTION phyetat0_srf
646
Note: See TracBrowser for help on using the repository browser.