source: LMDZ5/branches/LF-private/libf/phylmd/phyetat0.F90 @ 1910

Last change on this file since 1910 was 1827, checked in by lguez, 11 years ago

Changed names of variables ema_work1 and ema_work2 to more meaningful
sig1 and w01. Same change in (re)startphy.nc. phyetat0 tries to find
old names ema_work1 and ema_work2 if new names sig1 and w01 are not
found, so the program can run with an old restartphy.nc. restartphy.nc
is modified compared to the previous SVN revision because of the change of
names but the data content is not modified (this can be checked with
max_diff_nc.sh -i).

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 28.1 KB
Line 
1! $Id: phyetat0.F90 1827 2013-08-06 13:33:18Z fairhead $
2
3SUBROUTINE phyetat0 (fichnom, clesphy0, tabcntr0)
4
5  USE dimphy
6  USE mod_grid_phy_lmdz
7  USE mod_phys_lmdz_para
8  USE iophy
9  USE ocean_cpl_mod,    ONLY : ocean_cpl_init
10  USE fonte_neige_mod,  ONLY : fonte_neige_init
11  USE pbl_surface_mod,  ONLY : pbl_surface_init
12  USE surface_data,     ONLY : type_ocean
13  USE phys_state_var_mod
14  USE iostart
15  USE write_field_phy
16  USE infotrac
17  USE traclmdz_mod,    ONLY : traclmdz_from_restart
18  USE carbon_cycle_mod, ONLY : carbon_cycle_tr, carbon_cycle_cpl, co2_send
19  USE indice_sol_mod
20
21  IMPLICIT none
22  !======================================================================
23  ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
24  ! Objet: Lecture de l'etat initial pour la physique
25  !======================================================================
26  include "dimensions.h"
27  include "netcdf.inc"
28  include "dimsoil.h"
29  include "clesphys.h"
30  include "temps.h"
31  include "thermcell.h"
32  include "compbl.h"
33  !======================================================================
34  CHARACTER*(*) fichnom
35
36  ! les variables globales lues dans le fichier restart
37
38  REAL tsoil(klon, nsoilmx, nbsrf)
39  REAL tslab(klon), seaice(klon)
40  REAL qsurf(klon, nbsrf)
41  REAL qsol(klon)
42  REAL snow(klon, nbsrf)
43  REAL evap(klon, nbsrf)
44  real fder(klon)
45  REAL frugs(klon, nbsrf)
46  REAL agesno(klon, nbsrf)
47  REAL run_off_lic_0(klon)
48  REAL fractint(klon)
49  REAL trs(klon, nbtr)
50
51  CHARACTER*6 ocean_in
52  LOGICAL ok_veget_in
53
54  INTEGER        longcles
55  PARAMETER    ( longcles = 20 )
56  REAL clesphy0( longcles )
57
58  REAL xmin, xmax
59
60  INTEGER nid, nvarid
61  INTEGER ierr, i, nsrf, isoil , k
62  INTEGER length
63  PARAMETER (length=100)
64  INTEGER it, iiq
65  REAL tab_cntrl(length), tabcntr0(length)
66  CHARACTER*7 str7
67  CHARACTER*2 str2
68  LOGICAL :: found
69
70  ! FH1D
71  !     real iolat(jjm+1)
72  real iolat(jjm+1-1/(iim*jjm))
73
74  ! Ouvrir le fichier contenant l'etat initial:
75
76  CALL open_startphy(fichnom)
77
78  ! Lecture des parametres de controle:
79
80  CALL get_var("controle", tab_cntrl)
81
82!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
83  ! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
84  ! Les constantes de la physiques sont lues dans la physique seulement.
85  ! Les egalites du type
86  !             tab_cntrl( 5 )=clesphy0(1)
87  ! sont remplacees par
88  !             clesphy0(1)=tab_cntrl( 5 )
89  ! On inverse aussi la logique.
90  ! On remplit les tab_cntrl avec les parametres lus dans les .def
91!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
92
93  DO i = 1, length
94     tabcntr0( i ) = tab_cntrl( i )
95  ENDDO
96
97  tab_cntrl(1)=dtime
98  tab_cntrl(2)=radpas
99
100  ! co2_ppm : value from the previous time step
101  IF (carbon_cycle_tr .OR. carbon_cycle_cpl) THEN
102     co2_ppm = tab_cntrl(3)
103     RCO2    = co2_ppm * 1.0e-06  * 44.011/28.97
104     ! ELSE : keep value from .def
105  END IF
106
107  ! co2_ppm0 : initial value of atmospheric CO2 (from create_etat0_limit.e .def)
108  co2_ppm0   = tab_cntrl(16)
109
110  solaire_etat0      = tab_cntrl(4)
111  tab_cntrl(5)=iflag_con
112  tab_cntrl(6)=nbapp_rad
113
114  if (cycle_diurne) tab_cntrl( 7) =1.
115  if (soil_model) tab_cntrl( 8) =1.
116  if (new_oliq) tab_cntrl( 9) =1.
117  if (ok_orodr) tab_cntrl(10) =1.
118  if (ok_orolf) tab_cntrl(11) =1.
119  if (ok_limitvrai) tab_cntrl(12) =1.
120
121  itau_phy = tab_cntrl(15)
122
123  clesphy0(1)=tab_cntrl( 5 )
124  clesphy0(2)=tab_cntrl( 6 )
125  clesphy0(3)=tab_cntrl( 7 )
126  clesphy0(4)=tab_cntrl( 8 )
127  clesphy0(5)=tab_cntrl( 9 )
128  clesphy0(6)=tab_cntrl( 10 )
129  clesphy0(7)=tab_cntrl( 11 )
130  clesphy0(8)=tab_cntrl( 12 )
131
132  ! Lecture des latitudes (coordonnees):
133
134  CALL get_field("latitude", rlat)
135
136  ! Lecture des longitudes (coordonnees):
137
138  CALL get_field("longitude", rlon)
139
140  ! Lecture du masque terre mer
141
142  CALL get_field("masque", zmasq, found)
143  IF (.NOT. found) THEN
144     PRINT*, 'phyetat0: Le champ <masque> est absent'
145     PRINT *, 'fichier startphy non compatible avec phyetat0'
146  ENDIF
147
148  ! Lecture des fractions pour chaque sous-surface
149
150  ! initialisation des sous-surfaces
151
152  pctsrf = 0.
153
154  ! fraction de terre
155
156  CALL get_field("FTER", pctsrf(:, is_ter), found)
157  IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FTER> est absent'
158
159  ! fraction de glace de terre
160
161  CALL get_field("FLIC", pctsrf(:, is_lic), found)
162  IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FLIC> est absent'
163
164  ! fraction d'ocean
165
166  CALL get_field("FOCE", pctsrf(:, is_oce), found)
167  IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FOCE> est absent'
168
169  ! fraction glace de mer
170
171  CALL get_field("FSIC", pctsrf(:, is_sic), found)
172  IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FSIC> est absent'
173
174  !  Verification de l'adequation entre le masque et les sous-surfaces
175
176  fractint( 1 : klon) = pctsrf(1 : klon, is_ter)  &
177       + pctsrf(1 : klon, is_lic)
178  DO i = 1 , klon
179     IF ( abs(fractint(i) - zmasq(i) ) .GT. EPSFRA ) THEN
180        WRITE(*, *) 'phyetat0: attention fraction terre pas ',  &
181             'coherente ', i, zmasq(i), pctsrf(i, is_ter) &
182             , pctsrf(i, is_lic)
183        WRITE(*, *) 'Je force la coherence zmasq=fractint'
184        zmasq(i) = fractint(i)
185     ENDIF
186  END DO
187  fractint (1 : klon) =  pctsrf(1 : klon, is_oce)  &
188       + pctsrf(1 : klon, is_sic)
189  DO i = 1 , klon
190     IF ( abs( fractint(i) - (1. - zmasq(i))) .GT. EPSFRA ) THEN
191        WRITE(*, *) 'phyetat0 attention fraction ocean pas ',  &
192             'coherente ', i, zmasq(i) , pctsrf(i, is_oce) &
193             , pctsrf(i, is_sic)
194        WRITE(*, *) 'Je force la coherence zmasq=fractint'
195        zmasq(i) = fractint(i)
196     ENDIF
197  END DO
198
199  ! Lecture des temperatures du sol:
200
201  CALL get_field("TS", ftsol(:, 1), found)
202  IF (.NOT. found) THEN
203     PRINT*, 'phyetat0: Le champ <TS> est absent'
204     PRINT*, '          Mais je vais essayer de lire TS**'
205     DO nsrf = 1, nbsrf
206        IF (nsrf.GT.99) THEN
207           PRINT*, "Trop de sous-mailles"
208           CALL abort
209        ENDIF
210        WRITE(str2, '(i2.2)') nsrf
211        CALL get_field("TS"//str2, ftsol(:, nsrf))
212
213        xmin = 1.0E+20
214        xmax = -1.0E+20
215        DO i = 1, klon
216           xmin = MIN(ftsol(i, nsrf), xmin)
217           xmax = MAX(ftsol(i, nsrf), xmax)
218        ENDDO
219        PRINT*, 'Temperature du sol TS**:', nsrf, xmin, xmax
220     ENDDO
221  ELSE
222     PRINT*, 'phyetat0: Le champ <TS> est present'
223     PRINT*, '          J ignore donc les autres temperatures TS**'
224     xmin = 1.0E+20
225     xmax = -1.0E+20
226     DO i = 1, klon
227        xmin = MIN(ftsol(i, 1), xmin)
228        xmax = MAX(ftsol(i, 1), xmax)
229     ENDDO
230     PRINT*, 'Temperature du sol <TS>', xmin, xmax
231     DO nsrf = 2, nbsrf
232        DO i = 1, klon
233           ftsol(i, nsrf) = ftsol(i, 1)
234        ENDDO
235     ENDDO
236  ENDIF
237
238  ! Lecture des temperatures du sol profond:
239
240  DO nsrf = 1, nbsrf
241     DO isoil=1, nsoilmx
242        IF (isoil.GT.99 .AND. nsrf.GT.99) THEN
243           PRINT*, "Trop de couches ou sous-mailles"
244           CALL abort
245        ENDIF
246        WRITE(str7, '(i2.2, "srf", i2.2)') isoil, nsrf
247
248        CALL get_field('Tsoil'//str7, tsoil(:, isoil, nsrf), found)
249        IF (.NOT. found) THEN
250           PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
251           PRINT*, "          Il prend donc la valeur de surface"
252           DO i=1, klon
253              tsoil(i, isoil, nsrf)=ftsol(i, nsrf)
254           ENDDO
255        ENDIF
256     ENDDO
257  ENDDO
258
259  ! Lecture de l'humidite de l'air juste au dessus du sol:
260
261  CALL get_field("QS", qsurf(:, 1), found)
262  IF (.NOT. found) THEN
263     PRINT*, 'phyetat0: Le champ <QS> est absent'
264     PRINT*, '          Mais je vais essayer de lire QS**'
265     DO nsrf = 1, nbsrf
266        IF (nsrf.GT.99) THEN
267           PRINT*, "Trop de sous-mailles"
268           CALL abort
269        ENDIF
270        WRITE(str2, '(i2.2)') nsrf
271        CALL get_field("QS"//str2, qsurf(:, nsrf))
272        xmin = 1.0E+20
273        xmax = -1.0E+20
274        DO i = 1, klon
275           xmin = MIN(qsurf(i, nsrf), xmin)
276           xmax = MAX(qsurf(i, nsrf), xmax)
277        ENDDO
278        PRINT*, 'Humidite pres du sol QS**:', nsrf, xmin, xmax
279     ENDDO
280  ELSE
281     PRINT*, 'phyetat0: Le champ <QS> est present'
282     PRINT*, '          J ignore donc les autres humidites QS**'
283     xmin = 1.0E+20
284     xmax = -1.0E+20
285     DO i = 1, klon
286        xmin = MIN(qsurf(i, 1), xmin)
287        xmax = MAX(qsurf(i, 1), xmax)
288     ENDDO
289     PRINT*, 'Humidite pres du sol <QS>', xmin, xmax
290     DO nsrf = 2, nbsrf
291        DO i = 1, klon
292           qsurf(i, nsrf) = qsurf(i, 1)
293        ENDDO
294     ENDDO
295  ENDIF
296
297  ! Eau dans le sol (pour le modele de sol "bucket")
298
299  CALL get_field("QSOL", qsol, found)
300  IF (.NOT. found) THEN
301     PRINT*, 'phyetat0: Le champ <QSOL> est absent'
302     PRINT*, '          Valeur par defaut nulle'
303     qsol(:)=0.
304  ENDIF
305
306  xmin = 1.0E+20
307  xmax = -1.0E+20
308  DO i = 1, klon
309     xmin = MIN(qsol(i), xmin)
310     xmax = MAX(qsol(i), xmax)
311  ENDDO
312  PRINT*, 'Eau dans le sol (mm) <QSOL>', xmin, xmax
313
314  ! Lecture de neige au sol:
315
316  CALL get_field("SNOW", snow(:, 1), found)
317  IF (.NOT. found) THEN
318     PRINT*, 'phyetat0: Le champ <SNOW> est absent'
319     PRINT*, '          Mais je vais essayer de lire SNOW**'
320     DO nsrf = 1, nbsrf
321        IF (nsrf.GT.99) THEN
322           PRINT*, "Trop de sous-mailles"
323           CALL abort
324        ENDIF
325        WRITE(str2, '(i2.2)') nsrf
326        CALL get_field( "SNOW"//str2, snow(:, nsrf))
327        xmin = 1.0E+20
328        xmax = -1.0E+20
329        DO i = 1, klon
330           xmin = MIN(snow(i, nsrf), xmin)
331           xmax = MAX(snow(i, nsrf), xmax)
332        ENDDO
333        PRINT*, 'Neige du sol SNOW**:', nsrf, xmin, xmax
334     ENDDO
335  ELSE
336     PRINT*, 'phyetat0: Le champ <SNOW> est present'
337     PRINT*, '          J ignore donc les autres neiges SNOW**'
338     xmin = 1.0E+20
339     xmax = -1.0E+20
340     DO i = 1, klon
341        xmin = MIN(snow(i, 1), xmin)
342        xmax = MAX(snow(i, 1), xmax)
343     ENDDO
344     PRINT*, 'Neige du sol <SNOW>', xmin, xmax
345     DO nsrf = 2, nbsrf
346        DO i = 1, klon
347           snow(i, nsrf) = snow(i, 1)
348        ENDDO
349     ENDDO
350  ENDIF
351
352  ! Lecture de albedo de l'interval visible au sol:
353
354  CALL get_field("ALBE", falb1(:, 1), found)
355  IF (.NOT. found) THEN
356     PRINT*, 'phyetat0: Le champ <ALBE> est absent'
357     PRINT*, '          Mais je vais essayer de lire ALBE**'
358     DO nsrf = 1, nbsrf
359        IF (nsrf.GT.99) THEN
360           PRINT*, "Trop de sous-mailles"
361           CALL abort
362        ENDIF
363        WRITE(str2, '(i2.2)') nsrf
364        CALL get_field("ALBE"//str2, falb1(:, nsrf))
365        xmin = 1.0E+20
366        xmax = -1.0E+20
367        DO i = 1, klon
368           xmin = MIN(falb1(i, nsrf), xmin)
369           xmax = MAX(falb1(i, nsrf), xmax)
370        ENDDO
371        PRINT*, 'Albedo du sol ALBE**:', nsrf, xmin, xmax
372     ENDDO
373  ELSE
374     PRINT*, 'phyetat0: Le champ <ALBE> est present'
375     PRINT*, '          J ignore donc les autres ALBE**'
376     xmin = 1.0E+20
377     xmax = -1.0E+20
378     DO i = 1, klon
379        xmin = MIN(falb1(i, 1), xmin)
380        xmax = MAX(falb1(i, 1), xmax)
381     ENDDO
382     PRINT*, 'Neige du sol <ALBE>', xmin, xmax
383     DO nsrf = 2, nbsrf
384        DO i = 1, klon
385           falb1(i, nsrf) = falb1(i, 1)
386        ENDDO
387     ENDDO
388  ENDIF
389
390  ! Lecture de albedo au sol dans l'interval proche infra-rouge:
391
392  CALL get_field("ALBLW", falb2(:, 1), found)
393  IF (.NOT. found) THEN
394     PRINT*, 'phyetat0: Le champ <ALBLW> est absent'
395     PRINT*, '          Mais je vais prendre ALBE**'
396     DO nsrf = 1, nbsrf
397        DO i = 1, klon
398           falb2(i, nsrf) = falb1(i, nsrf)
399        ENDDO
400     ENDDO
401  ELSE
402     PRINT*, 'phyetat0: Le champ <ALBLW> est present'
403     PRINT*, '          J ignore donc les autres ALBLW**'
404     xmin = 1.0E+20
405     xmax = -1.0E+20
406     DO i = 1, klon
407        xmin = MIN(falb2(i, 1), xmin)
408        xmax = MAX(falb2(i, 1), xmax)
409     ENDDO
410     PRINT*, 'Neige du sol <ALBLW>', xmin, xmax
411     DO nsrf = 2, nbsrf
412        DO i = 1, klon
413           falb2(i, nsrf) = falb2(i, 1)
414        ENDDO
415     ENDDO
416  ENDIF
417
418  ! Lecture de evaporation: 
419
420  CALL get_field("EVAP", evap(:, 1), found)
421  IF (.NOT. found) THEN
422     PRINT*, 'phyetat0: Le champ <EVAP> est absent'
423     PRINT*, '          Mais je vais essayer de lire EVAP**'
424     DO nsrf = 1, nbsrf
425        IF (nsrf.GT.99) THEN
426           PRINT*, "Trop de sous-mailles"
427           CALL abort
428        ENDIF
429        WRITE(str2, '(i2.2)') nsrf
430        CALL get_field("EVAP"//str2, evap(:, nsrf))
431        xmin = 1.0E+20
432        xmax = -1.0E+20
433        DO i = 1, klon
434           xmin = MIN(evap(i, nsrf), xmin)
435           xmax = MAX(evap(i, nsrf), xmax)
436        ENDDO
437        PRINT*, 'evap du sol EVAP**:', nsrf, xmin, xmax
438     ENDDO
439  ELSE
440     PRINT*, 'phyetat0: Le champ <EVAP> est present'
441     PRINT*, '          J ignore donc les autres EVAP**'
442     xmin = 1.0E+20
443     xmax = -1.0E+20
444     DO i = 1, klon
445        xmin = MIN(evap(i, 1), xmin)
446        xmax = MAX(evap(i, 1), xmax)
447     ENDDO
448     PRINT*, 'Evap du sol <EVAP>', xmin, xmax
449     DO nsrf = 2, nbsrf
450        DO i = 1, klon
451           evap(i, nsrf) = evap(i, 1)
452        ENDDO
453     ENDDO
454  ENDIF
455
456  ! Lecture precipitation liquide:
457
458  CALL get_field("rain_f", rain_fall)
459  xmin = 1.0E+20
460  xmax = -1.0E+20
461  DO i = 1, klon
462     xmin = MIN(rain_fall(i), xmin)
463     xmax = MAX(rain_fall(i), xmax)
464  ENDDO
465  PRINT*, 'Precipitation liquide rain_f:', xmin, xmax
466
467  ! Lecture precipitation solide:
468
469  CALL get_field("snow_f", snow_fall)
470  xmin = 1.0E+20
471  xmax = -1.0E+20
472  DO i = 1, klon
473     xmin = MIN(snow_fall(i), xmin)
474     xmax = MAX(snow_fall(i), xmax)
475  ENDDO
476  PRINT*, 'Precipitation solide snow_f:', xmin, xmax
477
478  ! Lecture rayonnement solaire au sol:
479
480  CALL get_field("solsw", solsw, found)
481  IF (.NOT. found) THEN
482     PRINT*, 'phyetat0: Le champ <solsw> est absent'
483     PRINT*, 'mis a zero'
484     solsw(:) = 0.
485  ENDIF
486  xmin = 1.0E+20
487  xmax = -1.0E+20
488  DO i = 1, klon
489     xmin = MIN(solsw(i), xmin)
490     xmax = MAX(solsw(i), xmax)
491  ENDDO
492  PRINT*, 'Rayonnement solaire au sol solsw:', xmin, xmax
493
494  ! Lecture rayonnement IF au sol:
495
496  CALL get_field("sollw", sollw, found)
497  IF (.NOT. found) THEN
498     PRINT*, 'phyetat0: Le champ <sollw> est absent'
499     PRINT*, 'mis a zero'
500     sollw = 0.
501  ENDIF
502  xmin = 1.0E+20
503  xmax = -1.0E+20
504  DO i = 1, klon
505     xmin = MIN(sollw(i), xmin)
506     xmax = MAX(sollw(i), xmax)
507  ENDDO
508  PRINT*, 'Rayonnement IF au sol sollw:', xmin, xmax
509
510  ! Lecture derive des flux:
511
512  CALL get_field("fder", fder, found)
513  IF (.NOT. found) THEN
514     PRINT*, 'phyetat0: Le champ <fder> est absent'
515     PRINT*, 'mis a zero'
516     fder = 0.
517  ENDIF
518  xmin = 1.0E+20
519  xmax = -1.0E+20
520  DO i = 1, klon
521     xmin = MIN(fder(i), xmin)
522     xmax = MAX(fder(i), xmax)
523  ENDDO
524  PRINT*, 'Derive des flux fder:', xmin, xmax
525
526  ! Lecture du rayonnement net au sol:
527
528  CALL get_field("RADS", radsol)
529  xmin = 1.0E+20
530  xmax = -1.0E+20
531  DO i = 1, klon
532     xmin = MIN(radsol(i), xmin)
533     xmax = MAX(radsol(i), xmax)
534  ENDDO
535  PRINT*, 'Rayonnement net au sol radsol:', xmin, xmax
536
537  ! Lecture de la longueur de rugosite
538
539  CALL get_field("RUG", frugs(:, 1), found)
540  IF (.NOT. found) THEN
541     PRINT*, 'phyetat0: Le champ <RUG> est absent'
542     PRINT*, '          Mais je vais essayer de lire RUG**'
543     DO nsrf = 1, nbsrf
544        IF (nsrf.GT.99) THEN
545           PRINT*, "Trop de sous-mailles"
546           CALL abort
547        ENDIF
548        WRITE(str2, '(i2.2)') nsrf
549        CALL get_field("RUG"//str2, frugs(:, nsrf))
550        xmin = 1.0E+20
551        xmax = -1.0E+20
552        DO i = 1, klon
553           xmin = MIN(frugs(i, nsrf), xmin)
554           xmax = MAX(frugs(i, nsrf), xmax)
555        ENDDO
556        PRINT*, 'rugosite du sol RUG**:', nsrf, xmin, xmax
557     ENDDO
558  ELSE
559     PRINT*, 'phyetat0: Le champ <RUG> est present'
560     PRINT*, '          J ignore donc les autres RUG**'
561     xmin = 1.0E+20
562     xmax = -1.0E+20
563     DO i = 1, klon
564        xmin = MIN(frugs(i, 1), xmin)
565        xmax = MAX(frugs(i, 1), xmax)
566     ENDDO
567     PRINT*, 'rugosite <RUG>', xmin, xmax
568     DO nsrf = 2, nbsrf
569        DO i = 1, klon
570           frugs(i, nsrf) = frugs(i, 1)
571        ENDDO
572     ENDDO
573  ENDIF
574
575  ! Lecture de l'age de la neige:
576
577  CALL get_field("AGESNO", agesno(:, 1), found)
578  IF (.NOT. found) THEN
579     PRINT*, 'phyetat0: Le champ <AGESNO> est absent'
580     PRINT*, '          Mais je vais essayer de lire AGESNO**'
581     DO nsrf = 1, nbsrf
582        IF (nsrf.GT.99) THEN
583           PRINT*, "Trop de sous-mailles"
584           CALL abort
585        ENDIF
586        WRITE(str2, '(i2.2)') nsrf
587        CALL get_field("AGESNO"//str2, agesno(:, nsrf), found)
588        IF (.NOT. found) THEN
589           PRINT*, "phyetat0: Le champ <AGESNO"//str2//"> est absent"
590           agesno = 50.0
591        ENDIF
592        xmin = 1.0E+20
593        xmax = -1.0E+20
594        DO i = 1, klon
595           xmin = MIN(agesno(i, nsrf), xmin)
596           xmax = MAX(agesno(i, nsrf), xmax)
597        ENDDO
598        PRINT*, 'Age de la neige AGESNO**:', nsrf, xmin, xmax
599     ENDDO
600  ELSE
601     PRINT*, 'phyetat0: Le champ <AGESNO> est present'
602     PRINT*, '          J ignore donc les autres AGESNO**'
603     xmin = 1.0E+20
604     xmax = -1.0E+20
605     DO i = 1, klon
606        xmin = MIN(agesno(i, 1), xmin)
607        xmax = MAX(agesno(i, 1), xmax)
608     ENDDO
609     PRINT*, 'Age de la neige <AGESNO>', xmin, xmax
610     DO nsrf = 2, nbsrf
611        DO i = 1, klon
612           agesno(i, nsrf) = agesno(i, 1)
613        ENDDO
614     ENDDO
615  ENDIF
616
617  CALL get_field("ZMEA", zmea)
618  xmin = 1.0E+20
619  xmax = -1.0E+20
620  DO i = 1, klon
621     xmin = MIN(zmea(i), xmin)
622     xmax = MAX(zmea(i), xmax)
623  ENDDO
624  PRINT*, 'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
625
626  CALL get_field("ZSTD", zstd)
627  xmin = 1.0E+20
628  xmax = -1.0E+20
629  DO i = 1, klon
630     xmin = MIN(zstd(i), xmin)
631     xmax = MAX(zstd(i), xmax)
632  ENDDO
633  PRINT*, 'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
634
635  CALL get_field("ZSIG", zsig)
636  xmin = 1.0E+20
637  xmax = -1.0E+20
638  DO i = 1, klon
639     xmin = MIN(zsig(i), xmin)
640     xmax = MAX(zsig(i), xmax)
641  ENDDO
642  PRINT*, 'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
643
644  CALL get_field("ZGAM", zgam)
645  xmin = 1.0E+20
646  xmax = -1.0E+20
647  DO i = 1, klon
648     xmin = MIN(zgam(i), xmin)
649     xmax = MAX(zgam(i), xmax)
650  ENDDO
651  PRINT*, 'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
652
653  CALL get_field("ZTHE", zthe)
654  xmin = 1.0E+20
655  xmax = -1.0E+20
656  DO i = 1, klon
657     xmin = MIN(zthe(i), xmin)
658     xmax = MAX(zthe(i), xmax)
659  ENDDO
660  PRINT*, 'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
661
662  CALL get_field("ZPIC", zpic)
663  xmin = 1.0E+20
664  xmax = -1.0E+20
665  DO i = 1, klon
666     xmin = MIN(zpic(i), xmin)
667     xmax = MAX(zpic(i), xmax)
668  ENDDO
669  PRINT*, 'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
670
671  CALL get_field("ZVAL", zval)
672  xmin = 1.0E+20
673  xmax = -1.0E+20
674  DO i = 1, klon
675     xmin = MIN(zval(i), xmin)
676     xmax = MAX(zval(i), xmax)
677  ENDDO
678  PRINT*, 'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
679
680  CALL get_field("RUGSREL", rugoro)
681  xmin = 1.0E+20
682  xmax = -1.0E+20
683  DO i = 1, klon
684     xmin = MIN(rugoro(i), xmin)
685     xmax = MAX(rugoro(i), xmax)
686  ENDDO
687  PRINT*, 'Rugosite relief (ecart-type) rugsrel:', xmin, xmax
688
689  ancien_ok = .TRUE.
690
691  CALL get_field("TANCIEN", t_ancien, found)
692  IF (.NOT. found) THEN
693     PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
694     PRINT*, "Depart legerement fausse. Mais je continue"
695     ancien_ok = .FALSE.
696  ENDIF
697
698  CALL get_field("QANCIEN", q_ancien, found)
699  IF (.NOT. found) THEN
700     PRINT*, "phyetat0: Le champ <QANCIEN> est absent"
701     PRINT*, "Depart legerement fausse. Mais je continue"
702     ancien_ok = .FALSE.
703  ENDIF
704
705  CALL get_field("UANCIEN", u_ancien, found)
706  IF (.NOT. found) THEN
707     PRINT*, "phyetat0: Le champ <UANCIEN> est absent"
708     PRINT*, "Depart legerement fausse. Mais je continue"
709     ancien_ok = .FALSE.
710  ENDIF
711
712  CALL get_field("VANCIEN", v_ancien, found)
713  IF (.NOT. found) THEN
714     PRINT*, "phyetat0: Le champ <VANCIEN> est absent"
715     PRINT*, "Depart legerement fausse. Mais je continue"
716     ancien_ok = .FALSE.
717  ENDIF
718
719  clwcon=0.
720  CALL get_field("CLWCON", clwcon, found)
721  IF (.NOT. found) THEN
722     PRINT*, "phyetat0: Le champ CLWCON est absent"
723     PRINT*, "Depart legerement fausse. Mais je continue"
724  ENDIF
725  xmin = 1.0E+20
726  xmax = -1.0E+20
727  xmin = MINval(clwcon)
728  xmax = MAXval(clwcon)
729  PRINT*, 'Eau liquide convective (ecart-type) clwcon:', xmin, xmax
730
731  rnebcon = 0.
732  CALL get_field("RNEBCON", rnebcon, found)
733  IF (.NOT. found) THEN
734     PRINT*, "phyetat0: Le champ RNEBCON est absent"
735     PRINT*, "Depart legerement fausse. Mais je continue"
736  ENDIF
737  xmin = 1.0E+20
738  xmax = -1.0E+20
739  xmin = MINval(rnebcon)
740  xmax = MAXval(rnebcon)
741  PRINT*, 'Nebulosite convective (ecart-type) rnebcon:', xmin, xmax
742
743  ! Lecture ratqs
744
745  ratqs=0.
746  CALL get_field("RATQS", ratqs, found)
747  IF (.NOT. found) THEN
748     PRINT*, "phyetat0: Le champ <RATQS> est absent"
749     PRINT*, "Depart legerement fausse. Mais je continue"
750  ENDIF
751  xmin = 1.0E+20
752  xmax = -1.0E+20
753  xmin = MINval(ratqs)
754  xmax = MAXval(ratqs)
755  PRINT*, '(ecart-type) ratqs:', xmin, xmax
756
757  ! Lecture run_off_lic_0
758
759  CALL get_field("RUNOFFLIC0", run_off_lic_0, found)
760  IF (.NOT. found) THEN
761     PRINT*, "phyetat0: Le champ <RUNOFFLIC0> est absent"
762     PRINT*, "Depart legerement fausse. Mais je continue"
763     run_off_lic_0 = 0.
764  ENDIF
765  xmin = 1.0E+20
766  xmax = -1.0E+20
767  xmin = MINval(run_off_lic_0)
768  xmax = MAXval(run_off_lic_0)
769  PRINT*, '(ecart-type) run_off_lic_0:', xmin, xmax
770
771  ! Lecture de l'energie cinetique turbulente
772
773  IF (iflag_pbl>1) then
774     DO nsrf = 1, nbsrf
775        IF (nsrf.GT.99) THEN
776           PRINT*, "Trop de sous-mailles"
777           CALL abort
778        ENDIF
779        WRITE(str2, '(i2.2)') nsrf
780        CALL get_field("TKE"//str2, pbl_tke(:, 1:klev+1, nsrf), found)
781        IF (.NOT. found) THEN
782           PRINT*, "phyetat0: <TKE"//str2//"> est absent"
783           pbl_tke(:, :, nsrf)=1.e-8
784        ENDIF
785        xmin = 1.0E+20
786        xmax = -1.0E+20
787        DO k = 1, klev+1
788           DO i = 1, klon
789              xmin = MIN(pbl_tke(i, k, nsrf), xmin)
790              xmax = MAX(pbl_tke(i, k, nsrf), xmax)
791           ENDDO
792        ENDDO
793        PRINT*, 'Temperature du sol TKE**:', nsrf, xmin, xmax
794     ENDDO
795  ENDIF
796
797  ! zmax0
798  CALL get_field("ZMAX0", zmax0, found)
799  IF (.NOT. found) THEN
800     PRINT*, "phyetat0: Le champ <ZMAX0> est absent"
801     PRINT*, "Depart legerement fausse. Mais je continue"
802     zmax0=40.
803  ENDIF
804  xmin = 1.0E+20
805  xmax = -1.0E+20
806  xmin = MINval(zmax0)
807  xmax = MAXval(zmax0)
808  PRINT*, '(ecart-type) zmax0:', xmin, xmax
809
810  !           f0(ig)=1.e-5
811  ! f0
812  CALL get_field("F0", f0, found)
813  IF (.NOT. found) THEN
814     PRINT*, "phyetat0: Le champ <f0> est absent"
815     PRINT*, "Depart legerement fausse. Mais je continue"
816     f0=1.e-5
817  ENDIF
818  xmin = 1.0E+20
819  xmax = -1.0E+20
820  xmin = MINval(f0)
821  xmax = MAXval(f0)
822  PRINT*, '(ecart-type) f0:', xmin, xmax
823
824  ! sig1 or ema_work1
825
826  CALL get_field("sig1", sig1, found)
827  IF (.NOT. found) CALL get_field("EMA_WORK1", sig1, found)
828  IF (.NOT. found) THEN
829     PRINT*, "phyetat0: Le champ sig1 est absent"
830     PRINT*, "Depart legerement fausse. Mais je continue"
831     sig1=0.
832  ELSE
833     xmin = 1.0E+20
834     xmax = -1.0E+20
835     DO k = 1, klev
836        DO i = 1, klon
837           xmin = MIN(sig1(i, k), xmin)
838           xmax = MAX(sig1(i, k), xmax)
839        ENDDO
840     ENDDO
841     PRINT*, 'sig1:', xmin, xmax
842  ENDIF
843
844  ! w01 or ema_work2
845
846  CALL get_field("w01", w01, found)
847  IF (.NOT. found) CALL get_field("EMA_WORK2", w01, found)
848  IF (.NOT. found) THEN
849     PRINT*, "phyetat0: Le champ w01 est absent"
850     PRINT*, "Depart legerement fausse. Mais je continue"
851     w01=0.
852  ELSE
853     xmin = 1.0E+20
854     xmax = -1.0E+20
855     DO k = 1, klev
856        DO i = 1, klon
857           xmin = MIN(w01(i, k), xmin)
858           xmax = MAX(w01(i, k), xmax)
859        ENDDO
860     ENDDO
861     PRINT*, 'w01:', xmin, xmax
862  ENDIF
863
864  ! wake_deltat
865
866  CALL get_field("WAKE_DELTAT", wake_deltat, found)
867  IF (.NOT. found) THEN
868     PRINT*, "phyetat0: Le champ <WAKE_DELTAT> est absent"
869     PRINT*, "Depart legerement fausse. Mais je continue"
870     wake_deltat=0.
871  ELSE
872     xmin = 1.0E+20
873     xmax = -1.0E+20
874     DO k = 1, klev
875        DO i = 1, klon
876           xmin = MIN(wake_deltat(i, k), xmin)
877           xmax = MAX(wake_deltat(i, k), xmax)
878        ENDDO
879     ENDDO
880     PRINT*, 'wake_deltat:', xmin, xmax
881  ENDIF
882
883  ! wake_deltaq
884
885  CALL get_field("WAKE_DELTAQ", wake_deltaq, found)
886  IF (.NOT. found) THEN
887     PRINT*, "phyetat0: Le champ <WAKE_DELTAQ> est absent"
888     PRINT*, "Depart legerement fausse. Mais je continue"
889     wake_deltaq=0.
890  ELSE
891     xmin = 1.0E+20
892     xmax = -1.0E+20
893     DO k = 1, klev
894        DO i = 1, klon
895           xmin = MIN(wake_deltaq(i, k), xmin)
896           xmax = MAX(wake_deltaq(i, k), xmax)
897        ENDDO
898     ENDDO
899     PRINT*, 'wake_deltaq:', xmin, xmax
900  ENDIF
901
902  ! wake_s
903
904  CALL get_field("WAKE_S", wake_s, found)
905  IF (.NOT. found) THEN
906     PRINT*, "phyetat0: Le champ <WAKE_S> est absent"
907     PRINT*, "Depart legerement fausse. Mais je continue"
908     wake_s=0.
909  ENDIF
910  xmin = 1.0E+20
911  xmax = -1.0E+20
912  xmin = MINval(wake_s)
913  xmax = MAXval(wake_s)
914  PRINT*, '(ecart-type) wake_s:', xmin, xmax
915
916  ! wake_cstar
917
918  CALL get_field("WAKE_CSTAR", wake_cstar, found)
919  IF (.NOT. found) THEN
920     PRINT*, "phyetat0: Le champ <WAKE_CSTAR> est absent"
921     PRINT*, "Depart legerement fausse. Mais je continue"
922     wake_cstar=0.
923  ENDIF
924  xmin = 1.0E+20
925  xmax = -1.0E+20
926  xmin = MINval(wake_cstar)
927  xmax = MAXval(wake_cstar)
928  PRINT*, '(ecart-type) wake_cstar:', xmin, xmax
929
930  ! wake_pe
931
932  CALL get_field("WAKE_PE", wake_pe, found)
933  IF (.NOT. found) THEN
934     PRINT*, "phyetat0: Le champ <WAKE_PE> est absent"
935     PRINT*, "Depart legerement fausse. Mais je continue"
936     wake_pe=0.
937  ENDIF
938  xmin = 1.0E+20
939  xmax = -1.0E+20
940  xmin = MINval(wake_pe)
941  xmax = MAXval(wake_pe)
942  PRINT*, '(ecart-type) wake_pe:', xmin, xmax
943
944  ! wake_fip
945
946  CALL get_field("WAKE_FIP", wake_fip, found)
947  IF (.NOT. found) THEN
948     PRINT*, "phyetat0: Le champ <WAKE_FIP> est absent"
949     PRINT*, "Depart legerement fausse. Mais je continue"
950     wake_fip=0.
951  ENDIF
952  xmin = 1.0E+20
953  xmax = -1.0E+20
954  xmin = MINval(wake_fip)
955  xmax = MAXval(wake_fip)
956  PRINT*, '(ecart-type) wake_fip:', xmin, xmax
957
958  !  thermiques
959
960  CALL get_field("FM_THERM", fm_therm, found)
961  IF (.NOT. found) THEN
962     PRINT*, "phyetat0: Le champ <fm_therm> est absent"
963     PRINT*, "Depart legerement fausse. Mais je continue"
964     fm_therm=0.
965  ENDIF
966  xmin = 1.0E+20
967  xmax = -1.0E+20
968  xmin = MINval(fm_therm)
969  xmax = MAXval(fm_therm)
970  PRINT*, '(ecart-type) fm_therm:', xmin, xmax
971
972  CALL get_field("ENTR_THERM", entr_therm, found)
973  IF (.NOT. found) THEN
974     PRINT*, "phyetat0: Le champ <entr_therm> est absent"
975     PRINT*, "Depart legerement fausse. Mais je continue"
976     entr_therm=0.
977  ENDIF
978  xmin = 1.0E+20
979  xmax = -1.0E+20
980  xmin = MINval(entr_therm)
981  xmax = MAXval(entr_therm)
982  PRINT*, '(ecart-type) entr_therm:', xmin, xmax
983
984  CALL get_field("DETR_THERM", detr_therm, found)
985  IF (.NOT. found) THEN
986     PRINT*, "phyetat0: Le champ <detr_therm> est absent"
987     PRINT*, "Depart legerement fausse. Mais je continue"
988     detr_therm=0.
989  ENDIF
990  xmin = 1.0E+20
991  xmax = -1.0E+20
992  xmin = MINval(detr_therm)
993  xmax = MAXval(detr_therm)
994  PRINT*, '(ecart-type) detr_therm:', xmin, xmax
995
996  ! Read and send field trs to traclmdz
997
998  IF (type_trac == 'lmdz') THEN
999     DO it=1, nbtr
1000        iiq=niadv(it+2)
1001        CALL get_field("trs_"//tname(iiq), trs(:, it), found)
1002        IF (.NOT. found) THEN
1003           PRINT*,  &
1004                "phyetat0: Le champ <trs_"//tname(iiq)//"> est absent"
1005           PRINT*, "Depart legerement fausse. Mais je continue"
1006           trs(:, it) = 0.
1007        ENDIF
1008        xmin = 1.0E+20
1009        xmax = -1.0E+20
1010        xmin = MINval(trs(:, it))
1011        xmax = MAXval(trs(:, it))
1012        PRINT*, "(ecart-type) trs_"//tname(iiq)//" :", xmin, xmax
1013
1014     END DO
1015     CALL traclmdz_from_restart(trs)
1016
1017     IF (carbon_cycle_cpl) THEN
1018        ALLOCATE(co2_send(klon), stat=ierr)
1019        IF (ierr /= 0) CALL abort_gcm &
1020             ('phyetat0', 'pb allocation co2_send', 1)
1021        CALL get_field("co2_send", co2_send, found)
1022        IF (.NOT. found) THEN
1023           PRINT*, "phyetat0: Le champ <co2_send> est absent"
1024           PRINT*, "Initialisation uniforme a co2_ppm=", co2_ppm
1025           co2_send(:) = co2_ppm
1026        END IF
1027     END IF
1028  END IF
1029
1030  ! on ferme le fichier
1031  CALL close_startphy
1032
1033  CALL init_iophy_new(rlat, rlon)
1034
1035  ! Initialize module pbl_surface_mod
1036
1037  CALL pbl_surface_init(qsol, fder, snow, qsurf, &
1038       evap, frugs, agesno, tsoil)
1039
1040  ! Initialize module ocean_cpl_mod for the case of coupled ocean
1041  IF ( type_ocean == 'couple' ) THEN
1042     CALL ocean_cpl_init(dtime, rlon, rlat)
1043  ENDIF
1044
1045  ! Initilialize module fonte_neige_mod     
1046
1047  CALL fonte_neige_init(run_off_lic_0)
1048
1049END SUBROUTINE phyetat0
Note: See TracBrowser for help on using the repository browser.