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 11656 for NEMO/branches/2019/ENHANCE-03_closea/src/OCE/SBC/sbcclo.F90 – NEMO

Ignore:
Timestamp:
2019-10-04T21:03:26+02:00 (4 years ago)
Author:
mathiot
Message:

ENHANCE-03_closea: add heat/fw fluxes output from closed seas + rm useless USE statements + add USE ONLY when reasonable + ensure heat conservation during the redistribution process (ticket #2143)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/ENHANCE-03_closea/src/OCE/SBC/sbcclo.F90

    r11629 r11656  
    2222   !!---------------------------------------------------------------------- 
    2323   ! 
    24    USE oce             ! dynamics and tracers 
    25    USE dom_oce         ! ocean space and time domain 
    26    USE closea          ! closed sea  
    27    USE phycst          ! physical constants 
    28    USE sbc_oce         ! ocean surface boundary conditions 
    29    USE iom             ! I/O routines 
    30    ! 
    31    USE in_out_manager  ! I/O manager 
    32    USE lib_fortran,    ONLY: glob_sum 
    33    USE lib_mpp         ! MPP library 
     24   USE closea                                  ! closed sea  
     25   USE in_out_manager                          ! I/O manager 
     26   ! 
     27   USE dom_oce,     ONLY: e1e2t                ! ocean space and time domain 
     28   USE phycst ,     ONLY: rcp                  ! physical constants 
     29   USE sbc_oce,     ONLY: emp, qns, rnf, sst_m ! ocean surface boundary conditions 
     30   USE iom    ,     ONLY: iom_put              ! I/O routines 
     31   USE lib_fortran, ONLY: glob_sum             ! fortran library 
     32   USE lib_mpp    , ONLY: mpp_min, ctl_stop    ! MPP library 
    3433   ! 
    3534   IMPLICIT NONE 
     
    270269      INTEGER, DIMENSION(jpi,jpj) :: imsk_src, imsk_trg  ! tmp array source and target closed sea masks 
    271270       
    272       REAL(wp) :: zcoef, zcoef1, ztmp ! tmp 
    273       REAL(wp) :: zcsfwf              ! tmp net fwf over one closed sea 
    274       REAL(wp) :: zsurftrg            ! tmp target surface area 
     271      REAL(wp) :: zcsfw, zcsh        ! total fresh water and associated heat over one closed sea 
     272      REAL(wp) :: zcsfwf             ! mean fresh water flux over one closed sea 
     273      REAL(wp) :: zsurftrg, zsurfsrc ! total target surface area 
    275274      !!---------------------------------------------------------------------- 
    276275      ! 
    277276      DO jcs = 1, kncs  ! loop over closed seas 
    278277         ! 
    279          !! 0. get mask of the closed sea 
    280          imsk_src(:,:) = 0 
    281          WHERE ( kmsk_src(:,:) == jcs ) imsk_src(:,:) = 1 
    282          ! 
    283          !! 1. Work out net freshwater fluxes over the closed sea from EMP - RNF. 
     278         !! 0. get mask and surface of the closed sea 
     279         ! mask src 
     280         WHERE ( kmsk_src(:,:) == jcs )  
     281            imsk_src(:,:) = 1 
     282         ELSEWHERE 
     283            imsk_src(:,:) = 0 
     284         END WHERE 
     285         ! area src 
     286         zsurfsrc = psurfsrc(jcs) 
     287         ! 
     288         !! 1. Work out net freshwater over the closed sea from EMP - RNF. 
     289         !!    Work out net heat associated with the correction (needed for conservation) 
    284290         !!    (PM: should we consider used delayed glob sum ?) 
    285          zcsfwf = glob_sum( 'closea', e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * imsk_src(:,:) ) 
     291         zcsfw  = glob_sum( 'closea', e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * imsk_src(:,:) ) 
    286292         ! 
    287293         !! 2. Deal with runoff special case (net evaporation spread globally) 
    288294         !!    and compute trg mask 
    289          IF (cdcstype == 'rnf' .AND. zcsfwf > 0) THEN 
     295         IF (cdcstype == 'rnf' .AND. zcsfw  > 0._wp) THEN 
    290296            zsurftrg = psurf_opnsea(1)           ! change the target area surface 
    291297            imsk_trg = kcsgrp(jcs) * kmsk_opnsea ! trg mask is now the open sea mask 
     
    295301         END IF 
    296302         ! 
    297          !! 3. Add residuals to target points 
    298          zcoef  = zcsfwf / zsurftrg 
    299          zcoef1 = rcp * zcoef 
     303         !! 3. Subtract residuals from source points 
     304         zcsfwf = zcsfw / zsurfsrc 
     305         pwcs(:,:) = pwcs(:,:) -       zcsfwf              * imsk_src(:,:) 
     306         pqcs(:,:) = pqcs(:,:) + rcp * zcsfwf * sst_m(:,:) * imsk_src(:,:) 
     307         ! 
     308         !! 4. Add residuals to target points  
     309         !!    Do not use pqcs(:,:) = pqcs(:,:) - rcp * zcsfw  * sst_m(:,:) / zsurftrg  
     310         !!    as there is no reason for heat conservation with this formulation 
     311         zcsh   = glob_sum( 'closea', e1e2t(:,:) * rcp * zcsfwf * sst_m(:,:) * imsk_src(:,:) ) 
    300312         WHERE( imsk_trg(:,:) == kcsgrp(jcs) ) 
    301             pwcs(:,:) = pwcs(:,:) + zcoef 
    302             pqcs(:,:) = pqcs(:,:) - zcoef1 * sst_m(:,:) 
     313            pwcs(:,:) = pwcs(:,:) + zcsfw / zsurftrg 
     314            pqcs(:,:) = pqcs(:,:) - zcsh  / zsurftrg 
    303315         ENDWHERE 
    304          ! 
    305          !! 4. Subtract residuals from source points 
    306          zcoef    = zcsfwf / psurfsrc(jcs) 
    307          zcoef1   = rcp * zcoef 
    308          WHERE( kmsk_src(:,:) == jcs ) 
    309             pwcs(:,:) = pwcs(:,:) - zcoef 
    310             pqcs(:,:) = pqcs(:,:) + zcoef1 * sst_m(:,:) 
    311          ENDWHERE 
    312          ! WARNING (PM): the correction is done as it was done in the previous version 
    313          !               this do no conserve heat as there is no reason that  
    314          !               sum(zcoef1*sst_m) over the source (closed sea) (4) = sum(zcoef1*sst_m) over the target (river mouth) (3) 
    315316         ! 
    316317      END DO ! jcs 
Note: See TracChangeset for help on using the changeset viewer.