OpenCMISS-Iron Internal API Documentation
cmiss_cellml.f90
Go to the documentation of this file.
1 
43 
45 MODULE cmiss_cellml
46 
47  !Module imports
48  USE iso_c_binding
49 
50  USE base_routines
51 
52 #ifdef WITH_CELLML
53  USE cellml_model_definition
54 #endif
55 
56  ! Moved this usage declaration outside the preprocessor definition,
57  ! as this file is included only if CELLML integration is selected.
58  ! This fixes problems with the CMAKE FORTRAN parser. Its not detecting
59  ! the file (=module) dependency correctly and hence breaks the build
60  ! on some platforms.
61  USE cmiss_fortran_c
62 
63  USE field_routines
64  USE iso_varying_string
65  USE input_output
66  USE kinds
67  USE strings
68  USE types
69 
70 #include "macros.h"
71 
72  IMPLICIT NONE
73 
74  PRIVATE
75 
76  !Module parameters
77 
85  INTEGER(INTG), PARAMETER :: cellml_models_field = 1
86  INTEGER(INTG), PARAMETER :: cellml_state_field = 2
87  INTEGER(INTG), PARAMETER :: cellml_intermediate_field = 3
88  INTEGER(INTG), PARAMETER :: cellml_parameters_field = 4
90 
95  INTEGER(INTG), PARAMETER :: cellml_map_to_field_type = 1
96  INTEGER(INTG), PARAMETER :: cellml_map_from_field_type = 2
98 
103  INTEGER(INTG), PARAMETER :: cellml_models_field_not_checked = -2
104  INTEGER(INTG), PARAMETER :: cellml_models_field_not_constant =-1
106 
107  !Module types
108 
109  !Module variables
110 
111  !Interfaces
112 
114  INTERFACE map_cellml_variable_type_to_field_type
115  MODULE PROCEDURE map_cellml_variable_type_to_field_type_intg
116  END INTERFACE !MAP_CELLML_VARIABLE_TYPE_TO_FIELD_TYPE
117 
119  INTERFACE map_cellml_field_type_to_variable_type
120  MODULE PROCEDURE map_cellml_field_type_to_variable_type_intg
121  END INTERFACE !MAP_CELLML_FIELD_TYPE_TO_VARIABLE_TYPE
122 
123  INTERFACE cellml_model_import
124  MODULE PROCEDURE cellml_model_import_c
125  MODULE PROCEDURE cellml_model_import_vs
126  END INTERFACE !CELLML_MODEL_IMPORT
127 
128  INTERFACE cellml_variable_set_as_known
129  MODULE PROCEDURE cellml_variable_set_as_known_c
130  MODULE PROCEDURE cellml_variable_set_as_known_vs
131  END INTERFACE !CELLML_VARIABLE_SET_AS_KNOWN
132 
133  INTERFACE cellml_variable_set_as_wanted
134  MODULE PROCEDURE cellml_variable_set_as_wanted_c
135  MODULE PROCEDURE cellml_variable_set_as_wanted_vs
136  END INTERFACE !CELLML_VARIABLE_SET_AS_WANTED
137 
138  INTERFACE cellml_create_cellml_to_field_map
139  MODULE PROCEDURE cellml_create_cellml_to_field_map_c
140  MODULE PROCEDURE cellml_create_cellml_to_field_map_vs
141  END INTERFACE !CELLML_CREATE_CELLML_TO_FIELD_MAP
142 
143  INTERFACE cellml_create_field_to_cellml_map
144  MODULE PROCEDURE cellml_create_field_to_cellml_map_c
145  MODULE PROCEDURE cellml_create_field_to_cellml_map_vs
146  END INTERFACE !CELLML_CREATE_FIELD_TO_CELLML_MAP
147 
148  INTERFACE cellml_field_component_get
149  MODULE PROCEDURE cellml_field_component_get_c
150  MODULE PROCEDURE cellml_field_component_get_vs
151  END INTERFACE !CELLML_FIELD_COMPONENT_GET
152 
153  PUBLIC map_cellml_variable_type_to_field_type,map_cellml_field_type_to_variable_type
154 
155  PUBLIC cellml_models_field,cellml_state_field,cellml_intermediate_field,cellml_parameters_field
156 
157  PUBLIC cellml_models_field_not_constant
158 
159  PUBLIC cellml_cellml_to_field_update
160 
161  PUBLIC cellml_create_start,cellml_create_finish
162 
163  PUBLIC cellml_destroy
164 
165  PUBLIC cellml_field_to_cellml_update
166 
167  PUBLIC cellml_model_import
168 
169  PUBLIC cellml_variable_set_as_known,cellml_variable_set_as_wanted
170 
171  PUBLIC cellml_field_maps_create_start,cellml_field_maps_create_finish
172 
173  PUBLIC cellml_fieldmodeldofset
174 
175  PUBLIC cellml_create_cellml_to_field_map,cellml_create_field_to_cellml_map
176 
177  PUBLIC cellml_models_field_create_start,cellml_models_field_create_finish,cellml_models_field_get
178 
179  PUBLIC cellml_state_field_create_start,cellml_state_field_create_finish,cellml_state_field_get
180 
181  PUBLIC cellml_field_component_get
182 
183  PUBLIC cellml_intermediate_field_create_finish,cellml_intermediate_field_create_start
184 
185  PUBLIC cellml_intermediate_field_get
186 
187  PUBLIC cellml_parameters_field_create_start,cellml_parameters_field_create_finish
188 
189  PUBLIC cellml_parameters_field_get
190 
191  PUBLIC cellml_generate
192 
193  PUBLIC cellml_user_number_find
194 
195  PUBLIC cellml_environments_finalise,cellml_environments_initialise
196 
197 CONTAINS
198 
199  !
200  !=================================================================================================================================
201  !
202 
203 
205  SUBROUTINE cellml_cellml_to_field_update(CELLML,ERR,ERROR,*)
206  !Argument variables
207  TYPE(cellml_type), POINTER :: CELLML
208  INTEGER(INTG), INTENT(OUT) :: ERR
209  TYPE(varying_string), INTENT(OUT) :: ERROR
210  !Local variables
211  INTEGER(INTG) :: derivativeNumber,dofIdx,dofType,dof2ParamIdx,elementNumber,gaussNumber,gridNumber,map_idx,modelIdx, &
212  & nodeNumber,versionNumber
213  INTEGER(INTG), POINTER :: MODELS_DATA(:)
214  REAL(DP) :: dofValue
215  TYPE(cellml_field_maps_type), POINTER :: FIELD_MAPS
216  TYPE(cellml_model_map_type), POINTER :: MODEL_MAP
217  TYPE(cellml_model_maps_type), POINTER :: MODEL_MAPS
218  TYPE(field_type), POINTER :: MODELS_FIELD
219  TYPE(field_variable_type), POINTER :: MODELS_VARIABLE
220  TYPE(varying_string) :: LOCAL_ERROR
221 
222  enters("CELLML_CELLML_TO_FIELD_UPDATE",err,error,*999)
223 
224 #ifdef WITH_CELLML
225 
226  IF(ASSOCIATED(cellml)) THEN
227  IF(ASSOCIATED(cellml%MODELS_FIELD)) THEN
228  field_maps=>cellml%FIELD_MAPS
229  IF(ASSOCIATED(field_maps)) THEN
230  IF(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX/=cellml_models_field_not_constant) THEN
231  !The CellML environement only uses one model and so we can optimise for this.
232  model_maps=>field_maps%MODEL_MAPS(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX)%PTR
233  IF(ASSOCIATED(model_maps)) THEN
234  IF(diagnostics1) THEN
235  CALL write_string(diagnostic_output_type,"CellML to field update:",err,error,*999)
236  CALL write_string_value(diagnostic_output_type," CellML user number = ",cellml%USER_NUMBER,err,error,*999)
237  CALL write_string_value(diagnostic_output_type," One model index = ",cellml%MODELS_FIELD% &
238  & only_one_model_index,err,error,*999)
239  CALL write_string_value(diagnostic_output_type," Number of model maps = ",model_maps% &
240  & number_of_fields_mapped_to,err,error,*999)
241  ENDIF
242  !Loop over the number of CellML to field maps
243  DO map_idx=1,model_maps%NUMBER_OF_FIELDS_MAPPED_FROM
244  model_map=>model_maps%FIELDS_MAPPED_FROM(map_idx)%PTR
245  IF(ASSOCIATED(model_map)) THEN
246  SELECT CASE(model_map%CELLML_FIELD_TYPE)
247  CASE(cellml_models_field)
248  CALL flagerror("Cannot map models field.",err,error,*999)
249  CASE(cellml_state_field)
250  IF(ASSOCIATED(cellml%STATE_FIELD)) THEN
251  CALL field_parameterstofieldparameterscopy(cellml%STATE_FIELD%STATE_FIELD, &
252  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,model_map%CELLML_VARIABLE_NUMBER, &
253  & model_map%FIELD,model_map%VARIABLE_TYPE,model_map%FIELD_PARAMETER_SET,model_map%COMPONENT_NUMBER, &
254  & err,error,*999)
255  ELSE
256  CALL flagerror("CellML environment state field is not associated.",err,error,*999)
257  ENDIF
258  CASE(cellml_intermediate_field)
259  IF(ASSOCIATED(cellml%INTERMEDIATE_FIELD)) THEN
260  CALL field_parameterstofieldparameterscopy(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD, &
261  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,model_map%CELLML_VARIABLE_NUMBER,model_map%FIELD, &
262  & model_map%VARIABLE_TYPE,model_map%FIELD_PARAMETER_SET,model_map%COMPONENT_NUMBER,err,error,*999)
263  ELSE
264  CALL flagerror("CellML environment intermediate field is not associated.",err,error,*999)
265  ENDIF
266  CASE(cellml_parameters_field)
267  IF(ASSOCIATED(cellml%PARAMETERS_FIELD)) THEN
268  CALL field_parameterstofieldparameterscopy(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD, &
269  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,model_map%CELLML_VARIABLE_NUMBER,model_map%FIELD, &
270  & model_map%VARIABLE_TYPE,model_map%FIELD_PARAMETER_SET,model_map%COMPONENT_NUMBER,err,error,*999)
271  ELSE
272  CALL flagerror("CellML environment parameters field is not associated.",err,error,*999)
273  ENDIF
274  CASE DEFAULT
275  local_error="The CellML to field model map CellML field type of "// &
276  & trim(number_to_vstring(model_map%CELLML_FIELD_TYPE,"*",err,error))// &
277  & " is invalid for map index "//trim(number_to_vstring(map_idx,"*",err,error))//" of model index "// &
278  & trim(number_to_vstring(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX,"*",err,error))// &
279  & " of CellML environment number "//trim(number_to_vstring(cellml%USER_NUMBER,"*",err,error))//"."
280  CALL flagerror(local_error,err,error,*999)
281  END SELECT
282  ELSE
283  local_error="The CellML to field map is not associated for map index "// &
284  & trim(number_to_vstring(map_idx,"*",err,error))//" of model index "// &
285  & trim(number_to_vstring(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX,"*",err,error))// &
286  & " of CellML environment number "//trim(number_to_vstring(cellml%USER_NUMBER,"*",err,error))//"."
287  CALL flagerror(local_error,err,error,*999)
288  ENDIF
289  IF(diagnostics1) THEN
290  CALL write_string_value(diagnostic_output_type," Map index : ",map_idx,err,error,*999)
291  CALL write_string_value(diagnostic_output_type," CellML field type = ",model_map%CELLML_FIELD_TYPE, &
292  & err,error,*999)
293  CALL write_string_value(diagnostic_output_type," CellML parameter set = ",model_map%CELLML_PARAMETER_SET, &
294  & err,error,*999)
295  CALL write_string_value(diagnostic_output_type," CellML variable number = ",model_map%CELLML_VARIABLE_NUMBER, &
296  & err,error,*999)
297  CALL write_string_value(diagnostic_output_type," Field user number = ",model_map%FIELD%USER_NUMBER, &
298  & err,error,*999)
299  CALL write_string_value(diagnostic_output_type," Field variable type = ",model_map%VARIABLE_TYPE, &
300  & err,error,*999)
301  CALL write_string_value(diagnostic_output_type," Field parameter set = ",model_map%FIELD_PARAMETER_SET, &
302  & err,error,*999)
303  CALL write_string_value(diagnostic_output_type," Field component number = ",model_map%COMPONENT_NUMBER, &
304  & err,error,*999)
305  ENDIF
306  ENDDO !map_idx
307  ELSE
308  local_error="The CellML field maps models map is not associated for model index "// &
309  & trim(number_to_vstring(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX,"*",err,error))// &
310  & " of CellML environment number "//trim(number_to_vstring(cellml%USER_NUMBER,"*",err,error))//"."
311  CALL flagerror(local_error,err,error,*999)
312  ENDIF
313  ELSE
314  !More than one model used in the models field.
315  models_field=>cellml%MODELS_FIELD%MODELS_FIELD
316  IF(ASSOCIATED(models_field)) THEN
317  NULLIFY(models_variable)
318  CALL field_variable_get(models_field,field_u_variable_type,models_variable,err,error,*999)
319  NULLIFY(models_data)
320  CALL field_parameter_set_data_get(models_field,field_u_variable_type,field_values_set_type, &
321  & models_data,err,error,*999)
322  IF(diagnostics1) THEN
323  CALL write_string(diagnostic_output_type,"CellML to field update:",err,error,*999)
324  CALL write_string_value(diagnostic_output_type," CellML user number = ",cellml%USER_NUMBER,err,error,*999)
325  ENDIF
326  !Loop over the dofs in the models field
327  DO dofidx=1,models_variable%TOTAL_NUMBER_OF_DOFS
328  modelidx=models_data(dofidx)
329  IF(modelidx>0) THEN
330  model_maps=>field_maps%MODEL_MAPS(modelidx)%PTR
331  IF(ASSOCIATED(model_maps)) THEN
332  doftype=models_variable%DOF_TO_PARAM_MAP%DOF_TYPE(1,dofidx)
333  dof2paramidx=models_variable%DOF_TO_PARAM_MAP%DOF_TYPE(2,dofidx)
334  SELECT CASE(doftype)
335  CASE(field_constant_interpolation)
336  !Do nothing
337  CASE(field_element_based_interpolation)
338  elementnumber=models_variable%DOF_TO_PARAM_MAP%ELEMENT_DOF2PARAM_MAP(1,dof2paramidx)
339  CASE(field_node_based_interpolation)
340  versionnumber=models_variable%DOF_TO_PARAM_MAP%NODE_DOF2PARAM_MAP(1,dof2paramidx)
341  derivativenumber=models_variable%DOF_TO_PARAM_MAP%NODE_DOF2PARAM_MAP(2,dof2paramidx)
342  nodenumber=models_variable%DOF_TO_PARAM_MAP%NODE_DOF2PARAM_MAP(3,dof2paramidx)
343  CASE(field_grid_point_based_interpolation)
344  gridnumber=models_variable%DOF_TO_PARAM_MAP%GRID_POINT_DOF2PARAM_MAP(1,dof2paramidx)
345  CASE(field_gauss_point_based_interpolation)
346  gaussnumber=models_variable%DOF_TO_PARAM_MAP%GAUSS_POINT_DOF2PARAM_MAP(1,dof2paramidx)
347  elementnumber=models_variable%DOF_TO_PARAM_MAP%GAUSS_POINT_DOF2PARAM_MAP(2,dof2paramidx)
348  CASE DEFAULT
349  local_error="The DOF type of "//trim(number_to_vstring(doftype,"*",err,error))// &
350  & " for local DOF number "//trim(number_to_vstring(dofidx,"*",err,error))//" is invalid."
351  CALL flagerror(local_error,err,error,*999)
352  END SELECT
353  IF(diagnostics1) THEN
354  CALL write_string_value(diagnostic_output_type," DOF index : ",dofidx,err,error,*999)
355  CALL write_string_value(diagnostic_output_type," Model index : ",modelidx,err,error,*999)
356  CALL write_string_value(diagnostic_output_type," DOF type = ",doftype,err,error,*999)
357  SELECT CASE(doftype)
358  CASE(field_constant_interpolation)
359  !Do nothing
360  CASE(field_element_based_interpolation)
361  CALL write_string_value(diagnostic_output_type," Element number = ",elementnumber,err,error,*999)
362  CASE(field_node_based_interpolation)
363  CALL write_string_value(diagnostic_output_type," Version number = ",versionnumber,err,error,*999)
364  CALL write_string_value(diagnostic_output_type," Derivative number = ",derivativenumber, &
365  & err,error,*999)
366  CALL write_string_value(diagnostic_output_type," Node number = ",nodenumber,err,error,*999)
367  CASE(field_grid_point_based_interpolation)
368  CALL write_string_value(diagnostic_output_type," Grid number = ",gridnumber,err,error,*999)
369  CASE(field_gauss_point_based_interpolation)
370  CALL write_string_value(diagnostic_output_type," Gauss number = ",gaussnumber,err,error,*999)
371  CALL write_string_value(diagnostic_output_type," Element number = ",elementnumber,err,error,*999)
372  CASE DEFAULT
373  local_error="The DOF type of "//trim(number_to_vstring(doftype,"*",err,error))// &
374  & " for local DOF number "//trim(number_to_vstring(dofidx,"*",err,error))//" is invalid."
375  CALL flagerror(local_error,err,error,*999)
376  END SELECT
377  CALL write_string_value(diagnostic_output_type," Number of model maps = ",model_maps% &
378  & number_of_fields_mapped_to,err,error,*999)
379  ENDIF
380  !Loop over the number of CellML to field maps
381  DO map_idx=1,model_maps%NUMBER_OF_FIELDS_MAPPED_FROM
382  model_map=>model_maps%FIELDS_MAPPED_FROM(map_idx)%PTR
383  IF(ASSOCIATED(model_map)) THEN
384  !Get the CellML field DOF value
385  SELECT CASE(model_map%CELLML_FIELD_TYPE)
386  CASE(cellml_models_field)
387  CALL flagerror("Cannot map models field.",err,error,*999)
388  CASE(cellml_state_field)
389  IF(ASSOCIATED(cellml%STATE_FIELD)) THEN
390  SELECT CASE(doftype)
391  CASE(field_constant_interpolation)
392  CALL field_parameter_set_get_constant(cellml%STATE_FIELD%STATE_FIELD,field_u_variable_type, &
393  & model_map%CELLML_PARAMETER_SET,model_map%CELLML_VARIABLE_NUMBER,dofvalue,err,error,*999)
394  CASE(field_element_based_interpolation)
395  CALL field_parameter_set_get_element(cellml%STATE_FIELD%STATE_FIELD,field_u_variable_type, &
396  & model_map%CELLML_PARAMETER_SET,elementnumber,model_map%CELLML_VARIABLE_NUMBER,dofvalue, &
397  & err,error,*999)
398  CASE(field_node_based_interpolation)
399  CALL field_parametersetgetlocalnode(cellml%STATE_FIELD%STATE_FIELD,field_u_variable_type, &
400  & model_map%CELLML_PARAMETER_SET,versionnumber,derivativenumber,nodenumber, &
401  & model_map%CELLML_VARIABLE_NUMBER,dofvalue,err,error,*999)
402  CASE(field_grid_point_based_interpolation)
403  CALL flagerror("Not implemented.",err,error,*999)
404  CASE(field_gauss_point_based_interpolation)
405  CALL field_parametersetgetlocalgausspoint(cellml%STATE_FIELD%STATE_FIELD,field_u_variable_type, &
406  & model_map%CELLML_PARAMETER_SET,gaussnumber,elementnumber,model_map%CELLML_VARIABLE_NUMBER, &
407  & dofvalue,err,error,*999)
408  CASE DEFAULT
409  local_error="The DOF type of "//trim(number_to_vstring(doftype,"*",err,error))// &
410  & " for local DOF number "//trim(number_to_vstring(dofidx,"*",err,error))//" is invalid."
411  CALL flagerror(local_error,err,error,*999)
412  END SELECT
413  ELSE
414  CALL flagerror("CellML environment state field is not associated.",err,error,*999)
415  ENDIF
416  CASE(cellml_intermediate_field)
417  IF(ASSOCIATED(cellml%INTERMEDIATE_FIELD)) THEN
418  SELECT CASE(doftype)
419  CASE(field_constant_interpolation)
420  CALL field_parameter_set_get_constant(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD, &
421  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,model_map%CELLML_VARIABLE_NUMBER, &
422  & dofvalue,err,error,*999)
423  CASE(field_element_based_interpolation)
424  CALL field_parameter_set_get_element(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD, &
425  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,elementnumber, &
426  & model_map%CELLML_VARIABLE_NUMBER,dofvalue,err,error,*999)
427  CASE(field_node_based_interpolation)
428  CALL field_parametersetgetlocalnode(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD, &
429  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,versionnumber,derivativenumber,nodenumber, &
430  & model_map%CELLML_VARIABLE_NUMBER,dofvalue,err,error,*999)
431  CASE(field_grid_point_based_interpolation)
432  CALL flagerror("Not implemented.",err,error,*999)
433  CASE(field_gauss_point_based_interpolation)
434  CALL field_parametersetgetlocalgausspoint(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD, &
435  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,gaussnumber,elementnumber, &
436  & model_map%CELLML_VARIABLE_NUMBER,dofvalue,err,error,*999)
437  CASE DEFAULT
438  local_error="The DOF type of "//trim(number_to_vstring(doftype,"*",err,error))// &
439  & " for local DOF number "//trim(number_to_vstring(dofidx,"*",err,error))//" is invalid."
440  CALL flagerror(local_error,err,error,*999)
441  END SELECT
442  ELSE
443  CALL flagerror("CellML environment intermediate field is not associated.",err,error,*999)
444  ENDIF
445  CASE(cellml_parameters_field)
446  IF(ASSOCIATED(cellml%PARAMETERS_FIELD)) THEN
447  SELECT CASE(doftype)
448  CASE(field_constant_interpolation)
449  CALL field_parameter_set_get_constant(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD, &
450  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,model_map%CELLML_VARIABLE_NUMBER, &
451  & dofvalue,err,error,*999)
452  CASE(field_element_based_interpolation)
453  CALL field_parameter_set_get_element(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD,field_u_variable_type, &
454  & model_map%CELLML_PARAMETER_SET,elementnumber,model_map%CELLML_VARIABLE_NUMBER,dofvalue, &
455  & err,error,*999)
456  CASE(field_node_based_interpolation)
457  CALL field_parametersetgetlocalnode(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD,field_u_variable_type, &
458  & model_map%CELLML_PARAMETER_SET,versionnumber,derivativenumber,nodenumber, &
459  & model_map%CELLML_VARIABLE_NUMBER,dofvalue,err,error,*999)
460  CASE(field_grid_point_based_interpolation)
461  CALL flagerror("Not implemented.",err,error,*999)
462  CASE(field_gauss_point_based_interpolation)
463  CALL field_parametersetgetlocalgausspoint(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD, &
464  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,gaussnumber,elementnumber, &
465  & model_map%CELLML_VARIABLE_NUMBER,dofvalue,err,error,*999)
466  CASE DEFAULT
467  local_error="The DOF type of "//trim(number_to_vstring(doftype,"*",err,error))// &
468  & " for local DOF number "//trim(number_to_vstring(dofidx,"*",err,error))//" is invalid."
469  CALL flagerror(local_error,err,error,*999)
470  END SELECT
471  ELSE
472  CALL flagerror("CellML environment parameters field is not associated.",err,error,*999)
473  ENDIF
474  CASE DEFAULT
475  local_error="The CellML to field model map CellML field type of "// &
476  & trim(number_to_vstring(model_map%CELLML_FIELD_TYPE,"*",err,error))// &
477  & " is invalid for map index "//trim(number_to_vstring(map_idx,"*",err,error))//" of model index "// &
478  & trim(number_to_vstring(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX,"*",err,error))// &
479  & " of CellML environment number "//trim(number_to_vstring(cellml%USER_NUMBER,"*",err,error))//"."
480  CALL flagerror(local_error,err,error,*999)
481  END SELECT
482  !Update the OpenCMISS mapped field DOF value
483  SELECT CASE(doftype)
484  CASE(field_constant_interpolation)
485  CALL field_parameter_set_update_constant(model_map%FIELD,model_map%VARIABLE_TYPE, &
486  & model_map%FIELD_PARAMETER_SET,model_map%COMPONENT_NUMBER,dofvalue,err,error,*999)
487  CASE(field_element_based_interpolation)
488  CALL field_parameter_set_update_element(model_map%FIELD,model_map%VARIABLE_TYPE, &
489  & model_map%FIELD_PARAMETER_SET,elementnumber,model_map%COMPONENT_NUMBER,dofvalue, &
490  & err,error,*999)
491  CASE(field_node_based_interpolation)
492  CALL field_parameter_set_update_local_node(model_map%FIELD,model_map%VARIABLE_TYPE, &
493  & model_map%FIELD_PARAMETER_SET,versionnumber,derivativenumber,nodenumber, &
494  & model_map%COMPONENT_NUMBER,dofvalue,err,error,*999)
495  CASE(field_grid_point_based_interpolation)
496  CALL flagerror("Not implemented.",err,error,*999)
497  CASE(field_gauss_point_based_interpolation)
498  CALL field_parametersetupdategausspoint(model_map%FIELD,model_map%VARIABLE_TYPE, &
499  & model_map%FIELD_PARAMETER_SET,gaussnumber,elementnumber,model_map%COMPONENT_NUMBER, &
500  & dofvalue,err,error,*999)
501  CASE DEFAULT
502  local_error="The DOF type of "//trim(number_to_vstring(doftype,"*",err,error))// &
503  & " for local DOF number "//trim(number_to_vstring(dofidx,"*",err,error))//" is invalid."
504  CALL flagerror(local_error,err,error,*999)
505  END SELECT
506  ELSE
507  local_error="The CellML to field map is not associated for map index "// &
508  & trim(number_to_vstring(map_idx,"*",err,error))//" of model index "// &
509  & trim(number_to_vstring(modelidx,"*",err,error))//" of CellML environment number "// &
510  & trim(number_to_vstring(cellml%USER_NUMBER,"*",err,error))//"."
511  CALL flagerror(local_error,err,error,*999)
512  ENDIF
513  IF(diagnostics1) THEN
514  CALL write_string_value(diagnostic_output_type," Map index : ",map_idx,err,error,*999)
515  CALL write_string_value(diagnostic_output_type," CellML field type = ", &
516  & model_map%CELLML_FIELD_TYPE,err,error,*999)
517  CALL write_string_value(diagnostic_output_type," CellML parameter set = ", &
518  & model_map%CELLML_PARAMETER_SET,err,error,*999)
519  CALL write_string_value(diagnostic_output_type," CellML variable number = ", &
520  & model_map%CELLML_VARIABLE_NUMBER,err,error,*999)
521  CALL write_string_value(diagnostic_output_type," Field user number = ", &
522  & model_map%FIELD%USER_NUMBER,err,error,*999)
523  CALL write_string_value(diagnostic_output_type," Field variable type = ", &
524  & model_map%VARIABLE_TYPE,err,error,*999)
525  CALL write_string_value(diagnostic_output_type," Field parameter set = ", &
526  & model_map%FIELD_PARAMETER_SET,err,error,*999)
527  CALL write_string_value(diagnostic_output_type," Field component number = ", &
528  & model_map%COMPONENT_NUMBER,err,error,*999)
529  ENDIF
530  ENDDO !map_idx
531  ELSE
532  local_error="The CellML field maps models map is not associated for model index "// &
533  & trim(number_to_vstring(modelidx,"*",err,error))//" of CellML environment number "// &
534  & trim(number_to_vstring(cellml%USER_NUMBER,"*",err,error))//"."
535  CALL flagerror(local_error,err,error,*999)
536  ENDIF
537  ENDIF !modelIdx>0
538  ENDDO !dofIdx
539  CALL field_parameter_set_data_restore(models_field,field_u_variable_type,field_values_set_type, &
540  & models_data,err,error,*999)
541  ELSE
542  CALL flagerror("CellML environment models field models field is not associated.",err,error,*999)
543  ENDIF
544  ENDIF
545  ELSE
546  CALL flagerror("CellML environment field maps is not associated.",err,error,*999)
547  ENDIF
548  ELSE
549  CALL flagerror("CellML models field is not associated.",err,error,*999)
550  ENDIF
551  ELSE
552  CALL flagerror("CellML environment is not associated.",err,error,*999)
553  END IF
554 
555 #else
556 
557  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
558 
559 #endif
560 
561  exits("CELLML_CELLML_TO_FIELD_UPDATE")
562  RETURN
563 999 errorsexits("CELLML_CELLML_TO_FIELD_UPDATE",err,error)
564  RETURN 1
565  END SUBROUTINE cellml_cellml_to_field_update
566 
567  !
568  !=================================================================================================================================
569  !
570 
574  SUBROUTINE cellml_create_start(CELLML_USER_NUMBER,REGION,CELLML,ERR,ERROR,*)
575  !Argument variables
576  INTEGER(INTG), INTENT(IN) :: CELLML_USER_NUMBER
577  TYPE(region_type), POINTER, INTENT(IN) :: REGION
578  TYPE(cellml_type), POINTER :: CELLML
579  INTEGER(INTG), INTENT(OUT) :: ERR
580  TYPE(varying_string), INTENT(OUT) :: ERROR
581  !Local variables
582  INTEGER(INTG) :: cellml_idx
583  TYPE(cellml_type), POINTER :: NEW_CELLML
584  TYPE(cellml_environments_type), POINTER :: CELLML_ENVIRONMENTS
585  TYPE(cellml_ptr_type), ALLOCATABLE :: NEW_CELLML_ENVIRONMENTS(:)
586  TYPE(varying_string) :: LOCAL_ERROR
587 
588  NULLIFY(new_cellml)
589 
590  enters("CELLML_CREATE_START",err,error,*999)
591 
592 #ifdef WITH_CELLML
593 
594  IF(ASSOCIATED(region)) THEN
595  IF(ASSOCIATED(cellml)) THEN
596  CALL flagerror("CellML is already associated.",err,error,*999)
597  ELSE
598  NULLIFY(cellml)
599  CALL cellml_user_number_find(cellml_user_number,region,cellml,err,error,*999)
600  IF(ASSOCIATED(cellml)) THEN
601  local_error="CellML environment number "//trim(number_to_vstring(cellml_user_number,"*",err,error))// &
602  & " has already been created on region number "//trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
603  CALL flagerror(local_error,err,error,*999)
604  ELSE
605  cellml_environments=>region%CELLML_ENVIRONMENTS
606  IF(ASSOCIATED(cellml_environments)) THEN
607  !Allocate new cellml
608  NULLIFY(new_cellml)
609  CALL cellml_initialise(new_cellml,err,error,*999)
610  !Set cellml defaults
611  new_cellml%USER_NUMBER = cellml_user_number
612  new_cellml%GLOBAL_NUMBER = cellml_environments%NUMBER_OF_ENVIRONMENTS+1
613  new_cellml%ENVIRONMENTS => cellml_environments
614  new_cellml%REGION => region
615  !Add cellml to the list of cellml environments
616  ALLOCATE(new_cellml_environments(cellml_environments%NUMBER_OF_ENVIRONMENTS+1),stat=err)
617  IF(err/=0) CALL flagerror("Could not allocate new CellML environments.",err,error,*999)
618  DO cellml_idx=1,cellml_environments%NUMBER_OF_ENVIRONMENTS
619  new_cellml_environments(cellml_idx)%PTR=>cellml_environments%ENVIRONMENTS(cellml_idx)%PTR
620  ENDDO !cellml_idx
621  new_cellml_environments(cellml_environments%NUMBER_OF_ENVIRONMENTS+1)%PTR=>new_cellml
622  CALL move_alloc(new_cellml_environments,cellml_environments%ENVIRONMENTS)
623  cellml_environments%NUMBER_OF_ENVIRONMENTS=cellml_environments%NUMBER_OF_ENVIRONMENTS+1
624  cellml=>new_cellml
625  ELSE
626  CALL flagerror("Region CellML environments is not associated.",err,error,*999)
627  ENDIF
628  ENDIF
629  ENDIF
630  ELSE
631  CALL flagerror("Region is not associated.",err,error,*999)
632  ENDIF
633 
634 #else
635 
636  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
637 
638 #endif
639 
640  exits("CELLML_CREATE_START")
641  RETURN
642 999 IF(ALLOCATED(new_cellml_environments)) DEALLOCATE(new_cellml_environments)
643  errorsexits("CELLML_CREATE_START",err,error)
644  RETURN 1
645  END SUBROUTINE cellml_create_start
646 
647  !
648  !=================================================================================================================================
649  !
650 
654  SUBROUTINE cellml_create_finish(CELLML,ERR,ERROR,*)
655  !Argument variables
656  TYPE(cellml_type), POINTER :: CELLML
657  INTEGER(INTG), INTENT(OUT) :: ERR
658  TYPE(varying_string), INTENT(OUT) :: ERROR
659  !Local variables
660  TYPE(cellml_model_type), POINTER :: CELLML_MODEL
661  INTEGER(C_INT) :: ERROR_CODE
662  INTEGER(INTG) :: model_idx
663  TYPE(varying_string) :: LOCAL_ERROR
664 
665  enters("CELLML_CREATE_FINISH",err,error,*999)
666 
667 #ifdef WITH_CELLML
668 
669  IF(ASSOCIATED(cellml)) THEN
670  IF(cellml%CELLML_FINISHED) THEN
671  CALL flagerror("CellML environment has already been finished.",err,error,*999)
672  ELSE
673  !Check that we have set up the models
674  IF(cellml%NUMBER_OF_MODELS>0) THEN
675  DO model_idx=1,cellml%NUMBER_OF_MODELS
676  !write(*,*) 'model_idx = ',model_idx
677  cellml_model => cellml%MODELS(model_idx)%PTR
678  !CALL CELLML_MODEL_DEFINITION_SET_SAVE_TEMP_FILES(CELLML_MODEL%PTR,1)
679  error_code = cellml_model_definition_instantiate(cellml_model%PTR)
680  IF(error_code /= 0) THEN
681  local_error="Error instantiating CellML model index "//trim(number_to_vstring(model_idx,"*",err,error))//"."
682  CALL flagerror(local_error,err,error,*999)
683  ENDIF
684  cellml_model%NUMBER_OF_STATE = cellml_model_definition_get_n_rates(cellml_model%PTR)
685  IF(cellml_model%NUMBER_OF_STATE>cellml%MAXIMUM_NUMBER_OF_STATE) &
686  & cellml%MAXIMUM_NUMBER_OF_STATE=cellml_model%NUMBER_OF_STATE
687  cellml_model%NUMBER_OF_PARAMETERS = cellml_model_definition_get_n_constants(cellml_model%PTR)
688  IF(cellml_model%NUMBER_OF_PARAMETERS>cellml%MAXIMUM_NUMBER_OF_PARAMETERS) &
689  & cellml%MAXIMUM_NUMBER_OF_PARAMETERS=cellml_model%NUMBER_OF_PARAMETERS
690  cellml_model%NUMBER_OF_INTERMEDIATE = cellml_model_definition_get_n_algebraic(cellml_model%PTR)
691  IF(cellml_model%NUMBER_OF_INTERMEDIATE>cellml%MAXIMUM_NUMBER_OF_INTERMEDIATE) &
692  & cellml%MAXIMUM_NUMBER_OF_INTERMEDIATE=cellml_model%NUMBER_OF_INTERMEDIATE
693  ENDDO !model_idx
694  cellml%CELLML_FINISHED = .true.
695  ELSE
696  CALL flagerror("Invalid setup. No models have been imported into the CellML environment.",err,error,*999)
697  ENDIF
698  ENDIF
699  ELSE
700  CALL flagerror("CellML is not associated.",err,error,*999)
701  ENDIF
702 
703 #else
704 
705  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
706 
707 #endif
708 
709  exits("CELLML_CREATE_FINISH")
710  RETURN
711 999 errorsexits("CELLML_CREATE_FINISH",err,error)
712  RETURN 1
713  END SUBROUTINE cellml_create_finish
714 
715  !
716  !=================================================================================================================================
717  !
719  SUBROUTINE cellml_destroy(CELLML,ERR,ERROR,*)
720  !Argument variables
721  TYPE(cellml_type), POINTER :: CELLML
722  INTEGER(INTG), INTENT(OUT) :: ERR
723  TYPE(varying_string), INTENT(OUT) :: ERROR
724  !Local variables
725  INTEGER(INTG) :: cellml_idx,cellml_position
726  TYPE(cellml_environments_type), POINTER :: CELLML_ENVIRONMENTS
727  TYPE(cellml_ptr_type), ALLOCATABLE :: NEW_CELLML_ENVIRONMENTS(:)
728 
729  enters("CELLML_DESTROY",err,error,*999)
730 
731 #ifdef WITH_CELLML
732 
733  IF(ASSOCIATED(cellml)) THEN
734 
735  cellml_environments=>cellml%ENVIRONMENTS
736  IF(ASSOCIATED(cellml_environments)) THEN
737  cellml_position=cellml%GLOBAL_NUMBER
738  CALL cellml_finalise(cellml,err,error,*999)
739  IF(cellml_environments%NUMBER_OF_ENVIRONMENTS>1) THEN
740  ALLOCATE(new_cellml_environments(cellml_environments%NUMBER_OF_ENVIRONMENTS-1),stat=err)
741  IF(err/=0) CALL flagerror("Could not allocated new CellML environments.",err,error,*999)
742  DO cellml_idx=1,cellml_environments%NUMBER_OF_ENVIRONMENTS
743  IF(cellml_idx<cellml_position) THEN
744  new_cellml_environments(cellml_idx)%PTR=>cellml_environments%ENVIRONMENTS(cellml_idx)%PTR
745  ELSE IF(cellml_idx>cellml_position) THEN
746  cellml_environments%ENVIRONMENTS(cellml_idx)%PTR%GLOBAL_NUMBER=cellml_environments%ENVIRONMENTS(cellml_idx)% &
747  & ptr%GLOBAL_NUMBER-1
748  new_cellml_environments(cellml_idx-1)%PTR=>cellml_environments%ENVIRONMENTS(cellml_idx)%PTR
749  ENDIF
750  ENDDO !cellml_idx
751  CALL move_alloc(new_cellml_environments,cellml_environments%ENVIRONMENTS)
752  cellml_environments%NUMBER_OF_ENVIRONMENTS=cellml_environments%NUMBER_OF_ENVIRONMENTS-1
753  ELSE
754  IF(ALLOCATED(cellml_environments%ENVIRONMENTS)) DEALLOCATE(cellml_environments%ENVIRONMENTS)
755  cellml_environments%NUMBER_OF_ENVIRONMENTS=0
756  ENDIF
757  ELSE
758  CALL flagerror("CellML environments is not associated.",err,error,*999)
759  ENDIF
760  ELSE
761  CALL flagerror("CellML is not associated.",err,error,*999)
762  END IF
763 
764 #else
765 
766  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
767 
768 #endif
769 
770  exits("CELLML_DESTROY")
771  RETURN
772 999 IF(ALLOCATED(new_cellml_environments)) DEALLOCATE(new_cellml_environments)
773  errorsexits("CELLML_DESTROY",err,error)
774  RETURN 1
775 
776  END SUBROUTINE cellml_destroy
777 
778  !
779  !=================================================================================================================================
780  !
781 
782 
784  SUBROUTINE cellml_field_to_cellml_update(CELLML,ERR,ERROR,*)
785  !Argument variables
786  TYPE(cellml_type), POINTER :: CELLML
787  INTEGER(INTG), INTENT(OUT) :: ERR
788  TYPE(varying_string), INTENT(OUT) :: ERROR
789  !Local variables
790  INTEGER(INTG) :: derivativeNumber,dofIdx,dofType,dof2ParamIdx,elementNumber,gaussNumber,gridNumber,map_idx,modelIdx, &
791  & nodeNumber,versionNumber
792  INTEGER(INTG), POINTER :: MODELS_DATA(:)
793  REAL(DP) :: dofValue
794  TYPE(cellml_field_maps_type), POINTER :: FIELD_MAPS
795  TYPE(cellml_model_map_type), POINTER :: MODEL_MAP
796  TYPE(cellml_model_maps_type), POINTER :: MODEL_MAPS
797  TYPE(field_type), POINTER :: MODELS_FIELD
798  TYPE(field_variable_type), POINTER :: MODELS_VARIABLE
799  TYPE(varying_string) :: LOCAL_ERROR
800 
801  enters("CELLML_FIELD_TO_CELLML_UPDATE",err,error,*999)
802 
803 #ifdef WITH_CELLML
804 
805  IF(ASSOCIATED(cellml)) THEN
806  IF(ASSOCIATED(cellml%MODELS_FIELD)) THEN
807  field_maps=>cellml%FIELD_MAPS
808  IF(ASSOCIATED(field_maps)) THEN
809  IF(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX/=cellml_models_field_not_constant) THEN
810  !The CellML environement only uses one model and so we can optimise for this.
811  model_maps=>field_maps%MODEL_MAPS(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX)%PTR
812  IF(ASSOCIATED(model_maps)) THEN
813  IF(diagnostics1) THEN
814  CALL write_string(diagnostic_output_type,"Field to CellML update:",err,error,*999)
815  CALL write_string_value(diagnostic_output_type," CellML user number = ",cellml%USER_NUMBER,err,error,*999)
816  CALL write_string_value(diagnostic_output_type," One model index = ",cellml%MODELS_FIELD% &
817  & only_one_model_index,err,error,*999)
818  CALL write_string_value(diagnostic_output_type," Number of model maps = ",model_maps% &
819  & number_of_fields_mapped_to,err,error,*999)
820  ENDIF
821  !Loop over the number of field to CellML maps
822  DO map_idx=1,model_maps%NUMBER_OF_FIELDS_MAPPED_TO
823  model_map=>model_maps%FIELDS_MAPPED_TO(map_idx)%PTR
824  IF(ASSOCIATED(model_map)) THEN
825  SELECT CASE(model_map%CELLML_FIELD_TYPE)
826  CASE(cellml_models_field)
827  CALL flagerror("Cannot map models field.",err,error,*999)
828  CASE(cellml_state_field)
829  IF(ASSOCIATED(cellml%STATE_FIELD)) THEN
830  CALL field_parameterstofieldparameterscopy(model_map%FIELD,model_map%VARIABLE_TYPE, &
831  & model_map%FIELD_PARAMETER_SET,model_map%COMPONENT_NUMBER,cellml%STATE_FIELD%STATE_FIELD, &
832  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,model_map%CELLML_VARIABLE_NUMBER,err,error,*999)
833  ELSE
834  CALL flagerror("CellML environment state field is not associated.",err,error,*999)
835  ENDIF
836  CASE(cellml_intermediate_field)
837  IF(ASSOCIATED(cellml%INTERMEDIATE_FIELD)) THEN
838  CALL field_parameterstofieldparameterscopy(model_map%FIELD,model_map%VARIABLE_TYPE, &
839  & model_map%FIELD_PARAMETER_SET,model_map%COMPONENT_NUMBER,cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD, &
840  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,model_map%CELLML_VARIABLE_NUMBER,err,error,*999)
841  ELSE
842  CALL flagerror("CellML environment intermediate field is not associated.",err,error,*999)
843  ENDIF
844  CASE(cellml_parameters_field)
845  IF(ASSOCIATED(cellml%PARAMETERS_FIELD)) THEN
846  CALL field_parameterstofieldparameterscopy(model_map%FIELD,model_map%VARIABLE_TYPE, &
847  & model_map%FIELD_PARAMETER_SET,model_map%COMPONENT_NUMBER,cellml%PARAMETERS_FIELD%PARAMETERS_FIELD, &
848  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,model_map%CELLML_VARIABLE_NUMBER,err,error,*999)
849  ELSE
850  CALL flagerror("CellML environment parameters field is not associated.",err,error,*999)
851  ENDIF
852  CASE DEFAULT
853  local_error="The CellML to field model map CellML field type of "// &
854  & trim(number_to_vstring(model_map%CELLML_FIELD_TYPE,"*",err,error))// &
855  & " is invalid for map index "//trim(number_to_vstring(map_idx,"*",err,error))//" of model index "// &
856  & trim(number_to_vstring(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX,"*",err,error))// &
857  & " of CellML environment number "//trim(number_to_vstring(cellml%USER_NUMBER,"*",err,error))//"."
858  CALL flagerror(local_error,err,error,*999)
859  END SELECT
860  ELSE
861  local_error="The CellML to field map is not associated for map index "// &
862  & trim(number_to_vstring(map_idx,"*",err,error))//" of model index "// &
863  & trim(number_to_vstring(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX,"*",err,error))// &
864  & " of CellML environment number "//trim(number_to_vstring(cellml%USER_NUMBER,"*",err,error))//"."
865  CALL flagerror(local_error,err,error,*999)
866  ENDIF
867  IF(diagnostics1) THEN
868  CALL write_string_value(diagnostic_output_type," Map index : ",map_idx,err,error,*999)
869  CALL write_string_value(diagnostic_output_type," Field user number = ",model_map%FIELD%USER_NUMBER, &
870  & err,error,*999)
871  CALL write_string_value(diagnostic_output_type," Field variable type = ",model_map%VARIABLE_TYPE, &
872  & err,error,*999)
873  CALL write_string_value(diagnostic_output_type," Field parameter set = ",model_map%FIELD_PARAMETER_SET, &
874  & err,error,*999)
875  CALL write_string_value(diagnostic_output_type," Field component number = ",model_map%COMPONENT_NUMBER, &
876  & err,error,*999)
877  CALL write_string_value(diagnostic_output_type," CellML field type = ",model_map%CELLML_FIELD_TYPE, &
878  & err,error,*999)
879  CALL write_string_value(diagnostic_output_type," CellML parameter set = ",model_map%CELLML_PARAMETER_SET, &
880  & err,error,*999)
881  CALL write_string_value(diagnostic_output_type," CellML variable number = ",model_map%CELLML_VARIABLE_NUMBER, &
882  & err,error,*999)
883  ENDIF
884  ENDDO !map_idx
885  ELSE
886  local_error="The CellML field maps models map is not associated for model index "// &
887  & trim(number_to_vstring(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX,"*",err,error))// &
888  & " of CellML environment number "//trim(number_to_vstring(cellml%USER_NUMBER,"*",err,error))//"."
889  CALL flagerror(local_error,err,error,*999)
890  ENDIF
891  ELSE
892  !More than one model is used in the models field
893  models_field=>cellml%MODELS_FIELD%MODELS_FIELD
894  IF(ASSOCIATED(models_field)) THEN
895  NULLIFY(models_variable)
896  CALL field_variable_get(models_field,field_u_variable_type,models_variable,err,error,*999)
897  NULLIFY(models_data)
898  CALL field_parameter_set_data_get(models_field,field_u_variable_type,field_values_set_type, &
899  & models_data,err,error,*999)
900  IF(diagnostics1) THEN
901  CALL write_string(diagnostic_output_type,"Field to CellML update:",err,error,*999)
902  CALL write_string_value(diagnostic_output_type," CellML user number = ",cellml%USER_NUMBER,err,error,*999)
903  ENDIF
904  !Loop over the dofs in the models field
905  DO dofidx=1,models_variable%TOTAL_NUMBER_OF_DOFS
906  modelidx=models_data(dofidx)
907  IF(modelidx>0) THEN
908  model_maps=>field_maps%MODEL_MAPS(modelidx)%PTR
909  IF(ASSOCIATED(model_maps)) THEN
910  doftype=models_variable%DOF_TO_PARAM_MAP%DOF_TYPE(1,dofidx)
911  dof2paramidx=models_variable%DOF_TO_PARAM_MAP%DOF_TYPE(2,dofidx)
912  SELECT CASE(doftype)
913  CASE(field_constant_interpolation)
914  !Do nothing
915  CASE(field_element_based_interpolation)
916  elementnumber=models_variable%DOF_TO_PARAM_MAP%ELEMENT_DOF2PARAM_MAP(1,dof2paramidx)
917  CASE(field_node_based_interpolation)
918  versionnumber=models_variable%DOF_TO_PARAM_MAP%NODE_DOF2PARAM_MAP(1,dof2paramidx)
919  derivativenumber=models_variable%DOF_TO_PARAM_MAP%NODE_DOF2PARAM_MAP(2,dof2paramidx)
920  nodenumber=models_variable%DOF_TO_PARAM_MAP%NODE_DOF2PARAM_MAP(3,dof2paramidx)
921  CASE(field_grid_point_based_interpolation)
922  gridnumber=models_variable%DOF_TO_PARAM_MAP%GRID_POINT_DOF2PARAM_MAP(1,dof2paramidx)
923  CASE(field_gauss_point_based_interpolation)
924  gaussnumber=models_variable%DOF_TO_PARAM_MAP%GAUSS_POINT_DOF2PARAM_MAP(1,dof2paramidx)
925  elementnumber=models_variable%DOF_TO_PARAM_MAP%GAUSS_POINT_DOF2PARAM_MAP(2,dof2paramidx)
926  CASE DEFAULT
927  local_error="The DOF type of "//trim(number_to_vstring(doftype,"*",err,error))// &
928  & " for local DOF number "//trim(number_to_vstring(dofidx,"*",err,error))//" is invalid."
929  CALL flagerror(local_error,err,error,*999)
930  END SELECT
931  IF(diagnostics1) THEN
932  CALL write_string_value(diagnostic_output_type," DOF index : ",dofidx,err,error,*999)
933  CALL write_string_value(diagnostic_output_type," Model index : ",modelidx,err,error,*999)
934  CALL write_string_value(diagnostic_output_type," DOF type = ",doftype,err,error,*999)
935  SELECT CASE(doftype)
936  CASE(field_constant_interpolation)
937  !Do nothing
938  CASE(field_element_based_interpolation)
939  CALL write_string_value(diagnostic_output_type," Element number = ",elementnumber,err,error,*999)
940  CASE(field_node_based_interpolation)
941  CALL write_string_value(diagnostic_output_type," Version number = ",versionnumber,err,error,*999)
942  CALL write_string_value(diagnostic_output_type," Derivative number = ",derivativenumber, &
943  & err,error,*999)
944  CALL write_string_value(diagnostic_output_type," Node number = ",nodenumber,err,error,*999)
945  CASE(field_grid_point_based_interpolation)
946  CALL write_string_value(diagnostic_output_type," Grid number = ",gridnumber,err,error,*999)
947  CASE(field_gauss_point_based_interpolation)
948  CALL write_string_value(diagnostic_output_type," Gauss number = ",gaussnumber,err,error,*999)
949  CALL write_string_value(diagnostic_output_type," Element number = ",elementnumber,err,error,*999)
950  CASE DEFAULT
951  local_error="The DOF type of "//trim(number_to_vstring(doftype,"*",err,error))// &
952  & " for local DOF number "//trim(number_to_vstring(dofidx,"*",err,error))//" is invalid."
953  CALL flagerror(local_error,err,error,*999)
954  END SELECT
955  CALL write_string_value(diagnostic_output_type," Number of model maps = ",model_maps% &
956  & number_of_fields_mapped_to,err,error,*999)
957  ENDIF
958  !Loop over the number of field to CellML maps
959  DO map_idx=1,model_maps%NUMBER_OF_FIELDS_MAPPED_TO
960  model_map=>model_maps%FIELDS_MAPPED_TO(map_idx)%PTR
961  IF(ASSOCIATED(model_map)) THEN
962  !Get the OpenCMISS mapped field DOF value
963  SELECT CASE(doftype)
964  CASE(field_constant_interpolation)
965  CALL field_parameter_set_get_constant(model_map%FIELD,model_map%VARIABLE_TYPE, &
966  & model_map%FIELD_PARAMETER_SET,model_map%COMPONENT_NUMBER,dofvalue,err,error,*999)
967  CASE(field_element_based_interpolation)
968  CALL field_parameter_set_get_element(model_map%FIELD,model_map%VARIABLE_TYPE, &
969  & model_map%FIELD_PARAMETER_SET,elementnumber,model_map%COMPONENT_NUMBER,dofvalue, &
970  & err,error,*999)
971  CASE(field_node_based_interpolation)
972  CALL field_parametersetgetlocalnode(model_map%FIELD,model_map%VARIABLE_TYPE, &
973  & model_map%FIELD_PARAMETER_SET,versionnumber,derivativenumber,nodenumber, &
974  & model_map%COMPONENT_NUMBER,dofvalue,err,error,*999)
975  CASE(field_grid_point_based_interpolation)
976  CALL flagerror("Not implemented.",err,error,*999)
977  CASE(field_gauss_point_based_interpolation)
978  CALL field_parametersetgetlocalgausspoint(model_map%FIELD,model_map%VARIABLE_TYPE, &
979  & model_map%FIELD_PARAMETER_SET,gaussnumber,elementnumber, &
980  & model_map%COMPONENT_NUMBER,dofvalue,err,error,*999)
981  CASE DEFAULT
982  local_error="The DOF type of "//trim(number_to_vstring(doftype,"*",err,error))// &
983  & " for local DOF number "//trim(number_to_vstring(dofidx,"*",err,error))//" is invalid."
984  CALL flagerror(local_error,err,error,*999)
985  END SELECT
986  !Update the CellML field DOF value
987  SELECT CASE(model_map%CELLML_FIELD_TYPE)
988  CASE(cellml_models_field)
989  CALL flagerror("Cannot map models field.",err,error,*999)
990  CASE(cellml_state_field)
991  IF(ASSOCIATED(cellml%STATE_FIELD)) THEN
992  SELECT CASE(doftype)
993  CASE(field_constant_interpolation)
994  CALL field_parameter_set_update_constant(cellml%STATE_FIELD%STATE_FIELD,field_u_variable_type, &
995  & model_map%CELLML_PARAMETER_SET,model_map%CELLML_VARIABLE_NUMBER,dofvalue,err,error,*999)
996  CASE(field_element_based_interpolation)
997  CALL field_parameter_set_update_element(cellml%STATE_FIELD%STATE_FIELD,field_u_variable_type, &
998  & model_map%CELLML_PARAMETER_SET,elementnumber,model_map%CELLML_VARIABLE_NUMBER,dofvalue, &
999  & err,error,*999)
1000  CASE(field_node_based_interpolation)
1001  CALL field_parameter_set_update_local_node(cellml%STATE_FIELD%STATE_FIELD,field_u_variable_type, &
1002  & model_map%CELLML_PARAMETER_SET,versionnumber,derivativenumber,nodenumber, &
1003  & model_map%CELLML_VARIABLE_NUMBER,dofvalue,err,error,*999)
1004  CASE(field_grid_point_based_interpolation)
1005  CALL flagerror("Not implemented.",err,error,*999)
1006  CASE(field_gauss_point_based_interpolation)
1007  CALL field_parametersetupdategausspoint(cellml%STATE_FIELD%STATE_FIELD,field_u_variable_type, &
1008  & model_map%CELLML_PARAMETER_SET,gaussnumber,elementnumber,model_map%CELLML_VARIABLE_NUMBER, &
1009  & dofvalue,err,error,*999)
1010  CASE DEFAULT
1011  local_error="The DOF type of "//trim(number_to_vstring(doftype,"*",err,error))// &
1012  & " for local DOF number "//trim(number_to_vstring(dofidx,"*",err,error))//" is invalid."
1013  CALL flagerror(local_error,err,error,*999)
1014  END SELECT
1015  ELSE
1016  CALL flagerror("CellML environment state field is not associated.",err,error,*999)
1017  ENDIF
1018  CASE(cellml_intermediate_field)
1019  IF(ASSOCIATED(cellml%INTERMEDIATE_FIELD)) THEN
1020  SELECT CASE(doftype)
1021  CASE(field_constant_interpolation)
1022  CALL field_parameter_set_update_constant(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD, &
1023  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,model_map%CELLML_VARIABLE_NUMBER, &
1024  & dofvalue,err,error,*999)
1025  CASE(field_element_based_interpolation)
1026  CALL field_parameter_set_update_element(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD, &
1027  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,elementnumber, &
1028  & model_map%CELLML_VARIABLE_NUMBER,dofvalue,err,error,*999)
1029  CASE(field_node_based_interpolation)
1030  CALL field_parameter_set_update_local_node(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD, &
1031  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,versionnumber,derivativenumber,nodenumber, &
1032  & model_map%CELLML_VARIABLE_NUMBER,dofvalue,err,error,*999)
1033  CASE(field_grid_point_based_interpolation)
1034  CALL flagerror("Not implemented.",err,error,*999)
1035  CASE(field_gauss_point_based_interpolation)
1036  CALL field_parametersetupdategausspoint(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD, &
1037  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,gaussnumber,elementnumber, &
1038  & model_map%CELLML_VARIABLE_NUMBER,dofvalue,err,error,*999)
1039  CASE DEFAULT
1040  local_error="The DOF type of "//trim(number_to_vstring(doftype,"*",err,error))// &
1041  & " for local DOF number "//trim(number_to_vstring(dofidx,"*",err,error))//" is invalid."
1042  CALL flagerror(local_error,err,error,*999)
1043  END SELECT
1044  ELSE
1045  CALL flagerror("CellML environment intermediate field is not associated.",err,error,*999)
1046  ENDIF
1047  CASE(cellml_parameters_field)
1048  IF(ASSOCIATED(cellml%PARAMETERS_FIELD)) THEN
1049  SELECT CASE(doftype)
1050  CASE(field_constant_interpolation)
1051  CALL field_parameter_set_update_constant(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD, &
1052  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,model_map%CELLML_VARIABLE_NUMBER, &
1053  & dofvalue,err,error,*999)
1054  CASE(field_element_based_interpolation)
1055  CALL field_parameter_set_update_element(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD, &
1056  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,elementnumber, &
1057  & model_map%CELLML_VARIABLE_NUMBER,dofvalue,err,error,*999)
1058  CASE(field_node_based_interpolation)
1059  CALL field_parameter_set_update_local_node(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD, &
1060  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,versionnumber,derivativenumber,nodenumber, &
1061  & model_map%CELLML_VARIABLE_NUMBER,dofvalue,err,error,*999)
1062  CASE(field_grid_point_based_interpolation)
1063  CALL flagerror("Not implemented.",err,error,*999)
1064  CASE(field_gauss_point_based_interpolation)
1065  CALL field_parametersetupdategausspoint(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD, &
1066  & field_u_variable_type,model_map%CELLML_PARAMETER_SET,gaussnumber,elementnumber, &
1067  & model_map%CELLML_VARIABLE_NUMBER,dofvalue,err,error,*999)
1068  CASE DEFAULT
1069  local_error="The DOF type of "//trim(number_to_vstring(doftype,"*",err,error))// &
1070  & " for local DOF number "//trim(number_to_vstring(dofidx,"*",err,error))//" is invalid."
1071  CALL flagerror(local_error,err,error,*999)
1072  END SELECT
1073  ELSE
1074  CALL flagerror("CellML environment parameters field is not associated.",err,error,*999)
1075  ENDIF
1076  CASE DEFAULT
1077  local_error="The CellML to field model map CellML field type of "// &
1078  & trim(number_to_vstring(model_map%CELLML_FIELD_TYPE,"*",err,error))// &
1079  & " is invalid for map index "//trim(number_to_vstring(map_idx,"*",err,error))//" of model index "// &
1080  & trim(number_to_vstring(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX,"*",err,error))// &
1081  & " of CellML environment number "//trim(number_to_vstring(cellml%USER_NUMBER,"*",err,error))//"."
1082  CALL flagerror(local_error,err,error,*999)
1083  END SELECT
1084  ELSE
1085  local_error="The CellML to field map is not associated for map index "// &
1086  & trim(number_to_vstring(map_idx,"*",err,error))//" of model index "// &
1087  & trim(number_to_vstring(modelidx,"*",err,error))//" of CellML environment number "// &
1088  & trim(number_to_vstring(cellml%USER_NUMBER,"*",err,error))//"."
1089  CALL flagerror(local_error,err,error,*999)
1090  ENDIF
1091  IF(diagnostics1) THEN
1092  CALL write_string_value(diagnostic_output_type," Map index : ",map_idx,err,error,*999)
1093  CALL write_string_value(diagnostic_output_type," CellML field type = ", &
1094  & model_map%CELLML_FIELD_TYPE,err,error,*999)
1095  CALL write_string_value(diagnostic_output_type," CellML parameter set = ", &
1096  & model_map%CELLML_PARAMETER_SET,err,error,*999)
1097  CALL write_string_value(diagnostic_output_type," CellML variable number = ", &
1098  & model_map%CELLML_VARIABLE_NUMBER,err,error,*999)
1099  CALL write_string_value(diagnostic_output_type," Field user number = ", &
1100  & model_map%FIELD%USER_NUMBER,err,error,*999)
1101  CALL write_string_value(diagnostic_output_type," Field variable type = ", &
1102  & model_map%VARIABLE_TYPE,err,error,*999)
1103  CALL write_string_value(diagnostic_output_type," Field parameter set = ", &
1104  & model_map%FIELD_PARAMETER_SET,err,error,*999)
1105  CALL write_string_value(diagnostic_output_type," Field component number = ", &
1106  & model_map%COMPONENT_NUMBER,err,error,*999)
1107  ENDIF
1108  ENDDO !map_idx
1109  ELSE
1110  local_error="The CellML field maps models map is not associated for model index "// &
1111  & trim(number_to_vstring(modelidx,"*",err,error))//" of CellML environment number "// &
1112  & trim(number_to_vstring(cellml%USER_NUMBER,"*",err,error))//"."
1113  CALL flagerror(local_error,err,error,*999)
1114  ENDIF
1115  ENDIF !modelIdx>0
1116  ENDDO !dofIdx
1117  CALL field_parameter_set_data_restore(models_field,field_u_variable_type,field_values_set_type, &
1118  & models_data,err,error,*999)
1119  ELSE
1120  CALL flagerror("CellML environment models field models field is not associated.",err,error,*999)
1121  ENDIF
1122  ENDIF
1123  ELSE
1124  CALL flagerror("CellML environment field maps is not associated.",err,error,*999)
1125  ENDIF
1126  ELSE
1127  CALL flagerror("CellML environment models field is not associated.",err,error,*999)
1128  ENDIF
1129  ELSE
1130  CALL flagerror("CellML environment is not associated.",err,error,*999)
1131  END IF
1132 
1133 #else
1134 
1135  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1136 
1137 #endif
1138 
1139  exits("CELLML_FIELD_TO_CELLML_UPDATE")
1140  RETURN
1141 999 errorsexits("CELLML_FIELD_TO_CELLML_UPDATE",err,error)
1142  RETURN 1
1143  END SUBROUTINE cellml_field_to_cellml_update
1144 
1145  !
1146  !=================================================================================================================================
1147  !
1148 
1150  SUBROUTINE cellml_finalise(CELLML,ERR,ERROR,*)
1151  !Argument variables
1152  TYPE(cellml_type), POINTER :: CELLML
1153  INTEGER(INTG), INTENT(OUT) :: ERR
1154  TYPE(varying_string), INTENT(OUT) :: ERROR
1155  !Local variables
1156  INTEGER(INTG) :: model_idx
1157 
1158  enters("CELLML_FINALISE",err,error,*999)
1159 
1160 #ifdef WITH_CELLML
1161 
1162  IF(ASSOCIATED(cellml)) THEN
1163  IF(ALLOCATED(cellml%MODELS)) THEN
1164  DO model_idx=1,SIZE(cellml%MODELS,1)
1165  CALL cellml_model_finalise(cellml%MODELS(model_idx)%PTR,err,error,*999)
1166  ENDDO !model_idx
1167  DEALLOCATE(cellml%MODELS)
1168  ENDIF
1169  CALL cellml_field_maps_finalise(cellml%FIELD_MAPS,err,error,*999)
1170  CALL cellml_models_field_finalise(cellml%MODELS_FIELD,err,error,*999)
1171  CALL cellml_state_field_finalise(cellml%STATE_FIELD,err,error,*999)
1172  CALL cellml_intermediate_field_finalise(cellml%INTERMEDIATE_FIELD,err,error,*999)
1173  CALL cellml_parameters_field_finalise(cellml%PARAMETERS_FIELD,err,error,*999)
1174  DEALLOCATE(cellml)
1175  ENDIF
1176 
1177 #else
1178 
1179  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1180 
1181 #endif
1182 
1183  exits("CELLML_FINALISE")
1184  RETURN
1185 999 errorsexits("CELLML_FINALISE",err,error)
1186  RETURN 1
1187  END SUBROUTINE cellml_finalise
1188 
1189  !
1190  !=================================================================================================================================
1191  !
1192 
1194  SUBROUTINE cellml_initialise(CELLML,ERR,ERROR,*)
1195  !Argument variables
1196  TYPE(cellml_type), POINTER :: CELLML
1197  INTEGER(INTG), INTENT(OUT) :: ERR
1198  TYPE(varying_string), INTENT(OUT) :: ERROR
1199  !Local variables
1200  INTEGER(INTG) :: DUMMY_ERR
1201  TYPE(varying_string) :: DUMMY_ERROR
1202 
1203  enters("CELLML_INITIALISE",err,error,*998)
1204 
1205 #ifdef WITH_CELLML
1206 
1207  IF(ASSOCIATED(cellml)) THEN
1208  CALL flagerror("CellML environment is already associated.",err,error,*998)
1209  ELSE
1210  ALLOCATE(cellml,stat=err)
1211  IF(err/=0) CALL flagerror("Could not allocate CellML environment.",err,error,*999)
1212  cellml%GLOBAL_NUMBER=0
1213  cellml%USER_NUMBER=0
1214  NULLIFY(cellml%REGION)
1215  NULLIFY(cellml%ENVIRONMENTS)
1216  cellml%CELLML_FINISHED=.false.
1217  cellml%NUMBER_OF_MODELS=0
1218  cellml%MAXIMUM_NUMBER_OF_STATE=0
1219  cellml%MAXIMUM_NUMBER_OF_PARAMETERS=0
1220  cellml%MAXIMUM_NUMBER_OF_INTERMEDIATE=0
1221  NULLIFY(cellml%FIELD_MAPS)
1222  NULLIFY(cellml%MODELS_FIELD)
1223  NULLIFY(cellml%STATE_FIELD)
1224  NULLIFY(cellml%INTERMEDIATE_FIELD)
1225  NULLIFY(cellml%PARAMETERS_FIELD)
1226  cellml%CELLML_GENERATED=.false.
1227  ENDIF
1228 
1229 #else
1230 
1231  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*998)
1232 
1233 #endif
1234 
1235  exits("CELLML_INITIALISE")
1236  RETURN
1237 999 CALL cellml_finalise(cellml,dummy_err,dummy_error,*998)
1238 998 errorsexits("CELLML_INITIALISE",err,error)
1239  RETURN 1
1240  END SUBROUTINE cellml_initialise
1241 
1242  !
1243  !=================================================================================================================================
1244  !
1245 
1247  SUBROUTINE cellml_field_maps_create_finish(CELLML,ERR,ERROR,*)
1248 
1249  !Argument variables
1250  TYPE(cellml_type), POINTER :: CELLML
1251  INTEGER(INTG), INTENT(OUT) :: ERR
1252  TYPE(varying_string), INTENT(OUT) :: ERROR
1253  !Local variables
1254  INTEGER(INTG) :: model_idx
1255  TYPE(cellml_model_maps_type), POINTER :: CELLML_MODEL_MAPS
1256  TYPE(varying_string) :: LOCAL_ERROR
1257 
1258  enters("CELLML_FIELD_MAPS_CREATE_FINISH",err,error,*999)
1259 
1260 #ifdef WITH_CELLML
1261 
1262  IF(ASSOCIATED(cellml)) THEN
1263  IF(cellml%CELLML_FINISHED) THEN
1264  IF(ASSOCIATED(cellml%FIELD_MAPS)) THEN
1265  IF(cellml%FIELD_MAPS%CELLML_FIELD_MAPS_FINISHED) THEN
1266  CALL flagerror("The CellML environment field maps have already been finished.",err,error,*999)
1267  ELSE
1268  !Check that each model has field mappings
1269  DO model_idx=1,cellml%NUMBER_OF_MODELS
1270  cellml_model_maps=>cellml%FIELD_MAPS%MODEL_MAPS(model_idx)%PTR
1271  IF(ASSOCIATED(cellml_model_maps)) THEN
1272  IF(cellml_model_maps%NUMBER_OF_FIELDS_MAPPED_TO==0.AND.cellml_model_maps%NUMBER_OF_FIELDS_MAPPED_FROM==0) THEN
1273  local_error="Invalid setup. CellML model index "//trim(number_to_vstring(model_idx,"*",err,error))// &
1274  & " does not have any mappings to or from a field."
1275  CALL flagerror(local_error,err,error,*999)
1276  ENDIF
1277  ELSE
1278  local_error="CellML field maps model maps is not associated for model index "// &
1279  & trim(number_to_vstring(model_idx,"*",err,error))//"."
1280  CALL flagerror(local_error,err,error,*999)
1281  ENDIF
1282  ENDDO !model_idx
1283  cellml%FIELD_MAPS%CELLML_FIELD_MAPS_FINISHED=.true.
1284  ENDIF
1285  ELSE
1286  CALL flagerror("CellML environment field maps is not associated.",err,error,*999)
1287  ENDIF
1288  ELSE
1289  CALL flagerror("CellML environment has not been finished.",err,error,*999)
1290  ENDIF
1291  ELSE
1292  CALL flagerror("CellML is not associated.",err,error,*999)
1293  ENDIF
1294 
1295 #else
1296 
1297  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1298 
1299 #endif
1300 
1301  exits("CELLML_FIELD_MAPS_CREATE_FINISH")
1302  RETURN
1303 999 errorsexits("CELLML_FIELD_MAPS_CREATE_FINISH",err,error)
1304  RETURN 1
1305  END SUBROUTINE cellml_field_maps_create_finish
1306 
1307  !
1308  !=================================================================================================================================
1309  !
1310 
1312  SUBROUTINE cellml_field_maps_create_start(CELLML,ERR,ERROR,*)
1313 
1314  !Argument variables
1315  TYPE(cellml_type), POINTER :: CELLML
1316  INTEGER(INTG), INTENT(OUT) :: ERR
1317  TYPE(varying_string), INTENT(OUT) :: ERROR
1318  !Local variables
1319 
1320  enters("CELLML_FIELD_MAPS_CREATE_START",err,error,*999)
1321 
1322 #ifdef WITH_CELLML
1323 
1324  IF(ASSOCIATED(cellml)) THEN
1325  IF(cellml%CELLML_FINISHED) THEN
1326  !Initialise the field maps
1327  CALL cellml_field_maps_initialise(cellml,err,error,*999)
1328  ELSE
1329  CALL flagerror("CellML environment has not been finished.",err,error,*999)
1330  ENDIF
1331  ELSE
1332  CALL flagerror("CellML is not associated.",err,error,*999)
1333  ENDIF
1334 
1335 #else
1336 
1337  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1338 
1339 #endif
1340 
1341  exits("CELLML_FIELD_MAPS_CREATE_START")
1342  RETURN
1343 999 errorsexits("CELLML_FIELD_MAPS_CREATE_START",err,error)
1344  RETURN 1
1345  END SUBROUTINE cellml_field_maps_create_start
1346 
1347  !
1348  !=================================================================================================================================
1349  !
1350 
1352  SUBROUTINE cellml_field_maps_finalise(CELLML_FIELD_MAPS,ERR,ERROR,*)
1353  !Argument variables
1354  TYPE(cellml_field_maps_type), POINTER :: CELLML_FIELD_MAPS
1355  INTEGER(INTG), INTENT(OUT) :: ERR
1356  TYPE(varying_string), INTENT(OUT) :: ERROR
1357  !Local variables
1358  INTEGER(INTG) :: model_idx
1359 
1360  enters("CELLML_FIELD_MAPS_FINALISE",err,error,*999)
1361 
1362 #ifdef WITH_CELLML
1363 
1364  IF(ASSOCIATED(cellml_field_maps)) THEN
1365  IF(ALLOCATED(cellml_field_maps%MODEL_MAPS)) THEN
1366  DO model_idx=1,SIZE(cellml_field_maps%MODEL_MAPS,1)
1367  CALL cellml_model_maps_finalise(cellml_field_maps%MODEL_MAPS(model_idx)%PTR,err,error,*999)
1368  ENDDO !model_idx
1369  DEALLOCATE(cellml_field_maps%MODEL_MAPS)
1370  ENDIF
1371  DEALLOCATE(cellml_field_maps)
1372  ENDIF
1373 
1374 #else
1375 
1376  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1377 
1378 #endif
1379 
1380  exits("CELLML_FIELD_MAPS_FINALISE")
1381  RETURN
1382 999 errorsexits("CELLML_FIELD_MAPS_FINALISE",err,error)
1383  RETURN 1
1384  END SUBROUTINE cellml_field_maps_finalise
1385 
1386  !
1387  !=================================================================================================================================
1388  !
1389 
1391  SUBROUTINE cellml_field_maps_initialise(CELLML,ERR,ERROR,*)
1392 
1393  !Argument variables
1394  TYPE(cellml_type), POINTER :: CELLML
1395  INTEGER(INTG), INTENT(OUT) :: ERR
1396  TYPE(varying_string), INTENT(OUT) :: ERROR
1397  !Local variables
1398  INTEGER(INTG) :: DUMMY_ERR,model_idx
1399  TYPE(varying_string) :: DUMMY_ERROR
1400 
1401  enters("CELLML_FIELD_MAPS_INITIALISE",err,error,*998)
1402 
1403 #ifdef WITH_CELLML
1404 
1405  IF(ASSOCIATED(cellml)) THEN
1406  IF(ASSOCIATED(cellml%FIELD_MAPS)) THEN
1407  CALL flagerror("CellML environment field maps is already associated.",err,error,*999)
1408  ELSE
1409  IF(cellml%CELLML_FINISHED) THEN
1410  ALLOCATE(cellml%FIELD_MAPS,stat=err)
1411  IF(err/=0) CALL flagerror("Could not allocate CellML field maps.",err,error,*999)
1412  cellml%FIELD_MAPS%CELLML=>cellml
1413  cellml%FIELD_MAPS%CELLML_FIELD_MAPS_FINISHED=.false.
1414  NULLIFY(cellml%FIELD_MAPS%SOURCE_GEOMETRIC_FIELD)
1415  NULLIFY(cellml%FIELD_MAPS%SOURCE_FIELD_VARIABLE)
1416  NULLIFY(cellml%FIELD_MAPS%SOURCE_FIELD_DOMAIN)
1417  cellml%FIELD_MAPS%SOURCE_FIELD_INTERPOLATION_TYPE=0
1418  !CELLML%FIELD_MAPS%NUMBER_OF_SOURCE_DOFS=0
1419  !CELLML%FIELD_MAPS%TOTAL_NUMBER_OF_SOURCE_DOFS=0
1420  !CELLML%FIELD_MAPS%GLOBAL_NUMBER_OF_SOURCE_DOFS=0
1421  ALLOCATE(cellml%FIELD_MAPS%MODEL_MAPS(cellml%NUMBER_OF_MODELS),stat=err)
1422  IF(err/=0) CALL flagerror("Could not allocate CellML environment field maps model maps.",err,error,*999)
1423  DO model_idx=1,cellml%NUMBER_OF_MODELS
1424  NULLIFY(cellml%FIELD_MAPS%MODEL_MAPS(model_idx)%PTR)
1425  CALL cellml_model_maps_initialise(cellml%FIELD_MAPS%MODEL_MAPS(model_idx)%PTR,err,error,*999)
1426  ENDDO !model_idx
1427  ELSE
1428  CALL flagerror("CellML environment has not been finished.",err,error,*999)
1429  ENDIF
1430  ENDIF
1431  ELSE
1432  CALL flagerror("CellML environement is not associated.",err,error,*999)
1433  ENDIF
1434 
1435 #else
1436 
1437  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*998)
1438 
1439 #endif
1440 
1441  exits("CELLML_FIELD_MAPS_INITIALISE")
1442  RETURN
1443 999 CALL cellml_field_maps_finalise(cellml%FIELD_MAPS,dummy_err,dummy_error,*998)
1444 998 errorsexits("CELLML_FIELD_MAPS_INITIALISE",err,error)
1445  RETURN 1
1446  END SUBROUTINE cellml_field_maps_initialise
1447 
1448  !
1449  !=================================================================================================================================
1450  !
1451 
1453  SUBROUTINE cellml_model_finalise(CELLML_MODEL,ERR,ERROR,*)
1454  !Argument variables
1455  TYPE(cellml_model_type), POINTER :: CELLML_MODEL
1456  INTEGER(INTG), INTENT(OUT) :: ERR
1457  TYPE(varying_string), INTENT(OUT) :: ERROR
1458  !Local variables
1459 
1460  enters("CELLML_MODEL_FINALISE",err,error,*999)
1461 
1462 #ifdef WITH_CELLML
1463 
1464  IF(ASSOCIATED(cellml_model)) THEN
1465  IF(c_associated(cellml_model%PTR)) CALL destroy_cellml_model_definition(cellml_model%PTR)
1466  cellml_model%MODEL_ID=""
1467  DEALLOCATE(cellml_model)
1468  ENDIF
1469 
1470 #else
1471 
1472  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1473 
1474 #endif
1475 
1476  exits("CELLML_MODEL_FINALISE")
1477  RETURN
1478 999 errorsexits("CELLML_MODEL_FINALISE",err,error)
1479  RETURN 1
1480  END SUBROUTINE cellml_model_finalise
1481 
1482  !
1483  !=================================================================================================================================
1484  !
1485 
1487  SUBROUTINE cellml_model_initialise(CELLML_MODEL,ERR,ERROR,*)
1488 
1489  !Argument variables
1490  TYPE(cellml_model_type), POINTER :: CELLML_MODEL
1491  INTEGER(INTG), INTENT(OUT) :: ERR
1492  TYPE(varying_string), INTENT(OUT) :: ERROR
1493  !Local variables
1494  INTEGER(INTG) :: DUMMY_ERR
1495  TYPE(varying_string) :: DUMMY_ERROR
1496 
1497  enters("CELLML_MODEL_INITIALISE",err,error,*998)
1498 
1499 #ifdef WITH_CELLML
1500 
1501  IF(ASSOCIATED(cellml_model)) THEN
1502  CALL flagerror("CellML model is already associated.",err,error,*998)
1503  ELSE
1504  ALLOCATE(cellml_model,stat=err)
1505  IF(err/=0) CALL flagerror("Could not allocate CellML model.",err,error,*999)
1506  NULLIFY(cellml_model%CELLML)
1507  cellml_model%GLOBAL_NUMBER=0
1508  cellml_model%MODEL_ID=""
1509  cellml_model%PTR = c_null_ptr
1510  cellml_model%NUMBER_OF_STATE=0
1511  cellml_model%NUMBER_OF_INTERMEDIATE=0
1512  cellml_model%NUMBER_OF_PARAMETERS=0
1513  ENDIF
1514 
1515 #else
1516 
1517  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*998)
1518 
1519 #endif
1520 
1521  exits("CELLML_MODEL_INITIALISE")
1522  RETURN
1523 999 CALL cellml_model_finalise(cellml_model,dummy_err,dummy_error,*998)
1524 998 errorsexits("CELLML_MODEL_INITIALISE",err,error)
1525  RETURN 1
1526  END SUBROUTINE cellml_model_initialise
1527 
1528  !
1529  !=================================================================================================================================
1530  !
1531 
1533  SUBROUTINE cellml_model_map_finalise(CELLML_MODEL_MAP,ERR,ERROR,*)
1534  !Argument variables
1535  TYPE(cellml_model_map_type), POINTER :: CELLML_MODEL_MAP
1536  INTEGER(INTG), INTENT(OUT) :: ERR
1537  TYPE(varying_string), INTENT(OUT) :: ERROR
1538  !Local variables
1539 
1540  enters("CELLML_MODEL_MAP_FINALISE",err,error,*999)
1541 
1542 #ifdef WITH_CELLML
1543 
1544  IF(ASSOCIATED(cellml_model_map)) THEN
1545  CALL erase(cellml_model_map%VARIABLE_ID)
1546  DEALLOCATE(cellml_model_map)
1547  ENDIF
1548 
1549 #else
1550 
1551  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1552 
1553 #endif
1554 
1555  exits("CELLML_MODEL_MAP_FINALISE")
1556  RETURN
1557 999 errorsexits("CELLML_MODEL_MAP_FINALISE",err,error)
1558  RETURN 1
1559  END SUBROUTINE cellml_model_map_finalise
1560 
1561  !
1562  !=================================================================================================================================
1563  !
1564 
1566  SUBROUTINE cellml_model_map_initialise(CELLML_MODEL_MAP,ERR,ERROR,*)
1567 
1568  !Argument variables
1569  TYPE(cellml_model_map_type), POINTER :: CELLML_MODEL_MAP
1570  INTEGER(INTG), INTENT(OUT) :: ERR
1571  TYPE(varying_string), INTENT(OUT) :: ERROR
1572  !Local variables
1573  INTEGER(INTG) :: DUMMY_ERR
1574  TYPE(varying_string) :: DUMMY_ERROR
1575 
1576  enters("CELLML_MODEL_MAP_INITIALISE",err,error,*998)
1577 
1578 #ifdef WITH_CELLML
1579 
1580  IF(ASSOCIATED(cellml_model_map)) THEN
1581  CALL flagerror("CellML model map field is already associated.",err,error,*998)
1582  ELSE
1583  ALLOCATE(cellml_model_map,stat=err)
1584  IF(err/=0) CALL flagerror("Could not allocate CellML model map.",err,error,*999)
1585  cellml_model_map%CELLML_MAP_TYPE = 0
1586  NULLIFY(cellml_model_map%FIELD)
1587  cellml_model_map%VARIABLE_TYPE=0
1588  cellml_model_map%COMPONENT_NUMBER=0
1589  cellml_model_map%FIELD_PARAMETER_SET=0
1590  cellml_model_map%VARIABLE_ID=""
1591  cellml_model_map%CELLML_FIELD_TYPE=0
1592  cellml_model_map%CELLML_VARIABLE_NUMBER=0
1593  cellml_model_map%CELLML_PARAMETER_SET=0
1594  ENDIF
1595 
1596 #else
1597 
1598  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*998)
1599 
1600 #endif
1601 
1602  exits("CELLML_MODEL_MAP_INITIALISE")
1603  RETURN
1604 999 CALL cellml_model_map_finalise(cellml_model_map,dummy_err,dummy_error,*998)
1605 998 errorsexits("CELLML_MODEL_MAP_INITIALISE",err,error)
1606  RETURN 1
1607  END SUBROUTINE cellml_model_map_initialise
1608 
1609  !
1610  !=================================================================================================================================
1611  !
1612 
1614  SUBROUTINE cellml_model_maps_finalise(CELLML_MODEL_MAPS,ERR,ERROR,*)
1615  !Argument variables
1616  TYPE(cellml_model_maps_type), POINTER :: CELLML_MODEL_MAPS
1617  INTEGER(INTG), INTENT(OUT) :: ERR
1618  TYPE(varying_string), INTENT(OUT) :: ERROR
1619  !Local variables
1620  INTEGER(INTG) :: map_idx
1621 
1622  enters("CELLML_MODEL_MAPS_FINALISE",err,error,*999)
1623 
1624 #ifdef WITH_CELLML
1625 
1626  IF(ASSOCIATED(cellml_model_maps)) THEN
1627  IF(ALLOCATED(cellml_model_maps%FIELDS_MAPPED_TO)) THEN
1628  DO map_idx=1,SIZE(cellml_model_maps%FIELDS_MAPPED_TO,1)
1629  CALL cellml_model_map_finalise(cellml_model_maps%FIELDS_MAPPED_TO(map_idx)%PTR,err,error,*999)
1630  ENDDO !map_idx
1631  DEALLOCATE(cellml_model_maps%FIELDS_MAPPED_TO)
1632  ENDIF
1633  IF(ALLOCATED(cellml_model_maps%FIELDS_MAPPED_FROM)) THEN
1634  DO map_idx=1,SIZE(cellml_model_maps%FIELDS_MAPPED_FROM,1)
1635  CALL cellml_model_map_finalise(cellml_model_maps%FIELDS_MAPPED_FROM(map_idx)%PTR,err,error,*999)
1636  ENDDO !map_idx
1637  DEALLOCATE(cellml_model_maps%FIELDS_MAPPED_FROM)
1638  ENDIF
1639  DEALLOCATE(cellml_model_maps)
1640  ENDIF
1641 
1642 #else
1643 
1644  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1645 
1646 #endif
1647 
1648  exits("CELLML_MODEL_MAPS_FINALISE")
1649  RETURN
1650 999 errorsexits("CELLML_MODEL_MAPS_FINALISE",err,error)
1651  RETURN 1
1652  END SUBROUTINE cellml_model_maps_finalise
1653 
1654  !
1655  !=================================================================================================================================
1656  !
1657 
1659  SUBROUTINE cellml_model_maps_initialise(CELLML_MODEL_MAPS,ERR,ERROR,*)
1660 
1661  !Argument variables
1662  TYPE(cellml_model_maps_type), POINTER :: CELLML_MODEL_MAPS
1663  INTEGER(INTG), INTENT(OUT) :: ERR
1664  TYPE(varying_string), INTENT(OUT) :: ERROR
1665  !Local variables
1666  INTEGER(INTG) :: DUMMY_ERR
1667  TYPE(varying_string) :: DUMMY_ERROR
1668 
1669  enters("CELLML_MODEL_MAPS_INITIALISE",err,error,*998)
1670 
1671 #ifdef WITH_CELLML
1672 
1673  IF(ASSOCIATED(cellml_model_maps)) THEN
1674  CALL flagerror("CellML model maps is already associated.",err,error,*998)
1675  ELSE
1676  ALLOCATE(cellml_model_maps,stat=err)
1677  IF(err/=0) CALL flagerror("Could not allocate CellML model maps.",err,error,*999)
1678  cellml_model_maps%NUMBER_OF_FIELDS_MAPPED_TO=0
1679  cellml_model_maps%NUMBER_OF_FIELDS_MAPPED_FROM=0
1680  ENDIF
1681 
1682 #else
1683 
1684  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*998)
1685 
1686 #endif
1687 
1688  exits("CELLML_MODEL_MAPS_INITIALISE")
1689  RETURN
1690 999 CALL cellml_model_maps_finalise(cellml_model_maps,dummy_err,dummy_error,*998)
1691 998 errorsexits("CELLML_MODEL_MAPS_INITIALISE",err,error)
1692  RETURN 1
1693  END SUBROUTINE cellml_model_maps_initialise
1694 
1695  !
1696  !=================================================================================================================================
1697  !
1698 
1700  SUBROUTINE cellml_model_import_c(CELLML,URI,MODEL_INDEX,ERR,ERROR,*)
1701  !Argument variables
1702  TYPE(cellml_type), POINTER :: CELLML
1703  CHARACTER(LEN=*) :: URI
1704  INTEGER(INTG), INTENT(OUT) :: MODEL_INDEX
1705  INTEGER(INTG), INTENT(OUT) :: ERR
1706  TYPE(varying_string), INTENT(OUT) :: ERROR
1707  !Local variables
1708  INTEGER(INTG) :: cellml_idx
1709  TYPE(cellml_model_type), POINTER :: NEW_MODEL
1710  TYPE(cellml_model_ptr_type), ALLOCATABLE :: NEW_MODELS(:)
1711  !INTEGER (C_INT) CODE
1712  !TYPE(C_PTR) :: CELLML_MODEL
1713  CHARACTER(256) :: C_URI
1714  INTEGER(INTG) :: C_URI_L
1715 
1716  enters("CELLML_MODEL_IMPORT_C",err,error,*999)
1717 
1718 #ifdef WITH_CELLML
1719 
1720  NULLIFY(new_model)
1721  model_index=0
1722 
1723  IF(ASSOCIATED(cellml)) THEN
1724  !set up new model object
1725  !Allocate new CellML model
1726  NULLIFY(new_model)
1727  CALL cellml_model_initialise(new_model,err,error,*999)
1728  c_uri_l = len_trim(uri)
1729  WRITE(c_uri,'(A,A)') uri(1:c_uri_l),c_null_char
1730  new_model%PTR = create_cellml_model_definition(c_uri)
1731  IF(c_associated(new_model%PTR)) THEN
1732  new_model%GLOBAL_NUMBER = cellml%NUMBER_OF_MODELS+1
1733  new_model%MODEL_ID=uri(1:c_uri_l)
1734  !Add model to this CellML environment's list of models
1735  ALLOCATE(new_models(cellml%NUMBER_OF_MODELS+1),stat=err)
1736  IF(err/=0) CALL flagerror("Could not allocate new CellML models array.",err,error,*999)
1737  DO cellml_idx=1,cellml%NUMBER_OF_MODELS
1738  new_models(cellml_idx)%PTR=>cellml%MODELS(cellml_idx)%PTR
1739  ENDDO !cellml_idx
1740  new_models(cellml%NUMBER_OF_MODELS+1)%PTR=>new_model
1741  CALL move_alloc(new_models,cellml%MODELS)
1742  cellml%NUMBER_OF_MODELS = cellml%NUMBER_OF_MODELS+1
1743  model_index=cellml%NUMBER_OF_MODELS
1744  ELSE
1745  CALL flagerror("Error instantiating CellML model.",err,error,*999)
1746  ENDIF
1747  ELSE
1748  CALL flagerror("CellML environment is not associated.",err,error,*999)
1749  ENDIF
1750 
1751 #else
1752 
1753  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1754 
1755 #endif
1756 
1757  exits("CELLML_MODEL_IMPORT_C")
1758  RETURN
1759 999 errorsexits("CELLML_MODEL_IMPORT_C",err,error)
1760  RETURN 1
1761  END SUBROUTINE cellml_model_import_c
1762 
1763  !
1764  !=================================================================================================================================
1765  !
1766 
1768  SUBROUTINE cellml_model_import_vs(CELLML,URI,MODEL_INDEX,ERR,ERROR,*)
1769  !Argument variables
1770  TYPE(cellml_type), POINTER :: CELLML
1771  TYPE(varying_string), INTENT(IN) :: URI
1772  INTEGER(INTG), INTENT(OUT) :: MODEL_INDEX
1773  INTEGER(INTG), INTENT(OUT) :: ERR
1774  TYPE(varying_string), INTENT(OUT) :: ERROR
1775  !Local variables
1776 
1777  enters("CELLML_MODEL_IMPORT_VS",err,error,*999)
1778 
1779 #ifdef WITH_CELLML
1780 
1781  CALL cellml_model_import(cellml,char(uri),model_index,err,error,*999)
1782 
1783 #else
1784 
1785  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1786 
1787 #endif
1788 
1789  exits("CELLML_MODEL_IMPORT_VS")
1790  RETURN
1791 999 errorsexits("CELLML_MODEL_IMPORT_VS",err,error)
1792  RETURN 1
1793  END SUBROUTINE cellml_model_import_vs
1794 
1795  !
1796  !=================================================================================================================================
1797  !
1798 
1800  SUBROUTINE cellml_variable_set_as_known_c(CELLML,MODEL_INDEX,VARIABLE_ID,ERR,ERROR,*)
1801 
1802  !Argument variables
1803  TYPE(cellml_type), POINTER :: CELLML
1804  INTEGER(INTG), INTENT(IN) :: MODEL_INDEX
1805  CHARACTER(LEN=*), INTENT(IN) :: VARIABLE_ID
1806  INTEGER(INTG), INTENT(OUT) :: ERR
1807  TYPE(varying_string), INTENT(OUT) :: ERROR
1808  !Local variables
1809  CHARACTER(LEN=MAXSTRLEN) :: C_NAME
1810  INTEGER(INTG) :: C_NAME_L
1811  INTEGER(C_INT) :: ERROR_CODE
1812  TYPE(cellml_model_type), POINTER :: CELLML_MODEL
1813  TYPE(varying_string) :: LOCAL_ERROR
1814 
1815  enters("CELLML_VARIABLE_SET_AS_KNOWN_C",err,error,*999)
1816 
1817 #ifdef WITH_CELLML
1818 
1819  IF(ASSOCIATED(cellml)) THEN
1820  IF(cellml%CELLML_FINISHED) THEN
1821  CALL flagerror("CellML environment has already been finished.",err,error,*999)
1822  ELSE
1823  IF(model_index>0.AND.model_index<=cellml%NUMBER_OF_MODELS) THEN
1824  cellml_model=>cellml%MODELS(model_index)%PTR
1825  IF(ASSOCIATED(cellml_model)) THEN
1826  !All input arguments are ok.
1827  c_name_l = len_trim(variable_id)
1828  WRITE(c_name,'(A,A)') variable_id(1:c_name_l),c_null_char
1829  error_code = cellml_model_definition_set_variable_as_known(cellml_model%PTR,c_name)
1830  IF(error_code /= 0) THEN
1831  local_error="The specified variable can not be set as known: "//variable_id
1832  CALL flagerror(local_error,err,error,*999)
1833  ENDIF
1834  ELSE
1835  CALL flagerror("CellML model is not associated.",err,error,*999)
1836  ENDIF
1837  ELSE
1838  local_error="The specified model index of "//trim(number_to_vstring(model_index,"*",err,error))// &
1839  & " is invalid. The modex index should be >= 1 and <= "// &
1840  & trim(number_to_vstring(cellml%NUMBER_OF_MODELS,"*",err,error))//"."
1841  CALL flagerror(local_error,err,error,*999)
1842  ENDIF
1843  ENDIF
1844  ELSE
1845  CALL flagerror("CellML environment is not associated.",err,error,*999)
1846  ENDIF
1847 
1848 #else
1849 
1850  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1851 
1852 #endif
1853 
1854  exits("CELLML_VARIABLE_SET_AS_KNOWN_C")
1855  RETURN
1856 999 errorsexits("CELLML_VARIABLE_SET_AS_KNOWN_C",err,error)
1857  RETURN 1
1858  END SUBROUTINE cellml_variable_set_as_known_c
1859 
1860  !
1861  !=================================================================================================================================
1862  !
1863 
1865  SUBROUTINE cellml_variable_set_as_known_vs(CELLML,MODEL_USER_NUMBER,VARIABLE_ID,ERR,ERROR,*)
1866 
1867  !Argument variables
1868  TYPE(cellml_type), POINTER :: CELLML
1869  INTEGER(INTG), INTENT(IN) :: MODEL_USER_NUMBER
1870  TYPE(varying_string), INTENT(IN) :: VARIABLE_ID
1871  INTEGER(INTG), INTENT(OUT) :: ERR
1872  TYPE(varying_string), INTENT(OUT) :: ERROR
1873  !Local variables
1874 
1875  enters("CELLML_VARIABLE_SET_AS_KNOWN_VS",err,error,*999)
1876 
1877 #ifdef WITH_CELLML
1878 
1879  CALL cellml_variable_set_as_known(cellml,model_user_number,char(variable_id),err,error,*999)
1880 
1881 #else
1882 
1883  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1884 
1885 #endif
1886 
1887  exits("CELLML_VARIABLE_SET_AS_KNOWN_VS")
1888  RETURN
1889 999 errorsexits("CELLML_VARIABLE_SET_AS_KNOWN_VS",err,error)
1890  RETURN 1
1891  END SUBROUTINE cellml_variable_set_as_known_vs
1892 
1893  !
1894  !=================================================================================================================================
1895  !
1896 
1898  SUBROUTINE cellml_variable_set_as_wanted_c(CELLML,MODEL_INDEX,VARIABLE_ID,ERR,ERROR,*)
1899 
1900  !Argument variables
1901  TYPE(cellml_type), POINTER :: CELLML
1902  INTEGER(INTG), INTENT(IN) :: MODEL_INDEX
1903  CHARACTER(LEN=*), INTENT(IN) :: VARIABLE_ID
1904  INTEGER(INTG), INTENT(OUT) :: ERR
1905  TYPE(varying_string), INTENT(OUT) :: ERROR
1906  !Local variables
1907  CHARACTER(LEN=MAXSTRLEN) :: C_NAME
1908  INTEGER(INTG) :: C_NAME_L
1909  INTEGER(C_INT) :: ERROR_CODE
1910  TYPE(cellml_model_type), POINTER :: CELLML_MODEL
1911  TYPE(varying_string) :: LOCAL_ERROR
1912 
1913  enters("CELLML_VARIABLE_SET_AS_WANTED_C",err,error,*999)
1914 
1915 #ifdef WITH_CELLML
1916 
1917  IF(ASSOCIATED(cellml)) THEN
1918  IF(cellml%CELLML_FINISHED) THEN
1919  CALL flagerror("CellML environment has already been finished.",err,error,*999)
1920  ELSE
1921  IF(model_index>0.AND.model_index<=cellml%NUMBER_OF_MODELS) THEN
1922  cellml_model=>cellml%MODELS(model_index)%PTR
1923  IF(ASSOCIATED(cellml_model)) THEN
1924  !All input arguments are ok.
1925  c_name_l = len_trim(variable_id)
1926  WRITE(c_name,'(A,A)') variable_id(1:c_name_l),c_null_char
1927  error_code = cellml_model_definition_set_variable_as_wanted(cellml_model%PTR,c_name)
1928  IF(error_code .NE. 0) THEN
1929  local_error="The specified variable can not be set as wanted: "//variable_id
1930  CALL flagerror(local_error,err,error,*999)
1931  ENDIF
1932  ELSE
1933  CALL flagerror("CellML model is not associated.",err,error,*999)
1934  ENDIF
1935  ELSE
1936  local_error="The specified model index of "//trim(number_to_vstring(model_index,"*",err,error))// &
1937  & " is invalid. The model index should be >= 1 and <= "// &
1938  & trim(number_to_vstring(cellml%NUMBER_OF_MODELS,"*",err,error))//"."
1939  CALL flagerror(local_error,err,error,*999)
1940  ENDIF
1941  ENDIF
1942  ELSE
1943  CALL flagerror("CellML environment is not associated.",err,error,*999)
1944  ENDIF
1945 
1946 #else
1947 
1948  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1949 
1950 #endif
1951 
1952  exits("CELLML_VARIABLE_SET_AS_WANTED_C")
1953  RETURN
1954 999 errorsexits("CELLML_VARIABLE_SET_AS_WANTED_C",err,error)
1955  RETURN 1
1956  END SUBROUTINE cellml_variable_set_as_wanted_c
1957 
1958  !
1959  !=================================================================================================================================
1960  !
1961 
1963  SUBROUTINE cellml_variable_set_as_wanted_vs(CELLML,MODEL_USER_NUMBER,VARIABLE_ID,ERR,ERROR,*)
1964 
1965  !Argument variables
1966  TYPE(cellml_type), POINTER :: CELLML
1967  INTEGER(INTG), INTENT(IN) :: MODEL_USER_NUMBER
1968  TYPE(varying_string), INTENT(IN) :: VARIABLE_ID
1969  INTEGER(INTG), INTENT(OUT) :: ERR
1970  TYPE(varying_string), INTENT(OUT) :: ERROR
1971  !Local variables
1972 
1973  enters("CELLML_VARIABLE_SET_AS_WANTED_VS",err,error,*999)
1974 
1975 #ifdef WITH_CELLML
1976 
1977  CALL cellml_variable_set_as_wanted(cellml,model_user_number,char(variable_id),err,error,*999)
1978 
1979 #else
1980 
1981  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1982 
1983 #endif
1984 
1985  exits("CELLML_VARIABLE_SET_AS_WANTED_VS")
1986  RETURN
1987 999 errorsexits("CELLML_VARIABLE_SET_AS_WANTED_VS",err,error)
1988  RETURN 1
1989  END SUBROUTINE cellml_variable_set_as_wanted_vs
1990 
1991  !
1992  !=================================================================================================================================
1993  !
1994 
1996  SUBROUTINE cellml_create_cellml_to_field_map_c(CELLML,MODEL_INDEX,VARIABLE_ID,CELLML_PARAMETER_SET, &
1997  & field,variable_type,component_number,field_parameter_set,err,error,*)
1998 
1999  !Argument variables
2000  TYPE(cellml_type), POINTER :: CELLML
2001  INTEGER(INTG), INTENT(IN) :: MODEL_INDEX
2002  CHARACTER(LEN=*), INTENT(IN) :: VARIABLE_ID
2003  INTEGER(INTG), INTENT(IN) :: CELLML_PARAMETER_SET
2004  TYPE(field_type), POINTER, INTENT(IN) :: FIELD
2005  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
2006  INTEGER(INTG), INTENT(IN) :: COMPONENT_NUMBER
2007  INTEGER(INTG), INTENT(IN) :: FIELD_PARAMETER_SET
2008  INTEGER(INTG), INTENT(OUT) :: ERR
2009  TYPE(varying_string), INTENT(OUT) :: ERROR
2010  !Local variables
2011  CHARACTER(LEN=1,KIND=C_CHAR) :: C_NAME(maxstrlen)
2012  !INTEGER(INTG) :: C_NAME_L
2013  INTEGER(C_INT) :: ERROR_C
2014  INTEGER(INTG) :: CELLML_VARIABLE_TYPE,CELLML_FIELD_TYPE,CELLML_VARIABLE_NUMBER,map_idx
2015  TYPE(cellml_field_maps_type), POINTER :: CELLML_FIELD_MAPS
2016  TYPE(cellml_model_type), POINTER :: CELLML_MODEL
2017  TYPE(cellml_model_map_type), POINTER :: NEW_CELLML_MODEL_MAP
2018  TYPE(cellml_model_map_ptr_type), ALLOCATABLE :: NEW_FIELDS_MAPPED_FROM(:)
2019  TYPE(cellml_model_maps_type), POINTER :: CELLML_MODEL_MAPS
2020  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
2021  TYPE(field_parameter_set_type), POINTER :: PARAMETER_SET
2022  TYPE(varying_string) :: LOCAL_ERROR
2023 
2024  enters("CELLML_CREATE_CELLML_TO_FIELD_MAP_C",err,error,*999)
2025 
2026 #ifdef WITH_CELLML
2027 
2028  IF(ASSOCIATED(cellml)) THEN
2029  CALL cmissf2cstring(variable_id,c_name)
2030  IF(cellml%CELLML_FINISHED) THEN
2031  cellml_field_maps=>cellml%FIELD_MAPS
2032  IF(ASSOCIATED(cellml_field_maps)) THEN
2033  IF(cellml_field_maps%CELLML_FIELD_MAPS_FINISHED) THEN
2034  CALL flagerror("CellML field maps have already been finished.",err,error,*999)
2035  ELSE
2036  NULLIFY(field_variable)
2037  CALL field_variable_get(field,variable_type,field_variable,err,error,*999)
2038  NULLIFY(parameter_set)
2039  CALL field_parameter_set_get(field,variable_type,field_parameter_set,parameter_set,err,error,*999)
2040  IF(component_number>0.AND.component_number<=field_variable%NUMBER_OF_COMPONENTS) THEN
2041  IF(model_index>0.AND.model_index<=cellml%NUMBER_OF_MODELS) THEN
2042  cellml_model=>cellml%MODELS(model_index)%PTR
2043  IF(ASSOCIATED(cellml_model)) THEN
2044  cellml_model_maps=>cellml_field_maps%MODEL_MAPS(model_index)%PTR
2045  IF(ASSOCIATED(cellml_model_maps)) THEN
2046  !All input arguments are ok.
2047  ! get the type of the variable being mapped
2048  error_c = cellml_model_definition_get_variable_type(cellml_model%PTR,c_name,cellml_variable_type)
2049  IF(error_c /= 0) THEN
2050  local_error="Failed to get the type of CellML variable: "// &
2051  & variable_id// &
2052  & "; with the error code: "// &
2053  & trim(number_to_vstring(error_c,"*",err,error))
2054  CALL flagerror(local_error,err,error,*999)
2055  ENDIF
2056  cellml_field_type=map_cellml_variable_type_to_field_type(cellml_variable_type,err,error)
2057  CALL cellml_field_component_get(cellml,model_index,cellml_field_type,variable_id,cellml_variable_number, &
2058  & err,error,*999)
2059  !C_NAME_L = LEN_TRIM(VARIABLE_ID)
2060  !WRITE(C_NAME,'(A,A)') C_NAME(1:C_NAME_L),C_NULL_CHAR
2061  !CELLML_VARIABLE_NUMBER=CELLML_MODEL_DEFINITION_ADD_MAPPING_TO_FIELD(CELLML_MODEL%PTR,C_NAME)
2062  !Now check that the mapped field is consistent with the other mapped fields for the model.
2063  IF(ASSOCIATED(cellml_field_maps%SOURCE_GEOMETRIC_FIELD)) THEN
2064  IF(.NOT.ASSOCIATED(cellml_field_maps%SOURCE_GEOMETRIC_FIELD,field%GEOMETRIC_FIELD)) THEN
2065  local_error="The geometric field for field user number "// &
2066  & trim(number_to_vstring(field%USER_NUMBER,"*",err,error))// &
2067  & " does not match the geometric field for other field variable components mapped" // &
2068  & " in the CellML environment."
2069  CALL flagerror(local_error,err,error,*999)
2070  ENDIF
2071  IF(.NOT.ASSOCIATED(cellml_field_maps%SOURCE_FIELD_DOMAIN, &
2072  & field_variable%COMPONENTS(component_number)%DOMAIN)) THEN
2073  local_error="The domain for component number "//trim(number_to_vstring(component_number,"*",err,error))// &
2074  & " of variable type "//trim(number_to_vstring(variable_type,"*",err,error))// &
2075  & " of field user number "//trim(number_to_vstring(field%USER_NUMBER,"*",err,error))// &
2076  & " does not match the domain for other field variable components mapped in the CellML environment."
2077  CALL flagerror(local_error,err,error,*999)
2078  ENDIF
2079  IF(cellml_field_maps%SOURCE_FIELD_INTERPOLATION_TYPE/= &
2080  & field_variable%COMPONENTS(component_number)%INTERPOLATION_TYPE) THEN
2081  local_error="The interpolation type of "// &
2082  & trim(number_to_vstring(field_variable%COMPONENTS(component_number)%INTERPOLATION_TYPE, &
2083  & "*",err,error))//" for component number "//trim(number_to_vstring(component_number,"*",err,error))// &
2084  & " of variable type "//trim(number_to_vstring(variable_type,"*",err,error))// &
2085  & " of field user number "//trim(number_to_vstring(field%USER_NUMBER,"*",err,error))// &
2086  & " does not match the interpolation type of "// &
2087  & trim(number_to_vstring(cellml_field_maps%SOURCE_FIELD_INTERPOLATION_TYPE,"*",err,error))// &
2088  & " used in other field variable components mapped in the CellML environment."
2089  CALL flagerror(local_error,err,error,*999)
2090  ENDIF
2091  ELSE
2092  cellml_field_maps%SOURCE_GEOMETRIC_FIELD=>field%GEOMETRIC_FIELD
2093  cellml_field_maps%SOURCE_FIELD_VARIABLE=>field_variable
2094  cellml_field_maps%SOURCE_FIELD_DOMAIN=>field_variable%COMPONENTS(component_number)%DOMAIN
2095  cellml_field_maps%SOURCE_FIELD_INTERPOLATION_TYPE=field_variable%COMPONENTS(component_number)% &
2096  & interpolation_type
2097  ENDIF
2098  !Everything is OK so create the model map field.
2099  ! get the type of the variable being mapped
2100  error_c = cellml_model_definition_get_variable_type(cellml_model%PTR,c_name,cellml_variable_type)
2101  IF(error_c /= 0) THEN
2102  local_error="Failed to get the type of CellML variable: "// &
2103  & variable_id// &
2104  & "; with the error code: "// &
2105  & trim(number_to_vstring(error_c,"*",err,error))
2106  CALL flagerror(local_error,err,error,*999)
2107  ENDIF
2108  cellml_field_type=map_cellml_variable_type_to_field_type(cellml_variable_type,err,error)
2109  CALL cellml_field_component_get(cellml,model_index,cellml_field_type,variable_id,cellml_variable_number, &
2110  & err,error,*999)
2111  NULLIFY(new_cellml_model_map)
2112  CALL cellml_model_map_initialise(new_cellml_model_map,err,error,*999)
2113  new_cellml_model_map%CELLML_MAP_TYPE=cellml_map_from_field_type
2114  new_cellml_model_map%FIELD=>field
2115  new_cellml_model_map%VARIABLE_TYPE=variable_type
2116  new_cellml_model_map%COMPONENT_NUMBER=component_number
2117  new_cellml_model_map%FIELD_PARAMETER_SET=field_parameter_set
2118  new_cellml_model_map%VARIABLE_ID=variable_id
2119  new_cellml_model_map%CELLML_FIELD_TYPE=cellml_field_type
2120  new_cellml_model_map%CELLML_VARIABLE_NUMBER=cellml_variable_number
2121  new_cellml_model_map%CELLML_PARAMETER_SET=cellml_parameter_set
2122  !Put this model map field into the list of to field maps
2123  ALLOCATE(new_fields_mapped_from(cellml_model_maps%NUMBER_OF_FIELDS_MAPPED_FROM+1),stat=err)
2124  IF(err/=0) CALL flagerror("Could not allocate new fields mapped from.",err,error,*999)
2125  DO map_idx=1,cellml_model_maps%NUMBER_OF_FIELDS_MAPPED_FROM
2126  new_fields_mapped_from(map_idx)%PTR=>cellml_model_maps%FIELDS_MAPPED_FROM(map_idx)%PTR
2127  ENDDO !map_idx
2128  new_fields_mapped_from(cellml_model_maps%NUMBER_OF_FIELDS_MAPPED_FROM+1)%PTR=>new_cellml_model_map
2129  CALL move_alloc(new_fields_mapped_from,cellml_model_maps%FIELDS_MAPPED_FROM)
2130  cellml_model_maps%NUMBER_OF_FIELDS_MAPPED_FROM=cellml_model_maps%NUMBER_OF_FIELDS_MAPPED_FROM+1
2131 
2132  IF(diagnostics1) THEN
2133  CALL write_string(diagnostic_output_type,"CellML model variable -> field map:",err,error,*999)
2134  CALL write_string(diagnostic_output_type," CellML model :",err,error,*999)
2135  CALL write_string_value(diagnostic_output_type," CellML User number = ",cellml%USER_NUMBER, &
2136  & err,error,*999)
2137  CALL write_string_value(diagnostic_output_type," Model index = ",model_index,err,error,*999)
2138  CALL write_string_value(diagnostic_output_type," Variable ID = ",variable_id,err,error,*999)
2139  CALL write_string_value(diagnostic_output_type," CellML field type = ",cellml_field_type, &
2140  & err,error,*999)
2141  CALL write_string_value(diagnostic_output_type," CellML variable number = ",cellml_variable_number, &
2142  & err,error,*999)
2143  CALL write_string_value(diagnostic_output_type," CellML parameter set = ",cellml_parameter_set, &
2144  & err,error,*999)
2145  CALL write_string(diagnostic_output_type," Field :",err,error,*999)
2146  CALL write_string_value(diagnostic_output_type," User number = ",field%USER_NUMBER, &
2147  & err,error,*999)
2148  CALL write_string_value(diagnostic_output_type," Variable type = ",variable_type, &
2149  & err,error,*999)
2150  CALL write_string_value(diagnostic_output_type," Component number = ",component_number, &
2151  & err,error,*999)
2152  CALL write_string_value(diagnostic_output_type," Parameter set = ",field_parameter_set, &
2153  & err,error,*999)
2154  ENDIF
2155  ELSE
2156  CALL flagerror("CellML field maps model maps is not associated.",err,error,*999)
2157  ENDIF
2158  ELSE
2159  CALL flagerror("CellML model is not associated.",err,error,*999)
2160  ENDIF
2161  ELSE
2162  local_error="The specified model index of "//trim(number_to_vstring(model_index,"*",err,error))// &
2163  & " is invalid. The modex index should be >= 1 and <= "// &
2164  & trim(number_to_vstring(cellml%NUMBER_OF_MODELS,"*",err,error))//"."
2165  CALL flagerror(local_error,err,error,*999)
2166  ENDIF
2167  ELSE
2168  local_error="Component number "//trim(number_to_vstring(component_number,"*",err,error))// &
2169  & " is invalid for variable type "//trim(number_to_vstring(variable_type,"*",err,error))// &
2170  & " of field number "//trim(number_to_vstring(field%USER_NUMBER,"*",err,error))//" which has "// &
2171  & trim(number_to_vstring(field_variable%NUMBER_OF_COMPONENTS,"*",err,error))// &
2172  & " components."
2173  CALL flagerror(local_error,err,error,*999)
2174  ENDIF
2175  ENDIF
2176  ELSE
2177  CALL flagerror("CellML environment field maps is not associated.",err,error,*999)
2178  ENDIF
2179  ELSE
2180  CALL flagerror("CellML environment has not been finished.",err,error,*999)
2181  ENDIF
2182  ELSE
2183  CALL flagerror("CellML environment is not associated.",err,error,*999)
2184  ENDIF
2185 
2186 #else
2187 
2188  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
2189 
2190 #endif
2191 
2192  exits("CELLML_CREATE_CELLML_TO_FIELD_MAP_C")
2193  RETURN
2194 999 errorsexits("CELLML_CREATE_CELLML_TO_FIELD_MAP_C",err,error)
2195  RETURN 1
2196  END SUBROUTINE cellml_create_cellml_to_field_map_c
2197 
2198  !
2199  !=================================================================================================================================
2200  !
2201 
2203  SUBROUTINE cellml_create_cellml_to_field_map_vs(CELLML,MODEL_USER_NUMBER,VARIABLE_ID,CELLML_PARAMETER_SET, &
2204  & field,variable_type,component_number,field_parameter_set,err,error,*)
2205 
2206  !Argument variables
2207  TYPE(cellml_type), POINTER :: CELLML
2208  INTEGER(INTG), INTENT(IN) :: MODEL_USER_NUMBER
2209  TYPE(varying_string), INTENT(IN) :: VARIABLE_ID
2210  INTEGER(INTG), INTENT(IN) :: CELLML_PARAMETER_SET
2211  TYPE(field_type), POINTER, INTENT(IN) :: FIELD
2212  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
2213  INTEGER(INTG), INTENT(IN) :: COMPONENT_NUMBER
2214  INTEGER(INTG), INTENT(IN) :: FIELD_PARAMETER_SET
2215  INTEGER(INTG), INTENT(OUT) :: ERR
2216  TYPE(varying_string), INTENT(OUT) :: ERROR
2217  !Local variables
2218 
2219  enters("CELLML_CREATE_CELLML_TO_FIELD_MAP_VS",err,error,*999)
2220 
2221 #ifdef WITH_CELLML
2222 
2223  CALL cellml_create_cellml_to_field_map(cellml,model_user_number,char(variable_id),cellml_parameter_set, &
2224  & field,variable_type,component_number,field_parameter_set,err,error,*999)
2225 
2226 #else
2227 
2228  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
2229 
2230 #endif
2231 
2232  exits("CELLML_CREATE_CELLML_TO_FIELD_MAP_VS")
2233  RETURN
2234 999 errorsexits("CELLML_CREATE_CELLML_TO_FIELD_MAP_VS",err,error)
2235  RETURN 1
2236  END SUBROUTINE cellml_create_cellml_to_field_map_vs
2237 
2238  !
2239  !=================================================================================================================================
2240  !
2241 
2243  SUBROUTINE cellml_create_field_to_cellml_map_c(CELLML,FIELD,VARIABLE_TYPE,COMPONENT_NUMBER,FIELD_PARAMETER_SET, &
2244  & model_index,variable_id,cellml_parameter_set,err,error,*)
2245 
2246  !Argument variables
2247  TYPE(cellml_type), POINTER :: CELLML
2248  TYPE(field_type), POINTER, INTENT(IN) :: FIELD
2249  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
2250  INTEGER(INTG), INTENT(IN) :: COMPONENT_NUMBER
2251  INTEGER(INTG), INTENT(IN) :: FIELD_PARAMETER_SET
2252  INTEGER(INTG), INTENT(IN) :: MODEL_INDEX
2253  CHARACTER(LEN=*), INTENT(IN) :: VARIABLE_ID
2254  INTEGER(INTG), INTENT(IN) :: CELLML_PARAMETER_SET
2255  INTEGER(INTG), INTENT(OUT) :: ERR
2256  TYPE(varying_string), INTENT(OUT) :: ERROR
2257  !Local variables
2258  INTEGER(INTG) :: CELLML_FIELD_TYPE,CELLML_VARIABLE_NUMBER,map_idx
2259  TYPE(cellml_field_maps_type), POINTER :: CELLML_FIELD_MAPS
2260  TYPE(cellml_model_type), POINTER :: CELLML_MODEL
2261  TYPE(cellml_model_map_type), POINTER :: NEW_CELLML_MODEL_MAP
2262  TYPE(cellml_model_map_ptr_type), ALLOCATABLE :: NEW_FIELDS_MAPPED_TO(:)
2263  TYPE(cellml_model_maps_type), POINTER :: CELLML_MODEL_MAPS
2264  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
2265  TYPE(field_parameter_set_type), POINTER :: PARAMETER_SET
2266  TYPE(varying_string) :: LOCAL_ERROR
2267  CHARACTER(LEN=1,KIND=C_CHAR) :: C_NAME(maxstrlen)
2268  !INTEGER(INTG) :: C_NAME_L
2269  INTEGER(C_INT) :: ERROR_C
2270  INTEGER(INTG) :: CELLML_VARIABLE_TYPE
2271 
2272  enters("CELLML_CREATE_FIELD_TO_CELLML_MAP_C",err,error,*999)
2273 
2274 #ifdef WITH_CELLML
2275 
2276  IF(ASSOCIATED(cellml)) THEN
2277  CALL cmissf2cstring(variable_id,c_name)
2278  IF(cellml%CELLML_FINISHED) THEN
2279  cellml_field_maps=>cellml%FIELD_MAPS
2280  IF(ASSOCIATED(cellml_field_maps)) THEN
2281  IF(cellml_field_maps%CELLML_FIELD_MAPS_FINISHED) THEN
2282  CALL flagerror("CellML field maps have already been finished.",err,error,*999)
2283  ELSE
2284  NULLIFY(field_variable)
2285  CALL field_variable_get(field,variable_type,field_variable,err,error,*999)
2286  NULLIFY(parameter_set)
2287  CALL field_parameter_set_get(field,variable_type,field_parameter_set,parameter_set,err,error,*999)
2288  IF(component_number>0.AND.component_number<=field_variable%NUMBER_OF_COMPONENTS) THEN
2289  IF(model_index>0.AND.model_index<=cellml%NUMBER_OF_MODELS) THEN
2290  cellml_model=>cellml%MODELS(model_index)%PTR
2291  IF(ASSOCIATED(cellml_model)) THEN
2292  cellml_model_maps=>cellml_field_maps%MODEL_MAPS(model_index)%PTR
2293  IF(ASSOCIATED(cellml_model_maps)) THEN
2294  !All input arguments are ok.
2295  ! get the type of the variable being mapped
2296  error_c = cellml_model_definition_get_variable_type(cellml_model%PTR,c_name,cellml_variable_type)
2297  IF(error_c /= 0) THEN
2298  local_error="Failed to get the type of CellML variable: "// &
2299  & variable_id// &
2300  & "; with the error code: "// &
2301  & trim(number_to_vstring(error_c,"*",err,error))
2302  CALL flagerror(local_error,err,error,*999)
2303  ENDIF
2304  cellml_field_type=map_cellml_variable_type_to_field_type(cellml_variable_type,err,error)
2305  CALL cellml_field_component_get(cellml,model_index,cellml_field_type,variable_id,cellml_variable_number, &
2306  & err,error,*999)
2307  !C_NAME_L = LEN_TRIM(VARIABLE_ID)
2308  !WRITE(C_NAME,'(A,A)') C_NAME(1:C_NAME_L),C_NULL_CHAR
2309  !CELLML_VARIABLE_NUMBER=CELLML_MODEL_DEFINITION_ADD_MAPPING_TO_FIELD(CELLML_MODEL%PTR,C_NAME)
2310  !Now check that the mapped field is consistent with the other mapped fields for the model.
2311  IF(ASSOCIATED(cellml_field_maps%SOURCE_GEOMETRIC_FIELD)) THEN
2312  IF(.NOT.ASSOCIATED(cellml_field_maps%SOURCE_GEOMETRIC_FIELD,field%GEOMETRIC_FIELD)) THEN
2313  local_error="The geometric field for field user number "// &
2314  & trim(number_to_vstring(field%USER_NUMBER,"*",err,error))// &
2315  & " does not match the geometric field for other field variable components mapped in the" // &
2316  & " CellML environment."
2317  CALL flagerror(local_error,err,error,*999)
2318  ENDIF
2319  IF(.NOT.ASSOCIATED(cellml_field_maps%SOURCE_FIELD_DOMAIN, &
2320  & field_variable%COMPONENTS(component_number)%DOMAIN)) THEN
2321  local_error="The domain for component number "//trim(number_to_vstring(component_number,"*",err,error))// &
2322  & " of variable type "//trim(number_to_vstring(variable_type,"*",err,error))// &
2323  & " of field user number "//trim(number_to_vstring(field%USER_NUMBER,"*",err,error))// &
2324  & " does not match the domain for other field variable components mapped in the CellML environment."
2325  CALL flagerror(local_error,err,error,*999)
2326  ENDIF
2327  IF(cellml_field_maps%SOURCE_FIELD_INTERPOLATION_TYPE/= &
2328  & field_variable%COMPONENTS(component_number)%INTERPOLATION_TYPE) THEN
2329  local_error="The interpolation type of "// &
2330  & trim(number_to_vstring(field_variable%COMPONENTS(component_number)%INTERPOLATION_TYPE, &
2331  & "*",err,error))//" for component number "//trim(number_to_vstring(component_number,"*",err,error))// &
2332  & " of variable type "//trim(number_to_vstring(variable_type,"*",err,error))// &
2333  & " of field user number "//trim(number_to_vstring(field%USER_NUMBER,"*",err,error))// &
2334  & " does not match the interpolation type of "// &
2335  & trim(number_to_vstring(cellml_field_maps%SOURCE_FIELD_INTERPOLATION_TYPE,"*",err,error))// &
2336  & " used in other field variable components mapped in the CellML environment."
2337  CALL flagerror(local_error,err,error,*999)
2338  ENDIF
2339  ELSE
2340  cellml_field_maps%SOURCE_FIELD_DOMAIN=>field_variable%COMPONENTS(component_number)%DOMAIN
2341  cellml_field_maps%SOURCE_FIELD_INTERPOLATION_TYPE=field_variable%COMPONENTS(component_number)% &
2342  & interpolation_type
2343  ENDIF
2344  !Everything is OK so create the model map field.
2345  NULLIFY(new_cellml_model_map)
2346  CALL cellml_model_map_initialise(new_cellml_model_map,err,error,*999)
2347  new_cellml_model_map%CELLML_MAP_TYPE=cellml_map_to_field_type
2348  new_cellml_model_map%FIELD=>field
2349  new_cellml_model_map%VARIABLE_TYPE=variable_type
2350  new_cellml_model_map%COMPONENT_NUMBER=component_number
2351  new_cellml_model_map%FIELD_PARAMETER_SET=field_parameter_set
2352  new_cellml_model_map%VARIABLE_ID=variable_id
2353  new_cellml_model_map%CELLML_FIELD_TYPE=cellml_field_type
2354  new_cellml_model_map%CELLML_VARIABLE_NUMBER=cellml_variable_number
2355  new_cellml_model_map%CELLML_PARAMETER_SET=cellml_parameter_set
2356  !Put this model map field into the list of to field maps
2357  ALLOCATE(new_fields_mapped_to(cellml_model_maps%NUMBER_OF_FIELDS_MAPPED_TO+1),stat=err)
2358  IF(err/=0) CALL flagerror("Could not allocate new fields mapped to.",err,error,*999)
2359  DO map_idx=1,cellml_model_maps%NUMBER_OF_FIELDS_MAPPED_TO
2360  new_fields_mapped_to(map_idx)%PTR=>cellml_model_maps%FIELDS_MAPPED_TO(map_idx)%PTR
2361  ENDDO !map_idx
2362  new_fields_mapped_to(cellml_model_maps%NUMBER_OF_FIELDS_MAPPED_TO+1)%PTR=>new_cellml_model_map
2363  CALL move_alloc(new_fields_mapped_to,cellml_model_maps%FIELDS_MAPPED_TO)
2364  cellml_model_maps%NUMBER_OF_FIELDS_MAPPED_TO=cellml_model_maps%NUMBER_OF_FIELDS_MAPPED_TO+1
2365 
2366  IF(diagnostics1) THEN
2367  CALL write_string(diagnostic_output_type,"CellML model field -> CellML map:",err,error,*999)
2368  CALL write_string(diagnostic_output_type," Field :",err,error,*999)
2369  CALL write_string_value(diagnostic_output_type," User number = ",field%USER_NUMBER, &
2370  & err,error,*999)
2371  CALL write_string_value(diagnostic_output_type," Variable type = ",variable_type,err,error,*999)
2372  CALL write_string_value(diagnostic_output_type," Component number = ",component_number, &
2373  & err,error,*999)
2374  CALL write_string_value(diagnostic_output_type," Parameter set = ",field_parameter_set, &
2375  & err,error,*999)
2376  CALL write_string(diagnostic_output_type," CellML model :",err,error,*999)
2377  CALL write_string_value(diagnostic_output_type," CellML User number = ",cellml%USER_NUMBER, &
2378  & err,error,*999)
2379  CALL write_string_value(diagnostic_output_type," Model index = ",model_index,err,error,*999)
2380  CALL write_string_value(diagnostic_output_type," Variable ID = ",variable_id,err,error,*999)
2381  CALL write_string_value(diagnostic_output_type," CellML field type = ",cellml_field_type, &
2382  & err,error,*999)
2383  CALL write_string_value(diagnostic_output_type," CellML variable number = ",cellml_variable_number, &
2384  & err,error,*999)
2385  CALL write_string_value(diagnostic_output_type," CellML parameter set = ",cellml_parameter_set, &
2386  & err,error,*999)
2387  ENDIF
2388  ELSE
2389  CALL flagerror("CellML field maps model maps is not associated.",err,error,*999)
2390  ENDIF
2391  ELSE
2392  CALL flagerror("CellML model is not associated.",err,error,*999)
2393  ENDIF
2394  ELSE
2395  local_error="The specified model index of "//trim(number_to_vstring(model_index,"*",err,error))// &
2396  & " is invalid. The modex index should be >= 1 and <= "// &
2397  & trim(number_to_vstring(cellml%NUMBER_OF_MODELS,"*",err,error))//"."
2398  CALL flagerror(local_error,err,error,*999)
2399  ENDIF
2400 
2401  ELSE
2402  local_error="Component number "//trim(number_to_vstring(component_number,"*",err,error))// &
2403  & " is invalid for variable type "//trim(number_to_vstring(variable_type,"*",err,error))// &
2404  & " of field number "//trim(number_to_vstring(field%USER_NUMBER,"*",err,error))//" which has "// &
2405  & trim(number_to_vstring(field_variable%NUMBER_OF_COMPONENTS,"*",err,error))// &
2406  & " components."
2407  CALL flagerror(local_error,err,error,*999)
2408  ENDIF
2409  ENDIF
2410  ELSE
2411  CALL flagerror("CellML environment field maps is not associated.",err,error,*999)
2412  ENDIF
2413  ELSE
2414  CALL flagerror("CellML environment has not been finished.",err,error,*999)
2415  ENDIF
2416  ELSE
2417  CALL flagerror("CellML environment is not associated.",err,error,*999)
2418  ENDIF
2419 
2420 #else
2421 
2422  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
2423 
2424 #endif
2425 
2426  exits("CELLML_CREATE_FIELD_TO_CELLML_MAP_C")
2427  RETURN
2428 999 errorsexits("CELLML_CREATE_FIELD_TO_CELLML_MAP_C",err,error)
2429  RETURN 1
2430  END SUBROUTINE cellml_create_field_to_cellml_map_c
2431 
2432  !
2433  !=================================================================================================================================
2434  !
2435 
2437  SUBROUTINE cellml_create_field_to_cellml_map_vs(CELLML,FIELD,VARIABLE_TYPE,COMPONENT_NUMBER,FIELD_PARAMETER_SET, &
2438  & model_user_number,variable_id,cellml_parameter_set,err,error,*)
2439 
2440  !Argument variables
2441  TYPE(cellml_type), POINTER :: CELLML
2442  TYPE(field_type), POINTER, INTENT(IN) :: FIELD
2443  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
2444  INTEGER(INTG), INTENT(IN) :: COMPONENT_NUMBER
2445  INTEGER(INTG), INTENT(IN) :: FIELD_PARAMETER_SET
2446  INTEGER(INTG), INTENT(IN) :: MODEL_USER_NUMBER
2447  TYPE(varying_string), INTENT(IN) :: VARIABLE_ID
2448  INTEGER(INTG), INTENT(IN) :: CELLML_PARAMETER_SET
2449  INTEGER(INTG), INTENT(OUT) :: ERR
2450  TYPE(varying_string), INTENT(OUT) :: ERROR
2451  !Local variables
2452 
2453  enters("CELLML_CREATE_FIELD_TO_CELLML_MAP_VS",err,error,*999)
2454 
2455 #ifdef WITH_CELLML
2456 
2457  CALL cellml_create_field_to_cellml_map(cellml,field,variable_type,component_number,field_parameter_set, &
2458  & model_user_number,char(variable_id),cellml_parameter_set,err,error,*999)
2459 
2460 #else
2461 
2462  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
2463 
2464 #endif
2465 
2466  exits("CELLML_CREATE_FIELD_TO_CELLML_MAP_VS")
2467  RETURN
2468 999 errorsexits("CELLML_CREATE_FIELD_TO_CELLML_MAP_VS",err,error)
2469  RETURN 1
2470  END SUBROUTINE cellml_create_field_to_cellml_map_vs
2471 
2472  !
2473  !=================================================================================================================================
2474  !
2475 
2477  SUBROUTINE cellml_fieldmodeldofset(modelVariable,modelDofIdx,field,variableType,parameterSetIdx,componentIdx, &
2478  value,err,error,*)
2479 
2480  !Argument variables
2481  TYPE(field_variable_type), POINTER :: modelVariable
2482  INTEGER(INTG), INTENT(IN) :: modelDofIdx
2483  TYPE(field_type), POINTER :: field
2484  INTEGER(INTG), INTENT(IN) :: variableType
2485  INTEGER(INTG), INTENT(IN) :: parameterSetIdx
2486  INTEGER(INTG), INTENT(IN) :: componentIdx
2487  REAL(DP), INTENT(IN) :: value
2488  INTEGER(INTG), INTENT(OUT) :: err
2489  TYPE(varying_string), INTENT(OUT) :: error
2490  !Local variables
2491  INTEGER(INTG) :: derivativeNumber,dofParamIdx,dofType,elementNumber,gaussNumber,gridNumber,nodeNumber,versionNumber
2492  TYPE(varying_string) :: localError
2493 
2494  enters("CellML_FieldModelDofSet",err,error,*999)
2495 
2496 #ifdef WITH_CELLML
2497 
2498  IF(ASSOCIATED(modelvariable)) THEN
2499  IF(modeldofidx>0.AND.modeldofidx<=modelvariable%NUMBER_OF_DOFS) THEN
2500  doftype=modelvariable%DOF_TO_PARAM_MAP%DOF_TYPE(1,modeldofidx)
2501  dofparamidx=modelvariable%DOF_TO_PARAM_MAP%DOF_TYPE(2,modeldofidx)
2502  SELECT CASE(doftype)
2503  CASE(field_constant_dof_type)
2504  CALL field_parameter_set_update_constant(field,variabletype,parametersetidx,componentidx,VALUE,err,error,*999)
2505  CASE(field_element_dof_type)
2506  elementnumber=modelvariable%DOF_TO_PARAM_MAP%ELEMENT_DOF2PARAM_MAP(1,dofparamidx)
2507  CALL field_parameter_set_update_element(field,variabletype,parametersetidx,elementnumber,componentidx,value, &
2508  & err,error,*999)
2509  CASE(field_node_dof_type)
2510  versionnumber=modelvariable%DOF_TO_PARAM_MAP%NODE_DOF2PARAM_MAP(1,dofparamidx)
2511  derivativenumber=modelvariable%DOF_TO_PARAM_MAP%NODE_DOF2PARAM_MAP(2,dofparamidx)
2512  nodenumber=modelvariable%DOF_TO_PARAM_MAP%NODE_DOF2PARAM_MAP(3,dofparamidx)
2513  CALL field_parameter_set_update_local_node(field,variabletype,parametersetidx,versionnumber,derivativenumber,nodenumber, &
2514  & componentidx,VALUE,err,error,*999)
2515  CASE(field_grid_point_dof_type)
2516  gridnumber=modelvariable%DOF_TO_PARAM_MAP%GRID_POINT_DOF2PARAM_MAP(1,dofparamidx)
2517  CALL flagerror("Not implemented.",err,error,*999)
2518  CASE(field_gauss_point_dof_type)
2519  gaussnumber=modelvariable%DOF_TO_PARAM_MAP%GAUSS_POINT_DOF2PARAM_MAP(1,dofparamidx)
2520  elementnumber=modelvariable%DOF_TO_PARAM_MAP%GAUSS_POINT_DOF2PARAM_MAP(2,dofparamidx)
2521  CALL field_parametersetupdategausspoint(field,variabletype,parametersetidx,gaussnumber,elementnumber,componentidx, &
2522  & VALUE,err,error,*999)
2523  CASE DEFAULT
2524  localerror="The DOF type of "//trim(number_to_vstring(doftype,"*",err,error))// &
2525  & " for DOF number "//trim(number_to_vstring(modeldofidx,"*",err,error))//" is invalid."
2526  CALL flagerror(localerror,err,error,*999)
2527  END SELECT
2528  ELSE
2529  localerror="The model DOF index of "//trim(number_to_vstring(modeldofidx,"*",err,error))// &
2530  & " is invalid. The DOF index needs to be > 0 and <= "// &
2531  & trim(number_to_vstring(modelvariable%NUMBER_OF_DOFS,"*",err,error))//"."
2532  CALL flagerror(localerror,err,error,*999)
2533  ENDIF
2534  ELSE
2535  CALL flagerror("Model variable is not asssociated.",err,error,*999)
2536  ENDIF
2537 
2538 #else
2539 
2540  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
2541 
2542 #endif
2543 
2544  exits("CellML_FieldModelDofSet")
2545  RETURN
2546 999 errorsexits("CellML_FieldModelDofSet",err,error)
2547  RETURN 1
2548 
2549  END SUBROUTINE cellml_fieldmodeldofset
2550 
2551  !
2552  !=================================================================================================================================
2553  !
2554 
2556  SUBROUTINE cellml_models_field_check(MODELS_FIELD,ERR,ERROR,*)
2557  !Argument variables
2558  TYPE(cellml_models_field_type), POINTER :: MODELS_FIELD
2559  INTEGER(INTG), INTENT(OUT) :: ERR
2560  TYPE(varying_string), INTENT(OUT) :: ERROR
2561  !Local variables
2562  INTEGER(INTG) :: model_idx,source_dof_idx,first_dof_idx
2563  INTEGER(INTG), POINTER :: MODELS_DATA(:)
2564  TYPE(cellml_type), POINTER :: CELLML
2565  TYPE(field_variable_type), POINTER :: MODELS_VARIABLE
2566  TYPE(varying_string) :: LOCAL_ERROR
2567 
2568  enters("CELLML_MODELS_FIELD_CHECK",err,error,*999)
2569 
2570 #ifdef WITH_CELLML
2571 
2572  IF(ASSOCIATED(models_field)) THEN
2573  IF(models_field%MODELS_FIELD_FINISHED) THEN
2574  IF(models_field%ONLY_ONE_MODEL_INDEX==cellml_models_field_not_checked) THEN
2575  cellml=>models_field%CELLML
2576  IF(ASSOCIATED(cellml)) THEN
2577  !Models field has not been checked before.
2578  NULLIFY(models_variable)
2579  CALL field_variable_get(models_field%MODELS_FIELD,field_u_variable_type,models_variable,err,error,*999)
2580  IF(models_variable%NUMBER_OF_DOFS>0) THEN
2581  NULLIFY(models_data)
2582  CALL field_parameter_set_data_get(models_field%MODELS_FIELD,field_u_variable_type,field_values_set_type, &
2583  & models_data,err,error,*999)
2584  !check for the first non-zero model index
2585  source_dof_idx=0
2586  first_dof_idx=1
2587  DO source_dof_idx=1,models_variable%TOTAL_NUMBER_OF_DOFS
2588  model_idx=models_data(source_dof_idx)
2589  IF(model_idx>=0) THEN
2590  models_field%ONLY_ONE_MODEL_INDEX=model_idx
2591  first_dof_idx=source_dof_idx
2592  IF(model_idx>0) THEN
2593  EXIT
2594  ENDIF
2595  ELSE
2596  local_error="The model index of "//trim(number_to_vstring(model_idx,"*",err,error))// &
2597  & " is invalid for source DOF 1. The model index must be >= 0 and <= "// &
2598  & trim(number_to_vstring(cellml%NUMBER_OF_MODELS,"*",err,error))//"."
2599  CALL flagerror("The models field has not been set for DOF 1.",err,error,*999)
2600  ENDIF
2601  ENDDO
2602  IF(model_idx>=0.AND.model_idx<=cellml%NUMBER_OF_MODELS) THEN
2603  DO source_dof_idx=(first_dof_idx+1),models_variable%TOTAL_NUMBER_OF_DOFS
2604  model_idx=models_data(source_dof_idx)
2605  IF(model_idx>=0.AND.model_idx<=cellml%NUMBER_OF_MODELS) THEN
2606  IF(model_idx/=models_field%ONLY_ONE_MODEL_INDEX.AND.model_idx/=0) THEN
2607  models_field%ONLY_ONE_MODEL_INDEX=cellml_models_field_not_constant
2608  EXIT
2609  ENDIF
2610  ELSE
2611  local_error="The model index of "//trim(number_to_vstring(model_idx,"*",err,error))// &
2612  & " is invalid for source DOF "//trim(number_to_vstring(source_dof_idx,"*",err,error))// &
2613  & ". The model index must be >= 0 and <= "// &
2614  & trim(number_to_vstring(cellml%NUMBER_OF_MODELS,"*",err,error))//"."
2615  CALL flagerror(local_error,err,error,*999)
2616  ENDIF
2617  ENDDO !source_dof_idx
2618  IF(models_field%ONLY_ONE_MODEL_INDEX==0) &
2619  & CALL flagerror("Models field does not have any models set.",err,error,*999)
2620  ELSE
2621  local_error="The model index of "//trim(number_to_vstring(model_idx,"*",err,error))// &
2622  & " is invalid for source DOF 1. The model index must be >= 0 and <= "// &
2623  & trim(number_to_vstring(cellml%NUMBER_OF_MODELS,"*",err,error))//"."
2624  CALL flagerror("The models field has not been set for DOF 1.",err,error,*999)
2625  ENDIF
2626 !!TODO: Do we need to make sure it is the same model number on different ranks? The only one model optimisation is to ensure
2627 !!that we don't have to reference the models field inside dof loops on the rank???
2628  CALL field_parameter_set_data_restore(models_field%MODELS_FIELD,field_u_variable_type,field_values_set_type, &
2629  & models_data,err,error,*999)
2630  ELSE
2631  CALL flagerror("CellML models field variable does not have any DOFs.",err,error,*999)
2632  ENDIF
2633  ELSE
2634  CALL flagerror("The models field CellML environment is not associated.",err,error,*999)
2635  ENDIF
2636  ENDIF
2637  ELSE
2638  CALL flagerror("Models field has not been finished.",err,error,*999)
2639  ENDIF
2640  ELSE
2641  CALL flagerror("Models field is not associated.",err,error,*999)
2642  ENDIF
2643 
2644 #else
2645 
2646  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
2647 
2648 #endif
2649 
2650  exits("CELLML_MODELS_FIELD_CHECK")
2651  RETURN
2652 999 errorsexits("CELLML_MODELS_FIELD_CHECK",err,error)
2653  RETURN 1
2654  END SUBROUTINE cellml_models_field_check
2655 
2656  !
2657  !=================================================================================================================================
2658  !
2659 
2661  SUBROUTINE cellml_models_field_create_start(MODEL_FIELD_USER_NUMBER,CELLML,MODELS_FIELD,ERR,ERROR,*)
2662  !Argument variables
2663  INTEGER(INTG), INTENT(IN) :: MODEL_FIELD_USER_NUMBER
2664  TYPE(cellml_type), POINTER :: CELLML
2665  TYPE(field_type), POINTER :: MODELS_FIELD
2666  INTEGER(INTG), INTENT(OUT) :: ERR
2667  TYPE(varying_string), INTENT(OUT) :: ERROR
2668  !Local variables
2669  TYPE(cellml_field_maps_type), POINTER :: CELLML_FIELD_MAPS
2670  TYPE(field_type), POINTER :: FIELD
2671  TYPE(region_type), POINTER :: REGION,MODELS_FIELD_REGION
2672  TYPE(varying_string) :: LOCAL_ERROR
2673 
2674  enters("CELLML_MODELS_FIELD_CREATE_START",err,error,*999)
2675 
2676 #ifdef WITH_CELLML
2677 
2678  IF(ASSOCIATED(cellml)) THEN
2679  cellml_field_maps=>cellml%FIELD_MAPS
2680  IF(ASSOCIATED(cellml_field_maps)) THEN
2681  IF(cellml_field_maps%CELLML_FIELD_MAPS_FINISHED) THEN
2682  IF(ASSOCIATED(cellml%MODELS_FIELD)) THEN
2683  CALL flagerror("The CellML environment models field is already associated.",err,error,*999)
2684  ELSE
2685  region=>cellml%REGION
2686  IF(ASSOCIATED(region)) THEN
2687  IF(ASSOCIATED(cellml_field_maps%SOURCE_GEOMETRIC_FIELD)) THEN
2688  IF(ASSOCIATED(cellml_field_maps%SOURCE_FIELD_DOMAIN)) THEN
2689  IF(ASSOCIATED(models_field)) THEN
2690  !Check the field has been finished
2691  IF(models_field%FIELD_FINISHED) THEN
2692  !Check the user numbers match
2693  IF(model_field_user_number/=models_field%USER_NUMBER) THEN
2694  local_error="The specified models field user number of "// &
2695  & trim(number_to_vstring(model_field_user_number,"*",err,error))// &
2696  & " does not match the user number of the specified models field of "// &
2697  & trim(number_to_vstring(models_field%USER_NUMBER,"*",err,error))//"."
2698  CALL flagerror(local_error,err,error,*999)
2699  ENDIF
2700  models_field_region=>models_field%REGION
2701  IF(ASSOCIATED(models_field_region)) THEN
2702  !Check the field is defined on the same region as the CellML region
2703  IF(models_field_region%USER_NUMBER/=region%USER_NUMBER) THEN
2704  local_error="Invalid region setup. The specified models field has been created on region number "// &
2705  & trim(number_to_vstring(models_field_region%USER_NUMBER,"*",err,error))// &
2706  & " and the specified CellML environment has been created on region number "// &
2707  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
2708  CALL flagerror(local_error,err,error,*999)
2709  ENDIF
2710  !Check the specified models field has the same geometric field as the source field
2711  IF(.NOT.ASSOCIATED(cellml_field_maps%SOURCE_GEOMETRIC_FIELD,models_field%GEOMETRIC_FIELD)) THEN
2712  CALL flagerror("The specified models field does not have the same geometric field as the "// &
2713  & "geometric field for the specified CellML environment.",err,error,*999)
2714  ENDIF
2715  !Check the specified models field has the same decomposition as the source field
2716  IF(.NOT.ASSOCIATED(cellml_field_maps%SOURCE_FIELD_DOMAIN%DECOMPOSITION,models_field%DECOMPOSITION)) THEN
2717  CALL flagerror("The specified models field does not have the same decomposition as the source "// &
2718  & "domain decomposition for the specified CellML environment.",err,error,*999)
2719  ENDIF
2720  ELSE
2721  CALL flagerror("The specified models field region is not associated.",err,error,*999)
2722  ENDIF
2723  ELSE
2724  CALL flagerror("The specified models field has not been finished.",err,error,*999)
2725  ENDIF
2726  ELSE
2727  !Check the user number has not already been used for a field in this region.
2728  NULLIFY(field)
2729  CALL field_user_number_find(model_field_user_number,region,field,err,error,*999)
2730  IF(ASSOCIATED(field)) THEN
2731  local_error="The specified models field user number of "// &
2732  & trim(number_to_vstring(model_field_user_number,"*",err,error))// &
2733  & "has already been used to create a field on region number "// &
2734  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
2735  CALL flagerror(local_error,err,error,*999)
2736  ENDIF
2737  ENDIF
2738  CALL cellml_models_field_initialise(cellml,err,error,*999)
2739  IF(ASSOCIATED(models_field)) THEN
2740  !Now check the supplied field.
2741  CALL field_data_type_check(models_field,field_u_variable_type,field_intg_type,err,error,*999)
2742  CALL field_type_check(models_field,field_general_type,err,error,*999)
2743  CALL field_number_of_variables_check(models_field,1,err,error,*999)
2744  CALL field_variable_types_check(models_field,[field_u_variable_type],err,error,*999)
2745  CALL field_number_of_components_check(models_field,field_u_variable_type,1,err,error,*999)
2746  CALL field_component_mesh_component_check(models_field,field_u_variable_type,1, &
2747  & cellml_field_maps%SOURCE_FIELD_DOMAIN%MESH_COMPONENT_NUMBER,err,error,*999)
2748  CALL field_component_interpolation_check(models_field,field_u_variable_type,1, &
2749  & cellml_field_maps%SOURCE_FIELD_INTERPOLATION_TYPE,err,error,*999)
2750  ELSE
2751  cellml%MODELS_FIELD%MODELS_FIELD_AUTO_CREATED=.true.
2752  !Create the CellML environment models field
2753  CALL field_create_start(model_field_user_number,region,cellml%MODELS_FIELD%MODELS_FIELD,err,error,*999)
2754  CALL field_data_type_set_and_lock(cellml%MODELS_FIELD%MODELS_FIELD,field_u_variable_type,field_intg_type, &
2755  & err,error,*999)
2756  CALL field_label_set(cellml%MODELS_FIELD%MODELS_FIELD,"CellMLModelsField",err,error,*999)
2757  CALL field_type_set_and_lock(cellml%MODELS_FIELD%MODELS_FIELD,field_general_type,err,error,*999)
2758  CALL field_mesh_decomposition_set_and_lock(cellml%MODELS_FIELD%MODELS_FIELD, &
2759  & cellml_field_maps%SOURCE_FIELD_DOMAIN%DECOMPOSITION,err,error,*999)
2760  CALL field_geometric_field_set_and_lock(cellml%MODELS_FIELD%MODELS_FIELD,cellml_field_maps% &
2761  & source_geometric_field,err,error,*999)
2762  CALL field_number_of_variables_set_and_lock(cellml%MODELS_FIELD%MODELS_FIELD,1,err,error,*999)
2763  CALL field_variable_types_set_and_lock(cellml%MODELS_FIELD%MODELS_FIELD,[field_u_variable_type],err,error,*999)
2764  CALL field_variable_label_set(cellml%MODELS_FIELD%MODELS_FIELD,field_u_variable_type,"ModelMap",err,error,*999)
2765  CALL field_dof_order_type_set(cellml%MODELS_FIELD%MODELS_FIELD,field_u_variable_type, &
2766  & field_contiguous_component_dof_order,err,error,*999)
2767  CALL field_number_of_components_set_and_lock(cellml%MODELS_FIELD%MODELS_FIELD,field_u_variable_type,1, &
2768  & err,error,*999)
2769  CALL field_component_label_set(cellml%MODELS_FIELD%MODELS_FIELD,field_u_variable_type,1,"ModelUserNumber", &
2770  & err,error,*999)
2771  CALL field_component_mesh_component_set_and_lock(cellml%MODELS_FIELD%MODELS_FIELD,field_u_variable_type,1, &
2772  & cellml_field_maps%SOURCE_FIELD_DOMAIN%MESH_COMPONENT_NUMBER,err,error,*999)
2773  CALL field_component_interpolation_set_and_lock(cellml%MODELS_FIELD%MODELS_FIELD,field_u_variable_type,1, &
2774  & cellml_field_maps%SOURCE_FIELD_INTERPOLATION_TYPE,err,error,*999)
2775  ENDIF
2776  !Set pointers
2777  IF(cellml%MODELS_FIELD%MODELS_FIELD_AUTO_CREATED) THEN
2778  models_field=>cellml%MODELS_FIELD%MODELS_FIELD
2779  ELSE
2780  cellml%MODELS_FIELD%MODELS_FIELD=>models_field
2781  ENDIF
2782  ELSE
2783  CALL flagerror("CellML fields map source field domain is not associated.",err,error,*999)
2784  ENDIF
2785  ELSE
2786  CALL flagerror("CellML fields map source geometric field is not associated.",err,error,*999)
2787  ENDIF
2788  ELSE
2789  CALL flagerror("CellML environment region is not associated.",err,error,*999)
2790  ENDIF
2791  ENDIF
2792  ELSE
2793  CALL flagerror("The CellML environment fields map has not been finished.",err,error,*999)
2794  ENDIF
2795  ELSE
2796  CALL flagerror("CellML environment fields map is not associated. You must create the CellML field maps first.", &
2797  & err,error,*999)
2798  ENDIF
2799  ELSE
2800  CALL flagerror("CellML environment is not associated",err,error,*999)
2801  ENDIF
2802 
2803 #else
2804 
2805  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
2806 
2807 #endif
2808 
2809  exits("CELLML_MODELS_FIELD_CREATE_START")
2810  RETURN
2811 999 errorsexits("CELLML_MODELS_FIELD_CREATE_START",err,error)
2812  RETURN 1
2813  END SUBROUTINE cellml_models_field_create_start
2814 
2815  !
2816  !=================================================================================================================================
2817  !
2818 
2820  SUBROUTINE cellml_models_field_create_finish(CELLML,ERR,ERROR,*)
2821  !Argument variables
2822  TYPE(cellml_type), POINTER :: CELLML
2823  INTEGER(INTG), INTENT(OUT) :: ERR
2824  TYPE(varying_string), INTENT(OUT) :: ERROR
2825  !Local variables
2826 
2827  enters("CELLML_MODELS_FIELD_CREATE_FINISH",err,error,*999)
2828 
2829 #ifdef WITH_CELLML
2830 
2831  IF(ASSOCIATED(cellml)) THEN
2832  IF(ASSOCIATED(cellml%MODELS_FIELD)) THEN
2833  IF(cellml%MODELS_FIELD%MODELS_FIELD_FINISHED) THEN
2834  CALL flagerror("CellML models field has already been finished.",err,error,*999)
2835  ELSE
2836  !Finish the models field creation
2837  IF(cellml%MODELS_FIELD%MODELS_FIELD_AUTO_CREATED) &
2838  & CALL field_create_finish(cellml%MODELS_FIELD%MODELS_FIELD,err,error,*999)
2839  cellml%MODELS_FIELD%MODELS_FIELD_FINISHED=.true.
2840 ! CALL FIELD_DOF_ORDER_TYPE_CHECK(CELLML%MODELS_FIELD%MODELS_FIELD,FIELD_U_VARIABLE_TYPE, &
2841 ! & FIELD_CONTIGUOUS_COMPONENT_DOF_ORDER,ERR,ERROR,*999)
2842  !Default the models field to the first model
2843  CALL field_component_values_initialise(cellml%MODELS_FIELD%MODELS_FIELD,field_u_variable_type, &
2844  & field_values_set_type,1,1,err,error,*999)
2845  ENDIF
2846  ELSE
2847  CALL flagerror("CellML environment models field is not associated.",err,error,*999)
2848  ENDIF
2849  ELSE
2850  CALL flagerror("CellML environement is not associated.",err,error,*999)
2851  ENDIF
2852 
2853 #else
2854 
2855  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
2856 
2857 #endif
2858 
2859  exits("CELLML_MODELS_FIELD_CREATE_FINISH")
2860  RETURN
2861 999 errorsexits("CELLML_MODELS_FIELD_CREATE_FINISH",err,error)
2862  RETURN 1
2863  END SUBROUTINE cellml_models_field_create_finish
2864 
2865  !
2866  !=================================================================================================================================
2867  !
2868 
2870  SUBROUTINE cellml_models_field_finalise(MODELS_FIELD,ERR,ERROR,*)
2871  !Argument variables
2872  TYPE(cellml_models_field_type), POINTER :: MODELS_FIELD
2873  INTEGER(INTG), INTENT(OUT) :: ERR
2874  TYPE(varying_string), INTENT(OUT) :: ERROR
2875  !Local variables
2876 
2877  enters("CELLML_MODELS_FIELD_FINALISE",err,error,*999)
2878 
2879 #ifdef WITH_CELLML
2880 
2881  IF(ASSOCIATED(models_field)) THEN
2882  DEALLOCATE(models_field)
2883  ENDIF
2884 
2885 #else
2886 
2887  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
2888 
2889 #endif
2890 
2891  exits("CELLML_MODELS_FIELD_FINALISE")
2892  RETURN
2893 999 errorsexits("CELLML_MODELS_FIELD_FINALISE",err,error)
2894  RETURN 1
2895  END SUBROUTINE cellml_models_field_finalise
2896 
2897  !
2898  !=================================================================================================================================
2899  !
2900 
2902  SUBROUTINE cellml_models_field_get(CELLML,MODELS_FIELD,ERR,ERROR,*)
2903 
2904  !Argument variables
2905  TYPE(cellml_type), POINTER :: CELLML
2906  TYPE(field_type), POINTER :: MODELS_FIELD
2907  INTEGER(INTG), INTENT(OUT) :: ERR
2908  TYPE(varying_string), INTENT(OUT) :: ERROR
2909  !Local variables
2910 
2911  enters("CELLML_MODELS_FIELD_GET",err,error,*999)
2912 
2913 #ifdef WITH_CELLML
2914 
2915  IF(ASSOCIATED(cellml)) THEN
2916  IF(ASSOCIATED(cellml%MODELS_FIELD)) THEN
2917  IF(cellml%MODELS_FIELD%MODELS_FIELD_FINISHED) THEN
2918  IF(ASSOCIATED(models_field)) THEN
2919  CALL flagerror("Models field is already associated.",err,error,*999)
2920  ELSE
2921  models_field=>cellml%MODELS_FIELD%MODELS_FIELD
2922  ENDIF
2923  ELSE
2924  CALL flagerror("CellML environment models field has not been finished.",err,error,*999)
2925  ENDIF
2926  ELSE
2927  CALL flagerror("CellML environment models field is not associated. Create the models field first.",err,error,*999)
2928  ENDIF
2929  ELSE
2930  CALL flagerror("CellML environment is not associated.",err,error,*999)
2931  ENDIF
2932 
2933 #else
2934 
2935  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
2936 
2937 #endif
2938 
2939  exits("CELLML_MODELS_FIELD_GET")
2940  RETURN
2941 999 errorsexits("CELLML_MODELS_FIELD_GET",err,error)
2942  RETURN 1
2943  END SUBROUTINE cellml_models_field_get
2944 
2945  !
2946  !=================================================================================================================================
2947  !
2948 
2950  SUBROUTINE cellml_models_field_initialise(CELLML,ERR,ERROR,*)
2951  !Argument variables
2952  TYPE(cellml_type), POINTER :: CELLML
2953  INTEGER(INTG), INTENT(OUT) :: ERR
2954  TYPE(varying_string), INTENT(OUT) :: ERROR
2955  !Local variables
2956  INTEGER(INTG) :: DUMMY_ERR
2957  TYPE(varying_string) :: DUMMY_ERROR
2958 
2959  enters("CELLML_MODELS_FIELD_INITIALISE",err,error,*998)
2960 
2961 #ifdef WITH_CELLML
2962 
2963  IF(ASSOCIATED(cellml)) THEN
2964  IF(ASSOCIATED(cellml%MODELS_FIELD)) THEN
2965  CALL flagerror("CellML environment models field is already associated.",err,error,*998)
2966  ELSE
2967  ALLOCATE(cellml%MODELS_FIELD,stat=err)
2968  IF(err/=0) CALL flagerror("Could not allocate CellML environment models field.",err,error,*999)
2969  cellml%MODELS_FIELD%CELLML=>cellml
2970  cellml%MODELS_FIELD%MODELS_FIELD_FINISHED=.false.
2971  cellml%MODELS_FIELD%MODELS_FIELD_AUTO_CREATED=.false.
2972  NULLIFY(cellml%MODELS_FIELD%MODELS_FIELD)
2973  cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX=cellml_models_field_not_checked
2974  ENDIF
2975  ELSE
2976  CALL flagerror("CellML environment is not associated.",err,error,*998)
2977  ENDIF
2978 
2979 #else
2980 
2981  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*998)
2982 
2983 #endif
2984 
2985  exits("CELLML_MODELS_FIELD_INITIALISE")
2986  RETURN
2987 999 CALL cellml_models_field_finalise(cellml%MODELS_FIELD,dummy_err,dummy_error,*998)
2988 998 errorsexits("CELLML_MODELS_FIELD_INITIALISE",err,error)
2989  RETURN 1
2990  END SUBROUTINE cellml_models_field_initialise
2991 
2992  !
2993  !=================================================================================================================================
2994  !
2995 
2997  SUBROUTINE cellml_state_field_create_start(STATE_FIELD_USER_NUMBER,CELLML,STATE_FIELD,ERR,ERROR,*)
2998  !Argument variables
2999  INTEGER(INTG), INTENT(IN) :: STATE_FIELD_USER_NUMBER
3000  TYPE(cellml_type), POINTER :: CELLML
3001  TYPE(field_type), POINTER :: STATE_FIELD
3002  INTEGER(INTG), INTENT(OUT) :: ERR
3003  TYPE(varying_string), INTENT(OUT) :: ERROR
3004  !Local variables
3005  INTEGER(INTG) :: component_idx
3006  TYPE(cellml_field_maps_type), POINTER :: CELLML_FIELD_MAPS
3007  TYPE(field_type), POINTER :: FIELD
3008  TYPE(region_type), POINTER :: REGION,STATE_FIELD_REGION
3009  TYPE(varying_string) :: LOCAL_ERROR
3010 
3011  enters("CELLML_STATE_FIELD_CREATE_START",err,error,*999)
3012 
3013 #ifdef WITH_CELLML
3014 
3015  IF(ASSOCIATED(cellml)) THEN
3016  cellml_field_maps=>cellml%FIELD_MAPS
3017  IF(ASSOCIATED(cellml_field_maps)) THEN
3018  IF(cellml_field_maps%CELLML_FIELD_MAPS_FINISHED) THEN
3019  IF(ASSOCIATED(cellml%STATE_FIELD)) THEN
3020  CALL flagerror("The CellML environment models field is already associated.",err,error,*999)
3021  ELSE
3022  region=>cellml%REGION
3023  IF(ASSOCIATED(region)) THEN
3024  IF(ASSOCIATED(cellml_field_maps%SOURCE_GEOMETRIC_FIELD)) THEN
3025  IF(ASSOCIATED(cellml_field_maps%SOURCE_FIELD_DOMAIN)) THEN
3026  IF(ASSOCIATED(state_field)) THEN
3027  !Check the field has been finished
3028  IF(state_field%FIELD_FINISHED) THEN
3029  !Check the user numbers match
3030  IF(state_field_user_number/=state_field%USER_NUMBER) THEN
3031  local_error="The specified state field user number of "// &
3032  & trim(number_to_vstring(state_field_user_number,"*",err,error))// &
3033  & " does not match the user number of the specified state field of "// &
3034  & trim(number_to_vstring(state_field%USER_NUMBER,"*",err,error))//"."
3035  CALL flagerror(local_error,err,error,*999)
3036  ENDIF
3037  state_field_region=>state_field%REGION
3038  IF(ASSOCIATED(state_field_region)) THEN
3039  !Check the field is defined on the same region as the CellML region
3040  IF(state_field_region%USER_NUMBER/=region%USER_NUMBER) THEN
3041  local_error="Invalid region setup. The specified state field has been created on region number "// &
3042  & trim(number_to_vstring(state_field_region%USER_NUMBER,"*",err,error))// &
3043  & " and the CellML environment has been created on region number "// &
3044  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
3045  CALL flagerror(local_error,err,error,*999)
3046  ENDIF
3047  !Check the specified models field has the same geometric field as the source field
3048  IF(.NOT.ASSOCIATED(cellml_field_maps%SOURCE_GEOMETRIC_FIELD,state_field%GEOMETRIC_FIELD)) THEN
3049  CALL flagerror("The specified state field does not have the same geometric field as the "// &
3050  & "geometric field for the specified CellML environment.",err,error,*999)
3051  ENDIF
3052  !Check the specified models field has the same decomposition as the source field
3053  IF(.NOT.ASSOCIATED(cellml_field_maps%SOURCE_FIELD_DOMAIN%DECOMPOSITION,state_field%DECOMPOSITION)) THEN
3054  CALL flagerror("The specified state field does not have the same decomposition as the source "// &
3055  & "domain decomposition for the specified CellML environment.",err,error,*999)
3056  ENDIF
3057  ELSE
3058  CALL flagerror("The specified state field region is not associated.",err,error,*999)
3059  ENDIF
3060  ELSE
3061  CALL flagerror("The specified state field has not been finished.",err,error,*999)
3062  ENDIF
3063  ELSE
3064  !Check the user number has not already been used for a field in this region.
3065  NULLIFY(field)
3066  CALL field_user_number_find(state_field_user_number,region,field,err,error,*999)
3067  IF(ASSOCIATED(field)) THEN
3068  local_error="The specified state field user number of "// &
3069  & trim(number_to_vstring(state_field_user_number,"*",err,error))// &
3070  & "has already been used to create a field on region number "// &
3071  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
3072  CALL flagerror(local_error,err,error,*999)
3073  ENDIF
3074  ENDIF
3075  CALL cellml_state_field_initialise(cellml,err,error,*999)
3076  IF(ASSOCIATED(state_field)) THEN
3077  !Now check the supplied field.
3078  CALL field_data_type_check(state_field,field_u_variable_type,field_dp_type,err,error,*999)
3079  CALL field_type_check(state_field,field_general_type,err,error,*999)
3080  CALL field_number_of_variables_check(state_field,1,err,error,*999)
3081  CALL field_variable_types_check(state_field,[field_u_variable_type],err,error,*999)
3082  CALL field_number_of_components_check(state_field,field_u_variable_type,cellml%MAXIMUM_NUMBER_OF_STATE, &
3083  & err,error,*999)
3084  DO component_idx=1,cellml%MAXIMUM_NUMBER_OF_STATE
3085  CALL field_component_mesh_component_check(state_field,field_u_variable_type, &
3086  & component_idx,cellml_field_maps%SOURCE_FIELD_DOMAIN%MESH_COMPONENT_NUMBER,err,error,*999)
3087  CALL field_component_interpolation_check(state_field,field_u_variable_type, &
3088  & component_idx,cellml_field_maps%SOURCE_FIELD_INTERPOLATION_TYPE,err,error,*999)
3089  ENDDO !component_idx
3090  ELSE
3091  cellml%STATE_FIELD%STATE_FIELD_AUTO_CREATED=.true.
3092  !Create the CellML environment models field
3093  CALL field_create_start(state_field_user_number,region,cellml%STATE_FIELD%STATE_FIELD,err,error,*999)
3094  CALL field_data_type_set_and_lock(cellml%STATE_FIELD%STATE_FIELD,field_u_variable_type,field_dp_type, &
3095  & err,error,*999)
3096  CALL field_label_set(cellml%STATE_FIELD%STATE_FIELD,"CellMLStateField",err,error,*999)
3097  CALL field_type_set_and_lock(cellml%STATE_FIELD%STATE_FIELD,field_general_type,err,error,*999)
3098  CALL field_mesh_decomposition_set_and_lock(cellml%STATE_FIELD%STATE_FIELD, &
3099  & cellml_field_maps%SOURCE_FIELD_DOMAIN%DECOMPOSITION,err,error,*999)
3100  CALL field_geometric_field_set_and_lock(cellml%STATE_FIELD%STATE_FIELD,cellml_field_maps% &
3101  & source_geometric_field,err,error,*999)
3102  CALL field_number_of_variables_set_and_lock(cellml%STATE_FIELD%STATE_FIELD,1,err,error,*999)
3103  CALL field_variable_types_set_and_lock(cellml%STATE_FIELD%STATE_FIELD,[field_u_variable_type],err,error,*999)
3104  CALL field_variable_label_set(cellml%STATE_FIELD%STATE_FIELD,field_u_variable_type,"StateVariable", &
3105  & err,error,*999)
3106  CALL field_dof_order_type_set(cellml%STATE_FIELD%STATE_FIELD,field_u_variable_type, &
3107  & field_contiguous_component_dof_order,err,error,*999)
3108  CALL field_number_of_components_set_and_lock(cellml%STATE_FIELD%STATE_FIELD,field_u_variable_type,&
3109  & cellml%MAXIMUM_NUMBER_OF_STATE,err,error,*999)
3110  DO component_idx=1,cellml%MAXIMUM_NUMBER_OF_STATE
3111  CALL field_component_mesh_component_set_and_lock(cellml%STATE_FIELD%STATE_FIELD,field_u_variable_type, &
3112  & component_idx,cellml_field_maps%SOURCE_FIELD_DOMAIN%MESH_COMPONENT_NUMBER,err,error,*999)
3113  CALL field_component_interpolation_set_and_lock(cellml%STATE_FIELD%STATE_FIELD,field_u_variable_type, &
3114  & component_idx,cellml_field_maps%SOURCE_FIELD_INTERPOLATION_TYPE,err,error,*999)
3115  ENDDO !component_idx
3116  ENDIF
3117  !Set pointers
3118  IF(cellml%STATE_FIELD%STATE_FIELD_AUTO_CREATED) THEN
3119  state_field=>cellml%STATE_FIELD%STATE_FIELD
3120  ELSE
3121  cellml%STATE_FIELD%STATE_FIELD=>state_field
3122  ENDIF
3123  ELSE
3124  CALL flagerror("CellML field maps source field domain is not associated.",err,error,*999)
3125  ENDIF
3126  ELSE
3127  CALL flagerror("CellML field mapssource geometric field is not associated.",err,error,*999)
3128  ENDIF
3129  ELSE
3130  CALL flagerror("CellML environment region is not associated.",err,error,*999)
3131  ENDIF
3132  ENDIF
3133  ELSE
3134  CALL flagerror("The CellML environment fields map has not been finished.",err,error,*999)
3135  ENDIF
3136  ELSE
3137  CALL flagerror("CellML environment fields map is not associated. You must create the CellML field maps first.", &
3138  & err,error,*999)
3139  ENDIF
3140  ELSE
3141  CALL flagerror("CellML environment is not associated",err,error,*999)
3142  ENDIF
3143 
3144 #else
3145 
3146  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
3147 
3148 #endif
3149 
3150  exits("CELLML_STATE_FIELD_CREATE_START")
3151  RETURN
3152 999 errorsexits("CELLML_STATE_FIELD_CREATE_START",err,error)
3153  RETURN 1
3154  END SUBROUTINE cellml_state_field_create_start
3155 
3156  !
3157  !=================================================================================================================================
3158  !
3159 
3163  SUBROUTINE cellml_state_field_create_finish(CELLML,ERR,ERROR,*)
3164  !Argument variables
3165  TYPE(cellml_type), POINTER :: CELLML
3166  INTEGER(INTG), INTENT(OUT) :: ERR
3167  TYPE(varying_string), INTENT(OUT) :: ERROR
3168  !Local variables
3169  INTEGER(INTG) :: model_idx,models_dof_idx,state_component_idx,CELLML_VARIABLE_TYPE
3170  INTEGER(INTG), POINTER :: MODELS_DATA(:)
3171  REAL(DP) :: INITIAL_VALUE
3172  TYPE(field_variable_type), POINTER :: MODELS_VARIABLE
3173  TYPE(cellml_model_type), POINTER :: MODEL
3174  TYPE(varying_string) :: LOCAL_ERROR
3175 
3176  enters("CELLML_STATE_FIELD_CREATE_FINISH",err,error,*999)
3177 
3178 #ifdef WITH_CELLML
3179 
3180  IF(ASSOCIATED(cellml)) THEN
3181  IF(ASSOCIATED(cellml%STATE_FIELD)) THEN
3182  IF(cellml%STATE_FIELD%STATE_FIELD_FINISHED) THEN
3183  CALL flagerror("CellML state field has already been finished.",err,error,*999)
3184  ELSE
3185  IF(ASSOCIATED(cellml%MODELS_FIELD)) THEN
3186  IF(cellml%MODELS_FIELD%MODELS_FIELD_FINISHED) THEN
3187  CALL cellml_models_field_check(cellml%MODELS_FIELD,err,error,*999)
3188  !Finish the state field creation
3189  IF(cellml%STATE_FIELD%STATE_FIELD_AUTO_CREATED) &
3190  & CALL field_create_finish(cellml%STATE_FIELD%STATE_FIELD,err,error,*999)
3191 ! CALL FIELD_DOF_ORDER_TYPE_CHECK(CELLML%STATE_FIELD%STATE_FIELD,FIELD_U_VARIABLE_TYPE, &
3192 ! & FIELD_CONTIGUOUS_COMPONENT_DOF_ORDER,ERR,ERROR,*999)
3193  !Set the default field values to the initial CellML values.
3194  IF(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX/=cellml_models_field_not_constant) THEN
3195  !Only one model so optimise
3196  model=>cellml%MODELS(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX)%PTR
3197  IF(ASSOCIATED(model)) THEN
3198  DO state_component_idx=1,model%NUMBER_OF_STATE
3199  cellml_variable_type=map_cellml_field_type_to_variable_type(cellml_state_field,err,error)
3200  err = cellml_model_definition_get_initial_value_by_index(model%PTR,cellml_variable_type,&
3201  & state_component_idx,initial_value)
3202  IF(err /= 0) THEN
3203  !problem getting the initial value
3204  local_error="Failed to get an initial value for state variable with index "//&
3205  & trim(number_to_vstring(state_component_idx,"*",err,error))//"."
3206  CALL flagerror(local_error,err,error,*999)
3207  ENDIF
3208  !WRITE(*,*) '(single model) Initial value for state variable: ',state_component_idx,'; type: ',&
3209  ! & CELLML_VARIABLE_TYPE,'; value = ',INITIAL_VALUE
3210  CALL field_component_values_initialise(cellml%STATE_FIELD%STATE_FIELD,field_u_variable_type, &
3211  & field_values_set_type,state_component_idx,initial_value,err,error,*999)
3212  ENDDO !state_component_idx
3213  ELSE
3214  local_error="The model is not associated for model index "// &
3215  & trim(number_to_vstring(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX,"*",err,error))//"."
3216  CALL flagerror(local_error,err,error,*999)
3217  ENDIF
3218  ELSE
3219  !Multiple models so go through each dof.
3220  IF(ASSOCIATED(cellml%FIELD_MAPS)) THEN
3221  NULLIFY(models_variable)
3222  CALL field_variable_get(cellml%MODELS_FIELD%MODELS_FIELD,field_u_variable_type,models_variable,err,error,*999)
3223  NULLIFY(models_data)
3224  CALL field_parameter_set_data_get(cellml%MODELS_FIELD%MODELS_FIELD,field_u_variable_type, &
3225  & field_values_set_type,models_data,err,error,*999)
3226  DO models_dof_idx=1,models_variable%NUMBER_OF_DOFS
3227  model_idx=models_data(models_dof_idx)
3228  IF(model_idx>0) THEN
3229  model=>cellml%MODELS(model_idx)%PTR
3230  IF(ASSOCIATED(model)) THEN
3231  DO state_component_idx=1,model%NUMBER_OF_STATE
3232  cellml_variable_type=map_cellml_field_type_to_variable_type(cellml_state_field,err,error)
3233  IF(err/=0) GOTO 999
3234  err = cellml_model_definition_get_initial_value_by_index(model%PTR,cellml_variable_type,&
3235  & state_component_idx,initial_value)
3236  IF(err /= 0) THEN
3237  !problem getting the initial value
3238  local_error="Failed to get an initial value for state variable with index "//&
3239  & trim(number_to_vstring(state_component_idx,"*",err,error))//"."
3240  CALL flagerror(local_error,err,error,*999)
3241  ENDIF
3242  !WRITE(*,*) '(multiple models) Initial value for state variable: ',state_component_idx,'; type: ',&
3243  ! & CELLML_VARIABLE_TYPE,'; value = ',INITIAL_VALUE
3244  CALL cellml_fieldmodeldofset(models_variable,models_dof_idx,cellml%STATE_FIELD%STATE_FIELD, &
3245  & field_u_variable_type,field_values_set_type,state_component_idx,initial_value,err,error,*999)
3246  ENDDO !state_component_idx
3247  ELSE
3248  local_error="The model is not associated for model index "// &
3249  & trim(number_to_vstring(model_idx,"*",err,error))//"."
3250  CALL flagerror(local_error,err,error,*999)
3251  ENDIF
3252  ENDIF
3253  ENDDO !dofIdx
3254  CALL field_parameter_set_data_restore(cellml%MODELS_FIELD%MODELS_FIELD,field_u_variable_type, &
3255  & field_values_set_type,models_data,err,error,*999)
3256  ELSE
3257  CALL flagerror("CellML environment field maps is not associated.",err,error,*999)
3258  ENDIF
3259  ENDIF
3260  cellml%STATE_FIELD%STATE_FIELD_FINISHED=.true.
3261  ELSE
3262  CALL flagerror("CellML environment models field has not been finished.",err,error,*999)
3263  ENDIF
3264  ELSE
3265  CALL flagerror("CellML environment models field is not associated.",err,error,*999)
3266  ENDIF
3267  ENDIF
3268  ELSE
3269  CALL flagerror("CellML environment state field is not associated.",err,error,*999)
3270  ENDIF
3271  ELSE
3272  CALL flagerror("CellML environment is not associated.",err,error,*999)
3273  ENDIF
3274 
3275 #else
3276 
3277  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
3278 
3279 #endif
3280 
3281  exits("CELLML_STATE_FIELD_CREATE_FINISH")
3282  RETURN
3283 999 errorsexits("CELLML_STATE_FIELD_CREATE_FINISH",err,error)
3284  RETURN 1
3285  END SUBROUTINE cellml_state_field_create_finish
3286 
3287  !
3288  !=================================================================================================================================
3289  !
3290 
3292  SUBROUTINE cellml_state_field_finalise(STATE_FIELD,ERR,ERROR,*)
3293  !Argument variables
3294  TYPE(cellml_state_field_type), POINTER :: STATE_FIELD
3295  INTEGER(INTG), INTENT(OUT) :: ERR
3296  TYPE(varying_string), INTENT(OUT) :: ERROR
3297  !Local variables
3298 
3299  enters("CELLML_STATE_FIELD_FINALISE",err,error,*999)
3300 
3301 #ifdef WITH_CELLML
3302 
3303  IF(ASSOCIATED(state_field)) THEN
3304  DEALLOCATE(state_field)
3305  ENDIF
3306 
3307 #else
3308 
3309  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
3310 
3311 #endif
3312 
3313  exits("CELLML_STATE_FIELD_FINALISE")
3314  RETURN
3315 999 errorsexits("CELLML_STATE_FIELD_FINALISE",err,error)
3316  RETURN 1
3317  END SUBROUTINE cellml_state_field_finalise
3318 
3319  !
3320  !=================================================================================================================================
3321  !
3322 
3324  SUBROUTINE cellml_state_field_get(CELLML,STATE_FIELD,ERR,ERROR,*)
3325 
3326  !Argument variables
3327  TYPE(cellml_type), POINTER :: CELLML
3328  TYPE(field_type), POINTER :: STATE_FIELD
3329  INTEGER(INTG), INTENT(OUT) :: ERR
3330  TYPE(varying_string), INTENT(OUT) :: ERROR
3331  !Local variables
3332 
3333  enters("CELLML_STATE_FIELD_GET",err,error,*999)
3334 
3335 #ifdef WITH_CELLML
3336 
3337  IF(ASSOCIATED(cellml)) THEN
3338  IF(ASSOCIATED(cellml%STATE_FIELD)) THEN
3339  IF(cellml%STATE_FIELD%STATE_FIELD_FINISHED) THEN
3340  IF(ASSOCIATED(state_field)) THEN
3341  CALL flagerror("State field is already associated.",err,error,*999)
3342  ELSE
3343  state_field=>cellml%STATE_FIELD%STATE_FIELD
3344  ENDIF
3345  ELSE
3346  CALL flagerror("CellML environment state field has not been finished.",err,error,*999)
3347  ENDIF
3348  ELSE
3349  CALL flagerror("CellML environment state field is not associated. Create the state field first.",err,error,*999)
3350  ENDIF
3351  ELSE
3352  CALL flagerror("CellML environment is not associated.",err,error,*999)
3353  ENDIF
3354 
3355 #else
3356 
3357  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
3358 
3359 #endif
3360 
3361  exits("CELLML_STATE_FIELD_GET")
3362  RETURN
3363 999 errorsexits("CELLML_STATE_FIELD_GET",err,error)
3364  RETURN 1
3365  END SUBROUTINE cellml_state_field_get
3366 
3367  !
3368  !=================================================================================================================================
3369  !
3370 
3372  SUBROUTINE cellml_state_field_initialise(CELLML,ERR,ERROR,*)
3373  !Argument variables
3374  TYPE(cellml_type), POINTER :: CELLML
3375  INTEGER(INTG), INTENT(OUT) :: ERR
3376  TYPE(varying_string), INTENT(OUT) :: ERROR
3377  !Local variables
3378  INTEGER(INTG) :: DUMMY_ERR
3379  TYPE(varying_string) :: DUMMY_ERROR
3380 
3381  enters("CELLML_STATE_FIELD_INITIALISE",err,error,*998)
3382 
3383 #ifdef WITH_CELLML
3384 
3385  IF(ASSOCIATED(cellml)) THEN
3386  IF(ASSOCIATED(cellml%STATE_FIELD)) THEN
3387  CALL flagerror("CellML environment state field is already associated.",err,error,*998)
3388  ELSE
3389  ALLOCATE(cellml%STATE_FIELD,stat=err)
3390  IF(err/=0) CALL flagerror("Could not allocate CellML environment state field.",err,error,*999)
3391  cellml%STATE_FIELD%CELLML=>cellml
3392  cellml%STATE_FIELD%STATE_FIELD_FINISHED=.false.
3393  cellml%STATE_FIELD%STATE_FIELD_AUTO_CREATED=.false.
3394  NULLIFY(cellml%STATE_FIELD%STATE_FIELD)
3395  ENDIF
3396  ELSE
3397  CALL flagerror("CellML environment is not associated.",err,error,*998)
3398  ENDIF
3399 
3400 #else
3401 
3402  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*998)
3403 
3404 #endif
3405 
3406  exits("CELLML_STATE_FIELD_INITIALISE")
3407  RETURN
3408 999 CALL cellml_state_field_finalise(cellml%STATE_FIELD,dummy_err,dummy_error,*998)
3409 998 errorsexits("CELLML_STATE_FIELD_INITIALISE",err,error)
3410  RETURN 1
3411  END SUBROUTINE cellml_state_field_initialise
3412 
3413  !
3414  !=================================================================================================================================
3415  !
3416 
3422  SUBROUTINE cellml_field_component_get_c(CELLML,MODEL_INDEX,CELLML_FIELD_TYPE,VARIABLE_ID,COMPONENT_USER_NUMBER,ERR,ERROR,*)
3423  !Argument variables
3424  TYPE(cellml_type), POINTER :: CELLML
3425  INTEGER(INTG), INTENT(IN) :: MODEL_INDEX
3426  INTEGER(INTG), INTENT(IN) :: CELLML_FIELD_TYPE
3427  CHARACTER(LEN=*), INTENT(IN) :: VARIABLE_ID
3428  INTEGER(INTG), INTENT(OUT) :: COMPONENT_USER_NUMBER
3429  INTEGER(INTG), INTENT(OUT) :: ERR
3430  TYPE(varying_string), INTENT(OUT) :: ERROR
3431  !Local variables
3432  INTEGER(INTG) :: CELLML_VARIABLE_INDEX
3433  INTEGER(C_INT) :: ERROR_C
3434  TYPE(cellml_model_type), POINTER :: CELLML_MODEL
3435  TYPE(varying_string) :: LOCAL_ERROR
3436  CHARACTER(LEN=1,KIND=C_CHAR) :: C_NAME(maxstrlen)
3437  !INTEGER(INTG) :: C_NAME_L
3438 
3439  enters("CELLML_FIELD_COMPONENT_GET_C",err,error,*999)
3440 
3441 #ifdef WITH_CELLML
3442 
3443  IF(ASSOCIATED(cellml)) THEN
3444  cellml_model=>cellml%MODELS(model_index)%PTR
3445  IF(ASSOCIATED(cellml_model)) THEN
3446  CALL cmissf2cstring(variable_id,c_name)
3447  error_c = cellml_model_definition_get_variable_index(cellml_model%PTR,c_name,cellml_variable_index)
3448  IF(error_c /= 0) THEN
3449  local_error="Failed to get the index for CellML variable: "// &
3450  & variable_id//"; with the error code: "//trim(number_to_vstring(error_c,"*",err,error))
3451  CALL flagerror(local_error,err,error,*999)
3452  ENDIF
3453  component_user_number=cellml_variable_index
3454  ENDIF
3455  ELSE
3456  CALL flagerror("CellML environment is not associated.",err,error,*999)
3457  ENDIF
3458 
3459 #else
3460 
3461  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
3462 
3463 #endif
3464 
3465  exits("CELLML_FIELD_COMPONENT_GET_C")
3466  RETURN
3467 999 errorsexits("CELLML_FIELD_COMPONENT_GET_C",err,error)
3468  RETURN 1
3469  END SUBROUTINE cellml_field_component_get_c
3470  !
3471  !=================================================================================================================================
3472  !
3473 
3478  SUBROUTINE cellml_field_component_get_vs(CELLML,MODEL_INDEX,CELLML_FIELD_TYPE,VARIABLE_ID,COMPONENT_USER_NUMBER,ERR,ERROR,*)
3479  !Argument variables
3480  TYPE(cellml_type), POINTER :: CELLML
3481  INTEGER(INTG), INTENT(IN) :: MODEL_INDEX
3482  INTEGER(INTG), INTENT(IN) :: CELLML_FIELD_TYPE
3483  TYPE(varying_string), INTENT(IN) :: VARIABLE_ID
3484  INTEGER(INTG), INTENT(OUT) :: COMPONENT_USER_NUMBER
3485  INTEGER(INTG), INTENT(OUT) :: ERR
3486  TYPE(varying_string), INTENT(OUT) :: ERROR
3487  !Local variables
3488 
3489  enters("CELLML_FIELD_COMPONENT_GET_VS",err,error,*999)
3490 
3491 #ifdef WITH_CELLML
3492 
3493  CALL cellml_field_component_get(cellml,model_index,cellml_field_type,char(variable_id),component_user_number,err,error,*999)
3494 
3495 #else
3496 
3497  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
3498 
3499 #endif
3500 
3501  exits("CELLML_FIELD_COMPONENT_GET_VS")
3502  RETURN
3503 999 errorsexits("CELLML_FIELD_COMPONENT_GET_VS",err,error)
3504  RETURN 1
3505  END SUBROUTINE cellml_field_component_get_vs
3506 
3507  !
3508  !=================================================================================================================================
3509  !
3510 
3512  SUBROUTINE cellml_intermediate_field_create_start(INTERMEDIATE_FIELD_USER_NUMBER,CELLML,INTERMEDIATE_FIELD,ERR,ERROR,*)
3513  !Argument variables
3514  INTEGER(INTG), INTENT(IN) :: INTERMEDIATE_FIELD_USER_NUMBER
3515  TYPE(cellml_type), POINTER :: CELLML
3516  TYPE(field_type), POINTER :: INTERMEDIATE_FIELD
3517  INTEGER(INTG), INTENT(OUT) :: ERR
3518  TYPE(varying_string), INTENT(OUT) :: ERROR
3519  !Local variables
3520  INTEGER(INTG) :: component_idx
3521  TYPE(cellml_field_maps_type), POINTER :: CELLML_FIELD_MAPS
3522  TYPE(field_type), POINTER :: FIELD
3523  TYPE(region_type), POINTER :: REGION,INTERMEDIATE_FIELD_REGION
3524  TYPE(varying_string) :: LOCAL_ERROR
3525 
3526  enters("CELLML_INTERMEDIATE_FIELD_CREATE_START",err,error,*999)
3527 
3528 #ifdef WITH_CELLML
3529 
3530  IF(ASSOCIATED(cellml)) THEN
3531  cellml_field_maps=>cellml%FIELD_MAPS
3532  IF(ASSOCIATED(cellml_field_maps)) THEN
3533  IF(cellml_field_maps%CELLML_FIELD_MAPS_FINISHED) THEN
3534  IF(ASSOCIATED(cellml%INTERMEDIATE_FIELD)) THEN
3535  CALL flagerror("The CellML environment models field is already associated.",err,error,*999)
3536  ELSE
3537  region=>cellml%REGION
3538  IF(ASSOCIATED(region)) THEN
3539  IF(ASSOCIATED(cellml_field_maps%SOURCE_GEOMETRIC_FIELD)) THEN
3540  IF(ASSOCIATED(cellml_field_maps%SOURCE_FIELD_DOMAIN)) THEN
3541  IF(ASSOCIATED(intermediate_field)) THEN
3542  !Check the field has been finished
3543  IF(intermediate_field%FIELD_FINISHED) THEN
3544  !Check the user numbers match
3545  IF(intermediate_field_user_number/=intermediate_field%USER_NUMBER) THEN
3546  local_error="The specified intermediate field user number of "// &
3547  & trim(number_to_vstring(intermediate_field_user_number,"*",err,error))// &
3548  & " does not match the user number of the specified intermediate field of "// &
3549  & trim(number_to_vstring(intermediate_field%USER_NUMBER,"*",err,error))//"."
3550  CALL flagerror(local_error,err,error,*999)
3551  ENDIF
3552  intermediate_field_region=>intermediate_field%REGION
3553  IF(ASSOCIATED(intermediate_field_region)) THEN
3554  !Check the field is defined on the same region as the CellML region
3555  IF(intermediate_field_region%USER_NUMBER/=region%USER_NUMBER) THEN
3556  local_error="Invalid region setup. The specified intermediate field has been created on region"// &
3557  & " number "//trim(number_to_vstring(intermediate_field_region%USER_NUMBER,"*",err,error))// &
3558  & " and the specified CellML environment has been created on region number "// &
3559  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
3560  CALL flagerror(local_error,err,error,*999)
3561  ENDIF
3562  !Check the specified intermediate field has the same geometric field as the source field
3563  IF(.NOT.ASSOCIATED(cellml_field_maps%SOURCE_GEOMETRIC_FIELD,intermediate_field%GEOMETRIC_FIELD)) THEN
3564  CALL flagerror("The specified intermediate field does not have the same geometric field as the "// &
3565  & "geometric field for the specified CellML environment.",err,error,*999)
3566  ENDIF
3567  !Check the specified intermediate field has the same decomposition as the source field
3568  IF(.NOT.ASSOCIATED(cellml_field_maps%SOURCE_FIELD_DOMAIN%DECOMPOSITION, &
3569  & intermediate_field%DECOMPOSITION)) THEN
3570  CALL flagerror("The specified intermediate field does not have the same decomposition as the source "// &
3571  & "domain decomposition for the specified CellML environment.",err,error,*999)
3572  ENDIF
3573  ELSE
3574  CALL flagerror("The specified intermediate field region is not associated.",err,error,*999)
3575  ENDIF
3576  ELSE
3577  CALL flagerror("The specified intermediate field has not been finished.",err,error,*999)
3578  ENDIF
3579  ELSE
3580  !Check the user number has not already been used for a field in this region.
3581  NULLIFY(field)
3582  CALL field_user_number_find(intermediate_field_user_number,region,field,err,error,*999)
3583  IF(ASSOCIATED(field)) THEN
3584  local_error="The specified intermediate field user number of "// &
3585  & trim(number_to_vstring(intermediate_field_user_number,"*",err,error))// &
3586  & "has already been used to create a field on region number "// &
3587  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
3588  CALL flagerror(local_error,err,error,*999)
3589  ENDIF
3590  ENDIF
3591  CALL cellml_intermediate_field_initialise(cellml,err,error,*999)
3592  IF(ASSOCIATED(intermediate_field)) THEN
3593  !Now check the supplied field.
3594  CALL field_data_type_check(intermediate_field,field_u_variable_type,field_dp_type,err,error,*999)
3595  CALL field_type_check(intermediate_field,field_general_type,err,error,*999)
3596  CALL field_number_of_variables_check(intermediate_field,1,err,error,*999)
3597  CALL field_variable_types_check(intermediate_field,[field_u_variable_type],err,error,*999)
3598  CALL field_number_of_components_check(intermediate_field,field_u_variable_type, &
3599  & cellml%MAXIMUM_NUMBER_OF_INTERMEDIATE,err,error,*999)
3600  DO component_idx=1,cellml%MAXIMUM_NUMBER_OF_INTERMEDIATE
3601  CALL field_component_mesh_component_check(intermediate_field,field_u_variable_type,component_idx, &
3602  & cellml_field_maps%SOURCE_FIELD_DOMAIN%MESH_COMPONENT_NUMBER,err,error,*999)
3603  CALL field_component_interpolation_check(intermediate_field,field_u_variable_type,component_idx, &
3604  & cellml_field_maps%SOURCE_FIELD_INTERPOLATION_TYPE,err,error,*999)
3605  ENDDO !component_idx
3606  ELSE
3607  cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD_AUTO_CREATED=.true.
3608  !Create the CellML environment intermediate field
3609  CALL field_create_start(intermediate_field_user_number,region,cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD, &
3610  & err,error,*999)
3611  CALL field_data_type_set_and_lock(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD,field_u_variable_type, &
3612  & field_dp_type,err,error,*999)
3613  CALL field_label_set(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD,"CellMLIntermediateField",err,error,*999)
3614  CALL field_type_set_and_lock(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD,field_general_type,err,error,*999)
3615  CALL field_mesh_decomposition_set_and_lock(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD, &
3616  & cellml_field_maps%SOURCE_FIELD_DOMAIN%DECOMPOSITION,err,error,*999)
3617  CALL field_geometric_field_set_and_lock(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD,cellml_field_maps% &
3618  & source_geometric_field,err,error,*999)
3619  CALL field_number_of_variables_set_and_lock(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD,1,err,error,*999)
3620  CALL field_variable_types_set_and_lock(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD,[field_u_variable_type], &
3621  & err,error,*999)
3622  CALL field_variable_label_set(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD,field_u_variable_type, &
3623  & "IntermediateVariable",err,error,*999)
3624  CALL field_dof_order_type_set(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD,field_u_variable_type, &
3625  & field_contiguous_component_dof_order,err,error,*999)
3626  CALL field_number_of_components_set_and_lock(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD, &
3627  & field_u_variable_type,cellml%MAXIMUM_NUMBER_OF_INTERMEDIATE,err,error,*999)
3628  DO component_idx=1,cellml%MAXIMUM_NUMBER_OF_INTERMEDIATE
3629  CALL field_component_mesh_component_set_and_lock(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD, &
3630  & field_u_variable_type,component_idx,cellml_field_maps%SOURCE_FIELD_DOMAIN%MESH_COMPONENT_NUMBER, &
3631  & err,error,*999)
3632  CALL field_component_interpolation_set_and_lock(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD, &
3633  & field_u_variable_type,component_idx,cellml_field_maps%SOURCE_FIELD_INTERPOLATION_TYPE,err,error,*999)
3634  ENDDO !component_idx
3635  ENDIF
3636  !Set pointers
3637  IF(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD_AUTO_CREATED) THEN
3638  intermediate_field=>cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD
3639  ELSE
3640  cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD=>intermediate_field
3641  ENDIF
3642  ELSE
3643  CALL flagerror("CellML field maps source field domain is not associated.",err,error,*999)
3644  ENDIF
3645  ELSE
3646  CALL flagerror("CellML field maps source geometric field is not associated.",err,error,*999)
3647  ENDIF
3648  ELSE
3649  CALL flagerror("CellML environment region is not associated.",err,error,*999)
3650  ENDIF
3651  ENDIF
3652  ELSE
3653  CALL flagerror("The CellML environment fields map has not been finished.",err,error,*999)
3654  ENDIF
3655  ELSE
3656  CALL flagerror("CellML environment fields map is not associated. You must create the CellML field maps first.", &
3657  & err,error,*999)
3658  ENDIF
3659  ELSE
3660  CALL flagerror("CellML environment is not associated",err,error,*999)
3661  ENDIF
3662 
3663 #else
3664 
3665  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
3666 
3667 #endif
3668 
3669  exits("CELLML_INTERMEDIATE_FIELD_CREATE_START")
3670  RETURN
3671 999 errorsexits("CELLML_INTERMEDIATE_FIELD_CREATE_START",err,error)
3672  RETURN 1
3673  END SUBROUTINE cellml_intermediate_field_create_start
3674 
3675  !
3676  !=================================================================================================================================
3677  !
3678 
3683  SUBROUTINE cellml_intermediate_field_create_finish(CELLML,ERR,ERROR,*)
3684  !Argument variables
3685  TYPE(cellml_type), POINTER :: CELLML
3686  INTEGER(INTG), INTENT(OUT) :: ERR
3687  TYPE(varying_string), INTENT(OUT) :: ERROR
3688  !Local variables
3689 
3690  enters("CELLML_INTERMEDIATE_FIELD_CREATE_FINISH",err,error,*999)
3691 
3692 #ifdef WITH_CELLML
3693 
3694  IF(ASSOCIATED(cellml)) THEN
3695  IF(ASSOCIATED(cellml%INTERMEDIATE_FIELD)) THEN
3696  IF(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD_FINISHED) THEN
3697  CALL flagerror("CellML intermediate field has already been finished.",err,error,*999)
3698  ELSE
3699  IF(ASSOCIATED(cellml%MODELS_FIELD)) THEN
3700  IF(cellml%MODELS_FIELD%MODELS_FIELD_FINISHED) THEN
3701  CALL cellml_models_field_check(cellml%MODELS_FIELD,err,error,*999)
3702 ! CALL FIELD_DOF_ORDER_TYPE_CHECK(CELLML%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD,FIELD_U_VARIABLE_TYPE, &
3703 ! & FIELD_CONTIGUOUS_COMPONENT_DOF_ORDER,ERR,ERROR,*999)
3704  !Finish the intermediate field creation
3705  IF(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD_AUTO_CREATED) &
3706  & CALL field_create_finish(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD,err,error,*999)
3707  !As the intermediate field is strictly output do not initialise the values.
3708  cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD_FINISHED=.true.
3709  ELSE
3710  CALL flagerror("CellML environment models field has not been finished.",err,error,*999)
3711  ENDIF
3712  ELSE
3713  CALL flagerror("CellML environment models field is not associated.",err,error,*999)
3714  ENDIF
3715  ENDIF
3716  ELSE
3717  CALL flagerror("CellML environment intermediate field is not associated.",err,error,*999)
3718  ENDIF
3719  ELSE
3720  CALL flagerror("CellML environment is not associated.",err,error,*999)
3721  ENDIF
3722 
3723 #else
3724 
3725  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
3726 
3727 #endif
3728 
3729  exits("CELLML_INTERMEDIATE_FIELD_CREATE_FINISH")
3730  RETURN
3731 999 errorsexits("CELLML_INTERMEDIATE_FIELD_CREATE_FINISH",err,error)
3732  RETURN 1
3733  END SUBROUTINE cellml_intermediate_field_create_finish
3734 
3735  !
3736  !=================================================================================================================================
3737  !
3738 
3740  SUBROUTINE cellml_intermediate_field_finalise(INTERMEDIATE_FIELD,ERR,ERROR,*)
3741  !Argument variables
3742  TYPE(cellml_intermediate_field_type), POINTER :: INTERMEDIATE_FIELD
3743  INTEGER(INTG), INTENT(OUT) :: ERR
3744  TYPE(varying_string), INTENT(OUT) :: ERROR
3745  !Local variables
3746 
3747  enters("CELLML_INTERMEDIATE_FIELD_FINALISE",err,error,*999)
3748 
3749 #ifdef WITH_CELLML
3750 
3751  IF(ASSOCIATED(intermediate_field)) THEN
3752  DEALLOCATE(intermediate_field)
3753  ENDIF
3754 
3755 #else
3756 
3757  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
3758 
3759 #endif
3760 
3761  exits("CELLML_INTERMEDIATE_FIELD_FINALISE")
3762  RETURN
3763 999 errorsexits("CELLML_INTERMEDIATE_FIELD_FINALISE",err,error)
3764  RETURN 1
3765  END SUBROUTINE cellml_intermediate_field_finalise
3766 
3767  !
3768  !=================================================================================================================================
3769  !
3770 
3772  SUBROUTINE cellml_intermediate_field_get(CELLML,INTERMEDIATE_FIELD,ERR,ERROR,*)
3773  !Argument variables
3774  TYPE(cellml_type), POINTER :: CELLML
3775  TYPE(field_type), POINTER :: INTERMEDIATE_FIELD
3776  INTEGER(INTG), INTENT(OUT) :: ERR
3777  TYPE(varying_string), INTENT(OUT) :: ERROR
3778  !Local variables
3779 
3780  enters("CELLML_INTERMEDIATE_FIELD_GET",err,error,*999)
3781 
3782 #ifdef WITH_CELLML
3783 
3784  IF(ASSOCIATED(cellml)) THEN
3785  IF(ASSOCIATED(cellml%INTERMEDIATE_FIELD)) THEN
3786  IF(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD_FINISHED) THEN
3787  IF(ASSOCIATED(intermediate_field)) THEN
3788  CALL flagerror("Intermediate field is already associated.",err,error,*999)
3789  ELSE
3790  intermediate_field=>cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD
3791  ENDIF
3792  ELSE
3793  CALL flagerror("CellML environment intermediate field has not been finished.",err,error,*999)
3794  ENDIF
3795  ELSE
3796  CALL flagerror("CellML environment intermediate field is not associated. Create the intermediate field first.", &
3797  & err,error,*999)
3798  ENDIF
3799  ELSE
3800  CALL flagerror("CellML environment is not associated.",err,error,*999)
3801  ENDIF
3802 
3803 #else
3804 
3805  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
3806 
3807 #endif
3808 
3809  exits("CELLML_INTERMEDIATE_FIELD_GET")
3810  RETURN
3811 999 errorsexits("CELLML_INTERMEDIATE_FIELD_GET",err,error)
3812  RETURN 1
3813  END SUBROUTINE cellml_intermediate_field_get
3814 
3815  !
3816  !=================================================================================================================================
3817  !
3818 
3820  SUBROUTINE cellml_intermediate_field_initialise(CELLML,ERR,ERROR,*)
3821  !Argument variables
3822  TYPE(cellml_type), POINTER :: CELLML
3823  INTEGER(INTG), INTENT(OUT) :: ERR
3824  TYPE(varying_string), INTENT(OUT) :: ERROR
3825  !Local variables
3826  INTEGER(INTG) :: DUMMY_ERR
3827  TYPE(varying_string) :: DUMMY_ERROR
3828 
3829  enters("CELLML_INTERMEDIATE_FIELD_INITIALISE",err,error,*998)
3830 
3831 #ifdef WITH_CELLML
3832 
3833  IF(ASSOCIATED(cellml)) THEN
3834  IF(ASSOCIATED(cellml%INTERMEDIATE_FIELD)) THEN
3835  CALL flagerror("CellML environment intermediate field is already associated.",err,error,*998)
3836  ELSE
3837  ALLOCATE(cellml%INTERMEDIATE_FIELD,stat=err)
3838  IF(err/=0) CALL flagerror("Could not allocate CellML environment intermediate field.",err,error,*999)
3839  cellml%INTERMEDIATE_FIELD%CELLML=>cellml
3840  cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD_FINISHED=.false.
3841  cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD_AUTO_CREATED=.false.
3842  NULLIFY(cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD)
3843  ENDIF
3844  ELSE
3845  CALL flagerror("CellML environment is not associated.",err,error,*998)
3846  ENDIF
3847 
3848 #else
3849 
3850  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*998)
3851 
3852 #endif
3853 
3854  exits("CELLML_INTERMEDIATE_FIELD_INITIALISE")
3855  RETURN
3856 999 CALL cellml_intermediate_field_finalise(cellml%INTERMEDIATE_FIELD,dummy_err,dummy_error,*998)
3857 998 errorsexits("CELLML_INTERMEDIATE_FIELD_INITIALISE",err,error)
3858  RETURN 1
3859  END SUBROUTINE cellml_intermediate_field_initialise
3860 
3861  !
3862  !=================================================================================================================================
3863  !
3864 
3866  SUBROUTINE cellml_parameters_field_create_start(PARAMETERS_FIELD_USER_NUMBER,CELLML,PARAMETERS_FIELD,ERR,ERROR,*)
3867  !Argument variables
3868  INTEGER(INTG), INTENT(IN) :: PARAMETERS_FIELD_USER_NUMBER
3869  TYPE(cellml_type), POINTER :: CELLML
3870  TYPE(field_type), POINTER :: PARAMETERS_FIELD
3871  INTEGER(INTG), INTENT(OUT) :: ERR
3872  TYPE(varying_string), INTENT(OUT) :: ERROR
3873  !Local variables
3874  INTEGER(INTG) :: component_idx
3875  TYPE(cellml_field_maps_type), POINTER :: CELLML_FIELD_MAPS
3876  TYPE(field_type), POINTER :: FIELD
3877  TYPE(region_type), POINTER :: REGION,PARAMETERS_FIELD_REGION
3878  TYPE(varying_string) :: LOCAL_ERROR
3879 
3880  enters("CELLML_PARAMETERS_FIELD_CREATE_START",err,error,*999)
3881 
3882 #ifdef WITH_CELLML
3883 
3884  IF(ASSOCIATED(cellml)) THEN
3885  cellml_field_maps=>cellml%FIELD_MAPS
3886  IF(ASSOCIATED(cellml_field_maps)) THEN
3887  IF(cellml_field_maps%CELLML_FIELD_MAPS_FINISHED) THEN
3888  IF(ASSOCIATED(cellml%PARAMETERS_FIELD)) THEN
3889  CALL flagerror("The CellML environment parameters field is already associated.",err,error,*999)
3890  ELSE
3891  region=>cellml%REGION
3892  IF(ASSOCIATED(region)) THEN
3893  IF(ASSOCIATED(cellml_field_maps%SOURCE_GEOMETRIC_FIELD)) THEN
3894  IF(ASSOCIATED(cellml_field_maps%SOURCE_FIELD_DOMAIN)) THEN
3895  IF(ASSOCIATED(parameters_field)) THEN
3896  !Check the field has been finished
3897  IF(parameters_field%FIELD_FINISHED) THEN
3898  !Check the user numbers match
3899  IF(parameters_field_user_number/=parameters_field%USER_NUMBER) THEN
3900  local_error="The specified parameters field user number of "// &
3901  & trim(number_to_vstring(parameters_field_user_number,"*",err,error))// &
3902  & " does not match the user number of the specified parameters field of "// &
3903  & trim(number_to_vstring(parameters_field%USER_NUMBER,"*",err,error))//"."
3904  CALL flagerror(local_error,err,error,*999)
3905  ENDIF
3906  parameters_field_region=>parameters_field%REGION
3907  IF(ASSOCIATED(parameters_field_region)) THEN
3908  !Check the field is defined on the same region as the CellML region
3909  IF(parameters_field_region%USER_NUMBER/=region%USER_NUMBER) THEN
3910  local_error="Invalid region setup. The specified parameters field has been created on region number "// &
3911  & trim(number_to_vstring(parameters_field_region%USER_NUMBER,"*",err,error))// &
3912  & " and the specified CellML environment has been created on region number "// &
3913  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
3914  CALL flagerror(local_error,err,error,*999)
3915  ENDIF
3916  !Check the specified parameters field has the same geometric field as the source field
3917  IF(.NOT.ASSOCIATED(cellml_field_maps%SOURCE_GEOMETRIC_FIELD,parameters_field%GEOMETRIC_FIELD)) THEN
3918  CALL flagerror("The specified parameters field does not have the same geometric field as the "// &
3919  & "geometric field for the specified CellML environment.",err,error,*999)
3920  ENDIF
3921  !Check the specified parameters field has the same decomposition as the source field
3922  IF(.NOT.ASSOCIATED(cellml_field_maps%SOURCE_FIELD_DOMAIN%DECOMPOSITION,parameters_field%DECOMPOSITION)) THEN
3923  CALL flagerror("The specified parameters field does not have the same decomposition as the source "// &
3924  & "domain decomposition for the specified CellML environment.",err,error,*999)
3925  ENDIF
3926  ELSE
3927  CALL flagerror("The specified parameters field region is not associated.",err,error,*999)
3928  ENDIF
3929  ELSE
3930  CALL flagerror("The specified parameters field has not been finished.",err,error,*999)
3931  ENDIF
3932  ELSE
3933  !Check the user number has not already been used for a field in this region.
3934  NULLIFY(field)
3935  CALL field_user_number_find(parameters_field_user_number,region,field,err,error,*999)
3936  IF(ASSOCIATED(field)) THEN
3937  local_error="The specified parameters field user number of "// &
3938  & trim(number_to_vstring(parameters_field_user_number,"*",err,error))// &
3939  & "has already been used to create a field on region number "// &
3940  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
3941  CALL flagerror(local_error,err,error,*999)
3942  ENDIF
3943  ENDIF
3944  CALL cellml_parameters_field_initialise(cellml,err,error,*999)
3945  IF(ASSOCIATED(parameters_field)) THEN
3946  !Now check the supplied field.
3947  CALL field_data_type_check(parameters_field,field_u_variable_type,field_dp_type,err,error,*999)
3948  CALL field_type_check(parameters_field,field_general_type,err,error,*999)
3949  CALL field_number_of_variables_check(parameters_field,1,err,error,*999)
3950  CALL field_variable_types_check(parameters_field,[field_u_variable_type],err,error,*999)
3951  CALL field_number_of_components_check(parameters_field,field_u_variable_type, &
3952  & cellml%MAXIMUM_NUMBER_OF_PARAMETERS,err,error,*999)
3953  DO component_idx=1,cellml%MAXIMUM_NUMBER_OF_PARAMETERS
3954  CALL field_component_mesh_component_check(parameters_field,field_u_variable_type,component_idx, &
3955  & cellml_field_maps%SOURCE_FIELD_DOMAIN%MESH_COMPONENT_NUMBER,err,error,*999)
3956  CALL field_component_interpolation_check(parameters_field,field_u_variable_type,component_idx, &
3957  & cellml_field_maps%SOURCE_FIELD_INTERPOLATION_TYPE,err,error,*999)
3958  ENDDO !component_idx
3959  ELSE
3960  cellml%PARAMETERS_FIELD%PARAMETERS_FIELD_AUTO_CREATED=.true.
3961  !Create the CellML environment parameters field
3962  CALL field_create_start(parameters_field_user_number,region,cellml%PARAMETERS_FIELD%PARAMETERS_FIELD, &
3963  & err,error,*999)
3964  CALL field_data_type_set_and_lock(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD,field_u_variable_type, &
3965  & field_dp_type,err,error,*999)
3966  CALL field_label_set(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD,"CellMLParametersField",err,error,*999)
3967  CALL field_type_set_and_lock(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD,field_general_type,err,error,*999)
3968  CALL field_mesh_decomposition_set_and_lock(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD, &
3969  & cellml_field_maps%SOURCE_FIELD_DOMAIN%DECOMPOSITION,err,error,*999)
3970  CALL field_geometric_field_set_and_lock(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD, &
3971  & cellml_field_maps%SOURCE_GEOMETRIC_FIELD,err,error,*999)
3972  CALL field_number_of_variables_set_and_lock(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD,1,err,error,*999)
3973  CALL field_variable_types_set_and_lock(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD,[field_u_variable_type], &
3974  & err,error,*999)
3975  CALL field_variable_label_set(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD,field_u_variable_type, &
3976  & "ParametersVariable",err,error,*999)
3977  CALL field_dof_order_type_set(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD,field_u_variable_type, &
3978  & field_contiguous_component_dof_order,err,error,*999)
3979  CALL field_number_of_components_set_and_lock(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD,field_u_variable_type, &
3980  & cellml%MAXIMUM_NUMBER_OF_PARAMETERS,err,error,*999)
3981  DO component_idx=1,cellml%MAXIMUM_NUMBER_OF_PARAMETERS
3982  CALL field_component_mesh_component_set_and_lock(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD, &
3983  & field_u_variable_type,component_idx,cellml_field_maps%SOURCE_FIELD_DOMAIN%MESH_COMPONENT_NUMBER, &
3984  & err,error,*999)
3985  CALL field_component_interpolation_set_and_lock(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD, &
3986  & field_u_variable_type,component_idx,cellml_field_maps%SOURCE_FIELD_INTERPOLATION_TYPE,err,error,*999)
3987  ENDDO !component_idx
3988  ENDIF
3989  !Set pointers
3990  IF(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD_AUTO_CREATED) THEN
3991  parameters_field=>cellml%PARAMETERS_FIELD%PARAMETERS_FIELD
3992  ELSE
3993  cellml%PARAMETERS_FIELD%PARAMETERS_FIELD=>parameters_field
3994  ENDIF
3995  ELSE
3996  CALL flagerror("CellML field maps source field domain is not associated.",err,error,*999)
3997  ENDIF
3998  ELSE
3999  CALL flagerror("CellML field maps source geometric field is not associated.",err,error,*999)
4000  ENDIF
4001  ELSE
4002  CALL flagerror("CellML environment region is not associated.",err,error,*999)
4003  ENDIF
4004  ENDIF
4005  ELSE
4006  CALL flagerror("The CellML environment fields map has not been finished.",err,error,*999)
4007  ENDIF
4008  ELSE
4009  CALL flagerror("CellML environment fields map is not associated. You must create the CellML field maps first.", &
4010  & err,error,*999)
4011  ENDIF
4012  ELSE
4013  CALL flagerror("CellML environment is not associated",err,error,*999)
4014  ENDIF
4015 
4016 #else
4017 
4018  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
4019 
4020 #endif
4021 
4022  exits("CELLML_PARAMETERS_FIELD_CREATE_START")
4023  RETURN
4024 999 errorsexits("CELLML_PARAMETERS_FIELD_CREATE_START",err,error)
4025  RETURN 1
4026  END SUBROUTINE cellml_parameters_field_create_start
4027 
4028  !
4029  !=================================================================================================================================
4030  !
4031 
4033  SUBROUTINE cellml_parameters_field_create_finish(CELLML,ERR,ERROR,*)
4034  !Argument variables
4035  TYPE(cellml_type), POINTER :: CELLML
4036  INTEGER(INTG), INTENT(OUT) :: ERR
4037  TYPE(varying_string), INTENT(OUT) :: ERROR
4038  !Local variables
4039  INTEGER(INTG) :: model_idx,models_dof_idx,parameter_component_idx,CELLML_VARIABLE_TYPE
4040  INTEGER(INTG), POINTER :: MODELS_DATA(:)
4041  REAL(DP) :: INITIAL_VALUE
4042  TYPE(field_variable_type), POINTER :: MODELS_VARIABLE
4043  TYPE(cellml_model_type), POINTER :: MODEL
4044  TYPE(varying_string) :: LOCAL_ERROR
4045 
4046  enters("CELLML_PARAMETERS_FIELD_CREATE_FINISH",err,error,*999)
4047 
4048 #ifdef WITH_CELLML
4049 
4050  IF(ASSOCIATED(cellml)) THEN
4051  IF(ASSOCIATED(cellml%PARAMETERS_FIELD)) THEN
4052  IF(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD_FINISHED) THEN
4053  CALL flagerror("CellML parameters field has already been finished.",err,error,*999)
4054  ELSE
4055  IF(ASSOCIATED(cellml%MODELS_FIELD)) THEN
4056  IF(cellml%MODELS_FIELD%MODELS_FIELD_FINISHED) THEN
4057  CALL cellml_models_field_check(cellml%MODELS_FIELD,err,error,*999)
4058  !Finish the parameters field creation
4059  IF(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD_AUTO_CREATED) &
4060  & CALL field_create_finish(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD,err,error,*999)
4061 ! CALL FIELD_DOF_ORDER_TYPE_CHECK(CELLML%PARAMETERS_FIELD%PARAMETERS_FIELD,FIELD_U_VARIABLE_TYPE, &
4062 ! & FIELD_CONTIGUOUS_COMPONENT_DOF_ORDER,ERR,ERROR,*999)
4063  IF(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX/=cellml_models_field_not_constant) THEN
4064  !Only one model so optimise
4065  model=>cellml%MODELS(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX)%PTR
4066  IF(ASSOCIATED(model)) THEN
4067  DO parameter_component_idx=1,model%NUMBER_OF_PARAMETERS
4068  cellml_variable_type=map_cellml_field_type_to_variable_type(cellml_parameters_field,err,error)
4069  err = cellml_model_definition_get_initial_value_by_index(model%PTR,cellml_variable_type,&
4070  & parameter_component_idx,initial_value)
4071  IF(err /= 0) THEN
4072  !problem getting the initial value
4073  local_error="Failed to get an initial value for parameter variable with index "//&
4074  & trim(number_to_vstring(parameter_component_idx,"*",err,error))//"."
4075  CALL flagerror(local_error,err,error,*999)
4076  ENDIF
4077  !WRITE(*,*) '(single model) Initial value for parameter variable: ',parameter_component_idx,'; type: ',&
4078  ! & CELLML_VARIABLE_TYPE,'; value = ',INITIAL_VALUE
4079  CALL field_component_values_initialise(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD,field_u_variable_type, &
4080  & field_values_set_type,parameter_component_idx,initial_value,err,error,*999)
4081  ENDDO !parameter_component_idx
4082  ELSE
4083  local_error="The model is not associated for model index "// &
4084  & trim(number_to_vstring(cellml%MODELS_FIELD%ONLY_ONE_MODEL_INDEX,"*",err,error))//"."
4085  CALL flagerror(local_error,err,error,*999)
4086  ENDIF
4087  ELSE
4088  !Multiple models so go through each dof.
4089  IF(ASSOCIATED(cellml%FIELD_MAPS)) THEN
4090  NULLIFY(models_variable)
4091  CALL field_variable_get(cellml%MODELS_FIELD%MODELS_FIELD,field_u_variable_type,models_variable, &
4092  & err,error,*999)
4093  NULLIFY(models_data)
4094  CALL field_parameter_set_data_get(cellml%MODELS_FIELD%MODELS_FIELD,field_u_variable_type, &
4095  & field_values_set_type,models_data,err,error,*999)
4096  DO models_dof_idx=1,models_variable%NUMBER_OF_DOFS
4097  model_idx=models_data(models_dof_idx)
4098  IF(model_idx==0) THEN
4099  ! Do nothing- empty model index specified
4100  ELSE IF(model_idx > 0 .AND. model_idx <= cellml%NUMBER_OF_MODELS) THEN
4101  model=>cellml%MODELS(model_idx)%PTR
4102  IF(ASSOCIATED(model)) THEN
4103  DO parameter_component_idx=1,model%NUMBER_OF_PARAMETERS
4104  cellml_variable_type=map_cellml_field_type_to_variable_type(cellml_parameters_field,err,error)
4105  err = cellml_model_definition_get_initial_value_by_index(model%PTR,cellml_variable_type,&
4106  & parameter_component_idx,initial_value)
4107  IF(err /= 0) THEN
4108  !problem getting the initial value
4109  local_error="Failed to get an initial value for parameter variable with index "//&
4110  & trim(number_to_vstring(parameter_component_idx,"*",err,error))//"."
4111  CALL flagerror(local_error,err,error,*999)
4112  ENDIF
4113  !WRITE(*,*) '(multiple models) Initial value for parameter variable: ',parameter_component_idx,'; type: ',&
4114  ! & CELLML_VARIABLE_TYPE,'; value = ',INITIAL_VALUE
4115  CALL cellml_fieldmodeldofset(models_variable,models_dof_idx,cellml%PARAMETERS_FIELD%PARAMETERS_FIELD, &
4116  & field_u_variable_type,field_values_set_type,parameter_component_idx,initial_value,err,error,*999)
4117  ENDDO !parameter_component_idx
4118  ELSE
4119  local_error="The model is not associated for model index "// &
4120  & trim(number_to_vstring(model_idx,"*",err,error))//"."
4121  CALL flagerror(local_error,err,error,*999)
4122  ENDIF
4123  ELSE
4124  local_error="Invalid CellML model index: "// &
4125  & trim(number_to_vstring(model_idx,"*",err,error))//". The specified index should be between 1 and "// &
4126  & trim(number_to_vstring(cellml%NUMBER_OF_MODELS,"*",err,error))//"."
4127  CALL flagerror(local_error,err,error,*999)
4128  ENDIF
4129  ENDDO !models_dof_idx
4130  CALL field_parameter_set_data_restore(cellml%MODELS_FIELD%MODELS_FIELD,field_u_variable_type, &
4131  & field_values_set_type,models_data,err,error,*999)
4132  ELSE
4133  CALL flagerror("CellML environment field maps is not associated.",err,error,*999)
4134  ENDIF
4135  ENDIF
4136  cellml%PARAMETERS_FIELD%PARAMETERS_FIELD_FINISHED=.true.
4137  ELSE
4138  CALL flagerror("CellML environment models field has not been finished.",err,error,*999)
4139  ENDIF
4140  ELSE
4141  CALL flagerror("CellML environment models field is not associated.",err,error,*999)
4142  ENDIF
4143  ENDIF
4144  ELSE
4145  CALL flagerror("CellML environment parameters field is not associated.",err,error,*999)
4146  ENDIF
4147  ELSE
4148  CALL flagerror("CellML environement is not associated.",err,error,*999)
4149  ENDIF
4150 
4151 #else
4152 
4153  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
4154 
4155 #endif
4156 
4157  exits("CELLML_PARAMETERS_FIELD_CREATE_FINISH")
4158  RETURN
4159 999 errorsexits("CELLML_PARAMETERS_FIELD_CREATE_FINISH",err,error)
4160  RETURN 1
4161  END SUBROUTINE cellml_parameters_field_create_finish
4162 
4163  !
4164  !=================================================================================================================================
4165  !
4166 
4168  SUBROUTINE cellml_parameters_field_finalise(PARAMETERS_FIELD,ERR,ERROR,*)
4169  !Argument variables
4170  TYPE(cellml_parameters_field_type), POINTER :: PARAMETERS_FIELD
4171  INTEGER(INTG), INTENT(OUT) :: ERR
4172  TYPE(varying_string), INTENT(OUT) :: ERROR
4173  !Local variables
4174 
4175  enters("CELLML_PARAMETERS_FIELD_FINALISE",err,error,*999)
4176 
4177 #ifdef WITH_CELLML
4178 
4179  IF(ASSOCIATED(parameters_field)) THEN
4180  DEALLOCATE(parameters_field)
4181  ENDIF
4182 
4183 #else
4184 
4185  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
4186 
4187 #endif
4188 
4189  exits("CELLML_PARAMETERS_FIELD_FINALISE")
4190  RETURN
4191 999 errorsexits("CELLML_PARAMETERS_FIELD_FINALISE",err,error)
4192  RETURN 1
4193  END SUBROUTINE cellml_parameters_field_finalise
4194 
4195  !
4196  !=================================================================================================================================
4197  !
4198 
4200  SUBROUTINE cellml_parameters_field_get(CELLML,PARAMETERS_FIELD,ERR,ERROR,*)
4201  !Argument variables
4202  TYPE(cellml_type), POINTER :: CELLML
4203  TYPE(field_type), POINTER :: PARAMETERS_FIELD
4204  INTEGER(INTG), INTENT(OUT) :: ERR
4205  TYPE(varying_string), INTENT(OUT) :: ERROR
4206  !Local variables
4207 
4208  enters("CELLML_PARAMETERS_FIELD_GET",err,error,*999)
4209 
4210 #ifdef WITH_CELLML
4211 
4212  IF(ASSOCIATED(cellml)) THEN
4213  IF(ASSOCIATED(cellml%PARAMETERS_FIELD)) THEN
4214  IF(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD_FINISHED) THEN
4215  IF(ASSOCIATED(parameters_field)) THEN
4216  CALL flagerror("Parameters field is already associated.",err,error,*999)
4217  ELSE
4218  parameters_field=>cellml%PARAMETERS_FIELD%PARAMETERS_FIELD
4219  ENDIF
4220  ELSE
4221  CALL flagerror("CellML environment parameters field has not been finished.",err,error,*999)
4222  ENDIF
4223  ELSE
4224  CALL flagerror("CellML environment parameters field is not associated. Create the parameters field first.",err,error,*999)
4225  ENDIF
4226  ELSE
4227  CALL flagerror("CellML environment is not associated.",err,error,*999)
4228  ENDIF
4229 
4230 #else
4231 
4232  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
4233 
4234 #endif
4235 
4236  exits("CELLML_PARAMETERS_FIELD_GET")
4237  RETURN
4238 999 errorsexits("CELLML_PARAMETERS_FIELD_GET",err,error)
4239  RETURN 1
4240  END SUBROUTINE cellml_parameters_field_get
4241 
4242  !
4243  !=================================================================================================================================
4244  !
4245 
4247  SUBROUTINE cellml_parameters_field_initialise(CELLML,ERR,ERROR,*)
4248  !Argument variables
4249  TYPE(cellml_type), POINTER :: CELLML
4250  INTEGER(INTG), INTENT(OUT) :: ERR
4251  TYPE(varying_string), INTENT(OUT) :: ERROR
4252  !Local variables
4253  INTEGER(INTG) :: DUMMY_ERR
4254  TYPE(varying_string) :: DUMMY_ERROR
4255 
4256  enters("CELLML_PARAMETERS_FIELD_INITIALISE",err,error,*998)
4257 
4258 #ifdef WITH_CELLML
4259 
4260  IF(ASSOCIATED(cellml)) THEN
4261  IF(ASSOCIATED(cellml%PARAMETERS_FIELD)) THEN
4262  CALL flagerror("CellML environment parameters field is already associated.",err,error,*998)
4263  ELSE
4264  ALLOCATE(cellml%PARAMETERS_FIELD,stat=err)
4265  IF(err/=0) CALL flagerror("Could not allocate CellML environment parameters field.",err,error,*999)
4266  cellml%PARAMETERS_FIELD%CELLML=>cellml
4267  cellml%PARAMETERS_FIELD%PARAMETERS_FIELD_FINISHED=.false.
4268  cellml%PARAMETERS_FIELD%PARAMETERS_FIELD_AUTO_CREATED=.false.
4269  NULLIFY(cellml%PARAMETERS_FIELD%PARAMETERS_FIELD)
4270  ENDIF
4271  ELSE
4272  CALL flagerror("CellML environment is not associated.",err,error,*998)
4273  ENDIF
4274 
4275 #else
4276 
4277  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*998)
4278 
4279 #endif
4280 
4281  exits("CELLML_PARAMETERS_FIELD_INITIALISE")
4282  RETURN
4283 999 CALL cellml_parameters_field_finalise(cellml%PARAMETERS_FIELD,dummy_err,dummy_error,*998)
4284 998 errorsexits("CELLML_PARAMETERS_FIELD_INITIALISE",err,error)
4285  RETURN 1
4286  END SUBROUTINE cellml_parameters_field_initialise
4287 
4288  !
4289  !=================================================================================================================================
4290  !
4291 
4298  SUBROUTINE cellml_generate(CELLML,ERR,ERROR,*)
4299  !Argument variables
4300  TYPE(cellml_type), POINTER :: CELLML
4301  INTEGER(INTG), INTENT(OUT) :: ERR
4302  TYPE(varying_string), INTENT(OUT) :: ERROR
4303  !Local variables
4304 
4305  enters("CELLML_GENERATE",err,error,*999)
4306 
4307 #ifdef WITH_CELLML
4308 
4309  IF(ASSOCIATED(cellml)) THEN
4310  IF(cellml%CELLML_FINISHED) THEN
4311  !Set the generated flag
4312  cellml%CELLML_GENERATED=.true.
4313  ELSE
4314  CALL flagerror("CellML environment has not been finished.",err,error,*999)
4315  ENDIF
4316  ELSE
4317  CALL flagerror("CellML environment is not associated.",err,error,*999)
4318  ENDIF
4319 
4320 #else
4321 
4322  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
4323 
4324 #endif
4325 
4326  exits("CELLML_GENERATE")
4327  RETURN
4328 999 errorsexits("CELLML_GENERATE",err,error)
4329  RETURN 1
4330  END SUBROUTINE cellml_generate
4331 
4332  !
4333  !=================================================================================================================================
4334  !
4335 
4337  SUBROUTINE cellml_user_number_find(USER_NUMBER,REGION,CELLML,ERR,ERROR,*)
4338 
4339  !Argument variables
4340  INTEGER(INTG), INTENT(IN) :: USER_NUMBER
4341  TYPE(region_type), POINTER :: REGION
4342  TYPE(cellml_type), POINTER :: CELLML
4343  INTEGER(INTG), INTENT(OUT) :: ERR
4344  TYPE(varying_string), INTENT(OUT) :: ERROR
4345  !Local Variables
4346  INTEGER(INTG) :: cellml_idx
4347  TYPE(cellml_environments_type), POINTER :: CELLML_ENVIRONMENTS
4348 
4349  enters("CELLML_USER_NUMBER_FIND",err,error,*999)
4350 
4351 #ifdef WITH_CELLML
4352 
4353  IF(ASSOCIATED(region)) THEN
4354  IF(ASSOCIATED(cellml)) THEN
4355  CALL flagerror("CellML is already associated.",err,error,*999)
4356  ELSE
4357  NULLIFY(cellml)
4358  cellml_environments=>region%CELLML_ENVIRONMENTS
4359  IF(ASSOCIATED(cellml_environments)) THEN
4360  cellml_idx=1
4361  DO WHILE(cellml_idx<=cellml_environments%NUMBER_OF_ENVIRONMENTS.AND..NOT.ASSOCIATED(cellml))
4362  IF(cellml_environments%ENVIRONMENTS(cellml_idx)%PTR%USER_NUMBER==user_number) THEN
4363  cellml=>cellml_environments%ENVIRONMENTS(cellml_idx)%PTR
4364  ELSE
4365  cellml_idx=cellml_idx+1
4366  ENDIF
4367  ENDDO
4368  ELSE
4369  CALL flagerror("Region CellML environments is not associated.",err,error,*999)
4370  ENDIF
4371  ENDIF
4372  ELSE
4373  CALL flagerror("Region is not associated.",err,error,*999)
4374  ENDIF
4375 
4376 #else
4377 
4378  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
4379 
4380 #endif
4381 
4382  exits("CELLML_USER_NUMBER_FIND")
4383  RETURN
4384 999 errorsexits("CELLML_USER_NUMBER_FIND",err,error)
4385  RETURN 1
4386  END SUBROUTINE cellml_user_number_find
4387 
4388  !
4389  !=================================================================================================================================
4390  !
4391 
4393  SUBROUTINE cellml_environments_finalise(CELLML_ENVIRONMENTS,ERR,ERROR,*)
4394 
4395  !Argument variables
4396  TYPE(cellml_environments_type), POINTER :: CELLML_ENVIRONMENTS
4397  INTEGER(INTG), INTENT(OUT) :: ERR
4398  TYPE(varying_string), INTENT(OUT) :: ERROR
4399  !Local Variables
4400  INTEGER(INTG) :: cellml_idx
4401 
4402  enters("CELLML_ENVIRONMENTS_FINALISE",err,error,*999)
4403 
4404  IF(ASSOCIATED(cellml_environments)) THEN
4405  IF(ALLOCATED(cellml_environments%ENVIRONMENTS)) THEN
4406  DO cellml_idx=1,SIZE(cellml_environments%ENVIRONMENTS,1)
4407  CALL cellml_finalise(cellml_environments%ENVIRONMENTS(cellml_idx)%PTR,err,error,*999)
4408  ENDDO !cellml_idx
4409  DEALLOCATE(cellml_environments%ENVIRONMENTS)
4410  ENDIF
4411  DEALLOCATE(cellml_environments)
4412  ENDIF
4413 
4414  exits("CELLML_ENVIRONMENTS_FINALISE")
4415  RETURN
4416 999 errorsexits("CELLML_ENVIRONMENTS_FINALISE",err,error)
4417  RETURN 1
4418  END SUBROUTINE cellml_environments_finalise
4419 
4420  !
4421  !=================================================================================================================================
4422  !
4423 
4425  SUBROUTINE cellml_environments_initialise(REGION,ERR,ERROR,*)
4426 
4427  !Argument variables
4428  TYPE(region_type), POINTER :: REGION
4429  INTEGER(INTG), INTENT(OUT) :: ERR
4430  TYPE(varying_string), INTENT(OUT) :: ERROR
4431  !Local Variables
4432  INTEGER(INTG) :: DUMMY_ERR
4433  TYPE(varying_string) :: DUMMY_ERROR
4434 
4435  enters("CELLML_ENVIRONMENTS_INITIALISE",err,error,*998)
4436 
4437  IF(ASSOCIATED(region)) THEN
4438  IF(ASSOCIATED(region%CELLML_ENVIRONMENTS)) THEN
4439  CALL flagerror("Region CellML environments is already associated.",err,error,*998)
4440  ELSE
4441  ALLOCATE(region%CELLML_ENVIRONMENTS,stat=err)
4442  IF(err/=0) CALL flagerror("Could not allocate region CellML environments.",err,error,*999)
4443  region%CELLML_ENVIRONMENTS%REGION=>region
4444  region%CELLML_ENVIRONMENTS%NUMBER_OF_ENVIRONMENTS=0
4445  ENDIF
4446  ELSE
4447  CALL flagerror("Region is not associated.",err,error,*998)
4448  ENDIF
4449 
4450  exits("CELLML_ENVIRONMENTS_INITIALISE")
4451  RETURN
4452 999 CALL cellml_environments_finalise(region%CELLML_ENVIRONMENTS,dummy_err,dummy_error,*998)
4453 998 errorsexits("CELLML_ENVIRONMENTS_INITIALISE",err,error)
4454  RETURN 1
4455  END SUBROUTINE cellml_environments_initialise
4456 
4457  !
4458  !================================================================================================================================
4459  !
4460 
4462  FUNCTION map_cellml_variable_type_to_field_type_intg(CELLML_VARIABLE_TYPE,ERR,ERROR)
4463 
4464  !Argument variables
4465  INTEGER(INTG), INTENT(IN) :: CELLML_VARIABLE_TYPE
4466  INTEGER(INTG), INTENT(OUT) :: ERR
4467  TYPE(varying_string), INTENT(OUT) :: ERROR
4468  !Function variable
4469  INTEGER(INTG) :: MAP_CELLML_VARIABLE_TYPE_TO_FIELD_TYPE_INTG
4470  !Local Variables
4471  TYPE(varying_string) :: LOCAL_ERROR
4472 
4473  ! CellML variable types in OpenCMISS(cellml)/CellMLModelDefinitionF.h:
4474  ! state=1; known=2; wanted=3.
4475  ! independent=4 - but untested and maybe not working yet.
4476  enters("MAP_CELLML_VARIABLE_TYPE_TO_FIELD_TYPE_INTG",err,error,*999)
4477 
4478  SELECT CASE(cellml_variable_type)
4479  CASE(1)
4480  map_cellml_variable_type_to_field_type_intg=cellml_state_field
4481  CASE(2)
4482  map_cellml_variable_type_to_field_type_intg=cellml_parameters_field
4483  CASE(3)
4484  map_cellml_variable_type_to_field_type_intg=cellml_intermediate_field
4485  CASE(4)
4486  local_error="CellML variable type "//trim(number_to_vstring(cellml_variable_type,"*",err,error))//&
4487  & " (independent variable) support not yet implemented"
4488  CALL flagerror(local_error,err,error,*999)
4489  CASE DEFAULT
4490  local_error="CellML variable type "//trim(number_to_vstring(cellml_variable_type,"*",err,error))//&
4491  & " is invalid or not implemented."
4492  CALL flagerror(local_error,err,error,*999)
4493  END SELECT
4494 
4495  exits("MAP_CELLML_VARIABLE_TYPE_TO_FIELD_TYPE_INTG")
4496  RETURN
4497 999 errorsexits("MAP_CELLML_VARIABLE_TYPE_TO_FIELD_TYPE_INTG",err,error)
4498  RETURN
4499 
4500  END FUNCTION map_cellml_variable_type_to_field_type_intg
4501 
4502  !
4503  !================================================================================================================================
4504  !
4505 
4507  FUNCTION map_cellml_field_type_to_variable_type_intg(CELLML_FIELD_TYPE,ERR,ERROR)
4508  !Argument variables
4509  INTEGER(INTG), INTENT(IN) :: CELLML_FIELD_TYPE
4510  INTEGER(INTG), INTENT(OUT) :: ERR
4511  TYPE(varying_string), INTENT(OUT) :: ERROR
4512  !Function variable
4513  INTEGER(INTG) :: MAP_CELLML_FIELD_TYPE_TO_VARIABLE_TYPE_INTG
4514  !Local Variables
4515  TYPE(varying_string) :: LOCAL_ERROR
4516 
4517  ! CellML variable types in OpenCMISS(cellml)/CellMLModelDefinitionF.h:
4518  ! state=1; known=2; wanted=3.
4519  ! independent=4 - but untested and maybe not working yet.
4520  enters("MAP_CELLML_FIELD_TYPE_TO_VARIABLE_TYPE_INTG",err,error,*999)
4521  SELECT CASE(cellml_field_type)
4522  CASE(cellml_state_field)
4523  map_cellml_field_type_to_variable_type_intg=1
4524  CASE(cellml_parameters_field)
4525  map_cellml_field_type_to_variable_type_intg=2
4526  CASE(cellml_intermediate_field)
4527  map_cellml_field_type_to_variable_type_intg=3
4528  !CASE(4)
4529  ! LOCAL_ERROR="CellML variable type "//TRIM(NUMBER_TO_VSTRING(CELLML_VARIABLE_TYPE,"*",ERR,ERROR))//&
4530  ! & " (independent variable) support not yet implemented"
4531  ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
4532  CASE DEFAULT
4533  local_error="CellML field type "//trim(number_to_vstring(cellml_field_type,"*",err,error))//&
4534  & " is invalid or not implemented"
4535  CALL flagerror(local_error,err,error,*999)
4536  END SELECT
4537  exits("MAP_CELLML_FIELD_TYPE_TO_VARIABLE_TYPE_INTG")
4538  RETURN
4539 999 errorsexits("MAP_CELLML_FIELD_TYPE_TO_VARIABLE_TYPE_INTG",err,error)
4540  RETURN
4541 
4542  END FUNCTION map_cellml_field_type_to_variable_type_intg
4543 
4544 END MODULE cmiss_cellml
base_routines::enters
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Definition: base_routines.f90:363
input_output::write_string_value
Write a string followed by a value to a given output stream.
Definition: input_output.f90:86
cmiss_cellml::cellml_parameters_field_create_finish
subroutine, public cellml_parameters_field_create_finish(CELLML, ERR, ERROR,)
Finish the creation of the parameters field for the given CellML environment.
Definition: cmiss_cellml.f90:4034
kinds::ptr
integer, parameter ptr
Pointer integer kind.
Definition: kinds.f90:58
cmiss_cellml::cellml_intermediate_field_get
subroutine, public cellml_intermediate_field_get(CELLML, INTERMEDIATE_FIELD, ERR, ERROR,)
Returns the intermediate field for the given CellML environment.
Definition: cmiss_cellml.f90:3773
cmiss_cellml::cellml_field_to_cellml_update
subroutine, public cellml_field_to_cellml_update(CELLML, ERR, ERROR,)
Updates any cellml fields from the mapped fields.
Definition: cmiss_cellml.f90:785
types::region_type
Contains information for a region.
Definition: types.f90:3252
cmiss_cellml::cellml_field_maps_initialise
subroutine cellml_field_maps_initialise(CELLML, ERR, ERROR,)
Initialise a CellML field mpas.
Definition: cmiss_cellml.f90:1392
cmiss_cellml::cellml_parameters_field_finalise
subroutine cellml_parameters_field_finalise(PARAMETERS_FIELD, ERR, ERROR,)
Finalise a CellML environment parameters field and deallocate all memory.
Definition: cmiss_cellml.f90:4169
types::cellml_model_maps_type
Contains information on the maps between a CellML model and external OpenCMISS fields.
Definition: types.f90:2345
cmiss_cellml::cellml_model_map_finalise
subroutine cellml_model_map_finalise(CELLML_MODEL_MAP, ERR, ERROR,)
Finalise a CellML model map and deallocate all memory.
Definition: cmiss_cellml.f90:1534
cmiss_cellml::cellml_variable_set_as_wanted_c
subroutine cellml_variable_set_as_wanted_c(CELLML, MODEL_INDEX, VARIABLE_ID, ERR, ERROR,)
Sets a CellML model variable to be wanted - i.e., the variable&#39;s value will used by an OpenCMISS fiel...
Definition: cmiss_cellml.f90:1899
strings::number_to_vstring
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
cmiss_cellml::map_cellml_field_type_to_variable_type
Map a CellML field type to a CellML variable type from OpenCMISS(cellml).
Definition: cmiss_cellml.f90:119
cmiss_cellml::cellml_models_field_finalise
subroutine cellml_models_field_finalise(MODELS_FIELD, ERR, ERROR,)
Finalise a CellML environment models field and deallocate all memory.
Definition: cmiss_cellml.f90:2871
cmiss_cellml::cellml_field_component_get
Definition: cmiss_cellml.f90:148
cmiss_cellml::cellml_field_maps_create_start
subroutine, public cellml_field_maps_create_start(CELLML, ERR, ERROR,)
Start the creation of field maps for a CellML environment.
Definition: cmiss_cellml.f90:1313
cmiss_fortran_c
This module contains all Fortran and C data conversion routines.
Definition: cmiss_fortran_c.f90:48
cmiss_cellml::cellml_state_field_initialise
subroutine cellml_state_field_initialise(CELLML, ERR, ERROR,)
Initialise a CellML environment models field.
Definition: cmiss_cellml.f90:3373
cmiss_cellml::cellml_field_maps_finalise
subroutine cellml_field_maps_finalise(CELLML_FIELD_MAPS, ERR, ERROR,)
Finalise a CellML maps and deallocate all memory.
Definition: cmiss_cellml.f90:1353
cmiss_cellml::cellml_intermediate_field_create_finish
subroutine, public cellml_intermediate_field_create_finish(CELLML, ERR, ERROR,)
Finialse the creation of the intermediate field for the given CellML environment. Finish creating the...
Definition: cmiss_cellml.f90:3684
cmiss_cellml::cellml_create_start
subroutine, public cellml_create_start(CELLML_USER_NUMBER, REGION, CELLML, ERR, ERROR,)
Set up the CellML environment in the given region. For a given region, create a CellML environment th...
Definition: cmiss_cellml.f90:575
types::cellml_model_map_ptr_type
Buffer type to allow an array of pointers to CELLML_MODEL_MAP_FIELD_TYPE.
Definition: types.f90:2340
cmiss_cellml::cellml_models_field_initialise
subroutine cellml_models_field_initialise(CELLML, ERR, ERROR,)
Initialise a CellML environment models field.
Definition: cmiss_cellml.f90:2951
cmiss_cellml::cellml_model_finalise
subroutine cellml_model_finalise(CELLML_MODEL, ERR, ERROR,)
Finalise a CellML model and deallocate all memory.
Definition: cmiss_cellml.f90:1454
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
cmiss_cellml::cellml_model_import
Definition: cmiss_cellml.f90:123
cmiss_cellml::cellml_user_number_find
subroutine, public cellml_user_number_find(USER_NUMBER, REGION, CELLML, ERR, ERROR,)
Finds and returns in CELLML a pointer to the CellML environment identified by USER_NUMBER on a region...
Definition: cmiss_cellml.f90:4338
cmiss_cellml::cellml_cellml_to_field_update
subroutine, public cellml_cellml_to_field_update(CELLML, ERR, ERROR,)
Updates any mapped fields from the cellml fields.
Definition: cmiss_cellml.f90:206
cmiss_cellml::cellml_model_import_vs
subroutine cellml_model_import_vs(CELLML, URI, MODEL_INDEX, ERR, ERROR,)
Import the specified CellML model into the given CellML environment object.
Definition: cmiss_cellml.f90:1769
types::cellml_parameters_field_type
Contains information on the parameters field for a CellML environment.
Definition: types.f90:2310
cmiss_cellml::cellml_parameters_field_get
subroutine, public cellml_parameters_field_get(CELLML, PARAMETERS_FIELD, ERR, ERROR,)
Returns the parameters field for the given CellML environment.
Definition: cmiss_cellml.f90:4201
cmiss_cellml::cellml_intermediate_field_create_start
subroutine, public cellml_intermediate_field_create_start(INTERMEDIATE_FIELD_USER_NUMBER, CELLML, INTERMEDIATE_FIELD, ERR, ERROR,)
Create a field used to store intermediate variables of interest.
Definition: cmiss_cellml.f90:3513
types::field_type
Contains information for a field defined on a region.
Definition: types.f90:1346
cmiss_cellml::cellml_parameters_field
integer(intg), parameter, public cellml_parameters_field
CellML parameters field.
Definition: cmiss_cellml.f90:88
cmiss_cellml::cellml_field_component_get_c
subroutine cellml_field_component_get_c(CELLML, MODEL_INDEX, CELLML_FIELD_TYPE, VARIABLE_ID, COMPONENT_USER_NUMBER, ERR, ERROR,)
Find the component ID in the given field for the variable defined by the given variable ID in the pro...
Definition: cmiss_cellml.f90:3423
types::cellml_field_maps_type
Contains information on the maps between CellML and external OpenCMISS fields.
Definition: types.f90:2358
cmiss_cellml::cellml_environments_finalise
subroutine, public cellml_environments_finalise(CELLML_ENVIRONMENTS, ERR, ERROR,)
Finalises the CellML environments and deallocates all memory.
Definition: cmiss_cellml.f90:4394
iso_varying_string
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
Definition: iso_varying_string.f90:62
cmiss_cellml::cellml_variable_set_as_wanted_vs
subroutine cellml_variable_set_as_wanted_vs(CELLML, MODEL_USER_NUMBER, VARIABLE_ID, ERR, ERROR,)
Sets a CellML model variable to be wanted - i.e., the variable&#39;s value will be used by an OpenCMISS f...
Definition: cmiss_cellml.f90:1964
cmiss_cellml::cellml_create_cellml_to_field_map_c
subroutine cellml_create_cellml_to_field_map_c(CELLML, MODEL_INDEX, VARIABLE_ID, CELLML_PARAMETER_SET, FIELD, VARIABLE_TYPE, COMPONENT_NUMBER, FIELD_PARAMETER_SET, ERR, ERROR,)
Create a CellML model variable to field variable component map.
Definition: cmiss_cellml.f90:1998
types::cellml_intermediate_field_type
Contains information on the intermediate field for a CellML environment.
Definition: types.f90:2302
cmiss_cellml::cellml_intermediate_field_finalise
subroutine cellml_intermediate_field_finalise(INTERMEDIATE_FIELD, ERR, ERROR,)
Finalise a CellML environment models field and deallocate all memory.
Definition: cmiss_cellml.f90:3741
cmiss_cellml::cellml_state_field_create_start
subroutine, public cellml_state_field_create_start(STATE_FIELD_USER_NUMBER, CELLML, STATE_FIELD, ERR, ERROR,)
Start the creation of the state field for the given CellML environment.
Definition: cmiss_cellml.f90:2998
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
cmiss_cellml::cellml_field_maps_create_finish
subroutine, public cellml_field_maps_create_finish(CELLML, ERR, ERROR,)
Finish creating the field maps for a CellML environment.
Definition: cmiss_cellml.f90:1248
cmiss_cellml::cellml_generate
subroutine, public cellml_generate(CELLML, ERR, ERROR,)
Validate and instantiate the specified CellML environment. Users should call this routine once they h...
Definition: cmiss_cellml.f90:4299
cmiss_cellml::cellml_models_field_create_finish
subroutine, public cellml_models_field_create_finish(CELLML, ERR, ERROR,)
Finish the creation of the models field for the given CellML environment.
Definition: cmiss_cellml.f90:2821
cmiss_cellml::cellml_create_field_to_cellml_map_vs
subroutine cellml_create_field_to_cellml_map_vs(CELLML, FIELD, VARIABLE_TYPE, COMPONENT_NUMBER, FIELD_PARAMETER_SET, MODEL_USER_NUMBER, VARIABLE_ID, CELLML_PARAMETER_SET, ERR, ERROR,)
Create a field variable component to CellML model variable map.
Definition: cmiss_cellml.f90:2439
cmiss_cellml::cellml_state_field_finalise
subroutine cellml_state_field_finalise(STATE_FIELD, ERR, ERROR,)
Finalise a CellML environment state field and deallocate all memory.
Definition: cmiss_cellml.f90:3293
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
cmiss_cellml::map_cellml_variable_type_to_field_type
Map a CellML variable type from OpenCMISS(cellml) to a CellML field type.
Definition: cmiss_cellml.f90:114
cmiss_cellml::cellml_intermediate_field_initialise
subroutine cellml_intermediate_field_initialise(CELLML, ERR, ERROR,)
Initialise a CellML environment intermediate field.
Definition: cmiss_cellml.f90:3821
input_output::write_string
Write a string to a given output stream.
Definition: input_output.f90:74
base_routines
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Definition: base_routines.f90:45
cmiss_cellml::cellml_models_field
integer(intg), parameter, public cellml_models_field
CellML models field.
Definition: cmiss_cellml.f90:85
cmiss_cellml::map_cellml_field_type_to_variable_type_intg
integer(intg) function map_cellml_field_type_to_variable_type_intg(CELLML_FIELD_TYPE, ERR, ERROR)
Maps a CellML field type to a CellML variable type (.
Definition: cmiss_cellml.f90:4508
iso_varying_string::trim
Definition: iso_varying_string.f90:204
cmiss_cellml::cellml_models_field_get
subroutine, public cellml_models_field_get(CELLML, MODELS_FIELD, ERR, ERROR,)
Returns the models field for the given CellML environment.
Definition: cmiss_cellml.f90:2903
cmiss_cellml::cellml_variable_set_as_wanted
Definition: cmiss_cellml.f90:133
cmiss_cellml::cellml_create_field_to_cellml_map_c
subroutine cellml_create_field_to_cellml_map_c(CELLML, FIELD, VARIABLE_TYPE, COMPONENT_NUMBER, FIELD_PARAMETER_SET, MODEL_INDEX, VARIABLE_ID, CELLML_PARAMETER_SET, ERR, ERROR,)
Create a field variable component to CellML model variable map.
Definition: cmiss_cellml.f90:2245
types::cellml_state_field_type
Contains information on the state field for a CellML environment.
Definition: types.f90:2294
cmiss_cellml::cellml_map_to_field_type
integer(intg), parameter cellml_map_to_field_type
A CellML to field mapping type.
Definition: cmiss_cellml.f90:95
cmiss_cellml::cellml_models_field_not_constant
integer(intg), parameter, public cellml_models_field_not_constant
The CellML environement models field is not constant.
Definition: cmiss_cellml.f90:104
cmiss_cellml::cellml_model_maps_initialise
subroutine cellml_model_maps_initialise(CELLML_MODEL_MAPS, ERR, ERROR,)
Initialise a CellML model maps.
Definition: cmiss_cellml.f90:1660
iso_varying_string::erase
Definition: iso_varying_string.f90:282
cmiss_cellml::cellml_environments_initialise
subroutine, public cellml_environments_initialise(REGION, ERR, ERROR,)
Initialises the CellML environments.
Definition: cmiss_cellml.f90:4426
cmiss_cellml::cellml_state_field_get
subroutine, public cellml_state_field_get(CELLML, STATE_FIELD, ERR, ERROR,)
Returns the state field for the given CellML environment.
Definition: cmiss_cellml.f90:3325
types::cellml_model_map_type
Contains information on the mapping between CellML fields and OpenCMISS fields and vise versa...
Definition: types.f90:2327
cmiss_fortran_c::cmissf2cstring
subroutine, public cmissf2cstring(Fstring, Cstring)
Copys/converts a Fortran String (length of characters) to a C string (array of characters) ...
Definition: cmiss_fortran_c.f90:109
base_routines::diagnostics1
logical, save, public diagnostics1
.TRUE. if level 1 diagnostic output is active in the current routine
Definition: base_routines.f90:153
cmiss_cellml::cellml_models_field_check
subroutine cellml_models_field_check(MODELS_FIELD, ERR, ERROR,)
Checks a CellML environment models field for correctness.
Definition: cmiss_cellml.f90:2557
types::cellml_models_field_type
Contains information on the models field for a CellML environment.
Definition: types.f90:2285
cmiss_cellml::cellml_model_import_c
subroutine cellml_model_import_c(CELLML, URI, MODEL_INDEX, ERR, ERROR,)
Import the specified CellML model into the given CellML environment object.
Definition: cmiss_cellml.f90:1701
cmiss_cellml
This module is a OpenCMISS(cm) buffer module to OpenCMISS(cellml).
Definition: cmiss_cellml.f90:45
cmiss_cellml::cellml_variable_set_as_known_c
subroutine cellml_variable_set_as_known_c(CELLML, MODEL_INDEX, VARIABLE_ID, ERR, ERROR,)
Sets a CellML model variable to be known - i.e., the variable&#39;s value will be set by an OpenCMISS fie...
Definition: cmiss_cellml.f90:1801
iso_varying_string::char
Definition: iso_varying_string.f90:138
types::cellml_environments_type
Contains information on the CellML environments defined.
Definition: types.f90:2398
types::field_parameter_set_type
A type to hold the parameter sets for a field.
Definition: types.f90:1268
iso_varying_string::len_trim
Definition: iso_varying_string.f90:166
types::cellml_ptr_type
A buffer type to allow for an array of pointers to a CELLML_TYPE.
Definition: types.f90:2393
base_routines::diagnostic_output_type
integer(intg), parameter, public diagnostic_output_type
Diagnostic output type.
Definition: base_routines.f90:67
cmiss_cellml::cellml_destroy
subroutine, public cellml_destroy(CELLML, ERR, ERROR,)
Destroys the given CellML environment.
Definition: cmiss_cellml.f90:720
cmiss_cellml::cellml_variable_set_as_known
Definition: cmiss_cellml.f90:128
types::field_variable_type
Contains information for a field variable defined on a field.
Definition: types.f90:1289
types::cellml_model_ptr_type
A buffer type to allow for an array of pointers to a CELLML_MODEL_TYPE.
Definition: types.f90:2280
types::cellml_model_type
This type is a wrapper for the C_PTR which references the actual CellML model definition object...
Definition: types.f90:2266
cmiss_cellml::cellml_state_field_create_finish
subroutine, public cellml_state_field_create_finish(CELLML, ERR, ERROR,)
Finialse the creation of the state field for the given CellML environment. Finish creating the state ...
Definition: cmiss_cellml.f90:3164
cmiss_cellml::cellml_create_field_to_cellml_map
Definition: cmiss_cellml.f90:143
cmiss_cellml::cellml_map_from_field_type
integer(intg), parameter cellml_map_from_field_type
A field to CellML mapping type.
Definition: cmiss_cellml.f90:96
cmiss_cellml::cellml_models_field_create_start
subroutine, public cellml_models_field_create_start(MODEL_FIELD_USER_NUMBER, CELLML, MODELS_FIELD, ERR, ERROR,)
Start the creation of the models field for the given CellML environment.
Definition: cmiss_cellml.f90:2662
cmiss_cellml::cellml_fieldmodeldofset
subroutine, public cellml_fieldmodeldofset(modelVariable, modelDofIdx, field, variableType, parameterSetIdx, componentIdx, value, err, error,)
Set the dof in a field specified by a model DOF and component to a value.
Definition: cmiss_cellml.f90:2479
cmiss_cellml::cellml_variable_set_as_known_vs
subroutine cellml_variable_set_as_known_vs(CELLML, MODEL_USER_NUMBER, VARIABLE_ID, ERR, ERROR,)
Sets a CellML model variable to be known - i.e., the variable&#39;s value will be set by an OpenCMISS fie...
Definition: cmiss_cellml.f90:1866
cmiss_cellml::cellml_state_field
integer(intg), parameter, public cellml_state_field
CellML state field.
Definition: cmiss_cellml.f90:86
cmiss_cellml::cellml_create_cellml_to_field_map
Definition: cmiss_cellml.f90:138
cmiss_cellml::cellml_parameters_field_create_start
subroutine, public cellml_parameters_field_create_start(PARAMETERS_FIELD_USER_NUMBER, CELLML, PARAMETERS_FIELD, ERR, ERROR,)
Start the creation of the parameters field for the given CellML environment.
Definition: cmiss_cellml.f90:3867
cmiss_cellml::cellml_create_cellml_to_field_map_vs
subroutine cellml_create_cellml_to_field_map_vs(CELLML, MODEL_USER_NUMBER, VARIABLE_ID, CELLML_PARAMETER_SET, FIELD, VARIABLE_TYPE, COMPONENT_NUMBER, FIELD_PARAMETER_SET, ERR, ERROR,)
Create a CellML model variable to field variable component map.
Definition: cmiss_cellml.f90:2205
cmiss_cellml::cellml_create_finish
subroutine, public cellml_create_finish(CELLML, ERR, ERROR,)
Finish creating the CellML environment. At this point we know all the variables that are known and wa...
Definition: cmiss_cellml.f90:655
cmiss_cellml::cellml_initialise
subroutine cellml_initialise(CELLML, ERR, ERROR,)
Initialise a CellML environment and deallocate all memory.
Definition: cmiss_cellml.f90:1195
cmiss_cellml::cellml_intermediate_field
integer(intg), parameter, public cellml_intermediate_field
CellML intermediate field.
Definition: cmiss_cellml.f90:87
cmiss_cellml::cellml_models_field_not_checked
integer(intg), parameter cellml_models_field_not_checked
The CellML environment models field has not been checked.
Definition: cmiss_cellml.f90:103
cmiss_cellml::cellml_parameters_field_initialise
subroutine cellml_parameters_field_initialise(CELLML, ERR, ERROR,)
Initialise a CellML environment parameters field.
Definition: cmiss_cellml.f90:4248
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
cmiss_cellml::cellml_field_component_get_vs
subroutine cellml_field_component_get_vs(CELLML, MODEL_INDEX, CELLML_FIELD_TYPE, VARIABLE_ID, COMPONENT_USER_NUMBER, ERR, ERROR,)
Find the component ID in the given field for the variable defined by the given variable ID in the pro...
Definition: cmiss_cellml.f90:3479
types::cellml_type
Contains information for a CellML environment.
Definition: types.f90:2372
cmiss_cellml::cellml_finalise
subroutine cellml_finalise(CELLML, ERR, ERROR,)
Finalise a CellML environment and deallocate all memory.
Definition: cmiss_cellml.f90:1151
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
cmiss_cellml::map_cellml_variable_type_to_field_type_intg
integer(intg) function map_cellml_variable_type_to_field_type_intg(CELLML_VARIABLE_TYPE, ERR, ERROR)
Maps a CellML variable type to a CellML field type (.
Definition: cmiss_cellml.f90:4463
cmiss_cellml::cellml_model_map_initialise
subroutine cellml_model_map_initialise(CELLML_MODEL_MAP, ERR, ERROR,)
Initialise a CellML model map.
Definition: cmiss_cellml.f90:1567
cmiss_cellml::cellml_model_initialise
subroutine cellml_model_initialise(CELLML_MODEL, ERR, ERROR,)
Initialise a CellML model.
Definition: cmiss_cellml.f90:1488
cmiss_cellml::cellml_model_maps_finalise
subroutine cellml_model_maps_finalise(CELLML_MODEL_MAPS, ERR, ERROR,)
Finalise a CellML model maps and deallocate all memory.
Definition: cmiss_cellml.f90:1615
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45