source: LMDZ6/branches/LMDZ-COSP/libf/phylmd/rrtm/srtm_cmbgb19.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: 2.0 KB
Line 
1SUBROUTINE SRTM_CMBGB19
2
3!     BAND 19:  4650-5150 cm-1 (low - H2O,CO2; high - CO2)
4!-----------------------------------------------------------------------
5
6USE PARKIND1  ,ONLY : JPIM , JPRB
7USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
8
9USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
10USE YOESRTA19, 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_CMBGB19',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(4)
28        ZSUMK = 0.
29        DO IPR = 1, NGN(NGS(3)+IGC)
30          IPRSM = IPRSM + 1
31          ZSUMK = ZSUMK + KA(JN,JT,JP,IPRSM)*RWGT(IPRSM+48)
32        ENDDO
33        KAC(JN,JT,JP,IGC) = ZSUMK
34      ENDDO
35    ENDDO
36  ENDDO
37ENDDO
38
39DO JT = 1,5
40  DO JP = 13,59
41    IPRSM = 0
42    DO IGC = 1,NGC(4)
43      ZSUMK = 0.
44      DO IPR = 1, NGN(NGS(3)+IGC)
45        IPRSM = IPRSM + 1
46        ZSUMK = ZSUMK + KB(JT,JP,IPRSM)*RWGT(IPRSM+48)
47      ENDDO
48      KBC(JT,JP,IGC) = ZSUMK
49    ENDDO
50  ENDDO
51ENDDO
52
53DO JT = 1,10
54  IPRSM = 0
55  DO IGC = 1,NGC(4)
56    ZSUMK = 0.
57    DO IPR = 1, NGN(NGS(3)+IGC)
58      IPRSM = IPRSM + 1
59      ZSUMK = ZSUMK + SELFREF(JT,IPRSM)*RWGT(IPRSM+48)
60    ENDDO
61    SELFREFC(JT,IGC) = ZSUMK
62  ENDDO
63ENDDO
64
65DO JT = 1,3
66  IPRSM = 0
67  DO IGC = 1,NGC(4)
68    ZSUMK = 0.
69    DO IPR = 1, NGN(NGS(3)+IGC)
70      IPRSM = IPRSM + 1
71      ZSUMK = ZSUMK + FORREF(JT,IPRSM)*RWGT(IPRSM+48)
72    ENDDO
73    FORREFC(JT,IGC) = ZSUMK
74  ENDDO
75ENDDO
76
77DO JP = 1,9
78  IPRSM = 0
79  DO IGC = 1,NGC(4)
80    ZSUMF = 0.
81    DO IPR = 1, NGN(NGS(3)+IGC)
82      IPRSM = IPRSM + 1
83      ZSUMF = ZSUMF + SFLUXREF(IPRSM,JP)
84    ENDDO
85    SFLUXREFC(IGC,JP) = ZSUMF
86  ENDDO
87ENDDO
88
89!     -----------------------------------------------------------------
90IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB19',1,ZHOOK_HANDLE)
91END SUBROUTINE SRTM_CMBGB19
92
Note: See TracBrowser for help on using the repository browser.