source: dynamico_lmdz/aquaplanet/LMDZ5/libf/phylmd/phyredem.F90 @ 3825

Last change on this file since 3825 was 3825, checked in by ymipsl, 10 years ago

Reorganize geometry and grid modules. Prepare physics for unstructutured grid support. Simplify initialization of physics from dynamic.
Compiled only with dynd3dmem, but not tested for moment.

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