source: trunk/LMDZ.VENUS/libf/phyvenus/readstartphy.F @ 1314

Last change on this file since 1314 was 1301, checked in by slebonnois, 11 years ago

SL: many bug corrections in phyvenus, some cleaning, and a new ksi matrix format for Venus IR
File size: 14.2 KB
RevLine 
[3]1!
2! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phyetat0.F,v 1.2 2004/06/22 11:45:33 lmdzadmin Exp $
3!
4c
5c
6      SUBROUTINE readstartphy(fichnom,
7     .            rlat,rlon, tsol,tsoil,
8     .           albe, solsw, sollw,
[1301]9     .           fder,dlw, sollwdown, radsol,
[808]10     .    zmea, zstd, zsig, zgam, zthe, zpic, zval,
[3]11     .           tabcntr0)
12c======================================================================
13c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
14c Objet: Lecture de l'etat initial pour la physique
15c======================================================================
[101]16      use dimphy
17      IMPLICIT none
[3]18#include "dimensions.h"
19#include "netcdf.inc"
20#include "dimsoil.h"
21#include "temps.h"
22c======================================================================
[778]23      integer ngridmx
24      parameter (ngridmx=(2+(jjm-1)*iim - 1/jjm))
25
[3]26      CHARACTER*(*) fichnom
[778]27      REAL rlat(ngridmx), rlon(ngridmx)
28      REAL tsol(ngridmx)
29      REAL tsoil(ngridmx,nsoilmx)
30      REAL albe(ngridmx)
31      REAL radsol(ngridmx)
32      REAL sollw(ngridmx)
33      real solsw(ngridmx)
34      real fder(ngridmx)
[1301]35      real dlw(ngridmx)
36      real sollwdown(ngridmx)
[808]37      REAL zmea(ngridmx), zstd(ngridmx)
38      REAL zsig(ngridmx), zgam(ngridmx), zthe(ngridmx)
39      REAL zpic(ngridmx), zval(ngridmx)
[3]40      INTEGER length
41      PARAMETER (length=100)
42      REAL tabcntr0(length)
43
44      REAL xmin, xmax
45c
46      INTEGER nid, nvarid
47      INTEGER ierr, i, nsrf, isoil
48      CHARACTER*2 str2
49c
50c Ouvrir le fichier contenant l'etat initial:
51c
52      print*,'fichnom',fichnom
53      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
54      IF (ierr.NE.NF_NOERR) THEN
55        write(6,*)' Pb d''ouverture du fichier '//fichnom
56        write(6,*)' ierr = ', ierr
57        CALL ABORT
58      ENDIF
59c
60c Lecture des parametres de controle:
61c
62      ierr = NF_INQ_VARID (nid, "controle", nvarid)
63      IF (ierr.NE.NF_NOERR) THEN
64         PRINT*, 'phyetat0: Le champ <controle> est absent'
65         CALL abort
66      ENDIF
67#ifdef NC_DOUBLE
68      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tabcntr0)
69#else
70      ierr = NF_GET_VAR_REAL(nid, nvarid, tabcntr0)
71#endif
72      IF (ierr.NE.NF_NOERR) THEN
73         PRINT*, 'phyetat0: Lecture echouee pour <controle>'
74         CALL abort
75      ENDIF
76c
77c
78c Lecture des latitudes (coordonnees):
79c
80      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
81      IF (ierr.NE.NF_NOERR) THEN
82         PRINT*, 'phyetat0: Le champ <latitude> est absent'
83         CALL abort
84      ENDIF
85#ifdef NC_DOUBLE
86      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
87#else
88      ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
89#endif
90      IF (ierr.NE.NF_NOERR) THEN
91         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
92         CALL abort
93      ENDIF
94c
95c Lecture des longitudes (coordonnees):
96c
97      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
98      IF (ierr.NE.NF_NOERR) THEN
99         PRINT*, 'phyetat0: Le champ <longitude> est absent'
100         CALL abort
101      ENDIF
102#ifdef NC_DOUBLE
103      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
104#else
105      ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
106#endif
107      IF (ierr.NE.NF_NOERR) THEN
108         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
109         CALL abort
110      ENDIF
111C
112c Lecture des temperatures du sol:
113c
114      ierr = NF_INQ_VARID (nid, "TS", nvarid)
115      IF (ierr.NE.NF_NOERR) THEN
116         PRINT*, 'phyetat0: Le champ <TS> est absent'
117         PRINT*, "phyetat0: Lecture echouee pour <TS>"
118         CALL abort
119      ELSE
120         PRINT*, 'phyetat0: Le champ <TS> est present'
121#ifdef NC_DOUBLE
[778]122         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol)
[3]123#else
[778]124         ierr = NF_GET_VAR_REAL(nid, nvarid, tsol)
[3]125#endif
126         IF (ierr.NE.NF_NOERR) THEN
127            PRINT*, "phyetat0: Lecture echouee pour <TS>"
128            CALL abort
129         ENDIF
130         xmin = 1.0E+20
131         xmax = -1.0E+20
[778]132         DO i = 1, ngridmx
[3]133            xmin = MIN(tsol(i),xmin)
134            xmax = MAX(tsol(i),xmax)
135         ENDDO
136         PRINT*,'Temperature du sol <TS>', xmin, xmax
137      ENDIF
138c
139c Lecture des temperatures du sol profond:
140c
141      DO isoil=1, nsoilmx
142      IF (isoil.GT.99) THEN
143         PRINT*, "Trop de couches"
144         CALL abort
145      ENDIF
146      WRITE(str2,'(i2.2)') isoil
147      ierr = NF_INQ_VARID (nid, 'Tsoil'//str2, nvarid)
148      IF (ierr.NE.NF_NOERR) THEN
149         PRINT*, "phyetat0: Le champ <Tsoil"//str2//"> est absent"
150         PRINT*, "          Il prend donc la valeur de surface"
[778]151         DO i=1, ngridmx
[3]152             tsoil(i,isoil)=tsol(i)
153         ENDDO
154      ELSE
155#ifdef NC_DOUBLE
156         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil))
157#else
158         ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil))
159#endif
160         IF (ierr.NE.NF_NOERR) THEN
161            PRINT*, "Lecture echouee pour <Tsoil"//str2//">"
162            CALL abort
163         ENDIF
164      ENDIF
165      ENDDO
[778]166
[3]167c
168c Lecture de albedo au sol:
169c
170      ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
171      IF (ierr.NE.NF_NOERR) THEN
172         PRINT*, 'phyetat0: Le champ <ALBE> est absent'
173         PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
174         CALL abort
175      ELSE
176         PRINT*, 'phyetat0: Le champ <ALBE> est present'
177#ifdef NC_DOUBLE
178         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1))
179#else
180         ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1))
181#endif
182         IF (ierr.NE.NF_NOERR) THEN
183            PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
184            CALL abort
185         ENDIF
186         xmin = 1.0E+20
187         xmax = -1.0E+20
[778]188         DO i = 1, ngridmx
[3]189            xmin = MIN(albe(i),xmin)
190            xmax = MAX(albe(i),xmax)
191         ENDDO
192         PRINT*,'Albedo du sol <ALBE>', xmin, xmax
193      ENDIF
194
195c
196c Lecture rayonnement solaire au sol:
197c
198      ierr = NF_INQ_VARID (nid, "solsw", nvarid)
199      IF (ierr.NE.NF_NOERR) THEN
200         PRINT*, 'phyetat0: Le champ <solsw> est absent'
201         PRINT*, 'mis a zero'
202         solsw = 0.
203      ELSE
204#ifdef NC_DOUBLE
205        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
206#else
207        ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
208#endif
209        IF (ierr.NE.NF_NOERR) THEN
210          PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
211          CALL abort
212        ENDIF
213      ENDIF
214      xmin = 1.0E+20
215      xmax = -1.0E+20
[778]216      DO i = 1, ngridmx
[3]217         xmin = MIN(solsw(i),xmin)
218         xmax = MAX(solsw(i),xmax)
219      ENDDO
220      PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
221c
222c Lecture rayonnement IF au sol:
223c
224      ierr = NF_INQ_VARID (nid, "sollw", nvarid)
225      IF (ierr.NE.NF_NOERR) THEN
226         PRINT*, 'phyetat0: Le champ <sollw> est absent'
227         PRINT*, 'mis a zero'
228         sollw = 0.
229      ELSE
230#ifdef NC_DOUBLE
231        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
232#else
233        ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
234#endif
235        IF (ierr.NE.NF_NOERR) THEN
236          PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
237          CALL abort
238        ENDIF
239      ENDIF
240      xmin = 1.0E+20
241      xmax = -1.0E+20
[778]242      DO i = 1, ngridmx
[3]243         xmin = MIN(sollw(i),xmin)
244         xmax = MAX(sollw(i),xmax)
245      ENDDO
246      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
247
248c
249c Lecture derive des flux:
250c
251      ierr = NF_INQ_VARID (nid, "fder", nvarid)
252      IF (ierr.NE.NF_NOERR) THEN
253         PRINT*, 'phyetat0: Le champ <fder> est absent'
254         PRINT*, 'mis a zero'
255         fder = 0.
256      ELSE
257#ifdef NC_DOUBLE
258        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
259#else
260        ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
261#endif
262        IF (ierr.NE.NF_NOERR) THEN
263          PRINT*, 'phyetat0: Lecture echouee pour <fder>'
264          CALL abort
265        ENDIF
266      ENDIF
267      xmin = 1.0E+20
268      xmax = -1.0E+20
[778]269      DO i = 1, ngridmx
[3]270         xmin = MIN(fder(i),xmin)
271         xmax = MAX(fder(i),xmax)
272      ENDDO
273      PRINT*,'Derive des flux fder:', xmin, xmax
274
275c
[1301]276c Lecture derive des flux IR:
277c
278      ierr = NF_INQ_VARID (nid, "dlw", nvarid)
279      IF (ierr.NE.NF_NOERR) THEN
280         PRINT*, 'phyetat0: Le champ <dlw> est absent'
281         PRINT*, 'mis a zero'
282         dlw = 0.
283      ELSE
284#ifdef NC_DOUBLE
285        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, dlw)
286#else
287        ierr = NF_GET_VAR_REAL(nid, nvarid, dlw)
288#endif
289        IF (ierr.NE.NF_NOERR) THEN
290          PRINT*, 'phyetat0: Lecture echouee pour <dlw>'
291          CALL abort
292        ENDIF
293      ENDIF
294      xmin = 1.0E+20
295      xmax = -1.0E+20
296      DO i = 1, ngridmx
297         xmin = MIN(dlw(i),xmin)
298         xmax = MAX(dlw(i),xmax)
299      ENDDO
300      PRINT*,'Derive des flux IR dlw:', xmin, xmax
301
302c
303c Lecture rayonnement IR vers le bas au sol:
304c
305      ierr = NF_INQ_VARID (nid, "sollwdown", nvarid)
306      IF (ierr.NE.NF_NOERR) THEN
307         PRINT*, 'phyetat0: Le champ <sollwdown> est absent'
308         PRINT*, 'mis a zero'
309         sollwdown = 0.
310      ELSE
311#ifdef NC_DOUBLE
312        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollwdown)
313#else
314        ierr = NF_GET_VAR_REAL(nid, nvarid, sollwdown)
315#endif
316        IF (ierr.NE.NF_NOERR) THEN
317          PRINT*, 'phyetat0: Lecture echouee pour <sollwdown>'
318          CALL abort
319        ENDIF
320      ENDIF
321      xmin = 1.0E+20
322      xmax = -1.0E+20
323      DO i = 1, ngridmx
324         xmin = MIN(sollwdown(i),xmin)
325         xmax = MAX(sollwdown(i),xmax)
326      ENDDO
327      PRINT*,'Flux IR vers le bas au sol sollwdown:', xmin, xmax
328
329c
[3]330c Lecture du rayonnement net au sol:
331c
332      ierr = NF_INQ_VARID (nid, "RADS", nvarid)
333      IF (ierr.NE.NF_NOERR) THEN
334         PRINT*, 'phyetat0: Le champ <RADS> est absent'
335         CALL abort
336      ENDIF
337#ifdef NC_DOUBLE
338      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
339#else
340      ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
341#endif
342      IF (ierr.NE.NF_NOERR) THEN
343         PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
344         CALL abort
345      ENDIF
346      xmin = 1.0E+20
347      xmax = -1.0E+20
[778]348      DO i = 1, ngridmx
[3]349         xmin = MIN(radsol(i),xmin)
350         xmax = MAX(radsol(i),xmax)
351      ENDDO
352      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
[808]353
[3]354c
[808]355c Lecture des parametres orographie sous-maille:
356c
357      ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
358      IF (ierr.NE.NF_NOERR) THEN
359         PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
360         PRINT*, 'mis a zero'
361         zmea = 0.
362      ELSE
363#ifdef NC_DOUBLE
364       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea)
365#else
366       ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)
367#endif
368       IF (ierr.NE.NF_NOERR) THEN
369         PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
370         CALL abort
371       ENDIF
372      ENDIF
373      xmin = 1.0E+20
374      xmax = -1.0E+20
375      DO i = 1, ngridmx
376         xmin = MIN(zmea(i),xmin)
377         xmax = MAX(zmea(i),xmax)
378      ENDDO
379      PRINT*,'zmea:', xmin, xmax
380c
381      ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
382      IF (ierr.NE.NF_NOERR) THEN
383         PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
384         PRINT*, 'mis a zero'
385         zstd = 0.
386      ELSE
387#ifdef NC_DOUBLE
388       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd)
389#else
390       ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)
391#endif
392       IF (ierr.NE.NF_NOERR) THEN
393         PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
394         CALL abort
395       ENDIF
396      ENDIF
397      xmin = 1.0E+20
398      xmax = -1.0E+20
399      DO i = 1, ngridmx
400         xmin = MIN(zstd(i),xmin)
401         xmax = MAX(zstd(i),xmax)
402      ENDDO
403      PRINT*,'zstd:', xmin, xmax
404c
405      ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
406      IF (ierr.NE.NF_NOERR) THEN
407         PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
408         PRINT*, 'mis a zero'
409         zsig = 0.
410      ELSE
411#ifdef NC_DOUBLE
412       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig)
413#else
414       ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)
415#endif
416       IF (ierr.NE.NF_NOERR) THEN
417         PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
418         CALL abort
419       ENDIF
420      ENDIF
421      xmin = 1.0E+20
422      xmax = -1.0E+20
423      DO i = 1, ngridmx
424         xmin = MIN(zsig(i),xmin)
425         xmax = MAX(zsig(i),xmax)
426      ENDDO
427      PRINT*,'zsig:', xmin, xmax
428c
429      ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
430      IF (ierr.NE.NF_NOERR) THEN
431         PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
432         PRINT*, 'mis a zero'
433         zgam = 0.
434      ELSE
435#ifdef NC_DOUBLE
436       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam)
437#else
438       ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)
439#endif
440       IF (ierr.NE.NF_NOERR) THEN
441         PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
442         CALL abort
443       ENDIF
444      ENDIF
445      xmin = 1.0E+20
446      xmax = -1.0E+20
447      DO i = 1, ngridmx
448         xmin = MIN(zgam(i),xmin)
449         xmax = MAX(zgam(i),xmax)
450      ENDDO
451      PRINT*,'zgam:', xmin, xmax
452c
453      ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
454      IF (ierr.NE.NF_NOERR) THEN
455         PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
456         PRINT*, 'mis a zero'
457         zthe = 0.
458      ELSE
459#ifdef NC_DOUBLE
460       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe)
461#else
462       ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)
463#endif
464       IF (ierr.NE.NF_NOERR) THEN
465         PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
466         CALL abort
467       ENDIF
468      ENDIF
469      xmin = 1.0E+20
470      xmax = -1.0E+20
471      DO i = 1, ngridmx
472         xmin = MIN(zthe(i),xmin)
473         xmax = MAX(zthe(i),xmax)
474      ENDDO
475      PRINT*,'zthe:', xmin, xmax
476c
477      ierr = NF_INQ_VARID (nid, "ZPIC", nvarid)
478      IF (ierr.NE.NF_NOERR) THEN
479         PRINT*, 'phyetat0: Le champ <ZPIC> est absent'
480         PRINT*, 'mis a zero'
481         zpic = 0.
482      ELSE
483#ifdef NC_DOUBLE
484       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zpic)
485#else
486       ierr = NF_GET_VAR_REAL(nid, nvarid, zpic)
487#endif
488       IF (ierr.NE.NF_NOERR) THEN
489         PRINT*, 'phyetat0: Lecture echouee pour <ZPIC>'
490         CALL abort
491       ENDIF
492      ENDIF
493      xmin = 1.0E+20
494      xmax = -1.0E+20
495      DO i = 1, ngridmx
496         xmin = MIN(zpic(i),xmin)
497         xmax = MAX(zpic(i),xmax)
498      ENDDO
499      PRINT*,'zpic:', xmin, xmax
500c
501      ierr = NF_INQ_VARID (nid, "ZVAL", nvarid)
502      IF (ierr.NE.NF_NOERR) THEN
503         PRINT*, 'phyetat0: Le champ <ZVAL> est absent'
504         PRINT*, 'mis a zero'
505         zval = 0.
506      ELSE
507#ifdef NC_DOUBLE
508       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zval)
509#else
510       ierr = NF_GET_VAR_REAL(nid, nvarid, zval)
511#endif
512       IF (ierr.NE.NF_NOERR) THEN
513         PRINT*, 'phyetat0: Lecture echouee pour <ZVAL>'
514         CALL abort
515       ENDIF
516      ENDIF
517      xmin = 1.0E+20
518      xmax = -1.0E+20
519      DO i = 1, ngridmx
520         xmin = MIN(zval(i),xmin)
521         xmax = MAX(zval(i),xmax)
522      ENDDO
523      PRINT*,'zval:', xmin, xmax
524c
[3]525c Fermer le fichier:
526c
527      ierr = NF_CLOSE(nid)
528c
529      RETURN
[808]530      END
531
Note: See TracBrowser for help on using the repository browser.