- Timestamp:
- 2013-11-19T15:37:49+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r4105 r4254 81 81 INTEGER, DIMENSION(jpbgrd) :: ilen1 82 82 INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts 83 TYPE(OBC_DATA), POINTER :: dta ! short cut 83 84 !! 84 85 !!--------------------------------------------------------------------------- … … 92 93 ! Calculate depth-mean currents 93 94 !----------------------------- 94 CALL wrk_alloc(jpi,jpj,pu2d,pv2d) 95 96 pu2d(:,:) = 0._wp 97 pv2d(:,:) = 0._wp 98 95 CALL wrk_alloc(jpi,jpj,pun2d,pvn2d) 96 97 pun2d(:,:) = 0.e0 98 pvn2d(:,:) = 0.e0 99 99 DO ik = 1, jpkm1 !! Vertically integrated momentum trends 100 pu 2d(:,:) = pu2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik)101 pv 2d(:,:) = pv2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik)100 pun2d(:,:) = pun2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik) 101 pvn2d(:,:) = pvn2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik) 102 102 END DO 103 pu 2d(:,:) = pu2d(:,:) * hur(:,:)104 pv 2d(:,:) = pv2d(:,:) * hvr(:,:)103 pun2d(:,:) = pun2d(:,:) * hur(:,:) 104 pvn2d(:,:) = pvn2d(:,:) * hvr(:,:) 105 105 106 106 DO ib_bdy = 1, nb_bdy … … 108 108 nblen => idx_bdy(ib_bdy)%nblen 109 109 nblenrim => idx_bdy(ib_bdy)%nblenrim 110 111 IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN 110 dta => dta_bdy(ib_bdy) 111 112 IF( nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN 112 113 ilen1(:) = nblen(:) 113 igrd = 1 114 DO ib = 1, ilen1(igrd) 115 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 116 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 117 dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1) 118 END DO 119 igrd = 2 120 DO ib = 1, ilen1(igrd) 121 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 122 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 123 dta_bdy(ib_bdy)%u2d(ib) = pu2d(ii,ij) * umask(ii,ij,1) 124 END DO 125 igrd = 3 126 DO ib = 1, ilen1(igrd) 127 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 128 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 129 dta_bdy(ib_bdy)%v2d(ib) = pv2d(ii,ij) * vmask(ii,ij,1) 130 END DO 131 ENDIF 132 133 IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 134 ilen1(:) = nblen(:) 135 igrd = 2 136 DO ib = 1, ilen1(igrd) 137 DO ik = 1, jpkm1 114 IF( dta%ll_ssh ) THEN 115 igrd = 1 116 DO ib = 1, ilen1(igrd) 138 117 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 139 118 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 140 dta_bdy(ib_bdy)% u3d(ib,ik) = ( un(ii,ij,ik) - pu2d(ii,ij) ) * umask(ii,ij,ik)141 END DO 142 END DO143 igrd = 3144 DO ib = 1, ilen1(igrd)145 DO i k = 1, jpkm1119 dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1) 120 END DO 121 END IF 122 IF( dta%ll_u2d ) THEN 123 igrd = 2 124 DO ib = 1, ilen1(igrd) 146 125 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 147 126 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 148 dta_bdy(ib_bdy)%v3d(ib,ik) = ( vn(ii,ij,ik) - pv2d(ii,ij) ) * vmask(ii,ij,ik) 149 END DO 150 END DO 151 ENDIF 152 153 IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 0 ) THEN 154 ilen1(:) = nblen(:) 155 igrd = 1 ! Everything is at T-points here 156 DO ib = 1, ilen1(igrd) 157 DO ik = 1, jpkm1 127 dta_bdy(ib_bdy)%u2d(ib) = pun2d(ii,ij) * umask(ii,ij,1) 128 END DO 129 END IF 130 IF( dta%ll_v2d ) THEN 131 igrd = 3 132 DO ib = 1, ilen1(igrd) 158 133 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 159 134 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 160 dta_bdy(ib_bdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik) 161 dta_bdy(ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik) 162 END DO 163 END DO 164 ENDIF 165 166 #if defined key_lim2 167 IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN 135 dta_bdy(ib_bdy)%v2d(ib) = pvn2d(ii,ij) * vmask(ii,ij,1) 136 END DO 137 END IF 138 ENDIF 139 140 IF( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 168 141 ilen1(:) = nblen(:) 169 igrd = 1 ! Everything is at T-points here 170 DO ib = 1, ilen1(igrd) 171 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 172 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 173 dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1) 174 dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1) 175 dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1) 176 END DO 142 IF( dta%ll_u3d ) THEN 143 igrd = 2 144 DO ib = 1, ilen1(igrd) 145 DO ik = 1, jpkm1 146 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 147 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 148 dta_bdy(ib_bdy)%u3d(ib,ik) = ( un(ii,ij,ik) - pun2d(ii,ij) ) * umask(ii,ij,ik) 149 END DO 150 END DO 151 END IF 152 IF( dta%ll_v3d ) THEN 153 igrd = 3 154 DO ib = 1, ilen1(igrd) 155 DO ik = 1, jpkm1 156 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 157 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 158 dta_bdy(ib_bdy)%v3d(ib,ik) = ( vn(ii,ij,ik) - pvn2d(ii,ij) ) * vmask(ii,ij,ik) 159 END DO 160 END DO 161 END IF 162 ENDIF 163 164 IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 165 ilen1(:) = nblen(:) 166 IF( dta%ll_tem ) THEN 167 igrd = 1 168 DO ib = 1, ilen1(igrd) 169 DO ik = 1, jpkm1 170 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 171 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 172 dta_bdy(ib_bdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik) 173 END DO 174 END DO 175 END IF 176 IF( dta%ll_sal ) THEN 177 igrd = 1 178 DO ib = 1, ilen1(igrd) 179 DO ik = 1, jpkm1 180 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 181 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 182 dta_bdy(ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik) 183 END DO 184 END DO 185 END IF 186 ENDIF 187 188 #if defined key_lim2 189 IF( nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN 190 ilen1(:) = nblen(:) 191 IF( dta%ll_frld ) THEN 192 igrd = 1 193 DO ib = 1, ilen1(igrd) 194 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 195 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 196 dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1) 197 END DO 198 END IF 199 IF( dta%ll_hicif ) THEN 200 igrd = 1 201 DO ib = 1, ilen1(igrd) 202 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 203 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 204 dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1) 205 END DO 206 END IF 207 IF( dta%ll_hsnif ) THEN 208 igrd = 1 209 DO ib = 1, ilen1(igrd) 210 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 211 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 212 dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1) 213 END DO 214 END IF 177 215 ENDIF 178 216 #endif … … 180 218 ENDDO ! ib_bdy 181 219 182 CALL wrk_dealloc(jpi,jpj,pu 2d,pv2d)220 CALL wrk_dealloc(jpi,jpj,pun2d,pvn2d) 183 221 184 222 ENDIF ! kt .eq. nit000 … … 189 227 jstart = 1 190 228 DO ib_bdy = 1, nb_bdy 229 dta => dta_bdy(ib_bdy) 191 230 IF( nn_dta(ib_bdy) .eq. 1 ) THEN ! skip this bit if no external data required 192 231 … … 194 233 ! Update barotropic boundary conditions only 195 234 ! jit is optional argument for fld_read and bdytide_update 196 IF( nn_dyn2d(ib_bdy) .gt. 0) THEN235 IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN 197 236 IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 198 dta_bdy(ib_bdy)%ssh(:) = 0._wp199 dta_bdy(ib_bdy)%u2d(:) = 0._wp200 dta_bdy(ib_bdy)%v2d(:) = 0._wp237 IF( dta%ll_ssh ) dta%ssh(:) = 0.0 238 IF( dta%ll_u2d ) dta%u2d(:) = 0.0 239 IF( dta%ll_u3d ) dta%v2d(:) = 0.0 201 240 ENDIF 202 IF (nn_tra(ib_bdy).ne.4) THEN 203 IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR. & 204 & (ln_full_vel_array(ib_bdy) .AND. nn_dyn3d_dta(ib_bdy).eq.1) )THEN 205 206 ! For the runoff case, no need to update the forcing (already done in the baroclinic part) 207 jend = nb_bdy_fld(ib_bdy) 208 IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend - 2 241 IF (cn_tra(ib_bdy) /= 'runoff') THEN 242 IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 ) THEN 243 244 jend = jstart + dta%nread(2) - 1 209 245 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), & 210 246 & kit=jit, kt_offset=time_offset ) 211 IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend + 2 212 213 ! If full velocities in boundary data then split into barotropic and baroclinic data 247 248 ! If full velocities in boundary data then extract barotropic velocities from 3D fields 214 249 IF( ln_full_vel_array(ib_bdy) .AND. & 215 250 & ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR. & … … 217 252 218 253 igrd = 2 ! zonal velocity 219 dta _bdy(ib_bdy)%u2d(:) = 0._wp254 dta%u2d(:) = 0.0 220 255 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 221 256 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 222 257 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 223 258 DO ik = 1, jpkm1 224 dta _bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) &225 & + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta _bdy(ib_bdy)%u3d(ib,ik)259 dta%u2d(ib) = dta%u2d(ib) & 260 & + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 226 261 END DO 227 dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij) 228 DO ik = 1, jpkm1 229 dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib) 230 END DO 262 dta%u2d(ib) = dta%u2d(ib) * hur(ii,ij) 231 263 END DO 232 264 igrd = 3 ! meridional velocity 233 dta _bdy(ib_bdy)%v2d(:) = 0._wp265 dta%v2d(:) = 0.0 234 266 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 235 267 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 236 268 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 237 269 DO ik = 1, jpkm1 238 dta _bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) &239 & + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta _bdy(ib_bdy)%v3d(ib,ik)270 dta%v2d(ib) = dta%v2d(ib) & 271 & + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 240 272 END DO 241 dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij) 242 DO ik = 1, jpkm1 243 dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib) 244 END DO 273 dta%v2d(ib) = dta%v2d(ib) * hvr(ii,ij) 245 274 END DO 246 275 ENDIF 247 276 ENDIF 248 277 IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing 249 CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta _bdy(ib_bdy), td=tides(ib_bdy), &278 CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta, td=tides(ib_bdy), & 250 279 & jit=jit, time_offset=time_offset ) 251 280 ENDIF … … 253 282 ENDIF 254 283 ELSE 255 IF ( nn_tra(ib_bdy).eq.4) then ! runoff condition284 IF (cn_tra(ib_bdy) == 'runoff') then ! runoff condition 256 285 jend = nb_bdy_fld(ib_bdy) 257 286 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & … … 262 291 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 263 292 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 264 dta _bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) )293 dta%u2d(ib) = dta%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 265 294 END DO 266 295 ! … … 269 298 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 270 299 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 271 dta _bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) )300 dta%v2d(ib) = dta%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 272 301 END DO 273 302 ELSE 274 IF( nn_dyn2d (ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays275 dta_bdy(ib_bdy)%ssh(:) = 0._wp276 dta_bdy(ib_bdy)%u2d(:) = 0._wp277 dta_bdy(ib_bdy)%v2d(:) = 0._wp303 IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 304 IF( dta%ll_ssh ) dta%ssh(:) = 0.0 305 IF( dta%ll_u2d ) dta%u2d(:) = 0.0 306 IF( dta%ll_v2d ) dta%v2d(:) = 0.0 278 307 ENDIF 279 IF( nb_bdy_fld(ib_bdy) .gt. 0 ) THEN ! update external data280 jend = nb_bdy_fld(ib_bdy)308 IF( dta%nread(1) .gt. 0 ) THEN ! update external data 309 jend = jstart + dta%nread(1) - 1 281 310 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 282 311 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset ) … … 287 316 & nn_dyn3d_dta(ib_bdy) .EQ. 1 ) ) THEN 288 317 igrd = 2 ! zonal velocity 289 dta _bdy(ib_bdy)%u2d(:) = 0._wp318 dta%u2d(:) = 0.0 290 319 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 291 320 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 292 321 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 293 322 DO ik = 1, jpkm1 294 dta _bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) &295 & + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta _bdy(ib_bdy)%u3d(ib,ik)323 dta%u2d(ib) = dta%u2d(ib) & 324 & + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 296 325 END DO 297 dta _bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij)326 dta%u2d(ib) = dta%u2d(ib) * hur(ii,ij) 298 327 DO ik = 1, jpkm1 299 dta _bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib)328 dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib) 300 329 END DO 301 330 END DO 302 331 igrd = 3 ! meridional velocity 303 dta _bdy(ib_bdy)%v2d(:) = 0._wp332 dta%v2d(:) = 0.0 304 333 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 305 334 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 306 335 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 307 336 DO ik = 1, jpkm1 308 dta _bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) &309 & + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta _bdy(ib_bdy)%v3d(ib,ik)337 dta%v2d(ib) = dta%v2d(ib) & 338 & + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 310 339 END DO 311 dta _bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij)340 dta%v2d(ib) = dta%v2d(ib) * hvr(ii,ij) 312 341 DO ik = 1, jpkm1 313 dta _bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib)342 dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib) 314 343 END DO 315 344 END DO 316 345 ENDIF 317 ENDIF 318 ENDIF 319 jstart = jend+1 346 347 ENDIF 348 ENDIF 349 jstart = jstart + dta%nread(1) 320 350 END IF ! nn_dta(ib_bdy) = 1 321 351 END DO ! ib_bdy 322 352 353 ! bg jchanut tschanges 323 354 #if defined key_tide 324 355 ! Add tides if not split-explicit free surface else this is done in ts loop 325 356 IF (.NOT.lk_dynspg_ts) CALL bdy_dta_tides( kt=kt, time_offset=time_offset ) 326 357 #endif 358 ! end jchanut tschanges 359 327 360 IF ( ln_apr_obc ) THEN 328 361 DO ib_bdy = 1, nb_bdy 329 IF ( nn_tra(ib_bdy).NE.4)THEN362 IF (cn_tra(ib_bdy) /= 'runoff')THEN 330 363 igrd = 1 ! meridional velocity 331 364 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) … … 350 383 !! for open boundary conditions 351 384 !! 352 !! ** Method : Use fldread.F90385 !! ** Method : 353 386 !! 354 387 !!---------------------------------------------------------------------- … … 362 395 ! =F => baroclinic velocities in 3D boundary data 363 396 INTEGER :: ilen_global ! Max length required for global bdy dta arrays 364 INTEGER, DIMENSION(jpbgrd) :: ilen0 ! size of local arrays365 397 INTEGER, ALLOCATABLE, DIMENSION(:) :: ilen1, ilen3 ! size of 1st and 3rd dimensions of local arrays 366 398 INTEGER, ALLOCATABLE, DIMENSION(:) :: ibdy ! bdy set for a particular jfld 367 399 INTEGER, ALLOCATABLE, DIMENSION(:) :: igrid ! index for grid type (1,2,3 = T,U,V) 368 400 INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts 401 TYPE(OBC_DATA), POINTER :: dta ! short cut 369 402 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: blf_i ! array of namelist information structures 370 403 TYPE(FLD_N) :: bn_tem, bn_sal, bn_u3d, bn_v3d ! … … 404 437 nb_bdy_fld(:) = 0 405 438 DO ib_bdy = 1, nb_bdy 406 IF( nn_dyn2d(ib_bdy) .gt. 0.and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN439 IF( cn_dyn2d(ib_bdy) /= 'none' .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN 407 440 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 408 441 ENDIF 409 IF( nn_dyn3d(ib_bdy) .gt. 0.and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN442 IF( cn_dyn3d(ib_bdy) /= 'none' .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN 410 443 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 411 444 ENDIF 412 IF( nn_tra(ib_bdy) .gt. 0.and. nn_tra_dta(ib_bdy) .eq. 1 ) THEN445 IF( cn_tra(ib_bdy) /= 'none' .and. nn_tra_dta(ib_bdy) .eq. 1 ) THEN 413 446 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 414 447 ENDIF 415 448 #if defined key_lim2 416 IF( nn_ice_lim2(ib_bdy) .gt. 0.and. nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN449 IF( cn_ice_lim2(ib_bdy) /= 'none' .and. nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN 417 450 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 418 451 ENDIF … … 472 505 nblen => idx_bdy(ib_bdy)%nblen 473 506 nblenrim => idx_bdy(ib_bdy)%nblenrim 507 dta => dta_bdy(ib_bdy) 508 dta%nread(2) = 0 474 509 475 510 ! Only read in necessary fields for this set. 476 511 ! Important that barotropic variables come first. 477 IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN 478 479 IF( nn_dyn2d(ib_bdy) .ne. jp_frs .and. nn_tra(ib_bdy) .ne. 4 ) THEN ! runoff condition : no ssh reading 512 IF( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN 513 514 IF( dta%ll_ssh ) THEN 515 if(lwp) write(numout,*) '++++++ reading in ssh field' 480 516 jfld = jfld + 1 481 517 blf_i(jfld) = bn_ssh … … 484 520 ilen1(jfld) = nblen(igrid(jfld)) 485 521 ilen3(jfld) = 1 486 ENDIF 487 488 IF( .not. ln_full_vel_array(ib_bdy) ) THEN 522 dta%nread(2) = dta%nread(2) + 1 523 ENDIF 524 525 IF( dta%ll_u2d .and. .not. ln_full_vel_array(ib_bdy) ) THEN 526 if(lwp) write(numout,*) '++++++ reading in u2d field' 489 527 jfld = jfld + 1 490 528 blf_i(jfld) = bn_u2d … … 493 531 ilen1(jfld) = nblen(igrid(jfld)) 494 532 ilen3(jfld) = 1 495 533 dta%nread(2) = dta%nread(2) + 1 534 ENDIF 535 536 IF( dta%ll_v2d .and. .not. ln_full_vel_array(ib_bdy) ) THEN 537 if(lwp) write(numout,*) '++++++ reading in v2d field' 496 538 jfld = jfld + 1 497 539 blf_i(jfld) = bn_v2d … … 500 542 ilen1(jfld) = nblen(igrid(jfld)) 501 543 ilen3(jfld) = 1 502 ENDIF 503 504 ENDIF 505 506 ! baroclinic velocities 507 IF( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) .or. & 508 & ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and. & 509 & ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 510 511 jfld = jfld + 1 512 blf_i(jfld) = bn_u3d 513 ibdy(jfld) = ib_bdy 514 igrid(jfld) = 2 515 ilen1(jfld) = nblen(igrid(jfld)) 516 ilen3(jfld) = jpk 517 518 jfld = jfld + 1 519 blf_i(jfld) = bn_v3d 520 ibdy(jfld) = ib_bdy 521 igrid(jfld) = 3 522 ilen1(jfld) = nblen(igrid(jfld)) 523 ilen3(jfld) = jpk 544 dta%nread(2) = dta%nread(2) + 1 545 ENDIF 546 547 ENDIF 548 549 ! read 3D velocities if baroclinic velocities require OR if 550 ! barotropic velocities required and ln_full_vel set to .true. 551 IF( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. & 552 & ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 553 554 IF( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 555 if(lwp) write(numout,*) '++++++ reading in u3d field' 556 jfld = jfld + 1 557 blf_i(jfld) = bn_u3d 558 ibdy(jfld) = ib_bdy 559 igrid(jfld) = 2 560 ilen1(jfld) = nblen(igrid(jfld)) 561 ilen3(jfld) = jpk 562 IF( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) dta%nread(2) = dta%nread(2) + 1 563 ENDIF 564 565 IF( dta%ll_v3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN 566 if(lwp) write(numout,*) '++++++ reading in v3d field' 567 jfld = jfld + 1 568 blf_i(jfld) = bn_v3d 569 ibdy(jfld) = ib_bdy 570 igrid(jfld) = 3 571 ilen1(jfld) = nblen(igrid(jfld)) 572 ilen3(jfld) = jpk 573 IF( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) dta%nread(2) = dta%nread(2) + 1 574 ENDIF 524 575 525 576 ENDIF 526 577 527 578 ! temperature and salinity 528 IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1 ) THEN 529 530 jfld = jfld + 1 531 blf_i(jfld) = bn_tem 532 ibdy(jfld) = ib_bdy 533 igrid(jfld) = 1 534 ilen1(jfld) = nblen(igrid(jfld)) 535 ilen3(jfld) = jpk 536 537 jfld = jfld + 1 538 blf_i(jfld) = bn_sal 539 ibdy(jfld) = ib_bdy 540 igrid(jfld) = 1 541 ilen1(jfld) = nblen(igrid(jfld)) 542 ilen3(jfld) = jpk 579 IF( nn_tra_dta(ib_bdy) .eq. 1 ) THEN 580 581 IF( dta%ll_tem ) THEN 582 if(lwp) write(numout,*) '++++++ reading in tem field' 583 jfld = jfld + 1 584 blf_i(jfld) = bn_tem 585 ibdy(jfld) = ib_bdy 586 igrid(jfld) = 1 587 ilen1(jfld) = nblen(igrid(jfld)) 588 ilen3(jfld) = jpk 589 ENDIF 590 591 IF( dta%ll_sal ) THEN 592 if(lwp) write(numout,*) '++++++ reading in sal field' 593 jfld = jfld + 1 594 blf_i(jfld) = bn_sal 595 ibdy(jfld) = ib_bdy 596 igrid(jfld) = 1 597 ilen1(jfld) = nblen(igrid(jfld)) 598 ilen3(jfld) = jpk 599 ENDIF 543 600 544 601 ENDIF … … 546 603 #if defined key_lim2 547 604 ! sea ice 548 IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN 549 550 jfld = jfld + 1 551 blf_i(jfld) = bn_frld 552 ibdy(jfld) = ib_bdy 553 igrid(jfld) = 1 554 ilen1(jfld) = nblen(igrid(jfld)) 555 ilen3(jfld) = 1 556 557 jfld = jfld + 1 558 blf_i(jfld) = bn_hicif 559 ibdy(jfld) = ib_bdy 560 igrid(jfld) = 1 561 ilen1(jfld) = nblen(igrid(jfld)) 562 ilen3(jfld) = 1 563 564 jfld = jfld + 1 565 blf_i(jfld) = bn_hsnif 566 ibdy(jfld) = ib_bdy 567 igrid(jfld) = 1 568 ilen1(jfld) = nblen(igrid(jfld)) 569 ilen3(jfld) = 1 605 IF( nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN 606 607 IF( dta%ll_frld ) THEN 608 jfld = jfld + 1 609 blf_i(jfld) = bn_frld 610 ibdy(jfld) = ib_bdy 611 igrid(jfld) = 1 612 ilen1(jfld) = nblen(igrid(jfld)) 613 ilen3(jfld) = 1 614 ENDIF 615 616 IF( dta%ll_hicif ) THEN 617 jfld = jfld + 1 618 blf_i(jfld) = bn_hicif 619 ibdy(jfld) = ib_bdy 620 igrid(jfld) = 1 621 ilen1(jfld) = nblen(igrid(jfld)) 622 ilen3(jfld) = 1 623 ENDIF 624 625 IF( dta%ll_hsnif ) THEN 626 jfld = jfld + 1 627 blf_i(jfld) = bn_hsnif 628 ibdy(jfld) = ib_bdy 629 igrid(jfld) = 1 630 ilen1(jfld) = nblen(igrid(jfld)) 631 ilen3(jfld) = 1 632 ENDIF 570 633 571 634 ENDIF … … 582 645 ENDIF 583 646 647 dta%nread(1) = nb_bdy_fld(ib_bdy) 648 584 649 ENDIF ! nn_dta .eq. 1 585 650 ENDDO ! ib_bdy … … 610 675 611 676 nblen => idx_bdy(ib_bdy)%nblen 612 nblenrim => idx_bdy(ib_bdy)%nblenrim 613 614 IF (nn_dyn2d(ib_bdy) .gt. 0) THEN 615 IF( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 .or. ln_full_vel_array(ib_bdy) ) THEN 616 ilen0(1:3) = nblen(1:3) 617 ALLOCATE( dta_bdy(ib_bdy)%u2d(ilen0(2)) ) 618 ALLOCATE( dta_bdy(ib_bdy)%v2d(ilen0(3)) ) 619 IF ( nn_dyn2d(ib_bdy) .ne. jp_frs .and. (nn_dyn2d_dta(ib_bdy).eq.1.or.nn_dyn2d_dta(ib_bdy).eq.3) ) THEN 620 jfld = jfld + 1 621 dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1) 677 dta => dta_bdy(ib_bdy) 678 679 if(lwp) then 680 write(numout,*) '++++++ dta%ll_ssh = ',dta%ll_ssh 681 write(numout,*) '++++++ dta%ll_u2d = ',dta%ll_u2d 682 write(numout,*) '++++++ dta%ll_v2d = ',dta%ll_v2d 683 write(numout,*) '++++++ dta%ll_u3d = ',dta%ll_u3d 684 write(numout,*) '++++++ dta%ll_v3d = ',dta%ll_v3d 685 write(numout,*) '++++++ dta%ll_tem = ',dta%ll_tem 686 write(numout,*) '++++++ dta%ll_sal = ',dta%ll_sal 687 endif 688 689 IF ( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN 690 if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space' 691 IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) ) 692 IF( dta%ll_u2d ) ALLOCATE( dta%u2d(nblen(2)) ) 693 IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) ) 694 ENDIF 695 IF ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN 696 IF( dta%ll_ssh ) THEN 697 if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow' 698 jfld = jfld + 1 699 dta%ssh => bf(jfld)%fnow(:,1,1) 700 ENDIF 701 IF ( dta%ll_u2d ) THEN 702 IF ( ln_full_vel_array(ib_bdy) ) THEN 703 if(lwp) write(numout,*) '++++++ dta%u2d allocated space' 704 ALLOCATE( dta%u2d(nblen(2)) ) 622 705 ELSE 623 ALLOCATE( dta_bdy(ib_bdy)%ssh(nblen(1)) ) 624 ENDIF 625 ELSE 626 IF( nn_dyn2d(ib_bdy) .ne. jp_frs ) THEN 627 jfld = jfld + 1 628 dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1) 629 ENDIF 706 if(lwp) write(numout,*) '++++++ dta%u2d pointing to fnow' 707 jfld = jfld + 1 708 dta%u2d => bf(jfld)%fnow(:,1,1) 709 ENDIF 710 ENDIF 711 IF ( dta%ll_v2d ) THEN 712 IF ( ln_full_vel_array(ib_bdy) ) THEN 713 if(lwp) write(numout,*) '++++++ dta%v2d allocated space' 714 ALLOCATE( dta%v2d(nblen(3)) ) 715 ELSE 716 if(lwp) write(numout,*) '++++++ dta%v2d pointing to fnow' 717 jfld = jfld + 1 718 dta%v2d => bf(jfld)%fnow(:,1,1) 719 ENDIF 720 ENDIF 721 ENDIF 722 723 IF ( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 724 if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space' 725 IF( dta%ll_u3d ) ALLOCATE( dta_bdy(ib_bdy)%u3d(nblen(2),jpk) ) 726 IF( dta%ll_v3d ) ALLOCATE( dta_bdy(ib_bdy)%v3d(nblen(3),jpk) ) 727 ENDIF 728 IF ( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. & 729 & ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 730 IF ( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 731 if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow' 630 732 jfld = jfld + 1 631 dta_bdy(ib_bdy)%u2d => bf(jfld)%fnow(:,1,1) 733 dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:) 734 ENDIF 735 IF ( dta%ll_v3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN 736 if(lwp) write(numout,*) '++++++ dta%v3d pointing to fnow' 632 737 jfld = jfld + 1 633 dta_bdy(ib_bdy)%v2d => bf(jfld)%fnow(:,1,1) 634 ENDIF 635 ENDIF 636 637 IF ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 638 ilen0(1:3) = nblen(1:3) 639 ALLOCATE( dta_bdy(ib_bdy)%u3d(ilen0(2),jpk) ) 640 ALLOCATE( dta_bdy(ib_bdy)%v3d(ilen0(3),jpk) ) 641 ENDIF 642 IF ( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ).or. & 643 & ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and. & 644 & ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 645 jfld = jfld + 1 646 dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:) 647 jfld = jfld + 1 648 dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:) 649 ENDIF 650 651 IF (nn_tra(ib_bdy) .gt. 0) THEN 652 IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 653 ilen0(1:3) = nblen(1:3) 654 ALLOCATE( dta_bdy(ib_bdy)%tem(ilen0(1),jpk) ) 655 ALLOCATE( dta_bdy(ib_bdy)%sal(ilen0(1),jpk) ) 656 ELSE 738 dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:) 739 ENDIF 740 ENDIF 741 742 IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 743 if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space' 744 IF( dta%ll_tem ) ALLOCATE( dta_bdy(ib_bdy)%tem(nblen(1),jpk) ) 745 IF( dta%ll_sal ) ALLOCATE( dta_bdy(ib_bdy)%sal(nblen(1),jpk) ) 746 ELSE 747 IF( dta%ll_tem ) THEN 748 if(lwp) write(numout,*) '++++++ dta%tem pointing to fnow' 657 749 jfld = jfld + 1 658 750 dta_bdy(ib_bdy)%tem => bf(jfld)%fnow(:,1,:) 751 ENDIF 752 IF( dta%ll_sal ) THEN 753 if(lwp) write(numout,*) '++++++ dta%sal pointing to fnow' 659 754 jfld = jfld + 1 660 755 dta_bdy(ib_bdy)%sal => bf(jfld)%fnow(:,1,:) … … 665 760 IF (nn_ice_lim2(ib_bdy) .gt. 0) THEN 666 761 IF( nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN 667 ilen0(1:3) = nblen(1:3) 668 ALLOCATE( dta_bdy(ib_bdy)%frld(ilen0(1)) ) 669 ALLOCATE( dta_bdy(ib_bdy)%hicif(ilen0(1)) ) 670 ALLOCATE( dta_bdy(ib_bdy)%hsnif(ilen0(1)) ) 762 ALLOCATE( dta_bdy(ib_bdy)%frld(nblen(1)) ) 763 ALLOCATE( dta_bdy(ib_bdy)%hicif(nblen(1)) ) 764 ALLOCATE( dta_bdy(ib_bdy)%hsnif(nblen(1)) ) 671 765 ELSE 672 766 jfld = jfld + 1
Note: See TracChangeset
for help on using the changeset viewer.
