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

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

Activated call to physics - Held & Suarez test case seems to work now

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