source: LMDZ5/branches/testing/libf/phylmd/phyredem.F90 @ 2212

Last change on this file since 2212 was 2073, checked in by Laurent Fairhead, 10 years ago

Merged trunk changes r2054:2070 into testing branch
  • 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: 9.5 KB
RevLine 
[1403]1! $Id: phyredem.F90 2073 2014-06-25 15:43:19Z oboucher $
[782]2
[1827]3SUBROUTINE phyredem (fichnom)
[782]4
[1827]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
[2073]17  USE surface_data
18  USE ocean_slab_mod, ONLY : tslab
[967]19
[1827]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
[967]33
[1827]34  ! les variables globales ecrites dans le fichier restart
[782]35
[1827]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)
[782]46
[1827]47  INTEGER nid, nvarid, idim1, idim2, idim3
48  INTEGER ierr
49  INTEGER length
50  PARAMETER (length=100)
51  REAL tab_cntrl(length)
[782]52
[1827]53  INTEGER isoil, nsrf
54  CHARACTER (len=7) :: str7
55  CHARACTER (len=2) :: str2
56  INTEGER           :: it, iiq
[524]57
[1827]58  !======================================================================
[524]59
[1827]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)
[1279]64
[1827]65  ! Get a variable calculated in module fonte_neige_mod
66  CALL fonte_neige_final(run_off_lic_0)
[1001]67
[1827]68  !======================================================================
[1001]69
[1827]70  CALL open_restartphy(fichnom)
[1001]71
[1827]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
[524]82
[1827]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.
[524]88
[1827]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  ! 1. fraction de terre
110
111  CALL put_field("FTER", "fraction de continent", pctsrf(:, is_ter))
112
113  ! 2. Fraction de glace de terre
114
115  CALL put_field("FLIC", "fraction glace de terre", pctsrf(:, is_lic))
116
117  ! 3. fraction ocean
118
119  CALL put_field("FOCE", "fraction ocean", pctsrf(:, is_oce))
120
121  ! 4. Fraction glace de mer
122
123  CALL put_field("FSIC", "fraction glace mer", pctsrf(:, is_sic))
124
125  DO nsrf = 1, nbsrf
126     IF (nsrf.LE.99) THEN
127        WRITE(str2, '(i2.2)') nsrf
128        CALL put_field("TS"//str2, "Temperature de surface No."//str2, &
129             ftsol(:, nsrf))
130     ELSE
131        PRINT*, "Trop de sous-mailles"
[1999]132        call abort_gcm("phyredem", "", 1)
[1827]133     ENDIF
134  ENDDO
135
136  DO nsrf = 1, nbsrf
137     DO isoil=1, nsoilmx
138        IF (isoil.LE.99 .AND. nsrf.LE.99) THEN
139           WRITE(str7, '(i2.2, "srf", i2.2)') isoil, nsrf
140           CALL put_field("Tsoil"//str7, "Temperature du sol No."//str7, &
141                tsoil(:, isoil, nsrf))
[524]142        ELSE
[1827]143           PRINT*, "Trop de couches"
[1999]144           call abort_gcm("phyredem", "", 1)
[524]145        ENDIF
[1827]146     ENDDO
147  ENDDO
[524]148
[1827]149  DO nsrf = 1, nbsrf
150     IF (nsrf.LE.99) THEN
151        WRITE(str2, '(i2.2)') nsrf
152        CALL put_field("QS"//str2, "Humidite de surface No."//str2, &
153             qsurf(:, nsrf))
154     ELSE
155        PRINT*, "Trop de sous-mailles"
[1999]156        call abort_gcm("phyredem", "", 1)
[1827]157     ENDIF
158  END DO
159
160  CALL put_field("QSOL", "Eau dans le sol (mm)", qsol)
161
162  DO nsrf = 1, nbsrf
163     IF (nsrf.LE.99) THEN
164        WRITE(str2, '(i2.2)') nsrf
165        CALL put_field("ALBE"//str2, "albedo de surface No."//str2, &
166             falb1(:, nsrf))
167     ELSE
168        PRINT*, "Trop de sous-mailles"
[1999]169        call abort_gcm("phyredem", "", 1)
[1827]170     ENDIF
171  ENDDO
172
173  DO nsrf = 1, nbsrf
174     IF (nsrf.LE.99) THEN
175        WRITE(str2, '(i2.2)') nsrf
176        CALL put_field("ALBLW"//str2, "albedo LW de surface No."//str2, &
177             falb2(:, nsrf))
178     ELSE
179        PRINT*, "Trop de sous-mailles"
[1999]180        call abort_gcm("phyredem", "", 1)
[1827]181     ENDIF
182  ENDDO
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             , evap(:, nsrf))
189     ELSE
190        PRINT*, "Trop de sous-mailles"
[1999]191        call abort_gcm("phyredem", "", 1)
[1827]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"
[1999]202        call abort_gcm("phyredem", "", 1)
[1827]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("fder", "Derive de flux", fder)
213
214  CALL put_field("rain_f", "precipitation liquide", rain_fall)
215
216  CALL put_field("snow_f", "precipitation solide", snow_fall)
217
218  DO nsrf = 1, nbsrf
219     IF (nsrf.LE.99) THEN
220        WRITE(str2, '(i2.2)') nsrf
221        CALL put_field("RUG"//str2, "rugosite de surface No."//str2, &
222             frugs(:, nsrf))
223     ELSE
224        PRINT*, "Trop de sous-mailles"
[1999]225        call abort_gcm("phyredem", "", 1)
[1827]226     ENDIF
227  ENDDO
228
229  DO nsrf = 1, nbsrf
230     IF (nsrf.LE.99) THEN
231        WRITE(str2, '(i2.2)') nsrf
232        CALL put_field("AGESNO"//str2, &
233             "Age de la neige surface No."//str2, &
234             agesno(:, nsrf))
235     ELSE
236        PRINT*, "Trop de sous-mailles"
[1999]237        call abort_gcm("phyredem", "", 1)
[1827]238     ENDIF
239  ENDDO
240
241  CALL put_field("ZMEA", "ZMEA", zmea)
242
243  CALL put_field("ZSTD", "ZSTD", zstd)
244
245  CALL put_field("ZSIG", "ZSIG", zsig)
246
247  CALL put_field("ZGAM", "ZGAM", zgam)
248
249  CALL put_field("ZTHE", "ZTHE", zthe)
250
251  CALL put_field("ZPIC", "ZPIC", zpic)
252
253  CALL put_field("ZVAL", "ZVAL", zval)
254
255  CALL put_field("RUGSREL", "RUGSREL", rugoro)
256
257  CALL put_field("TANCIEN", "TANCIEN", t_ancien)
258
259  CALL put_field("QANCIEN", "QANCIEN", q_ancien)
260
261  CALL put_field("UANCIEN", "", u_ancien)
262
263  CALL put_field("VANCIEN", "", v_ancien)
264
265  CALL put_field("RUGMER", "Longueur de rugosite sur mer", &
266       frugs(:, is_oce))
267
268  CALL put_field("CLWCON", "Eau liquide convective", clwcon)
269
270  CALL put_field("RNEBCON", "Nebulosite convective", rnebcon)
271
272  CALL put_field("RATQS", "Ratqs", ratqs)
273
274  ! run_off_lic_0
275
276  CALL put_field("RUNOFFLIC0", "Runofflic0", run_off_lic_0)
277
278  ! DEB TKE PBL !
279
280  IF (iflag_pbl>1) then
281     DO nsrf = 1, nbsrf
[524]282        IF (nsrf.LE.99) THEN
[1827]283           WRITE(str2, '(i2.2)') nsrf
284           CALL put_field("TKE"//str2, "Energ. Cineti. Turb."//str2, &
285                pbl_tke(:, 1:klev+1, nsrf))
[524]286        ELSE
[1827]287           PRINT*, "Trop de sous-mailles"
[1999]288           call abort_gcm("phyredem", "", 1)
[524]289        ENDIF
[1827]290     ENDDO
291  ENDIF
[1619]292
[1827]293  ! FIN TKE PBL !
294  !IM ajout zmax0, f0, sig1, w01
295  !IM wake_deltat, wake_deltaq, wake_s, wake_cstar, wake_pe, wake_fip
[1619]296
[1827]297  CALL put_field("ZMAX0", "ZMAX0", zmax0)
[1619]298
[1827]299  CALL put_field("F0", "F0", f0)
[878]300
[1827]301  CALL put_field("sig1", "sig1 Emanuel", sig1)
[1001]302
[1827]303  CALL put_field("w01", "w01 Emanuel", w01)
[1001]304
[1827]305  ! wake_deltat
306  CALL put_field("WAKE_DELTAT", "WAKE_DELTAT", wake_deltat)
[1279]307
[1827]308  CALL put_field("WAKE_DELTAQ", "WAKE_DELTAQ", wake_deltaq)
[1403]309
[1827]310  CALL put_field("WAKE_S", "WAKE_S", wake_s)
[1403]311
[1827]312  CALL put_field("WAKE_CSTAR", "WAKE_CSTAR", wake_cstar)
[1403]313
[1827]314  CALL put_field("WAKE_PE", "WAKE_PE", wake_pe)
[1403]315
[1827]316  CALL put_field("WAKE_FIP", "WAKE_FIP", wake_fip)
[1279]317
[1827]318  ! thermiques
319
320  CALL put_field("FM_THERM", "FM_THERM", fm_therm)
321
322  CALL put_field("ENTR_THERM", "ENTR_THERM", entr_therm)
323
324  CALL put_field("DETR_THERM", "DETR_THERM", detr_therm)
325
[2073]326  CALL put_field("ALE_BL", "ALE_BL", Ale_bl)
327
328  CALL put_field("ALE_BL_TRIG", "ALE_BL_TRIG", Ale_bl_trig)
329
330  CALL put_field("ALP_BL", "ALP_BL", Alp_bl)
331
[1827]332  ! trs from traclmdz_mod
333  IF (type_trac == 'lmdz') THEN
334     CALL traclmdz_to_restart(trs)
335     DO it=1, nbtr
336        iiq=niadv(it+2)
337        CALL put_field("trs_"//tname(iiq), "", trs(:, it))
338     END DO
339     IF (carbon_cycle_cpl) THEN
340        IF (.NOT. ALLOCATED(co2_send)) THEN
341           ! This is the case of create_etat0_limit, ce0l
342           ALLOCATE(co2_send(klon))
343           co2_send(:) = co2_ppm0
344        END IF
345        CALL put_field("co2_send", "co2_ppm for coupling", co2_send)
346     END IF
347  END IF
348
[2073]349  ! Restart variables for Slab ocean
350  IF (type_ocean == 'slab') THEN
351      CALL put_field("tslab", "Slab ocean temperature", tslab)
352  END IF
353
[1999]354  if (ok_gwd_rando) then
355     call put_field("du_gwd_rando", &
356          "tendency on zonal wind due to gravity waves", &
357          du_gwd_rando)
358     call put_field("dv_gwd_rando", &
359          "tendency on meriodional wind due to gravity waves", &
360          dv_gwd_rando)
361  end if
362
[1827]363  CALL close_restartphy
364  !$OMP BARRIER
365
366END SUBROUTINE phyredem
Note: See TracBrowser for help on using the repository browser.