source: LMDZ4/trunk/libf/phytherm/phyetat0.F @ 945

Last change on this file since 945 was 852, checked in by Laurent Fairhead, 17 years ago

Mise a jour de la physique avec thermiques avec la version de FH d'aout 2007
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 47.2 KB
RevLine 
[814]1!
2! $Header$
3!
4c
5c
6      SUBROUTINE phyetat0 (fichnom,dtime,co2_ppm_etat0,solaire_etat0,
7     .           rlat_p, rlon_p, pctsrf_p, tsol_p,
8     .           ocean_in, ok_veget_in,
9     .           albe_p, alblw_p,
10     .           rain_fall_p, snow_fall_p,solsw_p, sollw_p,
11     .           radsol_p,clesphy0,
12     .           zmea_p,zstd_p,zsig_p,zgam_p,zthe_p,zpic_p,zval_p,
13     .           rugsrel_p,tabcntr0,
14     .           t_ancien_p,q_ancien_p,ancien_ok_p, rnebcon_p, ratqs_p,
[852]15     .           clwcon_p,pbl_tke_p)
[814]16
17      USE dimphy
18      USE mod_grid_phy_lmdz
19      USE mod_phys_lmdz_para
20      USE iophy
21      USE ocean_slab_mod,   ONLY : ocean_slab_init
22      USE ocean_cpl_mod,    ONLY : ocean_cpl_init
23      USE ocean_forced_mod, ONLY : ocean_forced_init
24      USE fonte_neige_mod,  ONLY : fonte_neige_init
25      USE pbl_surface_mod,  ONLY : pbl_surface_init
26      USE surface_data,     ONLY : ocean, ok_veget
27
28      IMPLICIT none
29c======================================================================
30c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
31c Objet: Lecture de l'etat initial pour la physique
32c======================================================================
33#include "dimensions.h"
34#include "netcdf.inc"
35#include "indicesol.h"
36#include "dimsoil.h"
37#include "clesphys.h"
38#include "temps.h"
[852]39#include "thermcell.h"
40#include "compbl.h"
[814]41c======================================================================
42      CHARACTER*(*) fichnom
43      REAL dtime
44      INTEGER radpas
45      REAL rlat_p(klon), rlon_p(klon)
46      REAL co2_ppm_etat0
47      REAL solaire_etat0
48      REAL tsol_p(klon,nbsrf)
[852]49      REAL pbl_tke_p(klon,klev,nbsrf)
[814]50      REAL tsoil_p(klon,nsoilmx,nbsrf)
51      REAL tslab_p(klon), seaice_p(klon)
52      REAL qsurf_p(klon,nbsrf)
53      REAL qsol_p(klon)
54      REAL snow_p(klon,nbsrf)
55      REAL albe_p(klon,nbsrf)
56cIM BEG alblw
57      REAL alblw_p(klon,nbsrf)
58cIM END alblw
59      REAL evap_p(klon,nbsrf)
60      REAL radsol_p(klon)
61      REAL rain_fall_p(klon)
62      REAL snow_fall_p(klon)
63      REAL sollw_p(klon)
64      real solsw_p(klon)
65      real fder_p(klon)
66      REAL frugs_p(klon,nbsrf)
67      REAL agesno_p(klon,nbsrf)
68      REAL zmea_p(klon)
69      REAL zstd_p(klon)
70      REAL zsig_p(klon)
71      REAL zgam_p(klon)
72      REAL zthe_p(klon)
73      REAL zpic_p(klon)
74      REAL zval_p(klon)
75      REAL rugsrel_p(klon)
76      REAL pctsrf_p(klon, nbsrf)
77      REAL run_off_lic_0_p(klon)
78     
79      REAL t_ancien_p(klon,klev), q_ancien_p(klon,klev)
80      real rnebcon_p(klon,klev),clwcon_p(klon,klev)
81      real ratqs_p(klon,klev)
82      LOGICAL,SAVE ::  ancien_ok
83      LOGICAL ::  ancien_ok_p
84     
85      REAL zmasq_glo(klon_glo)
86      REAL rlat(klon_glo), rlon(klon_glo)
87      REAL tsol(klon_glo,nbsrf)
[852]88      REAL pbl_tke(klon_glo,klev,nbsrf)
[814]89      REAL tsoil(klon_glo,nsoilmx,nbsrf)
90cIM "slab" ocean
91      REAL tslab(klon_glo), seaice(klon_glo)
92      REAL qsurf(klon_glo,nbsrf)
93      REAL qsol(klon_glo)
94      REAL snow(klon_glo,nbsrf)
95      REAL albe(klon_glo,nbsrf)
96      REAL alblw(klon_glo,nbsrf)
97      REAL evap(klon_glo,nbsrf)
98      REAL radsol(klon_glo)
99      REAL rain_fall(klon_glo)
100      REAL snow_fall(klon_glo)
101      REAL sollw(klon_glo)
102      real solsw(klon_glo)
103      real fder(klon_glo)
104      REAL frugs(klon_glo,nbsrf)
105      REAL agesno(klon_glo,nbsrf)
106      REAL zmea(klon_glo)
107      REAL zstd(klon_glo)
108      REAL zsig(klon_glo)
109      REAL zgam(klon_glo)
110      REAL zthe(klon_glo)
111      REAL zpic(klon_glo)
112      REAL zval(klon_glo)
113      REAL rugsrel(klon_glo)
114      REAL pctsrf(klon_glo, nbsrf)
115      REAL fractint(klon_glo)
116      REAL run_off_lic_0(klon_glo)
117      REAL t_ancien(klon_glo,klev)
118      REAL q_ancien(klon_glo,klev)
119      real rnebcon(klon_glo,klev)
120      real clwcon(klon_glo,klev)
121      real ratqs(klon_glo,klev)
122
123      CHARACTER*6 ocean_in
124      LOGICAL ok_veget_in
125
126      INTEGER        longcles
127      PARAMETER    ( longcles = 20 )
128      REAL clesphy0( longcles )
129c
130      REAL xmin, xmax
131c
132      INTEGER nid, nvarid
[852]133      INTEGER ierr, i, nsrf, isoil ,k
[814]134      INTEGER length
135      PARAMETER (length=100)
136      REAL tab_cntrl(length), tabcntr0(length)
137      REAL,SAVE :: tab_cntrl_omp(length)
138      CHARACTER*7 str7
139      CHARACTER*2 str2
140      real iolat(jjm+1)
141c
142c Ouvrir le fichier contenant l'etat initial:
143c
144
145c$OMP MASTER
146      print *,'MASTER -x , omp_rank=',omp_rank
147c$OMP END MASTER
148
149c$OMP MASTER
150      IF (is_mpi_root) THEN
151        print*,'fichnom ',fichnom
152        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
153        IF (ierr.NE.NF_NOERR) THEN
154          write(6,*)' Pb d''ouverture du fichier '//fichnom
155          write(6,*)' ierr = ', ierr
156          CALL ABORT
157        ENDIF
158      ENDIF
159c$OMP END MASTER
160c
161c Lecture des parametres de controle:
162c
163c$OMP MASTER
164      IF (is_mpi_root) THEN
165     
166      ierr = NF_INQ_VARID (nid, "controle", nvarid)
167      IF (ierr.NE.NF_NOERR) THEN
168         PRINT*, 'phyetat0: Le champ <controle> est absent'
169         CALL abort
170      ENDIF
171#ifdef NC_DOUBLE
172      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
173#else
174      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
175#endif
176      IF (ierr.NE.NF_NOERR) THEN
177         PRINT*, 'phyetat0: Lecture echouee pour <controle>'
178         CALL abort
179      ENDIF
180      ENDIF
181
182c$OMP END MASTER
183       
184       CALL bcast(tab_cntrl)
185       
186c
187       
188         DO i = 1, length
189           tabcntr0( i ) = tab_cntrl( i )
190         ENDDO
191c
192         cycle_diurne   = .FALSE.
193         soil_model     = .FALSE.
194         new_oliq       = .FALSE.
195         ok_orodr       = .FALSE.
196         ok_orolf       = .FALSE.
197         ok_limitvrai   = .FALSE.
198
199
200         IF( clesphy0(1).NE.tab_cntrl( 5 ) )  THEN
201             tab_cntrl( 5 ) = clesphy0(1)
202         ENDIF
203
204         IF( clesphy0(2).NE.tab_cntrl( 6 ) )  THEN
205             tab_cntrl( 6 ) = clesphy0(2)
206         ENDIF
207
208         IF( clesphy0(3).NE.tab_cntrl( 7 ) )  THEN
209             tab_cntrl( 7 ) = clesphy0(3)
210         ENDIF
211
212         IF( clesphy0(4).NE.tab_cntrl( 8 ) )  THEN
213             tab_cntrl( 8 ) = clesphy0(4)
214         ENDIF
215
216         IF( clesphy0(5).NE.tab_cntrl( 9 ) )  THEN
217             tab_cntrl( 9 ) = clesphy0( 5 )
218         ENDIF
219
220         IF( clesphy0(6).NE.tab_cntrl( 10 ) )  THEN
221             tab_cntrl( 10 ) = clesphy0( 6 )
222         ENDIF
223
224         IF( clesphy0(7).NE.tab_cntrl( 11 ) )  THEN
225             tab_cntrl( 11 ) = clesphy0( 7 )
226         ENDIF
227
228         IF( clesphy0(8).NE.tab_cntrl( 12 ) )  THEN
229             tab_cntrl( 12 ) = clesphy0( 8 )
230         ENDIF
231
232
233         dtime        = tab_cntrl(1)
234         radpas       = tab_cntrl(2)
235         co2_ppm_etat0      = tab_cntrl(3)
236         solaire_etat0      = tab_cntrl(4)
237         iflag_con    = tab_cntrl(5)
238         nbapp_rad    = tab_cntrl(6)
239
240
241         cycle_diurne    = .FALSE.
242         soil_model      = .FALSE.
243         new_oliq        = .FALSE.
244         ok_orodr        = .FALSE.
245         ok_orolf        = .FALSE.
246         ok_limitvrai    = .FALSE.
247
248         IF( tab_cntrl( 7) .EQ. 1. )    cycle_diurne  = .TRUE.
249         IF( tab_cntrl( 8) .EQ. 1. )       soil_model = .TRUE.
250         IF( tab_cntrl( 9) .EQ. 1. )         new_oliq = .TRUE.
251         IF( tab_cntrl(10) .EQ. 1. )         ok_orodr = .TRUE.
252         IF( tab_cntrl(11) .EQ. 1. )         ok_orolf = .TRUE.
253         IF( tab_cntrl(12) .EQ. 1. )     ok_limitvrai = .TRUE.
254
255
256      itau_phy = tab_cntrl(15)
257
258c
259c Lecture des latitudes (coordonnees):
260c
261c$OMP MASTER
262      IF (is_mpi_root) THEN
263     
264      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
265      IF (ierr.NE.NF_NOERR) THEN
266         PRINT*, 'phyetat0: Le champ <latitude> est absent'
267         CALL abort
268      ENDIF
269#ifdef NC_DOUBLE
270      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
271#else
272      ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
273#endif
274      IF (ierr.NE.NF_NOERR) THEN
275         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
276         CALL abort
277      ENDIF
278
279c
280c Lecture des longitudes (coordonnees):
281c
282      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
283      IF (ierr.NE.NF_NOERR) THEN
284         PRINT*, 'phyetat0: Le champ <longitude> est absent'
285         CALL abort
286      ENDIF
287#ifdef NC_DOUBLE
288      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
289#else
290      ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
291#endif
292      IF (ierr.NE.NF_NOERR) THEN
293         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
294         CALL abort
295      ENDIF
296C
297C
298C Lecture du masque terre mer
299C
300
301      ierr = NF_INQ_VARID (nid, "masque", nvarid)
302      IF (ierr .EQ.  NF_NOERR) THEN
303#ifdef NC_DOUBLE
304          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmasq_glo)
305#else
306          ierr = NF_GET_VAR_REAL(nid, nvarid, zmasq_glo)
307#endif
308          IF (ierr.NE.NF_NOERR) THEN
309              PRINT*, 'phyetat0: Lecture echouee pour <masque>'
310              CALL abort
311          ENDIF
312      else
313          PRINT*, 'phyetat0: Le champ <masque> est absent'
314          PRINT*, 'fichier startphy non compatible avec phyetat0'
315C      CALL abort
316      ENDIF
317
318       
319C Lecture des fractions pour chaque sous-surface
320C
321C initialisation des sous-surfaces
322C
323      pctsrf = 0.
324C
325C fraction de terre
326C
327
328      ierr = NF_INQ_VARID (nid, "FTER", nvarid)
329      IF (ierr .EQ.  NF_NOERR) THEN
330#ifdef NC_DOUBLE
331          ierr = NF_GET_VAR_DOUBLE(nid, nvarid,       
332     .                             pctsrf(1 : klon_glo,is_ter))
333#else
334          ierr = NF_GET_VAR_REAL(nid, nvarid,
335     .                           pctsrf(1 : klon_glo,is_ter))
336#endif
337          IF (ierr.NE.NF_NOERR) THEN
338              PRINT*, 'phyetat0: Lecture echouee pour <FTER>'
339              CALL abort
340          ENDIF
341      else
342          PRINT*, 'phyetat0: Le champ <FTER> est absent'
343c@$$         CALL abort
344      ENDIF
345
346C
347C fraction de glace de terre
348C
349      ierr = NF_INQ_VARID (nid, "FLIC", nvarid)
350      IF (ierr .EQ.  NF_NOERR) THEN
351#ifdef NC_DOUBLE
352          ierr = NF_GET_VAR_DOUBLE(nid, nvarid,
353     .                             pctsrf(1 : klon_glo,is_lic))
354#else
355          ierr = NF_GET_VAR_REAL(nid, nvarid,
356     .                           pctsrf(1 : klon_glo,is_lic))
357#endif
358          IF (ierr.NE.NF_NOERR) THEN
359              PRINT*, 'phyetat0: Lecture echouee pour <FLIC>'
360              CALL abort
361          ENDIF
362      else
363          PRINT*, 'phyetat0: Le champ <FLIC> est absent'
364c@$$         CALL abort
365      ENDIF
366C
367C fraction d'ocean
368C
369      ierr = NF_INQ_VARID (nid, "FOCE", nvarid)
370      IF (ierr .EQ.  NF_NOERR) THEN
371#ifdef NC_DOUBLE
372          ierr = NF_GET_VAR_DOUBLE(nid, nvarid,
373     .                             pctsrf(1 : klon_glo,is_oce))
374#else
375          ierr = NF_GET_VAR_REAL(nid, nvarid,
376     .                           pctsrf(1 : klon_glo,is_oce))
377#endif
378          IF (ierr.NE.NF_NOERR) THEN
379              PRINT*, 'phyetat0: Lecture echouee pour <FOCE>'
380              CALL abort
381          ENDIF
382      else
383          PRINT*, 'phyetat0: Le champ <FOCE> est absent'
384c@$$         CALL abort
385      ENDIF
386
387C
388C fraction glace de mer
389C
390      ierr = NF_INQ_VARID (nid, "FSIC", nvarid)
391      IF (ierr .EQ.  NF_NOERR) THEN
392#ifdef NC_DOUBLE
393          ierr = NF_GET_VAR_DOUBLE(nid, nvarid,
394     .                             pctsrf(1 : klon_glo,is_sic))
395#else
396          ierr = NF_GET_VAR_REAL(nid, nvarid,
397     .                           pctsrf(1 : klon_glo, is_sic))
398#endif
399          IF (ierr.NE.NF_NOERR) THEN
400              PRINT*, 'phyetat0: Lecture echouee pour <FSIC>'
401              CALL abort
402          ENDIF
403      else
404          PRINT*, 'phyetat0: Le champ <FSIC> est absent'
405c@$$         CALL abort
406      ENDIF
407
408C
409C  Verification de l'adequation entre le masque et les sous-surfaces
410C
411      fractint( 1 : klon_glo) = pctsrf(1 : klon_glo, is_ter)
412     $    + pctsrf(1 : klon_glo, is_lic)
413      DO i = 1 , klon_glo
414        IF ( abs(fractint(i) - zmasq_glo(i) ) .GT. EPSFRA ) THEN
415            WRITE(*,*) 'phyetat0: attention fraction terre pas ',
416     $          'coherente ', i, zmasq_glo(i), pctsrf(i, is_ter)
417     $          ,pctsrf(i, is_lic)
418        ENDIF
419      END DO
420      fractint (1 : klon_glo) =  pctsrf(1 : klon_glo, is_oce)
421     $    + pctsrf(1 : klon_glo, is_sic)
422      DO i = 1 , klon_glo
423        IF ( abs( fractint(i) - (1. - zmasq_glo(i))) .GT. EPSFRA ) THEN
424            WRITE(*,*) 'phyetat0 attention fraction ocean pas ',
425     $          'coherente ', i, zmasq_glo(i) , pctsrf(i, is_oce)
426     $          ,pctsrf(i, is_sic)
427        ENDIF
428      END DO
429
430C
431c Lecture des temperatures du sol:
432c
433
434      ierr = NF_INQ_VARID (nid, "TS", nvarid)
435      IF (ierr.NE.NF_NOERR) THEN
436         PRINT*, 'phyetat0: Le champ <TS> est absent'
437         PRINT*, '          Mais je vais essayer de lire TS**'
438         DO nsrf = 1, nbsrf
439           IF (nsrf.GT.99) THEN
440             PRINT*, "Trop de sous-mailles"
441             CALL abort
442           ENDIF
443           WRITE(str2,'(i2.2)') nsrf
444           ierr = NF_INQ_VARID (nid, "TS"//str2, nvarid)
445           IF (ierr.NE.NF_NOERR) THEN
446              PRINT*, "phyetat0: Le champ <TS"//str2//"> est absent"
447              CALL abort
448           ENDIF
449#ifdef NC_DOUBLE
450           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1,nsrf))
451#else
452           ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,nsrf))
453#endif
454           IF (ierr.NE.NF_NOERR) THEN
455             PRINT*, "phyetat0: Lecture echouee pour <TS"//str2//">"
456             CALL abort
457           ENDIF
458
459           xmin = 1.0E+20
460           xmax = -1.0E+20
461           DO i = 1, klon_glo
462              xmin = MIN(tsol(i,nsrf),xmin)
463              xmax = MAX(tsol(i,nsrf),xmax)
464           ENDDO
465           PRINT*,'Temperature du sol TS**:', nsrf, xmin, xmax
466         ENDDO
467      ELSE
468         PRINT*, 'phyetat0: Le champ <TS> est present'
469         PRINT*, '          J ignore donc les autres temperatures TS**'
470#ifdef NC_DOUBLE
471         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1,1))
472#else
473         ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,1))
474#endif
475         IF (ierr.NE.NF_NOERR) THEN
476            PRINT*, "phyetat0: Lecture echouee pour <TS>"
477            CALL abort
478         ENDIF
479         xmin = 1.0E+20
480         xmax = -1.0E+20
481         DO i = 1, klon_glo
482            xmin = MIN(tsol(i,1),xmin)
483            xmax = MAX(tsol(i,1),xmax)
484         ENDDO
485         PRINT*,'Temperature du sol <TS>', xmin, xmax
486         DO nsrf = 2, nbsrf
487         DO i = 1, klon_glo
488            tsol(i,nsrf) = tsol(i,1)
489         ENDDO
490         ENDDO
491      ENDIF
492
493c
494c Lecture des temperatures du sol profond:
495c
496      DO nsrf = 1, nbsrf
497      DO isoil=1, nsoilmx
498      IF (isoil.GT.99 .AND. nsrf.GT.99) THEN
499         PRINT*, "Trop de couches ou sous-mailles"
500         CALL abort
501      ENDIF
502      WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
503      ierr = NF_INQ_VARID (nid, 'Tsoil'//str7, nvarid)
504      IF (ierr.NE.NF_NOERR) THEN
505         PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
506         PRINT*, "          Il prend donc la valeur de surface"
507         DO i=1, klon_glo
508             tsoil(i,isoil,nsrf)=tsol(i,nsrf)
509         ENDDO
510      ELSE
511#ifdef NC_DOUBLE
512         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil,nsrf))
513#else
514         ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil,nsrf))
515#endif
516         IF (ierr.NE.NF_NOERR) THEN
517            PRINT*, "Lecture echouee pour <Tsoil"//str7//">"
518            CALL abort
519         ENDIF
520      ENDIF
521      ENDDO
522      ENDDO
523c
524cIM "slab" ocean
525c
526c Lecture de tslab (pour slab ocean seulement):     
527c
528      IF (ocean_in .eq. 'slab  ') then
529        ierr = NF_INQ_VARID (nid, "TSLAB", nvarid)
530        IF (ierr.NE.NF_NOERR) THEN
531          PRINT*, "phyetat0: Le champ <TSLAB> est absent"
532          CALL abort
533        ENDIF
534#ifdef NC_DOUBLE
535        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tslab)
536#else
537        ierr = NF_GET_VAR_REAL(nid, nvarid, tslab)
538#endif
539        IF (ierr.NE.NF_NOERR) THEN
540          PRINT*, "phyetat0: Lecture echouee pour <TSLAB>"
541          CALL abort
542        ENDIF
543        xmin = 1.0E+20
544        xmax = -1.0E+20
545        DO i = 1, klon_glo
546          xmin = MIN(tslab(i),xmin)
547          xmax = MAX(tslab(i),xmax)
548        ENDDO
549        PRINT*,'Min, Max tslab (utilise si OCEAN=slab )', xmin, xmax
550c
551c Lecture de seaice (pour slab ocean seulement):
552c
553        ierr = NF_INQ_VARID (nid, "SEAICE", nvarid)
554        IF (ierr.NE.NF_NOERR) THEN
555          PRINT*, "phyetat0: Le champ <SEAICE> est absent"
556          CALL abort
557        ENDIF
558#ifdef NC_DOUBLE
559        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, seaice)
560#else
561        ierr = NF_GET_VAR_REAL(nid, nvarid, seaice)
562#endif
563        IF (ierr.NE.NF_NOERR) THEN
564          PRINT*, "phyetat0: Lecture echouee pour <SEAICE>"
565          CALL abort
566        ENDIF
567        xmin = 1.0E+20
568        xmax = -1.0E+20
569        DO i = 1, klon_glo
570          xmin = MIN(seaice(i),xmin)
571          xmax = MAX(seaice(i),xmax)
572        ENDDO
573        PRINT*,'Masse de la glace de mer (utilise si OCEAN=slab)',
574     $  xmin, xmax
575      ELSE
576        tslab = 0.
577        seaice = 0.
578      ENDIF
579c
580c Lecture de l'humidite de l'air juste au dessus du sol:
581c
582      ierr = NF_INQ_VARID (nid, "QS", nvarid)
583      IF (ierr.NE.NF_NOERR) THEN
584         PRINT*, 'phyetat0: Le champ <QS> est absent'
585         PRINT*, '          Mais je vais essayer de lire QS**'
586         DO nsrf = 1, nbsrf
587           IF (nsrf.GT.99) THEN
588             PRINT*, "Trop de sous-mailles"
589             CALL abort
590           ENDIF
591           WRITE(str2,'(i2.2)') nsrf
592           ierr = NF_INQ_VARID (nid, "QS"//str2, nvarid)
593           IF (ierr.NE.NF_NOERR) THEN
594              PRINT*, "phyetat0: Le champ <QS"//str2//"> est absent"
595              CALL abort
596           ENDIF
597#ifdef NC_DOUBLE
598           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsurf(1,nsrf))
599#else
600           ierr = NF_GET_VAR_REAL(nid, nvarid, qsurf(1,nsrf))
601#endif
602           IF (ierr.NE.NF_NOERR) THEN
603             PRINT*, "phyetat0: Lecture echouee pour <QS"//str2//">"
604             CALL abort
605           ENDIF
606           xmin = 1.0E+20
607           xmax = -1.0E+20
608           DO i = 1, klon_glo
609              xmin = MIN(qsurf(i,nsrf),xmin)
610              xmax = MAX(qsurf(i,nsrf),xmax)
611           ENDDO
612           PRINT*,'Humidite pres du sol QS**:', nsrf, xmin, xmax
613         ENDDO
614      ELSE
615         PRINT*, 'phyetat0: Le champ <QS> est present'
616         PRINT*, '          J ignore donc les autres humidites QS**'
617#ifdef NC_DOUBLE
618         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsurf(1,1))
619#else
620         ierr = NF_GET_VAR_REAL(nid, nvarid, qsurf(1,1))
621#endif
622         IF (ierr.NE.NF_NOERR) THEN
623            PRINT*, "phyetat0: Lecture echouee pour <QS>"
624            CALL abort
625         ENDIF
626         xmin = 1.0E+20
627         xmax = -1.0E+20
628         DO i = 1, klon_glo
629            xmin = MIN(qsurf(i,1),xmin)
630            xmax = MAX(qsurf(i,1),xmax)
631         ENDDO
632         PRINT*,'Humidite pres du sol <QS>', xmin, xmax
633         DO nsrf = 2, nbsrf
634         DO i = 1, klon_glo
635            qsurf(i,nsrf) = qsurf(i,1)
636         ENDDO
637         ENDDO
638      ENDIF
639C
640C Eau dans le sol (pour le modele de sol "bucket")
641C
642      ierr = NF_INQ_VARID (nid, "QSOL", nvarid)
643      IF (ierr .EQ.  NF_NOERR) THEN
644#ifdef NC_DOUBLE
645          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsol)
646#else
647          ierr = NF_GET_VAR_REAL(nid, nvarid, qsol)
648#endif
649          IF (ierr.NE.NF_NOERR) THEN
650              PRINT*, 'phyetat0: Lecture echouee pour <QSOL>'
651              CALL abort
652          ENDIF
653      else
654          PRINT*, 'phyetat0: Le champ <QSOL> est absent'
655          PRINT*, '          Valeur par defaut nulle'
656          qsol(:)=0.
657c@$$         CALL abort
658      ENDIF
659      xmin = 1.0E+20
660      xmax = -1.0E+20
661      DO i = 1, klon_glo
662        xmin = MIN(qsol(i),xmin)
663        xmax = MAX(qsol(i),xmax)
664      ENDDO
665      PRINT*,'Eau dans le sol (mm) <QSOL>', xmin, xmax
666c
667c Lecture de neige au sol:
668c
669      ierr = NF_INQ_VARID (nid, "SNOW", nvarid)
670      IF (ierr.NE.NF_NOERR) THEN
671         PRINT*, 'phyetat0: Le champ <SNOW> est absent'
672         PRINT*, '          Mais je vais essayer de lire SNOW**'
673         DO nsrf = 1, nbsrf
674           IF (nsrf.GT.99) THEN
675             PRINT*, "Trop de sous-mailles"
676             CALL abort
677           ENDIF
678           WRITE(str2,'(i2.2)') nsrf
679           ierr = NF_INQ_VARID (nid, "SNOW"//str2, nvarid)
680           IF (ierr.NE.NF_NOERR) THEN
681              PRINT*, "phyetat0: Le champ <SNOW"//str2//"> est absent"
682              CALL abort
683           ENDIF
684#ifdef NC_DOUBLE
685           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow(1,nsrf))
686#else
687           ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,nsrf))
688#endif
689           IF (ierr.NE.NF_NOERR) THEN
690             PRINT*, "phyetat0: Lecture echouee pour <SNOW"//str2//">"
691             CALL abort
692           ENDIF
693           xmin = 1.0E+20
694           xmax = -1.0E+20
695           DO i = 1, klon_glo
696              xmin = MIN(snow(i,nsrf),xmin)
697              xmax = MAX(snow(i,nsrf),xmax)
698           ENDDO
699           PRINT*,'Neige du sol SNOW**:', nsrf, xmin, xmax
700         ENDDO
701      ELSE
702         PRINT*, 'phyetat0: Le champ <SNOW> est present'
703         PRINT*, '          J ignore donc les autres neiges SNOW**'
704#ifdef NC_DOUBLE
705         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow(1,1))
706#else
707         ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,1))
708#endif
709         IF (ierr.NE.NF_NOERR) THEN
710            PRINT*, "phyetat0: Lecture echouee pour <SNOW>"
711            CALL abort
712         ENDIF
713         xmin = 1.0E+20
714         xmax = -1.0E+20
715         DO i = 1, klon_glo
716            xmin = MIN(snow(i,1),xmin)
717            xmax = MAX(snow(i,1),xmax)
718         ENDDO
719         PRINT*,'Neige du sol <SNOW>', xmin, xmax
720         DO nsrf = 2, nbsrf
721         DO i = 1, klon_glo
722            snow(i,nsrf) = snow(i,1)
723         ENDDO
724         ENDDO
725      ENDIF
726c
727c Lecture de albedo au sol:
728c
729      ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
730      IF (ierr.NE.NF_NOERR) THEN
731         PRINT*, 'phyetat0: Le champ <ALBE> est absent'
732         PRINT*, '          Mais je vais essayer de lire ALBE**'
733         DO nsrf = 1, nbsrf
734           IF (nsrf.GT.99) THEN
735             PRINT*, "Trop de sous-mailles"
736             CALL abort
737           ENDIF
738           WRITE(str2,'(i2.2)') nsrf
739           ierr = NF_INQ_VARID (nid, "ALBE"//str2, nvarid)
740           IF (ierr.NE.NF_NOERR) THEN
741              PRINT*, "phyetat0: Le champ <ALBE"//str2//"> est absent"
742              CALL abort
743           ENDIF
744#ifdef NC_DOUBLE
745           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1,nsrf))
746#else
747           ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1,nsrf))
748#endif
749           IF (ierr.NE.NF_NOERR) THEN
750             PRINT*, "phyetat0: Lecture echouee pour <ALBE"//str2//">"
751             CALL abort
752           ENDIF
753           xmin = 1.0E+20
754           xmax = -1.0E+20
755           DO i = 1, klon_glo
756              xmin = MIN(albe(i,nsrf),xmin)
757              xmax = MAX(albe(i,nsrf),xmax)
758           ENDDO
759           PRINT*,'Albedo du sol ALBE**:', nsrf, xmin, xmax
760         ENDDO
761      ELSE
762         PRINT*, 'phyetat0: Le champ <ALBE> est present'
763         PRINT*, '          J ignore donc les autres ALBE**'
764#ifdef NC_DOUBLE
765         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1,1))
766#else
767         ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1,1))
768#endif
769         IF (ierr.NE.NF_NOERR) THEN
770            PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
771            CALL abort
772         ENDIF
773         xmin = 1.0E+20
774         xmax = -1.0E+20
775         DO i = 1, klon_glo
776            xmin = MIN(albe(i,1),xmin)
777            xmax = MAX(albe(i,1),xmax)
778         ENDDO
779         PRINT*,'Neige du sol <ALBE>', xmin, xmax
780         DO nsrf = 2, nbsrf
781         DO i = 1, klon_glo
782            albe(i,nsrf) = albe(i,1)
783         ENDDO
784         ENDDO
785      ENDIF
786
787c
788c Lecture de albedo au sol LW:
789c
790      ierr = NF_INQ_VARID (nid, "ALBLW", nvarid)
791      IF (ierr.NE.NF_NOERR) THEN
792         PRINT*, 'phyetat0: Le champ <ALBLW> est absent'
793c        PRINT*, '          Mais je vais essayer de lire ALBLW**'
794         PRINT*, '          Mais je vais prendre ALBE**'
795         DO nsrf = 1, nbsrf
796           DO i = 1, klon_glo
797             alblw(i,nsrf) = albe(i,nsrf)
798           ENDDO
799         ENDDO
800      ELSE
801         PRINT*, 'phyetat0: Le champ <ALBLW> est present'
802         PRINT*, '          J ignore donc les autres ALBLW**'
803#ifdef NC_DOUBLE
804         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alblw(1,1))
805#else
806         ierr = NF_GET_VAR_REAL(nid, nvarid, alblw(1,1))
807#endif
808         IF (ierr.NE.NF_NOERR) THEN
809            PRINT*, "phyetat0: Lecture echouee pour <ALBLW>"
810            CALL abort
811         ENDIF
812         xmin = 1.0E+20
813         xmax = -1.0E+20
814         DO i = 1, klon_glo
815            xmin = MIN(alblw(i,1),xmin)
816            xmax = MAX(alblw(i,1),xmax)
817         ENDDO
818         PRINT*,'Neige du sol <ALBLW>', xmin, xmax
819         DO nsrf = 2, nbsrf
820         DO i = 1, klon_glo
821            alblw(i,nsrf) = alblw(i,1)
822         ENDDO
823         ENDDO
824      ENDIF
825c
826c Lecture de evaporation: 
827c
828      ierr = NF_INQ_VARID (nid, "EVAP", nvarid)
829      IF (ierr.NE.NF_NOERR) THEN
830         PRINT*, 'phyetat0: Le champ <EVAP> est absent'
831         PRINT*, '          Mais je vais essayer de lire EVAP**'
832         DO nsrf = 1, nbsrf
833           IF (nsrf.GT.99) THEN
834             PRINT*, "Trop de sous-mailles"
835             CALL abort
836           ENDIF
837           WRITE(str2,'(i2.2)') nsrf
838           ierr = NF_INQ_VARID (nid, "EVAP"//str2, nvarid)
839           IF (ierr.NE.NF_NOERR) THEN
840              PRINT*, "phyetat0: Le champ <EVAP"//str2//"> est absent"
841              CALL abort
842           ENDIF
843#ifdef NC_DOUBLE
844           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, evap(1,nsrf))
845#else
846           ierr = NF_GET_VAR_REAL(nid, nvarid, evap(1,nsrf))
847#endif
848           IF (ierr.NE.NF_NOERR) THEN
849             PRINT*, "phyetat0: Lecture echouee pour <EVAP"//str2//">"
850             CALL abort
851           ENDIF
852           xmin = 1.0E+20
853           xmax = -1.0E+20
854           DO i = 1, klon_glo
855              xmin = MIN(evap(i,nsrf),xmin)
856              xmax = MAX(evap(i,nsrf),xmax)
857           ENDDO
858           PRINT*,'evap du sol EVAP**:', nsrf, xmin, xmax
859         ENDDO
860      ELSE
861         PRINT*, 'phyetat0: Le champ <EVAP> est present'
862         PRINT*, '          J ignore donc les autres EVAP**'
863#ifdef NC_DOUBLE
864         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, evap(1,1))
865#else
866         ierr = NF_GET_VAR_REAL(nid, nvarid, evap(1,1))
867#endif
868         IF (ierr.NE.NF_NOERR) THEN
869            PRINT*, "phyetat0: Lecture echouee pour <EVAP>"
870            CALL abort
871         ENDIF
872         xmin = 1.0E+20
873         xmax = -1.0E+20
874         DO i = 1, klon_glo
875            xmin = MIN(evap(i,1),xmin)
876            xmax = MAX(evap(i,1),xmax)
877         ENDDO
878         PRINT*,'Evap du sol <EVAP>', xmin, xmax
879         DO nsrf = 2, nbsrf
880         DO i = 1, klon_glo
881            evap(i,nsrf) = evap(i,1)
882         ENDDO
883         ENDDO
884      ENDIF
885c
886c Lecture precipitation liquide:
887c
888      ierr = NF_INQ_VARID (nid, "rain_f", nvarid)
889      IF (ierr.NE.NF_NOERR) THEN
890         PRINT*, 'phyetat0: Le champ <rain_f> est absent'
891         CALL abort
892      ENDIF
893#ifdef NC_DOUBLE
894      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rain_fall)
895#else
896      ierr = NF_GET_VAR_REAL(nid, nvarid, rain_fall)
897#endif
898      IF (ierr.NE.NF_NOERR) THEN
899         PRINT*, 'phyetat0: Lecture echouee pour <rain_f>'
900         CALL abort
901      ENDIF
902      xmin = 1.0E+20
903      xmax = -1.0E+20
904      DO i = 1, klon_glo
905         xmin = MIN(rain_fall(i),xmin)
906         xmax = MAX(rain_fall(i),xmax)
907      ENDDO
908      PRINT*,'Precipitation liquide rain_f:', xmin, xmax
909c
910c Lecture precipitation solide:
911c
912      ierr = NF_INQ_VARID (nid, "snow_f", nvarid)
913      IF (ierr.NE.NF_NOERR) THEN
914         PRINT*, 'phyetat0: Le champ <snow_f> est absent'
915         CALL abort
916      ENDIF
917#ifdef NC_DOUBLE
918      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow_fall)
919#else
920      ierr = NF_GET_VAR_REAL(nid, nvarid, snow_fall)
921#endif
922      IF (ierr.NE.NF_NOERR) THEN
923         PRINT*, 'phyetat0: Lecture echouee pour <snow_f>'
924         CALL abort
925      ENDIF
926      xmin = 1.0E+20
927      xmax = -1.0E+20
928      DO i = 1, klon_glo
929         xmin = MIN(snow_fall(i),xmin)
930         xmax = MAX(snow_fall(i),xmax)
931      ENDDO
932      PRINT*,'Precipitation solide snow_f:', xmin, xmax
933c
934c Lecture rayonnement solaire au sol:
935c
936      ierr = NF_INQ_VARID (nid, "solsw", nvarid)
937      IF (ierr.NE.NF_NOERR) THEN
938         PRINT*, 'phyetat0: Le champ <solsw> est absent'
939         PRINT*, 'mis a zero'
940         solsw = 0.
941      ELSE
942#ifdef NC_DOUBLE
943        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
944#else
945        ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
946#endif
947        IF (ierr.NE.NF_NOERR) THEN
948          PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
949          CALL abort
950        ENDIF
951      ENDIF
952      xmin = 1.0E+20
953      xmax = -1.0E+20
954      DO i = 1, klon_glo
955         xmin = MIN(solsw(i),xmin)
956         xmax = MAX(solsw(i),xmax)
957      ENDDO
958      PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
959c
960c Lecture rayonnement IF au sol:
961c
962      ierr = NF_INQ_VARID (nid, "sollw", nvarid)
963      IF (ierr.NE.NF_NOERR) THEN
964         PRINT*, 'phyetat0: Le champ <sollw> est absent'
965         PRINT*, 'mis a zero'
966         sollw = 0.
967      ELSE
968#ifdef NC_DOUBLE
969        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
970#else
971        ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
972#endif
973        IF (ierr.NE.NF_NOERR) THEN
974          PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
975          CALL abort
976        ENDIF
977      ENDIF
978      xmin = 1.0E+20
979      xmax = -1.0E+20
980      DO i = 1, klon_glo
981         xmin = MIN(sollw(i),xmin)
982         xmax = MAX(sollw(i),xmax)
983      ENDDO
984      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
985     
986      ENDIF  ! is_mpi_root
987c$OMP END MASTER
988
989
990c$OMP MASTER
991      IF (is_mpi_root) THEN
992c
993c Lecture derive des flux:
994c
995      ierr = NF_INQ_VARID (nid, "fder", nvarid)
996      IF (ierr.NE.NF_NOERR) THEN
997         PRINT*, 'phyetat0: Le champ <fder> est absent'
998         PRINT*, 'mis a zero'
999         fder = 0.
1000      ELSE
1001#ifdef NC_DOUBLE
1002        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
1003#else
1004        ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
1005#endif
1006        IF (ierr.NE.NF_NOERR) THEN
1007          PRINT*, 'phyetat0: Lecture echouee pour <fder>'
1008          CALL abort
1009        ENDIF
1010      ENDIF
1011      xmin = 1.0E+20
1012      xmax = -1.0E+20
1013      DO i = 1, klon_glo
1014         xmin = MIN(fder(i),xmin)
1015         xmax = MAX(fder(i),xmax)
1016      ENDDO
1017      PRINT*,'Derive des flux fder:', xmin, xmax
1018
1019c
1020c Lecture du rayonnement net au sol:
1021c
1022      ierr = NF_INQ_VARID (nid, "RADS", nvarid)
1023      IF (ierr.NE.NF_NOERR) THEN
1024         PRINT*, 'phyetat0: Le champ <RADS> est absent'
1025         CALL abort
1026      ENDIF
1027#ifdef NC_DOUBLE
1028      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
1029#else
1030      ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
1031#endif
1032      IF (ierr.NE.NF_NOERR) THEN
1033         PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
1034         CALL abort
1035      ENDIF
1036      xmin = 1.0E+20
1037      xmax = -1.0E+20
1038      DO i = 1, klon_glo
1039         xmin = MIN(radsol(i),xmin)
1040         xmax = MAX(radsol(i),xmax)
1041      ENDDO
1042      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
1043c
1044c Lecture de la longueur de rugosite
1045c
1046c
1047      ierr = NF_INQ_VARID (nid, "RUG", nvarid)
1048      IF (ierr.NE.NF_NOERR) THEN
1049         PRINT*, 'phyetat0: Le champ <RUG> est absent'
1050         PRINT*, '          Mais je vais essayer de lire RUG**'
1051         DO nsrf = 1, nbsrf
1052           IF (nsrf.GT.99) THEN
1053             PRINT*, "Trop de sous-mailles"
1054             CALL abort
1055           ENDIF
1056           WRITE(str2,'(i2.2)') nsrf
1057           ierr = NF_INQ_VARID (nid, "RUG"//str2, nvarid)
1058           IF (ierr.NE.NF_NOERR) THEN
1059              PRINT*, "phyetat0: Le champ <RUG"//str2//"> est absent"
1060              CALL abort
1061           ENDIF
1062#ifdef NC_DOUBLE
1063           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, frugs(1,nsrf))
1064#else
1065           ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,nsrf))
1066#endif
1067           IF (ierr.NE.NF_NOERR) THEN
1068             PRINT*, "phyetat0: Lecture echouee pour <RUG"//str2//">"
1069             CALL abort
1070           ENDIF
1071           xmin = 1.0E+20
1072           xmax = -1.0E+20
1073           DO i = 1, klon_glo
1074              xmin = MIN(frugs(i,nsrf),xmin)
1075              xmax = MAX(frugs(i,nsrf),xmax)
1076           ENDDO
1077           PRINT*,'rugosite du sol RUG**:', nsrf, xmin, xmax
1078         ENDDO
1079      ELSE
1080         PRINT*, 'phyetat0: Le champ <RUG> est present'
1081         PRINT*, '          J ignore donc les autres RUG**'
1082#ifdef NC_DOUBLE
1083         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, frugs(1,1))
1084#else
1085         ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,1))
1086#endif
1087         IF (ierr.NE.NF_NOERR) THEN
1088            PRINT*, "phyetat0: Lecture echouee pour <RUG>"
1089            CALL abort
1090         ENDIF
1091         xmin = 1.0E+20
1092         xmax = -1.0E+20
1093         DO i = 1, klon_glo
1094            xmin = MIN(frugs(i,1),xmin)
1095            xmax = MAX(frugs(i,1),xmax)
1096         ENDDO
1097         PRINT*,'rugosite <RUG>', xmin, xmax
1098         DO nsrf = 2, nbsrf
1099         DO i = 1, klon_glo
1100            frugs(i,nsrf) = frugs(i,1)
1101         ENDDO
1102         ENDDO
1103      ENDIF
1104
1105c
1106c Lecture de l'age de la neige:
1107c
1108      ierr = NF_INQ_VARID (nid, "AGESNO", nvarid)
1109      IF (ierr.NE.NF_NOERR) THEN
1110         PRINT*, 'phyetat0: Le champ <AGESNO> est absent'
1111         PRINT*, '          Mais je vais essayer de lire AGESNO**'
1112         DO nsrf = 1, nbsrf
1113           IF (nsrf.GT.99) THEN
1114             PRINT*, "Trop de sous-mailles"
1115             CALL abort
1116           ENDIF
1117           WRITE(str2,'(i2.2)') nsrf
1118           ierr = NF_INQ_VARID (nid, "AGESNO"//str2, nvarid)
1119           IF (ierr.NE.NF_NOERR) THEN
1120              PRINT*, "phyetat0: Le champ <AGESNO"//str2//"> est absent"
1121              agesno = 50.0
1122           ENDIF
1123#ifdef NC_DOUBLE
1124           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, agesno(1,nsrf))
1125#else
1126           ierr = NF_GET_VAR_REAL(nid, nvarid, agesno(1,nsrf))
1127#endif
1128           IF (ierr.NE.NF_NOERR) THEN
1129             PRINT*, "phyetat0: Lecture echouee pour <AGESNO"//str2//">"
1130             CALL abort
1131           ENDIF
1132           xmin = 1.0E+20
1133           xmax = -1.0E+20
1134           DO i = 1, klon_glo
1135              xmin = MIN(agesno(i,nsrf),xmin)
1136              xmax = MAX(agesno(i,nsrf),xmax)
1137           ENDDO
1138           PRINT*,'Age de la neige AGESNO**:', nsrf, xmin, xmax
1139         ENDDO
1140      ELSE
1141         PRINT*, 'phyetat0: Le champ <AGESNO> est present'
1142         PRINT*, '          J ignore donc les autres AGESNO**'
1143#ifdef NC_DOUBLE
1144         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, agesno(1,1))
1145#else
1146         ierr = NF_GET_VAR_REAL(nid, nvarid, agesno(1,1))
1147#endif
1148         IF (ierr.NE.NF_NOERR) THEN
1149            PRINT*, "phyetat0: Lecture echouee pour <AGESNO>"
1150            CALL abort
1151         ENDIF
1152         xmin = 1.0E+20
1153         xmax = -1.0E+20
1154         DO i = 1, klon_glo
1155            xmin = MIN(agesno(i,1),xmin)
1156            xmax = MAX(agesno(i,1),xmax)
1157         ENDDO
1158         PRINT*,'Age de la neige <AGESNO>', xmin, xmax
1159         DO nsrf = 2, nbsrf
1160         DO i = 1, klon_glo
1161            agesno(i,nsrf) = agesno(i,1)
1162         ENDDO
1163         ENDDO
1164      ENDIF
1165
1166c
1167      ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
1168      IF (ierr.NE.NF_NOERR) THEN
1169         PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
1170         CALL abort
1171      ENDIF
1172#ifdef NC_DOUBLE
1173      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea)
1174#else
1175      ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)
1176#endif
1177      IF (ierr.NE.NF_NOERR) THEN
1178         PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
1179         CALL abort
1180      ENDIF
1181      xmin = 1.0E+20
1182      xmax = -1.0E+20
1183      DO i = 1, klon_glo
1184         xmin = MIN(zmea(i),xmin)
1185         xmax = MAX(zmea(i),xmax)
1186      ENDDO
1187      PRINT*,'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
1188c
1189c
1190      ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
1191      IF (ierr.NE.NF_NOERR) THEN
1192         PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
1193         CALL abort
1194      ENDIF
1195#ifdef NC_DOUBLE
1196      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd)
1197#else
1198      ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)
1199#endif
1200      IF (ierr.NE.NF_NOERR) THEN
1201         PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
1202         CALL abort
1203      ENDIF
1204      xmin = 1.0E+20
1205      xmax = -1.0E+20
1206      DO i = 1, klon_glo
1207         xmin = MIN(zstd(i),xmin)
1208         xmax = MAX(zstd(i),xmax)
1209      ENDDO
1210      PRINT*,'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
1211c
1212c
1213      ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
1214      IF (ierr.NE.NF_NOERR) THEN
1215         PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
1216         CALL abort
1217      ENDIF
1218#ifdef NC_DOUBLE
1219      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig)
1220#else
1221      ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)
1222#endif
1223      IF (ierr.NE.NF_NOERR) THEN
1224         PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
1225         CALL abort
1226      ENDIF
1227      xmin = 1.0E+20
1228      xmax = -1.0E+20
1229      DO i = 1, klon_glo
1230         xmin = MIN(zsig(i),xmin)
1231         xmax = MAX(zsig(i),xmax)
1232      ENDDO
1233      PRINT*,'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
1234c
1235c
1236      ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
1237      IF (ierr.NE.NF_NOERR) THEN
1238         PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
1239         CALL abort
1240      ENDIF
1241#ifdef NC_DOUBLE
1242      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam)
1243#else
1244      ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)
1245#endif
1246      IF (ierr.NE.NF_NOERR) THEN
1247         PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
1248         CALL abort
1249      ENDIF
1250      xmin = 1.0E+20
1251      xmax = -1.0E+20
1252      DO i = 1, klon_glo
1253         xmin = MIN(zgam(i),xmin)
1254         xmax = MAX(zgam(i),xmax)
1255      ENDDO
1256      PRINT*,'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
1257c
1258c
1259      ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
1260      IF (ierr.NE.NF_NOERR) THEN
1261         PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
1262         CALL abort
1263      ENDIF
1264#ifdef NC_DOUBLE
1265      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe)
1266#else
1267      ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)
1268#endif
1269      IF (ierr.NE.NF_NOERR) THEN
1270         PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
1271         CALL abort
1272      ENDIF
1273      xmin = 1.0E+20
1274      xmax = -1.0E+20
1275      DO i = 1, klon_glo
1276         xmin = MIN(zthe(i),xmin)
1277         xmax = MAX(zthe(i),xmax)
1278      ENDDO
1279      PRINT*,'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
1280c
1281c
1282      ierr = NF_INQ_VARID (nid, "ZPIC", nvarid)
1283      IF (ierr.NE.NF_NOERR) THEN
1284         PRINT*, 'phyetat0: Le champ <ZPIC> est absent'
1285         CALL abort
1286      ENDIF
1287#ifdef NC_DOUBLE
1288      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zpic)
1289#else
1290      ierr = NF_GET_VAR_REAL(nid, nvarid, zpic)
1291#endif
1292      IF (ierr.NE.NF_NOERR) THEN
1293         PRINT*, 'phyetat0: Lecture echouee pour <ZPIC>'
1294         CALL abort
1295      ENDIF
1296      xmin = 1.0E+20
1297      xmax = -1.0E+20
1298      DO i = 1, klon_glo
1299         xmin = MIN(zpic(i),xmin)
1300         xmax = MAX(zpic(i),xmax)
1301      ENDDO
1302      PRINT*,'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
1303c
1304      ierr = NF_INQ_VARID (nid, "ZVAL", nvarid)
1305      IF (ierr.NE.NF_NOERR) THEN
1306         PRINT*, 'phyetat0: Le champ <ZVAL> est absent'
1307         CALL abort
1308      ENDIF
1309#ifdef NC_DOUBLE
1310      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zval)
1311#else
1312      ierr = NF_GET_VAR_REAL(nid, nvarid, zval)
1313#endif
1314      IF (ierr.NE.NF_NOERR) THEN
1315         PRINT*, 'phyetat0: Lecture echouee pour <ZVAL>'
1316         CALL abort
1317      ENDIF
1318      xmin = 1.0E+20
1319      xmax = -1.0E+20
1320      DO i = 1, klon_glo
1321         xmin = MIN(zval(i),xmin)
1322         xmax = MAX(zval(i),xmax)
1323      ENDDO
1324      PRINT*,'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
1325c
1326c
1327      ierr = NF_INQ_VARID (nid, "RUGSREL", nvarid)
1328      IF (ierr.NE.NF_NOERR) THEN
1329         PRINT*, 'phyetat0: Le champ <RUGSREL> est absent'
1330         CALL abort
1331      ENDIF
1332#ifdef NC_DOUBLE
1333      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rugsrel)
1334#else
1335      ierr = NF_GET_VAR_REAL(nid, nvarid, rugsrel)
1336#endif
1337      IF (ierr.NE.NF_NOERR) THEN
1338         PRINT*, 'phyetat0: Lecture echouee pour <RUGSREL>'
1339         CALL abort
1340      ENDIF
1341      xmin = 1.0E+20
1342      xmax = -1.0E+20
1343      DO i = 1, klon_glo
1344         xmin = MIN(rugsrel(i),xmin)
1345         xmax = MAX(rugsrel(i),xmax)
1346      ENDDO
1347      PRINT*,'Rugosite relief (ecart-type) rugsrel:', xmin, xmax
1348c
1349c
1350      ancien_ok = .TRUE.
1351c
1352      ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
1353      IF (ierr.NE.NF_NOERR) THEN
1354         PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
1355         PRINT*, "Depart legerement fausse. Mais je continue"
1356         ancien_ok = .FALSE.
1357      ELSE
1358#ifdef NC_DOUBLE
1359         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
1360#else
1361         ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
1362#endif
1363         IF (ierr.NE.NF_NOERR) THEN
1364            PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
1365            CALL abort
1366         ENDIF
1367      ENDIF
1368c
1369      ierr = NF_INQ_VARID (nid, "QANCIEN", nvarid)
1370      IF (ierr.NE.NF_NOERR) THEN
1371         PRINT*, "phyetat0: Le champ <QANCIEN> est absent"
1372         PRINT*, "Depart legerement fausse. Mais je continue"
1373         ancien_ok = .FALSE.
1374      ELSE
1375#ifdef NC_DOUBLE
1376         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_ancien)
1377#else
1378         ierr = NF_GET_VAR_REAL(nid, nvarid, q_ancien)
1379#endif
1380         IF (ierr.NE.NF_NOERR) THEN
1381            PRINT*, "phyetat0: Lecture echouee pour <QANCIEN>"
1382            CALL abort
1383         ENDIF
1384      ENDIF
1385c
1386      clwcon=0.
1387      ierr = NF_INQ_VARID (nid, "CLWCON", nvarid)
1388      IF (ierr.NE.NF_NOERR) THEN
1389         PRINT*, "phyetat0: Le champ CLWCON est absent"
1390         PRINT*, "Depart legerement fausse. Mais je continue"
1391         clwcon = 0.
1392      ELSE
1393#ifdef NC_DOUBLE
1394         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, clwcon)
1395#else
1396         ierr = NF_GET_VAR_REAL(nid, nvarid, clwcon)
1397#endif
1398         IF (ierr.NE.NF_NOERR) THEN
1399            PRINT*, "phyetat0: Lecture echouee pour <CLWCON>"
1400            CALL abort
1401         ENDIF
1402      ENDIF
1403      xmin = 1.0E+20
1404      xmax = -1.0E+20
1405      xmin = MINval(clwcon)
1406      xmax = MAXval(clwcon)
1407      PRINT*,'Eau liquide convective (ecart-type) clwcon:', xmin, xmax
1408c
1409      rnebcon=0.
1410      ierr = NF_INQ_VARID (nid, "RNEBCON", nvarid)
1411      IF (ierr.NE.NF_NOERR) THEN
1412         PRINT*, "phyetat0: Le champ RNEBCON est absent"
1413         PRINT*, "Depart legerement fausse. Mais je continue"
1414         rnebcon = 0.
1415      ELSE
1416#ifdef NC_DOUBLE
1417         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rnebcon)
1418#else
1419         ierr = NF_GET_VAR_REAL(nid, nvarid, rnebcon)
1420#endif
1421         IF (ierr.NE.NF_NOERR) THEN
1422            PRINT*, "phyetat0: Lecture echouee pour <RNEBCON>"
1423            CALL abort
1424         ENDIF
1425      ENDIF
1426      xmin = 1.0E+20
1427      xmax = -1.0E+20
1428      xmin = MINval(rnebcon)
1429      xmax = MAXval(rnebcon)
1430      PRINT*,'Nebulosite convective (ecart-type) rnebcon:', xmin, xmax
1431
1432c
1433      ierr = NF_INQ_VARID (nid, "QANCIEN", nvarid)
1434      IF (ierr.NE.NF_NOERR) THEN
1435         PRINT*, "phyetat0: Le champ <QANCIEN> est absent"
1436         PRINT*, "Depart legerement fausse. Mais je continue"
1437         ancien_ok = .FALSE.
1438      ELSE
1439#ifdef NC_DOUBLE
1440         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_ancien)
1441#else
1442         ierr = NF_GET_VAR_REAL(nid, nvarid, q_ancien)
1443#endif
1444         IF (ierr.NE.NF_NOERR) THEN
1445            PRINT*, "phyetat0: Lecture echouee pour <QANCIEN>"
1446            CALL abort
1447         ENDIF
1448      ENDIF
1449c
1450c Lecture ratqs
1451c
1452       ratqs=0.
1453      ierr = NF_INQ_VARID (nid, "RATQS", nvarid)
1454      IF (ierr.NE.NF_NOERR) THEN
1455         PRINT*, "phyetat0: Le champ <RATQS> est absent"
1456         PRINT*, "Depart legerement fausse. Mais je continue"
1457         ratqs = 0.
1458      ELSE
1459#ifdef NC_DOUBLE
1460         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ratqs)
1461#else
1462         ierr = NF_GET_VAR_REAL(nid, nvarid, ratqs)
1463#endif
1464         IF (ierr.NE.NF_NOERR) THEN
1465            PRINT*, "phyetat0: Lecture echouee pour <RATQS>"
1466            CALL abort
1467         ENDIF
1468      ENDIF
1469      xmin = 1.0E+20
1470      xmax = -1.0E+20
1471      xmin = MINval(ratqs)
1472      xmax = MAXval(ratqs)
1473      PRINT*,'(ecart-type) ratqs:', xmin, xmax
1474c
1475c Lecture run_off_lic_0
1476c
1477      ierr = NF_INQ_VARID (nid, "RUNOFFLIC0", nvarid)
1478      IF (ierr.NE.NF_NOERR) THEN
1479         PRINT*, "phyetat0: Le champ <RUNOFFLIC0> est absent"
1480         PRINT*, "Depart legerement fausse. Mais je continue"
1481         run_off_lic_0 = 0.
1482      ELSE
1483#ifdef NC_DOUBLE
1484         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, run_off_lic_0)
1485#else
1486         ierr = NF_GET_VAR_REAL(nid, nvarid, run_off_lic_0)
1487#endif
1488         IF (ierr.NE.NF_NOERR) THEN
1489            PRINT*, "phyetat0: Lecture echouee pour <RUNOFFLIC0>"
1490            CALL abort
1491         ENDIF
1492      ENDIF
1493      xmin = 1.0E+20
1494      xmax = -1.0E+20
1495      xmin = MINval(run_off_lic_0)
1496      xmax = MAXval(run_off_lic_0)
1497      PRINT*,'(ecart-type) run_off_lic_0:', xmin, xmax
[852]1498
1499
1500c Lecture de l'energie cinetique turbulente
[814]1501c
[852]1502
1503      IF (iflag_pbl>1) then
1504         PRINT*, 'phyetat0: Le champ <TKE> est absent'
1505         PRINT*, '          Mais je vais essayer de lire TKE**'
1506         DO nsrf = 1, nbsrf
1507           IF (nsrf.GT.99) THEN
1508             PRINT*, "Trop de sous-mailles"
1509             CALL abort
1510           ENDIF
1511           WRITE(str2,'(i2.2)') nsrf
1512           ierr = NF_INQ_VARID (nid, "TKE"//str2, nvarid)
1513           IF (ierr.NE.NF_NOERR) THEN
1514              PRINT*, "WARNING phyetat0: <TKE"//str2//"> est absent"
1515              pbl_tke(:,:,nsrf)=1.e-8
1516           ELSE
1517#ifdef NC_DOUBLE
1518              ierr = NF_GET_VAR_DOUBLE(nid, nvarid, pbl_tke(1,1,nsrf))
1519#else
1520              ierr = NF_GET_VAR_REAL(nid, nvarid, pbl_tke(1,1,nsrf))
1521#endif
1522              IF (ierr.NE.NF_NOERR) THEN
1523                PRINT*, "WARNING phyetat0: echec lect <TKE"//str2//">"
1524                CALL abort
1525              ENDIF
1526           ENDIF
1527
1528           xmin = 1.0E+20
1529           xmax = -1.0E+20
1530           DO k = 1, klev
1531           DO i = 1, klon_glo
1532              xmin = MIN(pbl_tke(i,k,nsrf),xmin)
1533              xmax = MAX(pbl_tke(i,k,nsrf),xmax)
1534           ENDDO
1535           ENDDO
1536           PRINT*,'Temperature du sol TKE**:', nsrf, xmin, xmax
1537         ENDDO
1538      ENDIF
1539
1540c
[814]1541c Fermer le fichier:
1542c
1543      ierr = NF_CLOSE(nid)
1544      ENDIF ! is_mpi_root
1545c
1546c$OMP END MASTER
1547
1548c$OMP MASTER
1549cym  en attendant mieux
1550        iolat(1)=rlat(1)
1551        iolat(jjm+1)=rlat(klon_glo)
1552        do i=2,jjm
1553          iolat(i)=rlat(2+(i-2)*iim)
1554        enddo
1555        CALL bcast_mpi(iolat)
1556        CALL bcast_mpi(rlon)
1557        call init_iophy(iolat,rlon(2:iim+1))
1558       
1559c$OMP END MASTER
1560       
1561      call Scatter( rlat,rlat_p)
1562      call Scatter( rlon,rlon_p)
1563      call Scatter( tsol,tsol_p)
[852]1564      IF (iflag_pbl>1) then
1565         call Scatter( pbl_tke,pbl_tke_p)
1566      endif
[814]1567      call Scatter( tsoil,tsoil_p)
1568      call Scatter( tslab,tslab_p)
1569      call Scatter( seaice,seaice_p)
1570      call Scatter( qsurf,qsurf_p)
1571      call Scatter( qsol,qsol_p)
1572      call Scatter( snow,snow_p)
1573      call Scatter( albe,albe_p)
1574      call Scatter( alblw,alblw_p)
1575      call Scatter( evap,evap_p)
1576      call Scatter( radsol,radsol_p)
1577      call Scatter( rain_fall,rain_fall_p)
1578      call Scatter( snow_fall,snow_fall_p)
1579      call Scatter( sollw,sollw_p)
1580      call Scatter( solsw,solsw_p)
1581      call Scatter( fder,fder_p)
1582      call Scatter( frugs,frugs_p)
1583      call Scatter( agesno,agesno_p)
1584      call Scatter( zmea,zmea_p)
1585      call Scatter( zstd,zstd_p)
1586      call Scatter( zsig,zsig_p)
1587      call Scatter( zgam,zgam_p)
1588      call Scatter( zthe,zthe_p)
1589      call Scatter( zpic,zpic_p)
1590      call Scatter( zval,zval_p)
1591      call Scatter( rugsrel,rugsrel_p)
1592      call Scatter( pctsrf,pctsrf_p)
1593      call Scatter( run_off_lic_0,run_off_lic_0_p)
1594      call Scatter( t_ancien,t_ancien_p)
1595      call Scatter( q_ancien,q_ancien_p)
1596      call Scatter( rnebcon,rnebcon_p)
1597      call Scatter( clwcon,clwcon_p)
1598      call Scatter( ratqs,ratqs_p)
1599      call Scatter( zmasq_glo,zmasq)
1600
1601c
1602c Initilalize variables in module surface_data
1603c
1604      ok_veget = ok_veget_in
1605      ocean    = ocean_in
1606c
1607c Initialize module pbl_surface_mod
1608c
1609      CALL pbl_surface_init(qsol_p, fder_p, snow_p, qsurf_p,
1610     $     evap_p, frugs_p, agesno_p, tsoil_p)
1611
1612c Initialize ocean module according to ocean type
1613      IF ( ocean == 'slab' ) THEN
1614c        initilalize module ocean_slab_init
1615         CALL ocean_slab_init(dtime, tslab_p, seaice_p, pctsrf_p)
1616      ELSEIF ( ocean == 'couple' ) THEN
1617c        initilalize module ocean_cpl_init
1618         CALL ocean_cpl_init(dtime, rlon_p, rlat_p)
1619      ELSE
1620c        initilalize module ocean_forced_init
1621         CALL ocean_forced_init
1622      ENDIF
1623c
1624c Initilialize module fonte_neige_mod     
1625c
1626      CALL fonte_neige_init(run_off_lic_0_p)
1627
1628
1629      RETURN
1630      END
Note: See TracBrowser for help on using the repository browser.