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