Changeset 13226 for NEMO/trunk/src/OCE/TRA
- Timestamp:
- 2020-07-02T16:24:31+02:00 (4 years ago)
- Location:
- NEMO/trunk/src/OCE/TRA
- Files:
-
- 13 edited
-
traadv_cen.F90 (modified) (1 diff)
-
traadv_fct.F90 (modified) (8 diffs)
-
traadv_mus.F90 (modified) (4 diffs)
-
traadv_qck.F90 (modified) (12 diffs)
-
traadv_ubs.F90 (modified) (4 diffs)
-
traatf.F90 (modified) (2 diffs)
-
trabbc.F90 (modified) (1 diff)
-
trabbl.F90 (modified) (9 diffs)
-
traldf_lap_blp.F90 (modified) (1 diff)
-
tramle.F90 (modified) (1 diff)
-
tranpc.F90 (modified) (1 diff)
-
trazdf.F90 (modified) (1 diff)
-
zpshde.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/TRA/traadv_cen.F90
r12377 r13226 115 115 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 116 116 END_3D 117 CALL lbc_lnk_multi( 'traadv_cen', ztu, 'U', -1. , ztv, 'V', -1.) ! Lateral boundary cond.117 CALL lbc_lnk_multi( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. 118 118 ! 119 119 DO_3D_00_10( 1, jpkm1 ) -
NEMO/trunk/src/OCE/TRA/traadv_fct.F90
r12489 r13226 96 96 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 97 97 ENDIF 98 !! -- init to 0 99 zwi(:,:,:) = 0._wp 100 zwx(:,:,:) = 0._wp 101 zwy(:,:,:) = 0._wp 102 zwz(:,:,:) = 0._wp 103 ztu(:,:,:) = 0._wp 104 ztv(:,:,:) = 0._wp 105 zltu(:,:,:) = 0._wp 106 zltv(:,:,:) = 0._wp 107 ztw(:,:,:) = 0._wp 98 108 ! 99 109 l_trd = .FALSE. ! set local switches … … 220 230 END_2D 221 231 END DO 222 CALL lbc_lnk_multi( 'traadv_fct', zltu, 'T', 1. , zltv, 'T', 1.) ! Lateral boundary cond. (unchanged sgn)232 CALL lbc_lnk_multi( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 223 233 ! 224 234 DO_3D_10_10( 1, jpkm1 ) … … 237 247 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 238 248 END_3D 239 CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1. , ztv, 'V', -1.) ! Lateral boundary cond. (unchanged sgn)249 CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 240 250 ! 241 251 DO_3D_00_00( 1, jpkm1 ) … … 289 299 END IF 290 300 ! 291 CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1. , zwx, 'U', -1. , zwy, 'V', -1., zwz, 'W', 1.)301 CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'W', 1.0_wp ) 292 302 ! 293 303 ! !== monotonicity algorithm ==! … … 374 384 INTEGER :: ji, jj, jk ! dummy loop indices 375 385 INTEGER :: ikm1 ! local integer 376 REAL( wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn ! local scalars377 REAL( wp) :: zau, zbu, zcu, zav, zbv, zcv, zup, zdo ! - -378 REAL( wp), DIMENSION(jpi,jpj,jpk) :: zbetup, zbetdo, zbup, zbdo379 !!---------------------------------------------------------------------- 380 ! 381 zbig = 1.e+40_ wp382 zrtrn = 1.e-15_ wp383 zbetup(:,:,:) = 0._ wp ; zbetdo(:,:,:) = 0._wp386 REAL(dp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn ! local scalars 387 REAL(dp) :: zau, zbu, zcu, zav, zbv, zcv, zup, zdo ! - - 388 REAL(dp), DIMENSION(jpi,jpj,jpk) :: zbetup, zbetdo, zbup, zbdo 389 !!---------------------------------------------------------------------- 390 ! 391 zbig = 1.e+40_dp 392 zrtrn = 1.e-15_dp 393 zbetup(:,:,:) = 0._dp ; zbetdo(:,:,:) = 0._dp 384 394 385 395 ! Search local extrema … … 423 433 END_2D 424 434 END DO 425 CALL lbc_lnk_multi( 'traadv_fct', zbetup, 'T', 1. , zbetdo, 'T', 1.) ! lateral boundary cond. (unchanged sign)435 CALL lbc_lnk_multi( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp ) ! lateral boundary cond. (unchanged sign) 426 436 427 437 ! 3. monotonic flux in the i & j direction (paa & pbb) … … 430 440 zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 431 441 zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 432 zcu = ( 0.5 + SIGN( 0.5 , paa(ji,jj,jk) ) )442 zcu = ( 0.5 + SIGN( 0.5_wp , paa(ji,jj,jk) ) ) 433 443 paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu ) 434 444 435 445 zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) ) 436 446 zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) ) 437 zcv = ( 0.5 + SIGN( 0.5 , pbb(ji,jj,jk) ) )447 zcv = ( 0.5 + SIGN( 0.5_wp , pbb(ji,jj,jk) ) ) 438 448 pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv ) 439 449 … … 442 452 za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) ) 443 453 zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) ) 444 zc = ( 0.5 + SIGN( 0.5 , pcc(ji,jj,jk+1) ) )454 zc = ( 0.5 + SIGN( 0.5_wp , pcc(ji,jj,jk+1) ) ) 445 455 pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb ) 446 456 END_3D 447 CALL lbc_lnk_multi( 'traadv_fct', paa, 'U', -1. , pbb, 'V', -1.) ! lateral boundary condition (changed sign)457 CALL lbc_lnk_multi( 'traadv_fct', paa, 'U', -1.0_wp , pbb, 'V', -1.0_wp ) ! lateral boundary condition (changed sign) 448 458 ! 449 459 END SUBROUTINE nonosc -
NEMO/trunk/src/OCE/TRA/traadv_mus.F90
r12377 r13226 136 136 END_3D 137 137 ! lateral boundary conditions (changed sign) 138 CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1.)138 CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) 139 139 ! !-- Slopes of tracer 140 140 zslpx(:,:,jpk) = 0._wp ! bottom values 141 141 zslpy(:,:,jpk) = 0._wp 142 142 DO_3D_01_01( 1, jpkm1 ) 143 zslpx(ji,jj,jk) = ( zwx(ji,jj,jk) + zwx(ji-1,jj ,jk) ) &144 & * ( 0.25 + SIGN( 0.25 , zwx(ji,jj,jk) * zwx(ji-1,jj ,jk) ) )145 zslpy(ji,jj,jk) = ( zwy(ji,jj,jk) + zwy(ji ,jj-1,jk) ) &146 & * ( 0.25 + SIGN( 0.25 , zwy(ji,jj,jk) * zwy(ji ,jj-1,jk) ) )143 zslpx(ji,jj,jk) = ( zwx(ji,jj,jk) + zwx(ji-1,jj ,jk) ) & 144 & * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji-1,jj ,jk) ) ) 145 zslpy(ji,jj,jk) = ( zwy(ji,jj,jk) + zwy(ji ,jj-1,jk) ) & 146 & * ( 0.25 + SIGN( 0.25_wp, zwy(ji,jj,jk) * zwy(ji ,jj-1,jk) ) ) 147 147 END_3D 148 148 ! 149 149 DO_3D_01_01( 1, jpkm1 ) 150 zslpx(ji,jj,jk) = SIGN( 1. , zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji ,jj,jk) ), &151 & 2.*ABS( zwx (ji-1,jj,jk) ), &152 & 2.*ABS( zwx (ji ,jj,jk) ) )153 zslpy(ji,jj,jk) = SIGN( 1. , zslpy(ji,jj,jk) ) * MIN( ABS( zslpy(ji,jj ,jk) ), &154 & 2.*ABS( zwy (ji,jj-1,jk) ), &155 & 2.*ABS( zwy (ji,jj ,jk) ) )150 zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji ,jj,jk) ), & 151 & 2.*ABS( zwx (ji-1,jj,jk) ), & 152 & 2.*ABS( zwx (ji ,jj,jk) ) ) 153 zslpy(ji,jj,jk) = SIGN( 1.0_wp, zslpy(ji,jj,jk) ) * MIN( ABS( zslpy(ji,jj ,jk) ), & 154 & 2.*ABS( zwy (ji,jj-1,jk) ), & 155 & 2.*ABS( zwy (ji,jj ,jk) ) ) 156 156 END_3D 157 157 ! 158 158 DO_3D_00_00( 1, jpkm1 ) 159 159 ! MUSCL fluxes 160 z0u = SIGN( 0.5 , pU(ji,jj,jk) )160 z0u = SIGN( 0.5_wp, pU(ji,jj,jk) ) 161 161 zalpha = 0.5 - z0u 162 162 zu = z0u - 0.5 * pU(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) … … 165 165 zwx(ji,jj,jk) = pU(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 166 166 ! 167 z0v = SIGN( 0.5 , pV(ji,jj,jk) )167 z0v = SIGN( 0.5_wp, pV(ji,jj,jk) ) 168 168 zalpha = 0.5 - z0v 169 169 zv = z0v - 0.5 * pV(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) … … 172 172 zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 173 173 END_3D 174 CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1.) ! lateral boundary conditions (changed sign)174 CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) ! lateral boundary conditions (changed sign) 175 175 ! 176 176 DO_3D_00_00( 1, jpkm1 ) … … 200 200 zslpx(:,:,1) = 0._wp ! surface values 201 201 DO_3D_11_11( 2, jpkm1 ) 202 zslpx(ji,jj,jk) = ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) ) &203 & * ( 0.25 + SIGN( 0.25 , zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) )202 zslpx(ji,jj,jk) = ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) ) & 203 & * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) ) 204 204 END_3D 205 205 DO_3D_11_11( 2, jpkm1 ) 206 zslpx(ji,jj,jk) = SIGN( 1. , zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji,jj,jk ) ), &207 & 2.*ABS( zwx (ji,jj,jk+1) ), &208 & 2.*ABS( zwx (ji,jj,jk ) ) )206 zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji,jj,jk ) ), & 207 & 2.*ABS( zwx (ji,jj,jk+1) ), & 208 & 2.*ABS( zwx (ji,jj,jk ) ) ) 209 209 END_3D 210 210 DO_3D_00_00( 1, jpk-2 ) 211 z0w = SIGN( 0.5 , pW(ji,jj,jk+1) )211 z0w = SIGN( 0.5_wp, pW(ji,jj,jk+1) ) 212 212 zalpha = 0.5 + z0w 213 213 zw = z0w - 0.5 * pW(ji,jj,jk+1) * p2dt * r1_e1e2t(ji,jj) / e3w(ji,jj,jk+1,Kmm) -
NEMO/trunk/src/OCE/TRA/traadv_qck.F90
r12377 r13226 145 145 zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb) ! Downstream in the x-direction for the tracer 146 146 END_3D 147 CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1. , zfd(:,:,:), 'T', 1.) ! Lateral boundary conditions147 CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 148 148 149 149 ! … … 151 151 ! --------------------------- 152 152 DO_3D_00_00( 1, jpkm1 ) 153 zdir = 0.5 + SIGN( 0.5 , pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0153 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 154 154 zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk) ! FU in the x-direction for T 155 155 END_3D 156 156 ! 157 157 DO_3D_00_00( 1, jpkm1 ) 158 zdir = 0.5 + SIGN( 0.5 , pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0158 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 159 159 zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 160 160 zwx(ji,jj,jk) = ABS( pU(ji,jj,jk) ) * p2dt / zdx ! (0<zc_cfl<1 : Courant number on x-direction) … … 163 163 END_3D 164 164 !--- Lateral boundary conditions 165 CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1. , zfd(:,:,:), 'T', 1., zfc(:,:,:), 'T', 1., zwx(:,:,:), 'T', 1.)165 CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwx(:,:,:), 'T', 1.0_wp ) 166 166 167 167 !--- QUICKEST scheme … … 172 172 zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 173 173 END_3D 174 CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1. ) ! Lateral boundary conditions174 CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 175 175 176 176 ! … … 179 179 ! 180 180 DO_2D_00_00 181 zdir = 0.5 + SIGN( 0.5 , pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0181 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 182 182 !--- If the second ustream point is a land point 183 183 !--- the flux is computed by the 1st order UPWIND scheme … … 188 188 END DO 189 189 ! 190 CALL lbc_lnk( 'traadv_qck', zwx(:,:,:), 'T', 1. ) ! Lateral boundary conditions190 CALL lbc_lnk( 'traadv_qck', zwx(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 191 191 ! 192 192 ! Computation of the trend … … 239 239 END_2D 240 240 END DO 241 CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1. , zfd(:,:,:), 'T', 1.) ! Lateral boundary conditions241 CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 242 242 243 243 … … 247 247 ! 248 248 DO_3D_00_00( 1, jpkm1 ) 249 zdir = 0.5 + SIGN( 0.5 , pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0249 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 250 250 zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk) ! FU in the x-direction for T 251 251 END_3D 252 252 ! 253 253 DO_3D_00_00( 1, jpkm1 ) 254 zdir = 0.5 + SIGN( 0.5 , pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0254 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 255 255 zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 256 256 zwy(ji,jj,jk) = ABS( pV(ji,jj,jk) ) * p2dt / zdx ! (0<zc_cfl<1 : Courant number on x-direction) … … 260 260 261 261 !--- Lateral boundary conditions 262 CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1. , zfd(:,:,:), 'T', 1., zfc(:,:,:), 'T', 1., zwy(:,:,:), 'T', 1.)262 CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp ) 263 263 264 264 !--- QUICKEST scheme … … 269 269 zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 270 270 END_3D 271 CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1. ) !--- Lateral boundary conditions271 CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) !--- Lateral boundary conditions 272 272 ! 273 273 ! Tracer flux on the x-direction … … 275 275 ! 276 276 DO_2D_00_00 277 zdir = 0.5 + SIGN( 0.5 , pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0277 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 278 278 !--- If the second ustream point is a land point 279 279 !--- the flux is computed by the 1st order UPWIND scheme … … 284 284 END DO 285 285 ! 286 CALL lbc_lnk( 'traadv_qck', zwy(:,:,:), 'T', 1. ) ! Lateral boundary conditions286 CALL lbc_lnk( 'traadv_qck', zwy(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 287 287 ! 288 288 ! Computation of the trend -
NEMO/trunk/src/OCE/TRA/traadv_ubs.F90
r12377 r13226 137 137 ! 138 138 END DO 139 CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1. ) ; CALL lbc_lnk( 'traadv_ubs', zltv, 'T', 1.) ! Lateral boundary cond. (unchanged sgn)139 CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp ) ; CALL lbc_lnk( 'traadv_ubs', zltv, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 140 140 ! 141 141 DO_3D_10_10( 1, jpkm1 ) … … 206 206 zti(ji,jj,jk) = ( pt(ji,jj,jk,jn,Kbb) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 207 207 END_3D 208 CALL lbc_lnk( 'traadv_ubs', zti, 'T', 1. ) ! Lateral boundary conditions on zti, zsi (unchanged sign)208 CALL lbc_lnk( 'traadv_ubs', zti, 'T', 1.0_wp ) ! Lateral boundary conditions on zti, zsi (unchanged sign) 209 209 ! 210 210 ! !* anti-diffusive flux : high order minus low order … … 270 270 !!---------------------------------------------------------------------- 271 271 ! 272 zbig = 1.e+ 40_wp272 zbig = 1.e+38_wp 273 273 zrtrn = 1.e-15_wp 274 274 zbetup(:,:,:) = 0._wp ; zbetdo(:,:,:) = 0._wp … … 321 321 za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) ) 322 322 zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) ) 323 zc = 0.5 * ( 1.e0 + SIGN( 1. e0, pcc(ji,jj,jk) ) )323 zc = 0.5 * ( 1.e0 + SIGN( 1.0_wp, pcc(ji,jj,jk) ) ) 324 324 pcc(ji,jj,jk) = pcc(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb ) 325 325 END_3D -
NEMO/trunk/src/OCE/TRA/traatf.F90
r12489 r13226 109 109 #endif 110 110 ! ! local domain boundaries (T-point, unchanged sign) 111 CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1. , pts(:,:,:,jp_sal,Kaa), 'T', 1.)111 CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 112 112 ! 113 113 IF( ln_bdy ) CALL bdy_tra( kt, Kbb, pts, Kaa ) ! BDY open boundaries … … 155 155 ENDIF 156 156 ! 157 CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kbb) , 'T', 1. , pts(:,:,:,jp_sal,Kbb) , 'T', 1., &158 & pts(:,:,:,jp_tem,Kmm) , 'T', 1. , pts(:,:,:,jp_sal,Kmm) , 'T', 1., &159 & pts(:,:,:,jp_tem,Kaa), 'T', 1. , pts(:,:,:,jp_sal,Kaa), 'T', 1.)157 CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kbb) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kbb) , 'T', 1.0_wp, & 158 & pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp, & 159 & pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 160 160 ! 161 161 ENDIF -
NEMO/trunk/src/OCE/TRA/trabbc.F90
r12489 r13226 94 94 END_2D 95 95 ! 96 CALL lbc_lnk( 'trabbc', pts(:,:,:,jp_tem,Krhs) , 'T', 1. )96 CALL lbc_lnk( 'trabbc', pts(:,:,:,jp_tem,Krhs) , 'T', 1.0_wp ) 97 97 ! 98 98 IF( l_trdtra ) THEN ! Send the trend for diagnostics -
NEMO/trunk/src/OCE/TRA/trabbl.F90
r12377 r13226 125 125 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 126 126 ! lateral boundary conditions ; just need for outputs 127 CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1. , ahv_bbl, 'V', 1.)127 CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1.0_wp , ahv_bbl, 'V', 1.0_wp ) 128 128 CALL iom_put( "ahu_bbl", ahu_bbl ) ! bbl diffusive flux i-coef 129 129 CALL iom_put( "ahv_bbl", ahv_bbl ) ! bbl diffusive flux j-coef … … 138 138 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 139 139 ! lateral boundary conditions ; just need for outputs 140 CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1. , vtr_bbl, 'V', 1.)140 CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 141 141 CALL iom_put( "uoce_bbl", utr_bbl ) ! bbl i-transport 142 142 CALL iom_put( "voce_bbl", vtr_bbl ) ! bbl j-transport … … 365 365 & - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) ) ) * umask(ji,jj,1) 366 366 ! 367 zsign = SIGN( 0.5 , -zgdrho * REAL( mgrhu(ji,jj) ) ) ! sign of ( i-gradient * i-slope )367 zsign = SIGN( 0.5_wp, -zgdrho * REAL( mgrhu(ji,jj) ) ) ! sign of ( i-gradient * i-slope ) 368 368 ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj) ! masked diffusive flux coeff. 369 369 ! … … 375 375 & - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) ) ) * vmask(ji,jj,1) 376 376 ! 377 zsign = SIGN( 0.5 , -zgdrho * REAL( mgrhv(ji,jj) ) ) ! sign of ( j-gradient * j-slope )377 zsign = SIGN( 0.5_wp, -zgdrho * REAL( mgrhv(ji,jj) ) ) ! sign of ( j-gradient * j-slope ) 378 378 ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj) 379 379 END_2D … … 395 395 - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) ) ) * umask(ji,jj,1) 396 396 ! 397 zsign = SIGN( 0.5 , - zgdrho * REAL( mgrhu(ji,jj) ) ) ! sign of i-gradient * i-slope398 zsigna= SIGN( 0.5 , zub(ji,jj) * REAL( mgrhu(ji,jj) ) ) ! sign of u * i-slope397 zsign = SIGN( 0.5_wp, - zgdrho * REAL( mgrhu(ji,jj) ) ) ! sign of i-gradient * i-slope 398 zsigna= SIGN( 0.5_wp, zub(ji,jj) * REAL( mgrhu(ji,jj) ) ) ! sign of u * i-slope 399 399 ! 400 400 ! ! bbl velocity … … 407 407 zgdrho = ( za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) ) & 408 408 & - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) ) ) * vmask(ji,jj,1) 409 zsign = SIGN( 0.5 , - zgdrho * REAL( mgrhv(ji,jj) ) ) ! sign of j-gradient * j-slope410 zsigna= SIGN( 0.5 , zvb(ji,jj) * REAL( mgrhv(ji,jj) ) ) ! sign of u * i-slope409 zsign = SIGN( 0.5_wp, - zgdrho * REAL( mgrhv(ji,jj) ) ) ! sign of j-gradient * j-slope 410 zsigna= SIGN( 0.5_wp, zvb(ji,jj) * REAL( mgrhv(ji,jj) ) ) ! sign of u * i-slope 411 411 ! 412 412 ! ! bbl transport … … 514 514 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 515 515 zmbku(:,:) = REAL( mbku_d(:,:), wp ) ; zmbkv(:,:) = REAL( mbkv_d(:,:), wp ) 516 CALL lbc_lnk_multi( 'trabbl', zmbku,'U',1. , zmbkv,'V',1.)516 CALL lbc_lnk_multi( 'trabbl', zmbku,'U',1.0_wp, zmbkv,'V',1.0_wp) 517 517 mbku_d(:,:) = MAX( INT( zmbku(:,:) ), 1 ) ; mbkv_d(:,:) = MAX( NINT( zmbkv(:,:) ), 1 ) 518 518 ! … … 521 521 DO_2D_10_10 522 522 IF( gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 523 mgrhu(ji,jj) = INT( SIGN( 1. e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) )523 mgrhu(ji,jj) = INT( SIGN( 1.0_wp, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 524 524 ENDIF 525 525 ! 526 526 IF( gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 527 mgrhv(ji,jj) = INT( SIGN( 1. e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) ) )527 mgrhv(ji,jj) = INT( SIGN( 1.0_wp, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 528 528 ENDIF 529 529 END_2D … … 533 533 e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) ) 534 534 END_2D 535 CALL lbc_lnk_multi( 'trabbl', e3u_bbl_0, 'U', 1. , e3v_bbl_0, 'V', 1.) ! lateral boundary conditions535 CALL lbc_lnk_multi( 'trabbl', e3u_bbl_0, 'U', 1.0_wp , e3v_bbl_0, 'V', 1.0_wp ) ! lateral boundary conditions 536 536 ! 537 537 ! !* masked diffusive flux coefficients -
NEMO/trunk/src/OCE/TRA/traldf_lap_blp.F90
r12377 r13226 199 199 END SELECT 200 200 ! 201 CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1. ) ! Lateral boundary conditions (unchanged sign)201 CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp ) ! Lateral boundary conditions (unchanged sign) 202 202 ! ! Partial top/bottom cell: GRADh( zlap ) 203 203 IF( ln_isfcav .AND. ln_zps ) THEN ; CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi ) ! both top & bottom -
NEMO/trunk/src/OCE/TRA/tramle.F90
r12489 r13226 288 288 rfv(ji,jj) = SQRT( zfv * zfv + z1_t2 ) 289 289 END_2D 290 CALL lbc_lnk_multi( 'tramle', rfu, 'U', 1. , rfv, 'V', 1.)290 CALL lbc_lnk_multi( 'tramle', rfu, 'U', 1.0_wp , rfv, 'V', 1.0_wp ) 291 291 ! 292 292 ELSEIF( nn_mle == 1 ) THEN ! MLE array allocation & initialisation -
NEMO/trunk/src/OCE/TRA/tranpc.F90
r12489 r13226 309 309 ENDIF 310 310 ! 311 CALL lbc_lnk_multi( 'tranpc', pts(:,:,:,jp_tem,Kaa), 'T', 1. , pts(:,:,:,jp_sal,Kaa), 'T', 1.)311 CALL lbc_lnk_multi( 'tranpc', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 312 312 ! 313 313 IF( lwp .AND. l_LB_debug ) THEN -
NEMO/trunk/src/OCE/TRA/trazdf.F90
r12489 r13226 90 90 END DO 91 91 !!gm this should be moved in trdtra.F90 and done on all trends 92 CALL lbc_lnk_multi( 'trazdf', ztrdt, 'T', 1. , ztrds, 'T', 1.)92 CALL lbc_lnk_multi( 'trazdf', ztrdt, 'T', 1.0_wp , ztrds, 'T', 1.0_wp ) 93 93 !!gm 94 94 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_zdf, ztrdt ) -
NEMO/trunk/src/OCE/TRA/zpshde.F90
r12377 r13226 145 145 END DO 146 146 ! 147 CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1. , pgtv(:,:,:), 'V', -1.) ! Lateral boundary cond.147 CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. 148 148 ! 149 149 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) … … 178 178 ENDIF 179 179 END_2D 180 CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1. , pgrv , 'V', -1.) ! Lateral boundary conditions180 CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions 181 181 ! 182 182 END IF … … 301 301 END DO 302 302 ! 303 CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1. , pgtv(:,:,:), 'V', -1.) ! Lateral boundary cond.303 CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. 304 304 305 305 ! horizontal derivative of density anomalies (rd) … … 343 343 END_2D 344 344 345 CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1. , pgrv , 'V', -1.) ! Lateral boundary conditions345 CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions 346 346 ! 347 347 END IF … … 394 394 ! 395 395 END DO 396 CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1. , pgtvi(:,:,:), 'V', -1.) ! Lateral boundary cond.396 CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. 397 397 398 398 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) … … 433 433 434 434 END_2D 435 CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1. , pgrvi, 'V', -1.) ! Lateral boundary conditions435 CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp ) ! Lateral boundary conditions 436 436 ! 437 437 END IF
Note: See TracChangeset
for help on using the changeset viewer.
