Changeset 15680
- Timestamp:
- 2022-02-01T17:43:17+01:00 (2 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/releases/r4.0/r4.0-HEAD/src/OCE/DOM/closea.F90
r10425 r15680 49 49 !: F => No closed seas defined (closea_mask field not found). 50 50 LOGICAL, PUBLIC :: l_clo_rnf !: T => Some closed seas output freshwater (RNF or EMPMR) to specified runoff points. 51 INTEGER , PUBLIC :: jncs !:number of closed seas (inferred from closea_mask field)52 INTEGER , PUBLIC :: jncsr !:number of closed seas rnf mappings (inferred from closea_mask_rnf field)53 INTEGER , PUBLIC :: jncse !:number of closed seas empmr mappings (inferred from closea_mask_empmr field)51 INTEGER :: jncs ! number of closed seas (inferred from closea_mask field) 52 INTEGER :: jncsr ! number of closed seas rnf mappings (inferred from closea_mask_rnf field) 53 INTEGER :: jncse ! number of closed seas empmr mappings (inferred from closea_mask_empmr field) 54 54 55 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: closea_mask !:mask of integers defining closed seas56 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: closea_mask_rnf !:mask of integers defining closed seas rnf mappings57 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: closea_mask_empmr !:mask of integers defining closed seas empmr mappings58 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: surf !:closed sea surface areas59 !:(and residual global surface area)60 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: surfr !:closed sea target rnf surface areas61 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: surfe !:closed sea target empmr surface areas55 INTEGER , ALLOCATABLE, DIMENSION(:,:) :: closea_mask ! mask of integers defining closed seas 56 INTEGER , ALLOCATABLE, DIMENSION(:,:) :: closea_mask_rnf ! mask of integers defining closed seas rnf mappings 57 INTEGER , ALLOCATABLE, DIMENSION(:,:) :: closea_mask_empmr ! mask of integers defining closed seas empmr mappings 58 REAL(wp), ALLOCATABLE, DIMENSION(:) :: surf ! closed sea surface areas 59 ! (and residual global surface area) 60 REAL(wp), ALLOCATABLE, DIMENSION(:) :: surfr ! closed sea target rnf surface areas 61 REAL(wp), ALLOCATABLE, DIMENSION(:) :: surfe ! closed sea target empmr surface areas 62 62 63 63 !! * Substitutions … … 201 201 !! 202 202 !! ** Action : emp updated surface freshwater fluxes and associated heat content at kt 203 !! 204 !! surf(1:jncs) = surface of closed seas (defined by mask/=0) 205 !! surf(jncs+1) = surface of global ocean without closed seas 206 !! surfe(1:jncse) = surface of target regions (defined by mask_empmr/=0 & mask=0) 207 !! where empmr budget (zfwfe) from some closed seas is added 208 !! (those where mask_empmr/=0 & mask/=0) 203 209 !!---------------------------------------------------------------------- 204 210 INTEGER , INTENT(in ) :: kt ! ocean model time step … … 206 212 INTEGER :: ierr 207 213 INTEGER :: jc, jcr, jce ! dummy loop indices 208 REAL(wp), PARAMETER :: rsmall = 1.e-20_wp ! Closed sea correction epsilon 209 REAL(wp) :: zfwf_total, zcoef, zcoef1 ! 210 REAL(wp), DIMENSION(jncs) :: zfwf !: 211 REAL(wp), DIMENSION(jncsr+1) :: zfwfr !: freshwater fluxes over closed seas 212 REAL(wp), DIMENSION(jncse+1) :: zfwfe !: 214 REAL(wp) :: zfwf_total, zcoef ! 215 REAL(wp), DIMENSION(jncs) :: zfwf ! 216 REAL(wp), DIMENSION(jncsr+1) :: zfwfr ! freshwater fluxes over closed seas 217 REAL(wp), DIMENSION(jncse+1) :: zfwfe ! 213 218 REAL(wp), DIMENSION(jpi,jpj) :: ztmp2d ! 2D workspace 214 219 !!---------------------------------------------------------------------- … … 247 252 ! 248 253 ! jncs+1 : surface area of global ocean, closed seas excluded 249 surf(jncs+1) = surf(jncs+1) - SUM(surf(1:jncs))254 IF( jncs > 0 ) surf(jncs+1) = surf(jncs+1) - SUM(surf(1:jncs)) 250 255 ! 251 256 ! ! surface areas of rnf target areas … … 314 319 DO jcr = 1, jncsr 315 320 ! 316 ztmp2d(:,:) = 0.e0_wp 317 WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) > 0 ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) 318 zfwfr(jcr) = glob_sum( 'closea', ztmp2d(:,:) ) 319 ! 320 ! The following if avoids the redistribution of the round off 321 IF ( ABS(zfwfr(jcr) / surf(jncs+1) ) > rsmall) THEN 321 IF( surfr(jcr) > 0._wp ) THEN ! target area /= 0 322 ztmp2d(:,:) = 0.e0_wp 323 WHERE( closea_mask_rnf(:,:) == jcr .AND. closea_mask(:,:) > 0 ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) 324 zfwfr(jcr) = glob_sum( 'closea', ztmp2d(:,:) ) 322 325 ! 323 326 ! Add residuals to target runoff points if negative and subtract from total to be added globally 324 327 IF( zfwfr(jcr) < 0.0 ) THEN 328 zcoef = zfwfr(jcr) / surfr(jcr) 329 WHERE( closea_mask_rnf(:,:) == jcr .AND. closea_mask(:,:) == 0 ) 330 emp(:,:) = emp(:,:) + zcoef 331 qns(:,:) = qns(:,:) - zcoef * rcp * sst_m(:,:) 332 ENDWHERE 325 333 zfwf_total = zfwf_total - zfwfr(jcr) 326 zcoef = zfwfr(jcr) / surfr(jcr)327 zcoef1 = rcp * zcoef328 WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) == 0.0)329 emp(:,:) = emp(:,:) + zcoef330 qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)331 ENDWHERE332 334 ENDIF 333 335 ! … … 343 345 DO jce = 1, jncse 344 346 ! 345 ztmp2d(:,:) = 0.e0_wp 346 WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) > 0 ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) 347 zfwfe(jce) = glob_sum( 'closea', ztmp2d(:,:) ) 348 ! 349 ! The following if avoids the redistribution of the round off 350 IF ( ABS( zfwfe(jce) / surf(jncs+1) ) > rsmall ) THEN 347 IF( surfe(jce) > 0._wp ) THEN ! target area /= 0 348 ztmp2d(:,:) = 0.e0_wp 349 WHERE( closea_mask_empmr(:,:) == jce .AND. closea_mask(:,:) > 0 ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) 350 zfwfe(jce) = glob_sum( 'closea', ztmp2d(:,:) ) 351 351 ! 352 352 ! Add residuals to runoff points and subtract from total to be added globally 353 zcoef = zfwfe(jce) / surfe(jce) 354 WHERE( closea_mask_empmr(:,:) == jce .AND. closea_mask(:,:) == 0 ) 355 emp(:,:) = emp(:,:) + zcoef 356 qns(:,:) = qns(:,:) - zcoef * rcp * sst_m(:,:) 357 ENDWHERE 353 358 zfwf_total = zfwf_total - zfwfe(jce) 354 zcoef = zfwfe(jce) / surfe(jce)355 zcoef1 = rcp * zcoef356 WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) == 0.0)357 emp(:,:) = emp(:,:) + zcoef358 qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)359 ENDWHERE360 !361 359 ENDIF 360 ! 362 361 END DO 363 362 ENDIF ! jncse > 0 … … 366 365 ! 4. Spread residual flux over global ocean. 367 366 ! 368 ! The following if avoids the redistribution of the round off 369 IF ( ABS(zfwf_total / surf(jncs+1) ) > rsmall) THEN 370 zcoef = zfwf_total / surf(jncs+1) 371 zcoef1 = rcp * zcoef 372 WHERE( closea_mask(:,:) == 0 ) 373 emp(:,:) = emp(:,:) + zcoef 374 qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:) 367 zcoef = zfwf_total / surf(jncs+1) 368 WHERE( closea_mask(:,:) == 0 ) 369 emp(:,:) = emp(:,:) + zcoef 370 qns(:,:) = qns(:,:) - zcoef * rcp * sst_m(:,:) 371 ENDWHERE 372 ! 373 ! 5. Subtract area means from emp (and qns) over closed seas to give zero mean FW flux over each sea. 374 ! 375 DO jc = 1, jncs 376 ! 377 ! Subtract residuals from fluxes over closed sea 378 zcoef = zfwf(jc) / surf(jc) 379 WHERE( closea_mask(:,:) == jc ) 380 emp(:,:) = emp(:,:) - zcoef 381 qns(:,:) = qns(:,:) + zcoef * rcp * sst_m(:,:) 375 382 ENDWHERE 376 ENDIF 377 378 ! 379 ! 5. Subtract area means from emp (and qns) over closed seas to give zero mean FW flux over each sea. 380 ! 381 DO jc = 1, jncs 382 ! The following if avoids the redistribution of the round off 383 IF ( ABS(zfwf(jc) / surf(jncs+1) ) > rsmall) THEN 384 ! 385 ! Subtract residuals from fluxes over closed sea 386 zcoef = zfwf(jc) / surf(jc) 387 zcoef1 = rcp * zcoef 388 WHERE( closea_mask(:,:) == jc ) 389 emp(:,:) = emp(:,:) - zcoef 390 qns(:,:) = qns(:,:) + zcoef1 * sst_m(:,:) 391 ENDWHERE 392 ! 393 ENDIF 383 ! 394 384 END DO 395 385 ! 396 386 emp (:,:) = emp (:,:) * tmask(:,:,1) 397 387 ! 398 CALL lbc_lnk( 'closea', emp , 'T', 1._wp ) 388 CALL lbc_lnk( 'closea', emp , 'T', 1._wp ) ! clem: why do we need that? 399 389 ! 400 390 END SUBROUTINE sbc_clo
Note: See TracChangeset
for help on using the changeset viewer.