6 SUBROUTINE coupling_isba_svat_n (DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST, SLT, &
8 ptstep, kyear, kmonth, kday, ptime, ki, ksv, ksw, ptsun, pzenith, pzenith2, &
9 pazim, pzref, puref, pzs, pu, pv, pqa, pta, prhoa, psv, pco2, hsv, &
10 prain, psnow, plw, pdir_sw, psca_sw, psw_bands, pps, ppa, &
11 psftq, psfth, psfts, psfco2, psfu, psfv, &
12 ptrad, pdir_alb, psca_alb, pemis, ptsurf, pz0, pz0h, pqsurf, &
13 ppew_a_coef, ppew_b_coef, &
14 ppet_a_coef, ppeq_a_coef, ppet_b_coef, ppeq_b_coef, &
60 USE yomhook
,ONLY : lhook, dr_hook
61 USE parkind1
,ONLY : jprb
63 USE modi_coupling_isba_orography_n
70 TYPE(isba_model_t
),
INTENT(INOUT) :: im
78 TYPE(dst_t),
INTENT(INOUT) :: dst
79 TYPE(slt_t),
INTENT(INOUT) :: slt
81 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
82 CHARACTER(LEN=1),
INTENT(IN) :: hcoupling
85 INTEGER,
INTENT(IN) :: kyear
86 INTEGER,
INTENT(IN) :: kmonth
87 INTEGER,
INTENT(IN) :: kday
88 REAL,
INTENT(IN) :: ptime
89 INTEGER,
INTENT(IN) :: ki
90 INTEGER,
INTENT(IN) :: ksv
91 INTEGER,
INTENT(IN) :: ksw
92 REAL,
DIMENSION(KI),
INTENT(IN) :: ptsun
93 REAL,
INTENT(IN) :: ptstep
94 REAL,
DIMENSION(KI),
INTENT(IN) :: pzref
95 REAL,
DIMENSION(KI),
INTENT(IN) :: puref
97 REAL,
DIMENSION(KI),
INTENT(IN) :: pta
98 REAL,
DIMENSION(KI),
INTENT(IN) :: pqa
99 REAL,
DIMENSION(KI),
INTENT(IN) :: prhoa
100 REAL,
DIMENSION(KI,KSV),
INTENT(IN) :: psv
103 CHARACTER(LEN=6),
DIMENSION(KSV),
INTENT(IN):: hsv
104 REAL,
DIMENSION(KI),
INTENT(IN) :: pu
105 REAL,
DIMENSION(KI),
INTENT(IN) :: pv
106 REAL,
DIMENSION(KI,KSW),
INTENT(IN) :: pdir_sw
108 REAL,
DIMENSION(KI,KSW),
INTENT(IN) :: psca_sw
110 REAL,
DIMENSION(KSW),
INTENT(IN) :: psw_bands
111 REAL,
DIMENSION(KI),
INTENT(IN) :: pzenith
112 REAL,
DIMENSION(KI),
INTENT(IN) :: pzenith2
113 REAL,
DIMENSION(KI),
INTENT(IN) :: pazim
114 REAL,
DIMENSION(KI),
INTENT(IN) :: plw
116 REAL,
DIMENSION(KI),
INTENT(IN) :: pps
117 REAL,
DIMENSION(KI),
INTENT(IN) :: ppa
118 REAL,
DIMENSION(KI),
INTENT(IN) :: pzs
119 REAL,
DIMENSION(KI),
INTENT(IN) :: pco2
120 REAL,
DIMENSION(KI),
INTENT(IN) :: psnow
121 REAL,
DIMENSION(KI),
INTENT(IN) :: prain
123 REAL,
DIMENSION(KI),
INTENT(OUT) :: psfth
124 REAL,
DIMENSION(KI),
INTENT(OUT) :: psftq
125 REAL,
DIMENSION(KI),
INTENT(OUT) :: psfu
126 REAL,
DIMENSION(KI),
INTENT(OUT) :: psfv
127 REAL,
DIMENSION(KI),
INTENT(OUT) :: psfco2
128 REAL,
DIMENSION(KI,KSV),
INTENT(OUT):: psfts
130 REAL,
DIMENSION(KI),
INTENT(OUT) :: ptrad
131 REAL,
DIMENSION(KI,KSW),
INTENT(OUT):: pdir_alb
132 REAL,
DIMENSION(KI,KSW),
INTENT(OUT):: psca_alb
133 REAL,
DIMENSION(KI),
INTENT(OUT) :: pemis
135 REAL,
DIMENSION(KI),
INTENT(OUT) :: ptsurf
136 REAL,
DIMENSION(KI),
INTENT(OUT) :: pz0
137 REAL,
DIMENSION(KI),
INTENT(OUT) :: pz0h
138 REAL,
DIMENSION(KI),
INTENT(OUT) :: pqsurf
140 REAL,
DIMENSION(KI),
INTENT(IN) :: ppew_a_coef
141 REAL,
DIMENSION(KI),
INTENT(IN) :: ppew_b_coef
142 REAL,
DIMENSION(KI),
INTENT(IN) :: ppet_a_coef
143 REAL,
DIMENSION(KI),
INTENT(IN) :: ppeq_a_coef
144 REAL,
DIMENSION(KI),
INTENT(IN) :: ppet_b_coef
145 REAL,
DIMENSION(KI),
INTENT(IN) :: ppeq_b_coef
146 CHARACTER(LEN=2),
INTENT(IN) :: htest
150 REAL,
DIMENSION(KI) :: zsfth
151 REAL,
DIMENSION(KI) :: zsftq
152 REAL,
DIMENSION(KI) :: zsfco2
153 REAL,
DIMENSION(KI,KSV) :: zsfts
154 REAL,
DIMENSION(KI) :: zsfu
155 REAL,
DIMENSION(KI) :: zsfv
156 REAL,
DIMENSION(KI) :: ztrad
157 REAL,
DIMENSION(KI) :: zemis
158 REAL,
DIMENSION(KI,KSW) :: zdir_alb
159 REAL,
DIMENSION(KI,KSW) :: zsca_alb
160 REAL,
DIMENSION(KI) :: ztsurf
161 REAL,
DIMENSION(KI) :: zz0
162 REAL,
DIMENSION(KI) :: zz0h
163 REAL,
DIMENSION(KI) :: zqsurf
165 REAL,
DIMENSION(KI) :: zwork_lw
166 REAL,
DIMENSION(KI) :: zwork_z0
167 REAL,
DIMENSION(KI) :: zwork_z0h
174 REAL(KIND=JPRB) :: zhook_handle
182 IF (lhook) CALL dr_hook(
'COUPLING_ISBA_SVAT_N',0,zhook_handle)
183 IF (hcoupling==
'I')
THEN
189 ELSE IF (im%I%XTSTEP==xundef)
THEN
196 it=max(nint(ptstep/im%I%XTSTEP),1)
243 CALL
coupling_isba_orography_n(dtco, ug, u, uss, im, dtgd, dtgr, tgro, dst, slt, &
244 hprogram, hcoupling, &
245 ztstep, kyear, kmonth, kday, ptime, &
247 ptsun, pzenith, pzenith2, pazim, &
248 pzref, puref, pzs, pu, pv, pqa, pta, prhoa, psv, pco2, hsv, &
249 prain, psnow, plw, pdir_sw, psca_sw, psw_bands, pps, ppa, &
250 zsftq, zsfth, zsfts, zsfco2, zsfu, zsfv, &
251 ztrad, zdir_alb, zsca_alb, zemis, ztsurf, zz0, zz0h, zqsurf, &
252 ppew_a_coef, ppew_b_coef, &
253 ppet_a_coef, ppeq_a_coef, ppet_b_coef, ppeq_b_coef, &
256 psftq = psftq + zsftq / zt
257 psfth = psfth + zsfth / zt
258 psfts = psfts + zsfts / zt
259 psfco2 = psfco2 + zsfco2 / zt
260 psfu = psfu + zsfu / zt
261 psfv = psfv + zsfv / zt
262 pemis = pemis + zemis / zt
263 pdir_alb = pdir_alb + zdir_alb / zt
264 psca_alb = psca_alb + zsca_alb / zt
265 ptsurf = ptsurf + ztsurf / zt
266 pqsurf = pqsurf + zqsurf / zt
268 zwork_lw = zwork_lw + zemis*ztrad**4 / zt
269 zwork_z0 = zwork_z0 + (1.0/(log(puref(:)/zz0 ))**2) / zt
270 zwork_z0h = zwork_z0h + (1.0/(log(pzref(:)/zz0h))**2) / zt
276 ptrad = (zwork_lw/pemis)**(0.25)
280 pz0 = puref(:) * exp( - sqrt(1./zwork_z0(:)) )
281 pz0h = pzref(:) * exp( - sqrt(1./zwork_z0h(:)) )
283 IF (lhook) CALL dr_hook(
'COUPLING_ISBA_SVAT_N',1,zhook_handle)
subroutine coupling_isba_orography_n(DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST, SLT, HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST)
subroutine coupling_isba_svat_n(DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST, SLT, HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST)