Changeset 2501 for LMDZ5/trunk/libf

Timestamp:

May 3, 2016, 5:09:56 PM (9 years ago)

Author:

oboucher

Message:

Adding a template for tropospheric aerosol LW optical properties
Only works for aerosol_couple = TRUE

Location:

LMDZ5/trunk/libf/phylmd

Files:

• physiq_mod.F90 (modified) (1 diff)
• rrtm/aeropt_lw_rrtm.F90 (modified) (1 diff)

LMDZ5/trunk/libf/phylmd/physiq_mod.F90

@@ -3286 +3286 @@
                 ENDIF
 
-                CALL aeropt_lw_rrtm
+                !--call LW optical properties for tropospheric aerosols 
+                !--only works for INCA aerosol (aerosol_couple = TRUE)
+                CALL aeropt_lw_rrtm(aerosol_couple,paprs,tr_seri)
                 !
 #else

LMDZ5/trunk/libf/phylmd/rrtm/aeropt_lw_rrtm.F90

@@ -1 +1 @@
 !
 ! aeropt_lw_rrtm.F90 2014-05-13 C. Kleinschmitt
+!                    2016-05-03 O. Boucher 
 !
+! This routine feeds aerosol LW properties to RRTM
+! we only consider absorption (not scattering)
 
-SUBROUTINE AEROPT_LW_RRTM
+SUBROUTINE AEROPT_LW_RRTM(aerosol_couple,paprs,tr_seri)
 
+  USE dimphy
+  USE aero_mod
   USE phys_state_var_mod, ONLY : tau_aero_lw_rrtm
 
   IMPLICIT NONE
 
-  tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
+  INCLUDE "YOMCST.h"
+  INCLUDE "clesphys.h"
+  !
+  ! Input arguments:
+  !
+  LOGICAL, INTENT(IN)                      :: aerosol_couple
+  REAL, DIMENSION(klon,klev+1), INTENT(in)  :: paprs
+  !
+  REAL, DIMENSION(klon,klev) :: zdp, mass_temp
+  !
+  INTEGER inu, k
+  INTEGER :: id_ASBCM, id_ASPOMM, id_ASSO4M, id_ASMSAM, id_CSSO4M, id_CSMSAM, id_SSSSM
+  INTEGER :: id_CSSSM, id_ASSSM, id_CIDUSTM, id_AIBCM, id_AIPOMM, id_ASNO3M, id_CSNO3M, id_CINO3M
 
+  !
+  !--absorption coefficient for CIDUST
+  REAL:: alpha_abs_CIDUST_16bands(nbands_lw_rrtm)   !--unit m2/g 
+  DATA alpha_abs_CIDUST_16bands /              & 
+       0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & 
+       0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0  /
+  !
+  IF (NLW.NE.nbands_lw_rrtm) THEN
+     print *,'Erreur NLW doit etre egal a 16 pour cette routine'
+     stop
+  ENDIF
+  ! 
+  IF (aerosol_couple) THEN 
+  ! 
+      do i=1,nbtr
+      select case(trim(solsym(i)))
+         case ("ASBCM")
+            id_ASBCM = i
+         case ("ASPOMM")
+            id_ASPOMM = i
+         case ("ASSO4M")
+            id_ASSO4M = i
+         case ("ASMSAM")
+            id_ASMSAM = i
+         case ("CSSO4M")
+            id_CSSO4M = i
+         case ("CSMSAM")
+            id_CSMSAM = i
+         case ("SSSSM")
+            id_SSSSM = i
+         case ("CSSSM")
+            id_CSSSM = i
+         case ("ASSSM")
+            id_ASSSM = i
+         case ("CIDUSTM")
+            id_CIDUSTM = i
+         case ("AIBCM")
+            id_AIBCM = i
+         case ("AIPOMM")
+            id_AIPOMM = i
+         case ("ASNO3M")
+            id_ASNO3M = i
+         case ("CSNO3M")
+            id_CSNO3M = i
+         case ("CINO3M")
+            id_CINO3M = i
+         end select
+    enddo
+    !
+    DO k=1, klev
+       zdp(:,k) = (paprs(i,k)-paprs(i,k+1))/RG !--kg/m2
+    ENDDO
+    !
+    !--for now only consider dust
+    mass_temp(:,:)=tr_seri(:,:,id_CIDUSTM)  !--kg/kg
+    !
+    DO inu=1,NLW
+      !
+      !--total aerosol
+      tau_aero_lw_rrtm(:,:,2,inu) = mass_temp(:,:)*zdp(:,:)*1000.*alpha_abs_CIDUST_16bands(inu)
+      !--no aerosol at all
+      tau_aero_lw_rrtm(:,:,1,inu) = 0.0
+      !
+    ENDDO
+    !
+    !--avoid very small values
+    tau_aero_lw_rrtm = MAX(tau_aero_lw_rrtm,1.e-15)
+    ! 
+  ELSE !--not aerosol_couple
+    !
+    !--no LW effects if not coupled to INCA
+    tau_aero_lw_rrtm = 1.e-15
+  ENDIF
+  !
 END SUBROUTINE AEROPT_LW_RRTM