source: LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/ifsrrtm/rrtm_cmbgb13.F90 @ 4947

Last change on this file since 4947 was 4728, checked in by idelkadi, 13 months ago

Update of ecrad in the LMDZ_ECRad branch of LMDZ:

  • version 1.6.1 of ecrad
  • files are no longer grouped in the same ecrad directory.
  • the structure of ecrad offline is preserved to facilitate updating in LMDZ
  • cfg.bld modified to take into account the new added subdirectories.
  • the interface routines and those added in ecrad are moved to the phylmd directory
File size: 3.0 KB
Line 
1!***************************************************************************
2SUBROUTINE RRTM_CMBGB13
3!***************************************************************************
4
5!     BAND 13:  2080-2250 cm-1 (low - H2O,N2O; high - nothing)
6!     ABozzo 201306 updated to rrtmg v4.85
7!     band 13:  2080-2250 cm-1 (low key - h2o,n2o; high minor - o3 minor)
8!***************************************************************************
9
10! Parameters
11USE PARKIND1  ,ONLY : JPIM     ,JPRB
12USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK, JPHOOK
13
14USE YOERRTO13, ONLY : KAO     ,SELFREFO, FORREFO   ,FRACREFAO, FRACREFBO, &
15                     & KAO_MCO2, KAO_MCO, KBO_MO3
16USE YOERRTA13, ONLY : KA      ,SELFREF, FORREF    ,FRACREFA, FRACREFB, &
17                     & KA_MCO2, KA_MCO, KB_MO3
18USE YOERRTRWT, ONLY : RWGT
19USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN     
20
21IMPLICIT NONE
22
23INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JN, JP, JT
24
25REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK, Z_SUMK1, Z_SUMK2
26REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
27
28
29IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB13',0,ZHOOK_HANDLE)
30DO JN = 1,9
31  DO JT = 1,5
32    DO JP = 1,13
33      IPRSM = 0
34      DO IGC = 1,NGC(13)
35        Z_SUMK = 0.0_JPRB
36        DO IPR = 1, NGN(NGS(12)+IGC)
37          IPRSM = IPRSM + 1
38
39          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+192)
40        ENDDO
41
42        KA(JN,JT,JP,IGC) = Z_SUMK
43      ENDDO
44    ENDDO
45  ENDDO
46ENDDO
47
48DO JN = 1,9
49   DO JT = 1,19
50      IPRSM = 0
51      DO IGC = 1,NGC(13)
52        Z_SUMK1 = 0.0_JPRB
53        Z_SUMK2 = 0.0_JPRB
54         DO IPR = 1, NGN(NGS(12)+IGC)
55            IPRSM = IPRSM + 1
56            Z_SUMK1 = Z_SUMK1 + KAO_MCO2(JN,JT,IPRSM)*RWGT(IPRSM+192)
57            Z_SUMK2 = Z_SUMK2 + KAO_MCO(JN,JT,IPRSM)*RWGT(IPRSM+192)
58         ENDDO
59         KA_MCO2(JN,JT,IGC) = Z_SUMK1
60         KA_MCO(JN,JT,IGC) = Z_SUMK2
61      ENDDO
62   ENDDO
63ENDDO
64
65DO JT = 1,19
66   IPRSM = 0
67   DO IGC = 1,NGC(13)
68      Z_SUMK = 0.0_JPRB
69      DO IPR = 1, NGN(NGS(12)+IGC)
70         IPRSM = IPRSM + 1
71         Z_SUMK = Z_SUMK + KBO_MO3(JT,IPRSM)*RWGT(IPRSM+192)
72      ENDDO
73      KB_MO3(JT,IGC) = Z_SUMK
74   ENDDO
75ENDDO
76
77
78DO JT = 1,10
79  IPRSM = 0
80  DO IGC = 1,NGC(13)
81    Z_SUMK = 0.0_JPRB
82    DO IPR = 1, NGN(NGS(12)+IGC)
83      IPRSM = IPRSM + 1
84
85      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+192)
86    ENDDO
87
88    SELFREF(JT,IGC) = Z_SUMK
89  ENDDO
90ENDDO
91
92DO JT = 1,4
93   IPRSM = 0
94   DO IGC = 1,NGC(13)
95      Z_SUMK = 0.0_JPRB
96      DO IPR = 1, NGN(NGS(12)+IGC)
97         IPRSM = IPRSM + 1
98         Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+192)
99      ENDDO
100      FORREF(JT,IGC) = Z_SUMK
101   ENDDO
102ENDDO
103
104IPRSM = 0
105DO IGC = 1,NGC(13)
106   Z_SUMF = 0.0_JPRB
107   DO IPR = 1, NGN(NGS(12)+IGC)
108      IPRSM = IPRSM + 1
109      Z_SUMF = Z_SUMF + FRACREFBO(IPRSM)
110   ENDDO
111   FRACREFB(IGC) = Z_SUMF
112ENDDO
113
114DO JP = 1,9
115  IPRSM = 0
116  DO IGC = 1,NGC(13)
117    Z_SUMF = 0.0_JPRB
118    DO IPR = 1, NGN(NGS(12)+IGC)
119      IPRSM = IPRSM + 1
120
121      Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JP)
122    ENDDO
123
124    FRACREFA(IGC,JP) = Z_SUMF
125  ENDDO
126ENDDO
127
128IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB13',1,ZHOOK_HANDLE)
129END SUBROUTINE RRTM_CMBGB13
Note: See TracBrowser for help on using the repository browser.