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

Last change on this file since 3816 was 3816, checked in by millour, 10 years ago

Further cleanup and adaptations:

  • setup iniphusiq to pass on information from dyn to phys.
  • infis (now module inifi_mod) transfers the information and for now also storesthe information. Thus modules control_mod_phys, comconst_phy_mod, comgeom2_phy_mod and temps_phy_mod are now useless.
  • removed q_sat_phy, and put q_sat in misc, since it is quite general.
  • moved information on horizontal and vertical grid to module comgeomphy.F90

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