source: LMDZ5/branches/IPSLCM6.0.11pre/libf/phylmd/rrtm/srtm_cmbgb21.F90 @ 3997

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