Changeset 7058 for branches/2016
- Timestamp:
- 2016-10-20T15:19:01+02:00 (8 years ago)
- Location:
- branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90
r6862 r7058 5 5 !!====================================================================== 6 6 !! History : 3.6 ! 2013 (D. Storkey) original code 7 !! 4.0 ! 2014 (T. Lovato) Generalize OBC structure 7 8 !!---------------------------------------------------------------------- 8 9 !!---------------------------------------------------------------------- … … 22 23 PRIVATE 23 24 24 PUBLIC bdy_orlanski_2d ! routine called where? 25 PUBLIC bdy_orlanski_3d ! routine called where? 25 PUBLIC bdy_frs, bdy_spe, bdy_nmn, bdy_orl 26 PUBLIC bdy_orlanski_2d 27 PUBLIC bdy_orlanski_3d 26 28 27 29 !!---------------------------------------------------------------------- 28 !! NEMO/OPA 3.3 , NEMO Consortium (2010)30 !! NEMO/OPA 4.0 , NEMO Consortium (2016) 29 31 !! $Id$ 30 32 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 31 33 !!---------------------------------------------------------------------- 32 34 CONTAINS 35 36 SUBROUTINE bdy_frs( idx, pta, dta ) 37 !!---------------------------------------------------------------------- 38 !! *** SUBROUTINE bdy_frs *** 39 !! 40 !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries. 41 !! 42 !! Reference : Engedahl H., 1995, Tellus, 365-382. 43 !!---------------------------------------------------------------------- 44 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 45 REAL(wp), DIMENSION(:,:), INTENT(in) :: dta ! OBC external data 46 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pta ! tracer trend 47 !! 48 REAL(wp) :: zwgt ! boundary weight 49 INTEGER :: ib, ik, igrd ! dummy loop indices 50 INTEGER :: ii, ij ! 2D addresses 51 !!---------------------------------------------------------------------- 52 ! 53 IF( nn_timing == 1 ) CALL timing_start('bdy_frs') 54 ! 55 igrd = 1 ! Everything is at T-points here 56 DO ib = 1, idx%nblen(igrd) 57 DO ik = 1, jpkm1 58 ii = idx%nbi(ib,igrd) 59 ij = idx%nbj(ib,igrd) 60 zwgt = idx%nbw(ib,igrd) 61 pta(ii,ij,ik) = ( pta(ii,ij,ik) + zwgt * (dta(ib,ik) - pta(ii,ij,ik) ) ) * tmask(ii,ij,ik) 62 END DO 63 END DO 64 ! 65 IF( nn_timing == 1 ) CALL timing_stop('bdy_frs') 66 ! 67 END SUBROUTINE bdy_frs 68 69 SUBROUTINE bdy_spe( idx, pta, dta ) 70 !!---------------------------------------------------------------------- 71 !! *** SUBROUTINE bdy_spe *** 72 !! 73 !! ** Purpose : Apply a specified value for tracers at open boundaries. 74 !! 75 !!---------------------------------------------------------------------- 76 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 77 REAL(wp), DIMENSION(:,:), INTENT(in) :: dta ! OBC external data 78 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pta ! tracer trend 79 !! 80 REAL(wp) :: zwgt ! boundary weight 81 INTEGER :: ib, ik, igrd ! dummy loop indices 82 INTEGER :: ii, ij ! 2D addresses 83 !!---------------------------------------------------------------------- 84 ! 85 IF( nn_timing == 1 ) CALL timing_start('bdy_spe') 86 ! 87 igrd = 1 ! Everything is at T-points here 88 DO ib = 1, idx%nblenrim(igrd) 89 ii = idx%nbi(ib,igrd) 90 ij = idx%nbj(ib,igrd) 91 DO ik = 1, jpkm1 92 pta(ii,ij,ik) = dta(ib,ik) * tmask(ii,ij,ik) 93 END DO 94 END DO 95 ! 96 IF( nn_timing == 1 ) CALL timing_stop('bdy_spe') 97 ! 98 END SUBROUTINE bdy_spe 99 100 SUBROUTINE bdy_nmn( idx, pta ) 101 !!---------------------------------------------------------------------- 102 !! *** SUBROUTINE bdy_nmn *** 103 !! 104 !! ** Purpose : Duplicate the value for tracers at open boundaries. 105 !! 106 !!---------------------------------------------------------------------- 107 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 108 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pta ! tracer trend 109 !! 110 REAL(wp) :: zwgt ! boundary weight 111 INTEGER :: ib, ik, igrd ! dummy loop indices 112 INTEGER :: ii, ij, zcoef, zcoef1, zcoef2, ip, jp ! 2D addresses 113 !!---------------------------------------------------------------------- 114 ! 115 IF( nn_timing == 1 ) CALL timing_start('bdy_nmn') 116 ! 117 igrd = 1 ! Everything is at T-points here 118 DO ib = 1, idx%nblenrim(igrd) 119 ii = idx%nbi(ib,igrd) 120 ij = idx%nbj(ib,igrd) 121 DO ik = 1, jpkm1 122 ! search the sense of the gradient 123 zcoef1 = bdytmask(ii-1,ij ) + bdytmask(ii+1,ij ) 124 zcoef2 = bdytmask(ii ,ij-1) + bdytmask(ii ,ij+1) 125 IF ( zcoef1+zcoef2 == 0) THEN 126 ! corner 127 zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) + tmask(ii,ij-1,ik) + tmask(ii,ij+1,ik) 128 pta(ii,ij,ik) = pta(ii-1,ij ,ik) * tmask(ii-1,ij ,ik) + & 129 & pta(ii+1,ij ,ik) * tmask(ii+1,ij ,ik) + & 130 & pta(ii ,ij-1,ik) * tmask(ii ,ij-1,ik) + & 131 & pta(ii ,ij+1,ik) * tmask(ii ,ij+1,ik) 132 pta(ii,ij,ik) = ( pta(ii,ij,ik) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 133 ELSE 134 ip = bdytmask(ii+1,ij ) - bdytmask(ii-1,ij ) 135 jp = bdytmask(ii ,ij+1) - bdytmask(ii ,ij-1) 136 pta(ii,ij,ik) = pta(ii+ip,ij+jp,ik) * tmask(ii+ip,ij+jp,ik) 137 ENDIF 138 END DO 139 END DO 140 ! 141 IF( nn_timing == 1 ) CALL timing_stop('bdy_nmn') 142 ! 143 END SUBROUTINE bdy_nmn 144 145 SUBROUTINE bdy_orl( idx, ptb, pta, dta, ll_npo ) 146 !!---------------------------------------------------------------------- 147 !! *** SUBROUTINE bdy_orl *** 148 !! 149 !! ** Purpose : Apply Orlanski radiation for tracers at open boundaries. 150 !! This is a wrapper routine for bdy_orlanski_3d below 151 !! 152 !!---------------------------------------------------------------------- 153 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 154 REAL(wp), DIMENSION(:,:), INTENT(in) :: dta ! OBC external data 155 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptb ! before tracer field 156 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pta ! tracer trend 157 LOGICAL, INTENT(in) :: ll_npo ! switch for NPO version 158 !! 159 INTEGER :: igrd ! grid index 160 !!---------------------------------------------------------------------- 161 ! 162 IF( nn_timing == 1 ) CALL timing_start('bdy_orl') 163 ! 164 igrd = 1 ! Everything is at T-points here 165 ! 166 CALL bdy_orlanski_3d( idx, igrd, ptb(:,:,:), pta(:,:,:), dta, ll_npo ) 167 ! 168 IF( nn_timing == 1 ) CALL timing_stop('bdy_orl') 169 ! 170 END SUBROUTINE bdy_orl 33 171 34 172 SUBROUTINE bdy_orlanski_2d( idx, igrd, phib, phia, phi_ext, ll_npo ) -
branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
r6862 r7058 8 8 !! 3.4 ! 2011 (D. Storkey) rewrite in preparation for OBC-BDY merge 9 9 !! 3.5 ! 2012 (S. Mocavero, I. Epicoco) Optimization of BDY communications 10 !! 4.0 ! 2016 (T. Lovato) Generalize OBC structure 10 11 !!---------------------------------------------------------------------- 11 !! bdy_tra : Apply open boundary conditions to T and S 12 !! bdy_tra_frs : Apply Flow Relaxation Scheme 12 !! bdy_tra : Apply open boundary conditions & damping to T and S 13 13 !!---------------------------------------------------------------------- 14 14 USE oce ! ocean dynamics and tracers variables … … 16 16 USE bdy_oce ! ocean open boundary conditions 17 17 USE bdylib ! for orlanski library routines 18 USE bdydta , ONLY: bf !19 18 ! 20 19 USE in_out_manager ! I/O manager … … 25 24 PRIVATE 26 25 26 ! Local structure to rearrange tracers data 27 TYPE, PUBLIC :: ztrabdy 28 REAL(wp), POINTER, DIMENSION(:,:) :: tra 29 END TYPE 30 27 31 PUBLIC bdy_tra ! called in tranxt.F90 28 32 PUBLIC bdy_tra_dmp ! called in step.F90 29 33 30 34 !!---------------------------------------------------------------------- 31 !! NEMO/OPA 3.3 , NEMO Consortium (2010)35 !! NEMO/OPA 4.0, NEMO Consortium (2016) 32 36 !! $Id$ 33 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 44 48 INTEGER, INTENT(in) :: kt ! Main time step counter 45 49 ! 46 INTEGER :: ib_bdy ! Loop index 50 INTEGER :: ib_bdy, jn ! Loop indeces 51 TYPE(ztrabdy), DIMENSION(jpts) :: zdta ! Temporary data structure 47 52 !!---------------------------------------------------------------------- 48 53 49 54 DO ib_bdy=1, nb_bdy 50 55 ! 51 SELECT CASE( cn_tra(ib_bdy) ) 52 CASE('none' ) ; CYCLE 53 CASE('frs' ) ; CALL bdy_tra_frs ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 54 CASE('specified' ) ; CALL bdy_tra_spe ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 55 CASE('neumann' ) ; CALL bdy_tra_nmn ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 56 CASE('orlanski' ) ; CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. ) 57 CASE('orlanski_npo') ; CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. ) 58 CASE('runoff' ) ; CALL bdy_tra_rnf ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 59 CASE DEFAULT ; CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 60 END SELECT 61 ! Boundary points should be updated 62 CALL lbc_bdy_lnk( tsa(:,:,:,jp_tem), 'T', 1., ib_bdy ) 63 CALL lbc_bdy_lnk( tsa(:,:,:,jp_sal), 'T', 1., ib_bdy ) 56 zdta(1)%tra => dta_bdy(ib_bdy)%tem 57 zdta(2)%tra => dta_bdy(ib_bdy)%sal 58 ! 59 DO jn = 1, jpts 60 ! 61 SELECT CASE( cn_tra(ib_bdy) ) 62 CASE('none' ) ; CYCLE 63 CASE('frs' ) ; CALL bdy_frs ( idx_bdy(ib_bdy), tsa(:,:,:,jn), zdta(jn)%tra ) 64 CASE('specified' ) ; CALL bdy_spe ( idx_bdy(ib_bdy), tsa(:,:,:,jn), zdta(jn)%tra ) 65 CASE('neumann' ) ; CALL bdy_nmn ( idx_bdy(ib_bdy), tsa(:,:,:,jn) ) 66 CASE('orlanski' ) ; CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.false. ) 67 CASE('orlanski_npo') ; CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.true. ) 68 CASE('runoff' ) ; CALL bdy_rnf ( idx_bdy(ib_bdy), tsa(:,:,:,jn), jn ) 69 CASE DEFAULT ; CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 70 END SELECT 71 ! Boundary points should be updated 72 CALL lbc_bdy_lnk( tsa(:,:,:,jn), 'T', 1., ib_bdy ) 73 ! 74 END DO 64 75 END DO 65 76 ! 66 77 END SUBROUTINE bdy_tra 67 78 68 69 SUBROUTINE bdy_tra_frs( idx, dta, kt ) 79 SUBROUTINE bdy_rnf( idx, pta, jpa ) 70 80 !!---------------------------------------------------------------------- 71 !! *** SUBROUTINE bdy_ tra_frs***81 !! *** SUBROUTINE bdy_rnf *** 72 82 !! 73 !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries. 74 !! 75 !! Reference : Engedahl H., 1995, Tellus, 365-382. 76 !!---------------------------------------------------------------------- 77 INTEGER, INTENT(in) :: kt ! 78 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 79 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 80 ! 81 REAL(wp) :: zwgt ! boundary weight 82 INTEGER :: ib, ik, igrd ! dummy loop indices 83 INTEGER :: ii, ij ! 2D addresses 84 !!---------------------------------------------------------------------- 85 ! 86 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_frs') 87 ! 88 igrd = 1 ! Everything is at T-points here 89 DO ib = 1, idx%nblen(igrd) 90 DO ik = 1, jpkm1 91 ii = idx%nbi(ib,igrd) 92 ij = idx%nbj(ib,igrd) 93 zwgt = idx%nbw(ib,igrd) 94 tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) + zwgt * ( dta%tem(ib,ik) - tsa(ii,ij,ik,jp_tem) ) ) * tmask(ii,ij,ik) 95 tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) + zwgt * ( dta%sal(ib,ik) - tsa(ii,ij,ik,jp_sal) ) ) * tmask(ii,ij,ik) 96 END DO 97 END DO 98 ! 99 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 100 ! 101 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_frs') 102 ! 103 END SUBROUTINE bdy_tra_frs 104 105 106 SUBROUTINE bdy_tra_spe( idx, dta, kt ) 107 !!---------------------------------------------------------------------- 108 !! *** SUBROUTINE bdy_tra_frs *** 109 !! 110 !! ** Purpose : Apply a specified value for tracers at open boundaries. 83 !! ** Purpose : Specialized routine to apply TRA runoff values at OBs: 84 !! - duplicate the neighbour value for the temperature 85 !! - specified to 0.1 PSU for the salinity 111 86 !! 112 87 !!---------------------------------------------------------------------- 113 INTEGER, INTENT(in) :: kt ! 114 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 115 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 116 ! 117 REAL(wp) :: zwgt ! boundary weight 118 INTEGER :: ib, ik, igrd ! dummy loop indices 119 INTEGER :: ii, ij ! 2D addresses 120 !!---------------------------------------------------------------------- 121 ! 122 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_spe') 123 ! 124 igrd = 1 ! Everything is at T-points here 125 DO ib = 1, idx%nblenrim(igrd) 126 ii = idx%nbi(ib,igrd) 127 ij = idx%nbj(ib,igrd) 128 DO ik = 1, jpkm1 129 tsa(ii,ij,ik,jp_tem) = dta%tem(ib,ik) * tmask(ii,ij,ik) 130 tsa(ii,ij,ik,jp_sal) = dta%sal(ib,ik) * tmask(ii,ij,ik) 131 END DO 132 END DO 133 ! 134 IF( kt == nit000 ) CLOSE( unit = 102 ) 135 ! 136 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_spe') 137 ! 138 END SUBROUTINE bdy_tra_spe 139 140 141 SUBROUTINE bdy_tra_nmn( idx, dta, kt ) 142 !!---------------------------------------------------------------------- 143 !! *** SUBROUTINE bdy_tra_nmn *** 144 !! 145 !! ** Purpose : Duplicate the value for tracers at open boundaries. 146 !! 147 !!---------------------------------------------------------------------- 148 INTEGER, INTENT(in) :: kt ! 149 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 150 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 151 ! 152 REAL(wp) :: zwgt ! boundary weight 153 INTEGER :: ib, ik, igrd ! dummy loop indices 154 INTEGER :: ii, ij,zcoef, zcoef1,zcoef2, ip, jp ! 2D addresses 155 !!---------------------------------------------------------------------- 156 ! 157 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_nmn') 158 ! 159 igrd = 1 ! Everything is at T-points here 160 DO ib = 1, idx%nblenrim(igrd) 161 ii = idx%nbi(ib,igrd) 162 ij = idx%nbj(ib,igrd) 163 DO ik = 1, jpkm1 164 ! search the sense of the gradient 165 zcoef1 = bdytmask(ii-1,ij ) + bdytmask(ii+1,ij ) 166 zcoef2 = bdytmask(ii ,ij-1) + bdytmask(ii ,ij+1) 167 IF ( zcoef1+zcoef2 == 0) THEN 168 ! corner 169 zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) + tmask(ii,ij-1,ik) + tmask(ii,ij+1,ik) 170 tsa(ii,ij,ik,jp_tem) = tsa(ii-1,ij ,ik,jp_tem) * tmask(ii-1,ij ,ik) + & 171 & tsa(ii+1,ij ,ik,jp_tem) * tmask(ii+1,ij ,ik) + & 172 & tsa(ii ,ij-1,ik,jp_tem) * tmask(ii ,ij-1,ik) + & 173 & tsa(ii ,ij+1,ik,jp_tem) * tmask(ii ,ij+1,ik) 174 tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 175 tsa(ii,ij,ik,jp_sal) = tsa(ii-1,ij ,ik,jp_sal) * tmask(ii-1,ij ,ik) + & 176 & tsa(ii+1,ij ,ik,jp_sal) * tmask(ii+1,ij ,ik) + & 177 & tsa(ii ,ij-1,ik,jp_sal) * tmask(ii ,ij-1,ik) + & 178 & tsa(ii ,ij+1,ik,jp_sal) * tmask(ii ,ij+1,ik) 179 tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 180 ELSE 181 ip = bdytmask(ii+1,ij ) - bdytmask(ii-1,ij ) 182 jp = bdytmask(ii ,ij+1) - bdytmask(ii ,ij-1) 183 tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii+ip,ij+jp,ik) 184 tsa(ii,ij,ik,jp_sal) = tsa(ii+ip,ij+jp,ik,jp_sal) * tmask(ii+ip,ij+jp,ik) 185 ENDIF 186 END DO 187 END DO 188 ! 189 IF( kt == nit000 ) CLOSE( unit = 102 ) 190 ! 191 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_nmn') 192 ! 193 END SUBROUTINE bdy_tra_nmn 194 195 196 SUBROUTINE bdy_tra_orlanski( idx, dta, ll_npo ) 197 !!---------------------------------------------------------------------- 198 !! *** SUBROUTINE bdy_tra_orlanski *** 199 !! 200 !! - Apply Orlanski radiation to temperature and salinity. 201 !! - Wrapper routine for bdy_orlanski_3d 202 !! 203 !! 204 !! References: Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001) 205 !!---------------------------------------------------------------------- 206 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 207 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 208 LOGICAL , INTENT(in) :: ll_npo ! switch for NPO version 209 ! 210 INTEGER :: igrd ! grid index 211 !!---------------------------------------------------------------------- 212 ! 213 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_orlanski') 214 ! 215 igrd = 1 ! Orlanski bc on temperature; 216 ! 217 CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_tem), tsa(:,:,:,jp_tem), dta%tem, ll_npo ) 218 219 igrd = 1 ! Orlanski bc on salinity; 220 ! 221 CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_sal), tsa(:,:,:,jp_sal), dta%sal, ll_npo ) 222 ! 223 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_orlanski') 224 ! 225 END SUBROUTINE bdy_tra_orlanski 226 227 228 SUBROUTINE bdy_tra_rnf( idx, dta, kt ) 229 !!---------------------------------------------------------------------- 230 !! *** SUBROUTINE bdy_tra_rnf *** 231 !! 232 !! ** Purpose : Apply the runoff values for tracers at open boundaries: 233 !! - specified to 0.1 PSU for the salinity 234 !! - duplicate the value for the temperature 235 !! 236 !!---------------------------------------------------------------------- 237 INTEGER , INTENT(in) :: kt ! 238 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 239 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 88 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 89 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pta ! tracer trend 90 INTEGER, INTENT(in) :: jpa ! TRA index 240 91 ! 241 92 REAL(wp) :: zwgt ! boundary weight … … 244 95 !!---------------------------------------------------------------------- 245 96 ! 246 IF( nn_timing == 1 ) CALL timing_start('bdy_ tra_rnf')97 IF( nn_timing == 1 ) CALL timing_start('bdy_rnf') 247 98 ! 248 99 igrd = 1 ! Everything is at T-points here … … 253 104 ip = bdytmask(ii+1,ij ) - bdytmask(ii-1,ij ) 254 105 jp = bdytmask(ii ,ij+1) - bdytmask(ii ,ij-1) 255 tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii,ij,ik)256 tsa(ii,ij,ik,jp_sal) =0.1 * tmask(ii,ij,ik)106 if (jpa == jp_tem) pta(ii,ij,ik) = pta(ii+ip,ij+jp,ik) * tmask(ii,ij,ik) 107 if (jpa == jp_sal) pta(ii,ij,ik) = 0.1 * tmask(ii,ij,ik) 257 108 END DO 258 109 END DO 259 110 ! 260 IF( kt == nit000 ) CLOSE( unit = 102)111 IF( nn_timing == 1 ) CALL timing_stop('bdy_rnf') 261 112 ! 262 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_rnf') 263 ! 264 END SUBROUTINE bdy_tra_rnf 265 113 END SUBROUTINE bdy_rnf 266 114 267 115 SUBROUTINE bdy_tra_dmp( kt ) -
branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r6489 r7058 202 202 DO jj = 2, jpjm1 203 203 DO ji = fs_2, fs_jpim1 204 IF( fsdept(ji,jj,jk) < ekm_dep(ji,jj) ) THEN204 IF( gdept_n(ji,jj,jk) < ekm_dep(ji,jj) ) THEN 205 205 avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), rn_wvmix ) 206 206 avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk), rn_wvmix ) -
branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90
r6862 r7058 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 13 #if defined key_top 13 14 !!---------------------------------------------------------------------- 14 !! trc_bdy : Apply open boundary conditions to T and S 15 !! trc_bdy_frs : Apply Flow Relaxation Scheme 15 !! trc_bdy : Apply open boundary conditions & damping to tracers 16 16 !!---------------------------------------------------------------------- 17 17 USE timing ! Timing … … 22 22 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 23 23 USE in_out_manager ! I/O manager 24 USE bdy_oce, only: idx_bdy , OBC_INDEX, BDYTMASK, ln_bdy! ocean open boundary conditions24 USE bdy_oce, only: idx_bdy ! ocean open boundary conditions 25 25 26 26 IMPLICIT NONE 27 27 PRIVATE 28 29 ! Local structure to rearrange tracers data 30 TYPE, PUBLIC :: ztrcbdy 31 REAL(wp), POINTER, DIMENSION(:,:) :: trc 32 REAL(wp), POINTER :: fac 33 END TYPE 28 34 29 35 PUBLIC trc_bdy ! routine called in trcnxt.F90 … … 31 37 32 38 !!---------------------------------------------------------------------- 33 !! NEMO/OPA 3.6 , NEMO Consortium (2015)39 !! NEMO/OPA 4.0 , NEMO Consortium (2016) 34 40 !! $Id$ 35 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 41 47 !! *** SUBROUTINE trc_bdy *** 42 48 !! 43 !! ** Purpose : - Apply open boundary conditions for tracers in TOP component 44 !! and scale the tracer data 49 !! ** Purpose : - Apply open boundary conditions for TOP tracers 45 50 !! 46 51 !!---------------------------------------------------------------------- … … 48 53 !! 49 54 INTEGER :: ib_bdy, jn ! Loop indeces 55 TYPE(ztrcbdy) :: zdta ! Temporary data structure 50 56 !!---------------------------------------------------------------------- 51 57 ! 52 58 IF( nn_timing == 1 ) CALL timing_start('trc_bdy') 53 59 ! 54 DO jn = 1, jptra 55 DO ib_bdy=1, nb_bdy 56 57 SELECT CASE( trcdta_bdy(jn,ib_bdy)%cn_obc ) 58 CASE('none') 59 CYCLE 60 CASE('frs') 61 CALL bdy_trc_frs( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 62 CASE('specified') 63 CALL bdy_trc_spe( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 64 CASE('neumann') 65 CALL bdy_trc_nmn( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 66 CASE('orlanski') 67 CALL bdy_trc_orlanski( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), ll_npo=.false. ) 68 CASE('orlanski_npo') 69 CALL bdy_trc_orlanski( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), ll_npo=.true. ) 70 CASE DEFAULT 71 CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 60 DO ib_bdy=1, nb_bdy 61 DO jn = 1, jptra 62 ! 63 zdta%trc => trcdta_bdy(jn,ib_bdy)%trc 64 zdta%fac => trcdta_bdy(jn,ib_bdy)%rn_fac 65 ! 66 SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) ) 67 CASE('none' ) ; CYCLE 68 CASE('frs' ) ; CALL bdy_frs( idx_bdy(ib_bdy), tra(:,:,:,jn), zdta%trc*zdta%fac ) 69 CASE('specified' ) ; CALL bdy_spe( idx_bdy(ib_bdy), tra(:,:,:,jn), zdta%trc*zdta%fac ) 70 CASE('neumann' ) ; CALL bdy_nmn( idx_bdy(ib_bdy), tra(:,:,:,jn) ) 71 CASE('orlanski' ) ; CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), zdta%trc*zdta%fac, ll_npo=.false. ) 72 CASE('orlanski_npo') ; CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), zdta%trc*zdta%fac, ll_npo=.true. ) 73 CASE DEFAULT ; CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 72 74 END SELECT 73 74 75 ! Boundary points should be updated 75 76 CALL lbc_bdy_lnk( tra(:,:,:,jn), 'T', 1., ib_bdy ) 76 77 END DO78 END DO77 ! 78 END DO 79 END DO 79 80 ! 80 81 IF( nn_timing == 1 ) CALL timing_stop('trc_bdy') 81 82 82 83 END SUBROUTINE trc_bdy 83 84 SUBROUTINE bdy_trc_frs( jn, idx, dta, kt )85 !!----------------------------------------------------------------------86 !! *** SUBROUTINE bdy_trc_frs ***87 !!88 !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries.89 !!90 !! Reference : Engedahl H., 1995, Tellus, 365-382.91 !!----------------------------------------------------------------------92 INTEGER, INTENT(in) :: kt93 INTEGER, INTENT(in) :: jn ! Tracer index94 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices95 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data96 !!97 REAL(wp) :: zwgt ! boundary weight98 INTEGER :: ib, ik, igrd ! dummy loop indices99 INTEGER :: ii, ij ! 2D addresses100 !!----------------------------------------------------------------------101 !102 IF( nn_timing == 1 ) CALL timing_start('bdy_trc_frs')103 !104 igrd = 1 ! Everything is at T-points here105 DO ib = 1, idx%nblen(igrd)106 DO ik = 1, jpkm1107 ii = idx%nbi(ib,igrd)108 ij = idx%nbj(ib,igrd)109 zwgt = idx%nbw(ib,igrd)110 tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) + zwgt * ( ( dta%trc(ib,ik) * dta%rn_fac) &111 & - tra(ii,ij,ik,jn) ) ) * tmask(ii,ij,ik)112 END DO113 END DO114 !115 IF( kt .eq. nit000 ) CLOSE( unit = 102 )116 !117 IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_frs')118 !119 END SUBROUTINE bdy_trc_frs120 121 SUBROUTINE bdy_trc_spe( jn, idx, dta, kt )122 !!----------------------------------------------------------------------123 !! *** SUBROUTINE bdy_trc_frs ***124 !!125 !! ** Purpose : Apply a specified value for tracers at open boundaries.126 !!127 !!----------------------------------------------------------------------128 INTEGER, INTENT(in) :: kt129 INTEGER, INTENT(in) :: jn ! Tracer index130 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices131 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data132 !!133 REAL(wp) :: zwgt ! boundary weight134 INTEGER :: ib, ik, igrd ! dummy loop indices135 INTEGER :: ii, ij ! 2D addresses136 !!----------------------------------------------------------------------137 !138 IF( nn_timing == 1 ) CALL timing_start('bdy_trc_spe')139 !140 igrd = 1 ! Everything is at T-points here141 DO ib = 1, idx%nblenrim(igrd)142 ii = idx%nbi(ib,igrd)143 ij = idx%nbj(ib,igrd)144 DO ik = 1, jpkm1145 tra(ii,ij,ik,jn) = dta%trc(ib,ik) * dta%rn_fac * tmask(ii,ij,ik)146 END DO147 END DO148 !149 IF( kt .eq. nit000 ) CLOSE( unit = 102 )150 !151 IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_spe')152 !153 END SUBROUTINE bdy_trc_spe154 155 SUBROUTINE bdy_trc_nmn( jn, idx, dta, kt )156 !!----------------------------------------------------------------------157 !! *** SUBROUTINE bdy_trc_nmn ***158 !!159 !! ** Purpose : Duplicate the value for tracers at open boundaries.160 !!161 !!----------------------------------------------------------------------162 INTEGER, INTENT(in) :: kt163 INTEGER, INTENT(in) :: jn ! Tracer index164 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices165 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data166 !!167 REAL(wp) :: zwgt ! boundary weight168 INTEGER :: ib, ik, igrd ! dummy loop indices169 INTEGER :: ii, ij, zcoef, zcoef1, zcoef2, ip, jp ! 2D addresses170 !!----------------------------------------------------------------------171 !172 IF( nn_timing == 1 ) CALL timing_start('bdy_trc_nmn')173 !174 igrd = 1 ! Everything is at T-points here175 DO ib = 1, idx%nblenrim(igrd)176 ii = idx%nbi(ib,igrd)177 ij = idx%nbj(ib,igrd)178 DO ik = 1, jpkm1179 ! search the sense of the gradient180 zcoef1 = bdytmask(ii-1,ij ) + bdytmask(ii+1,ij )181 zcoef2 = bdytmask(ii ,ij-1) + bdytmask(ii ,ij+1)182 IF ( zcoef1+zcoef2 == 0) THEN183 ! corner184 zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) + tmask(ii,ij-1,ik) + tmask(ii,ij+1,ik)185 tra(ii,ij,ik,jn) = tra(ii-1,ij ,ik,jn) * tmask(ii-1,ij ,ik) + &186 & tra(ii+1,ij ,ik,jn) * tmask(ii+1,ij ,ik) + &187 & tra(ii ,ij-1,ik,jn) * tmask(ii ,ij-1,ik) + &188 & tra(ii ,ij+1,ik,jn) * tmask(ii ,ij+1,ik)189 tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) / MAX( 1, zcoef) ) * tmask(ii,ij,ik)190 ELSE191 ip = bdytmask(ii+1,ij ) - bdytmask(ii-1,ij )192 jp = bdytmask(ii ,ij+1) - bdytmask(ii ,ij-1)193 tra(ii,ij,ik,jn) = tra(ii+ip,ij+jp,ik,jn) * tmask(ii+ip,ij+jp,ik)194 ENDIF195 END DO196 END DO197 !198 IF( kt .eq. nit000 ) CLOSE( unit = 102 )199 !200 IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_nmn')201 !202 END SUBROUTINE bdy_trc_nmn203 204 205 SUBROUTINE bdy_trc_orlanski( jn, idx, dta, ll_npo )206 !!----------------------------------------------------------------------207 !! *** SUBROUTINE bdy_trc_orlanski ***208 !!209 !! - Apply Orlanski radiation to tracers of TOP component.210 !! - Wrapper routine for bdy_orlanski_3d211 !!212 !!213 !! References: Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)214 !!----------------------------------------------------------------------215 INTEGER, INTENT(in) :: jn ! Tracer index216 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices217 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data218 LOGICAL, INTENT(in) :: ll_npo ! switch for NPO version219 220 INTEGER :: igrd ! grid index221 !!----------------------------------------------------------------------222 223 IF( nn_timing == 1 ) CALL timing_start('bdy_trc_orlanski')224 !225 igrd = 1 ! Orlanski bc on tracers;226 !227 CALL bdy_orlanski_3d( idx, igrd, trb(:,:,:,jn), tra(:,:,:,jn), (dta%trc * dta%rn_fac), ll_npo )228 !229 IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_orlanski')230 !231 232 END SUBROUTINE bdy_trc_orlanski233 84 234 85 SUBROUTINE trc_bdy_dmp( kt ) -
branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
r6862 r7058 499 499 z1_rau0 = 0.5 / rau0 500 500 ssha(:,:) = ( sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * tmask(:,:,1) 501 #if ! defined key_dynspg_ts 501 502 IF( .NOT.ln_dynspg_ts ) THEN 502 503 ! These lines are not necessary with time splitting since 503 504 ! boundary condition on sea level is set during ts loop … … 505 506 CALL agrif_ssh( kt ) 506 507 #endif 507 IF( ln_bdy ) THEN508 ssha(:,:) = ssha(:,:) * bdytmask(:,:)509 CALL lbc_lnk( ssha, 'T', 1. )510 ENDIF511 #endif 508 IF( ln_bdy ) THEN 509 ssha(:,:) = ssha(:,:) * bdytmask(:,:) 510 CALL lbc_lnk( ssha, 'T', 1. ) 511 ENDIF 512 ENDIF 512 513 ! 513 514 ! !------------------------------!
Note: See TracChangeset
for help on using the changeset viewer.