- Timestamp:
- 2016-06-24T09:50:27+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
r3703 r6736 5 5 !!====================================================================== 6 6 !! History : 3.4 ! 2011 (D. Storkey) new module as part of BDY rewrite 7 !! 3.5 ! 2012 (S. Mocavero, I. Epicoco) Optimization of BDY communications8 7 !!---------------------------------------------------------------------- 9 8 #if defined key_bdy … … 15 14 !!---------------------------------------------------------------------- 16 15 USE timing ! Timing 17 USE wrk_nemo ! Memory Allocation18 16 USE oce ! ocean dynamics and tracers 19 17 USE dom_oce ! ocean space and time domain … … 21 19 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 22 20 USE in_out_manager ! 23 Use phycst24 21 25 22 IMPLICIT NONE … … 27 24 28 25 PUBLIC bdy_dyn3d ! routine called by bdy_dyn 29 PUBLIC bdy_dyn3d_dmp ! routine called by step30 26 31 !! * Substitutions32 # include "domzgr_substitute.h90"33 27 !!---------------------------------------------------------------------- 34 28 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 60 54 CYCLE 61 55 CASE(jp_frs) 62 CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 63 CASE(2) 64 CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 65 CASE(3) 66 CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 56 CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 67 57 CASE DEFAULT 68 58 CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) … … 72 62 END SUBROUTINE bdy_dyn3d 73 63 74 SUBROUTINE bdy_dyn3d_spe( idx, dta, kt , ib_bdy ) 75 !!---------------------------------------------------------------------- 76 !! *** SUBROUTINE bdy_dyn3d_spe *** 77 !! 78 !! ** Purpose : - Apply a specified value for baroclinic velocities 79 !! at open boundaries. 80 !! 81 !!---------------------------------------------------------------------- 82 INTEGER :: kt 83 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 84 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 85 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 86 !! 87 INTEGER :: jb, jk ! dummy loop indices 88 INTEGER :: ii, ij, igrd ! local integers 89 REAL(wp) :: zwgt ! boundary weight 90 !!---------------------------------------------------------------------- 91 ! 92 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_spe') 93 ! 94 igrd = 2 ! Relaxation of zonal velocity 95 DO jb = 1, idx%nblenrim(igrd) 96 DO jk = 1, jpkm1 97 ii = idx%nbi(jb,igrd) 98 ij = idx%nbj(jb,igrd) 99 ua(ii,ij,jk) = dta%u3d(jb,jk) * umask(ii,ij,jk) 100 END DO 101 END DO 102 ! 103 igrd = 3 ! Relaxation of meridional velocity 104 DO jb = 1, idx%nblenrim(igrd) 105 DO jk = 1, jpkm1 106 ii = idx%nbi(jb,igrd) 107 ij = idx%nbj(jb,igrd) 108 va(ii,ij,jk) = dta%v3d(jb,jk) * vmask(ii,ij,jk) 109 END DO 110 END DO 111 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ; CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy ) ! Boundary points should be updated 112 ! 113 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 114 115 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_spe') 116 117 END SUBROUTINE bdy_dyn3d_spe 118 119 SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy ) 120 !!---------------------------------------------------------------------- 121 !! *** SUBROUTINE bdy_dyn3d_zro *** 122 !! 123 !! ** Purpose : - baroclinic velocities = 0. at open boundaries. 124 !! 125 !!---------------------------------------------------------------------- 126 INTEGER :: kt 127 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 128 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 129 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 130 !! 131 INTEGER :: ib, ik ! dummy loop indices 132 INTEGER :: ii, ij, igrd, zcoef ! local integers 133 REAL(wp) :: zwgt ! boundary weight 134 !!---------------------------------------------------------------------- 135 ! 136 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_zro') 137 ! 138 igrd = 2 ! Everything is at T-points here 139 DO ib = 1, idx%nblenrim(igrd) 140 ii = idx%nbi(ib,igrd) 141 ij = idx%nbj(ib,igrd) 142 DO ik = 1, jpkm1 143 ua(ii,ij,ik) = 0._wp 144 END DO 145 END DO 146 147 igrd = 3 ! Everything is at T-points here 148 DO ib = 1, idx%nblenrim(igrd) 149 ii = idx%nbi(ib,igrd) 150 ij = idx%nbj(ib,igrd) 151 DO ik = 1, jpkm1 152 va(ii,ij,ik) = 0._wp 153 END DO 154 END DO 155 ! 156 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ; CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy ) ! Boundary points should be updated 157 ! 158 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 159 160 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zro') 161 162 END SUBROUTINE bdy_dyn3d_zro 163 164 SUBROUTINE bdy_dyn3d_frs( idx, dta, kt, ib_bdy ) 64 SUBROUTINE bdy_dyn3d_frs( idx, dta, kt ) 165 65 !!---------------------------------------------------------------------- 166 66 !! *** SUBROUTINE bdy_dyn3d_frs *** … … 176 76 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 177 77 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 178 INTEGER, INTENT(in) :: ib_bdy ! BDY set index179 78 !! 180 79 INTEGER :: jb, jk ! dummy loop indices … … 204 103 END DO 205 104 END DO 206 CALL lbc_ bdy_lnk( ua, 'U', -1., ib_bdy ) ; CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy) ! Boundary points should be updated105 CALL lbc_lnk( ua, 'U', -1. ) ; CALL lbc_lnk( va, 'V', -1. ) ! Boundary points should be updated 207 106 ! 208 107 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) … … 212 111 END SUBROUTINE bdy_dyn3d_frs 213 112 214 SUBROUTINE bdy_dyn3d_dmp( kt )215 !!----------------------------------------------------------------------216 !! *** SUBROUTINE bdy_dyn3d_dmp ***217 !!218 !! ** Purpose : Apply damping for baroclinic velocities at open boundaries.219 !!220 !!----------------------------------------------------------------------221 INTEGER :: kt222 !!223 INTEGER :: jb, jk ! dummy loop indices224 INTEGER :: ii, ij, igrd ! local integers225 REAL(wp) :: zwgt ! boundary weight226 INTEGER :: ib_bdy ! loop index227 !!----------------------------------------------------------------------228 !229 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_dmp')230 !231 !-------------------------------------------------------232 ! Remove barotropic part from before velocity233 !-------------------------------------------------------234 CALL wrk_alloc(jpi,jpj,pu2d,pv2d)235 236 pu2d(:,:) = 0.e0237 pv2d(:,:) = 0.e0238 239 DO jk = 1, jpkm1240 #if defined key_vvl241 pu2d(:,:) = pu2d(:,:) + fse3u_b(:,:,jk)* ub(:,:,jk) *umask(:,:,jk)242 pv2d(:,:) = pv2d(:,:) + fse3v_b(:,:,jk)* vb(:,:,jk) *vmask(:,:,jk)243 #else244 pu2d(:,:) = pu2d(:,:) + fse3u_0(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)245 pv2d(:,:) = pv2d(:,:) + fse3v_0(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)246 #endif247 END DO248 249 IF( lk_vvl ) THEN250 pu2d(:,:) = pu2d(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) )251 pv2d(:,:) = pv2d(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) )252 ELSE253 pu2d(:,:) = pv2d(:,:) * hur(:,:)254 pv2d(:,:) = pu2d(:,:) * hvr(:,:)255 ENDIF256 257 DO ib_bdy=1, nb_bdy258 IF ( ln_dyn3d_dmp(ib_bdy).and.nn_dyn3d(ib_bdy).gt.0 ) THEN259 igrd = 2 ! Relaxation of zonal velocity260 DO jb = 1, idx_bdy(ib_bdy)%nblen(igrd)261 ii = idx_bdy(ib_bdy)%nbi(jb,igrd)262 ij = idx_bdy(ib_bdy)%nbj(jb,igrd)263 zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd)264 DO jk = 1, jpkm1265 ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%u3d(jb,jk) - &266 ub(ii,ij,jk) + pu2d(ii,ij)) ) * umask(ii,ij,jk)267 END DO268 END DO269 !270 igrd = 3 ! Relaxation of meridional velocity271 DO jb = 1, idx_bdy(ib_bdy)%nblen(igrd)272 ii = idx_bdy(ib_bdy)%nbi(jb,igrd)273 ij = idx_bdy(ib_bdy)%nbj(jb,igrd)274 zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd)275 DO jk = 1, jpkm1276 va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%v3d(jb,jk) - &277 vb(ii,ij,jk) + pv2d(ii,ij)) ) * vmask(ii,ij,jk)278 END DO279 END DO280 ENDIF281 ENDDO282 !283 CALL wrk_dealloc(jpi,jpj,pu2d,pv2d)284 !285 CALL lbc_lnk( ua, 'U', -1. ) ; CALL lbc_lnk( va, 'V', -1. ) ! Boundary points should be updated286 !287 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_dmp')288 289 END SUBROUTINE bdy_dyn3d_dmp290 113 291 114 #else … … 295 118 CONTAINS 296 119 SUBROUTINE bdy_dyn3d( kt ) ! Empty routine 297 WRITE(*,*) 'bdy_dyn 3d: You should not have seen this print! error?', kt120 WRITE(*,*) 'bdy_dyn_frs: You should not have seen this print! error?', kt 298 121 END SUBROUTINE bdy_dyn3d 299 300 SUBROUTINE bdy_dyn3d_dmp( kt ) ! Empty routine301 WRITE(*,*) 'bdy_dyn3d_dmp: You should not have seen this print! error?', kt302 END SUBROUTINE bdy_dyn3d_dmp303 304 122 #endif 305 123
Note: See TracChangeset
for help on using the changeset viewer.
