source: codes/icosagcm/trunk/src/etat0.f90 @ 194

MODULE etat0_mod
    CHARACTER(len=255),SAVE :: etat0_type
!$OMP THREADPRIVATE(etat0_type)

CONTAINS
  
  SUBROUTINE etat0(f_ps,f_mass,f_phis,f_theta_rhodz,f_u, f_q)
    USE icosa
    USE mpipara, ONLY : is_mpi_root
    USE disvert_mod
    USE etat0_williamson_mod, ONLY : etat0_williamson_new
    USE etat0_jablonowsky06_mod, ONLY : etat0_jablonowsky06=>etat0
    USE etat0_academic_mod, ONLY : etat0_academic=>etat0  
    USE etat0_dcmip1_mod, ONLY : etat0_dcmip1=>etat0
    USE etat0_dcmip2_mod, ONLY : etat0_dcmip2=>etat0
    USE etat0_dcmip3_mod, ONLY : etat0_dcmip3=>etat0  
    USE etat0_dcmip4_mod, ONLY : etat0_dcmip4=>etat0  
    USE etat0_dcmip5_mod, ONLY : etat0_dcmip5=>etat0  
    USE etat0_heldsz_mod, ONLY : etat0_heldsz=>etat0  
    USE dynetat0_gcm_mod, ONLY : dynetat0_start=>etat0 
    USE dynetat0_hz_mod,  ONLY : dynetat0_hz=>etat0 

    IMPLICIT NONE
    TYPE(t_field),POINTER :: f_ps(:)
    TYPE(t_field),POINTER :: f_mass(:)
    TYPE(t_field),POINTER :: f_phis(:)
    TYPE(t_field),POINTER :: f_theta_rhodz(:)
    TYPE(t_field),POINTER :: f_u(:)
    TYPE(t_field),POINTER :: f_q(:)
    
    REAL(rstd),POINTER :: ps(:), mass(:,:)
    LOGICAL :: init_mass
    INTEGER :: ind,i,j,ij,l

    ! most etat0 routines set ps and not mass
    ! in that case and if caldyn_eta == eta_lag
    ! the initial distribution of mass is taken to be the same
    ! as what the mass coordinate would dictate
    ! however if etat0_XXX defines mass then the flag init_mass must be set to .FALSE.
    ! otherwise mass will be overwritten 
    init_mass = (caldyn_eta == eta_lag)

    etat0_type='jablonowsky06'
    CALL getin("etat0",etat0_type)
    
    SELECT CASE (TRIM(etat0_type))
    CASE ('williamson91.6')
       CALL etat0_williamson_new(f_phis,f_mass,f_theta_rhodz,f_u, f_q)
       init_mass=.FALSE.
    CASE ('jablonowsky06')
       CALL etat0_jablonowsky06(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
    CASE ('academic')
       CALL etat0_academic(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
    CASE ('held_suarez')
       PRINT *,"Held & Suarez (1994) test case"
       CALL etat0_heldsz(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
    CASE ('dcmip1')
       CALL etat0_dcmip1(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
    CASE ('dcmip2_mountain','dcmip2_schaer_noshear','dcmip2_schaer_shear')
       CALL etat0_dcmip2(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
    CASE ('dcmip3')
       CALL etat0_dcmip3(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
     CASE ('dcmip4')
        IF(nqtot<2) THEN
           IF (is_mpi_root)  THEN
              PRINT *, "nqtot must be at least 2 for test case DCMIP4"
           END IF
           STOP
        END IF
       CALL etat0_dcmip4(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
     CASE ('dcmip5')
       CALL etat0_dcmip5(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
     CASE ('readnf_start') 
          print*,"readnf_start used"    
       CALL dynetat0_start(f_ps,f_phis,f_theta_rhodz,f_u,f_q) 
        CASE ('readnf_hz') 
          print*,"readnf_hz used"
       CALL dynetat0_hz(f_ps,f_phis,f_theta_rhodz,f_u,f_q) 
   CASE DEFAULT
       PRINT*, 'Bad selector for variable etat0 <',etat0_type, &
            '> options are <jablonowsky06>, <academic>, <dcmip[1-4]> '
       STOP
    END SELECT

    IF(init_mass) THEN ! initialize mass distribution using ps
!       !$OMP BARRIER
       DO ind=1,ndomain
          IF (.NOT. assigned_domain(ind)) CYCLE
          CALL swap_dimensions(ind)
          CALL swap_geometry(ind)
          mass=f_mass(ind); ps=f_ps(ind)
          CALL compute_rhodz(.TRUE., ps, mass)
       END DO
    END IF

  END SUBROUTINE etat0
         
END MODULE etat0_mod