source: LMDZ5/branches/testing/libf/phylmd/rrtm/rrtm_cmbgb7.F90

Last change on this file was 1999, checked in by Laurent Fairhead, 11 years ago

Merged trunk changes r1920:1997 into testing branch

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 2.5 KB
Line 
1!***************************************************************************
2SUBROUTINE RRTM_CMBGB7
3!***************************************************************************
4
5!     BAND 7:  980-1080 cm-1 (low - H2O,O3; high - O3)
6!***************************************************************************
7
8! Parameters
9USE PARKIND1  ,ONLY : JPIM     ,JPRB
10USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
11
12USE YOERRTO7 , ONLY : KAO     ,KBO     ,SELFREFO   ,FRACREFAO  ,&
13 & FRACREFBO, ABSCO2O 
14USE YOERRTA7 , ONLY : KA      ,KB      ,SELFREF    ,FRACREFA   ,&
15 & FRACREFB , ABSCO2 
16USE YOERRTRWT, ONLY : FREFA    ,FREFB    ,FREFADF  ,RWGT
17USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN     
18
19IMPLICIT NONE
20
21INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JN, JP, JT
22
23REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK
24REAL(KIND=JPRB) :: ZHOOK_HANDLE
25
26IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB7',0,ZHOOK_HANDLE)
27DO JN = 1,9
28  DO JT = 1,5
29    DO JP = 1,13
30      IPRSM = 0
31      DO IGC = 1,NGC(7)
32        Z_SUMK = 0.0_JPRB
33        DO IPR = 1, NGN(NGS(6)+IGC)
34          IPRSM = IPRSM + 1
35
36          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+96)
37        ENDDO
38
39        KA(JN,JT,JP,IGC) = Z_SUMK
40      ENDDO
41    ENDDO
42  ENDDO
43ENDDO
44DO JT = 1,5
45  DO JP = 13,59
46    IPRSM = 0
47    DO IGC = 1,NGC(7)
48      Z_SUMK = 0.0_JPRB
49      DO IPR = 1, NGN(NGS(6)+IGC)
50        IPRSM = IPRSM + 1
51
52        Z_SUMK = Z_SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM+96)
53      ENDDO
54
55      KB(JT,JP,IGC) = Z_SUMK
56    ENDDO
57  ENDDO
58ENDDO
59
60DO JT = 1,10
61  IPRSM = 0
62  DO IGC = 1,NGC(7)
63    Z_SUMK = 0.0_JPRB
64    DO IPR = 1, NGN(NGS(6)+IGC)
65      IPRSM = IPRSM + 1
66
67      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+96)
68    ENDDO
69
70    SELFREF(JT,IGC) = Z_SUMK
71  ENDDO
72ENDDO
73
74DO JP = 1,9
75  IPRSM = 0
76  DO IGC = 1,NGC(7)
77    Z_SUMF = 0.0_JPRB
78    DO IPR = 1, NGN(NGS(6)+IGC)
79      IPRSM = IPRSM + 1
80
81      Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JP)
82    ENDDO
83
84    FRACREFA(IGC,JP) = Z_SUMF
85  ENDDO
86ENDDO
87
88IPRSM = 0
89DO IGC = 1,NGC(7)
90  Z_SUMF = 0.0_JPRB
91  Z_SUMK = 0.0_JPRB
92  DO IPR = 1, NGN(NGS(6)+IGC)
93    IPRSM = IPRSM + 1
94
95    Z_SUMF = Z_SUMF + FRACREFBO(IPRSM)
96    Z_SUMK = Z_SUMK + ABSCO2O(IPRSM)*RWGT(IPRSM+96)
97  ENDDO
98
99  FRACREFB(IGC) = Z_SUMF
100  ABSCO2(IGC) = Z_SUMK
101ENDDO
102
103DO JP = 1,9
104  DO IGC = 1,NGC(7)
105
106    FREFA(NGS(6)+IGC,JP) = FRACREFA(IGC,JP)
107  ENDDO
108ENDDO
109DO JP = 1,8
110  DO IGC = 1,NGC(7)
111
112    FREFADF(NGS(6)+IGC,JP) = FRACREFA(IGC,JP+1) -FRACREFA(IGC,JP)
113  ENDDO
114ENDDO
115DO IGC = 1,NGC(7)
116
117  FREFB(NGS(6)+IGC,1) = FRACREFB(IGC)
118ENDDO
119
120IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB7',1,ZHOOK_HANDLE)
121END SUBROUTINE RRTM_CMBGB7
Note: See TracBrowser for help on using the repository browser.