source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/phyiso/rrtm/rrtm_cmbgb12.F90 @ 5313

Last change on this file since 5313 was 3331, checked in by acozic, 6 years ago

Add modification for isotopes

  • Property svn:executable set to *
File size: 1.8 KB
Line 
1!***************************************************************************
2SUBROUTINE RRTM_CMBGB12
3!***************************************************************************
4
5!     BAND 12:  1800-2080 cm-1 (low - H2O,CO2; high - nothing)
6!***************************************************************************
7
8! Parameters
9USE PARKIND1  ,ONLY : JPIM     ,JPRB
10USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
11
12USE YOERRTO12, ONLY : KAO     ,SELFREFO   ,FRACREFAO
13USE YOERRTA12, ONLY : KA      ,SELFREF    ,FRACREFA
14USE YOERRTRWT, ONLY : FREFA    ,FREFADF  ,RWGT
15USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN     
16
17IMPLICIT NONE
18
19INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JN, JP, JT
20
21REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK
22REAL(KIND=JPRB) :: ZHOOK_HANDLE
23
24IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB12',0,ZHOOK_HANDLE)
25DO JN = 1,9
26  DO JT = 1,5
27    DO JP = 1,13
28      IPRSM = 0
29      DO IGC = 1,NGC(12)
30        Z_SUMK = 0.0_JPRB
31        DO IPR = 1, NGN(NGS(11)+IGC)
32          IPRSM = IPRSM + 1
33
34          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+176)
35        ENDDO
36
37        KA(JN,JT,JP,IGC) = Z_SUMK
38      ENDDO
39    ENDDO
40  ENDDO
41ENDDO
42
43DO JT = 1,10
44  IPRSM = 0
45  DO IGC = 1,NGC(12)
46    Z_SUMK = 0.0_JPRB
47    DO IPR = 1, NGN(NGS(11)+IGC)
48      IPRSM = IPRSM + 1
49
50      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+176)
51    ENDDO
52
53    SELFREF(JT,IGC) = Z_SUMK
54  ENDDO
55ENDDO
56
57DO JP = 1,9
58  IPRSM = 0
59  DO IGC = 1,NGC(12)
60    Z_SUMF = 0.0_JPRB
61    DO IPR = 1, NGN(NGS(11)+IGC)
62      IPRSM = IPRSM + 1
63
64      Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JP)
65    ENDDO
66
67    FRACREFA(IGC,JP) = Z_SUMF
68  ENDDO
69ENDDO
70
71DO JP = 1,9
72  DO IGC = 1,NGC(12)
73
74    FREFA(NGS(11)+IGC,JP) = FRACREFA(IGC,JP)
75  ENDDO
76ENDDO
77DO JP = 1,8
78  DO IGC = 1,NGC(12)
79
80    FREFADF(NGS(11)+IGC,JP) = FRACREFA(IGC,JP+1) -FRACREFA(IGC,JP)
81  ENDDO
82ENDDO
83
84IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB12',1,ZHOOK_HANDLE)
85END SUBROUTINE RRTM_CMBGB12
Note: See TracBrowser for help on using the repository browser.