Changeset 1601 for trunk/NEMO/OPA_SRC/TRA/trabbl_adv.h90
- Timestamp:
- 2009-08-11T12:09:19+02:00 (15 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/TRA/trabbl_adv.h90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/TRA/trabbl_adv.h90
r1482 r1601 101 101 102 102 #if defined key_vectopt_loop 103 jj =1104 DO ji = 1, jpij ! vector opt. (forced unrolling)103 DO jj = 1, 1 104 DO ji = 1, jpij ! vector opt. (forced unrolling) 105 105 #else 106 106 DO jj = 1, jpj … … 116 116 zunb(ji,jj) = un(ji,jj,mbku(ji,jj)) 117 117 zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 118 #if ! defined key_vectopt_loop 119 END DO 120 #endif 118 END DO 121 119 END DO 122 120 … … 127 125 ! multiplied by the slope of the ocean bottom 128 126 129 SELECT CASE ( n eos )127 SELECT CASE ( nn_eos ) 130 128 ! 131 129 CASE ( 0 ) ! Jackett and McDougall (1994) formulation 132 ! 133 DO jj = 1, jpjm1 134 DO ji = 1, fs_jpim1 ! vector opt. 135 ! ... temperature, salinity anomalie and depth 136 zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 137 zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 138 zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 139 ! ... masked ratio alpha/beta 140 zalbet = fsalbt( zt, zs, zh ) * umask(ji,jj,1) 141 ! ... local density gradient along i-bathymetric slope 142 zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) ) & 143 & - ( zsnb(ji+1,jj) - zsnb(ji,jj) ) 144 zgdrho = zgdrho * umask(ji,jj,1) 145 ! ... sign of local i-gradient of density multiplied by the i-slope 146 zsign = SIGN( 0.5, -zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 147 zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 148 zalphax(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1) 149 END DO 150 END DO 151 ! 152 DO jj = 1, jpjm1 153 DO ji = 1, fs_jpim1 ! vector opt. 154 ! ... temperature, salinity anomalie and depth 155 zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 156 zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 157 zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 158 ! ... masked ratio alpha/beta 159 zalbet = fsalbt( zt, zs, zh ) * vmask(ji,jj,1) 160 ! ... local density gradient along j-bathymetric slope 161 zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) ) & 162 & - ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 163 zgdrho = zgdrho*vmask(ji,jj,1) 164 ! ... sign of local j-gradient of density multiplied by the j-slope 165 zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 166 zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 167 zalphay(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 168 END DO 169 END DO 170 ! 130 ! 131 DO jj = 1, jpjm1 132 DO ji = 1, fs_jpim1 ! vector opt. 133 ! ... temperature, salinity anomalie and depth 134 zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 135 zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 136 zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 137 ! ... masked ratio alpha/beta 138 zalbet = fsalbt( zt, zs, zh ) * umask(ji,jj,1) 139 ! ... local density gradient along i-bathymetric slope 140 zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) ) & 141 & - ( zsnb(ji+1,jj) - zsnb(ji,jj) ) 142 zgdrho = zgdrho * umask(ji,jj,1) 143 ! ... sign of local i-gradient of density multiplied by the i-slope 144 zsign = SIGN( 0.5, -zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 145 zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 146 zalphax(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1) 147 ! 148 ! ... temperature, salinity anomalie and depth 149 zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 150 zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 151 zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 152 ! ... masked ratio alpha/beta 153 zalbet = fsalbt( zt, zs, zh ) * vmask(ji,jj,1) 154 ! ... local density gradient along j-bathymetric slope 155 zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) ) & 156 & - ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 157 zgdrho = zgdrho*vmask(ji,jj,1) 158 ! ... sign of local j-gradient of density multiplied by the j-slope 159 zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 160 zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 161 zalphay(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 162 END DO 163 END DO 164 ! 171 165 CASE ( 1 ) ! Linear formulation function of temperature only 172 !173 DO jj = 1, jpjm1174 DO ji = 1, fs_jpim1 ! vector opt.175 ! local 'density/temperature' gradient along i-bathymetric slope176 zgdrho = ( ztnb(ji+1,jj) - ztnb(ji,jj) )177 ! sign of local i-gradient of density multiplied by the i-slope178 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )179 zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) )180 zalphax(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1)181 182 ! local density gradient along j-bathymetric slope183 zgdrho = ( ztnb(ji,jj+1) - ztnb(ji,jj) )184 ! sign of local j-gradient of density multiplied by the j-slope185 zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )186 zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) )187 zalphay(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1)188 END DO189 END DO190 !166 ! 167 DO jj = 1, jpjm1 168 DO ji = 1, fs_jpim1 ! vector opt. 169 ! local 'density/temperature' gradient along i-bathymetric slope 170 zgdrho = ( ztnb(ji+1,jj) - ztnb(ji,jj) ) 171 ! sign of local i-gradient of density multiplied by the i-slope 172 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 173 zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 174 zalphax(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1) 175 ! 176 ! local density gradient along j-bathymetric slope 177 zgdrho = ( ztnb(ji,jj+1) - ztnb(ji,jj) ) 178 ! sign of local j-gradient of density multiplied by the j-slope 179 zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 180 zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 181 zalphay(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 182 END DO 183 END DO 184 ! 191 185 CASE ( 2 ) ! Linear formulation function of temperature and salinity 192 ! 193 DO jj = 1, jpjm1 194 DO ji = 1, fs_jpim1 ! vector opt. 195 ! local density gradient along i-bathymetric slope 196 zgdrho = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) ) & 197 & - ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 198 ! sign of local i-gradient of density multiplied by the i-slope 199 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 200 zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 201 zalphax(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1) 202 203 ! local density gradient along j-bathymetric slope 204 zgdrho = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) ) & 205 - ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) ) 206 ! sign of local j-gradient of density multiplied by the j-slope 207 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 208 zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 209 zalphay(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 210 END DO 211 END DO 212 ! 213 CASE DEFAULT 214 WRITE(ctmp1,*) ' bad flag value for neos = ', neos 215 CALL ctl_stop( ctmp1 ) 186 ! 187 DO jj = 1, jpjm1 188 DO ji = 1, fs_jpim1 ! vector opt. 189 ! local density gradient along i-bathymetric slope 190 zgdrho = - ( rn_beta *( zsnb(ji+1,jj) - zsnb(ji,jj) ) & 191 & - rn_alpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 192 ! sign of local i-gradient of density multiplied by the i-slope 193 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 194 zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 195 zalphax(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1) 196 ! 197 ! local density gradient along j-bathymetric slope 198 zgdrho = - ( rn_beta *( zsnb(ji,jj+1) - zsnb(ji,jj) ) & 199 & - rn_alpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) ) 200 ! sign of local j-gradient of density multiplied by the j-slope 201 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 202 zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 203 zalphay(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 204 END DO 205 END DO 216 206 ! 217 207 END SELECT … … 231 221 232 222 # if defined key_vectopt_loop 233 jj =1234 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)223 DO jj = 1, 1 224 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 235 225 # else 236 226 DO jj = 1, jpjm1 … … 250 240 v_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) * ze3v / fse3v(ji,jj,ikv) 251 241 ENDIF 252 # if ! defined key_vectopt_loop 253 END DO 254 # endif 242 END DO 255 243 END DO 256 244 … … 261 249 262 250 #if defined key_vectopt_loop 263 jj =1264 DO ji = 1, jpij ! vector opt. (forced unrolling)251 DO jj = 1, 1 252 DO ji = 1, jpij ! vector opt. (forced unrolling) 265 253 #else 266 254 DO jj = 1, jpj … … 273 261 v_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) 274 262 ENDIF 275 #if ! defined key_vectopt_loop 276 END DO 277 #endif 263 END DO 278 264 END DO 279 265 280 266 ENDIF 281 267 282 268 283 269 ! 5. Along sigma advective trend … … 286 272 287 273 # if defined key_vectopt_loop 288 jj =1289 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)274 DO jj = 1, 1 275 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 290 276 # else 291 277 DO jj = 1, jpjm1 … … 310 296 zwz(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * zsbb(ji ,jj ) & 311 297 & +( zfvj - ABS( zfvj ) ) * zsbb(ji ,jj+1) ) * 0.5 312 #if ! defined key_vectopt_loop 313 END DO 314 #endif 315 END DO 316 # if defined key_vectopt_loop 317 jj = 1 318 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 298 END DO 299 END DO 300 # if defined key_vectopt_loop 301 DO jj = 1, 1 302 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 319 303 # else 320 304 DO jj = 2, jpjm1 … … 332 316 ta(ji,jj,ik) = ta(ji,jj,ik) + zta 333 317 sa(ji,jj,ik) = sa(ji,jj,ik) + zsa 334 #if ! defined key_vectopt_loop 335 END DO 336 #endif 318 END DO 337 319 END DO 338 320 … … 365 347 366 348 IF( ln_zps ) THEN 367 368 # if defined key_vectopt_loop 369 jj =1370 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)349 350 # if defined key_vectopt_loop 351 DO jj = 1, 1 352 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 371 353 # else 372 354 DO jj = 1, jpjm1 … … 381 363 ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) ) 382 364 ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) ) 383 365 384 366 zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * ze3u 385 367 zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * ze3v 386 #if ! defined key_vectopt_loop 387 END DO 388 #endif 368 END DO 389 369 END DO 390 370 ! 391 371 ELSE 392 393 # if defined key_vectopt_loop 394 jj =1395 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)372 ! 373 # if defined key_vectopt_loop 374 DO jj = 1, 1 375 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 396 376 # else 397 377 DO jj = 1, jpjm1 … … 402 382 zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,iku) 403 383 zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * fse3v(ji,jj,ikv) 404 #if ! defined key_vectopt_loop 405 END DO 406 #endif 407 END DO 408 384 END DO 385 END DO 386 ! 409 387 ENDIF 410 388 411 389 412 390 # if defined key_vectopt_loop 413 jj =1414 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)391 DO jj = 1, 1 392 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 415 393 # else 416 394 DO jj = 2, jpjm1 … … 426 404 & ) / zbt 427 405 428 # if ! defined key_vectopt_loop 429 END DO 430 # endif 431 END DO 406 END DO 407 END DO 432 408 433 409 ! 7. compute additional vertical velocity to be used in t boxes … … 442 418 END DO 443 419 END DO 444 445 ! Boundary condition on w_bbl (unchanged sign) 446 CALL lbc_lnk( w_bbl, 'W', 1. ) 420 CALL lbc_lnk( w_bbl, 'W', 1. ) ! Boundary condition on w_bbl (unchanged sign) 447 421 448 422 CALL iom_put( "uoce_bbl", u_bbl ) ! bbl i-current
Note: See TracChangeset
for help on using the changeset viewer.
