Ignore:
Timestamp:
Apr 25, 2025, 2:21:02 PM (2 months ago)
Author:
amaison
Message:

Representation of heterogeneous continental subsurfaces with parameter or flux aggregation in the simplified surface model (bucket) for 1D case studies.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • TabularUnified LMDZ6/trunk/libf/phylmd/dyn1d/compar1d_mod_h.f90

    r5302 r5627  
    88          iflag_nudge, snowmass, &
    99          restart, ok_old_disvert, &
     10          nb_ter_srf, alpha_soil_ter_srf, period_ter_srf, frac_ter_srf, &
     11          rugos_ter_srf, ratio_z0m_z0h_ter_srf, albedo_ter_srf, beta_ter_srf, &
     12          inertie_ter_srf, hcond_ter_srf, tsurf_ter_srf, tsoil_ter_srf, &
     13          tsoil_depths, nb_tsoil_depths, &
    1014          tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, &
    1115          trad, forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar, &
     
    4448  LOGICAL :: ok_old_disvert
    4549
     50  INTEGER :: nb_ter_srf
     51  REAL :: alpha_soil_ter_srf
     52  REAL :: period_ter_srf
     53  REAL, DIMENSION(5) :: frac_ter_srf
     54  REAL, DIMENSION(5) :: rugos_ter_srf
     55  REAL, DIMENSION(5) :: ratio_z0m_z0h_ter_srf
     56  REAL, DIMENSION(5) :: albedo_ter_srf
     57  REAL, DIMENSION(5) :: beta_ter_srf
     58  REAL, DIMENSION(5) :: inertie_ter_srf
     59  REAL, DIMENSION(5) :: hcond_ter_srf
     60  REAL, DIMENSION(5) :: tsurf_ter_srf
     61  REAL, DIMENSION(5*5) :: tsoil_ter_srf
     62  REAL, DIMENSION(5*5) :: tsoil_depths
     63  INTEGER :: nb_tsoil_depths
     64
    4665  ! Pour les forcages communs: ces entiers valent 0 ou 1
    4766  ! tadv= advection tempe, tadvv= adv tempe verticale, tadvh= adv tempe horizontale
     
    6584  !$OMP      iflag_nudge, snowmass, &
    6685  !$OMP      restart, ok_old_disvert, &
     86  !$OMP      nb_ter_srf, frac_ter_srf, rugos_ter_srf, albedo_ter_srf,         &
     87  !$OMP      beta_ter_srf, inertie_ter_srf, alpha_soil_ter_srf,               &
     88  !$OMP      period_ter_srf, hcond_ter_srf, ratio_z0m_z0h_ter_srf,            &
     89  !$OMP      tsurf_ter_srf, tsoil_ter_srf, tsoil_depths, nb_tsoil_depths,     &
    6790  !$OMP      tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, &
    6891  !$OMP      trad, forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar, &
Note: See TracChangeset for help on using the changeset viewer.