OpenCMISS-Iron Internal API Documentation
region_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE region_routines
46 
47  USE base_routines
48  USE coordinate_routines
49  USE cmiss_cellml
50  USE data_point_routines
51  USE equations_set_routines
52  USE field_routines
53  USE generated_mesh_routines
54  USE input_output
55  USE interface_routines
56  USE iso_varying_string
57  USE kinds
58  USE mesh_routines
59  USE node_routines
60  USE strings
61  USE types
62 
63 #include "macros.h"
64 
65  IMPLICIT NONE
66 
67  PRIVATE
68 
69  !Module parameters
70 
71  !Module types
72 
73  !Module variables
74 
75  TYPE(regions_type) :: regions
76 
77  !Interfaces
78 
79  INTERFACE region_label_get
80  MODULE PROCEDURE region_label_get_c
81  MODULE PROCEDURE region_label_get_vs
82  END INTERFACE !REGION_LABEL_GET
83 
84  INTERFACE region_label_set
85  MODULE PROCEDURE region_label_set_c
86  MODULE PROCEDURE region_label_set_vs
87  END INTERFACE !REGION_LABEL_SET
88 
89  PUBLIC region_coordinate_system_get,region_coordinate_system_set
90 
91  PUBLIC region_create_start,region_create_finish
92 
93  PUBLIC region_data_points_get
94 
95  PUBLIC region_destroy
96 
97  PUBLIC region_initialise,region_finalise
98 
99  PUBLIC region_label_get,region_label_set
100 
101  PUBLIC region_nodes_get
102 
103  PUBLIC region_user_number_find, region_user_number_to_region
104 
105  PUBLIC regions_initialise,regions_finalise
106 
107 CONTAINS
108 
109  !
110  !================================================================================================================================
111  !
112 
114  SUBROUTINE region_coordinate_system_get(REGION,COORDINATE_SYSTEM,ERR,ERROR,*)
115 
116  !Argument variables
117  TYPE(region_type), POINTER :: REGION
118  TYPE(coordinate_system_type), POINTER :: COORDINATE_SYSTEM
119  INTEGER(INTG), INTENT(OUT) :: ERR
120  TYPE(varying_string), INTENT(OUT) :: ERROR
121  !Local Variables
122 
123  enters("REGION_COORDINATE_SYSTEM_GET",err,error,*999)
124 
125  IF(ASSOCIATED(region)) THEN
126  IF(region%REGION_FINISHED) THEN
127  IF(ASSOCIATED(coordinate_system)) THEN
128  CALL flagerror("Coordinate system is already associated.",err,error,*999)
129  ELSE
130  coordinate_system=>region%COORDINATE_SYSTEM
131  ENDIF
132  ELSE
133  CALL flagerror("Region has not been finished.",err,error,*999)
134  ENDIF
135  ELSE
136  CALL flagerror("Region is not associated.",err,error,*999)
137  ENDIF
138 
139  exits("REGION_COORDINATE_SYSTEM_GET")
140  RETURN
141 999 errorsexits("REGION_COORDINATE_SYSTEM_GET",err,error)
142  RETURN 1
143  END SUBROUTINE region_coordinate_system_get
144 
145  !
146  !================================================================================================================================
147  !
148 
150  SUBROUTINE region_coordinate_system_set(REGION,COORDINATE_SYSTEM,ERR,ERROR,*)
151 
152  !Argument variables
153  TYPE(region_type), POINTER :: REGION
154  TYPE(coordinate_system_type), POINTER :: COORDINATE_SYSTEM
155  INTEGER(INTG), INTENT(OUT) :: ERR
156  TYPE(varying_string), INTENT(OUT) :: ERROR
157  !Local Variables
158 
159  enters("REGION_COORDINATE_SYSTEM_SET",err,error,*999)
160 
161  IF(ASSOCIATED(region)) THEN
162  IF(region%REGION_FINISHED) THEN
163  CALL flagerror("Region has been finished.",err,error,*999)
164  ELSE
165  IF(ASSOCIATED(coordinate_system)) THEN
166  IF(coordinate_system%COORDINATE_SYSTEM_FINISHED) THEN
167  region%COORDINATE_SYSTEM=>coordinate_system
168  ELSE
169  CALL flagerror("Coordinate system has not been finished.",err,error,*999)
170  ENDIF
171  ELSE
172  CALL flagerror("Coordinate system is not associated.",err,error,*999)
173  ENDIF
174  ENDIF
175  ELSE
176  CALL flagerror("Region is not associated.",err,error,*999)
177  ENDIF
178 
179  exits("REGION_COORDINATE_SYSTEM_SET")
180  RETURN
181 999 errorsexits("REGION_COORDINATE_SYSTEM_SET",err,error)
182  RETURN 1
183  END SUBROUTINE region_coordinate_system_set
184 
185  !
186  !================================================================================================================================
187  !
188 
190  SUBROUTINE region_create_finish(REGION,ERR,ERROR,*)
191 
192  !Argument variables
193  TYPE(region_type), POINTER :: REGION
194  INTEGER(INTG), INTENT(OUT) :: ERR
195  TYPE(varying_string), INTENT(OUT) :: ERROR
196  !Local Variables
197 
198  enters("REGION_CREATE_FINISH",err,error,*999)
199 
200  IF(ASSOCIATED(region)) THEN
201  IF(region%REGION_FINISHED) THEN
202  CALL flagerror("Region has already been finished.",err,error,*999)
203  ELSE
204  region%REGION_FINISHED=.true.
205  ENDIF
206  ELSE
207  CALL flagerror("Region is not associated.",err,error,*999)
208  ENDIF
209 
210  IF(diagnostics1) THEN
211  CALL write_string_value(diagnostic_output_type,"Region : ",region%USER_NUMBER,err,error,*999)
212  CALL write_string_value(diagnostic_output_type," Label = ",region%LABEL,err,error,*999)
213  IF(ASSOCIATED(region%PARENT_REGION)) THEN
214  CALL write_string_value(diagnostic_output_type," Parent region user number = ",region%PARENT_REGION%USER_NUMBER, &
215  & err,error,*999)
216  CALL write_string_value(diagnostic_output_type," Parent region label = ",region%PARENT_REGION%LABEL, &
217  & err,error,*999)
218  ENDIF
219  ENDIF
220 
221  exits("REGION_CREATE_FINISH")
222  RETURN
223 999 errorsexits("REGION_CREATE_FINISH",err,error)
224  RETURN 1
225  END SUBROUTINE region_create_finish
226 
227  !
228  !================================================================================================================================
229  !
230 
243  SUBROUTINE region_create_start(USER_NUMBER,PARENT_REGION,REGION,ERR,ERROR,*)
244 
245  !Argument variables
246  INTEGER(INTG), INTENT(IN) :: USER_NUMBER
247  TYPE(region_type), POINTER :: PARENT_REGION
248  TYPE(region_type), POINTER :: REGION
249  INTEGER(INTG), INTENT(OUT) :: ERR
250  TYPE(varying_string), INTENT(OUT) :: ERROR
251  !Local Variables
252  INTEGER(INTG) :: DUMMY_ERR,region_idx
253  TYPE(region_type), POINTER :: NEW_REGION
254  TYPE(region_ptr_type), POINTER :: NEW_SUB_REGIONS(:)
255  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR,LOCAL_STRING
256 
257  NULLIFY(new_region)
258  NULLIFY(new_sub_regions)
259 
260  enters("REGION_CREATE_START",err,error,*997)
261 
262  CALL region_user_number_find(user_number,new_region,err,error,*997)
263  IF(ASSOCIATED(new_region)) THEN
264  local_error="Region number "//trim(number_to_vstring(user_number,"*",err,error))// &
265  & " has already been created."
266  CALL flagerror(local_error,err,error,*997)
267  ELSE
268  IF(ASSOCIATED(region)) THEN
269  CALL flagerror("Region is already associated.",err,error,*997)
270  ELSE
271  NULLIFY(region)
272  IF(ASSOCIATED(parent_region)) THEN
273  IF(parent_region%REGION_FINISHED) THEN
274  IF(ASSOCIATED(parent_region%COORDINATE_SYSTEM)) THEN
275  !Initialise the region
276  CALL region_initialise(region,err,error,*999)
277  !Set the user number
278  region%USER_NUMBER=user_number
279  !CPB 21/02/07 The vstring operation crashes the AIX compiler so put a CHAR() etc. around it.
280  !REGION%LABEL="Region "//NUMBER_TO_VSTRING(USER_NUMBER,"*",ERR,ERROR)
281  local_string="Region "//number_to_vstring(user_number,"*",err,error)
282  region%LABEL=char(local_string)
283  IF(err/=0) GOTO 999
284  region%COORDINATE_SYSTEM=>parent_region%COORDINATE_SYSTEM
285  !Adjust the parent region to include this new daughter
286  ALLOCATE(new_sub_regions(parent_region%NUMBER_OF_SUB_REGIONS+1),stat=err)
287  IF(err/=0) CALL flagerror("Could not allocate new sub-regions.",err,error,*999)
288  DO region_idx=1,parent_region%NUMBER_OF_SUB_REGIONS
289  new_sub_regions(region_idx)%PTR=>parent_region%SUB_REGIONS(region_idx)%PTR
290  ENDDO !region_no
291  parent_region%NUMBER_OF_SUB_REGIONS=parent_region%NUMBER_OF_SUB_REGIONS+1
292  new_sub_regions(parent_region%NUMBER_OF_SUB_REGIONS)%PTR=>region
293  IF(ASSOCIATED(parent_region%SUB_REGIONS)) DEALLOCATE(parent_region%SUB_REGIONS)
294  parent_region%SUB_REGIONS=>new_sub_regions
295  !Set the new regions parent region to the parent region
296  region%PARENT_REGION=>parent_region
297  ELSE
298  CALL flagerror("Parent region does not have an associated coordinate system.",err,error,*997)
299  ENDIF
300  ELSE
301  CALL flagerror("Parent region has not been finished.",err,error,*997)
302  ENDIF
303  ELSE
304  CALL flagerror("Parent region is not associated.",err,error,*997)
305  ENDIF
306  ENDIF
307  ENDIF
308 
309  exits("REGION_CREATE_START")
310  RETURN
311 999 CALL region_finalise(region,dummy_err,dummy_error,*998)
312 998 IF(ASSOCIATED(new_sub_regions)) DEALLOCATE(new_sub_regions)
313 997 errorsexits("REGION_CREATE_START",err,error)
314  RETURN 1
315  END SUBROUTINE region_create_start
316 
317  !
318  !================================================================================================================================
319  !
320 
322  SUBROUTINE region_data_points_get(REGION,DATA_POINTS,ERR,ERROR,*)
323 
324  !Argument variables
325  TYPE(region_type), POINTER :: REGION
326  TYPE(data_points_type), POINTER :: DATA_POINTS
327  INTEGER(INTG), INTENT(OUT) :: ERR
328  TYPE(varying_string), INTENT(OUT) :: ERROR
329  !Local Variables
330 
331  enters("REGION_DATA_POINTS_GET",err,error,*998)
332 
333  IF(ASSOCIATED(region)) THEN
334  IF(region%REGION_FINISHED) THEN
335  IF(ASSOCIATED(data_points)) THEN
336  CALL flagerror("Data points is already associated.",err,error,*998)
337  ELSE
338  data_points=>region%DATA_POINTS
339  IF(.NOT.ASSOCIATED(data_points)) CALL flagerror("Data points is not associated.",err,error,*999)
340  ENDIF
341  ELSE
342  CALL flagerror("Region has not been finished.",err,error,*998)
343  ENDIF
344  ELSE
345  CALL flagerror("Region is not associated.",err,error,*998)
346  ENDIF
347 
348  exits("REGION_DATA_POINTS_GET")
349  RETURN
350 999 NULLIFY(data_points)
351 998 errorsexits("REGION_DATA_POINTS_GET",err,error)
352  RETURN 1
353 
354  END SUBROUTINE region_data_points_get
355 
356 
357  !
358  !================================================================================================================================
359  !
360 
362  RECURSIVE SUBROUTINE region_destroy_number(USER_NUMBER,ERR,ERROR,*)
363 
364  !Argument variables
365  INTEGER(INTG), INTENT(IN) :: USER_NUMBER
366  INTEGER(INTG), INTENT(OUT) :: ERR
367  TYPE(varying_string), INTENT(OUT) :: ERROR
368  !Local Variables
369  INTEGER(INTG) :: count,nr
370  TYPE(region_type), POINTER :: REGION
371  TYPE(region_ptr_type), POINTER :: NEW_SUB_REGIONS(:)
372 
373  enters("REGION_DESTROY_NUMBER",err,error,*999)
374 
375  NULLIFY(region)
376  CALL region_user_number_find(user_number,region,err,error,*999)
377  IF(ASSOCIATED(region)) THEN
378 
379 !!NOTE: We have to find a pointer to the region to destroy within this routine rather than passing in a pointer to a
380 !!DESTROY_REGION_PTR type routine because we need to change REGION%SUB_REGIONS of the PARENT region and this would violate section
381 !!12.4.1.6 of the Fortran standard if the dummy REGION pointer argument was associated with the SUB_REGIONS(x)%PTR actual
382 !!argument.
383 
384  IF(region%NUMBER_OF_SUB_REGIONS==0) THEN
385  !No more daughter sub regions so delete this instance
386  IF(ASSOCIATED(region%PARENT_REGION)) THEN
387  NULLIFY(new_sub_regions)
388  IF(region%PARENT_REGION%NUMBER_OF_SUB_REGIONS>1) THEN
389  !If the parent region has more than one sub regions then remove this instance from its sub-regions list
390  ALLOCATE(new_sub_regions(region%PARENT_REGION%NUMBER_OF_SUB_REGIONS-1),stat=err)
391  IF(err/=0) CALL flagerror("Could not allocate new sub-regions.",err,error,*999)
392  count=0
393  DO nr=1,region%PARENT_REGION%NUMBER_OF_SUB_REGIONS
394  IF(region%PARENT_REGION%SUB_REGIONS(nr)%PTR%USER_NUMBER/=region%USER_NUMBER) THEN
395  count=count+1
396  new_sub_regions(count)%PTR=>region%PARENT_REGION%SUB_REGIONS(nr)%PTR
397  ENDIF
398  ENDDO !nr
399  ENDIF
400  region%PARENT_REGION%NUMBER_OF_SUB_REGIONS=region%PARENT_REGION%NUMBER_OF_SUB_REGIONS-1
401  IF(ASSOCIATED(region%PARENT_REGION%SUB_REGIONS)) DEALLOCATE(region%PARENT_REGION%SUB_REGIONS)
402  region%PARENT_REGION%SUB_REGIONS=>new_sub_regions
403  !Finalise the region
404  CALL region_finalise(region,err,error,*999)
405  ELSE
406  CALL flagerror("Parent region is not associated.",err,error,*999)
407  ENDIF
408  ELSE
409  !Recursively delete sub regions first
410  DO WHILE(region%NUMBER_OF_SUB_REGIONS>0)
411  CALL region_destroy_number(region%SUB_REGIONS(1)%PTR%USER_NUMBER,err,error,*999)
412  ENDDO
413  !Now delete this instance
414  CALL region_destroy_number(region%USER_NUMBER,err,error,*999)
415  ENDIF
416  ELSE
417  CALL flagerror("Region number does not exist.",err,error,*999)
418  ENDIF
419 
420  exits("REGION_DESTROY_NUMBER")
421  RETURN
422 999 errorsexits("REGION_DESTROY_NUMBER",err,error)
423  RETURN 1
424  END SUBROUTINE region_destroy_number
425 
426  !
427  !================================================================================================================================
428  !
429 
431  SUBROUTINE region_destroy(REGION,ERR,ERROR,*)
432 
433  !Argument variables
434  TYPE(region_type), POINTER :: REGION
435  INTEGER(INTG), INTENT(OUT) :: ERR
436  TYPE(varying_string), INTENT(OUT) :: ERROR
437  !Local Variables
438  INTEGER(INTG) :: USER_NUMBER
439 
440  enters("REGION_DESTROY",err,error,*999)
441 
442  IF(ASSOCIATED(region)) THEN
443  user_number=region%USER_NUMBER
444  CALL region_destroy_number(user_number,err,error,*999)
445  ELSE
446  CALL flagerror("Region is not associated.",err,error,*999)
447  ENDIF
448 
449  exits("REGION_DESTROY")
450  RETURN
451 999 errorsexits("REGION_DESTROY",err,error)
452  RETURN 1
453  END SUBROUTINE region_destroy
454 
455  !
456  !================================================================================================================================
457  !
458 
460  SUBROUTINE region_finalise(REGION,ERR,ERROR,*)
461 
462  !Argument variables
463  TYPE(region_type), POINTER :: REGION
464  INTEGER(INTG), INTENT(OUT) :: ERR
465  TYPE(varying_string), INTENT(OUT) :: ERROR
466  !Local Variables
467 
468  enters("REGION_FINALISE",err,error,*999)
469 
470  IF(ASSOCIATED(region)) THEN
471  region%LABEL=""
472  CALL cellml_environments_finalise(region%CELLML_ENVIRONMENTS,err,error,*999)
473  CALL equations_sets_finalise(region,err,error,*999)
474  CALL fields_finalise(region%FIELDS,err,error,*999)
475  CALL meshes_finalise(region%MESHES,err,error,*999)
476  IF(ASSOCIATED(region%DATA_POINTS)) CALL data_points_destroy(region%DATA_POINTS,err,error,*999)
477  IF(ASSOCIATED(region%NODES)) CALL nodes_destroy(region%NODES,err,error,*999)
478  IF(ASSOCIATED(region%SUB_REGIONS)) DEALLOCATE(region%SUB_REGIONS)
479  IF(ASSOCIATED(region%INTERFACES)) CALL interfaces_finalise(region%INTERFACES,err,error,*999)
480  IF(ASSOCIATED(region%GENERATED_MESHES)) CALL generated_meshes_finalise(region%GENERATED_MESHES,err,error,*999)
481  DEALLOCATE(region)
482  ENDIF
483 
484  exits("REGION_FINALISE")
485  RETURN
486 999 errorsexits("REGION_FINALISE",err,error)
487  RETURN 1
488  END SUBROUTINE region_finalise
489 
490  !
491  !================================================================================================================================
492  !
493 
495  SUBROUTINE region_initialise(REGION,ERR,ERROR,*)
496 
497  !Argument variables
498  TYPE(region_type), POINTER :: REGION
499  INTEGER(INTG), INTENT(OUT) :: ERR
500  TYPE(varying_string), INTENT(OUT) :: ERROR
501  !Local Variables
502  INTEGER(INTG) :: DUMMY_ERR
503  TYPE(varying_string) :: DUMMY_ERROR
504 
505  enters("REGION_INITIALISE",err,error,*998)
506 
507  IF(ASSOCIATED(region)) THEN
508  CALL flagerror("Region is already associated.",err,error,*998)
509  ELSE
510  ALLOCATE(region,stat=err)
511  IF(err/=0) CALL flagerror("Could not allocate region.",err,error,*999)
512  region%USER_NUMBER=0
513  region%REGION_FINISHED=.false.
514  region%LABEL=""
515  NULLIFY(region%COORDINATE_SYSTEM)
516  NULLIFY(region%DATA_POINTS)
517  NULLIFY(region%NODES)
518  NULLIFY(region%MESHES)
519  NULLIFY(region%GENERATED_MESHES)
520  NULLIFY(region%FIELDS)
521  NULLIFY(region%EQUATIONS_SETS)
522  NULLIFY(region%CELLML_ENVIRONMENTS)
523  NULLIFY(region%PARENT_REGION)
524  region%NUMBER_OF_SUB_REGIONS=0
525  NULLIFY(region%SUB_REGIONS)
526  NULLIFY(region%INTERFACES)
527  CALL meshes_initialise(region,err,error,*999)
528  CALL generated_meshes_initialise(region,err,error,*999)
529  CALL fields_initialise(region,err,error,*999)
530  CALL equations_sets_initialise(region,err,error,*999)
531  CALL cellml_environments_initialise(region,err,error,*999)
532  CALL interfaces_initialise(region,err,error,*999)
533  ENDIF
534 
535  exits("REGION_INITIALISE")
536  RETURN
537 999 CALL region_finalise(region,dummy_err,dummy_error,*998)
538 998 errorsexits("REGION_INITIALISE",err,error)
539  RETURN 1
540 
541  END SUBROUTINE region_initialise
542 
543  !
544  !================================================================================================================================
545  !
546 
548  SUBROUTINE region_label_get_c(REGION,LABEL,ERR,ERROR,*)
549 
550  !Argument variables
551  TYPE(region_type), POINTER :: REGION
552  CHARACTER(LEN=*), INTENT(OUT) :: LABEL
553  INTEGER(INTG), INTENT(OUT) :: ERR
554  TYPE(varying_string), INTENT(OUT) :: ERROR
555  !Local Variables
556  INTEGER(INTG) :: C_LENGTH,VS_LENGTH
557 
558  enters("REGION_LABEL_GET_C",err,error,*999)
559 
560  IF(ASSOCIATED(region)) THEN
561  c_length=len(label)
562  vs_length=len_trim(region%LABEL)
563  IF(c_length>vs_length) THEN
564  label=char(region%LABEL,vs_length)
565  ELSE
566  label=char(region%LABEL,c_length)
567  ENDIF
568  ELSE
569  CALL flagerror("Region is not associated.",err,error,*999)
570  ENDIF
571 
572  exits("REGION_LABEL_GET_C")
573  RETURN
574 999 errorsexits("REGION_LABEL_GET_C",err,error)
575  RETURN 1
576 
577  END SUBROUTINE region_label_get_c
578 
579  !
580  !================================================================================================================================
581  !
582 
584  SUBROUTINE region_label_get_vs(REGION,LABEL,ERR,ERROR,*)
585 
586  !Argument variables
587  TYPE(region_type), POINTER :: REGION
588  TYPE(varying_string), INTENT(OUT) :: LABEL
589  INTEGER(INTG), INTENT(OUT) :: ERR
590  TYPE(varying_string), INTENT(OUT) :: ERROR
591  !Local Variables
592 
593  enters("REGION_LABEL_GET_VS",err,error,*999)
594 
595  IF(ASSOCIATED(region)) THEN
596  !CPB 20/2/07 The following line crashes the AIX compiler unless it has a VAR_STR(CHAR()) around it
597  label=var_str(char(region%LABEL))
598  ELSE
599  CALL flagerror("Region is not associated.",err,error,*999)
600  ENDIF
601 
602  exits("REGION_LABEL_GET_VS")
603  RETURN
604 999 errorsexits("REGION_LABEL_GET_VS",err,error)
605  RETURN 1
606 
607  END SUBROUTINE region_label_get_vs
608 
609  !
610  !================================================================================================================================
611  !
612 
614  SUBROUTINE region_label_set_c(REGION,LABEL,ERR,ERROR,*)
615 
616  !Argument variables
617  TYPE(region_type), POINTER :: REGION
618  CHARACTER(LEN=*), INTENT(IN) :: LABEL
619  INTEGER(INTG), INTENT(OUT) :: ERR
620  TYPE(varying_string), INTENT(OUT) :: ERROR
621  !Local Variables
622 
623  enters("REGION_LABEL_SET_C",err,error,*999)
624 
625  IF(ASSOCIATED(region)) THEN
626  IF(region%REGION_FINISHED) THEN
627  CALL flagerror("Region has been finished.",err,error,*999)
628  ELSE
629  region%LABEL=label
630  ENDIF
631  ELSE
632  CALL flagerror("Region is not associated.",err,error,*999)
633  ENDIF
634 
635  exits("REGION_LABEL_SET_C")
636  RETURN
637 999 errorsexits("REGION_LABEL_SET_C",err,error)
638  RETURN 1
639  END SUBROUTINE region_label_set_c
640 
641  !
642  !================================================================================================================================
643  !
644 
646  SUBROUTINE region_label_set_vs(REGION,LABEL,ERR,ERROR,*)
647 
648  !Argument variables
649  TYPE(region_type), POINTER :: REGION
650  TYPE(varying_string), INTENT(IN) :: LABEL
651  INTEGER(INTG), INTENT(OUT) :: ERR
652  TYPE(varying_string), INTENT(OUT) :: ERROR
653  !Local Variables
654 
655  enters("REGION_LABEL_SET_VS",err,error,*999)
656 
657  IF(ASSOCIATED(region)) THEN
658  IF(region%REGION_FINISHED) THEN
659  CALL flagerror("Region has been finished.",err,error,*999)
660  ELSE
661  region%LABEL=label
662  ENDIF
663  ELSE
664  CALL flagerror("Region is not associated.",err,error,*999)
665  ENDIF
666 
667  exits("REGION_LABEL_SET_VS")
668  RETURN
669 999 errorsexits("REGION_LABEL_SET_VS",err,error)
670  RETURN 1
671  END SUBROUTINE region_label_set_vs
672 
673  !
674  !================================================================================================================================
675  !
676 
678  SUBROUTINE region_nodes_get(REGION,NODES,ERR,ERROR,*)
679 
680  !Argument variables
681  TYPE(region_type), POINTER :: REGION
682  TYPE(nodes_type), POINTER :: NODES
683  INTEGER(INTG), INTENT(OUT) :: ERR
684  TYPE(varying_string), INTENT(OUT) :: ERROR
685  !Local Variables
686 
687  enters("REGION_NODES_GET",err,error,*998)
688 
689  IF(ASSOCIATED(region)) THEN
690  IF(region%REGION_FINISHED) THEN
691  IF(ASSOCIATED(nodes)) THEN
692  CALL flagerror("Nodes is already associated.",err,error,*998)
693  ELSE
694  nodes=>region%NODES
695  IF(.NOT.ASSOCIATED(nodes)) CALL flagerror("Nodes is not associated.",err,error,*999)
696  ENDIF
697  ELSE
698  CALL flagerror("Region has not been finished.",err,error,*998)
699  ENDIF
700  ELSE
701  CALL flagerror("Region is not associated.",err,error,*998)
702  ENDIF
703 
704  exits("REGION_NODES_GET")
705  RETURN
706 999 NULLIFY(nodes)
707 998 errorsexits("REGION_NODES_GET",err,error)
708  RETURN 1
709 
710  END SUBROUTINE region_nodes_get
711 
712  !
713  !================================================================================================================================
714  !
715 
718  SUBROUTINE region_user_number_find(USER_NUMBER,REGION,ERR,ERROR,*)
719 
720  !Argument variables
721  INTEGER(INTG), INTENT(IN) :: USER_NUMBER
722  TYPE(region_type), POINTER :: REGION
723  INTEGER(INTG), INTENT(OUT) :: ERR
724  TYPE(varying_string), INTENT(OUT) :: ERROR
725  !Local Variables
726  INTEGER(INTG) :: nr
727  TYPE(region_type), POINTER :: WORLD_REGION
728 
729  enters("REGION_USER_NUMBER_FIND",err,error,*999)
730 
731  IF(ASSOCIATED(region)) THEN
732  CALL flagerror("Region is already associated.",err,error,*999)
733  ELSE
734  NULLIFY(region)
735  world_region=>regions%WORLD_REGION
736  IF(ASSOCIATED(world_region)) THEN
737  IF(user_number==0) THEN
738  region=>world_region
739  ELSE
740  nr=1
741  DO WHILE(nr<=world_region%NUMBER_OF_SUB_REGIONS.AND..NOT.ASSOCIATED(region))
742  CALL region_user_number_find_ptr(user_number,world_region%SUB_REGIONS(nr)%PTR,region,err,error,*999)
743  IF(.NOT.ASSOCIATED(region)) nr=nr+1
744  END DO
745  ENDIF
746  ELSE
747  CALL flagerror("World region is not associated.",err,error,*999)
748  ENDIF
749  ENDIF
750 
751  exits("REGION_USER_NUMBER_FIND")
752  RETURN
753 999 errorsexits("REGION_USER_NUMBER_FIND",err,error)
754  RETURN 1
755  END SUBROUTINE region_user_number_find
756 
757  !
758  !================================================================================================================================
759  !
760 
764  RECURSIVE SUBROUTINE region_user_number_find_ptr(USER_NUMBER,START_REGION,REGION,ERR,ERROR,*)
765 
766  !Argument variables
767  INTEGER(INTG), INTENT(IN) :: USER_NUMBER
768  TYPE(region_type), POINTER :: START_REGION
769  TYPE(region_type), POINTER :: REGION
770  INTEGER(INTG), INTENT(OUT) :: ERR
771  TYPE(varying_string), INTENT(OUT) :: ERROR
772  !Local Variables
773  INTEGER(INTG) :: nr
774 
775  enters("REGION_USER_NUMBER_FIND_PTR",err,error,*999)
776 
777  NULLIFY(region)
778  IF(ASSOCIATED(start_region)) THEN
779  IF(start_region%USER_NUMBER==user_number) THEN
780  region=>start_region
781  ELSE
782  nr=1
783  DO WHILE(nr<=start_region%NUMBER_OF_SUB_REGIONS.AND..NOT.ASSOCIATED(region))
784  CALL region_user_number_find_ptr(user_number,region,start_region%SUB_REGIONS(nr)%PTR,err,error,*999)
785  IF(.NOT.ASSOCIATED(region)) nr=nr+1
786  END DO
787  ENDIF
788  ELSE
789  CALL flagerror("Start region is not associated",err,error,*999)
790  ENDIF
791 
792  exits("REGION_USER_NUMBER_FIND_PTR")
793  RETURN
794 999 errorsexits("REGION_USER_NUMBER_FIND_PTR",err,error)
795  RETURN 1
796  END SUBROUTINE region_user_number_find_ptr
797 
798  !
799  !================================================================================================================================
800  !
801 
803  SUBROUTINE regions_finalise(ERR,ERROR,*)
804 
805  !Argument variables
806  INTEGER(INTG), INTENT(OUT) :: ERR
807  TYPE(varying_string), INTENT(OUT) :: ERROR
808  !Local Variables
809 
810  enters("REGIONS_FINALISE",err,error,*999)
811 
812  IF(ASSOCIATED(regions%WORLD_REGION)) THEN
813  !Destroy any global region daughter regions first
814  DO WHILE(regions%WORLD_REGION%NUMBER_OF_SUB_REGIONS>0)
815  CALL region_destroy_number(regions%WORLD_REGION%SUB_REGIONS(1)%PTR%USER_NUMBER,err,error,*999)
816  ENDDO !region
817  !Destroy global region and deallocated any memory allocated in the global region
818  CALL region_finalise(regions%WORLD_REGION,err,error,*999)
819  NULLIFY(regions%WORLD_REGION)
820  ENDIF
821 
822  exits("REGIONS_FINALISE")
823  RETURN
824 999 errorsexits("REGIONS_FINALISE",err,error)
825  RETURN 1
826  END SUBROUTINE regions_finalise
827 
828  !
829  !================================================================================================================================
830  !
831 
833  SUBROUTINE regions_initialise(WORLD_REGION,ERR,ERROR,*)
834 
835  !Argument variables
836  TYPE(region_type), POINTER :: WORLD_REGION
837  INTEGER(INTG), INTENT(OUT) :: ERR
838  TYPE(varying_string), INTENT(OUT) :: ERROR
839  !Local Variables
840  TYPE(coordinate_system_type), POINTER :: WORLD_COORDINATE_SYSTEM
841 
842  NULLIFY(world_coordinate_system)
843 
844  enters("REGIONS_INITIALISE",err,error,*999)
845 
846  IF(ASSOCIATED(world_region)) THEN
847  CALL flagerror("World region is already associated.",err,error,*999)
848  ELSE
849  CALL coordinate_system_user_number_find(0,world_coordinate_system,err,error,*999)
850  IF(ASSOCIATED(world_coordinate_system)) THEN
851  CALL region_initialise(regions%WORLD_REGION,err,error,*999)
852  regions%WORLD_REGION%USER_NUMBER=0
853  regions%WORLD_REGION%LABEL="World Region"
854  regions%WORLD_REGION%COORDINATE_SYSTEM=>world_coordinate_system
855  regions%WORLD_REGION%REGION_FINISHED=.true.
856  !Return the pointer
857  world_region=>regions%WORLD_REGION
858  ELSE
859  CALL flagerror("World coordinate system has not been created.",err,error,*999)
860  ENDIF
861  ENDIF
862 
863  exits("REGIONS_INITIALISE")
864  RETURN
865 999 errorsexits("REGIONS_INITIALISE",err,error)
866  RETURN 1
867  END SUBROUTINE regions_initialise
868 
869  !
870  !================================================================================================================================
871  !
872 
874  SUBROUTINE region_user_number_to_region( USER_NUMBER, REGION, ERR, ERROR, * )
875  !Arguments
876  INTEGER(INTG), INTENT(IN) :: USER_NUMBER
877  TYPE(region_type), POINTER :: REGION
878  INTEGER(INTG), INTENT(OUT) :: ERR
879  TYPE(varying_string), INTENT(OUT) :: ERROR
880 
881  !Locals
882  TYPE(varying_string) :: LOCAL_ERROR
883 
884  enters("REGION_USER_NUMBER_TO_REGION", err, error, *999 )
885 
886  NULLIFY( region )
887  CALL region_user_number_find( user_number, region, err, error, *999 )
888  IF( .NOT.ASSOCIATED( region ) ) THEN
889  local_error = "A region with an user number of "//trim(number_to_vstring(user_number,"*", err, error ) )//" does not exist."
890  CALL flagerror( local_error, err, error, *999 )
891  ENDIF
892 
893  exits( "REGION_USER_NUMBER_TO_REGION" )
894  RETURN
895 999 errorsexits( "REGION_USER_NUMBER_TO_REGION", err, error )
896  RETURN 1
897 
898  END SUBROUTINE region_user_number_to_region
899 
900  !
901  !================================================================================================================================
902  !
903 
904 END MODULE region_routines
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
coordinate_routines
This module contains all coordinate transformation and support routines.
Definition: coordinate_routines.f90:45
region_routines::region_user_number_to_region
subroutine, public region_user_number_to_region(USER_NUMBER, REGION, ERR, ERROR,)
Find the region with the given user number, or throw an error if it does not exist.
Definition: region_routines.f90:875
types::region_type
Contains information for a region.
Definition: types.f90:3252
strings::number_to_vstring
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
region_routines
This module contains all region routines.
Definition: region_routines.f90:45
types::region_ptr_type
A buffer type to allow for an array of pointers to a REGION_TYPE.
Definition: types.f90:3247
region_routines::region_data_points_get
subroutine, public region_data_points_get(REGION, DATA_POINTS, ERR, ERROR,)
Returns a pointer to the data points for a region.
Definition: region_routines.f90:323
region_routines::region_destroy_number
recursive subroutine region_destroy_number(USER_NUMBER, ERR, ERROR,)
Destroys a region given by USER_NUMBER and all sub-regions under it.
Definition: region_routines.f90:363
types::data_points_type
Contains information on the data points defined on a region.
Definition: types.f90:333
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
region_routines::region_label_get
Definition: region_routines.f90:79
region_routines::region_coordinate_system_set
subroutine, public region_coordinate_system_set(REGION, COORDINATE_SYSTEM, ERR, ERROR,)
Sets the coordinate system of region.
Definition: region_routines.f90:151
region_routines::region_finalise
subroutine, public region_finalise(REGION, ERR, ERROR,)
Finalises a region and deallocates all memory.
Definition: region_routines.f90:461
region_routines::region_label_set
Definition: region_routines.f90:84
coordinate_routines::coordinate_system_user_number_find
subroutine, public coordinate_system_user_number_find(USER_NUMBER, COORDINATE_SYSTEM, ERR, ERROR,)
Returns a pointer to the coordinate system identified by USER_NUMBER. If a coordinate system with tha...
Definition: coordinate_routines.f90:4253
region_routines::region_nodes_get
subroutine, public region_nodes_get(REGION, NODES, ERR, ERROR,)
Returns a pointer to the nodes for a region.
Definition: region_routines.f90:679
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
types::coordinate_system_type
Contains information on a coordinate system.
Definition: types.f90:255
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
iso_varying_string::len
Definition: iso_varying_string.f90:162
types::regions_type
Contains information about the regions.
Definition: types.f90:3271
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
region_routines::region_initialise
subroutine, public region_initialise(REGION, ERR, ERROR,)
Initialises a region.
Definition: region_routines.f90:496
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
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
iso_varying_string::trim
Definition: iso_varying_string.f90:204
region_routines::regions
type(regions_type) regions
Definition: region_routines.f90:75
iso_varying_string::var_str
Definition: iso_varying_string.f90:214
region_routines::region_destroy
subroutine, public region_destroy(REGION, ERR, ERROR,)
Destroys a region identified by a pointer and all sub-regions under it.
Definition: region_routines.f90:432
region_routines::region_create_start
subroutine, public region_create_start(USER_NUMBER, PARENT_REGION, REGION, ERR, ERROR,)
Starts the creation a new region number USER_NUMBER as a sub region to the given PARENT_REGION, initialises all variables and inherits the PARENT_REGIONS coordinate system.
Definition: region_routines.f90:244
cmiss_cellml::cellml_environments_initialise
subroutine, public cellml_environments_initialise(REGION, ERR, ERROR,)
Initialises the CellML environments.
Definition: cmiss_cellml.f90:4426
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
This module is a OpenCMISS(cm) buffer module to OpenCMISS(cellml).
Definition: cmiss_cellml.f90:45
region_routines::regions_finalise
subroutine, public regions_finalise(ERR, ERROR,)
Finalises the regions and destroys any current regions.
Definition: region_routines.f90:804
region_routines::region_user_number_find_ptr
recursive subroutine region_user_number_find_ptr(USER_NUMBER, START_REGION, REGION, ERR, ERROR,)
Finds and returns in REGION a pointer to the region with the number given in USER_NUMBER starting fro...
Definition: region_routines.f90:765
iso_varying_string::char
Definition: iso_varying_string.f90:138
iso_varying_string::len_trim
Definition: iso_varying_string.f90:166
base_routines::diagnostic_output_type
integer(intg), parameter, public diagnostic_output_type
Diagnostic output type.
Definition: base_routines.f90:67
region_routines::regions_initialise
subroutine, public regions_initialise(WORLD_REGION, ERR, ERROR,)
Initialises the regions and creates the global world region.
Definition: region_routines.f90:834
types::nodes_type
Contains information on the nodes defined on a region.
Definition: types.f90:359
region_routines::region_user_number_find
subroutine, public region_user_number_find(USER_NUMBER, REGION, ERR, ERROR,)
Finds and returns in REGION a pointer to the region with the number given in USER_NUMBER. If no region with that number exits REGION is left nullified.
Definition: region_routines.f90:719
region_routines::region_label_get_vs
subroutine region_label_get_vs(REGION, LABEL, ERR, ERROR,)
Returns the label of a region.
Definition: region_routines.f90:585
region_routines::region_create_finish
subroutine, public region_create_finish(REGION, ERR, ERROR,)
Finishes the creation of a region.
Definition: region_routines.f90:191
region_routines::region_label_get_c
subroutine region_label_get_c(REGION, LABEL, ERR, ERROR,)
Returns the label of a region.
Definition: region_routines.f90:549
equations_set_routines::equations_sets_finalise
subroutine, public equations_sets_finalise(REGION, ERR, ERROR,)
Finalises all equations sets on a region and deallocates all memory.
Definition: equations_set_routines.f90:6430
region_routines::region_label_set_vs
subroutine region_label_set_vs(REGION, LABEL, ERR, ERROR,)
Sets the label of a region.
Definition: region_routines.f90:647
equations_set_routines
This module handles all equations set routines.
Definition: equations_set_routines.f90:45
region_routines::region_label_set_c
subroutine region_label_set_c(REGION, LABEL, ERR, ERROR,)
Sets the label of a region.
Definition: region_routines.f90:615
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
equations_set_routines::equations_sets_initialise
subroutine, public equations_sets_initialise(REGION, ERR, ERROR,)
Intialises all equations sets on a region.
Definition: equations_set_routines.f90:6462
region_routines::region_coordinate_system_get
subroutine, public region_coordinate_system_get(REGION, COORDINATE_SYSTEM, ERR, ERROR,)
Returns the coordinate system of region.
Definition: region_routines.f90:115
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45