source: LMDZ5/trunk/libf/phylmd/rrtm/srtm_taumol26.F90 @ 5412

Last change on this file since 5412 was 1990, checked in by Laurent Fairhead, 11 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM


Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 3.4 KB
Line 
1SUBROUTINE SRTM_TAUMOL26 &
2 & ( KLEV,&
3 & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
4 & K_JP      , K_JT     , K_JT1     , P_ONEMINUS,&
5 & P_COLH2O  , P_COLCO2 , P_COLMOL,&
6 & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF  , P_FORFAC, P_FORFRAC, K_INDFOR,&
7 & P_SFLUXZEN, P_TAUG   , P_TAUR    &
8 & ) 
9
10!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
11
12!     BAND 26:  22650-29000 cm-1 (low - nothing; high - nothing)
13
14!      PARAMETER (MG=16, MXLAY=203, NBANDS=14)
15
16! Modifications
17!        M.Hamrud      01-Oct-2003 CY28 Cleaning
18
19!     JJMorcrette 2003-02-24 adapted to ECMWF environment
20
21USE PARKIND1  ,ONLY : JPIM     ,JPRB
22USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
23
24USE PARSRTM  , ONLY : JPLAY, JPG, NG26
25USE YOESRTA26, ONLY : SFLUXREFC, RAYLC
26IMPLICIT NONE
27
28!-- Output
29INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
30REAL(KIND=JPRB)                  :: P_FAC00(JPLAY) ! Argument NOT used
31REAL(KIND=JPRB)                  :: P_FAC01(JPLAY) ! Argument NOT used
32REAL(KIND=JPRB)                  :: P_FAC10(JPLAY) ! Argument NOT used
33REAL(KIND=JPRB)                  :: P_FAC11(JPLAY) ! Argument NOT used
34INTEGER(KIND=JPIM)               :: K_JP(JPLAY) ! Argument NOT used
35INTEGER(KIND=JPIM)               :: K_JT(JPLAY) ! Argument NOT used
36INTEGER(KIND=JPIM)               :: K_JT1(JPLAY) ! Argument NOT used
37REAL(KIND=JPRB)                  :: P_ONEMINUS ! Argument NOT used
38REAL(KIND=JPRB)                  :: P_COLH2O(JPLAY) ! Argument NOT used
39REAL(KIND=JPRB)                  :: P_COLCO2(JPLAY) ! Argument NOT used
40REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(JPLAY)
41INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP
42REAL(KIND=JPRB)                  :: P_SELFFAC(JPLAY) ! Argument NOT used
43REAL(KIND=JPRB)                  :: P_SELFFRAC(JPLAY) ! Argument NOT used
44INTEGER(KIND=JPIM)               :: K_INDSELF(JPLAY) ! Argument NOT used
45REAL(KIND=JPRB)                  :: P_FORFAC(JPLAY) ! Argument NOT used
46REAL(KIND=JPRB)                  :: P_FORFRAC(JPLAY) ! Argument NOT used
47INTEGER(KIND=JPIM)               :: K_INDFOR(JPLAY) ! Argument NOT used
48
49REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(JPG)
50REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(JPLAY,JPG)
51REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(JPLAY,JPG)
52!- from AER
53!- from INTFAC     
54!- from INTIND
55!- from PRECISE             
56!- from PROFDATA             
57!- from SELF             
58INTEGER(KIND=JPIM) :: IG, I_LAY, I_LAYSOLFR, I_NLAYERS
59
60REAL(KIND=JPRB) :: ZHOOK_HANDLE
61
62IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL26',0,ZHOOK_HANDLE)
63I_NLAYERS = KLEV
64
65!     Compute the optical depth by interpolating in ln(pressure),
66!     temperature, and appropriate species.  Below LAYTROP, the water
67!     vapor self-continuum is interpolated (in temperature) separately. 
68I_LAYSOLFR = K_LAYTROP
69
70DO I_LAY = 1, K_LAYTROP
71!  DO IG = 1, NG(26)
72  DO IG = 1 , NG26
73!    TAUG(LAY,IG) = COLMOL(LAY) * RAYLC(IG)
74!    SSA(LAY,IG) = 1.0
75    IF (I_LAY == I_LAYSOLFR) P_SFLUXZEN(IG) = SFLUXREFC(IG)
76    P_TAUG(I_LAY,IG) = 0.0_JPRB
77    P_TAUR(I_LAY,IG) = P_COLMOL(I_LAY) * RAYLC(IG)
78  ENDDO
79ENDDO
80
81DO I_LAY = K_LAYTROP+1, I_NLAYERS
82!  DO IG = 1, NG(26)
83  DO IG = 1 , NG26
84!    TAUG(LAY,IG) = COLMOL(LAY) * RAYLC(IG)
85!    SSA(LAY,IG) = 1.0
86    P_TAUG(I_LAY,IG) = 0.0_JPRB
87    P_TAUR(I_LAY,IG) = P_COLMOL(I_LAY) * RAYLC(IG)
88  ENDDO
89ENDDO
90
91!-----------------------------------------------------------------------
92IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL26',1,ZHOOK_HANDLE)
93END SUBROUTINE SRTM_TAUMOL26
94
Note: See TracBrowser for help on using the repository browser.