copyright (C) 2001 MSC-RPN COMM %%%MC2%%% *subroutine uvadv3 1 implicit none * *REVISION * #include "yomdyn.cdk"
#include "dynmem.cdk"
#include "wrnmem.cdk"
#include "nbcpu.cdk"
#include "topo.cdk"
* integer i, j, k, n real*8 pt5 parameter(pt5=0.5d0) *---------------------------------------------------------------------- * * Set Pu=u, Pv=v, Ppp=pp, Pww=ww, Pbb=bb, Phu=hu and Ptr=tr * & * Set Ru=Rv=Rq=Rww=Rt=Rhu=Rtr=0 * !$omp do do k=1,gnk if (k.eq.1) then do j=1-hy,ldnj+hy-1 do i=1-hx,ldni+hx-1 wwm(i,j,1) = dhdt(i,j,1) - sbxy(i,j) * pt5 * $ (-gg1(i+1,j,1)*uum(i+1,j,1) - gg1(i,j,1)*uum(i,j,1) $ - gg2(i,j+1,1)*vvm(i,j+1,1) - gg2(i,j,1)*vvm(i,j,1) ) ww0(i,j,1) = dhdt(i,j,1) - sbxy(i,j) * pt5 * $ (-gg1(i+1,j,1)*uu0(i+1,j,1) - gg1(i,j,1)*uu0(i,j,1) $ - gg2(i,j+1,1)*vv0(i,j+1,1) - gg2(i,j,1)*vv0(i,j,1) ) end do end do endif do j=1-hy,ldnj+hy-1 do i=1-hx,ldni+hx-1 hup(i,j,k) = hum(i,j,k) end do end do do n = 1, ntr do j=1-hy,ldnj+hy-1 do i=1-hx,ldni+hx-1 trp(i,j,k,n) = trm(i,j,k,n) end do end do end do end do !$omp enddo c hup=hum c do n = 1, ntr c trp(:,:,:,n) = trm(:,:,:,n) c end do * if (nosolv) then * !$omp single ppp = ppm uup = uum vvp = vvm wwp = wwm bbp = bbm * ppr = 0. uur = 0. vvr = 0. wwr = 0. bbr = 0. !$omp end single * endif * *---------------------------------------------------------------------- return end