source: LMDZ6/trunk/libf/phylmd/ecrad/ifsrrtm/srtm_cmbgb19.F90 @ 5423

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