/[lmdze]/trunk/Sources/phylmd/phyredem.f
ViewVC logotype

Annotation of /trunk/Sources/phylmd/phyredem.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 20 - (hide annotations)
Wed Oct 15 16:19:57 2008 UTC (15 years, 7 months ago) by guez
Original Path: trunk/libf/phylmd/phyredem.f90
File size: 13676 byte(s) 
Deleted argument "presnivs" of "physiq", "ini_histhf", "ini_histhf3d",
"ini_histday", "ini_histins", "ini_histrac", "phytrac". Access it from
"comvert" instead.

Replaced calls to NetCDF Fortran 77 interface by calls to Fortran 90
interface or to NetCDF95.

Procedure "gr_phy_write_3d" now works with a variable of arbitrary
size in the second dimension.

Annotated use statements with "only" clause.

Replaced calls to NetCDF interface version 2 by calls to Fortran 90
interface in "guide.f90" and "read_reanalyse.f".

In "write_histrac", replaced calls to "gr_fi_ecrit" by calls to
"gr_phy_write_2d" and "gr_phy_write_3d".
1 guez 15 module phyredem_m
2 guez 3
3 guez 15 IMPLICIT NONE
4 guez 3
5 guez 15 contains
6 guez 3
7 guez 15 SUBROUTINE phyredem(fichnom, rlat, rlon, pctsrf, tsol, tsoil, tslab, &
8     seaice, qsurf, qsol, snow, albedo, alblw, evap, rain_fall,&
9     snow_fall, solsw, sollw, fder, radsol, frugs, agesno, zmea,&
10     zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien,&
11     rnebcon, ratqs, clwcon, run_off_lic_0)
12 guez 3
13 guez 15 ! From phylmd/phyredem.F, v 1.3 2005/05/25 13:10:09
14     ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
15     ! Objet: Ecriture de l'etat de démarrage ou redémarrage pour la physique
16 guez 12
17 guez 15 USE indicesol, ONLY : is_lic, is_oce, is_sic, is_ter, nbsrf
18     USE dimphy, ONLY : klev, klon, zmasq
19     USE dimsoil, ONLY : nsoilmx
20     USE temps, ONLY : itau_phy
21 guez 20 USE netcdf95, ONLY : nf95_create, nf95_put_att, nf95_def_dim, &
22     nf95_def_var, nf95_enddef, nf95_redef
23     USE netcdf, ONLY : nf90_clobber, nf90_global, nf90_float, nf90_put_var, &
24     nf90_close
25 guez 12
26 guez 15 CHARACTER(len=*) fichnom
27     REAL, INTENT (IN) :: rlat(klon), rlon(klon)
28     REAL :: tsol(klon, nbsrf)
29     REAL :: tsoil(klon, nsoilmx, nbsrf)
30 guez 12
31 guez 15 REAL :: tslab(klon), seaice(klon) !IM "slab" ocean
32     REAL :: qsurf(klon, nbsrf)
33     REAL :: qsol(klon)
34     REAL :: snow(klon, nbsrf)
35     REAL :: albedo(klon, nbsrf)
36 guez 12
37 guez 15 REAL :: alblw(klon, nbsrf)
38 guez 12
39 guez 15 REAL :: evap(klon, nbsrf)
40     REAL :: rain_fall(klon)
41     REAL :: snow_fall(klon)
42     REAL :: solsw(klon)
43     REAL :: sollw(klon)
44     REAL :: fder(klon)
45     REAL :: radsol(klon)
46     REAL :: frugs(klon, nbsrf)
47     REAL :: agesno(klon, nbsrf)
48     REAL :: zmea(klon)
49     REAL, intent(in):: zstd(klon)
50     REAL, intent(in):: zsig(klon)
51     REAL :: zgam(klon)
52     REAL :: zthe(klon)
53     REAL :: zpic(klon)
54     REAL :: zval(klon)
55     REAL :: pctsrf(klon, nbsrf)
56     REAL :: t_ancien(klon, klev), q_ancien(klon, klev)
57     REAL :: clwcon(klon, klev), rnebcon(klon, klev), ratqs(klon, klev)
58     REAL :: run_off_lic_0(klon)
59 guez 12
60 guez 15 INTEGER :: nid, nvarid, idim2, idim3
61     INTEGER :: ierr
62 guez 12
63 guez 15 INTEGER :: isoil, nsrf
64     CHARACTER (7) :: str7
65     CHARACTER (2) :: str2
66 guez 12
67 guez 15 !------------------------------------------------------------
68 guez 12
69 guez 15 PRINT *, 'Call sequence information: phyredem'
70     CALL nf95_create(fichnom, nf90_clobber, nid)
71 guez 12
72 guez 19 call nf95_put_att(nid, nf90_global, 'title', &
73     'Fichier redémarrage physique')
74 guez 15 call nf95_put_att(nid, nf90_global, "itau_phy", itau_phy)
75 guez 12
76 guez 20 call nf95_def_dim(nid, 'points_physiques', klon, idim2)
77     call nf95_def_dim(nid, 'horizon_vertical', klon*klev, idim3)
78 guez 12
79 guez 20 call nf95_def_var(nid, 'longitude', nf90_float, idim2, nvarid)
80     call nf95_put_att(nid, nvarid, 'title', &
81 guez 15 'Longitudes de la grille physique')
82 guez 20 call nf95_enddef(nid)
83     ierr = nf90_put_var(nid, nvarid, rlon)
84 guez 12
85 guez 20 call nf95_redef(nid)
86     call nf95_def_var(nid, 'latitude', nf90_float, idim2, nvarid)
87     call nf95_put_att(nid, nvarid, 'title', &
88 guez 15 'Latitudes de la grille physique')
89 guez 20 call nf95_enddef(nid)
90     ierr = nf90_put_var(nid, nvarid, rlat)
91 guez 12
92 guez 15 ! PB ajout du masque terre/mer
93 guez 12
94 guez 20 call nf95_redef(nid)
95     call nf95_def_var(nid, 'masque', nf90_float, idim2, nvarid)
96     call nf95_put_att(nid, nvarid, 'title', 'masque terre mer')
97     call nf95_enddef(nid)
98     ierr = nf90_put_var(nid, nvarid, zmasq)
99 guez 15 ! BP ajout des fraction de chaque sous-surface
100 guez 12
101 guez 15 ! 1. fraction de terre
102 guez 12
103 guez 20 call nf95_redef(nid)
104     call nf95_def_var(nid, 'FTER', nf90_float, idim2, nvarid)
105     call nf95_put_att(nid, nvarid, 'title', 'fraction de continent')
106     call nf95_enddef(nid)
107     ierr = nf90_put_var(nid, nvarid, pctsrf(:, is_ter))
108 guez 12
109 guez 15 ! 2. Fraction de glace de terre
110 guez 12
111 guez 20 call nf95_redef(nid)
112     call nf95_def_var(nid, 'FLIC', nf90_float, idim2, nvarid)
113     call nf95_put_att(nid, nvarid, 'title', 'fraction glace de terre')
114     call nf95_enddef(nid)
115     ierr = nf90_put_var(nid, nvarid, pctsrf(:, is_lic))
116 guez 12
117 guez 15 ! 3. fraction ocean
118 guez 12
119 guez 20 call nf95_redef(nid)
120     call nf95_def_var(nid, 'FOCE', nf90_float, idim2, nvarid)
121     call nf95_put_att(nid, nvarid, 'title', 'fraction ocean')
122     call nf95_enddef(nid)
123     ierr = nf90_put_var(nid, nvarid, pctsrf(:, is_oce))
124 guez 12
125 guez 15 ! 4. Fraction glace de mer
126 guez 3
127 guez 20 call nf95_redef(nid)
128     call nf95_def_var(nid, 'FSIC', nf90_float, idim2, nvarid)
129     call nf95_put_att(nid, nvarid, 'title', 'fraction glace mer')
130     call nf95_enddef(nid)
131     ierr = nf90_put_var(nid, nvarid, pctsrf(:, is_sic))
132 guez 12
133    
134    
135 guez 15 DO nsrf = 1, nbsrf
136     IF (nsrf<=99) THEN
137     WRITE (str2, '(i2.2)') nsrf
138 guez 20 call nf95_redef(nid)
139     call nf95_def_var(nid, 'TS'//str2, nf90_float, idim2, nvarid)
140     call nf95_put_att(nid, nvarid, 'title', &
141 guez 15 'Temperature de surface No.'//str2)
142 guez 20 call nf95_enddef(nid)
143 guez 15 ELSE
144     PRINT *, 'Trop de sous-mailles'
145     STOP 1
146     END IF
147 guez 20 ierr = nf90_put_var(nid, nvarid, tsol(:, nsrf))
148 guez 15 END DO
149 guez 12
150 guez 15 DO nsrf = 1, nbsrf
151     DO isoil = 1, nsoilmx
152     IF (isoil<=99 .AND. nsrf<=99) THEN
153     WRITE (str7, '(i2.2, "srf", i2.2)') isoil, nsrf
154 guez 20 call nf95_redef(nid)
155     call nf95_def_var(nid, 'Tsoil'//str7, nf90_float, idim2, nvarid)
156     call nf95_put_att(nid, nvarid, 'title', &
157 guez 15 'Temperature du sol No.'//str7)
158 guez 20 call nf95_enddef(nid)
159 guez 15 ELSE
160     PRINT *, 'Trop de couches'
161     STOP 1
162     END IF
163 guez 20 ierr = nf90_put_var(nid, nvarid, tsoil(:, isoil, nsrf))
164 guez 15 END DO
165     END DO
166 guez 12
167 guez 15 !IM "slab" ocean
168 guez 20 call nf95_redef(nid)
169     call nf95_def_var(nid, 'TSLAB', nf90_float, idim2, nvarid)
170     call nf95_put_att(nid, nvarid, 'title', &
171 guez 15 'Ecart de la SST (pour slab-ocean)')
172 guez 20 call nf95_enddef(nid)
173     ierr = nf90_put_var(nid, nvarid, tslab)
174 guez 12
175 guez 20 call nf95_redef(nid)
176     call nf95_def_var(nid, 'SEAICE', nf90_float, idim2, nvarid)
177     call nf95_put_att(nid, nvarid, 'title', &
178 guez 15 'Glace de mer kg/m2 (pour slab-ocean)')
179 guez 20 call nf95_enddef(nid)
180     ierr = nf90_put_var(nid, nvarid, seaice)
181 guez 12
182 guez 15 DO nsrf = 1, nbsrf
183     IF (nsrf<=99) THEN
184     WRITE (str2, '(i2.2)') nsrf
185 guez 20 call nf95_redef(nid)
186     call nf95_def_var(nid, 'QS'//str2, nf90_float, idim2, nvarid)
187     call nf95_put_att(nid, nvarid, 'title', &
188 guez 15 'Humidite de surface No.'//str2)
189 guez 20 call nf95_enddef(nid)
190 guez 15 ELSE
191     PRINT *, 'Trop de sous-mailles'
192     STOP 1
193     END IF
194 guez 20 ierr = nf90_put_var(nid, nvarid, qsurf(:, nsrf))
195 guez 15 END DO
196 guez 12
197 guez 20 call nf95_redef(nid)
198     call nf95_def_var(nid, 'QSOL', nf90_float, idim2, nvarid)
199     call nf95_put_att(nid, nvarid, 'title', 'Eau dans le sol (mm)')
200     call nf95_enddef(nid)
201     ierr = nf90_put_var(nid, nvarid, qsol)
202 guez 12
203 guez 15 DO nsrf = 1, nbsrf
204     IF (nsrf<=99) THEN
205     WRITE (str2, '(i2.2)') nsrf
206 guez 20 call nf95_redef(nid)
207     call nf95_def_var(nid, 'ALBE'//str2, nf90_float, idim2, nvarid)
208     call nf95_put_att(nid, nvarid, 'title', &
209 guez 15 'albedo de surface No.'//str2)
210 guez 20 call nf95_enddef(nid)
211 guez 15 ELSE
212     PRINT *, 'Trop de sous-mailles'
213     STOP 1
214     END IF
215 guez 20 ierr = nf90_put_var(nid, nvarid, albedo(:, nsrf))
216 guez 15 END DO
217 guez 12
218 guez 15 !IM BEG albedo LW
219     DO nsrf = 1, nbsrf
220     IF (nsrf<=99) THEN
221     WRITE (str2, '(i2.2)') nsrf
222 guez 20 call nf95_redef(nid)
223     call nf95_def_var(nid, 'ALBLW'//str2, nf90_float, idim2, nvarid)
224     call nf95_put_att(nid, nvarid, 'title', &
225 guez 15 'albedo LW de surface No.'//str2)
226 guez 20 call nf95_enddef(nid)
227 guez 15 ELSE
228     PRINT *, 'Trop de sous-mailles'
229     STOP 1
230     END IF
231 guez 20 ierr = nf90_put_var(nid, nvarid, alblw(:, nsrf))
232 guez 15 END DO
233     !IM END albedo LW
234 guez 12
235 guez 15 DO nsrf = 1, nbsrf
236     IF (nsrf<=99) THEN
237     WRITE (str2, '(i2.2)') nsrf
238 guez 20 call nf95_redef(nid)
239     call nf95_def_var(nid, 'EVAP'//str2, nf90_float, idim2, nvarid)
240     call nf95_put_att(nid, nvarid, 'title', &
241 guez 15 'Evaporation de surface No.'//str2)
242 guez 20 call nf95_enddef(nid)
243 guez 15 ELSE
244     PRINT *, 'Trop de sous-mailles'
245     STOP 1
246     END IF
247 guez 20 ierr = nf90_put_var(nid, nvarid, evap(:, nsrf))
248 guez 15 END DO
249 guez 12
250    
251 guez 15 DO nsrf = 1, nbsrf
252     IF (nsrf<=99) THEN
253     WRITE (str2, '(i2.2)') nsrf
254 guez 20 call nf95_redef(nid)
255     call nf95_def_var(nid, 'SNOW'//str2, nf90_float, idim2, nvarid)
256     call nf95_put_att(nid, nvarid, 'title', &
257 guez 15 'Neige de surface No.'//str2)
258 guez 20 call nf95_enddef(nid)
259 guez 15 ELSE
260     PRINT *, 'Trop de sous-mailles'
261     STOP 1
262     END IF
263 guez 20 ierr = nf90_put_var(nid, nvarid, snow(:, nsrf))
264 guez 15 END DO
265 guez 12
266    
267 guez 20 call nf95_redef(nid)
268     call nf95_def_var(nid, 'RADS', nf90_float, idim2, nvarid)
269     call nf95_put_att(nid, nvarid, 'title', &
270 guez 15 'Rayonnement net a la surface')
271 guez 20 call nf95_enddef(nid)
272     ierr = nf90_put_var(nid, nvarid, radsol)
273 guez 12
274 guez 20 call nf95_redef(nid)
275     call nf95_def_var(nid, 'solsw', nf90_float, idim2, nvarid)
276     call nf95_put_att(nid, nvarid, 'title', &
277 guez 15 'Rayonnement solaire a la surface')
278 guez 20 call nf95_enddef(nid)
279     ierr = nf90_put_var(nid, nvarid, solsw)
280 guez 12
281 guez 20 call nf95_redef(nid)
282     call nf95_def_var(nid, 'sollw', nf90_float, idim2, nvarid)
283     call nf95_put_att(nid, nvarid, 'title', &
284 guez 15 'Rayonnement IF a la surface')
285 guez 20 call nf95_enddef(nid)
286     ierr = nf90_put_var(nid, nvarid, sollw)
287 guez 12
288 guez 20 call nf95_redef(nid)
289     call nf95_def_var(nid, 'fder', nf90_float, idim2, nvarid)
290     call nf95_put_att(nid, nvarid, 'title', 'Derive de flux')
291     call nf95_enddef(nid)
292     ierr = nf90_put_var(nid, nvarid, fder)
293 guez 12
294 guez 20 call nf95_redef(nid)
295     call nf95_def_var(nid, 'rain_f', nf90_float, idim2, nvarid)
296     call nf95_put_att(nid, nvarid, 'title', 'precipitation liquide')
297     call nf95_enddef(nid)
298     ierr = nf90_put_var(nid, nvarid, rain_fall)
299 guez 12
300 guez 20 call nf95_redef(nid)
301     call nf95_def_var(nid, 'snow_f', nf90_float, idim2, nvarid)
302     call nf95_put_att(nid, nvarid, 'title', 'precipitation solide')
303     call nf95_enddef(nid)
304     ierr = nf90_put_var(nid, nvarid, snow_fall)
305 guez 12
306 guez 15 DO nsrf = 1, nbsrf
307     IF (nsrf<=99) THEN
308     WRITE (str2, '(i2.2)') nsrf
309 guez 20 call nf95_redef(nid)
310     call nf95_def_var(nid, 'RUG'//str2, nf90_float, idim2, nvarid)
311     call nf95_put_att(nid, nvarid, 'title', &
312 guez 15 'rugosite de surface No.'//str2)
313 guez 20 call nf95_enddef(nid)
314 guez 15 ELSE
315     PRINT *, 'Trop de sous-mailles'
316     STOP 1
317     END IF
318 guez 20 ierr = nf90_put_var(nid, nvarid, frugs(:, nsrf))
319 guez 15 END DO
320 guez 12
321 guez 15 DO nsrf = 1, nbsrf
322     IF (nsrf<=99) THEN
323     WRITE (str2, '(i2.2)') nsrf
324 guez 20 call nf95_redef(nid)
325     call nf95_def_var(nid, 'AGESNO'//str2, nf90_float, idim2, nvarid)
326     call nf95_put_att(nid, nvarid, 'title', &
327 guez 15 'Age de la neige surface No.'//str2)
328 guez 20 call nf95_enddef(nid)
329 guez 15 ELSE
330     PRINT *, 'Trop de sous-mailles'
331     STOP 1
332     END IF
333 guez 20 ierr = nf90_put_var(nid, nvarid, agesno(:, nsrf))
334 guez 15 END DO
335 guez 12
336 guez 20 call nf95_redef(nid)
337     call nf95_def_var(nid, 'ZMEA', nf90_float, idim2, nvarid)
338     call nf95_enddef(nid)
339     ierr = nf90_put_var(nid, nvarid, zmea)
340 guez 12
341 guez 20 call nf95_redef(nid)
342     call nf95_def_var(nid, 'ZSTD', nf90_float, idim2, nvarid)
343     call nf95_enddef(nid)
344     ierr = nf90_put_var(nid, nvarid, zstd)
345     call nf95_redef(nid)
346     call nf95_def_var(nid, 'ZSIG', nf90_float, idim2, nvarid)
347     call nf95_enddef(nid)
348     ierr = nf90_put_var(nid, nvarid, zsig)
349     call nf95_redef(nid)
350     call nf95_def_var(nid, 'ZGAM', nf90_float, idim2, nvarid)
351     call nf95_enddef(nid)
352     ierr = nf90_put_var(nid, nvarid, zgam)
353     call nf95_redef(nid)
354     call nf95_def_var(nid, 'ZTHE', nf90_float, idim2, nvarid)
355     call nf95_enddef(nid)
356     ierr = nf90_put_var(nid, nvarid, zthe)
357     call nf95_redef(nid)
358     call nf95_def_var(nid, 'ZPIC', nf90_float, idim2, nvarid)
359     call nf95_enddef(nid)
360     ierr = nf90_put_var(nid, nvarid, zpic)
361     call nf95_redef(nid)
362     call nf95_def_var(nid, 'ZVAL', nf90_float, idim2, nvarid)
363     call nf95_enddef(nid)
364     ierr = nf90_put_var(nid, nvarid, zval)
365 guez 12
366 guez 20 call nf95_redef(nid)
367     call nf95_def_var(nid, 'TANCIEN', nf90_float, idim3, nvarid)
368     call nf95_enddef(nid)
369     ierr = nf90_put_var(nid, nvarid, t_ancien)
370 guez 12
371 guez 20 call nf95_redef(nid)
372     call nf95_def_var(nid, 'QANCIEN', nf90_float, idim3, nvarid)
373     call nf95_enddef(nid)
374     ierr = nf90_put_var(nid, nvarid, q_ancien)
375 guez 12
376 guez 20 call nf95_redef(nid)
377     call nf95_def_var(nid, 'RUGMER', nf90_float, idim2, nvarid)
378     call nf95_put_att(nid, nvarid, 'title', &
379 guez 15 'Longueur de rugosite sur mer')
380 guez 20 call nf95_enddef(nid)
381     ierr = nf90_put_var(nid, nvarid, frugs(:, is_oce))
382 guez 12
383 guez 20 call nf95_redef(nid)
384     call nf95_def_var(nid, 'CLWCON', nf90_float, idim2, nvarid)
385     call nf95_put_att(nid, nvarid, 'title', 'Eau liquide convective')
386     call nf95_enddef(nid)
387     ierr = nf90_put_var(nid, nvarid, clwcon)
388 guez 12
389 guez 20 call nf95_redef(nid)
390     call nf95_def_var(nid, 'RNEBCON', nf90_float, idim2, nvarid)
391     call nf95_put_att(nid, nvarid, 'title', 'Nebulosite convective')
392     call nf95_enddef(nid)
393     ierr = nf90_put_var(nid, nvarid, rnebcon)
394 guez 12
395 guez 20 call nf95_redef(nid)
396     call nf95_def_var(nid, 'RATQS', nf90_float, idim2, nvarid)
397     call nf95_put_att(nid, nvarid, 'title', 'Ratqs')
398     call nf95_enddef(nid)
399     ierr = nf90_put_var(nid, nvarid, ratqs)
400 guez 15
401     ! run_off_lic_0
402    
403 guez 20 call nf95_redef(nid)
404     call nf95_def_var(nid, 'RUNOFFLIC0', nf90_float, idim2, nvarid)
405     call nf95_put_att(nid, nvarid, 'title', 'Runofflic0')
406     call nf95_enddef(nid)
407     ierr = nf90_put_var(nid, nvarid, run_off_lic_0)
408 guez 15
409    
410 guez 20 ierr = nf90_close(nid)
411 guez 15
412     END SUBROUTINE phyredem
413    
414     end module phyredem_m
  ViewVC Help
Powered by ViewVC 1.1.21