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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 62 - (hide annotations)
Thu Jul 26 14:37:37 2012 UTC (11 years, 9 months ago) by guez
Original Path: trunk/libf/phylmd/phyredem.f90
File size: 13611 byte(s) 
Changed handling of compiler in compilation system.

Removed the prefix letters "y", "p", "t" or "z" in some names of variables.

Replaced calls to NetCDF by calls to NetCDF95.

Extracted "ioget_calendar" procedures from "calendar.f90" into a
separate file.

Extracted to a separate file, "mathop2.f90", procedures that were not
part of the generic interface "mathop" in "mathop.f90".

Removed computation of "dq" in "bilan_dyn", which was not used.

In "iniadvtrac", removed schemes 20 Slopes and 30 Prather. Was not
compatible with declarations of array sizes.

In "clcdrag", "ustarhb", "vdif_kcay", "yamada4" and "coefkz", changed
the size of some arrays from "klon" to "knon".

Removed possible call to "conema3" in "physiq".

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