coriolis Subroutine

  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