Changeset 3318 for trunk/LMDZ.TITAN/libf/phytitan/optcv.F90

Timestamp:

Apr 26, 2024, 4:27:26 PM (7 months ago)

Author:

slebonnois

Message:

Titan PCM update : optics + microphysics

File:

• trunk/LMDZ.TITAN/libf/phytitan/optcv.F90 (modified) (12 diffs)

trunk/LMDZ.TITAN/libf/phytitan/optcv.F90

@@ -1 +1 @@
 SUBROUTINE OPTCV(PQMO,NLAY,ZLEV,PLEV,TMID,PMID,  &
      DTAUV,TAUV,TAUCUMV,WBARV,COSBV,TAURAY,TAUGSURF,SEASHAZEFACT,&
-     POPT_HAZE,POPT_CLOUDS,CDCOLUMN)
+     DIAG_OPTH,DIAG_OPTT,CDCOLUMN)
 
   use radinc_h
@@ -11 +11 @@
   use callkeys_mod, only: continuum,graybody,callgasvis,corrk_recombin,   &
                           callclouds,callmufi,seashaze,uncoupl_optic_haze,&
-                          opt4clouds,FHVIS, Fssa
+                          opt4clouds,FHVIS,FCVIS
   use tracer_h, only: nmicro,nice,ices_indx
 
@@ -69 +69 @@
   REAL*8, INTENT(OUT) :: WBARV(L_NLAYRAD,L_NSPECTV,L_NGAUSS)
   REAL*8, INTENT(OUT) :: TAUGSURF(L_NSPECTV,L_NGAUSS-1)
-  REAL*8, INTENT(OUT) :: POPT_HAZE(L_LEVELS,L_NSPECTI,3)
-  REAL*8, INTENT(OUT) :: POPT_CLOUDS(L_LEVELS,L_NSPECTI,3)
+  REAL*8, INTENT(OUT) :: DIAG_OPTH(L_LEVELS,L_NSPECTV,6)
+  REAL*8, INTENT(OUT) :: DIAG_OPTT(L_LEVELS,L_NSPECTV,6)
   ! ==========================================================
   
@@ -124 +124 @@
   real*8,save :: rhoaer_s(L_NSPECTV),ssa_s(L_NSPECTV),asf_s(L_NSPECTV)
   real*8,save :: rhoaer_f(L_NSPECTV),ssa_f(L_NSPECTV),asf_f(L_NSPECTV)
-  real*8,save :: ssa_ccn(L_NSPECTI),asf_ccn(L_NSPECTI)
+  real*8,save :: ssa_ccn(L_NSPECTV),asf_ccn(L_NSPECTV)
   real*8,save :: ssa_cld(L_NSPECTV),asf_cld(L_NSPECTV)
 !$OMP THREADPRIVATE(rhoaer_s,rhoaer_f,ssa_s,ssa_f,ssa_cld,asf_s,asf_f,asf_cld)
@@ -191 +191 @@
    end do
   
+   DIAG_OPTH(:,:,:) = 0.D0
+   DIAG_OPTT(:,:,:) = 0.D0
+
    do NW=1,L_NSPECTV
       ! We ignore K=1...
@@ -254 +257 @@
             ENDIF
 
+            ! Tuning of optical properties for haze :
+            !dtauaer_s = dtauaer_s * (FHVIS * (1-ssa_s(nw)) + ssa_s(nw))
+            !ssa_s(nw) = ssa_s(nw) / (FHVIS * (1-ssa_s(nw)) + ssa_s(nw))
+            dtauaer_f = dtauaer_f * (FHVIS * (1-ssa_f(nw)) + ssa_f(nw))
+            ssa_f(nw) = ssa_f(nw) / (FHVIS * (1-ssa_f(nw)) + ssa_f(nw))
+
             ! Total of Haze opacity (dtau), SSA (w) and ASF (COS) :
             DHAZE_T(k,nw) = dtauaer_s + dtauaer_f
@@ -265 +274 @@
                ASF_T(k,nw)   = 1.0
             ENDIF
+
             ! Diagnostics for the haze :
-            POPT_HAZE(k,nw,1) = DHAZE_T(k,nw) ! dtau
-            POPT_HAZE(k,nw,2) = SSA_T(k,nw)   ! wbar
-            POPT_HAZE(k,nw,3) = ASF_T(k,nw)   ! gbar
+            DIAG_OPTH(k,nw,1) = DHAZE_T(k,nw) ! dtau
+            DIAG_OPTH(k,nw,2) = SSA_T(k,nw)   ! wbar
+            DIAG_OPTH(k,nw,3) = ASF_T(k,nw)   ! gbar
 
             !---------------------
@@ -277 +287 @@
                m0ccn = pqmo(ilay,5) / 2.0
                m3ccn = pqmo(ilay,6) / 2.0
-               m3cld = 0.0d0
+               m3cld  = pqmo(ilay,6) / 2.0
                
                ! Clear / Dark column method :
@@ -309 +319 @@
 
                ! For small dropplets, opacity of nucleus dominates
+               dtau_cld = (dtau_cld*m3ccn + dtau_cld*m3cld) / (m3ccn + m3cld)
                ssa_cld(nw) = (ssa_ccn(nw)*m3ccn + ssa_cld(nw)*m3cld) / (m3ccn + m3cld)
-               ssa_cld(nw) = ssa_cld(nw) * Fssa
-
+
+               ! Tuning of optical properties for clouds :
+               dtau_cld = dtau_cld * (FCVIS * (1-ssa_cld(nw)) + ssa_cld(nw))
+               ssa_cld(nw) = ssa_cld(nw) / (FCVIS * (1-ssa_cld(nw)) + ssa_cld(nw))
+               
                ! Total of Haze + Clouds opacity (dtau), SSA (w) and ASF (COS) :
                DHAZE_T(k,nw) = dtauaer_s + dtauaer_f + dtau_cld
@@ -324 +338 @@
                ENDIF
                
-               ! Tuning of optical properties (now useless...) :
-               DHAZE_T(k,nw) = DHAZE_T(k,nw) * (FHVIS * (1-SSA_T(k,nw)) + SSA_T(k,nw))
-               SSA_T(k,nw)   = SSA_T(k,nw) / (FHVIS * (1-SSA_T(k,nw)) + SSA_T(k,nw))
-
                ! Diagnostics for clouds :
-               POPT_CLOUDS(k,nw,1) = DHAZE_T(k,nw) ! dtau
-               POPT_CLOUDS(k,nw,2) = SSA_T(k,nw)   ! wbar
-               POPT_CLOUDS(k,nw,3) = ASF_T(k,nw)   ! gbar
+               DIAG_OPTT(k,nw,1) = DHAZE_T(k,nw) ! dtau
+               DIAG_OPTT(k,nw,2) = SSA_T(k,nw)   ! wbar
+               DIAG_OPTT(k,nw,3) = ASF_T(k,nw)   ! gbar
             
             ELSE
                ! Diagnostics for clouds :
-               POPT_CLOUDS(k,nw,1) = 0.D0 ! dtau
-               POPT_CLOUDS(k,nw,2) = 1.0  ! wbar
-               POPT_CLOUDS(k,nw,3) = 1.0  ! gbar
+               DIAG_OPTT(k,nw,1) = 0.D0 ! dtau
+               DIAG_OPTT(k,nw,2) = 1.0  ! wbar
+               DIAG_OPTT(k,nw,3) = 1.0  ! gbar
             ENDIF 
             
@@ -346 +356 @@
             if (seashaze) DHAZE_T(k,nw) = DHAZE_T(k,nw)*seashazefact(k)
             ! Diagnostics for the haze :
-            POPT_HAZE(k,nw,1) = DHAZE_T(k,nw) ! dtau
-            POPT_HAZE(k,nw,2) = SSA_T(k,nw)   ! wbar
-            POPT_HAZE(k,nw,3) = ASF_T(k,nw)   ! gbar
+            DIAG_OPTH(k,nw,1) = DHAZE_T(k,nw) ! dtau
+            DIAG_OPTH(k,nw,2) = SSA_T(k,nw)   ! wbar
+            DIAG_OPTH(k,nw,3) = ASF_T(k,nw)   ! gbar
             ! Diagnostics for clouds :
-            POPT_CLOUDS(k,nw,1) = 0.D0 ! dtau
-            POPT_CLOUDS(k,nw,2) = 1.0  ! wbar
-            POPT_CLOUDS(k,nw,3) = 1.0  ! gbar
+            DIAG_OPTT(k,nw,1) = 0.D0 ! dtau
+            DIAG_OPTT(k,nw,2) = 1.0  ! wbar
+            DIAG_OPTT(k,nw,3) = 1.0  ! gbar
          ENDIF ! ENDIF callmufi
          
@@ -472 +482 @@
          DTAUKV(K,nw,ng) = DRAYAER + DCONT ! Scattering + parameterized continuum absorption, including Titan's haze
 
-      end do ! k = L_LEVELS
-   end do ! nw = L_NSPECTI
+         DIAG_OPTH(K,nw,4) = DRAYAER
+         DIAG_OPTH(K,nw,5) = TAUGAS
+         DIAG_OPTH(K,nw,6) = DCONT
+         DIAG_OPTT(K,nw,4) = DRAYAER
+         DIAG_OPTT(K,nw,5) = TAUGAS
+         DIAG_OPTT(K,nw,6) = DCONT
+
+      end do ! K = L_LEVELS
+   end do ! nw = L_NSPECTV
 
   !=======================================================================