subroutine coriolis
!-----------------------------------------------------------------|
! |
! Thijs Heus TU Delft |
! |
! purpose. |
! -------- |
! |
! Calculates the Coriolis force. |
! |
!** interface. |
! ---------- |
! |
! *coriolis* is called from *program*. |
! |
!-----------------------------------------------------------------|
! use modglobal, only : i1,j1,kmax,dzh,dzf,om22,om23
use modglobal, only : ib,ie,jb,je,kb,ke,kh,dzh,dzf,om22,om23,lcoriol,lprofforc,timee
use modfields, only : u0,v0,w0,up,vp,wp,ug,vg
use modmpi, only : myid
implicit none
integer i, j, k, jm, jp, km, kp
real, dimension(kb:ke+kh) :: ugg
real om23g
if (lcoriol ) then
! if (myid==0) then
! write(*,*) "up before coriol",up(3,3,ke)
! end if
do k=kb+1,ke
kp=k+1
km=k-1
do j=jb,je
jp=j+1
jm=j-1
do i=ib,ie
up(i,j,k) = up(i,j,k) &
+((v0(i,j,k)+v0(i,jp,k)+v0(i-1,j,k)+v0(i-1,jp,k))*om23*0.25) &
-((w0(i,j,k)+w0(i,j,kp)+w0(i-1,j,kp)+w0(i-1,j,k))*om22*0.25)
vp(i,j,k) = vp(i,j,k) &
-((u0(i,j,k)+u0(i,jm,k)+u0(i+1,jm,k)+u0(i+1,j,k))*om23*0.25)
wp(i,j,k) = wp(i,j,k) +(( (dzf(km) * (u0(i,j,k) + u0(i+1,j,k) ) &
+ dzf(k) * (u0(i,j,km) + u0(i+1,j,km)) ) / dzh(k) ) &
* om22*0.25)
end do
end do
! -------------------------------------------end i&j-loop
end do
! -------------------------------------------end k-loop
! --------------------------------------------
! special treatment for lowest full level: k=1
! --------------------------------------------
do j=jb,je
jp = j+1
jm = j-1
do i=ib,ie
up(i,j,kb) = up(i,j,kb) &
+(v0(i,j,kb)+v0(i,jp,kb)+v0(i-1,j,kb)+v0(i-1,jp,kb))*om23*0.25 &
-(w0(i,j,kb)+w0(i,j ,kb+1)+w0(i-1,j,kb+1)+w0(i-1,j ,kb))*om22*0.25
vp(i,j,kb) = vp(i,j,kb) &
-(u0(i,j,kb)+u0(i,jm,kb)+u0(i+1,jm,kb)+u0(i+1,j,kb))*om23*0.25
wp(i,j,kb) = 0.0
end do
end do
! ----------------------------------------------end i,j-loop
! if (myid==0) then
! write(*,*) "up after coriol",up(3,3,ke)
! end if
elseif (lprofforc) then
ugg(:) = ug(:)
om23g = om23
do k=kb+1,ke
do j=jb,je
do i=ib,ie
up(i,j,k) = up(i,j,k) + om23g*(ugg(k) - u0(i,j,k))
enddo
enddo
enddo
! --------------------------------------------
! special treatment for lowest full level: k=1
! --------------------------------------------
do j=jb,je
jp = j+1
jm = j-1
do i=ib,ie
up(i,j,kb) = up(i,j,kb) + om23g*(ugg(kb) - u0(i,j,kb))
enddo
enddo
! if (myid==0) then
! write(*,*) "up after profforc",up(3,3,ke)
! end if
endif !lcoriol and lprofforc
return
end subroutine coriolis