Changeset 12921
- Timestamp:
- 2020-05-14T09:51:23+02:00 (5 years ago)
- Location:
- NEMO/trunk/src/OCE/BDY
- Files:
-
- 3 edited
-
bdydta.F90 (modified) (8 diffs)
-
bdyini.F90 (modified) (2 diffs)
-
bdytides.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/BDY/bdydta.F90
r12638 r12921 91 91 INTEGER :: jbdy, jfld, jstart, jend, ib, jl ! dummy loop indices 92 92 INTEGER :: ii, ij, ik, igrd, ipl ! local integers 93 INTEGER, DIMENSION(jpbgrd) :: ilen194 93 TYPE(OBC_DATA) , POINTER :: dta_alias ! short cut 95 94 TYPE(FLD), DIMENSION(:), POINTER :: bf_alias … … 116 115 END DO 117 116 ENDIF 118 IF( dta_bdy(jbdy)%lneed_dyn2d .AND. ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN ! no SIZE with a unassociated pointer117 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 119 118 igrd = 2 120 DO ib = 1, SIZE(dta_bdy(jbdy)%u2d) ! u2d is used only on the rim except if ln_full_vel = T, see bdy_dta_init119 DO ib = 1, SIZE(dta_bdy(jbdy)%u2d) ! u2d is used either over the whole bdy or only on the rim 121 120 ii = idx_bdy(jbdy)%nbi(ib,igrd) 122 121 ij = idx_bdy(jbdy)%nbj(ib,igrd) 123 122 dta_bdy(jbdy)%u2d(ib) = uu_b(ii,ij,Kmm) * umask(ii,ij,1) 124 123 END DO 124 ENDIF 125 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 125 126 igrd = 3 126 DO ib = 1, SIZE(dta_bdy(jbdy)%v2d) ! v2d is used only on the rim except if ln_full_vel = T, see bdy_dta_init127 DO ib = 1, SIZE(dta_bdy(jbdy)%v2d) ! v2d is used either over the whole bdy or only on the rim 127 128 ii = idx_bdy(jbdy)%nbi(ib,igrd) 128 129 ij = idx_bdy(jbdy)%nbj(ib,igrd) … … 210 211 ! 211 212 ! if runoff condition: change river flow we read (in m3/s) into barotropic velocity (m/s) 212 IF( cn_tra(jbdy) == 'runoff' .AND. TRIM(bf_alias(jp_bdyu2d)%clrootname) /= 'NOT USED' ) THEN ! runoff and we read u/v2d213 IF( cn_tra(jbdy) == 'runoff' ) THEN ! runoff 213 214 ! 214 igrd = 2 ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 215 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 216 ii = idx_bdy(jbdy)%nbi(ib,igrd) 217 ij = idx_bdy(jbdy)%nbj(ib,igrd) 218 dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 219 END DO 220 igrd = 3 ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 221 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 222 ii = idx_bdy(jbdy)%nbi(ib,igrd) 223 ij = idx_bdy(jbdy)%nbj(ib,igrd) 224 dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 225 END DO 215 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 216 igrd = 2 ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 217 DO ib = 1, SIZE(dta_alias%u2d) ! u2d is used either over the whole bdy or only on the rim 218 ii = idx_bdy(jbdy)%nbi(ib,igrd) 219 ij = idx_bdy(jbdy)%nbj(ib,igrd) 220 dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 221 END DO 222 ENDIF 223 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 224 igrd = 3 ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 225 DO ib = 1, SIZE(dta_alias%v2d) ! v2d is used either over the whole bdy or only on the rim 226 ii = idx_bdy(jbdy)%nbi(ib,igrd) 227 ij = idx_bdy(jbdy)%nbj(ib,igrd) 228 dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 229 END DO 230 ENDIF 226 231 ENDIF 227 232 228 233 ! tidal harmonic forcing ONLY: initialise arrays 229 234 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! we did not read ssh, u/v2d 230 IF( dta_alias%lneed_ssh .AND.ASSOCIATED(dta_alias%ssh) ) dta_alias%ssh(:) = 0._wp231 IF( dta_alias%lneed_dyn2d .AND.ASSOCIATED(dta_alias%u2d) ) dta_alias%u2d(:) = 0._wp232 IF( dta_alias%lneed_dyn2d .AND.ASSOCIATED(dta_alias%v2d) ) dta_alias%v2d(:) = 0._wp235 IF( ASSOCIATED(dta_alias%ssh) ) dta_alias%ssh(:) = 0._wp 236 IF( ASSOCIATED(dta_alias%u2d) ) dta_alias%u2d(:) = 0._wp 237 IF( ASSOCIATED(dta_alias%v2d) ) dta_alias%v2d(:) = 0._wp 233 238 ENDIF 234 239 … … 330 335 DO jbdy = 1, nb_bdy ! Tidal component added in ts loop 331 336 IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 332 IF( cn_dyn2d(jbdy) == 'frs' ) THEN ; ilen1(:)=idx_bdy(jbdy)%nblen(:) 333 ELSE ; ilen1(:)=idx_bdy(jbdy)%nblenrim(:) 334 ENDIF 335 IF ( dta_bdy(jbdy)%lneed_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 336 IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 337 IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 337 IF( ASSOCIATED(dta_bdy(jbdy)%ssh) ) dta_bdy_s(jbdy)%ssh(:) = dta_bdy(jbdy)%ssh(:) 338 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) dta_bdy_s(jbdy)%u2d(:) = dta_bdy(jbdy)%u2d(:) 339 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) dta_bdy_s(jbdy)%v2d(:) = dta_bdy(jbdy)%v2d(:) 338 340 ENDIF 339 341 END DO 340 342 ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 341 343 ! 342 ! BDY: use pt_offset=1.0 as applied at the end of the step and bdy_dta_tides is referenced at the middle of the step343 344 CALL bdy_dta_tides( kt=kt, pt_offset = 1._wp ) 344 345 ENDIF … … 348 349 ! 349 350 END SUBROUTINE bdy_dta 350 351 351 352 352 353 SUBROUTINE bdy_dta_init … … 380 381 LOGICAL :: llneed ! 381 382 LOGICAL :: llread ! 383 LOGICAL :: llfullbdy ! 382 384 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_tem, bn_sal, bn_u3d, bn_v3d ! must be an array to be used with fld_fill 383 385 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read … … 494 496 igrd = 2 ! U point 495 497 ipk = 1 ! surface data 496 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)% sshwill be needed498 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%u2d will be needed 497 499 llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get u2d from u3d and read NetCDF file 498 500 bf_alias => bf(jp_bdyu2d,jbdy:jbdy) ! alias for u2d structure of bdy number jbdy 499 501 bn_alias => bn_u2d ! alias for u2d structure of nambdy_dta 500 IF( ln_full_vel ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) ! will be computed from u3d -> need on the full bdy 501 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) ! used only on the rim 502 llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs' ! need u2d over the whole bdy or only over the rim? 503 IF( llfullbdy ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) 504 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) 502 505 ENDIF 503 506 ENDIF … … 506 509 igrd = 3 ! V point 507 510 ipk = 1 ! surface data 508 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)% sshwill be needed511 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%v2d will be needed 509 512 llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get v2d from v3d and read NetCDF file 510 513 bf_alias => bf(jp_bdyv2d,jbdy:jbdy) ! alias for v2d structure of bdy number jbdy 511 514 bn_alias => bn_v2d ! alias for v2d structure of nambdy_dta 512 IF( ln_full_vel ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) ! will be computed from v3d -> need on the full bdy 513 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) ! used only on the rim 515 llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs' ! need v2d over the whole bdy or only over the rim? 516 IF( llfullbdy ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) 517 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) 514 518 ENDIF 515 519 ENDIF -
NEMO/trunk/src/OCE/BDY/bdyini.F90
r12377 r12921 19 19 USE oce ! ocean dynamics and tracers variables 20 20 USE dom_oce ! ocean space and time domain 21 USE sbc_oce , ONLY: nn_ice 21 22 USE bdy_oce ! unstructured open boundary conditions 22 23 USE bdydta ! open boundary cond. setting (bdy_dta_init routine) 23 24 USE bdytides ! open boundary cond. setting (bdytide_init routine) 24 25 USE tide_mod, ONLY: ln_tide ! tidal forcing 25 USE phycst 26 USE phycst , ONLY: rday 26 27 ! 27 28 USE in_out_manager ! I/O units … … 315 316 316 317 dta_bdy(ib_bdy)%lneed_ice = cn_ice(ib_bdy) /= 'none' 318 319 IF( dta_bdy(ib_bdy)%lneed_ice .AND. nn_ice /= 2 ) THEN 320 WRITE(ctmp1,*) 'bdy number ', ib_bdy,', needs ice model but nn_ice = ', nn_ice 321 CALL ctl_stop( ctmp1 ) 322 ENDIF 317 323 318 324 IF( lwp .AND. dta_bdy(ib_bdy)%lneed_ice ) THEN -
NEMO/trunk/src/OCE/BDY/bdytides.F90
r12489 r12921 65 65 !! namelist variables 66 66 !!------------------- 67 CHARACTER(len=80) :: filtide ! :Filename root for tidal input files68 LOGICAL :: ln_bdytide_2ddta ! :If true, read 2d harmonic data67 CHARACTER(len=80) :: filtide ! Filename root for tidal input files 68 LOGICAL :: ln_bdytide_2ddta ! If true, read 2d harmonic data 69 69 !! 70 INTEGER :: ib_bdy, itide, ib ! :dummy loop indices71 INTEGER :: ii, ij ! :dummy loop indices70 INTEGER :: ib_bdy, itide, ib ! dummy loop indices 71 INTEGER :: ii, ij ! dummy loop indices 72 72 INTEGER :: inum, igrd 73 INTEGER , DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays)73 INTEGER :: isz ! bdy data size 74 74 INTEGER :: ios ! Local integer output status for namelist read 75 75 INTEGER :: nbdy_rdstart, nbdy_loc 76 CHARACTER(LEN=50) :: cerrmsg ! :error string77 CHARACTER(len=80) :: clfile ! :full file name for tidal input file78 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: dta_read ! :work space to read in tidal harmonics data79 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: ztr, zti ! :" " " " " " " "76 CHARACTER(LEN=50) :: cerrmsg ! error string 77 CHARACTER(len=80) :: clfile ! full file name for tidal input file 78 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: dta_read ! work space to read in tidal harmonics data 79 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: ztr, zti ! " " " " " " " " 80 80 !! 81 TYPE(TIDES_DATA), POINTER :: td !: local short cut 81 TYPE(TIDES_DATA), POINTER :: td ! local short cut 82 TYPE( OBC_DATA), POINTER :: dta ! local short cut 82 83 !! 83 84 NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta … … 93 94 IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 94 95 ! 95 td => tides(ib_bdy) 96 96 td => tides(ib_bdy) 97 dta => dta_bdy(ib_bdy) 98 97 99 ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries 98 100 filtide(:) = '' … … 130 132 IF(lwp) WRITE(numout,*) ' ' 131 133 132 ! Allocate space for tidal harmonics data - get size from OBC data arrays 134 ! Allocate space for tidal harmonics data - get size from BDY data arrays 135 ! Allocate also slow varying data in the case of time splitting: 136 ! Do it anyway because at this stage knowledge of free surface scheme is unknown 133 137 ! ----------------------------------------------------------------------- 134 135 ! JC: If FRS scheme is used, we assume that tidal is needed over the whole 136 ! relaxation area 137 IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN ; ilen0(:) = idx_bdy(ib_bdy)%nblen (:) 138 ELSE ; ilen0(:) = idx_bdy(ib_bdy)%nblenrim(:) 139 ENDIF 140 141 ALLOCATE( td%ssh0( ilen0(1), nb_harmo, 2 ) ) 142 ALLOCATE( td%ssh ( ilen0(1), nb_harmo, 2 ) ) 143 144 ALLOCATE( td%u0( ilen0(2), nb_harmo, 2 ) ) 145 ALLOCATE( td%u ( ilen0(2), nb_harmo, 2 ) ) 146 147 ALLOCATE( td%v0( ilen0(3), nb_harmo, 2 ) ) 148 ALLOCATE( td%v ( ilen0(3), nb_harmo, 2 ) ) 149 150 td%ssh0(:,:,:) = 0._wp 151 td%ssh (:,:,:) = 0._wp 152 td%u0 (:,:,:) = 0._wp 153 td%u (:,:,:) = 0._wp 154 td%v0 (:,:,:) = 0._wp 155 td%v (:,:,:) = 0._wp 156 138 IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain 139 isz = SIZE(dta%ssh) 140 ALLOCATE( td%ssh0( isz, nb_harmo, 2 ), td%ssh( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%ssh( isz ) ) 141 dta_bdy_s(ib_bdy)%ssh(:) = 0._wp ! needed? 142 ENDIF 143 IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain 144 isz = SIZE(dta%u2d) 145 ALLOCATE( td%u0 ( isz, nb_harmo, 2 ), td%u ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%u2d( isz ) ) 146 dta_bdy_s(ib_bdy)%u2d(:) = 0._wp ! needed? 147 ENDIF 148 IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain 149 isz = SIZE(dta%v2d) 150 ALLOCATE( td%v0 ( isz, nb_harmo, 2 ), td%v ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%v2d( isz ) ) 151 dta_bdy_s(ib_bdy)%v2d(:) = 0._wp ! needed? 152 ENDIF 153 154 ! fill td%ssh0, td%u0, td%v0 155 ! ----------------------------------------------------------------------- 157 156 IF( ln_bdytide_2ddta ) THEN 157 ! 158 158 ! It is assumed that each data file contains all complex harmonic amplitudes 159 159 ! given on the global domain (ie global, jpiglo x jpjglo) … … 162 162 ! 163 163 ! SSH fields 164 clfile = TRIM(filtide)//'_grid_T.nc' 165 CALL iom_open( clfile , inum ) 166 igrd = 1 ! Everything is at T-points here 167 DO itide = 1, nb_harmo 168 CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 169 CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) ) 170 DO ib = 1, ilen0(igrd) 171 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 172 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 173 IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj ) CYCLE ! to remove? 174 td%ssh0(ib,itide,1) = ztr(ii,ij) 175 td%ssh0(ib,itide,2) = zti(ii,ij) 176 END DO 177 END DO 178 CALL iom_close( inum ) 164 IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain 165 clfile = TRIM(filtide)//'_grid_T.nc' 166 CALL iom_open( clfile , inum ) 167 igrd = 1 ! Everything is at T-points here 168 DO itide = 1, nb_harmo 169 CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 170 CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) ) 171 DO ib = 1, SIZE(dta%ssh) 172 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 173 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 174 td%ssh0(ib,itide,1) = ztr(ii,ij) 175 td%ssh0(ib,itide,2) = zti(ii,ij) 176 END DO 177 END DO 178 CALL iom_close( inum ) 179 ENDIF 179 180 ! 180 181 ! U fields 181 clfile = TRIM(filtide)//'_grid_U.nc' 182 CALL iom_open( clfile , inum ) 183 igrd = 2 ! Everything is at U-points here 184 DO itide = 1, nb_harmo 185 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:) ) 186 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:) ) 187 DO ib = 1, ilen0(igrd) 188 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 189 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 190 IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj ) CYCLE ! to remove? 191 td%u0(ib,itide,1) = ztr(ii,ij) 192 td%u0(ib,itide,2) = zti(ii,ij) 193 END DO 194 END DO 195 CALL iom_close( inum ) 182 IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain 183 clfile = TRIM(filtide)//'_grid_U.nc' 184 CALL iom_open( clfile , inum ) 185 igrd = 2 ! Everything is at U-points here 186 DO itide = 1, nb_harmo 187 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:) ) 188 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:) ) 189 DO ib = 1, SIZE(dta%u2d) 190 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 191 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 192 td%u0(ib,itide,1) = ztr(ii,ij) 193 td%u0(ib,itide,2) = zti(ii,ij) 194 END DO 195 END DO 196 CALL iom_close( inum ) 197 ENDIF 196 198 ! 197 199 ! V fields 198 clfile = TRIM(filtide)//'_grid_V.nc' 199 CALL iom_open( clfile , inum ) 200 igrd = 3 ! Everything is at V-points here 201 DO itide = 1, nb_harmo 202 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:) ) 203 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:) ) 204 DO ib = 1, ilen0(igrd) 205 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 206 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 207 IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj ) CYCLE ! to remove? 208 td%v0(ib,itide,1) = ztr(ii,ij) 209 td%v0(ib,itide,2) = zti(ii,ij) 210 END DO 211 END DO 212 CALL iom_close( inum ) 200 IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain 201 clfile = TRIM(filtide)//'_grid_V.nc' 202 CALL iom_open( clfile , inum ) 203 igrd = 3 ! Everything is at V-points here 204 DO itide = 1, nb_harmo 205 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:) ) 206 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:) ) 207 DO ib = 1, SIZE(dta%v2d) 208 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 209 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 210 td%v0(ib,itide,1) = ztr(ii,ij) 211 td%v0(ib,itide,2) = zti(ii,ij) 212 END DO 213 END DO 214 CALL iom_close( inum ) 215 ENDIF 213 216 ! 214 217 DEALLOCATE( ztr, zti ) … … 218 221 ! Read tidal data only on bdy segments 219 222 ! 220 ALLOCATE( dta_read( MAXVAL( ilen0(1:3)), 1, 1 ) )223 ALLOCATE( dta_read( MAXVAL( idx_bdy(ib_bdy)%nblen(:) ), 1, 1 ) ) 221 224 ! 222 225 ! Open files and read in tidal forcing data … … 225 228 DO itide = 1, nb_harmo 226 229 ! ! SSH fields 227 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_T.nc' 228 CALL iom_open( clfile, inum ) 229 CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 230 td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1) 231 CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 232 td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1) 233 CALL iom_close( inum ) 230 IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain 231 isz = SIZE(dta%ssh) 232 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_T.nc' 233 CALL iom_open( clfile, inum ) 234 CALL fld_map( inum, 'z1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 235 td%ssh0(:,itide,1) = dta_read(1:isz,1,1) 236 CALL fld_map( inum, 'z2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 237 td%ssh0(:,itide,2) = dta_read(1:isz,1,1) 238 CALL iom_close( inum ) 239 ENDIF 234 240 ! ! U fields 235 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_U.nc' 236 CALL iom_open( clfile, inum ) 237 CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 238 td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1) 239 CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 240 td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1) 241 CALL iom_close( inum ) 241 IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain 242 isz = SIZE(dta%u2d) 243 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_U.nc' 244 CALL iom_open( clfile, inum ) 245 CALL fld_map( inum, 'u1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 246 td%u0(:,itide,1) = dta_read(1:isz,1,1) 247 CALL fld_map( inum, 'u2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 248 td%u0(:,itide,2) = dta_read(1:isz,1,1) 249 CALL iom_close( inum ) 250 ENDIF 242 251 ! ! V fields 243 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_V.nc' 244 CALL iom_open( clfile, inum ) 245 CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 246 td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1) 247 CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 248 td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1) 249 CALL iom_close( inum ) 252 IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain 253 isz = SIZE(dta%v2d) 254 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_V.nc' 255 CALL iom_open( clfile, inum ) 256 CALL fld_map( inum, 'v1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 257 td%v0(:,itide,1) = dta_read(1:isz,1,1) 258 CALL fld_map( inum, 'v2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 259 td%v0(:,itide,2) = dta_read(1:isz,1,1) 260 CALL iom_close( inum ) 261 ENDIF 250 262 ! 251 263 END DO ! end loop on tidal components … … 254 266 ! 255 267 ENDIF ! ln_bdytide_2ddta=.true. 256 !257 ! Allocate slow varying data in the case of time splitting:258 ! Do it anyway because at this stage knowledge of free surface scheme is unknown259 ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) )260 ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) )261 ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) )262 dta_bdy_s(ib_bdy)%ssh(:) = 0._wp263 dta_bdy_s(ib_bdy)%u2d(:) = 0._wp264 dta_bdy_s(ib_bdy)%v2d(:) = 0._wp265 268 ! 266 269 ENDIF ! nn_dyn2d_dta(ib_bdy) >= 2 … … 283 286 ! 284 287 LOGICAL :: lk_first_btstp ! =.TRUE. if time splitting and first barotropic step 285 INTEGER :: itide, ib_bdy, ib, igrd ! loop indices 286 INTEGER, DIMENSION(jpbgrd) :: ilen0 287 INTEGER, DIMENSION(1:jpbgrd) :: nblen, nblenrim ! short cuts 288 INTEGER :: itide, ib_bdy, ib ! loop indices 288 289 REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist, zt_offset 289 290 !!---------------------------------------------------------------------- … … 310 311 IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 311 312 ! 312 nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd)313 nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd)314 !315 IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN ; ilen0(:) = nblen (:)316 ELSE ; ilen0(:) = nblenrim(:)317 ENDIF318 !319 313 ! We refresh nodal factors every day below 320 314 ! This should be done somewhere else … … 337 331 ! If time splitting, initialize arrays from slow varying open boundary data: 338 332 IF ( PRESENT(kit) ) THEN 339 IF ( dta_bdy(ib_bdy)%lneed_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1))340 IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2))341 IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3))333 IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) dta_bdy(ib_bdy)%ssh(:) = dta_bdy_s(ib_bdy)%ssh(:) 334 IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) dta_bdy(ib_bdy)%u2d(:) = dta_bdy_s(ib_bdy)%u2d(:) 335 IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) dta_bdy(ib_bdy)%v2d(:) = dta_bdy_s(ib_bdy)%v2d(:) 342 336 ENDIF 343 337 ! … … 349 343 z_sist = zramp * SIN( z_sarg ) 350 344 ! 351 IF ( dta_bdy(ib_bdy)%lneed_ssh ) THEN 352 igrd=1 ! SSH on tracer grid 353 DO ib = 1, ilen0(igrd) 345 IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) THEN ! SSH on tracer grid 346 DO ib = 1, SIZE(dta_bdy(ib_bdy)%ssh) 354 347 dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + & 355 348 & ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + & … … 358 351 ENDIF 359 352 ! 360 IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) THEN 361 igrd=2 ! U grid 362 DO ib = 1, ilen0(igrd) 353 IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) THEN ! U grid 354 DO ib = 1, SIZE(dta_bdy(ib_bdy)%u2d) 363 355 dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + & 364 356 & ( tides(ib_bdy)%u(ib,itide,1)*z_cost + & 365 357 & tides(ib_bdy)%u(ib,itide,2)*z_sist ) 366 358 END DO 367 igrd=3 ! V grid 368 DO ib = 1, ilen0(igrd) 359 ENDIF 360 ! 361 IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) THEN ! V grid 362 DO ib = 1, SIZE(dta_bdy(ib_bdy)%v2d) 369 363 dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + & 370 364 & ( tides(ib_bdy)%v(ib,itide,1)*z_cost + & … … 372 366 END DO 373 367 ENDIF 368 ! 374 369 END DO 375 END 370 ENDIF 376 371 END DO 377 372 ! … … 386 381 TYPE(TIDES_DATA), INTENT(inout) :: td ! tidal harmonics data 387 382 ! 388 INTEGER :: itide, igrd, ib ! dummy loop indices 389 INTEGER, DIMENSION(1) :: ilen0 ! length of boundary data (from OBC arrays) 383 INTEGER :: itide, isz, ib ! dummy loop indices 390 384 REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide 391 385 !!---------------------------------------------------------------------- 392 386 ! 393 igrd=1 394 ! SSH on tracer grid. 395 ilen0(1) = SIZE(td%ssh0(:,1,1)) 396 ! 397 ALLOCATE( mod_tide(ilen0(igrd)), phi_tide(ilen0(igrd)) ) 398 ! 399 DO itide = 1, nb_harmo 400 DO ib = 1, ilen0(igrd) 401 mod_tide(ib)=SQRT(td%ssh0(ib,itide,1)**2.+td%ssh0(ib,itide,2)**2.) 402 phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1)) 387 IF( ASSOCIATED(td%ssh0) ) THEN ! SSH on tracer grid. 388 ! 389 isz = SIZE( td%ssh0, dim = 1 ) 390 ALLOCATE( mod_tide(isz), phi_tide(isz) ) 391 ! 392 DO itide = 1, nb_harmo 393 DO ib = 1, isz 394 mod_tide(ib)=SQRT( td%ssh0(ib,itide,1)*td%ssh0(ib,itide,1) + td%ssh0(ib,itide,2)*td%ssh0(ib,itide,2) ) 395 phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1)) 396 END DO 397 DO ib = 1, isz 398 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 399 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0+tide_harmonics(itide)%u 400 END DO 401 DO ib = 1, isz 402 td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 403 td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 404 END DO 403 405 END DO 404 DO ib = 1 , ilen0(igrd) 405 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 406 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0+tide_harmonics(itide)%u 407 ENDDO 408 DO ib = 1 , ilen0(igrd) 409 td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 410 td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 411 ENDDO 412 END DO 413 ! 414 DEALLOCATE( mod_tide, phi_tide ) 406 ! 407 DEALLOCATE( mod_tide, phi_tide ) 408 ! 409 ENDIF 415 410 ! 416 411 END SUBROUTINE tide_init_elevation … … 424 419 TYPE(TIDES_DATA), INTENT(inout) :: td ! tidal harmonics data 425 420 ! 426 INTEGER :: itide, igrd, ib ! dummy loop indices 427 INTEGER, DIMENSION(3) :: ilen0 ! length of boundary data (from OBC arrays) 421 INTEGER :: itide, isz, ib ! dummy loop indices 428 422 REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide 429 423 !!---------------------------------------------------------------------- 430 424 ! 431 ilen0(2) = SIZE(td%u0(:,1,1)) 432 ilen0(3) = SIZE(td%v0(:,1,1)) 433 ! 434 igrd=2 ! U grid. 435 ! 436 ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 437 ! 438 DO itide = 1, nb_harmo 439 DO ib = 1, ilen0(igrd) 440 mod_tide(ib)=SQRT(td%u0(ib,itide,1)**2.+td%u0(ib,itide,2)**2.) 441 phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1)) 425 IF( ASSOCIATED(td%u0) ) THEN ! U grid. we use bdy u2d on this mpi subdomain 426 ! 427 isz = SIZE( td%u0, dim = 1 ) 428 ALLOCATE( mod_tide(isz), phi_tide(isz) ) 429 ! 430 DO itide = 1, nb_harmo 431 DO ib = 1, isz 432 mod_tide(ib)=SQRT( td%u0(ib,itide,1)*td%u0(ib,itide,1) + td%u0(ib,itide,2)*td%u0(ib,itide,2) ) 433 phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1)) 434 END DO 435 DO ib = 1, isz 436 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 437 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 438 END DO 439 DO ib = 1, isz 440 td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 441 td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 442 END DO 442 443 END DO 443 DO ib = 1, ilen0(igrd) 444 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 445 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 446 ENDDO 447 DO ib = 1, ilen0(igrd) 448 td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 449 td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 450 ENDDO 451 END DO 452 ! 453 DEALLOCATE( mod_tide , phi_tide ) 454 ! 455 igrd=3 ! V grid. 456 ! 457 ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 458 459 DO itide = 1, nb_harmo 460 DO ib = 1, ilen0(igrd) 461 mod_tide(ib)=SQRT(td%v0(ib,itide,1)**2.+td%v0(ib,itide,2)**2.) 462 phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1)) 444 ! 445 DEALLOCATE( mod_tide, phi_tide ) 446 ! 447 ENDIF 448 ! 449 IF( ASSOCIATED(td%v0) ) THEN ! V grid. we use bdy u2d on this mpi subdomain 450 ! 451 isz = SIZE( td%v0, dim = 1 ) 452 ALLOCATE( mod_tide(isz), phi_tide(isz) ) 453 ! 454 DO itide = 1, nb_harmo 455 DO ib = 1, isz 456 mod_tide(ib)=SQRT( td%v0(ib,itide,1)*td%v0(ib,itide,1) + td%v0(ib,itide,2)*td%v0(ib,itide,2) ) 457 phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1)) 458 END DO 459 DO ib = 1, isz 460 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 461 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 462 END DO 463 DO ib = 1, isz 464 td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 465 td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 466 END DO 463 467 END DO 464 DO ib = 1, ilen0(igrd) 465 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 466 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 467 ENDDO 468 DO ib = 1, ilen0(igrd) 469 td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 470 td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 471 ENDDO 472 END DO 473 ! 474 DEALLOCATE( mod_tide, phi_tide ) 475 ! 476 END SUBROUTINE tide_init_velocities 468 ! 469 DEALLOCATE( mod_tide, phi_tide ) 470 ! 471 ENDIF 472 ! 473 END SUBROUTINE tide_init_velocities 477 474 478 475 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
