- Timestamp:
- 2015-07-08T17:13:59+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5107_hadgem3_mct/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r5279 r5568 105 105 avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * fse3uw(ji,jj,ikbu+1) 106 106 avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * fse3vw(ji,jj,ikbv+1) 107 ikbu = miku(ji,jj) ! ocean top level at u- and v-points 108 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points) 109 IF (ikbu .GE. 2) avmu(ji,jj,ikbu) = -tfrua(ji,jj) * fse3uw(ji,jj,ikbu) 110 IF (ikbv .GE. 2) avmv(ji,jj,ikbv) = -tfrva(ji,jj) * fse3vw(ji,jj,ikbv) 111 END DO 112 END DO 107 END DO 108 END DO 109 IF ( ln_isfcav ) THEN 110 DO jj = 2, jpjm1 111 DO ji = 2, jpim1 112 ikbu = miku(ji,jj) ! ocean top level at u- and v-points 113 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points) 114 IF (ikbu .GE. 2) avmu(ji,jj,ikbu) = -tfrua(ji,jj) * fse3uw(ji,jj,ikbu) 115 IF (ikbv .GE. 2) avmv(ji,jj,ikbv) = -tfrva(ji,jj) * fse3vw(ji,jj,ikbv) 116 END DO 117 END DO 118 END IF 113 119 ENDIF 114 120 … … 145 151 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * bfrua(ji,jj) * ua_b(ji,jj) / ze3ua 146 152 va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * bfrva(ji,jj) * va_b(ji,jj) / ze3va 147 ikbu = miku(ji,jj) ! top ocean level at u- and v-points 148 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points) 149 ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,ikbu) + r_vvl * fse3u_a(ji,jj,ikbu) 150 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,ikbv) + r_vvl * fse3v_a(ji,jj,ikbv) 151 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * tfrua(ji,jj) * ua_b(ji,jj) / ze3ua 152 va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * tfrva(ji,jj) * va_b(ji,jj) / ze3va 153 END DO 154 END DO 153 END DO 154 END DO 155 IF ( ln_isfcav ) THEN 156 DO jj = 2, jpjm1 157 DO ji = fs_2, fs_jpim1 ! vector opt. 158 ikbu = miku(ji,jj) ! top ocean level at u- and v-points 159 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points) 160 ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,ikbu) + r_vvl * fse3u_a(ji,jj,ikbu) 161 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,ikbv) + r_vvl * fse3v_a(ji,jj,ikbv) 162 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * tfrua(ji,jj) * ua_b(ji,jj) / ze3ua 163 va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * tfrva(ji,jj) * va_b(ji,jj) / ze3va 164 END DO 165 END DO 166 END IF 155 167 ENDIF 156 168 #endif … … 167 179 ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,jk) + r_vvl * fse3u_a(ji,jj,jk) ! after scale factor at T-point 168 180 zcoef = - p2dt / ze3ua 169 zzwi = zcoef * avmu (ji,jj,jk ) / fse3uw(ji,jj,jk )170 zwi(ji,jj,jk) = zzwi * umask(ji,jj,jk)171 zzws = zcoef * avmu (ji,jj,jk+1) / fse3uw(ji,jj,jk+1)172 zws(ji,jj,jk) = zzws * umask(ji,jj,jk+1)173 zwd(ji,jj,jk) = 1._wp - z wi(ji,jj,jk)- zzws181 zzwi = zcoef * avmu (ji,jj,jk ) / fse3uw(ji,jj,jk ) 182 zwi(ji,jj,jk) = zzwi * wumask(ji,jj,jk ) 183 zzws = zcoef * avmu (ji,jj,jk+1) / fse3uw(ji,jj,jk+1) 184 zws(ji,jj,jk) = zzws * wumask(ji,jj,jk+1) 185 zwd(ji,jj,jk) = 1._wp - zzwi - zzws 174 186 END DO 175 187 END DO … … 198 210 ! 199 211 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 200 DO j j = 2, jpjm1201 DO j i = fs_2, fs_jpim1 ! vector opt.202 DO j k = miku(ji,jj)+1, jpkm1212 DO jk = 2, jpkm1 213 DO jj = 2, jpjm1 214 DO ji = fs_2, fs_jpim1 ! vector opt. 203 215 zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 204 216 END DO … … 208 220 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 == 209 221 DO ji = fs_2, fs_jpim1 ! vector opt. 210 ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,miku(ji,jj)) + r_vvl * fse3u_a(ji,jj,miku(ji,jj))211 222 #if defined key_dynspg_ts 212 ua(ji,jj,miku(ji,jj)) = ua(ji,jj,miku(ji,jj)) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) & 213 & / ( ze3ua * rau0 ) 223 ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,1) + r_vvl * fse3u_a(ji,jj,1) 224 ua(ji,jj,1) = ua(ji,jj,1) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) & 225 & / ( ze3ua * rau0 ) * umask(ji,jj,1) 214 226 #else 215 ua(ji,jj,miku(ji,jj)) = ub(ji,jj,miku(ji,jj)) & 216 & + p2dt *(ua(ji,jj,miku(ji,jj)) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) & 217 & / ( fse3u(ji,jj,miku(ji,jj)) * rau0 ) ) 218 #endif 219 DO jk = miku(ji,jj)+1, jpkm1 227 ua(ji,jj,1) = ub(ji,jj,1) & 228 & + p2dt *(ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) & 229 & / ( fse3u(ji,jj,1) * rau0 ) * umask(ji,jj,1) ) 230 #endif 231 END DO 232 END DO 233 DO jk = 2, jpkm1 234 DO jj = 2, jpjm1 235 DO ji = fs_2, fs_jpim1 220 236 #if defined key_dynspg_ts 221 237 zrhs = ua(ji,jj,jk) ! zrhs=right hand side … … 231 247 DO ji = fs_2, fs_jpim1 ! vector opt. 232 248 ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 233 DO jk = jpk-2, miku(ji,jj), -1 249 END DO 250 END DO 251 DO jk = jpk-2, 1, -1 252 DO jj = 2, jpjm1 253 DO ji = fs_2, fs_jpim1 234 254 ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk) 235 255 END DO … … 260 280 zcoef = - p2dt / ze3va 261 281 zzwi = zcoef * avmv (ji,jj,jk ) / fse3vw(ji,jj,jk ) 262 zwi(ji,jj,jk) = zzwi * vmask(ji,jj,jk)282 zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk) 263 283 zzws = zcoef * avmv (ji,jj,jk+1) / fse3vw(ji,jj,jk+1) 264 zws(ji,jj,jk) = zzws * vmask(ji,jj,jk+1)265 zwd(ji,jj,jk) = 1._wp - z wi(ji,jj,jk)- zzws284 zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1) 285 zwd(ji,jj,jk) = 1._wp - zzwi - zzws 266 286 END DO 267 287 END DO … … 290 310 ! 291 311 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 292 DO j j = 2, jpjm1293 DO j i = fs_2, fs_jpim1 ! vector opt.294 DO j k = mikv(ji,jj)+1, jpkm1312 DO jk = 2, jpkm1 313 DO jj = 2, jpjm1 314 DO ji = fs_2, fs_jpim1 ! vector opt. 295 315 zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 296 316 END DO … … 300 320 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 == 301 321 DO ji = fs_2, fs_jpim1 ! vector opt. 302 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,mikv(ji,jj)) + r_vvl * fse3v_a(ji,jj,mikv(ji,jj))303 322 #if defined key_dynspg_ts 304 va(ji,jj,mikv(ji,jj)) = va(ji,jj,mikv(ji,jj)) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 323 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,1) + r_vvl * fse3v_a(ji,jj,1) 324 va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 305 325 & / ( ze3va * rau0 ) 306 326 #else 307 va(ji,jj,mikv(ji,jj)) = vb(ji,jj,mikv(ji,jj)) & 308 & + p2dt *(va(ji,jj,mikv(ji,jj)) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 309 & / ( fse3v(ji,jj,mikv(ji,jj)) * rau0 ) ) 310 #endif 311 DO jk = mikv(ji,jj)+1, jpkm1 327 va(ji,jj,1) = vb(ji,jj,1) & 328 & + p2dt *(va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 329 & / ( fse3v(ji,jj,1) * rau0 ) ) 330 #endif 331 END DO 332 END DO 333 DO jk = 2, jpkm1 334 DO jj = 2, jpjm1 335 DO ji = fs_2, fs_jpim1 ! vector opt. 312 336 #if defined key_dynspg_ts 313 337 zrhs = va(ji,jj,jk) ! zrhs=right hand side … … 323 347 DO ji = fs_2, fs_jpim1 ! vector opt. 324 348 va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 325 DO jk = jpk-2, mikv(ji,jj), -1 349 END DO 350 END DO 351 DO jk = jpk-2, 1, -1 352 DO jj = 2, jpjm1 353 DO ji = fs_2, fs_jpim1 326 354 va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk) 327 355 END DO … … 349 377 avmu(ji,jj,ikbu+1) = 0.e0 350 378 avmv(ji,jj,ikbv+1) = 0.e0 351 ikbu = miku(ji,jj) ! ocean top level at u- and v-points352 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points)353 IF (ikbu > 1) avmu(ji,jj,ikbu) = 0.e0354 IF (ikbv > 1) avmv(ji,jj,ikbv) = 0.e0355 379 END DO 356 380 END DO 381 IF (ln_isfcav) THEN 382 DO jj = 2, jpjm1 383 DO ji = 2, jpim1 384 ikbu = miku(ji,jj) ! ocean top level at u- and v-points 385 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points) 386 IF (ikbu > 1) avmu(ji,jj,ikbu) = 0.e0 387 IF (ikbv > 1) avmv(ji,jj,ikbv) = 0.e0 388 END DO 389 END DO 390 END IF 357 391 ENDIF 358 392 !
Note: See TracChangeset
for help on using the changeset viewer.
