source: LMDZ5/trunk/libf/phylmd/phyredem.F90 @ 1838

Last change on this file since 1838 was 1827, checked in by lguez, 11 years ago

Changed names of variables ema_work1 and ema_work2 to more meaningful
sig1 and w01. Same change in (re)startphy.nc. phyetat0 tries to find
old names ema_work1 and ema_work2 if new names sig1 and w01 are not
found, so the program can run with an old restartphy.nc. restartphy.nc
is modified compared to the previous SVN revision because of the change of
names but the data content is not modified (this can be checked with
max_diff_nc.sh -i).
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.7 KB
RevLine 
[1403]1! $Id: phyredem.F90 1827 2013-08-06 13:33:18Z fairhead $
[782]2
[1827]3SUBROUTINE phyredem (fichnom)
[782]4
[1827]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
[967]17
[1827]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
[967]31
[1827]32  ! les variables globales ecrites dans le fichier restart
[782]33
[1827]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)
[782]45
[1827]46  INTEGER nid, nvarid, idim1, idim2, idim3
47  INTEGER ierr
48  INTEGER length
49  PARAMETER (length=100)
50  REAL tab_cntrl(length)
[782]51
[1827]52  INTEGER isoil, nsrf
53  CHARACTER (len=7) :: str7
54  CHARACTER (len=2) :: str2
55  INTEGER           :: it, iiq
[524]56
[1827]57  !======================================================================
[524]58
[1827]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)
[1279]63
[1827]64  ! Get a variable calculated in module fonte_neige_mod
65  CALL fonte_neige_final(run_off_lic_0)
[1001]66
[1827]67  !======================================================================
[1001]68
[1827]69  CALL open_restartphy(fichnom)
[1001]70
[1827]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
[524]81
[1827]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.
[524]87
[1827]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))
[524]141        ELSE
[1827]142           PRINT*, "Trop de couches"
143           CALL abort
[524]144        ENDIF
[1827]145     ENDDO
146  ENDDO
[524]147
[1827]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
[524]281        IF (nsrf.LE.99) THEN
[1827]282           WRITE(str2, '(i2.2)') nsrf
283           CALL put_field("TKE"//str2, "Energ. Cineti. Turb."//str2, &
284                pbl_tke(:, 1:klev+1, nsrf))
[524]285        ELSE
[1827]286           PRINT*, "Trop de sous-mailles"
287           CALL abort
[524]288        ENDIF
[1827]289     ENDDO
290  ENDIF
[1619]291
[1827]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
[1619]295
[1827]296  CALL put_field("ZMAX0", "ZMAX0", zmax0)
[1619]297
[1827]298  CALL put_field("F0", "F0", f0)
[878]299
[1827]300  CALL put_field("sig1", "sig1 Emanuel", sig1)
[1001]301
[1827]302  CALL put_field("w01", "w01 Emanuel", w01)
[1001]303
[1827]304  ! wake_deltat
305  CALL put_field("WAKE_DELTAT", "WAKE_DELTAT", wake_deltat)
[1279]306
[1827]307  CALL put_field("WAKE_DELTAQ", "WAKE_DELTAQ", wake_deltaq)
[1403]308
[1827]309  CALL put_field("WAKE_S", "WAKE_S", wake_s)
[1403]310
[1827]311  CALL put_field("WAKE_CSTAR", "WAKE_CSTAR", wake_cstar)
[1403]312
[1827]313  CALL put_field("WAKE_PE", "WAKE_PE", wake_pe)
[1403]314
[1827]315  CALL put_field("WAKE_FIP", "WAKE_FIP", wake_fip)
[1279]316
[1827]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.