source: LMDZ4/trunk/libf/phylmd/phyetat0.F @ 1081

Last change on this file since 1081 was 1054, checked in by lmdzadmin, 16 years ago

Ajout sorties tendances dynamiques histLES
ACA/FH/IM

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