1 | ! $Id: phyredem.F90 1938 2014-01-20 16:20:05Z abarral $ |
---|
2 | |
---|
3 | SUBROUTINE phyredem (fichnom) |
---|
4 | |
---|
5 | USE dimphy |
---|
6 | USE mod_grid_phy_lmdz |
---|
7 | USE mod_phys_lmdz_para |
---|
8 | USE fonte_neige_mod, ONLY : fonte_neige_final |
---|
9 | USE pbl_surface_mod, ONLY : pbl_surface_final |
---|
10 | USE phys_state_var_mod |
---|
11 | USE iostart |
---|
12 | USE traclmdz_mod, ONLY : traclmdz_to_restart |
---|
13 | USE infotrac |
---|
14 | USE control_mod |
---|
15 | USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send |
---|
16 | USE indice_sol_mod |
---|
17 | |
---|
18 | IMPLICIT none |
---|
19 | !====================================================================== |
---|
20 | ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818 |
---|
21 | ! Objet: Ecriture de l'etat de redemarrage pour la physique |
---|
22 | !====================================================================== |
---|
23 | include "netcdf.inc" |
---|
24 | include "dimsoil.h" |
---|
25 | include "clesphys.h" |
---|
26 | include "temps.h" |
---|
27 | include "thermcell.h" |
---|
28 | include "compbl.h" |
---|
29 | !====================================================================== |
---|
30 | CHARACTER*(*) fichnom |
---|
31 | |
---|
32 | ! les variables globales ecrites dans le fichier restart |
---|
33 | |
---|
34 | REAL tsoil(klon, nsoilmx, nbsrf) |
---|
35 | REAL tslab(klon), seaice(klon) |
---|
36 | REAL qsurf(klon, nbsrf) |
---|
37 | REAL qsol(klon) |
---|
38 | REAL snow(klon, nbsrf) |
---|
39 | REAL evap(klon, nbsrf) |
---|
40 | real fder(klon) |
---|
41 | REAL frugs(klon, nbsrf) |
---|
42 | REAL agesno(klon, nbsrf) |
---|
43 | REAL run_off_lic_0(klon) |
---|
44 | REAL trs(klon, nbtr) |
---|
45 | |
---|
46 | INTEGER nid, nvarid, idim1, idim2, idim3 |
---|
47 | INTEGER ierr |
---|
48 | INTEGER length |
---|
49 | PARAMETER (length=100) |
---|
50 | REAL tab_cntrl(length) |
---|
51 | |
---|
52 | INTEGER isoil, nsrf |
---|
53 | CHARACTER (len=7) :: str7 |
---|
54 | CHARACTER (len=2) :: str2 |
---|
55 | INTEGER :: it, iiq |
---|
56 | |
---|
57 | !====================================================================== |
---|
58 | |
---|
59 | ! Get variables which will be written to restart file from module |
---|
60 | ! pbl_surface_mod |
---|
61 | CALL pbl_surface_final(qsol, fder, snow, qsurf, & |
---|
62 | evap, frugs, agesno, tsoil) |
---|
63 | |
---|
64 | ! Get a variable calculated in module fonte_neige_mod |
---|
65 | CALL fonte_neige_final(run_off_lic_0) |
---|
66 | |
---|
67 | !====================================================================== |
---|
68 | |
---|
69 | CALL open_restartphy(fichnom) |
---|
70 | |
---|
71 | DO ierr = 1, length |
---|
72 | tab_cntrl(ierr) = 0.0 |
---|
73 | ENDDO |
---|
74 | tab_cntrl(1) = dtime |
---|
75 | tab_cntrl(2) = radpas |
---|
76 | ! co2_ppm : current value of atmospheric CO2 |
---|
77 | tab_cntrl(3) = co2_ppm |
---|
78 | tab_cntrl(4) = solaire |
---|
79 | tab_cntrl(5) = iflag_con |
---|
80 | tab_cntrl(6) = nbapp_rad |
---|
81 | |
---|
82 | IF( cycle_diurne ) tab_cntrl( 7 ) = 1. |
---|
83 | IF( soil_model ) tab_cntrl( 8 ) = 1. |
---|
84 | IF( new_oliq ) tab_cntrl( 9 ) = 1. |
---|
85 | IF( ok_orodr ) tab_cntrl(10 ) = 1. |
---|
86 | IF( ok_orolf ) tab_cntrl(11 ) = 1. |
---|
87 | |
---|
88 | tab_cntrl(13) = day_end |
---|
89 | tab_cntrl(14) = annee_ref |
---|
90 | tab_cntrl(15) = itau_phy |
---|
91 | |
---|
92 | ! co2_ppm0 : initial value of atmospheric CO2 |
---|
93 | tab_cntrl(16) = co2_ppm0 |
---|
94 | |
---|
95 | CALL put_var("controle", "Parametres de controle", tab_cntrl) |
---|
96 | |
---|
97 | CALL put_field("longitude", & |
---|
98 | "Longitudes de la grille physique", rlon) |
---|
99 | |
---|
100 | CALL put_field("latitude", "Latitudes de la grille physique", rlat) |
---|
101 | |
---|
102 | ! PB ajout du masque terre/mer |
---|
103 | |
---|
104 | CALL put_field("masque", "masque terre mer", zmasq) |
---|
105 | |
---|
106 | ! BP ajout des fraction de chaque sous-surface |
---|
107 | |
---|
108 | ! 1. fraction de terre |
---|
109 | |
---|
110 | CALL put_field("FTER", "fraction de continent", pctsrf(:, is_ter)) |
---|
111 | |
---|
112 | ! 2. Fraction de glace de terre |
---|
113 | |
---|
114 | CALL put_field("FLIC", "fraction glace de terre", pctsrf(:, is_lic)) |
---|
115 | |
---|
116 | ! 3. fraction ocean |
---|
117 | |
---|
118 | CALL put_field("FOCE", "fraction ocean", pctsrf(:, is_oce)) |
---|
119 | |
---|
120 | ! 4. Fraction glace de mer |
---|
121 | |
---|
122 | CALL put_field("FSIC", "fraction glace mer", pctsrf(:, is_sic)) |
---|
123 | |
---|
124 | DO nsrf = 1, nbsrf |
---|
125 | IF (nsrf.LE.99) THEN |
---|
126 | WRITE(str2, '(i2.2)') nsrf |
---|
127 | CALL put_field("TS"//str2, "Temperature de surface No."//str2, & |
---|
128 | ftsol(:, nsrf)) |
---|
129 | ELSE |
---|
130 | PRINT*, "Trop de sous-mailles" |
---|
131 | call abort_gcm("phyredem", "", 1) |
---|
132 | ENDIF |
---|
133 | ENDDO |
---|
134 | |
---|
135 | DO nsrf = 1, nbsrf |
---|
136 | DO isoil=1, nsoilmx |
---|
137 | IF (isoil.LE.99 .AND. nsrf.LE.99) THEN |
---|
138 | WRITE(str7, '(i2.2, "srf", i2.2)') isoil, nsrf |
---|
139 | CALL put_field("Tsoil"//str7, "Temperature du sol No."//str7, & |
---|
140 | tsoil(:, isoil, nsrf)) |
---|
141 | ELSE |
---|
142 | PRINT*, "Trop de couches" |
---|
143 | call abort_gcm("phyredem", "", 1) |
---|
144 | ENDIF |
---|
145 | ENDDO |
---|
146 | ENDDO |
---|
147 | |
---|
148 | DO nsrf = 1, nbsrf |
---|
149 | IF (nsrf.LE.99) THEN |
---|
150 | WRITE(str2, '(i2.2)') nsrf |
---|
151 | CALL put_field("QS"//str2, "Humidite de surface No."//str2, & |
---|
152 | qsurf(:, nsrf)) |
---|
153 | ELSE |
---|
154 | PRINT*, "Trop de sous-mailles" |
---|
155 | call abort_gcm("phyredem", "", 1) |
---|
156 | ENDIF |
---|
157 | END DO |
---|
158 | |
---|
159 | CALL put_field("QSOL", "Eau dans le sol (mm)", qsol) |
---|
160 | |
---|
161 | DO nsrf = 1, nbsrf |
---|
162 | IF (nsrf.LE.99) THEN |
---|
163 | WRITE(str2, '(i2.2)') nsrf |
---|
164 | CALL put_field("ALBE"//str2, "albedo de surface No."//str2, & |
---|
165 | falb1(:, nsrf)) |
---|
166 | ELSE |
---|
167 | PRINT*, "Trop de sous-mailles" |
---|
168 | call abort_gcm("phyredem", "", 1) |
---|
169 | ENDIF |
---|
170 | ENDDO |
---|
171 | |
---|
172 | DO nsrf = 1, nbsrf |
---|
173 | IF (nsrf.LE.99) THEN |
---|
174 | WRITE(str2, '(i2.2)') nsrf |
---|
175 | CALL put_field("ALBLW"//str2, "albedo LW de surface No."//str2, & |
---|
176 | falb2(:, nsrf)) |
---|
177 | ELSE |
---|
178 | PRINT*, "Trop de sous-mailles" |
---|
179 | call abort_gcm("phyredem", "", 1) |
---|
180 | ENDIF |
---|
181 | ENDDO |
---|
182 | |
---|
183 | DO nsrf = 1, nbsrf |
---|
184 | IF (nsrf.LE.99) THEN |
---|
185 | WRITE(str2, '(i2.2)') nsrf |
---|
186 | CALL put_field("EVAP"//str2, "Evaporation de surface No."//str2 & |
---|
187 | , evap(:, nsrf)) |
---|
188 | ELSE |
---|
189 | PRINT*, "Trop de sous-mailles" |
---|
190 | call abort_gcm("phyredem", "", 1) |
---|
191 | ENDIF |
---|
192 | ENDDO |
---|
193 | |
---|
194 | DO nsrf = 1, nbsrf |
---|
195 | IF (nsrf.LE.99) THEN |
---|
196 | WRITE(str2, '(i2.2)') nsrf |
---|
197 | CALL put_field("SNOW"//str2, "Neige de surface No."//str2, & |
---|
198 | snow(:, nsrf)) |
---|
199 | ELSE |
---|
200 | PRINT*, "Trop de sous-mailles" |
---|
201 | call abort_gcm("phyredem", "", 1) |
---|
202 | ENDIF |
---|
203 | ENDDO |
---|
204 | |
---|
205 | CALL put_field("RADS", "Rayonnement net a la surface", radsol) |
---|
206 | |
---|
207 | CALL put_field("solsw", "Rayonnement solaire a la surface", solsw) |
---|
208 | |
---|
209 | CALL put_field("sollw", "Rayonnement IF a la surface", sollw) |
---|
210 | |
---|
211 | CALL put_field("fder", "Derive de flux", fder) |
---|
212 | |
---|
213 | CALL put_field("rain_f", "precipitation liquide", rain_fall) |
---|
214 | |
---|
215 | CALL put_field("snow_f", "precipitation solide", snow_fall) |
---|
216 | |
---|
217 | DO nsrf = 1, nbsrf |
---|
218 | IF (nsrf.LE.99) THEN |
---|
219 | WRITE(str2, '(i2.2)') nsrf |
---|
220 | CALL put_field("RUG"//str2, "rugosite de surface No."//str2, & |
---|
221 | frugs(:, nsrf)) |
---|
222 | ELSE |
---|
223 | PRINT*, "Trop de sous-mailles" |
---|
224 | call abort_gcm("phyredem", "", 1) |
---|
225 | ENDIF |
---|
226 | ENDDO |
---|
227 | |
---|
228 | DO nsrf = 1, nbsrf |
---|
229 | IF (nsrf.LE.99) THEN |
---|
230 | WRITE(str2, '(i2.2)') nsrf |
---|
231 | CALL put_field("AGESNO"//str2, & |
---|
232 | "Age de la neige surface No."//str2, & |
---|
233 | agesno(:, nsrf)) |
---|
234 | ELSE |
---|
235 | PRINT*, "Trop de sous-mailles" |
---|
236 | call abort_gcm("phyredem", "", 1) |
---|
237 | ENDIF |
---|
238 | ENDDO |
---|
239 | |
---|
240 | CALL put_field("ZMEA", "ZMEA", zmea) |
---|
241 | |
---|
242 | CALL put_field("ZSTD", "ZSTD", zstd) |
---|
243 | |
---|
244 | CALL put_field("ZSIG", "ZSIG", zsig) |
---|
245 | |
---|
246 | CALL put_field("ZGAM", "ZGAM", zgam) |
---|
247 | |
---|
248 | CALL put_field("ZTHE", "ZTHE", zthe) |
---|
249 | |
---|
250 | CALL put_field("ZPIC", "ZPIC", zpic) |
---|
251 | |
---|
252 | CALL put_field("ZVAL", "ZVAL", zval) |
---|
253 | |
---|
254 | CALL put_field("RUGSREL", "RUGSREL", rugoro) |
---|
255 | |
---|
256 | CALL put_field("TANCIEN", "TANCIEN", t_ancien) |
---|
257 | |
---|
258 | CALL put_field("QANCIEN", "QANCIEN", q_ancien) |
---|
259 | |
---|
260 | CALL put_field("UANCIEN", "", u_ancien) |
---|
261 | |
---|
262 | CALL put_field("VANCIEN", "", v_ancien) |
---|
263 | |
---|
264 | CALL put_field("RUGMER", "Longueur de rugosite sur mer", & |
---|
265 | frugs(:, is_oce)) |
---|
266 | |
---|
267 | CALL put_field("CLWCON", "Eau liquide convective", clwcon) |
---|
268 | |
---|
269 | CALL put_field("RNEBCON", "Nebulosite convective", rnebcon) |
---|
270 | |
---|
271 | CALL put_field("RATQS", "Ratqs", ratqs) |
---|
272 | |
---|
273 | ! run_off_lic_0 |
---|
274 | |
---|
275 | CALL put_field("RUNOFFLIC0", "Runofflic0", run_off_lic_0) |
---|
276 | |
---|
277 | ! DEB TKE PBL ! |
---|
278 | |
---|
279 | IF (iflag_pbl>1) then |
---|
280 | DO nsrf = 1, nbsrf |
---|
281 | IF (nsrf.LE.99) THEN |
---|
282 | WRITE(str2, '(i2.2)') nsrf |
---|
283 | CALL put_field("TKE"//str2, "Energ. Cineti. Turb."//str2, & |
---|
284 | pbl_tke(:, 1:klev+1, nsrf)) |
---|
285 | ELSE |
---|
286 | PRINT*, "Trop de sous-mailles" |
---|
287 | call abort_gcm("phyredem", "", 1) |
---|
288 | ENDIF |
---|
289 | ENDDO |
---|
290 | ENDIF |
---|
291 | |
---|
292 | ! FIN TKE PBL ! |
---|
293 | !IM ajout zmax0, f0, sig1, w01 |
---|
294 | !IM wake_deltat, wake_deltaq, wake_s, wake_cstar, wake_pe, wake_fip |
---|
295 | |
---|
296 | CALL put_field("ZMAX0", "ZMAX0", zmax0) |
---|
297 | |
---|
298 | CALL put_field("F0", "F0", f0) |
---|
299 | |
---|
300 | CALL put_field("sig1", "sig1 Emanuel", sig1) |
---|
301 | |
---|
302 | CALL put_field("w01", "w01 Emanuel", w01) |
---|
303 | |
---|
304 | ! wake_deltat |
---|
305 | CALL put_field("WAKE_DELTAT", "WAKE_DELTAT", wake_deltat) |
---|
306 | |
---|
307 | CALL put_field("WAKE_DELTAQ", "WAKE_DELTAQ", wake_deltaq) |
---|
308 | |
---|
309 | CALL put_field("WAKE_S", "WAKE_S", wake_s) |
---|
310 | |
---|
311 | CALL put_field("WAKE_CSTAR", "WAKE_CSTAR", wake_cstar) |
---|
312 | |
---|
313 | CALL put_field("WAKE_PE", "WAKE_PE", wake_pe) |
---|
314 | |
---|
315 | CALL put_field("WAKE_FIP", "WAKE_FIP", wake_fip) |
---|
316 | |
---|
317 | ! thermiques |
---|
318 | |
---|
319 | CALL put_field("FM_THERM", "FM_THERM", fm_therm) |
---|
320 | |
---|
321 | CALL put_field("ENTR_THERM", "ENTR_THERM", entr_therm) |
---|
322 | |
---|
323 | CALL put_field("DETR_THERM", "DETR_THERM", detr_therm) |
---|
324 | |
---|
325 | ! trs from traclmdz_mod |
---|
326 | IF (type_trac == 'lmdz') THEN |
---|
327 | CALL traclmdz_to_restart(trs) |
---|
328 | DO it=1, nbtr |
---|
329 | iiq=niadv(it+2) |
---|
330 | CALL put_field("trs_"//tname(iiq), "", trs(:, it)) |
---|
331 | END DO |
---|
332 | IF (carbon_cycle_cpl) THEN |
---|
333 | IF (.NOT. ALLOCATED(co2_send)) THEN |
---|
334 | ! This is the case of create_etat0_limit, ce0l |
---|
335 | ALLOCATE(co2_send(klon)) |
---|
336 | co2_send(:) = co2_ppm0 |
---|
337 | END IF |
---|
338 | CALL put_field("co2_send", "co2_ppm for coupling", co2_send) |
---|
339 | END IF |
---|
340 | END IF |
---|
341 | |
---|
342 | if (ok_gwd_rando) then |
---|
343 | call put_field("du_gwd_rando", & |
---|
344 | "tendency on zonal wind due to gravity waves", & |
---|
345 | du_gwd_rando) |
---|
346 | call put_field("dv_gwd_rando", & |
---|
347 | "tendency on meriodional wind due to gravity waves", & |
---|
348 | dv_gwd_rando) |
---|
349 | end if |
---|
350 | |
---|
351 | CALL close_restartphy |
---|
352 | !$OMP BARRIER |
---|
353 | |
---|
354 | END SUBROUTINE phyredem |
---|