Changeset 3936 for trunk/LMDZ.PLUTO/libf


Ignore:
Timestamp:
Oct 25, 2025, 3:21:13 PM (7 weeks ago)
Author:
tbertrand
Message:

PLUTO PCM : correcting a bug in hazecloud (wrong lyman alpha fluxes due to mu0 being negative during nighttime) + cleaning routines
TB

Location:
trunk/LMDZ.PLUTO/libf/phypluto
Files:
1 deleted
7 edited
1 moved

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.PLUTO/libf/phypluto/hazecloud.F90

    r3934 r3936  
    164164         flym_ipm(1)=flym_ipm(1)*pfluxuv/5.
    165165      ELSE IF (.not.diurnal) THEN
    166          mu_sol(:) = mu0(:)
     166         mu_sol(:) = max(mu0(:),0.)
    167167         mu_ipm(:) = max(mu_sol(:), 0.5)
    168          flym_ipm(:)= mu0(:)*72.5e10
     168         flym_ipm(:)= mu_sol(:)*72.5e10
    169169      ELSE ! case with full fit to Gladstone et al. results
    170170!     1)  get longitude/latitude (in radian) of anti-subsolar point (max de mu0 - 180)
    … …  
    182182        DO ig=1,ngrid
    183183        ! calculation of cosinus of incident angle for IPM flux
    184           mu_sol(ig) = mu0(ig)
     184          mu_sol(ig) = max(mu0(ig),0.)
    185185          mu_ipm(ig) = max(mu_sol(ig), 0.5)
    186           IF (mu0(ig).LT.1.e-4) THEN ! Daytime
     186          IF (mu_sol(ig).LE.0.) THEN ! Nighttime
    187187           ! Distance to subsolar point
    188188           dist=acos(sin(latitude(ig))*sin(latit)+cos(latitude(ig))*    &
    … …  
    191191           flym_ipm(ig)=(valmin_dl-valmin)/(90.**puis)*(dist)**puis  &
    192192                                +valmin
    193           ELSE ! Nightime
    194            flym_ipm(ig)= mu0(ig)*(valmax-valmin_dl)+valmin_dl
     193          ELSE ! Daytime
     194           flym_ipm(ig)= mu_sol(ig)*(valmax-valmin_dl)+valmin_dl
    195195          ENDIF
    196196          ! Proportional to lyman alpha solar flux (reference 2015 : 5e11 ph/cm2/s) ?

  • trunk/LMDZ.PLUTO/libf/phypluto/initracer.F90

    r3585 r3936  
    4343!  rho_q(nq)       ! tracer densities (kg.m-3)
    4444!  qext(nq)        ! Single Scat. Extinction coeff at 0.67 um
    45 !  alpha_lift(nq)  ! saltation vertical flux/horiz flux ratio (m-1)
    46 !  alpha_devil(nq) ! lifting coeeficient by dust devil
    4745!  rho_dust          ! Mars dust density
    4846!  rho_ice           ! Water ice density
    … …  
    110108       IF (.NOT.ALLOCATED(rho_q))          ALLOCATE(rho_q(nq))
    111109       IF (.NOT.ALLOCATED(qext))           ALLOCATE(qext(nq))
    112        IF (.NOT.ALLOCATED(alpha_lift))     ALLOCATE(alpha_lift(nq))
    113        IF (.NOT.ALLOCATED(alpha_devil))    ALLOCATE(alpha_devil(nq))
    114110       IF (.NOT.ALLOCATED(qextrhor))       ALLOCATE(qextrhor(nq))
    115111      !  IF (.NOT.ALLOCATED(igcm_dustbin))   ALLOCATE(igcm_dustbin(nq))
    116        IF (.NOT.ALLOCATED(is_chim))        ALLOCATE(is_chim(nqtot))
    117112       IF (.NOT.ALLOCATED(is_rad))         ALLOCATE(is_rad(nqtot))
    118113       IF (.NOT.ALLOCATED(is_recomb))      ALLOCATE(is_recomb(nqtot))
    … …  
    125120
    126121       !! initialization
    127        alpha_lift(:)     = 0.
    128        alpha_devil(:)    = 0.
    129122       mmol(:)           = 0.
    130123       aki(:)            = 0.
    131124       cpi(:)            = 0.
    132        is_chim(:)        = 0
    133125       is_rad(:)         = 0
    134126       is_recomb(:)      = 0
    … …  
    383375
    384376      if (is_master) close(407)
    385 
    386       ! Calculate number of species in the chemistry
    387       nesp = sum(is_chim)
    388       write(*,*) 'Number of species in the chemistry nesp = ',nesp
    389377
    390378      ! Calculate number of microphysical tracer
    … …  
    451439      write(*,*)
    452440      Write(*,*) '******** initracer : dust transport parameters :'
    453       write(*,*) 'alpha_lift = ', alpha_lift
    454       write(*,*) 'alpha_devil = ', alpha_devil
    455441      write(*,*) 'radius  = ', radius
    456442      write(*,*) 'Qext  = ', qext
    … …  
    504490                  cpi(iq)
    505491          end if
    506           ! option is_chim
    507           if (index(tracline,'is_chim='   ) /= 0) then
    508           read(tracline(index(tracline,'is_chim=')+len('is_chim='):),*) &
    509                   is_chim(iq)
    510               write(*,*) ' Parameter value (traceur.def) : is_chim=', &
    511                   is_chim(iq)
    512           else
    513               write(*,*) ' Parameter value (default)     : is_chim=', &
    514                   is_chim(iq)
    515           end if
    516492          ! option is_rad
    517493          if (index(tracline,'is_rad=') /= 0) then

  • trunk/LMDZ.PLUTO/libf/phypluto/physiq_mod.F90

    r3935 r3936  
    3333                          igcm_n2,igcm_ch4_gas,igcm_ch4_ice,igcm_haze,&
    3434                          igcm_co_gas,igcm_co_ice,igcm_prec_haze,lw_n2,lw_ch4,lw_co,&
    35                           alpha_lift, alpha_devil, qextrhor, &
    36                           nesp, is_chim
     35                          qextrhor
    3736      use time_phylmdz_mod, only: diagfi_output_rate, startfi_output_rate, nday
    3837      use phyetat0_mod, only: phyetat0
    … …  
    535534         zdtsw(:,:) = 0.0
    536535         zdtlw(:,:) = 0.0
    537          zdqc(:,:,:)=0.
    538          zdqsc(:,:)=0.
    539536
    540537!        Initialize tracer names, indexes and properties.
    … …  
    14471444         endif
    14481445
     1446         zdqc(:,:,:)=0.0
     1447         zdqsc(:,:)=0.0
     1448
    14491449         call condense_n2(ngrid,nlayer,nq,ptimestep,                    &
    14501450                           capcal,pplay,pplev,tsurf,pt,                 &
    … …  
    22762276         call write_output("ASR","absorbed stellar rad.","W m-2",fluxabs_sw)
    22772277         call write_output("ISR","incoming stellar rad.","W m-2",fluxtop_dn)
     2278         call write_output("mu0","cos zenith anlge","",mu0)
    22782279         call write_output("OLR","outgoing longwave rad.","W m-2",fluxtop_lw)
    22792280         call write_output("GND","heat flux from ground","W m-2",fluxgrd)

  • trunk/LMDZ.PLUTO/libf/phypluto/stelang.F

    r3184 r3936  
    8585c----- AF24: replaced flat param by 0
    8686
    87       rap = 1./((1.-0)**2)
     87c      rap = 1./((1.-0)**2)
    8888
    8989 100  CONTINUE
    … …  
    9898C
    9999      DO jl=1,kgrid
    100         ztim1=psilat(jl)*ptim1*rap
     100        ztim1=psilat(jl)*ptim1 !*rap
    101101        ztim2=pcolat(jl)*ptim2
    102102        ztim3=pcolat(jl)*ptim3
    103103        pmu0(jl)=ztim1+ztim2*pcolon(jl)+ztim3*psilon(jl)
    104         pmu0(jl)=pmu0(jl)/SQRT(pcolat(jl)**2+(rap**2)*(psilat(jl)**2))
     104c       pmu0(jl)=pmu0(jl)/SQRT(pcolat(jl)**2+(rap**2)*(psilat(jl)**2))
    105105
    106106      ENDDO
    … …  
    112112        IF (pmu0(jl).gt.0.) THEN
    113113          pfract(jl)=1.
    114 c       pmu0(jl)=sqrt(1224.*pmu0(jl)*pmu0(jl)+1.)/35.
    115       ELSE
    116 c       pmu0(jl)=0.
    117         pfract(jl)=0.
     114c          pmu0(jl)=sqrt(1224.*pmu0(jl)*pmu0(jl)+1.)/35.
     115        ELSE
     116c          pmu0(jl)=0.
     117          pfract(jl)=0.
    118118        ENDIF
    119119      ENDDO

  • trunk/LMDZ.PLUTO/libf/phypluto/tabfi_mod.F90

    r3772 r3936  
    153153        dtemisice(:)=0 !time scale for snow metamorphism
    154154        volcapa=1000000 ! volumetric heat capacity of subsurface
     155        tpal=0.
     156        adjust=0.
    155157
    156158      ELSE

  • trunk/LMDZ.PLUTO/libf/phypluto/testconserv.F90

    r3627 r3936  
    1212!     Purpose
    1313!     -------
    14 !     Test conservation of tracers
     14!     Test conservation of gas trace tracers (CO and CH4 for now)
    1515! 
    1616!     Inputs
    … …  
    9696         enddo
    9797
    98          iq     = igcm1
    99          dWtots = dWtots + zdqs(ig,iq)*ptimestep*cell_area(ig)
    100          Wtots = Wtots + pqcs(ig,iq)*cell_area(ig)
    101          ncons(ig)=ncons(ig)+zdqs(ig,iq)
    102 
    10398         IF ((igcm2.eq.igcm_co_ice).or.(igcm2.eq.igcm_ch4_ice)) THEN
    10499              iq     = igcm2

  • trunk/LMDZ.PLUTO/libf/phypluto/tracer_h.F90

    r3585 r3936  
    1212
    1313       integer, save :: nqtot  ! total number of tracers
    14        integer, save :: nesp   ! number of species in the chemistry
    15 !$OMP THREADPRIVATE(nqtot,nesp)
     14!$OMP THREADPRIVATE(nqtot)
    1615
    1716       logical :: moderntracdef=.false. ! Standard or modern traceur.def
    … …  
    2524       real, save, allocatable :: rho_q(:)       ! tracer densities (kg.m-3)
    2625       real, save, allocatable :: qext(:)        ! Single Scat. Extinction coeff at 0.67 um
    27        real, save, allocatable :: alpha_lift(:)  ! saltation vertical flux/horiz flux ratio (m-1)
    28        real, save, allocatable :: alpha_devil(:) ! lifting coeeficient by dust devil
    2926       real, save, allocatable :: qextrhor(:)    ! Intermediate for computing opt. depth from q
    3027
    … …  
    4138       integer,save :: nmono
    4239       real,save :: ref_r0        ! for computing reff=ref_r0*r0 (in log.n. distribution)
    43 !$OMP THREADPRIVATE(noms,mmol,aki,cpi,radius,rho_q,qext,alpha_lift,alpha_devil,qextrhor, &
     40!$OMP THREADPRIVATE(noms,mmol,aki,cpi,radius,rho_q,qext,qextrhor, &
    4441        !$OMP varian,r3n_q,rho_dust,rho_ice,rho_n2,lw_n2,ref_r0)
    4542
    46        integer, save, allocatable :: is_chim(:) ! 1 if tracer used in chemistry, else 0
    4743       integer, save, allocatable :: is_rad(:)  ! 1 if   ""    ""  in radiative transfer, else 0
    48 !$OMP THREADPRIVATE(is_chim,is_rad)
     44!$OMP THREADPRIVATE(is_rad)
    4945
    5046       integer, save, allocatable :: is_recomb(:)      ! 1 if tracer used in recombining scheme, else 0 (if 1, must have is_rad=1)
Note: See TracChangeset for help on using the changeset viewer.