- Timestamp:
- 2020-06-24T14:38:26+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/OCE/BDY/bdydta.F90
r12396 r13151 70 70 !! * Substitutions 71 71 # include "do_loop_substitute.h90" 72 # include "domzgr_substitute.h90" 72 73 !!---------------------------------------------------------------------- 73 74 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 92 93 INTEGER :: ii, ij, ik, igrd, ipl ! local integers 93 94 INTEGER, DIMENSION(jpbgrd) :: ilen1 94 INTEGER, DIMENSION(:), POINTER :: nblen, nblenrim ! short cuts95 95 TYPE(OBC_DATA) , POINTER :: dta_alias ! short cut 96 96 TYPE(FLD), DIMENSION(:), POINTER :: bf_alias … … 108 108 DO jbdy = 1, nb_bdy 109 109 ! 110 nblen => idx_bdy(jbdy)%nblen111 nblenrim => idx_bdy(jbdy)%nblenrim112 !113 110 IF( nn_dyn2d_dta(jbdy) == 0 ) THEN 114 ilen1(:) = nblen(:)115 111 IF( dta_bdy(jbdy)%lneed_ssh ) THEN 116 112 igrd = 1 117 DO ib = 1, i len1(igrd)113 DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd) ! ssh is allocated and used only on the rim 118 114 ii = idx_bdy(jbdy)%nbi(ib,igrd) 119 115 ij = idx_bdy(jbdy)%nbj(ib,igrd) … … 121 117 END DO 122 118 ENDIF 123 IF( dta_bdy(jbdy)%lneed_dyn2d ) THEN119 IF( dta_bdy(jbdy)%lneed_dyn2d .AND. ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN ! no SIZE with a unassociated pointer 124 120 igrd = 2 125 DO ib = 1, ilen1(igrd)121 DO ib = 1, SIZE(dta_bdy(jbdy)%u2d) ! u2d is used only on the rim except if ln_full_vel = T, see bdy_dta_init 126 122 ii = idx_bdy(jbdy)%nbi(ib,igrd) 127 123 ij = idx_bdy(jbdy)%nbj(ib,igrd) … … 129 125 END DO 130 126 igrd = 3 131 DO ib = 1, ilen1(igrd)127 DO ib = 1, SIZE(dta_bdy(jbdy)%v2d) ! v2d is used only on the rim except if ln_full_vel = T, see bdy_dta_init 132 128 ii = idx_bdy(jbdy)%nbi(ib,igrd) 133 129 ij = idx_bdy(jbdy)%nbj(ib,igrd) … … 138 134 ! 139 135 IF( nn_dyn3d_dta(jbdy) == 0 ) THEN 140 ilen1(:) = nblen(:)141 136 IF( dta_bdy(jbdy)%lneed_dyn3d ) THEN 142 137 igrd = 2 143 DO ib = 1, i len1(igrd)138 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 144 139 DO ik = 1, jpkm1 145 140 ii = idx_bdy(jbdy)%nbi(ib,igrd) … … 149 144 END DO 150 145 igrd = 3 151 DO ib = 1, i len1(igrd)146 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 152 147 DO ik = 1, jpkm1 153 148 ii = idx_bdy(jbdy)%nbi(ib,igrd) … … 160 155 161 156 IF( nn_tra_dta(jbdy) == 0 ) THEN 162 ilen1(:) = nblen(:)163 157 IF( dta_bdy(jbdy)%lneed_tra ) THEN 164 158 igrd = 1 165 DO ib = 1, i len1(igrd)159 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 166 160 DO ik = 1, jpkm1 167 161 ii = idx_bdy(jbdy)%nbi(ib,igrd) … … 176 170 #if defined key_si3 177 171 IF( nn_ice_dta(jbdy) == 0 ) THEN ! set ice to initial values 178 ilen1(:) = nblen(:)179 172 IF( dta_bdy(jbdy)%lneed_ice ) THEN 180 173 igrd = 1 181 174 DO jl = 1, jpl 182 DO ib = 1, i len1(igrd)175 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 183 176 ii = idx_bdy(jbdy)%nbi(ib,igrd) 184 177 ij = idx_bdy(jbdy)%nbj(ib,igrd) … … 236 229 ! tidal harmonic forcing ONLY: initialise arrays 237 230 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! we did not read ssh, u/v2d 238 IF( dta_alias%lneed_ssh ) dta_alias%ssh(:) = 0._wp239 IF( dta_alias%lneed_dyn2d ) dta_alias%u2d(:) = 0._wp240 IF( dta_alias%lneed_dyn2d ) dta_alias%v2d(:) = 0._wp231 IF( dta_alias%lneed_ssh .AND. ASSOCIATED(dta_alias%ssh) ) dta_alias%ssh(:) = 0._wp 232 IF( dta_alias%lneed_dyn2d .AND. ASSOCIATED(dta_alias%u2d) ) dta_alias%u2d(:) = 0._wp 233 IF( dta_alias%lneed_dyn2d .AND. ASSOCIATED(dta_alias%v2d) ) dta_alias%v2d(:) = 0._wp 241 234 ENDIF 242 235 … … 245 238 ! 246 239 igrd = 2 ! zonal velocity 247 dta_alias%u2d(:) = 0._wp ! compute barotrope zonal velocity and put it in u2d248 240 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 249 241 ii = idx_bdy(jbdy)%nbi(ib,igrd) 250 242 ij = idx_bdy(jbdy)%nbj(ib,igrd) 243 dta_alias%u2d(ib) = 0._wp ! compute barotrope zonal velocity and put it in u2d 251 244 DO ik = 1, jpkm1 252 dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 245 dta_alias%u2d(ib) = dta_alias%u2d(ib) & 246 & + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 253 247 END DO 254 248 dta_alias%u2d(ib) = dta_alias%u2d(ib) * r1_hu(ii,ij,Kmm) … … 258 252 END DO 259 253 igrd = 3 ! meridional velocity 260 dta_alias%v2d(:) = 0._wp ! compute barotrope meridional velocity and put it in v2d261 254 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 262 255 ii = idx_bdy(jbdy)%nbi(ib,igrd) 263 256 ij = idx_bdy(jbdy)%nbj(ib,igrd) 257 dta_alias%v2d(ib) = 0._wp ! compute barotrope meridional velocity and put it in v2d 264 258 DO ik = 1, jpkm1 265 dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 259 dta_alias%v2d(ib) = dta_alias%v2d(ib) & 260 & + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 266 261 END DO 267 262 dta_alias%v2d(ib) = dta_alias%v2d(ib) * r1_hv(ii,ij,Kmm) … … 283 278 284 279 #if defined key_si3 285 IF( dta_alias%lneed_ice ) THEN280 IF( dta_alias%lneed_ice .AND. idx_bdy(jbdy)%nblen(1) > 0 ) THEN 286 281 ! fill temperature and salinity arrays 287 282 IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyt_i)%fnow(:,1,:) = rice_tem (jbdy) … … 338 333 DO jbdy = 1, nb_bdy ! Tidal component added in ts loop 339 334 IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 340 nblen => idx_bdy(jbdy)%nblen 341 nblenrim => idx_bdy(jbdy)%nblenrim 342 IF( cn_dyn2d(jbdy) == 'frs' ) THEN ; ilen1(:)=nblen(:) 343 ELSE ; ilen1(:)=nblenrim(:) 335 IF( cn_dyn2d(jbdy) == 'frs' ) THEN ; ilen1(:)=idx_bdy(jbdy)%nblen(:) 336 ELSE ; ilen1(:)=idx_bdy(jbdy)%nblenrim(:) 344 337 ENDIF 345 338 IF ( dta_bdy(jbdy)%lneed_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1))
Note: See TracChangeset
for help on using the changeset viewer.
