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

Last change on this file since 2243 was 2243, checked in by fhourdin, 9 years ago

Revisite de la formule des flux de surface
(en priorité sur l'océan) en tenant compte des bourrasques de
vent et de la différence entre les hauteurs de rugosités pour
la quantité de mouvement, l'enthalpie et éventuellement l'humidité.

Etape 2 :

  • Séparation des z0 pour la quantité de mouvement et l'enthalpie.

rugs (ou frugs, rugos, yrugos ...) disparait au profit de z0m, z0h.
Les variables qui étaient à la fois dans pbl_surface_init et

  • dans l'interface de pbl_surface sont suprimées de pbl_surface_init.

On travaille directement pour ces variables (evap, z0, qsol, agesno)
avec les versions de phys_state_var_mod (qui étaient
précédemment dans phys_local_var_mod

  • Nouveaux paramètres de contrôle :
    • iflag_z0_oce (par défaut 0, et seule option active jusque là)
    • z0m_seaice_omp, z0h_seaice_omp, comme leur nom l'indique (utilisées dans surf_landice
    • z0min appliqué sur z0m et z0h dans pbl_surface
  • Introduction des fonction phyeta0_get et phyetat0_srf pour lire

les conditions de initiales dans startphy.
Du coup une seule ligne suffit pour lire et contrôler d'éventuels
problèmes.

  • Pour la variable fxrugs, elle est remplacée par z0m(:,nbsrf+1)

Ce choix déjà utilisé pour d'autres variables pourrait être
systématiser pour alléger l'interface de pbl_surface_mod.

  • Dans les sorties, les variables rugs* ont été remplacées par

des z0m* et z0h*

  • Nettoyage des anciens alb1/alb2 dans les lectures/écritures

des états de redémarrage (et dans pbl_surface_mod.F90).
  • 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: 33.0 KB
Line 
1! $Id: phyetat0.F90 2243 2015-03-24 13:28:51Z fhourdin $
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, dv_gwd_rando, entr_therm, f0, fm_therm, &
14       falb_dir, falb_dif, &
15       ftsol, pbl_tke, pctsrf, q_ancien, radpas, radsol, rain_fall, ratqs, &
16       rlat, rlon, 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 iostart, ONLY : close_startphy, get_field, get_var, open_startphy
23  USE infotrac, only: nbtr, type_trac, tname, niadv
24  USE traclmdz_mod,    ONLY : traclmdz_from_restart
25  USE carbon_cycle_mod, ONLY : carbon_cycle_tr, carbon_cycle_cpl, co2_send
26  USE indice_sol_mod, only: nbsrf, is_ter, epsfra, is_lic, is_oce, is_sic
27  USE ocean_slab_mod, ONLY: tslab, seaice, tice, ocean_slab_init
28
29  IMPLICIT none
30  !======================================================================
31  ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
32  ! Objet: Lecture de l'etat initial pour la physique
33  !======================================================================
34  include "dimensions.h"
35  include "netcdf.inc"
36  include "dimsoil.h"
37  include "clesphys.h"
38  include "temps.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
75  ! FH1D
76  !     real iolat(jjm+1)
77  real iolat(jjm+1-1/(iim*jjm))
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
87!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
96!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
97
98  DO i = 1, length
99     tabcntr0( i ) = tab_cntrl( i )
100  ENDDO
101
102  tab_cntrl(1)=dtime
103  tab_cntrl(2)=radpas
104
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
111
112  ! co2_ppm0 : initial value of atmospheric CO2 (from create_etat0_limit.e .def)
113  co2_ppm0   = tab_cntrl(16)
114
115  solaire_etat0      = tab_cntrl(4)
116  tab_cntrl(5)=iflag_con
117  tab_cntrl(6)=nbapp_rad
118
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.
125
126  itau_phy = tab_cntrl(15)
127
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 )
136
137  ! Lecture des latitudes (coordonnees):
138
139  CALL get_field("latitude", rlat)
140
141  ! Lecture des longitudes (coordonnees):
142
143  CALL get_field("longitude", rlon)
144
145  ! Lecture du masque terre mer
146
147  CALL get_field("masque", zmasq, found)
148  IF (.NOT. found) THEN
149     PRINT*, 'phyetat0: Le champ <masque> est absent'
150     PRINT *, 'fichier startphy non compatible avec phyetat0'
151  ENDIF
152
153  ! Lecture des fractions pour chaque sous-surface
154
155  ! initialisation des sous-surfaces
156
157  pctsrf = 0.
158
159  ! fraction de terre
160
161  CALL get_field("FTER", pctsrf(:, is_ter), found)
162  IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FTER> est absent'
163
164  ! fraction de glace de terre
165
166  CALL get_field("FLIC", pctsrf(:, is_lic), found)
167  IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FLIC> est absent'
168
169  ! fraction d'ocean
170
171  CALL get_field("FOCE", pctsrf(:, is_oce), found)
172  IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FOCE> est absent'
173
174  ! fraction glace de mer
175
176  CALL get_field("FSIC", pctsrf(:, is_sic), found)
177  IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FSIC> est absent'
178
179  !  Verification de l'adequation entre le masque et les sous-surfaces
180
181  fractint( 1 : klon) = pctsrf(1 : klon, is_ter)  &
182       + pctsrf(1 : klon, is_lic)
183  DO i = 1 , klon
184     IF ( abs(fractint(i) - zmasq(i) ) .GT. EPSFRA ) THEN
185        WRITE(*, *) 'phyetat0: attention fraction terre pas ',  &
186             'coherente ', i, zmasq(i), pctsrf(i, is_ter) &
187             , pctsrf(i, is_lic)
188        WRITE(*, *) 'Je force la coherence zmasq=fractint'
189        zmasq(i) = fractint(i)
190     ENDIF
191  END DO
192  fractint (1 : klon) =  pctsrf(1 : klon, is_oce)  &
193       + pctsrf(1 : klon, is_sic)
194  DO i = 1 , klon
195     IF ( abs( fractint(i) - (1. - zmasq(i))) .GT. EPSFRA ) THEN
196        WRITE(*, *) 'phyetat0 attention fraction ocean pas ',  &
197             'coherente ', i, zmasq(i) , pctsrf(i, is_oce) &
198             , pctsrf(i, is_sic)
199        WRITE(*, *) 'Je force la coherence zmasq=1.-fractint'
200        zmasq(i) = 1. - fractint(i)
201     ENDIF
202  END DO
203
204  ! Lecture des temperatures du sol:
205
206  CALL get_field("TS", ftsol(:, 1), found)
207  IF (.NOT. found) THEN
208     PRINT*, 'phyetat0: Le champ <TS> est absent'
209     PRINT*, '          Mais je vais essayer de lire TS**'
210     DO nsrf = 1, nbsrf
211        IF (nsrf.GT.99) THEN
212           PRINT*, "Trop de sous-mailles"
213           call abort_gcm("phyetat0", "", 1)
214        ENDIF
215        WRITE(str2, '(i2.2)') nsrf
216        CALL get_field("TS"//str2, ftsol(:, nsrf))
217
218        xmin = 1.0E+20
219        xmax = -1.0E+20
220        DO i = 1, klon
221           xmin = MIN(ftsol(i, nsrf), xmin)
222           xmax = MAX(ftsol(i, nsrf), xmax)
223        ENDDO
224        PRINT*, 'Temperature du sol TS**:', nsrf, xmin, xmax
225     ENDDO
226  ELSE
227     PRINT*, 'phyetat0: Le champ <TS> est present'
228     PRINT*, '          J ignore donc les autres temperatures TS**'
229     xmin = 1.0E+20
230     xmax = -1.0E+20
231     DO i = 1, klon
232        xmin = MIN(ftsol(i, 1), xmin)
233        xmax = MAX(ftsol(i, 1), xmax)
234     ENDDO
235     PRINT*, 'Temperature du sol <TS>', xmin, xmax
236     DO nsrf = 2, nbsrf
237        DO i = 1, klon
238           ftsol(i, nsrf) = ftsol(i, 1)
239        ENDDO
240     ENDDO
241  ENDIF
242
243!===================================================================
244  ! Lecture des albedo difus et direct
245
246  DO nsrf = 1, nbsrf
247     DO isw=1, nsw
248        IF (isw.GT.99 .AND. nsrf.GT.99) THEN
249           PRINT*, "Trop de bandes SW ou sous-mailles"
250           call abort_gcm("phyetat0", "", 1)
251        ENDIF
252        WRITE(str7, '(i2.2, "srf", i2.2)') isw, nsrf
253
254        CALL get_field('A_dir_SW'//str7, falb_dir(:, isw, nsrf), found)
255        IF (.NOT. found) THEN
256           PRINT*, "phyetat0: Le champ <A_dir_SW"//str7//"> est absent"
257           PRINT*, "          Il prend donc la valeur de surface"
258           DO i=1, klon
259              falb_dir(i, isw, nsrf)=0.2
260           ENDDO
261        ENDIF
262        CALL get_field('A_dif_SW'//str7, falb_dif(:, isw, nsrf), found)
263        IF (.NOT. found) THEN
264           PRINT*, "phyetat0: Le champ <A_dif_SW"//str7//"> est absent"
265           PRINT*, "          Il prend donc la valeur de surface"
266           DO i=1, klon
267              falb_dif(i, isw, nsrf)=0.2
268           ENDDO
269        ENDIF
270     ENDDO
271  ENDDO
272
273!===================================================================
274  ! Lecture des temperatures du sol profond:
275
276  DO nsrf = 1, nbsrf
277     DO isoil=1, nsoilmx
278        IF (isoil.GT.99 .AND. nsrf.GT.99) THEN
279           PRINT*, "Trop de couches ou sous-mailles"
280           call abort_gcm("phyetat0", "", 1)
281        ENDIF
282        WRITE(str7, '(i2.2, "srf", i2.2)') isoil, nsrf
283
284        CALL get_field('Tsoil'//str7, tsoil(:, isoil, nsrf), found)
285        IF (.NOT. found) THEN
286           PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
287           PRINT*, "          Il prend donc la valeur de surface"
288           DO i=1, klon
289              tsoil(i, isoil, nsrf)=ftsol(i, nsrf)
290           ENDDO
291        ENDIF
292     ENDDO
293  ENDDO
294
295!===================================================================
296  ! Lecture de l'humidite de l'air juste au dessus du sol:
297
298  CALL get_field("QS", qsurf(:, 1), found)
299  IF (.NOT. found) THEN
300     PRINT*, 'phyetat0: Le champ <QS> est absent'
301     PRINT*, '          Mais je vais essayer de lire QS**'
302     DO nsrf = 1, nbsrf
303        IF (nsrf.GT.99) THEN
304           PRINT*, "Trop de sous-mailles"
305           call abort_gcm("phyetat0", "", 1)
306        ENDIF
307        WRITE(str2, '(i2.2)') nsrf
308        CALL get_field("QS"//str2, qsurf(:, nsrf))
309        xmin = 1.0E+20
310        xmax = -1.0E+20
311        DO i = 1, klon
312           xmin = MIN(qsurf(i, nsrf), xmin)
313           xmax = MAX(qsurf(i, nsrf), xmax)
314        ENDDO
315        PRINT*, 'Humidite pres du sol QS**:', nsrf, xmin, xmax
316     ENDDO
317  ELSE
318     PRINT*, 'phyetat0: Le champ <QS> est present'
319     PRINT*, '          J ignore donc les autres humidites QS**'
320     xmin = 1.0E+20
321     xmax = -1.0E+20
322     DO i = 1, klon
323        xmin = MIN(qsurf(i, 1), xmin)
324        xmax = MAX(qsurf(i, 1), xmax)
325     ENDDO
326     PRINT*, 'Humidite pres du sol <QS>', xmin, xmax
327     DO nsrf = 2, nbsrf
328        DO i = 1, klon
329           qsurf(i, nsrf) = qsurf(i, 1)
330        ENDDO
331     ENDDO
332  ENDIF
333
334  ! Eau dans le sol (pour le modele de sol "bucket")
335
336  CALL get_field("QSOL", qsol, found)
337  IF (.NOT. found) THEN
338     PRINT*, 'phyetat0: Le champ <QSOL> est absent'
339     PRINT*, '          Valeur par defaut nulle'
340     qsol(:)=0.
341  ENDIF
342
343  xmin = 1.0E+20
344  xmax = -1.0E+20
345  DO i = 1, klon
346     xmin = MIN(qsol(i), xmin)
347     xmax = MAX(qsol(i), xmax)
348  ENDDO
349  PRINT*, 'Eau dans le sol (mm) <QSOL>', xmin, xmax
350
351  ! Lecture de neige au sol:
352
353  CALL get_field("SNOW", snow(:, 1), found)
354  IF (.NOT. found) THEN
355     PRINT*, 'phyetat0: Le champ <SNOW> est absent'
356     PRINT*, '          Mais je vais essayer de lire SNOW**'
357     DO nsrf = 1, nbsrf
358        IF (nsrf.GT.99) THEN
359           PRINT*, "Trop de sous-mailles"
360           call abort_gcm("phyetat0", "", 1)
361        ENDIF
362        WRITE(str2, '(i2.2)') nsrf
363        CALL get_field( "SNOW"//str2, snow(:, nsrf))
364        xmin = 1.0E+20
365        xmax = -1.0E+20
366        DO i = 1, klon
367           xmin = MIN(snow(i, nsrf), xmin)
368           xmax = MAX(snow(i, nsrf), xmax)
369        ENDDO
370        PRINT*, 'Neige du sol SNOW**:', nsrf, xmin, xmax
371     ENDDO
372  ELSE
373     PRINT*, 'phyetat0: Le champ <SNOW> est present'
374     PRINT*, '          J ignore donc les autres neiges SNOW**'
375     xmin = 1.0E+20
376     xmax = -1.0E+20
377     DO i = 1, klon
378        xmin = MIN(snow(i, 1), xmin)
379        xmax = MAX(snow(i, 1), xmax)
380     ENDDO
381     PRINT*, 'Neige du sol <SNOW>', xmin, xmax
382     DO nsrf = 2, nbsrf
383        DO i = 1, klon
384           snow(i, nsrf) = snow(i, 1)
385        ENDDO
386     ENDDO
387  ENDIF
388
389  ! Lecture de evaporation: 
390
391  CALL get_field("EVAP", fevap(:, 1), found)
392  IF (.NOT. found) THEN
393     PRINT*, 'phyetat0: Le champ <EVAP> est absent'
394     PRINT*, '          Mais je vais essayer de lire EVAP**'
395     DO nsrf = 1, nbsrf
396        IF (nsrf.GT.99) THEN
397           PRINT*, "Trop de sous-mailles"
398           call abort_gcm("phyetat0", "", 1)
399        ENDIF
400        WRITE(str2, '(i2.2)') nsrf
401        CALL get_field("EVAP"//str2, fevap(:, nsrf))
402        xmin = 1.0E+20
403        xmax = -1.0E+20
404        DO i = 1, klon
405           xmin = MIN(fevap(i, nsrf), xmin)
406           xmax = MAX(fevap(i, nsrf), xmax)
407        ENDDO
408        PRINT*, 'fevap du sol EVAP**:', nsrf, xmin, xmax
409     ENDDO
410  ELSE
411     PRINT*, 'phyetat0: Le champ <EVAP> est present'
412     PRINT*, '          J ignore donc les autres EVAP**'
413     xmin = 1.0E+20
414     xmax = -1.0E+20
415     DO i = 1, klon
416        xmin = MIN(fevap(i, 1), xmin)
417        xmax = MAX(fevap(i, 1), xmax)
418     ENDDO
419     PRINT*, 'Evap du sol <EVAP>', xmin, xmax
420     DO nsrf = 2, nbsrf
421        DO i = 1, klon
422           fevap(i, nsrf) = fevap(i, 1)
423        ENDDO
424     ENDDO
425  ENDIF
426
427  ! Lecture precipitation liquide:
428
429  CALL get_field("rain_f", rain_fall)
430  xmin = 1.0E+20
431  xmax = -1.0E+20
432  DO i = 1, klon
433     xmin = MIN(rain_fall(i), xmin)
434     xmax = MAX(rain_fall(i), xmax)
435  ENDDO
436  PRINT*, 'Precipitation liquide rain_f:', xmin, xmax
437
438  ! Lecture precipitation solide:
439
440  CALL get_field("snow_f", snow_fall)
441  xmin = 1.0E+20
442  xmax = -1.0E+20
443  DO i = 1, klon
444     xmin = MIN(snow_fall(i), xmin)
445     xmax = MAX(snow_fall(i), xmax)
446  ENDDO
447  PRINT*, 'Precipitation solide snow_f:', xmin, xmax
448
449  ! Lecture rayonnement solaire au sol:
450
451  CALL get_field("solsw", solsw, found)
452  IF (.NOT. found) THEN
453     PRINT*, 'phyetat0: Le champ <solsw> est absent'
454     PRINT*, 'mis a zero'
455     solsw(:) = 0.
456  ENDIF
457  xmin = 1.0E+20
458  xmax = -1.0E+20
459  DO i = 1, klon
460     xmin = MIN(solsw(i), xmin)
461     xmax = MAX(solsw(i), xmax)
462  ENDDO
463  PRINT*, 'Rayonnement solaire au sol solsw:', xmin, xmax
464
465  ! Lecture rayonnement IF au sol:
466
467  CALL get_field("sollw", sollw, found)
468  IF (.NOT. found) THEN
469     PRINT*, 'phyetat0: Le champ <sollw> est absent'
470     PRINT*, 'mis a zero'
471     sollw = 0.
472  ENDIF
473  xmin = 1.0E+20
474  xmax = -1.0E+20
475  DO i = 1, klon
476     xmin = MIN(sollw(i), xmin)
477     xmax = MAX(sollw(i), xmax)
478  ENDDO
479  PRINT*, 'Rayonnement IF au sol sollw:', xmin, xmax
480
481  CALL get_field("sollwdown", sollwdown, found)
482  IF (.NOT. found) THEN
483     PRINT*, 'phyetat0: Le champ <sollwdown> est absent'
484     PRINT*, 'mis a zero'
485     sollwdown = 0.
486     zts=0.
487     do nsrf=1,nbsrf
488        zts(:)=zts(:)+ftsol(:,nsrf)*pctsrf(:,nsrf)
489     enddo
490     sollwdown(:)=sollw(:)+RSIGMA*zts(:)**4
491  ENDIF
492!  print*,'TS SOLL',zts(klon/2),sollw(klon/2),sollwdown(klon/2)
493  xmin = 1.0E+20
494  xmax = -1.0E+20
495  DO i = 1, klon
496     xmin = MIN(sollwdown(i), xmin)
497     xmax = MAX(sollwdown(i), xmax)
498  ENDDO
499  PRINT*, 'Rayonnement IF au sol sollwdown:', xmin, xmax
500
501
502  ! Lecture derive des flux:
503
504  CALL get_field("fder", fder, found)
505  IF (.NOT. found) THEN
506     PRINT*, 'phyetat0: Le champ <fder> est absent'
507     PRINT*, 'mis a zero'
508     fder = 0.
509  ENDIF
510  xmin = 1.0E+20
511  xmax = -1.0E+20
512  DO i = 1, klon
513     xmin = MIN(fder(i), xmin)
514     xmax = MAX(fder(i), xmax)
515  ENDDO
516  PRINT*, 'Derive des flux fder:', xmin, xmax
517
518  ! Lecture du rayonnement net au sol:
519
520  CALL get_field("RADS", radsol)
521  xmin = 1.0E+20
522  xmax = -1.0E+20
523  DO i = 1, klon
524     xmin = MIN(radsol(i), xmin)
525     xmax = MAX(radsol(i), xmax)
526  ENDDO
527  PRINT*, 'Rayonnement net au sol radsol:', xmin, xmax
528
529  ! Lecture de la longueur de rugosite
530
531IF (1==0) THEN ! A DERTRUIRE TOUT DE SUITE
532     DO nsrf = 1, nbsrf
533        IF (nsrf.GT.99) THEN
534           PRINT*, "Trop de sous-mailles"
535           call abort_gcm("phyetat0", "", 1)
536        ENDIF
537        WRITE(str2, '(i2.2)') nsrf
538! Retrocompatibilite. A nettoyer fin 2015
539        CALL get_field("RUG"//str2, z0m(:, nsrf),found)
540        IF (found) THEN
541            z0h(:,nsrf)=z0m(:,nsrf)
542            PRINT*,'Lecture de ',"RUG"//str2,' -> z0m/z0h (obsolete)'
543        ELSE
544            CALL get_field("Z0m"//str2, z0m(:, nsrf), found)
545            IF (.NOT.found) Z0m=1.e-3 ! initialisation à 1mm au cas ou.
546            CALL get_field("Z0h"//str2, z0h(:, nsrf), found)
547            IF (.NOT.found) Z0h=1.e-3 ! initialisation à 1mm au cas ou.
548        ENDIF
549        PRINT*, 'rugosite Z0m',nsrf,minval(z0m(:, nsrf)),maxval(z0m(:, nsrf))
550        PRINT*, 'rugosite Z0h',nsrf,minval(z0h(:, nsrf)),maxval(z0h(:, nsrf))
551
552     ENDDO
553ELSE
554  PRINT*,'AVANT phyetat0_srf'
555  found=phyetat0_srf(1,z0m,"RUG","Z0m ancien",0.001)
556  PRINT*,'APRES phyetat0_srf'
557  IF (found) THEN
558     z0h(:,1:nbsrf)=z0m(:,1:nbsrf)
559  ELSE
560     found=phyetat0_srf(1,z0m,"Z0m","Roughness length, momentum ",0.001)
561     found=phyetat0_srf(1,z0h,"Z0h","Roughness length, enthalpy ",0.001)
562  ENDIF
563ENDIF
564
565  ! Lecture de l'age de la neige:
566
567  CALL get_field("AGESNO", agesno(:, 1), found)
568  IF (.NOT. found) THEN
569     PRINT*, 'phyetat0: Le champ <AGESNO> est absent'
570     PRINT*, '          Mais je vais essayer de lire AGESNO**'
571     DO nsrf = 1, nbsrf
572        IF (nsrf.GT.99) THEN
573           PRINT*, "Trop de sous-mailles"
574           call abort_gcm("phyetat0", "", 1)
575        ENDIF
576        WRITE(str2, '(i2.2)') nsrf
577        CALL get_field("AGESNO"//str2, agesno(:, nsrf), found)
578        IF (.NOT. found) THEN
579           PRINT*, "phyetat0: Le champ <AGESNO"//str2//"> est absent"
580           agesno = 50.0
581        ENDIF
582        PRINT*, 'agesno',nsrf,minval(agesno(:, nsrf)),maxval(agesno(:, nsrf))
583     ENDDO
584  ELSE
585     PRINT*, 'phyetat0: Le champ <AGESNO> est present'
586     PRINT*, '          J ignore donc les autres AGESNO**'
587     xmin = 1.0E+20
588     xmax = -1.0E+20
589     DO i = 1, klon
590        xmin = MIN(agesno(i, 1), xmin)
591        xmax = MAX(agesno(i, 1), xmax)
592     ENDDO
593     PRINT*, 'Age de la neige <AGESNO>', xmin, xmax
594     DO nsrf = 2, nbsrf
595        DO i = 1, klon
596           agesno(i, nsrf) = agesno(i, 1)
597        ENDDO
598     ENDDO
599  ENDIF
600
601!  CALL get_field("ZMEA", zmea)
602!  PRINT*, 'OROGRAPHIE SOUS-MAILLE zmea:',minval(zmea(:)),maxval(zmea(:))
603  found=phyetat0_get(1,zmea,"ZMEA","mean orography",0.)
604
605  CALL get_field("ZSTD", zstd)
606  PRINT*, 'OROGRAPHIE SOUS-MAILLE zstd:',minval(zstd(:)),maxval(zstd(:))
607
608  CALL get_field("ZSIG", zsig)
609  PRINT*, 'OROGRAPHIE SOUS-MAILLE zsig:',minval(zsig(:)),maxval(zsig(:))
610
611  CALL get_field("ZGAM", zgam)
612  PRINT*, 'OROGRAPHIE SOUS-MAILLE zgam:',minval(zgam(:)),maxval(zgam(:))
613
614  CALL get_field("ZTHE", zthe)
615  PRINT*, 'OROGRAPHIE SOUS-MAILLE zthe:',minval(zthe(:)),maxval(zthe(:))
616
617  CALL get_field("ZPIC", zpic)
618  PRINT*, 'OROGRAPHIE SOUS-MAILLE zpic:',minval(zpic(:)),maxval(zpic(:))
619
620  CALL get_field("ZVAL", zval)
621  PRINT*, 'OROGRAPHIE SOUS-MAILLE zval:',minval(zval(:)),maxval(zval(:))
622
623  CALL get_field("RUGSREL", rugoro)
624  PRINT*, 'Rugosite relief (ecart-type) rugsrel:',minval(rugoro(:)),maxval(rugoro(:))
625
626  ancien_ok = .TRUE.
627
628  CALL get_field("TANCIEN", t_ancien, found)
629  IF (.NOT. found) THEN
630     PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
631     PRINT*, "Depart legerement fausse. Mais je continue"
632     ancien_ok = .FALSE.
633  ENDIF
634
635  CALL get_field("QANCIEN", q_ancien, found)
636  IF (.NOT. found) THEN
637     PRINT*, "phyetat0: Le champ <QANCIEN> est absent"
638     PRINT*, "Depart legerement fausse. Mais je continue"
639     ancien_ok = .FALSE.
640  ENDIF
641
642  CALL get_field("UANCIEN", u_ancien, found)
643  IF (.NOT. found) THEN
644     PRINT*, "phyetat0: Le champ <UANCIEN> est absent"
645     PRINT*, "Depart legerement fausse. Mais je continue"
646     ancien_ok = .FALSE.
647  ENDIF
648
649  CALL get_field("VANCIEN", v_ancien, found)
650  IF (.NOT. found) THEN
651     PRINT*, "phyetat0: Le champ <VANCIEN> est absent"
652     PRINT*, "Depart legerement fausse. Mais je continue"
653     ancien_ok = .FALSE.
654  ENDIF
655
656  clwcon=0.
657  CALL get_field("CLWCON", clwcon, found)
658  IF (.NOT. found) THEN
659     PRINT*, "phyetat0: Le champ CLWCON est absent"
660     PRINT*, "Depart legerement fausse. Mais je continue"
661  ENDIF
662  PRINT*,'Eau liquide convective (ecart-type) clwcon:',MINval(clwcon),MAXval(clwcon)
663
664
665  rnebcon = 0.
666  CALL get_field("RNEBCON", rnebcon, found)
667  IF (.NOT. found) THEN
668     PRINT*, "phyetat0: Le champ RNEBCON est absent"
669     PRINT*, "Depart legerement fausse. Mais je continue"
670  ENDIF
671  PRINT*, 'Nebulosite convective (ecart-type) rnebcon:',MINval(rnebcon),MAXval(rnebcon)
672
673  ! Lecture ratqs
674
675  ratqs=0.
676  CALL get_field("RATQS", ratqs, found)
677  IF (.NOT. found) THEN
678     PRINT*, "phyetat0: Le champ <RATQS> est absent"
679     PRINT*, "Depart legerement fausse. Mais je continue"
680  ENDIF
681  PRINT*, '(ecart-type) ratqs:', MINval(ratqs),MAXval(ratqs)
682
683  ! Lecture run_off_lic_0
684
685  CALL get_field("RUNOFFLIC0", run_off_lic_0, found)
686  IF (.NOT. found) THEN
687     PRINT*, "phyetat0: Le champ <RUNOFFLIC0> est absent"
688     PRINT*, "Depart legerement fausse. Mais je continue"
689     run_off_lic_0 = 0.
690  ENDIF
691  PRINT*, '(ecart-type) run_off_lic_0:', MINval(run_off_lic_0),MAXval(run_off_lic_0)
692
693  ! Lecture de l'energie cinetique turbulente
694
695  IF (iflag_pbl>1) then
696     DO nsrf = 1, nbsrf
697        IF (nsrf.GT.99) THEN
698           PRINT*, "Trop de sous-mailles"
699           call abort_gcm("phyetat0", "", 1)
700        ENDIF
701        WRITE(str2, '(i2.2)') nsrf
702        CALL get_field("TKE"//str2, pbl_tke(:, 1:klev+1, nsrf), found)
703        IF (.NOT. found) THEN
704           PRINT*, "phyetat0: <TKE"//str2//"> est absent"
705           pbl_tke(:, :, nsrf)=1.e-8
706        ENDIF
707        PRINT*, 'Turbulent kinetic energyl TKE**:', nsrf, minval(pbl_tke(:,:,nsrf)),maxval(pbl_tke(:,:, nsrf))
708
709     ENDDO
710  ENDIF
711
712! Lecture de l'ecart de TKE (w) - (x)
713!
714  IF (iflag_pbl>1 .AND. iflag_wake>=1  &
715           .AND. iflag_pbl_split >=1 ) then
716    DO nsrf = 1, nbsrf
717      IF (nsrf.GT.99) THEN
718        PRINT*, "Trop de sous-mailles"
719        call abort_gcm("phyetat0", "", 1)
720      ENDIF
721      WRITE(str2,'(i2.2)') nsrf
722      CALL get_field("DELTATKE"//str2, &
723                    wake_delta_pbl_tke(:,1:klev+1,nsrf),found)
724      IF (.NOT. found) THEN
725        PRINT*, "phyetat0: <DELTATKE"//str2//"> est absent"
726        wake_delta_pbl_tke(:,:,nsrf)=0.
727      ENDIF
728      PRINT*,'TKE difference (w)-(x) DELTATKE**:', nsrf,       &
729      minval(wake_delta_pbl_tke(:,:,nsrf)),maxval(wake_delta_pbl_tke(:,:, nsrf))
730
731    ENDDO
732
733  ! delta_tsurf
734
735    DO nsrf = 1, nbsrf
736       IF (nsrf.GT.99) THEN
737         PRINT*, "Trop de sous-mailles"
738         call abort_gcm("phyetat0", "", 1)
739       ENDIF
740       WRITE(str2,'(i2.2)') nsrf
741     CALL get_field("DELTA_TSURF"//str2, delta_tsurf(:,nsrf), found)
742     IF (.NOT. found) THEN
743        PRINT*, "phyetat0: Le champ <DELTA_TSURF"//str2//"> est absent"
744        PRINT*, "Depart legerement fausse. Mais je continue"
745        delta_tsurf(:,nsrf)=0.
746     ELSE
747        PRINT*, 'delta_tsurf:', nsrf,       &
748      minval(delta_tsurf(:,nsrf)),maxval(delta_tsurf(:, nsrf))
749     ENDIF
750    ENDDO  ! nsrf = 1, nbsrf
751  ENDIF   !(iflag_pbl>1 .AND. iflag_wake>=1 .AND. iflag_pbl_split >=1 )
752
753  ! zmax0
754  CALL get_field("ZMAX0", zmax0, found)
755  IF (.NOT. found) THEN
756     PRINT*, "phyetat0: Le champ <ZMAX0> est absent"
757     PRINT*, "Depart legerement fausse. Mais je continue"
758     zmax0=40.
759  ENDIF
760  PRINT*, '(ecart-type) zmax0:', MINval(zmax0),MAXval(zmax0)
761
762  !           f0(ig)=1.e-5
763  ! f0
764  CALL get_field("F0", f0, found)
765  IF (.NOT. found) THEN
766     PRINT*, "phyetat0: Le champ <f0> est absent"
767     PRINT*, "Depart legerement fausse. Mais je continue"
768     f0=1.e-5
769  ENDIF
770  PRINT*, '(ecart-type) f0:', MINval(f0),MAXval(f0)
771
772  ! sig1 or ema_work1
773
774  CALL get_field("sig1", sig1, found)
775  IF (.NOT. found) CALL get_field("EMA_WORK1", sig1, found)
776  IF (.NOT. found) THEN
777     PRINT*, "phyetat0: Le champ sig1 est absent"
778     PRINT*, "Depart legerement fausse. Mais je continue"
779     sig1=0.
780  ELSE
781     PRINT*, 'sig1:',minval(sig1(:,:)),maxval(sig1(:,:))
782  ENDIF
783
784  ! w01 or ema_work2
785
786  CALL get_field("w01", w01, found)
787  IF (.NOT. found) CALL get_field("EMA_WORK2", w01, found)
788  IF (.NOT. found) THEN
789     PRINT*, "phyetat0: Le champ w01 est absent"
790     PRINT*, "Depart legerement fausse. Mais je continue"
791     w01=0.
792  ELSE
793     PRINT*, 'w01:', minval(w01(:,:)),maxval(w01(:,:))
794  ENDIF
795
796  ! wake_deltat
797
798  CALL get_field("WAKE_DELTAT", wake_deltat, found)
799  IF (.NOT. found) THEN
800     PRINT*, "phyetat0: Le champ <WAKE_DELTAT> est absent"
801     PRINT*, "Depart legerement fausse. Mais je continue"
802     wake_deltat=0.
803  ELSE
804     PRINT*, 'wake_deltat:',  minval(wake_deltat(:,:)),maxval(wake_deltat(:,:))
805  ENDIF
806
807  ! wake_deltaq
808
809  found=phyetat0_get(klev,wake_deltaq,"WAKE_DELTAQ","Delta hum. wake/env",0.)
810! CALL get_field("WAKE_DELTAQ", wake_deltaq, found)
811! IF (.NOT. found) THEN
812!    PRINT*, "phyetat0: Le champ <WAKE_DELTAQ> est absent"
813!    PRINT*, "Depart legerement fausse. Mais je continue"
814!    wake_deltaq=0.
815! ELSE
816!    PRINT*, 'wake_deltaq:',  minval(wake_deltaq(:,:)),maxval(wake_deltaq(:,:))
817! ENDIF
818
819  ! wake_s
820
821  CALL get_field("WAKE_S", wake_s, found)
822  IF (.NOT. found) THEN
823     PRINT*, "phyetat0: Le champ <WAKE_S> est absent"
824     PRINT*, "Depart legerement fausse. Mais je continue"
825     wake_s=0.
826  ENDIF
827  PRINT*, '(ecart-type) wake_s:', MINval(wake_s),MAXval(wake_s)
828
829  ! wake_cstar
830
831  CALL get_field("WAKE_CSTAR", wake_cstar, found)
832  IF (.NOT. found) THEN
833     PRINT*, "phyetat0: Le champ <WAKE_CSTAR> est absent"
834     PRINT*, "Depart legerement fausse. Mais je continue"
835     wake_cstar=0.
836  ENDIF
837  PRINT*, '(ecart-type) wake_cstar:', MINval(wake_cstar),MAXval(wake_cstar)
838
839  ! wake_pe
840
841  CALL get_field("WAKE_PE", wake_pe, found)
842  IF (.NOT. found) THEN
843     PRINT*, "phyetat0: Le champ <WAKE_PE> est absent"
844     PRINT*, "Depart legerement fausse. Mais je continue"
845     wake_pe=0.
846  ENDIF
847  xmin = 1.0E+20
848  xmax = -1.0E+20
849  xmin = MINval(wake_pe)
850  xmax = MAXval(wake_pe)
851  PRINT*, '(ecart-type) wake_pe:', xmin, xmax
852
853  ! wake_fip
854
855  CALL get_field("WAKE_FIP", wake_fip, found)
856  IF (.NOT. found) THEN
857     PRINT*, "phyetat0: Le champ <WAKE_FIP> est absent"
858     PRINT*, "Depart legerement fausse. Mais je continue"
859     wake_fip=0.
860  ENDIF
861  xmin = 1.0E+20
862  xmax = -1.0E+20
863  xmin = MINval(wake_fip)
864  xmax = MAXval(wake_fip)
865  PRINT*, '(ecart-type) wake_fip:', xmin, xmax
866
867  !  thermiques
868
869  CALL get_field("FM_THERM", fm_therm, found)
870  IF (.NOT. found) THEN
871     PRINT*, "phyetat0: Le champ <fm_therm> est absent"
872     PRINT*, "Depart legerement fausse. Mais je continue"
873     fm_therm=0.
874  ENDIF
875  xmin = 1.0E+20
876  xmax = -1.0E+20
877  xmin = MINval(fm_therm)
878  xmax = MAXval(fm_therm)
879  PRINT*, '(ecart-type) fm_therm:', xmin, xmax
880
881  CALL get_field("ENTR_THERM", entr_therm, found)
882  IF (.NOT. found) THEN
883     PRINT*, "phyetat0: Le champ <entr_therm> est absent"
884     PRINT*, "Depart legerement fausse. Mais je continue"
885     entr_therm=0.
886  ENDIF
887  xmin = 1.0E+20
888  xmax = -1.0E+20
889  xmin = MINval(entr_therm)
890  xmax = MAXval(entr_therm)
891  PRINT*, '(ecart-type) entr_therm:', xmin, xmax
892
893  CALL get_field("DETR_THERM", detr_therm, found)
894  IF (.NOT. found) THEN
895     PRINT*, "phyetat0: Le champ <detr_therm> est absent"
896     PRINT*, "Depart legerement fausse. Mais je continue"
897     detr_therm=0.
898  ENDIF
899  xmin = 1.0E+20
900  xmax = -1.0E+20
901  xmin = MINval(detr_therm)
902  xmax = MAXval(detr_therm)
903  PRINT*, '(ecart-type) detr_therm:', xmin, xmax
904
905  CALL get_field("ALE_BL", ale_bl, found)
906  IF (.NOT. found) THEN
907     PRINT*, "phyetat0: Le champ <ale_bl> est absent"
908     PRINT*, "Depart legerement fausse. Mais je continue"
909     ale_bl=0.
910  ENDIF
911  xmin = 1.0E+20
912  xmax = -1.0E+20
913  xmin = MINval(ale_bl)
914  xmax = MAXval(ale_bl)
915  PRINT*, '(ecart-type) ale_bl:', xmin, xmax
916
917  CALL get_field("ALE_BL_TRIG", ale_bl_trig, found)
918  IF (.NOT. found) THEN
919     PRINT*, "phyetat0: Le champ <ale_bl_trig> est absent"
920     PRINT*, "Depart legerement fausse. Mais je continue"
921     ale_bl_trig=0.
922  ENDIF
923  xmin = 1.0E+20
924  xmax = -1.0E+20
925  xmin = MINval(ale_bl_trig)
926  xmax = MAXval(ale_bl_trig)
927  PRINT*, '(ecart-type) ale_bl_trig:', xmin, xmax
928
929  CALL get_field("ALP_BL", alp_bl, found)
930  IF (.NOT. found) THEN
931     PRINT*, "phyetat0: Le champ <alp_bl> est absent"
932     PRINT*, "Depart legerement fausse. Mais je continue"
933     alp_bl=0.
934  ENDIF
935  xmin = 1.0E+20
936  xmax = -1.0E+20
937  xmin = MINval(alp_bl)
938  xmax = MAXval(alp_bl)
939  PRINT*, '(ecart-type) alp_bl:', xmin, xmax
940
941  ! Read and send field trs to traclmdz
942
943  IF (type_trac == 'lmdz') THEN
944     DO it=1, nbtr
945        iiq=niadv(it+2)
946        CALL get_field("trs_"//tname(iiq), trs(:, it), found)
947        IF (.NOT. found) THEN
948           PRINT*,  &
949                "phyetat0: Le champ <trs_"//tname(iiq)//"> est absent"
950           PRINT*, "Depart legerement fausse. Mais je continue"
951           trs(:, it) = 0.
952        ENDIF
953        xmin = 1.0E+20
954        xmax = -1.0E+20
955        xmin = MINval(trs(:, it))
956        xmax = MAXval(trs(:, it))
957        PRINT*, "(ecart-type) trs_"//tname(iiq)//" :", xmin, xmax
958
959     END DO
960     CALL traclmdz_from_restart(trs)
961
962     IF (carbon_cycle_cpl) THEN
963        ALLOCATE(co2_send(klon), stat=ierr)
964        IF (ierr /= 0) CALL abort_gcm &
965             ('phyetat0', 'pb allocation co2_send', 1)
966        CALL get_field("co2_send", co2_send, found)
967        IF (.NOT. found) THEN
968           PRINT*, "phyetat0: Le champ <co2_send> est absent"
969           PRINT*, "Initialisation uniforme a co2_ppm=", co2_ppm
970           co2_send(:) = co2_ppm
971        END IF
972     END IF
973  END IF
974
975  if (ok_gwd_rando) then
976     call get_field("du_gwd_rando", du_gwd_rando, found)
977     if (.not. found) then
978        print *, "du_gwd_rando not found, setting it to 0."
979        du_gwd_rando = 0.
980     end if
981
982     call get_field("dv_gwd_rando", dv_gwd_rando, found)
983     if (.not. found) then
984        print *, "dv_gwd_rando not found, setting it to 0."
985        dv_gwd_rando = 0.
986     end if
987  end if
988
989  ! Initialize Slab variables
990  IF ( type_ocean == 'slab' ) THEN
991      print*, "calling slab_init"
992      CALL ocean_slab_init(dtime, pctsrf)
993      ! tslab
994      CALL get_field("tslab", tslab, found)
995      IF (.NOT. found) THEN
996          PRINT*, "phyetat0: Le champ <tslab> est absent"
997          PRINT*, "Initialisation a tsol_oce"
998          DO i=1,nslay
999              tslab(:,i)=MAX(ftsol(:,is_oce),271.35)
1000          END DO
1001      END IF
1002      ! Sea ice variables
1003      IF (version_ocean == 'sicINT') THEN
1004          CALL get_field("slab_tice", tice, found)
1005          IF (.NOT. found) THEN
1006              PRINT*, "phyetat0: Le champ <tice> est absent"
1007              PRINT*, "Initialisation a tsol_sic"
1008                  tice(:)=ftsol(:,is_sic)
1009          END IF
1010          CALL get_field("seaice", seaice, found)
1011          IF (.NOT. found) THEN
1012              PRINT*, "phyetat0: Le champ <seaice> est absent"
1013              PRINT*, "Initialisation a 0/1m suivant fraction glace"
1014              seaice(:)=0.
1015              WHERE (pctsrf(:,is_sic).GT.EPSFRA)
1016                  seaice=917.
1017              END WHERE
1018          END IF
1019      END IF !sea ice INT
1020  END IF ! Slab       
1021
1022  ! on ferme le fichier
1023  CALL close_startphy
1024
1025  ! Initialize module pbl_surface_mod
1026
1027  CALL pbl_surface_init(fder, snow, qsurf, tsoil)
1028
1029  ! Initialize module ocean_cpl_mod for the case of coupled ocean
1030  IF ( type_ocean == 'couple' ) THEN
1031     CALL ocean_cpl_init(dtime, rlon, rlat)
1032  ENDIF
1033
1034  CALL init_iophy_new(rlat, rlon)
1035
1036  ! Initilialize module fonte_neige_mod     
1037  CALL fonte_neige_init(run_off_lic_0)
1038
1039END SUBROUTINE phyetat0
1040
1041!===================================================================
1042FUNCTION phyetat0_get(nlev,field,name,descr,default)
1043!===================================================================
1044! Lecture d'un champ avec contrôle
1045! Function logique dont le resultat indique si la lecture
1046! s'est bien passée
1047! On donne une valeur par defaut dans le cas contraire
1048!===================================================================
1049
1050USE iostart, ONLY : get_field
1051USE dimphy, only: klon
1052
1053IMPLICIT NONE
1054INCLUDE "iniprint.h"
1055
1056LOGICAL phyetat0_get
1057
1058! arguments
1059INTEGER,INTENT(IN) :: nlev
1060CHARACTER*(*),INTENT(IN) :: name,descr
1061REAL,INTENT(IN) :: default
1062REAL,DIMENSION(klon,nlev),INTENT(INOUT) :: field
1063
1064! Local variables
1065LOGICAL found
1066
1067   CALL get_field(name, field, found)
1068   IF (.NOT. found) THEN
1069     WRITE(lunout,*) "phyetat0: Le champ <",name,"> est absent"
1070     WRITE(lunout,*) "Depart legerement fausse. Mais je continue"
1071     field(:,:)=default
1072   ENDIF
1073   WRITE(lunout,*) name, descr, MINval(field),MAXval(field)
1074   phyetat0_get=found
1075
1076RETURN
1077END FUNCTION phyetat0_get
1078
1079!================================================================
1080FUNCTION phyetat0_srf(nlev,field,name,descr,default)
1081!===================================================================
1082! Lecture d'un champ par sous-surface avec contrôle
1083! Function logique dont le resultat indique si la lecture
1084! s'est bien passée
1085! On donne une valeur par defaut dans le cas contraire
1086!===================================================================
1087
1088USE iostart, ONLY : get_field
1089USE dimphy, only: klon
1090USE indice_sol_mod, only: nbsrf
1091
1092IMPLICIT NONE
1093INCLUDE "iniprint.h"
1094
1095LOGICAL phyetat0_srf
1096! arguments
1097INTEGER,INTENT(IN) :: nlev
1098CHARACTER*(*),INTENT(IN) :: name,descr
1099REAL,INTENT(IN) :: default
1100REAL,DIMENSION(klon,nlev,nbsrf),INTENT(INOUT) :: field
1101
1102! Local variables
1103LOGICAL found,phyetat0_get
1104INTEGER nsrf
1105CHARACTER*2 str2
1106 
1107     IF (nbsrf.GT.99) THEN
1108        WRITE(lunout,*) "Trop de sous-mailles"
1109        call abort_gcm("phyetat0", "", 1)
1110     ENDIF
1111
1112     DO nsrf = 1, nbsrf
1113        WRITE(str2, '(i2.2)') nsrf
1114        found= phyetat0_get(nlev,field(:,:, nsrf), &
1115        name//str2,descr//" srf:"//str2,default)
1116     ENDDO
1117
1118     phyetat0_srf=found
1119
1120RETURN
1121END FUNCTION phyetat0_srf
1122
Note: See TracBrowser for help on using the repository browser.