Changeset 3901


Ignore:
Timestamp:
Aug 20, 2025, 4:25:12 PM (2 days ago)
Author:
emillour
Message:

Mars PCM:
Some code tidying:

  • turn aeroptproperties, albedocaps, cvmgp and convadj into modules
  • remove useless check in callradite
  • clean module vlz_fi (remove obsolete #ifdef CRAY cpp alternatives)
  • remove function cvmgp since it was only called under #ifdef CRAY in vlz_fi

EM

Location:
trunk/LMDZ.MARS
Files:
1 deleted
11 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.MARS/changelog.txt

    r3886 r3901  
    49454945Fix newstart, now that initracer is a module.
    49464946 
     4947== 20/08/2025 == EM
     4948Some code tidying:
     4949- turn aeroptproperties, albedocaps, cvmgp and convadj into modules
     4950- remove useless check in callradite
     4951- clean module vlz_fi (remove obsolete #ifdef CRAY cpp alternatives)
     4952- remove function cvmgp since it was only called under #ifdef CRAY in vlz_fi

  • trunk/LMDZ.MARS/libf/phymars/aeroptproperties.F

    r3726 r3901  
     1      MODULE aeroptproperties_mod
     2     
     3      IMPLICIT NONE
     4     
     5      CONTAINS
     6
    17      SUBROUTINE aeroptproperties(ngrid,nlayer,reffrad,nueffrad,
    28     &                            QVISsQREF3d,omegaVIS3d,gVIS3d,
    … …  
    13451351c==================================================================
    13461352
    1347       RETURN
    1348       END
     1353      END SUBROUTINE aeroptproperties
     1354
     1355      END MODULE aeroptproperties_mod

  • trunk/LMDZ.MARS/libf/phymars/albedocaps.F90

    r3726 r3901  
     1module albedocaps_mod
     2
     3implicit none
     4
     5contains
     6
    17subroutine albedocaps(zls,ngrid,piceco2,piceco2_peren,psolaralb,emisref)
    28
    … …  
    518524end subroutine TES_icecap_albedo
    519525
     526end module albedocaps_mod

  • trunk/LMDZ.MARS/libf/phymars/callradite_mod.F

    r3756 r3901  
    1717      use aeropacity_mod, only: aeropacity
    1818      use updatereffrad_mod, only: updatereffrad
     19      use aeroptproperties_mod, only: aeroptproperties
    1920      use dimradmars_mod, only: ndomainsz, nflev, nsun, nir
    2021      use dimradmars_mod, only: naerkind, name_iaer,
    … …  
    288289c   ---------------------
    289290
    290       real zco2   ! volume fraction of CO2 in Mars atmosphere
    291 !$OMP THREADPRIVATE(zco2)
    292       DATA zco2/0.95/
    293       SAVE zco2
    294 
    295       LOGICAL firstcall
     291      LOGICAL,SAVE :: firstcall = .true.
    296292!$OMP THREADPRIVATE(firstcall)
    297       DATA firstcall/.true./
    298       SAVE firstcall
    299293
    300294
    … …  
    413407         
    414408!         CALL SULW ! this step is now done in ini_yomlw_h
    415 
    416          if (ngrid .EQ. 1) then
    417            if (ndomainsz .NE. 1) then
    418              print*
    419              print*,'ATTENTION !!!'
    420              print*,'pour tourner en 1D, '
    421              print*,'fixer ndomainsz=1 dans phymars/dimradmars_h'
    422              print*
    423              call exit(1)
    424            endif
    425          endif
    426409
    427410         firstcall=.false.

  • trunk/LMDZ.MARS/libf/phymars/co2condens_mod.F

    r3739 r3901  
    4040      use callkeys_mod, only: caps, co2clouds
    4141      use co2snow_mod, only: co2snow
     42      use albedocaps_mod, only: albedocaps
    4243
    4344       IMPLICIT NONE

  • trunk/LMDZ.MARS/libf/phymars/convadj.F

    r3726 r3901  
     1      module convadj_mod
     2     
     3      implicit none
     4     
     5      contains
     6     
    17      subroutine convadj(ngrid,nlay,nq,ptimestep,
    28     &                   pplay,pplev,ppopsk,lmax_th,
    … …  
    381387     &                             -zq(1:ngrid,1:nlay,1:nq))/ptimestep
    382388
    383       end
     389      end subroutine convadj
    384390     
     391      end module convadj_mod

  • trunk/LMDZ.MARS/libf/phymars/cvmgt.F

    r38 r3901  
    1       FUNCTION cvmgt(x1,x2,l)
     1      MODULE cvmgt_mod
     2     
     3      IMPLICIT NONE
     4     
     5      CONTAINS
     6     
     7      REAL FUNCTION cvmgt(x1,x2,l)
     8      ! function which returns x1 if l == .true. , x2 otherwise
    29      IMPLICIT NONE
    310
    4       REAL x1,x2,cvmgt
    5       LOGICAL l
     11      REAL,INTENT(IN) :: x1,x2
     12      LOGICAL,INTENT(IN) :: l
    613
    714      IF(l) then
    … …  
    1118      ENDIF
    1219
    13       RETURN
    14       END
     20      END FUNCTION cvmgt
    1521C
     22      END MODULE cvmgt_mod

  • trunk/LMDZ.MARS/libf/phymars/physiq_mod.F

    r3855 r3901  
    2020      use co2cloud_mod, only: co2cloud
    2121      use callradite_mod, only: callradite
     22      use convadj_mod, only: convadj
    2223      use callsedim_mod, only: callsedim
    2324      use rocketduststorm_mod, only: rocketduststorm, dustliftday

  • trunk/LMDZ.MARS/libf/phymars/swr_fouquart.F

    r3759 r3901  
    1515      use callkeys_mod, only: rayleigh
    1616      use swrayleigh_mod, only: swrayleigh
     17      use cvmgt_mod, only: cvmgt
    1718
    1819      IMPLICIT NONE
    … …  
    112113     S     ,  ZTRA1(NDLON,NFLEV+1), ZTRA2(NDLON,NFLEV+1)
    113114
    114 c     Function
    115 c     --------
    116       real CVMGT
    117 
    118115C    --------------------------------
    119116C     OPTICAL PARAMETERS FOR AEROSOLS
    … …  
    138135            ZTAUAZ(JL,JK) = 0.
    139136         END DO
    140          DO 106 JAE=1,naerkind
    141             DO 105 JL = 1 , KDLON
     137         DO JAE=1,naerkind
     138            DO JL = 1 , KDLON
    142139c              Mean Extinction optical depth in the spectral band
    143140c              ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    … …  
    154151     S           QVISsQREF3d(JL,JK,KNU,JAE)*
    155152     &           omegaVIS3d(JL,JK,KNU,JAE)*gVIS3d(JL,JK,KNU,JAE)
    156  105        CONTINUE
    157  106     CONTINUE
     153            ENDDO
     154         ENDDO
    158155      END DO
    159156C     
    160157      DO JK = 1 , nlaylte
    161158         DO JL = 1 , KDLON
     159           ! NB: function CVMGT(x1,x2,l) returns x1 if l==.true.
     160           !     or x2 otherwise. Maybe worth inlining someday?
    162161            ZCGAZ(JL,JK) = CVMGT( 0., ZCGAZ(JL,JK) / ZPIZAZ(JL,JK),
    163162     S            (ZPIZAZ(JL,JK).EQ.0) )

  • trunk/LMDZ.MARS/libf/phymars/swr_toon.F

    r3740 r3901  
    1515      use callkeys_mod, only: rayleigh
    1616      use swrayleigh_mod, only: swrayleigh
     17      use cvmgt_mod, only: cvmgt
    1718     
    1819      IMPLICIT NONE
    … …  
    7576C     ARGUMENTS
    7677C     ---------
    77       INTEGER KDLON, KFLEV, KNU
    78       REAL aerosol(NDLO2,KFLEV,naerkind), albedo(NDLO2,2),
    79      S    PDSIG(NDLO2,KFLEV),PSEC(NDLO2)
    80 
    81       REAL QVISsQREF3d(NDLO2,KFLEV,nsun,naerkind) 
    82       REAL omegaVIS3d(NDLO2,KFLEV,nsun,naerkind)   
    83       REAL gVIS3d(NDLO2,KFLEV,nsun,naerkind)
    84 
    85       REAL PPSOL(NDLO2)
    86       REAL PFD(NDLO2,KFLEV+1),PFU(NDLO2,KFLEV+1)
    87       REAL PRMU(NDLO2)
     78      INTEGER,INTENT(IN) :: KDLON, KFLEV, KNU
     79      REAL,INTENT(IN) :: aerosol(NDLO2,KFLEV,naerkind), albedo(NDLO2,2)
     80      REAL,INTENT(IN) :: PDSIG(NDLO2,KFLEV),PSEC(NDLO2)
     81
     82      REAL,INTENT(IN) :: QVISsQREF3d(NDLO2,KFLEV,nsun,naerkind) 
     83      REAL,INTENT(IN) :: omegaVIS3d(NDLO2,KFLEV,nsun,naerkind)   
     84      REAL,INTENT(IN) :: gVIS3d(NDLO2,KFLEV,nsun,naerkind)
     85
     86      REAL,INTENT(IN) :: PPSOL(NDLO2)
     87      REAL,INTENT(OUT) :: PFD(NDLO2,KFLEV+1),PFU(NDLO2,KFLEV+1)
     88      REAL,INTENT(IN) :: PRMU(NDLO2)
    8889
    8990C     LOCAL ARRAYS
    … …  
    104105c     End part added by Tran The Trung
    105106
    106 c     Function
    107 c     --------
    108       real CVMGT
    109 
    110107c Computing TOTAL single scattering parameters by adding
    111108c  properties of all the NAERKIND kind of aerosols
    … …  
    117114            ZTAUAZ(JL,JK) = 0.
    118115         END DO
    119          DO 106 JAE=1,naerkind
    120             DO 105 JL = 1 , KDLON
     116         DO JAE=1,naerkind
     117            DO JL = 1 , KDLON
    121118c              Mean Extinction optical depth in the spectral band
    122119c              ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    … …  
    133130     S           QVISsQREF3d(JL,JK,KNU,JAE)*
    134131     &           omegaVIS3d(JL,JK,KNU,JAE)*gVIS3d(JL,JK,KNU,JAE)
    135  105        CONTINUE
    136  106     CONTINUE
     132            ENDDO
     133         ENDDO
    137134      END DO
    138135C     
    139136      DO JK = 1 , nlaylte
    140137         DO JL = 1 , KDLON
     138           ! NB: function CVMGT(x1,x2,l) returns x1 if l==.true.
     139           !     or x2 otherwise. Maybe worth inlining someday?
    141140            ZCGAZ(JL,JK) = CVMGT( 0., ZCGAZ(JL,JK) / ZPIZAZ(JL,JK),
    142141     S            (ZPIZAZ(JL,JK).EQ.0) )

  • trunk/LMDZ.MARS/libf/phymars/vlz_fi.F

    r3727 r3901  
    1010c
    1111c    ********************************************************************
    12 c     Shema  d'advection " pseudo amont " dans la verticale
    13 c    pour appel dans la physique (sedimentation)
     12c    "pseudo upstream" Advection scheme along the vertical
     13c    to be used in the physics (sedimentation)
    1414c    ********************************************************************
    15 c    q rapport de melange (kg/kg)...
    16 c    masse : masse de la couche Dp/g
    17 c    w : masse d'atm ``transferee'' a chaque pas de temps (kg.m-2)
    18 c    pente_max = 2 conseillee
    19 c
    20 c
    21 c   --------------------------------------------------------------------
     15
    2216      IMPLICIT NONE
    2317c
    … …  
    2923      integer,intent(in) :: ngrid ! number of atmospheric columns
    3024      integer,intent(in) :: nlay ! number of atmospheric layers
    31       real masse(ngrid,nlay),pente_max
    32       REAL q(ngrid,nlay)
    33       REAL w(ngrid,nlay)
    34       REAL wq(ngrid,nlay+1)
     25      real,intent(in) :: masse(ngrid,nlay) ! mass of atmospheric layer delta(P)/g
     26      real,intent(in) :: pente_max ! maximum slope for the scheme (2 is recommended)
     27      real,intent(inout) :: q(ngrid,nlay) ! tracer mixing ratio (kg/kg)
     28      real,intent(inout) :: w(ngrid,nlay) ! mass of atmosphere "transfered" over the time step (kg.m-2)
     29      real,intent(out) :: wq(ngrid,nlay+1) ! trancer increment due to advection (kg)
    3530c
    3631c      Local
    … …  
    4540      integer m
    4641
    47       REAL      SSUM,CVMGP,CVMGT
    48       integer ismax,ismin
    4942
    50 
    51 c    On oriente tout dans le sens de la pression c'est a dire dans le
    52 c    sens de W
     43c    Orientation follows pressure, i.e. follows W
    5344
    5445      do l=2,nlay
    … …  
    6152      do l=2,nlay-1
    6253         do ij=1,ngrid
    63 #ifdef CRAY
    64             dzq(ij,l)=0.5*
    65      ,      cvmgp(dzqw(ij,l)+dzqw(ij,l+1),0.,dzqw(ij,l)*dzqw(ij,l+1))
    66 #else
    6754            if(dzqw(ij,l)*dzqw(ij,l+1).gt.0.) then
    6855                dzq(ij,l)=0.5*(dzqw(ij,l)+dzqw(ij,l+1))
    … …  
    7057                dzq(ij,l)=0.
    7158            endif
    72 #endif
     59
    7360            dzqmax=pente_max*min(adzqw(ij,l),adzqw(ij,l+1))
    7461            dzq(ij,l)=sign(min(abs(dzq(ij,l)),dzqmax),dzq(ij,l))
    … …  
    8168      enddo
    8269c ---------------------------------------------------------------
    83 c   .... calcul des termes d'advection verticale  .......
     70c   .... compute vertical advection terms   .......
    8471c ---------------------------------------------------------------
    8572
    86 c calcul de  - d( q   * w )/ d(sigma)    qu'on ajoute a  dq pour calculer dq
     73c compute  - d( q   * w )/ d(sigma) , later added to dq to compute dq
    8774c
    8875c      No flux at the model top:
Note: See TracChangeset for help on using the changeset viewer.