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

Last change on this file since 2237 was 2237, checked in by fhourdin, 10 years ago

Prise en compte des nouveaux alebedo dans les fichiers de redémarrage.
Retour à 1+1=2

Taking into account new albedos in restart files. 1+1=2
  • 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.8 KB
Line 
1! $Id: phyredem.F90 2237 2015-03-20 06:53:17Z 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 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,isw
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! ================== Albedo =======================================
145  print*,'PHYREDEM NOUVEAU'
146  DO nsrf = 1, nbsrf
147     DO isw=1, nsw
148        IF (isw.LE.99 .AND. nsrf.LE.99) THEN
149           WRITE(str7, '(i2.2, "srf", i2.2)') isw, nsrf
150  print*,'PHYREDEM ',"A_dir_SW"//str7
151           CALL put_field("A_dir_SW"//str7, "Albedo direct du sol bande "//str7, &
152                falb_dir(:, isw, nsrf))
153           CALL put_field("A_dif_SW"//str7, "Albedo difus du sol bande "//str7, &
154                falb_dif(:, isw, nsrf))
155        ELSE
156           PRINT*, "Trop de couches"
157           call abort_gcm("phyredem", "", 1)
158        ENDIF
159     ENDDO
160  ENDDO
161
162! ================== Tsoil =======================================
163  DO nsrf = 1, nbsrf
164     DO isoil=1, nsoilmx
165        IF (isoil.LE.99 .AND. nsrf.LE.99) THEN
166           WRITE(str7, '(i2.2, "srf", i2.2)') isoil, nsrf
167           CALL put_field("Tsoil"//str7, "Temperature du sol No."//str7, &
168                tsoil(:, isoil, nsrf))
169        ELSE
170           PRINT*, "Trop de couches"
171           call abort_gcm("phyredem", "", 1)
172        ENDIF
173     ENDDO
174  ENDDO
175
176  DO nsrf = 1, nbsrf
177     IF (nsrf.LE.99) THEN
178        WRITE(str2, '(i2.2)') nsrf
179        CALL put_field("QS"//str2, "Humidite de surface No."//str2, &
180             qsurf(:, nsrf))
181     ELSE
182        PRINT*, "Trop de sous-mailles"
183        call abort_gcm("phyredem", "", 1)
184     ENDIF
185  END DO
186
187  CALL put_field("QSOL", "Eau dans le sol (mm)", qsol)
188
189  DO nsrf = 1, nbsrf
190     IF (nsrf.LE.99) THEN
191        WRITE(str2, '(i2.2)') nsrf
192        CALL put_field("ALBE"//str2, "albedo de surface No."//str2, &
193             falb1(:, nsrf))
194     ELSE
195        PRINT*, "Trop de sous-mailles"
196        call abort_gcm("phyredem", "", 1)
197     ENDIF
198  ENDDO
199
200  DO nsrf = 1, nbsrf
201     IF (nsrf.LE.99) THEN
202        WRITE(str2, '(i2.2)') nsrf
203        CALL put_field("ALBLW"//str2, "albedo LW de surface No."//str2, &
204             falb2(:, nsrf))
205     ELSE
206        PRINT*, "Trop de sous-mailles"
207        call abort_gcm("phyredem", "", 1)
208     ENDIF
209  ENDDO
210
211  DO nsrf = 1, nbsrf
212     IF (nsrf.LE.99) THEN
213        WRITE(str2, '(i2.2)') nsrf
214        CALL put_field("EVAP"//str2, "Evaporation de surface No."//str2 &
215             , evap(:, nsrf))
216     ELSE
217        PRINT*, "Trop de sous-mailles"
218        call abort_gcm("phyredem", "", 1)
219     ENDIF
220  ENDDO
221
222  DO nsrf = 1, nbsrf
223     IF (nsrf.LE.99) THEN
224        WRITE(str2, '(i2.2)') nsrf
225        CALL put_field("SNOW"//str2, "Neige de surface No."//str2, &
226             snow(:, nsrf))
227     ELSE
228        PRINT*, "Trop de sous-mailles"
229        call abort_gcm("phyredem", "", 1)
230     ENDIF
231  ENDDO
232
233  CALL put_field("RADS", "Rayonnement net a la surface", radsol)
234
235  CALL put_field("solsw", "Rayonnement solaire a la surface", solsw)
236
237  CALL put_field("sollw", "Rayonnement IF a la surface", sollw)
238
239  CALL put_field("sollwdown", "Rayonnement down IF a la surface", sollw)
240
241  CALL put_field("fder", "Derive de flux", fder)
242
243  CALL put_field("rain_f", "precipitation liquide", rain_fall)
244
245  CALL put_field("snow_f", "precipitation solide", snow_fall)
246
247  DO nsrf = 1, nbsrf
248     IF (nsrf.LE.99) THEN
249        WRITE(str2, '(i2.2)') nsrf
250        CALL put_field("RUG"//str2, "rugosite de surface No."//str2, &
251             frugs(:, nsrf))
252     ELSE
253        PRINT*, "Trop de sous-mailles"
254        call abort_gcm("phyredem", "", 1)
255     ENDIF
256  ENDDO
257
258  DO nsrf = 1, nbsrf
259     IF (nsrf.LE.99) THEN
260        WRITE(str2, '(i2.2)') nsrf
261        CALL put_field("AGESNO"//str2, &
262             "Age de la neige surface No."//str2, &
263             agesno(:, nsrf))
264     ELSE
265        PRINT*, "Trop de sous-mailles"
266        call abort_gcm("phyredem", "", 1)
267     ENDIF
268  ENDDO
269
270  CALL put_field("ZMEA", "ZMEA", zmea)
271
272  CALL put_field("ZSTD", "ZSTD", zstd)
273
274  CALL put_field("ZSIG", "ZSIG", zsig)
275
276  CALL put_field("ZGAM", "ZGAM", zgam)
277
278  CALL put_field("ZTHE", "ZTHE", zthe)
279
280  CALL put_field("ZPIC", "ZPIC", zpic)
281
282  CALL put_field("ZVAL", "ZVAL", zval)
283
284  CALL put_field("RUGSREL", "RUGSREL", rugoro)
285
286  CALL put_field("TANCIEN", "TANCIEN", t_ancien)
287
288  CALL put_field("QANCIEN", "QANCIEN", q_ancien)
289
290  CALL put_field("UANCIEN", "", u_ancien)
291
292  CALL put_field("VANCIEN", "", v_ancien)
293
294  CALL put_field("RUGMER", "Longueur de rugosite sur mer", &
295       frugs(:, is_oce))
296
297  CALL put_field("CLWCON", "Eau liquide convective", clwcon)
298
299  CALL put_field("RNEBCON", "Nebulosite convective", rnebcon)
300
301  CALL put_field("RATQS", "Ratqs", ratqs)
302
303  ! run_off_lic_0
304
305  CALL put_field("RUNOFFLIC0", "Runofflic0", run_off_lic_0)
306
307  ! DEB TKE PBL !
308
309  IF (iflag_pbl>1) then
310     DO nsrf = 1, nbsrf
311        IF (nsrf.LE.99) THEN
312           WRITE(str2, '(i2.2)') nsrf
313           CALL put_field("TKE"//str2, "Energ. Cineti. Turb."//str2, &
314                pbl_tke(:, 1:klev+1, nsrf))
315        ELSE
316           PRINT*, "Trop de sous-mailles"
317           call abort_gcm("phyredem", "", 1)
318        ENDIF
319     ENDDO
320  ENDIF
321
322  ! FIN TKE PBL !
323  !IM ajout zmax0, f0, sig1, w01
324  !IM wake_deltat, wake_deltaq, wake_s, wake_cstar, wake_pe, wake_fip
325
326  CALL put_field("ZMAX0", "ZMAX0", zmax0)
327
328  CALL put_field("F0", "F0", f0)
329
330  CALL put_field("sig1", "sig1 Emanuel", sig1)
331
332  CALL put_field("w01", "w01 Emanuel", w01)
333
334  ! wake_deltat
335  CALL put_field("WAKE_DELTAT", "WAKE_DELTAT", wake_deltat)
336
337  CALL put_field("WAKE_DELTAQ", "WAKE_DELTAQ", wake_deltaq)
338
339  CALL put_field("WAKE_S", "WAKE_S", wake_s)
340
341  CALL put_field("WAKE_CSTAR", "WAKE_CSTAR", wake_cstar)
342
343  CALL put_field("WAKE_PE", "WAKE_PE", wake_pe)
344
345  CALL put_field("WAKE_FIP", "WAKE_FIP", wake_fip)
346
347  ! thermiques
348
349  CALL put_field("FM_THERM", "FM_THERM", fm_therm)
350
351  CALL put_field("ENTR_THERM", "ENTR_THERM", entr_therm)
352
353  CALL put_field("DETR_THERM", "DETR_THERM", detr_therm)
354
355  CALL put_field("ALE_BL", "ALE_BL", Ale_bl)
356
357  CALL put_field("ALE_BL_TRIG", "ALE_BL_TRIG", Ale_bl_trig)
358
359  CALL put_field("ALP_BL", "ALP_BL", Alp_bl)
360
361  ! trs from traclmdz_mod
362  IF (type_trac == 'lmdz') THEN
363     CALL traclmdz_to_restart(trs)
364     DO it=1, nbtr
365        iiq=niadv(it+2)
366        CALL put_field("trs_"//tname(iiq), "", trs(:, it))
367     END DO
368     IF (carbon_cycle_cpl) THEN
369        IF (.NOT. ALLOCATED(co2_send)) THEN
370           ! This is the case of create_etat0_limit, ce0l
371           ALLOCATE(co2_send(klon))
372           co2_send(:) = co2_ppm0
373        END IF
374        CALL put_field("co2_send", "co2_ppm for coupling", co2_send)
375     END IF
376  END IF
377
378  ! Restart variables for Slab ocean
379  IF (type_ocean == 'slab') THEN
380      CALL put_field("tslab", "Slab ocean temperature", tslab)
381      IF (version_ocean == 'sicINT') THEN
382          CALL put_field("seaice", "Slab seaice (kg/m2)", seaice)
383          CALL put_field("slab_tice", "Slab sea ice temperature", tice)
384      END IF
385  END IF
386
387  if (ok_gwd_rando) then
388     call put_field("du_gwd_rando", &
389          "tendency on zonal wind due to gravity waves", &
390          du_gwd_rando)
391     call put_field("dv_gwd_rando", &
392          "tendency on meriodional wind due to gravity waves", &
393          dv_gwd_rando)
394  end if
395
396  CALL close_restartphy
397  !$OMP BARRIER
398
399END SUBROUTINE phyredem
Note: See TracBrowser for help on using the repository browser.