Changeset 13982 for NEMO/trunk/src/OCE/DOM
- Timestamp:
- 2020-12-02T11:57:05+01:00 (4 years ago)
- Location:
- NEMO/trunk/src/OCE/DOM
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/DOM/dom_oce.F90
r13557 r13982 74 74 LOGICAL, PUBLIC :: l_Iperio, l_Jperio ! should we explicitely take care I/J periodicity 75 75 76 ! Tiling namelist 77 LOGICAL, PUBLIC :: ln_tile 78 INTEGER :: nn_ltile_i, nn_ltile_j 79 80 ! Domain tiling (all tiles) 81 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntsi_a !: start of internal part of tile domain 82 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntsj_a ! 83 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntei_a !: end of internal part of tile domain 84 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntej_a ! 85 76 86 ! !: domain MPP decomposition parameters 77 87 INTEGER , PUBLIC :: nimpp, njmpp !: i- & j-indexes for mpp-subdomain left bottom … … 87 97 INTEGER, PUBLIC :: noea, nowe !: index of the local neighboring processors in 88 98 INTEGER, PUBLIC :: noso, nono !: east, west, south and north directions 99 INTEGER, PUBLIC :: nones, nonws !: north-east, north-west directions for sending 100 INTEGER, PUBLIC :: noses, nosws !: south-east, south-west directions for sending 101 INTEGER, PUBLIC :: noner, nonwr !: north-east, north-west directions for receiving 102 INTEGER, PUBLIC :: noser, noswr !: south-east, south-west directions for receiving 89 103 INTEGER, PUBLIC :: nidom !: ??? 90 104 … … 296 310 ALLOCATE( e3t(jpi,jpj,jpk,jpt) , e3u (jpi,jpj,jpk,jpt) , e3v (jpi,jpj,jpk,jpt) , e3f(jpi,jpj,jpk) , & 297 311 & e3w(jpi,jpj,jpk,jpt) , e3uw(jpi,jpj,jpk,jpt) , e3vw(jpi,jpj,jpk,jpt) , STAT=ierr(ii) ) 298 #endif 312 #endif 299 313 ! 300 314 ii = ii+1 301 315 ALLOCATE( r3t (jpi,jpj,jpt) , r3u (jpi,jpj,jpt) , r3v (jpi,jpj,jpt) , r3f (jpi,jpj) , & 302 & r3t_f(jpi,jpj) , r3u_f(jpi,jpj) , r3v_f(jpi,jpj) , STAT=ierr(ii) ) 316 & r3t_f(jpi,jpj) , r3u_f(jpi,jpj) , r3v_f(jpi,jpj) , STAT=ierr(ii) ) 303 317 ! 304 318 ii = ii+1 … … 317 331 ! 318 332 ii = ii+1 319 ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(ii) ) 333 ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(ii) ) 320 334 ! 321 335 ii = ii+1 … … 323 337 ! 324 338 ii = ii+1 325 ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) , & 339 ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) , & 326 340 & ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , & 327 341 & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv (jpi,jpj) , STAT=ierr(ii) ) … … 331 345 ! 332 346 ii = ii+1 333 ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) , & 347 ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) , & 334 348 & vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk) , STAT=ierr(ii) ) 335 349 ! -
NEMO/trunk/src/OCE/DOM/domain.F90
r13970 r13982 45 45 USE closea , ONLY : dom_clo ! closed seas 46 46 ! 47 USE prtctl ! Print control (prt_ctl_info routine) 47 48 USE in_out_manager ! I/O manager 48 49 USE iom ! I/O library … … 55 56 PUBLIC dom_init ! called by nemogcm.F90 56 57 PUBLIC domain_cfg ! called by nemogcm.F90 58 PUBLIC dom_tile ! called by step.F90 57 59 58 60 !!------------------------------------------------------------------------- … … 124 126 ! !== Reference coordinate system ==! 125 127 ! 126 CALL dom_glo ! global domain versus local domain 127 CALL dom_nam ! read namelist ( namrun, namdom ) 128 CALL dom_glo ! global domain versus local domain 129 CALL dom_nam ! read namelist ( namrun, namdom ) 130 CALL dom_tile( ntsi, ntsj, ntei, ntej ) ! Tile domain 131 128 132 ! 129 133 CALL dom_hgr ! Horizontal mesh … … 273 277 274 278 279 SUBROUTINE dom_tile( ktsi, ktsj, ktei, ktej, ktile ) 280 !!---------------------------------------------------------------------- 281 !! *** ROUTINE dom_tile *** 282 !! 283 !! ** Purpose : Set tile domain variables 284 !! 285 !! ** Action : - ktsi, ktsj : start of internal part of domain 286 !! - ktei, ktej : end of internal part of domain 287 !! - ntile : current tile number 288 !! - nijtile : total number of tiles 289 !!---------------------------------------------------------------------- 290 INTEGER, INTENT(out) :: ktsi, ktsj, ktei, ktej ! Tile domain indices 291 INTEGER, INTENT(in), OPTIONAL :: ktile ! Tile number 292 INTEGER :: jt ! dummy loop argument 293 INTEGER :: iitile, ijtile ! Local integers 294 CHARACTER (len=11) :: charout 295 !!---------------------------------------------------------------------- 296 IF( PRESENT(ktile) .AND. ln_tile ) THEN 297 ntile = ktile ! Set domain indices for tile 298 ktsi = ntsi_a(ktile) 299 ktsj = ntsj_a(ktile) 300 ktei = ntei_a(ktile) 301 ktej = ntej_a(ktile) 302 303 IF(sn_cfctl%l_prtctl) THEN 304 WRITE(charout, FMT="('ntile =', I4)") ktile 305 CALL prt_ctl_info( charout ) 306 ENDIF 307 ELSE 308 ntile = 0 ! Initialise to full domain 309 nijtile = 1 310 ktsi = Nis0 311 ktsj = Njs0 312 ktei = Nie0 313 ktej = Nje0 314 315 IF( ln_tile ) THEN ! Calculate tile domain indices 316 iitile = Ni_0 / nn_ltile_i ! Number of tiles 317 ijtile = Nj_0 / nn_ltile_j 318 IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1 319 IF( MOD( Nj_0, nn_ltile_j ) /= 0 ) ijtile = ijtile + 1 320 321 nijtile = iitile * ijtile 322 ALLOCATE( ntsi_a(0:nijtile), ntsj_a(0:nijtile), ntei_a(0:nijtile), ntej_a(0:nijtile) ) 323 324 ntsi_a(0) = ktsi ! Full domain 325 ntsj_a(0) = ktsj 326 ntei_a(0) = ktei 327 ntej_a(0) = ktej 328 329 DO jt = 1, nijtile ! Tile domains 330 ntsi_a(jt) = Nis0 + nn_ltile_i * MOD(jt - 1, iitile) 331 ntsj_a(jt) = Njs0 + nn_ltile_j * ((jt - 1) / iitile) 332 ntei_a(jt) = MIN(ntsi_a(jt) + nn_ltile_i - 1, Nie0) 333 ntej_a(jt) = MIN(ntsj_a(jt) + nn_ltile_j - 1, Nje0) 334 ENDDO 335 ENDIF 336 337 IF(lwp) THEN ! control print 338 WRITE(numout,*) 339 WRITE(numout,*) 'dom_tile : Domain tiling decomposition' 340 WRITE(numout,*) '~~~~~~~~' 341 IF( ln_tile ) THEN 342 WRITE(numout,*) iitile, 'tiles in i' 343 WRITE(numout,*) ' Starting indices' 344 WRITE(numout,*) ' ', (ntsi_a(jt), jt=1, iitile) 345 WRITE(numout,*) ' Ending indices' 346 WRITE(numout,*) ' ', (ntei_a(jt), jt=1, iitile) 347 WRITE(numout,*) ijtile, 'tiles in j' 348 WRITE(numout,*) ' Starting indices' 349 WRITE(numout,*) ' ', (ntsj_a(jt), jt=1, nijtile, iitile) 350 WRITE(numout,*) ' Ending indices' 351 WRITE(numout,*) ' ', (ntej_a(jt), jt=1, nijtile, iitile) 352 ELSE 353 WRITE(numout,*) 'No domain tiling' 354 WRITE(numout,*) ' i indices =', ktsi, ':', ktei 355 WRITE(numout,*) ' j indices =', ktsj, ':', ktej 356 ENDIF 357 ENDIF 358 ENDIF 359 END SUBROUTINE dom_tile 360 361 275 362 SUBROUTINE dom_nam 276 363 !!---------------------------------------------------------------------- … … 281 368 !! ** input : - namrun namelist 282 369 !! - namdom namelist 370 !! - namtile namelist 283 371 !! - namnc4 namelist ! "key_netcdf4" only 284 372 !!---------------------------------------------------------------------- … … 293 381 & ln_cfmeta, ln_xios_read, nn_wxios 294 382 NAMELIST/namdom/ ln_linssh, rn_Dt, rn_atfp, ln_crs, ln_meshmask 383 NAMELIST/namtile/ ln_tile, nn_ltile_i, nn_ltile_j 295 384 #if defined key_netcdf4 296 385 NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip … … 429 518 r1_Dt = 1._wp / rDt 430 519 520 READ ( numnam_ref, namtile, IOSTAT = ios, ERR = 905 ) 521 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtile in reference namelist' ) 522 READ ( numnam_cfg, namtile, IOSTAT = ios, ERR = 906 ) 523 906 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtile in configuration namelist' ) 524 IF(lwm) WRITE( numond, namtile ) 525 526 IF(lwp) THEN 527 WRITE(numout,*) 528 WRITE(numout,*) ' Namelist : namtile --- Domain tiling decomposition' 529 WRITE(numout,*) ' Tiling (T) or not (F) ln_tile = ', ln_tile 530 WRITE(numout,*) ' Length of tile in i nn_ltile_i = ', nn_ltile_i 531 WRITE(numout,*) ' Length of tile in j nn_ltile_j = ', nn_ltile_j 532 WRITE(numout,*) 533 IF( ln_tile ) THEN 534 WRITE(numout,*) ' The domain will be decomposed into tiles of size', nn_ltile_i, 'x', nn_ltile_j 535 ELSE 536 WRITE(numout,*) ' Domain tiling will NOT be used' 537 ENDIF 538 ENDIF 539 431 540 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 432 541 lrxios = ln_xios_read.AND.ln_rstart -
NEMO/trunk/src/OCE/DOM/domutl.F90
r13458 r13982 21 21 PRIVATE 22 22 23 INTERFACE is_tile 24 MODULE PROCEDURE is_tile_2d, is_tile_3d, is_tile_4d 25 END INTERFACE is_tile 26 23 27 PUBLIC dom_ngb ! routine called in iom.F90 module 24 28 PUBLIC dom_uniq ! Called by dommsk and domwri 29 PUBLIC is_tile 25 30 26 31 !!---------------------------------------------------------------------- … … 109 114 ! 110 115 END SUBROUTINE dom_uniq 111 116 117 118 FUNCTION is_tile_2d( pt ) 119 !! 120 REAL(wp), DIMENSION(:,:), INTENT(in) :: pt 121 INTEGER :: is_tile_2d 122 !! 123 IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 124 is_tile_2d = 1 125 ELSE 126 is_tile_2d = 0 127 ENDIF 128 END FUNCTION is_tile_2d 129 130 131 FUNCTION is_tile_3d( pt ) 132 !! 133 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pt 134 INTEGER :: is_tile_3d 135 !! 136 IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 137 is_tile_3d = 1 138 ELSE 139 is_tile_3d = 0 140 ENDIF 141 END FUNCTION is_tile_3d 142 143 144 FUNCTION is_tile_4d( pt ) 145 !! 146 REAL(wp), DIMENSION(:,:,:,:), INTENT(in) :: pt 147 INTEGER :: is_tile_4d 148 !! 149 IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 150 is_tile_4d = 1 151 ELSE 152 is_tile_4d = 0 153 ENDIF 154 END FUNCTION is_tile_4d 155 112 156 !!====================================================================== 113 157 END MODULE domutl -
NEMO/trunk/src/OCE/DOM/domvvl.F90
r13970 r13982 422 422 ! (stored for tracer advction and continuity equation) 423 423 CALL lbc_lnk_multi( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 424 425 424 ! 4 - Time stepping of baroclinic scale factors 426 425 ! --------------------------------------------- -
NEMO/trunk/src/OCE/DOM/dtatsd.F90
r13497 r13982 18 18 USE phycst ! physical constants 19 19 USE dom_oce ! ocean space and time domain 20 USE domain, ONLY : dom_tile 20 21 USE fldread ! read input fields 21 22 ! … … 135 136 !! ** Action : ptsd T-S data on medl mesh and interpolated at time-step kt 136 137 !!---------------------------------------------------------------------- 137 INTEGER 138 REAL(wp), DIMENSION( jpi,jpj,jpk,jpts), INTENT( out) :: ptsd ! T & S data138 INTEGER , INTENT(in ) :: kt ! ocean time-step 139 REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts), INTENT( out) :: ptsd ! T & S data 139 140 ! 140 141 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 141 142 INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 ! local integers 143 INTEGER :: itile 142 144 REAL(wp):: zl, zi ! local scalars 143 145 REAL(wp), DIMENSION(jpk) :: ztp, zsp ! 1D workspace 144 146 !!---------------------------------------------------------------------- 145 147 ! 146 CALL fld_read( kt, 1, sf_tsd ) !== read T & S data at kt time step ==! 148 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only for the full domain 149 itile = ntile 150 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 151 CALL fld_read( kt, 1, sf_tsd ) !== read T & S data at kt time step ==! 147 152 ! 148 153 ! 149 154 !!gm This should be removed from the code ===>>>> T & S files has to be changed 150 ! 151 ! !== ORCA_R2 configuration and T & S damping ==! 152 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 153 IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN ! some hand made alterations 154 ! 155 ij0 = 101 + nn_hls ; ij1 = 109 + nn_hls ! Reduced T & S in the Alboran Sea 156 ii0 = 141 + nn_hls - 1 ; ii1 = 155 + nn_hls - 1 157 DO jj = mj0(ij0), mj1(ij1) 158 DO ji = mi0(ii0), mi1(ii1) 159 sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp 160 sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp 161 sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp 162 ! 163 sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp 164 sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp 165 sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp 166 sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp 155 ! 156 ! !== ORCA_R2 configuration and T & S damping ==! 157 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 158 IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN ! some hand made alterations 159 ! 160 ij0 = 101 + nn_hls ; ij1 = 109 + nn_hls ! Reduced T & S in the Alboran Sea 161 ii0 = 141 + nn_hls - 1 ; ii1 = 155 + nn_hls - 1 162 DO jj = mj0(ij0), mj1(ij1) 163 DO ji = mi0(ii0), mi1(ii1) 164 sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp 165 sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp 166 sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp 167 ! 168 sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp 169 sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp 170 sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp 171 sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp 172 END DO 167 173 END DO 168 END DO 169 ij0 = 87 + nn_hls ; ij1 = 96 + nn_hls ! Reduced temperature in Red Sea 170 ii0 = 148 + nn_hls - 1 ; ii1 = 160 + nn_hls - 1 171 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0_wp 172 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp 173 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp 174 ENDIF 175 ENDIF 174 ij0 = 87 + nn_hls ; ij1 = 96 + nn_hls ! Reduced temperature in Red Sea 175 ii0 = 148 + nn_hls - 1 ; ii1 = 160 + nn_hls - 1 176 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0_wp 177 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp 178 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp 179 ENDIF 180 ENDIF 176 181 !!gm end 177 ! 178 ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:) ! NO mask 179 ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) 182 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 183 ENDIF 184 ! 185 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 186 ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jk) ! NO mask 187 ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jk) 188 END_3D 180 189 ! 181 190 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 182 191 ! 183 IF( kt == nit000 .AND. lwp )THEN 184 WRITE(numout,*) 185 WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 186 ENDIF 187 ! 188 DO_2D( 1, 1, 1, 1 ) ! vertical interpolation of T & S 192 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 193 IF( kt == nit000 .AND. lwp )THEN 194 WRITE(numout,*) 195 WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 196 ENDIF 197 ENDIF 198 ! 199 ! NOTE: [tiling-comms-merge] This fix was necessary to take out tra_adv lbc_lnk statements in the zps case, but did not work in the zco case 200 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! vertical interpolation of T & S 189 201 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 190 202 zl = gdept_0(ji,jj,jk) … … 215 227 ELSE !== z- or zps- coordinate ==! 216 228 ! 217 ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:) ! Mask 218 ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 229 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 230 ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) ! Mask 231 ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 232 END_3D 219 233 ! 220 234 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 221 DO_2D( 1, 1, 1, 1 ) 235 ! NOTE: [tiling-comms-merge] This fix was necessary to take out tra_adv lbc_lnk statements in the zps case 236 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 222 237 ik = mbkt(ji,jj) 223 238 IF( ik > 1 ) THEN
Note: See TracChangeset
for help on using the changeset viewer.