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

Timestamp:

Jan 24, 2018, 10:24:24 PM (7 years ago)

Author:

jvatant

Message:

Making Titan's hazy again - part II
+ Major updates of J.Burgalat YAMMS library and optical coupling, including :
++ Added the routines for haze optics inside YAMMS
++ Calling rad. transf. with interactive haze is plugged
in but should stay unactive as long as the microphysics is
in test phase : cf "uncoupl_optic_haze" flag : true for now !
++ Also some sanity checks for negative tendencies and
some others upkeep of YAMMS model
+ Also added a temporary CPP key USE_QTEST in physiq_mod
that enables to have microphysical tendencies separated
from dynamics for debugging and test phases
-- JVO and JB

File:

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

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

@@ -1 @@
-SUBROUTINE OPTCV(PQ,PLEV,TMID,PMID,  &
+SUBROUTINE OPTCV(PQO,NLAY,PLEV,TMID,PMID,  &
      DTAUV,TAUV,TAUCUMV,WBARV,COSBV,TAURAY,TAUGSURF)
 
@@ -6 +6 @@
   use gases_h
   use comcstfi_mod, only: g, r
-  use callkeys_mod, only: continuum,graybody,callgasvis
+  use callkeys_mod, only: continuum,graybody,callgasvis,callclouds,callmufi,uncoupl_optic_haze
+  use tracer_h, only: nmicro,nice
+  use MMP_OPTICS
 
   implicit none
@@ -41 +43 @@
   ! Input/Output
   !==========================================================
-  REAL*8, INTENT(IN)  :: PQ ! Tracers (kg/kg_of_air).
+  REAL*8, INTENT(IN)  :: PQO(nlay,nmicro) ! Tracers (X/m2).
+  INTEGER, INTENT(IN) :: NLAY             ! Number of pressure layers (for pqo)
   REAL*8, INTENT(IN)  :: PLEV(L_LEVELS)
   REAL*8, INTENT(IN)  :: TMID(L_LEVELS), PMID(L_LEVELS)
@@ -97 +100 @@
   integer interm
 
+  real*8 m0as,m3as,m0af,m3af
+  real*8 ext_s,sca_s,ssa_s,asf_s
+  real*8 ext_f,sca_f,ssa_f,asf_f
+  logical,save :: firstcall=.true.
+  !$OMP THREADPRIVATE(firstcall)
+
+
   !! AS: to save time in computing continuum (see bilinearbig)
   IF (.not.ALLOCATED(indv)) THEN
@@ -149 +159 @@
 
      do NW=1,L_NSPECTV
-
-        !================= Titan customisation ========================================
-        call disr_haze(dz(k),plev(k),wnov(nw),dhaze_T(k,nw),SSA_T(k,nw),ASF_T(k,nw))
-        ! =============================================================================
+     
+        ! Optical coupling of YAMMS is plugged but inactivated (if false) for now
+        ! as long as the microphysics only isn't fully debugged -- JVO 01/18
+        IF (callmufi .AND. (.NOT. uncoupl_optic_haze)) THEN
+          m0as = pqo(ilay,1)
+          m3as = pqo(ilay,2)
+          m0af = pqo(ilay,3)
+          m3af = pqo(ilay,4)
+
+          IF (.NOT.mmp_sph_optics_vis(m0as,m3as,nw,ext_s,sca_s,ssa_s,asf_s)) &
+          CALL abort_gcm("optcv", "Fatal error in mmp_sph_optics_vis", 12)
+          IF (.NOT.mmp_fra_optics_vis(m0af,m3af,nw,ext_f,sca_f,ssa_f,asf_f)) &
+          CALL abort_gcm("optcv", "Fatal error in mmp_fra_optics_vis", 12)
+          dhaze_T(k,nw) = ext_s+ext_f
+          SSA_T(k,nw)   = (sca_s+sca_f)/dhaze_T(k,nw)
+          ASF_T(k,nw)   = (asf_s*sca_s + asf_f*sca_f) /(sca_s+sca_f)
+          IF (callclouds.and.firstcall) & 
+            WRITE(*,*) 'WARNING: In optcv, optical properties &
+                       &calculations are not implemented yet'
+        ELSE
+          ! Call fixed vertical haze profile of extinction - same for all columns
+          call disr_haze(dz(k),plev(k),wnov(nw),dhaze_T(k,nw),SSA_T(k,nw),ASF_T(k,nw))
+        ENDIF
          
         DRAYAER = TRAY(K,NW)
@@ -355 +384 @@
 ! ==============================================================================  
 
+  if(firstcall) firstcall = .false.
 
   return