source: LMDZ6/trunk/libf/phylmd/phyredem.f90 @ 5481

Last change on this file since 5481 was 5481, checked in by dcugnet, 13 hours ago

Remove tracers attributes "isAdvected" and "isInPhysics" from infotrac (iadv is enough).
Remove tracers attribute "isAdvected" from infotrac_phy (isInPhysics is now equivalent
to former isInPhysics .AND. iadv > 0

  • 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: 15.6 KB
Line 
1!
2! $Id: phyredem.f90 5481 2025-01-16 19:14:15Z dcugnet $
3!
4SUBROUTINE phyredem (fichnom)
5!
6!-------------------------------------------------------------------------------
7! Author: Z.X. Li (LMD/CNRS), 1993/08/18
8!-------------------------------------------------------------------------------
9! Purpose: Write restart state for physics.
10!-------------------------------------------------------------------------------
11USE compbl_mod_h
12  USE alpale_mod
13    USE clesphys_mod_h
14  USE dimphy, ONLY: klon, klev
15  USE fonte_neige_mod,  ONLY : fonte_neige_final
16  USE pbl_surface_mod,  ONLY : pbl_surface_final
17  USE phys_state_var_mod, ONLY: radpas, zmasq, pctsrf,                       &
18                                ftsol, beta_aridity, delta_tsurf, falb_dir,  &
19                                falb_dif, qsol, fevap, radsol, solsw, sollw, &
20                                sollwdown, rain_fall, snow_fall, bs_fall, z0m, z0h, &
21                                agesno, zmea, zstd, zsig, zgam, zthe, zpic,  &
22                                zval, rugoro, t_ancien, q_ancien,            &
23                                prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien,      &
24                                ql_ancien, qs_ancien, qbs_ancien, cf_ancien, &
25                                rvc_ancien, u_ancien, v_ancien,              &
26                                clwcon, rnebcon, ratqs, pbl_tke,             &
27                                wake_delta_pbl_tke, zmax0, f0, sig1, w01,    &
28                                wake_deltat, wake_deltaq, wake_s, awake_s,   &
29                                wake_dens, awake_dens, cv_gen,               &
30                                wake_cstar,                                  &
31                                wake_pe, wake_fip, fm_therm, entr_therm,     &
32                                detr_therm, ale_bl, ale_bl_trig, alp_bl,     &
33                                ale_wake, ale_bl_stat,                       &
34                                du_gwd_rando, du_gwd_front, u10m, v10m, &
35                                treedrg, solswfdiff, delta_sal, ds_ns, dt_ns, &
36                                delta_sst, ratqs_inter_, dter, dser, dt_ds
37
38  USE geometry_mod, ONLY : longitude_deg, latitude_deg
39  USE iostart, ONLY: open_restartphy, close_restartphy, enddef_restartphy, put_field, put_var
40  USE traclmdz_mod, ONLY : traclmdz_to_restart
41  USE infotrac_phy, ONLY: type_trac, nqtot, tracers, nbtr
42  USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send, carbon_cycle_rad, RCO2_glo
43  USE indice_sol_mod, ONLY: nbsrf, is_oce, is_sic, is_ter, is_lic, epsfra
44  USE surface_data, ONLY: type_ocean, version_ocean
45  USE ocean_slab_mod, ONLY : nslay, tslab, seaice, tice, fsic
46  USE time_phylmdz_mod, ONLY: annee_ref, day_end, itau_phy, pdtphys
47  use config_ocean_skin_m, only: activate_ocean_skin
48  USE dimsoil_mod_h, ONLY: nsoilmx
49  IMPLICIT none
50  !======================================================================
51  CHARACTER*(*) fichnom
52
53  ! les variables globales ecrites dans le fichier restart
54
55  REAL tsoil(klon, nsoilmx, nbsrf)
56  REAL qsurf(klon, nbsrf)
57  REAL snow(klon, nbsrf)
58  real fder(klon)
59  REAL run_off_lic_0(klon)
60  REAL trs(klon, nbtr)
61
62  INTEGER nid, nvarid, idim1, idim2, idim3
63  INTEGER ierr
64  INTEGER length
65  PARAMETER (length=100)
66  REAL tab_cntrl(length)
67
68  INTEGER isoil, nsrf,isw
69  CHARACTER (len=2) :: str2
70  CHARACTER (len=256) :: nam, lnam
71  INTEGER           :: it, iq, pass
72
73  !======================================================================
74
75  ! Get variables which will be written to restart file from module
76  ! pbl_surface_mod
77  if ( iflag_physiq <= 1 ) then
78     CALL pbl_surface_final(fder, snow, qsurf,  tsoil)
79  endif
80
81  ! Get a variable calculated in module fonte_neige_mod
82  CALL fonte_neige_final(run_off_lic_0)
83
84  !======================================================================
85
86  CALL open_restartphy(fichnom)
87
88 
89  DO ierr = 1, length
90     tab_cntrl(ierr) = 0.0
91  ENDDO
92  tab_cntrl(1) = pdtphys
93  tab_cntrl(2) = radpas
94  ! co2_ppm : current value of atmospheric CO2
95  tab_cntrl(3) = co2_ppm
96  tab_cntrl(4) = solaire
97  tab_cntrl(5) = iflag_con
98  tab_cntrl(6) = nbapp_rad
99
100  IF( iflag_cycle_diurne.GE.1 ) tab_cntrl( 7 ) = iflag_cycle_diurne
101  IF(   soil_model ) tab_cntrl( 8 ) = 1.
102  IF(     new_oliq ) tab_cntrl( 9 ) = 1.
103  IF(     ok_orodr ) tab_cntrl(10 ) = 1.
104  IF(     ok_orolf ) tab_cntrl(11 ) = 1.
105
106  tab_cntrl(13) = day_end
107  tab_cntrl(14) = annee_ref
108  tab_cntrl(15) = itau_phy
109
110  ! co2_ppm0 : initial value of atmospheric CO2
111  ! tab_cntrl(16) = co2_ppm0
112
113  !  PC -- initial value of RCO2 for the radiation scheme
114  !  tab_cntrl(17) = co2_ppm * 1.0e-06 * RMCO2 / RMD
115  IF (carbon_cycle_rad) tab_cntrl(17) = RCO2_glo
116  !PRINT*, "PC : phyredem RCO2_glo =",RCO2_glo
117
118  DO pass=1,2   ! pass=1 netcdf definition ; pass=2 netcdf write
119 
120    CALL put_var(pass, "controle", "Parametres de controle", tab_cntrl)
121
122    CALL put_field(pass,"longitude", &
123         "Longitudes de la grille physique", longitude_deg)
124
125    CALL put_field(pass,"latitude", "Latitudes de la grille physique", latitude_deg)
126
127    ! PB ajout du masque terre/mer
128
129    CALL put_field(pass,"masque", "masque terre mer", zmasq)
130
131    ! BP ajout des fraction de chaque sous-surface
132
133    ! Get last fractions from slab ocean
134    IF (type_ocean == 'slab' .AND. version_ocean == "sicINT") THEN
135        WHERE (1.-zmasq(:).GT.EPSFRA)
136            pctsrf(:,is_oce)=(1.-fsic(:))*(1.-zmasq(:))
137            pctsrf(:,is_sic)=fsic(:)*(1.-zmasq(:))
138        END WHERE
139    END IF
140
141    ! 1. fraction de terre
142
143    CALL put_field(pass,"FTER", "fraction de continent", pctsrf(:, is_ter))
144
145    ! 2. Fraction de glace de terre
146
147    CALL put_field(pass,"FLIC", "fraction glace de terre", pctsrf(:, is_lic))
148    ! 3. fraction ocean
149
150    CALL put_field(pass,"FOCE", "fraction ocean", pctsrf(:, is_oce))
151
152    ! 4. Fraction glace de mer
153
154    CALL put_field(pass,"FSIC", "fraction glace mer", pctsrf(:, is_sic))
155
156    IF(nbsrf>99) THEN
157      PRINT*, "Trop de sous-mailles";  CALL abort_physic("phyredem", "", 1)
158    END IF
159    IF(nsoilmx>99) THEN
160      PRINT*, "Trop de sous-surfaces"; CALL abort_physic("phyredem", "", 1)
161    END IF
162    IF(nsw>99) THEN
163      PRINT*, "Trop de bandes"; CALL abort_physic("phyredem", "", 1)
164    END IF
165
166!    Surface variables
167    CALL put_field_srf1(pass,"TS","Temperature",ftsol(:,:))
168
169    IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1) then
170       CALL put_field_srf1(pass, "DELTATS", &
171            "w-x surface temperature difference", delta_tsurf(:,:))
172       CALL put_field_srf1(pass,"BETAS","Aridity factor", beta_aridity(:,:))
173    end IF
174!    End surface variables
175
176! ================== Albedo =======================================
177    print*,'PHYREDEM NOUVEAU'
178    CALL put_field_srf2(pass,"A_dir_SW","Albedo direct",falb_dir(:,:,:))
179    CALL put_field_srf2(pass,"A_dif_SW","Albedo diffus",falb_dif(:,:,:))
180
181    CALL put_field_srf1(pass,"U10M", "u a 10m", u10m)
182
183    CALL put_field_srf1(pass,"V10M", "v a 10m", v10m)
184
185
186! ================== Tsoil =========================================
187    CALL put_field_srf2(pass,"Tsoil","Temperature",tsoil(:,:,:))
188!FC
189!  CALL put_field_srf2("treedrg","freinage arbres",treedrg(:,:,:))
190    CALL put_field(pass,"treedrg_ter","freinage arbres",treedrg(:,:,is_ter))
191
192
193    CALL put_field_srf1(pass,"QS"  , "Humidite",qsurf(:,:))
194
195    CALL put_field     (pass,"QSOL", "Eau dans le sol (mm)", qsol)
196
197    CALL put_field_srf1(pass,"EVAP", "Evaporation", fevap(:,:))
198
199    CALL put_field_srf1(pass,"SNOW", "Neige", snow(:,:))
200
201    CALL put_field(pass,"RADS", "Rayonnement net a la surface", radsol)
202
203    CALL put_field(pass,"solsw", "Rayonnement solaire a la surface", solsw)
204
205    CALL put_field(pass,"solswfdiff", "Fraction du rayonnement solaire a la surface qui est diffus", solswfdiff)
206
207    CALL put_field(pass,"sollw", "Rayonnement IF a la surface", sollw)
208
209    CALL put_field(pass,"sollwdown", "Rayonnement down IF a la surface", sollwdown)
210
211    CALL put_field(pass,"fder", "Derive de flux", fder)
212
213    CALL put_field(pass,"rain_f", "precipitation liquide", rain_fall)
214
215    CALL put_field(pass,"snow_f", "precipitation solide", snow_fall)
216
217    CALL put_field_srf1(pass,"Z0m", "rugosite", z0m(:,:))
218
219    CALL put_field_srf1(pass,"Z0h", "rugosite", z0h(:,:))
220
221    CALL put_field_srf1(pass,"AGESNO", "Age de la neige", agesno(:,:))
222
223    CALL put_field(pass,"ZMEA", "ZMEA", zmea)
224
225    CALL put_field(pass,"ZSTD", "ZSTD", zstd)
226
227    CALL put_field(pass,"ZSIG", "ZSIG", zsig)
228
229    CALL put_field(pass,"ZGAM", "ZGAM", zgam)
230
231    CALL put_field(pass,"ZTHE", "ZTHE", zthe)
232
233    CALL put_field(pass,"ZPIC", "ZPIC", zpic)
234
235    CALL put_field(pass,"ZVAL", "ZVAL", zval)
236
237    CALL put_field(pass,"RUGSREL", "RUGSREL", rugoro)
238
239    CALL put_field(pass,"TANCIEN", "TANCIEN", t_ancien)
240
241    CALL put_field(pass,"QANCIEN", "QANCIEN", q_ancien)
242
243    CALL put_field(pass,"QLANCIEN", "QLANCIEN", ql_ancien)
244
245    CALL put_field(pass,"QSANCIEN", "QSANCIEN", qs_ancien)
246
247    IF (ok_bs) THEN
248       CALL put_field(pass,"bs_f", "precipitation neige soufflee", bs_fall)
249       CALL put_field(pass,"QBSANCIEN", "QBSANCIEN", qbs_ancien)
250       CALL put_field(pass,"PRBSWANCIEN", "PRBSWANCIEN", prbsw_ancien)
251    ENDIF
252
253    IF ( ok_ice_supersat ) THEN
254      CALL put_field(pass,"CFANCIEN", "CFANCIEN", cf_ancien)
255      CALL put_field(pass,"RVCANCIEN", "RVCANCIEN", rvc_ancien)
256    ENDIF
257
258    CALL put_field(pass,"PRWANCIEN", "PRWANCIEN", prw_ancien)
259
260    CALL put_field(pass,"PRLWANCIEN", "PRLWANCIEN", prlw_ancien)
261
262    CALL put_field(pass,"PRSWANCIEN", "PRSWANCIEN", prsw_ancien)
263
264    CALL put_field(pass,"UANCIEN", "UANCIEN", u_ancien)
265
266    CALL put_field(pass,"VANCIEN", "VANCIEN", v_ancien)
267
268    CALL put_field(pass,"CLWCON", "Eau liquide convective", clwcon)
269
270    CALL put_field(pass,"RNEBCON", "Nebulosite convective", rnebcon)
271
272    CALL put_field(pass,"RATQS", "Ratqs", ratqs)
273
274    ! run_off_lic_0
275
276    CALL put_field(pass,"RUNOFFLIC0", "Runofflic0", run_off_lic_0)
277
278    ! DEB TKE PBL !
279
280    IF (iflag_pbl>1) then
281      CALL put_field_srf3(pass,"TKE", "Energ. Cineti. Turb.", &
282           pbl_tke(:,:,:))
283      CALL put_field_srf3(pass,"DELTATKE", "Del TKE wk/env.", &
284           wake_delta_pbl_tke(:,:,:))
285    END IF
286
287    ! FIN TKE PBL !
288    !IM ajout zmax0, f0, sig1, w01
289    !IM wake_deltat, wake_deltaq, wake_s, wake_cstar, wake_pe, wake_fip
290
291    CALL put_field(pass,"ZMAX0", "ZMAX0", zmax0)
292
293    CALL put_field(pass,"F0", "F0", f0)
294
295    CALL put_field(pass,"sig1", "sig1 Emanuel", sig1)
296
297    CALL put_field(pass,"w01", "w01 Emanuel", w01)
298
299    ! wake_deltat
300    CALL put_field(pass,"WAKE_DELTAT", "WAKE_DELTAT", wake_deltat)
301
302    CALL put_field(pass,"WAKE_DELTAQ", "WAKE_DELTAQ", wake_deltaq)
303
304    CALL put_field(pass,"WAKE_S", "Wake frac. area", wake_s)
305
306    CALL put_field(pass,"AWAKE_S", "Active Wake frac. area", awake_s)
307
308    CALL put_field(pass,"WAKE_DENS", "Wake num. /unit area", wake_dens)
309
310    CALL put_field(pass,"AWAKE_DENS", "Active Wake num. /unit area", awake_dens)
311
312    CALL put_field(pass,"CV_GEN", "CB birth rate", cv_gen)
313
314    CALL put_field(pass,"WAKE_CSTAR", "WAKE_CSTAR", wake_cstar)
315
316    CALL put_field(pass,"WAKE_PE", "WAKE_PE", wake_pe)
317
318    CALL put_field(pass,"WAKE_FIP", "WAKE_FIP", wake_fip)
319
320    ! thermiques
321
322    CALL put_field(pass,"FM_THERM", "FM_THERM", fm_therm)
323
324    CALL put_field(pass,"ENTR_THERM", "ENTR_THERM", entr_therm)
325
326    CALL put_field(pass,"DETR_THERM", "DETR_THERM", detr_therm)
327
328    CALL put_field(pass,"ALE_BL", "ALE_BL", ale_bl)
329
330    CALL put_field(pass,"ALE_BL_TRIG", "ALE_BL_TRIG", ale_bl_trig)
331
332    CALL put_field(pass,"ALP_BL", "ALP_BL", alp_bl)
333
334    CALL put_field(pass,"ALE_WAKE", "ALE_WAKE", ale_wake)
335
336    CALL put_field(pass,"ALE_BL_STAT", "ALE_BL_STAT", ale_bl_stat)
337
338
339    ! fisrtilp/clouds
340    CALL put_field(pass,"RATQS_INTER","Relative width of the lsc sugrid scale water",ratqs_inter_)
341
342
343    IF (ANY(type_trac == ['co2i','inco'])) THEN
344       IF (carbon_cycle_cpl) THEN
345          IF (.NOT. ALLOCATED(co2_send)) THEN
346             ! This is the case of create_etat0_limit, ce0l
347             ALLOCATE(co2_send(klon))
348             co2_send(:) = co2_ppm0
349          END IF
350          CALL put_field(pass,"co2_send", "co2_ppm for coupling", co2_send)
351       END IF
352
353    ! trs from traclmdz_mod
354    ELSE IF (type_trac == 'lmdz') THEN
355       CALL traclmdz_to_restart(trs)
356       it = 0
357       DO iq = 1, nqtot
358          IF(.NOT.tracers(iq)%isInPhysics) CYCLE
359          it = it+1
360          CALL put_field(pass,"trs_"//tracers(iq)%name, "", trs(:, it))
361       END DO
362    END IF
363
364    ! Restart variables for Slab ocean
365    IF (type_ocean == 'slab') THEN
366        IF (nslay.EQ.1) THEN
367          CALL put_field(pass,"tslab", "Slab ocean temperature", tslab)
368        ELSE
369          DO it=1,nslay
370            WRITE(str2,'(i2.2)') it
371            CALL put_field(pass,"tslab"//str2, "Slab ocean temperature", tslab(:,it))
372          END DO
373        END IF
374        IF (version_ocean == 'sicINT') THEN
375            CALL put_field(pass,"seaice", "Slab seaice (kg/m2)", seaice)
376            CALL put_field(pass,"slab_tice", "Slab sea ice temperature", tice)
377        END IF
378    END IF
379
380    if (ok_gwd_rando) call put_field(pass,"du_gwd_rando", &
381         "tendency on zonal wind due to flott gravity waves", du_gwd_rando)
382
383    IF (.not. ok_hines .and. ok_gwd_rando) call put_field(pass,"du_gwd_front", &
384         "tendency on zonal wind due to acama gravity waves", du_gwd_front)
385
386    if (activate_ocean_skin >= 1) then
387       if (activate_ocean_skin == 2 .and. type_ocean == 'couple') then
388          CALL put_field(pass, "delta_sal", &
389               "ocean-air interface salinity minus bulk salinity", delta_sal)
390          CALL put_field(pass, "delta_SST", &
391               "ocean-air interface temperature minus bulk SST", delta_sst)
392          CALL put_field(pass, "dter", &
393               "ocean-air interface temperature minus subskin temperature", &
394               dter)
395          CALL put_field(pass, "dser", &
396               "ocean-air interface salinity minus subskin salinity", dser)
397          CALL put_field(pass, "dt_ds", &
398               "(tks / tkt) * dTer", dt_ds)
399       end if
400       
401       CALL put_field(pass, "dS_ns", "delta salinity near surface", ds_ns)
402       CALL put_field(pass, "dT_ns", "delta temperature near surface", dT_ns)
403    end if
404   
405    IF (pass==1) CALL enddef_restartphy
406    IF (pass==2) CALL close_restartphy
407  ENDDO ! DO pass=1,2   ! pass=1 netcdf definition ; pass=2 netcdf write
408 
409  !$OMP BARRIER
410
411
412  CONTAINS
413
414
415SUBROUTINE put_field_srf1(pass,nam,lnam,field)
416
417  IMPLICIT NONE
418  INTEGER, INTENT(IN)           :: pass
419  CHARACTER(LEN=*),  INTENT(IN) :: nam, lnam
420  REAL,              INTENT(IN) :: field(:,:)
421  CHARACTER(LEN=256) :: nm, lm, str
422  DO nsrf = 1, SIZE(field,2)
423    WRITE(str, '(i2.2)') nsrf
424    nm=TRIM(nam)//TRIM(str)
425    lm=TRIM(lnam)//" de surface No. "//TRIM(str)
426    CALL put_field(pass,nm,lm,field(:,nsrf))
427  END DO
428
429END SUBROUTINE put_field_srf1
430
431
432SUBROUTINE put_field_srf2(pass,nam,lnam,field)
433
434  IMPLICIT NONE
435  INTEGER, INTENT(IN)            :: pass
436  CHARACTER(LEN=*),  INTENT(IN) :: nam, lnam
437  REAL,              INTENT(IN) :: field(:,:,:)
438  CHARACTER(LEN=256) :: nm, lm, str
439  DO nsrf = 1, SIZE(field,3)
440    DO isoil=1, SIZE(field,2)
441      WRITE(str, '(i2.2,"srf",i2.2)')isoil,nsrf
442!      WRITE(lunout,*)"PHYREDEM ",TRIM(nam)//TRIM(str)
443      nm=TRIM(nam)//TRIM(str)
444      lm=TRIM(lnam)//" du sol No. "//TRIM(str)
445      CALL put_field(pass,nm,lm,field(:,isoil,nsrf))
446    END DO
447  END DO
448
449END SUBROUTINE put_field_srf2
450
451
452SUBROUTINE put_field_srf3(pass,nam,lnam,field)
453
454  IMPLICIT NONE
455  INTEGER, INTENT(IN)            :: pass
456  CHARACTER(LEN=*),  INTENT(IN) :: nam, lnam
457  REAL,              INTENT(IN) :: field(:,:,:)
458  CHARACTER(LEN=256) :: nm, lm, str
459  DO nsrf = 1, SIZE(field,3)
460    WRITE(str, '(i2.2)') nsrf
461    nm=TRIM(nam)//TRIM(str)
462    lm=TRIM(lnam)//TRIM(str)
463    CALL put_field(pass,nm,lm,field(:,1:klev+1,nsrf))
464  END DO
465
466END SUBROUTINE put_field_srf3
467
468
469END SUBROUTINE phyredem
Note: See TracBrowser for help on using the repository browser.