Changeset 10989 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/NST/agrif_oce_interp.F90
- Timestamp:
- 2019-05-16T17:45:46+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/NST/agrif_oce_interp.F90
r10068 r10989 107 107 ! 108 108 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 109 u a_b(ibdy1:ibdy2,:) = 0._wp109 uu_b(ibdy1:ibdy2,:,Krhs) = 0._wp 110 110 DO jk = 1, jpkm1 111 111 DO jj = 1, jpj 112 u a_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) &113 & + e3u _a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk)112 uu_b(ibdy1:ibdy2,jj,Krhs) = uu_b(ibdy1:ibdy2,jj,Krhs) & 113 & + e3u(ibdy1:ibdy2,jj,jk,Krhs) * uu(ibdy1:ibdy2,jj,jk,Krhs) * umask(ibdy1:ibdy2,jj,jk) 114 114 END DO 115 115 END DO 116 116 DO jj = 1, jpj 117 u a_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj)117 uu_b(ibdy1:ibdy2,jj,Krhs) = uu_b(ibdy1:ibdy2,jj,Krhs) * r1_hu_a(ibdy1:ibdy2,jj) 118 118 END DO 119 119 ENDIF … … 122 122 DO jk=1,jpkm1 ! Smooth 123 123 DO jj=j1,j2 124 u a(ibdy2,jj,jk) = 0.25_wp*(ua(ibdy2-1,jj,jk)+2._wp*ua(ibdy2,jj,jk)+ua(ibdy2+1,jj,jk))124 uu(ibdy2,jj,jk,Krhs) = 0.25_wp*(uu(ibdy2-1,jj,jk,Krhs)+2._wp*uu(ibdy2,jj,jk,Krhs)+uu(ibdy2+1,jj,jk,Krhs)) 125 125 END DO 126 126 END DO … … 131 131 DO jj = 1, jpj 132 132 zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) & 133 & + e3u _a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk)*umask(ibdy1:ibdy2,jj,jk)133 & + e3u(ibdy1:ibdy2,jj,jk,Krhs) * uu(ibdy1:ibdy2,jj,jk,Krhs)*umask(ibdy1:ibdy2,jj,jk) 134 134 END DO 135 135 END DO … … 140 140 DO jk = 1, jpkm1 141 141 DO jj = 1, jpj 142 u a(ibdy1:ibdy2,jj,jk) = ( ua(ibdy1:ibdy2,jj,jk) &143 & + u a_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj)) * umask(ibdy1:ibdy2,jj,jk)142 uu(ibdy1:ibdy2,jj,jk,Krhs) = ( uu(ibdy1:ibdy2,jj,jk,Krhs) & 143 & + uu_b(ibdy1:ibdy2,jj,Krhs)-zub(ibdy1:ibdy2,jj)) * umask(ibdy1:ibdy2,jj,jk) 144 144 END DO 145 145 END DO … … 150 150 DO jj = 1, jpj 151 151 zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) & 152 & + e3v _a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) * vmask(ibdy1:ibdy2,jj,jk)152 & + e3v(ibdy1:ibdy2,jj,jk,Krhs) * vv(ibdy1:ibdy2,jj,jk,Krhs) * vmask(ibdy1:ibdy2,jj,jk) 153 153 END DO 154 154 END DO … … 158 158 DO jk = 1, jpkm1 159 159 DO jj = 1, jpj 160 v a(ibdy1:ibdy2,jj,jk) = ( va(ibdy1:ibdy2,jj,jk) &161 & + v a_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj))*vmask(ibdy1:ibdy2,jj,jk)160 vv(ibdy1:ibdy2,jj,jk,Krhs) = ( vv(ibdy1:ibdy2,jj,jk,Krhs) & 161 & + vv_b(ibdy1:ibdy2,jj,Krhs)-zvb(ibdy1:ibdy2,jj))*vmask(ibdy1:ibdy2,jj,jk) 162 162 END DO 163 163 END DO … … 166 166 DO jk = 1, jpkm1 ! Mask domain edges 167 167 DO jj = 1, jpj 168 u a(1,jj,jk) = 0._wp169 v a(1,jj,jk) = 0._wp168 uu(1,jj,jk,Krhs) = 0._wp 169 vv(1,jj,jk,Krhs) = 0._wp 170 170 END DO 171 171 END DO … … 178 178 ! 179 179 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 180 u a_b(ibdy1:ibdy2,:) = 0._wp180 uu_b(ibdy1:ibdy2,:,Krhs) = 0._wp 181 181 DO jk = 1, jpkm1 182 182 DO jj = 1, jpj 183 u a_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) &184 & + e3u _a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk)183 uu_b(ibdy1:ibdy2,jj,Krhs) = uu_b(ibdy1:ibdy2,jj,Krhs) & 184 & + e3u(ibdy1:ibdy2,jj,jk,Krhs) * uu(ibdy1:ibdy2,jj,jk,Krhs) * umask(ibdy1:ibdy2,jj,jk) 185 185 END DO 186 186 END DO 187 187 DO jj = 1, jpj 188 u a_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj)188 uu_b(ibdy1:ibdy2,jj,Krhs) = uu_b(ibdy1:ibdy2,jj,Krhs) * r1_hu_a(ibdy1:ibdy2,jj) 189 189 END DO 190 190 ENDIF … … 193 193 DO jk=1,jpkm1 ! Smooth 194 194 DO jj=j1,j2 195 u a(ibdy1,jj,jk) = 0.25_wp*(ua(ibdy1-1,jj,jk)+2._wp*ua(ibdy1,jj,jk)+ua(ibdy1+1,jj,jk))195 uu(ibdy1,jj,jk,Krhs) = 0.25_wp*(uu(ibdy1-1,jj,jk,Krhs)+2._wp*uu(ibdy1,jj,jk,Krhs)+uu(ibdy1+1,jj,jk,Krhs)) 196 196 END DO 197 197 END DO … … 202 202 DO jj = 1, jpj 203 203 zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) & 204 & + e3u _a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk)204 & + e3u(ibdy1:ibdy2,jj,jk,Krhs) * uu(ibdy1:ibdy2,jj,jk,Krhs) * umask(ibdy1:ibdy2,jj,jk) 205 205 END DO 206 206 END DO … … 211 211 DO jk = 1, jpkm1 212 212 DO jj = 1, jpj 213 u a(ibdy1:ibdy2,jj,jk) = ( ua(ibdy1:ibdy2,jj,jk) &214 & + u a_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk)213 uu(ibdy1:ibdy2,jj,jk,Krhs) = ( uu(ibdy1:ibdy2,jj,jk,Krhs) & 214 & + uu_b(ibdy1:ibdy2,jj,Krhs)-zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk) 215 215 END DO 216 216 END DO … … 223 223 DO jj = 1, jpj 224 224 zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) & 225 & + e3v _a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) * vmask(ibdy1:ibdy2,jj,jk)225 & + e3v(ibdy1:ibdy2,jj,jk,Krhs) * vv(ibdy1:ibdy2,jj,jk,Krhs) * vmask(ibdy1:ibdy2,jj,jk) 226 226 END DO 227 227 END DO … … 231 231 DO jk = 1, jpkm1 232 232 DO jj = 1, jpj 233 v a(ibdy1:ibdy2,jj,jk) = ( va(ibdy1:ibdy2,jj,jk) &234 & + v a_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk)233 vv(ibdy1:ibdy2,jj,jk,Krhs) = ( vv(ibdy1:ibdy2,jj,jk,Krhs) & 234 & + vv_b(ibdy1:ibdy2,jj,Krhs)-zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk) 235 235 END DO 236 236 END DO … … 239 239 DO jk = 1, jpkm1 ! Mask domain edges 240 240 DO jj = 1, jpj 241 u a(nlci-1,jj,jk) = 0._wp242 v a(nlci ,jj,jk) = 0._wp241 uu(nlci-1,jj,jk,Krhs) = 0._wp 242 vv(nlci ,jj,jk,Krhs) = 0._wp 243 243 END DO 244 244 END DO … … 251 251 ! 252 252 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 253 v a_b(:,jbdy1:jbdy2) = 0._wp253 vv_b(:,jbdy1:jbdy2,Krhs) = 0._wp 254 254 DO jk = 1, jpkm1 255 255 DO ji = 1, jpi 256 v a_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) &257 & + e3v _a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk)256 vv_b(ji,jbdy1:jbdy2,Krhs) = vv_b(ji,jbdy1:jbdy2,Krhs) & 257 & + e3v(ji,jbdy1:jbdy2,jk,Krhs) * vv(ji,jbdy1:jbdy2,jk,Krhs) * vmask(ji,jbdy1:jbdy2,jk) 258 258 END DO 259 259 END DO 260 260 DO ji=1,jpi 261 v a_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2)261 vv_b(ji,jbdy1:jbdy2,Krhs) = vv_b(ji,jbdy1:jbdy2,Krhs) * r1_hv_a(ji,jbdy1:jbdy2) 262 262 END DO 263 263 ENDIF … … 266 266 DO jk = 1, jpkm1 ! Smooth 267 267 DO ji = i1, i2 268 v a(ji,jbdy2,jk) = 0.25_wp*(va(ji,jbdy2-1,jk)+2._wp*va(ji,jbdy2,jk)+va(ji,jbdy2+1,jk))268 vv(ji,jbdy2,jk,Krhs) = 0.25_wp*(vv(ji,jbdy2-1,jk,Krhs)+2._wp*vv(ji,jbdy2,jk,Krhs)+vv(ji,jbdy2+1,jk,Krhs)) 269 269 END DO 270 270 END DO … … 275 275 DO ji=1,jpi 276 276 zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) & 277 & + e3v _a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk)277 & + e3v(ji,jbdy1:jbdy2,jk,Krhs) * vv(ji,jbdy1:jbdy2,jk,Krhs) * vmask(ji,jbdy1:jbdy2,jk) 278 278 END DO 279 279 END DO … … 284 284 DO jk = 1, jpkm1 285 285 DO ji = 1, jpi 286 v a(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) &287 & + v a_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk)286 vv(ji,jbdy1:jbdy2,jk,Krhs) = ( vv(ji,jbdy1:jbdy2,jk,Krhs) & 287 & + vv_b(ji,jbdy1:jbdy2,Krhs) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 288 288 END DO 289 289 END DO … … 294 294 DO ji = 1, jpi 295 295 zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) & 296 & + e3u _a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk)296 & + e3u(ji,jbdy1:jbdy2,jk,Krhs) * uu(ji,jbdy1:jbdy2,jk,Krhs) * umask(ji,jbdy1:jbdy2,jk) 297 297 END DO 298 298 END DO … … 303 303 DO jk = 1, jpkm1 304 304 DO ji = 1, jpi 305 u a(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) &306 & + u a_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk)305 uu(ji,jbdy1:jbdy2,jk,Krhs) = ( uu(ji,jbdy1:jbdy2,jk,Krhs) & 306 & + uu_b(ji,jbdy1:jbdy2,Krhs) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 307 307 END DO 308 308 END DO … … 311 311 DO jk = 1, jpkm1 ! Mask domain edges 312 312 DO ji = 1, jpi 313 u a(ji,1,jk) = 0._wp314 v a(ji,1,jk) = 0._wp313 uu(ji,1,jk,Krhs) = 0._wp 314 vv(ji,1,jk,Krhs) = 0._wp 315 315 END DO 316 316 END DO … … 323 323 ! 324 324 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 325 v a_b(:,jbdy1:jbdy2) = 0._wp325 vv_b(:,jbdy1:jbdy2,Krhs) = 0._wp 326 326 DO jk = 1, jpkm1 327 327 DO ji = 1, jpi 328 v a_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) &329 & + e3v _a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk)328 vv_b(ji,jbdy1:jbdy2,Krhs) = vv_b(ji,jbdy1:jbdy2,Krhs) & 329 & + e3v(ji,jbdy1:jbdy2,jk,Krhs) * vv(ji,jbdy1:jbdy2,jk,Krhs) * vmask(ji,jbdy1:jbdy2,jk) 330 330 END DO 331 331 END DO 332 332 DO ji=1,jpi 333 v a_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2)333 vv_b(ji,jbdy1:jbdy2,Krhs) = vv_b(ji,jbdy1:jbdy2,Krhs) * r1_hv_a(ji,jbdy1:jbdy2) 334 334 END DO 335 335 ENDIF … … 338 338 DO jk = 1, jpkm1 ! Smooth 339 339 DO ji = i1, i2 340 v a(ji,jbdy1,jk) = 0.25_wp*(va(ji,jbdy1-1,jk)+2._wp*va(ji,jbdy1,jk)+va(ji,jbdy1+1,jk))340 vv(ji,jbdy1,jk,Krhs) = 0.25_wp*(vv(ji,jbdy1-1,jk,Krhs)+2._wp*vv(ji,jbdy1,jk,Krhs)+vv(ji,jbdy1+1,jk,Krhs)) 341 341 END DO 342 342 END DO … … 347 347 DO ji=1,jpi 348 348 zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) & 349 & + e3v _a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk)349 & + e3v(ji,jbdy1:jbdy2,jk,Krhs) * vv(ji,jbdy1:jbdy2,jk,Krhs) * vmask(ji,jbdy1:jbdy2,jk) 350 350 END DO 351 351 END DO … … 356 356 DO jk = 1, jpkm1 357 357 DO ji = 1, jpi 358 v a(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) &359 & + v a_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk)358 vv(ji,jbdy1:jbdy2,jk,Krhs) = ( vv(ji,jbdy1:jbdy2,jk,Krhs) & 359 & + vv_b(ji,jbdy1:jbdy2,Krhs) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 360 360 END DO 361 361 END DO … … 368 368 DO ji = 1, jpi 369 369 zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) & 370 & + e3u _a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk)370 & + e3u(ji,jbdy1:jbdy2,jk,Krhs) * uu(ji,jbdy1:jbdy2,jk,Krhs) * umask(ji,jbdy1:jbdy2,jk) 371 371 END DO 372 372 END DO … … 377 377 DO jk = 1, jpkm1 378 378 DO ji = 1, jpi 379 u a(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) &380 & + u a_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk)379 uu(ji,jbdy1:jbdy2,jk,Krhs) = ( uu(ji,jbdy1:jbdy2,jk,Krhs) & 380 & + uu_b(ji,jbdy1:jbdy2,Krhs) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 381 381 END DO 382 382 END DO … … 385 385 DO jk = 1, jpkm1 ! Mask domain edges 386 386 DO ji = 1, jpi 387 u a(ji,nlcj ,jk) = 0._wp388 v a(ji,nlcj-1,jk) = 0._wp387 uu(ji,nlcj ,jk,Krhs) = 0._wp 388 vv(ji,nlcj-1,jk,Krhs) = 0._wp 389 389 END DO 390 390 END DO … … 520 520 DO jj = 1, jpj 521 521 DO ji = 2, indx 522 ssh a(ji,jj) = hbdy_w(ji-1,jj)522 ssh(ji,jj,Krhs) = hbdy_w(ji-1,jj) 523 523 ENDDO 524 524 ENDDO … … 530 530 DO jj = 1, jpj 531 531 DO ji = indx, nlci-1 532 ssh a(ji,jj) = hbdy_e(ji-indx+1,jj)532 ssh(ji,jj,Krhs) = hbdy_e(ji-indx+1,jj) 533 533 ENDDO 534 534 ENDDO … … 540 540 DO jj = 2, indy 541 541 DO ji = 1, jpi 542 ssh a(ji,jj) = hbdy_s(ji,jj-1)542 ssh(ji,jj,Krhs) = hbdy_s(ji,jj-1) 543 543 ENDDO 544 544 ENDDO … … 550 550 DO jj = indy, nlcj-1 551 551 DO ji = 1, jpi 552 ssh a(ji,jj) = hbdy_n(ji,jj-indy+1)552 ssh(ji,jj,Krhs) = hbdy_n(ji,jj-indy+1) 553 553 ENDDO 554 554 ENDDO … … 659 659 DO jj=j1,j2 660 660 DO ji=i1,i2 661 ptab(ji,jj,jk,jn) = ts n(ji,jj,jk,jn)661 ptab(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm) 662 662 END DO 663 663 END DO … … 669 669 DO jj=j1,j2 670 670 DO ji=i1,i2 671 ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t _n(ji,jj,jk)671 ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm) 672 672 END DO 673 673 END DO … … 699 699 IF (tmask(iref,jref,jk) == 0) EXIT 700 700 N_out = N_out + 1 701 h_out(jk) = e3t _n(iref,jref,jk)701 h_out(jk) = e3t(iref,jref,jk,Kmm) 702 702 ENDDO 703 703 IF (N_in > 0) THEN … … 713 713 ! 714 714 DO jn=1, jpts 715 ts a(i1:i2,j1:j2,1:jpk,jn)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk)715 ts(i1:i2,j1:j2,1:jpk,jn,Krhs)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk) 716 716 END DO 717 717 … … 737 737 ibdy = nlci-nbghostcells 738 738 DO jn = 1, jpts 739 ts a(ibdy+1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn)739 ts(ibdy+1,jmin:jmax,1:jpkm1,jn,Krhs) = z1 * ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 740 740 DO jk = 1, jpkm1 741 741 DO jj = jmin,jmax 742 742 IF( umask(ibdy-1,jj,jk) == 0._wp ) THEN 743 ts a(ibdy,jj,jk,jn) = tsa(ibdy+1,jj,jk,jn) * tmask(ibdy,jj,jk)743 ts(ibdy,jj,jk,jn,Krhs) = ts(ibdy+1,jj,jk,jn,Krhs) * tmask(ibdy,jj,jk) 744 744 ELSE 745 ts a(ibdy,jj,jk,jn)=(z4*tsa(ibdy+1,jj,jk,jn)+z3*tsa(ibdy-1,jj,jk,jn))*tmask(ibdy,jj,jk)746 IF( u n(ibdy-1,jj,jk) > 0._wp ) THEN747 ts a(ibdy,jj,jk,jn)=( z6*tsa(ibdy-1,jj,jk,jn)+z5*tsa(ibdy+1,jj,jk,jn) &748 + z7*ts a(ibdy-2,jj,jk,jn) ) * tmask(ibdy,jj,jk)745 ts(ibdy,jj,jk,jn,Krhs)=(z4*ts(ibdy+1,jj,jk,jn,Krhs)+z3*ts(ibdy-1,jj,jk,jn,Krhs))*tmask(ibdy,jj,jk) 746 IF( uu(ibdy-1,jj,jk,Kmm) > 0._wp ) THEN 747 ts(ibdy,jj,jk,jn,Krhs)=( z6*ts(ibdy-1,jj,jk,jn,Krhs)+z5*ts(ibdy+1,jj,jk,jn,Krhs) & 748 + z7*ts(ibdy-2,jj,jk,jn,Krhs) ) * tmask(ibdy,jj,jk) 749 749 ENDIF 750 750 ENDIF … … 752 752 END DO 753 753 ! Restore ghost points: 754 ts a(ibdy+1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1)754 ts(ibdy+1,jmin:jmax,1:jpkm1,jn,Krhs) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1) 755 755 END DO 756 756 ENDIF … … 766 766 jbdy = nlcj-nbghostcells 767 767 DO jn = 1, jpts 768 ts a(imin:imax,jbdy+1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn)768 ts(imin:imax,jbdy+1,1:jpkm1,jn,Krhs) = z1 * ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 769 769 DO jk = 1, jpkm1 770 770 DO ji = imin,imax 771 771 IF( vmask(ji,jbdy-1,jk) == 0._wp ) THEN 772 ts a(ji,jbdy,jk,jn) = tsa(ji,jbdy+1,jk,jn) * tmask(ji,jbdy,jk)772 ts(ji,jbdy,jk,jn,Krhs) = ts(ji,jbdy+1,jk,jn,Krhs) * tmask(ji,jbdy,jk) 773 773 ELSE 774 ts a(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy+1,jk,jn)+z3*tsa(ji,jbdy-1,jk,jn))*tmask(ji,jbdy,jk)775 IF (v n(ji,jbdy-1,jk) > 0._wp ) THEN776 ts a(ji,jbdy,jk,jn)=( z6*tsa(ji,jbdy-1,jk,jn)+z5*tsa(ji,jbdy+1,jk,jn) &777 + z7*ts a(ji,jbdy-2,jk,jn) ) * tmask(ji,jbdy,jk)774 ts(ji,jbdy,jk,jn,Krhs)=(z4*ts(ji,jbdy+1,jk,jn,Krhs)+z3*ts(ji,jbdy-1,jk,jn,Krhs))*tmask(ji,jbdy,jk) 775 IF (vv(ji,jbdy-1,jk,Kmm) > 0._wp ) THEN 776 ts(ji,jbdy,jk,jn,Krhs)=( z6*ts(ji,jbdy-1,jk,jn,Krhs)+z5*ts(ji,jbdy+1,jk,jn,Krhs) & 777 + z7*ts(ji,jbdy-2,jk,jn,Krhs) ) * tmask(ji,jbdy,jk) 778 778 ENDIF 779 779 ENDIF … … 781 781 END DO 782 782 ! Restore ghost points: 783 ts a(imin:imax,jbdy+1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1)783 ts(imin:imax,jbdy+1,1:jpkm1,jn,Krhs) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1) 784 784 END DO 785 785 ENDIF … … 795 795 ibdy = 1+nbghostcells 796 796 DO jn = 1, jpts 797 ts a(ibdy-1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn)797 ts(ibdy-1,jmin:jmax,1:jpkm1,jn,Krhs) = z1 * ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 798 798 DO jk = 1, jpkm1 799 799 DO jj = jmin,jmax 800 800 IF( umask(ibdy,jj,jk) == 0._wp ) THEN 801 ts a(ibdy,jj,jk,jn) = tsa(ibdy-1,jj,jk,jn) * tmask(ibdy,jj,jk)801 ts(ibdy,jj,jk,jn,Krhs) = ts(ibdy-1,jj,jk,jn,Krhs) * tmask(ibdy,jj,jk) 802 802 ELSE 803 ts a(ibdy,jj,jk,jn)=(z4*tsa(ibdy-1,jj,jk,jn)+z3*tsa(ibdy+1,jj,jk,jn))*tmask(ibdy,jj,jk)804 IF( u n(ibdy,jj,jk) < 0._wp ) THEN805 ts a(ibdy,jj,jk,jn)=( z6*tsa(ibdy+1,jj,jk,jn)+z5*tsa(ibdy-1,jj,jk,jn) &806 + z7*ts a(ibdy+2,jj,jk,jn) ) * tmask(ibdy,jj,jk)803 ts(ibdy,jj,jk,jn,Krhs)=(z4*ts(ibdy-1,jj,jk,jn,Krhs)+z3*ts(ibdy+1,jj,jk,jn,Krhs))*tmask(ibdy,jj,jk) 804 IF( uu(ibdy,jj,jk,Kmm) < 0._wp ) THEN 805 ts(ibdy,jj,jk,jn,Krhs)=( z6*ts(ibdy+1,jj,jk,jn,Krhs)+z5*ts(ibdy-1,jj,jk,jn,Krhs) & 806 + z7*ts(ibdy+2,jj,jk,jn,Krhs) ) * tmask(ibdy,jj,jk) 807 807 ENDIF 808 808 ENDIF … … 810 810 END DO 811 811 ! Restore ghost points: 812 ts a(ibdy-1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1)812 ts(ibdy-1,jmin:jmax,1:jpkm1,jn,Krhs) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1) 813 813 END DO 814 814 ENDIF … … 824 824 jbdy=1+nbghostcells 825 825 DO jn = 1, jpts 826 ts a(imin:imax,jbdy-1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn)826 ts(imin:imax,jbdy-1,1:jpkm1,jn,Krhs) = z1 * ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 827 827 DO jk = 1, jpkm1 828 828 DO ji = imin,imax 829 829 IF( vmask(ji,jbdy,jk) == 0._wp ) THEN 830 ts a(ji,jbdy,jk,jn)=tsa(ji,jbdy-1,jk,jn) * tmask(ji,jbdy,jk)830 ts(ji,jbdy,jk,jn,Krhs)=ts(ji,jbdy-1,jk,jn,Krhs) * tmask(ji,jbdy,jk) 831 831 ELSE 832 ts a(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy-1,jk,jn)+z3*tsa(ji,jbdy+1,jk,jn))*tmask(ji,jbdy,jk)833 IF( v n(ji,jbdy,jk) < 0._wp ) THEN834 ts a(ji,jbdy,jk,jn)=( z6*tsa(ji,jbdy+1,jk,jn)+z5*tsa(ji,jbdy-1,jk,jn) &835 + z7*ts a(ji,jbdy+2,jk,jn) ) * tmask(ji,jbdy,jk)832 ts(ji,jbdy,jk,jn,Krhs)=(z4*ts(ji,jbdy-1,jk,jn,Krhs)+z3*ts(ji,jbdy+1,jk,jn,Krhs))*tmask(ji,jbdy,jk) 833 IF( vv(ji,jbdy,jk,Kmm) < 0._wp ) THEN 834 ts(ji,jbdy,jk,jn,Krhs)=( z6*ts(ji,jbdy+1,jk,jn,Krhs)+z5*ts(ji,jbdy-1,jk,jn,Krhs) & 835 + z7*ts(ji,jbdy+2,jk,jn,Krhs) ) * tmask(ji,jbdy,jk) 836 836 ENDIF 837 837 ENDIF … … 839 839 END DO 840 840 ! Restore ghost points: 841 ts a(imin:imax,jbdy-1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1)841 ts(imin:imax,jbdy-1,1:jpkm1,jn,Krhs) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1) 842 842 END DO 843 843 ENDIF … … 861 861 ! 862 862 IF( before) THEN 863 ptab(i1:i2,j1:j2) = ssh n(i1:i2,j1:j2)863 ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kmm) 864 864 ELSE 865 865 western_side = (nb == 1).AND.(ndir == 1) … … 900 900 DO jj=j1,j2 901 901 DO ji=i1,i2 902 ptab(ji,jj,jk,1) = (e2u(ji,jj) * e3u _n(ji,jj,jk) * un(ji,jj,jk)*umask(ji,jj,jk))902 ptab(ji,jj,jk,1) = (e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm)*umask(ji,jj,jk)) 903 903 # if defined key_vertical 904 ptab(ji,jj,jk,2) = (umask(ji,jj,jk) * e2u(ji,jj) * e3u _n(ji,jj,jk))904 ptab(ji,jj,jk,2) = (umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm)) 905 905 # endif 906 906 END DO … … 928 928 929 929 IF (N_in == 0) THEN 930 u a(ji,jj,:) = 0._wp930 uu(ji,jj,:,Krhs) = 0._wp 931 931 CYCLE 932 932 ENDIF … … 936 936 if (umask(iref,jj,jk) == 0) EXIT 937 937 N_out = N_out + 1 938 h_out(N_out) = e3u _a(iref,jj,jk)938 h_out(N_out) = e3u(iref,jj,jk,Krhs) 939 939 ENDDO 940 940 941 941 IF (N_out == 0) THEN 942 u a(ji,jj,:) = 0._wp942 uu(ji,jj,:,Krhs) = 0._wp 943 943 CYCLE 944 944 ENDIF … … 952 952 endif 953 953 ENDIF 954 call reconstructandremap(tabin(1:N_in),h_in(1:N_in),u a(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out)954 call reconstructandremap(tabin(1:N_in),h_in(1:N_in),uu(ji,jj,1:N_out,Krhs),h_out(1:N_out),N_in,N_out) 955 955 ENDDO 956 956 ENDDO … … 959 959 DO jk = 1, jpkm1 960 960 DO jj=j1,j2 961 u a(i1:i2,jj,jk) = ptab(i1:i2,jj,jk,1) / ( zrhoy * e2u(i1:i2,jj) * e3u_a(i1:i2,jj,jk) )961 uu(i1:i2,jj,jk,Krhs) = ptab(i1:i2,jj,jk,1) / ( zrhoy * e2u(i1:i2,jj) * e3u(i1:i2,jj,jk,Krhs) ) 962 962 END DO 963 963 END DO … … 992 992 DO jj=j1,j2 993 993 DO ji=i1,i2 994 ptab(ji,jj,jk,1) = (e1v(ji,jj) * e3v _n(ji,jj,jk) * vn(ji,jj,jk)*vmask(ji,jj,jk))994 ptab(ji,jj,jk,1) = (e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm)*vmask(ji,jj,jk)) 995 995 # if defined key_vertical 996 ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v _n(ji,jj,jk)996 ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 997 997 # endif 998 998 END DO … … 1019 1019 END DO 1020 1020 IF (N_in == 0) THEN 1021 v a(ji,jj,:) = 0._wp1021 vv(ji,jj,:,Krhs) = 0._wp 1022 1022 CYCLE 1023 1023 ENDIF … … 1027 1027 if (vmask(ji,jref,jk) == 0) EXIT 1028 1028 N_out = N_out + 1 1029 h_out(N_out) = e3v _a(ji,jref,jk)1029 h_out(N_out) = e3v(ji,jref,jk,Krhs) 1030 1030 END DO 1031 1031 IF (N_out == 0) THEN 1032 v a(ji,jj,:) = 0._wp1032 vv(ji,jj,:,Krhs) = 0._wp 1033 1033 CYCLE 1034 1034 ENDIF 1035 call reconstructandremap(tabin(1:N_in),h_in(1:N_in),v a(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out)1035 call reconstructandremap(tabin(1:N_in),h_in(1:N_in),vv(ji,jj,1:N_out,Krhs),h_out(1:N_out),N_in,N_out) 1036 1036 END DO 1037 1037 END DO 1038 1038 # else 1039 1039 DO jk = 1, jpkm1 1040 v a(i1:i2,j1:j2,jk) = ptab(i1:i2,j1:j2,jk,1) / ( zrhox * e1v(i1:i2,j1:j2) * e3v_a(i1:i2,j1:j2,jk) )1040 vv(i1:i2,j1:j2,jk,Krhs) = ptab(i1:i2,j1:j2,jk,1) / ( zrhox * e1v(i1:i2,j1:j2) * e3v(i1:i2,j1:j2,jk,Krhs) ) 1041 1041 END DO 1042 1042 # endif … … 1060 1060 ! 1061 1061 IF( before ) THEN 1062 ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu_n(i1:i2,j1:j2) * u n_b(i1:i2,j1:j2)1062 ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu_n(i1:i2,j1:j2) * uu_b(i1:i2,j1:j2,Kmm) 1063 1063 ELSE 1064 1064 western_side = (nb == 1).AND.(ndir == 1) … … 1113 1113 ! 1114 1114 IF( before ) THEN 1115 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv_n(i1:i2,j1:j2) * v n_b(i1:i2,j1:j2)1115 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv_n(i1:i2,j1:j2) * vv_b(i1:i2,j1:j2,Kmm) 1116 1116 ELSE 1117 1117 western_side = (nb == 1).AND.(ndir == 1) … … 1394 1394 DO jj=j1,j2 1395 1395 DO ji=i1,i2 1396 ptab(ji,jj,jk,2) = wmask(ji,jj,jk) * e3w _n(ji,jj,jk)1396 ptab(ji,jj,jk,2) = wmask(ji,jj,jk) * e3w(ji,jj,jk,Kmm) 1397 1397 END DO 1398 1398 END DO … … 1415 1415 IF (wmask(ji,jj,jk) == 0) EXIT 1416 1416 N_out = N_out + 1 1417 h_out(jk) = e3t _n(ji,jj,jk)1417 h_out(jk) = e3t(ji,jj,jk,Kmm) 1418 1418 ENDDO 1419 1419 IF (N_in > 0) THEN
Note: See TracChangeset
for help on using the changeset viewer.