copyright (C) 2001 MSC-RPN COMM %%%MC2%%% ***s/r sw2w3subroutine sw2w3 ( w,u,v,sw,sbxy,gg1,gg2,gg0wr,dhdt, 4 $ lminx,lmaxx,lminy,lmaxy,lnk ) implicit none * integer lminx,lmaxx,lminy,lmaxy,lnk real w (lminx:lmaxx,lminy:lmaxy,lnk), $ u (lminx:lmaxx,lminy:lmaxy,lnk), $ v (lminx:lmaxx,lminy:lmaxy,lnk), $ sw(lminx:lmaxx,lminy:lmaxy,lnk) real sbxy (lminx:lmaxx,lminy:lmaxy), $ gg1 (lminx:lmaxx,lminy:lmaxy,lnk), $ gg2 (lminx:lmaxx,lminy:lmaxy,lnk), $ gg0wr(lminx:lmaxx,lminy:lmaxy,lnk), $ dhdt (lminx:lmaxx,lminy:lmaxy,lnk) * *AUTHORs C. Girard & M. Desgagne * *OBJECT * * calculate * generalized vertical motion W (m/s) * from * true vertical motion sw (m/s) * #include "lcldim.cdk"
#include "nbcpu.cdk"
* integer i,j,k real*8 p25 parameter (p25=0.25d0) * *---------------------------------------------------------------- * !$omp do do k = 1, gnk if ((k.eq.1).or.(k.eq.gnk)) then do j=1-hy,ldnj+hy-1 do i=1-hx,ldni+hx-1 w(i,j,k) = 0. end do end do else do j=1-hy,ldnj+hy-1 do i=1-hx,ldni+hx-1 w(i,j,k) = ( sw(i,j,k) - dhdt(i,j,k) + sbxy(i,j) * p25 * $ (-gg1(i+1,j,k) * ( u(i+1,j,k) + u(i+1,j,k-1) ) $ - gg1(i ,j,k) * ( u(i ,j,k) + u(i ,j,k-1) ) $ - gg2(i,j+1,k) * ( v(i,j+1,k) + v(i,j+1,k-1) ) $ - gg2(i,j ,k) * ( v(i,j ,k) + v(i,j ,k-1) ) $ ) ) * gg0wr(i,j,k) end do end do endif end do !$omp enddo * *---------------------------------------------------------------- return end