Changeset 1715 for trunk/LMDZ.GENERIC/libf/phystd/optci.F90

Timestamp:

Jun 8, 2017, 1:03:06 AM (7 years ago)

Author:

jvatant

Message:

Cleaning of the radiative code + coherence between optci and optcv :

+ Get rid of the actually dummy and confusing extra level L_LEVELS+1 for aerosols
+ Harmonisation between optci and optcv
+ Get rid of tauref (called nowhere) and csqtly of ini_radcommon subroutine

JVO

File:

• trunk/LMDZ.GENERIC/libf/phystd/optci.F90 (modified) (12 diffs)

trunk/LMDZ.GENERIC/libf/phystd/optci.F90

@@ -32 +32 @@
 
   real*8 DTAUI(L_NLAYRAD,L_NSPECTI,L_NGAUSS)
-  real*8 DTAUKI(L_LEVELS+1,L_NSPECTI,L_NGAUSS)
+  real*8 DTAUKI(L_LEVELS,L_NSPECTI,L_NGAUSS)
   real*8 TAUI(L_NLEVRAD,L_NSPECTI,L_NGAUSS)
   real*8 TAUCUMI(L_LEVELS,L_NSPECTI,L_NGAUSS)
@@ -42 +42 @@
 
   ! for aerosols
-  real*8  QXIAER(L_LEVELS+1,L_NSPECTI,NAERKIND)
-  real*8  QSIAER(L_LEVELS+1,L_NSPECTI,NAERKIND)
-  real*8  GIAER(L_LEVELS+1,L_NSPECTI,NAERKIND)
-  real*8  TAUAERO(L_LEVELS+1,NAERKIND)
-  real*8  TAUAEROLK(L_LEVELS+1,L_NSPECTI,NAERKIND)
+  real*8  QXIAER(L_LEVELS,L_NSPECTI,NAERKIND)
+  real*8  QSIAER(L_LEVELS,L_NSPECTI,NAERKIND)
+  real*8  GIAER(L_LEVELS,L_NSPECTI,NAERKIND)
+  real*8  TAUAERO(L_LEVELS,NAERKIND)
+  real*8  TAUAEROLK(L_LEVELS,L_NSPECTI,NAERKIND)
   real*8  TAEROS(L_LEVELS,L_NSPECTI,NAERKIND)
 
@@ -135 +135 @@
   end do                    ! levels
 
-
+  ! Spectral dependance of aerosol absorption
   do iaer=1,naerkind
      DO NW=1,L_NSPECTI
@@ -147 +147 @@
 
      do K=2,L_LEVELS
-
-! continuum absorption
-        DCONT = 0.0d0 
+     
+        DAERO=SUM(TAEROS(K,NW,1:naerkind)) ! aerosol absorption
+
+        DCONT = 0.0d0 ! continuum absorption
 
         if(continuum.and.(.not.graybody))then
@@ -225 +226 @@
         endif
 
-! aerosol absorption
-        DAERO=SUM(TAEROS(K,NW,1:naerkind))
-
         do ng=1,L_NGAUSS-1
 
@@ -286 +284 @@
   end do
 
-  DTAUKI(L_LEVELS+1,1:L_NSPECTI,1:L_NGAUSS)=0.d0
   !=======================================================================
   !     Now the full treatment for the layers, where besides the opacity
@@ -293 +290 @@
   do iaer=1,naerkind
     DO NW=1,L_NSPECTI
-     DO K=2,L_LEVELS+1
-           TAUAEROLK(K,NW,IAER) = TAUAERO(K,IAER)*QSIAER(K,NW,IAER)
+     DO K=2,L_LEVELS
+           TAUAEROLK(K,NW,IAER) = TAUAERO(K,IAER)*QSIAER(K,NW,IAER) ! effect of scattering albedo
      ENDDO
     ENDDO
@@ -300 +297 @@
   
   DO NW=1,L_NSPECTI
-     DO L=1,L_NLAYRAD
+     DO L=1,L_NLAYRAD-1
         K              = 2*L+1
         btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) + SUM(TAUAEROLK(K+1,NW,1:naerkind))
      END DO ! L vertical loop
+     
+     ! Last level
+     L           = L_NLAYRAD
+     K           = 2*L+1    
+     btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind))
+     
   END DO                    ! NW spectral loop
   
@@ -309 +312 @@
   DO NW=1,L_NSPECTI
      NG = L_NGAUSS
-     DO L=1,L_NLAYRAD
+     DO L=1,L_NLAYRAD-1
 
         K              = 2*L+1
@@ -334 +337 @@
 
      END DO ! L vertical loop
+     
+     ! Last level
+     
+     L              = L_NLAYRAD
+     K              = 2*L+1
+     DTAUI(L,nw,ng) = DTAUKI(K,NW,NG) ! + 1.e-50
+
+     atemp = 0.
+     if(DTAUI(L,NW,NG) .GT. 1.0D-9) then
+        do iaer=1,naerkind
+           atemp = atemp + GIAER(K,NW,IAER)   * TAUAEROLK(K,NW,IAER)
+        end do
+        WBARI(L,nw,ng) = btemp(L,nw)  / DTAUI(L,NW,NG)
+     else
+        WBARI(L,nw,ng) = 0.0D0
+        DTAUI(L,NW,NG) = 1.0D-9
+     endif
+
+     if(btemp(L,nw) .GT. 0.0d0) then
+        cosbi(L,NW,NG) = atemp/btemp(L,nw)
+     else
+        cosbi(L,NW,NG) = 0.0D0
+     end if
+     
 
      ! Now the other Gauss points, if needed.
@@ -340 +367 @@
         IF(TAUGSURF(NW,NG) .gt. TLIMIT) THEN
 
-           DO L=1,L_NLAYRAD
+           DO L=1,L_NLAYRAD-1
               K              = 2*L+1
               DTAUI(L,nw,ng) = DTAUKI(K,NW,NG)+DTAUKI(K+1,NW,NG)! + 1.e-50
@@ -355 +382 @@
               cosbi(L,NW,NG) = cosbi(L,NW,L_NGAUSS)
            END DO ! L vertical loop
+           
+           ! Last level 
+           L              = L_NLAYRAD
+           K              = 2*L+1
+           DTAUI(L,nw,ng) = DTAUKI(K,NW,NG)! + 1.e-50
+
+           if(DTAUI(L,NW,NG) .GT. 1.0D-9) then
+
+              WBARI(L,nw,ng) = btemp(L,nw)  / DTAUI(L,NW,NG)
+
+           else
+              WBARI(L,nw,ng) = 0.0D0
+              DTAUI(L,NW,NG) = 1.0D-9
+           endif
+
+           cosbi(L,NW,NG) = cosbi(L,NW,L_NGAUSS)
+           
         END IF