- Timestamp:
- 2016-12-01T11:30:29+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
r6140 r7412 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 #if defined key_bdy 12 !!---------------------------------------------------------------------- 13 !! 'key_bdy' Unstructured Open Boundary Conditions 14 !!---------------------------------------------------------------------- 15 !! bdy_tra : Apply open boundary conditions to T and S 16 !! bdy_tra_frs : Apply Flow Relaxation Scheme 12 !! bdy_tra : Apply open boundary conditions & damping to T and S 17 13 !!---------------------------------------------------------------------- 18 14 USE oce ! ocean dynamics and tracers variables … … 20 16 USE bdy_oce ! ocean open boundary conditions 21 17 USE bdylib ! for orlanski library routines 22 USE bdydta , ONLY: bf !23 18 ! 24 19 USE in_out_manager ! I/O manager … … 29 24 PRIVATE 30 25 26 ! Local structure to rearrange tracers data 27 TYPE, PUBLIC :: ztrabdy 28 REAL(wp), POINTER, DIMENSION(:,:) :: tra 29 END TYPE 30 31 31 PUBLIC bdy_tra ! called in tranxt.F90 32 32 PUBLIC bdy_tra_dmp ! called in step.F90 33 33 34 34 !!---------------------------------------------------------------------- 35 !! NEMO/OPA 3.3 , NEMO Consortium (2010)35 !! NEMO/OPA 4.0, NEMO Consortium (2016) 36 36 !! $Id$ 37 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 48 48 INTEGER, INTENT(in) :: kt ! Main time step counter 49 49 ! 50 INTEGER :: ib_bdy ! Loop index 50 INTEGER :: ib_bdy, jn, igrd ! Loop indeces 51 TYPE(ztrabdy), DIMENSION(jpts) :: zdta ! Temporary data structure 51 52 !!---------------------------------------------------------------------- 53 igrd = 1 52 54 53 55 DO ib_bdy=1, nb_bdy 54 56 ! 55 SELECT CASE( cn_tra(ib_bdy) ) 56 CASE('none' ) ; CYCLE 57 CASE('frs' ) ; CALL bdy_tra_frs ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 58 CASE('specified' ) ; CALL bdy_tra_spe ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 59 CASE('neumann' ) ; CALL bdy_tra_nmn ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 60 CASE('orlanski' ) ; CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. ) 61 CASE('orlanski_npo') ; CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. ) 62 CASE('runoff' ) ; CALL bdy_tra_rnf ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 63 CASE DEFAULT ; CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 64 END SELECT 65 ! Boundary points should be updated 66 CALL lbc_bdy_lnk( tsa(:,:,:,jp_tem), 'T', 1., ib_bdy ) 67 CALL lbc_bdy_lnk( tsa(:,:,:,jp_sal), 'T', 1., ib_bdy ) 57 zdta(1)%tra => dta_bdy(ib_bdy)%tem 58 zdta(2)%tra => dta_bdy(ib_bdy)%sal 59 ! 60 DO jn = 1, jpts 61 ! 62 SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 63 CASE('none' ) ; CYCLE 64 CASE('frs' ) ; CALL bdy_frs ( idx_bdy(ib_bdy), tsa(:,:,:,jn), zdta(jn)%tra ) 65 CASE('specified' ) ; CALL bdy_spe ( idx_bdy(ib_bdy), tsa(:,:,:,jn), zdta(jn)%tra ) 66 CASE('neumann' ) ; CALL bdy_nmn ( idx_bdy(ib_bdy), igrd , tsa(:,:,:,jn) ) 67 CASE('orlanski' ) ; CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.false. ) 68 CASE('orlanski_npo') ; CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.true. ) 69 CASE('runoff' ) ; CALL bdy_rnf ( idx_bdy(ib_bdy), tsa(:,:,:,jn), jn ) 70 CASE DEFAULT ; CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 71 END SELECT 72 ! Boundary points should be updated 73 CALL lbc_bdy_lnk( tsa(:,:,:,jn), 'T', 1., ib_bdy ) 74 ! 75 END DO 68 76 END DO 69 77 ! 70 78 END SUBROUTINE bdy_tra 71 79 72 73 SUBROUTINE bdy_tra_frs( idx, dta, kt ) 80 SUBROUTINE bdy_rnf( idx, pta, jpa ) 74 81 !!---------------------------------------------------------------------- 75 !! *** SUBROUTINE bdy_ tra_frs***82 !! *** SUBROUTINE bdy_rnf *** 76 83 !! 77 !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries. 78 !! 79 !! Reference : Engedahl H., 1995, Tellus, 365-382. 80 !!---------------------------------------------------------------------- 81 INTEGER, INTENT(in) :: kt ! 82 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 83 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 84 ! 85 REAL(wp) :: zwgt ! boundary weight 86 INTEGER :: ib, ik, igrd ! dummy loop indices 87 INTEGER :: ii, ij ! 2D addresses 88 !!---------------------------------------------------------------------- 89 ! 90 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_frs') 91 ! 92 igrd = 1 ! Everything is at T-points here 93 DO ib = 1, idx%nblen(igrd) 94 DO ik = 1, jpkm1 95 ii = idx%nbi(ib,igrd) 96 ij = idx%nbj(ib,igrd) 97 zwgt = idx%nbw(ib,igrd) 98 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) 99 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) 100 END DO 101 END DO 102 ! 103 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 104 ! 105 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_frs') 106 ! 107 END SUBROUTINE bdy_tra_frs 108 109 110 SUBROUTINE bdy_tra_spe( idx, dta, kt ) 111 !!---------------------------------------------------------------------- 112 !! *** SUBROUTINE bdy_tra_frs *** 113 !! 114 !! ** Purpose : Apply a specified value for tracers at open boundaries. 84 !! ** Purpose : Specialized routine to apply TRA runoff values at OBs: 85 !! - duplicate the neighbour value for the temperature 86 !! - specified to 0.1 PSU for the salinity 115 87 !! 116 88 !!---------------------------------------------------------------------- 117 INTEGER, INTENT(in) :: kt ! 118 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 119 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 120 ! 121 REAL(wp) :: zwgt ! boundary weight 122 INTEGER :: ib, ik, igrd ! dummy loop indices 123 INTEGER :: ii, ij ! 2D addresses 124 !!---------------------------------------------------------------------- 125 ! 126 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_spe') 127 ! 128 igrd = 1 ! Everything is at T-points here 129 DO ib = 1, idx%nblenrim(igrd) 130 ii = idx%nbi(ib,igrd) 131 ij = idx%nbj(ib,igrd) 132 DO ik = 1, jpkm1 133 tsa(ii,ij,ik,jp_tem) = dta%tem(ib,ik) * tmask(ii,ij,ik) 134 tsa(ii,ij,ik,jp_sal) = dta%sal(ib,ik) * tmask(ii,ij,ik) 135 END DO 136 END DO 137 ! 138 IF( kt == nit000 ) CLOSE( unit = 102 ) 139 ! 140 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_spe') 141 ! 142 END SUBROUTINE bdy_tra_spe 143 144 145 SUBROUTINE bdy_tra_nmn( idx, dta, kt ) 146 !!---------------------------------------------------------------------- 147 !! *** SUBROUTINE bdy_tra_nmn *** 148 !! 149 !! ** Purpose : Duplicate the value for tracers at open boundaries. 150 !! 151 !!---------------------------------------------------------------------- 152 INTEGER, INTENT(in) :: kt ! 153 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 154 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 155 ! 156 REAL(wp) :: zwgt ! boundary weight 157 INTEGER :: ib, ik, igrd ! dummy loop indices 158 INTEGER :: ii, ij,zcoef, zcoef1,zcoef2, ip, jp ! 2D addresses 159 !!---------------------------------------------------------------------- 160 ! 161 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_nmn') 162 ! 163 igrd = 1 ! Everything is at T-points here 164 DO ib = 1, idx%nblenrim(igrd) 165 ii = idx%nbi(ib,igrd) 166 ij = idx%nbj(ib,igrd) 167 DO ik = 1, jpkm1 168 ! search the sense of the gradient 169 zcoef1 = bdytmask(ii-1,ij ) + bdytmask(ii+1,ij ) 170 zcoef2 = bdytmask(ii ,ij-1) + bdytmask(ii ,ij+1) 171 IF ( zcoef1+zcoef2 == 0) THEN 172 ! corner 173 zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) + tmask(ii,ij-1,ik) + tmask(ii,ij+1,ik) 174 tsa(ii,ij,ik,jp_tem) = tsa(ii-1,ij ,ik,jp_tem) * tmask(ii-1,ij ,ik) + & 175 & tsa(ii+1,ij ,ik,jp_tem) * tmask(ii+1,ij ,ik) + & 176 & tsa(ii ,ij-1,ik,jp_tem) * tmask(ii ,ij-1,ik) + & 177 & tsa(ii ,ij+1,ik,jp_tem) * tmask(ii ,ij+1,ik) 178 tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 179 tsa(ii,ij,ik,jp_sal) = tsa(ii-1,ij ,ik,jp_sal) * tmask(ii-1,ij ,ik) + & 180 & tsa(ii+1,ij ,ik,jp_sal) * tmask(ii+1,ij ,ik) + & 181 & tsa(ii ,ij-1,ik,jp_sal) * tmask(ii ,ij-1,ik) + & 182 & tsa(ii ,ij+1,ik,jp_sal) * tmask(ii ,ij+1,ik) 183 tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 184 ELSE 185 ip = bdytmask(ii+1,ij ) - bdytmask(ii-1,ij ) 186 jp = bdytmask(ii ,ij+1) - bdytmask(ii ,ij-1) 187 tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii+ip,ij+jp,ik) 188 tsa(ii,ij,ik,jp_sal) = tsa(ii+ip,ij+jp,ik,jp_sal) * tmask(ii+ip,ij+jp,ik) 189 ENDIF 190 END DO 191 END DO 192 ! 193 IF( kt == nit000 ) CLOSE( unit = 102 ) 194 ! 195 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_nmn') 196 ! 197 END SUBROUTINE bdy_tra_nmn 198 199 200 SUBROUTINE bdy_tra_orlanski( idx, dta, ll_npo ) 201 !!---------------------------------------------------------------------- 202 !! *** SUBROUTINE bdy_tra_orlanski *** 203 !! 204 !! - Apply Orlanski radiation to temperature and salinity. 205 !! - Wrapper routine for bdy_orlanski_3d 206 !! 207 !! 208 !! References: Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001) 209 !!---------------------------------------------------------------------- 210 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 211 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 212 LOGICAL , INTENT(in) :: ll_npo ! switch for NPO version 213 ! 214 INTEGER :: igrd ! grid index 215 !!---------------------------------------------------------------------- 216 ! 217 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_orlanski') 218 ! 219 igrd = 1 ! Orlanski bc on temperature; 220 ! 221 CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_tem), tsa(:,:,:,jp_tem), dta%tem, ll_npo ) 222 223 igrd = 1 ! Orlanski bc on salinity; 224 ! 225 CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_sal), tsa(:,:,:,jp_sal), dta%sal, ll_npo ) 226 ! 227 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_orlanski') 228 ! 229 END SUBROUTINE bdy_tra_orlanski 230 231 232 SUBROUTINE bdy_tra_rnf( idx, dta, kt ) 233 !!---------------------------------------------------------------------- 234 !! *** SUBROUTINE bdy_tra_rnf *** 235 !! 236 !! ** Purpose : Apply the runoff values for tracers at open boundaries: 237 !! - specified to 0.1 PSU for the salinity 238 !! - duplicate the value for the temperature 239 !! 240 !!---------------------------------------------------------------------- 241 INTEGER , INTENT(in) :: kt ! 242 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 243 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 89 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 90 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pta ! tracer trend 91 INTEGER, INTENT(in) :: jpa ! TRA index 244 92 ! 245 93 REAL(wp) :: zwgt ! boundary weight … … 248 96 !!---------------------------------------------------------------------- 249 97 ! 250 IF( nn_timing == 1 ) CALL timing_start('bdy_ tra_rnf')98 IF( nn_timing == 1 ) CALL timing_start('bdy_rnf') 251 99 ! 252 100 igrd = 1 ! Everything is at T-points here … … 257 105 ip = bdytmask(ii+1,ij ) - bdytmask(ii-1,ij ) 258 106 jp = bdytmask(ii ,ij+1) - bdytmask(ii ,ij-1) 259 tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii,ij,ik)260 tsa(ii,ij,ik,jp_sal) =0.1 * tmask(ii,ij,ik)107 if (jpa == jp_tem) pta(ii,ij,ik) = pta(ii+ip,ij+jp,ik) * tmask(ii,ij,ik) 108 if (jpa == jp_sal) pta(ii,ij,ik) = 0.1 * tmask(ii,ij,ik) 261 109 END DO 262 110 END DO 263 111 ! 264 IF( kt == nit000 ) CLOSE( unit = 102)112 IF( nn_timing == 1 ) CALL timing_stop('bdy_rnf') 265 113 ! 266 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_rnf') 267 ! 268 END SUBROUTINE bdy_tra_rnf 269 114 END SUBROUTINE bdy_rnf 270 115 271 116 SUBROUTINE bdy_tra_dmp( kt ) … … 308 153 END SUBROUTINE bdy_tra_dmp 309 154 310 #else311 !!----------------------------------------------------------------------312 !! Dummy module NO Unstruct Open Boundary Conditions313 !!----------------------------------------------------------------------314 CONTAINS315 SUBROUTINE bdy_tra(kt) ! Empty routine316 WRITE(*,*) 'bdy_tra: You should not have seen this print! error?', kt317 END SUBROUTINE bdy_tra318 319 SUBROUTINE bdy_tra_dmp(kt) ! Empty routine320 WRITE(*,*) 'bdy_tra_dmp: You should not have seen this print! error?', kt321 END SUBROUTINE bdy_tra_dmp322 #endif323 324 155 !!====================================================================== 325 156 END MODULE bdytra
Note: See TracChangeset
for help on using the changeset viewer.