source: LMDZ5/trunk/libf/phylmd/rrtm/srtm_cmbgb24.F90 @ 3831

Last change on this file since 3831 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.6 KB
Line 
1SUBROUTINE SRTM_CMBGB24
2
3!     BAND 24:  12850-16000 cm-1 (low - H2O,O2; high - O2)
4!-----------------------------------------------------------------------
5
6USE PARKIND1  ,ONLY : JPIM , JPRB
7USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
8
9USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
10USE YOESRTA24, ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, &
11                    & ABSO3A, ABSO3B, RAYLA, RAYLB, &
12                    & KAC, KBC, SELFREFC, FORREFC, SFLUXREFC, &
13                    & ABSO3AC, ABSO3BC, RAYLAC, RAYLBC
14
15IMPLICIT NONE
16
17! Local variables
18INTEGER(KIND=JPIM) :: JN, JT, JP, IGC, IPR, IPRSM
19REAL(KIND=JPRB)    :: ZSUMK, ZSUMF1, ZSUMF2, ZSUMF3
20
21REAL(KIND=JPRB) :: ZHOOK_HANDLE
22!     ------------------------------------------------------------------
23IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB24',0,ZHOOK_HANDLE)
24
25DO JN = 1,9
26  DO JT = 1,5
27    DO JP = 1,13
28      IPRSM = 0
29      DO IGC = 1,NGC(9)
30        ZSUMK = 0.
31        DO IPR = 1, NGN(NGS(8)+IGC)
32          IPRSM = IPRSM + 1
33          ZSUMK = ZSUMK + KA(JN,JT,JP,IPRSM)*RWGT(IPRSM+128)
34        ENDDO
35        KAC(JN,JT,JP,IGC) = ZSUMK
36      ENDDO
37    ENDDO
38  ENDDO
39ENDDO
40
41DO JT = 1,5
42  DO JP = 13,59
43    IPRSM = 0
44    DO IGC = 1,NGC(9)
45      ZSUMK = 0.
46      DO IPR = 1, NGN(NGS(8)+IGC)
47        IPRSM = IPRSM + 1
48        ZSUMK = ZSUMK + KB(JT,JP,IPRSM)*RWGT(IPRSM+128)
49      ENDDO
50      KBC(JT,JP,IGC) = ZSUMK
51    ENDDO
52  ENDDO
53ENDDO
54
55DO JT = 1,10
56  IPRSM = 0
57  DO IGC = 1,NGC(9)
58    ZSUMK = 0.
59    DO IPR = 1, NGN(NGS(8)+IGC)
60      IPRSM = IPRSM + 1
61      ZSUMK = ZSUMK + SELFREF(JT,IPRSM)*RWGT(IPRSM+128)
62    ENDDO
63    SELFREFC(JT,IGC) = ZSUMK
64  ENDDO
65ENDDO
66
67DO JT = 1,3
68  IPRSM = 0
69  DO IGC = 1,NGC(9)
70    ZSUMK = 0.
71    DO IPR = 1, NGN(NGS(8)+IGC)
72      IPRSM = IPRSM + 1
73      ZSUMK = ZSUMK + FORREF(JT,IPRSM)*RWGT(IPRSM+128)
74    ENDDO
75    FORREFC(JT,IGC) = ZSUMK
76  ENDDO
77ENDDO
78
79IPRSM = 0
80DO IGC = 1,NGC(9)
81  ZSUMF1 = 0.
82  ZSUMF2 = 0.
83  ZSUMF3 = 0.
84  DO IPR = 1, NGN(NGS(8)+IGC)
85    IPRSM = IPRSM + 1
86    ZSUMF1 = ZSUMF1 + RAYLB(IPRSM)*RWGT(IPRSM+128)
87    ZSUMF2 = ZSUMF2 + ABSO3A(IPRSM)*RWGT(IPRSM+128)
88    ZSUMF3 = ZSUMF3 + ABSO3B(IPRSM)*RWGT(IPRSM+128)
89  ENDDO
90  RAYLBC(IGC) = ZSUMF1
91  ABSO3AC(IGC) = ZSUMF2
92  ABSO3BC(IGC) = ZSUMF3
93ENDDO
94
95DO JP = 1,9
96  IPRSM = 0
97  DO IGC = 1,NGC(9)
98    ZSUMF1 = 0.
99    ZSUMF2 = 0.
100    DO IPR = 1, NGN(NGS(8)+IGC)
101      IPRSM = IPRSM + 1
102      ZSUMF1 = ZSUMF1 + SFLUXREF(IPRSM,JP)
103      ZSUMF2 = ZSUMF2 + RAYLA(IPRSM,JP)*RWGT(IPRSM+128)
104    ENDDO
105    SFLUXREFC(IGC,JP) = ZSUMF1
106    RAYLAC(IGC,JP) = ZSUMF2
107  ENDDO
108ENDDO
109
110!     -----------------------------------------------------------------
111IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB24',1,ZHOOK_HANDLE)
112END SUBROUTINE SRTM_CMBGB24
113
Note: See TracBrowser for help on using the repository browser.