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 12172 – NEMO

Changeset 12172


Ignore:
Timestamp:
2019-12-11T10:55:06+01:00 (4 years ago)
Author:
cetlod
Message:

dev_merge_option2 : merge in ENHANCE-03_closea branch

Location:
NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019
Files:
8 edited
1 copied

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/SHARED/field_def_nemo-oce.xml

    r12166 r12172  
    269269          <field id="runoffs"      long_name="River Runoffs"                        standard_name="water_flux_into_sea_water_from_rivers"                                unit="kg/m2/s"   /> 
    270270          <field id="precip"       long_name="Total precipitation"                  standard_name="precipitation_flux"                                                   unit="kg/m2/s"   /> 
     271          <field id="wclosea"      long_name="closed sea empmr correction"          standard_name="closea_empmr"                                                         unit="kg/m2/s"   /> 
    271272      
    272273          <field id="qt"           long_name="Net Downward Heat Flux"                standard_name="surface_downward_heat_flux_in_sea_water"                              unit="W/m2"                           /> 
     
    275276          <field id="qsr3d"        long_name="Shortwave Radiation 3D distribution"   standard_name="downwelling_shortwave_flux_in_sea_water"                              unit="W/m2"      grid_ref="grid_T_3D" /> 
    276277          <field id="qrp"          long_name="Surface Heat Flux: Damping"            standard_name="heat_flux_into_sea_water_due_to_newtonian_relaxation"                 unit="W/m2"                           /> 
     278          <field id="qclosea"      long_name="closed sea heat content flux"          standard_name="closea_heat_content_downward_flux"                                    unit="W/m2"     /> 
    277279          <field id="erp"          long_name="Surface Water Flux: Damping"           standard_name="water_flux_out_of_sea_water_due_to_newtonian_relaxation"              unit="kg/m2/s"                        /> 
    278280          <field id="taum"         long_name="wind stress module"                    standard_name="magnitude_of_surface_downward_stress"                                 unit="N/m2"                           /> 
  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/SHARED/namelist_ref

    r12166 r12172  
    8383&namcfg        !   parameters of the configuration                      (default: use namusr_def in namelist_cfg) 
    8484!----------------------------------------------------------------------- 
    85    ln_read_cfg = .false.   !  (=T) read the domain configuration file 
    86       !                    !  (=F) user defined configuration           (F => create/check namusr_def) 
     85   ln_read_cfg = .false.     !  (=T) read the domain configuration file 
     86      !                      !  (=F) user defined configuration           (F => create/check namusr_def) 
    8787      cn_domcfg = "domain_cfg"  ! domain configuration filename 
    8888      ! 
     
    9696      cn_domcfg_out = "domain_cfg_out" ! newly created domain configuration filename 
    9797      ! 
    98    ln_use_jattr = .false.  !  use (T) the file attribute: open_ocean_jstart, if present 
    99    !                       !  in netcdf input files, as the start j-row for reading 
     98   ln_use_jattr = .false.    !  use (T) the file attribute: open_ocean_jstart, if present 
     99   !                         !  in netcdf input files, as the start j-row for reading 
     100/ 
     101!----------------------------------------------------------------------- 
     102&namclo        !   parameters of the closed sea (cs) behavior           (default: OFF) 
     103!----------------------------------------------------------------------- 
     104   ln_maskcs = .false.        ! (=T) cs are masked ; So, in this case ln_mask_csundef and ln_clo_rnf have no effect. 
     105      !                       ! (=F => set ln_mask_csundef and ln_clo_rnf)  
     106      !                       ! cs masks are read and net evap/precip over closed sea spread out depending on domain_cfg.nc masks. 
     107      !                       ! See ln_mask_csundef and ln_clo_rnf for specific option related to this case 
     108      ! 
     109      ln_mask_csundef = .true.   ! (=T) undefined closed seas are masked ;  
     110      !                          ! (=F) undefined closed seas are kept and no specific treatment is done for these closed seas 
     111      ! 
     112      ln_clo_rnf = .true.        ! (=T) river mouth specified in domain_cfg.nc masks (rnf and emp case) are added to the runoff mask. 
     113      !                          !      allow the treatment of closed sea outflow grid-points to be the same as river mouth grid-points 
    100114/ 
    101115!----------------------------------------------------------------------- 
  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/DOM/closea.F90

    r10425 r12172  
    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 diurnal_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  
     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 
    6252 
    6353   !! * Substitutions 
     
    7666      !! ** Purpose :   Closed sea domain initialization 
    7767      !! 
    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       ! 
     68      !! ** Action  :   Read mask_cs* fields (if needed) from domain_cfg file and infer 
     69      !!                number of closed seas for each case (glo, rnf, emp) from mask_cs* field. 
     70      !! 
     71      !! ** Output  :   mask_csglo and mask_csgrpglo  : integer values defining mappings from closed seas and associated groups to the open ocean for net fluxes. 
     72      !!                mask_csrnf and mask_csgrprnf  : integer values defining mappings from closed seas and associated groups to a runoff area for downwards flux only. 
     73      !!                mask_csemp and mask_csgrpemp  : integer values defining mappings from closed seas and associated groups to a runoff area for net fluxes. 
     74      !!---------------------------------------------------------------------- 
     75      INTEGER ::   ios     ! io status 
     76      !! 
     77      NAMELIST/namclo/ ln_maskcs, ln_mask_csundef, ln_clo_rnf 
     78      !!--------------------------------------------------------------------- 
     79      !! 
     80      REWIND( numnam_ref )              ! Namelist namclo in reference namelist : Lateral momentum boundary condition 
     81      READ  ( numnam_ref, namclo, IOSTAT = ios, ERR = 901 ) 
     82901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namclo in reference namelist') 
     83      REWIND( numnam_cfg )              ! Namelist namclo in configuration namelist : Lateral momentum boundary condition 
     84      READ  ( numnam_cfg, namclo, IOSTAT = ios, ERR = 902 ) 
     85902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namclo in configuration namelist') 
     86      IF(lwm) WRITE ( numond, namclo ) 
     87      !! 
    9988      IF(lwp) WRITE(numout,*) 
    10089      IF(lwp) WRITE(numout,*)'dom_clo : read in masks to define closed seas ' 
    10190      IF(lwp) WRITE(numout,*)'~~~~~~~' 
     91      IF(lwp) WRITE(numout,*) 
     92      !! 
     93      !! check option compatibility 
     94      IF( .NOT. ln_read_cfg ) THEN 
     95         CALL ctl_stop('Suppression of closed seas does not work with ln_read_cfg = .true. . Set ln_closea = .false. .') 
     96      ENDIF 
     97      !! 
     98      IF( (.NOT. ln_maskcs) .AND. ln_diurnal_only ) THEN 
     99         CALL ctl_stop('Special handling of freshwater fluxes over closed seas not compatible with ln_diurnal_only.') 
     100      END IF 
    102101      ! 
    103102      ! read the closed seas masks (if they exist) from domain_cfg file (if it exists) 
    104103      ! ------------------------------------------------------------------------------ 
    105104      ! 
    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       ! 
     105      ! load mask of open sea 
     106      CALL alloc_csmask( mask_opnsea ) 
     107      CALL read_csmask( cn_domcfg, 'mask_opensea' , mask_opnsea  ) 
     108      ! 
     109      IF ( ln_maskcs ) THEN 
     110         ! closed sea are masked 
     111         IF(lwp) WRITE(numout,*)'          ln_maskcs = T : all closed seas are masked' 
     112         IF(lwp) WRITE(numout,*) 
     113         ! no special treatment of closed sea 
     114         ! no redistribution of emp unbalance over closed sea into river mouth/open ocean 
     115         l_sbc_clo = .false. ; l_clo_rnf = .false. 
     116      ELSE 
     117         ! redistribution of emp unbalance over closed sea into river mouth/open ocean 
     118         IF(lwp) WRITE(numout,*)'          ln_maskcs = F : net emp is corrected over defined closed seas' 
     119         ! 
     120         l_sbc_clo = .true. 
     121         ! 
     122         ! river mouth from lakes added to rnf mask for special treatment 
     123         IF ( ln_clo_rnf) l_clo_rnf = .true. 
     124         ! 
     125         IF ( ln_mask_csundef) THEN 
     126            ! closed sea not defined (ie not in the domcfg namelist used to build the domcfg.nc file) are masked  
     127            IF(lwp) WRITE(numout,*)'          ln_mask_csundef = T : all undefined closed seas are masked' 
     128            ! 
     129            CALL alloc_csmask( mask_csundef ) 
     130            CALL read_csmask( cn_domcfg, 'mask_csundef', mask_csundef ) 
     131            ! revert the mask for masking of undefined closed seas in domzgr  
     132            ! (0 over the undefined closed sea and 1 elsewhere) 
     133            mask_csundef(:,:) = 1 - mask_csundef(:,:) 
     134         END IF 
     135         IF(lwp) WRITE(numout,*) 
     136         ! 
     137         ! allocate source mask for each cases 
     138         CALL alloc_csmask( mask_csglo ) 
     139         CALL alloc_csmask( mask_csrnf ) 
     140         CALL alloc_csmask( mask_csemp ) 
     141         ! 
     142         ! load source mask of cs for each cases 
     143         CALL read_csmask( cn_domcfg, 'mask_csglo', mask_csglo ) 
     144         CALL read_csmask( cn_domcfg, 'mask_csrnf', mask_csrnf ) 
     145         CALL read_csmask( cn_domcfg, 'mask_csemp', mask_csemp ) 
     146         ! 
     147         ! compute number of cs for each cases 
     148         ncsg = MAXVAL( mask_csglo(:,:) ) ; CALL mpp_max( 'closea', ncsg ) 
     149         ncsr = MAXVAL( mask_csrnf(:,:) ) ; CALL mpp_max( 'closea', ncsr ) 
     150         ncse = MAXVAL( mask_csemp(:,:) ) ; CALL mpp_max( 'closea', ncse ) 
     151         ! 
     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)) 
     154         CALL alloc_csmask( mask_csgrpglo ) 
     155         CALL alloc_csmask( mask_csgrprnf ) 
     156         CALL alloc_csmask( mask_csgrpemp ) 
     157 
     158         ! load mask of cs group for each cases 
     159         CALL read_csmask( cn_domcfg, 'mask_csgrpglo', mask_csgrpglo ) 
     160         CALL read_csmask( cn_domcfg, 'mask_csgrprnf', mask_csgrprnf ) 
     161         CALL read_csmask( cn_domcfg, 'mask_csgrpemp', mask_csgrpemp ) 
     162         ! 
     163      END IF 
    189164   END SUBROUTINE dom_clo 
    190165 
    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  
    402166   SUBROUTINE clo_rnf( p_rnfmsk ) 
    403167      !!--------------------------------------------------------------------- 
    404       !!                  ***  ROUTINE sbc_rnf  *** 
     168      !!                  ***  ROUTINE clo_rnf  *** 
    405169      !!                     
    406170      !! ** Purpose :   allow the treatment of closed sea outflow grid-points 
     
    412176      !! ** Action  :   update (p_)mskrnf (set 1 at closed sea outflow) 
    413177      !!---------------------------------------------------------------------- 
     178      !! subroutine parameter 
    414179      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 
     180      !! 
     181      !! local variables 
     182      REAL(wp), DIMENSION(jpi,jpj) :: zmsk 
     183      !!---------------------------------------------------------------------- 
     184      ! 
     185      ! zmsk > 0 where cs river mouth defined (case rnf and emp) 
     186      zmsk(:,:) = ( mask_csgrprnf (:,:) + mask_csgrpemp(:,:) ) * mask_opnsea(:,:) 
     187      WHERE( zmsk(:,:) > 0 ) 
     188         p_rnfmsk(:,:) = 1.0_wp 
     189      END WHERE 
    428190      ! 
    429191   END SUBROUTINE clo_rnf 
    430     
    431192       
    432    SUBROUTINE clo_bat( k_top, k_bot ) 
    433       !!--------------------------------------------------------------------- 
    434       !!                  ***  ROUTINE clo_bat  *** 
     193   SUBROUTINE clo_msk( k_top, k_bot, k_mask, cd_prt ) 
     194      !!--------------------------------------------------------------------- 
     195      !!                  ***  ROUTINE clo_msk  *** 
    435196      !!                     
    436197      !! ** Purpose :   Suppress closed sea from the domain 
    437198      !! 
    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 
     199      !! ** Method  :   Where closea_mask > 0 set first and last ocean level to 0 
    440200      !!                (As currently coded you can't define a closea_mask field in  
    441201      !!                usr_def_zgr). 
     
    443203      !! ** Action  :   set k_top=0 and k_bot=0 over closed seas 
    444204      !!---------------------------------------------------------------------- 
     205      !! subroutine parameter 
    445206      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 
     207      INTEGER, DIMENSION(:,:), INTENT(in   ) ::   k_mask         ! mask used to mask ktop and k_bot 
     208      CHARACTER(256),          INTENT(in   ) ::   cd_prt         ! text for control print 
     209      !! 
     210      !! local variables 
     211      !!---------------------------------------------------------------------- 
     212      !! 
     213      IF ( lwp ) THEN 
    452214         WRITE(numout,*) 
    453          WRITE(numout,*) 'clo_bat : suppression of closed seas' 
     215         WRITE(numout,*) 'clo_msk : Suppression closed seas based on ',TRIM(cd_prt),' field.' 
    454216         WRITE(numout,*) '~~~~~~~' 
     217         WRITE(numout,*) 
    455218      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    !!====================================================================== 
     219      !! 
     220      k_top(:,:) = k_top(:,:) * k_mask(:,:) 
     221      k_bot(:,:) = k_bot(:,:) * k_mask(:,:) 
     222      !! 
     223   END SUBROUTINE clo_msk 
     224 
     225   SUBROUTINE read_csmask(cd_file, cd_var, k_mskout) 
     226      !!--------------------------------------------------------------------- 
     227      !!                  ***  ROUTINE read_csmask  *** 
     228      !!                     
     229      !! ** Purpose : read mask in cd_filec file 
     230      !!---------------------------------------------------------------------- 
     231      ! subroutine parameter 
     232      CHARACTER(256),          INTENT(in   ) :: cd_file, cd_var     ! netcdf file and variable name 
     233      INTEGER, DIMENSION(:,:), INTENT(  out) :: k_mskout            ! output mask variable 
     234      ! 
     235      ! local variables 
     236      INTEGER :: ics                       ! netcdf id 
     237      REAL(wp), DIMENSION(jpi,jpj) :: zdta ! netcdf data 
     238      !!---------------------------------------------------------------------- 
     239      ! 
     240      CALL iom_open ( cd_file, ics ) 
     241      CALL iom_get  ( ics, jpdom_data, TRIM(cd_var), zdta ) 
     242      CALL iom_close( ics ) 
     243      k_mskout(:,:) = NINT(zdta(:,:)) 
     244      ! 
     245   END SUBROUTINE read_csmask 
     246 
     247   SUBROUTINE alloc_csmask( kmask ) 
     248      !!--------------------------------------------------------------------- 
     249      !!                  ***  ROUTINE alloc_csmask  *** 
     250      !!                     
     251      !! ** Purpose : allocated cs mask 
     252      !!---------------------------------------------------------------------- 
     253      ! subroutine parameter 
     254      INTEGER, ALLOCATABLE, DIMENSION(:,:), INTENT(inout) :: kmask 
     255      ! 
     256      ! local variables 
     257      INTEGER :: ierr 
     258      !!---------------------------------------------------------------------- 
     259      ! 
     260      ALLOCATE( kmask(jpi,jpj) , STAT=ierr ) 
     261      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'alloc_csmask: failed to allocate surf array') 
     262      ! 
     263   END SUBROUTINE 
     264 
    487265END MODULE closea 
    488  
  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/DOM/domain.F90

    r12166 r12172  
    3030   USE trc_oce        ! shared ocean & passive tracers variab 
    3131   USE phycst         ! physical constants 
    32    USE closea         ! closed seas 
    3332   USE domhgr         ! domain: set the horizontal mesh 
    3433   USE domzgr         ! domain: set the vertical mesh 
     
    3837   USE c1d            ! 1D configuration 
    3938   USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine) 
    40    USE wet_dry,  ONLY : ll_wd 
     39   USE wet_dry, ONLY : ll_wd 
     40   USE closea , ONLY : dom_clo ! closed seas 
    4141   ! 
    4242   USE in_out_manager ! I/O manager 
     
    134134      ENDIF 
    135135      ! 
    136       CALL dom_hgr                     ! Horizontal mesh 
    137       CALL dom_zgr( ik_top, ik_bot )   ! Vertical mesh and bathymetry 
    138       CALL dom_msk( ik_top, ik_bot )   ! Masks 
    139       IF( ln_closea )   CALL dom_clo   ! ln_closea=T : closed seas included in the simulation 
    140                                        ! Read in masks to define closed seas and lakes  
     136      CALL dom_hgr                      ! Horizontal mesh 
     137      CALL dom_zgr( ik_top, ik_bot )    ! Vertical mesh and bathymetry 
     138      CALL dom_msk( ik_top, ik_bot )    ! Masks 
     139      IF( ln_closea ) CALL dom_clo      ! ln_closea=T : closed seas included in the simulation 
     140                                        ! Read in masks to define closed seas and lakes 
    141141      ! 
    142142      ht_0(:,:) = 0._wp  ! Reference ocean thickness 
  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/DOM/domzgr.F90

    r12166 r12172  
    119119      ! Any closed seas (defined by closea_mask > 0 in domain_cfg file) to be filled  
    120120      ! in at runtime if ln_closea=.false. 
    121       IF( .NOT.ln_closea )   CALL clo_bat( k_top, k_bot ) 
     121      IF( ln_closea ) THEN 
     122         IF ( ln_maskcs ) THEN 
     123            ! mask all the closed sea 
     124            CALL clo_msk( k_top, k_bot, mask_opnsea, 'mask_opensea' ) 
     125         ELSE IF ( ln_mask_csundef ) THEN 
     126            ! defined closed sea are kept 
     127            ! mask all the undefined closed sea 
     128            CALL clo_msk( k_top, k_bot, mask_csundef, 'mask_csundef' ) 
     129         END IF 
     130      END IF 
    122131      ! 
    123132      IF(lwp) THEN                     ! Control print 
  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/sbcmod.F90

    r12169 r12172  
    2525   USE oce            ! ocean dynamics and tracers 
    2626   USE dom_oce        ! ocean space and time domain 
     27   USE closea         ! closed seas 
    2728   USE phycst         ! physical constants 
    2829   USE sbc_oce        ! Surface boundary condition: ocean fields 
     
    4142   USE sbccpl         ! surface boundary condition: coupled formulation 
    4243   USE cpl_oasis3     ! OASIS routines for coupling 
     44   USE sbcclo         ! surface boundary condition: closed sea correction 
    4345   USE sbcssr         ! surface boundary condition: sea surface restoring 
    4446   USE sbcrnf         ! surface boundary condition: runoffs 
     
    336338      !                       !**  associated modules : initialization 
    337339      ! 
     340      IF( l_sbc_clo   )   CALL sbc_clo_init            ! closed sea surface initialisation 
     341      ! 
    338342                          CALL sbc_ssm_init            ! Sea-surface mean fields initialization 
    339343      ! 
     
    472476      ! Special treatment of freshwater fluxes over closed seas in the model domain 
    473477      ! Should not be run if ln_diurnal_only 
    474       IF( l_sbc_clo .AND. (.NOT. ln_diurnal_only) )   CALL sbc_clo( kt )    
     478      IF( l_sbc_clo     )   CALL sbc_clo( kt )    
    475479 
    476480!!$!RBbug do not understand why see ticket 667 
  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/sbcrnf.F90

    r12166 r12172  
    2020   USE sbc_oce        ! surface boundary condition variables 
    2121   USE eosbn2         ! Equation Of State 
    22    USE closea        ! closed seas 
     22   USE closea, ONLY: l_clo_rnf, clo_rnf ! closed seas 
    2323   ! 
    2424   USE in_out_manager ! I/O manager 
  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/par_oce.F90

    r10068 r12172  
    2727   !                                   !  with the extended grids used in the under ice shelf configurations to  
    2828   !                                   !  be used without redundant rows when the ice shelves are not in use. 
     29   LOGICAL       ::   ln_closea        !: (=T) special treatment of closed sea 
    2930   !  
    3031 
Note: See TracChangeset for help on using the changeset viewer.