source: LMDZ6/trunk/libf/phylmd/ecrad/ifsrrtm/srtm_cmbgb16.F90 @ 5422

Last change on this file since 5422 was 4773, checked in by idelkadi, 13 months ago
  • Update of Ecrad in LMDZ The same organization of the Ecrad offline version is retained in order to facilitate the updating of Ecrad in LMDZ and the comparison between online and offline results. version 1.6.1 of Ecrad (https://github.com/lguez/ecrad.git)
  • Implementation of the double call of Ecrad in LMDZ


File size: 2.6 KB
RevLine 
[4773]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, JPHOOK
21
22USE YOESRTM  , ONLY : NGN
23USE YOESRTWN , ONLY : NGC, RWGT
24!USE YOESRTWN , ONLY : NGC, NGN, RWGT
25USE YOESRTA16, ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, &
26                    & KAC, KBC, SELFREFC, FORREFC, SFLUXREFC
27
28IMPLICIT NONE
29
30! Local variables
31INTEGER(KIND=JPIM) :: JN, JT, JP, IGC, IPR, IPRSM
32REAL(KIND=JPRB)    :: ZSUMK, ZSUMF
33
34REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
35!     ------------------------------------------------------------------
36IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB16',0,ZHOOK_HANDLE)
37
38DO JN = 1,9
39  DO JT = 1,5
40    DO JP = 1,13
41      IPRSM = 0
42      DO IGC = 1,NGC(1)
43        ZSUMK = 0.
44        DO IPR = 1, NGN(IGC)
45          IPRSM = IPRSM + 1
46          ZSUMK = ZSUMK + KA(JN,JT,JP,IPRSM)*RWGT(IPRSM)
47        ENDDO
48        KAC(JN,JT,JP,IGC) = ZSUMK
49      ENDDO
50    ENDDO
51  ENDDO
52ENDDO
53
54DO JT = 1,5
55  DO JP = 13,59
56    IPRSM = 0
57    DO IGC = 1,NGC(1)
58      ZSUMK = 0.
59      DO IPR = 1, NGN(IGC)
60        IPRSM = IPRSM + 1
61        ZSUMK = ZSUMK + KB(JT,JP,IPRSM)*RWGT(IPRSM)
62      ENDDO
63      KBC(JT,JP,IGC) = ZSUMK
64    ENDDO
65  ENDDO
66ENDDO
67
68DO JT = 1,10
69  IPRSM = 0
70  DO IGC = 1,NGC(1)
71    ZSUMK = 0.
72    DO IPR = 1, NGN(IGC)
73      IPRSM = IPRSM + 1
74      ZSUMK = ZSUMK + SELFREF(JT,IPRSM)*RWGT(IPRSM)
75    ENDDO
76    SELFREFC(JT,IGC) = ZSUMK
77  ENDDO
78ENDDO
79
80DO JT = 1,3
81  IPRSM = 0
82  DO IGC = 1,NGC(1)
83    ZSUMK = 0.
84    DO IPR = 1, NGN(IGC)
85      IPRSM = IPRSM + 1
86      ZSUMK = ZSUMK + FORREF(JT,IPRSM)*RWGT(IPRSM)
87    ENDDO
88    FORREFC(JT,IGC) = ZSUMK
89  ENDDO
90ENDDO
91
92IPRSM = 0
93DO IGC = 1,NGC(1)
94  ZSUMF = 0.
95  DO IPR = 1, NGN(IGC)
96    IPRSM = IPRSM + 1
97    ZSUMF = ZSUMF + SFLUXREF(IPRSM)
98  ENDDO
99  SFLUXREFC(IGC) = ZSUMF
100ENDDO
101
102!     -----------------------------------------------------------------
103IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB16',1,ZHOOK_HANDLE)
104END SUBROUTINE SRTM_CMBGB16
105
Note: See TracBrowser for help on using the repository browser.