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

Last change on this file since 159 was 159, checked in by dubos, 11 years ago

Towards Lagrangian vertical coordinate (not there yet)

File size: 3.0 KB
RevLine 
[12]1MODULE etat0_mod
[149]2    CHARACTER(len=255),SAVE :: etat0_type
[12]3
[17]4CONTAINS
5 
[159]6  SUBROUTINE etat0(f_ps,f_mass,f_phis,f_theta_rhodz,f_u, f_q)
[54]7    USE icosa
[159]8    USE disvert_mod
[54]9    USE etat0_jablonowsky06_mod, ONLY : etat0_jablonowsky06=>etat0
10    USE etat0_academic_mod, ONLY : etat0_academic=>etat0 
11    USE etat0_dcmip1_mod, ONLY : etat0_dcmip1=>etat0
12    USE etat0_dcmip2_mod, ONLY : etat0_dcmip2=>etat0
13    USE etat0_dcmip3_mod, ONLY : etat0_dcmip3=>etat0 
[78]14    USE etat0_dcmip4_mod, ONLY : etat0_dcmip4=>etat0 
[113]15    USE etat0_dcmip5_mod, ONLY : etat0_dcmip5=>etat0 
[149]16    USE etat0_heldsz_mod, ONLY : etat0_heldsz=>etat0 
17    USE dynetat0_gcm_mod, ONLY : dynetat0_start=>etat0 
18    USE dynetat0_hz_mod,  ONLY : dynetat0_hz=>etat0 
19
[54]20    IMPLICIT NONE
[17]21    TYPE(t_field),POINTER :: f_ps(:)
[159]22    TYPE(t_field),POINTER :: f_mass(:)
[17]23    TYPE(t_field),POINTER :: f_phis(:)
24    TYPE(t_field),POINTER :: f_theta_rhodz(:)
25    TYPE(t_field),POINTER :: f_u(:)
26    TYPE(t_field),POINTER :: f_q(:)
[159]27    REAL(rstd),POINTER :: ps(:), mass(:,:)
28    LOGICAL :: init_mass
29    INTEGER :: ind,i,j,ij,l
30
31    ! most etat0 routines set ps and not mass
32    ! in that case and if caldyn_eta == eta_lag
33    ! the initial distribution of mass is taken to be the same
34    ! as what the mass coordinate would dictate
35    ! however if etat0_XXX defines mass then the flag init_mass must be set to .FALSE.
36    ! otherwise mass will be overwritten
37    init_mass = (caldyn_eta == eta_lag)
38
[17]39    etat0_type='jablonowsky06'
40    CALL getin("etat0",etat0_type)
41   
42    SELECT CASE (TRIM(etat0_type))
[54]43    CASE ('jablonowsky06')
44       CALL etat0_jablonowsky06(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
45    CASE ('academic')
46       CALL etat0_academic(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
[149]47    CASE ('heldsz')
48        print*,"heldsz test case"
49       CALL etat0_heldsz(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
[54]50    CASE ('dcmip1')
51       CALL etat0_dcmip1(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
52    CASE ('dcmip2_mountain','dcmip2_schaer_noshear','dcmip2_schaer_shear')
53       CALL etat0_dcmip2(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
54    CASE ('dcmip3')
55       CALL etat0_dcmip3(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
[78]56     CASE ('dcmip4')
57       CALL etat0_dcmip4(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
[113]58     CASE ('dcmip5')
59       CALL etat0_dcmip5(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
[149]60     CASE ('readnf_start') 
61          print*,"readnf_start used"   
62       CALL dynetat0_start(f_ps,f_phis,f_theta_rhodz,f_u,f_q) 
63        CASE ('readnf_hz') 
64          print*,"readnf_hz used"
65       CALL dynetat0_hz(f_ps,f_phis,f_theta_rhodz,f_u,f_q) 
[62]66   CASE DEFAULT
[54]67       PRINT*, 'Bad selector for variable etat0 <',etat0_type, &
[67]68            '> options are <jablonowsky06>, <academic>, <dcmip[1-4]> '
[54]69       STOP
70    END SELECT
[159]71
72    IF(init_mass) THEN ! initialize mass distribution using ps
73       !$OMP BARRIER
74       DO ind=1,ndomain
75          CALL swap_dimensions(ind)
76          CALL swap_geometry(ind)
77          mass=f_mass(ind); ps=f_ps(ind)
78          CALL compute_rhodz(.TRUE., ps, mass)
79       END DO
80    END IF
81
[54]82  END SUBROUTINE etat0
[17]83         
[12]84END MODULE etat0_mod
[159]85
Note: See TracBrowser for help on using the repository browser.