source: LMDZ6/branches/LMDZ-ECRAD/libf/phylmd/rrtm/srtm_cmbgb20.F90 @ 4109

Last change on this file since 4109 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: 2.0 KB
Line 
1SUBROUTINE SRTM_CMBGB20
2
3!     BAND 20:  5150-6150 cm-1 (low - H2O; high - H2O)
4!-----------------------------------------------------------------------
5
6USE PARKIND1  ,ONLY : JPIM , JPRB
7USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
8
9USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
10USE YOESRTA20, ONLY : KA, KB, SELFREF, FORREF, ABSCH4, SFLUXREF, &
11                    & KAC, KBC, SELFREFC, FORREFC, ABSCH4C, SFLUXREFC
12
13IMPLICIT NONE
14
15! Local variables
16INTEGER(KIND=JPIM) :: JT, JP, IGC, IPR, IPRSM
17REAL(KIND=JPRB)    :: ZSUMK, ZSUMF1, ZSUMF2
18
19REAL(KIND=JPRB) :: ZHOOK_HANDLE
20!     ------------------------------------------------------------------
21IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB20',0,ZHOOK_HANDLE)
22
23DO JT = 1,5
24  DO JP = 1,13
25    IPRSM = 0
26    DO IGC = 1,NGC(5)
27      ZSUMK = 0.
28      DO IPR = 1, NGN(NGS(4)+IGC)
29        IPRSM = IPRSM + 1
30        ZSUMK = ZSUMK + KA(JT,JP,IPRSM)*RWGT(IPRSM+64)
31      ENDDO
32      KAC(JT,JP,IGC) = ZSUMK
33    ENDDO
34  ENDDO
35
36  DO JP = 13,59
37    IPRSM = 0
38    DO IGC = 1,NGC(5)
39      ZSUMK = 0.
40      DO IPR = 1, NGN(NGS(4)+IGC)
41        IPRSM = IPRSM + 1
42        ZSUMK = ZSUMK + KB(JT,JP,IPRSM)*RWGT(IPRSM+64)
43      ENDDO
44      KBC(JT,JP,IGC) = ZSUMK
45    ENDDO
46  ENDDO
47ENDDO
48
49DO JT = 1,10
50  IPRSM = 0
51  DO IGC = 1,NGC(5)
52    ZSUMK = 0.
53    DO IPR = 1, NGN(NGS(4)+IGC)
54      IPRSM = IPRSM + 1
55      ZSUMK = ZSUMK + SELFREF(JT,IPRSM)*RWGT(IPRSM+64)
56    ENDDO
57    SELFREFC(JT,IGC) = ZSUMK
58  ENDDO
59ENDDO
60
61DO JT = 1,4
62  IPRSM = 0
63  DO IGC = 1,NGC(5)
64    ZSUMK = 0.
65    DO IPR = 1, NGN(NGS(4)+IGC)
66      IPRSM = IPRSM + 1
67      ZSUMK = ZSUMK + FORREF(JT,IPRSM)*RWGT(IPRSM+64)
68    ENDDO
69    FORREFC(JT,IGC) = ZSUMK
70  ENDDO
71ENDDO
72
73IPRSM = 0
74DO IGC = 1,NGC(5)
75  ZSUMF1 = 0.
76  ZSUMF2 = 0.
77  DO IPR = 1, NGN(NGS(4)+IGC)
78    IPRSM = IPRSM + 1
79    ZSUMF1 = ZSUMF1 + SFLUXREF(IPRSM)
80    ZSUMF2 = ZSUMF2 + ABSCH4(IPRSM)*RWGT(IPRSM+64)
81  ENDDO
82  SFLUXREFC(IGC) = ZSUMF1
83  ABSCH4C(IGC) = ZSUMF2
84ENDDO
85
86!     -----------------------------------------------------------------
87IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB20',1,ZHOOK_HANDLE)
88END SUBROUTINE SRTM_CMBGB20
89
Note: See TracBrowser for help on using the repository browser.