OpenCMISS-Iron Internal API Documentation
data_point_routines.f90
Go to the documentation of this file.
1 
43 
45 
46 MODULE data_point_routines
47 
48  USE base_routines
49  USE comp_environment
50  USE coordinate_routines
51  USE data_projection_routines
52  USE input_output
53  USE iso_varying_string
54  USE kinds
55  USE strings
56  USE trees
57  USE types
58 
59 #include "macros.h"
60 
61  IMPLICIT NONE
62 
63  PRIVATE
64 
65  !Module parameters
66 
67  !Module types
68 
69  !Module variables
70 
71  !Interfaces
72 
74  INTERFACE data_points_create_start
75  MODULE PROCEDURE data_points_create_start_region
76  MODULE PROCEDURE data_points_create_start_interface
77  END INTERFACE !DATA_POINTS_CREATE_START
78 
80  INTERFACE data_points_initialise
81  MODULE PROCEDURE data_points_initialise_region
82  MODULE PROCEDURE data_points_initialise_interface
83  END INTERFACE !DATA_POINTS_INITIALIES
84 
86  INTERFACE data_points_label_get
87  MODULE PROCEDURE data_points_label_get_c
88  MODULE PROCEDURE data_points_label_get_vs
89  END INTERFACE !DATA_POINTS_LABEL_SET
90 
92  INTERFACE data_points_label_set
93  MODULE PROCEDURE data_points_label_set_c
94  MODULE PROCEDURE data_points_label_set_vs
95  END INTERFACE !DATA_POINTS_LABEL_SET
96 
97  PUBLIC data_point_check_exists
98 
99  PUBLIC data_points_create_finish,data_points_create_start,data_points_destroy
100 
101  PUBLIC data_points_data_projection_get,datapoints_dataprojectionglobalnumberget
102 
103  PUBLIC data_points_global_number_get,data_points_label_get,data_points_label_set
104 
105  PUBLIC data_points_values_get,data_points_values_set
106 
107  PUBLIC data_points_number_of_data_points_get
108 
109  PUBLIC data_points_user_number_get,data_points_user_number_set
110 
111  PUBLIC data_points_weights_get,data_points_weights_set
112 
113 CONTAINS
114 
115  !
116  !================================================================================================================================
117  !
118 
120  SUBROUTINE data_point_check_exists(DATA_POINTS,USER_NUMBER,DATA_POINT_EXISTS,GLOBAL_NUMBER,ERR,ERROR,*)
121 
122  !Argument variables
123  TYPE(data_points_type), POINTER :: data_points
124  INTEGER(INTG) :: user_number
125  LOGICAL, INTENT(OUT) :: data_point_exists
126  INTEGER(INTG), INTENT(OUT) :: global_number
127  INTEGER(INTG), INTENT(OUT) :: err
128  TYPE(varying_string), INTENT(OUT) :: error
129  !Local Variables
130  TYPE(tree_node_type), POINTER :: tree_node
131 
132  enters("DATA_POINT_CHECK_EXISTS",err,error,*999)
133 
134  data_point_exists=.false.
135  global_number=0
136  IF(ASSOCIATED(data_points)) THEN
137  NULLIFY(tree_node)
138  CALL tree_search(data_points%DATA_POINTS_TREE,user_number,tree_node,err,error,*999)
139  IF(ASSOCIATED(tree_node)) THEN
140  CALL tree_node_value_get(data_points%DATA_POINTS_TREE,tree_node,global_number,err,error,*999)
141  data_point_exists=.true.
142  ENDIF
143  ELSE
144  CALL flagerror("Data points is not associated.",err,error,*999)
145  ENDIF
146 
147  exits("DATA_POINT_CHECK_EXISTS")
148  RETURN
149 999 errorsexits("DATA_POINT_CHECK_EXISTS",err,error)
150  RETURN 1
151 
152  END SUBROUTINE data_point_check_exists
153 
154  !
155  !================================================================================================================================
156  !
157 
159  SUBROUTINE data_point_finalise(DATA_POINT,ERR,ERROR,*)
160 
161  !Argument variables
162  TYPE(data_point_type),INTENT(OUT) :: data_point
163  INTEGER(INTG), INTENT(OUT) :: err
164  TYPE(varying_string), INTENT(OUT) :: error
165  !Local Variables
166 
167  enters("DATA_POINT_FINALISE",err,error,*999)
168 
169  data_point%GLOBAL_NUMBER=0
170  data_point%USER_NUMBER=0
171  IF(ALLOCATED(data_point%position)) DEALLOCATE(data_point%position)
172  IF(ALLOCATED(data_point%WEIGHTS)) DEALLOCATE(data_point%WEIGHTS)
173 
174  exits("DATA_POINT_FINALISE")
175  RETURN
176 999 errorsexits("DATA_POINT_FINALISE",err,error)
177  RETURN 1
178 
179  END SUBROUTINE data_point_finalise
180 
181  !
182  !================================================================================================================================
183  !
184 
186  SUBROUTINE data_points_create_finish(DATA_POINTS,ERR,ERROR,*)
187 
188  !Argument variables
189  TYPE(data_points_type), POINTER :: data_points
190  INTEGER(INTG), INTENT(OUT) :: err
191  TYPE(varying_string), INTENT(OUT) :: error
192  !Local Variables
193  INTEGER(INTG) :: data_point_idx
194 
195  enters("DATA_POINTS_CREATE_FINISH",err,error,*999)
196 
197  IF(ASSOCIATED(data_points)) THEN
198  IF(data_points%DATA_POINTS_FINISHED) THEN
199  CALL flagerror("Data points have already been finished.",err,error,*999)
200  ELSE
201  data_points%DATA_POINTS_FINISHED=.true.
202  ENDIF
203  ELSE
204  CALL flagerror("Data points is not associated.",err,error,*999)
205  ENDIF
206 
207  IF(diagnostics1) THEN
208  CALL write_string_value(diagnostic_output_type,"Number of data points = ",data_points%NUMBER_OF_DATA_POINTS,err,error,*999)
209  DO data_point_idx=1,data_points%NUMBER_OF_DATA_POINTS
210  CALL write_string_value(diagnostic_output_type," Data Points = ",data_point_idx,err,error,*999)
211  CALL write_string_value(diagnostic_output_type," Global number = ",data_points%DATA_POINTS(data_point_idx)% &
212  & global_number,err,error,*999)
213  CALL write_string_value(diagnostic_output_type," User number = ",data_points%DATA_POINTS(data_point_idx)% &
214  & user_number,err,error,*999)
215  CALL write_string_value(diagnostic_output_type," Label = ",data_points%DATA_POINTS(data_point_idx)%LABEL, &
216  & err,error,*999)
217  ENDDO !data_point_idx
218  CALL write_string(diagnostic_output_type,"Data points User->Global number tree",err,error,*999)
219  CALL tree_output(diagnostic_output_type,data_points%DATA_POINTS_TREE,err,error,*999)
220  ENDIF
221 
222  exits("DATA_POINTS_CREATE_FINISH")
223  RETURN
224 999 errorsexits("DATA_POINTS_CREATE_FINISH",err,error)
225  RETURN 1
226 
227  END SUBROUTINE data_points_create_finish
228 
229  !
230  !================================================================================================================================
231  !
232 
234  SUBROUTINE data_points_create_start_generic(DATA_POINTS,NUMBER_OF_DATA_POINTS,NUMBER_OF_DIMENSIONS, &
235  & err,error,*)
236 
237  !Argument variables
238  TYPE(data_points_type), POINTER :: data_points
239  INTEGER(INTG), INTENT(IN) :: number_of_data_points
240  INTEGER(INTG), INTENT(IN) :: number_of_dimensions
241  INTEGER(INTG), INTENT(OUT) :: err
242  TYPE(varying_string), INTENT(OUT) :: error
243  !Local Variables
244  INTEGER(INTG) :: insert_status,data_point_idx,coord_idx
245  TYPE(varying_string) :: local_error
246 
247  enters("DATA_POINTS_CREATE_START_GENERIC",err,error,*999)
248 
249  IF(ASSOCIATED(data_points)) THEN
250  IF(number_of_data_points>0) THEN
251  ALLOCATE(data_points%DATA_POINTS(number_of_data_points),stat=err)
252  IF(err/=0) CALL flagerror("Could not allocate data points data points.",err,error,*999)
253  data_points%NUMBER_OF_DATA_POINTS=number_of_data_points
254  data_points%NUMBER_OF_DATA_PROJECTIONS=0
255  IF(ALLOCATED(data_points%DATA_PROJECTIONS)) DEALLOCATE(data_points%DATA_PROJECTIONS)
256  CALL tree_create_start(data_points%DATA_PROJECTIONS_TREE,err,error,*999)
257  CALL tree_insert_type_set(data_points%DATA_PROJECTIONS_TREE,tree_no_duplicates_allowed,err,error,*999)
258  CALL tree_create_finish(data_points%DATA_PROJECTIONS_TREE,err,error,*999)
259  CALL tree_create_start(data_points%DATA_POINTS_TREE,err,error,*999)
260  CALL tree_insert_type_set(data_points%DATA_POINTS_TREE,tree_no_duplicates_allowed,err,error,*999)
261  CALL tree_create_finish(data_points%DATA_POINTS_TREE,err,error,*999)
262  !Set default data point numbers
263  DO data_point_idx=1,data_points%NUMBER_OF_DATA_POINTS
264  data_points%DATA_POINTS(data_point_idx)%GLOBAL_NUMBER=data_point_idx
265  data_points%DATA_POINTS(data_point_idx)%USER_NUMBER=data_point_idx
266  data_points%DATA_POINTS(data_point_idx)%LABEL=""
267  ! initialise data points values to 0.0 and weights to 1.0
268  ALLOCATE(data_points%DATA_POINTS(data_point_idx)%position(number_of_dimensions),stat=err)
269  IF(err/=0) CALL flagerror("Could not allocate data points data points("//trim(number_to_vstring &
270  & (data_point_idx,"*",err,error))//") values.",err,error,*999)
271  ALLOCATE(data_points%DATA_POINTS(data_point_idx)%WEIGHTS(number_of_dimensions),stat=err)
272  IF(err/=0) CALL flagerror("Could not allocate data points data points("//trim(number_to_vstring &
273  & (data_point_idx,"*",err,error))//") weights.",err,error,*999)
274  DO coord_idx=1,number_of_dimensions
275  data_points%DATA_POINTS(data_point_idx)%position(coord_idx)=0.0_dp
276  data_points%DATA_POINTS(data_point_idx)%WEIGHTS(coord_idx)=1.0_dp
277  ENDDO
278  CALL tree_item_insert(data_points%DATA_POINTS_TREE,data_point_idx,data_point_idx,insert_status,err,error,*999)
279  ENDDO !data_point_idx
280  ELSE
281  local_error="The specified number of data points of "//trim(number_to_vstring(number_of_data_points,"*",err,error))// &
282  & " is invalid. The number of data points must be > 0."
283  CALL flagerror(local_error,err,error,*999)
284  ENDIF
285  ELSE
286  CALL flagerror("Data points is not associated.",err,error,*999)
287  ENDIF
288 
289  exits("DATA_POINTS_CREATE_START_GENERIC")
290  RETURN
291 999 errorsexits("DATA_POINTS_CREATE_START_GENERIC",err,error)
292  RETURN 1
293 
294  END SUBROUTINE data_points_create_start_generic
295 
296  !
297  !================================================================================================================================
298  !
299 
301  SUBROUTINE data_points_create_start_interface(INTERFACE,NUMBER_OF_DATA_POINTS,DATA_POINTS,ERR,ERROR,*)
302 
303  !Argument variables
304  TYPE(interface_type), POINTER :: interface
305  INTEGER(INTG), INTENT(IN) :: number_of_data_points
306  TYPE(data_points_type), POINTER :: data_points
307  INTEGER(INTG), INTENT(OUT) :: err
308  TYPE(varying_string), INTENT(OUT) :: error
309  !Local Variables
310  INTEGER(INTG) :: dummy_err
311  TYPE(varying_string) :: dummy_error
312 
313  enters("DATA_POINTS_CREATE_START_INTERFACE",err,error,*998)
314 
315  IF(ASSOCIATED(interface)) THEN
316  IF(ASSOCIATED(data_points)) THEN
317  CALL flagerror("Data points is already associated.",err,error,*999)
318  ELSE
319  IF(ASSOCIATED(interface%DATA_POINTS)) THEN
320  CALL flagerror("Interface already has data points associated.",err,error,*998)
321  ELSE
322  !Initialise the data points for the interface
323  CALL data_points_initialise(interface,err,error,*999)
324  !Create the data points
325  CALL data_points_create_start_generic(interface%DATA_POINTS,number_of_data_points,interface% &
326  & coordinate_system%NUMBER_OF_DIMENSIONS,err,error,*999)
327  !Return the pointer
328  data_points=>interface%DATA_POINTS
329  ENDIF
330  ENDIF
331  ELSE
332  CALL flagerror("Interface is not associated.",err,error,*998)
333  ENDIF
334 
335  exits("DATA_POINTS_CREATE_START_INTERFACE")
336  RETURN
337 999 CALL data_points_finalise(interface%DATA_POINTS,dummy_err,dummy_error,*998)
338 998 errorsexits("DATA_POINTS_CREATE_START_INTERFACE",err,error)
339  RETURN 1
340 
341  END SUBROUTINE data_points_create_start_interface
342 
343  !
344  !================================================================================================================================
345  !
346 
348  SUBROUTINE data_points_create_start_region(REGION,NUMBER_OF_DATA_POINTS,DATA_POINTS,ERR,ERROR,*)
349 
350  !Argument variables
351  TYPE(region_type), POINTER :: region
352  INTEGER(INTG), INTENT(IN) :: number_of_data_points
353  TYPE(data_points_type), POINTER :: data_points
354  INTEGER(INTG), INTENT(OUT) :: err
355  TYPE(varying_string), INTENT(OUT) :: error
356  !Local Variables
357  INTEGER(INTG) :: dummy_err
358  TYPE(varying_string) :: dummy_error
359 
360  enters("DATA_POINTS_CREATE_START_REGION",err,error,*998)
361 
362  IF(ASSOCIATED(region)) THEN
363  IF(ASSOCIATED(data_points)) THEN
364  CALL flagerror("Data points is already associated.",err,error,*999)
365  ELSE
366  IF(ASSOCIATED(region%DATA_POINTS)) THEN
367  CALL flagerror("Region already has data points associated.",err,error,*998)
368  ELSE
369  !Initialise the data points for the region
370  CALL data_points_initialise(region,err,error,*999)
371  !Create the data points
372  CALL data_points_create_start_generic(region%DATA_POINTS,number_of_data_points,region%COORDINATE_SYSTEM% &
373  & number_of_dimensions,err,error,*999)
374  !Return the pointer
375  data_points=>region%DATA_POINTS
376  ENDIF
377  ENDIF
378  ELSE
379  CALL flagerror("Region is not associated.",err,error,*998)
380  ENDIF
381 
382  exits("DATA_POINTS_CREATE_START_REGION")
383  RETURN
384 999 CALL data_points_finalise(region%DATA_POINTS,dummy_err,dummy_error,*998)
385 998 errorsexits("DATA_POINTS_CREATE_START_REGION",err,error)
386  RETURN 1
387 
388  END SUBROUTINE data_points_create_start_region
389 
390 
391  !
392  !================================================================================================================================
393  !
394 
396  SUBROUTINE data_points_destroy(DATA_POINTS,ERR,ERROR,*)
397 
398  !Argument variables
399  TYPE(data_points_type), POINTER :: data_points
400  INTEGER(INTG), INTENT(OUT) :: err
401  TYPE(varying_string), INTENT(OUT) :: error
402  !Local Variables
403 
404  enters("DATA_POINTS_DESTROY",err,error,*999)
405 
406  IF(ASSOCIATED(data_points)) THEN
407  IF (ASSOCIATED(data_points%REGION)) THEN
408  NULLIFY(data_points%REGION%DATA_POINTS)
409  ELSE
410  CALL flag_error("Data_points region is not associated.",err,error,*999)
411  ENDIF
412  CALL data_points_finalise(data_points,err,error,*999)
413  ENDIF
414 
415  exits("DATA_POINTS_DESTROY")
416  RETURN
417 999 errorsexits("DATA_POINTS_DESTROY",err,error)
418  RETURN 1
419 
420  END SUBROUTINE data_points_destroy
421 
422  !
423  !===============================================================================================================================
424  !
425 
427  SUBROUTINE data_points_finalise(DATA_POINTS,ERR,ERROR,*)
428 
429  !Argument variables
430  TYPE(data_points_type), POINTER :: data_points
431  INTEGER(INTG), INTENT(OUT) :: err
432  TYPE(varying_string), INTENT(OUT) :: error
433  !Local Variables
434  INTEGER(INTG) :: data_point_idx,data_projection_idx
435 
436  enters("DATA_POINTS_FINALISE",err,error,*999)
437 
438  IF(ASSOCIATED(data_points)) THEN
439  IF(ALLOCATED(data_points%DATA_POINTS)) THEN
440  DO data_point_idx=1,SIZE(data_points%DATA_POINTS,1)
441  CALL data_point_finalise(data_points%DATA_POINTS(data_point_idx),err,error,*999)
442  ENDDO !data_point_idx
443  DEALLOCATE(data_points%DATA_POINTS)
444  ENDIF
445  IF(ASSOCIATED(data_points%DATA_POINTS_TREE)) CALL tree_destroy(data_points%DATA_POINTS_TREE,err,error,*999)
446  data_points%NUMBER_OF_DATA_PROJECTIONS=0
447  IF(ALLOCATED(data_points%DATA_PROJECTIONS)) THEN
448  DO data_projection_idx=1,SIZE(data_points%DATA_PROJECTIONS,1)
449  CALL data_projection_destroy(data_points%DATA_PROJECTIONS(data_projection_idx)%PTR,err,error,*999)
450  ENDDO !data_projection_idx
451  DEALLOCATE(data_points%DATA_PROJECTIONS)
452  ENDIF
453  IF(ASSOCIATED(data_points%DATA_PROJECTIONS_TREE)) CALL tree_destroy(data_points%DATA_PROJECTIONS_TREE,err,error,*999)
454  DEALLOCATE(data_points)
455  ENDIF
456 
457  exits("DATA_POINTS_FINALISE")
458  RETURN
459 999 errorsexits("DATA_POINTS_FINALISE",err,error)
460  RETURN 1
461 
462  END SUBROUTINE data_points_finalise
463 
464  !
465  !================================================================================================================================
466  !
467 
469  SUBROUTINE data_points_initialise_generic(DATA_POINTS,ERR,ERROR,*)
470 
471  !Argument variables
472  TYPE(data_points_type), POINTER :: data_points
473  INTEGER(INTG), INTENT(OUT) :: err
474  TYPE(varying_string), INTENT(OUT) :: error
475  !Local Variables
476 
477  enters("DATA_POINTS_INITIALISE_GENERIC",err,error,*999)
478 
479  IF(ASSOCIATED(data_points)) THEN
480  NULLIFY(data_points%REGION)
481  NULLIFY(data_points%INTERFACE)
482  data_points%DATA_POINTS_FINISHED=.false.
483  data_points%NUMBER_OF_DATA_POINTS=0
484  NULLIFY(data_points%DATA_POINTS_TREE)
485  data_points%NUMBER_OF_DATA_PROJECTIONS=0
486  NULLIFY(data_points%DATA_PROJECTIONS_TREE)
487  ELSE
488  CALL flagerror("Data points is not associated.",err,error,*999)
489  ENDIF
490 
491  exits("DATA_POINTS_INITIALISE_GENERIC")
492  RETURN
493 999 errorsexits("DATA_POINTS_INITIALISE_GENERIC",err,error)
494  RETURN 1
495  END SUBROUTINE data_points_initialise_generic
496 
497  !
498  !================================================================================================================================
499  !
500 
502  SUBROUTINE data_points_initialise_interface(INTERFACE,ERR,ERROR,*)
503 
504  !Argument variables
505  TYPE(interface_type), POINTER :: interface
506  INTEGER(INTG), INTENT(OUT) :: err
507  TYPE(varying_string), INTENT(OUT) :: error
508  !Local Variables
509 
510  enters("DATA_POINTS_INITIALISE_INTERFACE",err,error,*999)
511 
512  IF(ASSOCIATED(interface)) THEN
513  IF(ASSOCIATED(interface%DATA_POINTS)) THEN
514  CALL flagerror("Interface already has associated data points.",err,error,*999)
515  ELSE
516  ALLOCATE(interface%DATA_POINTS,stat=err)
517  IF(err/=0) CALL flagerror("Could not allocate interface data points.",err,error,*999)
518  CALL data_points_initialise_generic(interface%DATA_POINTS,err,error,*999)
519  interface%DATA_POINTS%INTERFACE=>INTERFACE
520  ENDIF
521  ELSE
522  CALL flagerror("Interface is not associated.",err,error,*999)
523  ENDIF
524 
525  exits("DATA_POINTS_INITIALISE_INTERFACE")
526  RETURN
527 999 errorsexits("DATA_POINTS_INITIALISE_INTERFACE",err,error)
528  RETURN 1
529 
530  END SUBROUTINE data_points_initialise_interface
531 
532  !
533  !================================================================================================================================
534  !
535 
537  SUBROUTINE data_points_initialise_region(REGION,ERR,ERROR,*)
538 
539  !Argument variables
540  TYPE(region_type), POINTER :: region
541  INTEGER(INTG), INTENT(OUT) :: err
542  TYPE(varying_string), INTENT(OUT) :: error
543  !Local Variables
544 
545  enters("DATA_POINTS_INITIALISE_REGION",err,error,*999)
546 
547  IF(ASSOCIATED(region)) THEN
548  IF(ASSOCIATED(region%DATA_POINTS)) THEN
549  CALL flagerror("Region has associated data points.",err,error,*999)
550  ELSE
551  ALLOCATE(region%DATA_POINTS,stat=err)
552  IF(err/=0) CALL flagerror("Could not allocate region data points.",err,error,*999)
553  CALL data_points_initialise_generic(region%DATA_POINTS,err,error,*999)
554  region%DATA_POINTS%REGION=>region
555  ENDIF
556  ELSE
557  CALL flagerror("Region is not associated.",err,error,*999)
558  ENDIF
559 
560  exits("DATA_POINTS_INITIALISE_REGION")
561  RETURN
562 999 errorsexits("DATA_POINTS_INITIALISE_REGION",err,error)
563  RETURN 1
564  END SUBROUTINE data_points_initialise_region
565 
566  !
567  !================================================================================================================================
568  !
569 
571  SUBROUTINE data_points_global_number_get(DATA_POINTS,USER_NUMBER,GLOBAL_NUMBER,ERR,ERROR,*)
572 
573  !Argument variables
574  TYPE(data_points_type), POINTER :: data_points
575  INTEGER(INTG), INTENT(IN) :: user_number
576  INTEGER(INTG), INTENT(OUT) :: global_number
577  INTEGER(INTG), INTENT(OUT) :: err
578  TYPE(varying_string), INTENT(OUT) :: error
579  !Local Variables
580  TYPE(varying_string) :: local_error
581  TYPE(tree_node_type), POINTER :: tree_node
582 
583  enters("DATA_POINTS_GLOBAL_NUMBER_GET",err,error,*999)
584 
585  IF(ASSOCIATED(data_points)) THEN
586  NULLIFY(tree_node)
587  CALL tree_search(data_points%DATA_POINTS_TREE,user_number,tree_node,err,error,*999)
588  IF(ASSOCIATED(tree_node)) THEN
589  CALL tree_node_value_get(data_points%DATA_POINTS_TREE,tree_node,global_number,err,error,*999)
590  ELSE
591  local_error="Tree node is not associates (cannot find the user number "//trim(number_to_vstring(user_number,"*",err, &
592  & error))//"."
593  CALL flagerror(local_error,err,error,*999)
594  ENDIF
595  ELSE
596  CALL flagerror("Data points is not associated.",err,error,*999)
597  ENDIF
598 
599  exits("DATA_POINTS_GLOBAL_NUMBER_GET")
600  RETURN
601 999 errorsexits("DATA_POINST_GLOBAL_NUMBER_GET",err,error)
602  RETURN 1
603 
604  END SUBROUTINE data_points_global_number_get
605 
606  !
607  !================================================================================================================================
608  !
609 
611  SUBROUTINE data_points_label_get_c(DATA_POINTS,GLOBAL_NUMBER,LABEL,ERR,ERROR,*)
612 
613  !Argument variables
614  TYPE(data_points_type), POINTER :: data_points
615  INTEGER(INTG), INTENT(IN) :: global_number
616  CHARACTER(LEN=*), INTENT(OUT) :: label
617  INTEGER(INTG), INTENT(OUT) :: err
618  TYPE(varying_string), INTENT(OUT) :: error
619  !Local Variables
620  INTEGER :: c_length,vs_length
621  TYPE(varying_string) :: local_error
622 
623  enters("DATA_POINTS_LABEL_GET_C",err,error,*999)
624 
625  IF(ASSOCIATED(data_points)) THEN
626  IF(data_points%DATA_POINTS_FINISHED) THEN
627  IF(global_number>=1.AND.global_number<=data_points%NUMBER_OF_DATA_POINTS) THEN
628  c_length=len(label)
629  vs_length=len_trim(data_points%DATA_POINTS(global_number)%LABEL)
630  IF(c_length>vs_length) THEN
631  label=char(len_trim(data_points%DATA_POINTS(global_number)%LABEL))
632  ELSE
633  label=char(data_points%DATA_POINTS(global_number)%LABEL,c_length)
634  ENDIF
635  ELSE
636  local_error="The specified global data point number of "//trim(number_to_vstring(global_number,"*",err,error))// &
637  & " is invalid. The global data point number should be between 1 and "// &
638  & trim(number_to_vstring(data_points%NUMBER_OF_DATA_POINTS,"*",err,error))//"."
639  CALL flagerror(local_error,err,error,*999)
640  ENDIF
641  ELSE
642  CALL flagerror("Data points have not been finished.",err,error,*999)
643  ENDIF
644  ELSE
645  CALL flagerror("Data points is not associated.",err,error,*999)
646  ENDIF
647 
648  exits("DATA_POINTS_LABEL_GET_C")
649  RETURN
650 999 errorsexits("DATA_POINTS_LABEL_GET_C",err,error)
651  RETURN 1
652 
653  END SUBROUTINE data_points_label_get_c
654 
655  !
656  !================================================================================================================================
657  !
658 
660  SUBROUTINE data_points_label_get_vs(DATA_POINTS,GLOBAL_NUMBER,LABEL,ERR,ERROR,*)
661 
662  !Argument variables
663  TYPE(data_points_type), POINTER :: data_points
664  INTEGER(INTG), INTENT(IN) :: global_number
665  TYPE(varying_string), INTENT(OUT) :: label
666  INTEGER(INTG), INTENT(OUT) :: err
667  TYPE(varying_string), INTENT(OUT) :: error
668  !Local Variables
669  TYPE(varying_string) :: local_error
670 
671  enters("DATA_POINTS_LABEL_GET_VS",err,error,*999)
672 
673  IF(ASSOCIATED(data_points)) THEN
674  IF(data_points%DATA_POINTS_FINISHED) THEN
675  IF(global_number>=1.AND.global_number<=data_points%NUMBER_OF_DATA_POINTS) THEN
676  label=data_points%DATA_POINTS(global_number)%LABEL
677  ELSE
678  local_error="The specified global data point number of "//trim(number_to_vstring(global_number,"*",err,error))// &
679  & " is invalid. The global data point number should be between 1 and "// &
680  & trim(number_to_vstring(data_points%NUMBER_OF_DATA_POINTS,"*",err,error))//"."
681  CALL flagerror(local_error,err,error,*999)
682  ENDIF
683  ELSE
684  CALL flagerror("Data points have not been finished.",err,error,*999)
685  ENDIF
686  ELSE
687  CALL flagerror("Data points is not associated.",err,error,*999)
688  ENDIF
689 
690  exits("DATA_POINTS_LABEL_GET_VS")
691  RETURN
692 999 errorsexits("DATA_POINTS_LABEL_GET_VS",err,error)
693  RETURN 1
694 
695  END SUBROUTINE data_points_label_get_vs
696 
697  !
698  !================================================================================================================================
699  !
700 
702  SUBROUTINE data_points_label_set_c(DATA_POINTS,GLOBAL_NUMBER,LABEL,ERR,ERROR,*)
703 
704  !Argument variables
705  TYPE(data_points_type), POINTER :: data_points
706  INTEGER(INTG), INTENT(IN) :: global_number
707  CHARACTER(LEN=*), INTENT(IN) :: label
708  INTEGER(INTG), INTENT(OUT) :: err
709  TYPE(varying_string), INTENT(OUT) :: error
710  !Local Variables
711  TYPE(varying_string) :: local_error
712 
713  enters("DATA_POINTS_LABEL_SET_C",err,error,*999)
714 
715  IF(ASSOCIATED(data_points)) THEN
716  IF(data_points%DATA_POINTS_FINISHED) THEN
717  CALL flagerror("Data points have been finished.",err,error,*999)
718  ELSE
719  IF(global_number>=1.AND.global_number<=data_points%NUMBER_OF_DATA_POINTS) THEN
720  data_points%DATA_POINTS(global_number)%LABEL=label
721  ELSE
722  local_error="The specified global data point number of "//trim(number_to_vstring(global_number,"*",err,error))// &
723  & " is invalid. The global data point number should be between 1 and "// &
724  & trim(number_to_vstring(data_points%NUMBER_OF_DATA_POINTS,"*",err,error))//"."
725  CALL flagerror(local_error,err,error,*999)
726  ENDIF
727  ENDIF
728  ELSE
729  CALL flagerror("Data points is not associated.",err,error,*999)
730  ENDIF
731 
732  exits("DATA_POINTS_LABEL_SET_C")
733  RETURN
734 999 errorsexits("DATA_POINTS_LABEL_SET_C",err,error)
735  RETURN 1
736 
737  END SUBROUTINE data_points_label_set_c
738 
739  !
740  !================================================================================================================================
741  !
742 
743 
745  SUBROUTINE data_points_label_set_vs(DATA_POINTS,GLOBAL_NUMBER,LABEL,ERR,ERROR,*)
746 
747  !Argument variables
748  TYPE(data_points_type), POINTER :: data_points
749  INTEGER(INTG), INTENT(IN) :: global_number
750  TYPE(varying_string), INTENT(IN) :: label
751  INTEGER(INTG), INTENT(OUT) :: err
752  TYPE(varying_string), INTENT(OUT) :: error
753  !Local Variables
754  TYPE(varying_string) :: local_error
755 
756  enters("DATA_POINTS_LABEL_SET_VS",err,error,*999)
757 
758  IF(ASSOCIATED(data_points)) THEN
759  IF(data_points%DATA_POINTS_FINISHED) THEN
760  CALL flagerror("Data points have been finished.",err,error,*999)
761  ELSE
762  IF(global_number>=1.AND.global_number<=data_points%NUMBER_OF_DATA_POINTS) THEN
763  data_points%DATA_POINTS(global_number)%LABEL=label
764  ELSE
765  local_error="The specified global data point number of "//trim(number_to_vstring(global_number,"*",err,error))// &
766  & " is invalid. The global data point number should be between 1 and "// &
767  & trim(number_to_vstring(data_points%NUMBER_OF_DATA_POINTS,"*",err,error))//"."
768  CALL flagerror(local_error,err,error,*999)
769  ENDIF
770  ENDIF
771  ELSE
772  CALL flagerror("Data points is not associated.",err,error,*999)
773  ENDIF
774 
775  exits("DATA_POINTS_LABEL_SET_VS")
776  RETURN
777 999 errorsexits("DATA_POINTS_LABEL_SET_VS",err,error)
778  RETURN 1
779 
780  END SUBROUTINE data_points_label_set_vs
781 
782  !
783  !================================================================================================================================
784  !
785 
787  SUBROUTINE data_points_values_get(DATA_POINTS,GLOBAL_NUMBER,VALUES,ERR,ERROR,*)
788 
789  !Argument variables
790  TYPE(data_points_type), POINTER :: data_points
791  INTEGER(INTG), INTENT(IN) :: global_number
792  REAL(DP), INTENT(OUT) :: values(:)
793  INTEGER(INTG), INTENT(OUT) :: err
794  TYPE(varying_string), INTENT(OUT) :: error
795  !Local Variables
796  TYPE(varying_string) :: local_error
797 
798  enters("DATA_POINTS_VALUES_GET",err,error,*999)
799 
800  IF(ASSOCIATED(data_points)) THEN
801  IF(data_points%DATA_POINTS_FINISHED) THEN
802  !Check the data point global number exists
803  IF(global_number>=1.AND.global_number<=data_points%NUMBER_OF_DATA_POINTS) THEN
804  IF(SIZE(values,1)==SIZE(data_points%DATA_POINTS(global_number)%position,1)) THEN
805  values=data_points%DATA_POINTS(global_number)%position
806  ELSE
807  CALL flagerror("array values has size of "//trim(number_to_vstring(SIZE(values,1),"*",err,error))// &
808  & "but it needs to have size of "// &
809  & trim(number_to_vstring(SIZE(data_points%DATA_POINTS(global_number)%position,1),"*",err,error))// &
810  & "." ,err,error,*999)
811  ENDIF
812  ELSE
813  local_error="The specified global data point number of "//trim(number_to_vstring(global_number,"*",err,error))// &
814  & " is invalid. The global data point number should be between 1 and "// &
815  & trim(number_to_vstring(data_points%NUMBER_OF_DATA_POINTS,"*",err,error))//"."
816  CALL flagerror(local_error,err,error,*999)
817  ENDIF
818  ELSE
819  CALL flagerror("Data points have not been finished.",err,error,*999)
820  ENDIF
821  ELSE
822  CALL flagerror("Data points is not associated.",err,error,*999)
823  ENDIF
824 
825  exits("DATA_POINTS_VALUES_GET")
826  RETURN
827 999 errorsexits("DATA_POINTS_VALUES_GET",err,error)
828  RETURN 1
829 
830  END SUBROUTINE data_points_values_get
831 
832  !
833  !================================================================================================================================
834  !
835 
837  SUBROUTINE data_points_values_set(DATA_POINTS,GLOBAL_NUMBER,VALUES,ERR,ERROR,*)
838 
839  !Argument variables
840  TYPE(data_points_type), POINTER :: data_points
841  INTEGER(INTG), INTENT(IN) :: global_number
842  REAL(DP), INTENT(IN) :: values(:)
843  INTEGER(INTG), INTENT(OUT) :: err
844  TYPE(varying_string), INTENT(OUT) :: error
845  !Local Variables
846  TYPE(varying_string) :: local_error
847 
848  enters("DATA_POINTS_VALUES_SET",err,error,*999)
849 
850  IF(ASSOCIATED(data_points)) THEN
851  IF(data_points%DATA_POINTS_FINISHED) THEN
852  CALL flagerror("Data points have been finished.",err,error,*999)
853  ELSE
854  IF(global_number>=1.AND.global_number<=data_points%NUMBER_OF_DATA_POINTS) THEN
855  IF(SIZE(values,1)==SIZE(data_points%DATA_POINTS(global_number)%position,1)) THEN
856  data_points%DATA_POINTS(global_number)%position(1:SIZE(values,1))=values(1:SIZE(values,1))
857  !X=[1.0_DP,1.0_DP]
858  !CALL COORDINATE_CONVERT_COORDINATE_SYSTEMS(DATA_POINTS%INTERFACE%COORDINATE_SYSTEM, &
859  !& DATA_POINTS%INTERFACE%PARENT_REGION%COORDINATE_SYSTEM,VALUES,Y,ERR,ERROR,*999)
860  ELSE
861  CALL flagerror("The dimension of the input values does not match.",err,error,*999)
862  ENDIF
863  ELSE
864  local_error="The specified global data point number of "//trim(number_to_vstring(global_number,"*",err,error))// &
865  & " is invalid. The global data point number should be between 1 and "// &
866  & trim(number_to_vstring(data_points%NUMBER_OF_DATA_POINTS,"*",err,error))//"."
867  CALL flagerror(local_error,err,error,*999)
868  ENDIF
869  ENDIF
870  ELSE
871  CALL flagerror("Data points is not associated.",err,error,*999)
872  ENDIF
873 
874  exits("DATA_POINTS_VALUES_SET")
875  RETURN
876 999 errorsexits("DATA_POINTS_VALUES_SET",err,error)
877  RETURN 1
878 
879  END SUBROUTINE data_points_values_set
880 
881  !
882  !================================================================================================================================
883  !
884 
886  SUBROUTINE data_points_number_of_data_points_get(DATA_POINTS,NUMBER_OF_DATA_POINTS,ERR,ERROR,*)
887 
888  !Argument variables
889  TYPE(data_points_type), POINTER :: data_points
890  INTEGER(INTG), INTENT(OUT) :: number_of_data_points
891  INTEGER(INTG), INTENT(OUT) :: err
892  TYPE(varying_string), INTENT(OUT) :: error
893  !Local Variables
894 
895  enters("DATA_POINTS_NUMBER_OF_DATA_POINTS_GET",err,error,*999)
896 
897  IF(ASSOCIATED(data_points)) THEN
898  IF(data_points%DATA_POINTS_FINISHED) THEN
899  number_of_data_points=data_points%NUMBER_OF_DATA_POINTS
900  ELSE
901  CALL flagerror("Data points have not been finished.",err,error,*999)
902  ENDIF
903  ELSE
904  CALL flagerror("Data points is not associated.",err,error,*999)
905  ENDIF
906 
907  exits("DATA_POINTS_NUMBER_OF_DATA_POINTS_GET")
908  RETURN
909 999 errorsexits("DATA_POINTS_NUMBER_OF_DATA_POINTS_GET",err,error)
910  RETURN 1
911 
912  END SUBROUTINE data_points_number_of_data_points_get
913 
914  !
915  !================================================================================================================================
916  !
917 
919  SUBROUTINE data_points_user_number_get(DATA_POINTS,GLOBAL_NUMBER,USER_NUMBER,ERR,ERROR,*)
920 
921  !Argument variables
922  TYPE(data_points_type), POINTER :: data_points
923  INTEGER(INTG), INTENT(IN) :: global_number
924  INTEGER(INTG), INTENT(OUT) :: user_number
925  INTEGER(INTG), INTENT(OUT) :: err
926  TYPE(varying_string), INTENT(OUT) :: error
927  !Local Variables
928  TYPE(varying_string) :: local_error
929 
930  enters("DATA_POINTS_USER_NUMBER_GET",err,error,*999)
931 
932  IF(ASSOCIATED(data_points)) THEN
933  IF(data_points%DATA_POINTS_FINISHED) THEN
934  IF(global_number>=1.AND.global_number<=data_points%NUMBER_OF_DATA_POINTS) THEN
935  user_number=data_points%DATA_POINTS(global_number)%USER_NUMBER
936  ELSE
937  local_error="The specified global data point number of "//trim(number_to_vstring(global_number,"*",err,error))// &
938  & " is invalid. The global data point number should be between 1 and "// &
939  & trim(number_to_vstring(data_points%NUMBER_OF_DATA_POINTS,"*",err,error))//"."
940  CALL flagerror(local_error,err,error,*999)
941  ENDIF
942  ELSE
943  CALL flagerror("Data points have not been finished.",err,error,*999)
944  ENDIF
945  ELSE
946  CALL flagerror("Data points is not associated.",err,error,*999)
947  ENDIF
948 
949  exits("DATA_POINTS_USER_NUMBER_GET")
950  RETURN
951 999 errorsexits("DATA_POINTS_USER_NUMBER_GET",err,error)
952  RETURN 1
953 
954  END SUBROUTINE data_points_user_number_get
955 
956  !
957  !================================================================================================================================
958  !
959 
961  SUBROUTINE data_points_user_number_set(DATA_POINTS,GLOBAL_NUMBER,USER_NUMBER,ERR,ERROR,*)
962 
963  !Argument variables
964  TYPE(data_points_type), POINTER :: data_points
965  INTEGER(INTG), INTENT(IN) :: global_number
966  INTEGER(INTG), INTENT(IN) :: user_number
967  INTEGER(INTG), INTENT(OUT) :: err
968  TYPE(varying_string), INTENT(OUT) :: error
969  !Local Variables
970  INTEGER(INTG) :: insert_status,old_global_number
971  LOGICAL :: data_point_exists
972  TYPE(varying_string) :: local_error
973 
974  enters("DATA_POINTS_USER_NUMBER_SET",err,error,*999)
975 
976  IF(ASSOCIATED(data_points)) THEN
977  IF(data_points%DATA_POINTS_FINISHED) THEN
978  CALL flagerror("Data points have been finished.",err,error,*999)
979  ELSE
980  IF(global_number>=1.AND.global_number<=data_points%NUMBER_OF_DATA_POINTS) THEN
981  !Check the data point user number is not already used
982  CALL data_point_check_exists(data_points,user_number,data_point_exists,old_global_number,err,error,*999)
983  IF(data_point_exists) THEN
984  IF(old_global_number/=global_number) THEN
985  local_error="The specified data point user number of "//trim(number_to_vstring(user_number,"*",err,error))// &
986  & " is already used by global data point number "//trim(number_to_vstring(old_global_number,"*",err,error))// &
987  & ". User data point numbers must be unique."
988  CALL flagerror(local_error,err,error,*999)
989  ENDIF
990  ELSE
991  CALL tree_item_delete(data_points%DATA_POINTS_TREE,data_points%DATA_POINTS(global_number)%USER_NUMBER,err,error,*999)
992  CALL tree_item_insert(data_points%DATA_POINTS_TREE,user_number,global_number,insert_status,err,error,*999)
993  IF(insert_status/=tree_node_insert_sucessful) CALL flagerror("Unsucessful data points tree insert.",err,error,*999)
994  data_points%DATA_POINTS(global_number)%USER_NUMBER=user_number
995  ENDIF
996  ELSE
997  local_error="The specified global data point number of "//trim(number_to_vstring(global_number,"*",err,error))// &
998  & " is invalid. The global data point number should be between 1 and "// &
999  & trim(number_to_vstring(data_points%NUMBER_OF_DATA_POINTS,"*",err,error))//"."
1000  CALL flagerror(local_error,err,error,*999)
1001  ENDIF
1002  ENDIF
1003  ELSE
1004  CALL flagerror("Data points is not associated.",err,error,*999)
1005  ENDIF
1006 
1007  exits("DATA_POINTS_USER_NUMBER_SET")
1008  RETURN
1009 999 errorsexits("DATA_POINTS_USER_NUMBER_SET",err,error)
1010  RETURN 1
1011 
1012  END SUBROUTINE data_points_user_number_set
1013 
1014  !
1015  !================================================================================================================================
1016  !
1017 
1019  SUBROUTINE data_points_weights_get(DATA_POINTS,GLOBAL_NUMBER,WEIGHTS,ERR,ERROR,*)
1020 
1021  !Argument variables
1022  TYPE(data_points_type), POINTER :: data_points
1023  INTEGER(INTG), INTENT(IN) :: global_number
1024  REAL(DP), INTENT(OUT) :: weights(:)
1025  INTEGER(INTG), INTENT(OUT) :: err
1026  TYPE(varying_string), INTENT(OUT) :: error
1027  !Local Variables
1028  TYPE(varying_string) :: local_error
1029 
1030  enters("DATA_POINTS_WEIGHTS_GET",err,error,*999)
1031 
1032  IF(ASSOCIATED(data_points)) THEN
1033  IF(data_points%DATA_POINTS_FINISHED) THEN
1034  !Check the data point global number exists
1035  IF(global_number>=1.AND.global_number<=data_points%NUMBER_OF_DATA_POINTS) THEN
1036  IF(SIZE(weights,1)==SIZE(data_points%DATA_POINTS(global_number)%WEIGHTS,1)) THEN
1037  weights=data_points%DATA_POINTS(global_number)%WEIGHTS
1038  ELSE
1039  CALL flagerror("array weights has size of "//trim(number_to_vstring(SIZE(weights,1),"*",err,error))// &
1040  & "but it needs to have size of "// &
1041  & trim(number_to_vstring(SIZE(data_points%DATA_POINTS(global_number)%WEIGHTS,1),"*",err,error))// &
1042  & "." ,err,error,*999)
1043  ENDIF
1044  ELSE
1045  local_error="The specified global data point number of "//trim(number_to_vstring(global_number,"*",err,error))// &
1046  & " is invalid. The global data point number should be between 1 and "// &
1047  & trim(number_to_vstring(data_points%NUMBER_OF_DATA_POINTS,"*",err,error))//"."
1048  CALL flagerror(local_error,err,error,*999)
1049  ENDIF
1050  ELSE
1051  CALL flagerror("Data points have not been finished.",err,error,*999)
1052  ENDIF
1053  ELSE
1054  CALL flagerror("Data points is not associated.",err,error,*999)
1055  ENDIF
1056 
1057  exits("DATA_POINTS_WEIGHTS_GET")
1058  RETURN
1059 999 errorsexits("DATA_POINTS_WEIGHTS_GET",err,error)
1060  RETURN 1
1061 
1062  END SUBROUTINE data_points_weights_get
1063 
1064  !
1065  !================================================================================================================================
1066  !
1067 
1069  SUBROUTINE data_points_weights_set(DATA_POINTS,GLOBAL_NUMBER,WEIGHTS,ERR,ERROR,*)
1070 
1071  !Argument variables
1072  TYPE(data_points_type), POINTER :: data_points
1073  INTEGER(INTG), INTENT(IN) :: global_number
1074  REAL(DP), INTENT(IN) :: weights(:)
1075  INTEGER(INTG), INTENT(OUT) :: err
1076  TYPE(varying_string), INTENT(OUT) :: error
1077  !Local Variables
1078  TYPE(varying_string) :: local_error
1079 
1080  enters("DATA_POINTS_WEIGHTS_SET",err,error,*999)
1081 
1082  IF(ASSOCIATED(data_points)) THEN
1083  IF(data_points%DATA_POINTS_FINISHED) THEN
1084  CALL flagerror("Data points have been finished.",err,error,*999)
1085  ELSE
1086  IF(global_number>=1.AND.global_number<=data_points%NUMBER_OF_DATA_POINTS) THEN
1087  IF(SIZE(weights,1)==SIZE(data_points%DATA_POINTS(global_number)%WEIGHTS,1)) THEN
1088  data_points%DATA_POINTS(global_number)%WEIGHTS(1:SIZE(weights,1))=weights(1:SIZE(weights,1))
1089  ELSE
1090  CALL flagerror("The dimension of the input weights does not match.",err,error,*999)
1091  ENDIF
1092  ELSE
1093  local_error="The specified global data point number of "//trim(number_to_vstring(global_number,"*",err,error))// &
1094  & " is invalid. The global data point number should be between 1 and "// &
1095  & trim(number_to_vstring(data_points%NUMBER_OF_DATA_POINTS,"*",err,error))//"."
1096  CALL flagerror(local_error,err,error,*999)
1097  ENDIF
1098  ENDIF
1099  ELSE
1100  CALL flagerror("Data points is not associated.",err,error,*999)
1101  ENDIF
1102 
1103  exits("DATA_POINTS_WEIGHTS_SET")
1104  RETURN
1105 999 errorsexits("DATA_POINTS_WEIGHTS_SET",err,error)
1106  RETURN 1
1107 
1108  END SUBROUTINE data_points_weights_set
1109 
1110  !
1111  !================================================================================================================================
1112  !
1113 
1115  SUBROUTINE data_points_data_projection_get(DATA_POINTS,GLOBAL_NUMBER,DATA_PROJECTION,ERR,ERROR,*)
1116 
1117  !Argument variables
1118  TYPE(data_points_type), POINTER :: data_points
1119  INTEGER(INTG), INTENT(IN) :: global_number
1120  TYPE(data_projection_type), POINTER :: data_projection
1121  INTEGER(INTG), INTENT(OUT) :: err
1122  TYPE(varying_string), INTENT(OUT) :: error
1123  !Local Variables
1124  enters("DATA_POINTS_DATA_PROJECTION_GET",err,error,*999)
1125 
1126  IF(ASSOCIATED(data_points)) THEN
1127  IF(data_points%DATA_POINTS_FINISHED) THEN
1128  IF(ASSOCIATED(data_projection)) THEN
1129  CALL flagerror("Data projection is already associated.",err,error,*999)
1130  ELSE
1131  data_projection=>data_points%DATA_PROJECTIONS(global_number)%PTR
1132  IF(.NOT.ASSOCIATED(data_projection)) CALL flagerror("Data points data projections("//trim(number_to_vstring( &
1133  & global_number,"*",err,error))//") ptr is not associated.",err,error,*999)
1134  ENDIF
1135  ELSE
1136  CALL flagerror("Data points has not been finished.",err,error,*999)
1137  ENDIF
1138  ELSE
1139  CALL flagerror("Data points is not associated.",err,error,*999)
1140  ENDIF
1141 
1142  exits("DATA_POINTS_DATA_PROJECTION_GET")
1143  RETURN
1144 999 errorsexits("DATA_POINTS_DATA_PROJECTION_GET",err,error)
1145  RETURN 1
1146 
1147  END SUBROUTINE data_points_data_projection_get
1148 
1149  !
1150  !================================================================================================================================
1151  !
1152 
1154  SUBROUTINE datapoints_dataprojectionglobalnumberget(DATA_POINTS,USER_NUMBER,GLOBAL_NUMBER,ERR,ERROR,*)
1155 
1156  !Argument variables
1157  TYPE(data_points_type), POINTER :: data_points
1158  INTEGER(INTG), INTENT(IN) :: user_number
1159  INTEGER(INTG), INTENT(OUT) :: global_number
1160  INTEGER(INTG), INTENT(OUT) :: err
1161  TYPE(varying_string), INTENT(OUT) :: error
1162  !Local Variables
1163  TYPE(varying_string) :: local_error
1164  TYPE(tree_node_type), POINTER :: tree_node
1165 
1166  enters("DataPoints_DataProjectionGlobalNumberGet",err,error,*999)
1167 
1168  IF(ASSOCIATED(data_points)) THEN
1169  IF(data_points%DATA_POINTS_FINISHED) THEN
1170  NULLIFY(tree_node)
1171  CALL tree_search(data_points%DATA_PROJECTIONS_TREE,user_number,tree_node,err,error,*999)
1172  IF(ASSOCIATED(tree_node)) THEN
1173  CALL tree_node_value_get(data_points%DATA_PROJECTIONS_TREE,tree_node,global_number,err,error,*999)
1174  ELSE
1175  local_error="Tree node is not associates (cannot find the user number "//trim(number_to_vstring(user_number,"*",err, &
1176  & error))//"."
1177  CALL flagerror(local_error,err,error,*999)
1178  ENDIF
1179 
1180  ELSE
1181  CALL flagerror("Data points have not been finished.",err,error,*999)
1182  ENDIF
1183  ELSE
1184  CALL flagerror("Data points is not associated.",err,error,*999)
1185  ENDIF
1186 
1187  exits("DataPoints_DataProjectionGlobalNumberGet")
1188  RETURN
1189 999 errorsexits("DataPoints_DataProjectionGlobalNumberGet",err,error)
1190  RETURN 1
1191 
1192  END SUBROUTINE datapoints_dataprojectionglobalnumberget
1193 
1194 
1195  !
1196  !================================================================================================================================
1197  !
1198 
1199 END MODULE data_point_routines
1200 
1201 
1202 
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
trees::tree_insert_type_set
subroutine, public tree_insert_type_set(TREE, INSERT_TYPE, ERR, ERROR,)
Sets/changes the insert type for a tree.
Definition: trees.f90:480
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
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
trees
Implements trees of base types.
Definition: trees.f90:45
trees::tree_node_insert_sucessful
integer(intg), parameter, public tree_node_insert_sucessful
Successful insert status.
Definition: trees.f90:73
types::data_points_type
Contains information on the data points defined on a region.
Definition: types.f90:333
trees::tree_search
subroutine, public tree_search(TREE, KEY, X, ERR, ERROR,)
Searches a tree to see if it contains a key.
Definition: trees.f90:1277
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
trees::tree_node_type
Definition: trees.f90:87
types::data_point_type
Contains information about a data point.
Definition: types.f90:324
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
trees::tree_output
subroutine, public tree_output(ID, TREE, ERR, ERROR,)
Outputs a tree to the specified output stream ID.
Definition: trees.f90:1133
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
iso_varying_string::len
Definition: iso_varying_string.f90:162
types::data_projection_type
Definition: types.f90:289
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
data_projection_routines
This module handles all data projection routines.
Definition: data_projection_routines.f90:46
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
trees::tree_item_delete
subroutine, public tree_item_delete(TREE, KEY, ERR, ERROR,)
Deletes a tree node specified by a key from a tree.
Definition: trees.f90:521
iso_varying_string::trim
Definition: iso_varying_string.f90:204
trees::tree_create_finish
subroutine, public tree_create_finish(TREE, ERR, ERROR,)
Finishes the creation of a tree created with TREE_CREATE_START.
Definition: trees.f90:190
comp_environment
This module contains all computational environment variables.
Definition: computational_environment.f90:46
trees::tree_no_duplicates_allowed
integer(intg), parameter, public tree_no_duplicates_allowed
No duplicate keys allowed tree type.
Definition: trees.f90:82
base_routines::diagnostics1
logical, save, public diagnostics1
.TRUE. if level 1 diagnostic output is active in the current routine
Definition: base_routines.f90:153
trees::tree_destroy
subroutine, public tree_destroy(TREE, ERR, ERROR,)
Destroys a tree.
Definition: trees.f90:265
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
trees::tree_item_insert
subroutine, public tree_item_insert(TREE, KEY, VALUE, INSERT_STATUS, ERR, ERROR,)
Inserts a tree node into a red-black tree.
Definition: trees.f90:769
types::interface_type
Contains information for the interface data.
Definition: types.f90:2228
trees::tree_node_value_get
subroutine, public tree_node_value_get(TREE, TREE_NODE, VALUE, ERR, ERROR,)
Gets the value at a specified tree node.
Definition: trees.f90:1059
base_routines::flag_error
Flags an error condition.
Definition: base_routines.f90:226
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
trees::tree_create_start
subroutine, public tree_create_start(TREE, ERR, ERROR,)
Starts the creation of a tree and returns a pointer to the created tree.
Definition: trees.f90:233
data_projection_routines::data_projection_destroy
subroutine, public data_projection_destroy(DATA_PROJECTION, ERR, ERROR,)
Destroys a data projection.
Definition: data_projection_routines.f90:834
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