Choral
ionicModel_mod.f90
Go to the documentation of this file.
1 
126 
128 
129  use choral_variables
130  use choral_constants
131  use real_type
132  use basic_tools
133  use br_mod
134  use tnnp_mod
135 
136  implicit none
137  private
138 
139  ! %----------------------------------------%
140  ! | |
141  ! | PUBLIC DATA |
142  ! | |
143  ! %----------------------------------------%
144  public :: ionicmodel
145  public :: print
146  public :: ionicmodel_ilist
147 
148  ! %----------------------------------------%
149  ! | |
150  ! | ABSTRACT INTERFACES |
151  ! | |
152  ! %----------------------------------------%
153  abstract interface
154 
158  subroutine ionic_term(a, b, I, y, N, Na)
159  import :: rp
160  real(RP), dimension(Na), intent(out) :: a
161  real(RP), dimension(N) , intent(out) :: b
162  real(RP) , intent(in) :: I
163  real(RP), dimension(N) , intent(in) :: y
164  integer , intent(in) :: N, Na
165  end subroutine ionic_term
166 
167  end interface
168 
169 
170  ! %----------------------------------------%
171  ! | |
172  ! | DERIVED TYPE |
173  ! | |
174  ! %----------------------------------------%
175 
185  character(20) :: name
186 
188  integer :: type
189 
191  integer :: n
192 
194  integer :: na
195 
197  integer :: ni
198 
200  real(RP) :: ist
201 
203  real(RP) :: vrest
204 
205  ! rest state
206  real(RP), dimension(:), allocatable :: y0
207 
208  ! model functions
209  procedure(ionic_term), nopass, pointer :: ab =>null()
210 
211  contains
212 
215 
216  end type ionicmodel
217 
218 
219  ! %----------------------------------------%
220  ! | |
221  ! | GENERIC INTERFACES |
222  ! | |
223  ! %----------------------------------------%
225  interface print
226  module procedure ionicmodel_print
227  end interface print
228 
229  interface ionicmodel
230  module procedure ionicmodel_create
231  end interface ionicmodel
232 
234  interface clear
235  module procedure ionicmodel_clear
236  end interface clear
237 
238 contains
239 
240 
242  subroutine ionicmodel_clear(im)
243  type(ionicmodel), intent(inout) :: im
244 
245  im%type = -1
246  im%name = "Undefined"
247  im%N = -1
248  im%Na = -1
249  im%NI = -1
250 
251  call freemem(im%Y0)
252  im%ab =>null()
253 
254  end subroutine ionicmodel_clear
255 
256 
264  function ionicmodel_create(type) result(im)
265  type(ionicmodel) :: im
266  integer, intent(in) :: type
267 
268  call clear(im)
269  im%type = type
270 
271  select case(type)
272  case(ionic_br)
273  im%name = "IONIC_BR"
274  im%N = br_ny
275  im%Na = br_nw
276  im%ab => br_ab_w
277  im%NI = br_ni
278  im%Ist = 50.0_rp ! [A/F]
279  call allocmem(im%Y0, im%N)
280  call br_y0(im%Y0)
281  im%Vrest = im%Y0(im%N)
282 
283  case(ionic_br_0)
284  im%name = "IONIC_BR_0"
285  im%N = br_ny
286  im%Na = 0
287  im%ab => br_ab_0
288  im%NI = br_ni
289  im%Ist = 50.0_rp ! [A/F]
290  call allocmem(im%Y0, im%N)
291  call br_y0(im%Y0)
292  im%Vrest = im%Y0(im%N)
293 
294  case(ionic_br_wv)
295  im%name = "IONIC_BR_WV"
296  im%N = br_ny
297  im%Na = br_ny
298  im%ab => br_ab_wv
299  im%NI = br_ni
300  im%Ist = 50.0_rp ! [A/F]
301  call allocmem(im%Y0, im%N)
302  call br_y0(im%Y0)
303  im%Vrest = im%Y0(im%N)
304 
305  case(ionic_br_sp)
306  im%name = "IONIC_BR_SP"
307  im%N = br_ny
308  im%Na = br_nw
309  im%ab => br_sp_ab_w
310  im%NI = br_ni
311  im%Ist = 50.0_rp ! [A/F]
312  call allocmem(im%Y0, im%N)
313  call br_sp_y0(im%Y0)
314  im%Vrest = im%Y0(im%N)
315 
316  case(ionic_tnnp)
317  im%name = "IONIC_TNNP"
318  im%N = 17
319  im%Na = 12
320  im%ab => tnnp_ab_w
321  im%NI = 15
322  im%Ist = 52.0_rp ! [A/F]
323 
324  call allocmem(im%Y0, im%N)
325  call tnnp_y0(im%Y0)
326  im%Vrest = im%Y0(im%N)
327 
328  case(ionic_tnnp_0)
329  im%name = "IONIC_TNNP_0"
330  im%N = 17
331  im%Na = 12
332  im%ab => tnnp_ab_0
333  im%NI = 15
334  im%Ist = 52.0_rp ! [A/F]
335 
336  call allocmem(im%Y0, im%N)
337  call tnnp_y0(im%Y0)
338  im%Vrest = im%Y0(im%N)
339 
340  case default
341  call quit(&
342  & "ionicModel_mod: ionicModel_create: wrong type")
343  end select
344 
345 
346  if (choral_verb>0) write (*,*) &
347  & 'ionicModel_mod : create = ', trim(im%name)
348 
349  if (choral_verb>1) write(*,*) &
350  & " Size N, Na =", im%N, im%Na
351 
352  end function ionicmodel_create
353 
354 
356  subroutine ionicmodel_print (im)
357  type(ionicmodel) :: im
358 
359  write(*,*)"ionicModel_mod : ionicModel_print"
360  write(*,*)" name = " // trim(im%name)
361  write(*,*)" N =", im%N
362  write(*,*)" NA =", im%NA
363  write(*,*)" NI =", im%NI
364  write(*,*)" Ist =", im%Ist
365  write(*,*)" Vrest =", im%Vrest
366 
367  end subroutine ionicmodel_print
368 
369 
385  subroutine ionicmodel_ilist(I, Y, I_app, type)
386  real(RP), dimension(:), intent(out) :: I
387  real(RP), dimension(:), intent(in) :: Y
388  real(RP) , intent(in) :: I_app
389  integer , intent(in) :: type
390 
391  select case(type)
393  call br_ilist(i(1:br_ni), y(1:br_ny))
394 
395  case(ionic_br_sp)
396  call br_sp_ilist(i(1:br_ni), y(1:br_ny))
397 
398  case(ionic_tnnp, ionic_tnnp_0)
399  call tnnp_ilist(i(1:tnnp_ni), y(1:tnnp_ny))
400 
401  case default
402  call quit("ionicModel_mod: ionicModel_IList: unknown type")
403 
404  end select
405 
406  end subroutine ionicmodel_ilist
407 
408 end module ionicmodel_mod
subroutine, public br_sp_y0(Y)
Model IONIC_BR_SP: rest state
Definition: br_mod.f90:389
BASIC TOOLS
Definition: basic_tools.F90:8
subroutine, public tnnp_ab_w(a, b, I, Y, N, Na)
Definition: tnnp_mod.f90:205
deallocate memory for real(RP) arrays
Definition: real_type.F90:163
integer, parameter ionic_br_wv
integer, parameter ionic_tnnp_0
subroutine, public br_y0(Y)
re-computed rest state (solving F(Y0)=0)
Definition: br_mod.f90:89
DERIVED TYPE ionicModel: cellular ionic models in electrophysiology
Abstract interface: .
integer, parameter, public rp
real(kind=RP) = real precision in the code REAL_TOL = epsilon to test real equality ...
Definition: real_type.F90:90
subroutine, public quit(message)
Stop program execution, display an error messahe.
subroutine, public tnnp_ilist(IList, Y)
Definition: tnnp_mod.f90:228
integer, parameter, public br_nw
Definition: br_mod.f90:51
integer, parameter ionic_br
TNNP ionic model
Definition: tnnp_mod.f90:27
integer, parameter ionic_br_0
integer, parameter, public tnnp_ny
Definition: tnnp_mod.f90:73
REAL NUMBERS PRECISION IN CHORAL: selects simple/double/quad
Definition: real_type.F90:33
integer, parameter, public br_ni
Definition: br_mod.f90:52
subroutine ionicmodel_clear(im)
Destructor.
Beeler Reuter ionic model
Definition: br_mod.f90:28
subroutine, public br_ab_w(a, b, I, Y, N, Na)
Model IONIC_BR: reaction term
Definition: br_mod.f90:189
type(ionicmodel) function ionicmodel_create(type)
Constructor for the type ionicModel
subroutine, public br_sp_ab_w(a, b, I, Y, N, Na)
Model IONIC_BR_SP: reaction term
Definition: br_mod.f90:408
CHORAL CONSTANTS
subroutine, public br_sp_ilist(IList, Y)
Model IONIC_BR_SP: ionic current list
Definition: br_mod.f90:375
real(rp), parameter vrest
Definition: tnnp_mod.f90:108
subroutine, public tnnp_y0(Y)
Definition: tnnp_mod.f90:159
allocate memory for real(RP) arrays
Definition: real_type.F90:158
print a short description
subroutine, public br_ilist(IList, Y)
Definition: br_mod.f90:247
integer, parameter ionic_br_sp
integer, parameter, public br_ny
Definition: br_mod.f90:50
integer choral_verb
Verbosity level.
DERIVED TYPE ionicModel: cellular ionic models in electrophysiology
subroutine, public br_ab_0(a, b, I, Y, N, Na)
Model IONIC_BR: reaction term
Definition: br_mod.f90:159
DEFINITION OF GLOBAL VARIABLES FOR THE LIBRARY CHORAL
integer, parameter na
integer, parameter, public tnnp_ni
Definition: tnnp_mod.f90:48
subroutine, public ionicmodel_ilist(I, Y, I_app, type)
Membrane ionic currents
subroutine ionicmodel_print(im)
Print a short description.
subroutine, public tnnp_ab_0(a, b, I, Y, N, Na)
Definition: tnnp_mod.f90:188
subroutine, public br_ab_wv(a, b, I, Y, N, Na)
Model IONIC_BR: reaction term
Definition: br_mod.f90:217
integer, parameter ionic_tnnp