source: LMDZ6/branches/LMDZ-COSP/libf/phylmd/rrtm/srtm_cmbgb25.F90 @ 3847

Last change on this file since 3847 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: 1.5 KB
Line 
1SUBROUTINE SRTM_CMBGB25
2
3!     BAND 25:  16000-22650 cm-1 (low - H2O; high - nothing)
4!-----------------------------------------------------------------------
5
6USE PARKIND1  ,ONLY : JPIM , JPRB
7USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
8
9USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
10USE YOESRTA25, ONLY : KA, SFLUXREF, ABSO3A, ABSO3B, RAYL, &
11                    & KAC, SFLUXREFC, ABSO3AC, ABSO3BC, RAYLC
12
13IMPLICIT NONE
14
15! Local variables
16INTEGER(KIND=JPIM) :: JT, JP, IGC, IPR, IPRSM
17REAL(KIND=JPRB)    :: ZSUMK, ZSUMF1, ZSUMF2, ZSUMF3, ZSUMF4
18
19REAL(KIND=JPRB) :: ZHOOK_HANDLE
20!     ------------------------------------------------------------------
21IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB25',0,ZHOOK_HANDLE)
22
23DO JT = 1,5
24  DO JP = 1,13
25    IPRSM = 0
26    DO IGC = 1,NGC(10)
27      ZSUMK = 0.
28      DO IPR = 1, NGN(NGS(9)+IGC)
29        IPRSM = IPRSM + 1
30        ZSUMK = ZSUMK + KA(JT,JP,IPRSM)*RWGT(IPRSM+144)
31      ENDDO
32      KAC(JT,JP,IGC) = ZSUMK
33    ENDDO
34  ENDDO
35ENDDO
36
37IPRSM = 0
38DO IGC = 1,NGC(10)
39  ZSUMF1 = 0.
40  ZSUMF2 = 0.
41  ZSUMF3 = 0.
42  ZSUMF4 = 0.
43  DO IPR = 1, NGN(NGS(9)+IGC)
44    IPRSM = IPRSM + 1
45    ZSUMF1 = ZSUMF1 + SFLUXREF(IPRSM)
46    ZSUMF2 = ZSUMF2 + ABSO3A(IPRSM)*RWGT(IPRSM+144)
47    ZSUMF3 = ZSUMF3 + ABSO3B(IPRSM)*RWGT(IPRSM+144)
48    ZSUMF4 = ZSUMF4 + RAYL(IPRSM)*RWGT(IPRSM+144)
49  ENDDO
50  SFLUXREFC(IGC) = ZSUMF1
51  ABSO3AC(IGC) = ZSUMF2
52  ABSO3BC(IGC) = ZSUMF3
53  RAYLC(IGC) = ZSUMF4
54ENDDO
55
56!     -----------------------------------------------------------------
57IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB25',1,ZHOOK_HANDLE)
58END SUBROUTINE SRTM_CMBGB25
59
Note: See TracBrowser for help on using the repository browser.