source: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol26.F90 @ 4175

Last change on this file since 4175 was 3908, checked in by idelkadi, 3 years ago

Online implementation of the radiative transfer code ECRAD in the LMDZ model.

  • Inclusion of the ecrad directory containing the sources of the ECRAD code
    • interface routine : radiation_scheme.F90
  • Adaptation of compilation scripts :
    • compilation under CPP key CPP_ECRAD
    • compilation with option "-rad ecard" or "-ecard true"
    • The "-rad old/rtm/ecran" build option will need to replace the "-rrtm true" and "-ecrad true" options in the future.
  • Runing LMDZ simulations with ecrad, you need :
    • logical key iflag_rrtm = 2 in physiq.def
    • namelist_ecrad (DefLists?)
    • the directory "data" containing the configuration files is temporarily placed in ../libfphylmd/ecrad/
  • Compilation and execution are tested in the 1D case. The repository under svn would allow to continue the implementation work: tests, verification of the results, ...
File size: 3.0 KB
RevLine 
[3908]1SUBROUTINE SRTM_TAUMOL26 &
2 & ( KIDIA   , KFDIA    , KLEV,&
3 & P_COLMOL  ,K_LAYTROP,&
4 & P_SFLUXZEN, P_TAUG   , P_TAUR    , PRMU0   &
5 & ) 
6
7!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
8
9!     BAND 26:  22650-29000 cm-1 (low - nothing; high - nothing)
10
11!      PARAMETER (MG=16, MXLAY=203, NBANDS=14)
12
13! Modifications
14!        M.Hamrud      01-Oct-2003 CY28 Cleaning
15
16!     JJMorcrette 2003-02-24 adapted to ECMWF environment
17!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
18!     JJMorcrette 20110610 Flexible configuration for number of g-points
19
20USE PARKIND1 , ONLY : JPIM, JPRB
21USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
22USE PARSRTM  , ONLY : JPG
23USE YOESRTM  , ONLY : NG26
24USE YOESRTA26, ONLY : SFLUXREFC, RAYLC
25
26IMPLICIT NONE
27
28!-- Output
29INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA
30INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
31REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV)
32INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA)
33
34REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
35REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
36REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
37REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
38!- from AER
39!- from INTFAC     
40!- from INTIND
41!- from PRECISE             
42!- from PROFDATA             
43!- from SELF             
44INTEGER(KIND=JPIM) :: IG, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
45
46REAL(KIND=JPRB) :: ZHOOK_HANDLE
47
48ASSOCIATE(NFLEVG=>KLEV)
49IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL26',0,ZHOOK_HANDLE)
50
51I_NLAYERS = KLEV
52
53!     Compute the optical depth by interpolating in ln(pressure),
54!     temperature, and appropriate species.  Below LAYTROP, the water
55!     vapor self-continuum is interpolated (in temperature) separately. 
56
57I_LAYSOLFR(KIDIA:KFDIA) = K_LAYTROP(KIDIA:KFDIA)
58
59DO I_LAY = 1, I_NLAYERS
60  DO IPLON = KIDIA, KFDIA
61    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
62      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
63        !  DO IG = 1, NG(26)
64!CDIR UNROLL=NG26
65        DO IG = 1 , NG26
66          !    TAUG(LAY,IG) = COLMOL(LAY) * RAYLC(IG)
67          !    SSA(LAY,IG) = 1.0
68          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG)
69          P_TAUG(IPLON,I_LAY,IG) = 0.0_JPRB
70          P_TAUR(IPLON,I_LAY,IG) = P_COLMOL(IPLON,I_LAY) * RAYLC(IG)
71        ENDDO
72      ENDIF
73    ENDIF
74  ENDDO
75ENDDO
76
77DO I_LAY = 1, I_NLAYERS
78  DO IPLON = KIDIA, KFDIA
79    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
80      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
81        !  DO IG = 1, NG(26)
82!CDIR UNROLL=NG26
83        DO IG = 1 , NG26
84          !    TAUG(LAY,IG) = COLMOL(LAY) * RAYLC(IG)
85          !    SSA(LAY,IG) = 1.0
86          P_TAUG(IPLON,I_LAY,IG) = 0.0_JPRB
87          P_TAUR(IPLON,I_LAY,IG) = P_COLMOL(IPLON,I_LAY) * RAYLC(IG)
88        ENDDO
89      ENDIF
90    ENDIF
91  ENDDO
92ENDDO
93
94!-----------------------------------------------------------------------
95IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL26',1,ZHOOK_HANDLE)
96END ASSOCIATE
97END SUBROUTINE SRTM_TAUMOL26
Note: See TracBrowser for help on using the repository browser.