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

Last change on this file since 778 was 778, checked in by slebonnois, 12 years ago

SL: bug correction for a file specific to Venus and Titan, + Venus gravity waves routine update (work still in progress)
File size: 8.1 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,
9     .           fder,radsol,
10     .           tabcntr0)
11c======================================================================
12c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
13c Objet: Lecture de l'etat initial pour la physique
14c======================================================================
[101]15      use dimphy
16      IMPLICIT none
[3]17#include "dimensions.h"
18#include "netcdf.inc"
19#include "dimsoil.h"
20#include "temps.h"
21c======================================================================
[778]22      integer ngridmx
23      parameter (ngridmx=(2+(jjm-1)*iim - 1/jjm))
24
[3]25      CHARACTER*(*) fichnom
[778]26      REAL rlat(ngridmx), rlon(ngridmx)
27      REAL tsol(ngridmx)
28      REAL tsoil(ngridmx,nsoilmx)
29      REAL albe(ngridmx)
[3]30cIM BEG alblw
[778]31      REAL alblw(ngridmx)
[3]32cIM END alblw
[778]33      REAL radsol(ngridmx)
34      REAL sollw(ngridmx)
35      real solsw(ngridmx)
36      real fder(ngridmx)
[3]37      INTEGER length
38      PARAMETER (length=100)
39      REAL tabcntr0(length)
40
41      REAL xmin, xmax
42c
43      INTEGER nid, nvarid
44      INTEGER ierr, i, nsrf, isoil
45      CHARACTER*2 str2
46c
47c Ouvrir le fichier contenant l'etat initial:
48c
49      print*,'fichnom',fichnom
50      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
51      IF (ierr.NE.NF_NOERR) THEN
52        write(6,*)' Pb d''ouverture du fichier '//fichnom
53        write(6,*)' ierr = ', ierr
54        CALL ABORT
55      ENDIF
56c
57c Lecture des parametres de controle:
58c
59      ierr = NF_INQ_VARID (nid, "controle", nvarid)
60      IF (ierr.NE.NF_NOERR) THEN
61         PRINT*, 'phyetat0: Le champ <controle> est absent'
62         CALL abort
63      ENDIF
64#ifdef NC_DOUBLE
65      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tabcntr0)
66#else
67      ierr = NF_GET_VAR_REAL(nid, nvarid, tabcntr0)
68#endif
69      IF (ierr.NE.NF_NOERR) THEN
70         PRINT*, 'phyetat0: Lecture echouee pour <controle>'
71         CALL abort
72      ENDIF
73c
74c
75c Lecture des latitudes (coordonnees):
76c
77      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
78      IF (ierr.NE.NF_NOERR) THEN
79         PRINT*, 'phyetat0: Le champ <latitude> est absent'
80         CALL abort
81      ENDIF
82#ifdef NC_DOUBLE
83      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
84#else
85      ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
86#endif
87      IF (ierr.NE.NF_NOERR) THEN
88         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
89         CALL abort
90      ENDIF
91c
92c Lecture des longitudes (coordonnees):
93c
94      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
95      IF (ierr.NE.NF_NOERR) THEN
96         PRINT*, 'phyetat0: Le champ <longitude> est absent'
97         CALL abort
98      ENDIF
99#ifdef NC_DOUBLE
100      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
101#else
102      ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
103#endif
104      IF (ierr.NE.NF_NOERR) THEN
105         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
106         CALL abort
107      ENDIF
108C
109c Lecture des temperatures du sol:
110c
111      ierr = NF_INQ_VARID (nid, "TS", nvarid)
112      IF (ierr.NE.NF_NOERR) THEN
113         PRINT*, 'phyetat0: Le champ <TS> est absent'
114         PRINT*, "phyetat0: Lecture echouee pour <TS>"
115         CALL abort
116      ELSE
117         PRINT*, 'phyetat0: Le champ <TS> est present'
118#ifdef NC_DOUBLE
[778]119         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol)
[3]120#else
[778]121         ierr = NF_GET_VAR_REAL(nid, nvarid, tsol)
[3]122#endif
123         IF (ierr.NE.NF_NOERR) THEN
124            PRINT*, "phyetat0: Lecture echouee pour <TS>"
125            CALL abort
126         ENDIF
127         xmin = 1.0E+20
128         xmax = -1.0E+20
[778]129         DO i = 1, ngridmx
[3]130            xmin = MIN(tsol(i),xmin)
131            xmax = MAX(tsol(i),xmax)
132         ENDDO
133         PRINT*,'Temperature du sol <TS>', xmin, xmax
134      ENDIF
135c
136c Lecture des temperatures du sol profond:
137c
138      DO isoil=1, nsoilmx
139      IF (isoil.GT.99) THEN
140         PRINT*, "Trop de couches"
141         CALL abort
142      ENDIF
143      WRITE(str2,'(i2.2)') isoil
144      ierr = NF_INQ_VARID (nid, 'Tsoil'//str2, nvarid)
145      IF (ierr.NE.NF_NOERR) THEN
146         PRINT*, "phyetat0: Le champ <Tsoil"//str2//"> est absent"
147         PRINT*, "          Il prend donc la valeur de surface"
[778]148         DO i=1, ngridmx
[3]149             tsoil(i,isoil)=tsol(i)
150         ENDDO
151      ELSE
152#ifdef NC_DOUBLE
153         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil))
154#else
155         ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil))
156#endif
157         IF (ierr.NE.NF_NOERR) THEN
158            PRINT*, "Lecture echouee pour <Tsoil"//str2//">"
159            CALL abort
160         ENDIF
161      ENDIF
162      ENDDO
[778]163
[3]164c
165c Lecture de albedo au sol:
166c
167      ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
168      IF (ierr.NE.NF_NOERR) THEN
169         PRINT*, 'phyetat0: Le champ <ALBE> est absent'
170         PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
171         CALL abort
172      ELSE
173         PRINT*, 'phyetat0: Le champ <ALBE> est present'
174#ifdef NC_DOUBLE
175         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1))
176#else
177         ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1))
178#endif
179         IF (ierr.NE.NF_NOERR) THEN
180            PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
181            CALL abort
182         ENDIF
183         xmin = 1.0E+20
184         xmax = -1.0E+20
[778]185         DO i = 1, ngridmx
[3]186            xmin = MIN(albe(i),xmin)
187            xmax = MAX(albe(i),xmax)
188         ENDDO
189         PRINT*,'Albedo du sol <ALBE>', xmin, xmax
190      ENDIF
191
192c
193c Lecture rayonnement solaire au sol:
194c
195      ierr = NF_INQ_VARID (nid, "solsw", nvarid)
196      IF (ierr.NE.NF_NOERR) THEN
197         PRINT*, 'phyetat0: Le champ <solsw> est absent'
198         PRINT*, 'mis a zero'
199         solsw = 0.
200      ELSE
201#ifdef NC_DOUBLE
202        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
203#else
204        ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
205#endif
206        IF (ierr.NE.NF_NOERR) THEN
207          PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
208          CALL abort
209        ENDIF
210      ENDIF
211      xmin = 1.0E+20
212      xmax = -1.0E+20
[778]213      DO i = 1, ngridmx
[3]214         xmin = MIN(solsw(i),xmin)
215         xmax = MAX(solsw(i),xmax)
216      ENDDO
217      PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
218c
219c Lecture rayonnement IF au sol:
220c
221      ierr = NF_INQ_VARID (nid, "sollw", nvarid)
222      IF (ierr.NE.NF_NOERR) THEN
223         PRINT*, 'phyetat0: Le champ <sollw> est absent'
224         PRINT*, 'mis a zero'
225         sollw = 0.
226      ELSE
227#ifdef NC_DOUBLE
228        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
229#else
230        ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
231#endif
232        IF (ierr.NE.NF_NOERR) THEN
233          PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
234          CALL abort
235        ENDIF
236      ENDIF
237      xmin = 1.0E+20
238      xmax = -1.0E+20
[778]239      DO i = 1, ngridmx
[3]240         xmin = MIN(sollw(i),xmin)
241         xmax = MAX(sollw(i),xmax)
242      ENDDO
243      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
244
245c
246c Lecture derive des flux:
247c
248      ierr = NF_INQ_VARID (nid, "fder", nvarid)
249      IF (ierr.NE.NF_NOERR) THEN
250         PRINT*, 'phyetat0: Le champ <fder> est absent'
251         PRINT*, 'mis a zero'
252         fder = 0.
253      ELSE
254#ifdef NC_DOUBLE
255        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
256#else
257        ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
258#endif
259        IF (ierr.NE.NF_NOERR) THEN
260          PRINT*, 'phyetat0: Lecture echouee pour <fder>'
261          CALL abort
262        ENDIF
263      ENDIF
264      xmin = 1.0E+20
265      xmax = -1.0E+20
[778]266      DO i = 1, ngridmx
[3]267         xmin = MIN(fder(i),xmin)
268         xmax = MAX(fder(i),xmax)
269      ENDDO
270      PRINT*,'Derive des flux fder:', xmin, xmax
271
272c
273c Lecture du rayonnement net au sol:
274c
275      ierr = NF_INQ_VARID (nid, "RADS", nvarid)
276      IF (ierr.NE.NF_NOERR) THEN
277         PRINT*, 'phyetat0: Le champ <RADS> est absent'
278         CALL abort
279      ENDIF
280#ifdef NC_DOUBLE
281      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
282#else
283      ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
284#endif
285      IF (ierr.NE.NF_NOERR) THEN
286         PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
287         CALL abort
288      ENDIF
289      xmin = 1.0E+20
290      xmax = -1.0E+20
[778]291      DO i = 1, ngridmx
[3]292         xmin = MIN(radsol(i),xmin)
293         xmax = MAX(radsol(i),xmax)
294      ENDDO
295      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
296c
297c Fermer le fichier:
298c
299      ierr = NF_CLOSE(nid)
300c
301      RETURN
[778]302      END
Note: See TracBrowser for help on using the repository browser.