Changeset 1601 for trunk/NEMO/OPA_SRC/TRA/trabbl.F90
- Timestamp:
- 2009-08-11T12:09:19+02:00 (15 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/TRA/trabbl.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/TRA/trabbl.F90
r1152 r1601 35 35 36 36 !!* Namelist nambbl: bottom boundary layer 37 REAL(wp), PUBLIC :: atrbbl = 1.e+3 !: lateral coeff. for bottom boundary layer scheme (m2/s)37 REAL(wp), PUBLIC :: rn_ahtbbl = 1.e+3 !: lateral coeff. for bottom boundary layer scheme (m2/s) 38 38 39 39 # if defined key_trabbl_dif … … 108 108 INTEGER, INTENT( in ) :: kt ! ocean time-step 109 109 !! 110 INTEGER :: ji, jj 110 INTEGER :: ji, jj ! dummy loop indices 111 111 INTEGER :: ik 112 INTEGER :: ii0, ii1, ij0, ij1 112 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers 113 113 INTEGER :: iku1, iku2, ikv1,ikv2 ! temporary intergers 114 114 REAL(wp) :: ze3u, ze3v ! temporary scalars 115 115 INTEGER :: iku, ikv 116 REAL(wp) :: & 117 zsign, zt, zs, zh, zalbet, & ! temporary scalars 118 zgdrho, zbtr, zta, zsa 119 REAL(wp), DIMENSION(jpi,jpj) :: & 120 zki, zkj, zkw, zkx, zky, zkz, & ! 2D workspace arrays 121 ztnb, zsnb, zdep, & 122 ztbb, zsbb, zahu, zahv 116 REAL(wp) :: zsign, zt, zs, zh, zalbet ! temporary scalars 117 REAL(wp) :: zgdrho, zbtr, zta, zsa 118 REAL(wp), DIMENSION(jpi,jpj) :: zki, zkj, zkw, zkx, zky, zkz ! 2D workspace 119 REAL(wp), DIMENSION(jpi,jpj) :: ztnb, zsnb, zdep, ztbb, zsbb, zahu, zahv 120 !! 123 121 REAL(wp) :: fsalbt, pft, pfs, pfh ! statement function 124 122 !!---------------------------------------------------------------------- … … 132 130 fsalbt( pft, pfs, pfh ) = & 133 131 ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft & 134 135 136 132 & - 0.203814e-03 ) * pft & 133 & + 0.170907e-01 ) * pft & 134 & + 0.665157e-01 & 137 135 +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs & 138 136 + ( ( - 0.302285e-13 * pfh & 139 140 141 142 143 137 & - 0.251520e-11 * pfs & 138 & + 0.512857e-12 * pft * pft ) * pfh & 139 & - 0.164759e-06 * pfs & 140 & +( 0.791325e-08 * pft - 0.933746e-06 ) * pft & 141 & + 0.380374e-04 ) * pfh 144 142 !!---------------------------------------------------------------------- 145 143 … … 155 153 ! mbathy= number of w-level, minimum value=1 (cf dommsk.F) 156 154 # if defined key_vectopt_loop 157 jj =1158 DO ji = 1, jpij ! vector opt. (forced unrolling)155 DO jj = 1, 1 156 DO ji = 1, jpij ! vector opt. (forced unrolling) 159 157 # else 160 158 DO jj = 1, jpj … … 167 165 zsbb(ji,jj) = sb(ji,jj,ik) * tmask(ji,jj,1) 168 166 zdep(ji,jj) = fsdept(ji,jj,ik) ! depth of the ocean bottom T-level 169 # if ! defined key_vectopt_loop 170 END DO 171 # endif 167 END DO 172 168 END DO 173 169 174 170 IF( ln_zps ) THEN ! partial steps correction 175 171 # if defined key_vectopt_loop 176 jj =1177 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)172 DO jj = 1, 1 173 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 178 174 # else 179 175 DO jj = 1, jpjm1 … … 186 182 ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) ) 187 183 ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) ) 188 zahu(ji,jj) = atrbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1) 189 zahv(ji,jj) = atrbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1) 190 # if ! defined key_vectopt_loop 184 zahu(ji,jj) = rn_ahtbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1) 185 zahv(ji,jj) = rn_ahtbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1) 191 186 END DO 192 # endif193 187 END DO 194 188 ELSE ! z-coordinate - full steps or s-coordinate 195 189 # if defined key_vectopt_loop 196 jj =1197 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)190 DO jj = 1, 1 191 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 198 192 # else 199 193 DO jj = 1, jpjm1 … … 202 196 iku = mbku(ji,jj) 203 197 ikv = mbkv(ji,jj) 204 zahu(ji,jj) = atrbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1) 205 zahv(ji,jj) = atrbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1) 206 # if ! defined key_vectopt_loop 198 zahu(ji,jj) = rn_ahtbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1) 199 zahv(ji,jj) = rn_ahtbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1) 207 200 END DO 208 # endif209 201 END DO 210 202 ENDIF … … 215 207 ! multiplied by the slope of the ocean bottom 216 208 217 SELECT CASE ( neos ) 218 219 CASE ( 0 ) ! Jackett and McDougall (1994) formulation 220 221 # if defined key_vectopt_loop 222 jj = 1 223 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 224 # else 225 DO jj = 1, jpjm1 226 DO ji = 1, jpim1 227 # endif 228 ! temperature, salinity anomalie and depth 229 zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 230 zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 231 zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 232 ! masked ratio alpha/beta 233 zalbet = fsalbt( zt, zs, zh )*umask(ji,jj,1) 234 ! local density gradient along i-bathymetric slope 235 zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) ) & 236 - ( zsnb(ji+1,jj) - zsnb(ji,jj) ) 237 ! sign of local i-gradient of density multiplied by the i-slope 238 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 239 zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 240 # if ! defined key_vectopt_loop 241 END DO 242 # endif 243 END DO 244 245 # if defined key_vectopt_loop 246 jj = 1 247 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 248 # else 249 DO jj = 1, jpjm1 250 DO ji = 1, jpim1 251 # endif 252 ! temperature, salinity anomalie and depth 253 zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 254 zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 255 zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 256 ! masked ratio alpha/beta 257 zalbet = fsalbt( zt, zs, zh )*vmask(ji,jj,1) 258 ! local density gradient along j-bathymetric slope 259 zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) ) & 260 - ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 261 ! sign of local j-gradient of density multiplied by the j-slope 262 zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 263 zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 264 # if ! defined key_vectopt_loop 265 END DO 266 # endif 267 END DO 268 269 CASE ( 1 ) ! Linear formulation function of temperature only 270 ! 271 # if defined key_vectopt_loop 272 jj = 1 273 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 274 # else 275 DO jj = 1, jpjm1 276 DO ji = 1, jpim1 277 # endif 278 ! local 'density/temperature' gradient along i-bathymetric slope 279 zgdrho = ztnb(ji+1,jj) - ztnb(ji,jj) 280 ! sign of local i-gradient of density multiplied by the i-slope 281 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 282 zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 283 # if ! defined key_vectopt_loop 284 END DO 285 # endif 286 END DO 287 288 # if defined key_vectopt_loop 289 jj = 1 290 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 291 # else 292 DO jj = 1, jpjm1 293 DO ji = 1, jpim1 294 # endif 295 ! local density gradient along j-bathymetric slope 296 zgdrho = ztnb(ji,jj+1) - ztnb(ji,jj) 297 ! sign of local j-gradient of density multiplied by the j-slope 298 zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 299 zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 300 # if ! defined key_vectopt_loop 301 END DO 302 # endif 303 END DO 304 305 CASE ( 2 ) ! Linear formulation function of temperature and salinity 306 307 # if defined key_vectopt_loop 308 jj = 1 309 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 310 # else 311 DO jj = 1, jpjm1 312 DO ji = 1, jpim1 209 SELECT CASE ( nn_eos ) 210 ! 211 CASE ( 0 ) !== Jackett and McDougall (1994) formulation ==! 212 # if defined key_vectopt_loop 213 DO jj = 1, 1 214 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 215 # else 216 DO jj = 1, jpjm1 217 DO ji = 1, jpim1 218 # endif 219 ! temperature, salinity anomalie and depth 220 zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 221 zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 222 zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 223 ! masked ratio alpha/beta 224 zalbet = fsalbt( zt, zs, zh )*umask(ji,jj,1) 225 ! local density gradient along i-bathymetric slope 226 zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) ) & 227 - ( zsnb(ji+1,jj) - zsnb(ji,jj) ) 228 ! sign of local i-gradient of density multiplied by the i-slope 229 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 230 zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 231 ! 232 ! temperature, salinity anomalie and depth 233 zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 234 zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 235 zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 236 ! masked ratio alpha/beta 237 zalbet = fsalbt( zt, zs, zh )*vmask(ji,jj,1) 238 ! local density gradient along j-bathymetric slope 239 zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) ) & 240 - ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 241 ! sign of local j-gradient of density multiplied by the j-slope 242 zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 243 zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 244 END DO 245 END DO 246 ! 247 CASE ( 1 ) !== Linear formulation function of temperature only ==! 248 # if defined key_vectopt_loop 249 DO jj = 1, 1 250 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 251 # else 252 DO jj = 1, jpjm1 253 DO ji = 1, jpim1 254 # endif 255 ! local 'density/temperature' gradient along i-bathymetric slope 256 zgdrho = ztnb(ji+1,jj) - ztnb(ji,jj) 257 ! sign of local i-gradient of density multiplied by the i-slope 258 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 259 zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 260 ! 261 ! local density gradient along j-bathymetric slope 262 zgdrho = ztnb(ji,jj+1) - ztnb(ji,jj) 263 ! sign of local j-gradient of density multiplied by the j-slope 264 zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 265 zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 266 END DO 267 END DO 268 ! 269 CASE ( 2 ) !== Linear formulation function of temperature and salinity ==! 270 # if defined key_vectopt_loop 271 DO jj = 1, 1 272 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 273 # else 274 DO jj = 1, jpjm1 275 DO ji = 1, jpim1 313 276 # endif 314 ! local density gradient along i-bathymetric slope 315 zgdrho = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) ) & 316 - ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 317 ! sign of local i-gradient of density multiplied by the i-slope 318 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 319 zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 320 # if ! defined key_vectopt_loop 321 END DO 322 # endif 323 END DO 324 325 # if defined key_vectopt_loop 326 jj = 1 327 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 328 # else 329 DO jj = 1, jpjm1 330 DO ji = 1, jpim1 331 # endif 332 ! local density gradient along j-bathymetric slope 333 zgdrho = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) ) & 334 - ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) ) 335 ! sign of local j-gradient of density multiplied by the j-slope 336 zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 337 zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 338 # if ! defined key_vectopt_loop 339 END DO 340 # endif 341 END DO 342 343 CASE DEFAULT 344 345 WRITE(ctmp1,*) ' bad flag value for neos = ', neos 346 CALL ctl_stop(ctmp1) 347 277 ! local density gradient along i-bathymetric slope 278 zgdrho = - ( rn_beta *( zsnb(ji+1,jj) - zsnb(ji,jj) ) & 279 & - rn_alpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 280 ! sign of local i-gradient of density multiplied by the i-slope 281 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 282 zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 283 ! 284 ! local density gradient along j-bathymetric slope 285 zgdrho = - ( rn_beta *( zsnb(ji,jj+1) - zsnb(ji,jj) ) & 286 & - rn_alpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) ) 287 ! sign of local j-gradient of density multiplied by the j-slope 288 zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 289 zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 290 END DO 291 END DO 292 ! 348 293 END SELECT 349 294 … … 403 348 ! second derivative (divergence) and add to the general tracer trend 404 349 # if defined key_vectopt_loop 405 jj =1406 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)350 DO jj = 1, 1 351 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 407 352 # else 408 353 DO jj = 2, jpjm1 … … 417 362 ta(ji,jj,ik) = ta(ji,jj,ik) + zta 418 363 sa(ji,jj,ik) = sa(ji,jj,ik) + zsa 419 # if ! defined key_vectopt_loop 420 END DO 421 # endif 364 END DO 422 365 END DO 423 366 … … 460 403 REAL(wp), DIMENSION(jpi,jpj) :: zmbk 461 404 462 NAMELIST/nambbl/ atrbbl405 NAMELIST/nambbl/ rn_ahtbbl 463 406 !!---------------------------------------------------------------------- 464 407 … … 470 413 WRITE(numout,*) 'tra_bbl_init : ' 471 414 WRITE(numout,*) '~~~~~~~~~~~~' 472 IF (lk_trabbl_dif ) WRITE(numout,*) ' * Diffusive Bottom Boundary Layer'415 IF( lk_trabbl_dif ) WRITE(numout,*) ' * Diffusive Bottom Boundary Layer' 473 416 IF( lk_trabbl_adv ) WRITE(numout,*) ' * Advective Bottom Boundary Layer' 474 417 WRITE(numout,*) ' Namelist nambbl : set bbl parameters' 475 WRITE(numout,*) ' bottom boundary layer coef. atrbbl = ', atrbbl418 WRITE(numout,*) ' bottom boundary layer coef. rn_ahtbbl = ', rn_ahtbbl 476 419 ENDIF 477 420
Note: See TracChangeset
for help on using the changeset viewer.
