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

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

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