Changeset 11258 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdylib.F90
- Timestamp:
- 2019-07-11T18:21:02+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdylib.F90
r11191 r11258 149 149 REAL(wp) :: zdy_1, zdy_2, zsign_ups 150 150 REAL(wp), PARAMETER :: zepsilon = 1.e-30 ! local small value 151 REAL(wp), POINTER, DIMENSION(:,:) :: pmask ! land/sea mask for field152 REAL(wp), POINTER, DIMENSION(:,:) :: pmask_xdif ! land/sea mask for x-derivatives153 REAL(wp), POINTER, DIMENSION(:,:) :: pmask_ydif ! land/sea mask for y-derivatives151 REAL(wp), POINTER, DIMENSION(:,:) :: zmask ! land/sea mask for field 152 REAL(wp), POINTER, DIMENSION(:,:) :: zmask_xdif ! land/sea mask for x-derivatives 153 REAL(wp), POINTER, DIMENSION(:,:) :: zmask_ydif ! land/sea mask for y-derivatives 154 154 REAL(wp), POINTER, DIMENSION(:,:) :: pe_xdif ! scale factors for x-derivatives 155 155 REAL(wp), POINTER, DIMENSION(:,:) :: pe_ydif ! scale factors for y-derivatives … … 162 162 SELECT CASE(igrd) 163 163 CASE(1) 164 pmask => tmask(:,:,1)165 pmask_xdif => umask(:,:,1)166 pmask_ydif => vmask(:,:,1)164 zmask => tmask(:,:,1) 165 zmask_xdif => umask(:,:,1) 166 zmask_ydif => vmask(:,:,1) 167 167 pe_xdif => e1u(:,:) 168 168 pe_ydif => e2v(:,:) … … 170 170 ij_offset = 0 171 171 CASE(2) 172 pmask => umask(:,:,1)173 pmask_xdif => tmask(:,:,1)174 pmask_ydif => fmask(:,:,1)172 zmask => umask(:,:,1) 173 zmask_xdif => tmask(:,:,1) 174 zmask_ydif => fmask(:,:,1) 175 175 pe_xdif => e1t(:,:) 176 176 pe_ydif => e2f(:,:) … … 178 178 ij_offset = 0 179 179 CASE(3) 180 pmask => vmask(:,:,1)181 pmask_xdif => fmask(:,:,1)182 pmask_ydif => tmask(:,:,1)180 zmask => vmask(:,:,1) 181 zmask_xdif => fmask(:,:,1) 182 zmask_ydif => tmask(:,:,1) 183 183 pe_xdif => e1f(:,:) 184 184 pe_ydif => e2t(:,:) … … 214 214 ! 215 215 ! Calculate scale factors for calculation of spatial derivatives. 216 zex1 = ( abs(iibm1-iibm2) * pe_xdif(iibm1 +ii_offset,ijbm1 )&217 & + abs(ijbm1-ijbm2) * pe_ydif(iibm1 ,ijbm1+ij_offset) )218 zex2 = ( abs(iibm1-iibm2) * pe_xdif(iibm2 +ii_offset,ijbm2 )&219 & + abs(ijbm1-ijbm2) * pe_ydif(iibm2 ,ijbm2+ij_offset) )220 zey1 = ( (iibm1-iibm1jm1) * pe_xdif(iibm1jm1+ii_offset,ijbm1jm1 ) &216 zex1 = ( abs(iibm1-iibm2) * pe_xdif(iibm1 +ii_offset,ijbm1 ) & 217 & + abs(ijbm1-ijbm2) * pe_ydif(iibm1 ,ijbm1 +ij_offset) ) 218 zex2 = ( abs(iibm1-iibm2) * pe_xdif(iibm2 +ii_offset,ijbm2 ) & 219 & + abs(ijbm1-ijbm2) * pe_ydif(iibm2 ,ijbm2 +ij_offset) ) 220 zey1 = ( (iibm1-iibm1jm1) * pe_xdif(iibm1jm1+ii_offset,ijbm1jm1 ) & 221 221 & + (ijbm1-ijbm1jm1) * pe_ydif(iibm1jm1 ,ijbm1jm1+ij_offset) ) 222 zey2 = ( (iibm1jp1-iibm1) * pe_xdif(iibm1 +ii_offset,ijbm1)&223 & + (ijbm1jp1-ijbm1) * pe_ydif(iibm1 ,ijbm1+ij_offset) )222 zey2 = ( (iibm1jp1-iibm1) * pe_xdif(iibm1 +ii_offset,ijbm1 ) & 223 & + (ijbm1jp1-ijbm1) * pe_ydif(iibm1 ,ijbm1 +ij_offset) ) 224 224 ! make sure scale factors are nonzero 225 225 if( zey1 .lt. rsmall ) zey1 = zey2 … … 228 228 zey1 = max(zey1,rsmall); zey2 = max(zey2,rsmall); 229 229 ! 230 ! Calculate masks for calculation of spatial derivatives. 231 zmask_x = ( abs(iibm1-iibm2) * pmask_xdif(iibm2+ii_offset,ijbm2 )&232 & + abs(ijbm1-ijbm2) * pmask_ydif(iibm2 ,ijbm2+ij_offset) )233 zmask_y1 = ( (iibm1-iibm1jm1) * pmask_xdif(iibm1jm1+ii_offset,ijbm1jm1 )&234 & + (ijbm1-ijbm1jm1) * pmask_ydif(iibm1jm1 ,ijbm1jm1+ij_offset) )235 zmask_y2 = ( (iibm1jp1-iibm1) * pmask_xdif(iibm1+ii_offset,ijbm1)&236 & + (ijbm1jp1-ijbm1) * pmask_ydif(iibm1 ,ijbm1+ij_offset) )230 ! Calculate masks for calculation of spatial derivatives. 231 zmask_x = ( abs(iibm1-iibm2) * zmask_xdif(iibm2 +ii_offset,ijbm2 ) & 232 & + abs(ijbm1-ijbm2) * zmask_ydif(iibm2 ,ijbm2 +ij_offset) ) 233 zmask_y1 = ( (iibm1-iibm1jm1) * zmask_xdif(iibm1jm1+ii_offset,ijbm1jm1 ) & 234 & + (ijbm1-ijbm1jm1) * zmask_ydif(iibm1jm1 ,ijbm1jm1+ij_offset) ) 235 zmask_y2 = ( (iibm1jp1-iibm1) * zmask_xdif(iibm1 +ii_offset,ijbm1 ) & 236 & + (ijbm1jp1-ijbm1) * zmask_ydif(iibm1 ,ijbm1 +ij_offset) ) 237 237 238 238 ! Calculation of terms required for both versions of the scheme. … … 242 242 ! Note no rdt factor in expression for zdt because it cancels in the expressions for 243 243 ! zrx and zry. 244 zdt = phia(iibm1,ijbm1) - phib(iibm1,ijbm1)245 zdx = ( ( phia(iibm1,ijbm1) - phia(iibm2,ijbm2) ) / zex2 ) * zmask_x244 zdt = phia(iibm1 ,ijbm1 ) - phib(iibm1 ,ijbm1 ) 245 zdx = ( ( phia(iibm1 ,ijbm1 ) - phia(iibm2 ,ijbm2 ) ) / zex2 ) * zmask_x 246 246 zdy_1 = ( ( phib(iibm1 ,ijbm1 ) - phib(iibm1jm1,ijbm1jm1) ) / zey1 ) * zmask_y1 247 zdy_2 = ( ( phib(iibm1jp1,ijbm1jp1) - phib(iibm1 ,ijbm1 )) / zey2 ) * zmask_y2247 zdy_2 = ( ( phib(iibm1jp1,ijbm1jp1) - phib(iibm1 ,ijbm1 ) ) / zey2 ) * zmask_y2 248 248 zdy_centred = 0.5 * ( zdy_1 + zdy_2 ) 249 249 !!$ zdy_centred = phib(iibm1jp1,ijbm1jp1) - phib(iibm1jm1,ijbm1jm1) … … 276 276 & + zwgt * ( phi_ext(jb) - phib(ii,ij) ) ) / ( 1. + zrx ) 277 277 end if 278 phia(ii,ij) = phia(ii,ij) * pmask(ii,ij)278 phia(ii,ij) = phia(ii,ij) * zmask(ii,ij) 279 279 END DO 280 280 ! … … 314 314 REAL(wp) :: zdy_1, zdy_2, zsign_ups 315 315 REAL(wp), PARAMETER :: zepsilon = 1.e-30 ! local small value 316 REAL(wp), POINTER, DIMENSION(:,:,:) :: pmask ! land/sea mask for field317 REAL(wp), POINTER, DIMENSION(:,:,:) :: pmask_xdif ! land/sea mask for x-derivatives318 REAL(wp), POINTER, DIMENSION(:,:,:) :: pmask_ydif ! land/sea mask for y-derivatives316 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask ! land/sea mask for field 317 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask_xdif ! land/sea mask for x-derivatives 318 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask_ydif ! land/sea mask for y-derivatives 319 319 REAL(wp), POINTER, DIMENSION(:,:) :: pe_xdif ! scale factors for x-derivatives 320 320 REAL(wp), POINTER, DIMENSION(:,:) :: pe_ydif ! scale factors for y-derivatives … … 327 327 SELECT CASE(igrd) 328 328 CASE(1) 329 pmask => tmask(:,:,:)330 pmask_xdif => umask(:,:,:)331 pmask_ydif => vmask(:,:,:)329 zmask => tmask(:,:,:) 330 zmask_xdif => umask(:,:,:) 331 zmask_ydif => vmask(:,:,:) 332 332 pe_xdif => e1u(:,:) 333 333 pe_ydif => e2v(:,:) … … 335 335 ij_offset = 0 336 336 CASE(2) 337 pmask => umask(:,:,:)338 pmask_xdif => tmask(:,:,:)339 pmask_ydif => fmask(:,:,:)337 zmask => umask(:,:,:) 338 zmask_xdif => tmask(:,:,:) 339 zmask_ydif => fmask(:,:,:) 340 340 pe_xdif => e1t(:,:) 341 341 pe_ydif => e2f(:,:) … … 343 343 ij_offset = 0 344 344 CASE(3) 345 pmask => vmask(:,:,:)346 pmask_xdif => fmask(:,:,:)347 pmask_ydif => tmask(:,:,:)345 zmask => vmask(:,:,:) 346 zmask_xdif => fmask(:,:,:) 347 zmask_ydif => tmask(:,:,:) 348 348 pe_xdif => e1f(:,:) 349 349 pe_ydif => e2t(:,:) … … 381 381 ! 382 382 ! Calculate scale factors for calculation of spatial derivatives. 383 zex1 = ( abs(iibm1-iibm2) * pe_xdif(iibm1 +ii_offset,ijbm1 )&384 & + abs(ijbm1-ijbm2) * pe_ydif(iibm1 ,ijbm1+ij_offset) )385 zex2 = ( abs(iibm1-iibm2) * pe_xdif(iibm2 +ii_offset,ijbm2 )&386 & + abs(ijbm1-ijbm2) * pe_ydif(iibm2 ,ijbm2+ij_offset) )387 zey1 = ( (iibm1-iibm1jm1) * pe_xdif(iibm1jm1+ii_offset,ijbm1jm1 ) &383 zex1 = ( abs(iibm1-iibm2) * pe_xdif(iibm1 +ii_offset,ijbm1 ) & 384 & + abs(ijbm1-ijbm2) * pe_ydif(iibm1 ,ijbm1+ij_offset ) ) 385 zex2 = ( abs(iibm1-iibm2) * pe_xdif(iibm2 +ii_offset,ijbm2 ) & 386 & + abs(ijbm1-ijbm2) * pe_ydif(iibm2 ,ijbm2+ij_offset ) ) 387 zey1 = ( (iibm1-iibm1jm1) * pe_xdif(iibm1jm1+ii_offset,ijbm1jm1 ) & 388 388 & + (ijbm1-ijbm1jm1) * pe_ydif(iibm1jm1 ,ijbm1jm1+ij_offset) ) 389 zey2 = ( (iibm1jp1-iibm1) * pe_xdif(iibm1 +ii_offset,ijbm1)&390 & + (ijbm1jp1-ijbm1) * pe_ydif(iibm1 ,ijbm1+ij_offset) )389 zey2 = ( (iibm1jp1-iibm1) * pe_xdif(iibm1 +ii_offset,ijbm1 ) & 390 & + (ijbm1jp1-ijbm1) * pe_ydif(iibm1 ,ijbm1+ij_offset ) ) 391 391 ! make sure scale factors are nonzero 392 392 if( zey1 .lt. rsmall ) zey1 = zey2 … … 396 396 ! 397 397 ! Calculate masks for calculation of spatial derivatives. 398 zmask_x = ( abs(iibm1-iibm2) * pmask_xdif(iibm2+ii_offset,ijbm2 ,jk)&399 & + abs(ijbm1-ijbm2) * pmask_ydif(iibm2 ,ijbm2+ij_offset,jk) )400 zmask_y1 = ( (iibm1-iibm1jm1) * pmask_xdif(iibm1jm1+ii_offset,ijbm1jm1 ,jk) &401 & + (ijbm1-ijbm1jm1) * pmask_ydif(iibm1jm1 ,ijbm1jm1+ij_offset,jk) )402 zmask_y2 = ( (iibm1jp1-iibm1) * pmask_xdif(iibm1+ii_offset,ijbm1 ,jk)&403 & + (ijbm1jp1-ijbm1) * pmask_ydif(iibm1 ,ijbm1+ij_offset,jk) )398 zmask_x = ( abs(iibm1-iibm2) * zmask_xdif(iibm2 +ii_offset,ijbm2 ,jk) & 399 & + abs(ijbm1-ijbm2) * zmask_ydif(iibm2 ,ijbm2 +ij_offset,jk) ) 400 zmask_y1 = ( (iibm1-iibm1jm1) * zmask_xdif(iibm1jm1+ii_offset,ijbm1jm1 ,jk) & 401 & + (ijbm1-ijbm1jm1) * zmask_ydif(iibm1jm1 ,ijbm1jm1+ij_offset,jk) ) 402 zmask_y2 = ( (iibm1jp1-iibm1) * zmask_xdif(iibm1 +ii_offset,ijbm1 ,jk) & 403 & + (ijbm1jp1-ijbm1) * zmask_ydif(iibm1 ,ijbm1 +ij_offset,jk) ) 404 404 ! 405 405 ! Calculate normal (zrx) and tangential (zry) components of radiation velocities. … … 407 407 ! Centred derivative is calculated as average of "left" and "right" derivatives for 408 408 ! this reason. 409 zdt = phia(iibm1,ijbm1,jk) - phib(iibm1,ijbm1,jk)410 zdx = ( ( phia(iibm1,ijbm1,jk) - phia(iibm2,ijbm2,jk) ) / zex2 ) * zmask_x409 zdt = phia(iibm1 ,ijbm1 ,jk) - phib(iibm1 ,ijbm1 ,jk) 410 zdx = ( ( phia(iibm1 ,ijbm1 ,jk) - phia(iibm2 ,ijbm2 ,jk) ) / zex2 ) * zmask_x 411 411 zdy_1 = ( ( phib(iibm1 ,ijbm1 ,jk) - phib(iibm1jm1,ijbm1jm1,jk) ) / zey1 ) * zmask_y1 412 412 zdy_2 = ( ( phib(iibm1jp1,ijbm1jp1,jk) - phib(iibm1 ,ijbm1 ,jk) ) / zey2 ) * zmask_y2 … … 442 442 & + zwgt * ( phi_ext(jb,jk) - phib(ii,ij,jk) ) ) / ( 1. + zrx ) 443 443 end if 444 phia(ii,ij,jk) = phia(ii,ij,jk) * pmask(ii,ij,jk)444 phia(ii,ij,jk) = phia(ii,ij,jk) * zmask(ii,ij,jk) 445 445 END DO 446 446 ! … … 469 469 !! 470 470 REAL(wp) :: zweight 471 REAL(wp), POINTER, DIMENSION(:,:,:) :: pmask ! land/sea mask for field471 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask ! land/sea mask for field 472 472 INTEGER :: ib, ik ! dummy loop indices 473 473 INTEGER :: ii, ij ! 2D addresses … … 480 480 ! 481 481 SELECT CASE(igrd) 482 CASE(1) ; pmask => tmask(:,:,:)483 CASE(2) ; pmask => umask(:,:,:)484 CASE(3) ; pmask => vmask(:,:,:)482 CASE(1) ; zmask => tmask(:,:,:) 483 CASE(2) ; zmask => umask(:,:,:) 484 CASE(3) ; zmask => vmask(:,:,:) 485 485 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for igrd in bdy_nmn' ) 486 486 END SELECT … … 502 502 IF( ii1 < 1 .OR. ii1 > jpi .OR. ij1 < 1 .OR. ij1 > jpj ) CYCLE 503 503 DO ik = 1, ipkm1 504 IF( pmask(ii1,ij1,ik) /= 0. ) phia(ii,ij,ik) = phia(ii1,ij1,ik)504 IF( zmask(ii1,ij1,ik) /= 0. ) phia(ii,ij,ik) = phia(ii1,ij1,ik) 505 505 END DO 506 506 CASE( 9:12 ) … … 508 508 IF( ii2 < 1 .OR. ii2 > jpi .OR. ij2 < 1 .OR. ij2 > jpj ) CYCLE 509 509 DO ik = 1, ipkm1 510 zweight = pmask(ii1,ij1,ik) + pmask(ii2,ij2,ik)510 zweight = zmask(ii1,ij1,ik) + zmask(ii2,ij2,ik) 511 511 IF( zweight /= 0. ) phia(ii,ij,ik) = ( phia(ii1,ij1,ik) + phia(ii2,ij2,ik) ) / zweight 512 512 END DO … … 516 516 IF( ii3 < 1 .OR. ii3 > jpi .OR. ij3 < 1 .OR. ij3 > jpj ) CYCLE 517 517 DO ik = 1, ipkm1 518 zweight = pmask(ii1,ij1,ik) + pmask(ii2,ij2,ik) + pmask(ii3,ij3,ik)518 zweight = zmask(ii1,ij1,ik) + zmask(ii2,ij2,ik) + zmask(ii3,ij3,ik) 519 519 IF( zweight /= 0. ) phia(ii,ij,ik) = ( phia(ii1,ij1,ik) + phia(ii2,ij2,ik) + phia(ii3,ij3,ik) ) / zweight 520 520 END DO
Note: See TracChangeset
for help on using the changeset viewer.
