1 | MODULE etat0_dcmip2_mod |
---|
2 | ! test cases DCMIP 2012, category 2 : Orographic gravity waves |
---|
3 | USE icosa |
---|
4 | IMPLICIT NONE |
---|
5 | PRIVATE |
---|
6 | |
---|
7 | INTEGER, SAVE :: testcase |
---|
8 | INTEGER, PARAMETER :: mountain=0, schaer_noshear=1, schaer_shear=2 |
---|
9 | REAL(rstd):: Teq_test2= 300.d0,h0_test2 = 250.d0 |
---|
10 | |
---|
11 | PUBLIC getin_etat0, compute_etat0,Teq_test2,h0_test2 |
---|
12 | |
---|
13 | CONTAINS |
---|
14 | |
---|
15 | SUBROUTINE getin_etat0 |
---|
16 | CHARACTER(len=255) :: etat0_type |
---|
17 | etat0_type='jablonowsky06' |
---|
18 | CALL getin("etat0",etat0_type) |
---|
19 | CALL getin("dcmip2_Teq",Teq_test2) |
---|
20 | CALL getin("dcmip2_h0",h0_test2) |
---|
21 | SELECT CASE (TRIM(etat0_type)) |
---|
22 | CASE('dcmip2_mountain') |
---|
23 | testcase = mountain |
---|
24 | CASE('dcmip2_schaer_noshear') |
---|
25 | testcase = schaer_noshear |
---|
26 | CASE('dcmip2_schaer_shear') |
---|
27 | testcase = schaer_shear |
---|
28 | CASE DEFAULT |
---|
29 | PRINT *, 'This should not happen : etat0_type =', TRIM(etat0_type), ' in etat0_dcmip2.f90/etat0' |
---|
30 | STOP |
---|
31 | END SELECT |
---|
32 | PRINT *, 'Orographic gravity-wave test case :', TRIM(etat0_type) |
---|
33 | END SUBROUTINE getin_etat0 |
---|
34 | |
---|
35 | SUBROUTINE compute_etat0(ngrid,lon,lat, phis, ps, Temp, ulon, ulat) |
---|
36 | USE disvert_mod |
---|
37 | USE omp_para |
---|
38 | INTEGER, INTENT(IN) :: ngrid |
---|
39 | REAL(rstd),INTENT(IN) :: lon(ngrid) |
---|
40 | REAL(rstd),INTENT(IN) :: lat(ngrid) |
---|
41 | REAL(rstd),INTENT(OUT) :: ps(ngrid) |
---|
42 | REAL(rstd),INTENT(OUT) :: phis(ngrid) |
---|
43 | REAL(rstd),INTENT(OUT) :: Temp(ngrid,llm) |
---|
44 | REAL(rstd),INTENT(OUT) :: ulon(ngrid,llm) |
---|
45 | REAL(rstd),INTENT(OUT) :: ulat(ngrid,llm) |
---|
46 | INTEGER :: l,ij |
---|
47 | REAL(rstd) :: hyam, hybm |
---|
48 | |
---|
49 | ! Hexagons : ps,phis,temp |
---|
50 | DO l=ll_begin,ll_end |
---|
51 | ! The surface pressure is not set yet so we provide the hybrid coefficients |
---|
52 | hyam = .5*(ap(l)+ap(l+1))/preff |
---|
53 | hybm = .5*(bp(l)+bp(l+1)) |
---|
54 | DO ij=1,ngrid |
---|
55 | CALL comp_all(hyam,hybm,lon(ij),lat(ij), & |
---|
56 | ps(ij),phis(ij), Temp(ij,l),ulon(ij,l), ulat(ij,l) ) |
---|
57 | END DO |
---|
58 | END DO |
---|
59 | END SUBROUTINE compute_etat0 |
---|
60 | |
---|
61 | SUBROUTINE comp_all(hyam,hybm,lon,lat, psj,phisj,tempj, ulonj,ulatj) |
---|
62 | USE dcmip_initial_conditions_test_1_2_3 |
---|
63 | REAL(rstd), INTENT(IN) :: hyam, hybm, lon, lat |
---|
64 | REAL(rstd), INTENT(OUT) :: psj,phisj,tempj,ulonj,ulatj |
---|
65 | REAL :: dummy |
---|
66 | dummy=0. |
---|
67 | SELECT CASE (testcase) |
---|
68 | CASE(mountain) |
---|
69 | CALL test2_steady_state_mountain(lon,lat,dummy,dummy,0,.TRUE.,hyam,hybm, & |
---|
70 | ulonj,ulatj,dummy,tempj,phisj,psj,dummy,dummy,h0_test2) |
---|
71 | CASE(schaer_noshear) |
---|
72 | CALL test2_schaer_mountain(lon,lat,dummy,dummy,0,.TRUE.,hyam,hybm,0,& |
---|
73 | ulonj,ulatj,dummy,tempj,phisj,psj,dummy,dummy,h0_test2,Teq_test2) |
---|
74 | CASE(schaer_shear) |
---|
75 | CALL test2_schaer_mountain(lon,lat,dummy,dummy,0,.TRUE.,hyam,hybm,1, & |
---|
76 | ulonj,ulatj,dummy,tempj,phisj,psj,dummy,dummy,h0_test2,Teq_test2) |
---|
77 | END SELECT |
---|
78 | END SUBROUTINE comp_all |
---|
79 | |
---|
80 | END MODULE etat0_dcmip2_mod |
---|