Ignore:
Timestamp:
Feb 21, 2025, 2:01:55 PM (3 days ago)
Author:
asima
Message:

Encapsulating in modules 3 Dust (SPLA) subroutines with identical names in INCA
(see also r5505);
Related changes in other files, especially some cleaning of chem_mod_f.90.
Everything cf the new coding conventions bien sûr !

Location:
LMDZ6/trunk/libf/phylmd
Files:
6 edited
3 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/Dust/lmdz_spla_bl_for_dms.f90

    r5553 r5554  
    1 SUBROUTINE bl_for_dms(u,v,paprs,pplay,cdragh,cdragm &
     1MODULE lmdz_spla_bl_for_dms
     2
     3CONTAINS
     4
     5SUBROUTINE spla_bl_for_dms(klon,klev,u,v,paprs,pplay,cdragh,cdragm &
    26        ,t,q,tsol,ustar,obklen)
    3   USE dimphy
    4 USE yomcst_mod_h
    5   USE yoethf_mod_h
    6 IMPLICIT NONE
     7
     8  USE lmdz_spla_ini, ONLY : RG,RD,RCPD,RLVTT,RLSTT,RETV,RTT, &
     9          R2ES,R3IES,R3LES,R4IES,R4LES,R5IES,R5LES,RVTMP2
     10
     11 !USE yoethf_mod_h
    712  !
    813  !===================================================================
    … …  
    1924  !===================================================================
    2025  !
     26  IMPLICIT NONE
     27
    2128  INCLUDE "FCTTRE.h"
     29
     30  !
     31  INTEGER, intent(in) :: klon,klev
    2232  !
    2333  ! Arguments :
    24   REAL :: u(klon,klev)          ! vent zonal
    25   REAL :: v(klon,klev)          ! vent meridien
    26   REAL :: paprs(klon,klev+1)    ! niveaux de pression aux intercouches (Pa)
    27   REAL :: pplay(klon,klev)      ! niveaux de pression aux milieux... (Pa)
    28   REAL :: cdragh(klon)          ! coefficient de trainee pour la chaleur
    29   REAL :: cdragm(klon)          ! coefficient de trainee pour le vent
    30   REAL :: t(klon,klev)          ! temperature
    31   REAL :: q(klon,klev)          ! humidite kg/kg
    32   REAL :: tsol(klon)            ! temperature du sol
    33   REAL :: ustar(klon)           ! vitesse de friction
    34   REAL :: obklen(klon)          ! longueur de Monin-Obukhov
     34  REAL, dimension(klon,klev), intent(in) :: u          ! vent zonal
     35  REAL, dimension(klon,klev), intent(in) :: v          ! vent meridien
     36  REAL, dimension(klon,klev+1), intent(in):: paprs    ! niveaux de pression aux intercouches (Pa)
     37  REAL, dimension(klon,klev), intent(in) :: pplay     ! niveaux de pression aux milieux... (Pa)
     38  REAL, dimension(klon,klev), intent(in) :: t          ! temperature
     39  REAL, dimension(klon,klev), intent(in) :: q          ! humidite kg/kg
     40  REAL, dimension(klon), intent(in) :: cdragh          ! coefficient de trainee pour la chaleur
     41  REAL, dimension(klon), intent(in) :: cdragm          ! coefficient de trainee pour le vent
     42  REAL, dimension(klon), intent(in) :: tsol            ! temperature du sol
     43  REAL, dimension(klon), intent(out) :: ustar           ! vitesse de friction
     44  REAL, dimension(klon), intent(out) :: obklen          ! longueur de Monin-Obukhov
    3545  !
    3646  ! Locales :
    … …  
    4353  REAL :: zxt, zxu, zxv, zxq, zxqs, zxmod, taux, tauy
    4454  REAL :: zcor, zdelta, zcvm5
    45   REAL :: z(klon,klev)
     55  REAL, dimension(klon,klev) :: z
    4656  REAL :: zx_alf1, zx_alf2 ! parametres pour extrapolation
    47   REAL :: khfs(klon)       ! surface kinematic heat flux [mK/s]
    48   REAL :: kqfs(klon)       ! sfc kinematic constituent flux [m/s]
    49   REAL :: heatv(klon)      ! surface virtual heat flux
     57  REAL, dimension(klon) :: khfs       ! surface kinematic heat flux [mK/s]
     58  REAL, dimension(klon) :: kqfs       ! sfc kinematic constituent flux [m/s]
     59  REAL, dimension(klon) :: heatv      ! surface virtual heat flux
    5060
    5161
    … …  
    102112  ENDDO
    103113  !
    104 END SUBROUTINE bl_for_dms
     114END SUBROUTINE spla_bl_for_dms
     115
     116END MODULE lmdz_spla_bl_for_dms

  • LMDZ6/trunk/libf/phylmd/Dust/lmdz_spla_gastoparticle.f90

    r5553 r5554  
    1 SUBROUTINE gastoparticle(pdtphys,zdz,zrho,xlat,pplay,t_seri, &
     1MODULE lmdz_spla_gastoparticle
     2
     3CONTAINS
     4
     5SUBROUTINE spla_gastoparticle(klon,klev,nbtr,pdtphys,zdz,zrho,xlat,pplay,t_seri, &
    26        id_prec,id_fine, &
    37        tr_seri,his_g2pgas ,his_g2paer )
    48  !nhl     .                         fluxso4chem, flux_sparam_sulf,
    59
    6 USE chem_spla_mod_h
    7   USE chem_mod_h
    8   USE yoecumf_mod_h
    9     USE dimphy
    10   USE infotrac_phy, ONLY: nbtr
    11    ! USE indice_sol_mod
     10USE lmdz_spla_ini, ONLY: RNAVO,masse_s,masse_ammsulfate
    1211
    13 USE yomcst_mod_h
     12  !USE yoecumf_mod_h !!!! AS: pour Tiedke (Tiedtke) ; ça compile sans -->> inutile?!
     13
    1414IMPLICIT NONE
    1515  !
    16 
    17 
     16  INTEGER, intent(in) :: klon,klev  ! from dimphy
     17  INTEGER, intent(in) :: nbtr  ! from infotrac_phy
    1818  !
    19   REAL :: pdtphys
    20   REAL :: zrho(klon,klev)
    21   REAL :: zdz(klon,klev)
    22   REAL :: tr_seri(klon,klev,nbtr)   ! traceurs
    23   REAL :: tend                 ! tendance par espece
    24   REAL :: xlat(klon)       ! latitudes pour chaque point
     19  INTEGER,intent(in) :: id_prec,id_fine            ! JE: 20140120
     20  REAL, intent(in) :: pdtphys
     21  REAL, dimension(klon,klev), intent(in) :: zrho
     22  REAL, dimension(klon,klev), intent(in) :: zdz
     23  REAL, dimension(klon), intent(in) :: xlat       ! latitudes pour chaque point
     24  REAL, dimension(klon,klev), intent(in) :: pplay  ! JE: 20140120
     25  REAL, dimension(klon,klev), intent(in) :: t_seri ! JE: 20140120
     26  REAL, dimension(klon,klev,nbtr), intent(inout) :: tr_seri   ! traceurs
     27  REAL, dimension(klon), intent(out) :: his_g2pgas ! JE: 20140120
     28  REAL, dimension(klon), intent(out) :: his_g2paer ! JE: 20140120
     29  !       local
     30  REAL :: tendincm3(klon,klev)  ! JE: 20140120
     31  REAL :: tempvar(klon,klev)    ! JE: 20140120
     32  REAL :: tend2d(klon,klev)     ! JE: 20140120
     33  REAL :: tend                  ! tendance par espece
    2534  REAL :: pi
    26   !   JE: 20140120
    27   REAL :: his_g2pgas(klon)
    28   REAL :: his_g2paer(klon)
    29   REAL :: tendincm3(klon,klev)
    30   REAL :: tempvar(klon,klev)
    31   REAL :: pplay(klon,klev)
    32   REAL :: t_seri(klon,klev)
    33   REAL :: tend2d(klon,klev)
    34   INTEGER :: id_prec,id_fine
    35   !
    3635  !------------------------- Scaling Parameter --------------------------
    3736  !
    3837  !  REAL scale_param_so4(klon)  !Scaling parameter for sulfate
    39 
    4038  INTEGER :: i, k
    4139  REAL :: tau_chem     !---chemical lifetime in s
    … …  
    9189  !
    9290  RETURN
    93 END SUBROUTINE gastoparticle
     91END SUBROUTINE spla_gastoparticle
     92
     93END MODULE lmdz_spla_gastoparticle

  • LMDZ6/trunk/libf/phylmd/Dust/lmdz_spla_ini.f90

    r5505 r5554  
    11MODULE lmdz_spla_ini
    2 INTEGER, SAVE :: is_oce
    3 REAL, SAVE :: RNAVO
    4 !$OMP THREADPRIVATE(is_oce,RNAVO)
     2
     3IMPLICIT NONE
     4
     5SAVE
     6
     7! from indice_sol_mod.f90
     8INTEGER, PROTECTED :: is_oce
     9!$OMP THREADPRIVATE(is_oce)
     10
     11! from yomcst_mod_h.f90
     12REAL, PROTECTED :: RNAVO,RG,RD,RCPD,RLVTT,RLSTT,RETV,RTT 
     13!$OMP THREADPRIVATE(RNAVO,RG,RD,RCPD,RLVTT,RLSTT,RETV,RTT)
     14
     15! from yoethf_mod_h.f90
     16! COMMON *YOETHF* DERIVED CONSTANTS SPECIFIC TO ECMWF THERMODYNAMICS
     17REAL :: R2ES,R3IES,R3LES,R4IES,R4LES,R5IES,R5LES,RVTMP2     
     18!$OMP THREADPRIVATE(R2ES,R3LES,R3IES,R4LES,R4IES,R5LES,R5IES,RVTMP2)
     19
     20! from chem_mod_h.f90
     21REAL, PARAMETER :: masse_s=32.0  !--g mol-1 ; molar mass sulfur-32 isotope (stable)
     22
     23! from chem_spla_mod_h.f90
     24REAL, PARAMETER :: masse_ammsulfate = 132.0  !--g mol-1
    525
    626CONTAINS
    7 SUBROUTINE spla_ini(is_oce_in,RNAVO_in)
     27
     28SUBROUTINE spla_ini(is_oce_in,   &
     29                RNAVO_in,RG_in,RD_in,RCPD_in,RLVTT_in,RLSTT_in,RETV_in,RTT_in,  &
     30                R2ES_in,R3LES_in,R3IES_in,R4LES_in,R4IES_in,R5LES_in,R5IES_in,RVTMP2_in  &
     31                )
     32
    833IMPLICIT NONE
    9 INTEGER is_oce_in
    10 REAL RNAVO_in
     34
     35integer, intent(in) :: is_oce_in
     36real, intent(in) :: RNAVO_in,RG_in,RD_in,RCPD_in,RLVTT_in,RLSTT_in,RETV_in,RTT_in
     37real, intent(in) :: R2ES_in,R3LES_in,R3IES_in,R4LES_in,R4IES_in,R5LES_in,R5IES_in,RVTMP2_in
     38
    1139is_oce=is_oce_in
     40
    1241RNAVO=RNAVO_in
     42RG=RG_in
     43RD=RD_in
     44RCPD=RCPD_in
     45RLVTT=RLVTT_in
     46RLSTT=RLSTT_in
     47RETV=RETV_in
     48RTT=RTT_in
     49
     50R2ES=R2ES_in
     51R3LES=R3LES_in
     52R3IES=R3IES_in
     53R4LES=R4LES_in
     54R4IES=R4IES_in
     55R5LES=R5LES_in
     56R5IES=R5IES_in
     57RVTMP2=RVTMP2_in
     58
    1359END SUBROUTINE spla_ini
     60
    1461END MODULE lmdz_spla_ini

  • LMDZ6/trunk/libf/phylmd/Dust/lmdz_spla_neutral.f90

    r5553 r5554  
     1MODULE lmdz_spla_neutral
     2  CONTAINS
    13!***********************************************************************
    2   subroutine neutral(u10_mps,ustar_mps,obklen_m, &
     4  subroutine spla_neutral(klon,u10_mps,ustar_mps,obklen_m, &
    35          u10n_mps )
    46  !-----------------------------------------------------------------------     
    … …  
    2729  !----------------------------------------------------------------------               
    2830  !
    29   USE dimphy
    3031  !
    31     real :: u10_mps(klon),ustar_mps(klon),obklen_m(klon)
    32     real :: u10n_mps(klon)
     32  IMPLICIT NONE
     33  !
     34  INTEGER klon 
     35
     36   
     37    real, dimension(klon), intent(in) :: u10_mps, ustar_mps, obklen_m
     38    real, dimension(klon), intent(out) :: u10n_mps
    3339    real :: pi,von_karman
    3440    ! parameter (pi = 3.141592653589793, von_karman = 0.4)     
    … …  
    4248    psi = 0.
    4349    do i=1,klon
    44 
    45     if (u10_mps(i) .lt. 0.) u10_mps(i) = 0.0
     50    ! Original : needs u10_mps defined as "inout" to be able to modify it here, but in reality it is only "in"
     51    !if (u10_mps(i) .lt. 0.) u10_mps(i) = 0.0
     52    ! Instead, STOP to check why the module is negative
     53    if (u10_mps(i) .lt. 0.) STOP 'negative wind module u10 in input of spla_neutral'
    4654
    4755    if  (obklen_m(i) .lt. 0.) then
    … …  
    6876    enddo
    6977    return
    70 end subroutine neutral
     78end subroutine spla_neutral
    7179!***********************************************************************
     80END MODULE lmdz_spla_neutral

  • LMDZ6/trunk/libf/phylmd/Dust/lmdz_spla_nightingale.f90

    r5505 r5554  
    11MODULE lmdz_spla_nightingale
     2
    23CONTAINS
     4
    35SUBROUTINE spla_nightingale(klon,klev,nbsrf,u, v, u_10m, v_10m, paprs, pplay, &
    46        cdragh, cdragm, t, q, ftsol, tsol, &
    57        pctsrf, lmt_dmsconc, lmt_dms)
    68  !
    7 USE lmdz_spla_ini, ONLY: is_oce, RNAVO
     9  USE lmdz_spla_ini, ONLY: is_oce, RNAVO
     10  USE lmdz_spla_bl_for_dms, ONLY: spla_bl_for_dms
     11  USE lmdz_spla_neutral, ONLY: spla_neutral
    812
    9 IMPLICIT NONE
     13  IMPLICIT NONE
    1014  !
    11 INTEGER klon,klev,nbsrf
     15  INTEGER, intent(in) :: klon,klev,nbsrf
    1216  !
    1317  REAL, dimension(klon,klev), intent(in) :: u, v
    … …  
    3034  INTEGER :: i
    3135  !
    32   CALL bl_for_dms(u, v, paprs, pplay, cdragh, cdragm, &
     36  CALL spla_bl_for_dms(klon, klev, u, v, paprs, pplay, cdragh, cdragm, &
    3337        t, q, tsol, ustar, obklen)
    3438  !
    … …  
    3741  ENDDO
    3842  !
    39   CALL neutral(u10, ustar, obklen, u10n)
     43  CALL spla_neutral(klon, u10, ustar, obklen, u10n)
    4044  !
    4145  DO i=1,klon
    … …  
    8488  !
    8589END SUBROUTINE spla_nightingale
     90
    8691END MODULE lmdz_spla_nightingale

  • LMDZ6/trunk/libf/phylmd/Dust/phytracr_spl_mod.F90

    r5337 r5554  
    44MODULE phytracr_spl_mod
    55
     6  USE lmdz_spla_gastoparticle, ONLY : spla_gastoparticle
     7
    68  ! Recuperation des morceaux de la physique de Jeronimo specifiques
    79  ! du modele d'aerosols d'Olivier n'co.
    8   USE chem_mod_h
     10  USE lmdz_spla_ini, ONLY: masse_s   !au lieu de USE chem_mod_h
    911  USE chem_spla_mod_h
    1012
    … …  
    27482750      ENDIF
    27492751
    2750       CALL gastoparticle(pdtphys,zdz,zrho,rlat, &
     2752      CALL spla_gastoparticle(klon,klev,nbtr,pdtphys,zdz,zrho,rlat, &
    27512753                   pplay,t_seri,id_prec,id_fine, &
    27522754                   tr_seri,his_g2pgas ,his_g2paer)

  • LMDZ6/trunk/libf/phylmd/Dust/precuremission.f90

    r5505 r5554  
    1818USE lmdz_spla_nightingale, ONLY: spla_nightingale
    1919USE chem_spla_mod_h
    20   USE chem_mod_h
     20USE lmdz_spla_ini, ONLY: masse_s   !au lieu de USE chem_mod_h
    2121  USE dimphy
    2222  USE indice_sol_mod

  • LMDZ6/trunk/libf/phylmd/chem_mod_h.f90

    r5292 r5554  
    11MODULE chem_mod_h
     2
     3! AS 20250220 : masse_s MOVED TO Dust/lmdz_spla_ini.f90
     4!               n_avogadro, masse_so4 REMOVED BECAUSE NOT USED     
     5
    26  IMPLICIT NONE; PRIVATE
    37  PUBLIC idms, iso2, iso4, ih2s, idmso, imsa, ih2o2, &
    4           n_avogadro, masse_s, masse_so4, rho_water, rho_ice
     8          rho_water, rho_ice
    59
    610  INTEGER idms, iso2, iso4, ih2s, idmso, imsa, ih2o2
    … …  
    812  PARAMETER (ih2s = 4, idmso = 5, imsa = 6, ih2o2 = 7)
    913
    10   REAL n_avogadro, masse_s, masse_so4, rho_water, rho_ice
    11   PARAMETER (n_avogadro = 6.02E23)                  !--molec mol-1
    12   PARAMETER (masse_s = 32.0)                        !--g mol-1
    13   PARAMETER (masse_so4 = 96.0)                      !--g mol-1
     14  REAL rho_water, rho_ice
    1415  PARAMETER (rho_water = 1000.0)                    !--kg m-3
    1516  PARAMETER (rho_ice = 500.0)                       !--kg m-3

  • LMDZ6/trunk/libf/phylmd/physiq_mod.F90

    r5518 r5554  
    18841884IF (CPPKEY_DUST) THEN
    18851885       ! Quand on utilise SPLA, on force iflag_phytrac=1
    1886        CALL spla_ini(is_oce,RNAVO)
     1886       CALL spla_ini(is_oce,RNAVO,RG,RD,RCPD,RLVTT,RLSTT,RETV,RTT,              &
     1887               R2ES,R3LES,R3IES,R4LES,R4IES,R5LES,R5IES,RVTMP2)
    18871888       CALL phytracr_spl_out_init()
    18881889       CALL phys_output_write_spl(itap, pdtphys, paprs, pphis,                  &
Note: See TracChangeset for help on using the changeset viewer.