- Timestamp:
- 2020-08-03T15:48:40+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900/src/OCE/ICB/icbutl.F90
r13365 r13374 164 164 REAL(wp), DIMENSION(4) :: zmskF, zmskU, zmskV, zmskT ! mask 165 165 REAL(wp), DIMENSION(4) :: zwTp, zmskTp, zwTm, zmskTm 166 REAL(wp), DIMENSION(4,jpk) :: zw1d 166 167 INTEGER :: iiT, iiU, iiV, iiF, ijT, ijU, ijV, ijF ! bottom left corner 167 168 INTEGER :: iiTp, iiTm, ijTp, ijTm … … 225 226 ! 3d interpolation 226 227 IF ( PRESENT(puoce) .AND. PRESENT(pvoce) ) THEN 227 puoce(:) = icb_utl_bilin_h( uoce_e , iiU, ijU, zwU ) 228 pvoce(:) = icb_utl_bilin_h( voce_e , iiV, ijV, zwV ) 228 ! no need to mask as 0 is a valid data for land 229 zw1d(1,:) = zwU(1) ; zw1d(2,:) = zwU(2) ; zw1d(3,:) = zwU(3) ; zw1d(4,:) = zwU(4) ; 230 puoce(:) = icb_utl_bilin_h( uoce_e , iiU, ijU, zw1d ) 231 232 zw1d(1,:) = zwV(1) ; zw1d(2,:) = zwV(2) ; zw1d(3,:) = zwV(3) ; zw1d(4,:) = zwV(4) ; 233 pvoce(:) = icb_utl_bilin_h( voce_e , iiV, ijV, zw1d ) 229 234 END IF 230 IF ( PRESENT(ptoce) ) ptoce(:) = icb_utl_bilin_h( toce_e , iiT, ijT, zwT * zmskT ) 235 236 IF ( PRESENT(ptoce) ) THEN 237 ! for temperature we need to mask the weight properly 238 ! no need of extra halo as it is a T point variable 239 zw1d(1,:) = tmask(iiT ,ijT ,:) * zwT(1) * zmskT(1) 240 zw1d(2,:) = tmask(iiT+1,ijT ,:) * zwT(2) * zmskT(2) 241 zw1d(3,:) = tmask(iiT ,ijT+1,:) * zwT(3) * zmskT(3) 242 zw1d(4,:) = tmask(iiT+1,ijT+1,:) * zwT(4) * zmskT(4) 243 ptoce(:) = icb_utl_bilin_h( toce_e , iiT, ijT, zw1d ) 244 END IF 245 ! 231 246 IF ( PRESENT(pe3t) ) pe3t(:) = e3t_e(iiT,ijT,:) ! as in Nacho tarball need to be fix once we are able to reproduce Nacho results 232 247 ! … … 300 315 IF ( ierr > 0 ) THEN 301 316 WRITE(numout,*) 'bottom left corner T point out of bound' 302 WRITE(numout,*) kii, mig( 1 ), mig(jpi) 303 WRITE(numout,*) kij, mjg( 1 ), mjg(jpj) 317 WRITE(numout,*) pi, kii, mig( 1 ), mig(jpi) 318 WRITE(numout,*) pj, kij, mjg( 1 ), mjg(jpj) 319 WRITE(numout,*) pmsk 304 320 CALL ctl_stop('STOP','icb_utl_bilin_h: an icebergs coordinates is out of valid range (out of bound error)') 305 321 END IF … … 381 397 !!---------------------------------------------------------------------- 382 398 REAL(wp), DIMENSION(0:jpi+1,0:jpj+1, jpk), INTENT(in) :: pfld ! field to be interpolated 383 REAL(wp), DIMENSION(4 ), INTENT(in) :: pw ! weight399 REAL(wp), DIMENSION(4,jpk) , INTENT(in) :: pw ! weight 384 400 INTEGER , INTENT(in) :: pii, pij ! bottom left corner 385 401 REAL(wp), DIMENSION(jpk) :: icb_utl_bilin_3d_h 386 402 ! 387 403 REAL(wp), DIMENSION(4,jpk) :: zdat ! input data 404 INTEGER :: jk 388 405 !!---------------------------------------------------------------------- 389 406 ! … … 395 412 ! 396 413 ! compute interpolated value 397 icb_utl_bilin_3d_h(:) = ( zdat(1,:)*pw(1) + zdat(2,:)*pw(2) + zdat(3,:)*pw(3) + zdat(4,:)*pw(4) ) / MAX(1.e-20, pw(1)+pw(2)+pw(3)+pw(4)) 414 DO jk=1,jpk 415 icb_utl_bilin_3d_h(jk) = ( zdat(1,jk)*pw(1,jk) + zdat(2,jk)*pw(2,jk) + zdat(3,jk)*pw(3,jk) + zdat(4,jk)*pw(4,jk) ) & 416 & / MAX(1.e-20, pw(1,jk)+pw(2,jk)+pw(3,jk)+pw(4,jk)) 417 END DO 398 418 ! 399 419 END FUNCTION icb_utl_bilin_3d_h
Note: See TracChangeset
for help on using the changeset viewer.