source: LMDZ5/trunk/libf/phylmd/test_disvert_m.F90 @ 2037

module test_disvert_m

  implicit none

contains

  subroutine test_disvert

    ! Author: Lionel GUEZ

    ! This procedure tests the order of pressure values at half-levels
    ! and full levels. We arbitrarily choose to test ngrid values of
    ! the surface pressure, which sample possible values on Earth.

    use exner_hyb_m, only: exner_hyb

    ! For llm:
    include "dimensions.h"

    ! For ap, bp, preff:
    include "comvert.h"

    ! For kappa, cpp:
    include "comconst.h"

    ! Local:
    integer l, i
    integer, parameter:: ngrid = 7
    real p(ngrid, llm + 1) ! pressure at half-level, in Pa
    real pks(ngrid) ! exner function at the surface, in J K-1 kg-1 
    real pk(ngrid, llm) ! exner function at full level, in J K-1 kg-1 
    real ps(ngrid) ! surface pressure, in Pa
    real p_lay(ngrid, llm) ! pressure at full level, in Pa
    real delta_ps ! in Pa

    !---------------------

    print *, "Call sequence information: test_disvert"

    delta_ps = 6e4 / (ngrid - 1)
    ps = (/(5e4 + delta_ps * i, i = 0, ngrid - 1)/)
    forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
    call exner_hyb(ngrid, ps, p, pks, pk)
    p_lay = preff * (pk / cpp)**(1. / kappa)

    ! Are pressure values in the right order?
    if (any(p(:, :llm) <= p_lay .or. p_lay <= p(:, 2:))) then
       ! List details and stop:
       do l = 1, llm
          do i = 1, ngrid
             if (p(i, l) <= p_lay(i, l)) then
                print 1000, "p(", i, ", ", l, ") = ", p(i, l) / 100., &
                     " hPa <= p_lay(", i, ", ", l, ") = ", &
                     p_lay(i, l) / 100., " hPa"
             end if
             if (p_lay(i, l) <= p(i, l + 1)) then
                print 1000, "p_lay(", i, ", ", l, ") = ", p_lay(i, l) / 100., &
                     " hPa <= p(", i, ", ", l + 1, ") = ", &
                     p(i, l + 1) / 100., " hPa"
             end if
          end do
       end do
       call abort_gcm("test_disvert", "bad order of pressure values", 1)
    end if

1000 format (2(a, 2(i0, a), g13.6), a)

  end subroutine test_disvert

end module test_disvert_m