source: codes/icosagcm/trunk/src/vertical/disvert_ncar.f90

  MODULE disvert_ncar_mod
  USE icosa
 
  REAL(rstd), SAVE, ALLOCATABLE,TARGET :: ap(:)
!$OMP THREADPRIVATE(ap)
  REAL(rstd), SAVE, ALLOCATABLE,TARGET :: bp(:)
!$OMP THREADPRIVATE(bp)
  REAL(rstd), SAVE, ALLOCATABLE,TARGET :: presnivs(:)
!$OMP THREADPRIVATE(presnivs)

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

  SUBROUTINE init_disvert
  USE icosa
  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 icosa
  USE mpipara
  IMPLICIT NONE
  REAL(rstd),INTENT(OUT) :: ap(:)
  REAL(rstd),INTENT(OUT) :: bp(:)
  REAL(rstd),INTENT(OUT) :: presnivs(:)
  ! reads from run.def : ncar_dz, ncar_T0, ncar_p0, ncar_disvert_c
  INTEGER :: l,cindx
  REAL(rstd) :: H, eta_top, eta

  ncar_dz=400 ; CALL getin('ncar_dz',ncar_dz);

! SELECT CASE( 
! pressure profile depends on test case
! coded here for 1-x (transport)

  ncar_T0=300; CALL getin('ncar_T0',ncar_T0)
  ncar_p0=1e5; CALL getin('ncar_p0',ncar_p0)
  cindx=1 ; CALL getin('ncar_disvert_c',cindx)

  H = ncar_T0*cpp*kappa/g ! height scale R.T0/g with R=cpp*kappa
  eta_top = exp(-llm*ncar_dz/H)
 
  do l = 1,llm+1
     eta = exp(-(l-1)*ncar_dz/H)
     bp(l) = ((eta - eta_top)/(1 - eta_top))**cindx
     ap(l) = ncar_p0 * ( eta - bp(l) )
  ENDDO
  bp(1)=1.
  ap(1)=0.
  bp(llm+1) = 0
  
  DO l = 1, llm
     presnivs(l) = 0.5 *( ap(l)+bp(l)*ncar_p0 + ap(l+1)+bp(l+1)*ncar_p0 )
  ENDDO

!$OMP MASTER  
  IF (is_mpi_root) PRINT *, 'Vertical placement of model levels according to DCMIP Appendix E.3'
  IF (is_mpi_root) PRINT *, 'Parameters : ncar_dz=', ncar_dz, '  ncar_p0=',ncar_p0, '  ncar_disvert_c=',cindx
  PRINT *, 'Isothermal amtosphere with ncar_T0=',ncar_T0 
!$OMP END MASTER  

END SUBROUTINE disvert

END  MODULE disvert_ncar_mod