source: LMDZ5/branches/LMDZ5V2.0-dev/libf/phylmd/phyetat0.F @ 3150

Last change on this file since 3150 was 1457, checked in by musat, 14 years ago

Ooops
phyetat0, phyredem: correction dimension verticale pbl_tke: pbl_tke(:,1:klev+1,:)
physiq: pour pouvoir fixer la longitude solaire avec la nouvelle orbite

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