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 12377 for NEMO/trunk/src/OCE/DOM/closea.F90 – NEMO

Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (4 years ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 

  • NEMO/trunk/src/OCE/DOM/closea.F90

    r10425 r12377  
    1111   !!             4.0  !  2016-06  (G. Madec)  move to usrdef_closea, remove clo_ups 
    1212   !!             4.0  !  2017-12  (D. Storkey) new formulation based on masks read from file 
     13   !!             4.1  !  2019-07  (P. Mathiot) update to the new domcfg.nc input file 
    1314   !!---------------------------------------------------------------------- 
    1415 
    1516   !!---------------------------------------------------------------------- 
    1617   !!   dom_clo    : read in masks which define closed seas and runoff areas 
    17    !!   sbc_clo    : Special handling of freshwater fluxes over closed seas 
    1818   !!   clo_rnf    : set close sea outflows as river mouths (see sbcrnf) 
    19    !!   clo_bat    : set to zero a field over closed sea (see domzgr) 
    20    !!---------------------------------------------------------------------- 
    21    USE oce             ! dynamics and tracers 
    22    USE dom_oce         ! ocean space and time domain 
    23    USE phycst          ! physical constants 
    24    USE sbc_oce         ! ocean surface boundary conditions 
    25    USE iom             ! I/O routines 
     19   !!   clo_msk    : set to zero a field over closed sea (see domzgr) 
     20   !!---------------------------------------------------------------------- 
     21   USE in_out_manager  ! I/O manager 
    2622   ! 
    27    USE in_out_manager  ! I/O manager 
    28    USE lib_fortran,    ONLY: glob_sum 
    29    USE lbclnk          ! lateral boundary condition - MPP exchanges 
    30    USE lib_mpp         ! MPP library 
    31    USE timing          ! Timing 
     23   USE diu_bulk    , ONLY: ln_diurnal_only            ! used for sanity check 
     24   USE iom         , ONLY: iom_open, iom_get, iom_close, jpdom_data ! I/O routines 
     25   USE lib_fortran , ONLY: glob_sum                   ! fortran library 
     26   USE lib_mpp     , ONLY: mpp_max, ctl_nam, ctl_stop ! MPP library 
    3227 
    3328   IMPLICIT NONE 
     29 
    3430   PRIVATE 
    3531 
    3632   PUBLIC dom_clo      ! called by domain module 
    37    PUBLIC sbc_clo      ! called by sbcmod module 
    3833   PUBLIC clo_rnf      ! called by sbcrnf module 
    39    PUBLIC clo_bat      ! called in domzgr module 
    40  
    41    LOGICAL, PUBLIC :: ln_closea  !:  T => keep closed seas (defined by closea_mask field) in the domain and apply 
    42                                  !:       special treatment of freshwater fluxes. 
    43                                  !:  F => suppress closed seas (defined by closea_mask field) from the bathymetry 
    44                                  !:       at runtime. 
    45                                  !:  If there is no closea_mask field in the domain_cfg file or we do not use 
    46                                  !:  a domain_cfg file then this logical does nothing. 
    47                                  !: 
    48    LOGICAL, PUBLIC :: l_sbc_clo  !: T => Closed seas defined, apply special treatment of freshwater fluxes. 
    49                                  !: F => No closed seas defined (closea_mask field not found). 
    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) 
    54     
    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  
    62  
    63    !! * Substitutions 
    64 #  include "vectopt_loop_substitute.h90" 
     34   PUBLIC clo_msk      ! called in domzgr module 
     35 
     36   LOGICAL, PUBLIC :: ln_maskcs        !: logical to mask all closed sea 
     37   LOGICAL, PUBLIC :: ln_mask_csundef  !: logical to mask all undefined closed sea 
     38   LOGICAL, PUBLIC :: ln_clo_rnf       !: closed sea treated as runoff (update rnf mask) 
     39 
     40   LOGICAL, PUBLIC :: l_sbc_clo  !: T => net evap/precip over closed seas spread outover the globe/river mouth 
     41   LOGICAL, PUBLIC :: l_clo_rnf  !: T => Some closed seas output freshwater (RNF) to specified runoff points. 
     42 
     43   INTEGER, PUBLIC :: ncsg      !: number of closed seas global mappings (inferred from closea_mask_glo field) 
     44   INTEGER, PUBLIC :: ncsr      !: number of closed seas rnf    mappings (inferred from closea_mask_rnf field) 
     45   INTEGER, PUBLIC :: ncse      !: number of closed seas empmr  mappings (inferred from closea_mask_emp field) 
     46 
     47   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_opnsea, mask_csundef  !: mask defining the open sea and the undefined closed sea 
     48  
     49   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csglo , mask_csgrpglo !: mask of integers defining closed seas 
     50   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csrnf , mask_csgrprnf !: mask of integers defining closed seas rnf mappings 
     51   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csemp , mask_csgrpemp !: mask of integers defining closed seas empmr mappings 
     52 
    6553   !!---------------------------------------------------------------------- 
    6654   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7664      !! ** Purpose :   Closed sea domain initialization 
    7765      !! 
    78       !! ** Method  :   if a closed sea is located only in a model grid point 
    79       !!                just the thermodynamic processes are applied. 
    80       !! 
    81       !! ** Action  :   Read closea_mask* fields (if they exist) from domain_cfg file and infer 
    82       !!                number of closed seas from closea_mask field. 
    83       !!                closea_mask       : integer values defining closed seas (or groups of closed seas) 
    84       !!                closea_mask_rnf   : integer values defining mappings from closed seas or groups of 
    85       !!                                    closed seas to a runoff area for downwards flux only. 
    86       !!                closea_mask_empmr : integer values defining mappings from closed seas or groups of 
    87       !!                                    closed seas to a runoff area for net fluxes. 
    88       !! 
    89       !!                Python code to generate the closea_masks* fields from the old-style indices 
    90       !!                definitions is available at TOOLS/DOMAINcfg/make_closea_masks.py 
    91       !!---------------------------------------------------------------------- 
    92       INTEGER ::   inum    ! input file identifier 
    93       INTEGER ::   ierr    ! error code 
    94       INTEGER ::   id      ! netcdf variable ID 
    95  
    96       REAL(wp), DIMENSION(jpi,jpj) :: zdata_in ! temporary real array for input 
    97       !!---------------------------------------------------------------------- 
    98       ! 
     66      !! ** Action  :   Read mask_cs* fields (if needed) from domain_cfg file and infer 
     67      !!                number of closed seas for each case (glo, rnf, emp) from mask_cs* field. 
     68      !! 
     69      !! ** Output  :   mask_csglo and mask_csgrpglo  : integer values defining mappings from closed seas and associated groups to the open ocean for net fluxes. 
     70      !!                mask_csrnf and mask_csgrprnf  : integer values defining mappings from closed seas and associated groups to a runoff area for downwards flux only. 
     71      !!                mask_csemp and mask_csgrpemp  : integer values defining mappings from closed seas and associated groups to a runoff area for net fluxes. 
     72      !!---------------------------------------------------------------------- 
     73      INTEGER ::   ios     ! io status 
     74      !! 
     75      NAMELIST/namclo/ ln_maskcs, ln_mask_csundef, ln_clo_rnf 
     76      !!--------------------------------------------------------------------- 
     77      !! 
     78      READ  ( numnam_ref, namclo, IOSTAT = ios, ERR = 901 ) 
     79901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namclo in reference namelist' ) 
     80      READ  ( numnam_cfg, namclo, IOSTAT = ios, ERR = 902 ) 
     81902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namclo in configuration namelist' ) 
     82      IF(lwm) WRITE ( numond, namclo ) 
     83      !! 
    9984      IF(lwp) WRITE(numout,*) 
    10085      IF(lwp) WRITE(numout,*)'dom_clo : read in masks to define closed seas ' 
    10186      IF(lwp) WRITE(numout,*)'~~~~~~~' 
     87      IF(lwp) WRITE(numout,*) 
     88      !! 
     89      !! check option compatibility 
     90      IF( .NOT. ln_read_cfg ) THEN 
     91         CALL ctl_stop('Suppression of closed seas does not work with ln_read_cfg = .true. . Set ln_closea = .false. .') 
     92      ENDIF 
     93      !! 
     94      IF( (.NOT. ln_maskcs) .AND. ln_diurnal_only ) THEN 
     95         CALL ctl_stop('Special handling of freshwater fluxes over closed seas not compatible with ln_diurnal_only.') 
     96      END IF 
    10297      ! 
    10398      ! read the closed seas masks (if they exist) from domain_cfg file (if it exists) 
    10499      ! ------------------------------------------------------------------------------ 
    105100      ! 
    106       IF( ln_read_cfg) THEN 
    107          ! 
    108          CALL iom_open( cn_domcfg, inum ) 
    109          ! 
    110          id = iom_varid(inum, 'closea_mask', ldstop = .false.) 
    111          IF( id > 0 ) THEN  
    112             l_sbc_clo = .true. 
    113             ALLOCATE( closea_mask(jpi,jpj) , STAT=ierr ) 
    114             IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dom_clo: failed to allocate closea_mask array') 
    115             zdata_in(:,:) = 0.0 
    116             CALL iom_get ( inum, jpdom_data, 'closea_mask', zdata_in ) 
    117             closea_mask(:,:) = NINT(zdata_in(:,:)) * tmask(:,:,1) 
    118             ! number of closed seas = global maximum value in closea_mask field 
    119             jncs = maxval(closea_mask(:,:)) 
    120             CALL mpp_max('closea', jncs) 
    121             IF( jncs > 0 ) THEN 
    122                IF( lwp ) WRITE(numout,*) 'Number of closed seas : ',jncs 
    123             ELSE 
    124                CALL ctl_stop( 'Problem with closea_mask field in domain_cfg file. Has no values > 0 so no closed seas defined.') 
    125             ENDIF 
    126          ELSE  
    127             IF( lwp ) WRITE(numout,*) 
    128             IF( lwp ) WRITE(numout,*) '   ==>>>   closea_mask field not found in domain_cfg file.' 
    129             IF( lwp ) WRITE(numout,*) '           No closed seas defined.' 
    130             IF( lwp ) WRITE(numout,*) 
    131             l_sbc_clo = .false. 
    132             jncs = 0  
    133          ENDIF 
    134  
    135          l_clo_rnf = .false. 
    136  
    137          IF( l_sbc_clo ) THEN ! No point reading in closea_mask_rnf or closea_mask_empmr fields if no closed seas defined. 
    138  
    139             id = iom_varid(inum, 'closea_mask_rnf', ldstop = .false.) 
    140             IF( id > 0 ) THEN  
    141                l_clo_rnf = .true.             
    142                ALLOCATE( closea_mask_rnf(jpi,jpj) , STAT=ierr ) 
    143                IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dom_clo: failed to allocate closea_mask_rnf array') 
    144                CALL iom_get ( inum, jpdom_data, 'closea_mask_rnf', zdata_in ) 
    145                closea_mask_rnf(:,:) = NINT(zdata_in(:,:)) * tmask(:,:,1) 
    146                ! number of closed seas rnf mappings = global maximum in closea_mask_rnf field 
    147                jncsr = maxval(closea_mask_rnf(:,:)) 
    148                CALL mpp_max('closea', jncsr) 
    149                IF( jncsr > 0 ) THEN 
    150                   IF( lwp ) WRITE(numout,*) 'Number of closed seas rnf mappings : ',jncsr 
    151                ELSE 
    152                   CALL ctl_stop( 'Problem with closea_mask_rnf field in domain_cfg file. Has no values > 0 so no closed seas rnf mappings defined.') 
    153                ENDIF 
    154             ELSE  
    155                IF( lwp ) WRITE(numout,*) 'closea_mask_rnf field not found in domain_cfg file. No closed seas rnf mappings defined.' 
    156                jncsr = 0 
    157             ENDIF 
    158   
    159             id = iom_varid(inum, 'closea_mask_empmr', ldstop = .false.) 
    160             IF( id > 0 ) THEN  
    161                l_clo_rnf = .true.             
    162                ALLOCATE( closea_mask_empmr(jpi,jpj) , STAT=ierr ) 
    163                IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dom_clo: failed to allocate closea_mask_empmr array') 
    164                CALL iom_get ( inum, jpdom_data, 'closea_mask_empmr', zdata_in ) 
    165                closea_mask_empmr(:,:) = NINT(zdata_in(:,:)) * tmask(:,:,1) 
    166                ! number of closed seas empmr mappings = global maximum value in closea_mask_empmr field 
    167                jncse = maxval(closea_mask_empmr(:,:)) 
    168                CALL mpp_max('closea', jncse) 
    169                IF( jncse > 0 ) THEN  
    170                   IF( lwp ) WRITE(numout,*) 'Number of closed seas empmr mappings : ',jncse 
    171                ELSE 
    172                   CALL ctl_stop( 'Problem with closea_mask_empmr field in domain_cfg file. Has no values > 0 so no closed seas empmr mappings defined.') 
    173                ENDIF 
    174             ELSE  
    175                IF( lwp ) WRITE(numout,*) 'closea_mask_empmr field not found in domain_cfg file. No closed seas empmr mappings defined.' 
    176                jncse = 0 
    177             ENDIF 
    178  
    179          ENDIF ! l_sbc_clo 
    180          ! 
    181          CALL iom_close( inum ) 
    182          ! 
    183       ELSE ! ln_read_cfg = .false. so no domain_cfg file 
    184          IF( lwp ) WRITE(numout,*) 'No domain_cfg file so no closed seas defined.' 
    185          l_sbc_clo = .false. 
    186          l_clo_rnf = .false. 
    187       ENDIF 
    188       ! 
     101      ! load mask of open sea 
     102      CALL alloc_csmask( mask_opnsea ) 
     103      CALL read_csmask( cn_domcfg, 'mask_opensea' , mask_opnsea  ) 
     104      ! 
     105      IF ( ln_maskcs ) THEN 
     106         ! closed sea are masked 
     107         IF(lwp) WRITE(numout,*)'          ln_maskcs = T : all closed seas are masked' 
     108         IF(lwp) WRITE(numout,*) 
     109         ! no special treatment of closed sea 
     110         ! no redistribution of emp unbalance over closed sea into river mouth/open ocean 
     111         l_sbc_clo = .false. ; l_clo_rnf = .false. 
     112      ELSE 
     113         ! redistribution of emp unbalance over closed sea into river mouth/open ocean 
     114         IF(lwp) WRITE(numout,*)'          ln_maskcs = F : net emp is corrected over defined closed seas' 
     115         ! 
     116         l_sbc_clo = .true. 
     117         ! 
     118         ! river mouth from lakes added to rnf mask for special treatment 
     119         IF ( ln_clo_rnf) l_clo_rnf = .true. 
     120         ! 
     121         IF ( ln_mask_csundef) THEN 
     122            ! closed sea not defined (ie not in the domcfg namelist used to build the domcfg.nc file) are masked  
     123            IF(lwp) WRITE(numout,*)'          ln_mask_csundef = T : all undefined closed seas are masked' 
     124            ! 
     125            CALL alloc_csmask( mask_csundef ) 
     126            CALL read_csmask( cn_domcfg, 'mask_csundef', mask_csundef ) 
     127            ! revert the mask for masking of undefined closed seas in domzgr  
     128            ! (0 over the undefined closed sea and 1 elsewhere) 
     129            mask_csundef(:,:) = 1 - mask_csundef(:,:) 
     130         END IF 
     131         IF(lwp) WRITE(numout,*) 
     132         ! 
     133         ! allocate source mask for each cases 
     134         CALL alloc_csmask( mask_csglo ) 
     135         CALL alloc_csmask( mask_csrnf ) 
     136         CALL alloc_csmask( mask_csemp ) 
     137         ! 
     138         ! load source mask of cs for each cases 
     139         CALL read_csmask( cn_domcfg, 'mask_csglo', mask_csglo ) 
     140         CALL read_csmask( cn_domcfg, 'mask_csrnf', mask_csrnf ) 
     141         CALL read_csmask( cn_domcfg, 'mask_csemp', mask_csemp ) 
     142         ! 
     143         ! compute number of cs for each cases 
     144         ncsg = MAXVAL( mask_csglo(:,:) ) ; CALL mpp_max( 'closea', ncsg ) 
     145         ncsr = MAXVAL( mask_csrnf(:,:) ) ; CALL mpp_max( 'closea', ncsr ) 
     146         ncse = MAXVAL( mask_csemp(:,:) ) ; CALL mpp_max( 'closea', ncse ) 
     147         ! 
     148         ! allocate closed sea group masks  
     149         !(used to defined the target area in case multiple lakes have the same river mouth (great lakes for example)) 
     150         CALL alloc_csmask( mask_csgrpglo ) 
     151         CALL alloc_csmask( mask_csgrprnf ) 
     152         CALL alloc_csmask( mask_csgrpemp ) 
     153 
     154         ! load mask of cs group for each cases 
     155         CALL read_csmask( cn_domcfg, 'mask_csgrpglo', mask_csgrpglo ) 
     156         CALL read_csmask( cn_domcfg, 'mask_csgrprnf', mask_csgrprnf ) 
     157         CALL read_csmask( cn_domcfg, 'mask_csgrpemp', mask_csgrpemp ) 
     158         ! 
     159      END IF 
    189160   END SUBROUTINE dom_clo 
    190161 
    191  
    192    SUBROUTINE sbc_clo( kt ) 
    193       !!--------------------------------------------------------------------- 
    194       !!                  ***  ROUTINE sbc_clo  *** 
    195       !!                     
    196       !! ** Purpose :   Special handling of closed seas 
    197       !! 
    198       !! ** Method  :   Water flux is forced to zero over closed sea 
    199       !!      Excess is shared between remaining ocean, or 
    200       !!      put as run-off in open ocean. 
    201       !! 
    202       !! ** Action  :   emp updated surface freshwater fluxes and associated heat content at kt 
    203       !!---------------------------------------------------------------------- 
    204       INTEGER         , INTENT(in   ) ::   kt       ! ocean model time step 
    205       ! 
    206       INTEGER             ::   ierr 
    207       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     !:  
    213       REAL(wp), DIMENSION(jpi,jpj) ::   ztmp2d   ! 2D workspace 
    214       !!---------------------------------------------------------------------- 
    215       ! 
    216       IF( ln_timing )  CALL timing_start('sbc_clo') 
    217       ! 
    218       !                                                   !------------------!  
    219       IF( kt == nit000 ) THEN                             !  Initialisation  ! 
    220          !                                                !------------------! 
    221          IF(lwp) WRITE(numout,*) 
    222          IF(lwp) WRITE(numout,*)'sbc_clo : closed seas ' 
    223          IF(lwp) WRITE(numout,*)'~~~~~~~' 
    224  
    225          ALLOCATE( surf(jncs+1) , STAT=ierr ) 
    226          IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surf array') 
    227          surf(:) = 0.e0_wp 
    228          ! 
    229          ! jncsr can be zero so add 1 to avoid allocating zero-length array 
    230          ALLOCATE( surfr(jncsr+1) , STAT=ierr ) 
    231          IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surfr array') 
    232          surfr(:) = 0.e0_wp 
    233          ! 
    234          ! jncse can be zero so add 1 to avoid allocating zero-length array 
    235          ALLOCATE( surfe(jncse+1) , STAT=ierr ) 
    236          IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surfe array') 
    237          surfe(:) = 0.e0_wp 
    238          ! 
    239          surf(jncs+1) = glob_sum( 'closea', e1e2t(:,:) )   ! surface of the global ocean 
    240          ! 
    241          !                                        ! surface areas of closed seas  
    242          DO jc = 1, jncs 
    243             ztmp2d(:,:) = 0.e0_wp 
    244             WHERE( closea_mask(:,:) == jc ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:) 
    245             surf(jc) = glob_sum( 'closea', ztmp2d(:,:) ) 
    246          END DO 
    247          ! 
    248          ! jncs+1 : surface area of global ocean, closed seas excluded 
    249          surf(jncs+1) = surf(jncs+1) - SUM(surf(1:jncs)) 
    250          ! 
    251          !                                        ! surface areas of rnf target areas 
    252          IF( jncsr > 0 ) THEN 
    253             DO jcr = 1, jncsr 
    254                ztmp2d(:,:) = 0.e0_wp 
    255                WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) == 0 ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:) 
    256                surfr(jcr) = glob_sum( 'closea', ztmp2d(:,:) ) 
    257             END DO 
    258          ENDIF 
    259          ! 
    260          !                                        ! surface areas of empmr target areas 
    261          IF( jncse > 0 ) THEN 
    262             DO jce = 1, jncse 
    263                ztmp2d(:,:) = 0.e0_wp 
    264                WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) == 0 ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:) 
    265                surfe(jce) = glob_sum( 'closea', ztmp2d(:,:) ) 
    266             END DO 
    267          ENDIF 
    268          ! 
    269          IF(lwp) WRITE(numout,*)'     Closed sea surface areas (km2)' 
    270          DO jc = 1, jncs 
    271             IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jc, surf(jc) * 1.0e-6 
    272          END DO 
    273          IF(lwp) WRITE(numout,FMT='(A,ES12.2)') 'Global surface area excluding closed seas (km2): ', surf(jncs+1) * 1.0e-6 
    274          ! 
    275          IF(jncsr > 0) THEN 
    276             IF(lwp) WRITE(numout,*)'     Closed sea target rnf surface areas (km2)' 
    277             DO jcr = 1, jncsr 
    278                IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jcr, surfr(jcr) * 1.0e-6 
    279             END DO 
    280          ENDIF 
    281          ! 
    282          IF(jncse > 0) THEN 
    283             IF(lwp) WRITE(numout,*)'     Closed sea target empmr surface areas (km2)' 
    284             DO jce = 1, jncse 
    285                IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jce, surfe(jce) * 1.0e-6 
    286             END DO 
    287          ENDIF 
    288       ENDIF 
    289       ! 
    290       !                                                      !--------------------! 
    291       !                                                      !  update emp        ! 
    292       !                                                      !--------------------! 
    293  
    294       zfwf_total = 0._wp 
    295  
    296       ! 
    297       ! 1. Work out total freshwater fluxes over closed seas from EMP - RNF. 
    298       ! 
    299       zfwf(:) = 0.e0_wp            
    300       DO jc = 1, jncs 
    301          ztmp2d(:,:) = 0.e0_wp 
    302          WHERE( closea_mask(:,:) == jc ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) 
    303          zfwf(jc) = glob_sum( 'closea', ztmp2d(:,:) ) 
    304       END DO 
    305       zfwf_total = SUM(zfwf) 
    306  
    307       zfwfr(:) = 0.e0_wp            
    308       IF( jncsr > 0 ) THEN 
    309          ! 
    310          ! 2. Work out total FW fluxes over rnf source areas and add to rnf target areas.  
    311          !    Where zfwf is negative add flux at specified runoff points and subtract from fluxes for global redistribution. 
    312          !    Where positive leave in global redistribution total. 
    313          ! 
    314          DO jcr = 1, jncsr 
    315             ! 
    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 
    322                ! 
    323                ! Add residuals to target runoff points if negative and subtract from total to be added globally 
    324                IF( zfwfr(jcr) < 0.0 ) THEN  
    325                   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 
    332                ENDIF 
    333                ! 
    334             ENDIF 
    335          END DO 
    336       ENDIF  ! jncsr > 0     
    337       ! 
    338       zfwfe(:) = 0.e0_wp            
    339       IF( jncse > 0 ) THEN 
    340          ! 
    341          ! 3. Work out total fluxes over empmr source areas and add to empmr target areas.  
    342          ! 
    343          DO jce = 1, jncse 
    344             ! 
    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 
    351                ! 
    352                ! Add residuals to runoff points and subtract from total to be added globally 
    353                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                ! 
    361             ENDIF 
    362          END DO 
    363       ENDIF ! jncse > 0     
    364  
    365       ! 
    366       ! 4. Spread residual flux over global ocean.  
    367       ! 
    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(:,:) 
    375          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 
    394       END DO 
    395       ! 
    396       emp (:,:) = emp (:,:) * tmask(:,:,1) 
    397       ! 
    398       CALL lbc_lnk( 'closea', emp , 'T', 1._wp ) 
    399       ! 
    400    END SUBROUTINE sbc_clo 
    401  
    402162   SUBROUTINE clo_rnf( p_rnfmsk ) 
    403163      !!--------------------------------------------------------------------- 
    404       !!                  ***  ROUTINE sbc_rnf  *** 
     164      !!                  ***  ROUTINE clo_rnf  *** 
    405165      !!                     
    406166      !! ** Purpose :   allow the treatment of closed sea outflow grid-points 
    … …  
    412172      !! ** Action  :   update (p_)mskrnf (set 1 at closed sea outflow) 
    413173      !!---------------------------------------------------------------------- 
     174      !! subroutine parameter 
    414175      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_rnfmsk   ! river runoff mask (rnfmsk array) 
    415       !!---------------------------------------------------------------------- 
    416       ! 
    417       IF( jncsr > 0 ) THEN 
    418          WHERE( closea_mask_rnf(:,:) > 0 .and. closea_mask(:,:) == 0 ) 
    419             p_rnfmsk(:,:) = MAX( p_rnfmsk(:,:), 1.0_wp ) 
    420          ENDWHERE 
    421       ENDIF 
    422       ! 
    423       IF( jncse > 0 ) THEN 
    424          WHERE( closea_mask_empmr(:,:) > 0 .and. closea_mask(:,:) == 0 ) 
    425             p_rnfmsk(:,:) = MAX( p_rnfmsk(:,:), 1.0_wp ) 
    426          ENDWHERE 
    427       ENDIF 
     176      !! 
     177      !! local variables 
     178      REAL(wp), DIMENSION(jpi,jpj) :: zmsk 
     179      !!---------------------------------------------------------------------- 
     180      ! 
     181      ! zmsk > 0 where cs river mouth defined (case rnf and emp) 
     182      zmsk(:,:) = ( mask_csgrprnf (:,:) + mask_csgrpemp(:,:) ) * mask_opnsea(:,:) 
     183      WHERE( zmsk(:,:) > 0 ) 
     184         p_rnfmsk(:,:) = 1.0_wp 
     185      END WHERE 
    428186      ! 
    429187   END SUBROUTINE clo_rnf 
    430     
    431188       
    432    SUBROUTINE clo_bat( k_top, k_bot ) 
    433       !!--------------------------------------------------------------------- 
    434       !!                  ***  ROUTINE clo_bat  *** 
     189   SUBROUTINE clo_msk( k_top, k_bot, k_mask, cd_prt ) 
     190      !!--------------------------------------------------------------------- 
     191      !!                  ***  ROUTINE clo_msk  *** 
    435192      !!                     
    436193      !! ** Purpose :   Suppress closed sea from the domain 
    437194      !! 
    438       !! ** Method  :   Read in closea_mask field (if it exists) from domain_cfg file. 
    439       !!                Where closea_mask > 0 set first and last ocean level to 0 
     195      !! ** Method  :   Where closea_mask > 0 set first and last ocean level to 0 
    440196      !!                (As currently coded you can't define a closea_mask field in  
    441197      !!                usr_def_zgr). 
    … …  
    443199      !! ** Action  :   set k_top=0 and k_bot=0 over closed seas 
    444200      !!---------------------------------------------------------------------- 
     201      !! subroutine parameter 
    445202      INTEGER, DIMENSION(:,:), INTENT(inout) ::   k_top, k_bot   ! ocean first and last level indices 
    446       INTEGER                           :: inum, id 
    447       INTEGER,  DIMENSION(jpi,jpj) :: closea_mask ! closea_mask field 
    448       REAL(wp), DIMENSION(jpi,jpj) :: zdata_in ! temporary real array for input 
    449       !!---------------------------------------------------------------------- 
    450       ! 
    451       IF(lwp) THEN                     ! Control print 
     203      INTEGER, DIMENSION(:,:), INTENT(in   ) ::   k_mask         ! mask used to mask ktop and k_bot 
     204      CHARACTER(LEN=*),        INTENT(in   ) ::   cd_prt         ! text for control print 
     205      !! 
     206      !! local variables 
     207      !!---------------------------------------------------------------------- 
     208      !! 
     209      IF ( lwp ) THEN 
    452210         WRITE(numout,*) 
    453          WRITE(numout,*) 'clo_bat : suppression of closed seas' 
     211         WRITE(numout,*) 'clo_msk : Suppression closed seas based on ',TRIM(cd_prt),' field.' 
    454212         WRITE(numout,*) '~~~~~~~' 
     213         WRITE(numout,*) 
    455214      ENDIF 
    456       ! 
    457       IF( ln_read_cfg ) THEN 
    458          ! 
    459          CALL iom_open( cn_domcfg, inum ) 
    460          ! 
    461          id = iom_varid(inum, 'closea_mask', ldstop = .false.)       
    462          IF( id > 0 ) THEN 
    463             IF( lwp ) WRITE(numout,*) 'Suppressing closed seas in bathymetry based on closea_mask field,' 
    464             CALL iom_get ( inum, jpdom_data, 'closea_mask', zdata_in ) 
    465             closea_mask(:,:) = NINT(zdata_in(:,:)) 
    466             WHERE( closea_mask(:,:) > 0 ) 
    467                k_top(:,:) = 0    
    468                k_bot(:,:) = 0    
    469             ENDWHERE 
    470          ELSE 
    471             IF( lwp ) WRITE(numout,*) 'No closea_mask field found in domain_cfg file. No suppression of closed seas.' 
    472          ENDIF 
    473          ! 
    474          CALL iom_close(inum) 
    475          ! 
    476       ELSE 
    477          IF( lwp ) WRITE(numout,*) 'No domain_cfg file => no suppression of closed seas.' 
    478       ENDIF 
    479       ! 
    480       ! Initialise l_sbc_clo and l_clo_rnf for this case (ln_closea=.false.) 
    481       l_sbc_clo = .false. 
    482       l_clo_rnf = .false. 
    483       ! 
    484    END SUBROUTINE clo_bat 
    485  
    486    !!====================================================================== 
     215      !! 
     216      k_top(:,:) = k_top(:,:) * k_mask(:,:) 
     217      k_bot(:,:) = k_bot(:,:) * k_mask(:,:) 
     218      !! 
     219   END SUBROUTINE clo_msk 
     220 
     221   SUBROUTINE read_csmask(cd_file, cd_var, k_mskout) 
     222      !!--------------------------------------------------------------------- 
     223      !!                  ***  ROUTINE read_csmask  *** 
     224      !!                     
     225      !! ** Purpose : read mask in cd_filec file 
     226      !!---------------------------------------------------------------------- 
     227      ! subroutine parameter 
     228      CHARACTER(LEN=256),          INTENT(in   ) :: cd_file    ! netcdf file     name 
     229      CHARACTER(LEN= * ),          INTENT(in   ) :: cd_var     ! netcdf variable name 
     230      INTEGER, DIMENSION(:,:), INTENT(  out) :: k_mskout            ! output mask variable 
     231      ! 
     232      ! local variables 
     233      INTEGER :: ics                       ! netcdf id 
     234      REAL(wp), DIMENSION(jpi,jpj) :: zdta ! netcdf data 
     235      !!---------------------------------------------------------------------- 
     236      ! 
     237      CALL iom_open ( cd_file, ics ) 
     238      CALL iom_get  ( ics, jpdom_data, TRIM(cd_var), zdta ) 
     239      CALL iom_close( ics ) 
     240      k_mskout(:,:) = NINT(zdta(:,:)) 
     241      ! 
     242   END SUBROUTINE read_csmask 
     243 
     244   SUBROUTINE alloc_csmask( kmask ) 
     245      !!--------------------------------------------------------------------- 
     246      !!                  ***  ROUTINE alloc_csmask  *** 
     247      !!                     
     248      !! ** Purpose : allocated cs mask 
     249      !!---------------------------------------------------------------------- 
     250      ! subroutine parameter 
     251      INTEGER, ALLOCATABLE, DIMENSION(:,:), INTENT(inout) :: kmask 
     252      ! 
     253      ! local variables 
     254      INTEGER :: ierr 
     255      !!---------------------------------------------------------------------- 
     256      ! 
     257      ALLOCATE( kmask(jpi,jpj) , STAT=ierr ) 
     258      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'alloc_csmask: failed to allocate surf array') 
     259      ! 
     260   END SUBROUTINE 
     261 
    487262END MODULE closea 
    488  
Note: See TracChangeset for help on using the changeset viewer.