1 |
|
71568 |
SUBROUTINE RRTM_GASABS1A_140GP (KLEV,P_ATR1,P_OD,P_TF1,P_COLDRY,P_WX,& |
2 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,P_ONEMINUS,& |
3 |
|
|
& P_COLH2O,P_COLCO2,P_COLO3,P_COLN2O,P_COLCH4,P_COLO2,P_CO2MULT,& |
4 |
|
|
& K_LAYTROP,K_LAYSWTCH,K_LAYLOW,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) |
5 |
|
|
|
6 |
|
|
! Reformatted for F90 by JJMorcrette, ECMWF, 980714 |
7 |
|
|
|
8 |
|
|
USE PARKIND1 ,ONLY : JPIM ,JPRB |
9 |
|
|
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
10 |
|
|
|
11 |
|
|
USE PARRRTM , ONLY : JPLAY ,JPBAND ,JPGPT ,JPXSEC |
12 |
|
|
USE YOERRTAB , ONLY : TRANS ,BPADE |
13 |
|
|
|
14 |
|
|
IMPLICIT NONE |
15 |
|
|
|
16 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KLEV |
17 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: P_ATR1(JPGPT,JPLAY) |
18 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: P_OD(JPGPT,JPLAY) |
19 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: P_TF1(JPGPT,JPLAY) |
20 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_COLDRY(JPLAY) |
21 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_WX(JPXSEC,JPLAY) ! Amount of trace gases |
22 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(JPLAY,JPBAND) |
23 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY) |
24 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY) |
25 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY) |
26 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY) |
27 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(JPLAY) |
28 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY) |
29 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY) |
30 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY) |
31 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS |
32 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY) |
33 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(JPLAY) |
34 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(JPLAY) |
35 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_COLN2O(JPLAY) |
36 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCH4(JPLAY) |
37 |
|
|
REAL(KIND=JPRB) :: P_COLO2(JPLAY) ! Argument NOT used |
38 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_CO2MULT(JPLAY) |
39 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP |
40 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYSWTCH |
41 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYLOW |
42 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY) |
43 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY) |
44 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY) |
45 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(JPGPT,JPLAY) |
46 |
|
|
!- from AER |
47 |
|
|
!- from INTFAC |
48 |
|
|
!- from INTIND |
49 |
|
|
!- from PRECISE |
50 |
|
|
!- from PROFDATA |
51 |
|
|
!- from SELF |
52 |
|
|
!- from SP |
53 |
|
|
REAL(KIND=JPRB) :: Z_TAU (JPGPT,JPLAY) |
54 |
|
|
|
55 |
|
|
INTEGER(KIND=JPIM) :: IPR, ITR, I_LAY |
56 |
|
|
|
57 |
|
|
REAL(KIND=JPRB) :: Z_ODEPTH, Z_SECANG, Z_TF |
58 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
59 |
|
|
|
60 |
|
|
#include "rrtm_taumol1.intfb.h" |
61 |
|
|
#include "rrtm_taumol10.intfb.h" |
62 |
|
|
#include "rrtm_taumol11.intfb.h" |
63 |
|
|
#include "rrtm_taumol12.intfb.h" |
64 |
|
|
#include "rrtm_taumol13.intfb.h" |
65 |
|
|
#include "rrtm_taumol14.intfb.h" |
66 |
|
|
#include "rrtm_taumol15.intfb.h" |
67 |
|
|
#include "rrtm_taumol16.intfb.h" |
68 |
|
|
#include "rrtm_taumol2.intfb.h" |
69 |
|
|
#include "rrtm_taumol3.intfb.h" |
70 |
|
|
#include "rrtm_taumol4.intfb.h" |
71 |
|
|
#include "rrtm_taumol5.intfb.h" |
72 |
|
|
#include "rrtm_taumol6.intfb.h" |
73 |
|
|
#include "rrtm_taumol7.intfb.h" |
74 |
|
|
#include "rrtm_taumol8.intfb.h" |
75 |
|
|
#include "rrtm_taumol9.intfb.h" |
76 |
|
|
|
77 |
|
|
!- SECANG is equal to the secant of the diffusivity angle. |
78 |
✓✗ |
71568 |
IF (LHOOK) CALL DR_HOOK('RRTM_GASABS1A_140GP',0,ZHOOK_HANDLE) |
79 |
|
|
Z_SECANG = 1.66_JPRB |
80 |
|
|
|
81 |
|
|
CALL RRTM_TAUMOL1 (KLEV,Z_TAU,& |
82 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,& |
83 |
|
71568 |
& P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) |
84 |
|
|
CALL RRTM_TAUMOL2 (KLEV,Z_TAU,P_COLDRY,& |
85 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,& |
86 |
|
71568 |
& P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) |
87 |
|
|
CALL RRTM_TAUMOL3 (KLEV,Z_TAU,& |
88 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,P_ONEMINUS,& |
89 |
|
71568 |
& P_COLH2O,P_COLCO2,P_COLN2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) |
90 |
|
|
CALL RRTM_TAUMOL4 (KLEV,Z_TAU,& |
91 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,P_ONEMINUS,& |
92 |
|
71568 |
& P_COLH2O,P_COLCO2,P_COLO3,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) |
93 |
|
|
CALL RRTM_TAUMOL5 (KLEV,Z_TAU,P_WX,& |
94 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,P_ONEMINUS,& |
95 |
|
71568 |
& P_COLH2O,P_COLCO2,P_COLO3,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) |
96 |
|
|
CALL RRTM_TAUMOL6 (KLEV,Z_TAU,P_WX,& |
97 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,& |
98 |
|
71568 |
& P_COLH2O,P_CO2MULT,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) |
99 |
|
|
CALL RRTM_TAUMOL7 (KLEV,Z_TAU,& |
100 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,& |
101 |
|
71568 |
& P_COLH2O,P_COLO3,P_CO2MULT,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) |
102 |
|
|
CALL RRTM_TAUMOL8 (KLEV,Z_TAU,P_WX,& |
103 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,& |
104 |
|
71568 |
& P_COLH2O,P_COLO3,P_COLN2O,P_CO2MULT,K_LAYSWTCH,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) |
105 |
|
|
CALL RRTM_TAUMOL9 (KLEV,Z_TAU,& |
106 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,& |
107 |
|
71568 |
& P_COLH2O,P_COLN2O,P_COLCH4,K_LAYTROP,K_LAYSWTCH,K_LAYLOW,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) |
108 |
|
|
CALL RRTM_TAUMOL10 (KLEV,Z_TAU,& |
109 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,& |
110 |
|
71568 |
& P_COLH2O,K_LAYTROP,PFRAC) |
111 |
|
|
CALL RRTM_TAUMOL11 (KLEV,Z_TAU,& |
112 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,& |
113 |
|
71568 |
& P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) |
114 |
|
|
CALL RRTM_TAUMOL12 (KLEV,Z_TAU,& |
115 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,& |
116 |
|
71568 |
& P_COLH2O,P_COLCO2,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) |
117 |
|
|
CALL RRTM_TAUMOL13 (KLEV,Z_TAU,& |
118 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,& |
119 |
|
71568 |
& P_COLH2O,P_COLN2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) |
120 |
|
|
CALL RRTM_TAUMOL14 (KLEV,Z_TAU,& |
121 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,& |
122 |
|
71568 |
& P_COLCO2,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) |
123 |
|
|
CALL RRTM_TAUMOL15 (KLEV,Z_TAU,& |
124 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,& |
125 |
|
71568 |
& P_COLH2O,P_COLCO2,P_COLN2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) |
126 |
|
|
CALL RRTM_TAUMOL16 (KLEV,Z_TAU,& |
127 |
|
|
& P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,& |
128 |
|
71568 |
& P_COLH2O,P_COLCH4,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) |
129 |
|
|
|
130 |
|
|
!- Loop over g-channels. |
131 |
✓✓ |
2862720 |
DO I_LAY = 1, KLEV |
132 |
✓✓ |
393624000 |
DO IPR = 1, JPGPT |
133 |
|
390761280 |
Z_ODEPTH = Z_SECANG * Z_TAU(IPR,I_LAY) |
134 |
|
390761280 |
P_OD(IPR,I_LAY) = Z_ODEPTH |
135 |
|
390761280 |
Z_ODEPTH=0.5D0*(ABS(Z_ODEPTH)+Z_ODEPTH) |
136 |
|
|
|
137 |
|
|
!-- revised code to get the pre-computed transmission |
138 |
|
|
! IF (ODEPTH.LE.0.) PRINT*, 'ODEPTH = ',ODEPTH |
139 |
|
|
!! IF (ODEPTH <= _ZERO_)THEN |
140 |
|
|
!! ATR1(IPR,LAY) = _ONE_ - TRANS(0) |
141 |
|
|
!! TF1(IPR,LAY) = _ZERO_ |
142 |
|
|
!! ELSE |
143 |
|
|
|
144 |
|
390761280 |
Z_TF = Z_ODEPTH/(BPADE+Z_ODEPTH) |
145 |
|
390761280 |
ITR=INT(5.E+03_JPRB*Z_TF+0.5_JPRB) |
146 |
|
|
IF (ITR.LT.0) ITR=0 ! MPL 12.12.08 |
147 |
|
390761280 |
P_ATR1(IPR,I_LAY) = 1.0_JPRB - TRANS(ITR) |
148 |
|
393552432 |
P_TF1(IPR,I_LAY) = Z_TF |
149 |
|
|
|
150 |
|
|
!! ENDIF |
151 |
|
|
ENDDO |
152 |
|
|
ENDDO |
153 |
|
|
|
154 |
|
|
! ----------------------------------------------------------------- |
155 |
|
|
|
156 |
✓✗ |
71568 |
IF (LHOOK) CALL DR_HOOK('RRTM_GASABS1A_140GP',1,ZHOOK_HANDLE) |
157 |
|
71568 |
END SUBROUTINE RRTM_GASABS1A_140GP |