Changeset 3959 for trunk/LMDZ.PLUTO/libf/phypluto/optcv.F90

Timestamp:

Nov 12, 2025, 6:12:16 PM (5 weeks ago)

Author:

debatzbr

Message:

Pluto PCM: Take clouds into account in radiative transfer.
BBT

File:

• trunk/LMDZ.PLUTO/libf/phypluto/optcv.F90 (modified) (6 diffs)

trunk/LMDZ.PLUTO/libf/phypluto/optcv.F90

@@ -15 +15 @@
                      igas_CH4, igas_N2
   use comcstfi_mod, only: g, r, mugaz
-  use callkeys_mod, only: kastprof,continuum,graybody,callgasvis,callmufi,Fabs_aers_VI,Fabs_aerf_VI
+  use callkeys_mod, only: kastprof,continuum,graybody,callgasvis,callmufi,callmuclouds, &
+                          Fabs_aers_VI,Fabs_aerf_VI,Fabs_cldd_VI
   use recombin_corrk_mod, only: corrk_recombin, gasv_recomb
   use tpindex_mod, only: tpindex
@@ -146 +147 @@
   wbarv_aer(:,:,:) = 1.0
 
-  if(callmufi) then
+  if (callmufi) then
    Fabs_aer(1) = Fabs_aers_VI
    Fabs_aer(2) = Fabs_aerf_VI
+   if (callmuclouds) then
+      Fabs_aer(3) = Fabs_cldd_VI
+   endif
   else
    Fabs_aer(:) = 1.0
@@ -185 +189 @@
         do K=5,L_LEVELS
            TAEROS(K,NW,IAER) = TAUAERO(K,IAER) * QXVAER(K,NW,IAER)
-           ! Aerosol absorption correction --> impact on opacity.
+           ! Aerosol/Cloud absorption correction --> impact on opacity.
            if (callmufi .and. (TAEROS(K,NW,IAER).gt.0.d0)) then
             TAEROS(K,NW,IAER) = TAEROS(K,NW,IAER) * &
@@ -376 +380 @@
             btemp(L,NW) = btemp(L,NW) + TAUAEROLK(K,NW,2) + TAUAEROLK(K+1,NW,2)
          endif
+
+         ! Cloud absorption correction --> impact on single scattering albedo.
+         if (callmuclouds) then
+            if ((TAEROS(K,NW,3).gt.0.d0) .and. TAEROS(K+1,NW,3).gt.0.d0) then
+               btemp(L,NW) = btemp(L,NW) + &
+                           (TAUAEROLK(K,NW,3) / &
+                           (QSVAER(K,NW,3)/QXVAER(K,NW,3) + &
+                              Fabs_aer(3)*(1.-QSVAER(K,NW,3)/QXVAER(K,NW,3)))) + &
+                           (TAUAEROLK(K+1,NW,3) / &
+                           (QSVAER(K+1,NW,3)/QXVAER(K+1,NW,3) + &
+                              Fabs_aer(3)*(1.-QSVAER(K+1,NW,3)/QXVAER(K+1,NW,3))))
+            else
+               btemp(L,NW) = btemp(L,NW) + TAUAEROLK(K,NW,3) + TAUAEROLK(K+1,NW,3)
+            endif
+         endif ! end callmuclouds
       else
          btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) + SUM(TAUAEROLK(K+1,NW,1:naerkind))
@@ -409 +428 @@
          btemp(L,NW) = btemp(L,NW) + TAUAEROLK(K,NW,2)
       endif
+      ! Cloud absorption correction --> impact on single scattering albedo.
+      if (callmuclouds) then
+         if (TAEROS(K,NW,3).gt.0.d0) then
+            btemp(L,NW) = btemp(L,NW) + &
+                          (TAUAEROLK(K,NW,3) / &
+                          (QSVAER(K,NW,3)/QXVAER(K,NW,3) + &
+                           Fabs_aer(3)*(1.-QSVAER(K,NW,3)/QXVAER(K,NW,3))))
+         else
+            btemp(L,NW) = btemp(L,NW) + TAUAEROLK(K,NW,3)
+         endif
+      endif ! end callmuclouds
      else
       btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind))
@@ -421 +451 @@
     DO NW=1,L_NSPECTV
      DO L=1,L_NLAYRAD-1
-
         K              = 2*L+1
         DTAUV(L,nw,ng) = DTAUKV(K,NW,NG) + DTAUKV(K+1,NW,NG)
         WBARV(L,nw,ng) = ctemp(L,NW) / DTAUV(L,nw,ng)
-
       END DO ! L vertical loop
 
-        ! Last level
-
-        L              = L_NLAYRAD
-        K              = 2*L+1
-        DTAUV(L,nw,ng) = DTAUKV(K,NW,NG)
-
-        WBARV(L,NW,NG) = ctemp(L,NW) / DTAUV(L,NW,NG)
-
-     END DO                 ! NW spectral loop
-  END DO                    ! NG Gauss loop
+      ! Last level
+      !-----------
+      L = L_NLAYRAD
+      K = 2*L+1
+           
+      DTAUV(L,nw,ng) = DTAUKV(K,NW,NG)
+      WBARV(L,NW,NG) = ctemp(L,NW) / DTAUV(L,NW,NG)
+     END DO ! NW spectral loop
+  END DO ! NG Gauss loop
 
   ! Aerosols extinction optical depths