source: LMDZ5/trunk/libf/phylmd/rrtm/srtm_cmbgb29.F90 @ 5224

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