1 |
|
|
SUBROUTINE SRTM_INIT |
2 |
|
|
|
3 |
|
|
!-- read in the basic coefficients to configure RRTM_SW |
4 |
|
|
!- creates module YOESRTWN with BG, NSPA, NSPB, WAVENUM1, WAVENUM2, |
5 |
|
|
! DELWAVE, PREF, PREFLOG, TREF |
6 |
|
|
|
7 |
|
|
USE PARKIND1 ,ONLY : JPIM , JPRB |
8 |
|
|
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
9 |
|
|
|
10 |
|
|
USE PARSRTM , ONLY : JPG, JPSW |
11 |
|
|
USE YOESRTWN , ONLY : NG, NGM, WT, NGC, NGN, RWGT, WTSM |
12 |
|
|
|
13 |
|
|
IMPLICIT NONE |
14 |
|
|
|
15 |
|
|
! Local variables |
16 |
|
|
INTEGER(KIND=JPIM) :: IGC, IGCSM, IBND, IG, IND, IPR, IPRSM |
17 |
|
|
REAL(KIND=JPRB) :: ZWTSUM |
18 |
|
|
|
19 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
20 |
|
|
|
21 |
|
|
#include "susrtm.intfb.h" |
22 |
|
|
#include "srtm_kgb16.intfb.h" |
23 |
|
|
#include "srtm_kgb17.intfb.h" |
24 |
|
|
#include "srtm_kgb18.intfb.h" |
25 |
|
|
#include "srtm_kgb19.intfb.h" |
26 |
|
|
#include "srtm_kgb20.intfb.h" |
27 |
|
|
#include "srtm_kgb21.intfb.h" |
28 |
|
|
#include "srtm_kgb22.intfb.h" |
29 |
|
|
#include "srtm_kgb23.intfb.h" |
30 |
|
|
#include "srtm_kgb24.intfb.h" |
31 |
|
|
#include "srtm_kgb25.intfb.h" |
32 |
|
|
#include "srtm_kgb26.intfb.h" |
33 |
|
|
#include "srtm_kgb27.intfb.h" |
34 |
|
|
#include "srtm_kgb28.intfb.h" |
35 |
|
|
#include "srtm_kgb29.intfb.h" |
36 |
|
|
!#include "susrtop.intfb.h" |
37 |
|
|
|
38 |
|
|
#include "srtm_cmbgb16.intfb.h" |
39 |
|
|
#include "srtm_cmbgb17.intfb.h" |
40 |
|
|
#include "srtm_cmbgb18.intfb.h" |
41 |
|
|
#include "srtm_cmbgb19.intfb.h" |
42 |
|
|
#include "srtm_cmbgb20.intfb.h" |
43 |
|
|
#include "srtm_cmbgb21.intfb.h" |
44 |
|
|
#include "srtm_cmbgb22.intfb.h" |
45 |
|
|
#include "srtm_cmbgb23.intfb.h" |
46 |
|
|
#include "srtm_cmbgb24.intfb.h" |
47 |
|
|
#include "srtm_cmbgb25.intfb.h" |
48 |
|
|
#include "srtm_cmbgb26.intfb.h" |
49 |
|
|
#include "srtm_cmbgb27.intfb.h" |
50 |
|
|
#include "srtm_cmbgb28.intfb.h" |
51 |
|
|
#include "srtm_cmbgb29.intfb.h" |
52 |
|
|
|
53 |
|
|
IF (LHOOK) CALL DR_HOOK('SRTM_INIT',0,ZHOOK_HANDLE) |
54 |
|
|
|
55 |
|
|
CALL SUSRTM |
56 |
|
|
|
57 |
|
|
!-- read in the molecular absorption coefficients |
58 |
|
|
|
59 |
|
|
CALL SRTM_KGB16 |
60 |
|
|
CALL SRTM_KGB17 |
61 |
|
|
CALL SRTM_KGB18 |
62 |
|
|
CALL SRTM_KGB19 |
63 |
|
|
CALL SRTM_KGB20 |
64 |
|
|
CALL SRTM_KGB21 |
65 |
|
|
CALL SRTM_KGB22 |
66 |
|
|
CALL SRTM_KGB23 |
67 |
|
|
CALL SRTM_KGB24 |
68 |
|
|
CALL SRTM_KGB25 |
69 |
|
|
CALL SRTM_KGB26 |
70 |
|
|
CALL SRTM_KGB27 |
71 |
|
|
CALL SRTM_KGB28 |
72 |
|
|
CALL SRTM_KGB29 |
73 |
|
|
|
74 |
|
|
!-- read in the cloud optical properties |
75 |
|
|
!- creates module YOESRTOP with EXTLIQ1, SSALIQ1, ASYLIQ1, |
76 |
|
|
! EXTICE3, SSAICE3, ASYICE3, FDLICE3 |
77 |
|
|
|
78 |
|
|
!-- RRTM_SW cloud optical properties are not used |
79 |
|
|
! SRTM_CLDPROP is not called |
80 |
|
|
! no need to call SUSRTOP |
81 |
|
|
|
82 |
|
|
!CALL SUSRTOP ( -1 ) |
83 |
|
|
|
84 |
|
|
|
85 |
|
|
!Mike Iacono 20050804 |
86 |
|
|
!-- Perform g-point reduction from 16 per band (224 total points) to |
87 |
|
|
!-- a band dependent number (112 total points) for all absorption |
88 |
|
|
!-- coefficient input data and Planck fraction input data. |
89 |
|
|
!-- Compute relative weighting for new g-point combinations. |
90 |
|
|
|
91 |
|
|
IGCSM = 0 |
92 |
|
|
DO IBND = 1,JPSW |
93 |
|
|
IPRSM = 0 |
94 |
|
|
IF (NGC(IBND) < JPG) THEN |
95 |
|
|
DO IGC = 1,NGC(IBND) |
96 |
|
|
IGCSM = IGCSM + 1 |
97 |
|
|
ZWTSUM = 0. |
98 |
|
|
DO IPR = 1, NGN(IGCSM) |
99 |
|
|
IPRSM = IPRSM + 1 |
100 |
|
|
ZWTSUM = ZWTSUM + WT(IPRSM) |
101 |
|
|
ENDDO |
102 |
|
|
WTSM(IGC) = ZWTSUM |
103 |
|
|
ENDDO |
104 |
|
|
|
105 |
|
|
DO IG = 1,NG(IBND+15) |
106 |
|
|
IND = (IBND-1)*JPG + IG |
107 |
|
|
RWGT(IND) = WT(IG)/WTSM(NGM(IND)) |
108 |
|
|
ENDDO |
109 |
|
|
ELSE |
110 |
|
|
DO IG = 1,NG(IBND+15) |
111 |
|
|
IGCSM = IGCSM + 1 |
112 |
|
|
IND = (IBND-1)*JPG + IG |
113 |
|
|
RWGT(IND) = 1.0 |
114 |
|
|
ENDDO |
115 |
|
|
ENDIF |
116 |
|
|
ENDDO |
117 |
|
|
|
118 |
|
|
CALL SRTM_CMBGB16 |
119 |
|
|
CALL SRTM_CMBGB17 |
120 |
|
|
CALL SRTM_CMBGB18 |
121 |
|
|
CALL SRTM_CMBGB19 |
122 |
|
|
CALL SRTM_CMBGB20 |
123 |
|
|
CALL SRTM_CMBGB21 |
124 |
|
|
CALL SRTM_CMBGB22 |
125 |
|
|
CALL SRTM_CMBGB23 |
126 |
|
|
CALL SRTM_CMBGB24 |
127 |
|
|
CALL SRTM_CMBGB25 |
128 |
|
|
CALL SRTM_CMBGB26 |
129 |
|
|
CALL SRTM_CMBGB27 |
130 |
|
|
CALL SRTM_CMBGB28 |
131 |
|
|
CALL SRTM_CMBGB29 |
132 |
|
|
|
133 |
|
|
!----------------------------------------------------------------------- |
134 |
|
|
IF (LHOOK) CALL DR_HOOK('SRTM_INIT',1,ZHOOK_HANDLE) |
135 |
|
|
END SUBROUTINE SRTM_INIT |
136 |
|
|
|