ROMS
Loading...
Searching...
No Matches
npzd_Franks_mod.h
Go to the documentation of this file.
1 MODULE mod_biology
2!
3!git $Id$
4!================================================== Hernan G. Arango ===
5! Copyright (c) 2002-2025 The ROMS Group !
6! Licensed under a MIT/X style license !
7! See License_ROMS.md !
8!=======================================================================
9! !
10! Parameters for Franks et al. (1986) type model: !
11! !
12! BioIter Maximum number of iterations to achieve convergence of !
13! the nonlinear solution. !
14! BioIni Initial concentration for analytical initial (uniform) !
15! conditions. !
16! DetRR Detritus remineraliztion rate, [1/day]. !
17! K_ext Light extinction coefficient, [1/m]. !
18! K_NO3 Inverse half-saturation for phytoplankton nitrate uptake !
19! [1/(millimole_N m-3)]. !
20! K_Phy Phytoplankton saturation coefficient, [millimole_N m-3]. !
21! PhyMR Phytoplankton senescence/mortality rate, [1/day]. !
22! Vm_NO3 Nitrate uptake rate, [1/day]. !
23! wDet Detrital sinking rate, [m/day]. !
24! ZooGR Zooplankton maximum growth rate, [1/day]. !
25! ZooMR Zooplankton mortality rate, [1/day]. !
26! ZooMD Zooplankton death bits rate, [1/day]. !
27! ZooGA Zooplankton grazing inefficiency, [nondimensional]. !
28! ZooEC Zooplankton excreted fraction, [nondimensional]. !
29! !
30!=======================================================================
31!
32 USE mod_param
33!
34 implicit none
35!
36! Set biological tracer identification indices.
37!
38 integer, allocatable :: idbio(:) ! Biological tracers
39 integer :: iNO3_ ! Nitrate concentration
40 integer :: iPhyt ! Phytoplankton concentration
41 integer :: iZoop ! Zooplankton concentration
42 integer :: isdet ! Small detritus concentration
43!
44! Biological parameters.
45!
46 integer, allocatable :: bioiter(:)
47
48#ifdef ANA_BIOLOGY
49 real(r8), allocatable :: bioini(:,:)
50#endif
51 real(r8), allocatable :: detrr(:) ! 1/day
52 real(r8), allocatable :: k_ext(:) ! 1/m
53 real(r8), allocatable :: k_no3(:) ! 1/(mmol/m3)
54 real(r8), allocatable :: k_phy(:) ! mmol/m3
55 real(r8), allocatable :: phymr(:) ! 1/day
56 real(r8), allocatable :: vm_no3(:) ! 1/day
57 real(r8), allocatable :: wdet(:) ! m/day
58#ifdef TANGENT
59 real(r8), allocatable :: tl_wdet(:)
60#endif
61#ifdef ADJOINT
62 real(r8), allocatable :: ad_wdet(:)
63#endif
64 real(r8), allocatable :: zoogr(:) ! 1/day
65 real(r8), allocatable :: zoomr(:) ! 1/day
66 real(r8), allocatable :: zoomd(:) ! 1/day
67 real(r8), allocatable :: zooga(:) ! nondimensional
68 real(r8), allocatable :: zooec(:) ! nondimensional
69!
70 CONTAINS
71!
72 SUBROUTINE initialize_biology
73!
74!=======================================================================
75! !
76! This routine sets several variables needed by the biology model. !
77! It allocates and assigns biological tracers indices. !
78! !
79!=======================================================================
80!
81! Local variable declarations
82!
83 integer :: i, ic
84!
85!-----------------------------------------------------------------------
86! Set number of biological tracers.
87!-----------------------------------------------------------------------
88!
89 nbt=4
90!
91!-----------------------------------------------------------------------
92! Allocate various module variables.
93!-----------------------------------------------------------------------
94!
95 IF (.not.allocated(bioiter)) THEN
96 allocate ( bioiter(ngrids) )
97 dmem(1)=dmem(1)+real(ngrids,r8)
98 END IF
99
100 IF (.not.allocated(detrr)) THEN
101 allocate ( detrr(ngrids) )
102 dmem(1)=dmem(1)+real(ngrids,r8)
103 END IF
104
105 IF (.not.allocated(k_ext)) THEN
106 allocate ( k_ext(ngrids) )
107 dmem(1)=dmem(1)+real(ngrids,r8)
108 END IF
109
110 IF (.not.allocated(k_no3)) THEN
111 allocate ( k_no3(ngrids) )
112 dmem(1)=dmem(1)+real(ngrids,r8)
113 END IF
114
115 IF (.not.allocated(k_phy)) THEN
116 allocate ( k_phy(ngrids) )
117 dmem(1)=dmem(1)+real(ngrids,r8)
118 END IF
119
120 IF (.not.allocated(phymr)) THEN
121 allocate ( phymr(ngrids) )
122 dmem(1)=dmem(1)+real(ngrids,r8)
123 END IF
124
125 IF (.not.allocated(vm_no3)) THEN
126 allocate ( vm_no3(ngrids) )
127 dmem(1)=dmem(1)+real(ngrids,r8)
128 END IF
129
130 IF (.not.allocated(wdet)) THEN
131 allocate ( wdet(ngrids) )
132 dmem(1)=dmem(1)+real(ngrids,r8)
133 END IF
134
135#ifdef TANGENT
136 IF (.not.allocated(tl_wdet)) THEN
137 allocate ( tl_wdet(ngrids) )
138 dmem(1)=dmem(1)+real(ngrids,r8)
139 END IF
140#endif
141
142#ifdef ADJOINT
143 IF (.not.allocated(ad_wdet)) THEN
144 allocate ( ad_wdet(ngrids) )
145 dmem(1)=dmem(1)+real(ngrids,r8)
146 END IF
147#endif
148
149 IF (.not.allocated(zoogr)) THEN
150 allocate ( zoogr(ngrids) )
151 dmem(1)=dmem(1)+real(ngrids,r8)
152 END IF
153
154 IF (.not.allocated(zoomr)) THEN
155 allocate ( zoomr(ngrids) )
156 dmem(1)=dmem(1)+real(ngrids,r8)
157 END IF
158
159 IF (.not.allocated(zoomd)) THEN
160 allocate ( zoomd(ngrids) )
161 dmem(1)=dmem(1)+real(ngrids,r8)
162 END IF
163
164 IF (.not.allocated(zooga)) THEN
165 allocate ( zooga(ngrids) )
166 dmem(1)=dmem(1)+real(ngrids,r8)
167 END IF
168
169 IF (.not.allocated(zooec)) THEN
170 allocate ( zooec(ngrids) )
171 dmem(1)=dmem(1)+real(ngrids,r8)
172 END IF
173!
174! Allocate biological tracer vector.
175!
176 IF (.not.allocated(idbio)) THEN
177 allocate ( idbio(nbt) )
178 dmem(1)=dmem(1)+real(nbt,r8)
179 END IF
180!
181!-----------------------------------------------------------------------
182! Initialize tracer identification indices.
183!-----------------------------------------------------------------------
184!
185 ic=nat+npt+ncs+nns
186 DO i=1,nbt
187 idbio(i)=ic+i
188 END DO
189 ino3_=ic+1
190 iphyt=ic+2
191 izoop=ic+3
192 isdet=ic+4
193!
194 RETURN
195 END SUBROUTINE initialize_biology
196
197 END MODULE mod_biology
real(r8), dimension(:), allocatable zooga
real(r8), dimension(:), allocatable tl_wdet
real(r8), dimension(:), allocatable zoomr
Definition fennel_mod.h:162
real(r8), dimension(:), allocatable k_phy
Definition fennel_mod.h:135
real(r8), dimension(:), allocatable detrr
real(r8), dimension(:), allocatable wdet
real(r8), dimension(:), allocatable zoomd
integer, dimension(:), allocatable bioiter
Definition ecosim_mod.h:343
real(r8), dimension(:,:), allocatable bioini
real(r8), dimension(:), allocatable zoogr
Definition fennel_mod.h:160
real(r8), dimension(:), allocatable k_no3
Definition fennel_mod.h:133
real(r8), dimension(:), allocatable phymr
Definition fennel_mod.h:145
real(r8), dimension(:), allocatable zooec
real(r8), dimension(:), allocatable ad_wdet
real(r8), dimension(:), allocatable vm_no3
subroutine initialize_biology
Definition ecosim_mod.h:499
real(r8), dimension(:), allocatable k_ext
integer nat
Definition mod_param.F:499
real(r8), dimension(:), allocatable dmem
Definition mod_param.F:137
integer ncs
Definition mod_param.F:525
integer nbt
Definition mod_param.F:509
integer ngrids
Definition mod_param.F:113
integer nns
Definition mod_param.F:529
integer npt
Definition mod_param.F:505