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

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

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