source: LMDZ6/trunk/libf/phylmd/phyredem.F90 @ 4544

Last change on this file since 4544 was 4537, checked in by fhourdin, 19 months ago

Travail preparatoire au couplage avec mesoNH

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