forked from E3SM-Project/Ocean-BGC
-
Notifications
You must be signed in to change notification settings - Fork 0
/
MACROS_parms.F90
166 lines (137 loc) · 6.62 KB
/
MACROS_parms.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
MODULE MACROS_parms
!-----------------------------------------------------------------------------
! Backfill by imitating analogous module with name ecosys_parms
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
! This module manages the parameter variables for the module MACROS_mod.
! Most of the variables are not parameters in the Fortran sense. In the
! the Fortran sense, they are vanilla module variables.
!
! This modules handles initializing the variables to default values and
! reading them from the namelist MACROS_parms. The values used are echoed
! to stdout for record keeping purposes.
!
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
! variables/subroutines/function used from other modules
! The following are used extensively in this set of routines, so are used at
! the module level. The use statements for variables that are only needed
! locally are located at the module subprogram level.
!-----------------------------------------------------------------------------
! !USES:
IMPLICIT NONE
!-----------------------------------------------------------------------------
! public/private declarations
! all module variables are public and should have their values preserved
!-----------------------------------------------------------------------------
PUBLIC
SAVE
!-----------------------------------------------------------------------------
! kinds definitions
!-----------------------------------------------------------------------------
integer, parameter, public :: &
MACROS_char = 256 ,&
MACROS_log = kind(.true.) ,&
MACROS_i4 = selected_int_kind(6) ,&
MACROS_i8 = selected_int_kind(13) ,&
MACROS_r4 = selected_real_kind(6) ,&
MACROS_r8 = selected_real_kind(13)
!-----------------------------------------------------------------------------
! floating point constants used across ecosystem module
!-----------------------------------------------------------------------------
real (MACROS_r8), parameter, private :: &
c0 = 0.0_MACROS_r8, &
c1 = 1.0_MACROS_r8, &
c2 = 2.0_MACROS_r8, &
c10 = 10.0_MACROS_r8, &
p5 = 0.5_MACROS_r8
REAL(KIND=MACROS_r8), PARAMETER :: &
spd = 86400.0_MACROS_r8, & ! number of seconds in a day
dps = c1 / spd, & ! number of days in a second
yps = c1 / (365.0_MACROS_r8*spd) ! number of years in a second
type, public :: MACROS_indices_type
integer (MACROS_i4) :: &
prot_ind, & ! MACROS index
poly_ind, & ! MACROS index
lip_ind, & ! MACROS index
zooC_ind, & ! MACROS index
spC_ind, & ! MACROS index
diatC_ind, & ! MACROS index
diazC_ind, & ! MACROS index
phaeoC_ind ! MACROS index
character (MACROS_char), allocatable, dimension(:) :: &
short_name, & ! short name of variable
long_name, & ! long name of variable
units ! units of variable
end type MACROS_indices_type
type, public :: MACROS_input_type
real (MACROS_r8), allocatable, dimension(:,:,:) :: &
MACROS_tracers
real (MACROS_r8), allocatable, dimension(:,:) :: &
cell_thickness
integer (MACROS_i4), allocatable, dimension(:) :: &
number_of_active_levels
end type MACROS_input_type
!-------------------------------------------------------------------------
! Here SE removes piston velocity related, since the organics ride bubbles.
! SB will handle the surfactant and spray flux chemistry initially.
! Also flux and temperature are sacrificed since initial mechanism minimalist.
!-------------------------------------------------------------------------
type, public :: MACROS_output_type
real (MACROS_r8), allocatable, dimension(:,:,:) :: &
MACROS_tendencies
end type MACROS_output_type
!-----------------------------------------------------------------------------
! Sea air gas transfer originally diagnosed in this location for DMS
! but the macromolecules will scavenged on bubble surfaces
! in a routine likely handled by Burrows and company at PNNL, at least initially.
!-----------------------------------------------------------------------------
type, public :: MACROS_diagnostics_type
real (MACROS_r8), allocatable, dimension(:,:) :: &
diag_PROT_S_TOTAL, &
diag_POLY_S_TOTAL, &
diag_LIP_S_TOTAL, &
diag_PROT_R_TOTAL, &
diag_POLY_R_TOTAL, &
diag_LIP_R_TOTAL
end type MACROS_diagnostics_type
!-----------------------------------------------------------------------------
! Floating point constants used across MACROS module.
! mm encourages se to sacrifice as much as possible this go around.
! Hence all light, temperature and prokaryotic details disappear.
! Even Redfield goes the way of the great white buffalo
!-----------------------------------------------------------------------------
real (MACROS_r8) :: &
f_prot , &
f_poly , &
f_lip , &
k_C_p_base , &
zooC_avg , &
mort , &
k_prot_bac , &
k_poly_bac , &
k_lip_bac , &
inject_scale
real (MACROS_r8), parameter :: &
epsC = 1.00e-8_MACROS_r8 ! small C concentration (mmol C/m^3)
!*****************************************************************************
CONTAINS
!*****************************************************************************
SUBROUTINE MACROS_parms_init
!---------------------------------------------------------------------------
! default parameter values
!---------------------------------------------------------------------------
f_prot = 0.6_MACROS_r8
f_poly = 0.2_MACROS_r8
f_lip = 0.2_MACROS_r8
k_C_p_base = dps*0.1_MACROS_r8
zooC_avg = 0.3_MACROS_r8
mort = 0.0_MACROS_r8
k_prot_bac = dps*0.1_MACROS_r8
k_poly_bac = dps*0.01_MACROS_r8
k_lip_bac = dps*1.0_MACROS_r8
inject_scale = 1.0_MACROS_r8
!---------------------------------------------------------------------------
END SUBROUTINE MACROS_parms_init
!*****************************************************************************
END MODULE MACROS_parms