- Timestamp:
- 2011-07-11T12:53:56+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC/obctra.F90
r2528 r2797 1 1 MODULE obctra 2 !!====================================================================== ===========2 !!====================================================================== 3 3 !! *** MODULE obctra *** 4 !! Ocean tracers: Radiation of tracers on each open boundary 5 !!================================================================================= 4 !! Ocean tracers: Flow Relaxation Scheme of tracers on each open boundary 5 !!====================================================================== 6 !! History : 1.0 ! 2005-01 (J. Chanut, A. Sellar) Original code 7 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 8 !!---------------------------------------------------------------------- 6 9 #if defined key_obc 7 !!--------------------------------------------------------------------------------- 8 !! 'key_obc' : Open Boundary Conditions 9 !!--------------------------------------------------------------------------------- 10 !! obc_tra : call the subroutine for each open boundary 11 !! obc_tra_east : radiation of the east open boundary tracers 12 !! obc_tra_west : radiation of the west open boundary tracers 13 !! obc_tra_north : radiation of the north open boundary tracers 14 !! obc_tra_south : radiation of the south open boundary tracers 15 !!---------------------------------------------------------------------------------- 16 !! * Modules used 10 !!---------------------------------------------------------------------- 11 !! 'key_obc' Unstructured Open Boundary Conditions 12 !!---------------------------------------------------------------------- 13 !! obc_tra : Apply open boundary conditions to T and S 14 !! obc_tra_frs : Apply Flow Relaxation Scheme 15 !!---------------------------------------------------------------------- 17 16 USE oce ! ocean dynamics and tracers variables 18 17 USE dom_oce ! ocean space and time domain variables 19 USE phycst ! physical constants20 18 USE obc_oce ! ocean open boundary conditions 21 USE lib_mpp ! ???22 USE lbclnk ! ???19 USE obcdta, ONLY: bf 20 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 23 21 USE in_out_manager ! I/O manager 24 22 … … 26 24 PRIVATE 27 25 28 !! * Accessibility 29 PUBLIC obc_tra ! routine called in tranxt.F90 26 PUBLIC obc_tra ! routine called in tranxt.F90 30 27 31 !! * Module variables 32 INTEGER :: & ! ... boundary space indices 33 nib = 1, & ! nib = boundary point 34 nibm = 2, & ! nibm = 1st interior point 35 nibm2 = 3, & ! nibm2 = 2nd interior point 36 ! ... boundary time indices 37 nit = 1, & ! nit = now 38 nitm = 2, & ! nitm = before 39 nitm2 = 3 ! nitm2 = before-before 40 41 REAL(wp) :: & 42 rtaue , rtauw , rtaun , rtaus , & ! Boundary restoring coefficient 43 rtauein, rtauwin, rtaunin, rtausin ! Boundary restoring coefficient for inflow 44 45 !! * Substitutions 46 # include "obc_vectopt_loop_substitute.h90" 47 !!--------------------------------------------------------------------------------- 28 !!---------------------------------------------------------------------- 48 29 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 49 30 !! $Id$ 50 31 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 51 !!--------------------------------------------------------------------------------- 52 32 !!---------------------------------------------------------------------- 53 33 CONTAINS 54 34 55 35 SUBROUTINE obc_tra( kt ) 56 !!------------------------------------------------------------------------------- 57 !! *** SUBROUTINE obc_tra *** 58 !! 59 !! ** Purpose : Compute tracer fields (t,s) along the open boundaries. 60 !! This routine is called by the tranxt.F routine and updates ta,sa 61 !! which are the actual temperature and salinity fields. 62 !! The logical variable lp_obc_east, and/or lp_obc_west, and/or lp_obc_north, 63 !! and/or lp_obc_south allow the user to determine which boundary is an 64 !! open one (must be done in the param_obc.h90 file). 36 !!---------------------------------------------------------------------- 37 !! *** SUBROUTINE obc_dyn3d *** 65 38 !! 66 !! Reference : 67 !! Marchesiello P., 1995, these de l'universite J. Fourier, Grenoble, France. 39 !! ** Purpose : - Apply open boundary conditions for baroclinic velocities 68 40 !! 69 !! History :70 !! ! 95-03 (J.-M. Molines) Original, SPEM71 !! ! 97-07 (G. Madec, J.-M. Molines) addition72 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) F9073 41 !!---------------------------------------------------------------------- 74 !! * Arguments75 INTEGER, INTENT( in ) :: kt76 !!----------------------------------------------------------------------42 INTEGER, INTENT( in ) :: kt ! Main time step counter 43 !! 44 INTEGER :: ib_obc ! Loop index 77 45 78 ! 0. Local constant initialization46 DO ib_obc=1, nb_obc 79 47 80 IF( kt == nit000 .OR. ln_rstart) THEN 81 ! ... Boundary restoring coefficient 82 rtaue = 2. * rdt / rdpeob 83 rtauw = 2. * rdt / rdpwob 84 rtaun = 2. * rdt / rdpnob 85 rtaus = 2. * rdt / rdpsob 86 ! ... Boundary restoring coefficient for inflow ( all boundaries) 87 rtauein = 2. * rdt / rdpein 88 rtauwin = 2. * rdt / rdpwin 89 rtaunin = 2. * rdt / rdpnin 90 rtausin = 2. * rdt / rdpsin 91 END IF 92 93 IF( lp_obc_east ) CALL obc_tra_east ( kt ) ! East open boundary 94 95 IF( lp_obc_west ) CALL obc_tra_west ( kt ) ! West open boundary 96 97 IF( lp_obc_north ) CALL obc_tra_north( kt ) ! North open boundary 98 99 IF( lp_obc_south ) CALL obc_tra_south( kt ) ! South open boundary 100 101 IF( lk_mpp ) THEN !!bug ??? 102 IF( kt >= nit000+3 .AND. ln_rstart ) THEN 103 CALL lbc_lnk( tb, 'T', 1. ) 104 CALL lbc_lnk( sb, 'T', 1. ) 105 END IF 106 CALL lbc_lnk( ta, 'T', 1. ) 107 CALL lbc_lnk( sa, 'T', 1. ) 108 ENDIF 48 SELECT CASE( nn_tra(ib_obc) ) 49 CASE(jp_none) 50 CYCLE 51 CASE(jp_frs) 52 CALL obc_tra_frs( idx_obc(ib_obc), dta_obc(ib_obc), kt ) 53 CASE DEFAULT 54 CALL ctl_stop( 'obc_tra : unrecognised option for open boundaries for T an S' ) 55 END SELECT 56 ENDDO 109 57 110 58 END SUBROUTINE obc_tra 111 59 112 113 SUBROUTINE obc_tra_east ( kt ) 114 !!------------------------------------------------------------------------------ 115 !! *** SUBROUTINE obc_tra_east *** 116 !! 117 !! ** Purpose : 118 !! Apply the radiation algorithm on east OBC tracers ta, sa using the 119 !! phase velocities calculated in obc_rad_east subroutine in obcrad.F90 module 120 !! If the logical lfbceast is .TRUE., there is no radiation but only fixed OBC 121 !! 122 !! History : 123 !! ! 95-03 (J.-M. Molines) Original from SPEM 124 !! ! 97-07 (G. Madec, J.-M. Molines) additions 125 !! ! 97-12 (M. Imbard) Mpp adaptation 126 !! ! 00-06 (J.-M. Molines) 127 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) F90 128 !!------------------------------------------------------------------------------ 129 !! * Arguments 130 INTEGER, INTENT( in ) :: kt 131 132 !! * Local declaration 133 INTEGER :: ji, jj, jk ! dummy loop indices 134 REAL(wp) :: z05cx, ztau, zin 135 !!------------------------------------------------------------------------------ 136 137 ! 1. First three time steps and more if lfbceast is .TRUE. 138 ! In that case open boundary conditions are FIXED. 139 ! -------------------------------------------------------- 140 141 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbceast ) THEN 142 DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt. 143 DO jk = 1, jpkm1 144 DO jj = 1, jpj 145 ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - temsk(jj,jk)) + & 146 tfoe(jj,jk)*temsk(jj,jk) 147 sa(ji,jj,jk) = sa(ji,jj,jk) * (1. - temsk(jj,jk)) + & 148 sfoe(jj,jk)*temsk(jj,jk) 149 END DO 150 END DO 60 SUBROUTINE obc_tra_frs( idx, dta, kt ) 61 !!---------------------------------------------------------------------- 62 !! *** SUBROUTINE obc_tra_frs *** 63 !! 64 !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries. 65 !! 66 !! Reference : Engedahl H., 1995, Tellus, 365-382. 67 !!---------------------------------------------------------------------- 68 INTEGER, INTENT(in) :: kt 69 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 70 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 71 !! 72 REAL(wp) :: zwgt ! boundary weight 73 INTEGER :: ib, ik, igrd ! dummy loop indices 74 INTEGER :: ii, ij ! 2D addresses 75 !!---------------------------------------------------------------------- 76 ! 77 ! 78 igrd = 1 ! Everything is at T-points here 79 DO ib = 1, idx%nblen(igrd) 80 DO ik = 1, jpkm1 81 ii = idx%nbi(ib,igrd) 82 ij = idx%nbj(ib,igrd) 83 zwgt = idx%nbw(ib,igrd) 84 ta(ii,ij,ik) = ( ta(ii,ij,ik) + zwgt * ( dta%tem(ib,ik) - ta(ii,ij,ik) ) ) * tmask(ii,ij,ik) 85 sa(ii,ij,ik) = ( sa(ii,ij,ik) + zwgt * ( dta%sal(ib,ik) - sa(ii,ij,ik) ) ) * tmask(ii,ij,ik) 151 86 END DO 152 153 ELSE 154 155 ! 2. Beyond the fourth time step if lfbceast is .FALSE. 156 ! ----------------------------------------------------- 157 158 ! Temperature and salinity radiation 159 ! ---------------------------------- 160 ! 161 ! nibm2 nibm nib 162 ! | nibm | nib///|/// 163 ! | | | |////|/// 164 ! jj line --v----f----v----f----v--- 165 ! | | | |////|/// 166 ! | |/// // 167 ! jj line T u T u/// T // 168 ! | |/// // 169 ! | | | |////|/// 170 ! jj-1 line --v----f----v----f----v--- 171 ! | | | |////|/// 172 ! jpieob-1 jpieob / /// 173 ! | | | 174 ! jpieob-1 jpieob jpieob+1 175 ! 176 ! ... radiative conditions + relaxation toward a climatology 177 ! the phase velocity is taken as the phase velocity of the tangen- 178 ! tial velocity (here vn), which have been saved in (u_cxebnd,v_cxebnd) 179 ! ... (jpjedp1, jpjefm1), jpieob+1 180 DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt. 181 DO jk = 1, jpkm1 182 DO jj = 2, jpjm1 183 ! ... i-phase speed ratio (from averaged of v_cxebnd) 184 z05cx = ( 0.5 * ( v_cxebnd(jj,jk) + v_cxebnd(jj-1,jk) ) ) / e1t(ji-1,jj) 185 z05cx = min( z05cx, 1. ) 186 ! ... z05cx=< 0, inflow zin=0, ztau=1 187 ! > 0, outflow zin=1, ztau=rtaue 188 zin = sign( 1., z05cx ) 189 zin = 0.5*( zin + abs(zin) ) 190 ! ... for inflow rtauein is used for relaxation coefficient else rtaue 191 ztau = (1.-zin ) * rtauein + zin * rtaue 192 z05cx = z05cx * zin 193 ! ... update ( ta, sa ) with radiative or climatological (t, s) 194 ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - temsk(jj,jk)) + & 195 temsk(jj,jk) * ( ( 1. - z05cx - ztau ) & 196 * tebnd(jj,jk,nib ,nitm) + 2.*z05cx & 197 * tebnd(jj,jk,nibm,nit ) + ztau * tfoe (jj,jk) ) & 198 / (1. + z05cx) 199 sa(ji,jj,jk) = sa(ji,jj,jk) * (1. - temsk(jj,jk)) + & 200 temsk(jj,jk) * ( ( 1. - z05cx - ztau ) & 201 * sebnd(jj,jk,nib ,nitm) + 2.*z05cx & 202 * sebnd(jj,jk,nibm,nit ) + ztau * sfoe (jj,jk) ) & 203 / (1. + z05cx) 204 END DO 205 END DO 206 END DO 207 208 END IF 209 210 END SUBROUTINE obc_tra_east 211 212 213 SUBROUTINE obc_tra_west ( kt ) 214 !!------------------------------------------------------------------------------ 215 !! *** SUBROUTINE obc_tra_west *** 216 !! 217 !! ** Purpose : 218 !! Apply the radiation algorithm on west OBC tracers ta, sa using the 219 !! phase velocities calculated in obc_rad_west subroutine in obcrad.F90 module 220 !! If the logical lfbcwest is .TRUE., there is no radiation but only fixed OBC 221 !! 222 !! History : 223 !! ! 95-03 (J.-M. Molines) Original from SPEM 224 !! ! 97-07 (G. Madec, J.-M. Molines) additions 225 !! ! 97-12 (M. Imbard) Mpp adaptation 226 !! ! 00-06 (J.-M. Molines) 227 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) F90 228 !!------------------------------------------------------------------------------ 229 !! * Arguments 230 INTEGER, INTENT( in ) :: kt 231 232 !! * Local declaration 233 INTEGER :: ji, jj, jk ! dummy loop indices 234 REAL(wp) :: z05cx, ztau, zin 235 !!------------------------------------------------------------------------------ 236 237 ! 1. First three time steps and more if lfbcwest is .TRUE. 238 ! In that case open boundary conditions are FIXED. 239 ! -------------------------------------------------------- 240 241 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcwest ) THEN 242 243 DO ji = fs_niw0, fs_niw1 ! Vector opt. 244 DO jk = 1, jpkm1 245 DO jj = 1, jpj 246 ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - twmsk(jj,jk)) + & 247 tfow(jj,jk)*twmsk(jj,jk) 248 sa(ji,jj,jk) = sa(ji,jj,jk) * (1. - twmsk(jj,jk)) + & 249 sfow(jj,jk)*twmsk(jj,jk) 250 END DO 251 END DO 252 END DO 253 254 ELSE 255 256 ! 2. Beyond the fourth time step if lfbcwest is .FALSE. 257 ! ----------------------------------------------------- 258 259 ! Temperature and salinity radiation 260 ! ---------------------------------- 261 ! 262 ! nib nibm nibm2 263 ! nib///| nibm | nibm2 | 264 ! ///|////| | | | | 265 ! ---v----f----v----f----v----f-- jj line 266 ! ///|////| | | | | 267 ! // ///| | | 268 ! // T ///u T u T u jj line 269 ! // ///| | | 270 ! ///|////| | | | | 271 ! ---v----f----v----f----v----f-- jj-1 line 272 ! ///|////| | | | | 273 ! jpiwob jpiwob+1 jpiwob+2 274 ! | | | 275 ! jpiwob jpiwob+1 jpiwob+2 276 ! 277 ! ... radiative conditions + relaxation toward a climatology 278 ! ... the phase velocity is taken as the phase velocity of the tangen- 279 ! ... tial velocity (here vn), which have been saved in (v_cxwbnd) 280 DO ji = fs_niw0, fs_niw1 ! Vector opt. 281 DO jk = 1, jpkm1 282 DO jj = 2, jpjm1 283 ! ... i-phase speed ratio (from averaged of v_cxwbnd) 284 z05cx = ( 0.5 * ( v_cxwbnd(jj,jk) + v_cxwbnd(jj-1,jk) ) ) / e1t(ji+1,jj) 285 z05cx = max( z05cx, -1. ) 286 ! ... z05cx > 0, inflow zin=0, ztau=1 287 ! < 0, outflow zin=1, ztau=rtauw 288 zin = sign( 1., -1.* z05cx ) 289 zin = 0.5*( zin + abs(zin) ) 290 ztau = (1.-zin )*rtauwin + zin * rtauw 291 z05cx = z05cx * zin 292 ! ... update (ta,sa) with radiative or climatological (t, s) 293 ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - twmsk(jj,jk)) + & 294 twmsk(jj,jk) * ( ( 1. + z05cx - ztau ) & 295 * twbnd(jj,jk,nib ,nitm) - 2.*z05cx & 296 * twbnd(jj,jk,nibm,nit ) + ztau * tfow (jj,jk) ) & 297 / (1. - z05cx) 298 sa(ji,jj,jk) = sa(ji,jj,jk) * (1. - twmsk(jj,jk)) + & 299 twmsk(jj,jk) * ( ( 1. + z05cx - ztau ) & 300 * swbnd(jj,jk,nib ,nitm) - 2.*z05cx & 301 * swbnd(jj,jk,nibm,nit ) + ztau * sfow (jj,jk) ) & 302 / (1. - z05cx) 303 END DO 304 END DO 305 END DO 306 307 END IF 308 309 END SUBROUTINE obc_tra_west 310 311 312 SUBROUTINE obc_tra_north ( kt ) 313 !!------------------------------------------------------------------------------ 314 !! *** SUBROUTINE obc_tra_north *** 315 !! 316 !! ** Purpose : 317 !! Apply the radiation algorithm on north OBC tracers ta, sa using the 318 !! phase velocities calculated in obc_rad_north subroutine in obcrad.F90 module 319 !! If the logical lfbcnorth is .TRUE., there is no radiation but only fixed OBC 320 !! 321 !! History : 322 !! ! 95-03 (J.-M. Molines) Original from SPEM 323 !! ! 97-07 (G. Madec, J.-M. Molines) additions 324 !! ! 97-12 (M. Imbard) Mpp adaptation 325 !! ! 00-06 (J.-M. Molines) 326 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) F90 327 !!------------------------------------------------------------------------------ 328 !! * Arguments 329 INTEGER, INTENT( in ) :: kt 330 331 !! * Local declaration 332 INTEGER :: ji, jj, jk ! dummy loop indices 333 REAL(wp) :: z05cx, ztau, zin 334 !!------------------------------------------------------------------------------ 335 336 ! 1. First three time steps and more if lfbcnorth is .TRUE. 337 ! In that case open boundary conditions are FIXED. 338 ! -------------------------------------------------------- 339 340 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcnorth ) THEN 341 342 DO jj = fs_njn0+1, fs_njn1+1 ! Vector opt. 343 DO jk = 1, jpkm1 344 DO ji = 1, jpi 345 ta(ji,jj,jk)= ta(ji,jj,jk) * (1.-tnmsk(ji,jk)) + & 346 tnmsk(ji,jk) * tfon(ji,jk) 347 sa(ji,jj,jk)= sa(ji,jj,jk) * (1.-tnmsk(ji,jk)) + & 348 tnmsk(ji,jk) * sfon(ji,jk) 349 END DO 350 END DO 351 END DO 352 353 ELSE 354 355 ! 2. Beyond the fourth time step if lfbcnorth is .FALSE. 356 ! ------------------------------------------------------- 357 358 ! Temperature and salinity radiation 359 ! ---------------------------------- 360 ! 361 ! ji-1 ji ji ji +1 362 ! | 363 ! nib //// u // T // u // T // jpjnob + 1 364 ! /////|////////////////// 365 ! nib ----f----v----f----v--- jpjnob 366 ! | | 367 ! nibm-- u -- T -- u -- T -- jpjnob 368 ! | | 369 ! nibm ----f----v----f----v--- jpjnob-1 370 ! | | 371 ! nibm2-- u -- T -- T -- T -- jpjnob-1 372 ! | | 373 ! nibm2 ----f----v----f----v--- jpjnob-2 374 ! | | 375 ! 376 ! ... radiative conditions + relaxation toward a climatology 377 ! ... the phase velocity is taken as the normal phase velocity of the tangen- 378 ! ... tial velocity (here un), which has been saved in (u_cynbnd) 379 ! ... jpjnob+1,(jpindp1, jpinfm1) 380 DO jj = fs_njn0+1, fs_njn1+1 ! Vector opt. 381 DO jk = 1, jpkm1 382 DO ji = 2, jpim1 383 ! ... j-phase speed ratio (from averaged of vtnbnd) 384 ! (bounded by 1) 385 z05cx = ( 0.5 * ( u_cynbnd(ji,jk) + u_cynbnd(ji-1,jk) ) ) / e2t(ji,jj-1) 386 z05cx = min( z05cx, 1. ) 387 ! ... z05cx=< 0, inflow zin=0, ztau=1 388 ! > 0, outflow zin=1, ztau=rtaun 389 zin = sign( 1., z05cx ) 390 zin = 0.5*( zin + abs(zin) ) 391 ! ... for inflow rtaunin is used for relaxation coefficient else rtaun 392 ztau = (1.-zin ) * rtaunin + zin * rtaun 393 z05cx = z05cx * zin 394 ! ... update (ta,sa) with radiative or climatological (t, s) 395 ta(ji,jj,jk) = ta(ji,jj,jk) * (1.-tnmsk(ji,jk)) + & 396 tnmsk(ji,jk) * ( ( 1. - z05cx - ztau ) & 397 * tnbnd(ji,jk,nib ,nitm) + 2.*z05cx & 398 * tnbnd(ji,jk,nibm,nit ) + ztau * tfon (ji,jk) ) & 399 / (1. + z05cx) 400 sa(ji,jj,jk) = sa(ji,jj,jk) * (1.-tnmsk(ji,jk)) + & 401 tnmsk(ji,jk) * ( ( 1. - z05cx - ztau ) & 402 * snbnd(ji,jk,nib ,nitm) + 2.*z05cx & 403 * snbnd(ji,jk,nibm,nit ) + ztau * sfon (ji,jk) ) & 404 / (1. + z05cx) 405 END DO 406 END DO 407 END DO 408 409 END IF 410 411 END SUBROUTINE obc_tra_north 412 413 414 SUBROUTINE obc_tra_south ( kt ) 415 !!------------------------------------------------------------------------------ 416 !! *** SUBROUTINE obc_tra_south *** 417 !! 418 !! ** Purpose : 419 !! Apply the radiation algorithm on south OBC tracers ta, sa using the 420 !! phase velocities calculated in obc_rad_south subroutine in obcrad.F90 module 421 !! If the logical lfbcsouth is .TRUE., there is no radiation but only fixed OBC 422 !! 423 !! History : 424 !! ! 95-03 (J.-M. Molines) Original from SPEM 425 !! ! 97-07 (G. Madec, J.-M. Molines) additions 426 !! ! 97-12 (M. Imbard) Mpp adaptation 427 !! ! 00-06 (J.-M. Molines) 428 !! 8.5 ! 02-10 (C. Talandier, A-M Treguier) F90 429 !!------------------------------------------------------------------------------ 430 !! * Arguments 431 INTEGER, INTENT( in ) :: kt 432 433 !! * Local declaration 434 INTEGER :: ji, jj, jk ! dummy loop indices 435 REAL(wp) :: z05cx, ztau, zin 436 !!------------------------------------------------------------------------------ 437 438 ! 1. First three time steps and more if lfbcsouth is .TRUE. 439 ! In that case open boundary conditions are FIXED. 440 ! -------------------------------------------------------- 441 442 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcsouth ) THEN 443 444 DO jj = fs_njs0, fs_njs1 ! Vector opt. 445 DO jk = 1, jpkm1 446 DO ji = 1, jpi 447 ta(ji,jj,jk)= ta(ji,jj,jk) * (1.-tsmsk(ji,jk)) + & 448 tsmsk(ji,jk) * tfos(ji,jk) 449 sa(ji,jj,jk)= sa(ji,jj,jk) * (1.-tsmsk(ji,jk)) + & 450 tsmsk(ji,jk) * sfos(ji,jk) 451 END DO 452 END DO 453 END DO 454 455 ELSE 456 457 ! 2. Beyond the fourth time step if lfbcsouth is .FALSE. 458 ! ------------------------------------------------------- 459 460 ! Temperature and salinity radiation 461 ! ---------------------------------- 462 ! 463 ! ji-1 ji ji ji +1 464 ! | | 465 ! nibm2 ----f----v----f----v--- jpjsob+2 466 ! | | 467 ! nibm2 -- u -- T -- u -- T -- jpjsob+2 468 ! | | 469 ! nibm ----f----v----f----v--- jpjsob+1 470 ! | | 471 ! nibm -- u -- T -- T -- T -- jpjsob+1 472 ! | | 473 ! nib -----f----v----f----v--- jpjsob 474 ! //////|/////////|//////// 475 ! nib //// u // T // u // T // jpjsob 476 ! 477 !... radiative conditions + relaxation toward a climatology 478 !... the phase velocity is taken as the phase velocity of the tangen- 479 !... tial velocity (here un), which has been saved in (u_cysbnd) 480 !... jpjsob,(jpisdp1, jpisfm1) 481 DO jj = fs_njs0, fs_njs1 ! Vector opt. 482 DO jk = 1, jpkm1 483 DO ji = 2, jpim1 484 !... j-phase speed ratio (from averaged of u_cysbnd) 485 ! (bounded by 1) 486 z05cx = ( 0.5 * ( u_cysbnd(ji,jk) + u_cysbnd(ji-1,jk) ) ) / e2t(ji,jj+1) 487 z05cx = max( z05cx, -1. ) 488 !... z05cx > 0, inflow zin=0, ztau=1 489 ! < 0, outflow zin=1, ztau=rtaus 490 zin = sign( 1., -1.* z05cx ) 491 zin = 0.5*( zin + abs(zin) ) 492 ztau = (1.-zin ) * rtausin + zin * rtaus 493 z05cx = z05cx * zin 494 495 !... update (ta,sa) with radiative or climatological (t, s) 496 ta(ji,jj,jk) = ta(ji,jj,jk) * (1.-tsmsk(ji,jk)) + & 497 tsmsk(ji,jk) * ( ( 1. + z05cx - ztau ) & 498 * tsbnd(ji,jk,nib ,nitm) - 2.*z05cx & 499 * tsbnd(ji,jk,nibm,nit ) + ztau * tfos (ji,jk) ) & 500 / (1. - z05cx) 501 sa(ji,jj,jk) = sa(ji,jj,jk) * (1.-tsmsk(ji,jk)) + & 502 tsmsk(ji,jk) * ( ( 1. + z05cx - ztau ) & 503 * ssbnd(ji,jk,nib ,nitm) - 2.*z05cx & 504 * ssbnd(ji,jk,nibm,nit ) + ztau * sfos (ji,jk) ) & 505 / (1. - z05cx) 506 END DO 507 END DO 508 END DO 509 510 END IF 511 512 END SUBROUTINE obc_tra_south 513 87 END DO 88 ! 89 CALL lbc_lnk( ta, 'T', 1. ) ; CALL lbc_lnk( sa, 'T', 1. ) ! Boundary points should be updated 90 ! 91 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 92 ! 93 END SUBROUTINE obc_tra_frs 94 514 95 #else 515 !!---------------------------------------------------------------------- -----------516 !! D efault option Empty module517 !!---------------------------------------------------------------------- -----------96 !!---------------------------------------------------------------------- 97 !! Dummy module NO Unstruct Open Boundary Conditions 98 !!---------------------------------------------------------------------- 518 99 CONTAINS 519 SUBROUTINE obc_tra ! Empty routine 100 SUBROUTINE obc_tra(kt) ! Empty routine 101 WRITE(*,*) 'obc_tra: You should not have seen this print! error?', kt 520 102 END SUBROUTINE obc_tra 521 103 #endif 522 104 523 !!====================================================================== ===========105 !!====================================================================== 524 106 END MODULE obctra
Note: See TracChangeset
for help on using the changeset viewer.
