Changeset 10957
- Timestamp:
- 2019-05-10T12:26:38+02:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/BDY/bdydta.F90
r10647 r10957 65 65 CONTAINS 66 66 67 SUBROUTINE bdy_dta( kt, jit, time_offset )67 SUBROUTINE bdy_dta( kt, Kmm, time_offset ) 68 68 !!---------------------------------------------------------------------- 69 69 !! *** SUBROUTINE bdy_dta *** … … 75 75 !!---------------------------------------------------------------------- 76 76 INTEGER, INTENT(in) :: kt ! ocean time-step index 77 INTEGER, INTENT(in) , OPTIONAL :: jit ! subcycle time-step index (for timesplitting option)77 INTEGER, INTENT(in) :: Kmm ! ocean time level index 78 78 INTEGER, INTENT(in), OPTIONAL :: time_offset ! time offset in units of timesteps. NB. if jit 79 79 ! ! is present then units = subcycle timesteps. … … 94 94 ! Initialise data arrays once for all from initial conditions where required 95 95 !--------------------------------------------------------------------------- 96 IF( kt == nit000 .AND. .NOT.PRESENT(jit)) THEN96 IF( kt == nit000 ) THEN 97 97 98 98 ! Calculate depth-mean currents … … 112 112 ii = idx_bdy(jbdy)%nbi(ib,igrd) 113 113 ij = idx_bdy(jbdy)%nbj(ib,igrd) 114 dta_bdy(jbdy)%ssh(ib) = ssh n(ii,ij) * tmask(ii,ij,1)114 dta_bdy(jbdy)%ssh(ib) = ssh(ii,ij,Kmm) * tmask(ii,ij,1) 115 115 END DO 116 116 ENDIF … … 120 120 ii = idx_bdy(jbdy)%nbi(ib,igrd) 121 121 ij = idx_bdy(jbdy)%nbj(ib,igrd) 122 dta_bdy(jbdy)%u2d(ib) = u n_b(ii,ij) * umask(ii,ij,1)122 dta_bdy(jbdy)%u2d(ib) = uu_b(ii,ij,Kmm) * umask(ii,ij,1) 123 123 END DO 124 124 ENDIF … … 128 128 ii = idx_bdy(jbdy)%nbi(ib,igrd) 129 129 ij = idx_bdy(jbdy)%nbj(ib,igrd) 130 dta_bdy(jbdy)%v2d(ib) = v n_b(ii,ij) * vmask(ii,ij,1)130 dta_bdy(jbdy)%v2d(ib) = vv_b(ii,ij,Kmm) * vmask(ii,ij,1) 131 131 END DO 132 132 ENDIF … … 141 141 ii = idx_bdy(jbdy)%nbi(ib,igrd) 142 142 ij = idx_bdy(jbdy)%nbj(ib,igrd) 143 dta_bdy(jbdy)%u3d(ib,ik) = ( u n(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik)143 dta_bdy(jbdy)%u3d(ib,ik) = ( uu(ii,ij,ik,Kmm) - uu_b(ii,ij,Kmm) ) * umask(ii,ij,ik) 144 144 END DO 145 145 END DO … … 151 151 ii = idx_bdy(jbdy)%nbi(ib,igrd) 152 152 ij = idx_bdy(jbdy)%nbj(ib,igrd) 153 dta_bdy(jbdy)%v3d(ib,ik) = ( v n(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik)153 dta_bdy(jbdy)%v3d(ib,ik) = ( vv(ii,ij,ik,Kmm) - vv_b(ii,ij,Kmm) ) * vmask(ii,ij,ik) 154 154 END DO 155 155 END DO … … 165 165 ii = idx_bdy(jbdy)%nbi(ib,igrd) 166 166 ij = idx_bdy(jbdy)%nbj(ib,igrd) 167 dta_bdy(jbdy)%tem(ib,ik) = ts n(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)167 dta_bdy(jbdy)%tem(ib,ik) = ts(ii,ij,ik,jp_tem,Kmm) * tmask(ii,ij,ik) 168 168 END DO 169 169 END DO … … 175 175 ii = idx_bdy(jbdy)%nbi(ib,igrd) 176 176 ij = idx_bdy(jbdy)%nbj(ib,igrd) 177 dta_bdy(jbdy)%sal(ib,ik) = ts n(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)177 dta_bdy(jbdy)%sal(ib,ik) = ts(ii,ij,ik,jp_sal,Kmm) * tmask(ii,ij,ik) 178 178 END DO 179 179 END DO … … 227 227 dta => dta_bdy(jbdy) 228 228 IF( nn_dta(jbdy) == 1 ) THEN ! skip this bit if no external data required 229 230 IF( PRESENT(jit) ) THEN 231 ! Update barotropic boundary conditions only 232 ! jit is optional argument for fld_read and bdytide_update 233 IF( cn_dyn2d(jbdy) /= 'none' ) THEN 234 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 235 IF( dta%ll_ssh ) dta%ssh(:) = 0._wp 236 IF( dta%ll_u2d ) dta%u2d(:) = 0._wp 237 IF( dta%ll_u3d ) dta%v2d(:) = 0._wp 238 ENDIF 239 IF (cn_tra(jbdy) /= 'runoff') THEN 240 IF( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 ) THEN 241 242 jend = jstart + dta%nread(2) - 1 243 IF( ln_full_vel_array(jbdy) ) THEN 244 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), & 245 & kit=jit, kt_offset=time_offset , jpk_bdy=nb_jpk_bdy, & 246 & fvl=ln_full_vel_array(jbdy) ) 247 ELSE 248 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), & 249 & kit=jit, kt_offset=time_offset ) 250 ENDIF 251 252 ! If full velocities in boundary data then extract barotropic velocities from 3D fields 253 IF( ln_full_vel_array(jbdy) .AND. & 254 & ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 .OR. & 255 & nn_dyn3d_dta(jbdy) == 1 ) )THEN 256 257 igrd = 2 ! zonal velocity 258 dta%u2d(:) = 0._wp 259 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 260 ii = idx_bdy(jbdy)%nbi(ib,igrd) 261 ij = idx_bdy(jbdy)%nbj(ib,igrd) 262 DO ik = 1, jpkm1 263 dta%u2d(ib) = dta%u2d(ib) & 264 & + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 265 END DO 266 dta%u2d(ib) = dta%u2d(ib) * r1_hu_n(ii,ij) 267 END DO 268 igrd = 3 ! meridional velocity 269 dta%v2d(:) = 0._wp 270 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 271 ii = idx_bdy(jbdy)%nbi(ib,igrd) 272 ij = idx_bdy(jbdy)%nbj(ib,igrd) 273 DO ik = 1, jpkm1 274 dta%v2d(ib) = dta%v2d(ib) & 275 & + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 276 END DO 277 dta%v2d(ib) = dta%v2d(ib) * r1_hv_n(ii,ij) 278 END DO 279 ENDIF 280 ENDIF 281 IF( nn_dyn2d_dta(jbdy) .ge. 2 ) THEN ! update tidal harmonic forcing 282 CALL bdytide_update( kt=kt, idx=idx_bdy(jbdy), dta=dta, td=tides(jbdy), & 283 & jit=jit, time_offset=time_offset ) 284 ENDIF 285 ENDIF 286 ENDIF 229 IF (cn_tra(jbdy) == 'runoff') then ! runoff condition 230 jend = nb_bdy_fld(jbdy) 231 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 232 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset ) 233 ! 234 igrd = 2 ! zonal velocity 235 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 236 ii = idx_bdy(jbdy)%nbi(ib,igrd) 237 ij = idx_bdy(jbdy)%nbj(ib,igrd) 238 dta%u2d(ib) = dta%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 239 END DO 240 ! 241 igrd = 3 ! meridional velocity 242 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 243 ii = idx_bdy(jbdy)%nbi(ib,igrd) 244 ij = idx_bdy(jbdy)%nbj(ib,igrd) 245 dta%v2d(ib) = dta%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 246 END DO 287 247 ELSE 288 IF (cn_tra(jbdy) == 'runoff') then ! runoff condition 289 jend = nb_bdy_fld(jbdy) 290 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 291 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset ) 292 ! 248 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 249 IF( dta%ll_ssh ) dta%ssh(:) = 0._wp 250 IF( dta%ll_u2d ) dta%u2d(:) = 0._wp 251 IF( dta%ll_v2d ) dta%v2d(:) = 0._wp 252 ENDIF 253 IF( dta%nread(1) .gt. 0 ) THEN ! update external data 254 jend = jstart + dta%nread(1) - 1 255 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 256 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy, & 257 & fvl=ln_full_vel_array(jbdy) ) 258 ENDIF 259 ! If full velocities in boundary data then split into barotropic and baroclinic data 260 IF( ln_full_vel_array(jbdy) .and. & 261 & ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 .OR. & 262 & nn_dyn3d_dta(jbdy) == 1 ) ) THEN 293 263 igrd = 2 ! zonal velocity 264 dta%u2d(:) = 0._wp 294 265 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 295 266 ii = idx_bdy(jbdy)%nbi(ib,igrd) 296 267 ij = idx_bdy(jbdy)%nbj(ib,igrd) 297 dta%u2d(ib) = dta%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 268 DO ik = 1, jpkm1 269 dta%u2d(ib) = dta%u2d(ib) & 270 & + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta%u3d(ib,ik) 271 END DO 272 dta%u2d(ib) = dta%u2d(ib) * r1_hu_n(ii,ij) 273 DO ik = 1, jpkm1 274 dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib) 275 END DO 298 276 END DO 299 !300 277 igrd = 3 ! meridional velocity 278 dta%v2d(:) = 0._wp 301 279 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 302 280 ii = idx_bdy(jbdy)%nbi(ib,igrd) 303 281 ij = idx_bdy(jbdy)%nbj(ib,igrd) 304 dta%v2d(ib) = dta%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 282 DO ik = 1, jpkm1 283 dta%v2d(ib) = dta%v2d(ib) & 284 & + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 285 END DO 286 dta%v2d(ib) = dta%v2d(ib) * r1_hv_n(ii,ij) 287 DO ik = 1, jpkm1 288 dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib) 289 END DO 305 290 END DO 306 ELSE 307 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 308 IF( dta%ll_ssh ) dta%ssh(:) = 0._wp 309 IF( dta%ll_u2d ) dta%u2d(:) = 0._wp 310 IF( dta%ll_v2d ) dta%v2d(:) = 0._wp 311 ENDIF 312 IF( dta%nread(1) .gt. 0 ) THEN ! update external data 313 jend = jstart + dta%nread(1) - 1 314 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 315 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy, & 316 & fvl=ln_full_vel_array(jbdy) ) 317 ENDIF 318 ! If full velocities in boundary data then split into barotropic and baroclinic data 319 IF( ln_full_vel_array(jbdy) .and. & 320 & ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 .OR. & 321 & nn_dyn3d_dta(jbdy) == 1 ) ) THEN 322 igrd = 2 ! zonal velocity 323 dta%u2d(:) = 0._wp 324 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 325 ii = idx_bdy(jbdy)%nbi(ib,igrd) 326 ij = idx_bdy(jbdy)%nbj(ib,igrd) 327 DO ik = 1, jpkm1 328 dta%u2d(ib) = dta%u2d(ib) & 329 & + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 330 END DO 331 dta%u2d(ib) = dta%u2d(ib) * r1_hu_n(ii,ij) 332 DO ik = 1, jpkm1 333 dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib) 334 END DO 335 END DO 336 igrd = 3 ! meridional velocity 337 dta%v2d(:) = 0._wp 338 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 339 ii = idx_bdy(jbdy)%nbi(ib,igrd) 340 ij = idx_bdy(jbdy)%nbj(ib,igrd) 341 DO ik = 1, jpkm1 342 dta%v2d(ib) = dta%v2d(ib) & 343 & + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 344 END DO 345 dta%v2d(ib) = dta%v2d(ib) * r1_hv_n(ii,ij) 346 DO ik = 1, jpkm1 347 dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib) 348 END DO 349 END DO 350 ENDIF 351 352 ENDIF 353 #if defined key_si3 354 ! convert N-cat fields (input) into jpl-cat (output) 355 IF( cn_ice(jbdy) /= 'none' .AND. nn_ice_dta(jbdy) == 1 ) THEN 356 jfld_hti = jfld_htit(jbdy) 357 jfld_hts = jfld_htst(jbdy) 358 jfld_ai = jfld_ait(jbdy) 359 IF ( jpl /= 1 .AND. nice_cat == 1 ) THEN ! case input cat = 1 360 CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 361 & dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i ) 362 ELSEIF( jpl /= 1 .AND. nice_cat /= 1 .AND. nice_cat /= jpl ) THEN ! case input cat /=1 and /=jpl 363 CALL ice_var_itd2( bf(jfld_hti)%fnow(:,1,:), bf(jfld_hts)%fnow(:,1,:), bf(jfld_ai)%fnow(:,1,:), & 364 & dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i ) 365 ENDIF 366 ENDIF 367 #endif 368 ENDIF 291 ENDIF 292 293 ENDIF 294 #if defined key_si3 295 ! convert N-cat fields (input) into jpl-cat (output) 296 IF( cn_ice(jbdy) /= 'none' .AND. nn_ice_dta(jbdy) == 1 ) THEN 297 jfld_hti = jfld_htit(jbdy) 298 jfld_hts = jfld_htst(jbdy) 299 jfld_ai = jfld_ait(jbdy) 300 IF ( jpl /= 1 .AND. nice_cat == 1 ) THEN ! case input cat = 1 301 CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 302 & dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i ) 303 ELSEIF( jpl /= 1 .AND. nice_cat /= 1 .AND. nice_cat /= jpl ) THEN ! case input cat /=1 and /=jpl 304 CALL ice_var_itd2( bf(jfld_hti)%fnow(:,1,:), bf(jfld_hts)%fnow(:,1,:), bf(jfld_ai)%fnow(:,1,:), & 305 & dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i ) 306 ENDIF 307 ENDIF 308 #endif 369 309 jstart = jstart + dta%nread(1) 370 310 ENDIF ! nn_dta(jbdy) = 1 -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/BDY/bdydyn.F90
r10068 r10957 37 37 CONTAINS 38 38 39 SUBROUTINE bdy_dyn( kt, dyn3d_only )39 SUBROUTINE bdy_dyn( kt, Kbb, puu, pvv, Kaa, dyn3d_only ) 40 40 !!---------------------------------------------------------------------- 41 41 !! *** SUBROUTINE bdy_dyn *** … … 44 44 !! 45 45 !!---------------------------------------------------------------------- 46 INTEGER, INTENT(in) :: kt ! Main time step counter 47 LOGICAL, INTENT(in), OPTIONAL :: dyn3d_only ! T => only update baroclinic velocities 46 INTEGER , INTENT(in) :: kt ! Main time step counter 47 INTEGER , INTENT(in) :: Kbb, Kaa ! Ocean time level indices 48 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! Ocean velocities (to be updated at open boundaries) 49 LOGICAL, OPTIONAL , INTENT(in) :: dyn3d_only ! T => only update baroclinic velocities 48 50 ! 49 51 INTEGER :: jk, ii, ij, ib_bdy, ib, igrd ! Loop counter 50 52 LOGICAL :: ll_dyn2d, ll_dyn3d, ll_orlanski 51 REAL(wp), DIMENSION(jpi,jpj) :: pua2d, pva2d ! after barotropic velocities53 REAL(wp), DIMENSION(jpi,jpj) :: zua2d, zva2d ! after barotropic velocities 52 54 !!---------------------------------------------------------------------- 53 55 ! … … 70 72 71 73 ! ! "After" velocities: 72 pua2d(:,:) = 0._wp73 pva2d(:,:) = 0._wp74 zua2d(:,:) = 0._wp 75 zva2d(:,:) = 0._wp 74 76 DO jk = 1, jpkm1 75 pua2d(:,:) = pua2d(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)76 pva2d(:,:) = pva2d(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)77 zua2d(:,:) = zua2d(:,:) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 78 zva2d(:,:) = zva2d(:,:) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 77 79 END DO 78 pua2d(:,:) = pua2d(:,:) * r1_hu_a(:,:)79 pva2d(:,:) = pva2d(:,:) * r1_hv_a(:,:)80 zua2d(:,:) = zua2d(:,:) * r1_hu_a(:,:) 81 zva2d(:,:) = zva2d(:,:) * r1_hv_a(:,:) 80 82 81 83 DO jk = 1 , jpkm1 82 ua(:,:,jk) = ( ua(:,:,jk) - pua2d(:,:) ) * umask(:,:,jk)83 va(:,:,jk) = ( va(:,:,jk) - pva2d(:,:) ) * vmask(:,:,jk)84 puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kaa) - zua2d(:,:) ) * umask(:,:,jk) 85 pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kaa) - zva2d(:,:) ) * vmask(:,:,jk) 84 86 END DO 85 87 … … 87 89 IF( ll_orlanski ) THEN ! "Before" velocities (Orlanski condition only) 88 90 DO jk = 1 , jpkm1 89 ub(:,:,jk) = ( ub(:,:,jk) - ub_b(:,:) ) * umask(:,:,jk)90 vb(:,:,jk) = ( vb(:,:,jk) - vb_b(:,:) ) * vmask(:,:,jk)91 puu(:,:,jk,Kbb) = ( puu(:,:,jk,Kbb) - uu_b(:,:,Kbb) ) * umask(:,:,jk) 92 pvv(:,:,jk,Kbb) = ( pvv(:,:,jk,Kbb) - vv_b(:,:,Kbb) ) * vmask(:,:,jk) 91 93 END DO 92 94 ENDIF … … 97 99 !------------------------------------------------------- 98 100 99 IF( ll_dyn2d ) CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, r1_hu_a(:,:), r1_hv_a(:,:), ssha)101 IF( ll_dyn2d ) CALL bdy_dyn2d( kt, zua2d, zva2d, uu_b(:,:,Kbb), vv_b(:,:,Kbb), r1_hu_a(:,:), r1_hv_a(:,:), ssh(:,:,Kaa) ) 100 102 101 IF( ll_dyn3d ) CALL bdy_dyn3d( kt )103 IF( ll_dyn3d ) CALL bdy_dyn3d( kt, Kbb, puu, pvv, Kaa ) 102 104 103 105 !------------------------------------------------------- … … 106 108 ! 107 109 DO jk = 1 , jpkm1 108 ua(:,:,jk) = ( ua(:,:,jk) + pua2d(:,:) ) * umask(:,:,jk)109 va(:,:,jk) = ( va(:,:,jk) + pva2d(:,:) ) * vmask(:,:,jk)110 puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kaa) + zua2d(:,:) ) * umask(:,:,jk) 111 pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kaa) + zva2d(:,:) ) * vmask(:,:,jk) 110 112 END DO 111 113 ! 112 114 IF ( ll_orlanski ) THEN 113 115 DO jk = 1 , jpkm1 114 ub(:,:,jk) = ( ub(:,:,jk) + ub_b(:,:) ) * umask(:,:,jk)115 vb(:,:,jk) = ( vb(:,:,jk) + vb_b(:,:) ) * vmask(:,:,jk)116 puu(:,:,jk,Kbb) = ( puu(:,:,jk,Kbb) + uu_b(:,:,Kbb) ) * umask(:,:,jk) 117 pvv(:,:,jk,Kbb) = ( pvv(:,:,jk,Kbb) + vv_b(:,:,Kbb) ) * vmask(:,:,jk) 116 118 END DO 117 119 END IF -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/BDY/bdydyn3d.F90
r10529 r10957 33 33 CONTAINS 34 34 35 SUBROUTINE bdy_dyn3d( kt )35 SUBROUTINE bdy_dyn3d( kt, Kbb, puu, pvv, Kaa ) 36 36 !!---------------------------------------------------------------------- 37 37 !! *** SUBROUTINE bdy_dyn3d *** … … 40 40 !! 41 41 !!---------------------------------------------------------------------- 42 INTEGER, INTENT(in) :: kt ! Main time step counter 42 INTEGER , INTENT( in ) :: kt ! Main time step counter 43 INTEGER , INTENT( in ) :: Kbb, Kaa ! Time level indices 44 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries) 43 45 ! 44 46 INTEGER :: ib_bdy ! loop index … … 49 51 SELECT CASE( cn_dyn3d(ib_bdy) ) 50 52 CASE('none') ; CYCLE 51 CASE('frs' ) ; CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )52 CASE('specified') ; CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )53 CASE('zero') ; CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )54 CASE('orlanski' ) ; CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. )55 CASE('orlanski_npo'); CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. )56 CASE('zerograd') ; CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )57 CASE('neumann') ; CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy )53 CASE('frs' ) ; CALL bdy_dyn3d_frs( puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 54 CASE('specified') ; CALL bdy_dyn3d_spe( puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 55 CASE('zero') ; CALL bdy_dyn3d_zro( puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 56 CASE('orlanski' ) ; CALL bdy_dyn3d_orlanski( Kbb, puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 57 CASE('orlanski_npo'); CALL bdy_dyn3d_orlanski( Kbb, puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 58 CASE('zerograd') ; CALL bdy_dyn3d_zgrad( puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 59 CASE('neumann') ; CALL bdy_dyn3d_nmn( puu, pvv, Kaa, idx_bdy(ib_bdy), ib_bdy ) 58 60 CASE DEFAULT ; CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 59 61 END SELECT … … 63 65 64 66 65 SUBROUTINE bdy_dyn3d_spe( idx, dta, kt, ib_bdy )67 SUBROUTINE bdy_dyn3d_spe( puu, pvv, Kaa, idx, dta, ib_bdy ) 66 68 !!---------------------------------------------------------------------- 67 69 !! *** SUBROUTINE bdy_dyn3d_spe *** … … 71 73 !! 72 74 !!---------------------------------------------------------------------- 73 INTEGER , INTENT(in) :: kt ! time step index 74 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 75 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 76 INTEGER , INTENT(in) :: ib_bdy ! BDY set index 75 INTEGER , INTENT( in ) :: Kaa ! Time level index 76 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries) 77 TYPE(OBC_INDEX) , INTENT( in ) :: idx ! OBC indices 78 TYPE(OBC_DATA) , INTENT( in ) :: dta ! OBC external data 79 INTEGER , INTENT( in ) :: ib_bdy ! BDY set index 77 80 ! 78 81 INTEGER :: jb, jk ! dummy loop indices … … 86 89 ii = idx%nbi(jb,igrd) 87 90 ij = idx%nbj(jb,igrd) 88 ua(ii,ij,jk) = dta%u3d(jb,jk) * umask(ii,ij,jk)91 puu(ii,ij,jk,Kaa) = dta%u3d(jb,jk) * umask(ii,ij,jk) 89 92 END DO 90 93 END DO … … 95 98 ii = idx%nbi(jb,igrd) 96 99 ij = idx%nbj(jb,igrd) 97 va(ii,ij,jk) = dta%v3d(jb,jk) * vmask(ii,ij,jk) 98 END DO 99 END DO 100 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 101 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 102 ! 103 IF( kt == nit000 ) CLOSE( unit = 102 ) 100 pvv(ii,ij,jk,Kaa) = dta%v3d(jb,jk) * vmask(ii,ij,jk) 101 END DO 102 END DO 103 CALL lbc_bdy_lnk( 'bdydyn3d', puu(:,:,:,Kaa), 'U', -1., ib_bdy ) ! Boundary points should be updated 104 CALL lbc_bdy_lnk( 'bdydyn3d', pvv(:,:,:,Kaa), 'V', -1., ib_bdy ) 104 105 ! 105 106 END SUBROUTINE bdy_dyn3d_spe 106 107 107 108 108 SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt, ib_bdy )109 SUBROUTINE bdy_dyn3d_zgrad( puu, pvv, Kaa, idx, dta, ib_bdy ) 109 110 !!---------------------------------------------------------------------- 110 111 !! *** SUBROUTINE bdy_dyn3d_zgrad *** … … 113 114 !! 114 115 !!---------------------------------------------------------------------- 115 INTEGER :: kt 116 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 117 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 118 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 116 INTEGER , INTENT( in ) :: Kaa ! Time level index 117 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries) 118 TYPE(OBC_INDEX) , INTENT( in ) :: idx ! OBC indices 119 TYPE(OBC_DATA) , INTENT( in ) :: dta ! OBC external data 120 INTEGER , INTENT( in ) :: ib_bdy ! BDY set index 119 121 !! 120 122 INTEGER :: jb, jk ! dummy loop indices … … 130 132 ij = idx%nbj(jb,igrd) 131 133 fu = ABS( ABS (NINT( idx%flagu(jb,igrd) ) ) - 1 ) 132 ua(ii,ij,jk) = ua(ii,ij,jk) * REAL( 1 - fu) + ( ua(ii,ij+fu,jk) * umask(ii,ij+fu,jk) &133 &+ ua(ii,ij-fu,jk) * umask(ii,ij-fu,jk) ) * umask(ii,ij,jk) * REAL( fu )134 puu(ii,ij,jk,Kaa) = puu(ii,ij,jk,Kaa) * REAL( 1 - fu) + ( puu(ii,ij+fu,jk,Kaa) * umask(ii,ij+fu,jk) & 135 &+ puu(ii,ij-fu,jk,Kaa) * umask(ii,ij-fu,jk) ) * umask(ii,ij,jk) * REAL( fu ) 134 136 END DO 135 137 END DO … … 141 143 ij = idx%nbj(jb,igrd) 142 144 fv = ABS( ABS (NINT( idx%flagv(jb,igrd) ) ) - 1 ) 143 va(ii,ij,jk) = va(ii,ij,jk) * REAL( 1 - fv ) + ( va(ii+fv,ij,jk) * vmask(ii+fv,ij,jk) & 144 &+ va(ii-fv,ij,jk) * vmask(ii-fv,ij,jk) ) * vmask(ii,ij,jk) * REAL( fv ) 145 END DO 146 END DO 147 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 148 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 149 ! 150 IF( kt == nit000 ) CLOSE( unit = 102 ) 145 pvv(ii,ij,jk,Kaa) = pvv(ii,ij,jk,Kaa) * REAL( 1 - fv ) + ( pvv(ii+fv,ij,jk,Kaa) * vmask(ii+fv,ij,jk) & 146 &+ pvv(ii-fv,ij,jk,Kaa) * vmask(ii-fv,ij,jk) ) * vmask(ii,ij,jk) * REAL( fv ) 147 END DO 148 END DO 149 CALL lbc_bdy_lnk( 'bdydyn3d', puu(:,:,:,Kaa), 'U', -1., ib_bdy ) ! Boundary points should be updated 150 CALL lbc_bdy_lnk( 'bdydyn3d', pvv(:,:,:,Kaa), 'V', -1., ib_bdy ) 151 151 ! 152 152 END SUBROUTINE bdy_dyn3d_zgrad 153 153 154 154 155 SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy )155 SUBROUTINE bdy_dyn3d_zro( puu, pvv, Kaa, idx, dta, ib_bdy ) 156 156 !!---------------------------------------------------------------------- 157 157 !! *** SUBROUTINE bdy_dyn3d_zro *** … … 160 160 !! 161 161 !!---------------------------------------------------------------------- 162 INTEGER , INTENT(in) :: kt ! time step index 163 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 164 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 165 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 162 INTEGER , INTENT( in ) :: Kaa ! Time level index 163 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries) 164 TYPE(OBC_INDEX) , INTENT( in ) :: idx ! OBC indices 165 TYPE(OBC_DATA) , INTENT( in ) :: dta ! OBC external data 166 INTEGER , INTENT( in ) :: ib_bdy ! BDY set index 166 167 ! 167 168 INTEGER :: ib, ik ! dummy loop indices … … 175 176 ij = idx%nbj(ib,igrd) 176 177 DO ik = 1, jpkm1 177 ua(ii,ij,ik) = 0._wp178 puu(ii,ij,ik,Kaa) = 0._wp 178 179 END DO 179 180 END DO … … 184 185 ij = idx%nbj(ib,igrd) 185 186 DO ik = 1, jpkm1 186 va(ii,ij,ik) = 0._wp 187 END DO 188 END DO 189 ! 190 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ; CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1.,ib_bdy ) ! Boundary points should be updated 191 ! 192 IF( kt == nit000 ) CLOSE( unit = 102 ) 187 pvv(ii,ij,ik,Kaa) = 0._wp 188 END DO 189 END DO 190 ! 191 CALL lbc_bdy_lnk( 'bdydyn3d', puu(:,:,:,Kaa), 'U', -1., ib_bdy ) ; CALL lbc_bdy_lnk( 'bdydyn3d', pvv(:,:,:,Kaa), 'V', -1.,ib_bdy ) ! Boundary points should be updated 193 192 ! 194 193 END SUBROUTINE bdy_dyn3d_zro 195 194 196 195 197 SUBROUTINE bdy_dyn3d_frs( idx, dta, kt, ib_bdy )196 SUBROUTINE bdy_dyn3d_frs( puu, pvv, Kaa, idx, dta, ib_bdy ) 198 197 !!---------------------------------------------------------------------- 199 198 !! *** SUBROUTINE bdy_dyn3d_frs *** … … 206 205 !! topography. Tellus, 365-382. 207 206 !!---------------------------------------------------------------------- 208 INTEGER , INTENT(in) :: kt ! time step index 209 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 210 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 211 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 207 INTEGER , INTENT( in ) :: Kaa ! Time level index 208 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries) 209 TYPE(OBC_INDEX) , INTENT( in ) :: idx ! OBC indices 210 TYPE(OBC_DATA) , INTENT( in ) :: dta ! OBC external data 211 INTEGER , INTENT( in ) :: ib_bdy ! BDY set index 212 212 ! 213 213 INTEGER :: jb, jk ! dummy loop indices … … 222 222 ij = idx%nbj(jb,igrd) 223 223 zwgt = idx%nbw(jb,igrd) 224 ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta%u3d(jb,jk) - ua(ii,ij,jk) ) ) * umask(ii,ij,jk)224 puu(ii,ij,jk,Kaa) = ( puu(ii,ij,jk,Kaa) + zwgt * ( dta%u3d(jb,jk) - puu(ii,ij,jk,Kaa) ) ) * umask(ii,ij,jk) 225 225 END DO 226 226 END DO … … 232 232 ij = idx%nbj(jb,igrd) 233 233 zwgt = idx%nbw(jb,igrd) 234 va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta%v3d(jb,jk) - va(ii,ij,jk) ) ) * vmask(ii,ij,jk)234 pvv(ii,ij,jk,Kaa) = ( pvv(ii,ij,jk,Kaa) + zwgt * ( dta%v3d(jb,jk) - pvv(ii,ij,jk,Kaa) ) ) * vmask(ii,ij,jk) 235 235 END DO 236 236 END DO 237 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 238 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 239 ! 240 IF( kt == nit000 ) CLOSE( unit = 102 ) 237 CALL lbc_bdy_lnk( 'bdydyn3d', puu(:,:,:,Kaa), 'U', -1., ib_bdy ) ! Boundary points should be updated 238 CALL lbc_bdy_lnk( 'bdydyn3d', pvv(:,:,:,Kaa), 'V', -1., ib_bdy ) 241 239 ! 242 240 END SUBROUTINE bdy_dyn3d_frs 243 241 244 242 245 SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, ll_npo )243 SUBROUTINE bdy_dyn3d_orlanski( Kbb, puu, pvv, Kaa, idx, dta, ib_bdy, ll_npo ) 246 244 !!---------------------------------------------------------------------- 247 245 !! *** SUBROUTINE bdy_dyn3d_orlanski *** … … 253 251 !! References: Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001) 254 252 !!---------------------------------------------------------------------- 255 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 256 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 257 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 258 LOGICAL, INTENT(in) :: ll_npo ! switch for NPO version 253 INTEGER , INTENT( in ) :: Kbb, Kaa ! Time level indices 254 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries) 255 TYPE(OBC_INDEX) , INTENT( in ) :: idx ! OBC indices 256 TYPE(OBC_DATA) , INTENT( in ) :: dta ! OBC external data 257 INTEGER , INTENT( in ) :: ib_bdy ! BDY set index 258 LOGICAL , INTENT( in ) :: ll_npo ! switch for NPO version 259 259 260 260 INTEGER :: jb, igrd ! dummy loop indices 261 261 !!---------------------------------------------------------------------- 262 262 ! 263 !! Note that at this stage the ub and uaarrays contain the baroclinic velocities.263 !! Note that at this stage the puu(:,:,:,Kbb) and puu(:,:,:,Kaa) arrays contain the baroclinic velocities. 264 264 ! 265 265 igrd = 2 ! Orlanski bc on u-velocity; 266 266 ! 267 CALL bdy_orlanski_3d( idx, igrd, ub, ua, dta%u3d, ll_npo )267 CALL bdy_orlanski_3d( idx, igrd, puu(:,:,:,Kbb), puu(:,:,:,Kaa), dta%u3d, ll_npo ) 268 268 269 269 igrd = 3 ! Orlanski bc on v-velocity 270 270 ! 271 CALL bdy_orlanski_3d( idx, igrd, vb, va, dta%v3d, ll_npo )272 ! 273 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated274 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy )271 CALL bdy_orlanski_3d( idx, igrd, pvv(:,:,:,Kbb), pvv(:,:,:,Kaa), dta%v3d, ll_npo ) 272 ! 273 CALL lbc_bdy_lnk( 'bdydyn3d', puu(:,:,:,Kaa), 'U', -1., ib_bdy ) ! Boundary points should be updated 274 CALL lbc_bdy_lnk( 'bdydyn3d', pvv(:,:,:,Kaa), 'V', -1., ib_bdy ) 275 275 ! 276 276 END SUBROUTINE bdy_dyn3d_orlanski 277 277 278 278 279 SUBROUTINE bdy_dyn3d_dmp( kt )279 SUBROUTINE bdy_dyn3d_dmp( kt, Kbb, puu, pvv, Krhs ) 280 280 !!---------------------------------------------------------------------- 281 281 !! *** SUBROUTINE bdy_dyn3d_dmp *** … … 284 284 !! 285 285 !!---------------------------------------------------------------------- 286 INTEGER, INTENT(in) :: kt ! time step index 286 INTEGER , INTENT( in ) :: kt ! time step 287 INTEGER , INTENT( in ) :: Kbb, Krhs ! Time level indices 288 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities and trends (to be updated at open boundaries) 287 289 ! 288 290 INTEGER :: jb, jk ! dummy loop indices … … 302 304 zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd) 303 305 DO jk = 1, jpkm1 304 ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%u3d(jb,jk) - &305 ub(ii,ij,jk) + ub_b(ii,ij)) ) * umask(ii,ij,jk)306 puu(ii,ij,jk,Krhs) = ( puu(ii,ij,jk,Krhs) + zwgt * ( dta_bdy(ib_bdy)%u3d(jb,jk) - & 307 puu(ii,ij,jk,Kbb) + uu_b(ii,ij,Kbb)) ) * umask(ii,ij,jk) 306 308 END DO 307 309 END DO … … 313 315 zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd) 314 316 DO jk = 1, jpkm1 315 va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%v3d(jb,jk) - &316 vb(ii,ij,jk) + vb_b(ii,ij)) ) * vmask(ii,ij,jk)317 pvv(ii,ij,jk,Krhs) = ( pvv(ii,ij,jk,Krhs) + zwgt * ( dta_bdy(ib_bdy)%v3d(jb,jk) - & 318 pvv(ii,ij,jk,Kbb) + vv_b(ii,ij,Kbb)) ) * vmask(ii,ij,jk) 317 319 END DO 318 320 END DO … … 320 322 END DO 321 323 ! 322 CALL lbc_lnk_multi( 'bdydyn3d', ua, 'U', -1., va, 'V', -1. ) ! Boundary points should be updated324 CALL lbc_lnk_multi( 'bdydyn3d', puu(:,:,:,Krhs), 'U', -1., pvv(:,:,:,Krhs), 'V', -1. ) ! Boundary points should be updated 323 325 ! 324 326 IF( ln_timing ) CALL timing_stop('bdy_dyn3d_dmp') … … 327 329 328 330 329 SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy )331 SUBROUTINE bdy_dyn3d_nmn( puu, pvv, Kaa, idx, ib_bdy ) 330 332 !!---------------------------------------------------------------------- 331 333 !! *** SUBROUTINE bdy_dyn3d_nmn *** … … 336 338 !! 337 339 !!---------------------------------------------------------------------- 338 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 339 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 340 INTEGER , INTENT( in ) :: Kaa ! Time level index 341 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries) 342 TYPE(OBC_INDEX) , INTENT( in ) :: idx ! OBC indices 343 INTEGER , INTENT( in ) :: ib_bdy ! BDY set index 340 344 341 345 INTEGER :: jb, igrd ! dummy loop indices 342 346 !!---------------------------------------------------------------------- 343 347 ! 344 !! Note that at this stage the ub and uaarrays contain the baroclinic velocities.348 !! Note that at this stage the puu(:,:,:,Kbb) and puu(:,:,:,Kaa) arrays contain the baroclinic velocities. 345 349 ! 346 350 igrd = 2 ! Neumann bc on u-velocity; 347 351 ! 348 CALL bdy_nmn( idx, igrd, ua)352 CALL bdy_nmn( idx, igrd, puu(:,:,:,Kaa) ) 349 353 350 354 igrd = 3 ! Neumann bc on v-velocity 351 355 ! 352 CALL bdy_nmn( idx, igrd, va)353 ! 354 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated355 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy )356 CALL bdy_nmn( idx, igrd, pvv(:,:,:,Kaa) ) 357 ! 358 CALL lbc_bdy_lnk( 'bdydyn3d', puu(:,:,:,Kaa), 'U', -1., ib_bdy ) ! Boundary points should be updated 359 CALL lbc_bdy_lnk( 'bdydyn3d', pvv(:,:,:,Kaa), 'V', -1., ib_bdy ) 356 360 ! 357 361 END SUBROUTINE bdy_dyn3d_nmn -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/BDY/bdylib.F90
r10529 r10957 34 34 CONTAINS 35 35 36 SUBROUTINE bdy_frs( idx, p ta, dta )36 SUBROUTINE bdy_frs( idx, phia, dta ) 37 37 !!---------------------------------------------------------------------- 38 38 !! *** SUBROUTINE bdy_frs *** … … 44 44 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 45 45 REAL(wp), DIMENSION(:,:), INTENT(in) :: dta ! OBC external data 46 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: p ta ! tracer trend46 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phia ! tracer trend 47 47 !! 48 48 REAL(wp) :: zwgt ! boundary weight … … 57 57 ij = idx%nbj(ib,igrd) 58 58 zwgt = idx%nbw(ib,igrd) 59 p ta(ii,ij,ik) = ( pta(ii,ij,ik) + zwgt * (dta(ib,ik) - pta(ii,ij,ik) ) ) * tmask(ii,ij,ik)59 phia(ii,ij,ik) = ( phia(ii,ij,ik) + zwgt * (dta(ib,ik) - phia(ii,ij,ik) ) ) * tmask(ii,ij,ik) 60 60 END DO 61 61 END DO … … 64 64 65 65 66 SUBROUTINE bdy_spe( idx, p ta, dta )66 SUBROUTINE bdy_spe( idx, phia, dta ) 67 67 !!---------------------------------------------------------------------- 68 68 !! *** SUBROUTINE bdy_spe *** … … 73 73 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 74 74 REAL(wp), DIMENSION(:,:), INTENT(in) :: dta ! OBC external data 75 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: p ta ! tracer trend75 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phia ! tracer trend 76 76 !! 77 77 REAL(wp) :: zwgt ! boundary weight … … 85 85 ij = idx%nbj(ib,igrd) 86 86 DO ik = 1, jpkm1 87 p ta(ii,ij,ik) = dta(ib,ik) * tmask(ii,ij,ik)87 phia(ii,ij,ik) = dta(ib,ik) * tmask(ii,ij,ik) 88 88 END DO 89 89 END DO … … 92 92 93 93 94 SUBROUTINE bdy_orl( idx, p tb, pta, dta, ll_npo )94 SUBROUTINE bdy_orl( idx, phib, phia, dta, ll_npo ) 95 95 !!---------------------------------------------------------------------- 96 96 !! *** SUBROUTINE bdy_orl *** … … 102 102 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 103 103 REAL(wp), DIMENSION(:,:), INTENT(in) :: dta ! OBC external data 104 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: p tb ! before tracer field105 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: p ta ! tracer trend104 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phib ! before tracer field 105 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phia ! tracer trend 106 106 LOGICAL, INTENT(in) :: ll_npo ! switch for NPO version 107 107 !! … … 111 111 igrd = 1 ! Everything is at T-points here 112 112 ! 113 CALL bdy_orlanski_3d( idx, igrd, p tb(:,:,:), pta(:,:,:), dta, ll_npo )113 CALL bdy_orlanski_3d( idx, igrd, phib(:,:,:), phia(:,:,:), dta, ll_npo ) 114 114 ! 115 115 END SUBROUTINE bdy_orl -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/BDY/bdytra.F90
r10529 r10957 40 40 CONTAINS 41 41 42 SUBROUTINE bdy_tra( kt )42 SUBROUTINE bdy_tra( kt, Kbb, pts, Kaa ) 43 43 !!---------------------------------------------------------------------- 44 44 !! *** SUBROUTINE bdy_tra *** … … 47 47 !! 48 48 !!---------------------------------------------------------------------- 49 INTEGER, INTENT(in) :: kt ! Main time step counter 49 INTEGER , INTENT(in) :: kt ! Main time step counter 50 INTEGER , INTENT(in) :: Kbb, Kaa ! time level indices 51 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! tracer fields 50 52 ! 51 INTEGER :: ib_bdy, jn, igrd ! Loop ind eces53 INTEGER :: ib_bdy, jn, igrd ! Loop indices 52 54 TYPE(ztrabdy), DIMENSION(jpts) :: zdta ! Temporary data structure 53 55 !!---------------------------------------------------------------------- … … 63 65 SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 64 66 CASE('none' ) ; CYCLE 65 CASE('frs' ) ; CALL bdy_frs ( idx_bdy(ib_bdy), tsa(:,:,:,jn), zdta(jn)%tra )66 CASE('specified' ) ; CALL bdy_spe ( idx_bdy(ib_bdy), tsa(:,:,:,jn), zdta(jn)%tra )67 CASE('neumann' ) ; CALL bdy_nmn ( idx_bdy(ib_bdy), igrd , tsa(:,:,:,jn) )68 CASE('orlanski' ) ; CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.false. )69 CASE('orlanski_npo') ; CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.true. )70 CASE('runoff' ) ; CALL bdy_rnf ( idx_bdy(ib_bdy), tsa(:,:,:,jn), jn )67 CASE('frs' ) ; CALL bdy_frs ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kaa), zdta(jn)%tra ) 68 CASE('specified' ) ; CALL bdy_spe ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kaa), zdta(jn)%tra ) 69 CASE('neumann' ) ; CALL bdy_nmn ( idx_bdy(ib_bdy), igrd , pts(:,:,:,jn,Kaa) ) 70 CASE('orlanski' ) ; CALL bdy_orl ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kbb), pts(:,:,:,jn,Kaa), zdta(jn)%tra, ll_npo=.false. ) 71 CASE('orlanski_npo') ; CALL bdy_orl ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kbb), pts(:,:,:,jn,Kaa), zdta(jn)%tra, ll_npo=.true. ) 72 CASE('runoff' ) ; CALL bdy_rnf ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kaa), jn ) 71 73 CASE DEFAULT ; CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 72 74 END SELECT 73 75 ! Boundary points should be updated 74 CALL lbc_bdy_lnk( 'bdytra', tsa(:,:,:,jn), 'T', 1., ib_bdy )76 CALL lbc_bdy_lnk( 'bdytra', pts(:,:,:,jn,Kaa), 'T', 1., ib_bdy ) 75 77 ! 76 78 END DO … … 80 82 81 83 82 SUBROUTINE bdy_rnf( idx, pt a, jpa )84 SUBROUTINE bdy_rnf( idx, pt, jpa ) 83 85 !!---------------------------------------------------------------------- 84 86 !! *** SUBROUTINE bdy_rnf *** … … 90 92 !!---------------------------------------------------------------------- 91 93 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 92 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt a! tracer trend94 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt ! tracer trend 93 95 INTEGER, INTENT(in) :: jpa ! TRA index 94 96 ! … … 105 107 ip = bdytmask(ii+1,ij ) - bdytmask(ii-1,ij ) 106 108 jp = bdytmask(ii ,ij+1) - bdytmask(ii ,ij-1) 107 if (jpa == jp_tem) pt a(ii,ij,ik) = pta(ii+ip,ij+jp,ik) * tmask(ii,ij,ik)108 if (jpa == jp_sal) pt a(ii,ij,ik) = 0.1 * tmask(ii,ij,ik)109 if (jpa == jp_tem) pt(ii,ij,ik) = pt(ii+ip,ij+jp,ik) * tmask(ii,ij,ik) 110 if (jpa == jp_sal) pt(ii,ij,ik) = 0.1 * tmask(ii,ij,ik) 109 111 END DO 110 112 END DO … … 113 115 114 116 115 SUBROUTINE bdy_tra_dmp( kt )117 SUBROUTINE bdy_tra_dmp( kt, Kbb, pts, Krhs ) 116 118 !!---------------------------------------------------------------------- 117 119 !! *** SUBROUTINE bdy_tra_dmp *** … … 120 122 !! 121 123 !!---------------------------------------------------------------------- 122 INTEGER, INTENT(in) :: kt ! 124 INTEGER , INTENT(in) :: kt ! time step 125 INTEGER , INTENT(in) :: Kbb, Krhs ! time level indices 126 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 123 127 ! 124 128 REAL(wp) :: zwgt ! boundary weight … … 139 143 zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd) 140 144 DO ik = 1, jpkm1 141 zta = zwgt * ( dta_bdy(ib_bdy)%tem(ib,ik) - tsb(ii,ij,ik,jp_tem) ) * tmask(ii,ij,ik)142 zsa = zwgt * ( dta_bdy(ib_bdy)%sal(ib,ik) - tsb(ii,ij,ik,jp_sal) ) * tmask(ii,ij,ik)143 tsa(ii,ij,ik,jp_tem) = tsa(ii,ij,ik,jp_tem) + zta144 tsa(ii,ij,ik,jp_sal) = tsa(ii,ij,ik,jp_sal) + zsa145 zta = zwgt * ( dta_bdy(ib_bdy)%tem(ib,ik) - pts(ii,ij,ik,jp_tem,Kbb) ) * tmask(ii,ij,ik) 146 zsa = zwgt * ( dta_bdy(ib_bdy)%sal(ib,ik) - pts(ii,ij,ik,jp_sal,Kbb) ) * tmask(ii,ij,ik) 147 pts(ii,ij,ik,jp_tem,Krhs) = pts(ii,ij,ik,jp_tem,Krhs) + zta 148 pts(ii,ij,ik,jp_sal,Krhs) = pts(ii,ij,ik,jp_sal,Krhs) + zsa 145 149 END DO 146 150 END DO -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynnxt.F90
r10946 r10957 50 50 #if defined key_agrif 51 51 USE agrif_oce_interp 52 #endif 52 #endif 53 53 54 54 IMPLICIT NONE … … 64 64 CONTAINS 65 65 66 SUBROUTINE dyn_nxt ( kt, K mm)66 SUBROUTINE dyn_nxt ( kt, Kbb, Kmm, Kaa ) 67 67 !!---------------------------------------------------------------------- 68 68 !! *** ROUTINE dyn_nxt *** … … 92 92 !! un,vn now horizontal velocity of next time-step 93 93 !!---------------------------------------------------------------------- 94 INTEGER, INTENT( in ) :: kt ! ocean time-step index95 INTEGER, INTENT( in ) :: K mm ! time level index94 INTEGER, INTENT( in ) :: kt ! ocean time-step index 95 INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices 96 96 ! 97 97 INTEGER :: ji, jj, jk ! dummy loop indices … … 148 148 ! 149 149 ! !* BDY open boundaries 150 IF( ln_bdy .AND. ln_dynspg_exp ) CALL bdy_dyn( kt ) 151 IF( ln_bdy .AND. ln_dynspg_ts ) CALL bdy_dyn( kt, dyn3d_only=.true. ) 150 !! IMMERSE development : Following the general pattern for the new code we want to pass in the 151 !! velocities to bdy_dyn as arguments so here we use "uu" and "vv" even 152 !! though we haven't converted the velocity names in the rest of dynnxt.F90 153 !! because it will be completely rewritten. DS. 154 IF( ln_bdy .AND. ln_dynspg_exp ) CALL bdy_dyn( kt, Kbb, uu, vv, Kaa ) 155 IF( ln_bdy .AND. ln_dynspg_ts ) CALL bdy_dyn( kt, Kbb, uu, vv, Kaa, dyn3d_only=.true. ) 152 156 153 157 !!$ Do we need a call to bdy_vol here?? -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/tranxt.F90
r10954 r10957 64 64 CONTAINS 65 65 66 SUBROUTINE tra_nxt( kt, Kbb, Kmm, Krhs )66 SUBROUTINE tra_nxt( kt, Kbb, Kmm, Krhs, Kaa ) 67 67 !!---------------------------------------------------------------------- 68 68 !! *** ROUTINE tranxt *** … … 86 86 !! ** Action : - ts(Kbb) & ts(Kmm) ready for the next time step 87 87 !!---------------------------------------------------------------------- 88 INTEGER, INTENT(in) :: kt ! ocean time-step index89 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices88 INTEGER, INTENT(in) :: kt ! ocean time-step index 89 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs, Kaa ! time level indices 90 90 !! 91 91 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 110 110 CALL lbc_lnk_multi( 'tranxt', ts(:,:,:,jp_tem,Krhs), 'T', 1., ts(:,:,:,jp_sal,Krhs), 'T', 1. ) 111 111 ! 112 IF( ln_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries 112 !! IMMERSE development : Following the general pattern for the new code we want to pass in the 113 !! velocities to bdy_dyn as arguments so here we use "ts" even 114 !! though we haven't converted the tracer names in the rest of tranxt.F90 115 !! because it will be completely rewritten. DS. 116 IF( ln_bdy ) CALL bdy_tra( kt, Kbb, ts, Kaa ) ! BDY open boundaries 113 117 114 118 ! set time step size (Euler/Leapfrog) -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/step.F90
r10954 r10957 118 118 IF( ln_tide ) CALL sbc_tide( kstp ) ! update tide potential 119 119 IF( ln_apr_dyn ) CALL sbc_apr ( kstp ) ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib) 120 IF( ln_bdy ) CALL bdy_dta ( kstp, time_offset=+1 )! update dynamic & tracer data at open boundaries121 CALL sbc ( kstp, Nbb, Nnn ) ! Sea Boundary Condition (including sea-ice)120 IF( ln_bdy ) CALL bdy_dta ( kstp, Nnn, time_offset=+1 ) ! update dynamic & tracer data at open boundaries 121 CALL sbc ( kstp, Nbb, Nnn ) ! Sea Boundary Condition (including sea-ice) 122 122 123 123 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 188 188 IF( lk_asminc .AND. ln_asmiau .AND. ln_dyninc ) & 189 189 & CALL dyn_asm_inc ( kstp ) ! apply dynamics assimilation increment 190 IF( ln_bdy ) CALL bdy_dyn3d_dmp ( kstp ) ! bdy damping trends190 IF( ln_bdy ) CALL bdy_dyn3d_dmp ( kstp, Nbb, uu, vv, Nrhs ) ! bdy damping trends 191 191 #if defined key_agrif 192 192 IF(.NOT. Agrif_Root()) & … … 247 247 IF( ln_trabbl ) CALL tra_bbl ( kstp, Nbb, Nnn, Nrhs ) ! advective (and/or diffusive) bottom boundary layer scheme 248 248 IF( ln_tradmp ) CALL tra_dmp ( kstp, Nbb, Nnn, Nrhs ) ! internal damping trends 249 IF( ln_bdy ) CALL bdy_tra_dmp ( kstp ) ! bdy damping trends249 IF( ln_bdy ) CALL bdy_tra_dmp ( kstp, Nbb, ts, Nrhs ) ! bdy damping trends 250 250 #if defined key_agrif 251 251 IF(.NOT. Agrif_Root()) & … … 281 281 !! 282 282 !!jc2: dynnxt must be the latest call. e3t_b are indeed updated in that routine 283 CALL tra_nxt ( kstp, Nbb, Nnn, Nrhs ) ! finalize (bcs) tracer fields at next time step and swap284 CALL dyn_nxt ( kstp, Nnn )! finalize (bcs) velocities at next time step and swap (always called after tra_nxt)283 CALL tra_nxt ( kstp, Nbb, Nnn, Nrhs, Naa ) ! finalize (bcs) tracer fields at next time step and swap 284 CALL dyn_nxt ( kstp, Nbb, Nnn, Naa ) ! finalize (bcs) velocities at next time step and swap (always called after tra_nxt) 285 285 CALL ssh_swp ( kstp ) ! swap of sea surface height 286 286 IF(.NOT.ln_linssh) CALL dom_vvl_sf_swp( kstp ) ! swap of vertical scale factors
Note: See TracChangeset
for help on using the changeset viewer.