-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathvariables.f90
executable file
·127 lines (100 loc) · 4.43 KB
/
variables.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
!>@author
!>Paul Connolly, The University of Manchester
!>@brief
!>variables for the thermal cloud model
module variables
use numerics_type
!>@author
!>Paul J. Connolly, The University of Manchester
!>@brief
!>variables and types for the thermal cloud model
implicit none
!>@brief
!>main model prognostic variables
type grid
! variables for grid
integer(i4b) :: n_levels,nq,ncat, nprec, &
iqv, iqc, iqr, iqi, iqs, iqg, inc, inr, ini, ins, ing, &
cat_am, cat_c, cat_r,cat_i,iai
real(wp) :: dx,dz, dt, &
zbase,ztop
real(wp), dimension(:,:,:), allocatable :: q, qold, precip
real(wp), dimension(:,:), allocatable :: theta, th_old, &
p, rho, t, u, w,delsq, vis
real(wp), dimension(:), allocatable :: x,z,xn,zn, dx2, dz2
! point to the start and end of a category
integer(i4b), dimension(:), allocatable :: c_s, c_e
character(len=20), dimension(:), allocatable :: q_name
integer(i4b), dimension(:), allocatable :: q_type
integer(i4b) :: n_mode
end type grid
!>@brief
!>variables for sounding input
type sounding
! variables for grid
integer(i4b) :: n_levels
real(wp), dimension(:,:), allocatable :: q
real(wp), dimension(:), allocatable :: theta, p, z, rh
end type sounding
!>@brief
!>variables for NetCDF file output
type io
! variables for io
integer(i4b) :: ncid, varid, x_dimid, y_dimid, z_dimid, &
dimids(2), a_dimid, xx_dimid, yy_dimid, &
zz_dimid, i_dimid, j_dimid, k_dimid, nq_dimid, &
lq_dimid, nprec_dimid
integer(i4b) :: icur=1
logical :: new_file=.true.
end type io
! declare a grid type
type(grid) :: grid1
! declare a sounding type
type(sounding) :: sounding1
! declare an io type
type(io) :: io1
! constants
integer(i4b), parameter :: nlevels_r=1000
logical :: micro_init=.true., adiabatic_prof=.false.
real(wp) :: adiabatic_frac
logical :: monotone=.true.,viscous_dissipation=.false.,theta_flag=.false., &
hm_flag=.true., aero_prof_flag=.true., &
adjust_thermal_flag=.false., &
offset_equal_zbase=.false.,ice_flag=.false., &
wr_flag=.true.,rm_flag=.true.
integer(i4b) :: advection_scheme=0,microphysics_flag=0, above_cloud=0
character (len=200) :: bam_nmlfile = ' '
character (len=200) :: aero_nmlfile = ' '
! variables for model
real(wp), allocatable,dimension(:,:) :: q_read ! nq x nlevels_r
real(wp), dimension(nlevels_r) :: theta_read,rh_read, &
z_read
real(wp) :: dx, dz,dt, runtime, psurf, theta_surf,tsurf, t_cbase, t_ctop, t_thresh, &
t_thresh2, w_cb, theta_q_sat,t1old, p111, num_ice, mass_ice, &
num_drop, cvis, output_interval
integer(i4b) :: ip,kp, n_levels_s, ord, o_halo,halo, updraft_type
logical :: ice_init=.true., drop_num_init=.false.
integer(i4b) :: nq = 9, qv=1,qc=2,qr=3,nqc=-1,nqr=-1,qs=4,qg=5,qi=6, &
nqi=7,nqs=8,nqg=9, nprec=4
! the type of q-variable. 0 vapour, 1 mass, 2 number conc.
integer(i4b), allocatable, dimension(:) :: q_type !=(/0,1,1,1,1,1,2,2,2,2,2/)
! whether to initialise or not
logical, allocatable, dimension(:) :: q_init !=(/.true.,.false.,.false.,.false., &
!.false.,.false.,.false.,.false., &
!.false.,.false.,.false./)
character (len=200) :: outputfile='output'
! variables for thermal properties
real(wp) :: k, dsm_by_dz_z_eq_zc, b, del_gamma_mac, &
del_c_s, del_c_t, epsilon_therm, w_peak, z_offset=0.
logical :: therm_init=.true.
end module variables
module constants
use numerics_type
!>@author
!>Paul J. Connolly, The University of Manchester
!>@brief
!>constants for the thermal cloud model
implicit none
real(wp), parameter :: ra=287.0_wp, cp=1005.0_wp, grav=9.81_wp, &
rv=461._wp, eps1=ra/rv, lv=2.5e6_wp, ttr=273.15_wp
end module constants