source: codes/icosagcm/trunk/src/disvert_ncar.f90 @ 17

  MODULE disvert_ncar_mod
  USE prec
 
  REAL(rstd), SAVE, ALLOCATABLE,TARGET :: ap(:)
  REAL(rstd), SAVE, ALLOCATABLE,TARGET :: bp(:)
  REAL(rstd), SAVE, ALLOCATABLE,TARGET :: presnivs(:)

CONTAINS 
!=========================================================================

  SUBROUTINE init_disvert
  USE grid_param
  USE ioipsl
  IMPLICIT NONE
  
    ALLOCATE(ap(llm+1))
    ALLOCATE(bp(llm+1))
    ALLOCATE(presnivs(llm))
    
    CALL disvert(ap,bp,presnivs)    

  END SUBROUTINE init_disvert  


  SUBROUTINE disvert(ap,bp,presnivs)
  USE earth_const
  USE math_const 
  USE grid_param
  IMPLICIT NONE
  REAL(rstd),INTENT(OUT) :: ap(:)
  REAL(rstd),INTENT(OUT) :: bp(:)
  REAL(rstd),INTENT(OUT) :: presnivs(:)
  
  REAL(rstd) :: sig(llm+1)
  REAL(rstd) :: sigtop
  REAL(rstd),PARAMETER:: p0=100000.0 
  INTEGER :: l,cindx
  REAL(rstd) :: hdz, ehdz 


         hdz = 400.*g/(300.*287.) 
         ehdz = exp(-hdz) 

    do l = 1,llm+1
        sig(l) = ehdz**(l-1) 
    end do  
        
       sigtop = sig(llm+1) 
        cindx = 1 

    bp(llm+1) =   0.
    DO l = 1, llm
      bp(l) = (sig(l) - sigtop)/(1 - sigtop)
      bp(l) = bp(l)**cindx
      ap(l) = p0 * ( sig(l) - bp(l) )
    ENDDO
    bp(1)=1.
    ap(1)=0.
    ap(llm+1) = p0 * ( sig(llm+1) - bp(llm+1) )
  
    DO l = 1, llm
      presnivs(l) = 0.5 *( ap(l)+bp(l)*p0 + ap(l+1)+bp(l+1)*p0 )
   ENDDO

  END SUBROUTINE disvert

END  MODULE disvert_ncar_mod