source: LMDZ6/branches/LMDZ-ECRAD/libf/phylmd/ecrad/rrtm_cmbgb11.F90 @ 4115

Last change on this file since 4115 was 3880, checked in by idelkadi, 4 years ago

Online implementation of the radiative transfer code ECRAD in LMDZ.

  • Inclusion of the ecrad directory containing the sources of the ECRAD code
  • Adaptation of compilation scripts (CPP_ECRAD keys)
  • Call of ecrad in radlwsw_m.F90 under the logical key iflag_rrtm = 2
File size: 3.0 KB
RevLine 
[3880]1!***************************************************************************
2SUBROUTINE RRTM_CMBGB11
3!***************************************************************************
4
5!     BAND 11:  1480-1800 cm-1 (low - H2O; high - H2O)
6!     ABozzo updated to rrtmg v4.85
7!     band 11:  1480-1800 cm-1 (low - h2o; low minor - o2)
8!                              (high key - h2o; high minor - o2)
9!***************************************************************************
10
11! Parameters
12USE PARKIND1  ,ONLY : JPIM     ,JPRB
13USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
14
15USE YOERRTO11, ONLY : KAO     ,KBO     ,SELFREFO,FORREFO    ,FRACREFAO ,FRACREFBO, &
16                    & KAO_MO2, KBO_MO2
17USE YOERRTA11, ONLY : KA      ,KB      ,SELFREF,FORREF     ,FRACREFA  ,FRACREFB, &
18                    & KA_MO2, KB_MO2
19USE YOERRTRWT, ONLY : RWGT
20USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN     
21
22IMPLICIT NONE
23
24INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JP, JT
25
26REAL(KIND=JPRB) :: Z_SUMF1, Z_SUMF2, Z_SUMK,Z_SUMK1,Z_SUMK2
27REAL(KIND=JPRB) :: ZHOOK_HANDLE
28
29IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB11',0,ZHOOK_HANDLE)
30DO JT = 1,5
31  DO JP = 1,13
32    IPRSM = 0
33    DO IGC = 1,NGC(11)
34      Z_SUMK = 0.0_JPRB
35      DO IPR = 1, NGN(NGS(10)+IGC)
36        IPRSM = IPRSM + 1
37
38        Z_SUMK = Z_SUMK + KAO(JT,JP,IPRSM)*RWGT(IPRSM+160)
39      ENDDO
40
41      KA(JT,JP,IGC) = Z_SUMK
42    ENDDO
43  ENDDO
44ENDDO
45DO JT = 1,5
46  DO JP = 13,59
47    IPRSM = 0
48    DO IGC = 1,NGC(11)
49      Z_SUMK = 0.0_JPRB
50      DO IPR = 1, NGN(NGS(10)+IGC)
51        IPRSM = IPRSM + 1
52
53        Z_SUMK = Z_SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM+160)
54      ENDDO
55
56      KB(JT,JP,IGC) = Z_SUMK
57    ENDDO
58  ENDDO
59ENDDO
60
61      DO JT = 1,19
62         IPRSM = 0
63         DO IGC = 1,NGC(11)
64            Z_SUMK1 = 0.0_JPRB
65            Z_SUMK2 = 0.0_JPRB
66            DO IPR = 1, NGN(NGS(10)+IGC)
67               IPRSM = IPRSM + 1
68               Z_SUMK1 = Z_SUMK1 + KAO_MO2(JT,IPRSM)*RWGT(IPRSM+160)
69               Z_SUMK2 = Z_SUMK2 + KBO_MO2(JT,IPRSM)*RWGT(IPRSM+160)
70            ENDDO
71            KA_MO2(JT,IGC) = Z_SUMK1
72            KB_MO2(JT,IGC) = Z_SUMK2
73         ENDDO
74      ENDDO
75
76
77DO JT = 1,10
78  IPRSM = 0
79  DO IGC = 1,NGC(11)
80    Z_SUMK = 0.0_JPRB
81    DO IPR = 1, NGN(NGS(10)+IGC)
82      IPRSM = IPRSM + 1
83
84      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+160)
85    ENDDO
86
87    SELFREF(JT,IGC) = Z_SUMK
88  ENDDO
89ENDDO
90
91DO JT = 1,4
92         IPRSM = 0
93         DO IGC = 1,NGC(11)
94            Z_SUMK = 0.0_JPRB
95            DO IPR = 1, NGN(NGS(10)+IGC)
96               IPRSM = IPRSM + 1
97               Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+160)
98            ENDDO
99            FORREF(JT,IGC) = Z_SUMK
100         ENDDO
101ENDDO
102
103IPRSM = 0
104DO IGC = 1,NGC(11)
105         Z_SUMF1= 0.0_JPRB
106         Z_SUMF2= 0.0_JPRB
107   DO IPR = 1, NGN(NGS(10)+IGC)
108            IPRSM = IPRSM + 1
109            Z_SUMF1= Z_SUMF1+ FRACREFAO(IPRSM)
110            Z_SUMF2= Z_SUMF2+ FRACREFBO(IPRSM)
111   ENDDO
112         FRACREFA(IGC) = Z_SUMF1
113         FRACREFB(IGC) = Z_SUMF2
114 ENDDO
115
116IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB11',1,ZHOOK_HANDLE)
117END SUBROUTINE RRTM_CMBGB11
Note: See TracBrowser for help on using the repository browser.