[382] | 1 | MODULE etat0_dcmip2016_baroclinic_wave_mod |
---|
| 2 | USE icosa |
---|
[732] | 3 | USE caldyn_vars_mod |
---|
[382] | 4 | IMPLICIT NONE |
---|
| 5 | PRIVATE |
---|
[408] | 6 | |
---|
[382] | 7 | INTEGER,SAVE :: testcase |
---|
| 8 | !$OMP THREADPRIVATE(testcase) |
---|
| 9 | |
---|
[408] | 10 | INTEGER :: perturbation |
---|
| 11 | !$OMP THREADPRIVATE(perturbation) |
---|
| 12 | |
---|
[382] | 13 | PUBLIC getin_etat0, compute_etat0 |
---|
| 14 | |
---|
| 15 | CONTAINS |
---|
| 16 | |
---|
| 17 | SUBROUTINE getin_etat0 |
---|
| 18 | USE mpipara, ONLY : is_mpi_root |
---|
| 19 | USE tracer_mod |
---|
[408] | 20 | IMPLICIT NONE |
---|
| 21 | LOGICAL :: is_moist |
---|
| 22 | CHARACTER(LEN=255) :: str_perturbation |
---|
| 23 | |
---|
[382] | 24 | IF(nqtot<5) THEN |
---|
| 25 | IF (is_mpi_root) THEN |
---|
| 26 | PRINT *, "nqtot must be at least 5 for test case dcmip2016_baroclinic_wave" |
---|
| 27 | END IF |
---|
| 28 | STOP |
---|
| 29 | END IF |
---|
| 30 | |
---|
[408] | 31 | str_perturbation="exponential" |
---|
| 32 | CALL getin("dcmip2016_baroclinic_wave_perturbation",str_perturbation) |
---|
| 33 | IF (TRIM(str_perturbation)=="exponential") THEN |
---|
| 34 | perturbation=0 |
---|
| 35 | ELSE IF (TRIM(str_perturbation)=="stream") THEN |
---|
| 36 | perturbation=1 |
---|
| 37 | ENDIF |
---|
| 38 | |
---|
| 39 | |
---|
[382] | 40 | END SUBROUTINE getin_etat0 |
---|
| 41 | |
---|
| 42 | SUBROUTINE compute_etat0(ngrid,lon,lat, phis,ps,temp,ulon,ulat,q) |
---|
| 43 | USE icosa |
---|
| 44 | USE disvert_mod |
---|
| 45 | USE omp_para |
---|
[408] | 46 | USE dcmip2016_baroclinic_wave_mod, ONLY : baroclinic_wave_test |
---|
| 47 | USE earth_const |
---|
| 48 | USE terminator, ONLY: initial_value_Terminator |
---|
| 49 | IMPLICIT NONE |
---|
[382] | 50 | INTEGER, INTENT(IN) :: ngrid |
---|
| 51 | REAL(rstd),INTENT(IN) :: lon(ngrid) |
---|
| 52 | REAL(rstd),INTENT(IN) :: lat(ngrid) |
---|
| 53 | REAL(rstd),INTENT(OUT) :: phis(ngrid) |
---|
| 54 | REAL(rstd),INTENT(OUT) :: ps(ngrid) |
---|
| 55 | REAL(rstd),INTENT(OUT) :: temp(ngrid,llm) |
---|
| 56 | REAL(rstd),INTENT(OUT) :: ulon(ngrid,llm) |
---|
| 57 | REAL(rstd),INTENT(OUT) :: ulat(ngrid,llm) |
---|
| 58 | REAL(rstd),INTENT(OUT) :: q(ngrid,llm,nqtot) |
---|
| 59 | |
---|
[408] | 60 | INTEGER :: deep=0 |
---|
| 61 | INTEGER :: zcoords |
---|
| 62 | REAL :: p,z |
---|
| 63 | REAL :: rho, thetav |
---|
| 64 | INTEGER :: ij,l |
---|
| 65 | INTEGER :: moist |
---|
[382] | 66 | |
---|
[408] | 67 | moist=0 |
---|
| 68 | IF (physics_thermo==thermo_moist .OR. physics_thermo==thermo_fake_moist) moist=1 |
---|
| 69 | |
---|
[382] | 70 | DO ij=1,ngrid |
---|
[408] | 71 | z=0. |
---|
| 72 | zcoords=1 |
---|
| 73 | CALL baroclinic_wave_test(deep,moist,perturbation,scale_factor,lon(ij),lat(ij),p,z,zcoords,ulon(ij,1),ulat(ij,1), & |
---|
| 74 | temp(ij,1),thetav,phis(ij),ps(ij),rho,q(ij,1,1)) |
---|
[382] | 75 | |
---|
[408] | 76 | zcoords=0 |
---|
| 77 | DO l=ll_begin,ll_end |
---|
| 78 | p=0.5*(ap(l)+ap(l+1) + (bp(l)+bp(l+1)) * ps(ij)) |
---|
| 79 | CALL baroclinic_wave_test(deep,moist,perturbation,scale_factor,lon(ij),lat(ij),p,z,zcoords,ulon(ij,l),ulat(ij,l), & |
---|
| 80 | temp(ij,l),thetav,phis(ij),ps(ij),rho,q(ij,l,1)) |
---|
| 81 | |
---|
| 82 | IF (physics_thermo==thermo_fake_moist) temp(ij,l)=Temp(ij,l)*(1+0.608*q(ij,l,1)) |
---|
| 83 | q(ij,l,2)=0. |
---|
| 84 | q(ij,l,3)=0. |
---|
| 85 | CALL initial_value_Terminator(lat(ij),lon(ij),q(ij,l,4),q(ij,l,5)) |
---|
[382] | 86 | END DO |
---|
[408] | 87 | ENDDO |
---|
| 88 | |
---|
[382] | 89 | END SUBROUTINE compute_etat0 |
---|
[408] | 90 | |
---|
[382] | 91 | END MODULE etat0_dcmip2016_baroclinic_wave_mod |
---|