forked from ESCOMP/CARMA_base
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathcarmagas_mod.F90
253 lines (211 loc) · 10.3 KB
/
carmagas_mod.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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
!! The CARMAGAS module contains configuration information about a gas used by CARMA.
!!
!! @version May-2009
!! @author Chuck Bardeen
module carmagas_mod
use carma_precision_mod
use carma_enums_mod
use carma_constants_mod
use carma_types_mod
! CARMA explicitly declares all variables.
implicit none
! All CARMA variables and procedures are private except those explicitly declared to be public.
private
! Declare the public methods.
public CARMAGAS_Create
public CARMAGAS_Destroy
public CARMAGAS_Get
public CARMAGAS_Print
contains
!! Defines a gas used by CARMA for nucleation and growth of cloud and
!! aerosol particles.
!!
!! @author Chuck Bardeen
!! @version May-2009
!!
!! @see CARMA_AddGas
!! @see CARMAGAS_Destroy
subroutine CARMAGAS_Create(carma, igas, name, wtmol, ivaprtn, icomposition, &
rc, shortname, dgc_threshold, ds_threshold, refidx)
type(carma_type), intent(inout) :: carma !! the carma object
integer, intent(in) :: igas !! the gas index
character(*), intent(in) :: name !! the gas name, maximum of 255 characters
real(kind=f), intent(in) :: wtmol !! the gas molecular weight [g/mol]
integer, intent(in) :: ivaprtn !! vapor pressure routine for this gas
integer, intent(in) :: icomposition !! gas compound specification
integer, intent(out) :: rc !! return code, negative indicates failure
character(*), optional, intent(in) :: shortname !! the gas shortname, maximum of 6 characters
real(kind=f), optional, intent(in) :: dgc_threshold !! convergence criteria for gas concentration
!! [0 : off; > 0 : percentage change]
real(kind=f), optional, intent(in) :: ds_threshold !! convergence criteria for gas saturation
!! [0 : off; > 0 : percentage change; < 0 : amount past 0 crossing]
complex(kind=f), optional, intent(in) :: refidx(carma%f_NWAVE, carma%f_NREFIDX) !! refractive indices
integer :: ier
! Assume success.
rc = RC_OK
! Make sure there are enough gases allocated.
if (igas > carma%f_NGAS) then
if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGAS_GetCreate:: ERROR - The specifed gas (", &
igas, ") is larger than the number of gases (", carma%f_NGAS, ")."
rc = RC_ERROR
return
end if
if ((carma%f_NWAVE > 0) .and. (carma%f_NREFIDX > 0)) then
allocate( &
carma%f_gas(igas)%f_refidx(carma%f_NWAVE, carma%f_NREFIDX), &
stat=ier)
if(ier /= 0) then
if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAELEMENT_Add: ERROR allocating, status=", ier
rc = RC_ERROR
return
end if
carma%f_gas(igas)%f_refidx(:,:) = CMPLX(0._f, 0._f, kind=f)
end if
! Save off the settings.
carma%f_gas(igas)%f_name = name
carma%f_gas(igas)%f_wtmol = wtmol
carma%f_gas(igas)%f_ivaprtn = ivaprtn
carma%f_gas(igas)%f_icomposition = icomposition
! Defaults for optional parameters
carma%f_gas(igas)%f_shortname = ""
carma%f_gas(igas)%f_dgc_threshold = 0._f
carma%f_gas(igas)%f_ds_threshold = 0._f
! Set optional parameters.
if (present(shortname)) carma%f_gas(igas)%f_shortname = shortname
if (present(dgc_threshold)) carma%f_gas(igas)%f_dgc_threshold = dgc_threshold
if (present(ds_threshold)) carma%f_gas(igas)%f_ds_threshold = ds_threshold
if (present(refidx)) carma%f_gas(igas)%f_refidx(:,:) = refidx(:,:)
return
end subroutine CARMAGAS_Create
!! Deallocates the memory associated with a CARMAGAS object.
!!
!! @author Chuck Bardeen
!! @version May-2009
!!
!! @see CARMAGAS_Create
subroutine CARMAGAS_Destroy(carma, igas, rc)
type(carma_type), intent(inout) :: carma !! the carma object
integer, intent(in) :: igas !! the gas index
integer, intent(out) :: rc !! return code, negative indicates failure
integer :: ier
! Assume success.
rc = RC_OK
! Make sure there are enough gases allocated.
if (igas > carma%f_NGAS) then
if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGAS_Destroy:: ERROR - The specifed gas (", &
igas, ") is larger than the number of gases (", carma%f_NGAS, ")."
rc = RC_ERROR
return
end if
if (allocated(carma%f_gas(igas)%f_refidx)) then
deallocate(carma%f_gas(igas)%f_refidx, stat=ier)
if(ier /= 0) then
if (carma%f_do_print) then
write(carma%f_LUNOPRT, *) "CARMAGAS_Destroy: ERROR deallocating f_refidx, status=", ier
endif
rc = RC_ERROR
return
endif
endif
return
end subroutine CARMAGAS_Destroy
!! Gets information about a gas.
!!
!! The group name and other properties are available after a call to
!! CARMAGAS_Create().
!!
!! @author Chuck Bardeen
!! @version May-2009
!!
!! @see CARMAGAS_Create
!! @see CARMA_GetGas
subroutine CARMAGAS_Get(carma, igas, rc, name, shortname, wtmol, ivaprtn, icomposition, dgc_threshold, ds_threshold, refidx)
type(carma_type), intent(in) :: carma !! the carma object
integer, intent(in) :: igas !! the gas index
integer, intent(out) :: rc !! return code, negative indicates failure
character(len=*), optional, intent(out) :: name !! the gas name
character(len=*), optional, intent(out) :: shortname !! the gas short name
real(kind=f), optional, intent(out) :: wtmol !! the gas molecular weight [g/mol]
integer, optional, intent(out) :: ivaprtn !! vapor pressure routine for this gas
integer, optional, intent(out) :: icomposition !! gas compound specification
real(kind=f), optional, intent(out) :: dgc_threshold !! convergence criteria for gas concentration [fraction]
real(kind=f), optional, intent(out) :: ds_threshold !! convergence criteria for gas saturation [fraction]
complex(kind=f), optional, intent(out) :: refidx(carma%f_NWAVE, carma%f_NREFIDX) !! Refractive indices
! Assume success.
rc = RC_OK
! Make sure there are enough gases allocated.
if (igas > carma%f_NGAS) then
if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGAS_Get:: ERROR - The specifed gas (", &
igas, ") is larger than the number of gases (", carma%f_NGAS, ")."
rc = RC_ERROR
return
end if
! Return any requested properties of the group.
if (present(name)) name = carma%f_gas(igas)%f_name
if (present(shortname)) shortname = carma%f_gas(igas)%f_shortname
if (present(wtmol)) wtmol = carma%f_gas(igas)%f_wtmol
if (present(ivaprtn)) ivaprtn = carma%f_gas(igas)%f_ivaprtn
if (present(icomposition)) icomposition = carma%f_gas(igas)%f_icomposition
if (present(dgc_threshold)) dgc_threshold = carma%f_gas(igas)%f_dgc_threshold
if (present(ds_threshold)) ds_threshold = carma%f_gas(igas)%f_ds_threshold
if ((carma%f_NWAVE == 0) .or. (carma%f_NREFIDX == 0)) then
if (present(refidx)) then
if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Get: ERROR no refidx defined."
rc = RC_ERROR
return
end if
else
if (present(refidx)) refidx(:,:) = carma%f_gas(igas)%f_refidx(:,:)
end if
return
end subroutine CARMAGAS_Get
!! Prints information about a gas.
!!
!! @author Chuck Bardeen
!! @version May-2009
!!
!! @see CARMAGAS_Get
subroutine CARMAGAS_Print(carma, igas, rc)
type(carma_type), intent(in) :: carma !! the carma object
integer, intent(in) :: igas !! the gas index
integer, intent(out) :: rc !! return code, negative indicates failure
! Local variables
character(len=CARMA_NAME_LEN) :: name !! name
character(len=CARMA_SHORT_NAME_LEN) :: shortname !! shortname
real(kind=f) :: wtmol !! molecular weight (g/mol)
integer :: ivaprtn !! vapor pressure routine for this gas
integer :: icomposition !! gas compound specification
real(kind=f) :: dgc_threshold !! convergence criteria for gas concentration [fraction]
real(kind=f) :: ds_threshold !! convergence criteria for gas saturation [fraction]
complex(kind=f) :: refidx(carma%f_NWAVE, carma%f_NREFIDX) ! Refractive indices
! Assume success.
rc = RC_OK
! Test out the Get method.
if (carma%f_do_print) then
call CARMAGAS_Get(carma, igas, rc, name=name, shortname=shortname, wtmol=wtmol, &
ivaprtn=ivaprtn, icomposition=icomposition, refidx=refidx)
if (rc < RC_OK) return
write(carma%f_LUNOPRT,*) " name : ", trim(name)
write(carma%f_LUNOPRT,*) " shortname : ", trim(shortname)
write(carma%f_LUNOPRT,*) " wtmol : ", wtmol, " (g/mol)"
write(carma%f_LUNOPRT,*) " dgc_threshold : ", dgc_threshold
write(carma%f_LUNOPRT,*) " ds_threshold : ", ds_threshold
select case(ivaprtn)
case (I_VAPRTN_H2O_BUCK1981)
write(carma%f_LUNOPRT,*) " ivaprtn : Buck [1981]"
case (I_VAPRTN_H2O_MURPHY2005)
write(carma%f_LUNOPRT,*) " ivaprtn : Murphy & Koop [2005]"
case default
write(carma%f_LUNOPRT,*) " ivaprtn : unknown, ", ivaprtn
end select
select case(icomposition)
case (I_GCOMP_H2O)
write(carma%f_LUNOPRT,*) " icomposition : H2O"
case default
write(carma%f_LUNOPRT,*) " icomposition : unknown, ", icomposition
end select
write(carma%f_LUNOPRT,*) " ref. index : ", refidx
end if
return
end subroutine CARMAGAS_Print
end module