- Timestamp:
- 2019-11-26T12:39:45+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_eORCA1_visc/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90
r11101 r11965 205 205 INTEGER :: ifreq, il1, il2, ij, ii 206 206 REAL(wp) :: zahmeq, zcoff, zcoft, zmsk ! local scalars 207 REAL(wp) :: zemax , zemin, ze ref, zahmm207 REAL(wp) :: zemax , zemin, zetmax, zefmax, zeref, zahmm, zemax75 208 208 CHARACTER (len=15) :: clexp 209 209 INTEGER , POINTER, DIMENSION(:,:) :: icof 210 INTEGER , POINTER, DIMENSION(:,:) :: imsk 210 211 REAL(wp), POINTER, DIMENSION(: ) :: zcoef 211 212 REAL(wp), POINTER, DIMENSION(:,:) :: zahm0 … … 216 217 ! 217 218 CALL wrk_alloc( jpi , jpj , icof ) 219 CALL wrk_alloc( jpi , jpj , imsk ) 218 220 CALL wrk_alloc( jpk , zcoef ) 219 221 CALL wrk_alloc( jpi , jpj , zahm0 ) … … 253 255 zahmeq = 5.0 * aht0 254 256 zahmm = min( 160000.0, ahm0) 255 zemax = MAXVAL ( e1t(:,:) * e2t(:,:), tmask(:,:,1) .GE. 0.5 ) 256 zemin = MINVAL ( e1t(:,:) * e2t(:,:), tmask(:,:,1) .GE. 0.5 ) 257 zemax = MAXVAL ( e1t(:,:) * e2t(:,:), ssmask(:,:) .GE. 0.5 ) 258 zemin = MINVAL ( e1t(:,:) * e2t(:,:), ssmask(:,:) .GE. 0.5 ) 259 257 260 tempmask(:,:) = .FALSE. 258 261 ! Pre calculate mask for zeref since embedding the following 259 262 ! term in the MAXVAL operation offends the Cray compiler for no 260 263 ! justifiable reason under certain conditions. 261 tempmask(:,:) = ( tmask(:,:,1) .GE. 0.5) .AND. (ABS(gphit(:,:)) .GT. 50.)264 tempmask(:,:) = (ssmask(:,:) .GE. 0.5) .AND. (ABS(gphit(:,:)) .GT. 50.) 262 265 zeref = MAXVAL ( e1t(:,:) * e2t(:,:), tempmask(:,:) ) 263 266 … … 321 324 END DO 322 325 ! f-point 323 icof(:,:) = icof(:,:) * tmask(:,:,1)326 icof(:,:) = icof(:,:) * ssmask(:,:) 324 327 DO jj = 1, jpjm1 325 328 DO ji = 1, jpim1 ! NO vector opt. 326 zmsk = tmask(ji,jj+1,1) + tmask(ji+1,jj+1,1) + tmask(ji,jj,1) + tmask(ji,jj+1,1)329 zmsk = ssmask(ji,jj+1) + ssmask(ji+1,jj+1) + ssmask(ji,jj) + ssmask(ji,jj+1) 327 330 IF( zmsk == 0. ) THEN 328 331 zcoff = 1. … … 387 390 CALL lbc_lnk( ahm2, 'F', 1. ) 388 391 392 IF( jp_cfg == 1 ) THEN ! Limit AHM south of -75 (critical for Giant ice shelves with small e1/e2) 393 ! special orca1 treatment remove the grid size scaling. Need to restore it south of -75N 394 ! define max grid size south of -75 395 imsk(:,:) = 0 396 WHERE( gphit(:,:) < -75.0 ) imsk(:,:) = 1 397 zemax75 = MAX( MAXVAL( e1t(:,:)*imsk(:,:) ), MAXVAL( e2t(:,:)*imsk(:,:) ) ) 398 IF( lk_mpp ) CALL mpp_max(zemax75) 399 ! 400 ! apply grid size scaling of ahm south of -75 (no change north of it) 401 DO jj = 1, jpj 402 DO ji = 1, jpi 403 IF ( gphit(ji,jj) < -75.0 ) THEN 404 zetmax = MAX( e1t(ji,jj), e2t(ji,jj) ) 405 zefmax = MAX( e1f(ji,jj), e2f(ji,jj) ) 406 ahm1(ji,jj,:) = zetmax / zemax75 * ahm1(ji,jj,:) 407 ahm2(ji,jj,:) = zefmax / zemax75 * ahm2(ji,jj,:) 408 END IF 409 END DO 410 END DO 411 END IF 412 389 413 390 414 IF(lwp) THEN ! Control print … … 432 456 WRITE(numout,*) ' ahm4 array level 1' 433 457 CALL prihre(ahm4(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 434 ENDIF 435 ! 458 ENDIF 459 ! 436 460 IF(lwp .AND. lflush) CALL flush(numout) 437 461 ! 438 462 CALL wrk_dealloc( jpi , jpj , icof ) 463 CALL wrk_dealloc( jpi , jpj , imsk ) 439 464 CALL wrk_dealloc( jpk , zcoef ) 440 465 CALL wrk_dealloc( jpi , jpj , zahm0 )
Note: See TracChangeset
for help on using the changeset viewer.