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

Ignore:
Timestamp:
2019-10-01T18:17:20+02:00 (5 years ago)
Author:
mathiot
Message:

ENHANCE-03_closea: cosmetic changes (ticket #2143)

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r11295 r11629  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  sbcclo  *** 
    4    !! Ocean forcing:  closea sea correction 
     4   !! Ocean forcing: redistribution of emp unbalance over closed sea into river mouth or open ocean 
    55   !!===================================================================== 
    6    !! History :  4.1  ! 2019-09  (P. Mathiot) original 
    7    !!   NEMO  
    8    !!---------------------------------------------------------------------- 
    9    ! 
    10    !!---------------------------------------------------------------------- 
     6   !! History :  4.0 and earlier ! see closea.F90 history    
     7   !!   NEMO     4.1  ! 2019-09  (P. Mathiot) rewrite sbc_clo module to match new closed sea mask definition (original sbcclo.F90) 
     8   !!  
     9   !!---------------------------------------------------------------------- 
     10   ! 
     11   !!---------------------------------------------------------------------- 
     12   !!   Public subroutines: 
    1113   !!   sbc_clo       : update emp and qns over target area and source area 
    1214   !!   sbc_clo_init  : initialise all variable needed for closed sea correction 
    1315   !! 
    14    !!   alloc_cssurf  : allocate closed sea surface array 
    15    !!   alloc_csgrp   : allocate closed sea group array 
     16   !!   Private subroutines: 
     17   !!   alloc_csarr   : allocate closed sea array 
    1618   !!   get_cssrcsurf : compute source surface area 
    1719   !!   get_cstrgsurf : compute target surface area 
    … …  
    3335   IMPLICIT NONE 
    3436   ! 
    35    PRIVATE alloc_cssurf 
    36    PRIVATE alloc_csgrp 
    37    PRIVATE get_cssrcsurf 
    38    PRIVATE get_cstrgsurf 
    39    PRIVATE prt_csctl 
    40    PRIVATE sbc_csupdate 
     37   PRIVATE 
    4138   ! 
    4239   PUBLIC sbc_clo 
    4340   PUBLIC sbc_clo_init 
    4441   ! 
    45    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcg, rsurftrgg !: closed sea target glo surface areas  
    46    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcr, rsurftrgr !: closed sea target rnf surface areas  
    47    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrce, rsurftrge !: closed sea target emp surface areas  
    48    ! 
    49    INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: mcsgrpg, mcsgrpr, mcsgrpe !: closed sea group for glo, rnf and emp 
     42   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcg, rsurftrgg      !: closed sea source/target glo surface areas  
     43   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcr, rsurftrgr      !: closed sea source/target rnf surface areas  
     44   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrce, rsurftrge      !: closed sea source/target emp surface areas  
     45   ! 
     46   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)  :: mcsgrpg, mcsgrpr, mcsgrpe !: closed sea group for glo, rnf and emp 
    5047   ! 
    5148   CONTAINS 
    … …  
    5956      !!                  ***  ROUTINE sbc_clo_init  *** 
    6057      !!                     
    61       !! ** Purpose :  Initialisation of the net fw closed sea correction 
     58      !! ** Purpose :  Initialisation of the variable needed for the net fw closed sea correction 
    6259      !! 
    6360      !! ** Method  :  - compute source surface area for each closed sea 
    6461      !!               - defined the group of each closed sea  
    65       !!                    (needed to manage multiple closed sea and one target area like great lakes / St Laurent outlet) 
    66       !!               - compute target surface area and corresponding group for each closed sea 
     62      !!                 (needed to manage multiple closed sea and one target area like great lakes / St Laurent outlet) 
     63      !!               - compute target surface area 
    6764      !!---------------------------------------------------------------------- 
    6865      ! 
    6966      ! 0. Allocate cs variables (surf) 
    70       CALL alloc_cssurf( ncsg, rsurfsrcg, rsurftrgg )  
    71       CALL alloc_cssurf( ncsr, rsurfsrcr, rsurftrgr ) 
    72       CALL alloc_cssurf( ncse, rsurfsrce, rsurftrge ) 
     67      CALL alloc_csarr( ncsg, rsurfsrcg, rsurftrgg, mcsgrpg )  
     68      CALL alloc_csarr( ncsr, rsurfsrcr, rsurftrgr, mcsgrpr ) 
     69      CALL alloc_csarr( ncse, rsurfsrce, rsurftrge, mcsgrpe ) 
    7370      ! 
    7471      ! 1. compute source surface area 
    … …  
    7774      CALL get_cssrcsurf( ncse, mask_csemp, rsurfsrce ) 
    7875      ! 
    79       ! 2. Allocate cs group variables (mcsgrp) 
    80       CALL alloc_csgrp( ncsg, mcsgrpg ) 
    81       CALL alloc_csgrp( ncsr, mcsgrpr ) 
    82       CALL alloc_csgrp( ncse, mcsgrpe ) 
    83       ! 
    84       ! 3. compute target surface area and group number (mcsgrp) for all cs and cases  
     76      ! 2. compute target surface area and group number (mcsgrp) for all cs and cases  
    8577      ! glo could be simpler but for lisibility, all treated the same way 
    8678      ! It is only done once, so not a big deal 
    … …  
    8981      CALL get_cstrgsurf( ncse, mask_csemp, mask_csgrpemp, rsurftrge, mcsgrpe ) 
    9082      !  
    91       ! 4. print out in ocean.ouput 
     83      ! 3. print out in ocean.ouput 
     84      IF ( lwp ) WRITE(numout,*) 'sbc_clo_init : compute surface area for source (closed sea) and target (river mouth)' 
     85      IF ( lwp ) WRITE(numout,*) '~~~~~~~~~~~~~~' 
    9286      CALL prt_csctl( ncsg, rsurfsrcg, rsurftrgg, mcsgrpg, 'glo' ) 
    9387      CALL prt_csctl( ncsr, rsurfsrcr, rsurftrgr, mcsgrpr, 'rnf' ) 
    … …  
    9690   END SUBROUTINE sbc_clo_init 
    9791 
    98    SUBROUTINE sbc_clo( kt ) ! to be move in SBC in a file sbcclo ??? 
     92   SUBROUTINE sbc_clo( kt ) 
    9993      !!--------------------------------------------------------------------- 
    10094      !!                  ***  ROUTINE sbc_clo  *** 
    … …  
    144138      !!---------------------------------------------------------------------- 
    145139      ! subroutine parameters 
    146       INTEGER,                 INTENT(in   ) :: kncs           ! closed sea number 
    147       INTEGER, DIMENSION(:,:), INTENT(in   ) :: kmaskcs        ! closed sea mask 
    148  
    149       REAL(wp), DIMENSION(:)  , INTENT(inout) :: psurfsrc      ! source surface area 
     140      INTEGER ,                 INTENT(in   ) :: kncs          ! closed sea number 
     141      INTEGER , DIMENSION(:,:), INTENT(in   ) :: kmaskcs       ! closed sea mask 
     142      REAL(wp), DIMENSION(:)  , INTENT(  out) :: psurfsrc      ! source surface area 
    150143 
    151144      ! local variables 
    … …  
    177170      !!---------------------------------------------------------------------- 
    178171      ! subroutine parameters 
     172      ! input 
    179173      INTEGER,                 INTENT(in   ) :: kncs                 ! closed sea number 
    180       INTEGER, DIMENSION(:)  , INTENT(inout) :: kcsgrp               ! closed sea group number 
    181174      INTEGER, DIMENSION(:,:), INTENT(in   ) :: kmaskcs, kmaskcsgrp  ! closed sea and group mask 
    182175 
    183       REAL(wp), DIMENSION(:)  , INTENT(inout) :: psurftrg            ! target surface area 
     176      ! output 
     177      INTEGER , DIMENSION(:)  , INTENT(  out) :: kcsgrp              ! closed sea group number 
     178      REAL(wp), DIMENSION(:)  , INTENT(  out) :: psurftrg            ! target surface area 
    184179 
    185180      ! local variables 
    186181      INTEGER :: jcs, jtmp                                           ! tmp 
    187       INTEGER, DIMENSION(jpi,jpj) :: imskgrp, imsksrc, imsktrg       ! tmp group, source and target mask 
     182      INTEGER, DIMENSION(jpi,jpj) :: imskgrp, imsksrc, imsktrg, imsk ! tmp group, source, target and tmp mask 
    188183      !!---------------------------------------------------------------------- 
    189184      ! 
    … …  
    194189         imsksrc = kmaskcs 
    195190         ! 
    196          ! set cs value where cs is 
    197          imsktrg = HUGE(1) 
    198          WHERE ( imsksrc == jcs ) imsktrg = jcs 
    199          ! 
    200          ! zmsk = HUGE outside the cs number jcs 
    201          ! ktmp = jcs - group number 
    202          ! jgrp = group corresponding to the cs jcs 
    203          imsktrg = imsktrg - imskgrp 
    204          jtmp = MINVAL(imsktrg) ; CALL mpp_min('closea',jtmp) 
     191         ! set cs value where cs is defined 
     192         ! imsk = HUGE outside the cs id jcs 
     193         imsk = HUGE(1) 
     194         WHERE ( imsksrc == jcs ) imsk = jcs 
     195         ! 
     196         ! jtmp = jcs - group id for this lake 
     197         imsk = imsk - imskgrp 
     198         jtmp = MINVAL(imsk) ; CALL mpp_min('closea',jtmp) 
     199         ! kcsgrp = group id corresponding to the cs id jcs 
     200         ! kcsgrp(jcs)=(jcs - (jcs - group id))=group id 
    205201         kcsgrp(jcs) = jcs - jtmp 
    206202         ! 
    207          !! 1. build river mouth mask for this lake 
     203         !! 1. build the target river mouth mask for this lake 
    208204         WHERE ( imskgrp * mask_opnsea == kcsgrp(jcs) ) 
    209205            imsktrg = 1 
    … …  
    243239         ! 
    244240         DO jcs = 1,kncs 
    245             WRITE(numout,FMT='(3a,i3,a,i3)') ' ',TRIM(cdcstype),' closed sea id is ',jcs,' and trg id is : ', kcsgrp(jcs) 
     241            WRITE(numout,FMT='(3a,i3,a,i3)') ' ',TRIM(cdcstype),' closed sea id is ',jcs,' and trg group id is : ', kcsgrp(jcs) 
    246242            WRITE(numout,FMT='(a,f12.2)'   ) ' src surface areas (km2) : ', psurfsrc(jcs) * 1.0e-6 
    247243            WRITE(numout,FMT='(a,f12.2)'   ) ' trg surface areas (km2) : ', psurftrg(jcs) * 1.0e-6 
    … …  
    253249   END SUBROUTINE 
    254250 
    255    SUBROUTINE sbc_csupdate(kncs, kcsgrp, kmsk_src, kmsk_trg, psurfsrc, psurftrg, cdcstype, kmsk_opnsea, psurf_opnsea, pwcs, pqcs) 
     251   SUBROUTINE sbc_csupdate(kncs, kcsgrp, kmsk_src, kmsk_grp, psurfsrc, psurftrg, cdcstype, kmsk_opnsea, psurf_opnsea, pwcs, pqcs) 
    256252      !!----------------------------------------------------------------------- 
    257253      !!                  ***  routine sbc_csupdate  *** 
    … …  
    261257      !!---------------------------------------------------------------------- 
    262258      ! subroutine parameters 
    263       INTEGER,                 INTENT(in) :: kncs                              ! closed sea number 
    264       INTEGER, DIMENSION(:  ), INTENT(in) :: kcsgrp                            ! closed sea group number 
    265       INTEGER, DIMENSION(:,:), INTENT(in) :: kmsk_src, kmsk_trg, kmsk_opnsea   ! source, target, open ocean mask 
     259      INTEGER,                 INTENT(in) :: kncs                                 ! closed sea id 
     260      INTEGER, DIMENSION(:  ), INTENT(in) :: kcsgrp                               ! closed sea group id 
     261      INTEGER, DIMENSION(:,:), INTENT(in) :: kmsk_src, kmsk_grp, kmsk_opnsea      ! source, target, open ocean mask 
    266262       
    267263      REAL(wp), DIMENSION(:)  , INTENT(in   ) :: psurfsrc, psurftrg, psurf_opnsea ! source, target and open ocean surface area 
    … …  
    271267 
    272268      ! local variables 
    273       INTEGER :: jcs  ! loop index over closed sea  
     269      INTEGER :: jcs                                     ! loop index over closed sea  
    274270      INTEGER, DIMENSION(jpi,jpj) :: imsk_src, imsk_trg  ! tmp array source and target closed sea masks 
    275271       
    … …  
    281277      DO jcs = 1, kncs  ! loop over closed seas 
    282278         ! 
    283          !! 0. get mask of each closed sea 
     279         !! 0. get mask of the closed sea 
    284280         imsk_src(:,:) = 0 
    285281         WHERE ( kmsk_src(:,:) == jcs ) imsk_src(:,:) = 1 
    286282         ! 
    287          !! 1. Work out net freshwater fluxes over each closed seas from EMP - RNF. 
     283         !! 1. Work out net freshwater fluxes over the closed sea from EMP - RNF. 
     284         !!    (PM: should we consider used delayed glob sum ?) 
    288285         zcsfwf = glob_sum( 'closea', e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * imsk_src(:,:) ) 
    289286         ! 
    290287         !! 2. Deal with runoff special case (net evaporation spread globally) 
     288         !!    and compute trg mask 
    291289         IF (cdcstype == 'rnf' .AND. zcsfwf > 0) THEN 
    292             zsurftrg = psurf_opnsea(1) 
    293             imsk_trg = kmsk_opnsea * kcsgrp(jcs) ! set imsk_trg value to the corresponding group id 
     290            zsurftrg = psurf_opnsea(1)           ! change the target area surface 
     291            imsk_trg = kcsgrp(jcs) * kmsk_opnsea ! trg mask is now the open sea mask 
    294292         ELSE 
    295293            zsurftrg = psurftrg(jcs) 
    296             imsk_trg = kmsk_trg 
     294            imsk_trg = kmsk_grp * kmsk_opnsea 
    297295         END IF 
    298          imsk_trg = imsk_trg * kmsk_opnsea 
    299296         ! 
    300297         !! 3. Add residuals to target points 
    301          zcoef    = zcsfwf / zsurftrg 
    302          zcoef1   = rcp * zcoef 
     298         zcoef  = zcsfwf / zsurftrg 
     299         zcoef1 = rcp * zcoef 
    303300         WHERE( imsk_trg(:,:) == kcsgrp(jcs) ) 
    304301            pwcs(:,:) = pwcs(:,:) + zcoef 
    … …  
    313310            pqcs(:,:) = pqcs(:,:) + zcoef1 * sst_m(:,:) 
    314311         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) 
    315315         ! 
    316316      END DO ! jcs 
    … …  
    318318   END SUBROUTINE 
    319319 
    320    SUBROUTINE alloc_cssurf( klen, pvarsrc, pvartrg ) 
     320   SUBROUTINE alloc_csarr( klen, pvarsrc, pvartrg, kvargrp ) 
    321321      !!----------------------------------------------------------------------- 
    322322      !!                  ***  routine alloc_cssurf  *** 
    323323      !! 
    324       !! ** Purpose : allocate closed sea surface array (source) 
    325       !!---------------------------------------------------------------------- 
    326       ! subroutine parameters 
    327       INTEGER, INTENT(in) :: klen 
    328       REAL(wp), ALLOCATABLE, DIMENSION(:), INTENT(inout) :: pvarsrc, pvartrg  
     324      !! ** Purpose : allocate closed sea surface array 
     325      !!---------------------------------------------------------------------- 
     326      ! subroutine parameters 
     327      INTEGER,  INTENT(in) :: klen 
     328      INTEGER,  ALLOCATABLE, DIMENSION(:), INTENT(  out) :: kvargrp 
     329      REAL(wp), ALLOCATABLE, DIMENSION(:), INTENT(  out) :: pvarsrc, pvartrg  
    329330      ! 
    330331      ! local variables 
    … …  
    336337      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surf array') 
    337338      ! 
     339      ALLOCATE( kvargrp(MAX(klen,1)) , STAT=ierr ) 
     340      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate group array') 
     341      ! 
    338342      ! initialise to 0 
    339343      pvarsrc(:) = 0.e0_wp 
    340344      pvartrg(:) = 0.e0_wp 
    341    END SUBROUTINE 
    342  
    343    SUBROUTINE alloc_csgrp( klen, kvar ) 
    344       !!----------------------------------------------------------------------- 
    345       !!                  ***  routine alloc_csgrp  *** 
    346       !! 
    347       !! ** Purpose : allocate closed sea group surface array 
    348       !!---------------------------------------------------------------------- 
    349       ! subroutine parameters 
    350       INTEGER, INTENT(in) :: klen 
    351       INTEGER, ALLOCATABLE, DIMENSION(:), INTENT(inout) :: kvar  
    352       ! 
    353       ! local variables 
    354       INTEGER :: ierr 
    355       !!---------------------------------------------------------------------- 
    356       ! 
    357       ! klen (number of lake) can be zero so use MAX(klen,1) to avoid 0 length array 
    358       ALLOCATE( kvar(MAX(klen,1)) , STAT=ierr ) 
    359       IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate group array') 
    360       ! initialise to 0 
    361       kvar(:) = 0 
     345      kvargrp(:) = 0 
    362346   END SUBROUTINE 
    363347 
Note: See TracChangeset for help on using the changeset viewer.