source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/rrtm/srtm_cmbgb16.F90 @ 2174

Last change on this file since 2174 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.5 KB
Line 
1SUBROUTINE SRTM_CMBGB16
2
3!
4!  Original version:       Michael J. Iacono; July, 1998
5!  Revision for RRTM_SW:   Michael J. Iacono; November, 2002
6!  Revision for RRTMG_SW:  Michael J. Iacono; December, 2003
7!
8!  The subroutines CMBGB16->CMBGB29 input the absorption coefficient
9!  data for each band, which are defined for 16 g-points and 14 spectral
10!  bands. The data are combined with appropriate weighting following the
11!  g-point mapping arrays specified in RRTMG_SW_INIT.  Solar source
12!  function data in array SFLUXREF are combined without weighting.  All
13!  g-point reduced data are put into new arrays for use in RRTMG_SW.
14!
15!  BAND 16:  2600-3250 cm-1 (low key- H2O,CH4; high key - CH4)
16!
17!-----------------------------------------------------------------------
18
19USE PARKIND1  ,ONLY : JPIM , JPRB
20USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
21
22USE YOESRTWN , ONLY : NGC, NGN, RWGT
23USE YOESRTA16, ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, &
24                    & KAC, KBC, SELFREFC, FORREFC, SFLUXREFC
25
26IMPLICIT NONE
27
28! Local variables
29INTEGER(KIND=JPIM) :: JN, JT, JP, IGC, IPR, IPRSM
30REAL(KIND=JPRB)    :: ZSUMK, ZSUMF
31
32REAL(KIND=JPRB) :: ZHOOK_HANDLE
33!     ------------------------------------------------------------------
34IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB16',0,ZHOOK_HANDLE)
35
36DO JN = 1,9
37  DO JT = 1,5
38    DO JP = 1,13
39      IPRSM = 0
40      DO IGC = 1,NGC(1)
41        ZSUMK = 0.
42        DO IPR = 1, NGN(IGC)
43          IPRSM = IPRSM + 1
44          ZSUMK = ZSUMK + KA(JN,JT,JP,IPRSM)*RWGT(IPRSM)
45        ENDDO
46        KAC(JN,JT,JP,IGC) = ZSUMK
47      ENDDO
48    ENDDO
49  ENDDO
50ENDDO
51
52DO JT = 1,5
53  DO JP = 13,59
54    IPRSM = 0
55    DO IGC = 1,NGC(1)
56      ZSUMK = 0.
57      DO IPR = 1, NGN(IGC)
58        IPRSM = IPRSM + 1
59        ZSUMK = ZSUMK + KB(JT,JP,IPRSM)*RWGT(IPRSM)
60      ENDDO
61      KBC(JT,JP,IGC) = ZSUMK
62    ENDDO
63  ENDDO
64ENDDO
65
66DO JT = 1,10
67  IPRSM = 0
68  DO IGC = 1,NGC(1)
69    ZSUMK = 0.
70    DO IPR = 1, NGN(IGC)
71      IPRSM = IPRSM + 1
72      ZSUMK = ZSUMK + SELFREF(JT,IPRSM)*RWGT(IPRSM)
73    ENDDO
74    SELFREFC(JT,IGC) = ZSUMK
75  ENDDO
76ENDDO
77
78DO JT = 1,3
79  IPRSM = 0
80  DO IGC = 1,NGC(1)
81    ZSUMK = 0.
82    DO IPR = 1, NGN(IGC)
83      IPRSM = IPRSM + 1
84      ZSUMK = ZSUMK + FORREF(JT,IPRSM)*RWGT(IPRSM)
85    ENDDO
86    FORREFC(JT,IGC) = ZSUMK
87  ENDDO
88ENDDO
89
90IPRSM = 0
91DO IGC = 1,NGC(1)
92  ZSUMF = 0.
93  DO IPR = 1, NGN(IGC)
94    IPRSM = IPRSM + 1
95    ZSUMF = ZSUMF + SFLUXREF(IPRSM)
96  ENDDO
97  SFLUXREFC(IGC) = ZSUMF
98ENDDO
99
100!     -----------------------------------------------------------------
101IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB16',1,ZHOOK_HANDLE)
102END SUBROUTINE SRTM_CMBGB16
103
Note: See TracBrowser for help on using the repository browser.