OpenCMISS-Iron Internal API Documentation
lists.f90
Go to the documentation of this file.
1 
44 
46 MODULE lists
47 
48  USE base_routines
49  USE constants
50  USE iso_varying_string
51  USE kinds
52  USE strings
53  USE types
54 
55 #include "macros.h"
56 
57  IMPLICIT NONE
58 
59  PRIVATE
60 
61  !Module parameters
62 
67  INTEGER(INTG), PARAMETER :: list_intg_type=integer_type
68  INTEGER(INTG), PARAMETER :: list_sp_type=single_real_type
69  INTEGER(INTG), PARAMETER :: list_dp_type=double_real_type
71 
76  INTEGER(INTG), PARAMETER :: list_unsorted_type=1
77  INTEGER(INTG), PARAMETER :: list_sort_ascending_type=2
78  INTEGER(INTG), PARAMETER :: list_sort_descending_type=3
80 
85  INTEGER(INTG), PARAMETER :: list_bubble_sort_method=1
86  INTEGER(INTG), PARAMETER :: list_shell_sort_method=2
87  INTEGER(INTG), PARAMETER :: list_heap_sort_method=3
89 
90  !Module types
91 
92  !Module variables
93 
94  !Interfaces
95 
96  INTERFACE list_createfinish
97  MODULE PROCEDURE list_create_finish
98  END INTERFACE list_createfinish
99 
100  INTERFACE list_createstart
101  MODULE PROCEDURE list_create_start
102  END INTERFACE list_createstart
103 
104  INTERFACE list_datadimensionset
105  MODULE PROCEDURE list_data_dimension_set
106  END INTERFACE list_datadimensionset
107 
108  INTERFACE list_datatypeset
109  MODULE PROCEDURE list_data_type_set
110  END INTERFACE list_datatypeset
111 
113  INTERFACE list_detach_and_destroy
114  MODULE PROCEDURE list_detach_and_destroy_intg1
115  MODULE PROCEDURE list_detach_and_destroy_intg2
116  MODULE PROCEDURE list_detach_and_destroy_sp1
117  MODULE PROCEDURE list_detach_and_destroy_sp2
118  MODULE PROCEDURE list_detach_and_destroy_dp1
119  MODULE PROCEDURE list_detach_and_destroy_dp2
120  END INTERFACE list_detach_and_destroy
121 
123  INTERFACE list_detachanddestroy
124  MODULE PROCEDURE list_detach_and_destroy_intg1
125  MODULE PROCEDURE list_detach_and_destroy_intg2
126  MODULE PROCEDURE list_detach_and_destroy_sp1
127  MODULE PROCEDURE list_detach_and_destroy_sp2
128  MODULE PROCEDURE list_detach_and_destroy_dp1
129  MODULE PROCEDURE list_detach_and_destroy_dp2
130  END INTERFACE list_detachanddestroy
131 
133  INTERFACE list_item_add
134  MODULE PROCEDURE list_item_add_intg1
135  MODULE PROCEDURE list_item_add_intg2
136  MODULE PROCEDURE list_item_add_sp1
137  MODULE PROCEDURE list_item_add_sp2
138  MODULE PROCEDURE list_item_add_dp1
139  MODULE PROCEDURE list_item_add_dp2
140  END INTERFACE list_item_add
141 
143  INTERFACE list_itemadd
144  MODULE PROCEDURE list_item_add_intg1
145  MODULE PROCEDURE list_item_add_intg2
146  MODULE PROCEDURE list_item_add_sp1
147  MODULE PROCEDURE list_item_add_sp2
148  MODULE PROCEDURE list_item_add_dp1
149  MODULE PROCEDURE list_item_add_dp2
150  END INTERFACE list_itemadd
151 
152  INTERFACE list_itemdelete
153  MODULE PROCEDURE list_item_delete
154  END INTERFACE list_itemdelete
155 
157  INTERFACE list_item_set
158  MODULE PROCEDURE list_item_set_intg1
159  MODULE PROCEDURE list_item_set_intg2
160  MODULE PROCEDURE list_item_set_sp1
161  MODULE PROCEDURE list_item_set_sp2
162  MODULE PROCEDURE list_item_set_dp1
163  MODULE PROCEDURE list_item_set_dp2
164  END INTERFACE list_item_set
165 
167  INTERFACE list_itemset
168  MODULE PROCEDURE list_item_set_intg1
169  MODULE PROCEDURE list_item_set_intg2
170  MODULE PROCEDURE list_item_set_sp1
171  MODULE PROCEDURE list_item_set_sp2
172  MODULE PROCEDURE list_item_set_dp1
173  MODULE PROCEDURE list_item_set_dp2
174  END INTERFACE list_itemset
175 
177  INTERFACE list_item_get
178  MODULE PROCEDURE list_item_get_intg1
179  MODULE PROCEDURE list_item_get_intg2
180  MODULE PROCEDURE list_item_get_sp1
181  MODULE PROCEDURE list_item_get_sp2
182  MODULE PROCEDURE list_item_get_dp1
183  MODULE PROCEDURE list_item_get_dp2
184  END INTERFACE list_item_get
185 
187  INTERFACE list_itemget
188  MODULE PROCEDURE list_item_get_intg1
189  MODULE PROCEDURE list_item_get_intg2
190  MODULE PROCEDURE list_item_get_sp1
191  MODULE PROCEDURE list_item_get_sp2
192  MODULE PROCEDURE list_item_get_dp1
193  MODULE PROCEDURE list_item_get_dp2
194  END INTERFACE list_itemget
195 
197  INTERFACE list_item_in_list
198  MODULE PROCEDURE list_item_in_list_intg1
199  MODULE PROCEDURE list_item_in_list_sp1
200  MODULE PROCEDURE list_item_in_list_dp1
201  END INTERFACE list_item_in_list
202 
204  INTERFACE list_iteminlist
205  MODULE PROCEDURE list_item_in_list_intg1
206  MODULE PROCEDURE list_item_in_list_sp1
207  MODULE PROCEDURE list_item_in_list_dp1
208  END INTERFACE list_iteminlist
209 
210  INTERFACE list_initialsizeset
211  MODULE PROCEDURE list_initial_size_set
212  END INTERFACE list_initialsizeset
213 
214  INTERFACE list_keydimensionset
215  MODULE PROCEDURE list_key_dimension_set
216  END INTERFACE list_keydimensionset
217 
218  INTERFACE list_mutableset
219  MODULE PROCEDURE list_mutable_set
220  END INTERFACE list_mutableset
221 
222  INTERFACE list_numberofitemsget
223  MODULE PROCEDURE list_number_of_items_get
224  END INTERFACE list_numberofitemsget
225 
226  INTERFACE list_removeduplicates
227  MODULE PROCEDURE list_remove_duplicates
228  END INTERFACE list_removeduplicates
229 
231  INTERFACE list_search
232  MODULE PROCEDURE list_search_intg_array
233  MODULE PROCEDURE list_search_sp_array
234  MODULE PROCEDURE list_search_dp_array
235  END INTERFACE list_search
236 
238  INTERFACE list_search_linear
239  MODULE PROCEDURE list_search_linear_intg_array
240  MODULE PROCEDURE list_search_linear_sp_array
241  MODULE PROCEDURE list_search_linear_dp_array
242  END INTERFACE list_search_linear
243 
245  INTERFACE list_searchlinear
246  MODULE PROCEDURE list_search_linear_intg_array
247  MODULE PROCEDURE list_search_linear_sp_array
248  MODULE PROCEDURE list_search_linear_dp_array
249  END INTERFACE list_searchlinear
250 
252  INTERFACE list_sort
253  MODULE PROCEDURE list_sort_list
254  MODULE PROCEDURE list_sort_intg1_array
255  MODULE PROCEDURE list_sort_intg2_array
256  MODULE PROCEDURE list_sort_sp1_array
257  MODULE PROCEDURE list_sort_sp2_array
258  MODULE PROCEDURE list_sort_dp1_array
259  MODULE PROCEDURE list_sort_dp2_array
260  END INTERFACE list_sort
261 
263  INTERFACE list_sort_bubble
264  MODULE PROCEDURE list_sort_bubble_intg1_array
265  MODULE PROCEDURE list_sort_bubble_intg2_array
266  MODULE PROCEDURE list_sort_bubble_sp1_array
267  MODULE PROCEDURE list_sort_bubble_sp2_array
268  MODULE PROCEDURE list_sort_bubble_dp1_array
269  MODULE PROCEDURE list_sort_bubble_dp2_array
270  END INTERFACE list_sort_bubble
271 
273  INTERFACE list_sortbubble
274  MODULE PROCEDURE list_sort_bubble_intg1_array
275  MODULE PROCEDURE list_sort_bubble_intg2_array
276  MODULE PROCEDURE list_sort_bubble_sp1_array
277  MODULE PROCEDURE list_sort_bubble_sp2_array
278  MODULE PROCEDURE list_sort_bubble_dp1_array
279  MODULE PROCEDURE list_sort_bubble_dp2_array
280  END INTERFACE list_sortbubble
281 
283  INTERFACE list_sort_heap
284  MODULE PROCEDURE list_sort_heap_intg1_array
285  MODULE PROCEDURE list_sort_heap_intg2_array
286  MODULE PROCEDURE list_sort_heap_sp1_array
287  MODULE PROCEDURE list_sort_heap_sp2_array
288  MODULE PROCEDURE list_sort_heap_dp1_array
289  MODULE PROCEDURE list_sort_heap_dp2_array
290  END INTERFACE list_sort_heap
291 
293  INTERFACE list_sortheap
294  MODULE PROCEDURE list_sort_heap_intg1_array
295  MODULE PROCEDURE list_sort_heap_intg2_array
296  MODULE PROCEDURE list_sort_heap_sp1_array
297  MODULE PROCEDURE list_sort_heap_sp2_array
298  MODULE PROCEDURE list_sort_heap_dp1_array
299  MODULE PROCEDURE list_sort_heap_dp2_array
300  END INTERFACE list_sortheap
301 
303  INTERFACE list_sort_shell
304  MODULE PROCEDURE list_sort_shell_intg1_array
305  MODULE PROCEDURE list_sort_shell_intg2_array
306  MODULE PROCEDURE list_sort_shell_sp1_array
307  MODULE PROCEDURE list_sort_shell_sp2_array
308  MODULE PROCEDURE list_sort_shell_dp1_array
309  MODULE PROCEDURE list_sort_shell_dp2_array
310  END INTERFACE list_sort_shell
311 
313  INTERFACE list_sortshell
314  MODULE PROCEDURE list_sort_shell_intg1_array
315  MODULE PROCEDURE list_sort_shell_intg2_array
316  MODULE PROCEDURE list_sort_shell_sp1_array
317  MODULE PROCEDURE list_sort_shell_sp2_array
318  MODULE PROCEDURE list_sort_shell_dp1_array
319  MODULE PROCEDURE list_sort_shell_dp2_array
320  END INTERFACE list_sortshell
321 
323  INTERFACE list_itersection
324  MODULE PROCEDURE list_intersection_intg_array
325  END INTERFACE list_itersection
326 
328  INTERFACE list_subset_of
329  MODULE PROCEDURE lists_subset_of_intg_array
330  END INTERFACE list_subset_of
331 
333  INTERFACE list_subsetof
334  MODULE PROCEDURE lists_subset_of_intg_array
335  END INTERFACE list_subsetof
336 
337  PUBLIC list_intg_type,list_sp_type,list_dp_type
338 
339  PUBLIC list_appendlist
340 
341  PUBLIC list_clearitems
342 
343  PUBLIC list_create_finish,list_create_start
344 
345  PUBLIC list_createfinish,list_createstart
346 
347  PUBLIC list_data_dimension_set
348 
349  PUBLIC list_datadimensionset
350 
351  PUBLIC list_data_type_set
352 
353  PUBLIC list_datatypeset
354 
355  PUBLIC list_detach_and_destroy
356 
357  PUBLIC list_destroy,list_detachanddestroy
358 
359  PUBLIC list_item_add
360 
361  PUBLIC list_itemadd
362 
363  PUBLIC list_item_delete
364 
365  PUBLIC list_itemdelete
366 
367  PUBLIC list_item_get
368 
369  PUBLIC list_itemget
370 
371  PUBLIC list_item_in_list
372 
373  PUBLIC list_iteminlist
374 
375  PUBLIC list_item_set
376 
377  PUBLIC list_itemset
378 
379  PUBLIC list_initial_size_set
380 
381  PUBLIC list_initialsizeset
382 
383  PUBLIC list_key_dimension_set
384 
385  PUBLIC list_keydimensionset
386 
387  PUBLIC list_mutable_set
388 
389  PUBLIC list_mutableset
390 
391  PUBLIC list_number_of_items_get
392 
393  PUBLIC list_numberofitemsget
394 
395  PUBLIC list_remove_duplicates
396 
397  PUBLIC list_search_linear
398 
399  PUBLIC list_search,list_searchlinear
400 
401  PUBLIC list_sort_bubble,list_sort_heap,list_sort_shell
402 
403  PUBLIC list_sort,list_sortbubble,list_sortheap,list_sortshell
404 
405  PUBLIC list_itersection
406 
407  PUBLIC list_subset_of
408 
409  PUBLIC list_subsetof
410 
411 CONTAINS
412 
413  !
414  !================================================================================================================================
415  !
416 
418  SUBROUTINE list_create_finish(LIST,ERR,ERROR,*)
419 
420  !Argument Variables
421  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
422  INTEGER(INTG), INTENT(OUT) :: ERR
423  TYPE(varying_string), INTENT(OUT) :: ERROR
424  !Local Variables
425  INTEGER(INTG) :: DUMMY_ERR
426  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
427 
428  enters("LIST_CREATE_FINISH",err,error,*998)
429 
430  IF(ASSOCIATED(list)) THEN
431  IF(list%LIST_FINISHED) THEN
432  CALL flagerror("List is already finished.",err,error,*998)
433  ELSE
434  !Allocate the list
435  IF(list%DATA_DIMENSION==1) THEN
436  SELECT CASE(list%DATA_TYPE)
437  CASE(list_intg_type)
438  ALLOCATE(list%LIST_INTG(list%INITIAL_SIZE),stat=err)
439  IF(err/=0) CALL flagerror("Could not allocate list integer data.",err,error,*999)
440  CASE(list_sp_type)
441  ALLOCATE(list%LIST_SP(list%INITIAL_SIZE),stat=err)
442  IF(err/=0) CALL flagerror("Could not allocate list single precision data.",err,error,*999)
443  CASE(list_dp_type)
444  ALLOCATE(list%LIST_DP(list%INITIAL_SIZE),stat=err)
445  IF(err/=0) CALL flagerror("Could not allocate list double precision data.",err,error,*999)
446  CASE DEFAULT
447  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))//" is invalid."
448  CALL flagerror(local_error,err,error,*999)
449  END SELECT
450  ELSE
451  SELECT CASE(list%DATA_TYPE)
452  CASE(list_intg_type)
453  ALLOCATE(list%LIST_INTG2(list%DATA_DIMENSION,list%INITIAL_SIZE),stat=err)
454  IF(err/=0) CALL flagerror("Could not allocate list integer data.",err,error,*999)
455  CASE(list_sp_type)
456  ALLOCATE(list%LIST_SP2(list%DATA_DIMENSION,list%INITIAL_SIZE),stat=err)
457  IF(err/=0) CALL flagerror("Could not allocate list single precision data.",err,error,*999)
458  CASE(list_dp_type)
459  ALLOCATE(list%LIST_DP2(list%DATA_DIMENSION,list%INITIAL_SIZE),stat=err)
460  IF(err/=0) CALL flagerror("Could not allocate list double precision data.",err,error,*999)
461  CASE DEFAULT
462  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))//" is invalid."
463  CALL flagerror(local_error,err,error,*999)
464  END SELECT
465  ENDIF
466  list%SIZE=list%INITIAL_SIZE
467  list%LIST_FINISHED=.true.
468  ENDIF
469  ELSE
470  CALL flagerror("List is not associated.",err,error,*998)
471  ENDIF
472 
473  exits("LIST_CREATE_FINISH")
474  RETURN
475 999 CALL list_finalise(list,dummy_err,dummy_error,*998)
476 998 errorsexits("LIST_CREATE_FINISH",err,error)
477  RETURN 1
478  END SUBROUTINE list_create_finish
479 
480  !
481  !================================================================================================================================
482  !
483 
485  SUBROUTINE list_create_start(LIST,ERR,ERROR,*)
486 
487  !Argument Variables
488  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
489  INTEGER(INTG), INTENT(OUT) :: ERR
490  TYPE(varying_string), INTENT(OUT) :: ERROR
491  !Local Variables
492 
493  enters("LIST_CREATE_START",err,error,*999)
494 
495  CALL list_initialise(list,err,error,*999)
496 
497  exits("LIST_CREATE_START")
498  RETURN
499 999 errorsexits("LIST_CREATE_START",err,error)
500  RETURN 1
501  END SUBROUTINE list_create_start
502 
503  !
504  !================================================================================================================================
505  !
506 
508  SUBROUTINE list_data_dimension_set(LIST,DATA_DIMENSION,ERR,ERROR,*)
509 
510  !Argument Variables
511  TYPE(list_type), POINTER, INTENT(IN) :: LIST
512  INTEGER(INTG), INTENT(IN) :: DATA_DIMENSION
513  INTEGER(INTG), INTENT(OUT) :: ERR
514  TYPE(varying_string), INTENT(OUT) :: ERROR
515  !Local Variables
516  TYPE(varying_string) :: LOCAL_ERROR
517 
518  enters("LIST_DATA_DIMENSION_SET",err,error,*999)
519 
520  IF(ASSOCIATED(list)) THEN
521  IF(list%LIST_FINISHED) THEN
522  CALL flagerror("List has been finished.",err,error,*999)
523  ELSE
524  IF(data_dimension>0) THEN
525  list%DATA_DIMENSION=data_dimension
526  ELSE
527  local_error="The specified data dimension of "//trim(numbertovstring(data_dimension,"*",err,error))// &
528  & " is invalid. The dimension must be > 0."
529  CALL flagerror(local_error,err,error,*999)
530  ENDIF
531  ENDIF
532  ELSE
533  CALL flagerror("List is not associated.",err,error,*999)
534  ENDIF
535 
536  exits("LIST_DATA_DIMENSION_SET")
537  RETURN
538 999 errorsexits("LIST_DATA_DIMENSION_SET",err,error)
539  RETURN 1
540  END SUBROUTINE list_data_dimension_set
541 
542  !
543  !================================================================================================================================
544  !
545 
547  SUBROUTINE list_mutable_set(LIST,MUTABLE,ERR,ERROR,*)
548 
549  !Argument Variables
550  TYPE(list_type), POINTER, INTENT(IN) :: LIST
551  LOGICAL, INTENT(IN) :: MUTABLE
552  INTEGER(INTG), INTENT(OUT) :: ERR
553  TYPE(varying_string), INTENT(OUT) :: ERROR
554 
555  enters("LIST_MUTABLE_SET",err,error,*999)
556 
557  IF(ASSOCIATED(list)) THEN
558  IF(list%LIST_FINISHED) THEN
559  CALL flagerror("List has been finished.",err,error,*999)
560  ELSE
561  list%MUTABLE = mutable
562  ENDIF
563  ELSE
564  CALL flagerror("List is not associated.",err,error,*999)
565  ENDIF
566 
567  exits("LIST_MUTABLE_SET")
568  RETURN
569 999 errorsexits("LIST_MUTABLE_SET",err,error)
570  RETURN 1
571  END SUBROUTINE list_mutable_set
572 
573  !
574  !================================================================================================================================
575  !
576 
578  SUBROUTINE list_data_type_set(LIST,DATA_TYPE,ERR,ERROR,*)
579 
580  !Argument Variables
581  TYPE(list_type), POINTER, INTENT(IN) :: LIST
582  INTEGER(INTG), INTENT(IN) :: DATA_TYPE
583  INTEGER(INTG), INTENT(OUT) :: ERR
584  TYPE(varying_string), INTENT(OUT) :: ERROR
585  !Local Variables
586  TYPE(varying_string) :: LOCAL_ERROR
587 
588  enters("LIST_DATA_TYPE_SET",err,error,*999)
589 
590  IF(ASSOCIATED(list)) THEN
591  IF(list%LIST_FINISHED) THEN
592  CALL flagerror("List has been finished.",err,error,*999)
593  ELSE
594  SELECT CASE(data_type)
595  CASE(list_intg_type)
596  list%DATA_TYPE=list_intg_type
597  CASE(list_sp_type)
598  list%DATA_TYPE=list_sp_type
599  CASE(list_dp_type)
600  list%DATA_TYPE=list_dp_type
601  CASE DEFAULT
602  local_error="The data type of "//trim(numbertovstring(data_type,"*",err,error))//" is invalid."
603  CALL flagerror(local_error,err,error,*999)
604  END SELECT
605  ENDIF
606  ELSE
607  CALL flagerror("List is not associated.",err,error,*999)
608  ENDIF
609 
610  exits("LIST_DATA_TYPE_SET")
611  RETURN
612 999 errorsexits("LIST_DATA_TYPE_SET",err,error)
613  RETURN 1
614  END SUBROUTINE list_data_type_set
615 
616  !
617  !================================================================================================================================
618  !
619 
621  SUBROUTINE list_destroy(LIST,ERR,ERROR,*)
622 
623  !Argument Variables
624  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
625  INTEGER(INTG), INTENT(OUT) :: ERR
626  TYPE(varying_string), INTENT(OUT) :: ERROR
627  !Local Variables
628 
629  enters("LIST_DESTROY",err,error,*999)
630 
631  IF(ASSOCIATED(list)) THEN
632  CALL list_finalise(list,err,error,*999)
633  ELSE
634  CALL flagerror("List is not associated.",err,error,*999)
635  ENDIF
636 
637  exits("LIST_DESTROY")
638  RETURN
639 999 errorsexits("LIST_DESTROY",err,error)
640  RETURN 1
641  END SUBROUTINE list_destroy
642 
643  !
644  !================================================================================================================================
645  !
646 
648  SUBROUTINE list_finalise(LIST,ERR,ERROR,*)
649 
650  !Argument Variables
651  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
652  INTEGER(INTG), INTENT(OUT) :: ERR
653  TYPE(varying_string), INTENT(OUT) :: ERROR
654  !Local Variables
655 
656  enters("LIST_FINALISE",err,error,*999)
657 
658  IF(ASSOCIATED(list)) THEN
659  IF(ALLOCATED(list%LIST_INTG)) DEALLOCATE(list%LIST_INTG)
660  IF(ALLOCATED(list%LIST_INTG2)) DEALLOCATE(list%LIST_INTG2)
661  IF(ALLOCATED(list%LIST_SP)) DEALLOCATE(list%LIST_SP)
662  IF(ALLOCATED(list%LIST_SP2)) DEALLOCATE(list%LIST_SP2)
663  IF(ALLOCATED(list%LIST_DP)) DEALLOCATE(list%LIST_DP)
664  IF(ALLOCATED(list%LIST_DP2)) DEALLOCATE(list%LIST_DP2)
665  DEALLOCATE(list)
666  ENDIF
667 
668  exits("LIST_FINALISE")
669  RETURN
670 999 errorsexits("LIST_FINALISE",err,error)
671  RETURN 1
672  END SUBROUTINE list_finalise
673 
674  !
675  !================================================================================================================================
676  !
677 
679  SUBROUTINE list_appendlist(list,appendedList,err,error,*)
680  !Argument Variables
681  TYPE(list_type), POINTER, INTENT(INOUT) :: list
682  TYPE(list_type), POINTER, INTENT(IN) :: appendedList
683  INTEGER(INTG), INTENT(OUT) :: err
684  TYPE(varying_string), INTENT(OUT) :: error
685  !Local Variables
686  INTEGER(INTG) :: newSize
687  INTEGER(INTG), ALLOCATABLE :: newListIntg(:)
688  REAL(SP), ALLOCATABLE :: newListSP(:)
689  REAL(DP), ALLOCATABLE :: newListDP(:)
690  INTEGER(C_INT), ALLOCATABLE :: newListCInt(:)
691  TYPE(varying_string) :: localError
692 
693  enters("List_AppendList",err,error,*999)
694 
695  IF(ASSOCIATED(list)) THEN
696  IF(list%LIST_FINISHED) THEN
697  IF(ASSOCIATED(appendedlist)) THEN
698  IF(appendedlist%LIST_FINISHED) THEN
699  IF(list%DATA_TYPE==appendedlist%DATA_TYPE) THEN
700  IF(list%DATA_DIMENSION==appendedlist%DATA_DIMENSION) THEN
701  SELECT CASE(list%DATA_DIMENSION)
702  CASE(1)
703  SELECT CASE(list%DATA_TYPE)
704  CASE(list_intg_type)
705  IF(list%SIZE<list%NUMBER_IN_LIST+appendedlist%NUMBER_IN_LIST) THEN
706  !Reallocate
707  newsize=max(2*list%NUMBER_IN_LIST,list%NUMBER_IN_LIST+appendedlist%NUMBER_IN_LIST*2)
708  ALLOCATE(newlistintg(newsize),stat=err)
709  IF(err/=0) CALL flagerror("Could not allocate new list.",err,error,*999)
710  newlistintg(1:list%NUMBER_IN_LIST)=list%LIST_INTG(1:list%NUMBER_IN_LIST)
711  CALL move_alloc(newlistintg,list%LIST_INTG)
712  list%SIZE=newsize
713  END IF
714  list%LIST_INTG(list%NUMBER_IN_LIST+1:list%NUMBER_IN_LIST+appendedlist%NUMBER_IN_LIST)= &
715  & appendedlist%LIST_INTG(1:appendedlist%NUMBER_IN_LIST)
716  list%NUMBER_IN_LIST=list%NUMBER_IN_LIST+appendedlist%NUMBER_IN_LIST
717  CASE(list_sp_type)
718  IF(list%SIZE<list%NUMBER_IN_LIST+appendedlist%NUMBER_IN_LIST) THEN
719  !Reallocate
720  newsize=max(2*list%NUMBER_IN_LIST,list%NUMBER_IN_LIST+appendedlist%NUMBER_IN_LIST*2)
721  ALLOCATE(newlistsp(newsize),stat=err)
722  IF(err/=0) CALL flagerror("Could not allocate new list.",err,error,*999)
723  newlistsp(1:list%NUMBER_IN_LIST)=list%LIST_SP(1:list%NUMBER_IN_LIST)
724  CALL move_alloc(newlistsp,list%LIST_SP)
725  list%SIZE=newsize
726  END IF
727  list%LIST_SP(list%NUMBER_IN_LIST+1:list%NUMBER_IN_LIST+appendedlist%NUMBER_IN_LIST)= &
728  & appendedlist%LIST_SP(1:appendedlist%NUMBER_IN_LIST)
729  list%NUMBER_IN_LIST=list%NUMBER_IN_LIST+appendedlist%NUMBER_IN_LIST
730  CASE(list_dp_type)
731  IF(list%SIZE<list%NUMBER_IN_LIST+appendedlist%NUMBER_IN_LIST) THEN
732  !Reallocate
733  newsize=max(2*list%NUMBER_IN_LIST,list%NUMBER_IN_LIST+appendedlist%NUMBER_IN_LIST*2)
734  ALLOCATE(newlistdp(newsize),stat=err)
735  IF(err/=0) CALL flagerror("Could not allocate new list.",err,error,*999)
736  newlistdp(1:list%NUMBER_IN_LIST)=list%LIST_DP(1:list%NUMBER_IN_LIST)
737  CALL move_alloc(newlistdp,list%LIST_DP)
738  list%SIZE=newsize
739  END IF
740  list%LIST_DP(list%NUMBER_IN_LIST+1:list%NUMBER_IN_LIST+appendedlist%NUMBER_IN_LIST)= &
741  & appendedlist%LIST_DP(1:appendedlist%NUMBER_IN_LIST)
742  list%NUMBER_IN_LIST=list%NUMBER_IN_LIST+appendedlist%NUMBER_IN_LIST
743  CASE DEFAULT
744  CALL flagerror("The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
745  & " is invalid.",err,error,*999)
746  END SELECT
747  CASE DEFAULT
748  CALL flagerror("Dimensions > 1 not implemented for appended to a list",err,error,*999)
749  END SELECT
750  ELSE
751  localerror="Invalid data dimension. The list to append has data dimension of "// &
752  & trim(numbertovstring(appendedlist%DATA_DIMENSION,"*",err,error))//" and the list data dimension is "// &
753  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
754  CALL flagerror(localerror,err,error,*999)
755  ENDIF
756  ELSE
757  localerror="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
758  & " does not match the data type of the list to append"
759  CALL flagerror(localerror,err,error,*999)
760  ENDIF
761  ELSE
762  CALL flagerror("The list to append has not been finished",err,error,*999)
763  ENDIF
764  ELSE
765  CALL flagerror("The list to append is not associated",err,error,*999)
766  ENDIF
767  ELSE
768  CALL flagerror("The list has not been finished",err,error,*999)
769  ENDIF
770  ELSE
771  CALL flagerror("List is not associated",err,error,*999)
772  ENDIF
773 
774  exits("List_AppendList")
775  RETURN
776 999 IF(ALLOCATED(newlistintg)) DEALLOCATE(newlistintg)
777  IF(ALLOCATED(newlistsp)) DEALLOCATE(newlistsp)
778  IF(ALLOCATED(newlistdp)) DEALLOCATE(newlistdp)
779  IF(ALLOCATED(newlistcint)) DEALLOCATE(newlistcint)
780  errorsexits("List_AppendList",err,error)
781  RETURN 1
782  END SUBROUTINE list_appendlist
783 
784  !
785  !================================================================================================================================
786  !
787 
789  SUBROUTINE list_clearitems(list,err,error,*)
790  !Argument Variables
791  TYPE(list_type), POINTER, INTENT(INOUT) :: list
792  INTEGER(INTG), INTENT(OUT) :: err
793  TYPE(varying_string), INTENT(OUT) :: error
794 
795  enters("List_ClearItems",err,error,*999)
796 
797  IF(ASSOCIATED(list)) THEN
798  IF(list%LIST_FINISHED) THEN
799  IF(list%mutable) THEN
800  list%NUMBER_IN_LIST=0
801  ELSE
802  CALL flagerror("The list is not mutable",err,error,*999)
803  END IF
804  ELSE
805  CALL flagerror("The list has not been finished",err,error,*999)
806  END IF
807  ELSE
808  CALL flagerror("List is not associated",err,error,*999)
809  END IF
810 
811  exits("List_ClearItems")
812  RETURN
813 999 errorsexits("List_ClearItems",err,error)
814  RETURN 1
815  END SUBROUTINE list_clearitems
816  !
817  !================================================================================================================================
818  !
819 
821  SUBROUTINE list_initialise(LIST,ERR,ERROR,*)
822 
823  !Argument Variables
824  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
825  INTEGER(INTG), INTENT(OUT) :: ERR
826  TYPE(varying_string), INTENT(OUT) :: ERROR
827  !Local Variables
828  INTEGER(INTG) :: DUMMY_ERR
829  TYPE(varying_string) :: DUMMY_ERROR
830 
831  enters("LIST_INITIALISE",err,error,*998)
832 
833  IF(ASSOCIATED(list)) THEN
834  CALL flagerror("List is already associated.",err,error,*998)
835  ELSE
836  ALLOCATE(list,stat=err)
837  IF(err/=0) CALL flagerror("Could not allocate list.",err,error,*999)
838  list%LIST_FINISHED=.false.
839  list%MUTABLE=.false.
840  list%NUMBER_IN_LIST=0
841  list%DATA_DIMENSION=1
842  list%INITIAL_SIZE=10
843  list%SIZE=0
844  list%DATA_TYPE=list_intg_type
845  list%KEY_DIMENSION=1
846  list%SORT_ORDER=list_sort_ascending_type
847  list%SORT_METHOD=list_heap_sort_method
848  ENDIF
849 
850  exits("LIST_INITIALISE")
851  RETURN
852 999 CALL list_finalise(list,dummy_err,dummy_error,*998)
853 998 errorsexits("LIST_INITIALISE",err,error)
854  RETURN 1
855  END SUBROUTINE list_initialise
856 
857  !
858  !================================================================================================================================
859  !
860 
862  SUBROUTINE list_initial_size_set(LIST,INITIAL_SIZE,ERR,ERROR,*)
863 
864  !Argument Variables
865  TYPE(list_type), POINTER, INTENT(IN) :: LIST
866  INTEGER(INTG), INTENT(IN) :: INITIAL_SIZE
867  INTEGER(INTG), INTENT(OUT) :: ERR
868  TYPE(varying_string), INTENT(OUT) :: ERROR
869  !Local Variables
870  TYPE(varying_string) :: LOCAL_ERROR
871 
872  enters("LIST_INITIAL_SIZE_SET",err,error,*999)
873 
874  IF(ASSOCIATED(list)) THEN
875  IF(list%LIST_FINISHED) THEN
876  CALL flagerror("List has been finished.",err,error,*999)
877  ELSE
878  IF(initial_size>0) THEN
879  list%INITIAL_SIZE=initial_size
880  ELSE
881  local_error="The initial size of "//trim(numbertovstring(initial_size,"*",err,error))// &
882  & " is invalid. The size must be > 0."
883  CALL flagerror(local_error,err,error,*999)
884  ENDIF
885  ENDIF
886  ELSE
887  CALL flagerror("List is not associated",err,error,*999)
888  ENDIF
889 
890  exits("LIST_INTIIAL_SIZE_SET")
891  RETURN
892 999 errorsexits("LIST_INITIAL_SIZE_SET",err,error)
893  RETURN 1
894  END SUBROUTINE list_initial_size_set
895 
896  !
897  !================================================================================================================================
898  !
899 
901  SUBROUTINE list_item_add_intg1(LIST,ITEM,ERR,ERROR,*)
902  !Argument Variables
903  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
904  INTEGER(INTG), INTENT(IN) :: ITEM
905  INTEGER(INTG), INTENT(OUT) :: ERR
906  TYPE(varying_string), INTENT(OUT) :: ERROR
907  !Local Variables
908  INTEGER(INTG) :: NEW_SIZE
909  INTEGER(INTG), ALLOCATABLE :: NEW_LIST(:)
910  TYPE(varying_string) :: LOCAL_ERROR
911 
912  enters("LIST_ITEM_ADD_INTG1",err,error,*999)
913 
914  IF(ASSOCIATED(list)) THEN
915  IF(list%LIST_FINISHED) THEN
916  IF(list%DATA_TYPE==list_intg_type) THEN
917  IF(list%DATA_DIMENSION==1) THEN
918  IF(list%NUMBER_IN_LIST==list%SIZE) THEN
919  !Reallocate
920  new_size=max(2*list%NUMBER_IN_LIST,1)
921  ALLOCATE(new_list(new_size),stat=err)
922  IF(err/=0) CALL flagerror("Could not allocate new list.",err,error,*999)
923  new_list(1:list%NUMBER_IN_LIST)=list%LIST_INTG(1:list%NUMBER_IN_LIST)
924  CALL move_alloc(new_list,list%LIST_INTG)
925  list%SIZE=new_size
926  ENDIF
927  list%LIST_INTG(list%NUMBER_IN_LIST+1)=item
928  list%NUMBER_IN_LIST=list%NUMBER_IN_LIST+1
929  ELSE
930  local_error="Invalid data dimension. The supplied data dimension is 1 and the list data dimension is "// &
931  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
932  CALL flagerror(local_error,err,error,*999)
933  ENDIF
934  ELSE
935  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
936  & " does not match the integer type of the supplied list item"
937  CALL flagerror(local_error,err,error,*999)
938  ENDIF
939  ELSE
940  CALL flagerror("The list has not been finished",err,error,*999)
941  ENDIF
942  ELSE
943  CALL flagerror("List is not associated",err,error,*999)
944  ENDIF
945 
946  exits("LIST_ITEM_ADD_INTG1")
947  RETURN
948 999 IF(ALLOCATED(new_list)) DEALLOCATE(new_list)
949  errorsexits("LIST_ITEM_ADD_INTG1",err,error)
950  RETURN 1
951  END SUBROUTINE list_item_add_intg1
952 
953  !
954  !================================================================================================================================
955  !
956 
958  SUBROUTINE list_item_add_intg2(LIST,ITEM,ERR,ERROR,*)
959  !Argument Variables
960  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
961  INTEGER(INTG), INTENT(IN) :: ITEM(:)
962  INTEGER(INTG), INTENT(OUT) :: ERR
963  TYPE(varying_string), INTENT(OUT) :: ERROR
964  !Local Variables
965  INTEGER(INTG) :: NEW_SIZE
966  INTEGER(INTG), ALLOCATABLE :: NEW_LIST(:,:)
967  TYPE(varying_string) :: LOCAL_ERROR
968 
969  enters("LIST_ITEM_ADD_INTG2",err,error,*999)
970 
971  IF(ASSOCIATED(list)) THEN
972  IF(list%LIST_FINISHED) THEN
973  IF(list%DATA_TYPE==list_intg_type) THEN
974  IF(list%DATA_DIMENSION==SIZE(item,1)) THEN
975  IF(list%NUMBER_IN_LIST==list%SIZE) THEN
976  !Reallocate
977  new_size=max(2*list%NUMBER_IN_LIST,1)
978  ALLOCATE(new_list(list%DATA_DIMENSION,new_size),stat=err)
979  IF(err/=0) CALL flagerror("Could not allocate new list.",err,error,*999)
980  new_list(:,1:list%NUMBER_IN_LIST)=list%LIST_INTG2(:,1:list%NUMBER_IN_LIST)
981  CALL move_alloc(new_list,list%LIST_INTG2)
982  list%SIZE=new_size
983  ENDIF
984  list%LIST_INTG2(:,list%NUMBER_IN_LIST+1)=item
985  list%NUMBER_IN_LIST=list%NUMBER_IN_LIST+1
986  ELSE
987  local_error="Invalid data dimension. The supplied data dimension is "// &
988  & trim(numbertovstring(SIZE(item,1),"*",err,error))//" and the list data dimension is "// &
989  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
990  CALL flagerror(local_error,err,error,*999)
991  ENDIF
992  ELSE
993  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
994  & " does not match the integer type of the supplied list item."
995  CALL flagerror(local_error,err,error,*999)
996  ENDIF
997  ELSE
998  CALL flagerror("The list has not been finished.",err,error,*999)
999  ENDIF
1000  ELSE
1001  CALL flagerror("List is not associated.",err,error,*999)
1002  ENDIF
1003 
1004  exits("LIST_ITEM_ADD_INTG2")
1005  RETURN
1006 999 IF(ALLOCATED(new_list)) DEALLOCATE(new_list)
1007  errorsexits("LIST_ITEM_ADD_INTG2",err,error)
1008  RETURN 1
1009 
1010  END SUBROUTINE list_item_add_intg2
1011 
1012  !
1013  !================================================================================================================================
1014  !
1015 
1017  SUBROUTINE list_item_add_sp1(LIST,ITEM,ERR,ERROR,*)
1018 
1019  !Argument Variables
1020  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
1021  REAL(SP), INTENT(IN) :: ITEM
1022  INTEGER(INTG), INTENT(OUT) :: ERR
1023  TYPE(varying_string), INTENT(OUT) :: ERROR
1024  !Local Variables
1025  INTEGER(INTG) :: NEW_SIZE
1026  REAL(SP), ALLOCATABLE :: NEW_LIST(:)
1027  TYPE(varying_string) :: LOCAL_ERROR
1028 
1029  enters("LIST_ITEM_ADD_SP1",err,error,*999)
1030 
1031  IF(ASSOCIATED(list)) THEN
1032  IF(list%LIST_FINISHED) THEN
1033  IF(list%DATA_TYPE==list_sp_type) THEN
1034  IF(list%DATA_DIMENSION==1) THEN
1035  IF(list%NUMBER_IN_LIST==list%SIZE) THEN
1036  !Reallocate
1037  new_size=max(2*list%NUMBER_IN_LIST,1)
1038  ALLOCATE(new_list(new_size),stat=err)
1039  IF(err/=0) CALL flagerror("Could not allocate new list.",err,error,*999)
1040  new_list(1:list%NUMBER_IN_LIST)=list%LIST_SP(1:list%NUMBER_IN_LIST)
1041  CALL move_alloc(new_list,list%LIST_SP)
1042  list%SIZE=new_size
1043  ENDIF
1044  list%LIST_SP(list%NUMBER_IN_LIST+1)=item
1045  list%NUMBER_IN_LIST=list%NUMBER_IN_LIST+1
1046  ELSE
1047  local_error="Invalid data dimension. The supplied data dimension is 1 and the list data dimension is "// &
1048  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
1049  ENDIF
1050  ELSE
1051  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1052  & " does not match the single precision type of the supplied list item."
1053  CALL flagerror(local_error,err,error,*999)
1054  ENDIF
1055  ELSE
1056  CALL flagerror("The list has not been finished.",err,error,*999)
1057  ENDIF
1058  ELSE
1059  CALL flagerror("List is not associated.",err,error,*999)
1060  ENDIF
1061  exits("LIST_ITEM_ADD_SP1")
1062  RETURN
1063 999 IF(ALLOCATED(new_list)) DEALLOCATE(new_list)
1064  errorsexits("LIST_ITEM_ADD_SP1",err,error)
1065  RETURN 1
1066  END SUBROUTINE list_item_add_sp1
1067 
1068  !
1069  !================================================================================================================================
1070  !
1071 
1073  SUBROUTINE list_item_add_sp2(LIST,ITEM,ERR,ERROR,*)
1074 
1075  !Argument Variables
1076  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
1077  REAL(SP), INTENT(IN) :: ITEM(:)
1078  INTEGER(INTG), INTENT(OUT) :: ERR
1079  TYPE(varying_string), INTENT(OUT) :: ERROR
1080  !Local Variables
1081  INTEGER(INTG) :: NEW_SIZE
1082  REAL(SP), ALLOCATABLE :: NEW_LIST(:,:)
1083  TYPE(varying_string) :: LOCAL_ERROR
1084 
1085  enters("LIST_ITEM_ADD_SP2",err,error,*999)
1086 
1087  IF(ASSOCIATED(list)) THEN
1088  IF(list%LIST_FINISHED) THEN
1089  IF(list%DATA_TYPE==list_sp_type) THEN
1090  IF(list%DATA_DIMENSION==SIZE(item,1)) THEN
1091  IF(list%NUMBER_IN_LIST==list%SIZE) THEN
1092  !Reallocate
1093  new_size=max(2*list%NUMBER_IN_LIST,1)
1094  ALLOCATE(new_list(list%DATA_DIMENSION,new_size),stat=err)
1095  IF(err/=0) CALL flagerror("Could not allocate new list.",err,error,*999)
1096  new_list(:,1:list%NUMBER_IN_LIST)=list%LIST_SP2(:,1:list%NUMBER_IN_LIST)
1097  CALL move_alloc(new_list,list%LIST_SP2)
1098  list%SIZE=new_size
1099  ENDIF
1100  list%LIST_SP2(:,list%NUMBER_IN_LIST+1)=item
1101  list%NUMBER_IN_LIST=list%NUMBER_IN_LIST+1
1102  ELSE
1103  local_error="Invalid data dimension. The supplied data dimension is "// &
1104  & trim(numbertovstring(SIZE(item,1),"*",err,error))//" and the list data dimension is "// &
1105  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
1106  CALL flagerror(local_error,err,error,*999)
1107  ENDIF
1108  ELSE
1109  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1110  & " does not match the single precision type of the supplied list item."
1111  CALL flagerror(local_error,err,error,*999)
1112  ENDIF
1113  ELSE
1114  CALL flagerror("The list has not been finished.",err,error,*999)
1115  ENDIF
1116  ELSE
1117  CALL flagerror("List is not associated.",err,error,*999)
1118  ENDIF
1119  exits("LIST_ITEM_ADD_SP2")
1120  RETURN
1121 999 IF(ALLOCATED(new_list)) DEALLOCATE(new_list)
1122  errorsexits("LIST_ITEM_ADD_SP2",err,error)
1123  RETURN 1
1124  END SUBROUTINE list_item_add_sp2
1125 
1126  !
1127  !================================================================================================================================
1128  !
1129 
1131  SUBROUTINE list_item_add_dp1(LIST,ITEM,ERR,ERROR,*)
1132 
1133  !Argument Variables
1134  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
1135  REAL(DP), INTENT(IN) :: ITEM
1136  INTEGER(INTG), INTENT(OUT) :: ERR
1137  TYPE(varying_string), INTENT(OUT) :: ERROR
1138  !Local Variables
1139  INTEGER(INTG) :: NEW_SIZE
1140  REAL(DP), ALLOCATABLE :: NEW_LIST(:)
1141  TYPE(varying_string) :: LOCAL_ERROR
1142 
1143  enters("LIST_ITEM_ADD_DP1",err,error,*999)
1144 
1145  IF(ASSOCIATED(list)) THEN
1146  IF(list%LIST_FINISHED) THEN
1147  IF(list%DATA_TYPE==list_dp_type) THEN
1148  IF(list%DATA_DIMENSION==1) THEN
1149  IF(list%NUMBER_IN_LIST==list%SIZE) THEN
1150  !Reallocate
1151  new_size=max(2*list%NUMBER_IN_LIST,1)
1152  ALLOCATE(new_list(new_size),stat=err)
1153  IF(err/=0) CALL flagerror("Could not allocate new list.",err,error,*999)
1154  new_list(1:list%NUMBER_IN_LIST)=list%LIST_DP(1:list%NUMBER_IN_LIST)
1155  CALL move_alloc(new_list,list%LIST_DP)
1156  list%SIZE=new_size
1157  ENDIF
1158  list%LIST_DP(list%NUMBER_IN_LIST+1)=item
1159  list%NUMBER_IN_LIST=list%NUMBER_IN_LIST+1
1160  ELSE
1161  local_error="Invalid data dimension. The supplied data dimension is 1 and the list data dimension is "// &
1162  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
1163  CALL flagerror(local_error,err,error,*999)
1164  ENDIF
1165  ELSE
1166  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1167  & " does not match the double precision type of the supplied list item."
1168  CALL flagerror(local_error,err,error,*999)
1169  ENDIF
1170  ELSE
1171  CALL flagerror("The list has not been finished.",err,error,*999)
1172  ENDIF
1173  ELSE
1174  CALL flagerror("List is not associated.",err,error,*999)
1175  ENDIF
1176  exits("LIST_ITEM_ADD_DP1")
1177  RETURN
1178 999 IF(ALLOCATED(new_list)) DEALLOCATE(new_list)
1179  errorsexits("LIST_ITEM_ADD_DP1",err,error)
1180  RETURN 1
1181  END SUBROUTINE list_item_add_dp1
1182 
1183  !
1184  !================================================================================================================================
1185  !
1186 
1188  SUBROUTINE list_item_add_dp2(LIST,ITEM,ERR,ERROR,*)
1189 
1190  !Argument Variables
1191  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
1192  REAL(DP), INTENT(IN) :: ITEM(:)
1193  INTEGER(INTG), INTENT(OUT) :: ERR
1194  TYPE(varying_string), INTENT(OUT) :: ERROR
1195  !Local Variables
1196  INTEGER(INTG) :: NEW_SIZE
1197  REAL(DP), ALLOCATABLE :: NEW_LIST(:,:)
1198  TYPE(varying_string) :: LOCAL_ERROR
1199 
1200  enters("LIST_ITEM_ADD_DP2",err,error,*999)
1201 
1202  IF(ASSOCIATED(list)) THEN
1203  IF(list%LIST_FINISHED) THEN
1204  IF(list%DATA_TYPE==list_dp_type) THEN
1205  IF(list%DATA_DIMENSION==SIZE(item,1)) THEN
1206  IF(list%NUMBER_IN_LIST==list%SIZE) THEN
1207  !Reallocate
1208  new_size=max(2*list%NUMBER_IN_LIST,1)
1209  ALLOCATE(new_list(list%DATA_DIMENSION,new_size),stat=err)
1210  IF(err/=0) CALL flagerror("Could not allocate new list.",err,error,*999)
1211  new_list(:,1:list%NUMBER_IN_LIST)=list%LIST_DP2(:,1:list%NUMBER_IN_LIST)
1212  CALL move_alloc(new_list,list%LIST_DP2)
1213  list%SIZE=new_size
1214  ENDIF
1215  list%LIST_DP2(:,list%NUMBER_IN_LIST+1)=item
1216  list%NUMBER_IN_LIST=list%NUMBER_IN_LIST+1
1217  ELSE
1218  local_error="Invalid data dimension. The supplied data dimension is "// &
1219  & trim(numbertovstring(SIZE(item,1),"*",err,error))//" and the list data dimension is "// &
1220  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
1221  CALL flagerror(local_error,err,error,*999)
1222  ENDIF
1223  ELSE
1224  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1225  & " does not match the double precision type of the supplied list item."
1226  CALL flagerror(local_error,err,error,*999)
1227  ENDIF
1228  ELSE
1229  CALL flagerror("The list has not been finished.",err,error,*999)
1230  ENDIF
1231  ELSE
1232  CALL flagerror("List is not associated.",err,error,*999)
1233  ENDIF
1234  exits("LIST_ITEM_ADD_DP2")
1235  RETURN
1236 999 IF(ALLOCATED(new_list)) DEALLOCATE(new_list)
1237  errorsexits("LIST_ITEM_ADD_DP2",err,error)
1238  RETURN 1
1239  END SUBROUTINE list_item_add_dp2
1240 
1241  !
1242  !================================================================================================================================
1243  !
1244 
1246  SUBROUTINE list_item_set_intg1(LIST,LIST_ITEM,ITEM,ERR,ERROR,*)
1247  !Argument Variables
1248  TYPE(list_type), POINTER, INTENT(IN) :: LIST
1249  INTEGER(INTG), INTENT(IN) :: LIST_ITEM
1250  INTEGER(INTG), INTENT(IN) :: ITEM
1251  INTEGER(INTG), INTENT(OUT) :: ERR
1252  TYPE(varying_string), INTENT(OUT) :: ERROR
1253  !Local Variables
1254  TYPE(varying_string) :: LOCAL_ERROR
1255 
1256  enters("LIST_ITEM_SET_INTG1",err,error,*999)
1257 
1258  IF(ASSOCIATED(list)) THEN
1259  IF(list%LIST_FINISHED) THEN
1260  IF(list%DATA_TYPE==list_intg_type) THEN
1261  IF(list%DATA_DIMENSION==1) THEN
1262  IF(list_item>0.AND.list_item<=list%NUMBER_IN_LIST) THEN
1263  IF(list%MUTABLE) THEN
1264  list%LIST_INTG(list_item)=item
1265  ELSE
1266  CALL flagerror("Cannot modify an immutable list.",err,error,*999)
1267  ENDIF
1268  ELSE
1269  local_error="Invalid list index. The supplied index is "// &
1270  & trim(numbertovstring(list_item,"*",err,error))//" and that list entry count is"// &
1271  & trim(numbertovstring(list%NUMBER_IN_LIST,"*",err,error))//"."
1272  CALL flagerror(local_error,err,error,*999)
1273  ENDIF
1274  ELSE
1275  local_error="Invalid data dimension. The supplied data dimension is 1 and the list data dimension is "// &
1276  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
1277  CALL flagerror(local_error,err,error,*999)
1278  ENDIF
1279  ELSE
1280  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1281  & " does not match the integer type of the supplied list item"
1282  CALL flagerror(local_error,err,error,*999)
1283  ENDIF
1284  ELSE
1285  CALL flagerror("The list has not been finished",err,error,*999)
1286  ENDIF
1287  ELSE
1288  CALL flagerror("List is not associated",err,error,*999)
1289  ENDIF
1290 
1291  exits("LIST_ITEM_SET_INTG1")
1292  RETURN
1293 999 errorsexits("LIST_ITEM_SET_INTG1",err,error)
1294  RETURN 1
1295  END SUBROUTINE list_item_set_intg1
1296 
1297  !
1298  !================================================================================================================================
1299  !
1300 
1302  SUBROUTINE list_item_set_intg2(LIST,LIST_ITEM,ITEM,ERR,ERROR,*)
1303  !Argument Variables
1304  TYPE(list_type), POINTER, INTENT(IN) :: LIST
1305  INTEGER(INTG), INTENT(IN) :: LIST_ITEM
1306  INTEGER(INTG), INTENT(IN) :: ITEM(:)
1307  INTEGER(INTG), INTENT(OUT) :: ERR
1308  TYPE(varying_string), INTENT(OUT) :: ERROR
1309  !Local Variables
1310  TYPE(varying_string) :: LOCAL_ERROR
1311 
1312  enters("LIST_ITEM_SET_INTG2",err,error,*999)
1313 
1314  IF(ASSOCIATED(list)) THEN
1315  IF(list%LIST_FINISHED) THEN
1316  IF(list%DATA_TYPE==list_intg_type) THEN
1317  IF(list%DATA_DIMENSION==SIZE(item,1)) THEN
1318  IF(list_item>0.AND.list_item<=list%NUMBER_IN_LIST) THEN
1319  IF(list%MUTABLE) THEN
1320  list%LIST_INTG2(:,list_item)=item
1321  ELSE
1322  CALL flagerror("Cannot modify an immutable list.",err,error,*999)
1323  ENDIF
1324  ELSE
1325  local_error="Invalid list index. The supplied index is "//&
1326  & trim(numbertovstring(list_item,"*",err,error))//" and that list entry count is"//&
1327  & trim(numbertovstring(list%NUMBER_IN_LIST,"*",err,error))//"."
1328  CALL flagerror(local_error,err,error,*999)
1329  ENDIF
1330  ELSE
1331  local_error="Invalid data dimension. The supplied data dimension is "// &
1332  & trim(numbertovstring(SIZE(item,1),"*",err,error))//" and the list data dimension is "// &
1333  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
1334  CALL flagerror(local_error,err,error,*999)
1335  ENDIF
1336  ELSE
1337  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1338  & " does not match the integer type of the supplied list item."
1339  CALL flagerror(local_error,err,error,*999)
1340  ENDIF
1341  ELSE
1342  CALL flagerror("The list has not been finished.",err,error,*999)
1343  ENDIF
1344  ELSE
1345  CALL flagerror("List is not associated.",err,error,*999)
1346  ENDIF
1347 
1348  exits("LIST_ITEM_SET_INTG2")
1349  RETURN
1350 999 errorsexits("LIST_ITEM_SET_INTG2",err,error)
1351  RETURN 1
1352 
1353  END SUBROUTINE list_item_set_intg2
1354 
1355  !
1356  !================================================================================================================================
1357  !
1358 
1360  SUBROUTINE list_item_set_sp1(LIST,LIST_ITEM,ITEM,ERR,ERROR,*)
1361 
1362  !Argument Variables
1363  TYPE(list_type), POINTER, INTENT(IN) :: LIST
1364  INTEGER(INTG), INTENT(IN) :: LIST_ITEM
1365  REAL(SP), INTENT(IN) :: ITEM
1366  INTEGER(INTG), INTENT(OUT) :: ERR
1367  TYPE(varying_string), INTENT(OUT) :: ERROR
1368  !Local Variables
1369  TYPE(varying_string) :: LOCAL_ERROR
1370 
1371  enters("LIST_ITEM_SET_SP1",err,error,*999)
1372 
1373  IF(ASSOCIATED(list)) THEN
1374  IF(list%LIST_FINISHED) THEN
1375  IF(list%DATA_TYPE==list_sp_type) THEN
1376  IF(list%DATA_DIMENSION==1) THEN
1377  IF(list_item>0.AND.list_item<=list%NUMBER_IN_LIST) THEN
1378  IF(list%MUTABLE) THEN
1379  list%LIST_SP(list_item)=item
1380  ELSE
1381  CALL flagerror("Cannot modify an immutable list.",err,error,*999)
1382  ENDIF
1383  ELSE
1384  local_error="Invalid list index. The supplied index is "//&
1385  & trim(numbertovstring(list_item,"*",err,error))//" and that list entry count is"//&
1386  & trim(numbertovstring(list%NUMBER_IN_LIST,"*",err,error))//"."
1387  CALL flagerror(local_error,err,error,*999)
1388  ENDIF
1389  ELSE
1390  local_error="Invalid data dimension. The supplied data dimension is 1 and the list data dimension is "// &
1391  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
1392  ENDIF
1393  ELSE
1394  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1395  & " does not match the single precision type of the supplied list item."
1396  CALL flagerror(local_error,err,error,*999)
1397  ENDIF
1398  ELSE
1399  CALL flagerror("The list has not been finished.",err,error,*999)
1400  ENDIF
1401  ELSE
1402  CALL flagerror("List is not associated.",err,error,*999)
1403  ENDIF
1404  exits("LIST_ITEM_SET_SP1")
1405  RETURN
1406 999 errorsexits("LIST_ITEM_SET_SP1",err,error)
1407  RETURN 1
1408  END SUBROUTINE list_item_set_sp1
1409 
1410  !
1411  !================================================================================================================================
1412  !
1413 
1415  SUBROUTINE list_item_set_sp2(LIST,LIST_ITEM,ITEM,ERR,ERROR,*)
1416 
1417  !Argument Variables
1418  TYPE(list_type), POINTER, INTENT(IN) :: LIST
1419  INTEGER(INTG), INTENT(IN) :: LIST_ITEM
1420  REAL(SP), INTENT(IN) :: ITEM(:)
1421  INTEGER(INTG), INTENT(OUT) :: ERR
1422  TYPE(varying_string), INTENT(OUT) :: ERROR
1423  !Local Variables
1424  TYPE(varying_string) :: LOCAL_ERROR
1425 
1426  enters("LIST_ITEM_SET_SP2",err,error,*999)
1427 
1428  IF(ASSOCIATED(list)) THEN
1429  IF(list%LIST_FINISHED) THEN
1430  IF(list%DATA_TYPE==list_sp_type) THEN
1431  IF(list%DATA_DIMENSION==SIZE(item,1)) THEN
1432  IF(list_item>0.AND.list_item<=list%NUMBER_IN_LIST) THEN
1433  IF(list%MUTABLE) THEN
1434  list%LIST_SP2(:,list_item)=item
1435  ELSE
1436  CALL flagerror("Cannot modify an immutable list.",err,error,*999)
1437  ENDIF
1438  ELSE
1439  local_error="Invalid list index. The supplied index is "//&
1440  & trim(numbertovstring(list_item,"*",err,error))//" and that list entry count is"//&
1441  & trim(numbertovstring(list%NUMBER_IN_LIST,"*",err,error))//"."
1442  CALL flagerror(local_error,err,error,*999)
1443  ENDIF
1444  ELSE
1445  local_error="Invalid data dimension. The supplied data dimension is "// &
1446  & trim(numbertovstring(SIZE(item,1),"*",err,error))//" and the list data dimension is "// &
1447  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
1448  CALL flagerror(local_error,err,error,*999)
1449  ENDIF
1450  ELSE
1451  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1452  & " does not match the single precision type of the supplied list item."
1453  CALL flagerror(local_error,err,error,*999)
1454  ENDIF
1455  ELSE
1456  CALL flagerror("The list has not been finished.",err,error,*999)
1457  ENDIF
1458  ELSE
1459  CALL flagerror("List is not associated.",err,error,*999)
1460  ENDIF
1461  exits("LIST_ITEM_SET_SP2")
1462  RETURN
1463 999 errorsexits("LIST_ITEM_SET_SP2",err,error)
1464  RETURN 1
1465  END SUBROUTINE list_item_set_sp2
1466 
1467  !
1468  !================================================================================================================================
1469  !
1470 
1472  SUBROUTINE list_item_set_dp1(LIST,LIST_ITEM,ITEM,ERR,ERROR,*)
1473 
1474  !Argument Variables
1475  TYPE(list_type), POINTER, INTENT(IN) :: LIST
1476  INTEGER(INTG), INTENT(IN) :: LIST_ITEM
1477  REAL(DP), INTENT(IN) :: ITEM
1478  INTEGER(INTG), INTENT(OUT) :: ERR
1479  TYPE(varying_string), INTENT(OUT) :: ERROR
1480  !Local Variables
1481  TYPE(varying_string) :: LOCAL_ERROR
1482 
1483  enters("LIST_ITEM_SET_DP1",err,error,*999)
1484 
1485  IF(ASSOCIATED(list)) THEN
1486  IF(list%LIST_FINISHED) THEN
1487  IF(list%DATA_TYPE==list_dp_type) THEN
1488  IF(list%DATA_DIMENSION==1) THEN
1489  IF(list_item>0.AND.list_item<=list%NUMBER_IN_LIST) THEN
1490  IF(list%MUTABLE) THEN
1491  list%LIST_DP(list_item)=item
1492  ELSE
1493  CALL flagerror("Cannot modify an immutable list.",err,error,*999)
1494  ENDIF
1495  ELSE
1496  local_error="Invalid list index. The supplied index is "//&
1497  & trim(numbertovstring(list_item,"*",err,error))//" and that list entry count is"//&
1498  & trim(numbertovstring(list%NUMBER_IN_LIST,"*",err,error))//"."
1499  CALL flagerror(local_error,err,error,*999)
1500  ENDIF
1501  ELSE
1502  local_error="Invalid data dimension. The supplied data dimension is 1 and the list data dimension is "// &
1503  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
1504  CALL flagerror(local_error,err,error,*999)
1505  ENDIF
1506  ELSE
1507  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1508  & " does not match the double precision type of the supplied list item."
1509  CALL flagerror(local_error,err,error,*999)
1510  ENDIF
1511  ELSE
1512  CALL flagerror("The list has not been finished.",err,error,*999)
1513  ENDIF
1514  ELSE
1515  CALL flagerror("List is not associated.",err,error,*999)
1516  ENDIF
1517  exits("LIST_ITEM_SET_DP1")
1518  RETURN
1519 999 errorsexits("LIST_ITEM_SET_DP1",err,error)
1520  RETURN 1
1521  END SUBROUTINE list_item_set_dp1
1522 
1523  !
1524  !================================================================================================================================
1525  !
1526 
1528  SUBROUTINE list_item_set_dp2(LIST,LIST_ITEM,ITEM,ERR,ERROR,*)
1529 
1530  !Argument Variables
1531  TYPE(list_type), POINTER, INTENT(IN) :: LIST
1532  INTEGER(INTG), INTENT(IN) :: LIST_ITEM
1533  REAL(DP), INTENT(IN) :: ITEM(:)
1534  INTEGER(INTG), INTENT(OUT) :: ERR
1535  TYPE(varying_string), INTENT(OUT) :: ERROR
1536  !Local Variables
1537  TYPE(varying_string) :: LOCAL_ERROR
1538 
1539  enters("LIST_ITEM_SET_DP2",err,error,*999)
1540 
1541  IF(ASSOCIATED(list)) THEN
1542  IF(list%LIST_FINISHED) THEN
1543  IF(list%DATA_TYPE==list_dp_type) THEN
1544  IF(list%DATA_DIMENSION==SIZE(item,1)) THEN
1545  IF(list_item>0.AND.list_item<=list%NUMBER_IN_LIST) THEN
1546  IF(list%MUTABLE) THEN
1547  list%LIST_DP2(:,list_item)=item
1548  ELSE
1549  CALL flagerror("Cannot modify an immutable list.",err,error,*999)
1550  ENDIF
1551  ELSE
1552  local_error="Invalid list index. The supplied index is "//&
1553  & trim(numbertovstring(list_item,"*",err,error))//" and that list entry count is"//&
1554  & trim(numbertovstring(list%NUMBER_IN_LIST,"*",err,error))//"."
1555  CALL flagerror(local_error,err,error,*999)
1556  ENDIF
1557  ELSE
1558  local_error="Invalid data dimension. The supplied data dimension is "// &
1559  & trim(numbertovstring(SIZE(item,1),"*",err,error))//" and the list data dimension is "// &
1560  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
1561  CALL flagerror(local_error,err,error,*999)
1562  ENDIF
1563  ELSE
1564  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1565  & " does not match the double precision type of the supplied list item."
1566  CALL flagerror(local_error,err,error,*999)
1567  ENDIF
1568  ELSE
1569  CALL flagerror("The list has not been finished.",err,error,*999)
1570  ENDIF
1571  ELSE
1572  CALL flagerror("List is not associated.",err,error,*999)
1573  ENDIF
1574  exits("LIST_ITEM_SET_DP2")
1575  RETURN
1576 999 errorsexits("LIST_ITEM_SET_DP2",err,error)
1577  RETURN 1
1578  END SUBROUTINE list_item_set_dp2
1579 
1580  !
1581  !================================================================================================================================
1582  !
1583 
1585  SUBROUTINE list_item_get_intg1(LIST,LIST_ITEM,ITEM,ERR,ERROR,*)
1586 
1587  !Argument Variables
1588  TYPE(list_type), POINTER, INTENT(IN) :: LIST
1589  INTEGER(INTG), INTENT(IN) :: LIST_ITEM
1590  INTEGER(INTG), INTENT(OUT) :: ITEM
1591  INTEGER(INTG), INTENT(OUT) :: ERR
1592  TYPE(varying_string), INTENT(OUT) :: ERROR
1593  !Local Variables
1594  TYPE(varying_string) :: LOCAL_ERROR
1595 
1596  enters("LIST_ITEM_GET_INTG1",err,error,*999)
1597 
1598  IF(ASSOCIATED(list)) THEN
1599  IF(list%LIST_FINISHED) THEN
1600  IF(list%DATA_TYPE==list_intg_type) THEN
1601  IF(list_item>0.AND.list_item<=list%NUMBER_IN_LIST) THEN
1602  IF(list%DATA_DIMENSION==1) THEN
1603  item=list%LIST_INTG(list_item)
1604  ELSE
1605  local_error="Invalid item dimension. The specified item has dimension 1 and the list is of dimension "// &
1606  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))
1607  CALL flagerror(local_error,err,error,*999)
1608  ENDIF
1609  ELSE
1610  local_error="The specified list item position of "//trim(numbertovstring(list_item,"*",err,error))// &
1611  & " is invalid. The list item position must be > 0 and <= "// &
1612  & trim(numbertovstring(list%NUMBER_IN_LIST,"*",err,error))//"."
1613  CALL flagerror(local_error,err,error,*999)
1614  ENDIF
1615  ELSE
1616  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1617  & " does not match the integer type of the supplied list item."
1618  CALL flagerror(local_error,err,error,*999)
1619  ENDIF
1620  ELSE
1621  CALL flagerror("List has not been finished.",err,error,*999)
1622  ENDIF
1623  ELSE
1624  CALL flagerror("List is not associated.",err,error,*999)
1625  ENDIF
1626 
1627  exits("LIST_ITEM_GET_INTG1")
1628  RETURN
1629 999 errorsexits("LIST_ITEM_GET_INTG1",err,error)
1630  RETURN 1
1631  END SUBROUTINE list_item_get_intg1
1632 
1633  !
1634  !================================================================================================================================
1635  !
1636 
1638  SUBROUTINE list_item_get_intg2(LIST,LIST_ITEM,ITEM,ERR,ERROR,*)
1639 
1640  !Argument Variables
1641  TYPE(list_type), POINTER, INTENT(IN) :: LIST
1642  INTEGER(INTG), INTENT(IN) :: LIST_ITEM
1643  INTEGER(INTG), INTENT(OUT) :: ITEM(:)
1644  INTEGER(INTG), INTENT(OUT) :: ERR
1645  TYPE(varying_string), INTENT(OUT) :: ERROR
1646  !Local Variables
1647  TYPE(varying_string) :: LOCAL_ERROR
1648 
1649  enters("LIST_ITEM_GET_INTG2",err,error,*999)
1650 
1651  IF(ASSOCIATED(list)) THEN
1652  IF(list%LIST_FINISHED) THEN
1653  IF(list%DATA_TYPE==list_intg_type) THEN
1654  IF(list_item>0.AND.list_item<=list%NUMBER_IN_LIST) THEN
1655  IF(list%DATA_DIMENSION==SIZE(item,1)) THEN
1656  item=list%LIST_INTG2(:,list_item)
1657  ELSE
1658  local_error="Invalid item dimension. The specified item has dimension "// &
1659  & trim(numbertovstring(SIZE(item,1),"*",err,error))//" and the list is of dimension "// &
1660  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))
1661  CALL flagerror(local_error,err,error,*999)
1662  ENDIF
1663  ELSE
1664  local_error="The specified list item position of "//trim(numbertovstring(list_item,"*",err,error))// &
1665  & " is invalid. The list item position must be > 0 and <= "// &
1666  & trim(numbertovstring(list%NUMBER_IN_LIST,"*",err,error))//"."
1667  CALL flagerror(local_error,err,error,*999)
1668  ENDIF
1669  ELSE
1670  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1671  & " does not match the integer type of the supplied list item."
1672  CALL flagerror(local_error,err,error,*999)
1673  ENDIF
1674  ELSE
1675  CALL flagerror("List has not been finished.",err,error,*999)
1676  ENDIF
1677  ELSE
1678  CALL flagerror("List is not associated.",err,error,*999)
1679  ENDIF
1680 
1681  exits("LIST_ITEM_GET_INTG2")
1682  RETURN
1683 999 errorsexits("LIST_ITEM_GET_INTG2",err,error)
1684  RETURN 1
1685  END SUBROUTINE list_item_get_intg2
1686 
1687  !
1688  !================================================================================================================================
1689  !
1690 
1692  SUBROUTINE list_item_get_sp1(LIST,LIST_ITEM,ITEM,ERR,ERROR,*)
1693 
1694  !Argument Variables
1695  TYPE(list_type), POINTER, INTENT(IN) :: LIST
1696  INTEGER(INTG), INTENT(IN) :: LIST_ITEM
1697  REAL(SP), INTENT(OUT) :: ITEM
1698  INTEGER(INTG), INTENT(OUT) :: ERR
1699  TYPE(varying_string), INTENT(OUT) :: ERROR
1700  !Local Variables
1701  TYPE(varying_string) :: LOCAL_ERROR
1702 
1703  enters("LIST_ITEM_GET_SP1",err,error,*999)
1704 
1705  IF(ASSOCIATED(list)) THEN
1706  IF(list%LIST_FINISHED) THEN
1707  IF(list%DATA_TYPE==list_sp_type) THEN
1708  IF(list_item>0.AND.list_item<=list%NUMBER_IN_LIST) THEN
1709  IF(list%DATA_DIMENSION==1) THEN
1710  item=list%LIST_SP(list_item)
1711  ELSE
1712  local_error="Invalid item dimension. The specified item has dimension 1 and the list is of dimension "// &
1713  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))
1714  CALL flagerror(local_error,err,error,*999)
1715  ENDIF
1716  ELSE
1717  local_error="The specified list item position of "//trim(numbertovstring(list_item,"*",err,error))// &
1718  & " is invalid. The list item position must be > 0 and <= "// &
1719  & trim(numbertovstring(list%NUMBER_IN_LIST,"*",err,error))//"."
1720  CALL flagerror(local_error,err,error,*999)
1721  ENDIF
1722  ELSE
1723  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1724  & " does not match the single precision type of the supplied list item."
1725  CALL flagerror(local_error,err,error,*999)
1726  ENDIF
1727  ELSE
1728  CALL flagerror("List has not been finished.",err,error,*999)
1729  ENDIF
1730  ELSE
1731  CALL flagerror("List is not associated.",err,error,*999)
1732  ENDIF
1733 
1734  exits("LIST_ITEM_GET_SP1")
1735  RETURN
1736 999 errorsexits("LIST_ITEM_GET_SP1",err,error)
1737  RETURN 1
1738  END SUBROUTINE list_item_get_sp1
1739 
1740  !
1741  !================================================================================================================================
1742  !
1743 
1745  SUBROUTINE list_item_get_sp2(LIST,LIST_ITEM,ITEM,ERR,ERROR,*)
1746 
1747  !Argument Variables
1748  TYPE(list_type), POINTER, INTENT(IN) :: LIST
1749  INTEGER(INTG), INTENT(IN) :: LIST_ITEM
1750  REAL(SP), INTENT(OUT) :: ITEM(:)
1751  INTEGER(INTG), INTENT(OUT) :: ERR
1752  TYPE(varying_string), INTENT(OUT) :: ERROR
1753  !Local Variables
1754  TYPE(varying_string) :: LOCAL_ERROR
1755 
1756  enters("LIST_ITEM_GET_SP2",err,error,*999)
1757 
1758  IF(ASSOCIATED(list)) THEN
1759  IF(list%LIST_FINISHED) THEN
1760  IF(list%DATA_TYPE==list_sp_type) THEN
1761  IF(list_item>0.AND.list_item<=list%NUMBER_IN_LIST) THEN
1762  IF(list%DATA_DIMENSION==SIZE(item,1)) THEN
1763  item=list%LIST_SP2(:,list_item)
1764  ELSE
1765  local_error="Invalid item dimension. The specified item has dimension "// &
1766  & trim(numbertovstring(SIZE(item,1),"*",err,error))//" and the list is of dimension "// &
1767  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))
1768  CALL flagerror(local_error,err,error,*999)
1769  ENDIF
1770  ELSE
1771  local_error="The specified list item position of "//trim(numbertovstring(list_item,"*",err,error))// &
1772  & " is invalid. The list item position must be > 0 and <= "// &
1773  & trim(numbertovstring(list%NUMBER_IN_LIST,"*",err,error))//"."
1774  CALL flagerror(local_error,err,error,*999)
1775  ENDIF
1776  ELSE
1777  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1778  & " does not match the single precision type of the supplied list item."
1779  CALL flagerror(local_error,err,error,*999)
1780  ENDIF
1781  ELSE
1782  CALL flagerror("List has not been finished.",err,error,*999)
1783  ENDIF
1784  ELSE
1785  CALL flagerror("List is not associated.",err,error,*999)
1786  ENDIF
1787 
1788  exits("LIST_ITEM_GET_SP2")
1789  RETURN
1790 999 errorsexits("LIST_ITEM_GET_SP2",err,error)
1791  RETURN 1
1792  END SUBROUTINE list_item_get_sp2
1793 
1794  !
1795  !================================================================================================================================
1796  !
1797 
1799  SUBROUTINE list_item_get_dp1(LIST,LIST_ITEM,ITEM,ERR,ERROR,*)
1800 
1801  !Argument Variables
1802  TYPE(list_type), POINTER, INTENT(IN) :: LIST
1803  INTEGER(INTG), INTENT(IN) :: LIST_ITEM
1804  REAL(DP), INTENT(OUT) :: ITEM
1805  INTEGER(INTG), INTENT(OUT) :: ERR
1806  TYPE(varying_string), INTENT(OUT) :: ERROR
1807  !Local Variables
1808  TYPE(varying_string) :: LOCAL_ERROR
1809 
1810  enters("LIST_ITEM_GET_DP1",err,error,*999)
1811 
1812  IF(ASSOCIATED(list)) THEN
1813  IF(list%LIST_FINISHED) THEN
1814  IF(list%DATA_TYPE==list_dp_type) THEN
1815  IF(list_item>0.AND.list_item<=list%NUMBER_IN_LIST) THEN
1816  IF(list%DATA_DIMENSION==1) THEN
1817  item=list%LIST_DP(list_item)
1818  ELSE
1819  local_error="Invalid item dimension. The specified item has dimension 1 and the list is of dimension "// &
1820  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))
1821  CALL flagerror(local_error,err,error,*999)
1822  ENDIF
1823  ELSE
1824  local_error="The specified list item position of "//trim(numbertovstring(list_item,"*",err,error))// &
1825  & " is invalid. The list item position must be > 0 and <= "// &
1826  & trim(numbertovstring(list%NUMBER_IN_LIST,"*",err,error))//"."
1827  CALL flagerror(local_error,err,error,*999)
1828  ENDIF
1829  ELSE
1830  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1831  & " does not match the double precision type of the supplied list item."
1832  CALL flagerror(local_error,err,error,*999)
1833  ENDIF
1834  ELSE
1835  CALL flagerror("List has not been finished.",err,error,*999)
1836  ENDIF
1837  ELSE
1838  CALL flagerror("List is not associated.",err,error,*999)
1839  ENDIF
1840 
1841  exits("LIST_ITEM_GET_DP1")
1842  RETURN
1843 999 errorsexits("LIST_ITEM_GET_DP1",err,error)
1844  RETURN 1
1845  END SUBROUTINE list_item_get_dp1
1846 
1847  !
1848  !================================================================================================================================
1849  !
1850 
1852  SUBROUTINE list_item_get_dp2(LIST,LIST_ITEM,ITEM,ERR,ERROR,*)
1853 
1854  !Argument Variables
1855  TYPE(list_type), POINTER, INTENT(IN) :: LIST
1856  INTEGER(INTG), INTENT(IN) :: LIST_ITEM
1857  REAL(DP), INTENT(OUT) :: ITEM(:)
1858  INTEGER(INTG), INTENT(OUT) :: ERR
1859  TYPE(varying_string), INTENT(OUT) :: ERROR
1860  !Local Variables
1861  TYPE(varying_string) :: LOCAL_ERROR
1862 
1863  enters("LIST_ITEM_GET_DP2",err,error,*999)
1864 
1865  IF(ASSOCIATED(list)) THEN
1866  IF(list%LIST_FINISHED) THEN
1867  IF(list%DATA_TYPE==list_dp_type) THEN
1868  IF(list_item>0.AND.list_item<=list%NUMBER_IN_LIST) THEN
1869  IF(list%DATA_DIMENSION==SIZE(item,1)) THEN
1870  item=list%LIST_DP2(:,list_item)
1871  ELSE
1872  local_error="Invalid item dimension. The specified item has dimension "// &
1873  & trim(numbertovstring(SIZE(item,1),"*",err,error))//" and the list is of dimension "// &
1874  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))
1875  CALL flagerror(local_error,err,error,*999)
1876  ENDIF
1877  ELSE
1878  local_error="The specified list item position of "//trim(numbertovstring(list_item,"*",err,error))// &
1879  & " is invalid. The list item position must be > 0 and <= "// &
1880  & trim(numbertovstring(list%NUMBER_IN_LIST,"*",err,error))//"."
1881  CALL flagerror(local_error,err,error,*999)
1882  ENDIF
1883  ELSE
1884  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1885  & " does not match the double precision type of the supplied list item."
1886  CALL flagerror(local_error,err,error,*999)
1887  ENDIF
1888  ELSE
1889  CALL flagerror("List has not been finished.",err,error,*999)
1890  ENDIF
1891  ELSE
1892  CALL flagerror("List is not associated.",err,error,*999)
1893  ENDIF
1894 
1895  exits("LIST_ITEM_GET_DP2")
1896  RETURN
1897 999 errorsexits("LIST_ITEM_GET_DP2",err,error)
1898  RETURN 1
1899  END SUBROUTINE list_item_get_dp2
1900 
1901  !
1902  !================================================================================================================================
1903  !
1904 
1906  SUBROUTINE list_item_in_list_intg1(LIST,ITEM,LIST_ITEM,ERR,ERROR,*)
1907 
1908  !Argument Variables
1909  TYPE(list_type), POINTER, INTENT(IN) :: LIST
1910  INTEGER(INTG), INTENT(IN) :: ITEM
1911  INTEGER(INTG), INTENT(OUT) :: LIST_ITEM
1912  INTEGER(INTG), INTENT(OUT) :: ERR
1913  TYPE(varying_string), INTENT(OUT) :: ERROR
1914  !Local Variables
1915  TYPE(varying_string) :: LOCAL_ERROR
1916 
1917  enters("LIST_ITEM_IN_LIST_INTG1",err,error,*999)
1918 
1919  IF(ASSOCIATED(list)) THEN
1920  IF(list%LIST_FINISHED) THEN
1921  IF(list%DATA_TYPE==list_intg_type) THEN
1922 !!TODO: Could search better but requires list to be sorted.
1923  IF(list%DATA_DIMENSION==1) THEN
1924  CALL list_search_linear(list%LIST_INTG(1:list%NUMBER_IN_LIST),item,list_item,err,error,*999)
1925  ELSE
1926  CALL list_search_linear(list%LIST_INTG2(list%KEY_DIMENSION,1:list%NUMBER_IN_LIST),item,list_item,err,error,*999)
1927  ENDIF
1928  ELSE
1929  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1930  & " does not match the integer type of the supplied list item."
1931  CALL flagerror(local_error,err,error,*999)
1932  ENDIF
1933  ELSE
1934  CALL flagerror("List has not been finished.",err,error,*999)
1935  ENDIF
1936  ELSE
1937  CALL flagerror("List is not associated.",err,error,*999)
1938  ENDIF
1939 
1940  exits("LIST_ITEM_IN_LIST_INTG1")
1941  RETURN
1942 999 errorsexits("LIST_ITEM_IN_LIST_INTG1",err,error)
1943  RETURN 1
1944  END SUBROUTINE list_item_in_list_intg1
1945 
1946  !
1947  !================================================================================================================================
1948  !
1949 
1951  SUBROUTINE list_item_in_list_intg2(LIST,ITEM,LIST_ITEM,ERR,ERROR,*)
1952 
1953  !Argument Variables
1954  TYPE(list_type), POINTER, INTENT(IN) :: LIST
1955  INTEGER(INTG), INTENT(IN) :: ITEM(:)
1956  INTEGER(INTG), INTENT(OUT) :: LIST_ITEM
1957  INTEGER(INTG), INTENT(OUT) :: ERR
1958  TYPE(varying_string), INTENT(OUT) :: ERROR
1959  !Local Variables
1960  TYPE(varying_string) :: LOCAL_ERROR
1961 
1962  enters("LIST_ITEM_IN_LIST_INTG2",err,error,*999)
1963 
1964  IF(ASSOCIATED(list)) THEN
1965  IF(list%LIST_FINISHED) THEN
1966  IF(list%DATA_TYPE==list_intg_type) THEN
1967 !!TODO: Could search better but requires list to be sorted.
1968  IF(list%DATA_DIMENSION==1) THEN
1969  CALL list_search_linear(list%LIST_INTG(1:list%NUMBER_IN_LIST),item(list%KEY_DIMENSION),list_item,err,error,*999)
1970  ELSE
1971  CALL list_search_linear(list%LIST_INTG2(list%KEY_DIMENSION,1:list%NUMBER_IN_LIST),item(list%KEY_DIMENSION), &
1972  & list_item,err,error,*999)
1973  ENDIF
1974  ELSE
1975  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
1976  & " does not match the integer type of the supplied list item."
1977  CALL flagerror(local_error,err,error,*999)
1978  ENDIF
1979  ELSE
1980  CALL flagerror("List has not been finished.",err,error,*999)
1981  ENDIF
1982  ELSE
1983  CALL flagerror("List is not associated.",err,error,*999)
1984  ENDIF
1985 
1986  exits("LIST_ITEM_IN_LIST_INTG2")
1987  RETURN
1988 999 errorsexits("LIST_ITEM_IN_LIST_INTG2",err,error)
1989  RETURN 1
1990  END SUBROUTINE list_item_in_list_intg2
1991 
1992  !
1993  !================================================================================================================================
1994  !
1995 
1998  SUBROUTINE list_item_in_list_sp1(LIST,ITEM,LIST_ITEM,ERR,ERROR,*)
1999 
2000  !Argument Variables
2001  TYPE(list_type), POINTER, INTENT(IN) :: LIST
2002  REAL(SP), INTENT(IN) :: ITEM
2003  INTEGER(INTG), INTENT(OUT) :: LIST_ITEM
2004  INTEGER(INTG), INTENT(OUT) :: ERR
2005  TYPE(varying_string), INTENT(OUT) :: ERROR
2006  !Local Variables
2007  TYPE(varying_string) :: LOCAL_ERROR
2008 
2009  enters("LIST_ITEM_IN_LIST_SP1",err,error,*999)
2010 
2011  IF(ASSOCIATED(list)) THEN
2012  IF(list%LIST_FINISHED) THEN
2013  IF(list%DATA_TYPE==list_sp_type) THEN
2014 !!TODO: Could search better but requires list to be sorted.
2015  IF(list%DATA_DIMENSION==1) THEN
2016  CALL list_search_linear(list%LIST_SP(1:list%NUMBER_IN_LIST),item,list_item,err,error,*999)
2017  ELSE
2018  CALL list_search_linear(list%LIST_SP2(list%KEY_DIMENSION,1:list%NUMBER_IN_LIST),item,list_item,err,error,*999)
2019  ENDIF
2020  ELSE
2021  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
2022  & " does not match the single precision type of the supplied list item."
2023  CALL flagerror(local_error,err,error,*999)
2024  ENDIF
2025  ELSE
2026  CALL flagerror("List has not been finished.",err,error,*999)
2027  ENDIF
2028  ELSE
2029  CALL flagerror("List is not associated.",err,error,*999)
2030  ENDIF
2031 
2032  exits("LIST_ITEM_IN_LIST_SP1")
2033  RETURN
2034 999 errorsexits("LIST_ITEM_IN_LIST_SP1",err,error)
2035  RETURN 1
2036  END SUBROUTINE list_item_in_list_sp1
2037 
2038  !
2039  !================================================================================================================================
2040  !
2041 
2044  SUBROUTINE list_item_in_list_sp2(LIST,ITEM,LIST_ITEM,ERR,ERROR,*)
2045 
2046  !Argument Variables
2047  TYPE(list_type), POINTER, INTENT(IN) :: LIST
2048  REAL(SP), INTENT(IN) :: ITEM(:)
2049  INTEGER(INTG), INTENT(OUT) :: LIST_ITEM
2050  INTEGER(INTG), INTENT(OUT) :: ERR
2051  TYPE(varying_string), INTENT(OUT) :: ERROR
2052  !Local Variables
2053  TYPE(varying_string) :: LOCAL_ERROR
2054 
2055  enters("LIST_ITEM_IN_LIST_SP2",err,error,*999)
2056 
2057  IF(ASSOCIATED(list)) THEN
2058  IF(list%LIST_FINISHED) THEN
2059  IF(list%DATA_TYPE==list_sp_type) THEN
2060 !!TODO: Could search better but requires list to be sorted.
2061  IF(list%DATA_DIMENSION==1) THEN
2062  CALL list_search_linear(list%LIST_SP(1:list%NUMBER_IN_LIST),item(list%KEY_DIMENSION),list_item,err,error,*999)
2063  ELSE
2064  CALL list_search_linear(list%LIST_SP2(list%KEY_DIMENSION,1:list%NUMBER_IN_LIST),item(list%KEY_DIMENSION), &
2065  & list_item,err,error,*999)
2066  ENDIF
2067  ELSE
2068  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
2069  & " does not match the single precision type of the supplied list item."
2070  CALL flagerror(local_error,err,error,*999)
2071  ENDIF
2072  ELSE
2073  CALL flagerror("List has not been finished.",err,error,*999)
2074  ENDIF
2075  ELSE
2076  CALL flagerror("List is not associated.",err,error,*999)
2077  ENDIF
2078 
2079  exits("LIST_ITEM_IN_LIST_SP2")
2080  RETURN
2081 999 errorsexits("LIST_ITEM_IN_LIST_SP2",err,error)
2082  RETURN 1
2083  END SUBROUTINE list_item_in_list_sp2
2084 
2085  !
2086  !================================================================================================================================
2087  !
2088 
2091  SUBROUTINE list_item_in_list_dp1(LIST,ITEM,LIST_ITEM,ERR,ERROR,*)
2092 
2093  !Argument Variables
2094  TYPE(list_type), POINTER, INTENT(IN) :: LIST
2095  REAL(DP), INTENT(IN) :: ITEM
2096  INTEGER(INTG), INTENT(OUT) :: LIST_ITEM
2097  INTEGER(INTG), INTENT(OUT) :: ERR
2098  TYPE(varying_string), INTENT(OUT) :: ERROR
2099  !Local Variables
2100  TYPE(varying_string) :: LOCAL_ERROR
2101 
2102  enters("LIST_ITEM_IN_LIST_DP1",err,error,*999)
2103 
2104  IF(ASSOCIATED(list)) THEN
2105  IF(list%LIST_FINISHED) THEN
2106  IF(list%DATA_TYPE==list_dp_type) THEN
2107 !!TODO: Could search better but requires list to be sorted.
2108  IF(list%DATA_DIMENSION==1) THEN
2109  CALL list_search_linear(list%LIST_DP(1:list%NUMBER_IN_LIST),item,list_item,err,error,*999)
2110  ELSE
2111  CALL list_search_linear(list%LIST_DP2(list%KEY_DIMENSION,1:list%NUMBER_IN_LIST),item,list_item,err,error,*999)
2112  ENDIF
2113  ELSE
2114  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
2115  & " does not match the single precision type of the supplied list item."
2116  CALL flagerror(local_error,err,error,*999)
2117  ENDIF
2118  ELSE
2119  CALL flagerror("List has not been finished.",err,error,*999)
2120  ENDIF
2121  ELSE
2122  CALL flagerror("List is not associated.",err,error,*999)
2123  ENDIF
2124 
2125  exits("LIST_ITEM_IN_LIST_DP1")
2126  RETURN
2127 999 errorsexits("LIST_ITEM_IN_LIST_DP1",err,error)
2128  RETURN 1
2129  END SUBROUTINE list_item_in_list_dp1
2130 
2131  !
2132  !================================================================================================================================
2133  !
2134 
2137  SUBROUTINE list_item_in_list_dp2(LIST,ITEM,LIST_ITEM,ERR,ERROR,*)
2138 
2139  !Argument Variables
2140  TYPE(list_type), POINTER, INTENT(IN) :: LIST
2141  REAL(DP), INTENT(IN) :: ITEM(:)
2142  INTEGER(INTG), INTENT(OUT) :: LIST_ITEM
2143  INTEGER(INTG), INTENT(OUT) :: ERR
2144  TYPE(varying_string), INTENT(OUT) :: ERROR
2145  !Local Variables
2146  TYPE(varying_string) :: LOCAL_ERROR
2147 
2148  enters("LIST_ITEM_IN_LIST_DP2",err,error,*999)
2149 
2150  IF(ASSOCIATED(list)) THEN
2151  IF(list%LIST_FINISHED) THEN
2152  IF(list%DATA_TYPE==list_dp_type) THEN
2153 !!TODO: Could search better but requires list to be sorted.
2154  IF(list%DATA_DIMENSION==1) THEN
2155  CALL list_search_linear(list%LIST_DP(1:list%NUMBER_IN_LIST),item(list%KEY_DIMENSION),list_item,err,error,*999)
2156  ELSE
2157  CALL list_search_linear(list%LIST_DP2(list%KEY_DIMENSION,1:list%NUMBER_IN_LIST),item(list%KEY_DIMENSION), &
2158  & list_item,err,error,*999)
2159  ENDIF
2160  ELSE
2161  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
2162  & " does not match the single precision type of the supplied list item."
2163  CALL flagerror(local_error,err,error,*999)
2164  ENDIF
2165  ELSE
2166  CALL flagerror("List has not been finished.",err,error,*999)
2167  ENDIF
2168  ELSE
2169  CALL flagerror("List is not associated.",err,error,*999)
2170  ENDIF
2171 
2172  exits("LIST_ITEM_IN_LIST_DP2")
2173  RETURN
2174 999 errorsexits("LIST_ITEM_IN_LIST_DP2",err,error)
2175  RETURN 1
2176  END SUBROUTINE list_item_in_list_dp2
2177 
2178  !
2179  !================================================================================================================================
2180  !
2181 
2183  SUBROUTINE list_item_delete(LIST,LIST_ITEM,ERR,ERROR,*)
2184 
2185  !Argument Variables
2186  TYPE(list_type), POINTER, INTENT(IN) :: LIST
2187  INTEGER(INTG), INTENT(IN) :: LIST_ITEM
2188  INTEGER(INTG), INTENT(OUT) :: ERR
2189  TYPE(varying_string), INTENT(OUT) :: ERROR
2190  !Local Variables
2191  TYPE(varying_string) :: LOCAL_ERROR
2192 
2193  enters("LIST_ITEM_DELETE",err,error,*999)
2194 
2195  IF(ASSOCIATED(list)) THEN
2196  IF(list%LIST_FINISHED) THEN
2197  IF(list_item>=1.AND.list_item<=list%NUMBER_IN_LIST) THEN
2198  IF(list%DATA_DIMENSION==1) THEN
2199  SELECT CASE(list%DATA_TYPE)
2200  CASE(list_intg_type)
2201  list%LIST_INTG(1:list_item-1)=list%LIST_INTG(1:list_item-1)
2202  list%LIST_INTG(list_item:list%NUMBER_IN_LIST-1)=list%LIST_INTG(list_item+1:list%NUMBER_IN_LIST)
2203  CASE(list_sp_type)
2204  list%LIST_SP(1:list_item-1)=list%LIST_SP(1:list_item-1)
2205  list%LIST_SP(list_item:list%NUMBER_IN_LIST-1)=list%LIST_SP(list_item+1:list%NUMBER_IN_LIST)
2206  CASE(list_dp_type)
2207  list%LIST_DP(1:list_item-1)=list%LIST_DP(1:list_item-1)
2208  list%LIST_DP(list_item:list%NUMBER_IN_LIST-1)=list%LIST_DP(list_item+1:list%NUMBER_IN_LIST)
2209  CASE DEFAULT
2210  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))//" is invalid."
2211  CALL flagerror(local_error,err,error,*999)
2212  END SELECT
2213  ELSE
2214  SELECT CASE(list%DATA_TYPE)
2215  CASE(list_intg_type)
2216  list%LIST_INTG2(:,1:list_item-1)=list%LIST_INTG2(:,1:list_item-1)
2217  list%LIST_INTG2(:,list_item:list%NUMBER_IN_LIST-1)=list%LIST_INTG2(:,list_item+1:list%NUMBER_IN_LIST)
2218  CASE(list_sp_type)
2219  list%LIST_SP2(:,1:list_item-1)=list%LIST_SP2(:,1:list_item-1)
2220  list%LIST_SP2(:,list_item:list%NUMBER_IN_LIST-1)=list%LIST_SP2(:,list_item+1:list%NUMBER_IN_LIST)
2221  CASE(list_dp_type)
2222  list%LIST_DP2(:,1:list_item-1)=list%LIST_DP2(:,1:list_item-1)
2223  list%LIST_DP2(:,list_item:list%NUMBER_IN_LIST-1)=list%LIST_DP2(:,list_item+1:list%NUMBER_IN_LIST)
2224  CASE DEFAULT
2225  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))//" is invalid."
2226  CALL flagerror(local_error,err,error,*999)
2227  END SELECT
2228  ENDIF
2229  list%NUMBER_IN_LIST=list%NUMBER_IN_LIST-1
2230  ELSE
2231  local_error="The specified list item of "//trim(numbertovstring(list_item,"*",err,error))// &
2232  & " is invalid. The item must be >= 1 and <= "//trim(numbertovstring(list%NUMBER_IN_LIST,"*",err,error))//"."
2233  CALL flagerror(local_error,err,error,*999)
2234  ENDIF
2235  ELSE
2236  CALL flagerror("List has not been finished.",err,error,*999)
2237  ENDIF
2238  ELSE
2239  CALL flagerror("List is not associated.",err,error,*999)
2240  ENDIF
2241 
2242  exits("LIST_ITEM_DELETE")
2243  RETURN
2244 999 errorsexits("LIST_ITEM_DELETE",err,error)
2245  RETURN 1
2246  END SUBROUTINE list_item_delete
2247 
2248  !
2249  !================================================================================================================================
2250  !
2251 
2253  SUBROUTINE list_key_dimension_set(LIST,KEY_DIMENSION,ERR,ERROR,*)
2254 
2255  !Argument Variables
2256  TYPE(list_type), POINTER, INTENT(IN) :: LIST
2257  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
2258  INTEGER(INTG), INTENT(OUT) :: ERR
2259  TYPE(varying_string), INTENT(OUT) :: ERROR
2260  !Local Variables
2261  TYPE(varying_string) :: LOCAL_ERROR
2262 
2263  enters("LIST_KEY_DIMENSION_SET",err,error,*999)
2264 
2265  IF(ASSOCIATED(list)) THEN
2266  IF(key_dimension>0.AND.key_dimension<=list%DATA_DIMENSION) THEN
2267  list%KEY_DIMENSION=key_dimension
2268  ELSE
2269  local_error="The specified key dimension of "//trim(numbertovstring(key_dimension,"*",err,error))// &
2270  & " is invalid. The key dimension must be > 0 and <= "// &
2271  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
2272  CALL flagerror(local_error,err,error,*999)
2273  ENDIF
2274  ELSE
2275  CALL flagerror("List is not associated.",err,error,*999)
2276  ENDIF
2277 
2278  exits("LIST_KEY_DIMENSION_SET")
2279  RETURN
2280 999 errorsexits("LIST_KEY_DIMENSION_SET",err,error)
2281  RETURN 1
2282  END SUBROUTINE list_key_dimension_set
2283 
2284  !
2285  !================================================================================================================================
2286  !
2287 
2289  SUBROUTINE list_number_of_items_get(LIST,NUMBER_OF_ITEMS,ERR,ERROR,*)
2290 
2291  !Argument variables
2292  TYPE(list_type), POINTER, INTENT(IN) :: LIST
2293  INTEGER(INTG), INTENT(OUT) :: NUMBER_OF_ITEMS
2294  INTEGER(INTG), INTENT(OUT) :: ERR
2295  TYPE(varying_string), INTENT(OUT) :: ERROR
2296  !Local variables
2297 
2298  enters("LIST_NUMBER_OF_ITEMS_GET",err,error,*999)
2299 
2300  IF(ASSOCIATED(list)) THEN
2301  IF(list%LIST_FINISHED) THEN
2302  number_of_items=list%NUMBER_IN_LIST
2303  ELSE
2304  CALL flagerror("List has not been finished.",err,error,*999)
2305  ENDIF
2306  ELSE
2307  CALL flagerror("List is not associated.",err,error,*999)
2308  ENDIF
2309 
2310  exits("LIST_NUMBER_OF_ITEMS_GET")
2311  RETURN
2312 999 errorsexits("LIST_NUMBER_OF_ITEMS_GET",err,error)
2313  RETURN 1
2314  END SUBROUTINE list_number_of_items_get
2315 
2316  !
2317  !================================================================================================================================
2318  !
2319 
2323  SUBROUTINE list_detach_and_destroy_intg1(LIST,NUMBER_IN_LIST,LIST_VALUES,ERR,ERROR,*)
2324 
2325  !Argument Variables
2326  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
2327  INTEGER(INTG), INTENT(OUT) :: NUMBER_IN_LIST
2328  INTEGER(INTG), ALLOCATABLE, INTENT(INOUT) :: LIST_VALUES(:)
2329  INTEGER(INTG), INTENT(OUT) :: ERR
2330  TYPE(varying_string), INTENT(OUT) :: ERROR
2331  !Local Variables
2332  TYPE(varying_string) :: LOCAL_ERROR
2333 
2334  enters("LIST_DETACH_AND_DESTROY_INTG1",err,error,*999)
2335 
2336  IF(ASSOCIATED(list)) THEN
2337  IF(list%LIST_FINISHED) THEN
2338  IF(ALLOCATED(list_values)) THEN
2339  CALL flagerror("List values is allocated.",err,error,*999)
2340  ELSE
2341  IF(list%DATA_TYPE==list_intg_type) THEN
2342  IF(list%DATA_DIMENSION==1) THEN
2343  number_in_list=list%NUMBER_IN_LIST
2344  !Note this will return more memory as the list will be bigger. Maybe copy to an array the correct size?
2345  CALL move_alloc(list%LIST_INTG,list_values)
2346  CALL list_finalise(list,err,error,*999)
2347  ELSE
2348  local_error="Invalid data dimension. The supplied data dimension is 1 and the list data dimension is "// &
2349  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
2350  CALL flagerror(local_error,err,error,*999)
2351  ENDIF
2352  ELSE
2353  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
2354  & " does not match the integer type of the supplied list values item."
2355  CALL flagerror(local_error,err,error,*999)
2356  ENDIF
2357  ENDIF
2358  ELSE
2359  CALL flagerror("List has not been finished.",err,error,*999)
2360  ENDIF
2361  ELSE
2362  CALL flagerror("List is not associated.",err,error,*999)
2363  ENDIF
2364 
2365  exits("LIST_DETACH_AND_DESTROY_INTG1")
2366  RETURN
2367 999 errorsexits("LIST_DETACH_AND_DESTROY_INTG1",err,error)
2368  RETURN 1
2369  END SUBROUTINE list_detach_and_destroy_intg1
2370 
2371  !
2372  !================================================================================================================================
2373  !
2374 
2378  SUBROUTINE list_detach_and_destroy_intg2(LIST,NUMBER_IN_LIST,LIST_VALUES,ERR,ERROR,*)
2379 
2380  !Argument Variables
2381  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
2382  INTEGER(INTG), INTENT(OUT) :: NUMBER_IN_LIST
2383  INTEGER(INTG), ALLOCATABLE, INTENT(INOUT) :: LIST_VALUES(:,:)
2384  INTEGER(INTG), INTENT(OUT) :: ERR
2385  TYPE(varying_string), INTENT(OUT) :: ERROR
2386  !Local Variables
2387  TYPE(varying_string) :: LOCAL_ERROR
2388 
2389  enters("LIST_DETACH_AND_DESTROY_INTG2",err,error,*999)
2390 
2391  IF(ASSOCIATED(list)) THEN
2392  IF(list%LIST_FINISHED) THEN
2393  IF(ALLOCATED(list_values)) THEN
2394  CALL flagerror("List values is allocated.",err,error,*999)
2395  ELSE
2396  IF(list%DATA_TYPE==list_intg_type) THEN
2397  IF(list%DATA_DIMENSION>1) THEN
2398  number_in_list=list%NUMBER_IN_LIST
2399  !Note this will return more memory as the list will be bigger. Maybe copy to an array the correct size?
2400  CALL move_alloc(list%LIST_INTG2,list_values)
2401  CALL list_finalise(list,err,error,*999)
2402  ELSE
2403  CALL flagerror("Invalid data dimension. The supplied data dimension is > 1 and the list data dimension is 1.", &
2404  & err,error,*999)
2405  ENDIF
2406  ELSE
2407  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
2408  & " does not match the integer type of the supplied list values item."
2409  CALL flagerror(local_error,err,error,*999)
2410  ENDIF
2411  ENDIF
2412  ELSE
2413  CALL flagerror("List has not been finished.",err,error,*999)
2414  ENDIF
2415  ELSE
2416  CALL flagerror("List is not associated.",err,error,*999)
2417  ENDIF
2418 
2419  exits("LIST_DETACH_AND_DESTROY_INTG2")
2420  RETURN
2421 999 errorsexits("LIST_DETACH_AND_DESTROY_INTG2",err,error)
2422  RETURN 1
2423  END SUBROUTINE list_detach_and_destroy_intg2
2424 
2425  !
2426  !================================================================================================================================
2427  !
2428 
2432  SUBROUTINE list_detach_and_destroy_sp1(LIST,NUMBER_IN_LIST,LIST_VALUES,ERR,ERROR,*)
2433 
2434  !Argument Variables
2435  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
2436  INTEGER(INTG), INTENT(OUT) :: NUMBER_IN_LIST
2437  REAL(SP), ALLOCATABLE, INTENT(INOUT) :: LIST_VALUES(:)
2438  INTEGER(INTG), INTENT(OUT) :: ERR
2439  TYPE(varying_string), INTENT(OUT) :: ERROR
2440  !Local Variables
2441  TYPE(varying_string) :: LOCAL_ERROR
2442 
2443  enters("LIST_DETACH_AND_DESTROY_SP1",err,error,*999)
2444 
2445  IF(ASSOCIATED(list)) THEN
2446  IF(list%LIST_FINISHED) THEN
2447  IF(ALLOCATED(list_values)) THEN
2448  CALL flagerror("List values is associated.",err,error,*999)
2449  ELSE
2450  IF(list%DATA_TYPE==list_sp_type) THEN
2451  IF(list%DATA_DIMENSION==1) THEN
2452  number_in_list=list%NUMBER_IN_LIST
2453  !Note this will return more memory as the list will be bigger. Maybe copy to an array the correct size?
2454  CALL move_alloc(list%LIST_SP,list_values)
2455  CALL list_finalise(list,err,error,*999)
2456  ELSE
2457  local_error="Invalid data dimension. The supplied data dimension is 1 and the list data dimension is "// &
2458  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
2459  CALL flagerror(local_error,err,error,*999)
2460  ENDIF
2461  ELSE
2462  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
2463  & " does not match the single precision type of the supplied list values item."
2464  CALL flagerror(local_error,err,error,*999)
2465  ENDIF
2466  ENDIF
2467  ELSE
2468  CALL flagerror("List has not been finished.",err,error,*999)
2469  ENDIF
2470  ELSE
2471  CALL flagerror("List is not associated.",err,error,*999)
2472  ENDIF
2473 
2474  exits("LIST_DETACH_AND_DESTROY_SP1")
2475  RETURN
2476 999 errorsexits("LIST_DETACH_AND_DESTROY_SP1",err,error)
2477  RETURN 1
2478  END SUBROUTINE list_detach_and_destroy_sp1
2479  !
2480  !================================================================================================================================
2481  !
2482 
2486  SUBROUTINE list_detach_and_destroy_sp2(LIST,NUMBER_IN_LIST,LIST_VALUES,ERR,ERROR,*)
2487 
2488  !Argument Variables
2489  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
2490  INTEGER(INTG), INTENT(OUT) :: NUMBER_IN_LIST
2491  REAL(SP), ALLOCATABLE, INTENT(INOUT) :: LIST_VALUES(:,:)
2492  INTEGER(INTG), INTENT(OUT) :: ERR
2493  TYPE(varying_string), INTENT(OUT) :: ERROR
2494  !Local Variables
2495  TYPE(varying_string) :: LOCAL_ERROR
2496 
2497  enters("LIST_DETACH_AND_DESTROY_SP2",err,error,*999)
2498 
2499  IF(ASSOCIATED(list)) THEN
2500  IF(list%LIST_FINISHED) THEN
2501  IF(ALLOCATED(list_values)) THEN
2502  CALL flagerror("List values is associated.",err,error,*999)
2503  ELSE
2504  IF(list%DATA_TYPE==list_sp_type) THEN
2505  IF(list%DATA_DIMENSION>1) THEN
2506  number_in_list=list%NUMBER_IN_LIST
2507  !Note this will return more memory as the list will be bigger. Maybe copy to an array the correct size?
2508  CALL move_alloc(list%LIST_SP2,list_values)
2509  CALL list_finalise(list,err,error,*999)
2510  ELSE
2511  CALL flagerror("Invalid data dimension. The supplied data dimension is > 1 and the list data dimension is 1.", &
2512  & err,error,*999)
2513  ENDIF
2514  ELSE
2515  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
2516  & " does not match the single precision type of the supplied list values item."
2517  CALL flagerror(local_error,err,error,*999)
2518  ENDIF
2519  ENDIF
2520  ELSE
2521  CALL flagerror("List has not been finished.",err,error,*999)
2522  ENDIF
2523  ELSE
2524  CALL flagerror("List is not associated.",err,error,*999)
2525  ENDIF
2526 
2527  exits("LIST_DETACH_AND_DESTROY_SP2")
2528  RETURN
2529 999 errorsexits("LIST_DETACH_AND_DESTROY_SP2",err,error)
2530  RETURN 1
2531  END SUBROUTINE list_detach_and_destroy_sp2
2532 
2533  !
2534  !================================================================================================================================
2535  !
2536 
2540  SUBROUTINE list_detach_and_destroy_dp1(LIST,NUMBER_IN_LIST,LIST_VALUES,ERR,ERROR,*)
2541 
2542  !Argument Variables
2543  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
2544  INTEGER(INTG), INTENT(OUT) :: NUMBER_IN_LIST
2545  REAL(DP), ALLOCATABLE, INTENT(INOUT) :: LIST_VALUES(:)
2546  INTEGER(INTG), INTENT(OUT) :: ERR
2547  TYPE(varying_string), INTENT(OUT) :: ERROR
2548  !Local Variables
2549  TYPE(varying_string) :: LOCAL_ERROR
2550 
2551  enters("LIST_DETACH_AND_DESTROY_DP1",err,error,*999)
2552 
2553  IF(ASSOCIATED(list)) THEN
2554  IF(list%LIST_FINISHED) THEN
2555  IF(ALLOCATED(list_values)) THEN
2556  CALL flagerror("List values is associated.",err,error,*999)
2557  ELSE
2558  IF(list%DATA_TYPE==list_dp_type) THEN
2559  IF(list%DATA_DIMENSION==1) THEN
2560  number_in_list=list%NUMBER_IN_LIST
2561  !Note this will return more memory as the list will be bigger. Maybe copy to an array the correct size?
2562  CALL move_alloc(list%LIST_DP,list_values)
2563  CALL list_finalise(list,err,error,*999)
2564  ELSE
2565  local_error="Invalid data dimension. The supplied data dimension is 1 and the list data dimension is "// &
2566  & trim(numbertovstring(list%DATA_DIMENSION,"*",err,error))//"."
2567  CALL flagerror(local_error,err,error,*999)
2568  ENDIF
2569  ELSE
2570  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
2571  & " does not match the double precision type of the supplied list values item."
2572  CALL flagerror(local_error,err,error,*999)
2573  ENDIF
2574  ENDIF
2575  ELSE
2576  CALL flagerror("List has not been finished.",err,error,*999)
2577  ENDIF
2578  ELSE
2579  CALL flagerror("List is not associated.",err,error,*999)
2580  ENDIF
2581 
2582  exits("LIST_DETACH_AND_DESTROY_DP1")
2583  RETURN
2584 999 errorsexits("LIST_DETACH_AND_DESTROY_DP1",err,error)
2585  RETURN 1
2586  END SUBROUTINE list_detach_and_destroy_dp1
2587 
2588  !
2589  !================================================================================================================================
2590  !
2591 
2595  SUBROUTINE list_detach_and_destroy_dp2(LIST,NUMBER_IN_LIST,LIST_VALUES,ERR,ERROR,*)
2596 
2597  !Argument Variables
2598  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
2599  INTEGER(INTG), INTENT(OUT) :: NUMBER_IN_LIST
2600  REAL(DP), ALLOCATABLE, INTENT(INOUT) :: LIST_VALUES(:,:)
2601  INTEGER(INTG), INTENT(OUT) :: ERR
2602  TYPE(varying_string), INTENT(OUT) :: ERROR
2603  !Local Variables
2604  TYPE(varying_string) :: LOCAL_ERROR
2605 
2606  enters("LIST_DETACH_AND_DESTROY_DP2",err,error,*999)
2607 
2608  IF(ASSOCIATED(list)) THEN
2609  IF(list%LIST_FINISHED) THEN
2610  IF(ALLOCATED(list_values)) THEN
2611  CALL flagerror("List values is associated.",err,error,*999)
2612  ELSE
2613  IF(list%DATA_TYPE==list_dp_type) THEN
2614  IF(list%DATA_DIMENSION>1) THEN
2615  number_in_list=list%NUMBER_IN_LIST
2616  !Note this will return more memory as the list will be bigger. Maybe copy to an array the correct size?
2617  CALL move_alloc(list%LIST_DP2,list_values)
2618  CALL list_finalise(list,err,error,*999)
2619  ELSE
2620  CALL flagerror("Invalid data dimension. The supplied data dimension is > 1 and the list data dimension is 1.", &
2621  & err,error,*999)
2622  ENDIF
2623  ELSE
2624  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))// &
2625  & " does not match the double precision type of the supplied list values item."
2626  CALL flagerror(local_error,err,error,*999)
2627  ENDIF
2628  ENDIF
2629  ELSE
2630  CALL flagerror("List has not been finished.",err,error,*999)
2631  ENDIF
2632  ELSE
2633  CALL flagerror("List is not associated.",err,error,*999)
2634  ENDIF
2635 
2636  exits("LIST_DETACH_AND_DESTROY_DP2")
2637  RETURN
2638 999 errorsexits("LIST_DETACH_AND_DESTROY_DP2",err,error)
2639  RETURN 1
2640  END SUBROUTINE list_detach_and_destroy_dp2
2641 
2642  !
2643  !================================================================================================================================
2644  !
2645 
2647  SUBROUTINE list_remove_duplicates(LIST,ERR,ERROR,*)
2648 
2649  !Argument Variables
2650  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
2651  INTEGER(INTG), INTENT(OUT) :: ERR
2652  TYPE(varying_string), INTENT(OUT) :: ERROR
2653  !Local Variables
2654  INTEGER(INTG) :: i,j,NUMBER_REMOVED
2655  LOGICAL :: SAME_VALUE
2656  TYPE(varying_string) :: LOCAL_ERROR
2657 
2658  enters("LIST_REMOVE_DUPLICATES",err,error,*999)
2659 
2660  IF(ASSOCIATED(list)) THEN
2661  IF(list%LIST_FINISHED) THEN
2662  IF(list%NUMBER_IN_LIST>0) THEN
2663  IF(list%DATA_DIMENSION==1) THEN
2664  SELECT CASE(list%DATA_TYPE)
2665  CASE(list_intg_type)
2666  CALL list_sort(list%LIST_INTG(1:list%NUMBER_IN_LIST),err,error,*999)
2667  i=1
2668  DO WHILE(i<=list%NUMBER_IN_LIST)
2669  !Find the extent of duplicate values if any
2670  j=i+1
2671  same_value=.true.
2672  DO WHILE(j<=list%NUMBER_IN_LIST.AND.same_value)
2673  IF(list%LIST_INTG(j)==list%LIST_INTG(i)) THEN
2674  j=j+1
2675  ELSE
2676  same_value=.false.
2677  ENDIF
2678  ENDDO !j
2679  IF(j>i+1.OR.same_value) THEN
2680  !We have duplicates so remove them
2681  IF(same_value) THEN
2682  !Duplicates to the end of the list so just set the number in the list
2683  list%NUMBER_IN_LIST=i
2684  ELSE
2685  number_removed=j-i-1
2686  list%LIST_INTG(i+1:list%NUMBER_IN_LIST-number_removed)=list%LIST_INTG(j:list%NUMBER_IN_LIST)
2687  list%NUMBER_IN_LIST=list%NUMBER_IN_LIST-number_removed
2688  ENDIF
2689  ENDIF
2690  i=i+1
2691  ENDDO !i
2692  CASE(list_sp_type)
2693  CALL list_sort(list%LIST_SP(1:list%NUMBER_IN_LIST),err,error,*999)
2694  i=1
2695  DO WHILE(i<=list%NUMBER_IN_LIST)
2696  !Find the extent of duplicate values if any
2697  j=i+1
2698  same_value=.true.
2699  DO WHILE(j<=list%NUMBER_IN_LIST.AND.same_value)
2700  IF(abs(list%LIST_SP(j)-list%LIST_SP(i))<=zero_tolerance_sp) THEN
2701  j=j+1
2702  ELSE
2703  same_value=.false.
2704  ENDIF
2705  ENDDO !j
2706  IF(j>i+1.OR.same_value) THEN
2707  !We have duplicates so remove them
2708  IF(same_value) THEN
2709  !Duplicates to the end of the list so just set the number in the list
2710  list%NUMBER_IN_LIST=i
2711  ELSE
2712  number_removed=j-i-1
2713  list%LIST_SP(i+1:list%NUMBER_IN_LIST-number_removed)=list%LIST_SP(j:list%NUMBER_IN_LIST)
2714  list%NUMBER_IN_LIST=list%NUMBER_IN_LIST-number_removed
2715  ENDIF
2716  ENDIF
2717  i=i+1
2718  ENDDO !i
2719  CASE(list_dp_type)
2720  CALL list_sort(list%LIST_DP(1:list%NUMBER_IN_LIST),err,error,*999)
2721  i=1
2722  DO WHILE(i<=list%NUMBER_IN_LIST)
2723  !Find the extent of duplicate values if any
2724  j=i+1
2725  same_value=.true.
2726  DO WHILE(j<=list%NUMBER_IN_LIST.AND.same_value)
2727  IF(abs(list%LIST_DP(j)-list%LIST_DP(i))<=zero_tolerance) THEN
2728  j=j+1
2729  ELSE
2730  same_value=.false.
2731  ENDIF
2732  ENDDO !j
2733  IF(j>i+1.OR.same_value) THEN
2734  !We have duplicates so remove them
2735  IF(same_value) THEN
2736  !Duplicates to the end of the list so just set the number in the list
2737  list%NUMBER_IN_LIST=i
2738  ELSE
2739  number_removed=j-i-1
2740  list%LIST_DP(i+1:list%NUMBER_IN_LIST-number_removed)=list%LIST_DP(j:list%NUMBER_IN_LIST)
2741  list%NUMBER_IN_LIST=list%NUMBER_IN_LIST-number_removed
2742  ENDIF
2743  ENDIF
2744  i=i+1
2745  ENDDO !i
2746  CASE DEFAULT
2747  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))//" is invalid."
2748  CALL flagerror(local_error,err,error,*999)
2749  END SELECT
2750  ELSE
2751  SELECT CASE(list%DATA_TYPE)
2752  CASE(list_intg_type)
2753  CALL list_sort(list%LIST_INTG2(:,1:list%NUMBER_IN_LIST),list%KEY_DIMENSION,err,error,*999)
2754  i=1
2755  DO WHILE(i<=list%NUMBER_IN_LIST)
2756  !Find the extent of duplicate values if any
2757  j=i+1
2758  same_value=.true.
2759  DO WHILE(j<=list%NUMBER_IN_LIST.AND.same_value)
2760  IF(list%LIST_INTG2(list%KEY_DIMENSION,j)==list%LIST_INTG2(list%KEY_DIMENSION,i)) THEN
2761  j=j+1
2762  ELSE
2763  same_value=.false.
2764  ENDIF
2765  ENDDO !j
2766  IF(j>i+1.OR.same_value) THEN
2767  !We have duplicates so remove them
2768  IF(same_value) THEN
2769  !Duplicates to the end of the list so just set the number in the list
2770  list%NUMBER_IN_LIST=i
2771  ELSE
2772  number_removed=j-i-1
2773  list%LIST_INTG2(:,i+1:list%NUMBER_IN_LIST-number_removed)=list%LIST_INTG2(:,j:list%NUMBER_IN_LIST)
2774  list%NUMBER_IN_LIST=list%NUMBER_IN_LIST-number_removed
2775  ENDIF
2776  ENDIF
2777  i=i+1
2778  ENDDO !i
2779  CASE(list_sp_type)
2780  CALL list_sort(list%LIST_SP2(:,1:list%NUMBER_IN_LIST),list%KEY_DIMENSION,err,error,*999)
2781  i=1
2782  DO WHILE(i<=list%NUMBER_IN_LIST)
2783  !Find the extent of duplicate values if any
2784  j=i+1
2785  same_value=.true.
2786  DO WHILE(j<=list%NUMBER_IN_LIST.AND.same_value)
2787  IF(abs(list%LIST_SP2(list%KEY_DIMENSION,j)-list%LIST_SP2(list%KEY_DIMENSION,i))<=zero_tolerance_sp) THEN
2788  j=j+1
2789  ELSE
2790  same_value=.false.
2791  ENDIF
2792  ENDDO !j
2793  IF(j>i+1.OR.same_value) THEN
2794  !We have duplicates so remove them
2795  IF(same_value) THEN
2796  !Duplicates to the end of the list so just set the number in the list
2797  list%NUMBER_IN_LIST=i
2798  ELSE
2799  number_removed=j-i-1
2800  list%LIST_SP2(:,i+1:list%NUMBER_IN_LIST-number_removed)=list%LIST_SP2(:,j:list%NUMBER_IN_LIST)
2801  list%NUMBER_IN_LIST=list%NUMBER_IN_LIST-number_removed
2802  ENDIF
2803  ENDIF
2804  i=i+1
2805  ENDDO !i
2806  CASE(list_dp_type)
2807  CALL list_sort(list%LIST_DP2(:,1:list%NUMBER_IN_LIST),list%KEY_DIMENSION,err,error,*999)
2808  i=1
2809  DO WHILE(i<=list%NUMBER_IN_LIST)
2810  !Find the extent of duplicate values if any
2811  j=i+1
2812  same_value=.true.
2813  DO WHILE(j<=list%NUMBER_IN_LIST.AND.same_value)
2814  IF(abs(list%LIST_DP2(list%KEY_DIMENSION,j)-list%LIST_DP2(list%KEY_DIMENSION,i))<=zero_tolerance) THEN
2815  j=j+1
2816  ELSE
2817  same_value=.false.
2818  ENDIF
2819  ENDDO !j
2820  IF(j>i+1.OR.same_value) THEN
2821  !We have duplicates so remove them
2822  IF(same_value) THEN
2823  !Duplicates to the end of the list so just set the number in the list
2824  list%NUMBER_IN_LIST=i
2825  ELSE
2826  number_removed=j-i-1
2827  list%LIST_DP2(:,i+1:list%NUMBER_IN_LIST-number_removed)=list%LIST_DP2(:,j:list%NUMBER_IN_LIST)
2828  list%NUMBER_IN_LIST=list%NUMBER_IN_LIST-number_removed
2829  ENDIF
2830  ENDIF
2831  i=i+1
2832  ENDDO !i
2833  CASE DEFAULT
2834  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))//" is invalid."
2835  CALL flagerror(local_error,err,error,*999)
2836  END SELECT
2837  ENDIF
2838  ENDIF
2839  ELSE
2840  CALL flagerror("List has not been finished.",err,error,*999)
2841  ENDIF
2842  ELSE
2843  CALL flagerror("List is not associated.",err,error,*999)
2844  ENDIF
2845 
2846  exits("LIST_REMOVE_DUPLICATES")
2847  RETURN
2848 999 errorsexits("LIST_REMOVE_DUPLICATES",err,error)
2849  RETURN 1
2850  END SUBROUTINE list_remove_duplicates
2851 
2852  !
2853  !================================================================================================================================
2854  !
2855 
2857  SUBROUTINE list_search_intg_array(A,VALUE,POSITION,ERR,ERROR,*)
2858 
2859  !Argument variables
2860  INTEGER(INTG), INTENT(IN) :: A(:)
2861  INTEGER(INTG), INTENT(IN) :: VALUE
2862  INTEGER(INTG), INTENT(OUT) :: POSITION
2863  INTEGER(INTG), INTENT(OUT) :: ERR
2864  TYPE(varying_string), INTENT(OUT) :: ERROR
2865  !Local variables
2866 
2867  enters("LIST_SEARCH_INTG_ARRAY",err,error,*999)
2868 
2869  !Default search method is a linear search
2870  CALL list_search_linear(a,VALUE,position,err,error,*999)
2871 
2872  exits("LIST_SEARCH_INTG_ARRAY")
2873  RETURN
2874 999 errorsexits("LIST_SEARCH_INTG_ARRAY",err,error)
2875  RETURN 1
2876  END SUBROUTINE list_search_intg_array
2877 
2878  !
2879  !================================================================================================================================
2880  !
2881 
2883  SUBROUTINE list_search_c_int_array(A,VALUE,POSITION,ERR,ERROR,*)
2884 
2885  !Argument variables
2886  INTEGER(C_INT), INTENT(IN) :: A(:)
2887  INTEGER(C_INT), INTENT(IN) :: VALUE
2888  INTEGER(INTG), INTENT(OUT) :: POSITION
2889  INTEGER(INTG), INTENT(OUT) :: ERR
2890  TYPE(varying_string), INTENT(OUT) :: ERROR
2891  !Local variables
2892 
2893  enters("LIST_SEARCH_C_INT_ARRAY",err,error,*999)
2894 
2895  !Default search method is a linear search
2896  CALL list_search_linear(a,VALUE,position,err,error,*999)
2897 
2898  exits("LIST_SEARCH_C_INT_ARRAY")
2899  RETURN
2900 999 errorsexits("LIST_SEARCH_C_INT_ARRAY",err,error)
2901  RETURN 1
2902  END SUBROUTINE list_search_c_int_array
2903 
2904  !
2905  !================================================================================================================================
2906  !
2907 
2909  SUBROUTINE list_search_sp_array(A,VALUE,POSITION,ERR,ERROR,*)
2910 
2911  !Argument variables
2912  REAL(SP), INTENT(IN) :: A(:)
2913  REAL(SP), INTENT(IN) :: VALUE
2914  INTEGER(INTG), INTENT(OUT) :: POSITION
2915  INTEGER(INTG), INTENT(OUT) :: ERR
2916  TYPE(varying_string), INTENT(OUT) :: ERROR
2917  !Local variables
2918 
2919  enters("LIST_SEARCH_SP_ARRAY",err,error,*999)
2920 
2921  !Default search method is a linear search
2922  CALL list_search_linear(a,VALUE,position,err,error,*999)
2923 
2924  exits("LIST_SEARCH_SP_ARRAY")
2925  RETURN
2926 999 errorsexits("LIST_SEARCH_SP_ARRAY",err,error)
2927  RETURN 1
2928  END SUBROUTINE list_search_sp_array
2929 
2930  !
2931  !================================================================================================================================
2932  !
2933 
2935  SUBROUTINE list_search_dp_array(A,VALUE,POSITION,ERR,ERROR,*)
2936 
2937  !Argument variables
2938  REAL(DP), INTENT(IN) :: A(:)
2939  REAL(DP), INTENT(IN) :: VALUE
2940  INTEGER(INTG), INTENT(OUT) :: POSITION
2941  INTEGER(INTG), INTENT(OUT) :: ERR
2942  TYPE(varying_string), INTENT(OUT) :: ERROR
2943  !Local variables
2944 
2945  enters("LIST_SEARCH_DP_ARRAY",err,error,*999)
2946 
2947  !Default search method is a linear search
2948  CALL list_search_linear(a,VALUE,position,err,error,*999)
2949 
2950  exits("LIST_SEARCH_DP_ARRAY")
2951  RETURN
2952 999 errorsexits("LIST_SEARCH_DP_ARRAY",err,error)
2953  RETURN 1
2954  END SUBROUTINE list_search_dp_array
2955 
2956  !
2957  !================================================================================================================================
2958  !
2959 
2961  SUBROUTINE list_search_linear_intg_array(A,VALUE,POSITION,ERR,ERROR,*)
2962 
2963  !Argument variables
2964  INTEGER(INTG), INTENT(IN) :: A(:)
2965  INTEGER(INTG), INTENT(IN) :: VALUE
2966  INTEGER(INTG), INTENT(OUT) :: POSITION
2967  INTEGER(INTG), INTENT(OUT) :: ERR
2968  TYPE(varying_string), INTENT(OUT) :: ERROR
2969  !Local variables
2970  INTEGER(INTG) :: i
2971  LOGICAL :: FOUND
2972 
2973  enters("LIST_SEARCH_LINEAR_INTG_ARRAY",err,error,*999)
2974 
2975  found=.false.
2976  i=1
2977  DO WHILE(i<=SIZE(a,1).AND..NOT.found)
2978  IF(a(i)==VALUE) THEN
2979  found=.true.
2980  ELSE
2981  i=i+1
2982  ENDIF
2983  ENDDO
2984  IF(found) THEN
2985  position=i
2986  ELSE
2987  position=0
2988  ENDIF
2989 
2990  exits("LIST_SEARCH_LINEAR_INTG_ARRAY")
2991  RETURN
2992 999 errorsexits("LIST_SEARCH_LINEAR_INTG_ARRAY",err,error)
2993  RETURN 1
2994  END SUBROUTINE list_search_linear_intg_array
2995 
2996  !
2997  !================================================================================================================================
2998  !
2999 
3001  SUBROUTINE list_search_linear_c_int_array(A,VALUE,POSITION,ERR,ERROR,*)
3002 
3003  !Argument variables
3004  INTEGER(C_INT), INTENT(IN) :: A(:)
3005  INTEGER(C_INT), INTENT(IN) :: VALUE
3006  INTEGER(INTG), INTENT(OUT) :: POSITION
3007  INTEGER(INTG), INTENT(OUT) :: ERR
3008  TYPE(varying_string), INTENT(OUT) :: ERROR
3009  !Local variables
3010  INTEGER(INTG) :: i
3011  LOGICAL :: FOUND
3012 
3013  enters("LIST_SEARCH_LINEAR_C_INT_ARRAY",err,error,*999)
3014 
3015  found=.false.
3016  i=1
3017  DO WHILE(i<=SIZE(a,1).AND..NOT.found)
3018  IF(a(i)==VALUE) THEN
3019  found=.true.
3020  ELSE
3021  i=i+1
3022  ENDIF
3023  ENDDO
3024  IF(found) THEN
3025  position=i
3026  ELSE
3027  position=0
3028  ENDIF
3029 
3030  exits("LIST_SEARCH_LINEAR_C_INT_ARRAY")
3031  RETURN
3032 999 errorsexits("LIST_SEARCH_LINEAR_C_INT_ARRAY",err,error)
3033  RETURN 1
3034  END SUBROUTINE list_search_linear_c_int_array
3035 
3036  !
3037  !================================================================================================================================
3038  !
3039 
3041  SUBROUTINE list_search_linear_sp_array(A,VALUE,POSITION,ERR,ERROR,*)
3042 
3043  !Argument variables
3044  REAL(SP), INTENT(IN) :: A(:)
3045  REAL(SP), INTENT(IN) :: VALUE
3046  INTEGER(INTG), INTENT(OUT) :: POSITION
3047  INTEGER(INTG), INTENT(OUT) :: ERR
3048  TYPE(varying_string), INTENT(OUT) :: ERROR
3049  !Local variables
3050  INTEGER(INTG) :: i
3051  LOGICAL :: FOUND
3052 
3053  enters("LIST_SEARCH_LINEAR_SP_ARRAY",err,error,*999)
3054 
3055  found=.false.
3056  i=1
3057  DO WHILE(i<=SIZE(a,1).AND..NOT.found)
3058  IF(abs(a(i)-VALUE)<zero_tolerance_sp) THEN
3059  found=.true.
3060  ELSE
3061  i=i+1
3062  ENDIF
3063  ENDDO
3064  IF(found) THEN
3065  position=i
3066  ELSE
3067  position=0
3068  ENDIF
3069 
3070  exits("LIST_SEARCH_LINEAR_SP_ARRAY")
3071  RETURN
3072 999 errorsexits("LIST_SEARCH_LINEAR_SP_ARRAY",err,error)
3073  RETURN 1
3074  END SUBROUTINE list_search_linear_sp_array
3075 
3076  !
3077  !================================================================================================================================
3078  !
3079 
3081  SUBROUTINE list_search_linear_dp_array(A,VALUE,POSITION,ERR,ERROR,*)
3082 
3083  !Argument variables
3084  REAL(DP), INTENT(IN) :: A(:)
3085  REAL(DP), INTENT(IN) :: VALUE
3086  INTEGER(INTG), INTENT(OUT) :: POSITION
3087  INTEGER(INTG), INTENT(OUT) :: ERR
3088  TYPE(varying_string), INTENT(OUT) :: ERROR
3089  !Local variables
3090  INTEGER(INTG) :: i
3091  LOGICAL :: FOUND
3092 
3093  enters("LIST_SEARCH_LINEAR_DP_ARRAY",err,error,*999)
3094 
3095  found=.false.
3096  i=1
3097  DO WHILE(i<=SIZE(a,1).AND..NOT.found)
3098  IF(abs(a(i)-VALUE)<zero_tolerance) THEN
3099  found=.true.
3100  ELSE
3101  i=i+1
3102  ENDIF
3103  ENDDO
3104  IF(found) THEN
3105  position=i
3106  ELSE
3107  position=0
3108  ENDIF
3109 
3110  exits("LIST_SEARCH_LINEAR_DP_ARRAY")
3111  RETURN
3112 999 errorsexits("LIST_SEARCH_LINEAR_DP_ARRAY",err,error)
3113  RETURN 1
3114  END SUBROUTINE list_search_linear_dp_array
3115 
3116  !
3117  !================================================================================================================================
3118  !
3119 
3121  SUBROUTINE list_sort_list(LIST,ERR,ERROR,*)
3122 
3123  !Argument variables
3124  TYPE(list_type), POINTER, INTENT(INOUT) :: LIST
3125  INTEGER(INTG), INTENT(OUT) :: ERR
3126  TYPE(varying_string), INTENT(OUT) :: ERROR
3127  !Local variables
3128  TYPE(varying_string) :: LOCAL_ERROR
3129 
3130  enters("LIST_SORT_LIST",err,error,*999)
3131 
3132  IF(ASSOCIATED(list)) THEN
3133  IF(list%LIST_FINISHED) THEN
3134  SELECT CASE(list%SORT_METHOD)
3135  CASE(list_bubble_sort_method)
3136  IF(list%DATA_DIMENSION==1) THEN
3137  SELECT CASE(list%DATA_TYPE)
3138  CASE(list_intg_type)
3139  CALL list_sort_bubble_intg1_array(list%LIST_INTG(1:list%NUMBER_IN_LIST),err,error,*999)
3140  CASE(list_sp_type)
3141  CALL list_sort_bubble_sp1_array(list%LIST_SP(1:list%NUMBER_IN_LIST),err,error,*999)
3142  CASE(list_dp_type)
3143  CALL list_sort_bubble_dp1_array(list%LIST_DP(1:list%NUMBER_IN_LIST),err,error,*999)
3144  CASE DEFAULT
3145  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))//" is invalid."
3146  CALL flagerror(local_error,err,error,*999)
3147  END SELECT
3148  ELSE
3149  SELECT CASE(list%DATA_TYPE)
3150  CASE(list_intg_type)
3151  CALL list_sort_bubble_intg2_array(list%LIST_INTG2(:,1:list%NUMBER_IN_LIST),list%KEY_DIMENSION, &
3152  & err,error,*999)
3153  CASE(list_sp_type)
3154  CALL list_sort_bubble_sp2_array(list%LIST_SP2(:,1:list%NUMBER_IN_LIST),list%KEY_DIMENSION, &
3155  & err,error,*999)
3156  CASE(list_dp_type)
3157  CALL list_sort_bubble_dp2_array(list%LIST_DP2(:,1:list%NUMBER_IN_LIST),list%KEY_DIMENSION, &
3158  & err,error,*999)
3159  CASE DEFAULT
3160  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))//" is invalid."
3161  CALL flagerror(local_error,err,error,*999)
3162  END SELECT
3163  ENDIF
3164  CASE(list_shell_sort_method)
3165  IF(list%DATA_DIMENSION==1) THEN
3166  SELECT CASE(list%DATA_TYPE)
3167  CASE(list_intg_type)
3168  CALL list_sort_shell_intg1_array(list%LIST_INTG(1:list%NUMBER_IN_LIST),err,error,*999)
3169  CASE(list_sp_type)
3170  CALL list_sort_shell_sp1_array(list%LIST_SP(1:list%NUMBER_IN_LIST),err,error,*999)
3171  CASE(list_dp_type)
3172  CALL list_sort_shell_dp1_array(list%LIST_DP(1:list%NUMBER_IN_LIST),err,error,*999)
3173  CASE DEFAULT
3174  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))//" is invalid."
3175  CALL flagerror(local_error,err,error,*999)
3176  END SELECT
3177  ELSE
3178  SELECT CASE(list%DATA_TYPE)
3179  CASE(list_intg_type)
3180  CALL list_sort_shell_intg2_array(list%LIST_INTG2(:,1:list%NUMBER_IN_LIST),list%KEY_DIMENSION, &
3181  & err,error,*999)
3182  CASE(list_sp_type)
3183  CALL list_sort_shell_sp2_array(list%LIST_SP2(:,1:list%NUMBER_IN_LIST),list%KEY_DIMENSION, &
3184  & err,error,*999)
3185  CASE(list_dp_type)
3186  CALL list_sort_shell_dp2_array(list%LIST_DP2(:,1:list%NUMBER_IN_LIST),list%KEY_DIMENSION, &
3187  & err,error,*999)
3188  CASE DEFAULT
3189  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))//" is invalid."
3190  CALL flagerror(local_error,err,error,*999)
3191  END SELECT
3192  ENDIF
3193  CASE(list_heap_sort_method)
3194  IF(list%DATA_DIMENSION==1) THEN
3195  SELECT CASE(list%DATA_TYPE)
3196  CASE(list_intg_type)
3197  CALL list_sort_heap_intg1_array(list%LIST_INTG(1:list%NUMBER_IN_LIST),err,error,*999)
3198  CASE(list_sp_type)
3199  CALL list_sort_heap_sp1_array(list%LIST_SP(1:list%NUMBER_IN_LIST),err,error,*999)
3200  CASE(list_dp_type)
3201  CALL list_sort_heap_dp1_array(list%LIST_DP(1:list%NUMBER_IN_LIST),err,error,*999)
3202  CASE DEFAULT
3203  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))//" is invalid."
3204  CALL flagerror(local_error,err,error,*999)
3205  END SELECT
3206  ELSE
3207  SELECT CASE(list%DATA_TYPE)
3208  CASE(list_intg_type)
3209  CALL list_sort_heap_intg2_array(list%LIST_INTG2(:,1:list%NUMBER_IN_LIST),list%KEY_DIMENSION, &
3210  & err,error,*999)
3211  CASE(list_sp_type)
3212  CALL list_sort_heap_sp2_array(list%LIST_SP2(:,1:list%NUMBER_IN_LIST),list%KEY_DIMENSION, &
3213  & err,error,*999)
3214  CASE(list_dp_type)
3215  CALL list_sort_heap_dp2_array(list%LIST_DP2(:,1:list%NUMBER_IN_LIST),list%KEY_DIMENSION, &
3216  & err,error,*999)
3217  CASE DEFAULT
3218  local_error="The list data type of "//trim(numbertovstring(list%DATA_TYPE,"*",err,error))//" is invalid."
3219  CALL flagerror(local_error,err,error,*999)
3220  END SELECT
3221  ENDIF
3222  CASE DEFAULT
3223  local_error="The list sort method of "//trim(numbertovstring(list%SORT_METHOD,"*",err,error))//" is invlaid."
3224  CALL flagerror(local_error,err,error,*999)
3225  END SELECT
3226  ELSE
3227  CALL flagerror("List has not been finished.",err,error,*999)
3228  ENDIF
3229  ELSE
3230  CALL flagerror("List is not associated.",err,error,*999)
3231  ENDIF
3232 
3233  exits("LIST_SORT_LIST")
3234  RETURN
3235 999 errorsexits("LIST_SORT_LIST",err,error)
3236  RETURN 1
3237  END SUBROUTINE list_sort_list
3238 
3239  !
3240  !================================================================================================================================
3241  !
3242 
3244  SUBROUTINE list_sort_intg1_array(A,ERR,ERROR,*)
3245 
3246  !Argument variables
3247  INTEGER(INTG), INTENT(INOUT) :: A(:)
3248  INTEGER(INTG), INTENT(OUT) :: ERR
3249  TYPE(varying_string), INTENT(OUT) :: ERROR
3250  !Local variables
3251 
3252  enters("LIST_SORT_INTG1_ARRAY",err,error,*999)
3253 
3254  !Default sort method is a heap sort
3255  CALL list_sort_heap(a,err,error,*999)
3256 
3257  exits("LIST_SORT_INTG1_ARRAY")
3258  RETURN
3259 999 errorsexits("LIST_SORT_INTG1_ARRAY",err,error)
3260  RETURN 1
3261  END SUBROUTINE list_sort_intg1_array
3262 
3263  !
3264  !================================================================================================================================
3265  !
3266 
3268  SUBROUTINE list_sort_intg2_array(A,KEY_DIMENSION,ERR,ERROR,*)
3269 
3270  !Argument variables
3271  INTEGER(INTG), INTENT(INOUT) :: A(:,:)
3272  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
3273  INTEGER(INTG), INTENT(OUT) :: ERR
3274  TYPE(varying_string), INTENT(OUT) :: ERROR
3275  !Local variables
3276 
3277  enters("LIST_SORT_INTG2_ARRAY",err,error,*999)
3278 
3279  !Default sort method is a heap sort
3280  CALL list_sort_heap(a,key_dimension,err,error,*999)
3281 
3282  exits("LIST_SORT_INTG2_ARRAY")
3283  RETURN
3284 999 errorsexits("LIST_SORT_INTG2_ARRAY",err,error)
3285  RETURN 1
3286  END SUBROUTINE list_sort_intg2_array
3287 
3288  !
3289  !================================================================================================================================
3290  !
3291 
3293  SUBROUTINE list_sort_c_int1_array(A,ERR,ERROR,*)
3294 
3295  !Argument variables
3296  INTEGER(C_INT), INTENT(INOUT) :: A(:)
3297  INTEGER(INTG), INTENT(OUT) :: ERR
3298  TYPE(varying_string), INTENT(OUT) :: ERROR
3299  !Local variables
3300 
3301  enters("LIST_SORT_C_INT1_ARRAY",err,error,*999)
3302 
3303  !Default sort method is a heap sort
3304  CALL list_sort_heap(a,err,error,*999)
3305 
3306  exits("LIST_SORT_C_INT1_ARRAY")
3307  RETURN
3308 999 errorsexits("LIST_SORT_C_INT1_ARRAY",err,error)
3309  RETURN 1
3310  END SUBROUTINE list_sort_c_int1_array
3311 
3312  !
3313  !================================================================================================================================
3314  !
3315 
3317  SUBROUTINE list_sort_c_int2_array(A,KEY_DIMENSION,ERR,ERROR,*)
3318 
3319  !Argument variables
3320  INTEGER(C_INT), INTENT(INOUT) :: A(:,:)
3321  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
3322  INTEGER(INTG), INTENT(OUT) :: ERR
3323  TYPE(varying_string), INTENT(OUT) :: ERROR
3324  !Local variables
3325 
3326  enters("LIST_SORT_C_INT2_ARRAY",err,error,*999)
3327 
3328  !Default sort method is a heap sort
3329  CALL list_sort_heap(a,key_dimension,err,error,*999)
3330 
3331  exits("LIST_SORT_C_INT2_ARRAY")
3332  RETURN
3333 999 errorsexits("LIST_SORT_C_INT2_ARRAY",err,error)
3334  RETURN 1
3335  END SUBROUTINE list_sort_c_int2_array
3336 
3337  !
3338  !================================================================================================================================
3339  !
3340 
3342  SUBROUTINE list_sort_sp1_array(A,ERR,ERROR,*)
3343 
3344  !Argument variables
3345  REAL(SP), INTENT(INOUT) :: A(:)
3346  INTEGER(INTG), INTENT(OUT) :: ERR
3347  TYPE(varying_string), INTENT(OUT) :: ERROR
3348  !Local variables
3349 
3350  enters("LIST_SORT_SP1_ARRAY",err,error,*999)
3351 
3352  !Default sort method is a heap sort
3353  CALL list_sort_heap(a,err,error,*999)
3354 
3355  exits("LIST_SORT_SP1_ARRAY")
3356  RETURN
3357 999 errorsexits("LIST_SORT_SP1_ARRAY",err,error)
3358  RETURN 1
3359  END SUBROUTINE list_sort_sp1_array
3360 
3361  !
3362  !================================================================================================================================
3363  !
3364 
3366  SUBROUTINE list_sort_sp2_array(A,KEY_DIMENSION,ERR,ERROR,*)
3367 
3368  !Argument variables
3369  REAL(SP), INTENT(INOUT) :: A(:,:)
3370  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
3371  INTEGER(INTG), INTENT(OUT) :: ERR
3372  TYPE(varying_string), INTENT(OUT) :: ERROR
3373  !Local variables
3374 
3375  enters("LIST_SORT_SP2_ARRAY",err,error,*999)
3376 
3377  !Default sort method is a heap sort
3378  CALL list_sort_heap(a,key_dimension,err,error,*999)
3379 
3380  exits("LIST_SORT_SP2_ARRAY")
3381  RETURN
3382 999 errorsexits("LIST_SORT_SP2_ARRAY",err,error)
3383  RETURN 1
3384  END SUBROUTINE list_sort_sp2_array
3385 
3386  !
3387  !================================================================================================================================
3388  !
3389 
3391  SUBROUTINE list_sort_dp1_array(A,ERR,ERROR,*)
3392 
3393  !Argument variables
3394  REAL(DP), INTENT(INOUT) :: A(:)
3395  INTEGER(INTG), INTENT(OUT) :: ERR
3396  TYPE(varying_string), INTENT(OUT) :: ERROR
3397  !Local variables
3398 
3399  enters("LIST_SORT_DP1_ARRAY",err,error,*999)
3400 
3401  !Default sort method is a heap sort
3402  CALL list_sort_heap(a,err,error,*999)
3403 
3404  exits("LIST_SORT_DP1_ARRAY")
3405  RETURN
3406 999 errorsexits("LIST_SORT_DP1_ARRAY",err,error)
3407  RETURN 1
3408  END SUBROUTINE list_sort_dp1_array
3409 
3410  !
3411  !================================================================================================================================
3412  !
3413 
3415  SUBROUTINE list_sort_dp2_array(A,KEY_DIMENSION,ERR,ERROR,*)
3416 
3417  !Argument variables
3418  REAL(DP), INTENT(INOUT) :: A(:,:)
3419  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
3420  INTEGER(INTG), INTENT(OUT) :: ERR
3421  TYPE(varying_string), INTENT(OUT) :: ERROR
3422  !Local variables
3423 
3424  enters("LIST_SORT_DP2_ARRAY",err,error,*999)
3425 
3426  !Default sort method is a heap sort
3427  CALL list_sort_heap(a,key_dimension,err,error,*999)
3428 
3429  exits("LIST_SORT_DP2_ARRAY")
3430  RETURN
3431 999 errorsexits("LIST_SORT_DP2_ARRAY",err,error)
3432  RETURN 1
3433  END SUBROUTINE list_sort_dp2_array
3434 
3435  !
3436  !================================================================================================================================
3437  !
3438 
3440  SUBROUTINE list_sort_bubble_intg1_array(A,ERR,ERROR,*)
3441 
3442  !Argument variables
3443  INTEGER(INTG), INTENT(INOUT) :: A(:)
3444  INTEGER(INTG), INTENT(OUT) :: ERR
3445  TYPE(varying_string), INTENT(OUT) :: ERROR
3446  !Local variables
3447  INTEGER(INTG) :: FLAG,i,j,k,VALUE
3448 
3449  enters("LIST_SORT_BUBBLE_INTG1_ARRAY",err,error,*999)
3450 
3451  IF(SIZE(a,1)>1) THEN
3452  flag=SIZE(a,1)
3453  DO i=1,SIZE(a,1)
3454  k=flag-1
3455  flag=0
3456  DO j=1,k
3457  IF(a(j)>a(j+1)) THEN
3458  VALUE=a(j)
3459  a(j)=a(j+1)
3460  a(j+1)=VALUE
3461  flag=j
3462  ENDIF
3463  ENDDO
3464  IF(flag==0) EXIT
3465  ENDDO
3466  ENDIF
3467 
3468  exits("LIST_SORT_BUBBLE_INTG1_ARRAY")
3469  RETURN
3470 999 errorsexits("LIST_SORT_BUBBLE_INTG1_ARRAY",err,error)
3471  RETURN 1
3472  END SUBROUTINE list_sort_bubble_intg1_array
3473 
3474  !
3475  !================================================================================================================================
3476  !
3477 
3479  SUBROUTINE list_sort_bubble_intg2_array(A,KEY_DIMENSION,ERR,ERROR,*)
3480 
3481  !Argument variables
3482  INTEGER(INTG), INTENT(INOUT) :: A(:,:)
3483  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
3484  INTEGER(INTG), INTENT(OUT) :: ERR
3485  TYPE(varying_string), INTENT(OUT) :: ERROR
3486  !Local variables
3487  INTEGER(INTG) :: FLAG,i,j,k,VALUE(size(a,1))
3488  TYPE(varying_string) :: LOCAL_ERROR
3489 
3490  enters("LIST_SORT_BUBBLE_INTG2_ARRAY",err,error,*999)
3491 
3492  IF(key_dimension>0.AND.key_dimension<=SIZE(a,1)) THEN
3493  IF(SIZE(a,2)>1) THEN
3494  flag=SIZE(a,2)
3495  DO i=1,SIZE(a,2)
3496  k=flag-1
3497  flag=0
3498  DO j=1,k
3499  IF(a(key_dimension,j)>a(key_dimension,j+1)) THEN
3500  VALUE=a(:,j)
3501  a(:,j)=a(:,j+1)
3502  a(:,j+1)=VALUE
3503  flag=j
3504  ENDIF
3505  ENDDO
3506  IF(flag==0) EXIT
3507  ENDDO
3508  ENDIF
3509  ELSE
3510  local_error="The specified key dimension of "//trim(numbertovstring(key_dimension,"*",err,error))// &
3511  & " is invalid. The key dimension must be > 0 and <= "//trim(numbertovstring(SIZE(a,1),"*",err,error))//"."
3512  CALL flagerror(local_error,err,error,*999)
3513  ENDIF
3514 
3515  exits("LIST_SORT_BUBBLE_INTG2_ARRAY")
3516  RETURN
3517 999 errorsexits("LIST_SORT_BUBBLE_INTG2_ARRAY",err,error)
3518  RETURN 1
3519  END SUBROUTINE list_sort_bubble_intg2_array
3520 
3521  !
3522  !================================================================================================================================
3523  !
3524 
3526  SUBROUTINE list_sort_bubble_c_int1_array(A,ERR,ERROR,*)
3527 
3528  !Argument variables
3529  INTEGER(C_INT), INTENT(INOUT) :: A(:)
3530  INTEGER(INTG), INTENT(OUT) :: ERR
3531  TYPE(varying_string), INTENT(OUT) :: ERROR
3532  !Local variables
3533  INTEGER(INTG) :: FLAG,i,j,k
3534  INTEGER(C_INT) :: VALUE
3535 
3536  enters("LIST_SORT_BUBBLE_C_INT1_ARRAY",err,error,*999)
3537 
3538  IF(SIZE(a,1)>1) THEN
3539  flag=SIZE(a,1)
3540  DO i=1,SIZE(a,1)
3541  k=flag-1
3542  flag=0
3543  DO j=1,k
3544  IF(a(j)>a(j+1)) THEN
3545  VALUE=a(j)
3546  a(j)=a(j+1)
3547  a(j+1)=VALUE
3548  flag=j
3549  ENDIF
3550  ENDDO
3551  IF(flag==0) EXIT
3552  ENDDO
3553  ENDIF
3554 
3555  exits("LIST_SORT_BUBBLE_C_INT1_ARRAY")
3556  RETURN
3557 999 errorsexits("LIST_SORT_BUBBLE_C_INT1_ARRAY",err,error)
3558  RETURN 1
3559  END SUBROUTINE list_sort_bubble_c_int1_array
3560 
3561  !
3562  !================================================================================================================================
3563  !
3564 
3566  SUBROUTINE list_sort_bubble_c_int2_array(A,KEY_DIMENSION,ERR,ERROR,*)
3567 
3568  !Argument variables
3569  INTEGER(C_INT), INTENT(INOUT) :: A(:,:)
3570  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
3571  INTEGER(INTG), INTENT(OUT) :: ERR
3572  TYPE(varying_string), INTENT(OUT) :: ERROR
3573  !Local variables
3574  INTEGER(INTG) :: FLAG,i,j,k
3575  INTEGER(C_INT) :: VALUE(size(a,1))
3576  TYPE(varying_string) :: LOCAL_ERROR
3577 
3578  enters("LIST_SORT_BUBBLE_C_INT2_ARRAY",err,error,*999)
3579 
3580  IF(key_dimension>0.AND.key_dimension<=SIZE(a,1)) THEN
3581  IF(SIZE(a,2)>1) THEN
3582  flag=SIZE(a,2)
3583  DO i=1,SIZE(a,2)
3584  k=flag-1
3585  flag=0
3586  DO j=1,k
3587  IF(a(key_dimension,j)>a(key_dimension,j+1)) THEN
3588  VALUE=a(:,j)
3589  a(:,j)=a(:,j+1)
3590  a(:,j+1)=VALUE
3591  flag=j
3592  ENDIF
3593  ENDDO
3594  IF(flag==0) EXIT
3595  ENDDO
3596  ENDIF
3597  ELSE
3598  local_error="The specified key dimension of "//trim(numbertovstring(key_dimension,"*",err,error))// &
3599  & " is invalid. The key dimension must be > 0 and <= "//trim(numbertovstring(SIZE(a,1),"*",err,error))//"."
3600  CALL flagerror(local_error,err,error,*999)
3601  ENDIF
3602 
3603  exits("LIST_SORT_BUBBLE_C_INT2_ARRAY")
3604  RETURN
3605 999 errorsexits("LIST_SORT_BUBBLE_C_INT2_ARRAY",err,error)
3606  RETURN 1
3607  END SUBROUTINE list_sort_bubble_c_int2_array
3608 
3609  !
3610  !================================================================================================================================
3611  !
3612 
3614  SUBROUTINE list_sort_bubble_sp1_array(A,ERR,ERROR,*)
3615 
3616  !Argument variables
3617  REAL(SP), INTENT(INOUT) :: A(:)
3618  INTEGER(INTG), INTENT(OUT) :: ERR
3619  TYPE(varying_string), INTENT(OUT) :: ERROR
3620  !Local variables
3621  INTEGER(INTG) :: FLAG,i,j,k
3622  REAL(SP) :: VALUE
3623 
3624  enters("LIST_SORT_BUBBLE_SP1_ARRAY",err,error,*999)
3625 
3626  IF(SIZE(a,1)>1) THEN
3627  flag=SIZE(a,1)
3628  DO i=1,SIZE(a,1)
3629  k=flag-1
3630  flag=0
3631  DO j=1,k
3632  IF(a(j)>a(j+1)) THEN
3633  VALUE=a(j)
3634  a(j)=a(j+1)
3635  a(j+1)=VALUE
3636  flag=j
3637  ENDIF
3638  ENDDO
3639  IF(flag==0) EXIT
3640  ENDDO
3641  ENDIF
3642 
3643  exits("LIST_SORT_BUBBLE_SP1_ARRAY")
3644  RETURN
3645 999 errorsexits("LIST_SORT_BUBBLE_SP1_ARRAY",err,error)
3646  RETURN 1
3647  END SUBROUTINE list_sort_bubble_sp1_array
3648 
3649  !
3650  !================================================================================================================================
3651  !
3652 
3654  SUBROUTINE list_sort_bubble_sp2_array(A,KEY_DIMENSION,ERR,ERROR,*)
3655 
3656  !Argument variables
3657  REAL(SP), INTENT(INOUT) :: A(:,:)
3658  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
3659  INTEGER(INTG), INTENT(OUT) :: ERR
3660  TYPE(varying_string), INTENT(OUT) :: ERROR
3661  !Local variables
3662  INTEGER(INTG) :: FLAG,i,j,k
3663  REAL(SP) :: VALUE(size(a,1))
3664  TYPE(varying_string) :: LOCAL_ERROR
3665 
3666  enters("LIST_SORT_BUBBLE_SP2_ARRAY",err,error,*999)
3667 
3668  IF(key_dimension>0.AND.key_dimension<=SIZE(a,1)) THEN
3669  IF(SIZE(a,2)>1) THEN
3670  flag=SIZE(a,2)
3671  DO i=1,SIZE(a,2)
3672  k=flag-1
3673  flag=0
3674  DO j=1,k
3675  IF(a(key_dimension,j)>a(key_dimension,j+1)) THEN
3676  VALUE=a(:,j)
3677  a(:,j)=a(:,j+1)
3678  a(:,j+1)=VALUE
3679  flag=j
3680  ENDIF
3681  ENDDO
3682  IF(flag==0) EXIT
3683  ENDDO
3684  ENDIF
3685  ELSE
3686  local_error="The specified key dimension of "//trim(numbertovstring(key_dimension,"*",err,error))// &
3687  & " is invalid. The key dimension must be > 0 and <= "//trim(numbertovstring(SIZE(a,1),"*",err,error))//"."
3688  CALL flagerror(local_error,err,error,*999)
3689  ENDIF
3690 
3691  exits("LIST_SORT_BUBBLE_SP2_ARRAY")
3692  RETURN
3693 999 errorsexits("LIST_SORT_BUBBLE_SP2_ARRAY",err,error)
3694  RETURN 1
3695  END SUBROUTINE list_sort_bubble_sp2_array
3696 
3697  !
3698  !================================================================================================================================
3699  !
3700 
3702  SUBROUTINE list_sort_bubble_dp1_array(A,ERR,ERROR,*)
3703 
3704  !Argument variables
3705  REAL(DP), INTENT(INOUT) :: A(:)
3706  INTEGER(INTG), INTENT(OUT) :: ERR
3707  TYPE(varying_string), INTENT(OUT) :: ERROR
3708  !Local variables
3709  INTEGER(INTG) :: FLAG,i,j,k
3710  REAL(DP) :: VALUE
3711 
3712  enters("LIST_SORT_BUBBLE_DP1_ARRAY",err,error,*999)
3713 
3714  IF(SIZE(a,1)>1) THEN
3715  flag=SIZE(a,1)
3716  DO i=1,SIZE(a,1)
3717  k=flag-1
3718  flag=0
3719  DO j=1,k
3720  IF(a(j)>a(j+1)) THEN
3721  VALUE=a(j)
3722  a(j)=a(j+1)
3723  a(j+1)=VALUE
3724  flag=j
3725  ENDIF
3726  ENDDO
3727  IF(flag==0) EXIT
3728  ENDDO
3729  ENDIF
3730 
3731  exits("LIST_SORT_BUBBLE_DP1_ARRAY")
3732  RETURN
3733 999 errorsexits("LIST_SORT_BUBBLE_DP1_ARRAY",err,error)
3734  RETURN 1
3735  END SUBROUTINE list_sort_bubble_dp1_array
3736 
3737  !
3738  !================================================================================================================================
3739  !
3740 
3742  SUBROUTINE list_sort_bubble_dp2_array(A,KEY_DIMENSION,ERR,ERROR,*)
3743 
3744  !Argument variables
3745  REAL(DP), INTENT(INOUT) :: A(:,:)
3746  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
3747  INTEGER(INTG), INTENT(OUT) :: ERR
3748  TYPE(varying_string), INTENT(OUT) :: ERROR
3749  !Local variables
3750  INTEGER(INTG) :: FLAG,i,j,k
3751  REAL(DP) :: VALUE(size(a,1))
3752  TYPE(varying_string) :: LOCAL_ERROR
3753 
3754  enters("LIST_SORT_BUBBLE_DP2_ARRAY",err,error,*999)
3755 
3756  IF(key_dimension>0.AND.key_dimension<=SIZE(a,1)) THEN
3757  IF(SIZE(a,2)>1) THEN
3758  flag=SIZE(a,2)
3759  DO i=1,SIZE(a,2)
3760  k=flag-1
3761  flag=0
3762  DO j=1,k
3763  IF(a(key_dimension,j)>a(key_dimension,j+1)) THEN
3764  VALUE=a(:,j)
3765  a(:,j)=a(:,j+1)
3766  a(:,j+1)=VALUE
3767  flag=j
3768  ENDIF
3769  ENDDO
3770  IF(flag==0) EXIT
3771  ENDDO
3772  ENDIF
3773  ELSE
3774  local_error="The specified key dimension of "//trim(numbertovstring(key_dimension,"*",err,error))// &
3775  & " is invalid. The key dimension must be > 0 and <= "//trim(numbertovstring(SIZE(a,1),"*",err,error))//"."
3776  CALL flagerror(local_error,err,error,*999)
3777  ENDIF
3778 
3779  exits("LIST_SORT_BUBBLE_DP2_ARRAY")
3780  RETURN
3781 999 errorsexits("LIST_SORT_BUBBLE_DP2_ARRAY",err,error)
3782  RETURN 1
3783  END SUBROUTINE list_sort_bubble_dp2_array
3784 
3785  !
3786  !================================================================================================================================
3787  !
3788 
3790  SUBROUTINE list_sort_heap_intg1_array(A,ERR,ERROR,*)
3791 
3792  !Argument variables
3793  INTEGER(INTG), INTENT(INOUT) :: A(:)
3794  INTEGER(INTG), INTENT(OUT) :: ERR
3795  TYPE(varying_string), INTENT(OUT) :: ERROR
3796  !Local variables
3797  INTEGER(INTG) :: I,IVALUE,J,L,VALUE
3798 
3799  enters("LIST_SORT_HEAP_INTG1_ARRAY",err,error,*999)
3800 
3801  IF(SIZE(a,1)>1) THEN
3802  l=SIZE(a,1)/2+1
3803  ivalue=SIZE(a,1)
3804  DO
3805  IF(l>1) THEN
3806  l=l-1
3807  VALUE=a(l)
3808  ELSE
3809  VALUE=a(ivalue)
3810  a(ivalue)=a(1)
3811  ivalue=ivalue-1
3812  IF(ivalue==1) THEN
3813  a(1)=VALUE
3814  EXIT
3815  ENDIF
3816  ENDIF
3817  i=l
3818  j=l+l
3819  DO WHILE(j<=ivalue)
3820  IF(j<ivalue) THEN
3821  IF(a(j)<a(j+1)) j=j+1
3822  ENDIF
3823  IF(VALUE<a(j)) THEN
3824  a(i)=a(j)
3825  i=j
3826  j=j+j
3827  ELSE
3828  j=ivalue+1
3829  ENDIF
3830  ENDDO
3831  a(i)=VALUE
3832  ENDDO
3833  ENDIF
3834 
3835  exits("LIST_SORT_HEAP_INTG1_ARRAY")
3836  RETURN
3837 999 errorsexits("LIST_SORT_HEAP_INTG1_ARRAY",err,error)
3838  RETURN 1
3839  END SUBROUTINE list_sort_heap_intg1_array
3840 
3841  !
3842  !================================================================================================================================
3843  !
3844 
3846  SUBROUTINE list_sort_heap_intg2_array(A,KEY_DIMENSION,ERR,ERROR,*)
3847 
3848  !Argument variables
3849  INTEGER(INTG), INTENT(INOUT) :: A(:,:)
3850  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
3851  INTEGER(INTG), INTENT(OUT) :: ERR
3852  TYPE(varying_string), INTENT(OUT) :: ERROR
3853  !Local variables
3854  INTEGER(INTG) :: I,IVALUE,J,L,VALUE(size(a,1))
3855  TYPE(varying_string) :: LOCAL_ERROR
3856 
3857  enters("LIST_SORT_HEAP_INTG2_ARRAY",err,error,*999)
3858 
3859  IF(key_dimension>0.AND.key_dimension<=SIZE(a,1)) THEN
3860  IF(SIZE(a,2)>1) THEN
3861  l=SIZE(a,2)/2+1
3862  ivalue=SIZE(a,2)
3863  DO
3864  IF(l>1) THEN
3865  l=l-1
3866  VALUE=a(:,l)
3867  ELSE
3868  VALUE=a(:,ivalue)
3869  a(:,ivalue)=a(:,1)
3870  ivalue=ivalue-1
3871  IF(ivalue==1) THEN
3872  a(:,1)=VALUE
3873  EXIT
3874  ENDIF
3875  ENDIF
3876  i=l
3877  j=l+l
3878  DO WHILE(j<=ivalue)
3879  IF(j<ivalue) THEN
3880  IF(a(key_dimension,j)<a(key_dimension,j+1)) j=j+1
3881  ENDIF
3882  IF(value(key_dimension)<a(key_dimension,j)) THEN
3883  a(:,i)=a(:,j)
3884  i=j
3885  j=j+j
3886  ELSE
3887  j=ivalue+1
3888  ENDIF
3889  ENDDO
3890  a(:,i)=VALUE
3891  ENDDO
3892  ENDIF
3893  ELSE
3894  local_error="The specified key dimension of "//trim(numbertovstring(key_dimension,"*",err,error))// &
3895  & " is invalid. The key dimension must be > 0 and <= "//trim(numbertovstring(SIZE(a,1),"*",err,error))//"."
3896  CALL flagerror(local_error,err,error,*999)
3897  ENDIF
3898 
3899  exits("LIST_SORT_HEAP_INTG2_ARRAY")
3900  RETURN
3901 999 errorsexits("LIST_SORT_HEAP_INTG2_ARRAY",err,error)
3902  RETURN 1
3903  END SUBROUTINE list_sort_heap_intg2_array
3904 
3905  !
3906  !================================================================================================================================
3907  !
3908 
3910  SUBROUTINE list_sort_heap_c_int1_array(A,ERR,ERROR,*)
3911 
3912  !Argument variables
3913  INTEGER(C_INT), INTENT(INOUT) :: A(:)
3914  INTEGER(INTG), INTENT(OUT) :: ERR
3915  TYPE(varying_string), INTENT(OUT) :: ERROR
3916  !Local variables
3917  INTEGER(INTG) :: I,J,L
3918  INTEGER(C_INT) :: IVALUE,VALUE
3919 
3920  enters("LIST_SORT_HEAP_C_INT1_ARRAY",err,error,*999)
3921 
3922  IF(SIZE(a,1)>1) THEN
3923  l=SIZE(a,1)/2+1
3924  ivalue=SIZE(a,1)
3925  DO
3926  IF(l>1) THEN
3927  l=l-1
3928  VALUE=a(l)
3929  ELSE
3930  VALUE=a(ivalue)
3931  a(ivalue)=a(1)
3932  ivalue=ivalue-1
3933  IF(ivalue==1) THEN
3934  a(1)=VALUE
3935  EXIT
3936  ENDIF
3937  ENDIF
3938  i=l
3939  j=l+l
3940  DO WHILE(j<=ivalue)
3941  IF(j<ivalue) THEN
3942  IF(a(j)<a(j+1)) j=j+1
3943  ENDIF
3944  IF(VALUE<a(j)) THEN
3945  a(i)=a(j)
3946  i=j
3947  j=j+j
3948  ELSE
3949  j=ivalue+1
3950  ENDIF
3951  ENDDO
3952  a(i)=VALUE
3953  ENDDO
3954  ENDIF
3955 
3956  exits("LIST_SORT_HEAP_C_INT1_ARRAY")
3957  RETURN
3958 999 errorsexits("LIST_SORT_HEAP_C_INT1_ARRAY",err,error)
3959  RETURN 1
3960  END SUBROUTINE list_sort_heap_c_int1_array
3961 
3962  !
3963  !================================================================================================================================
3964  !
3965 
3967  SUBROUTINE list_sort_heap_c_int2_array(A,KEY_DIMENSION,ERR,ERROR,*)
3968 
3969  !Argument variables
3970  INTEGER(C_INT), INTENT(INOUT) :: A(:,:)
3971  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
3972  INTEGER(INTG), INTENT(OUT) :: ERR
3973  TYPE(varying_string), INTENT(OUT) :: ERROR
3974  !Local variables
3975  INTEGER(INTG) :: I,J,L
3976  INTEGER(C_INT) :: IVALUE,VALUE(size(a,1))
3977  TYPE(varying_string) :: LOCAL_ERROR
3978 
3979  enters("LIST_SORT_HEAP_C_INT2_ARRAY",err,error,*999)
3980 
3981  IF(key_dimension>0.AND.key_dimension<=SIZE(a,1)) THEN
3982  IF(SIZE(a,2)>1) THEN
3983  l=SIZE(a,2)/2+1
3984  ivalue=SIZE(a,2)
3985  DO
3986  IF(l>1) THEN
3987  l=l-1
3988  VALUE=a(:,l)
3989  ELSE
3990  VALUE=a(:,ivalue)
3991  a(:,ivalue)=a(:,1)
3992  ivalue=ivalue-1
3993  IF(ivalue==1) THEN
3994  a(:,1)=VALUE
3995  EXIT
3996  ENDIF
3997  ENDIF
3998  i=l
3999  j=l+l
4000  DO WHILE(j<=ivalue)
4001  IF(j<ivalue) THEN
4002  IF(a(key_dimension,j)<a(key_dimension,j+1)) j=j+1
4003  ENDIF
4004  IF(value(key_dimension)<a(key_dimension,j)) THEN
4005  a(:,i)=a(:,j)
4006  i=j
4007  j=j+j
4008  ELSE
4009  j=ivalue+1
4010  ENDIF
4011  ENDDO
4012  a(:,i)=VALUE
4013  ENDDO
4014  ENDIF
4015  ELSE
4016  local_error="The specified key dimension of "//trim(numbertovstring(key_dimension,"*",err,error))// &
4017  & " is invalid. The key dimension must be > 0 and <= "//trim(numbertovstring(SIZE(a,1),"*",err,error))//"."
4018  CALL flagerror(local_error,err,error,*999)
4019  ENDIF
4020 
4021  exits("LIST_SORT_HEAP_C_INT2_ARRAY")
4022  RETURN
4023 999 errorsexits("LIST_SORT_HEAP_C_INT2_ARRAY",err,error)
4024  RETURN 1
4025  END SUBROUTINE list_sort_heap_c_int2_array
4026 
4027  !
4028  !================================================================================================================================
4029  !
4030 
4032  SUBROUTINE list_sort_heap_sp1_array(A,ERR,ERROR,*)
4033 
4034  !Argument variables
4035  REAL(SP), INTENT(INOUT) :: A(:)
4036  INTEGER(INTG), INTENT(OUT) :: ERR
4037  TYPE(varying_string), INTENT(OUT) :: ERROR
4038  !Local variables
4039  INTEGER(INTG) :: I,IVALUE,J,L
4040  REAL(SP) :: VALUE
4041 
4042  enters("LIST_SORT_HEAP_SP1_ARRAY",err,error,*999)
4043 
4044  IF(SIZE(a,1)>1) THEN
4045  l=SIZE(a,1)/2+1
4046  ivalue=SIZE(a,1)
4047  DO
4048  IF(l>1) THEN
4049  l=l-1
4050  VALUE=a(l)
4051  ELSE
4052  VALUE=a(ivalue)
4053  a(ivalue)=a(1)
4054  ivalue=ivalue-1
4055  IF(ivalue==1) THEN
4056  a(1)=VALUE
4057  EXIT
4058  ENDIF
4059  ENDIF
4060  i=l
4061  j=l+l
4062  DO WHILE(j<=ivalue)
4063  IF(j<ivalue) THEN
4064  IF(a(j)<a(j+1)) j=j+1
4065  ENDIF
4066  IF(VALUE<a(j)) THEN
4067  a(i)=a(j)
4068  i=j
4069  j=j+j
4070  ELSE
4071  j=ivalue+1
4072  ENDIF
4073  ENDDO
4074  a(i)=VALUE
4075  ENDDO
4076  ENDIF
4077 
4078  exits("LIST_SORT_HEAP_SP1_ARRAY")
4079  RETURN
4080 999 errorsexits("LIST_SORT_HEAP_SP1_ARRAY",err,error)
4081  RETURN 1
4082  END SUBROUTINE list_sort_heap_sp1_array
4083 
4084  !
4085  !================================================================================================================================
4086  !
4087 
4089  SUBROUTINE list_sort_heap_sp2_array(A,KEY_DIMENSION,ERR,ERROR,*)
4090 
4091  !Argument variables
4092  REAL(SP), INTENT(INOUT) :: A(:,:)
4093  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
4094  INTEGER(INTG), INTENT(OUT) :: ERR
4095  TYPE(varying_string), INTENT(OUT) :: ERROR
4096  !Local variables
4097  INTEGER(INTG) :: I,IVALUE,J,L
4098  REAL(SP) :: VALUE(size(a,1))
4099  TYPE(varying_string) :: LOCAL_ERROR
4100 
4101  enters("LIST_SORT_HEAP_SP2_ARRAY",err,error,*999)
4102 
4103  IF(key_dimension>0.AND.key_dimension<=SIZE(a,1)) THEN
4104  IF(SIZE(a,2)>1) THEN
4105  l=SIZE(a,2)/2+1
4106  ivalue=SIZE(a,2)
4107  DO
4108  IF(l>1) THEN
4109  l=l-1
4110  VALUE=a(:,l)
4111  ELSE
4112  VALUE=a(:,ivalue)
4113  a(:,ivalue)=a(:,1)
4114  ivalue=ivalue-1
4115  IF(ivalue==1) THEN
4116  a(:,1)=VALUE
4117  EXIT
4118  ENDIF
4119  ENDIF
4120  i=l
4121  j=l+l
4122  DO WHILE(j<=ivalue)
4123  IF(j<ivalue) THEN
4124  IF(a(key_dimension,j)<a(key_dimension,j+1)) j=j+1
4125  ENDIF
4126  IF(value(key_dimension)<a(key_dimension,j)) THEN
4127  a(:,i)=a(:,j)
4128  i=j
4129  j=j+j
4130  ELSE
4131  j=ivalue+1
4132  ENDIF
4133  ENDDO
4134  a(:,i)=VALUE
4135  ENDDO
4136  ENDIF
4137  ELSE
4138  local_error="The specified key dimension of "//trim(numbertovstring(key_dimension,"*",err,error))// &
4139  & " is invalid. The key dimension must be > 0 and <= "//trim(numbertovstring(SIZE(a,1),"*",err,error))//"."
4140  CALL flagerror(local_error,err,error,*999)
4141  ENDIF
4142 
4143  exits("LIST_SORT_HEAP_SP2_ARRAY")
4144  RETURN
4145 999 errorsexits("LIST_SORT_HEAP_SP2_ARRAY",err,error)
4146  RETURN 1
4147  END SUBROUTINE list_sort_heap_sp2_array
4148 
4149  !
4150  !================================================================================================================================
4151  !
4152 
4154  SUBROUTINE list_sort_heap_dp1_array(A,ERR,ERROR,*)
4155 
4156  !Argument variables
4157  REAL(DP), INTENT(INOUT) :: A(:)
4158  INTEGER(INTG), INTENT(OUT) :: ERR
4159  TYPE(varying_string), INTENT(OUT) :: ERROR
4160  !Local variables
4161  INTEGER(INTG) :: I,IVALUE,J,L
4162  REAL(DP) :: VALUE
4163 
4164  enters("LIST_SORT_HEAP_DP1_ARRAY",err,error,*999)
4165 
4166  IF(SIZE(a,1)>1) THEN
4167  l=SIZE(a,1)/2+1
4168  ivalue=SIZE(a,1)
4169  DO
4170  IF(l>1) THEN
4171  l=l-1
4172  VALUE=a(l)
4173  ELSE
4174  VALUE=a(ivalue)
4175  a(ivalue)=a(1)
4176  ivalue=ivalue-1
4177  IF(ivalue==1) THEN
4178  a(1)=VALUE
4179  EXIT
4180  ENDIF
4181  ENDIF
4182  i=l
4183  j=l+l
4184  DO WHILE(j<=ivalue)
4185  IF(j<ivalue) THEN
4186  IF(a(j)<a(j+1)) j=j+1
4187  ENDIF
4188  IF(VALUE<a(j)) THEN
4189  a(i)=a(j)
4190  i=j
4191  j=j+j
4192  ELSE
4193  j=ivalue+1
4194  ENDIF
4195  ENDDO
4196  a(i)=VALUE
4197  ENDDO
4198  ENDIF
4199 
4200  exits("LIST_SORT_HEAP_DP1_ARRAY")
4201  RETURN
4202 999 errorsexits("LIST_SORT_HEAP_DP1_ARRAY",err,error)
4203  RETURN 1
4204  END SUBROUTINE list_sort_heap_dp1_array
4205 
4206  !
4207  !================================================================================================================================
4208  !
4209 
4211  SUBROUTINE list_sort_heap_dp2_array(A,KEY_DIMENSION,ERR,ERROR,*)
4212 
4213  !Argument variables
4214  REAL(DP), INTENT(INOUT) :: A(:,:)
4215  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
4216  INTEGER(INTG), INTENT(OUT) :: ERR
4217  TYPE(varying_string), INTENT(OUT) :: ERROR
4218  !Local variables
4219  INTEGER(INTG) :: I,IVALUE,J,L
4220  REAL(DP) :: VALUE(size(a,1))
4221  TYPE(varying_string) :: LOCAL_ERROR
4222 
4223  enters("LIST_SORT_HEAP_DP2_ARRAY",err,error,*999)
4224 
4225  IF(key_dimension>0.AND.key_dimension<=SIZE(a,1)) THEN
4226  IF(SIZE(a,2)>1) THEN
4227  l=SIZE(a,2)/2+1
4228  ivalue=SIZE(a,2)
4229  DO
4230  IF(l>1) THEN
4231  l=l-1
4232  VALUE=a(:,l)
4233  ELSE
4234  VALUE=a(:,ivalue)
4235  a(:,ivalue)=a(:,1)
4236  ivalue=ivalue-1
4237  IF(ivalue==1) THEN
4238  a(:,1)=VALUE
4239  EXIT
4240  ENDIF
4241  ENDIF
4242  i=l
4243  j=l+l
4244  DO WHILE(j<=ivalue)
4245  IF(j<ivalue) THEN
4246  IF(a(key_dimension,j)<a(key_dimension,j+1)) j=j+1
4247  ENDIF
4248  IF(value(key_dimension)<a(key_dimension,j)) THEN
4249  a(:,i)=a(:,j)
4250  i=j
4251  j=j+j
4252  ELSE
4253  j=ivalue+1
4254  ENDIF
4255  ENDDO
4256  a(:,i)=VALUE
4257  ENDDO
4258  ENDIF
4259  ELSE
4260  local_error="The specified key dimension of "//trim(numbertovstring(key_dimension,"*",err,error))// &
4261  & " is invalid. The key dimension must be > 0 and <= "//trim(numbertovstring(SIZE(a,1),"*",err,error))//"."
4262  CALL flagerror(local_error,err,error,*999)
4263  ENDIF
4264 
4265  exits("LIST_SORT_HEAP_DP2_ARRAY")
4266  RETURN
4267 999 errorsexits("LIST_SORT_HEAP_DP2_ARRAY",err,error)
4268  RETURN 1
4269  END SUBROUTINE list_sort_heap_dp2_array
4270 
4271  !
4272  !================================================================================================================================
4273  !
4274 
4276  SUBROUTINE list_sort_shell_intg1_array(A,ERR,ERROR,*)
4277 
4278  !Argument variables
4279  INTEGER(INTG), INTENT(INOUT) :: A(:)
4280  INTEGER(INTG), INTENT(OUT) :: ERR
4281  TYPE(varying_string), INTENT(OUT) :: ERROR
4282  !Local variables
4283  INTEGER(INTG) :: I,INC,J,VALUE
4284 
4285  enters("LIST_SORT_SHELL_INTG1_ARRAY",err,error,*999)
4286 
4287  inc=4
4288  DO WHILE(inc<=SIZE(a,1))
4289  inc=3*inc+1
4290  ENDDO
4291  DO WHILE(inc>1)
4292  inc=inc/3
4293  DO i=inc+1,SIZE(a,1)
4294  VALUE=a(i)
4295  j=i
4296  DO WHILE(a(j-inc)>VALUE)
4297  a(j)=a(j-inc)
4298  j=j-inc
4299  IF(j<=inc) EXIT
4300  ENDDO
4301  a(j)=VALUE
4302  ENDDO !i
4303  ENDDO
4304 
4305  exits("LIST_SORT_SHELL_INTG1_ARRAY")
4306  RETURN
4307 999 errorsexits("LIST_SORT_SHELL_INTG1_ARRAY",err,error)
4308  RETURN 1
4309  END SUBROUTINE list_sort_shell_intg1_array
4310 
4311  !
4312  !================================================================================================================================
4313  !
4314 
4316  SUBROUTINE list_sort_shell_intg2_array(A,KEY_DIMENSION,ERR,ERROR,*)
4317 
4318  !Argument variables
4319  INTEGER(INTG), INTENT(INOUT) :: A(:,:)
4320  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
4321  INTEGER(INTG), INTENT(OUT) :: ERR
4322  TYPE(varying_string), INTENT(OUT) :: ERROR
4323  !Local variables
4324  INTEGER(INTG) :: I,INC,J,VALUE(size(a,1))
4325  TYPE(varying_string) :: LOCAL_ERROR
4326 
4327  enters("LIST_SORT_SHELL_INTG2_ARRAY",err,error,*999)
4328 
4329  IF(key_dimension>0.AND.key_dimension<=SIZE(a,1)) THEN
4330  inc=4
4331  DO WHILE(inc<=SIZE(a,2))
4332  inc=3*inc+1
4333  ENDDO
4334  DO WHILE(inc>1)
4335  inc=inc/3
4336  DO i=inc+1,SIZE(a,2)
4337  VALUE=a(:,i)
4338  j=i
4339  DO WHILE(a(key_dimension,j-inc)>value(key_dimension))
4340  a(:,j)=a(:,j-inc)
4341  j=j-inc
4342  IF(j<=inc) EXIT
4343  ENDDO
4344  a(:,j)=VALUE
4345  ENDDO !i
4346  ENDDO
4347  ELSE
4348  local_error="The specified key dimension of "//trim(numbertovstring(key_dimension,"*",err,error))// &
4349  & " is invalid. The key dimension must be > 0 and <= "//trim(numbertovstring(SIZE(a,1),"*",err,error))//"."
4350  CALL flagerror(local_error,err,error,*999)
4351  ENDIF
4352 
4353  exits("LIST_SORT_SHELL_INTG2_ARRAY")
4354  RETURN
4355 999 errorsexits("LIST_SORT_SHELL_INTG2_ARRAY",err,error)
4356  RETURN 1
4357  END SUBROUTINE list_sort_shell_intg2_array
4358 
4359  !
4360  !================================================================================================================================
4361  !
4362 
4364  SUBROUTINE list_sort_shell_c_int1_array(A,ERR,ERROR,*)
4365 
4366  !Argument variables
4367  INTEGER(C_INT), INTENT(INOUT) :: A(:)
4368  INTEGER(INTG), INTENT(OUT) :: ERR
4369  TYPE(varying_string), INTENT(OUT) :: ERROR
4370  !Local variables
4371  INTEGER(INTG) :: I,INC,J
4372  INTEGER(C_INT) :: VALUE
4373 
4374  enters("LIST_SORT_SHELL_C_INT1_ARRAY",err,error,*999)
4375 
4376  inc=4
4377  DO WHILE(inc<=SIZE(a,1))
4378  inc=3*inc+1
4379  ENDDO
4380  DO WHILE(inc>1)
4381  inc=inc/3
4382  DO i=inc+1,SIZE(a,1)
4383  VALUE=a(i)
4384  j=i
4385  DO WHILE(a(j-inc)>VALUE)
4386  a(j)=a(j-inc)
4387  j=j-inc
4388  IF(j<=inc) EXIT
4389  ENDDO
4390  a(j)=VALUE
4391  ENDDO !i
4392  ENDDO
4393 
4394  exits("LIST_SORT_SHELL_C_INT1_ARRAY")
4395  RETURN
4396 999 errorsexits("LIST_SORT_SHELL_C_INT1_ARRAY",err,error)
4397  RETURN 1
4398  END SUBROUTINE list_sort_shell_c_int1_array
4399 
4400  !
4401  !================================================================================================================================
4402  !
4403 
4405  SUBROUTINE list_sort_shell_c_int2_array(A,KEY_DIMENSION,ERR,ERROR,*)
4406 
4407  !Argument variables
4408  INTEGER(C_INT), INTENT(INOUT) :: A(:,:)
4409  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
4410  INTEGER(INTG), INTENT(OUT) :: ERR
4411  TYPE(varying_string), INTENT(OUT) :: ERROR
4412  !Local variables
4413  INTEGER(INTG) :: I,INC,J
4414  INTEGER(C_INT) :: VALUE(size(a,1))
4415  TYPE(varying_string) :: LOCAL_ERROR
4416 
4417  enters("LIST_SORT_SHELL_C_INT2_ARRAY",err,error,*999)
4418 
4419  IF(key_dimension>0.AND.key_dimension<=SIZE(a,1)) THEN
4420  inc=4
4421  DO WHILE(inc<=SIZE(a,2))
4422  inc=3*inc+1
4423  ENDDO
4424  DO WHILE(inc>1)
4425  inc=inc/3
4426  DO i=inc+1,SIZE(a,2)
4427  VALUE=a(:,i)
4428  j=i
4429  DO WHILE(a(key_dimension,j-inc)>value(key_dimension))
4430  a(:,j)=a(:,j-inc)
4431  j=j-inc
4432  IF(j<=inc) EXIT
4433  ENDDO
4434  a(:,j)=VALUE
4435  ENDDO !i
4436  ENDDO
4437  ELSE
4438  local_error="The specified key dimension of "//trim(numbertovstring(key_dimension,"*",err,error))// &
4439  & " is invalid. The key dimension must be > 0 and <= "//trim(numbertovstring(SIZE(a,1),"*",err,error))//"."
4440  CALL flagerror(local_error,err,error,*999)
4441  ENDIF
4442 
4443  exits("LIST_SORT_SHELL_C_INT2_ARRAY")
4444  RETURN
4445 999 errorsexits("LIST_SORT_SHELL_C_INT2_ARRAY",err,error)
4446  RETURN 1
4447  END SUBROUTINE list_sort_shell_c_int2_array
4448 
4449  !
4450  !================================================================================================================================
4451  !
4452 
4455  SUBROUTINE list_sort_shell_sp1_array(A,ERR,ERROR,*)
4456 
4457  !Argument variables
4458  REAL(SP), INTENT(INOUT) :: A(:)
4459  INTEGER(INTG), INTENT(OUT) :: ERR
4460  TYPE(varying_string), INTENT(OUT) :: ERROR
4461  !Local variables
4462  INTEGER(INTG) :: I,INC,J
4463  REAL(SP) :: VALUE
4464 
4465  enters("LIST_SORT_SHELL_SP1_ARRAY",err,error,*999)
4466 
4467  inc=4
4468  DO WHILE(inc<=SIZE(a,1))
4469  inc=3*inc+1
4470  ENDDO
4471  DO WHILE(inc>1)
4472  inc=inc/3
4473  DO i=inc+1,SIZE(a,1)
4474  VALUE=a(i)
4475  j=i
4476  DO WHILE(a(j-inc)>VALUE)
4477  a(j)=a(j-inc)
4478  j=j-inc
4479  IF(j<=inc) EXIT
4480  ENDDO
4481  a(j)=VALUE
4482  ENDDO !i
4483  ENDDO
4484 
4485  exits("LIST_SORT_SHELL_SP1_ARRAY")
4486  RETURN
4487 999 errorsexits("LIST_SORT_SHELL_SP1_ARRAY",err,error)
4488  RETURN 1
4489  END SUBROUTINE list_sort_shell_sp1_array
4490 
4491  !
4492  !================================================================================================================================
4493  !
4494 
4497  SUBROUTINE list_sort_shell_sp2_array(A,KEY_DIMENSION,ERR,ERROR,*)
4498 
4499  !Argument variables
4500  REAL(SP), INTENT(INOUT) :: A(:,:)
4501  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
4502  INTEGER(INTG), INTENT(OUT) :: ERR
4503  TYPE(varying_string), INTENT(OUT) :: ERROR
4504  !Local variables
4505  INTEGER(INTG) :: I,INC,J
4506  REAL(SP) :: VALUE(size(a,1))
4507  TYPE(varying_string) :: LOCAL_ERROR
4508 
4509  enters("LIST_SORT_SHELL_SP2_ARRAY",err,error,*999)
4510 
4511  IF(key_dimension>0.AND.key_dimension<=SIZE(a,1)) THEN
4512  inc=4
4513  DO WHILE(inc<=SIZE(a,2))
4514  inc=3*inc+1
4515  ENDDO
4516  DO WHILE(inc>1)
4517  inc=inc/3
4518  DO i=inc+1,SIZE(a,2)
4519  VALUE=a(:,i)
4520  j=i
4521  DO WHILE(a(key_dimension,j-inc)>value(key_dimension))
4522  a(:,j)=a(:,j-inc)
4523  j=j-inc
4524  IF(j<=inc) EXIT
4525  ENDDO
4526  a(:,j)=VALUE
4527  ENDDO !i
4528  ENDDO
4529  ELSE
4530  local_error="The specified key dimension of "//trim(numbertovstring(key_dimension,"*",err,error))// &
4531  & " is invalid. The key dimension must be > 0 and <= "//trim(numbertovstring(SIZE(a,1),"*",err,error))//"."
4532  CALL flagerror(local_error,err,error,*999)
4533  ENDIF
4534 
4535  exits("LIST_SORT_SHELL_SP2_ARRAY")
4536  RETURN
4537 999 errorsexits("LIST_SORT_SHELL_SP2_ARRAY",err,error)
4538  RETURN 1
4539  END SUBROUTINE list_sort_shell_sp2_array
4540 
4541  !
4542  !================================================================================================================================
4543  !
4544 
4547  SUBROUTINE list_sort_shell_dp1_array(A,ERR,ERROR,*)
4548 
4549  !Argument variables
4550  REAL(DP), INTENT(INOUT) :: A(:)
4551  INTEGER(INTG), INTENT(OUT) :: ERR
4552  TYPE(varying_string), INTENT(OUT) :: ERROR
4553  !Local variables
4554  INTEGER(INTG) :: I,INC,J
4555  REAL(DP) :: VALUE
4556 
4557  enters("LIST_SORT_SHELL_DP1_ARRAY",err,error,*999)
4558 
4559  inc=4
4560  DO WHILE(inc<=SIZE(a,1))
4561  inc=3*inc+1
4562  ENDDO
4563  DO WHILE(inc>1)
4564  inc=inc/3
4565  DO i=inc+1,SIZE(a,1)
4566  VALUE=a(i)
4567  j=i
4568  DO WHILE(a(j-inc)>VALUE)
4569  a(j)=a(j-inc)
4570  j=j-inc
4571  IF(j<=inc) EXIT
4572  ENDDO
4573  a(j)=VALUE
4574  ENDDO !i
4575  ENDDO
4576 
4577  exits("LIST_SORT_SHELL_DP1_ARRAY")
4578  RETURN
4579 999 errorsexits("LIST_SORT_SHELL_DP1_ARRAY",err,error)
4580  RETURN 1
4581  END SUBROUTINE list_sort_shell_dp1_array
4582 
4583  !
4584  !================================================================================================================================
4585  !
4586 
4589  SUBROUTINE list_sort_shell_dp2_array(A,KEY_DIMENSION,ERR,ERROR,*)
4590 
4591  !Argument variables
4592  REAL(DP), INTENT(INOUT) :: A(:,:)
4593  INTEGER(INTG), INTENT(IN) :: KEY_DIMENSION
4594  INTEGER(INTG), INTENT(OUT) :: ERR
4595  TYPE(varying_string), INTENT(OUT) :: ERROR
4596  !Local variables
4597  INTEGER(INTG) :: I,INC,J
4598  REAL(DP) :: VALUE(size(a,1))
4599  TYPE(varying_string) :: LOCAL_ERROR
4600 
4601  enters("LIST_SORT_SHELL_DP2_ARRAY",err,error,*999)
4602 
4603  IF(key_dimension>0.AND.key_dimension<=SIZE(a,1)) THEN
4604  inc=4
4605  DO WHILE(inc<=SIZE(a,2))
4606  inc=3*inc+1
4607  ENDDO
4608  DO WHILE(inc>1)
4609  inc=inc/3
4610  DO i=inc+1,SIZE(a,2)
4611  VALUE=a(:,i)
4612  j=i
4613  DO WHILE(a(key_dimension,j-inc)>value(key_dimension))
4614  a(:,j)=a(:,j-inc)
4615  j=j-inc
4616  IF(j<=inc) EXIT
4617  ENDDO
4618  a(:,j)=VALUE
4619  ENDDO !i
4620  ENDDO
4621  ELSE
4622  local_error="The specified key dimension of "//trim(numbertovstring(key_dimension,"*",err,error))// &
4623  & " is invalid. The key dimension must be > 0 and <= "//trim(numbertovstring(SIZE(a,1),"*",err,error))//"."
4624  CALL flagerror(local_error,err,error,*999)
4625  ENDIF
4626 
4627  exits("LIST_SORT_SHELL_DP1_ARRAY")
4628  RETURN
4629 999 errorsexits("LIST_SORT_SHELL_DP1_ARRAY",err,error)
4630  RETURN 1
4631  END SUBROUTINE list_sort_shell_dp2_array
4632 
4633  !
4634  !================================================================================================================================
4635  !
4636 
4638  SUBROUTINE list_intersection_intg_array(A,B,C,ERR,ERROR,*)
4639 
4640  ! Argument variables
4641  INTEGER(INTG), INTENT(IN), TARGET :: A(:)
4642  INTEGER(INTG), INTENT(IN), TARGET :: B(:)
4643  INTEGER(INTG), ALLOCATABLE, INTENT(OUT) :: C(:)
4644  INTEGER(INTG), INTENT(OUT) :: ERR
4645  TYPE(varying_string), INTENT(OUT) :: ERROR
4646  ! Local variables
4647  INTEGER(INTG) :: SIZE_SHORTER,SIZE_LONGER
4648  INTEGER(INTG) :: I,J,START,NUMBER_OF_MATCHES
4649  INTEGER(INTG), POINTER :: LONGER(:),SHORTER(:)
4650  INTEGER(INTG), ALLOCATABLE :: MATCHES(:)
4651  INTEGER(INTG), ALLOCATABLE :: LONG_ARRAY(:),SHORT_ARRAY(:)
4652 
4653  enters("LIST_INTERSECTION_INTG_ARRAY",err,error,*999)
4654 
4655  ! if the lists are small, it's probably easier to directly compare: O(n^2)
4656  ! but if they're big, sort first then compare: O(n log n)*2 + 2*O(n)
4657 
4658  IF(ALLOCATED(c)) THEN
4659  ! theoretically this cannot happen?
4660  CALL flagerror("Output array is already allocated.",err,error,*999)
4661  ELSE
4662  ! start finding the intersection
4663  NULLIFY(longer)
4664  NULLIFY(shorter)
4665  ! it's quicker to compare shorter array elements to longer ones
4666  IF(SIZE(a)>SIZE(b)) THEN
4667  longer=>a
4668  shorter=>b
4669  ELSE
4670  longer=>b
4671  shorter=>a
4672  ENDIF
4673  size_shorter=SIZE(shorter)
4674  size_longer=SIZE(longer)
4675  ALLOCATE(matches(size_shorter))
4676  number_of_matches=0
4677 
4678  ! long or short lists?
4679  IF(size_longer*size_shorter<=1e4) THEN ! a rather arbitrary cutoff...
4680  ! 'short' lists - begin comparing straight away
4681  DO i=1,size_shorter
4682  DO j=1,size_longer
4683  IF(shorter(i)==longer(j)) THEN
4684  number_of_matches=number_of_matches+1
4685  matches(number_of_matches)=shorter(i)
4686  ENDIF
4687  ENDDO
4688  ENDDO
4689  ELSE
4690  ! 'long' lists - make copies of the arrays
4691  ALLOCATE(long_array(size_longer),short_array(size_shorter))
4692  long_array(1:size_longer)=longer(1:size_longer)
4693  short_array(1:size_shorter)=shorter(1:size_shorter)
4694  ! sort both arrays
4695  CALL list_sort(long_array,err,error,*999)
4696  CALL list_sort(short_array,err,error,*999)
4697  ! compare now
4698  start=1
4699  DO i=1,size_shorter
4700  DO j=start,size_longer
4701  IF(long_array(j)==short_array(i)) THEN
4702  number_of_matches=number_of_matches+1
4703  matches(number_of_matches)=short_array(i)
4704  start=min(j+1,size_longer)
4705  EXIT
4706  ELSEIF(long_array(j)>short_array(i)) THEN
4707  ! can start here next time
4708  start=max(j-1,1)
4709  EXIT
4710  ENDIF
4711  ENDDO
4712  ENDDO
4713  DEALLOCATE(long_array,short_array)
4714  ENDIF ! long or short lists
4715  ! cut the array down to size
4716  ALLOCATE(c(number_of_matches))
4717  c(1:number_of_matches)=matches(1:number_of_matches)
4718  DEALLOCATE(matches)
4719  ENDIF
4720 
4721  exits("LIST_INTERSECTION_INTG_ARRAY")
4722  RETURN
4723 999 errorsexits("LIST_INTERSECTION_INTG_ARRAY",err,error)
4724  RETURN 1
4725 
4726  END SUBROUTINE list_intersection_intg_array
4727 
4728  !
4729  !================================================================================================================================
4730  !
4731 
4733  SUBROUTINE list_intersection_c_int_array(A,B,C,ERR,ERROR,*)
4734 
4735  ! Argument variables
4736  INTEGER(C_INT), INTENT(IN), TARGET :: A(:)
4737  INTEGER(C_INT), INTENT(IN), TARGET :: B(:)
4738  INTEGER(C_INT), ALLOCATABLE, INTENT(OUT) :: C(:)
4739  INTEGER(INTG), INTENT(OUT) :: ERR
4740  TYPE(varying_string), INTENT(OUT) :: ERROR
4741  ! Local variables
4742  INTEGER(INTG) :: SIZE_SHORTER,SIZE_LONGER
4743  INTEGER(INTG) :: I,J,START,NUMBER_OF_MATCHES
4744  INTEGER(C_INT), POINTER :: LONGER(:),SHORTER(:)
4745  INTEGER(C_INT), ALLOCATABLE :: MATCHES(:)
4746  INTEGER(C_INT), ALLOCATABLE :: LONG_ARRAY(:),SHORT_ARRAY(:)
4747 
4748  enters("LIST_INTERSECTION_C_INT_ARRAY",err,error,*999)
4749 
4750  ! if the lists are small, it's probably easier to directly compare: O(n^2)
4751  ! but if they're big, sort first then compare: O(n log n)*2 + 2*O(n)
4752 
4753  IF(ALLOCATED(c)) THEN
4754  ! theoretically this cannot happen?
4755  CALL flagerror("Output array is already allocated.",err,error,*999)
4756  ELSE
4757  ! start finding the intersection
4758  NULLIFY(longer)
4759  NULLIFY(shorter)
4760  ! it's quicker to compare shorter array elements to longer ones
4761  IF(SIZE(a)>SIZE(b)) THEN
4762  longer=>a
4763  shorter=>b
4764  ELSE
4765  longer=>b
4766  shorter=>a
4767  ENDIF
4768  size_shorter=SIZE(shorter)
4769  size_longer=SIZE(longer)
4770  ALLOCATE(matches(size_shorter))
4771  number_of_matches=0
4772 
4773  ! long or short lists?
4774  IF(size_longer*size_shorter<=1e4) THEN ! a rather arbitrary cutoff...
4775  ! 'short' lists - begin comparing straight away
4776  DO i=1,size_shorter
4777  DO j=1,size_longer
4778  IF(shorter(i)==longer(j)) THEN
4779  number_of_matches=number_of_matches+1
4780  matches(number_of_matches)=shorter(i)
4781  ENDIF
4782  ENDDO
4783  ENDDO
4784  ELSE
4785  ! 'long' lists - make copies of the arrays
4786  ALLOCATE(long_array(size_longer),short_array(size_shorter))
4787  long_array(1:size_longer)=longer(1:size_longer)
4788  short_array(1:size_shorter)=shorter(1:size_shorter)
4789  ! sort both arrays
4790  CALL list_sort(long_array,err,error,*999)
4791  CALL list_sort(short_array,err,error,*999)
4792  ! compare now
4793  start=1
4794  DO i=1,size_shorter
4795  DO j=start,size_longer
4796  IF(long_array(j)==short_array(i)) THEN
4797  number_of_matches=number_of_matches+1
4798  matches(number_of_matches)=short_array(i)
4799  start=min(j+1,size_longer)
4800  EXIT
4801  ELSEIF(long_array(j)>short_array(i)) THEN
4802  ! can start here next time
4803  start=max(j-1,1)
4804  EXIT
4805  ENDIF
4806  ENDDO
4807  ENDDO
4808  DEALLOCATE(long_array,short_array)
4809  ENDIF ! long or short lists
4810  ! cut the array down to size
4811  ALLOCATE(c(number_of_matches))
4812  c(1:number_of_matches)=matches(1:number_of_matches)
4813  DEALLOCATE(matches)
4814  ENDIF
4815 
4816  exits("LIST_INTERSECTION_C_INT_ARRAY")
4817  RETURN
4818 999 errorsexits("LIST_INTERSECTION_C_INT_ARRAY",err,error)
4819  RETURN 1
4820 
4821  END SUBROUTINE list_intersection_c_int_array
4822 
4823  !
4824  !================================================================================================================================
4825  !
4826 
4828  SUBROUTINE lists_subset_of_intg_array(A,B,SUBSET,ERR,ERROR,*)
4829  ! Argument variables
4830  INTEGER(INTG), INTENT(IN) :: A(:)
4831  INTEGER(INTG), INTENT(IN) :: B(:)
4832  LOGICAL, INTENT(OUT) :: SUBSET
4833  INTEGER(INTG), INTENT(OUT) :: ERR
4834  TYPE(varying_string), INTENT(OUT) :: ERROR
4835  ! Logical variables
4836  INTEGER(INTG) :: SIZE_A,SIZE_B,I,J,START,SIZE_REDUCE
4837  INTEGER(INTG), ALLOCATABLE :: A_SORTED(:),B_SORTED(:)
4838 
4839  enters("LISTS_SUBSET_OF_INTG_ARRAY",err,error,*999)
4840 
4841  size_a=SIZE(a)
4842  size_b=SIZE(b)
4843  subset=.false.
4844 
4845  ! some easy tests
4846  IF(size_a>size_b) THEN
4847  exits("LISTS_SUBSET_OF_INTG_ARRAY")
4848  RETURN
4849  ENDIF
4850 
4851  size_reduce=0
4852  DO i=1,size_a
4853  IF(a(i)==0) size_reduce=size_reduce+1
4854  ENDDO
4855  size_a=size_a-size_reduce
4856  size_reduce=0
4857  DO i=1,size_b
4858  IF(b(i)==0) size_reduce=size_reduce+1
4859  ENDDO
4860  size_b=size_b-size_reduce
4861 
4862  ! short of long arrays?
4863  IF(size_a*size_b<=1e4) THEN
4864  ! 'short' arrays - just compare without sorting
4865  DO i=1,size_a
4866  DO j=1,size_b
4867  IF(a(i)==b(j)) THEN
4868  EXIT
4869  ELSEIF(j==size_b) THEN
4870  exits("LISTS_SUBSET_OF_INTG_ARRAY")
4871  RETURN
4872  ENDIF
4873  ENDDO
4874  IF(i==size_a) subset=.true.
4875  ENDDO
4876  ELSE
4877  ! 'long' arrays - sort first
4878  ALLOCATE(a_sorted(size_a),b_sorted(size_b))
4879  a_sorted(1:size_a)=a(1:size_a)
4880  b_sorted(1:size_b)=b(1:size_b)
4881  CALL list_sort(a_sorted,err,error,*999)
4882  CALL list_sort(b_sorted,err,error,*999)
4883  start=1
4884  DO i=1,size_a
4885  DO j=1,size_b
4886  IF(a(i)==b(j)) THEN
4887  start=min(j+1,size_b)
4888  EXIT
4889  ELSEIF(a(i)<b(j)) THEN
4890  DEALLOCATE(a_sorted,b_sorted)
4891  exits("LISTS_SUBSET_OF_INTG_ARRAY")
4892  RETURN
4893  ENDIF
4894  ENDDO
4895  IF(i==size_a) subset=.true.
4896  ENDDO
4897  DEALLOCATE(a_sorted,b_sorted)
4898  ENDIF
4899 
4900  exits("LISTS_SUBSET_OF_INTG_ARRAY")
4901  RETURN
4902 999 errorsexits("LISTS_SUBSET_OF_INTG_ARRAY",err,error)
4903  RETURN 1
4904 
4905  END SUBROUTINE lists_subset_of_intg_array
4906 
4907  !
4908  !================================================================================================================================
4909  !
4910 
4912  SUBROUTINE lists_subset_of_c_int_array(A,B,SUBSET,ERR,ERROR,*)
4913  ! Argument variables
4914  INTEGER(C_INT), INTENT(IN) :: A(:)
4915  INTEGER(C_INT), INTENT(IN) :: B(:)
4916  LOGICAL, INTENT(OUT) :: SUBSET
4917  INTEGER(INTG), INTENT(OUT) :: ERR
4918  TYPE(varying_string), INTENT(OUT) :: ERROR
4919  ! Logical variables
4920  INTEGER(INTG) :: SIZE_A,SIZE_B,I,J,START,SIZE_REDUCE
4921  INTEGER(C_INT), ALLOCATABLE :: A_SORTED(:),B_SORTED(:)
4922 
4923  enters("LISTS_SUBSET_OF_C_INT_ARRAY",err,error,*999)
4924 
4925  size_a=SIZE(a)
4926  size_b=SIZE(b)
4927  subset=.false.
4928 
4929  ! some easy tests
4930  IF(size_a>size_b) THEN
4931  exits("LISTS_SUBSET_OF_C_INT_ARRAY")
4932  RETURN
4933  ENDIF
4934 
4935  size_reduce=0
4936  DO i=1,size_a
4937  IF(a(i)==0) size_reduce=size_reduce+1
4938  ENDDO
4939  size_a=size_a-size_reduce
4940  size_reduce=0
4941  DO i=1,size_b
4942  IF(b(i)==0) size_reduce=size_reduce+1
4943  ENDDO
4944  size_b=size_b-size_reduce
4945 
4946  ! short of long arrays?
4947  IF(size_a*size_b<=1e4) THEN
4948  ! 'short' arrays - just compare without sorting
4949  DO i=1,size_a
4950  DO j=1,size_b
4951  IF(a(i)==b(j)) THEN
4952  EXIT
4953  ELSEIF(j==size_b) THEN
4954  exits("LISTS_SUBSET_OF_C_INT_ARRAY")
4955  RETURN
4956  ENDIF
4957  ENDDO
4958  IF(i==size_a) subset=.true.
4959  ENDDO
4960  ELSE
4961  ! 'long' arrays - sort first
4962  ALLOCATE(a_sorted(size_a),b_sorted(size_b))
4963  a_sorted(1:size_a)=a(1:size_a)
4964  b_sorted(1:size_b)=b(1:size_b)
4965  CALL list_sort(a_sorted,err,error,*999)
4966  CALL list_sort(b_sorted,err,error,*999)
4967  start=1
4968  DO i=1,size_a
4969  DO j=1,size_b
4970  IF(a(i)==b(j)) THEN
4971  start=min(j+1,size_b)
4972  EXIT
4973  ELSEIF(a(i)<b(j)) THEN
4974  DEALLOCATE(a_sorted,b_sorted)
4975  exits("LISTS_SUBSET_OF_C_INT_ARRAY")
4976  RETURN
4977  ENDIF
4978  ENDDO
4979  IF(i==size_a) subset=.true.
4980  ENDDO
4981  DEALLOCATE(a_sorted,b_sorted)
4982  ENDIF
4983 
4984  exits("LISTS_SUBSET_OF_C_INT_ARRAY")
4985  RETURN
4986 999 errorsexits("LISTS_SUBSET_OF_C_INT_ARRAY",err,error)
4987  RETURN 1
4988 
4989  END SUBROUTINE lists_subset_of_c_int_array
4990 
4991  !
4992  !================================================================================================================================
4993  !
4994 
4995 END MODULE lists
lists::list_sort_heap
Sorts a list into assending order using the heap sort method.
Definition: lists.f90:283
lists::list_sort_heap_c_int2_array
subroutine list_sort_heap_c_int2_array(A, KEY_DIMENSION, ERR, ERROR,)
Sorts an integer array of data dimension > 1 list into assending order using the heap sort method...
Definition: lists.f90:3968
lists::list_search_dp_array
subroutine list_search_dp_array(A, VALUE, POSITION, ERR, ERROR,)
Searches a double precision real array list A for VALUE. If the search is successful POSITION contain...
Definition: lists.f90:2936
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
lists::list_bubble_sort_method
integer(intg), parameter list_bubble_sort_method
Bubble sort method.
Definition: lists.f90:85
lists::list_detach_and_destroy_sp2
subroutine list_detach_and_destroy_sp2(LIST, NUMBER_IN_LIST, LIST_VALUES, ERR, ERROR,)
Detaches the list values from a single precision real list of data dimension > 1 and returns them as ...
Definition: lists.f90:2487
lists::list_itemdelete
Definition: lists.f90:152
lists::list_key_dimension_set
subroutine, public list_key_dimension_set(LIST, KEY_DIMENSION, ERR, ERROR,)
Sets/changes the key dimension (i.e., the dimension for searching and sorting) for a list...
Definition: lists.f90:2254
lists::list_item_get_intg2
subroutine list_item_get_intg2(LIST, LIST_ITEM, ITEM, ERR, ERROR,)
Returns the ITEM in a list at position LIST_ITEM in the given integer LIST.
Definition: lists.f90:1639
lists::list_sort_intg1_array
subroutine list_sort_intg1_array(A, ERR, ERROR,)
Sorts an integer array list of data dimension 1 into ascending order.
Definition: lists.f90:3245
constants::zero_tolerance_sp
real(sp), parameter zero_tolerance_sp
The zero tolerance for single precision zero tests i.e., if(abs(x)>zero_tolerance) then...
Definition: constants.f90:75
lists::list_item_in_list_intg1
subroutine list_item_in_list_intg1(LIST, ITEM, LIST_ITEM, ERR, ERROR,)
Determines if ITEM is in the given integer LIST. If it is LIST_ITEM is the index in the list...
Definition: lists.f90:1907
lists::list_keydimensionset
Definition: lists.f90:214
lists::list_detach_and_destroy_dp1
subroutine list_detach_and_destroy_dp1(LIST, NUMBER_IN_LIST, LIST_VALUES, ERR, ERROR,)
Detaches the list values from a double precision real list of data dimension 1 and returns them as an...
Definition: lists.f90:2541
lists::list_detach_and_destroy_intg1
subroutine list_detach_and_destroy_intg1(LIST, NUMBER_IN_LIST, LIST_VALUES, ERR, ERROR,)
Detaches the list values from an integer list of data dimension 1 and returns them as an array of bas...
Definition: lists.f90:2324
lists::list_item_add_dp1
subroutine list_item_add_dp1(LIST, ITEM, ERR, ERROR,)
Adds an item to the end of a double precision real list of data dimension 1.
Definition: lists.f90:1132
lists::list_numberofitemsget
Definition: lists.f90:222
lists::list_search_linear_sp_array
subroutine list_search_linear_sp_array(A, VALUE, POSITION, ERR, ERROR,)
Searches a single precision real array list A for VALUE using the linear search method. If the search is successful POSITION contains the index of the position of VALUE in the list otherwise POSITION is zero.
Definition: lists.f90:3042
lists::list_subsetof
Checks whether an array is a subset of another array.
Definition: lists.f90:333
lists::list_item_in_list
Determines if an item is in a list and returns the position of the item.
Definition: lists.f90:197
lists::list_intersection_c_int_array
subroutine list_intersection_c_int_array(A, B, C, ERR, ERROR,)
Finds the intersection of two sets (arrays), leaving the original arrays intact.
Definition: lists.f90:4734
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
lists::list_number_of_items_get
subroutine, public list_number_of_items_get(LIST, NUMBER_OF_ITEMS, ERR, ERROR,)
Gets the current number of items in a list.
Definition: lists.f90:2290
constants::double_real_type
integer(intg), parameter double_real_type
Double precision real data type.
Definition: constants.f90:89
lists::list_item_in_list_sp1
subroutine list_item_in_list_sp1(LIST, ITEM, LIST_ITEM, ERR, ERROR,)
Determines if ITEM is in the given single precision real LIST. If it is LIST_ITEM is the index in the...
Definition: lists.f90:1999
lists::list_sort
Sorts a list into ascending order.
Definition: lists.f90:252
lists::list_search_linear_dp_array
subroutine list_search_linear_dp_array(A, VALUE, POSITION, ERR, ERROR,)
Searches a double precision real array list A for VALUE using the linear search method. If the search is successful POSITION contains the index of the position of VALUE in the list otherwise POSITION is zero.
Definition: lists.f90:3082
lists::list_intg_type
integer(intg), parameter, public list_intg_type
Integer data type for a list.
Definition: lists.f90:67
lists::list_item_add_sp1
subroutine list_item_add_sp1(LIST, ITEM, ERR, ERROR,)
Adds an item to the end of a single precision real list of data dimension 1.
Definition: lists.f90:1018
lists::list_datadimensionset
Definition: lists.f90:104
lists::list_sort_heap_c_int1_array
subroutine list_sort_heap_c_int1_array(A, ERR, ERROR,)
Sorts an integer array of data dimension 1 list into assending order using the heap sort method...
Definition: lists.f90:3911
lists::list_sort_sp2_array
subroutine list_sort_sp2_array(A, KEY_DIMENSION, ERR, ERROR,)
Sorts an single precision array list of data dimension > 1 into ascending order.
Definition: lists.f90:3367
lists::list_sort_c_int1_array
subroutine list_sort_c_int1_array(A, ERR, ERROR,)
Sorts an integer array list of data dimension 1 into ascending order.
Definition: lists.f90:3294
lists::list_datatypeset
Definition: lists.f90:108
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
lists::list_remove_duplicates
subroutine, public list_remove_duplicates(LIST, ERR, ERROR,)
Removes duplicate entries from a list. A side effect of this is that the list is sorted.
Definition: lists.f90:2648
lists::list_itersection
Calculates the intersection of two arrays.
Definition: lists.f90:323
lists::list_item_set_intg2
subroutine list_item_set_intg2(LIST, LIST_ITEM, ITEM, ERR, ERROR,)
Set an item in an integer list of data dimension > 1.
Definition: lists.f90:1303
lists::list_item_add_dp2
subroutine list_item_add_dp2(LIST, ITEM, ERR, ERROR,)
Adds an item to the end of a double precision real list of data dimension > 1.
Definition: lists.f90:1189
lists::list_sort_bubble_intg2_array
subroutine list_sort_bubble_intg2_array(A, KEY_DIMENSION, ERR, ERROR,)
BUBBLE_SORT_INTG performs a bubble sort on an integer array of data dimension > 1 list...
Definition: lists.f90:3480
lists::list_search_sp_array
subroutine list_search_sp_array(A, VALUE, POSITION, ERR, ERROR,)
Searches a single precision real array list A for VALUE. If the search is successful POSITION contain...
Definition: lists.f90:2910
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
lists::list_sort_bubble_dp2_array
subroutine list_sort_bubble_dp2_array(A, KEY_DIMENSION, ERR, ERROR,)
BUBBLE_SORT_DP performs a bubble sort on a double precision of data dimension > 1 list...
Definition: lists.f90:3743
constants
This module contains all program wide constants.
Definition: constants.f90:45
lists::list_sortbubble
Sorts a list into assending order using the bubble sort method.
Definition: lists.f90:273
lists::list_sort_heap_sp2_array
subroutine list_sort_heap_sp2_array(A, KEY_DIMENSION, ERR, ERROR,)
Sorts a real single precision array of data dimension > 1 list into assending order using the heap so...
Definition: lists.f90:4090
lists::list_sort_shell_dp1_array
subroutine list_sort_shell_dp1_array(A, ERR, ERROR,)
Sorts a real double precision array of data dimension 1 list into either assending or descending orde...
Definition: lists.f90:4548
lists::list_createstart
Definition: lists.f90:100
lists::list_item_set_dp2
subroutine list_item_set_dp2(LIST, LIST_ITEM, ITEM, ERR, ERROR,)
Sets an item in a double precision real list of data dimension > 1.
Definition: lists.f90:1529
lists::list_createfinish
Definition: lists.f90:96
lists::list_iteminlist
Determines if an item is in a list and returns the position of the item.
Definition: lists.f90:204
lists::list_sort_list
subroutine list_sort_list(LIST, ERR, ERROR,)
Sorts a list of into ascending order.
Definition: lists.f90:3122
lists::list_detach_and_destroy
Detaches the list values from a list and returns them as a pointer to a array of base type before des...
Definition: lists.f90:113
lists::lists_subset_of_c_int_array
subroutine lists_subset_of_c_int_array(A, B, SUBSET, ERR, ERROR,)
Finds out whether array A is a subset of array B.
Definition: lists.f90:4913
lists::list_sort_bubble
Sorts a list into assending order using the bubble sort method.
Definition: lists.f90:263
lists::list_sort_bubble_c_int1_array
subroutine list_sort_bubble_c_int1_array(A, ERR, ERROR,)
BUBBLE_SORT_C_INT performs a bubble sort on an integer array of data dimension 1 list.
Definition: lists.f90:3527
lists::list_item_in_list_sp2
subroutine list_item_in_list_sp2(LIST, ITEM, LIST_ITEM, ERR, ERROR,)
Determines if ITEM is in the given single precision real LIST. If it is LIST_ITEM is the index in the...
Definition: lists.f90:2045
lists::list_mutableset
Definition: lists.f90:218
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
lists::list_sort_heap_dp1_array
subroutine list_sort_heap_dp1_array(A, ERR, ERROR,)
Sorts a real double precision array of data dimension 1 list into assending order using the heap sort...
Definition: lists.f90:4155
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
lists::list_sort_heap_dp2_array
subroutine list_sort_heap_dp2_array(A, KEY_DIMENSION, ERR, ERROR,)
Sorts a real double precision array of data dimension > 1 list into assending order using the heap so...
Definition: lists.f90:4212
lists::list_sort_bubble_dp1_array
subroutine list_sort_bubble_dp1_array(A, ERR, ERROR,)
BUBBLE_SORT_DP performs a bubble sort on a double precision of data dimension 1 list.
Definition: lists.f90:3703
lists::list_item_get_intg1
subroutine list_item_get_intg1(LIST, LIST_ITEM, ITEM, ERR, ERROR,)
Returns the ITEM in a list at position LIST_ITEM in the given integer LIST.
Definition: lists.f90:1586
lists::list_intersection_intg_array
subroutine list_intersection_intg_array(A, B, C, ERR, ERROR,)
Finds the intersection of two sets (arrays), leaving the original arrays intact.
Definition: lists.f90:4639
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
lists::list_item_add_intg1
subroutine list_item_add_intg1(LIST, ITEM, ERR, ERROR,)
Adds an item to the end of an integer list of data dimension 1.
Definition: lists.f90:902
lists::list_item_in_list_dp2
subroutine list_item_in_list_dp2(LIST, ITEM, LIST_ITEM, ERR, ERROR,)
Determines if ITEM is in the given double precision real LIST. If it is LIST_ITEM is the index in the...
Definition: lists.f90:2138
lists::list_sort_dp2_array
subroutine list_sort_dp2_array(A, KEY_DIMENSION, ERR, ERROR,)
Sorts an double precision array list of data dimension > 1 into ascending order.
Definition: lists.f90:3416
lists::list_item_set_intg1
subroutine list_item_set_intg1(LIST, LIST_ITEM, ITEM, ERR, ERROR,)
Sets an item in an integer list of data dimension 1.
Definition: lists.f90:1247
lists::list_item_get_sp2
subroutine list_item_get_sp2(LIST, LIST_ITEM, ITEM, ERR, ERROR,)
Returns the ITEM in a list at position LIST_ITEM in the given single precision LIST.
Definition: lists.f90:1746
lists::list_sort_descending_type
integer(intg), parameter list_sort_descending_type
Descending order for sort.
Definition: lists.f90:78
iso_varying_string::trim
Definition: iso_varying_string.f90:204
lists::list_create_finish
subroutine, public list_create_finish(LIST, ERR, ERROR,)
Finishes the creation of a list created with LIST_CREATE_START.
Definition: lists.f90:419
lists::list_sp_type
integer(intg), parameter, public list_sp_type
Single precision real data type for a list.
Definition: lists.f90:68
lists::list_item_in_list_dp1
subroutine list_item_in_list_dp1(LIST, ITEM, LIST_ITEM, ERR, ERROR,)
Determines if ITEM is in the given double precision real LIST. If it is LIST_ITEM is the index in the...
Definition: lists.f90:2092
lists::list_sort_shell_c_int2_array
subroutine list_sort_shell_c_int2_array(A, KEY_DIMENSION, ERR, ERROR,)
Sorts an integer array of data dimension > 1 list into either assending or descending order using the...
Definition: lists.f90:4406
lists::list_item_set_sp1
subroutine list_item_set_sp1(LIST, LIST_ITEM, ITEM, ERR, ERROR,)
Sets an item in a single precision real list of data dimension 1.
Definition: lists.f90:1361
lists::list_shell_sort_method
integer(intg), parameter list_shell_sort_method
Shell sort method.
Definition: lists.f90:86
types::list_type
Contains information on a list.
Definition: types.f90:113
lists::list_item_add_intg2
subroutine list_item_add_intg2(LIST, ITEM, ERR, ERROR,)
Adds an item to the end of an integer list of data dimension > 1.
Definition: lists.f90:959
lists::list_sort_heap_intg1_array
subroutine list_sort_heap_intg1_array(A, ERR, ERROR,)
Sorts an integer array of data dimension 1 list into assending order using the heap sort method...
Definition: lists.f90:3791
lists::list_detach_and_destroy_intg2
subroutine list_detach_and_destroy_intg2(LIST, NUMBER_IN_LIST, LIST_VALUES, ERR, ERROR,)
Detaches the list values from an integer list of data dimension > 1 and returns them as an array of b...
Definition: lists.f90:2379
lists::list_item_get_dp1
subroutine list_item_get_dp1(LIST, LIST_ITEM, ITEM, ERR, ERROR,)
Returns the ITEM in a list at position LIST_ITEM in the given double precision LIST.
Definition: lists.f90:1800
lists::list_finalise
subroutine list_finalise(LIST, ERR, ERROR,)
Finalises a list and deallocates all memory.
Definition: lists.f90:649
lists::list_item_delete
subroutine, public list_item_delete(LIST, LIST_ITEM, ERR, ERROR,)
Deletes the item given by the LIST_ITEM index from the given list.
Definition: lists.f90:2184
lists::list_itemadd
Adds an item to the end of a list.
Definition: lists.f90:143
lists::list_data_dimension_set
subroutine, public list_data_dimension_set(LIST, DATA_DIMENSION, ERR, ERROR,)
Sets/changes the data dimension for a list.
Definition: lists.f90:509
lists::list_initialise
subroutine list_initialise(LIST, ERR, ERROR,)
Initialises a list and all its components.
Definition: lists.f90:822
lists::list_initialsizeset
Definition: lists.f90:210
lists::list_mutable_set
subroutine, public list_mutable_set(LIST, MUTABLE, ERR, ERROR,)
Sets/changes the data dimension for a list.
Definition: lists.f90:548
lists::list_sort_shell_intg1_array
subroutine list_sort_shell_intg1_array(A, ERR, ERROR,)
Sorts an integer array of data dimension 1 list into either assending or descending order using the s...
Definition: lists.f90:4277
lists::list_sort_shell_sp1_array
subroutine list_sort_shell_sp1_array(A, ERR, ERROR,)
Sorts a real single precision array of data dimension 1 list into either assending or descending orde...
Definition: lists.f90:4456
lists::list_searchlinear
Searches a list using the linear search method.
Definition: lists.f90:245
lists::list_sort_bubble_intg1_array
subroutine list_sort_bubble_intg1_array(A, ERR, ERROR,)
BUBBLE_SORT_INTG performs a bubble sort on an integer array of data dimension 1 list.
Definition: lists.f90:3441
lists::list_item_get
Returns an item in a list at a specififed position.
Definition: lists.f90:177
lists::list_sort_ascending_type
integer(intg), parameter list_sort_ascending_type
Ascending order for sort.
Definition: lists.f90:77
lists::list_sort_shell_dp2_array
subroutine list_sort_shell_dp2_array(A, KEY_DIMENSION, ERR, ERROR,)
Sorts a real double precision array of data dimension 2 list into either assending or descending orde...
Definition: lists.f90:4590
lists::list_heap_sort_method
integer(intg), parameter list_heap_sort_method
Heap sort method.
Definition: lists.f90:87
lists::list_sortheap
Sorts a list into assending order using the heap sort method.
Definition: lists.f90:293
lists::list_search_linear_intg_array
subroutine list_search_linear_intg_array(A, VALUE, POSITION, ERR, ERROR,)
Searches an integer array list A for VALUE using the linear search method. If the search is successfu...
Definition: lists.f90:2962
lists::list_detach_and_destroy_sp1
subroutine list_detach_and_destroy_sp1(LIST, NUMBER_IN_LIST, LIST_VALUES, ERR, ERROR,)
Detaches the list values from a single precision real list of data dimension 1 and returns them as an...
Definition: lists.f90:2433
lists::list_create_start
subroutine, public list_create_start(LIST, ERR, ERROR,)
Starts the creation of a list and returns a pointer to the created list.
Definition: lists.f90:486
lists::list_subset_of
Checks whether an array is a subset of another array.
Definition: lists.f90:328
lists::list_item_set_dp1
subroutine list_item_set_dp1(LIST, LIST_ITEM, ITEM, ERR, ERROR,)
Sets an item in a double precision real list of data dimension 1.
Definition: lists.f90:1473
lists::list_search
Searches a list for a given value and returns the position in the list if the value exists...
Definition: lists.f90:231
lists::list_item_set
Sets an item in the list.
Definition: lists.f90:157
lists::list_sortshell
Sorts a list into either assending or descending order using the shell sort method.
Definition: lists.f90:313
lists::list_sort_intg2_array
subroutine list_sort_intg2_array(A, KEY_DIMENSION, ERR, ERROR,)
Sorts an integer array list of data dimension > 1 into ascending order.
Definition: lists.f90:3269
lists::list_itemset
Sets an item in the list.
Definition: lists.f90:167
lists::list_item_add
Adds an item to the end of a list.
Definition: lists.f90:133
lists::list_clearitems
subroutine, public list_clearitems(list, err, error,)
Clears all the items from a list.
Definition: lists.f90:790
lists::list_sort_shell
Sorts a list into either assending or descending order using the shell sort method.
Definition: lists.f90:303
lists::list_sort_heap_intg2_array
subroutine list_sort_heap_intg2_array(A, KEY_DIMENSION, ERR, ERROR,)
Sorts an integer array of data dimension > 1 list into assending order using the heap sort method...
Definition: lists.f90:3847
constants::single_real_type
integer(intg), parameter single_real_type
Single precision real data type.
Definition: constants.f90:88
lists::list_dp_type
integer(intg), parameter, public list_dp_type
Double precision real data type for a list.
Definition: lists.f90:69
lists
Implements lists of base types.
Definition: lists.f90:46
lists::list_detachanddestroy
Detaches the list values from a list and returns them as a pointer to a array of base type before des...
Definition: lists.f90:123
lists::list_data_type_set
subroutine, public list_data_type_set(LIST, DATA_TYPE, ERR, ERROR,)
Sets/changes the data type for a list.
Definition: lists.f90:579
lists::list_removeduplicates
Definition: lists.f90:226
lists::list_destroy
subroutine, public list_destroy(LIST, ERR, ERROR,)
Destroys a list.
Definition: lists.f90:622
lists::list_sort_sp1_array
subroutine list_sort_sp1_array(A, ERR, ERROR,)
Sorts an single precision array list of data dimension 1 into ascending order.
Definition: lists.f90:3343
lists::list_detach_and_destroy_dp2
subroutine list_detach_and_destroy_dp2(LIST, NUMBER_IN_LIST, LIST_VALUES, ERR, ERROR,)
Detaches the list values from a double precision real list of data dimension > 1 and returns them as ...
Definition: lists.f90:2596
lists::list_itemget
Returns an item in a list at a specififed position.
Definition: lists.f90:187
lists::list_sort_c_int2_array
subroutine list_sort_c_int2_array(A, KEY_DIMENSION, ERR, ERROR,)
Sorts an integer array list of data dimension > 1 into ascending order.
Definition: lists.f90:3318
lists::list_item_in_list_intg2
subroutine list_item_in_list_intg2(LIST, ITEM, LIST_ITEM, ERR, ERROR,)
Determines if ITEM is in the given integer LIST. If it is LIST_ITEM is the index in the list...
Definition: lists.f90:1952
lists::list_unsorted_type
integer(intg), parameter list_unsorted_type
Unsorted list type.
Definition: lists.f90:76
lists::list_sort_bubble_sp2_array
subroutine list_sort_bubble_sp2_array(A, KEY_DIMENSION, ERR, ERROR,)
BUBBLE_SORT_SP performs a bubble sort on a single precision array of data dimension > 1 list...
Definition: lists.f90:3655
lists::list_item_get_dp2
subroutine list_item_get_dp2(LIST, LIST_ITEM, ITEM, ERR, ERROR,)
Returns the ITEM in a list at position LIST_ITEM in the given double precision LIST.
Definition: lists.f90:1853
lists::list_search_linear_c_int_array
subroutine list_search_linear_c_int_array(A, VALUE, POSITION, ERR, ERROR,)
Searches an integer array list A for VALUE using the linear search method. If the search is successfu...
Definition: lists.f90:3002
lists::list_item_add_sp2
subroutine list_item_add_sp2(LIST, ITEM, ERR, ERROR,)
Adds an item to the end of a single precision real list of data dimension > 1.
Definition: lists.f90:1074
lists::lists_subset_of_intg_array
subroutine lists_subset_of_intg_array(A, B, SUBSET, ERR, ERROR,)
Finds out whether array A is a subset of array B.
Definition: lists.f90:4829
lists::list_search_linear
Searches a list using the linear search method.
Definition: lists.f90:238
lists::list_search_intg_array
subroutine list_search_intg_array(A, VALUE, POSITION, ERR, ERROR,)
Searches an integer array list A for VALUE. If the search is successful POSITION contains the index o...
Definition: lists.f90:2858
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
lists::list_item_set_sp2
subroutine list_item_set_sp2(LIST, LIST_ITEM, ITEM, ERR, ERROR,)
Sets an item in a single precision real list of data dimension > 1.
Definition: lists.f90:1416
lists::list_sort_dp1_array
subroutine list_sort_dp1_array(A, ERR, ERROR,)
Sorts an double precision array list of data dimension 1 into ascending order.
Definition: lists.f90:3392
constants::integer_type
integer(intg), parameter integer_type
Integer data type.
Definition: constants.f90:85
lists::list_sort_shell_sp2_array
subroutine list_sort_shell_sp2_array(A, KEY_DIMENSION, ERR, ERROR,)
Sorts a real single precision array of data dimension > 1 list into either assending or descending or...
Definition: lists.f90:4498
lists::list_initial_size_set
subroutine, public list_initial_size_set(LIST, INITIAL_SIZE, ERR, ERROR,)
Sets/changes the initial size for a list.
Definition: lists.f90:863
constants::zero_tolerance
real(dp), parameter zero_tolerance
Definition: constants.f90:70
lists::list_item_get_sp1
subroutine list_item_get_sp1(LIST, LIST_ITEM, ITEM, ERR, ERROR,)
Returns the ITEM in a list at position LIST_ITEM in the given single precision LIST.
Definition: lists.f90:1693
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
lists::list_sort_shell_intg2_array
subroutine list_sort_shell_intg2_array(A, KEY_DIMENSION, ERR, ERROR,)
Sorts an integer array of data dimension > 1 list into either assending or descending order using the...
Definition: lists.f90:4317
lists::list_search_c_int_array
subroutine list_search_c_int_array(A, VALUE, POSITION, ERR, ERROR,)
Searches an integer array list A for VALUE. If the search is successful POSITION contains the index o...
Definition: lists.f90:2884
lists::list_sort_heap_sp1_array
subroutine list_sort_heap_sp1_array(A, ERR, ERROR,)
Sorts a real single precision array of data dimension 1 list into assending order using the heap sort...
Definition: lists.f90:4033
lists::list_sort_bubble_c_int2_array
subroutine list_sort_bubble_c_int2_array(A, KEY_DIMENSION, ERR, ERROR,)
BUBBLE_SORT_C_INT performs a bubble sort on an integer array of data dimension > 1 list...
Definition: lists.f90:3567
lists::list_sort_bubble_sp1_array
subroutine list_sort_bubble_sp1_array(A, ERR, ERROR,)
BUBBLE_SORT_SP performs a bubble sort on a single precision array of data dimension 1 list...
Definition: lists.f90:3615
lists::list_sort_shell_c_int1_array
subroutine list_sort_shell_c_int1_array(A, ERR, ERROR,)
Sorts an integer array of data dimension 1 list into either assending or descending order using the s...
Definition: lists.f90:4365
lists::list_appendlist
subroutine, public list_appendlist(list, appendedList, err, error,)
Appends a list to the end of this list.
Definition: lists.f90:680