6 SUBROUTINE coupling_isba_orography_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, &
59 USE modd_csts, ONLY : xstefan, xcpd, xrd, xp00
63 USE modi_forcing_vert_shift
64 USE modi_coupling_isba_canopy_n
66 USE yomhook
,ONLY : lhook, dr_hook
67 USE parkind1
,ONLY : jprb
74 TYPE(isba_model_t
),
INTENT(INOUT) :: im
82 TYPE(dst_t),
INTENT(INOUT) :: dst
83 TYPE(slt_t),
INTENT(INOUT) :: slt
85 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
86 CHARACTER(LEN=1),
INTENT(IN) :: hcoupling
89 INTEGER,
INTENT(IN) :: kyear
90 INTEGER,
INTENT(IN) :: kmonth
91 INTEGER,
INTENT(IN) :: kday
92 REAL,
INTENT(IN) :: ptime
93 INTEGER,
INTENT(IN) :: ki
94 INTEGER,
INTENT(IN) :: ksv
95 INTEGER,
INTENT(IN) :: ksw
96 REAL,
DIMENSION(KI),
INTENT(IN) :: ptsun
97 REAL,
INTENT(IN) :: ptstep
98 REAL,
DIMENSION(KI),
INTENT(IN) :: pzref
99 REAL,
DIMENSION(KI),
INTENT(IN) :: puref
101 REAL,
DIMENSION(KI),
INTENT(IN) :: pta
102 REAL,
DIMENSION(KI),
INTENT(IN) :: pqa
103 REAL,
DIMENSION(KI),
INTENT(IN) :: prhoa
104 REAL,
DIMENSION(KI,KSV),
INTENT(IN) :: psv
107 CHARACTER(LEN=6),
DIMENSION(KSV),
INTENT(IN):: hsv
108 REAL,
DIMENSION(KI),
INTENT(IN) :: pu
109 REAL,
DIMENSION(KI),
INTENT(IN) :: pv
110 REAL,
DIMENSION(KI,KSW),
INTENT(IN) :: pdir_sw
112 REAL,
DIMENSION(KI,KSW),
INTENT(IN) :: psca_sw
114 REAL,
DIMENSION(KSW),
INTENT(IN) :: psw_bands
115 REAL,
DIMENSION(KI),
INTENT(IN) :: pzenith
116 REAL,
DIMENSION(KI),
INTENT(IN) :: pzenith2
117 REAL,
DIMENSION(KI),
INTENT(IN) :: pazim
118 REAL,
DIMENSION(KI),
INTENT(IN) :: plw
120 REAL,
DIMENSION(KI),
INTENT(IN) :: pps
121 REAL,
DIMENSION(KI),
INTENT(IN) :: ppa
122 REAL,
DIMENSION(KI),
INTENT(IN) :: pzs
123 REAL,
DIMENSION(KI),
INTENT(IN) :: pco2
124 REAL,
DIMENSION(KI),
INTENT(IN) :: psnow
125 REAL,
DIMENSION(KI),
INTENT(IN) :: prain
128 REAL,
DIMENSION(KI),
INTENT(OUT) :: psfth
129 REAL,
DIMENSION(KI),
INTENT(OUT) :: psftq
130 REAL,
DIMENSION(KI),
INTENT(OUT) :: psfu
131 REAL,
DIMENSION(KI),
INTENT(OUT) :: psfv
132 REAL,
DIMENSION(KI),
INTENT(OUT) :: psfco2
133 REAL,
DIMENSION(KI,KSV),
INTENT(OUT):: psfts
135 REAL,
DIMENSION(KI),
INTENT(OUT) :: ptrad
136 REAL,
DIMENSION(KI,KSW),
INTENT(OUT):: pdir_alb
137 REAL,
DIMENSION(KI,KSW),
INTENT(OUT):: psca_alb
138 REAL,
DIMENSION(KI),
INTENT(OUT) :: pemis
140 REAL,
DIMENSION(KI),
INTENT(OUT) :: ptsurf
141 REAL,
DIMENSION(KI),
INTENT(OUT) :: pz0
142 REAL,
DIMENSION(KI),
INTENT(OUT) :: pz0h
143 REAL,
DIMENSION(KI),
INTENT(OUT) :: pqsurf
145 REAL,
DIMENSION(KI),
INTENT(IN) :: ppew_a_coef
146 REAL,
DIMENSION(KI),
INTENT(IN) :: ppew_b_coef
147 REAL,
DIMENSION(KI),
INTENT(IN) :: ppet_a_coef
148 REAL,
DIMENSION(KI),
INTENT(IN) :: ppeq_a_coef
149 REAL,
DIMENSION(KI),
INTENT(IN) :: ppet_b_coef
150 REAL,
DIMENSION(KI),
INTENT(IN) :: ppeq_b_coef
151 CHARACTER(LEN=2),
INTENT(IN) :: htest
155 REAL,
DIMENSION(KI) :: zta
156 REAL,
DIMENSION(KI) :: zpa
157 REAL,
DIMENSION(KI) :: zps
158 REAL,
DIMENSION(KI) :: zqa
159 REAL,
DIMENSION(KI) :: zrhoa
160 REAL,
DIMENSION(KI) :: zlw
161 REAL,
DIMENSION(KI) :: zrain
162 REAL,
DIMENSION(KI) :: zsnow
165 REAL,
DIMENSION(KI) :: z3d_tot_surf
167 REAL,
DIMENSION(KI) :: z3d_tot_surf_inv
168 REAL,
DIMENSION(KI,KSW)::zdir_sw
170 REAL,
DIMENSION(KI,KSW)::zsca_sw
173 REAL,
DIMENSION(KI) :: zpeq_b_coef
174 REAL,
DIMENSION(KI) :: zpet_b_coef
179 REAL(KIND=JPRB) :: zhook_handle
186 IF (lhook) CALL dr_hook(
'COUPLING_ISBA_OROGRAPHY_N',0,zhook_handle)
188 zpeq_b_coef(:) = ppeq_b_coef(:)
189 zpet_b_coef(:) = ppet_b_coef(:)
203 zta,zqa,zpa,zrhoa,zlw,zrain,zsnow )
205 zps(:) = zpa(:) + (pps(:) - ppa(:))
207 IF (hcoupling==
'I')
THEN
208 zpeq_b_coef = ppeq_b_coef + zqa - pqa
209 zpet_b_coef = ppet_b_coef + zta/(zpa/xp00)**(xrd/xcpd) - pta/(ppa/xp00)**(xrd/xcpd)
235 z3d_tot_surf_inv(:) = 0.
237 zsca_sw(:,:) = psca_sw(:,:)
238 zdir_sw(:,:) = pdir_sw(:,:)
258 z3d_tot_surf(:) = sqrt(1.+im%I%XSSO_SLOPE(:)**2)
259 z3d_tot_surf_inv(:) = 1./z3d_tot_surf(:)
263 iswb =
SIZE(psw_bands)
268 zsca_sw(:,jswb) = psca_sw(:,jswb) * z3d_tot_surf_inv(:)
272 zdir_sw(:,jswb) = pdir_sw(:,jswb) * z3d_tot_surf_inv(:)
280 zlw(:) = zlw(:) * z3d_tot_surf_inv(:) &
281 + xstefan*im%I%XEMIS_NAT(:)*im%I%XTSRAD_NAT(:)**4 * (1.-z3d_tot_surf_inv(:))
285 zrain(:) = zrain(:) * z3d_tot_surf_inv(:)
289 zsnow(:) = zsnow(:) * z3d_tot_surf_inv(:)
298 CALL
coupling_isba_canopy_n(dtco, ug, u, uss, im, dtgd, dtgr, tgro, dst, slt, &
299 hprogram, hcoupling, &
300 ptstep, kyear, kmonth, kday, ptime, &
302 ptsun, pzenith, pzenith2, pazim, &
303 pzref, puref, pzs, pu, pv, zqa, zta, zrhoa, psv, pco2, hsv, &
304 zrain, zsnow, zlw, zdir_sw, zsca_sw, psw_bands, zps, zpa, &
305 psftq, psfth, psfts, psfco2, psfu, psfv, &
306 ptrad, pdir_alb, psca_alb, pemis, ptsurf, pz0, pz0h, pqsurf, &
307 ppew_a_coef, ppew_b_coef, &
308 ppet_a_coef, ppeq_a_coef, zpet_b_coef, zpeq_b_coef, &
317 psfth(:) = psfth(:) * z3d_tot_surf(:)
318 psftq(:) = psftq(:) * z3d_tot_surf(:)
319 psfco2(:) = psfco2(:) * z3d_tot_surf(:)
320 DO jsv=1,
SIZE(psfts,2)
321 psfts(:,jsv) = psfts(:,jsv) * z3d_tot_surf(:)
325 IF (lhook) CALL dr_hook(
'COUPLING_ISBA_OROGRAPHY_N',1,zhook_handle)
subroutine coupling_isba_canopy_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_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 forcing_vert_shift(PZS_ATM, PZS_SURF, PTA_ATM, PQA_ATM, PPA_ATM, PRHOA_ATM, PLW_ATM, PRAIN_ATM, PSNOW_ATM, PTA_SURF, PQA_SURF, PPA_SURF, PRHOA_SURF, PLW_SURF, PRAIN_SURF, PSNOW_SURF)