Changeset 12910 for NEMO/releases/r4.0/r4.0-HEAD/src/OCE/BDY/bdydta.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/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
Note: See TracChangeset
for help on using the changeset viewer.