- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DOM/closea.F90
r10425 r13463 11 11 !! 4.0 ! 2016-06 (G. Madec) move to usrdef_closea, remove clo_ups 12 12 !! 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 13 14 !!---------------------------------------------------------------------- 14 15 15 16 !!---------------------------------------------------------------------- 16 17 !! dom_clo : read in masks which define closed seas and runoff areas 17 !! sbc_clo : Special handling of freshwater fluxes over closed seas18 18 !! 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 26 22 ! 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_global ! 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 32 27 33 28 IMPLICIT NONE 29 34 30 PRIVATE 35 31 36 32 PUBLIC dom_clo ! called by domain module 37 PUBLIC sbc_clo ! called by sbcmod module38 33 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 65 53 !!---------------------------------------------------------------------- 66 54 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 76 64 !! ** Purpose : Closed sea domain initialization 77 65 !! 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 ) 79 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namclo in reference namelist' ) 80 READ ( numnam_cfg, namclo, IOSTAT = ios, ERR = 902 ) 81 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namclo in configuration namelist' ) 82 IF(lwm) WRITE ( numond, namclo ) 83 !! 99 84 IF(lwp) WRITE(numout,*) 100 85 IF(lwp) WRITE(numout,*)'dom_clo : read in masks to define closed seas ' 101 86 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 102 97 ! 103 98 ! read the closed seas masks (if they exist) from domain_cfg file (if it exists) 104 99 ! ------------------------------------------------------------------------------ 105 100 ! 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 189 160 END SUBROUTINE dom_clo 190 161 191 192 SUBROUTINE sbc_clo( kt )193 !!---------------------------------------------------------------------194 !! *** ROUTINE sbc_clo ***195 !!196 !! ** Purpose : Special handling of closed seas197 !!198 !! ** Method : Water flux is forced to zero over closed sea199 !! Excess is shared between remaining ocean, or200 !! put as run-off in open ocean.201 !!202 !! ** Action : emp updated surface freshwater fluxes and associated heat content at kt203 !!----------------------------------------------------------------------204 INTEGER , INTENT(in ) :: kt ! ocean model time step205 !206 INTEGER :: ierr207 INTEGER :: jc, jcr, jce ! dummy loop indices208 REAL(wp), PARAMETER :: rsmall = 1.e-20_wp ! Closed sea correction epsilon209 REAL(wp) :: zfwf_total, zcoef, zcoef1 !210 REAL(wp), DIMENSION(jncs) :: zfwf !:211 REAL(wp), DIMENSION(jncsr+1) :: zfwfr !: freshwater fluxes over closed seas212 REAL(wp), DIMENSION(jncse+1) :: zfwfe !:213 REAL(wp), DIMENSION(jpi,jpj) :: ztmp2d ! 2D workspace214 !!----------------------------------------------------------------------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_wp228 !229 ! jncsr can be zero so add 1 to avoid allocating zero-length array230 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_wp233 !234 ! jncse can be zero so add 1 to avoid allocating zero-length array235 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_wp238 !239 surf(jncs+1) = glob_sum( 'closea', e1e2t(:,:) ) ! surface of the global ocean240 !241 ! ! surface areas of closed seas242 DO jc = 1, jncs243 ztmp2d(:,:) = 0.e0_wp244 WHERE( closea_mask(:,:) == jc ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:)245 surf(jc) = glob_sum( 'closea', ztmp2d(:,:) )246 END DO247 !248 ! jncs+1 : surface area of global ocean, closed seas excluded249 surf(jncs+1) = surf(jncs+1) - SUM(surf(1:jncs))250 !251 ! ! surface areas of rnf target areas252 IF( jncsr > 0 ) THEN253 DO jcr = 1, jncsr254 ztmp2d(:,:) = 0.e0_wp255 WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) == 0 ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:)256 surfr(jcr) = glob_sum( 'closea', ztmp2d(:,:) )257 END DO258 ENDIF259 !260 ! ! surface areas of empmr target areas261 IF( jncse > 0 ) THEN262 DO jce = 1, jncse263 ztmp2d(:,:) = 0.e0_wp264 WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) == 0 ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:)265 surfe(jce) = glob_sum( 'closea', ztmp2d(:,:) )266 END DO267 ENDIF268 !269 IF(lwp) WRITE(numout,*)' Closed sea surface areas (km2)'270 DO jc = 1, jncs271 IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jc, surf(jc) * 1.0e-6272 END DO273 IF(lwp) WRITE(numout,FMT='(A,ES12.2)') 'Global surface area excluding closed seas (km2): ', surf(jncs+1) * 1.0e-6274 !275 IF(jncsr > 0) THEN276 IF(lwp) WRITE(numout,*)' Closed sea target rnf surface areas (km2)'277 DO jcr = 1, jncsr278 IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jcr, surfr(jcr) * 1.0e-6279 END DO280 ENDIF281 !282 IF(jncse > 0) THEN283 IF(lwp) WRITE(numout,*)' Closed sea target empmr surface areas (km2)'284 DO jce = 1, jncse285 IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jce, surfe(jce) * 1.0e-6286 END DO287 ENDIF288 ENDIF289 !290 ! !--------------------!291 ! ! update emp !292 ! !--------------------!293 294 zfwf_total = 0._wp295 296 !297 ! 1. Work out total freshwater fluxes over closed seas from EMP - RNF.298 !299 zfwf(:) = 0.e0_wp300 DO jc = 1, jncs301 ztmp2d(:,:) = 0.e0_wp302 WHERE( closea_mask(:,:) == jc ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:)303 zfwf(jc) = glob_sum( 'closea', ztmp2d(:,:) )304 END DO305 zfwf_total = SUM(zfwf)306 307 zfwfr(:) = 0.e0_wp308 IF( jncsr > 0 ) THEN309 !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, jncsr315 !316 ztmp2d(:,:) = 0.e0_wp317 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 off321 IF ( ABS(zfwfr(jcr) / surf(jncs+1) ) > rsmall) THEN322 !323 ! Add residuals to target runoff points if negative and subtract from total to be added globally324 IF( zfwfr(jcr) < 0.0 ) THEN325 zfwf_total = zfwf_total - zfwfr(jcr)326 zcoef = zfwfr(jcr) / surfr(jcr)327 zcoef1 = rcp * zcoef328 WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) == 0.0)329 emp(:,:) = emp(:,:) + zcoef330 qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)331 ENDWHERE332 ENDIF333 !334 ENDIF335 END DO336 ENDIF ! jncsr > 0337 !338 zfwfe(:) = 0.e0_wp339 IF( jncse > 0 ) THEN340 !341 ! 3. Work out total fluxes over empmr source areas and add to empmr target areas.342 !343 DO jce = 1, jncse344 !345 ztmp2d(:,:) = 0.e0_wp346 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 off350 IF ( ABS( zfwfe(jce) / surf(jncs+1) ) > rsmall ) THEN351 !352 ! Add residuals to runoff points and subtract from total to be added globally353 zfwf_total = zfwf_total - zfwfe(jce)354 zcoef = zfwfe(jce) / surfe(jce)355 zcoef1 = rcp * zcoef356 WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) == 0.0)357 emp(:,:) = emp(:,:) + zcoef358 qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)359 ENDWHERE360 !361 ENDIF362 END DO363 ENDIF ! jncse > 0364 365 !366 ! 4. Spread residual flux over global ocean.367 !368 ! The following if avoids the redistribution of the round off369 IF ( ABS(zfwf_total / surf(jncs+1) ) > rsmall) THEN370 zcoef = zfwf_total / surf(jncs+1)371 zcoef1 = rcp * zcoef372 WHERE( closea_mask(:,:) == 0 )373 emp(:,:) = emp(:,:) + zcoef374 qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)375 ENDWHERE376 ENDIF377 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, jncs382 ! The following if avoids the redistribution of the round off383 IF ( ABS(zfwf(jc) / surf(jncs+1) ) > rsmall) THEN384 !385 ! Subtract residuals from fluxes over closed sea386 zcoef = zfwf(jc) / surf(jc)387 zcoef1 = rcp * zcoef388 WHERE( closea_mask(:,:) == jc )389 emp(:,:) = emp(:,:) - zcoef390 qns(:,:) = qns(:,:) + zcoef1 * sst_m(:,:)391 ENDWHERE392 !393 ENDIF394 END DO395 !396 emp (:,:) = emp (:,:) * tmask(:,:,1)397 !398 CALL lbc_lnk( 'closea', emp , 'T', 1._wp )399 !400 END SUBROUTINE sbc_clo401 402 162 SUBROUTINE clo_rnf( p_rnfmsk ) 403 163 !!--------------------------------------------------------------------- 404 !! *** ROUTINE sbc_rnf ***164 !! *** ROUTINE clo_rnf *** 405 165 !! 406 166 !! ** Purpose : allow the treatment of closed sea outflow grid-points … … 412 172 !! ** Action : update (p_)mskrnf (set 1 at closed sea outflow) 413 173 !!---------------------------------------------------------------------- 174 !! subroutine parameter 414 175 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 428 186 ! 429 187 END SUBROUTINE clo_rnf 430 431 188 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 *** 435 192 !! 436 193 !! ** Purpose : Suppress closed sea from the domain 437 194 !! 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 440 196 !! (As currently coded you can't define a closea_mask field in 441 197 !! usr_def_zgr). … … 443 199 !! ** Action : set k_top=0 and k_bot=0 over closed seas 444 200 !!---------------------------------------------------------------------- 201 !! subroutine parameter 445 202 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 452 210 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.' 454 212 WRITE(numout,*) '~~~~~~~' 213 WRITE(numout,*) 455 214 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_global, 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 487 262 END MODULE closea 488
Note: See TracChangeset
for help on using the changeset viewer.