1 | MODULE etat0_dcmip2016_baroclinic_wave_mod |
---|
2 | USE icosa |
---|
3 | IMPLICIT NONE |
---|
4 | PRIVATE |
---|
5 | |
---|
6 | REAL(rstd),PARAMETER :: eta0=0.252 |
---|
7 | REAL(rstd),PARAMETER :: etat=0.2 |
---|
8 | REAL(rstd),PARAMETER :: ps0=1e5 |
---|
9 | REAL(rstd),PARAMETER :: u0=35 |
---|
10 | REAL(rstd),PARAMETER :: T0=288 |
---|
11 | REAL(rstd),PARAMETER :: DeltaT=4.8e5 |
---|
12 | REAL(rstd),PARAMETER :: Rd=287 |
---|
13 | REAL(rstd),PARAMETER :: Gamma=0.005 |
---|
14 | REAL(rstd),PARAMETER :: up0=1 |
---|
15 | REAL(rstd),PARAMETER :: lonc=Pi/9, latc=2*Pi/9, latw=2*Pi/9 |
---|
16 | REAL(rstd),PARAMETER :: pw=34000 |
---|
17 | REAL(rstd),PARAMETER :: q0=0.021 |
---|
18 | |
---|
19 | INTEGER,SAVE :: testcase |
---|
20 | !$OMP THREADPRIVATE(testcase) |
---|
21 | |
---|
22 | PUBLIC getin_etat0, compute_etat0 |
---|
23 | |
---|
24 | CONTAINS |
---|
25 | |
---|
26 | SUBROUTINE getin_etat0 |
---|
27 | USE mpipara, ONLY : is_mpi_root |
---|
28 | USE tracer_mod |
---|
29 | IF(nqtot<5) THEN |
---|
30 | IF (is_mpi_root) THEN |
---|
31 | PRINT *, "nqtot must be at least 5 for test case dcmip2016_baroclinic_wave" |
---|
32 | END IF |
---|
33 | STOP |
---|
34 | END IF |
---|
35 | ! CALL set_advection_scheme(1,advect_none) |
---|
36 | ! CALL set_advection_scheme(2,advect_none) |
---|
37 | ! CALL set_advection_scheme(3,advect_none) |
---|
38 | |
---|
39 | END SUBROUTINE getin_etat0 |
---|
40 | |
---|
41 | SUBROUTINE compute_etat0(ngrid,lon,lat, phis,ps,temp,ulon,ulat,q) |
---|
42 | USE icosa |
---|
43 | USE disvert_mod |
---|
44 | USE omp_para |
---|
45 | USE terminator |
---|
46 | USE tracer_mod |
---|
47 | INTEGER, INTENT(IN) :: ngrid |
---|
48 | REAL(rstd),INTENT(IN) :: lon(ngrid) |
---|
49 | REAL(rstd),INTENT(IN) :: lat(ngrid) |
---|
50 | REAL(rstd),INTENT(OUT) :: phis(ngrid) |
---|
51 | REAL(rstd),INTENT(OUT) :: ps(ngrid) |
---|
52 | REAL(rstd),INTENT(OUT) :: temp(ngrid,llm) |
---|
53 | REAL(rstd),INTENT(OUT) :: ulon(ngrid,llm) |
---|
54 | REAL(rstd),INTENT(OUT) :: ulat(ngrid,llm) |
---|
55 | REAL(rstd),INTENT(OUT) :: q(ngrid,llm,nqtot) |
---|
56 | |
---|
57 | INTEGER :: l,ij |
---|
58 | REAL(rstd) :: etal, etavl, etas, etavs, sinlat, coslat, & |
---|
59 | Y, Tave, T, phis_ave, vort, r2, utot, & |
---|
60 | dthetaodeta_ave, dthetaodeta, dthetaodlat, duodeta, K, r |
---|
61 | |
---|
62 | etas=ap(1)/preff+bp(1) |
---|
63 | etavs=(etas-eta0)*Pi/2 |
---|
64 | phis_ave=T0*g/Gamma*(1-etas**(Rd*Gamma/g)) |
---|
65 | |
---|
66 | DO ij=1,ngrid |
---|
67 | sinlat=SIN(lat(ij)) |
---|
68 | coslat=COS(lat(ij)) |
---|
69 | phis(ij)=phis_ave+u0*cos(etavs)**1.5*( (-2*sinlat**6 * (coslat**2+1./3) + 10./63 )*u0*cos(etavs)**1.5 & |
---|
70 | +(8./5*coslat**3 * (sinlat**2 + 2./3) - Pi/4)*radius*Omega ) |
---|
71 | ps(ij)=ps0 |
---|
72 | ENDDO |
---|
73 | |
---|
74 | DO l=ll_begin,ll_end |
---|
75 | etal = 0.5 *( ap(l)/preff+bp(l) + ap(l+1)/preff+bp(l+1) ) |
---|
76 | etavl=(etal-eta0)*Pi/2 |
---|
77 | |
---|
78 | Tave=T0*etal**(Rd*Gamma/g) |
---|
79 | dthetaodeta_ave = T0 *( Rd*Gamma/g - kappa)* etal**(Rd*Gamma/g-kappa-1) |
---|
80 | IF (etat>etal) THEN |
---|
81 | Tave=Tave+DeltaT*(etat-etal)**5 |
---|
82 | dthetaodeta_ave = dthetaodeta_ave - DeltaT * ( 5*(etat-etal)**4 * etal**(-kappa) & |
---|
83 | + kappa * (etat-etal)**5 * etal**(-kappa-1)) |
---|
84 | END IF |
---|
85 | |
---|
86 | DO ij=1,ngrid |
---|
87 | sinlat=SIN(lat(ij)) |
---|
88 | coslat=COS(lat(ij)) |
---|
89 | |
---|
90 | K=sin(latc)*sinlat+cos(latc)*coslat*cos(lon(ij)-lonc) |
---|
91 | r=radius*acos(K) |
---|
92 | utot=u0*cos(etavl)**1.5*sin(2*lat(ij))**2 + up0*exp(-(r/(0.1*radius))**2) |
---|
93 | ulon(ij,l) = utot |
---|
94 | ulat(ij,l) = 0. |
---|
95 | Y = ((-2*sinlat**6*(coslat**2+1./3)+10./63)*2*u0*cos(etavl)**1.5 & |
---|
96 | + (8./5*coslat**3*(sinlat**2+2./3)-Pi/4)*radius*Omega) |
---|
97 | T = Tave + 0.75*(etal*Pi*u0/Rd)*sin(etavl)*cos(etavl)**0.5 * Y |
---|
98 | temp(ij,l)=T |
---|
99 | |
---|
100 | q(ij,l,1)=q0*exp(-(lat(ij)/latw)**4)*exp(-((etal-1)*preff/pw)**2) |
---|
101 | q(ij,l,2)=0. |
---|
102 | q(ij,l,3)=0. |
---|
103 | CALL initial_value_Terminator(lat(ij),lon(ij),q(ij,l,4),q(ij,l,5)) |
---|
104 | END DO |
---|
105 | END DO |
---|
106 | |
---|
107 | END SUBROUTINE compute_etat0 |
---|
108 | |
---|
109 | END MODULE etat0_dcmip2016_baroclinic_wave_mod |
---|