- Timestamp:
- 2017-11-24T17:56:51+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r8586 r8813 51 51 52 52 #if defined key_lim3 53 LOGICAL :: ll_bdylim3 ! determine whether ice input is 1cat (F) or Xcat (T) type54 INTEGER :: jfld_hti, jfld_hts, jfld_ai! indices of ice thickness, snow thickness and concentration in bf structure53 INTEGER :: nice_cat ! number of categories in the input file 54 INTEGER :: jfld_hti, jfld_hts, jfld_ai ! indices of ice thickness, snow thickness and concentration in bf structure 55 55 #endif 56 56 57 57 !!---------------------------------------------------------------------- 58 !! NEMO/OPA 3.3 , NEMO Consortium (2010)58 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 59 59 !! $Id$ 60 60 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 80 80 ! ! etc. 81 81 ! 82 INTEGER :: ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd, jl ! local indices 82 INTEGER :: jbdy, jfld, jstart, jend, ib, jl ! dummy loop indices 83 INTEGER :: ii, ij, ik, igrd ! local integers 83 84 INTEGER, DIMENSION(jpbgrd) :: ilen1 84 85 INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts … … 95 96 !----------------------------- 96 97 97 DO ib_bdy = 1, nb_bdy98 DO jbdy = 1, nb_bdy 98 99 ! 99 nblen => idx_bdy(ib_bdy)%nblen100 nblenrim => idx_bdy( ib_bdy)%nblenrim101 dta => dta_bdy(ib_bdy)102 103 IF( nn_dyn2d_dta( ib_bdy) == 0 ) THEN100 nblen => idx_bdy(jbdy)%nblen 101 nblenrim => idx_bdy(jbdy)%nblenrim 102 dta => dta_bdy(jbdy) 103 ! 104 IF( nn_dyn2d_dta(jbdy) == 0 ) THEN 104 105 ilen1(:) = nblen(:) 105 106 IF( dta%ll_ssh ) THEN 106 107 igrd = 1 107 108 DO ib = 1, ilen1(igrd) 108 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)109 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)110 dta_bdy( ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)109 ii = idx_bdy(jbdy)%nbi(ib,igrd) 110 ij = idx_bdy(jbdy)%nbj(ib,igrd) 111 dta_bdy(jbdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1) 111 112 END DO 112 END 113 ENDIF 113 114 IF( dta%ll_u2d ) THEN 114 115 igrd = 2 115 116 DO ib = 1, ilen1(igrd) 116 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)117 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)118 dta_bdy( ib_bdy)%u2d(ib) = un_b(ii,ij) * umask(ii,ij,1)117 ii = idx_bdy(jbdy)%nbi(ib,igrd) 118 ij = idx_bdy(jbdy)%nbj(ib,igrd) 119 dta_bdy(jbdy)%u2d(ib) = un_b(ii,ij) * umask(ii,ij,1) 119 120 END DO 120 END 121 ENDIF 121 122 IF( dta%ll_v2d ) THEN 122 123 igrd = 3 123 124 DO ib = 1, ilen1(igrd) 124 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)125 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)126 dta_bdy( ib_bdy)%v2d(ib) = vn_b(ii,ij) * vmask(ii,ij,1)125 ii = idx_bdy(jbdy)%nbi(ib,igrd) 126 ij = idx_bdy(jbdy)%nbj(ib,igrd) 127 dta_bdy(jbdy)%v2d(ib) = vn_b(ii,ij) * vmask(ii,ij,1) 127 128 END DO 128 END 129 ENDIF 130 131 IF( nn_dyn3d_dta( ib_bdy) == 0 ) THEN129 ENDIF 130 ENDIF 131 ! 132 IF( nn_dyn3d_dta(jbdy) == 0 ) THEN 132 133 ilen1(:) = nblen(:) 133 134 IF( dta%ll_u3d ) THEN … … 135 136 DO ib = 1, ilen1(igrd) 136 137 DO ik = 1, jpkm1 137 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)138 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)139 dta_bdy( ib_bdy)%u3d(ib,ik) = ( un(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik)138 ii = idx_bdy(jbdy)%nbi(ib,igrd) 139 ij = idx_bdy(jbdy)%nbj(ib,igrd) 140 dta_bdy(jbdy)%u3d(ib,ik) = ( un(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik) 140 141 END DO 141 142 END DO 142 END 143 ENDIF 143 144 IF( dta%ll_v3d ) THEN 144 145 igrd = 3 145 146 DO ib = 1, ilen1(igrd) 146 147 DO ik = 1, jpkm1 147 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)148 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)149 dta_bdy( ib_bdy)%v3d(ib,ik) = ( vn(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik)148 ii = idx_bdy(jbdy)%nbi(ib,igrd) 149 ij = idx_bdy(jbdy)%nbj(ib,igrd) 150 dta_bdy(jbdy)%v3d(ib,ik) = ( vn(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik) 150 151 END DO 151 152 END DO 152 END 153 ENDIF 154 155 IF( nn_tra_dta( ib_bdy) == 0 ) THEN153 ENDIF 154 ENDIF 155 156 IF( nn_tra_dta(jbdy) == 0 ) THEN 156 157 ilen1(:) = nblen(:) 157 158 IF( dta%ll_tem ) THEN … … 159 160 DO ib = 1, ilen1(igrd) 160 161 DO ik = 1, jpkm1 161 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)162 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)163 dta_bdy( ib_bdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)162 ii = idx_bdy(jbdy)%nbi(ib,igrd) 163 ij = idx_bdy(jbdy)%nbj(ib,igrd) 164 dta_bdy(jbdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik) 164 165 END DO 165 166 END DO 166 END 167 ENDIF 167 168 IF( dta%ll_sal ) THEN 168 169 igrd = 1 169 170 DO ib = 1, ilen1(igrd) 170 171 DO ik = 1, jpkm1 171 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)172 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)173 dta_bdy( ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)172 ii = idx_bdy(jbdy)%nbi(ib,igrd) 173 ij = idx_bdy(jbdy)%nbj(ib,igrd) 174 dta_bdy(jbdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik) 174 175 END DO 175 176 END DO 176 END 177 ENDIF 178 179 #if defined key_lim3 180 IF( nn_ice_lim_dta( ib_bdy) == 0 ) THEN177 ENDIF 178 ENDIF 179 180 #if defined key_lim3 181 IF( nn_ice_lim_dta(jbdy) == 0 ) THEN ! set ice to initial values 181 182 ilen1(:) = nblen(:) 182 183 IF( dta%ll_a_i ) THEN … … 184 185 DO jl = 1, jpl 185 186 DO ib = 1, ilen1(igrd) 186 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)187 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)188 dta_bdy( ib_bdy)%a_i (ib,jl) = a_i(ii,ij,jl) * tmask(ii,ij,1)187 ii = idx_bdy(jbdy)%nbi(ib,igrd) 188 ij = idx_bdy(jbdy)%nbj(ib,igrd) 189 dta_bdy(jbdy)%a_i (ib,jl) = a_i(ii,ij,jl) * tmask(ii,ij,1) 189 190 END DO 190 191 END DO … … 194 195 DO jl = 1, jpl 195 196 DO ib = 1, ilen1(igrd) 196 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)197 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)198 dta_bdy( ib_bdy)%h_i (ib,jl) = h_i(ii,ij,jl) * tmask(ii,ij,1)197 ii = idx_bdy(jbdy)%nbi(ib,igrd) 198 ij = idx_bdy(jbdy)%nbj(ib,igrd) 199 dta_bdy(jbdy)%h_i (ib,jl) = h_i(ii,ij,jl) * tmask(ii,ij,1) 199 200 END DO 200 201 END DO … … 204 205 DO jl = 1, jpl 205 206 DO ib = 1, ilen1(igrd) 206 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)207 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)208 dta_bdy( ib_bdy)%h_s (ib,jl) = h_s(ii,ij,jl) * tmask(ii,ij,1)207 ii = idx_bdy(jbdy)%nbi(ib,igrd) 208 ij = idx_bdy(jbdy)%nbj(ib,igrd) 209 dta_bdy(jbdy)%h_s (ib,jl) = h_s(ii,ij,jl) * tmask(ii,ij,1) 209 210 END DO 210 211 END DO … … 212 213 ENDIF 213 214 #endif 214 END DO ! ib_bdy215 END DO ! jbdy 215 216 ! 216 217 ENDIF ! kt == nit000 … … 220 221 221 222 jstart = 1 222 DO ib_bdy = 1, nb_bdy223 dta => dta_bdy( ib_bdy)224 IF( nn_dta( ib_bdy) == 1 ) THEN ! skip this bit if no external data required223 DO jbdy = 1, nb_bdy 224 dta => dta_bdy(jbdy) 225 IF( nn_dta(jbdy) == 1 ) THEN ! skip this bit if no external data required 225 226 226 227 IF( PRESENT(jit) ) THEN 227 228 ! Update barotropic boundary conditions only 228 229 ! jit is optional argument for fld_read and bdytide_update 229 IF( cn_dyn2d( ib_bdy) /= 'none' ) THEN230 IF( nn_dyn2d_dta( ib_bdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays230 IF( cn_dyn2d(jbdy) /= 'none' ) THEN 231 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 231 232 IF( dta%ll_ssh ) dta%ssh(:) = 0._wp 232 233 IF( dta%ll_u2d ) dta%u2d(:) = 0._wp 233 234 IF( dta%ll_u3d ) dta%v2d(:) = 0._wp 234 235 ENDIF 235 IF (cn_tra( ib_bdy) /= 'runoff') THEN236 IF( nn_dyn2d_dta( ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 ) THEN236 IF (cn_tra(jbdy) /= 'runoff') THEN 237 IF( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 ) THEN 237 238 238 239 jend = jstart + dta%nread(2) - 1 239 IF( ln_full_vel_array( ib_bdy) ) THEN240 IF( ln_full_vel_array(jbdy) ) THEN 240 241 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), & 241 & kit=jit, kt_offset=time_offset , jpk_bdy=nb_jpk_bdy, fvl=ln_full_vel_array( ib_bdy) )242 & kit=jit, kt_offset=time_offset , jpk_bdy=nb_jpk_bdy, fvl=ln_full_vel_array(jbdy) ) 242 243 ELSE 243 244 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), & … … 246 247 247 248 ! If full velocities in boundary data then extract barotropic velocities from 3D fields 248 IF( ln_full_vel_array( ib_bdy) .AND. &249 & ( nn_dyn2d_dta( ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 .OR. &250 & nn_dyn3d_dta( ib_bdy) == 1 ) )THEN249 IF( ln_full_vel_array(jbdy) .AND. & 250 & ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 .OR. & 251 & nn_dyn3d_dta(jbdy) == 1 ) )THEN 251 252 252 253 igrd = 2 ! zonal velocity 253 254 dta%u2d(:) = 0._wp 254 DO ib = 1, idx_bdy( ib_bdy)%nblen(igrd)255 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)256 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)255 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 256 ii = idx_bdy(jbdy)%nbi(ib,igrd) 257 ij = idx_bdy(jbdy)%nbj(ib,igrd) 257 258 DO ik = 1, jpkm1 258 259 dta%u2d(ib) = dta%u2d(ib) & … … 263 264 igrd = 3 ! meridional velocity 264 265 dta%v2d(:) = 0._wp 265 DO ib = 1, idx_bdy( ib_bdy)%nblen(igrd)266 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)267 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)266 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 267 ii = idx_bdy(jbdy)%nbi(ib,igrd) 268 ij = idx_bdy(jbdy)%nbj(ib,igrd) 268 269 DO ik = 1, jpkm1 269 270 dta%v2d(ib) = dta%v2d(ib) & … … 274 275 ENDIF 275 276 ENDIF 276 IF( nn_dyn2d_dta( ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing277 CALL bdytide_update( kt=kt, idx=idx_bdy( ib_bdy), dta=dta, td=tides(ib_bdy), &277 IF( nn_dyn2d_dta(jbdy) .ge. 2 ) THEN ! update tidal harmonic forcing 278 CALL bdytide_update( kt=kt, idx=idx_bdy(jbdy), dta=dta, td=tides(jbdy), & 278 279 & jit=jit, time_offset=time_offset ) 279 280 ENDIF … … 281 282 ENDIF 282 283 ELSE 283 IF (cn_tra( ib_bdy) == 'runoff') then ! runoff condition284 jend = nb_bdy_fld( ib_bdy)284 IF (cn_tra(jbdy) == 'runoff') then ! runoff condition 285 jend = nb_bdy_fld(jbdy) 285 286 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 286 287 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset ) 287 288 ! 288 289 igrd = 2 ! zonal velocity 289 DO ib = 1, idx_bdy( ib_bdy)%nblen(igrd)290 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)291 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)290 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 291 ii = idx_bdy(jbdy)%nbi(ib,igrd) 292 ij = idx_bdy(jbdy)%nbj(ib,igrd) 292 293 dta%u2d(ib) = dta%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 293 294 END DO 294 295 ! 295 296 igrd = 3 ! meridional velocity 296 DO ib = 1, idx_bdy( ib_bdy)%nblen(igrd)297 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)298 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)297 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 298 ii = idx_bdy(jbdy)%nbi(ib,igrd) 299 ij = idx_bdy(jbdy)%nbj(ib,igrd) 299 300 dta%v2d(ib) = dta%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 300 301 END DO 301 302 ELSE 302 IF( nn_dyn2d_dta( ib_bdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays303 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 303 304 IF( dta%ll_ssh ) dta%ssh(:) = 0._wp 304 305 IF( dta%ll_u2d ) dta%u2d(:) = 0._wp … … 308 309 jend = jstart + dta%nread(1) - 1 309 310 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 310 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy, fvl=ln_full_vel_array( ib_bdy) )311 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy, fvl=ln_full_vel_array(jbdy) ) 311 312 ENDIF 312 313 ! If full velocities in boundary data then split into barotropic and baroclinic data 313 IF( ln_full_vel_array( ib_bdy) .and. &314 & ( nn_dyn2d_dta( ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 .OR. &315 & nn_dyn3d_dta( ib_bdy) == 1 ) ) THEN314 IF( ln_full_vel_array(jbdy) .and. & 315 & ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 .OR. & 316 & nn_dyn3d_dta(jbdy) == 1 ) ) THEN 316 317 igrd = 2 ! zonal velocity 317 318 dta%u2d(:) = 0._wp 318 DO ib = 1, idx_bdy( ib_bdy)%nblen(igrd)319 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)320 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)319 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 320 ii = idx_bdy(jbdy)%nbi(ib,igrd) 321 ij = idx_bdy(jbdy)%nbj(ib,igrd) 321 322 DO ik = 1, jpkm1 322 323 dta%u2d(ib) = dta%u2d(ib) & … … 330 331 igrd = 3 ! meridional velocity 331 332 dta%v2d(:) = 0._wp 332 DO ib = 1, idx_bdy( ib_bdy)%nblen(igrd)333 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)334 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)333 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 334 ii = idx_bdy(jbdy)%nbi(ib,igrd) 335 ij = idx_bdy(jbdy)%nbj(ib,igrd) 335 336 DO ik = 1, jpkm1 336 337 dta%v2d(ib) = dta%v2d(ib) & … … 346 347 ENDIF 347 348 #if defined key_lim3 348 IF( .NOT. ll_bdylim3 .AND. cn_ice_lim(ib_bdy) /= 'none' .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN ! bdy ice input (case input is 1cat) 349 CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 350 & dta_bdy(ib_bdy)%h_i, dta_bdy(ib_bdy)%h_s, dta_bdy(ib_bdy)%a_i ) 349 IF( cn_ice_lim(jbdy) /= 'none' .AND. nn_ice_lim_dta(jbdy) == 1 ) THEN 350 IF( nice_cat == 1 ) THEN ! case input cat = 1 351 CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 352 & dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i ) 353 ELSEIF( nice_cat /= 1 .AND. nice_cat /= jpl ) THEN ! case input cat /=1 and /=jpl 354 CALL ice_var_itd2( bf(jfld_hti)%fnow(:,1,:), bf(jfld_hts)%fnow(:,1,:), bf(jfld_ai)%fnow(:,1,:), & 355 & dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i ) 356 ENDIF 351 357 ENDIF 352 358 #endif 353 359 ENDIF 354 360 jstart = jstart + dta%nread(1) 355 END IF ! nn_dta(ib_bdy) = 1356 END DO ! ib_bdy361 ENDIF ! nn_dta(jbdy) = 1 362 END DO ! jbdy 357 363 358 364 IF ( ln_tide ) THEN 359 365 IF (ln_dynspg_ts) THEN ! Fill temporary arrays with slow-varying bdy data 360 DO ib_bdy = 1, nb_bdy ! Tidal component added in ts loop361 IF ( nn_dyn2d_dta( ib_bdy) .ge. 2 ) THEN362 nblen => idx_bdy( ib_bdy)%nblen363 nblenrim => idx_bdy( ib_bdy)%nblenrim364 IF( cn_dyn2d( ib_bdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF365 IF ( dta_bdy( ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen1(1)) = dta_bdy(ib_bdy)%ssh(1:ilen1(1))366 IF ( dta_bdy( ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen1(2)) = dta_bdy(ib_bdy)%u2d(1:ilen1(2))367 IF ( dta_bdy( ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen1(3)) = dta_bdy(ib_bdy)%v2d(1:ilen1(3))366 DO jbdy = 1, nb_bdy ! Tidal component added in ts loop 367 IF ( nn_dyn2d_dta(jbdy) .ge. 2 ) THEN 368 nblen => idx_bdy(jbdy)%nblen 369 nblenrim => idx_bdy(jbdy)%nblenrim 370 IF( cn_dyn2d(jbdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF 371 IF ( dta_bdy(jbdy)%ll_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 372 IF ( dta_bdy(jbdy)%ll_u2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 373 IF ( dta_bdy(jbdy)%ll_v2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 368 374 ENDIF 369 375 END DO … … 375 381 376 382 IF ( ln_apr_obc ) THEN 377 DO ib_bdy = 1, nb_bdy378 IF (cn_tra( ib_bdy) /= 'runoff')THEN383 DO jbdy = 1, nb_bdy 384 IF (cn_tra(jbdy) /= 'runoff')THEN 379 385 igrd = 1 ! meridional velocity 380 DO ib = 1, idx_bdy( ib_bdy)%nblenrim(igrd)381 ii = idx_bdy( ib_bdy)%nbi(ib,igrd)382 ij = idx_bdy( ib_bdy)%nbj(ib,igrd)383 dta_bdy( ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + ssh_ib(ii,ij)386 DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd) 387 ii = idx_bdy(jbdy)%nbi(ib,igrd) 388 ij = idx_bdy(jbdy)%nbj(ib,igrd) 389 dta_bdy(jbdy)%ssh(ib) = dta_bdy(jbdy)%ssh(ib) + ssh_ib(ii,ij) 384 390 END DO 385 391 ENDIF … … 402 408 !! 403 409 !!---------------------------------------------------------------------- 404 INTEGER :: ib_bdy, jfld, jstart, jend, ierror, ios ! Local integers410 INTEGER :: jbdy, jfld, jstart, jend, ierror, ios ! Local integers 405 411 ! 406 412 CHARACTER(len=100) :: cn_dir ! Root directory for location of data files … … 408 414 CHARACTER(len = 256):: clname ! temporary file name 409 415 LOGICAL :: ln_full_vel ! =T => full velocities in 3D boundary data 410 416 ! ! =F => baroclinic velocities in 3D boundary data 411 417 INTEGER :: ilen_global ! Max length required for global bdy dta arrays 412 418 INTEGER, ALLOCATABLE, DIMENSION(:) :: ilen1, ilen3 ! size of 1st and 3rd dimensions of local arrays … … 416 422 TYPE(OBC_DATA), POINTER :: dta ! short cut 417 423 #if defined key_lim3 418 INTEGER :: zndims ! number of dimensions in an array (i.e. 3 = wo ice cat; 4 = w ice cat) 424 INTEGER :: kndims ! number of dimensions in an array (i.e. 3 = wo ice cat; 4 = w ice cat) 425 INTEGER, DIMENSION(4) :: kdimsz ! size of dimensions 419 426 INTEGER :: inum,id1 ! local integer 420 427 #endif … … 440 447 441 448 ! Set nn_dta 442 DO ib_bdy = 1, nb_bdy443 nn_dta( ib_bdy) = MAX( nn_dyn2d_dta(ib_bdy)&444 ,nn_dyn3d_dta(ib_bdy)&445 ,nn_tra_dta(ib_bdy)&446 #if defined key_lim3 447 ,nn_ice_lim_dta(ib_bdy) &449 DO jbdy = 1, nb_bdy 450 nn_dta(jbdy) = MAX( nn_dyn2d_dta (jbdy) & 451 & , nn_dyn3d_dta (jbdy) & 452 & , nn_tra_dta (jbdy) & 453 #if defined key_lim3 454 & , nn_ice_lim_dta(jbdy) & 448 455 #endif 449 456 ) 450 IF(nn_dta( ib_bdy) > 1) nn_dta(ib_bdy) = 1457 IF(nn_dta(jbdy) > 1) nn_dta(jbdy) = 1 451 458 END DO 452 459 … … 455 462 ALLOCATE( nb_bdy_fld(nb_bdy) ) 456 463 nb_bdy_fld(:) = 0 457 DO ib_bdy = 1, nb_bdy458 IF( cn_dyn2d( ib_bdy) /= 'none' .and. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) THEN459 nb_bdy_fld( ib_bdy) = nb_bdy_fld(ib_bdy) + 3460 ENDIF 461 IF( cn_dyn3d( ib_bdy) /= 'none' .and. nn_dyn3d_dta(ib_bdy) == 1 ) THEN462 nb_bdy_fld( ib_bdy) = nb_bdy_fld(ib_bdy) + 2463 ENDIF 464 IF( cn_tra( ib_bdy) /= 'none' .and. nn_tra_dta(ib_bdy) == 1 ) THEN465 nb_bdy_fld( ib_bdy) = nb_bdy_fld(ib_bdy) + 2466 ENDIF 467 #if defined key_lim3 468 IF( cn_ice_lim( ib_bdy) /= 'none' .and. nn_ice_lim_dta(ib_bdy) == 1 ) THEN469 nb_bdy_fld( ib_bdy) = nb_bdy_fld(ib_bdy) + 3464 DO jbdy = 1, nb_bdy 465 IF( cn_dyn2d(jbdy) /= 'none' .AND. ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) ) THEN 466 nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 3 467 ENDIF 468 IF( cn_dyn3d(jbdy) /= 'none' .AND. nn_dyn3d_dta(jbdy) == 1 ) THEN 469 nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 2 470 ENDIF 471 IF( cn_tra(jbdy) /= 'none' .AND. nn_tra_dta(jbdy) == 1 ) THEN 472 nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 2 473 ENDIF 474 #if defined key_lim3 475 IF( cn_ice_lim(jbdy) /= 'none' .AND. nn_ice_lim_dta(jbdy) == 1 ) THEN 476 nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 3 470 477 ENDIF 471 478 #endif 472 IF(lwp) WRITE(numout,*) 'Maximum number of files to open =', nb_bdy_fld(ib_bdy)479 IF(lwp) WRITE(numout,*) 'Maximum number of files to open =', nb_bdy_fld(jbdy) 473 480 END DO 474 481 … … 496 503 REWIND(numnam_cfg) 497 504 jfld = 0 498 DO ib_bdy = 1, nb_bdy499 IF( nn_dta( ib_bdy) == 1 ) THEN505 DO jbdy = 1, nb_bdy 506 IF( nn_dta(jbdy) == 1 ) THEN 500 507 READ ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 501 508 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp ) … … 505 512 IF(lwm) WRITE( numond, nambdy_dta ) 506 513 507 cn_dir_array( ib_bdy) = cn_dir508 ln_full_vel_array( ib_bdy) = ln_full_vel509 510 nblen => idx_bdy( ib_bdy)%nblen511 nblenrim => idx_bdy( ib_bdy)%nblenrim512 dta => dta_bdy( ib_bdy)514 cn_dir_array(jbdy) = cn_dir 515 ln_full_vel_array(jbdy) = ln_full_vel 516 517 nblen => idx_bdy(jbdy)%nblen 518 nblenrim => idx_bdy(jbdy)%nblenrim 519 dta => dta_bdy(jbdy) 513 520 dta%nread(2) = 0 514 521 515 522 ! Only read in necessary fields for this set. 516 523 ! Important that barotropic variables come first. 517 IF( nn_dyn2d_dta( ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) THEN524 IF( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) THEN 518 525 519 526 IF( dta%ll_ssh ) THEN … … 521 528 jfld = jfld + 1 522 529 blf_i(jfld) = bn_ssh 523 ibdy(jfld) = ib_bdy530 ibdy(jfld) = jbdy 524 531 igrid(jfld) = 1 525 532 ilen1(jfld) = nblen(igrid(jfld)) … … 528 535 ENDIF 529 536 530 IF( dta%ll_u2d .and. .not. ln_full_vel_array( ib_bdy) ) THEN537 IF( dta%ll_u2d .and. .not. ln_full_vel_array(jbdy) ) THEN 531 538 if(lwp) write(numout,*) '++++++ reading in u2d field' 532 539 jfld = jfld + 1 533 540 blf_i(jfld) = bn_u2d 534 ibdy(jfld) = ib_bdy541 ibdy(jfld) = jbdy 535 542 igrid(jfld) = 2 536 543 ilen1(jfld) = nblen(igrid(jfld)) … … 539 546 ENDIF 540 547 541 IF( dta%ll_v2d .and. .not. ln_full_vel_array( ib_bdy) ) THEN548 IF( dta%ll_v2d .and. .not. ln_full_vel_array(jbdy) ) THEN 542 549 if(lwp) write(numout,*) '++++++ reading in v2d field' 543 550 jfld = jfld + 1 544 551 blf_i(jfld) = bn_v2d 545 ibdy(jfld) = ib_bdy552 ibdy(jfld) = jbdy 546 553 igrid(jfld) = 3 547 554 ilen1(jfld) = nblen(igrid(jfld)) … … 554 561 ! read 3D velocities if baroclinic velocities require OR if 555 562 ! barotropic velocities required and ln_full_vel set to .true. 556 IF( nn_dyn3d_dta( ib_bdy) == 1 .OR. &557 & ( ln_full_vel_array( ib_bdy) .AND. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) ) THEN558 559 IF( dta%ll_u3d .OR. ( ln_full_vel_array( ib_bdy) .and. dta%ll_u2d ) ) THEN563 IF( nn_dyn3d_dta(jbdy) == 1 .OR. & 564 & ( ln_full_vel_array(jbdy) .AND. ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 ) ) ) THEN 565 566 IF( dta%ll_u3d .OR. ( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) ) THEN 560 567 if(lwp) write(numout,*) '++++++ reading in u3d field' 561 568 jfld = jfld + 1 562 569 blf_i(jfld) = bn_u3d 563 ibdy(jfld) = ib_bdy570 ibdy(jfld) = jbdy 564 571 igrid(jfld) = 2 565 572 ilen1(jfld) = nblen(igrid(jfld)) 566 573 ilen3(jfld) = jpk 567 IF( ln_full_vel_array( ib_bdy) .and. dta%ll_u2d ) dta%nread(2) = dta%nread(2) + 1568 ENDIF 569 570 IF( dta%ll_v3d .OR. ( ln_full_vel_array( ib_bdy) .and. dta%ll_v2d ) ) THEN574 IF( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) dta%nread(2) = dta%nread(2) + 1 575 ENDIF 576 577 IF( dta%ll_v3d .OR. ( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) ) THEN 571 578 if(lwp) write(numout,*) '++++++ reading in v3d field' 572 579 jfld = jfld + 1 573 580 blf_i(jfld) = bn_v3d 574 ibdy(jfld) = ib_bdy581 ibdy(jfld) = jbdy 575 582 igrid(jfld) = 3 576 583 ilen1(jfld) = nblen(igrid(jfld)) 577 584 ilen3(jfld) = jpk 578 IF( ln_full_vel_array( ib_bdy) .and. dta%ll_v2d ) dta%nread(2) = dta%nread(2) + 1585 IF( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) dta%nread(2) = dta%nread(2) + 1 579 586 ENDIF 580 587 … … 582 589 583 590 ! temperature and salinity 584 IF( nn_tra_dta( ib_bdy) == 1 ) THEN591 IF( nn_tra_dta(jbdy) == 1 ) THEN 585 592 586 593 IF( dta%ll_tem ) THEN … … 588 595 jfld = jfld + 1 589 596 blf_i(jfld) = bn_tem 590 ibdy(jfld) = ib_bdy597 ibdy(jfld) = jbdy 591 598 igrid(jfld) = 1 592 599 ilen1(jfld) = nblen(igrid(jfld)) … … 598 605 jfld = jfld + 1 599 606 blf_i(jfld) = bn_sal 600 ibdy(jfld) = ib_bdy607 ibdy(jfld) = jbdy 601 608 igrid(jfld) = 1 602 609 ilen1(jfld) = nblen(igrid(jfld)) … … 608 615 #if defined key_lim3 609 616 ! sea ice 610 IF( nn_ice_lim_dta( ib_bdy) == 1 ) THEN617 IF( nn_ice_lim_dta(jbdy) == 1 ) THEN 611 618 ! Test for types of ice input (1cat or Xcat) 612 619 ! Build file name to find dimensions … … 622 629 ! 623 630 CALL iom_open ( clname, inum ) 624 id1 = iom_varid( inum, bn_a_i%clvar, k ndims=zndims, ldstop = .FALSE. )631 id1 = iom_varid( inum, bn_a_i%clvar, kdimsz=kdimsz, kndims=kndims, ldstop = .FALSE. ) 625 632 CALL iom_close ( inum ) 626 633 627 IF ( zndims == 4 ) THEN628 ll_bdylim3 = .TRUE.! Xcat input634 IF ( kndims == 4 ) THEN 635 nice_cat = kdimsz(4) ! Xcat input 629 636 ELSE 630 ll_bdylim3 = .FALSE.! 1cat input637 nice_cat = 1 ! 1cat input 631 638 ENDIF 632 639 ! End test … … 635 642 jfld = jfld + 1 636 643 blf_i(jfld) = bn_a_i 637 ibdy(jfld) = ib_bdy644 ibdy(jfld) = jbdy 638 645 igrid(jfld) = 1 639 646 ilen1(jfld) = nblen(igrid(jfld)) 640 IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF647 ilen3(jfld) = nice_cat 641 648 ENDIF 642 649 … … 644 651 jfld = jfld + 1 645 652 blf_i(jfld) = bn_h_i 646 ibdy(jfld) = ib_bdy653 ibdy(jfld) = jbdy 647 654 igrid(jfld) = 1 648 655 ilen1(jfld) = nblen(igrid(jfld)) 649 IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF656 ilen3(jfld) = nice_cat 650 657 ENDIF 651 658 652 659 IF( dta%ll_h_s ) THEN 653 660 jfld = jfld + 1 654 655 ibdy(jfld) = ib_bdy661 blf_i(jfld) = bn_h_s 662 ibdy(jfld) = jbdy 656 663 igrid(jfld) = 1 657 664 ilen1(jfld) = nblen(igrid(jfld)) 658 IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF665 ilen3(jfld) = nice_cat 659 666 ENDIF 660 667 … … 663 670 ! Recalculate field counts 664 671 !------------------------- 665 IF( ib_bdy == 1 ) THEN672 IF( jbdy == 1 ) THEN 666 673 nb_bdy_fld_sum = 0 667 nb_bdy_fld( ib_bdy) = jfld674 nb_bdy_fld(jbdy) = jfld 668 675 nb_bdy_fld_sum = jfld 669 676 ELSE 670 nb_bdy_fld( ib_bdy) = jfld - nb_bdy_fld_sum671 nb_bdy_fld_sum = nb_bdy_fld_sum + nb_bdy_fld( ib_bdy)672 ENDIF 673 674 dta%nread(1) = nb_bdy_fld( ib_bdy)677 nb_bdy_fld(jbdy) = jfld - nb_bdy_fld_sum 678 nb_bdy_fld_sum = nb_bdy_fld_sum + nb_bdy_fld(jbdy) 679 ENDIF 680 681 dta%nread(1) = nb_bdy_fld(jbdy) 675 682 676 683 ENDIF ! nn_dta == 1 677 ENDDO ! ib_bdy684 ENDDO ! jbdy 678 685 679 686 DO jfld = 1, nb_bdy_fld_sum … … 687 694 !------------------------------------- 688 695 jstart = 1 689 DO ib_bdy = 1, nb_bdy690 jend = jstart - 1 + nb_bdy_fld( ib_bdy)691 CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array( ib_bdy), 'bdy_dta', &696 DO jbdy = 1, nb_bdy 697 jend = jstart - 1 + nb_bdy_fld(jbdy) 698 CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(jbdy), 'bdy_dta', & 692 699 & 'open boundary conditions', 'nambdy_dta' ) 693 700 jstart = jend + 1 … … 700 707 701 708 jfld = 0 702 DO ib_bdy=1, nb_bdy703 704 nblen => idx_bdy( ib_bdy)%nblen705 dta => dta_bdy( ib_bdy)709 DO jbdy=1, nb_bdy 710 711 nblen => idx_bdy(jbdy)%nblen 712 dta => dta_bdy(jbdy) 706 713 707 714 if(lwp) then … … 715 722 endif 716 723 717 IF ( nn_dyn2d_dta( ib_bdy) == 0 .or. nn_dyn2d_dta(ib_bdy) == 2 ) THEN724 IF ( nn_dyn2d_dta(jbdy) == 0 .or. nn_dyn2d_dta(jbdy) == 2 ) THEN 718 725 if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space' 719 726 IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) ) … … 721 728 IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) ) 722 729 ENDIF 723 IF ( nn_dyn2d_dta( ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) THEN730 IF ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) THEN 724 731 IF( dta%ll_ssh ) THEN 725 732 if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow' … … 728 735 ENDIF 729 736 IF ( dta%ll_u2d ) THEN 730 IF ( ln_full_vel_array( ib_bdy) ) THEN737 IF ( ln_full_vel_array(jbdy) ) THEN 731 738 if(lwp) write(numout,*) '++++++ dta%u2d allocated space' 732 739 ALLOCATE( dta%u2d(nblen(2)) ) … … 738 745 ENDIF 739 746 IF ( dta%ll_v2d ) THEN 740 IF ( ln_full_vel_array( ib_bdy) ) THEN747 IF ( ln_full_vel_array(jbdy) ) THEN 741 748 if(lwp) write(numout,*) '++++++ dta%v2d allocated space' 742 749 ALLOCATE( dta%v2d(nblen(3)) ) … … 749 756 ENDIF 750 757 751 IF ( nn_dyn3d_dta( ib_bdy) == 0 ) THEN758 IF ( nn_dyn3d_dta(jbdy) == 0 ) THEN 752 759 if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space' 753 IF( dta%ll_u3d ) ALLOCATE( dta_bdy( ib_bdy)%u3d(nblen(2),jpk) )754 IF( dta%ll_v3d ) ALLOCATE( dta_bdy( ib_bdy)%v3d(nblen(3),jpk) )755 ENDIF 756 IF ( nn_dyn3d_dta( ib_bdy) == 1 .or. &757 & ( ln_full_vel_array( ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) ) THEN758 IF ( dta%ll_u3d .or. ( ln_full_vel_array( ib_bdy) .and. dta%ll_u2d ) ) THEN760 IF( dta%ll_u3d ) ALLOCATE( dta_bdy(jbdy)%u3d(nblen(2),jpk) ) 761 IF( dta%ll_v3d ) ALLOCATE( dta_bdy(jbdy)%v3d(nblen(3),jpk) ) 762 ENDIF 763 IF ( nn_dyn3d_dta(jbdy) == 1 .or. & 764 & ( ln_full_vel_array(jbdy) .and. ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) ) ) THEN 765 IF ( dta%ll_u3d .or. ( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) ) THEN 759 766 if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow' 760 767 jfld = jfld + 1 761 dta_bdy( ib_bdy)%u3d => bf(jfld)%fnow(:,1,:)762 ENDIF 763 IF ( dta%ll_v3d .or. ( ln_full_vel_array( ib_bdy) .and. dta%ll_v2d ) ) THEN768 dta_bdy(jbdy)%u3d => bf(jfld)%fnow(:,1,:) 769 ENDIF 770 IF ( dta%ll_v3d .or. ( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) ) THEN 764 771 if(lwp) write(numout,*) '++++++ dta%v3d pointing to fnow' 765 772 jfld = jfld + 1 766 dta_bdy( ib_bdy)%v3d => bf(jfld)%fnow(:,1,:)767 ENDIF 768 ENDIF 769 770 IF( nn_tra_dta( ib_bdy) == 0 ) THEN773 dta_bdy(jbdy)%v3d => bf(jfld)%fnow(:,1,:) 774 ENDIF 775 ENDIF 776 777 IF( nn_tra_dta(jbdy) == 0 ) THEN 771 778 if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space' 772 IF( dta%ll_tem ) ALLOCATE( dta_bdy( ib_bdy)%tem(nblen(1),jpk) )773 IF( dta%ll_sal ) ALLOCATE( dta_bdy( ib_bdy)%sal(nblen(1),jpk) )779 IF( dta%ll_tem ) ALLOCATE( dta_bdy(jbdy)%tem(nblen(1),jpk) ) 780 IF( dta%ll_sal ) ALLOCATE( dta_bdy(jbdy)%sal(nblen(1),jpk) ) 774 781 ELSE 775 782 IF( dta%ll_tem ) THEN 776 783 if(lwp) write(numout,*) '++++++ dta%tem pointing to fnow' 777 784 jfld = jfld + 1 778 dta_bdy( ib_bdy)%tem => bf(jfld)%fnow(:,1,:)785 dta_bdy(jbdy)%tem => bf(jfld)%fnow(:,1,:) 779 786 ENDIF 780 787 IF( dta%ll_sal ) THEN 781 788 if(lwp) write(numout,*) '++++++ dta%sal pointing to fnow' 782 789 jfld = jfld + 1 783 dta_bdy( ib_bdy)%sal => bf(jfld)%fnow(:,1,:)784 ENDIF 785 ENDIF 786 787 #if defined key_lim3 788 IF (cn_ice_lim( ib_bdy) /= 'none') THEN789 IF( nn_ice_lim_dta( ib_bdy) == 0 ) THEN790 ALLOCATE( dta_bdy( ib_bdy)%a_i(nblen(1),jpl) )791 ALLOCATE( dta_bdy( ib_bdy)%h_i(nblen(1),jpl) )792 ALLOCATE( dta_bdy( ib_bdy)%h_s(nblen(1),jpl) )790 dta_bdy(jbdy)%sal => bf(jfld)%fnow(:,1,:) 791 ENDIF 792 ENDIF 793 794 #if defined key_lim3 795 IF (cn_ice_lim(jbdy) /= 'none') THEN 796 IF( nn_ice_lim_dta(jbdy) == 0 ) THEN 797 ALLOCATE( dta_bdy(jbdy)%a_i(nblen(1),jpl) ) 798 ALLOCATE( dta_bdy(jbdy)%h_i(nblen(1),jpl) ) 799 ALLOCATE( dta_bdy(jbdy)%h_s(nblen(1),jpl) ) 793 800 ELSE 794 IF ( ll_bdylim3 ) THEN ! case input is Xcat795 jfld = jfld + 1 796 dta_bdy( ib_bdy)%a_i => bf(jfld)%fnow(:,1,:)797 jfld = jfld + 1 798 dta_bdy( ib_bdy)%h_i => bf(jfld)%fnow(:,1,:)799 jfld = jfld + 1 800 dta_bdy( ib_bdy)%h_s => bf(jfld)%fnow(:,1,:)801 ELSE ! case input is 1cat801 IF ( nice_cat == jpl ) THEN ! case input cat = jpl 802 jfld = jfld + 1 803 dta_bdy(jbdy)%a_i => bf(jfld)%fnow(:,1,:) 804 jfld = jfld + 1 805 dta_bdy(jbdy)%h_i => bf(jfld)%fnow(:,1,:) 806 jfld = jfld + 1 807 dta_bdy(jbdy)%h_s => bf(jfld)%fnow(:,1,:) 808 ELSE ! case input cat = 1 OR (/=1 and /=jpl) 802 809 jfld_ai = jfld + 1 803 810 jfld_hti = jfld + 2 804 811 jfld_hts = jfld + 3 805 812 jfld = jfld + 3 806 ALLOCATE( dta_bdy( ib_bdy)%a_i(nblen(1),jpl) )807 ALLOCATE( dta_bdy( ib_bdy)%h_i(nblen(1),jpl) )808 ALLOCATE( dta_bdy( ib_bdy)%h_s(nblen(1),jpl) )809 dta_bdy( ib_bdy)%a_i(:,:) = 0._wp810 dta_bdy( ib_bdy)%h_i(:,:) = 0._wp811 dta_bdy( ib_bdy)%h_s(:,:) = 0._wp813 ALLOCATE( dta_bdy(jbdy)%a_i(nblen(1),jpl) ) 814 ALLOCATE( dta_bdy(jbdy)%h_i(nblen(1),jpl) ) 815 ALLOCATE( dta_bdy(jbdy)%h_s(nblen(1),jpl) ) 816 dta_bdy(jbdy)%a_i(:,:) = 0._wp 817 dta_bdy(jbdy)%h_i(:,:) = 0._wp 818 dta_bdy(jbdy)%h_s(:,:) = 0._wp 812 819 ENDIF 813 820 … … 816 823 #endif 817 824 ! 818 END DO ! ib_bdy825 END DO ! jbdy 819 826 ! 820 827 IF( nn_timing == 1 ) CALL timing_stop('bdy_dta_init')
Note: See TracChangeset
for help on using the changeset viewer.
