source: codes/icosagcm/trunk/src/initial/etat0_dcmip2016_baroclinic_wave.f90 @ 548

MODULE etat0_dcmip2016_baroclinic_wave_mod
  USE icosa
  IMPLICIT NONE
  PRIVATE
 
  INTEGER,SAVE :: testcase
  !$OMP THREADPRIVATE(testcase)  
  
  INTEGER :: perturbation
  !$OMP THREADPRIVATE(perturbation)  

  PUBLIC getin_etat0, compute_etat0

CONTAINS

  SUBROUTINE getin_etat0
    USE mpipara, ONLY : is_mpi_root
    USE tracer_mod
    IMPLICIT NONE
    LOGICAL :: is_moist
    CHARACTER(LEN=255) :: str_perturbation
    
    IF(nqtot<5) THEN
       IF (is_mpi_root)  THEN
          PRINT *, "nqtot must be at least 5 for test case dcmip2016_baroclinic_wave"
       END IF
       STOP
    END IF
    
    str_perturbation="exponential"
    CALL getin("dcmip2016_baroclinic_wave_perturbation",str_perturbation)
    IF (TRIM(str_perturbation)=="exponential") THEN
      perturbation=0
    ELSE IF (TRIM(str_perturbation)=="stream") THEN
      perturbation=1
    ENDIF
    
  
  END SUBROUTINE getin_etat0

  SUBROUTINE compute_etat0(ngrid,lon,lat, phis,ps,temp,ulon,ulat,q)
    USE icosa
    USE disvert_mod
    USE omp_para
    USE dcmip2016_baroclinic_wave_mod, ONLY : baroclinic_wave_test
    USE earth_const
    USE terminator, ONLY: initial_value_Terminator
    IMPLICIT NONE
    INTEGER, INTENT(IN) :: ngrid
    REAL(rstd),INTENT(IN) :: lon(ngrid)
    REAL(rstd),INTENT(IN) :: lat(ngrid)
    REAL(rstd),INTENT(OUT) :: phis(ngrid)
    REAL(rstd),INTENT(OUT) :: ps(ngrid)
    REAL(rstd),INTENT(OUT) :: temp(ngrid,llm)
    REAL(rstd),INTENT(OUT) :: ulon(ngrid,llm)
    REAL(rstd),INTENT(OUT) :: ulat(ngrid,llm)
    REAL(rstd),INTENT(OUT) :: q(ngrid,llm,nqtot)
    
    INTEGER :: deep=0
    INTEGER :: zcoords
    REAL :: p,z
    REAL :: rho, thetav
    INTEGER :: ij,l
    INTEGER :: moist
    
    moist=0
    IF (physics_thermo==thermo_moist .OR. physics_thermo==thermo_fake_moist) moist=1
   
    DO ij=1,ngrid
       z=0.
       zcoords=1
       CALL baroclinic_wave_test(deep,moist,perturbation,scale_factor,lon(ij),lat(ij),p,z,zcoords,ulon(ij,1),ulat(ij,1), &
                                 temp(ij,1),thetav,phis(ij),ps(ij),rho,q(ij,1,1))
       
       zcoords=0
       DO l=ll_begin,ll_end
         p=0.5*(ap(l)+ap(l+1) + (bp(l)+bp(l+1)) * ps(ij))
         CALL baroclinic_wave_test(deep,moist,perturbation,scale_factor,lon(ij),lat(ij),p,z,zcoords,ulon(ij,l),ulat(ij,l), &
                                   temp(ij,l),thetav,phis(ij),ps(ij),rho,q(ij,l,1))
                                   
        IF (physics_thermo==thermo_fake_moist) temp(ij,l)=Temp(ij,l)*(1+0.608*q(ij,l,1))
        q(ij,l,2)=0.
        q(ij,l,3)=0.
        CALL initial_value_Terminator(lat(ij),lon(ij),q(ij,l,4),q(ij,l,5))
       END DO
    ENDDO

  END SUBROUTINE compute_etat0

END MODULE etat0_dcmip2016_baroclinic_wave_mod