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

Last change on this file since 2225 was 2209, checked in by Ehouarn Millour, 10 years ago

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