Changeset 375
- Timestamp:
- 04/08/16 09:48:36 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/caldyn_kernels_hevi.f90
r369 r375 357 357 ! ENDDO 358 358 359 ! Compute Exner function (needed by compute_caldyn_fast) and du= g^-2.grad(w^2)359 ! Compute Exner function (needed by compute_caldyn_fast) and du=-g^2.grad(w^2) 360 360 DO l=1,llm 361 361 !DIR$ SIMD 362 362 DO ij=ij_begin_ext,ij_end_ext 363 363 pk(ij,l) = cpp*((pk(ij,l)/preff)**kappa) ! other formulae possible if exponentiation is slow 364 berni(ij) = (-.5*g*g)*( (W(ij,l)/m_il(ij,l))**2 & 364 berni(ij) = (-.5*g*g)*( & 365 (W(ij,l)/m_il(ij,l))**2 & 365 366 + (W(ij,l+1)/m_il(ij,l+1))**2 ) 366 367 ENDDO 367 368 DO ij=ij_begin,ij_end 368 du(ij+u_right,l) = ne_right* berni(ij)+ne_left *berni(ij+t_right)369 du(ij+u_lup,l) = ne_lup * berni(ij)+ne_rdown*berni(ij+t_lup)370 du(ij+u_ldown,l) = ne_ldown* berni(ij)+ne_rup *berni(ij+t_ldown)369 du(ij+u_right,l) = ne_right*(berni(ij)-berni(ij+t_right)) 370 du(ij+u_lup,l) = ne_lup *(berni(ij)-berni(ij+t_lup)) 371 du(ij+u_ldown,l) = ne_ldown*(berni(ij)-berni(ij+t_ldown)) 371 372 ENDDO 372 373 ENDDO … … 418 419 !DIR$ SIMD 419 420 DO ij=ij_begin,ij_end 420 due_right = 0.5*(theta(ij,l)+theta(ij+t_right,l)) 421 *( ne_right*pk(ij,l) +ne_left*pk(ij+t_right,l))&422 + ne_right*berni(ij,l)+ne_left*berni(ij+t_right,l)423 due_lup = 0.5*(theta(ij,l)+theta(ij+t_lup,l)) 424 *( ne_lup*pk(ij,l) +ne_rdown*pk(ij+t_lup,l)) &425 + ne_lup*berni(ij,l)+ne_rdown*berni(ij+t_lup,l)426 due_ldown = 0.5*(theta(ij,l)+theta(ij+t_ldown,l)) 427 *( ne_ldown*pk(ij,l) +ne_rup*pk(ij+t_ldown,l)) &428 + ne_ldown*berni(ij,l)+ne_rup*berni(ij+t_ldown,l)429 du(ij+u_right,l) = du(ij+u_right,l) +due_right430 du(ij+u_lup,l) = du(ij+u_lup,l) +due_lup431 du(ij+u_ldown,l) = du(ij+u_ldown,l) +due_ldown421 due_right = 0.5*(theta(ij,l)+theta(ij+t_right,l)) & 422 *(pk(ij+t_right,l)-pk(ij,l)) & 423 + berni(ij+t_right,l)-berni(ij,l) 424 due_lup = 0.5*(theta(ij,l)+theta(ij+t_lup,l)) & 425 *(pk(ij+t_lup,l)-pk(ij,l)) & 426 + berni(ij+t_lup,l)-berni(ij,l) 427 due_ldown = 0.5*(theta(ij,l)+theta(ij+t_ldown,l)) & 428 *(pk(ij+t_ldown,l)-pk(ij,l)) & 429 + berni(ij+t_ldown,l)-berni(ij,l) 430 du(ij+u_right,l) = du(ij+u_right,l) - ne_right*due_right 431 du(ij+u_lup,l) = du(ij+u_lup,l) - ne_lup*due_lup 432 du(ij+u_ldown,l) = du(ij+u_ldown,l) - ne_ldown*due_ldown 432 433 u(ij+u_right,l) = u(ij+u_right,l) + tau*du(ij+u_right,l) 433 434 u(ij+u_lup,l) = u(ij+u_lup,l) + tau*du(ij+u_lup,l) … … 623 624 le_de(ij+u_rdown)*u(ij+u_rdown,l)**2 ) 624 625 ENDDO 625 ! Compute du= grad(Bernoulli)626 ! Compute du=-grad(Bernoulli) 626 627 !DIR$ SIMD 627 628 DO ij=ij_begin,ij_end 628 du(ij+u_right,l) = ne_right* berni(ij)+ne_left*berni(ij+t_right)629 du(ij+u_lup,l) = ne_lup* berni(ij)+ne_rdown*berni(ij+t_lup)630 du(ij+u_ldown,l) = ne_ldown* berni(ij)+ne_rup*berni(ij+t_ldown)629 du(ij+u_right,l) = ne_right*(berni(ij)-berni(ij+t_right)) 630 du(ij+u_lup,l) = ne_lup*(berni(ij)-berni(ij+t_lup)) 631 du(ij+u_ldown,l) = ne_ldown*(berni(ij)-berni(ij+t_ldown)) 631 632 END DO 632 633 END DO … … 751 752 -0.5*(F_el(ij+u_right,l)+F_el(ij+u_right,l+1)) 752 753 hflux(ij+u_right,l) = uu_right*le_de(ij+u_right) 753 du(ij+u_right,l) = ne_right* berni(ij)+ne_left*berni(ij+t_right)754 du(ij+u_right,l) = ne_right*(berni(ij)-berni(ij+t_right)) 754 755 ! Compute on edge 'lup' 755 756 uu_lup = 0.5*(rhodz(ij,l)+rhodz(ij+t_lup,l))*u(ij+u_lup,l) & 756 757 -0.5*(F_el(ij+u_lup,l)+F_el(ij+u_lup,l+1)) 757 758 hflux(ij+u_lup,l) = uu_lup*le_de(ij+u_lup) 758 du(ij+u_lup,l) = ne_lup* berni(ij)+ne_rdown*berni(ij+t_lup)759 du(ij+u_lup,l) = ne_lup*(berni(ij)-berni(ij+t_lup)) 759 760 ! Compute on edge 'ldown' 760 761 uu_ldown = 0.5*(rhodz(ij,l)+rhodz(ij+t_ldown,l))*u(ij+u_ldown,l) & 761 762 -0.5*(F_el(ij+u_ldown,l)+F_el(ij+u_ldown,l+1)) 762 763 hflux(ij+u_ldown,l) = uu_ldown*le_de(ij+u_ldown) 763 du(ij+u_ldown,l) = ne_ldown* berni(ij)+ne_rup*berni(ij+t_ldown)764 du(ij+u_ldown,l) = ne_ldown*(berni(ij)-berni(ij+t_ldown)) 764 765 END DO 765 766 END DO
Note: See TracChangeset
for help on using the changeset viewer.