Changeset 12910 for NEMO/releases/r4.0/r4.0-HEAD/src/OCE/BDY/bdytides.F90
- Timestamp:
- 2020-05-12T10:21:19+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/releases/r4.0/r4.0-HEAD/src/OCE/BDY/bdytides.F90
r11536 r12910 62 62 !! namelist variables 63 63 !!------------------- 64 CHARACTER(len=80) :: filtide ! :Filename root for tidal input files65 LOGICAL :: ln_bdytide_2ddta ! :If true, read 2d harmonic data66 LOGICAL :: ln_bdytide_conj ! :If true, assume complex conjugate tidal data64 CHARACTER(len=80) :: filtide ! Filename root for tidal input files 65 LOGICAL :: ln_bdytide_2ddta ! If true, read 2d harmonic data 66 LOGICAL :: ln_bdytide_conj ! If true, assume complex conjugate tidal data 67 67 !! 68 INTEGER :: ib_bdy, itide, ib ! :dummy loop indices69 INTEGER :: ii, ij ! :dummy loop indices68 INTEGER :: ib_bdy, itide, ib ! dummy loop indices 69 INTEGER :: ii, ij ! dummy loop indices 70 70 INTEGER :: inum, igrd 71 INTEGER , DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays)71 INTEGER :: isz ! bdy data size 72 72 INTEGER :: ios ! Local integer output status for namelist read 73 CHARACTER(len=80) :: clfile ! :full file name for tidal input file74 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: dta_read ! :work space to read in tidal harmonics data75 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: ztr, zti ! :" " " " " " " "73 CHARACTER(len=80) :: clfile ! full file name for tidal input file 74 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: dta_read ! work space to read in tidal harmonics data 75 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: ztr, zti ! " " " " " " " " 76 76 !! 77 TYPE(TIDES_DATA), POINTER :: td !: local short cut 77 TYPE(TIDES_DATA), POINTER :: td ! local short cut 78 TYPE( OBC_DATA), POINTER :: dta ! local short cut 78 79 !! 79 80 NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj … … 89 90 IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 90 91 ! 91 td => tides(ib_bdy) 92 92 td => tides(ib_bdy) 93 dta => dta_bdy(ib_bdy) 94 93 95 ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries 94 96 filtide(:) = '' … … 115 117 IF(lwp) WRITE(numout,*) ' ' 116 118 117 ! Allocate space for tidal harmonics data - get size from OBC data arrays 119 ! Allocate space for tidal harmonics data - get size from BDY data arrays 120 ! Allocate also slow varying data in the case of time splitting: 121 ! Do it anyway because at this stage knowledge of free surface scheme is unknown 118 122 ! ----------------------------------------------------------------------- 119 120 ! JC: If FRS scheme is used, we assume that tidal is needed over the whole 121 ! relaxation area 122 IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN ; ilen0(:) = idx_bdy(ib_bdy)%nblen (:) 123 ELSE ; ilen0(:) = idx_bdy(ib_bdy)%nblenrim(:) 123 IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain 124 isz = SIZE(dta%ssh) 125 ALLOCATE( td%ssh0( isz, nb_harmo, 2 ), td%ssh( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%ssh( isz ) ) 126 dta_bdy_s(ib_bdy)%ssh(:) = 0._wp ! needed? 124 127 ENDIF 125 126 ALLOCATE( td%ssh0( ilen0(1), nb_harmo, 2 ) ) 127 ALLOCATE( td%ssh ( ilen0(1), nb_harmo, 2 ) ) 128 129 ALLOCATE( td%u0( ilen0(2), nb_harmo, 2 ) ) 130 ALLOCATE( td%u ( ilen0(2), nb_harmo, 2 ) ) 131 132 ALLOCATE( td%v0( ilen0(3), nb_harmo, 2 ) ) 133 ALLOCATE( td%v ( ilen0(3), nb_harmo, 2 ) ) 134 135 td%ssh0(:,:,:) = 0._wp 136 td%ssh (:,:,:) = 0._wp 137 td%u0 (:,:,:) = 0._wp 138 td%u (:,:,:) = 0._wp 139 td%v0 (:,:,:) = 0._wp 140 td%v (:,:,:) = 0._wp 141 128 IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain 129 isz = SIZE(dta%u2d) 130 ALLOCATE( td%u0 ( isz, nb_harmo, 2 ), td%u ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%u2d( isz ) ) 131 dta_bdy_s(ib_bdy)%u2d(:) = 0._wp ! needed? 132 ENDIF 133 IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain 134 isz = SIZE(dta%v2d) 135 ALLOCATE( td%v0 ( isz, nb_harmo, 2 ), td%v ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%v2d( isz ) ) 136 dta_bdy_s(ib_bdy)%v2d(:) = 0._wp ! needed? 137 ENDIF 138 139 ! fill td%ssh0, td%u0, td%v0 140 ! ----------------------------------------------------------------------- 142 141 IF( ln_bdytide_2ddta ) THEN 142 ! 143 143 ! It is assumed that each data file contains all complex harmonic amplitudes 144 144 ! given on the global domain (ie global, jpiglo x jpjglo) … … 147 147 ! 148 148 ! SSH fields 149 clfile = TRIM(filtide)//'_grid_T.nc' 150 CALL iom_open( clfile , inum ) 151 igrd = 1 ! Everything is at T-points here 152 DO itide = 1, nb_harmo 153 CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) ) 154 CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) ) 155 DO ib = 1, ilen0(igrd) 156 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 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? 159 td%ssh0(ib,itide,1) = ztr(ii,ij) 160 td%ssh0(ib,itide,2) = zti(ii,ij) 149 IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain 150 clfile = TRIM(filtide)//'_grid_T.nc' 151 CALL iom_open( clfile , inum ) 152 igrd = 1 ! Everything is at T-points here 153 DO itide = 1, nb_harmo 154 CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) ) 155 CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) ) 156 DO ib = 1, SIZE(dta%ssh) 157 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 158 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 159 td%ssh0(ib,itide,1) = ztr(ii,ij) 160 td%ssh0(ib,itide,2) = zti(ii,ij) 161 END DO 161 162 END DO 162 END DO163 CALL iom_close( inum )163 CALL iom_close( inum ) 164 END IF 164 165 ! 165 166 ! U fields 166 clfile = TRIM(filtide)//'_grid_U.nc' 167 CALL iom_open( clfile , inum ) 168 igrd = 2 ! Everything is at U-points here 169 DO itide = 1, nb_harmo 170 CALL iom_get ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) ) 171 CALL iom_get ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) ) 172 DO ib = 1, ilen0(igrd) 173 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 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? 176 td%u0(ib,itide,1) = ztr(ii,ij) 177 td%u0(ib,itide,2) = zti(ii,ij) 167 IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain 168 clfile = TRIM(filtide)//'_grid_U.nc' 169 CALL iom_open( clfile , inum ) 170 igrd = 2 ! Everything is at U-points here 171 DO itide = 1, nb_harmo 172 CALL iom_get ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) ) 173 CALL iom_get ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) ) 174 DO ib = 1, SIZE(dta%u2d) 175 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 176 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 177 td%u0(ib,itide,1) = ztr(ii,ij) 178 td%u0(ib,itide,2) = zti(ii,ij) 179 END DO 178 180 END DO 179 END DO180 CALL iom_close( inum )181 CALL iom_close( inum ) 182 END IF 181 183 ! 182 184 ! V fields 183 clfile = TRIM(filtide)//'_grid_V.nc' 184 CALL iom_open( clfile , inum ) 185 igrd = 3 ! Everything is at V-points here 186 DO itide = 1, nb_harmo 187 CALL iom_get ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) ) 188 CALL iom_get ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) ) 189 DO ib = 1, ilen0(igrd) 190 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 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? 193 td%v0(ib,itide,1) = ztr(ii,ij) 194 td%v0(ib,itide,2) = zti(ii,ij) 185 IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain 186 clfile = TRIM(filtide)//'_grid_V.nc' 187 CALL iom_open( clfile , inum ) 188 igrd = 3 ! Everything is at V-points here 189 DO itide = 1, nb_harmo 190 CALL iom_get ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) ) 191 CALL iom_get ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) ) 192 DO ib = 1, SIZE(dta%v2d) 193 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 194 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 195 td%v0(ib,itide,1) = ztr(ii,ij) 196 td%v0(ib,itide,2) = zti(ii,ij) 197 END DO 195 198 END DO 196 END DO197 CALL iom_close( inum )199 CALL iom_close( inum ) 200 END IF 198 201 ! 199 202 DEALLOCATE( ztr, zti ) … … 203 206 ! Read tidal data only on bdy segments 204 207 ! 205 ALLOCATE( dta_read( MAXVAL( ilen0(1:3)), 1, 1 ) )208 ALLOCATE( dta_read( MAXVAL( idx_bdy(ib_bdy)%nblen(:) ), 1, 1 ) ) 206 209 ! 207 210 ! Open files and read in tidal forcing data … … 210 213 DO itide = 1, nb_harmo 211 214 ! ! SSH fields 212 clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_T.nc' 213 CALL iom_open( clfile, inum ) 214 CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 215 td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1) 216 CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 217 td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1) 218 CALL iom_close( inum ) 215 IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain 216 isz = SIZE(dta%ssh) 217 clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_T.nc' 218 CALL iom_open( clfile, inum ) 219 CALL fld_map( inum, 'z1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 220 td%ssh0(:,itide,1) = dta_read(1:isz,1,1) 221 CALL fld_map( inum, 'z2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 222 td%ssh0(:,itide,2) = dta_read(1:isz,1,1) 223 CALL iom_close( inum ) 224 ENDIF 219 225 ! ! U fields 220 clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_U.nc' 221 CALL iom_open( clfile, inum ) 222 CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 223 td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1) 224 CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 225 td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1) 226 CALL iom_close( inum ) 226 IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain 227 isz = SIZE(dta%u2d) 228 clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_U.nc' 229 CALL iom_open( clfile, inum ) 230 CALL fld_map( inum, 'u1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 231 td%u0(:,itide,1) = dta_read(1:isz,1,1) 232 CALL fld_map( inum, 'u2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 233 td%u0(:,itide,2) = dta_read(1:isz,1,1) 234 CALL iom_close( inum ) 235 ENDIF 227 236 ! ! V fields 228 clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_V.nc' 229 CALL iom_open( clfile, inum ) 230 CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 231 td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1) 232 CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 233 td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1) 234 CALL iom_close( inum ) 237 IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain 238 isz = SIZE(dta%v2d) 239 clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_V.nc' 240 CALL iom_open( clfile, inum ) 241 CALL fld_map( inum, 'v1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 242 td%v0(:,itide,1) = dta_read(1:isz,1,1) 243 CALL fld_map( inum, 'v2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 244 td%v0(:,itide,2) = dta_read(1:isz,1,1) 245 CALL iom_close( inum ) 246 ENDIF 235 247 ! 236 248 END DO ! end loop on tidal components … … 241 253 ! 242 254 IF( ln_bdytide_conj ) THEN ! assume complex conjugate in data files 243 td%ssh0(:,:,2) = - td%ssh0(:,:,2)244 td%u0 (:,:,2) = - td%u0 (:,:,2)245 td%v0 (:,:,2) = - td%v0 (:,:,2)255 IF( ASSOCIATED(dta%ssh) ) td%ssh0(:,:,2) = - td%ssh0(:,:,2) 256 IF( ASSOCIATED(dta%u2d) ) td%u0 (:,:,2) = - td%u0 (:,:,2) 257 IF( ASSOCIATED(dta%v2d) ) td%v0 (:,:,2) = - td%v0 (:,:,2) 246 258 ENDIF 247 !248 ! Allocate slow varying data in the case of time splitting:249 ! Do it anyway because at this stage knowledge of free surface scheme is unknown250 ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) )251 ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) )252 ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) )253 dta_bdy_s(ib_bdy)%ssh(:) = 0._wp254 dta_bdy_s(ib_bdy)%u2d(:) = 0._wp255 dta_bdy_s(ib_bdy)%v2d(:) = 0._wp256 259 ! 257 260 ENDIF ! nn_dyn2d_dta(ib_bdy) >= 2 … … 281 284 ! ! etc. 282 285 ! 283 INTEGER :: itide, i grd, ib! dummy loop indices286 INTEGER :: itide, ib ! dummy loop indices 284 287 INTEGER :: time_add ! time offset in units of timesteps 285 INTEGER , DIMENSION(3) :: ilen0 ! length of boundary data (from OBC arrays)288 INTEGER :: isz ! bdy data size 286 289 REAL(wp) :: z_arg, z_sarg, zflag, zramp ! local scalars 287 290 REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost 288 291 !!---------------------------------------------------------------------- 289 292 ! 290 ilen0(1) = SIZE(td%ssh(:,1,1))291 ilen0(2) = SIZE(td%u(:,1,1))292 ilen0(3) = SIZE(td%v(:,1,1))293 294 293 zflag=1 295 294 IF ( PRESENT(kit) ) THEN 296 295 IF ( kit /= 1 ) zflag=0 297 296 ENDIF 298 297 ! 299 298 IF ( (nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000) .AND. zflag==1 ) THEN 300 299 ! … … 334 333 335 334 DO itide = 1, nb_harmo 336 igrd=1 ! SSH on tracer grid 337 DO ib = 1, ilen0(igrd) 338 dta%ssh(ib) = dta%ssh(ib) + zramp*(td%ssh(ib,itide,1)*z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide)) 339 END DO 340 igrd=2 ! U grid 341 DO ib = 1, ilen0(igrd) 342 dta%u2d(ib) = dta%u2d(ib) + zramp*(td%u (ib,itide,1)*z_cost(itide) + td%u (ib,itide,2)*z_sist(itide)) 343 END DO 344 igrd=3 ! V grid 345 DO ib = 1, ilen0(igrd) 346 dta%v2d(ib) = dta%v2d(ib) + zramp*(td%v (ib,itide,1)*z_cost(itide) + td%v (ib,itide,2)*z_sist(itide)) 347 END DO 335 ! SSH on tracer grid 336 IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain 337 DO ib = 1, SIZE(dta%ssh) 338 dta%ssh(ib) = dta%ssh(ib) + zramp*(td%ssh(ib,itide,1)*z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide)) 339 END DO 340 ENDIF 341 ! U grid 342 IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain 343 DO ib = 1, SIZE(dta%u2d) 344 dta%u2d(ib) = dta%u2d(ib) + zramp*(td%u (ib,itide,1)*z_cost(itide) + td%u (ib,itide,2)*z_sist(itide)) 345 END DO 346 ENDIF 347 ! V grid 348 IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain 349 DO ib = 1, SIZE(dta%v2d) 350 dta%v2d(ib) = dta%v2d(ib) + zramp*(td%v (ib,itide,1)*z_cost(itide) + td%v (ib,itide,2)*z_sist(itide)) 351 END DO 352 ENDIF 348 353 END DO 349 354 ! … … 368 373 ! 369 374 LOGICAL :: lk_first_btstp ! =.TRUE. if time splitting and first barotropic step 370 INTEGER :: itide, ib_bdy, ib , igrd! loop indices375 INTEGER :: itide, ib_bdy, ib ! loop indices 371 376 INTEGER :: time_add ! time offset in units of timesteps 372 INTEGER, DIMENSION(jpbgrd) :: ilen0373 INTEGER, DIMENSION(1:jpbgrd) :: nblen, nblenrim ! short cuts374 377 REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist 375 378 !!---------------------------------------------------------------------- … … 398 401 IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 399 402 ! 400 nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd)401 nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd)402 !403 IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN ; ilen0(:) = nblen (:)404 ELSE ; ilen0(:) = nblenrim(:)405 ENDIF406 !407 403 ! We refresh nodal factors every day below 408 404 ! This should be done somewhere else … … 425 421 ! If time splitting, initialize arrays from slow varying open boundary data: 426 422 IF ( PRESENT(kit) ) THEN 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))423 IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) dta_bdy(ib_bdy)%ssh(:) = dta_bdy_s(ib_bdy)%ssh(:) 424 IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) dta_bdy(ib_bdy)%u2d(:) = dta_bdy_s(ib_bdy)%u2d(:) 425 IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) dta_bdy(ib_bdy)%v2d(:) = dta_bdy_s(ib_bdy)%v2d(:) 430 426 ENDIF 431 427 ! … … 437 433 z_sist = zramp * SIN( z_sarg ) 438 434 ! 439 IF ( dta_bdy(ib_bdy)%lneed_ssh ) THEN 440 igrd=1 ! SSH on tracer grid 441 DO ib = 1, ilen0(igrd) 435 IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) THEN ! SSH on tracer grid 436 DO ib = 1, SIZE(dta_bdy(ib_bdy)%ssh) 442 437 dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + & 443 438 & ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + & … … 446 441 ENDIF 447 442 ! 448 IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) THEN 449 igrd=2 ! U grid 450 DO ib = 1, ilen0(igrd) 443 IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) THEN ! U grid 444 DO ib = 1, SIZE(dta_bdy(ib_bdy)%u2d) 451 445 dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + & 452 446 & ( tides(ib_bdy)%u(ib,itide,1)*z_cost + & 453 447 & tides(ib_bdy)%u(ib,itide,2)*z_sist ) 454 448 END DO 455 igrd=3 ! V grid 456 DO ib = 1, ilen0(igrd) 449 ENDIF 450 ! 451 IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) THEN ! V grid 452 DO ib = 1, SIZE(dta_bdy(ib_bdy)%v2d) 457 453 dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + & 458 454 & ( tides(ib_bdy)%v(ib,itide,1)*z_cost + & … … 460 456 END DO 461 457 ENDIF 458 ! 462 459 END DO 463 460 END IF … … 474 471 TYPE(TIDES_DATA), INTENT(inout) :: td ! tidal harmonics data 475 472 ! 476 INTEGER :: itide, igrd, ib ! dummy loop indices 477 INTEGER, DIMENSION(1) :: ilen0 ! length of boundary data (from OBC arrays) 473 INTEGER :: itide, isz, ib ! dummy loop indices 478 474 REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide 479 475 !!---------------------------------------------------------------------- 480 476 ! 481 igrd=1 482 ! SSH on tracer grid. 483 ilen0(1) = SIZE(td%ssh0(:,1,1)) 484 ! 485 ALLOCATE( mod_tide(ilen0(igrd)), phi_tide(ilen0(igrd)) ) 486 ! 487 DO itide = 1, nb_harmo 488 DO ib = 1, ilen0(igrd) 489 mod_tide(ib)=SQRT(td%ssh0(ib,itide,1)**2.+td%ssh0(ib,itide,2)**2.) 490 phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1)) 477 IF( ASSOCIATED(td%ssh0) ) THEN ! SSH on tracer grid. 478 ! 479 isz = SIZE( td%ssh0, dim = 1 ) 480 ALLOCATE( mod_tide(isz), phi_tide(isz) ) 481 ! 482 DO itide = 1, nb_harmo 483 DO ib = 1, isz 484 mod_tide(ib)=SQRT( td%ssh0(ib,itide,1)*td%ssh0(ib,itide,1) + td%ssh0(ib,itide,2)*td%ssh0(ib,itide,2) ) 485 phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1)) 486 END DO 487 DO ib = 1, isz 488 mod_tide(ib)=mod_tide(ib)*ftide(itide) 489 phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide) 490 END DO 491 DO ib = 1, isz 492 td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 493 td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 494 END DO 491 495 END DO 492 DO ib = 1 , ilen0(igrd) 493 mod_tide(ib)=mod_tide(ib)*ftide(itide) 494 phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide) 495 ENDDO 496 DO ib = 1 , ilen0(igrd) 497 td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 498 td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 499 ENDDO 500 END DO 501 ! 502 DEALLOCATE( mod_tide, phi_tide ) 496 ! 497 DEALLOCATE( mod_tide, phi_tide ) 498 ! 499 ENDIF 503 500 ! 504 501 END SUBROUTINE tide_init_elevation … … 512 509 TYPE(TIDES_DATA), INTENT(inout) :: td ! tidal harmonics data 513 510 ! 514 INTEGER :: itide, igrd, ib ! dummy loop indices 515 INTEGER, DIMENSION(3) :: ilen0 ! length of boundary data (from OBC arrays) 511 INTEGER :: itide, isz, ib ! dummy loop indices 516 512 REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide 517 513 !!---------------------------------------------------------------------- 518 514 ! 519 ilen0(2) = SIZE(td%u0(:,1,1)) 520 ilen0(3) = SIZE(td%v0(:,1,1)) 521 ! 522 igrd=2 ! U grid. 523 ! 524 ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 525 ! 526 DO itide = 1, nb_harmo 527 DO ib = 1, ilen0(igrd) 528 mod_tide(ib)=SQRT(td%u0(ib,itide,1)**2.+td%u0(ib,itide,2)**2.) 529 phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1)) 515 IF( ASSOCIATED(td%u0) ) THEN ! U grid. we use bdy u2d on this mpi subdomain 516 ! 517 isz = SIZE( td%u0, dim = 1 ) 518 ALLOCATE( mod_tide(isz), phi_tide(isz) ) 519 ! 520 DO itide = 1, nb_harmo 521 DO ib = 1, isz 522 mod_tide(ib)=SQRT( td%u0(ib,itide,1)*td%u0(ib,itide,1) + td%u0(ib,itide,2)*td%u0(ib,itide,2) ) 523 phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1)) 524 END DO 525 DO ib = 1, isz 526 mod_tide(ib)=mod_tide(ib)*ftide(itide) 527 phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide) 528 END DO 529 DO ib = 1, isz 530 td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 531 td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 532 END DO 530 533 END DO 531 DO ib = 1, ilen0(igrd) 532 mod_tide(ib)=mod_tide(ib)*ftide(itide) 533 phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide) 534 ENDDO 535 DO ib = 1, ilen0(igrd) 536 td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 537 td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 538 ENDDO 539 END DO 540 ! 541 DEALLOCATE( mod_tide , phi_tide ) 542 ! 543 igrd=3 ! V grid. 544 ! 545 ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 546 547 DO itide = 1, nb_harmo 548 DO ib = 1, ilen0(igrd) 549 mod_tide(ib)=SQRT(td%v0(ib,itide,1)**2.+td%v0(ib,itide,2)**2.) 550 phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1)) 534 ! 535 DEALLOCATE( mod_tide, phi_tide ) 536 ! 537 ENDIF 538 ! 539 IF( ASSOCIATED(td%v0) ) THEN ! V grid. we use bdy u2d on this mpi subdomain 540 ! 541 isz = SIZE( td%v0, dim = 1 ) 542 ALLOCATE( mod_tide(isz), phi_tide(isz) ) 543 ! 544 DO itide = 1, nb_harmo 545 DO ib = 1, isz 546 mod_tide(ib)=SQRT( td%v0(ib,itide,1)*td%v0(ib,itide,1) + td%v0(ib,itide,2)*td%v0(ib,itide,2) ) 547 phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1)) 548 END DO 549 DO ib = 1, isz 550 mod_tide(ib)=mod_tide(ib)*ftide(itide) 551 phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide) 552 END DO 553 DO ib = 1, isz 554 td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 555 td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 556 END DO 551 557 END DO 552 DO ib = 1, ilen0(igrd) 553 mod_tide(ib)=mod_tide(ib)*ftide(itide) 554 phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide) 555 ENDDO 556 DO ib = 1, ilen0(igrd) 557 td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 558 td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 559 ENDDO 560 END DO 561 ! 562 DEALLOCATE( mod_tide, phi_tide ) 563 ! 564 END SUBROUTINE tide_init_velocities 558 ! 559 DEALLOCATE( mod_tide, phi_tide ) 560 ! 561 ENDIF 562 ! 563 END SUBROUTINE tide_init_velocities 565 564 566 565 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
