Changeset 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
- Timestamp:
- 2015-12-01T16:35:30+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r4370 r5965 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) … … 114 107 END DO 115 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 116 119 ENDIF 117 120 … … 138 141 ua(:,:,jk) = (ua(:,:,jk) - ua_b(:,:)) * umask(:,:,jk) 139 142 va(:,:,jk) = (va(:,:,jk) - va_b(:,:)) * vmask(:,:,jk) 140 END DO141 ! Add bottom stress due to barotropic component only:143 END DO 144 ! Add bottom/top stress due to barotropic component only: 142 145 DO jj = 2, jpjm1 143 146 DO ji = fs_2, fs_jpim1 ! vector opt. … … 150 153 END DO 151 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 152 167 ENDIF 153 168 #endif … … 164 179 ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,jk) + r_vvl * fse3u_a(ji,jj,jk) ! after scale factor at T-point 165 180 zcoef = - p2dt / ze3ua 166 zzwi = zcoef * avmu (ji,jj,jk ) / fse3uw(ji,jj,jk )167 zwi(ji,jj,jk) = zzwi * umask(ji,jj,jk)168 zzws = zcoef * avmu (ji,jj,jk+1) / fse3uw(ji,jj,jk+1)169 zws(ji,jj,jk) = zzws * umask(ji,jj,jk+1)170 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 171 186 END DO 172 187 END DO … … 194 209 !----------------------------------------------------------------------- 195 210 ! 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 zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 200 END DO 201 END DO 202 END DO 203 ! 204 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 == 205 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) 207 #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) ) & 209 & / ( ze3ua * rau0 ) 210 #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 211 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 216 212 DO jk = 2, jpkm1 217 213 DO jj = 2, jpjm1 218 214 DO ji = fs_2, fs_jpim1 ! vector opt. 215 zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 216 END DO 217 END DO 218 END DO 219 ! 220 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 == 221 DO ji = fs_2, fs_jpim1 ! vector opt. 222 #if defined key_dynspg_ts 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) 226 #else 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 219 236 #if defined key_dynspg_ts 220 237 zrhs = ua(ji,jj,jk) ! zrhs=right hand side … … 233 250 END DO 234 251 DO jk = jpk-2, 1, -1 235 DO jj = 2, jpjm1 236 DO ji = fs_2, fs_jpim1 ! vector opt.252 DO jj = 2, jpjm1 253 DO ji = fs_2, fs_jpim1 237 254 ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk) 238 255 END DO … … 263 280 zcoef = - p2dt / ze3va 264 281 zzwi = zcoef * avmv (ji,jj,jk ) / fse3vw(ji,jj,jk ) 265 zwi(ji,jj,jk) = zzwi * vmask(ji,jj,jk)282 zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk) 266 283 zzws = zcoef * avmv (ji,jj,jk+1) / fse3vw(ji,jj,jk+1) 267 zws(ji,jj,jk) = zzws * vmask(ji,jj,jk+1)268 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 269 286 END DO 270 287 END DO … … 292 309 !----------------------------------------------------------------------- 293 310 ! 294 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 311 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 312 DO jk = 2, jpkm1 295 313 DO jj = 2, jpjm1 296 314 DO ji = fs_2, fs_jpim1 ! vector opt. … … 302 320 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 == 303 321 DO ji = fs_2, fs_jpim1 ! vector opt. 322 #if defined key_dynspg_ts 304 323 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,1) + r_vvl * fse3v_a(ji,jj,1) 305 #if defined key_dynspg_ts306 324 va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 307 325 & / ( ze3va * rau0 ) 308 326 #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) ) & 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) ) & 310 329 & / ( fse3v(ji,jj,1) * rau0 ) ) 311 330 #endif … … 331 350 END DO 332 351 DO jk = jpk-2, 1, -1 333 DO jj = 2, jpjm1 334 DO ji = fs_2, fs_jpim1 ! vector opt.352 DO jj = 2, jpjm1 353 DO ji = fs_2, fs_jpim1 335 354 va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk) 336 355 END DO … … 352 371 !! restore bottom layer avmu(v) 353 372 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 373 DO jj = 2, jpjm1 374 DO ji = 2, jpim1 375 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 376 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 377 avmu(ji,jj,ikbu+1) = 0.e0 378 avmv(ji,jj,ikbv+1) = 0.e0 379 END DO 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 367 391 ENDIF 368 392 !
Note: See TracChangeset
for help on using the changeset viewer.