- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/DOM/domzgr.F90 (modified) (10 diffs)
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/domzgr.F90
r10425 r13463 44 44 45 45 !! * Substitutions 46 # include " vectopt_loop_substitute.h90"46 # include "do_loop_substitute.h90" 47 47 !!---------------------------------------------------------------------- 48 48 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 71 71 INTEGER, DIMENSION(:,:), INTENT(out) :: k_top, k_bot ! ocean first and last level indices 72 72 ! 73 INTEGER :: jk ! dummy loop index 73 INTEGER :: ji,jj,jk ! dummy loop index 74 INTEGER :: ikt, ikb ! top/bot index 74 75 INTEGER :: ioptio, ibat, ios ! local integer 75 76 REAL(wp) :: zrefdep ! depth of the reference level (~10m) 77 REAL(wp), DIMENSION(jpi,jpj) :: zmsk 76 78 !!---------------------------------------------------------------------- 77 79 ! … … 109 111 ENDIF 110 112 ! 113 ! the following is mandatory 114 ! make sure that closed boundaries are correctly defined in k_top that will be used to compute all mask arrays 115 ! 116 zmsk(:,:) = 1._wp ! default: no closed boundaries 117 IF( jperio == 0 .OR. jperio == 2 .OR. jperio == 3 .OR. jperio == 5 ) THEN ! E-W closed 118 zmsk( mi0( 1+nn_hls):mi1( 1+nn_hls),:) = 0._wp ! first column of inner global domain at 0 119 zmsk( mi0(jpiglo-nn_hls):mi1(jpiglo-nn_hls),:) = 0._wp ! last column of inner global domain at 0 120 ENDIF 121 IF( .NOT. ( jperio == 2 .OR. jperio == 7 ) ) THEN ! S closed 122 zmsk(:,mj0( 1+nn_hls):mj1( 1+nn_hls) ) = 0._wp ! first line of inner global domain at 0 123 ENDIF 124 IF( jperio == 0 .OR. jperio == 1 ) THEN ! N closed 125 zmsk(:,mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls) ) = 0._wp ! last line of inner global domain at 0 126 ENDIF 127 CALL lbc_lnk( 'usrdef_zgr', zmsk, 'T', 1. ) ! set halos 128 k_top(:,:) = k_top(:,:) * NINT( zmsk(:,:) ) 129 ! 111 130 !!gm to be remove when removing the OLD definition of e3 scale factors so that gde3w disappears 112 131 ! Compute gde3w_0 (vertical sum of e3w) … … 118 137 ! Any closed seas (defined by closea_mask > 0 in domain_cfg file) to be filled 119 138 ! in at runtime if ln_closea=.false. 120 IF( .NOT.ln_closea ) CALL clo_bat( k_top, k_bot ) 139 IF( ln_closea ) THEN 140 IF ( ln_maskcs ) THEN 141 ! mask all the closed sea 142 CALL clo_msk( k_top, k_bot, mask_opnsea, 'mask_opensea' ) 143 ELSE IF ( ln_mask_csundef ) THEN 144 ! defined closed sea are kept 145 ! mask all the undefined closed sea 146 CALL clo_msk( k_top, k_bot, mask_csundef, 'mask_csundef' ) 147 END IF 148 END IF 121 149 ! 122 150 IF(lwp) THEN ! Control print … … 138 166 ! ! top/bottom ocean level indices for t-, u- and v-points (f-point also for top) 139 167 CALL zgr_top_bot( k_top, k_bot ) ! with a minimum value set to 1 140 141 168 ! 169 ! ! ice shelf draft and bathymetry 170 DO_2D( 1, 1, 1, 1 ) 171 ikt = mikt(ji,jj) 172 ikb = mbkt(ji,jj) 173 bathy (ji,jj) = gdepw_0(ji,jj,ikb+1) 174 risfdep(ji,jj) = gdepw_0(ji,jj,ikt ) 175 END_2D 176 ! 142 177 ! ! deepest/shallowest W level Above/Below ~10m 143 178 !!gm BUG in s-coordinate this does not work! … … 147 182 !!gm end bug 148 183 ! 149 IF( nprint == 1 .AND.lwp ) THEN184 IF( lwp ) THEN 150 185 WRITE(numout,*) ' MIN val k_top ', MINVAL( k_top(:,:) ), ' MAX ', MAXVAL( k_top(:,:) ) 151 186 WRITE(numout,*) ' MIN val k_bot ', MINVAL( k_bot(:,:) ), ' MAX ', MAXVAL( k_bot(:,:) ) … … 219 254 CALL iom_get( inum, jpdom_unknown, 'e3w_1d' , pe3w_1d ) 220 255 ! 221 CALL iom_get( inum, jpdom_ data, 'e3t_0' , pe3t , lrowattr=ln_use_jattr) ! 3D coordinate222 CALL iom_get( inum, jpdom_ data, 'e3u_0' , pe3u , lrowattr=ln_use_jattr)223 CALL iom_get( inum, jpdom_ data, 'e3v_0' , pe3v , lrowattr=ln_use_jattr)224 CALL iom_get( inum, jpdom_ data, 'e3f_0' , pe3f , lrowattr=ln_use_jattr)225 CALL iom_get( inum, jpdom_ data, 'e3w_0' , pe3w , lrowattr=ln_use_jattr)226 CALL iom_get( inum, jpdom_ data, 'e3uw_0' , pe3uw , lrowattr=ln_use_jattr)227 CALL iom_get( inum, jpdom_ data, 'e3vw_0' , pe3vw , lrowattr=ln_use_jattr)256 CALL iom_get( inum, jpdom_global, 'e3t_0' , pe3t , cd_type = 'T', psgn = 1._wp, kfill = jpfillcopy ) ! 3D coordinate 257 CALL iom_get( inum, jpdom_global, 'e3u_0' , pe3u , cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 258 CALL iom_get( inum, jpdom_global, 'e3v_0' , pe3v , cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 259 CALL iom_get( inum, jpdom_global, 'e3f_0' , pe3f , cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy ) 260 CALL iom_get( inum, jpdom_global, 'e3w_0' , pe3w , cd_type = 'W', psgn = 1._wp, kfill = jpfillcopy ) 261 CALL iom_get( inum, jpdom_global, 'e3uw_0' , pe3uw, cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 262 CALL iom_get( inum, jpdom_global, 'e3vw_0' , pe3vw, cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 228 263 ! 229 264 ! !* depths … … 237 272 CALL iom_get( inum, jpdom_unknown, 'gdept_1d', pdept_1d ) 238 273 CALL iom_get( inum, jpdom_unknown, 'gdepw_1d', pdepw_1d ) 239 CALL iom_get( inum, jpdom_ data , 'gdept_0' , pdept , lrowattr=ln_use_jattr)240 CALL iom_get( inum, jpdom_ data , 'gdepw_0' , pdepw , lrowattr=ln_use_jattr)274 CALL iom_get( inum, jpdom_global , 'gdept_0' , pdept, kfill = jpfillcopy ) 275 CALL iom_get( inum, jpdom_global , 'gdepw_0' , pdepw, kfill = jpfillcopy ) 241 276 ! 242 277 ELSE !- depths computed from e3. scale factors … … 252 287 ! 253 288 ! !* ocean top and bottom level 254 CALL iom_get( inum, jpdom_ data, 'top_level' , z2d , lrowattr=ln_use_jattr) ! 1st wet T-points (ISF)289 CALL iom_get( inum, jpdom_global, 'top_level' , z2d ) ! 1st wet T-points (ISF) 255 290 k_top(:,:) = NINT( z2d(:,:) ) 256 CALL iom_get( inum, jpdom_ data, 'bottom_level' , z2d , lrowattr=ln_use_jattr) ! last wet T-points291 CALL iom_get( inum, jpdom_global, 'bottom_level' , z2d ) ! last wet T-points 257 292 k_bot(:,:) = NINT( z2d(:,:) ) 258 293 ! … … 296 331 ! ! N.B. top k-index of W-level = mikt 297 332 ! ! bottom k-index of W-level = mbkt+1 298 DO jj = 1, jpjm1 299 DO ji = 1, jpim1 300 miku(ji,jj) = MAX( mikt(ji+1,jj ) , mikt(ji,jj) ) 301 mikv(ji,jj) = MAX( mikt(ji ,jj+1) , mikt(ji,jj) ) 302 mikf(ji,jj) = MAX( mikt(ji ,jj+1) , mikt(ji,jj), mikt(ji+1,jj ), mikt(ji+1,jj+1) ) 303 ! 304 mbku(ji,jj) = MIN( mbkt(ji+1,jj ) , mbkt(ji,jj) ) 305 mbkv(ji,jj) = MIN( mbkt(ji ,jj+1) , mbkt(ji,jj) ) 306 END DO 307 END DO 333 DO_2D( 1, 0, 1, 0 ) 334 miku(ji,jj) = MAX( mikt(ji+1,jj ) , mikt(ji,jj) ) 335 mikv(ji,jj) = MAX( mikt(ji ,jj+1) , mikt(ji,jj) ) 336 mikf(ji,jj) = MAX( mikt(ji ,jj+1) , mikt(ji,jj), mikt(ji+1,jj ), mikt(ji+1,jj+1) ) 337 ! 338 mbku(ji,jj) = MIN( mbkt(ji+1,jj ) , mbkt(ji,jj) ) 339 mbkv(ji,jj) = MIN( mbkt(ji ,jj+1) , mbkt(ji,jj) ) 340 END_2D 308 341 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 309 zk(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'U', 1. ) ; miku(:,:) = MAX( NINT( zk(:,:) ), 1 )310 zk(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'V', 1. ) ; mikv(:,:) = MAX( NINT( zk(:,:) ), 1 )311 zk(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'F', 1. ) ; mikf(:,:) = MAX( NINT( zk(:,:) ), 1 )312 ! 313 zk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'U', 1. ) ; mbku(:,:) = MAX( NINT( zk(:,:) ), 1 )314 zk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'V', 1. ) ; mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 )342 zk(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp ) ; miku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 343 zk(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) ; mikv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 344 zk(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'F', 1.0_wp ) ; mikf(:,:) = MAX( NINT( zk(:,:) ), 1 ) 345 ! 346 zk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp ) ; mbku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 347 zk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) ; mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 315 348 ! 316 349 END SUBROUTINE zgr_top_bot
Note: See TracChangeset
for help on using the changeset viewer.
