Changeset 11573 for NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/OCE/BDY/bdytides.F90
- Timestamp:
- 2019-09-19T11:18:03+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/OCE/BDY/bdytides.F90
r10068 r11573 70 70 INTEGER :: inum, igrd 71 71 INTEGER, DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays) 72 INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts73 72 INTEGER :: ios ! Local integer output status for namelist read 74 73 CHARACTER(len=80) :: clfile !: full file name for tidal input file … … 77 76 !! 78 77 TYPE(TIDES_DATA), POINTER :: td !: local short cut 79 TYPE(MAP_POINTER), DIMENSION(jpbgrd) :: ibmap_ptr !: array of pointers to nbmap80 78 !! 81 79 NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj 82 80 !!---------------------------------------------------------------------- 83 81 ! 84 IF (nb_bdy>0) THEN 85 IF(lwp) WRITE(numout,*) 86 IF(lwp) WRITE(numout,*) 'bdytide_init : initialization of tidal harmonic forcing at open boundaries' 87 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 88 ENDIF 82 IF(lwp) WRITE(numout,*) 83 IF(lwp) WRITE(numout,*) 'bdytide_init : initialization of tidal harmonic forcing at open boundaries' 84 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 89 85 90 86 REWIND(numnam_cfg) … … 94 90 ! 95 91 td => tides(ib_bdy) 96 nblen => idx_bdy(ib_bdy)%nblen97 nblenrim => idx_bdy(ib_bdy)%nblenrim98 92 99 93 ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries 100 94 filtide(:) = '' 101 95 96 REWIND( numnam_ref ) 97 READ ( numnam_ref, nambdy_tide, IOSTAT = ios, ERR = 901) 98 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in reference namelist' ) 102 99 ! Don't REWIND here - may need to read more than one of these namelists. 103 READ ( numnam_ref, nambdy_tide, IOSTAT = ios, ERR = 901)104 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in reference namelist', lwp )105 100 READ ( numnam_cfg, nambdy_tide, IOSTAT = ios, ERR = 902 ) 106 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist' , lwp)101 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist' ) 107 102 IF(lwm) WRITE ( numond, nambdy_tide ) 108 103 ! ! Parameter control and print … … 125 120 ! JC: If FRS scheme is used, we assume that tidal is needed over the whole 126 121 ! relaxation area 127 IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN ; ilen0(:) = nblen (:)128 ELSE ; ilen0(:) = nblenrim(:)122 IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN ; ilen0(:) = idx_bdy(ib_bdy)%nblen (:) 123 ELSE ; ilen0(:) = idx_bdy(ib_bdy)%nblenrim(:) 129 124 ENDIF 130 125 … … 161 156 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 162 157 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 158 IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj ) CYCLE ! to remove? 163 159 td%ssh0(ib,itide,1) = ztr(ii,ij) 164 160 td%ssh0(ib,itide,2) = zti(ii,ij) … … 177 173 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 178 174 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 175 IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj ) CYCLE ! to remove? 179 176 td%u0(ib,itide,1) = ztr(ii,ij) 180 177 td%u0(ib,itide,2) = zti(ii,ij) … … 193 190 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 194 191 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 192 IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj ) CYCLE ! to remove? 195 193 td%v0(ib,itide,1) = ztr(ii,ij) 196 194 td%v0(ib,itide,2) = zti(ii,ij) … … 207 205 ALLOCATE( dta_read( MAXVAL(ilen0(1:3)), 1, 1 ) ) 208 206 ! 209 ! Set map structure210 ibmap_ptr(1)%ptr => idx_bdy(ib_bdy)%nbmap(:,1) ; ibmap_ptr(1)%ll_unstruc = ln_coords_file(ib_bdy)211 ibmap_ptr(2)%ptr => idx_bdy(ib_bdy)%nbmap(:,2) ; ibmap_ptr(2)%ll_unstruc = ln_coords_file(ib_bdy)212 ibmap_ptr(3)%ptr => idx_bdy(ib_bdy)%nbmap(:,3) ; ibmap_ptr(3)%ll_unstruc = ln_coords_file(ib_bdy)213 214 207 ! Open files and read in tidal forcing data 215 208 ! ----------------------------------------- … … 219 212 clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_T.nc' 220 213 CALL iom_open( clfile, inum ) 221 CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, ibmap_ptr(1) )214 CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 222 215 td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1) 223 CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, ibmap_ptr(1) )216 CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 224 217 td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1) 225 218 CALL iom_close( inum ) … … 227 220 clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_U.nc' 228 221 CALL iom_open( clfile, inum ) 229 CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, i bmap_ptr(2) )222 CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 230 223 td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1) 231 CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, i bmap_ptr(2) )224 CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 232 225 td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1) 233 226 CALL iom_close( inum ) … … 235 228 clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_V.nc' 236 229 CALL iom_open( clfile, inum ) 237 CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, i bmap_ptr(3) )230 CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 238 231 td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1) 239 CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, i bmap_ptr(3) )232 CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 240 233 td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1) 241 234 CALL iom_close( inum ) … … 269 262 270 263 271 SUBROUTINE bdytide_update( kt, idx, dta, td, jit, time_offset )264 SUBROUTINE bdytide_update( kt, idx, dta, td, kit, kt_offset ) 272 265 !!---------------------------------------------------------------------- 273 266 !! *** SUBROUTINE bdytide_update *** … … 280 273 TYPE(OBC_DATA) , INTENT(inout) :: dta ! OBC external data 281 274 TYPE(TIDES_DATA) , INTENT(inout) :: td ! tidal harmonics data 282 INTEGER, OPTIONAL, INTENT(in ) :: jit ! Barotropic timestep counter (for timesplitting option)283 INTEGER, OPTIONAL, INTENT(in ) :: time_offset ! time offset in units of timesteps. NB. if jit275 INTEGER, OPTIONAL, INTENT(in ) :: kit ! Barotropic timestep counter (for timesplitting option) 276 INTEGER, OPTIONAL, INTENT(in ) :: kt_offset ! time offset in units of timesteps. NB. if kit 284 277 ! ! is present then units = subcycle timesteps. 285 ! ! time_offset = 0 => get data at "now" time level286 ! ! time_offset = -1 => get data at "before" time level287 ! ! time_offset = +1 => get data at "after" time level278 ! ! kt_offset = 0 => get data at "now" time level 279 ! ! kt_offset = -1 => get data at "before" time level 280 ! ! kt_offset = +1 => get data at "after" time level 288 281 ! ! etc. 289 282 ! … … 300 293 301 294 zflag=1 302 IF ( PRESENT( jit) ) THEN303 IF ( jit /= 1 ) zflag=0295 IF ( PRESENT(kit) ) THEN 296 IF ( kit /= 1 ) zflag=0 304 297 ENDIF 305 298 … … 320 313 321 314 time_add = 0 322 IF( PRESENT( time_offset) ) THEN323 time_add = time_offset315 IF( PRESENT(kt_offset) ) THEN 316 time_add = kt_offset 324 317 ENDIF 325 318 326 IF( PRESENT( jit) ) THEN327 z_arg = ((kt-kt_tide) * rdt + ( jit+0.5_wp*(time_add-1)) * rdt / REAL(nn_baro,wp) )319 IF( PRESENT(kit) ) THEN 320 z_arg = ((kt-kt_tide) * rdt + (kit+0.5_wp*(time_add-1)) * rdt / REAL(nn_baro,wp) ) 328 321 ELSE 329 322 z_arg = ((kt-kt_tide)+time_add) * rdt … … 358 351 359 352 360 SUBROUTINE bdy_dta_tides( kt, kit, time_offset )353 SUBROUTINE bdy_dta_tides( kt, kit, kt_offset ) 361 354 !!---------------------------------------------------------------------- 362 355 !! *** SUBROUTINE bdy_dta_tides *** … … 367 360 INTEGER, INTENT(in) :: kt ! Main timestep counter 368 361 INTEGER, OPTIONAL, INTENT(in) :: kit ! Barotropic timestep counter (for timesplitting option) 369 INTEGER, OPTIONAL, INTENT(in) :: time_offset! time offset in units of timesteps. NB. if kit362 INTEGER, OPTIONAL, INTENT(in) :: kt_offset ! time offset in units of timesteps. NB. if kit 370 363 ! ! is present then units = subcycle timesteps. 371 ! ! time_offset = 0 => get data at "now" time level372 ! ! time_offset = -1 => get data at "before" time level373 ! ! time_offset = +1 => get data at "after" time level364 ! ! kt_offset = 0 => get data at "now" time level 365 ! ! kt_offset = -1 => get data at "before" time level 366 ! ! kt_offset = +1 => get data at "after" time level 374 367 ! ! etc. 375 368 ! … … 386 379 387 380 time_add = 0 388 IF( PRESENT( time_offset) ) THEN389 time_add = time_offset381 IF( PRESENT(kt_offset) ) THEN 382 time_add = kt_offset 390 383 ENDIF 391 384 … … 432 425 ! If time splitting, initialize arrays from slow varying open boundary data: 433 426 IF ( PRESENT(kit) ) THEN 434 IF ( dta_bdy(ib_bdy)%l l_ssh) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1))435 IF ( dta_bdy(ib_bdy)%l l_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2))436 IF ( dta_bdy(ib_bdy)%l l_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3))427 IF ( dta_bdy(ib_bdy)%lneed_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 428 IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 429 IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 437 430 ENDIF 438 431 ! … … 444 437 z_sist = zramp * SIN( z_sarg ) 445 438 ! 446 IF ( dta_bdy(ib_bdy)%l l_ssh ) THEN439 IF ( dta_bdy(ib_bdy)%lneed_ssh ) THEN 447 440 igrd=1 ! SSH on tracer grid 448 441 DO ib = 1, ilen0(igrd) … … 453 446 ENDIF 454 447 ! 455 IF ( dta_bdy(ib_bdy)%l l_u2d ) THEN448 IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) THEN 456 449 igrd=2 ! U grid 457 450 DO ib = 1, ilen0(igrd) … … 460 453 & tides(ib_bdy)%u(ib,itide,2)*z_sist ) 461 454 END DO 462 ENDIF463 !464 IF ( dta_bdy(ib_bdy)%ll_v2d ) THEN465 455 igrd=3 ! V grid 466 456 DO ib = 1, ilen0(igrd)
Note: See TracChangeset
for help on using the changeset viewer.