source: LMDZ5/branches/testing/libf/phylmd/phyredem.F90 @ 1864

Last change on this file since 1864 was 1864, checked in by Laurent Fairhead, 11 years ago

Création d'une nouvelle testing:

merge des modifications du trunk entre r1796 et r1860

New testing version

merged modifications between r1796 and r1860 from the trunk

i.e.
svn merge -r1796:1860 ​http://svn.lmd.jussieu.fr/LMDZ/LMDZ5/trunk
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.7 KB
Line 
1! $Id: phyredem.F90 1864 2013-09-11 09:45:01Z fairhead $
2
3SUBROUTINE 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
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
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
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
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
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
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
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
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
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
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  CALL close_restartphy
343  !$OMP BARRIER
344
345END SUBROUTINE phyredem
Note: See TracBrowser for help on using the repository browser.