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

Last change on this file since 149 was 149, checked in by sdubey, 11 years ago
Added few new routines to read NC files and compute diagnostics to r145.
Few routines of dry physics including radiation module, surface process and convective adjustment in new routine phyparam.f90. dynetat to read start files for dynamics. check_conserve routine to compute conservation of quatities like mass, energy etc.etat0_heldsz.f90 for held-suarez test case initial conditions. new Key time_style=lmd or dcmip to use day_step, ndays like in LMDZ
File size: 2.2 KB
Line 
1MODULE etat0_mod
2    CHARACTER(len=255),SAVE :: etat0_type
3
4CONTAINS
5 
6  SUBROUTINE etat0(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
7    USE icosa
8    USE etat0_jablonowsky06_mod, ONLY : etat0_jablonowsky06=>etat0
9    USE etat0_academic_mod, ONLY : etat0_academic=>etat0 
10    USE etat0_dcmip1_mod, ONLY : etat0_dcmip1=>etat0
11    USE etat0_dcmip2_mod, ONLY : etat0_dcmip2=>etat0
12    USE etat0_dcmip3_mod, ONLY : etat0_dcmip3=>etat0 
13    USE etat0_dcmip4_mod, ONLY : etat0_dcmip4=>etat0 
14    USE etat0_dcmip5_mod, ONLY : etat0_dcmip5=>etat0 
15    USE etat0_heldsz_mod, ONLY : etat0_heldsz=>etat0 
16    USE dynetat0_gcm_mod, ONLY : dynetat0_start=>etat0 
17    USE dynetat0_hz_mod,  ONLY : dynetat0_hz=>etat0 
18
19    IMPLICIT NONE
20    TYPE(t_field),POINTER :: f_ps(:)
21    TYPE(t_field),POINTER :: f_phis(:)
22    TYPE(t_field),POINTER :: f_theta_rhodz(:)
23    TYPE(t_field),POINTER :: f_u(:)
24    TYPE(t_field),POINTER :: f_q(:)
25   
26    etat0_type='jablonowsky06'
27    CALL getin("etat0",etat0_type)
28   
29    SELECT CASE (TRIM(etat0_type))
30    CASE ('jablonowsky06')
31       CALL etat0_jablonowsky06(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
32    CASE ('academic')
33       CALL etat0_academic(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
34    CASE ('heldsz')
35        print*,"heldsz test case"
36       CALL etat0_heldsz(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
37    CASE ('dcmip1')
38       CALL etat0_dcmip1(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
39    CASE ('dcmip2_mountain','dcmip2_schaer_noshear','dcmip2_schaer_shear')
40       CALL etat0_dcmip2(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
41    CASE ('dcmip3')
42       CALL etat0_dcmip3(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
43     CASE ('dcmip4')
44       CALL etat0_dcmip4(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
45     CASE ('dcmip5')
46       CALL etat0_dcmip5(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
47     CASE ('readnf_start') 
48          print*,"readnf_start used"   
49       CALL dynetat0_start(f_ps,f_phis,f_theta_rhodz,f_u,f_q) 
50        CASE ('readnf_hz') 
51          print*,"readnf_hz used"
52       CALL dynetat0_hz(f_ps,f_phis,f_theta_rhodz,f_u,f_q) 
53   CASE DEFAULT
54       PRINT*, 'Bad selector for variable etat0 <',etat0_type, &
55            '> options are <jablonowsky06>, <academic>, <dcmip[1-4]> '
56       STOP
57    END SELECT
58   
59  END SUBROUTINE etat0
60         
61END MODULE etat0_mod
Note: See TracBrowser for help on using the repository browser.