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

Timestamp:

Aug 7, 2025, 10:01:38 AM (4 months ago)

Author:

debatzbr

Message:

Pluto PCM: Add correction for aerosol absorption
BBT

File:

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

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

@@ -14 +14 @@
                      igas_CH4, igas_N2
   use comcstfi_mod, only: g, r, mugaz
-  use callkeys_mod, only: kastprof,continuum,graybody,callgasvis
+  use callkeys_mod, only: kastprof,continuum,graybody,callgasvis,callmufi
   use recombin_corrk_mod, only: corrk_recombin, gasv_recomb
   use tpindex_mod, only: tpindex
@@ -100 +100 @@
   real*8 dz(L_LEVELS)
 
+  ! Variables for aerosol absorption
+  real*8 Fabs_aer(NAERKIND)
 
   integer igas, jgas
@@ -137 +139 @@
   lkcoef(:,:)   = 0.0
   DTAUKV(:,:,:) = 0.0
+
+  if(callmufi) then
+   Fabs_aer(1) = 0.7
+   Fabs_aer(2) = 2.5
+  else
+   Fabs_aer(:) = 1.0
+  endif
 
   do K=2,L_LEVELS
@@ -160 +169 @@
 
   ! Spectral dependance of aerosol absorption
-            !JL18 It seems to be good to have aerosols in the first "radiative layer" of the gcm in the IR
+       !JL18 It seems to be good to have aerosols in the first "radiative layer" of the gcm in the IR
             !   but visible does not handle very well diffusion in first layer.
             !   The tauaero and tauray are thus set to 0 (a small value for rayleigh because the code crashes otherwise)
@@ -170 +179 @@
         do K=5,L_LEVELS
            TAEROS(K,NW,IAER) = TAUAERO(K,IAER) * QXVAER(K,NW,IAER)
-        end do                    ! levels
-     end do
-  end do
-
+           ! Aerosol absorption correction --> impact on opacity.
+           if (callmufi .and. (TAEROS(K,NW,IAER).gt.0.d0)) then
+            TAEROS(K,NW,IAER) = TAEROS(K,NW,IAER) * &
+                                ((QSVAER(K,NW,IAER)/QXVAER(K,NW,IAER)) + Fabs_aer(IAER)*(1.-(QSVAER(K,NW,IAER)/QXVAER(K,NW,IAER))))
+           endif
+        end do ! L_LEVELS
+     end do ! L_NSPECTV
+  end do ! naerkind
+  
   ! Rayleigh scattering
   do NW=1,L_NSPECTV
@@ -328 +342 @@
   DO NW=1,L_NSPECTV
      DO L=1,L_NLAYRAD-1
-        K              = 2*L+1
-        atemp(L,NW) = SUM(GVAER(K,NW,1:naerkind) * TAUAEROLK(K,NW,1:naerkind))+SUM(GVAER(K+1,NW,1:naerkind) * TAUAEROLK(K+1,NW,1:naerkind))
-        btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) + SUM(TAUAEROLK(K+1,NW,1:naerkind))
-        ctemp(L,NW) = btemp(L,NW) + 0.9999*(TRAY(K,NW) + TRAY(K+1,NW))  ! JVO 2017 : does this 0.999 is really meaningful ?
-        btemp(L,NW) = btemp(L,NW) + TRAY(K,NW) + TRAY(K+1,NW)
-        COSBV(L,NW,1:L_NGAUSS) = atemp(L,NW)/btemp(L,NW)
+        K = 2*L+1
+             atemp(L,NW) = SUM(GVAER(K,NW,1:naerkind) * TAUAEROLK(K,NW,1:naerkind)) + &
+                      SUM(GVAER(K+1,NW,1:naerkind) * TAUAEROLK(K+1,NW,1:naerkind))
+      ! Aerosol absorption correction --> impact on single scattering albedo.
+      if (callmufi) then
+         if ((TAEROS(K,NW,1).gt.0.d0) .and. TAEROS(K+1,NW,1).gt.0.d0) then
+            btemp(L,NW) = TAUAEROLK(K,NW,1) / &
+                          (QSVAER(K,NW,1)/QXVAER(K,NW,1) + &
+                           Fabs_aer(1)*(1.-QSVAER(K,NW,1)/QXVAER(K,NW,1))) + &
+                          TAUAEROLK(K+1,NW,1) / &
+                          (QSVAER(K+1,NW,1)/QXVAER(K+1,NW,1) + &
+                           Fabs_aer(1)*(1.-QSVAER(K+1,NW,1)/QXVAER(K+1,NW,1)))
+         else
+            btemp(L,NW) = TAUAEROLK(K,NW,1) + TAUAEROLK(K+1,NW,1)
+         endif
+         if ((TAEROS(K,NW,2).gt.0.d0) .and. TAEROS(K+1,NW,2).gt.0.d0) then
+            btemp(L,NW) = btemp(L,NW) + &
+                          (TAUAEROLK(K,NW,2) / &
+                          (QSVAER(K,NW,2)/QXVAER(K,NW,2) + &
+                           Fabs_aer(2)*(1.-QSVAER(K,NW,2)/QXVAER(K,NW,2)))) + &
+                          (TAUAEROLK(K+1,NW,2) / &
+                          (QSVAER(K+1,NW,2)/QXVAER(K+1,NW,2) + &
+                           Fabs_aer(2)*(1.-QSVAER(K+1,NW,2)/QXVAER(K+1,NW,2))))
+         else
+            btemp(L,NW) = btemp(L,NW) + TAUAEROLK(K,NW,2) + TAUAEROLK(K+1,NW,2)
+         endif
+      else
+         btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) + SUM(TAUAEROLK(K+1,NW,1:naerkind))
+      endif ! callmufi
+      ctemp(L,NW) = btemp(L,NW) + 0.9999*(TRAY(K,NW) + TRAY(K+1,NW))  ! JVO 2017 : does this 0.999 is really meaningful ?
+        
+      btemp(L,NW) = btemp(L,NW) + TRAY(K,NW) + TRAY(K+1,NW)
+           COSBV(L,NW,1:L_NGAUSS) = atemp(L,NW)/btemp(L,NW)
      END DO ! L vertical loop
 
      ! Last level
-     L           = L_NLAYRAD
-     K           = 2*L+1
+     !-----------
+     L = L_NLAYRAD
+     K = 2*L+1
      atemp(L,NW) = SUM(GVAER(K,NW,1:naerkind) * TAUAEROLK(K,NW,1:naerkind))
-     btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind))
+     ! Aerosol absorption correction --> impact on single scattering albedo.
+     if (callmufi) then
+      if (TAEROS(K,NW,1).gt.0.d0) then
+         btemp(L,NW) = TAUAEROLK(K,NW,1) / &
+                       (QSVAER(K,NW,1)/QXVAER(K,NW,1) + &
+                        Fabs_aer(1)*(1.-QSVAER(K,NW,1)/QXVAER(K,NW,1)))
+      else
+         btemp(L,NW) = TAUAEROLK(K,NW,1)
+      endif
+      if (TAEROS(K,NW,2).gt.0.d0) then
+         btemp(L,NW) = btemp(L,NW) + &
+                       (TAUAEROLK(K,NW,2) / &
+                       (QSVAER(K,NW,2)/QXVAER(K,NW,2) + &
+                        Fabs_aer(2)*(1.-QSVAER(K,NW,2)/QXVAER(K,NW,2))))
+      else
+         btemp(L,NW) = btemp(L,NW) + TAUAEROLK(K,NW,2)
+      endif
+     else
+      btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind))
+     endif ! callmufi
      ctemp(L,NW) = btemp(L,NW) + 0.9999*TRAY(K,NW) ! JVO 2017 : does this 0.999 is really meaningful ?
+     
      btemp(L,NW) = btemp(L,NW) + TRAY(K,NW)
      COSBV(L,NW,1:L_NGAUSS) = atemp(L,NW)/btemp(L,NW)
-
-
-  END DO                    ! NW spectral loop
+  END DO ! NW spectral loop
 
   DO NG=1,L_NGAUSS