Changeset 11629


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

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

Location:
NEMO/branches/2019/ENHANCE-03_closea/src/OCE
Files:
3 edited

Legend:

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

    r11295 r11629  
    1616   !!---------------------------------------------------------------------- 
    1717   !!   dom_clo    : read in masks which define closed seas and runoff areas 
    18    !!   sbc_clo    : Special handling of freshwater fluxes over closed seas 
    1918   !!   clo_rnf    : set close sea outflows as river mouths (see sbcrnf) 
    20    !!   clo_bat    : set to zero a field over closed sea (see domzgr) 
     19   !!   clo_msk    : set to zero a field over closed sea (see domzgr) 
    2120   !!---------------------------------------------------------------------- 
    2221   USE oce             ! dynamics and tracers 
     
    3837   PUBLIC dom_clo      ! called by domain module 
    3938   PUBLIC clo_rnf      ! called by sbcrnf module 
    40    PUBLIC clo_bat      ! called in domzgr module 
     39   PUBLIC clo_msk      ! called in domzgr module 
    4140 
    4241   LOGICAL, PUBLIC :: ln_maskcs        !: logical to mask all closed sea 
     
    7776      !! ** Action  :   Read mask_cs* fields (if needed) from domain_cfg file and infer 
    7877      !!                number of closed seas for each case (glo, rnf, emp) from mask_cs* field. 
    79       !!                mask_csglo and mask_csgrpglo  : integer values defining mappings from closed seas and associated groups to the open ocean for net fluxes. 
     78      !! 
     79      !! ** Output  :   mask_csglo and mask_csgrpglo  : integer values defining mappings from closed seas and associated groups to the open ocean for net fluxes. 
    8080      !!                mask_csrnf and mask_csgrprnf  : integer values defining mappings from closed seas and associated groups to a runoff area for downwards flux only. 
    8181      !!                mask_csemp and mask_csgrpemp  : integer values defining mappings from closed seas and associated groups to a runoff area for net fluxes. 
     
    107107      END IF 
    108108      ! 
    109       l_sbc_clo = .false. ; l_clo_rnf = .false. 
    110       IF (.NOT. ln_maskcs)                  l_sbc_clo = .true. 
    111       IF (.NOT. ln_maskcs .AND. ln_clo_rnf) l_clo_rnf = .true. 
    112       ! 
    113109      ! read the closed seas masks (if they exist) from domain_cfg file (if it exists) 
    114110      ! ------------------------------------------------------------------------------ 
     
    119115      ! 
    120116      IF ( ln_maskcs ) THEN 
    121          ! not special treatment of closed sea 
     117         ! closed sea are masked 
     118         ! no special treatment of closed sea 
     119         ! no redistribution of emp unbalance over closed sea into river mouth/open ocean 
    122120         l_sbc_clo = .false. ; l_clo_rnf = .false. 
    123121      ELSE 
    124          ! special treatment of closed seas 
     122         ! redistribution of emp unbalance over closed sea into river mouth/open ocean 
    125123         l_sbc_clo = .true. 
    126124         ! 
     
    128126         IF ( ln_clo_rnf) l_clo_rnf = .true. 
    129127         ! 
     128         ! closed sea not defined (ie not in the domcfg namelist used to build the domcfg.nc file) are masked  
    130129         IF ( ln_mask_csundef) THEN 
    131             ! load undef cs mask (1 in undef closed sea) 
    132130            CALL alloc_csmask( mask_csundef ) 
    133131            CALL read_csmask( cn_domcfg, 'mask_csundef', mask_csundef ) 
    134             ! revert the mask for masking in domzgr 
     132            ! revert the mask for masking of undefined closed seas in domzgr  
     133            ! (0 over the undefined closed sea and 1 elsewhere) 
    135134            mask_csundef = 1 - mask_csundef 
    136135         END IF 
    137136         ! 
    138          ! allocate source mask 
     137         ! allocate source mask for each cases 
    139138         CALL alloc_csmask( mask_csglo ) 
    140139         CALL alloc_csmask( mask_csrnf ) 
     
    151150         ncse = MAXVAL( mask_csemp(:,:) ) ; CALL mpp_max( 'closea', ncse ) 
    152151         ! 
    153          ! allocate closed sea group masks 
     152         ! allocate closed sea group masks  
     153         !(used to defined the target area in case multiple lakes have the same river mouth (great lakes for example) 
    154154         CALL alloc_csmask( mask_csgrpglo ) 
    155155         CALL alloc_csmask( mask_csgrprnf ) 
     
    176176      !! ** Action  :   update (p_)mskrnf (set 1 at closed sea outflow) 
    177177      !!---------------------------------------------------------------------- 
    178       !! 
    179178      !! subroutine parameter 
    180179      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_rnfmsk   ! river runoff mask (rnfmsk array) 
     
    192191   END SUBROUTINE clo_rnf 
    193192       
    194    SUBROUTINE clo_bat( k_top, k_bot, k_mask, cd_prt ) 
    195       !!--------------------------------------------------------------------- 
    196       !!                  ***  ROUTINE clo_bat  *** 
     193   SUBROUTINE clo_msk( k_top, k_bot, k_mask, cd_prt ) 
     194      !!--------------------------------------------------------------------- 
     195      !!                  ***  ROUTINE clo_msk  *** 
    197196      !!                     
    198197      !! ** Purpose :   Suppress closed sea from the domain 
    199198      !! 
    200       !! ** Method  :   Read in closea_mask field (if it exists) from domain_cfg file. 
    201       !!                Where closea_mask > 0 set first and last ocean level to 0 
     199      !! ** Method  :   Where closea_mask > 0 set first and last ocean level to 0 
    202200      !!                (As currently coded you can't define a closea_mask field in  
    203201      !!                usr_def_zgr). 
     
    205203      !! ** Action  :   set k_top=0 and k_bot=0 over closed seas 
    206204      !!---------------------------------------------------------------------- 
    207       !! 
    208205      !! subroutine parameter 
    209206      INTEGER, DIMENSION(:,:), INTENT(inout) ::   k_top, k_bot   ! ocean first and last level indices 
     
    216213      IF ( lwp ) THEN 
    217214         WRITE(numout,*) 
    218          WRITE(numout,*) 'clo_bat : Suppression closed seas based on ',TRIM(cd_prt),' field.' 
     215         WRITE(numout,*) 'clo_msk : Suppression closed seas based on ',TRIM(cd_prt),' field.' 
    219216         WRITE(numout,*) '~~~~~~~' 
    220217         WRITE(numout,*) 
     
    224221      k_bot(:,:) = k_bot(:,:) * k_mask(:,:) 
    225222      !! 
    226    END SUBROUTINE clo_bat 
     223   END SUBROUTINE clo_msk 
    227224 
    228225   SUBROUTINE read_csmask(cd_file, cd_var, k_mskout) 
    229       ! 
     226      !!--------------------------------------------------------------------- 
     227      !!                  ***  ROUTINE read_csmask  *** 
     228      !!                     
     229      !! ** Purpose : read mask in cd_filec file 
     230      !!---------------------------------------------------------------------- 
    230231      ! subroutine parameter 
    231       CHARACTER(256), INTENT(in   ) :: cd_file, cd_var     ! netcdf file and variable name 
    232       INTEGER, DIMENSION(:,:), INTENT(inout) :: k_mskout ! output mask variable 
     232      CHARACTER(256),          INTENT(in   ) :: cd_file, cd_var     ! netcdf file and variable name 
     233      INTEGER, DIMENSION(:,:), INTENT(  out) :: k_mskout            ! output mask variable 
    233234      ! 
    234235      ! local variables 
    235236      INTEGER :: ics                       ! netcdf id 
    236237      REAL(wp), DIMENSION(jpi,jpj) :: zdta ! netcdf data 
     238      !!---------------------------------------------------------------------- 
    237239      ! 
    238240      CALL iom_open ( cd_file, ics ) 
     
    244246 
    245247   SUBROUTINE alloc_csmask( kmask ) 
    246       ! 
     248      !!--------------------------------------------------------------------- 
     249      !!                  ***  ROUTINE alloc_csmask  *** 
     250      !!                     
     251      !! ** Purpose : allocated cs mask 
     252      !!---------------------------------------------------------------------- 
    247253      ! subroutine parameter 
    248254      INTEGER, ALLOCATABLE, DIMENSION(:,:), INTENT(inout) :: kmask 
     
    250256      ! local variables 
    251257      INTEGER :: ierr 
     258      !!---------------------------------------------------------------------- 
    252259      ! 
    253260      ALLOCATE( kmask(jpi,jpj) , STAT=ierr ) 
  • NEMO/branches/2019/ENHANCE-03_closea/src/OCE/DOM/domzgr.F90

    r11207 r11629  
    121121         IF ( ln_maskcs ) THEN 
    122122            ! mask all the closed sea 
    123             CALL clo_bat( k_top, k_bot, mask_opnsea, 'mask_opensea' ) 
     123            CALL clo_msk( k_top, k_bot, mask_opnsea, 'mask_opensea' ) 
    124124         ELSE IF ( ln_mask_csundef ) THEN 
    125125            ! defined closed sea are kept 
    126126            ! mask all the undefined closed sea 
    127             CALL clo_bat( k_top, k_bot, mask_csundef, 'mask_csundef' ) 
     127            CALL clo_msk( k_top, k_bot, mask_csundef, 'mask_csundef' ) 
    128128         END IF 
    129129      END IF 
  • 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.