Changeset 5208 for branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
- Timestamp:
- 2015-04-13T15:08:59+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r4370 r5208 70 70 REAL(wp) :: z1_p2dt, zcoef, zzwi, zzws, zrhs ! local scalars 71 71 REAL(wp) :: ze3ua, ze3va 72 !!----------------------------------------------------------------------73 74 72 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwd, zws 75 73 !!---------------------------------------------------------------------- … … 101 99 102 100 IF( ln_bfrimp ) THEN 103 # if defined key_vectopt_loop104 DO jj = 1, 1105 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)106 # else107 101 DO jj = 2, jpjm1 108 102 DO ji = 2, jpim1 109 # endif110 103 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 111 104 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 112 105 avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * fse3uw(ji,jj,ikbu+1) 113 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) 114 111 END DO 115 112 END DO … … 138 135 ua(:,:,jk) = (ua(:,:,jk) - ua_b(:,:)) * umask(:,:,jk) 139 136 va(:,:,jk) = (va(:,:,jk) - va_b(:,:)) * vmask(:,:,jk) 140 END DO141 ! Add bottom stress due to barotropic component only:137 END DO 138 ! Add bottom/top stress due to barotropic component only: 142 139 DO jj = 2, jpjm1 143 140 DO ji = fs_2, fs_jpim1 ! vector opt. … … 148 145 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * bfrua(ji,jj) * ua_b(ji,jj) / ze3ua 149 146 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 150 153 END DO 151 154 END DO … … 166 169 zzwi = zcoef * avmu (ji,jj,jk ) / fse3uw(ji,jj,jk ) 167 170 zwi(ji,jj,jk) = zzwi * umask(ji,jj,jk) 168 zzws = zcoef * avmu (ji,jj,jk+1) / fse3uw(ji,jj,jk+1) 171 zzws = zcoef * avmu (ji,jj,jk+1) / fse3uw(ji,jj,jk+1) 169 172 zws(ji,jj,jk) = zzws * umask(ji,jj,jk+1) 170 173 zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws … … 194 197 !----------------------------------------------------------------------- 195 198 ! 196 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 197 DO jj = 2, jpjm1 198 DO ji = fs_2, fs_jpim1 ! vector opt. 199 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 200 DO jj = 2, jpjm1 201 DO ji = fs_2, fs_jpim1 ! vector opt. 202 DO jk = miku(ji,jj)+1, jpkm1 199 203 zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 200 204 END DO … … 204 208 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 == 205 209 DO ji = fs_2, fs_jpim1 ! vector opt. 206 ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj, 1) + r_vvl * fse3u_a(ji,jj,1)210 ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,miku(ji,jj)) + r_vvl * fse3u_a(ji,jj,miku(ji,jj)) 207 211 #if defined key_dynspg_ts 208 ua(ji,jj, 1) = ua(ji,jj,1) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) &212 ua(ji,jj,miku(ji,jj)) = ua(ji,jj,miku(ji,jj)) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) & 209 213 & / ( ze3ua * rau0 ) 210 214 #else 211 ua(ji,jj,1) = ub(ji,jj,1) + p2dt *(ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) & 212 & / ( fse3u(ji,jj,1) * rau0 ) ) 213 #endif 214 END DO 215 END DO 216 DO jk = 2, jpkm1 217 DO jj = 2, jpjm1 218 DO ji = fs_2, fs_jpim1 ! vector opt. 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 219 220 #if defined key_dynspg_ts 220 221 zrhs = ua(ji,jj,jk) ! zrhs=right hand side … … 230 231 DO ji = fs_2, fs_jpim1 ! vector opt. 231 232 ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 232 END DO 233 END DO 234 DO jk = jpk-2, 1, -1 235 DO jj = 2, jpjm1 236 DO ji = fs_2, fs_jpim1 ! vector opt. 233 DO jk = jpk-2, miku(ji,jj), -1 237 234 ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk) 238 235 END DO … … 292 289 !----------------------------------------------------------------------- 293 290 ! 294 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 295 DO jj = 2, jpjm1 296 DO ji = fs_2, fs_jpim1 ! vector opt. 291 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 292 DO jj = 2, jpjm1 293 DO ji = fs_2, fs_jpim1 ! vector opt. 294 DO jk = mikv(ji,jj)+1, jpkm1 297 295 zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 298 296 END DO … … 302 300 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 == 303 301 DO ji = fs_2, fs_jpim1 ! vector opt. 304 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj, 1) + r_vvl * fse3v_a(ji,jj,1)302 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,mikv(ji,jj)) + r_vvl * fse3v_a(ji,jj,mikv(ji,jj)) 305 303 #if defined key_dynspg_ts 306 va(ji,jj, 1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) &304 va(ji,jj,mikv(ji,jj)) = va(ji,jj,mikv(ji,jj)) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 307 305 & / ( ze3va * rau0 ) 308 306 #else 309 va(ji,jj,1) = vb(ji,jj,1) + p2dt *(va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 310 & / ( fse3v(ji,jj,1) * rau0 ) ) 311 #endif 312 END DO 313 END DO 314 DO jk = 2, jpkm1 315 DO jj = 2, jpjm1 316 DO ji = fs_2, fs_jpim1 ! vector opt. 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 317 312 #if defined key_dynspg_ts 318 313 zrhs = va(ji,jj,jk) ! zrhs=right hand side … … 328 323 DO ji = fs_2, fs_jpim1 ! vector opt. 329 324 va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 330 END DO 331 END DO 332 DO jk = jpk-2, 1, -1 333 DO jj = 2, jpjm1 334 DO ji = fs_2, fs_jpim1 ! vector opt. 325 DO jk = jpk-2, mikv(ji,jj), -1 335 326 va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk) 336 327 END DO … … 352 343 !! restore bottom layer avmu(v) 353 344 IF( ln_bfrimp ) THEN 354 # if defined key_vectopt_loop 355 DO jj = 1, 1 356 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 357 # else 358 DO jj = 2, jpjm1 359 DO ji = 2, jpim1 360 # endif 361 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 362 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 363 avmu(ji,jj,ikbu+1) = 0.e0 364 avmv(ji,jj,ikbv+1) = 0.e0 365 END DO 366 END DO 345 DO jj = 2, jpjm1 346 DO ji = 2, jpim1 347 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 348 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 349 avmu(ji,jj,ikbu+1) = 0.e0 350 avmv(ji,jj,ikbv+1) = 0.e0 351 ikbu = miku(ji,jj) ! ocean top level at u- and v-points 352 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points) 353 IF (ikbu > 1) avmu(ji,jj,ikbu) = 0.e0 354 IF (ikbv > 1) avmv(ji,jj,ikbv) = 0.e0 355 END DO 356 END DO 367 357 ENDIF 368 358 !
Note: See TracChangeset
for help on using the changeset viewer.
