- Timestamp:
- 2016-12-01T11:30:29+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90
r6140 r7412 9 9 !! 3.5 ! 2012 (S. Mocavero, I. Epicoco) Optimization of BDY communications 10 10 !! 3.6 ! 2015 (T. Lovato) Adapt BDY for tracers in TOP component 11 !! 4.0 ! 2016 (T. Lovato) Generalize OBC structure 11 12 !!---------------------------------------------------------------------- 12 #if defined key_ bdy && key_top13 #if defined key_top 13 14 !!---------------------------------------------------------------------- 14 !! 'key_bdy' Unstructured Open Boundary Conditions 15 !!---------------------------------------------------------------------- 16 !! trc_bdy : Apply open boundary conditions to T and S 17 !! trc_bdy_frs : Apply Flow Relaxation Scheme 15 !! trc_bdy : Apply open boundary conditions & damping to tracers 18 16 !!---------------------------------------------------------------------- 19 17 USE timing ! Timing … … 24 22 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 23 USE in_out_manager ! I/O manager 26 USE bdy_oce, only: idx_bdy , OBC_INDEX, BDYTMASK, lk_bdy! ocean open boundary conditions24 USE bdy_oce, only: idx_bdy ! ocean open boundary conditions 27 25 28 26 IMPLICIT NONE … … 33 31 34 32 !!---------------------------------------------------------------------- 35 !! NEMO/OPA 3.6 , NEMO Consortium (2015)33 !! NEMO/OPA 4.0 , NEMO Consortium (2016) 36 34 !! $Id$ 37 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 43 41 !! *** SUBROUTINE trc_bdy *** 44 42 !! 45 !! ** Purpose : - Apply open boundary conditions for tracers in TOP component 46 !! and scale the tracer data 43 !! ** Purpose : - Apply open boundary conditions for TOP tracers 47 44 !! 48 45 !!---------------------------------------------------------------------- 49 46 INTEGER, INTENT( in ) :: kt ! Main time step counter 50 47 !! 51 INTEGER :: ib_bdy, jn ! Loop indeces 48 INTEGER :: ib_bdy ,jn ,igrd ! Loop indeces 49 REAL(wp), POINTER, DIMENSION(:,:) :: ztrc 50 REAL(wp), POINTER :: zfac 52 51 !!---------------------------------------------------------------------- 53 52 ! 54 53 IF( nn_timing == 1 ) CALL timing_start('trc_bdy') 55 54 ! 56 DO jn = 1, jptra 57 DO ib_bdy=1, nb_bdy 58 59 SELECT CASE( trcdta_bdy(jn,ib_bdy)%cn_obc ) 60 CASE('none') 61 CYCLE 62 CASE('frs') 63 CALL bdy_trc_frs( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 64 CASE('specified') 65 CALL bdy_trc_spe( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 66 CASE('neumann') 67 CALL bdy_trc_nmn( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 68 CASE('orlanski') 69 CALL bdy_trc_orlanski( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), ll_npo=.false. ) 70 CASE('orlanski_npo') 71 CALL bdy_trc_orlanski( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), ll_npo=.true. ) 72 CASE DEFAULT 73 CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 55 igrd = 1 56 ! 57 DO ib_bdy=1, nb_bdy 58 DO jn = 1, jptra 59 ! 60 ztrc => trcdta_bdy(jn,ib_bdy)%trc 61 zfac => trcdta_bdy(jn,ib_bdy)%rn_fac 62 ! 63 SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) ) 64 CASE('none' ) ; CYCLE 65 CASE('frs' ) ; CALL bdy_frs( idx_bdy(ib_bdy), tra(:,:,:,jn), ztrc*zfac ) 66 CASE('specified' ) ; CALL bdy_spe( idx_bdy(ib_bdy), tra(:,:,:,jn), ztrc*zfac ) 67 CASE('neumann' ) ; CALL bdy_nmn( idx_bdy(ib_bdy), igrd , tra(:,:,:,jn) ) 68 CASE('orlanski' ) ; CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.false. ) 69 CASE('orlanski_npo') ; CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.true. ) 70 CASE DEFAULT ; CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 74 71 END SELECT 75 76 72 ! Boundary points should be updated 77 73 CALL lbc_bdy_lnk( tra(:,:,:,jn), 'T', 1., ib_bdy ) 78 79 END DO80 END DO74 ! 75 END DO 76 END DO 81 77 ! 82 78 IF( nn_timing == 1 ) CALL timing_stop('trc_bdy') 83 79 84 80 END SUBROUTINE trc_bdy 85 86 SUBROUTINE bdy_trc_frs( jn, idx, dta, kt )87 !!----------------------------------------------------------------------88 !! *** SUBROUTINE bdy_trc_frs ***89 !!90 !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries.91 !!92 !! Reference : Engedahl H., 1995, Tellus, 365-382.93 !!----------------------------------------------------------------------94 INTEGER, INTENT(in) :: kt95 INTEGER, INTENT(in) :: jn ! Tracer index96 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices97 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data98 !!99 REAL(wp) :: zwgt ! boundary weight100 INTEGER :: ib, ik, igrd ! dummy loop indices101 INTEGER :: ii, ij ! 2D addresses102 !!----------------------------------------------------------------------103 !104 IF( nn_timing == 1 ) CALL timing_start('bdy_trc_frs')105 !106 igrd = 1 ! Everything is at T-points here107 DO ib = 1, idx%nblen(igrd)108 DO ik = 1, jpkm1109 ii = idx%nbi(ib,igrd)110 ij = idx%nbj(ib,igrd)111 zwgt = idx%nbw(ib,igrd)112 tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) + zwgt * ( ( dta%trc(ib,ik) * dta%rn_fac) &113 & - tra(ii,ij,ik,jn) ) ) * tmask(ii,ij,ik)114 END DO115 END DO116 !117 IF( kt .eq. nit000 ) CLOSE( unit = 102 )118 !119 IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_frs')120 !121 END SUBROUTINE bdy_trc_frs122 123 SUBROUTINE bdy_trc_spe( jn, idx, dta, kt )124 !!----------------------------------------------------------------------125 !! *** SUBROUTINE bdy_trc_frs ***126 !!127 !! ** Purpose : Apply a specified value for tracers at open boundaries.128 !!129 !!----------------------------------------------------------------------130 INTEGER, INTENT(in) :: kt131 INTEGER, INTENT(in) :: jn ! Tracer index132 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices133 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data134 !!135 REAL(wp) :: zwgt ! boundary weight136 INTEGER :: ib, ik, igrd ! dummy loop indices137 INTEGER :: ii, ij ! 2D addresses138 !!----------------------------------------------------------------------139 !140 IF( nn_timing == 1 ) CALL timing_start('bdy_trc_spe')141 !142 igrd = 1 ! Everything is at T-points here143 DO ib = 1, idx%nblenrim(igrd)144 ii = idx%nbi(ib,igrd)145 ij = idx%nbj(ib,igrd)146 DO ik = 1, jpkm1147 tra(ii,ij,ik,jn) = dta%trc(ib,ik) * dta%rn_fac * tmask(ii,ij,ik)148 END DO149 END DO150 !151 IF( kt .eq. nit000 ) CLOSE( unit = 102 )152 !153 IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_spe')154 !155 END SUBROUTINE bdy_trc_spe156 157 SUBROUTINE bdy_trc_nmn( jn, idx, dta, kt )158 !!----------------------------------------------------------------------159 !! *** SUBROUTINE bdy_trc_nmn ***160 !!161 !! ** Purpose : Duplicate the value for tracers at open boundaries.162 !!163 !!----------------------------------------------------------------------164 INTEGER, INTENT(in) :: kt165 INTEGER, INTENT(in) :: jn ! Tracer index166 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices167 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data168 !!169 REAL(wp) :: zwgt ! boundary weight170 INTEGER :: ib, ik, igrd ! dummy loop indices171 INTEGER :: ii, ij, zcoef, zcoef1, zcoef2, ip, jp ! 2D addresses172 !!----------------------------------------------------------------------173 !174 IF( nn_timing == 1 ) CALL timing_start('bdy_trc_nmn')175 !176 igrd = 1 ! Everything is at T-points here177 DO ib = 1, idx%nblenrim(igrd)178 ii = idx%nbi(ib,igrd)179 ij = idx%nbj(ib,igrd)180 DO ik = 1, jpkm1181 ! search the sense of the gradient182 zcoef1 = bdytmask(ii-1,ij ) + bdytmask(ii+1,ij )183 zcoef2 = bdytmask(ii ,ij-1) + bdytmask(ii ,ij+1)184 IF ( zcoef1+zcoef2 == 0) THEN185 ! corner186 zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) + tmask(ii,ij-1,ik) + tmask(ii,ij+1,ik)187 tra(ii,ij,ik,jn) = tra(ii-1,ij ,ik,jn) * tmask(ii-1,ij ,ik) + &188 & tra(ii+1,ij ,ik,jn) * tmask(ii+1,ij ,ik) + &189 & tra(ii ,ij-1,ik,jn) * tmask(ii ,ij-1,ik) + &190 & tra(ii ,ij+1,ik,jn) * tmask(ii ,ij+1,ik)191 tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) / MAX( 1, zcoef) ) * tmask(ii,ij,ik)192 ELSE193 ip = bdytmask(ii+1,ij ) - bdytmask(ii-1,ij )194 jp = bdytmask(ii ,ij+1) - bdytmask(ii ,ij-1)195 tra(ii,ij,ik,jn) = tra(ii+ip,ij+jp,ik,jn) * tmask(ii+ip,ij+jp,ik)196 ENDIF197 END DO198 END DO199 !200 IF( kt .eq. nit000 ) CLOSE( unit = 102 )201 !202 IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_nmn')203 !204 END SUBROUTINE bdy_trc_nmn205 206 207 SUBROUTINE bdy_trc_orlanski( jn, idx, dta, ll_npo )208 !!----------------------------------------------------------------------209 !! *** SUBROUTINE bdy_trc_orlanski ***210 !!211 !! - Apply Orlanski radiation to tracers of TOP component.212 !! - Wrapper routine for bdy_orlanski_3d213 !!214 !!215 !! References: Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)216 !!----------------------------------------------------------------------217 INTEGER, INTENT(in) :: jn ! Tracer index218 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices219 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data220 LOGICAL, INTENT(in) :: ll_npo ! switch for NPO version221 222 INTEGER :: igrd ! grid index223 !!----------------------------------------------------------------------224 225 IF( nn_timing == 1 ) CALL timing_start('bdy_trc_orlanski')226 !227 igrd = 1 ! Orlanski bc on tracers;228 !229 CALL bdy_orlanski_3d( idx, igrd, trb(:,:,:,jn), tra(:,:,:,jn), (dta%trc * dta%rn_fac), ll_npo )230 !231 IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_orlanski')232 !233 234 END SUBROUTINE bdy_trc_orlanski235 81 236 82 SUBROUTINE trc_bdy_dmp( kt )
Note: See TracChangeset
for help on using the changeset viewer.
