Changeset 4171 for LMDZ6/branches/LMDZ-ECRAD/libf/phylmd/rrtm

Timestamp:

Jun 17, 2022, 4:24:49 PM (3 years ago)

Author:

lguez

Message:

Sync latest trunk changes to branch LMDZ-ECRAD.

Location:

LMDZ6/branches/LMDZ-ECRAD

Files:

• . (modified) (1 prop)
• libf/phylmd/rrtm/abor1.intfb.h (modified) (1 diff)
• libf/phylmd/rrtm/aeropt_6bands_rrtm.F90 (modified) (1 diff)
• libf/phylmd/rrtm/readaerosol_optic_rrtm.F90 (modified) (3 diffs)
• libf/phylmd/rrtm/recmwf_aero.F90 (modified) (3 diffs)
• libf/phylmd/rrtm/tpm_fft.F90 (modified) (1 diff)

LMDZ6/branches/LMDZ-ECRAD/libf/phylmd/rrtm/abor1.intfb.h

@@ -1 +1 @@
 INTERFACE
 SUBROUTINE ABOR1(CDTEXT)
-CHARACTER(LEN=*) :: CDTEXT
+CHARACTER(LEN=*), INTENT(IN) :: CDTEXT
 END SUBROUTINE ABOR1
 END INTERFACE

LMDZ6/branches/LMDZ-ECRAD/libf/phylmd/rrtm/aeropt_6bands_rrtm.F90

@@ -318 +318 @@
    ! Dust insoluble
   0.894, 0.902, 0.937, 0.980, 0.993, 0.967, &
-   ! BC insoluble 
+   ! BC insoluble
+  0.480, 0.469, 0.456, 0.427, 0.349, 0.196, &
+   ! POM insoluble
+  0.956, 0.965, 0.969, 0.953, 0.892, 0.826, &
+   ! Nitrate insoluble
+  1.000, 1.000, 1.000, 1.000, 0.999, 0.707 /
+
+  DATA cg_aeri_6bands/ &
+   ! Dust insoluble
+  0.756, 0.737, 0.713, 0.701, 0.696, 0.672, &
+   ! BC insoluble
   0.820, 0.760, 0.695, 0.603, 0.469, 0.276, &
    ! POM insoluble
   0.687, 0.685, 0.673, 0.637, 0.553, 0.340, &
-   ! Nitrate insoluble
-  1.000, 1.000, 1.000, 1.000, 0.999, 0.707 /
-
-  DATA cg_aeri_6bands/ &
-   ! Dust insoluble
-  0.756, 0.737, 0.713, 0.701, 0.696, 0.672, &
-   ! BC insoluble 
-  0.480, 0.469, 0.456, 0.427, 0.349, 0.196, &
-   ! POM insoluble
-  0.956, 0.965, 0.969, 0.953, 0.892, 0.826, &
    ! Nitrate insoluble
   0.765, 0.754, 0.743, 0.737, 0.739, 0.651 /

LMDZ6/branches/LMDZ-ECRAD/libf/phylmd/rrtm/readaerosol_optic_rrtm.F90

@@ -20 +20 @@
        load_tmp8,load_tmp9,load_tmp10
 
-  USE infotrac_phy
+  USE infotrac_phy, ONLY: tracers, nqtot, nbtr
   USE YOMCST
 
@@ -91 +91 @@
   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
-  INTEGER :: k, i
+  INTEGER :: k, i, iq, itr
 
   !--air density
@@ -107 +107 @@
      !--convert to ug m-3 unit for consistency with offline fields
      !
-     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
+     itr = 0
+     DO iq = 1,nqtot
+        IF(.NOT. tracers(iq)%isInPhysics) CYCLE
+        itr = itr+1
+        SELECT CASE(trim(tracers(iq)%name))
+           CASE ("ASBCM");  id_ASBCM  = itr
+           CASE ("ASPOMM"); id_ASPOMM = itr
+           CASE ("ASSO4M"); id_ASSO4M = itr
+           CASE ("ASMSAM"); id_ASMSAM = itr
+           CASE ("CSSO4M"); id_CSSO4M = itr
+           CASE ("CSMSAM"); id_CSMSAM = itr
+           CASE ("SSSSM");  id_SSSSM  = itr
+           CASE ("CSSSM");  id_CSSSM  = itr
+           CASE ("ASSSM");  id_ASSSM  = itr
+           CASE ("CIDUSTM");id_CIDUSTM= itr
+           CASE ("AIBCM");  id_AIBCM  = itr
+           CASE ("AIPOMM"); id_AIPOMM = itr
+           CASE ("ASNO3M"); id_ASNO3M = itr
+           CASE ("CSNO3M"); id_CSNO3M = itr
+           CASE ("CINO3M"); id_CINO3M = itr
+        END SELECT
+     END DO
 
      bcsol(:,:)        =   tr_seri(:,:,id_ASBCM)                         *zrho(:,:)*1.e9  ! ASBCM

LMDZ6/branches/LMDZ-ECRAD/libf/phylmd/rrtm/recmwf_aero.F90

@@ -36 +36 @@
  & PTOPLWAIAERO,PSOLLWAIAERO,&
  & PLWADAERO,& !--NL
+!--ajout volmip 
+ & volmip_solsw, flag_volc_surfstrat,&
 !..end
  & ok_ade, ok_aie, ok_volcan, flag_aerosol,flag_aerosol_strat,&
@@ -259 +261 @@
 REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLCCDN(KPROMA,KLEV+1) ! LW clear sky clean (no aerosol) flux down
 REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLCCUP(KPROMA,KLEV+1) ! LW clear sky clean (no aerosol) flux up
+!--ajout VOLMIP
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: volmip_solsw(KPROMA) ! SW clear sky in the case of VOLMIP
+INTEGER, INTENT(IN)              :: flag_volc_surfstrat !--VOlMIP Modif
 
 !     ==== COMPUTED IN RADITE ===
@@ -795 +800 @@
 ENDIF
 
+!--VolMIP Strat/Surf
+!--only ok_ade + ok_aie case treated
+IF (ok_ade.AND.ok_aie.AND.ok_volcan) THEN
+   !--in this case the fluxes used for the heating rates come from case 4 but SW surface radiation is kept from case 2
+   IF (flag_volc_surfstrat.EQ.2) THEN ! STRAT HEATING
+      volmip_solsw(:)= ZFSDN_AERO(:,1,2)-ZFSUP_AERO(:,1,2)
+   ELSEIF (flag_volc_surfstrat.EQ.1) THEN ! SURF COOLING
+      !--in this case the fluxes used for the heating rates come from case 2 but SW surface radiation is kept from case 4
+      PFSUP(:,:) =    ZFSUP_AERO(:,:,2)
+      PFSDN(:,:) =    ZFSDN_AERO(:,:,2)
+      PFSCUP(:,:) =   ZFSUP0_AERO(:,:,2)
+      PFSCDN(:,:) =   ZFSDN0_AERO(:,:,2)
+      PFLUX(:,1,:) =  LWUP_AERO(:,:,2)
+      PFLUX(:,2,:) =  LWDN_AERO(:,:,2)
+      PFLUC(:,1,:) =  LWDN0_AERO(:,:,2) 
+      PFLUC(:,2,:) =  LWDN0_AERO(:,:,2)
+      volmip_solsw(:)= ZFSDN_AERO(:,1,4)-ZFSUP_AERO(:,1,4)
+   ENDIF
+ENDIF
+!--End VolMIP Strat/Surf
+
 IF (swaerofree_diag) THEN
 ! copy shortwave clear-sky clean (no aerosol) case

LMDZ6/branches/LMDZ-ECRAD/libf/phylmd/rrtm/tpm_fft.F90

@@ -7 +7 @@
 
 TYPE FFT_TYPE
-  REAL(KIND=JPRB)   ,POINTER :: TRIGS(:,:)
-  INTEGER(KIND=JPIM),POINTER :: NFAX(:,:)
+  REAL(KIND=JPRB)   ,ALLOCATABLE :: TRIGS(:,:)
+  INTEGER(KIND=JPIM),ALLOCATABLE :: NFAX(:,:)
 END TYPE FFT_TYPE