New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 15680 – NEMO

Changeset 15680


Ignore:
Timestamp:
2022-02-01T17:43:17+01:00 (2 years ago)
Author:
clem
Message:

4.0-HEAD: debug closea, see ticket #2754

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/releases/r4.0/r4.0-HEAD/src/OCE/DOM/closea.F90

    r10425 r15680  
    4949                                 !: F => No closed seas defined (closea_mask field not found). 
    5050   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) 
    5454    
    55    INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::  closea_mask       !: mask of integers defining closed seas 
    56    INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::  closea_mask_rnf   !: mask of integers defining closed seas rnf mappings 
    57    INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::  closea_mask_empmr !: mask of integers defining closed seas empmr mappings 
    58    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:)  ::   surf         !: closed sea surface areas  
    59                                                                   !: (and residual global surface area)  
    60    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:)  ::   surfr        !: closed sea target rnf surface areas  
    61    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:)  ::   surfe        !: closed sea target empmr surface areas  
     55   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  
    6262 
    6363   !! * Substitutions 
     
    201201      !! 
    202202      !! ** 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) 
    203209      !!---------------------------------------------------------------------- 
    204210      INTEGER         , INTENT(in   ) ::   kt       ! ocean model time step 
     
    206212      INTEGER             ::   ierr 
    207213      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     !  
    213218      REAL(wp), DIMENSION(jpi,jpj) ::   ztmp2d   ! 2D workspace 
    214219      !!---------------------------------------------------------------------- 
     
    247252         ! 
    248253         ! 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)) 
    250255         ! 
    251256         !                                        ! surface areas of rnf target areas 
     
    314319         DO jcr = 1, jncsr 
    315320            ! 
    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(:,:) ) 
    322325               ! 
    323326               ! Add residuals to target runoff points if negative and subtract from total to be added globally 
    324327               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 
    325333                  zfwf_total = zfwf_total - zfwfr(jcr) 
    326                   zcoef    = zfwfr(jcr) / surfr(jcr) 
    327                   zcoef1   = rcp * zcoef 
    328                   WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) == 0.0) 
    329                      emp(:,:) = emp(:,:) + zcoef 
    330                      qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:) 
    331                   ENDWHERE 
    332334               ENDIF 
    333335               ! 
     
    343345         DO jce = 1, jncse 
    344346            ! 
    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(:,:) ) 
    351351               ! 
    352352               ! 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 
    353358               zfwf_total = zfwf_total - zfwfe(jce) 
    354                zcoef    = zfwfe(jce) / surfe(jce) 
    355                zcoef1   = rcp * zcoef 
    356                WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) == 0.0) 
    357                   emp(:,:) = emp(:,:) + zcoef 
    358                   qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:) 
    359                ENDWHERE 
    360                ! 
    361359            ENDIF 
     360            ! 
    362361         END DO 
    363362      ENDIF ! jncse > 0     
     
    366365      ! 4. Spread residual flux over global ocean.  
    367366      ! 
    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(:,:) 
    375382         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         ! 
    394384      END DO 
    395385      ! 
    396386      emp (:,:) = emp (:,:) * tmask(:,:,1) 
    397387      ! 
    398       CALL lbc_lnk( 'closea', emp , 'T', 1._wp ) 
     388      CALL lbc_lnk( 'closea', emp , 'T', 1._wp ) ! clem: why do we need that? 
    399389      ! 
    400390   END SUBROUTINE sbc_clo 
Note: See TracChangeset for help on using the changeset viewer.