Changeset 12910
- Timestamp:
- 2020-05-12T10:21:19+02:00 (5 years ago)
- Location:
- NEMO/releases/r4.0/r4.0-HEAD/src/OCE/BDY
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/releases/r4.0/r4.0-HEAD/src/OCE/BDY/bdydta.F90
r12639 r12910 95 95 INTEGER :: jbdy, jfld, jstart, jend, ib, jl ! dummy loop indices 96 96 INTEGER :: ii, ij, ik, igrd, ipl ! local integers 97 INTEGER, DIMENSION(jpbgrd) :: ilen198 97 TYPE(OBC_DATA) , POINTER :: dta_alias ! short cut 99 98 TYPE(FLD), DIMENSION(:), POINTER :: bf_alias … … 120 119 END DO 121 120 ENDIF 122 IF( dta_bdy(jbdy)%lneed_dyn2d .AND. ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN ! no SIZE with a unassociated pointer121 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 123 122 igrd = 2 124 DO ib = 1, SIZE(dta_bdy(jbdy)%u2d) ! u2d is used only on the rim except if ln_full_vel = T, see bdy_dta_init123 DO ib = 1, SIZE(dta_bdy(jbdy)%u2d) ! u2d is used either over the whole bdy or only on the rim 125 124 ii = idx_bdy(jbdy)%nbi(ib,igrd) 126 125 ij = idx_bdy(jbdy)%nbj(ib,igrd) 127 126 dta_bdy(jbdy)%u2d(ib) = un_b(ii,ij) * umask(ii,ij,1) 128 127 END DO 128 ENDIF 129 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 129 130 igrd = 3 130 DO ib = 1, SIZE(dta_bdy(jbdy)%v2d) ! v2d is used only on the rim except if ln_full_vel = T, see bdy_dta_init131 DO ib = 1, SIZE(dta_bdy(jbdy)%v2d) ! v2d is used either over the whole bdy or only on the rim 131 132 ii = idx_bdy(jbdy)%nbi(ib,igrd) 132 133 ij = idx_bdy(jbdy)%nbj(ib,igrd) … … 214 215 ! 215 216 ! if runoff condition: change river flow we read (in m3/s) into barotropic velocity (m/s) 216 IF( cn_tra(jbdy) == 'runoff' .AND. TRIM(bf_alias(jp_bdyu2d)%clrootname) /= 'NOT USED' ) THEN ! runoff and we read u/v2d217 IF( cn_tra(jbdy) == 'runoff' ) THEN ! runoff 217 218 ! 218 igrd = 2 ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 219 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 220 ii = idx_bdy(jbdy)%nbi(ib,igrd) 221 ij = idx_bdy(jbdy)%nbj(ib,igrd) 222 dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 223 END DO 224 igrd = 3 ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 225 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 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 219 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 220 igrd = 2 ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 221 DO ib = 1, SIZE(dta_alias%u2d) ! u2d is used either over the whole bdy or only on the rim 222 ii = idx_bdy(jbdy)%nbi(ib,igrd) 223 ij = idx_bdy(jbdy)%nbj(ib,igrd) 224 dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 225 END DO 226 ENDIF 227 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 228 igrd = 3 ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 229 DO ib = 1, SIZE(dta_alias%v2d) ! v2d is used either over the whole bdy or only on the rim 230 ii = idx_bdy(jbdy)%nbi(ib,igrd) 231 ij = idx_bdy(jbdy)%nbj(ib,igrd) 232 dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 233 END DO 234 ENDIF 230 235 ENDIF 231 236 232 237 ! tidal harmonic forcing ONLY: initialise arrays 233 238 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! we did not read ssh, u/v2d 234 IF( dta_alias%lneed_ssh .AND.ASSOCIATED(dta_alias%ssh) ) dta_alias%ssh(:) = 0._wp235 IF( dta_alias%lneed_dyn2d .AND.ASSOCIATED(dta_alias%u2d) ) dta_alias%u2d(:) = 0._wp236 IF( dta_alias%lneed_dyn2d .AND.ASSOCIATED(dta_alias%v2d) ) dta_alias%v2d(:) = 0._wp239 IF( ASSOCIATED(dta_alias%ssh) ) dta_alias%ssh(:) = 0._wp 240 IF( ASSOCIATED(dta_alias%u2d) ) dta_alias%u2d(:) = 0._wp 241 IF( ASSOCIATED(dta_alias%v2d) ) dta_alias%v2d(:) = 0._wp 237 242 ENDIF 238 243 … … 340 345 DO jbdy = 1, nb_bdy ! Tidal component added in ts loop 341 346 IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 342 IF( cn_dyn2d(jbdy) == 'frs' ) THEN ; ilen1(:)=idx_bdy(jbdy)%nblen(:) 343 ELSE ; ilen1(:)=idx_bdy(jbdy)%nblenrim(:) 344 ENDIF 345 IF ( dta_bdy(jbdy)%lneed_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 346 IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 347 IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 348 ENDIF 349 END DO 350 ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 351 ! 352 CALL bdy_dta_tides( kt=kt, kt_offset=kt_offset ) 353 ENDIF 354 ENDIF 355 ! 356 IF( ln_timing ) CALL timing_stop('bdy_dta') 357 ! 358 END SUBROUTINE bdy_dta 359 347 IF( ASSOCIATED(dta_bdy(jbdy)%ssh) ) dta_bdy_s(jbdy)%ssh(:) = dta_bdy(jbdy)%ssh(:) 348 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) dta_bdy_s(jbdy)%u2d(:) = dta_bdy(jbdy)%u2d(:) 349 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) dta_bdy_s(jbdy)%v2d(:) = dta_bdy(jbdy)%v2d(:) 350 ENDIF 351 END DO 352 ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 353 ! 354 CALL bdy_dta_tides( kt=kt, kt_offset=kt_offset ) 355 ENDIF 356 ENDIF 357 ! 358 IF( ln_timing ) CALL timing_stop('bdy_dta') 359 ! 360 END SUBROUTINE bdy_dta 361 360 362 361 363 SUBROUTINE bdy_dta_init … … 387 389 LOGICAL :: llneed ! 388 390 LOGICAL :: llread ! 391 LOGICAL :: llfullbdy ! 389 392 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_tem, bn_sal, bn_u3d, bn_v3d ! must be an array to be used with fld_fill 390 393 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read … … 487 490 igrd = 2 ! U point 488 491 ipk = 1 ! surface data 489 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)% sshwill be needed492 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%u2d will be needed 490 493 llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get u2d from u3d and read NetCDF file 491 494 bf_alias => bf(jp_bdyu2d,jbdy:jbdy) ! alias for u2d structure of bdy number jbdy 492 495 bn_alias => bn_u2d ! alias for u2d structure of nambdy_dta 493 IF( ln_full_vel ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) ! will be computed from u3d -> need on the full bdy 494 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) ! used only on the rim 496 llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs' ! need u2d over the whole bdy or only over the rim? 497 IF( llfullbdy ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) 498 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) 495 499 ENDIF 496 500 ENDIF … … 499 503 igrd = 3 ! V point 500 504 ipk = 1 ! surface data 501 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)% sshwill be needed505 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%v2d will be needed 502 506 llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get v2d from v3d and read NetCDF file 503 507 bf_alias => bf(jp_bdyv2d,jbdy:jbdy) ! alias for v2d structure of bdy number jbdy 504 508 bn_alias => bn_v2d ! alias for v2d structure of nambdy_dta 505 IF( ln_full_vel ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) ! will be computed from v3d -> need on the full bdy 506 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) ! used only on the rim 509 llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs' ! need v2d over the whole bdy or only over the rim? 510 IF( llfullbdy ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) 511 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) 507 512 ENDIF 508 513 ENDIF -
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.