MONC
collections.F90
Go to the documentation of this file.
1 
11  use logging_mod, only : log_error, log_log
12  implicit none
13 
14 #ifndef TEST_MODE
15  private
16 #endif
17 
20  integer, parameter, private :: hash_size = 4993
21 
24  type(listnode_type), pointer :: next=>null(),&
25  prev=>null()
27  class(*), pointer :: data => null()
28  logical :: memory_allocation_automatic
29  end type listnode_type
30 
33  logical :: memory_allocation_automatic
35  character(len=STRING_LENGTH) :: key
37  class(*), pointer :: value => null()
38  end type mapnode_type
39 
43  character(len=STRING_LENGTH) :: key
44  end type setnode_type
45 
46  type, public :: mapentry_type
47  character(len=STRING_LENGTH) :: key
48  class(*), pointer :: value => null()
49  end type mapentry_type
50 
51  type, public :: iterator_type
52  type(listnode_type), pointer :: next_item
53  type(list_type), dimension(:), pointer :: hash_structure
54  integer :: hash_ptr
55  end type iterator_type
56 
60  type, public :: list_type
61  type(listnode_type), pointer, private :: head=>null(),&
62  tail=>null()
64  integer, private :: size=0
65  end type list_type
66 
70  type, public :: queue_type
72  type(list_type), private :: queue_ds
73  end type queue_type
74 
78  type, public :: stack_type
80  type(list_type), private :: stack_ds
81  end type stack_type
82 
86  type, public :: map_type
88  type(list_type), private :: map_ds
89  end type map_type
90 
94  type, public :: hashmap_type
96  type(list_type), pointer, dimension(:), private :: map_ds => null()
97  integer, private :: size=0
98  end type hashmap_type
99 
102  type, public :: hashset_type
103  type(list_type), pointer, dimension(:), private :: set_ds => null()
104  integer, private :: size=0
105  end type hashset_type
106 
113  interface c_push_generic
114  module procedure stack_push_generic, queue_push_generic
115  end interface c_push_generic
116 
122  interface c_push_integer
123  module procedure stack_push_int, queue_push_int
124  end interface c_push_integer
125 
131  interface c_push_string
132  module procedure stack_push_string, queue_push_string
133  end interface c_push_string
134 
140  interface c_push_real
141  module procedure stack_push_real, queue_push_real
142  end interface c_push_real
143 
149  interface c_push_logical
150  module procedure stack_push_logical, queue_push_logical
151  end interface c_push_logical
152 
158  interface c_pop_generic
159  module procedure stack_pop_generic, queue_pop_generic
160  end interface c_pop_generic
161 
167  interface c_pop_integer
168  module procedure stack_pop_int, queue_pop_int
169  end interface c_pop_integer
170 
176  interface c_pop_string
177  module procedure stack_pop_string, queue_pop_string
178  end interface c_pop_string
179 
185  interface c_pop_real
186  module procedure stack_pop_real, queue_pop_real
187  end interface c_pop_real
188 
194  interface c_pop_logical
195  module procedure stack_pop_logical, queue_pop_logical
196  end interface c_pop_logical
197 
204  interface c_add_generic
205  module procedure list_add_generic
206  end interface c_add_generic
207 
213  interface c_add_integer
214  module procedure list_add_int
215  end interface c_add_integer
216 
222  interface c_add_string
223  module procedure list_add_string, hashset_add
224  end interface c_add_string
225 
231  interface c_add_real
232  module procedure list_add_real
233  end interface c_add_real
234 
240  interface c_add_logical
241  module procedure list_add_logical
242  end interface c_add_logical
243 
252  module procedure list_insert_generic
253  end interface c_insert_generic
254 
262  module procedure list_insert_int
263  end interface c_insert_integer
264 
271  interface c_insert_string
272  module procedure list_insert_string
273  end interface c_insert_string
274 
281  interface c_insert_real
282  module procedure list_insert_real
283  end interface c_insert_real
284 
292  module procedure list_insert_logical
293  end interface c_insert_logical
294 
305  interface c_put_generic
306  module procedure map_put_generic, hashmap_put_generic
307  end interface c_put_generic
308 
318  interface c_put_integer
319  module procedure map_put_int, hashmap_put_int
320  end interface c_put_integer
321 
331  interface c_put_string
332  module procedure map_put_string, hashmap_put_string
333  end interface c_put_string
334 
344  interface c_put_real
345  module procedure map_put_real, hashmap_put_real
346  end interface c_put_real
347 
357  interface c_put_logical
358  module procedure map_put_logical, hashmap_put_logical
359  end interface c_put_logical
360 
367  interface c_get_generic
370  end interface c_get_generic
371 
378  interface c_get_integer
380  end interface c_get_integer
381 
388  interface c_get_string
391  end interface c_get_string
392 
399  interface c_get_real
401  end interface c_get_real
402 
409  interface c_get_logical
412  end interface c_get_logical
413 
419  interface c_remove
421  end interface c_remove
422 
428  interface c_size
430  end interface c_size
431 
437  interface c_is_empty
439  end interface c_is_empty
440 
447  interface c_contains
449  end interface c_contains
450 
457  interface c_key_at
458  module procedure map_key_at, hashmap_key_at
459  end interface c_key_at
460 
467  interface c_generic_at
468  module procedure map_generic_at, hashmap_generic_at
469  end interface c_generic_at
470 
477  interface c_integer_at
478  module procedure map_integer_at, hashmap_integer_at
479  end interface c_integer_at
480 
487  interface c_string_at
488  module procedure map_string_at, hashmap_string_at
489  end interface c_string_at
490 
497  interface c_real_at
498  module procedure map_real_at, hashmap_real_at
499  end interface c_real_at
500 
507  interface c_logical_at
508  module procedure map_logical_at, hashmap_logical_at
509  end interface c_logical_at
510 
521  end interface c_generic_entry_at
522 
533  end interface c_integer_entry_at
534 
545  end interface c_string_entry_at
546 
555  interface c_real_entry_at
556  module procedure map_real_entry_at, hashmap_real_entry_at
557  end interface c_real_entry_at
558 
569  end interface c_logical_entry_at
570 
577  interface c_free
579  end interface c_free
580 
581  interface c_get_iterator
584  end interface c_get_iterator
585 
586  interface c_has_next
587  module procedure iteratior_has_next
588  end interface c_has_next
589 
590  interface c_next_integer
591  module procedure iterator_get_next_integer
592  end interface c_next_integer
593 
594  interface c_next_string
595  module procedure iterator_get_next_string
596  end interface c_next_string
597 
598  interface c_next_real
599  module procedure iterator_get_next_real
600  end interface c_next_real
601 
602  interface c_next_logical
603  module procedure iterator_get_next_logical
604  end interface c_next_logical
605 
606  interface c_next_mapentry
607  module procedure iterator_get_next_mapentry
608  end interface c_next_mapentry
609 
610  interface c_next_generic
611  module procedure iterator_get_next_generic
612  end interface c_next_generic
613 
614  ! Explicit public interfaces and data items
622 contains
623 
627  type(iterator_type) function map_get_iterator(specificmap)
628  type(map_type), intent(inout) :: specificmap
629 
630  map_get_iterator%next_item=>specificmap%map_ds%head
631  map_get_iterator%hash_structure=>null()
632  map_get_iterator%hash_ptr=0
633  end function map_get_iterator
634 
644  subroutine map_put_int(specificmap, key, int_data)
645  type(map_type), intent(inout) :: specificmap
646  integer, intent(in) :: int_data
647  character(len=*), intent(in) :: key
648 
649  class(*), pointer :: generic
650 
651  generic=>conv_to_generic(int_data, .true.)
652  call map_put_generic(specificmap, key, generic, .true.)
653  end subroutine map_put_int
654 
664  subroutine map_put_string(specificmap, key, str_data)
665  type(map_type), intent(inout) :: specificmap
666  character(len=STRING_LENGTH), intent(in) :: str_data
667  character(len=*), intent(in) :: key
668 
669  class(*), pointer :: generic
670 
671  generic=>conv_to_generic(str_data, .true.)
672  call map_put_generic(specificmap, key, generic, .true.)
673  end subroutine map_put_string
674 
684  subroutine map_put_real(specificmap, key, real_data)
685  type(map_type), intent(inout) :: specificmap
686  real(kind=DEFAULT_PRECISION), intent(in) :: real_data
687  character(len=*), intent(in) :: key
688 
689  class(*), pointer :: generic
690 
691  generic=>conv_to_generic(real_data, .true.)
692  call map_put_generic(specificmap, key, generic, .true.)
693  end subroutine map_put_real
694 
704  subroutine map_put_logical(specificmap, key, logical_data)
705  type(map_type), intent(inout) :: specificmap
706  logical, intent(in) :: logical_data
707  character(len=*), intent(in) :: key
708 
709  class(*), pointer :: generic
710 
711  generic=>conv_to_generic(logical_data, .true.)
712  call map_put_generic(specificmap, key, generic, .true.)
713  end subroutine map_put_logical
714 
725  subroutine map_put_generic(specificmap, key, data, memory_allocation_automatic)
726  type(map_type), intent(inout) :: specificmap
727  class(*), pointer, intent(in) :: data
728  character(len=*), intent(in) :: key
729  logical, intent(in) :: memory_allocation_automatic
730 
731  class(*), pointer :: raw_map_node, generic_map_node
732  type(mapnode_type), pointer :: newmapnode
733 
734  ! Test to see if key already exists in the map
735  raw_map_node=>map_getnode(specificmap, key)
736 
737  if (associated(raw_map_node)) then
738  select type(raw_map_node)
739  type is (mapnode_type)
740  raw_map_node%value => data
741  end select
742  else
743  allocate(newmapnode)
744  newmapnode%value => data
745  newmapnode%key = key
746  newmapnode%memory_allocation_automatic=memory_allocation_automatic
747  ! Clone and deallocate the newmapnode - this keeps GNU happy with passing the correct pointer and Cray
748  ! doesn't link the generic pointer just pointing to the data structure hence we clone it
749  allocate(generic_map_node, source=newmapnode)
750  deallocate(newmapnode)
751  call list_add_generic(specificmap%map_ds, generic_map_node, .false.)
752  end if
753  end subroutine map_put_generic
754 
761  logical function map_contains_key(specificmap, key)
762  type(map_type), intent(inout) :: specificmap
763  character(len=*), intent(in) :: key
764 
765  integer :: key_location
766  class(*), pointer :: raw_map_node
767 
768  raw_map_node => map_getnode(specificmap, key, key_location)
769  map_contains_key = key_location .gt. 0
770  end function map_contains_key
771 
778  character(len=STRING_LENGTH) function map_key_at(specificmap, i)
779  type(map_type), intent(inout) :: specificmap
780  integer, intent(in) :: i
781 
782  class(*), pointer :: raw_map_node
783  integer :: the_map_size
784 
785  the_map_size = map_size(specificmap)
786  if (i .le. the_map_size) then
787  raw_map_node=>list_get_generic(specificmap%map_ds, i)
788  if (associated(raw_map_node)) then
789  select type(raw_map_node)
790  type is(mapnode_type)
791  map_key_at = raw_map_node%key
792  end select
793  return
794  end if
795  end if
796  map_key_at=""
797  end function map_key_at
798 
805  function map_integer_at(specificmap, i)
806  type(map_type), intent(inout) :: specificmap
807  integer, intent(in) :: i
808  integer :: map_integer_at
809 
810  class(*), pointer :: generic
811 
812  generic=>map_generic_at(specificmap, i)
813  if (.not. associated(generic)) call log_log(log_error, "Can not find integer at "//trim(conv_to_string(i)))
814  map_integer_at=conv_to_integer(generic, .false.)
815  end function map_integer_at
816 
823  function map_string_at(specificmap, i)
824  type(map_type), intent(inout) :: specificmap
825  integer, intent(in) :: i
826  character(len=STRING_LENGTH) :: map_string_at
827 
828  class(*), pointer :: generic
829 
830  generic=>map_generic_at(specificmap, i)
831  if (.not. associated(generic)) call log_log(log_error, "Can not find string at "//trim(conv_to_string(i)))
832  map_string_at=conv_to_string(generic, .false., string_length)
833  end function map_string_at
834 
841  function map_real_at(specificmap, i)
842  type(map_type), intent(inout) :: specificmap
843  integer, intent(in) :: i
844  real(kind=DEFAULT_PRECISION) :: map_real_at
845 
846  class(*), pointer :: generic
847 
848  generic=>map_generic_at(specificmap, i)
849  if (.not. associated(generic)) call log_log(log_error, "Can not find real at "//trim(conv_to_string(i)))
850  select type(vr=>generic)
851  type is (real(kind=default_precision))
852  map_real_at=vr
853  type is (real)
854  map_real_at=conv_single_real_to_double(vr)
855  type is (integer)
856  map_real_at=conv_single_real_to_double(conv_to_real(vr))
857  end select
858  end function map_real_at
859 
866  function map_logical_at(specificmap, i)
867  type(map_type), intent(inout) :: specificmap
868  integer, intent(in) :: i
869  logical :: map_logical_at
870 
871  class(*), pointer :: generic
872 
873  generic=>map_generic_at(specificmap, i)
874  if (.not. associated(generic)) call log_log(log_error, "Can not find logical at "//trim(conv_to_string(i)))
875  map_logical_at=conv_to_logical(generic, .false.)
876  end function map_logical_at
877 
884  function map_generic_at(specificmap, i)
885  type(map_type), intent(inout) :: specificmap
886  integer, intent(in) :: i
887 
888  class(*), pointer :: raw_map_node, map_generic_at
889  integer :: the_map_size
890 
891  the_map_size = map_size(specificmap)
892  if (i .le. the_map_size) then
893  raw_map_node=>list_get_generic(specificmap%map_ds, i)
894  if (associated(raw_map_node)) then
895  select type(raw_map_node)
896  type is (mapnode_type)
897  map_generic_at => raw_map_node%value
898  end select
899  return
900  end if
901  end if
902  map_generic_at=>null()
903  end function map_generic_at
904 
912  logical function map_integer_entry_at(specificmap, i, key, int_val)
913  type(map_type), intent(inout) :: specificmap
914  integer, intent(in) :: i
915  character(len=*), intent(out) :: key
916  integer, intent(out) :: int_val
917 
918  class(*), pointer :: generic
919 
920  map_integer_entry_at=map_generic_entry_at(specificmap, i, key, generic)
921  if (.not. associated(generic)) call log_log(log_error, "Can not find integer entry with key '"//trim(key)//"'")
922  int_val=conv_to_integer(generic, .false.)
923  end function map_integer_entry_at
924 
932  logical function map_string_entry_at(specificmap, i, key, str_val)
933  type(map_type), intent(inout) :: specificmap
934  integer, intent(in) :: i
935  character(len=*), intent(out) :: key
936  character(len=STRING_LENGTH), intent(out) :: str_val
937 
938  class(*), pointer :: generic
939 
940  map_string_entry_at=map_generic_entry_at(specificmap, i, key, generic)
941  if (.not. associated(generic)) call log_log(log_error, "Can not find string entry with key '"//trim(key)//"'")
942  str_val=conv_to_string(generic, .false., string_length)
943  end function map_string_entry_at
944 
952  logical function map_real_entry_at(specificmap, i, key, real_val)
953  type(map_type), intent(inout) :: specificmap
954  integer, intent(in) :: i
955  character(len=*), intent(out) :: key
956  real(kind=DEFAULT_PRECISION), intent(out) :: real_val
957 
958  class(*), pointer :: generic
959 
960  map_real_entry_at=map_generic_entry_at(specificmap, i, key, generic)
961  if (.not. associated(generic)) call log_log(log_error, "Can not find real entry with key '"//trim(key)//"'")
962  select type(vr=>generic)
963  type is (real(kind=default_precision))
964  real_val=vr
965  type is (real)
966  real_val=conv_single_real_to_double(vr)
967  type is (integer)
968  real_val=conv_single_real_to_double(conv_to_real(vr))
969  end select
970  end function map_real_entry_at
971 
979  logical function map_logical_entry_at(specificmap, i, key, logical_val)
980  type(map_type), intent(inout) :: specificmap
981  integer, intent(in) :: i
982  character(len=*), intent(out) :: key
983  logical, intent(out) :: logical_val
984 
985  class(*), pointer :: generic
986 
987  map_logical_entry_at=map_generic_entry_at(specificmap, i, key, generic)
988  if (.not. associated(generic)) call log_log(log_error, "Can not find logical entry with key '"//trim(key)//"'")
989  logical_val=conv_to_logical(generic, .false.)
990  end function map_logical_entry_at
991 
999  logical function map_generic_entry_at(specificmap, i, key, val)
1000  type(map_type), intent(inout) :: specificmap
1001  integer, intent(in) :: i
1002  character(len=*), intent(out) :: key
1003  class(*), pointer, intent(out) :: val
1004 
1005  class(*), pointer :: raw_map_node
1006  integer :: the_map_size
1007 
1008  the_map_size = map_size(specificmap)
1009  if (i .le. the_map_size) then
1010  raw_map_node=>list_get_generic(specificmap%map_ds, i)
1011  if (associated(raw_map_node)) then
1012  select type(raw_map_node)
1013  type is (mapnode_type)
1014  val=>raw_map_node%value
1015  key=raw_map_node%key
1016  end select
1017  map_generic_entry_at=.true.
1018  return
1019  end if
1020  end if
1021  val=>null()
1022  map_generic_entry_at=.false.
1023  end function map_generic_entry_at
1024 
1030  subroutine map_remove(specificmap, key)
1031  type(map_type), intent(inout) :: specificmap
1032  character(len=*), intent(in) :: key
1033 
1034  integer :: key_location
1035  class(*), pointer :: raw_map_node
1036 
1037  raw_map_node=>map_getnode(specificmap, key, key_location)
1038 
1039  if (key_location .gt. 0) then
1040  select type (raw_map_node)
1041  type is (mapnode_type)
1042  if (raw_map_node%memory_allocation_automatic) then
1043  if (associated(raw_map_node%value)) deallocate(raw_map_node%value)
1044  end if
1045  deallocate(raw_map_node)
1046  end select
1047  call list_remove(specificmap%map_ds, key_location)
1048  end if
1049  end subroutine map_remove
1050 
1057  function map_get_int(specificmap, key)
1058  type(map_type), intent(inout) :: specificmap
1059  character(len=*), intent(in) :: key
1060  integer :: map_get_int
1061 
1062  class(*), pointer :: generic
1063 
1064  generic=>map_get_generic(specificmap, key)
1065  if (.not. associated(generic)) call log_log(log_error, "Can not find integer entry with key '"//trim(key)//"'")
1066  map_get_int=conv_to_integer(generic, .false.)
1067  end function map_get_int
1068 
1075  function map_get_string(specificmap, key)
1076  type(map_type), intent(inout) :: specificmap
1077  character(len=*), intent(in) :: key
1078  character(len=STRING_LENGTH) :: map_get_string
1079 
1080  class(*), pointer :: generic
1081 
1082  generic=>map_get_generic(specificmap, key)
1083  if (.not. associated(generic)) call log_log(log_error, "Can not find string entry with key '"//trim(key)//"'")
1084  map_get_string=conv_to_string(generic, .false., string_length)
1085  end function map_get_string
1086 
1093  function map_get_real(specificmap, key)
1094  type(map_type), intent(inout) :: specificmap
1095  character(len=*), intent(in) :: key
1096  real(kind=DEFAULT_PRECISION) :: map_get_real
1097 
1098  class(*), pointer :: generic
1099 
1100  generic=>map_get_generic(specificmap, key)
1101  if (.not. associated(generic)) call log_log(log_error, "Can not find real entry with key '"//trim(key)//"'")
1102  select type(vr=>generic)
1103  type is (real(kind=default_precision))
1104  map_get_real=vr
1105  type is (real)
1106  map_get_real=conv_single_real_to_double(vr)
1107  type is (integer)
1108  map_get_real=conv_single_real_to_double(conv_to_real(vr))
1109  end select
1110  end function map_get_real
1111 
1118  function map_get_logical(specificmap, key)
1119  type(map_type), intent(inout) :: specificmap
1120  character(len=*), intent(in) :: key
1121  logical :: map_get_logical
1122 
1123  class(*), pointer :: generic
1124 
1125  generic=>map_get_generic(specificmap, key)
1126  if (.not. associated(generic)) call log_log(log_error, "Can not find logical entry with key '"//trim(key)//"'")
1127  map_get_logical=conv_to_logical(generic, .false.)
1128  end function map_get_logical
1129 
1136  function map_get_generic(specificmap, key)
1137  type(map_type), intent(inout) :: specificmap
1138  character(len=*), intent(in) :: key
1139  class(*), pointer :: map_get_generic, raw_map_node
1140 
1141  raw_map_node=>map_getnode(specificmap, key)
1142  if (associated(raw_map_node)) then
1143  select type (raw_map_node)
1144  type is (mapnode_type)
1145  map_get_generic => raw_map_node%value
1146  end select
1147  return
1148  end if
1149  map_get_generic => null()
1150  end function map_get_generic
1151 
1160  function map_getnode(specificmap, key, foundindex)
1161  type(map_type), intent(inout) :: specificmap
1162  integer, intent(out), optional :: foundindex
1163  character(len=*), intent(in) :: key
1164  class(*), pointer :: raw_data, map_getnode
1165 
1166  integer :: i
1167  type(listnode_type), pointer :: node
1168 
1169  i=1
1170  node=>specificmap%map_ds%head
1171  if (associated(node)) then
1172  do while(1==1)
1173  raw_data=>node%data
1174  if (associated(raw_data)) then
1175  select type (raw_data)
1176  type is (mapnode_type)
1177  if (raw_data%key .eq. key) then
1178  map_getnode=>raw_data
1179  if (present(foundindex)) foundindex=i
1180  return
1181  end if
1182  end select
1183  end if
1184  node=>node%next
1185  i=i+1
1186  if (.not. associated(node)) exit
1187  end do
1188  end if
1189  map_getnode => null()
1190  if(present(foundindex)) foundindex = 0
1191  end function map_getnode
1192 
1198  integer function map_size(specificmap)
1199  type(map_type), intent(inout) :: specificmap
1200 
1201  map_size = list_size(specificmap%map_ds)
1202  end function map_size
1203 
1209  logical function map_is_empty(specificmap)
1210  type(map_type), intent(inout) :: specificmap
1211 
1212  map_is_empty = list_is_empty(specificmap%map_ds)
1213  end function map_is_empty
1214 
1221  subroutine map_free(specificmap)
1222  type(map_type), intent(inout) :: specificmap
1223 
1224  type(listnode_type), pointer :: node, previousnode
1225 
1226  node=>specificmap%map_ds%head
1227  previousnode=>null()
1228 
1229  if (associated(node)) then
1230  do while(1==1)
1231  previousnode=>node
1232  node=>node%next
1233  if (associated(previousnode%data)) then
1234  select type (n=>previousnode%data)
1235  type is (mapnode_type)
1236  if (n%memory_allocation_automatic) then
1237  if (associated(n%value)) deallocate(n%value)
1238  end if
1239  end select
1240  deallocate(previousnode%data) ! Free the mapnode data structure
1241  end if
1242  deallocate(previousnode)
1243  if (.not. associated(node)) exit
1244  end do
1245  end if
1246 
1247  specificmap%map_ds%tail=>null()
1248  specificmap%map_ds%head=>null()
1249  specificmap%map_ds%size=0
1250  end subroutine map_free
1251 
1255  type(iterator_type) function hashmap_get_iterator(specificmap)
1256  type(hashmap_type), intent(inout) :: specificmap
1257 
1258  integer :: i
1259 
1260  hashmap_get_iterator%next_item=>null()
1261  if (associated(specificmap%map_ds)) then
1262  hashmap_get_iterator%hash_structure=>specificmap%map_ds
1263 
1264  do i=1, size(specificmap%map_ds)
1265  if (specificmap%map_ds(i)%size .gt. 0) then
1266  hashmap_get_iterator%next_item=>specificmap%map_ds(i)%head
1267  exit
1268  end if
1269  end do
1270  hashmap_get_iterator%hash_ptr=i+1
1271  end if
1272  end function hashmap_get_iterator
1273 
1283  subroutine hashmap_put_int(specificmap, key, int_data)
1284  type(hashmap_type), intent(inout) :: specificmap
1285  integer, intent(in) :: int_data
1286  character(len=*), intent(in) :: key
1287 
1288  class(*), pointer :: generic
1289 
1290  generic=>conv_to_generic(int_data, .true.)
1291  call hashmap_put_generic(specificmap, key, generic, .true.)
1292  end subroutine hashmap_put_int
1293 
1303  subroutine hashmap_put_string(specificmap, key, str_data)
1304  type(hashmap_type), intent(inout) :: specificmap
1305  character(len=STRING_LENGTH), intent(in) :: str_data
1306  character(len=*), intent(in) :: key
1307 
1308  class(*), pointer :: generic
1309 
1310  generic=>conv_to_generic(str_data, .true.)
1311  call hashmap_put_generic(specificmap, key, generic, .true.)
1312  end subroutine hashmap_put_string
1313 
1323  subroutine hashmap_put_real(specificmap, key, real_data)
1324  type(hashmap_type), intent(inout) :: specificmap
1325  real(kind=DEFAULT_PRECISION), intent(in) :: real_data
1326  character(len=*), intent(in) :: key
1327 
1328  class(*), pointer :: generic
1329 
1330  generic=>conv_to_generic(real_data, .true.)
1331  call hashmap_put_generic(specificmap, key, generic, .true.)
1332  end subroutine hashmap_put_real
1333 
1343  subroutine hashmap_put_logical(specificmap, key, logical_data)
1344  type(hashmap_type), intent(inout) :: specificmap
1345  logical, intent(in) :: logical_data
1346  character(len=*), intent(in) :: key
1347 
1348  class(*), pointer :: generic
1349 
1350  generic=>conv_to_generic(logical_data, .true.)
1351  call hashmap_put_generic(specificmap, key, generic, .true.)
1352  end subroutine hashmap_put_logical
1353 
1364  subroutine hashmap_put_generic(specificmap, key, data, memory_allocation_automatic)
1365  type(hashmap_type), intent(inout) :: specificmap
1366  class(*), pointer, intent(in) :: data
1367  character(len=*), intent(in) :: key
1368  logical, intent(in) :: memory_allocation_automatic
1369 
1370  class(*), pointer :: raw_map_node, generic_map_node
1371  type(mapnode_type), pointer :: newmapnode
1372 
1373  if (.not. associated(specificmap%map_ds)) allocate(specificmap%map_ds(hash_size))
1374 
1375  ! Test to see if key already exists in the map
1376  raw_map_node=>hashmap_getnode(specificmap, key)
1377 
1378  if (associated(raw_map_node)) then
1379  select type(raw_map_node)
1380  type is (mapnode_type)
1381  raw_map_node%value=>data
1382  end select
1383  else
1384  allocate(newmapnode)
1385  newmapnode%value=>data
1386  newmapnode%key=key
1387  newmapnode%memory_allocation_automatic=memory_allocation_automatic
1388  ! Clone and deallocate the newmapnode - this keeps GNU happy with passing the correct pointer and Cray
1389  ! doesn't link the generic pointer just pointing to the data structure hence we clone it
1390  allocate(generic_map_node, source=newmapnode)
1391  deallocate(newmapnode)
1392  call list_add_generic(specificmap%map_ds(get_hashkey(key)), generic_map_node, .false.)
1393  specificmap%size=specificmap%size+1
1394  end if
1395  end subroutine hashmap_put_generic
1396 
1403  logical function hashmap_contains_key(specificmap, key)
1404  type(hashmap_type), intent(inout) :: specificmap
1405  character(len=*), intent(in) :: key
1406 
1407  class(*), pointer :: raw_map_node
1408 
1409  raw_map_node=>hashmap_getnode(specificmap, key)
1410  hashmap_contains_key=associated(raw_map_node)
1411  end function hashmap_contains_key
1412 
1420  character(len=STRING_LENGTH) function hashmap_key_at(specificmap, i)
1421  type(hashmap_type), intent(inout) :: specificmap
1422  integer, intent(in) :: i
1423 
1424  class(*), pointer :: raw_map_node
1425 
1426  raw_map_node=>hashmap_getnode_atindex(specificmap, i)
1427  if (associated(raw_map_node)) then
1428  select type(raw_map_node)
1429  type is(mapnode_type)
1430  hashmap_key_at = raw_map_node%key
1431  end select
1432  return
1433  else
1434  hashmap_key_at=""
1435  end if
1436  end function hashmap_key_at
1437 
1445  function hashmap_integer_at(specificmap, i)
1446  type(hashmap_type), intent(inout) :: specificmap
1447  integer, intent(in) :: i
1448  integer :: hashmap_integer_at
1449 
1450  class(*), pointer :: generic
1451 
1452  generic=>hashmap_generic_at(specificmap, i)
1453  if (.not. associated(generic)) call log_log(log_error, "Can not find integer at "//trim(conv_to_string(i)))
1454  hashmap_integer_at=conv_to_integer(generic, .false.)
1455  end function hashmap_integer_at
1456 
1464  function hashmap_string_at(specificmap, i)
1465  type(hashmap_type), intent(inout) :: specificmap
1466  integer, intent(in) :: i
1467  character(len=STRING_LENGTH) :: hashmap_string_at
1468 
1469  class(*), pointer :: generic
1470 
1471  generic=>hashmap_generic_at(specificmap, i)
1472  if (.not. associated(generic)) call log_log(log_error, "Can not find string at "//trim(conv_to_string(i)))
1473  hashmap_string_at=conv_to_string(generic, .false., string_length)
1474  end function hashmap_string_at
1475 
1483  function hashmap_real_at(specificmap, i)
1484  type(hashmap_type), intent(inout) :: specificmap
1485  integer, intent(in) :: i
1486  integer :: hashmap_real_at
1487 
1488  class(*), pointer :: generic
1489 
1490  generic=>hashmap_generic_at(specificmap, i)
1491  if (.not. associated(generic)) call log_log(log_error, "Can not find real at "//trim(conv_to_string(i)))
1492  select type(vr=>generic)
1493  type is (real(kind=default_precision))
1494  hashmap_real_at=vr
1495  type is (real)
1496  hashmap_real_at=conv_single_real_to_double(vr)
1497  type is (integer)
1498  hashmap_real_at=conv_single_real_to_double(conv_to_real(vr))
1499  end select
1500  end function hashmap_real_at
1501 
1509  function hashmap_logical_at(specificmap, i)
1510  type(hashmap_type), intent(inout) :: specificmap
1511  integer, intent(in) :: i
1512  logical :: hashmap_logical_at
1513 
1514  class(*), pointer :: generic
1515 
1516  generic=>hashmap_generic_at(specificmap, i)
1517  if (.not. associated(generic)) call log_log(log_error, "Can not find logical at "//trim(conv_to_string(i)))
1518  hashmap_logical_at=conv_to_logical(generic, .false.)
1519  end function hashmap_logical_at
1520 
1528  function hashmap_generic_at(specificmap, i)
1529  type(hashmap_type), intent(inout) :: specificmap
1530  integer, intent(in) :: i
1531 
1532  class(*), pointer :: raw_map_node, hashmap_generic_at
1533 
1534  raw_map_node=>hashmap_getnode_atindex(specificmap, i)
1535  if (associated(raw_map_node)) then
1536  select type(raw_map_node)
1537  type is (mapnode_type)
1538  hashmap_generic_at=>raw_map_node%value
1539  end select
1540  return
1541  else
1542  hashmap_generic_at=>null()
1543  end if
1544  end function hashmap_generic_at
1545 
1553  logical function hashmap_integer_entry_at(specificmap, i, key, int_val)
1554  type(hashmap_type), intent(inout) :: specificmap
1555  integer, intent(in) :: i
1556  character(len=*), intent(out) :: key
1557  integer, intent(out) :: int_val
1558 
1559  class(*), pointer :: generic
1560 
1561  hashmap_integer_entry_at=hashmap_generic_entry_at(specificmap, i, key, generic)
1562  if (.not. associated(generic)) call log_log(log_error, "Can not find integer entry with key '"//trim(key)//"'")
1563  int_val=conv_to_integer(generic, .false.)
1564  end function hashmap_integer_entry_at
1565 
1573  logical function hashmap_string_entry_at(specificmap, i, key, str_val)
1574  type(hashmap_type), intent(inout) :: specificmap
1575  integer, intent(in) :: i
1576  character(len=*), intent(out) :: key
1577  character(len=STRING_LENGTH), intent(out) :: str_val
1578 
1579  class(*), pointer :: generic
1580 
1581  hashmap_string_entry_at=hashmap_generic_entry_at(specificmap, i, key, generic)
1582  if (.not. associated(generic)) call log_log(log_error, "Can not find string entry with key '"//trim(key)//"'")
1583  str_val=conv_to_string(generic, .false., string_length)
1584  end function hashmap_string_entry_at
1585 
1593  logical function hashmap_real_entry_at(specificmap, i, key, real_val)
1594  type(hashmap_type), intent(inout) :: specificmap
1595  integer, intent(in) :: i
1596  character(len=*), intent(out) :: key
1597  real(kind=DEFAULT_PRECISION), intent(out) :: real_val
1598 
1599  class(*), pointer :: generic
1600 
1601  hashmap_real_entry_at=hashmap_generic_entry_at(specificmap, i, key, generic)
1602  if (.not. associated(generic)) call log_log(log_error, "Can not find real entry with key '"//trim(key)//"'")
1603  select type(vr=>generic)
1604  type is (real(kind=default_precision))
1605  real_val=vr
1606  type is (real)
1607  real_val=conv_single_real_to_double(vr)
1608  type is (integer)
1609  real_val=conv_single_real_to_double(conv_to_real(vr))
1610  end select
1611  end function hashmap_real_entry_at
1612 
1620  logical function hashmap_logical_entry_at(specificmap, i, key, logical_val)
1621  type(hashmap_type), intent(inout) :: specificmap
1622  integer, intent(in) :: i
1623  character(len=*), intent(out) :: key
1624  logical, intent(out) :: logical_val
1625 
1626  class(*), pointer :: generic
1627 
1628  hashmap_logical_entry_at=hashmap_generic_entry_at(specificmap, i, key, generic)
1629  if (.not. associated(generic)) call log_log(log_error, "Can not find logical entry with key '"//trim(key)//"'")
1630  logical_val=conv_to_logical(generic, .false.)
1631  end function hashmap_logical_entry_at
1632 
1640  logical function hashmap_generic_entry_at(specificmap, i, key, val)
1641  type(hashmap_type), intent(inout) :: specificmap
1642  integer, intent(in) :: i
1643  character(len=*), intent(out) :: key
1644  class(*), pointer, intent(out) :: val
1645 
1646  class(*), pointer :: raw_map_node
1647 
1648  raw_map_node => hashmap_getnode_atindex(specificmap, i)
1649  if (associated(raw_map_node)) then
1650  select type(raw_map_node)
1651  type is (mapnode_type)
1652  val=>raw_map_node%value
1653  key=raw_map_node%key
1654  end select
1656  return
1657  end if
1658  val=>null()
1659  hashmap_generic_entry_at=.false.
1660  end function hashmap_generic_entry_at
1661 
1667  subroutine hashmap_remove(specificmap, key)
1668  type(hashmap_type), intent(inout) :: specificmap
1669  character(len=*), intent(in) :: key
1670 
1671  integer :: key_location
1672  class(*), pointer :: raw_map_node
1673 
1674  raw_map_node=>hashmap_getnode(specificmap, key, key_location)
1675 
1676  if (key_location .gt. 0) then
1677  select type (raw_map_node)
1678  type is (mapnode_type)
1679  if (raw_map_node%memory_allocation_automatic) then
1680  if (associated(raw_map_node%value)) deallocate(raw_map_node%value)
1681  end if
1682  deallocate(raw_map_node)
1683  end select
1684  call list_remove(specificmap%map_ds(get_hashkey(key)), key_location)
1685  specificmap%size=specificmap%size-1
1686  end if
1687  end subroutine hashmap_remove
1688 
1695  function hashmap_get_int(specificmap, key)
1696  type(hashmap_type), intent(inout) :: specificmap
1697  character(len=*), intent(in) :: key
1698  integer :: hashmap_get_int
1699 
1700  class(*), pointer :: generic
1701 
1702  generic=>hashmap_get_generic(specificmap, key)
1703  if (.not. associated(generic)) call log_log(log_error, "Can not find integer entry with key '"//trim(key)//"'")
1704  hashmap_get_int=conv_to_integer(generic, .false.)
1705  end function hashmap_get_int
1706 
1713  function hashmap_get_string(specificmap, key)
1714  type(hashmap_type), intent(inout) :: specificmap
1715  character(len=*), intent(in) :: key
1716  character(len=STRING_LENGTH) :: hashmap_get_string
1717 
1718  class(*), pointer :: generic
1719 
1720  generic=>hashmap_get_generic(specificmap, key)
1721  if (.not. associated(generic)) call log_log(log_error, "Can not find string entry with key '"//trim(key)//"'")
1722  hashmap_get_string=conv_to_string(generic, .false., string_length)
1723  end function hashmap_get_string
1724 
1731  function hashmap_get_real(specificmap, key)
1732  type(hashmap_type), intent(inout) :: specificmap
1733  character(len=*), intent(in) :: key
1734  real(kind=DEFAULT_PRECISION) :: hashmap_get_real
1735 
1736  class(*), pointer :: generic
1737 
1738  generic=>hashmap_get_generic(specificmap, key)
1739  if (.not. associated(generic)) call log_log(log_error, "Can not find real entry with key '"//trim(key)//"'")
1740  select type(vr=>generic)
1741  type is (real(kind=default_precision))
1742  hashmap_get_real=vr
1743  type is (real)
1744  hashmap_get_real=conv_single_real_to_double(vr)
1745  type is (integer)
1746  hashmap_get_real=conv_single_real_to_double(conv_to_real(vr))
1747  end select
1748  end function hashmap_get_real
1749 
1756  function hashmap_get_logical(specificmap, key)
1757  type(hashmap_type), intent(inout) :: specificmap
1758  character(len=*), intent(in) :: key
1759  logical :: hashmap_get_logical
1760 
1761  class(*), pointer :: generic
1762 
1763  generic=>hashmap_get_generic(specificmap, key)
1764  if (.not. associated(generic)) call log_log(log_error, "Can not find logical entry with key '"//trim(key)//"'")
1765  hashmap_get_logical=conv_to_logical(generic, .false.)
1766  end function hashmap_get_logical
1767 
1774  function hashmap_get_generic(specificmap, key)
1775  type(hashmap_type), intent(inout) :: specificmap
1776  character(len=*), intent(in) :: key
1777  class(*), pointer :: hashmap_get_generic, raw_map_node
1778 
1779  raw_map_node=>hashmap_getnode(specificmap, key)
1780  if (associated(raw_map_node)) then
1781  select type (raw_map_node)
1782  type is (mapnode_type)
1783  hashmap_get_generic=>raw_map_node%value
1784  end select
1785  return
1786  end if
1787  hashmap_get_generic=>null()
1788  end function hashmap_get_generic
1789 
1798  function hashmap_getnode(specificmap, key, key_location)
1799  type(hashmap_type), intent(inout) :: specificmap
1800  character(len=*), intent(in) :: key
1801  integer, intent(out), optional :: key_location
1802  class(*), pointer :: raw_data, hashmap_getnode
1803 
1804  integer :: i, hash
1805  type(listnode_type), pointer :: node
1806 
1807  hashmap_getnode=>null()
1808  if (present(key_location)) key_location=0
1809 
1810  if (.not. associated(specificmap%map_ds)) return
1811 
1812  hash=get_hashkey(key)
1813 
1814  i=1
1815  node=>specificmap%map_ds(hash)%head
1816  if (associated(node)) then
1817  do while(1==1)
1818  raw_data=>node%data
1819  if (associated(raw_data)) then
1820  select type (raw_data)
1821  type is (mapnode_type)
1822  if (raw_data%key .eq. key) then
1823  hashmap_getnode=>raw_data
1824  if (present(key_location)) key_location=i
1825  return
1826  end if
1827  end select
1828  end if
1829  node=>node%next
1830  i=i+1
1831  if (.not. associated(node)) exit
1832  end do
1833  end if
1834  if (present(key_location)) key_location=0
1835  end function hashmap_getnode
1836 
1842  function hashmap_getnode_atindex(specificmap, index)
1843  type(hashmap_type), intent(inout) :: specificmap
1844  integer, intent(in) :: index
1845  class(*), pointer :: hashmap_getnode_atindex
1846 
1847  integer :: i, current_size, prev
1848 
1849  hashmap_getnode_atindex=>null()
1850  if (.not. associated(specificmap%map_ds) .or. index .gt. specificmap%size) return
1851 
1852  current_size=0
1853  prev=0
1854  do i=1, hash_size
1855  current_size=current_size+list_size(specificmap%map_ds(i))
1856  if (current_size .ge. index) then
1857  hashmap_getnode_atindex=>list_get_generic(specificmap%map_ds(i), index-prev)
1858  return
1859  end if
1860  prev=current_size
1861  end do
1862  end function hashmap_getnode_atindex
1863 
1869  integer function hashmap_size(specificmap)
1870  type(hashmap_type), intent(inout) :: specificmap
1871 
1872  hashmap_size=specificmap%size
1873  end function hashmap_size
1874 
1880  logical function hashmap_is_empty(specificmap)
1881  type(hashmap_type), intent(inout) :: specificmap
1882 
1883  hashmap_is_empty=(specificmap%size == 0)
1884  end function hashmap_is_empty
1885 
1892  subroutine hashmap_free(specificmap)
1893  type(hashmap_type), intent(inout) :: specificmap
1894 
1895  type(listnode_type), pointer :: node, previousnode
1896  integer :: i
1897 
1898  if (associated(specificmap%map_ds)) then
1899  do i=1, hash_size
1900  node=>specificmap%map_ds(i)%head
1901  previousnode=>null()
1902 
1903  if (associated(node)) then
1904  do while(1==1)
1905  previousnode=>node
1906  node=>node%next
1907  if (associated(previousnode%data)) then
1908  select type (n=>previousnode%data)
1909  type is (mapnode_type)
1910  if (n%memory_allocation_automatic) then
1911  if (associated(n%value)) deallocate(n%value)
1912  end if
1913  end select
1914  deallocate(previousnode%data) ! Free the mapnode data structure
1915  end if
1916  deallocate(previousnode)
1917  if (.not. associated(node)) exit
1918  end do
1919  end if
1920 
1921  specificmap%map_ds(i)%tail=>null()
1922  specificmap%map_ds(i)%head=>null()
1923  specificmap%map_ds(i)%size=0
1924  end do
1925  specificmap%size=0
1926  deallocate(specificmap%map_ds)
1927  end if
1928  end subroutine hashmap_free
1929 
1933  type(iterator_type) function hashset_get_iterator(specificset)
1934  type(hashset_type), intent(inout) :: specificset
1935 
1936  integer :: i
1937 
1938  hashset_get_iterator%next_item=>null()
1939  if (associated(specificset%set_ds)) then
1940  hashset_get_iterator%hash_structure=>specificset%set_ds
1941 
1942  do i=1, size(specificset%set_ds)
1943  if (specificset%set_ds(i)%size .gt. 0) then
1944  hashset_get_iterator%next_item=>specificset%set_ds(i)%head
1945  exit
1946  end if
1947  end do
1948  hashset_get_iterator%hash_ptr=i+1
1949  end if
1950  end function hashset_get_iterator
1951 
1958  subroutine hashset_add(specificset, key)
1959  type(hashset_type), intent(inout) :: specificset
1960  character(len=*), intent(in) :: key
1961 
1962  class(*), pointer :: generic
1963  type(setnode_type), pointer :: newsetnode
1964  integer :: hash, location
1965 
1966  if (.not. associated(specificset%set_ds)) allocate(specificset%set_ds(hash_size))
1967 
1968  call hashset_getlocation(specificset, key, hash, location)
1969 
1970  if (hash .gt. 0 .and. location .eq. 0) then
1971  allocate(newsetnode)
1972  newsetnode%key=key
1973  ! Clone and deallocate the newmapnode - this keeps GNU happy with passing the correct pointer and Cray
1974  ! doesn't link the generic pointer just pointing to the data structure hence we clone it
1975  allocate(generic, source=newsetnode)
1976  deallocate(newsetnode)
1977  call list_add_generic(specificset%set_ds(hash), generic, .true.)
1978  specificset%size=specificset%size+1
1979  end if
1980  end subroutine hashset_add
1981 
1987  subroutine hashset_remove(specificset, key)
1988  type(hashset_type), intent(inout) :: specificset
1989  character(len=*), intent(in) :: key
1990 
1991  integer :: location, hash
1992 
1993  call hashset_getlocation(specificset, key, hash, location)
1994  if (hash .gt. 0 .and. location .gt. 0) then
1995  call list_remove(specificset%set_ds(hash), location)
1996  specificset%size=specificset%size-1
1997  end if
1998  end subroutine hashset_remove
1999 
2005  logical function hashset_contains(specificset, key)
2006  type(hashset_type), intent(inout) :: specificset
2007  character(len=*), intent(in) :: key
2008 
2009  integer :: hash, key_location
2010 
2011  call hashset_getlocation(specificset, key, hash, key_location)
2012  hashset_contains= (hash .gt. 0 .and. key_location .gt. 0)
2013  end function hashset_contains
2014 
2023  subroutine hashset_getlocation(specificset, key, hash, key_location)
2024  type(hashset_type), intent(inout) :: specificset
2025  character(len=*), intent(in) :: key
2026  integer, intent(out) :: hash, key_location
2027  class(*), pointer :: raw_data
2028 
2029  integer :: i
2030  type(listnode_type), pointer :: node
2031 
2032  hash=0
2033  key_location=0
2034 
2035  if (.not. associated(specificset%set_ds)) return
2036 
2037  hash=get_hashkey(key)
2038 
2039  i=1
2040  node=>specificset%set_ds(hash)%head
2041  if (associated(node)) then
2042  do while(1==1)
2043  raw_data=>node%data
2044  if (associated(raw_data)) then
2045  select type (raw_data)
2046  type is (setnode_type)
2047  if (raw_data%key .eq. key) then
2048  key_location=i
2049  return
2050  end if
2051  end select
2052  end if
2053  node=>node%next
2054  i=i+1
2055  if (.not. associated(node)) exit
2056  end do
2057  end if
2058  key_location=0
2059  end subroutine hashset_getlocation
2060 
2066  logical function hashset_is_empty(specificset)
2067  type(hashset_type), intent(in) :: specificset
2068 
2069  hashset_is_empty = specificset%size == 0
2070  end function hashset_is_empty
2071 
2078  character(len=STRING_LENGTH) function hashset_get_string(specificset, index)
2079  type(hashset_type), intent(inout) :: specificset
2080  integer, intent(in) :: index
2081  class(*), pointer :: generic
2082 
2083  integer :: i, current_size, prev
2084 
2086  if (.not. associated(specificset%set_ds) .or. index .gt. specificset%size) return
2087 
2088  current_size=0
2089  prev=0
2090  do i=1, hash_size
2091  current_size=current_size+list_size(specificset%set_ds(i))
2092  if (current_size .ge. index) then
2093  generic=>list_get_generic(specificset%set_ds(i), index-prev)
2094  if (associated(generic)) then
2095  select type (generic)
2096  type is (setnode_type)
2097  hashset_get_string=generic%key
2098  end select
2099  return
2100  else
2101  call log_log(log_error, "Can not find hashset entry at index "//trim(conv_to_string(index)))
2102  end if
2103  end if
2104  prev=current_size
2105  end do
2106  end function hashset_get_string
2107 
2114  subroutine hashset_free(specificset)
2115  type(hashset_type), intent(inout) :: specificset
2116 
2117  type(listnode_type), pointer :: node, previousnode
2118  integer :: i
2119 
2120  if (associated(specificset%set_ds)) then
2121  do i=1, hash_size
2122  node=>specificset%set_ds(i)%head
2123  previousnode=>null()
2124 
2125  if (associated(node)) then
2126  do while(1==1)
2127  previousnode=>node
2128  node=>node%next
2129  if (associated(previousnode%data)) then
2130  deallocate(previousnode%data) ! Free the mapnode data structure
2131  end if
2132  deallocate(previousnode)
2133  if (.not. associated(node)) exit
2134  end do
2135  end if
2136 
2137  specificset%set_ds(i)%tail=>null()
2138  specificset%set_ds(i)%head=>null()
2139  specificset%set_ds(i)%size=0
2140  end do
2141  specificset%size=0
2142  deallocate(specificset%set_ds)
2143  end if
2144  end subroutine hashset_free
2145 
2151  integer function hashset_size(specificset)
2152  type(hashset_type), intent(in) :: specificset
2153 
2154  hashset_size = specificset%size
2155  end function hashset_size
2156 
2161  integer function get_hashkey(key)
2162  character(len=*), intent(in) :: key
2163 
2164  integer :: i
2165 
2166  get_hashkey=5381
2167  do i=1, len(trim(key))
2168  get_hashkey=(ishft(get_hashkey,5) + get_hashkey) + ichar(key(i:i))
2169  end do
2170  get_hashkey=abs(mod(get_hashkey, hash_size))+1
2171  end function get_hashkey
2172 
2176  type(iterator_type) function stack_get_iterator(specificstack)
2177  type(stack_type), intent(inout) :: specificstack
2178 
2179  stack_get_iterator%next_item=>specificstack%stack_ds%head
2180  stack_get_iterator%hash_structure=>null()
2181  stack_get_iterator%hash_ptr=0
2182  end function stack_get_iterator
2183 
2189  subroutine stack_push_int(specificstack, int_data)
2190  type(stack_type), intent(inout) :: specificstack
2191  integer, intent(in) :: int_data
2192 
2193  class(*), pointer :: generic
2194 
2195  generic=>conv_to_generic(int_data, .true.)
2196  call stack_push_generic(specificstack, generic, .true.)
2197  end subroutine stack_push_int
2198 
2204  subroutine stack_push_string(specificstack, str_data)
2205  type(stack_type), intent(inout) :: specificstack
2206  character(len=STRING_LENGTH), intent(in) :: str_data
2207 
2208  class(*), pointer :: generic
2209 
2210  generic=>conv_to_generic(str_data, .true.)
2211  call stack_push_generic(specificstack, generic, .true.)
2212  end subroutine stack_push_string
2213 
2219  subroutine stack_push_real(specificstack, real_data)
2220  type(stack_type), intent(inout) :: specificstack
2221  real(kind=DEFAULT_PRECISION), intent(in) :: real_data
2222 
2223  class(*), pointer :: generic
2224 
2225  generic=>conv_to_generic(real_data, .true.)
2226  call stack_push_generic(specificstack, generic, .true.)
2227  end subroutine stack_push_real
2228 
2234  subroutine stack_push_logical(specificstack, logical_data)
2235  type(stack_type), intent(inout) :: specificstack
2236  logical, intent(in) :: logical_data
2237 
2238  class(*), pointer :: generic
2239 
2240  generic=>conv_to_generic(logical_data, .true.)
2241  call stack_push_generic(specificstack, generic, .true.)
2242  end subroutine stack_push_logical
2243 
2250  subroutine stack_push_generic(specificstack, data, memory_allocation_automatic)
2251  type(stack_type), intent(inout) :: specificstack
2252  class(*), pointer, intent(in) :: data
2253  logical, intent(in) :: memory_allocation_automatic
2254 
2255  call list_insert_generic(specificstack%stack_ds, data, 1, memory_allocation_automatic)
2256  end subroutine stack_push_generic
2257 
2263  function stack_pop_int(specificstack)
2264  type(stack_type), intent(inout) :: specificstack
2265  integer :: stack_pop_int
2266 
2267  class(*), pointer :: generic
2268 
2269  generic=>stack_pop_generic(specificstack)
2270  if (.not. associated(generic)) call log_log(log_error, "Can not pop integer from stack")
2271  stack_pop_int=conv_to_integer(generic, .false.)
2272  end function stack_pop_int
2273 
2279  function stack_pop_string(specificstack)
2280  type(stack_type), intent(inout) :: specificstack
2281  character(len=STRING_LENGTH) :: stack_pop_string
2282 
2283  class(*), pointer :: generic
2284 
2285  generic=>stack_pop_generic(specificstack)
2286  if (.not. associated(generic)) call log_log(log_error, "Can not pop string from stack")
2287  stack_pop_string=conv_to_string(generic, .false., string_length)
2288  end function stack_pop_string
2289 
2295  function stack_pop_real(specificstack)
2296  type(stack_type), intent(inout) :: specificstack
2297  real(kind=DEFAULT_PRECISION) :: stack_pop_real
2298 
2299  class(*), pointer :: generic
2300 
2301  generic=>stack_pop_generic(specificstack)
2302  if (.not. associated(generic)) call log_log(log_error, "Can not pop real from stack")
2303  select type(vr=>generic)
2304  type is (real(kind=default_precision))
2305  stack_pop_real=vr
2306  type is (real)
2307  stack_pop_real=conv_single_real_to_double(vr)
2308  type is (integer)
2309  stack_pop_real=conv_single_real_to_double(conv_to_real(vr))
2310  end select
2311  end function stack_pop_real
2312 
2318  function stack_pop_logical(specificstack)
2319  type(stack_type), intent(inout) :: specificstack
2320  logical :: stack_pop_logical
2321 
2322  class(*), pointer :: generic
2323 
2324  generic=>stack_pop_generic(specificstack)
2325  if (.not. associated(generic)) call log_log(log_error, "Can not pop logical from stack")
2326  stack_pop_logical=conv_to_logical(generic, .false.)
2327  end function stack_pop_logical
2328 
2334  function stack_pop_generic(specificstack)
2335  type(stack_type), intent(inout) :: specificstack
2336  class(*), pointer :: stack_pop_generic
2337 
2338  stack_pop_generic=>stack_get_generic(specificstack, 1)
2339  call list_remove(specificstack%stack_ds, 1)
2340  end function stack_pop_generic
2341 
2348  function stack_get_int(specificstack, i)
2349  type(stack_type), intent(inout) :: specificstack
2350  integer, intent(in) :: i
2351  integer :: stack_get_int
2352 
2353  class(*), pointer :: generic
2354 
2355  generic=>stack_get_generic(specificstack, i)
2356  if (.not. associated(generic)) call log_log(log_error, "Can not get integer from stack at index "//trim(conv_to_string(i)))
2357  stack_get_int=conv_to_integer(generic, .false.)
2358  end function stack_get_int
2359 
2366  function stack_get_string(specificstack, i)
2367  type(stack_type), intent(inout) :: specificstack
2368  integer, intent(in) :: i
2369  character(len=STRING_LENGTH) :: stack_get_string
2370 
2371  class(*), pointer :: generic
2372 
2373  generic=>stack_get_generic(specificstack, i)
2374  if (.not. associated(generic)) call log_log(log_error, "Can not get string from stack at index "//trim(conv_to_string(i)))
2375  stack_get_string=conv_to_string(generic, .false., string_length)
2376  end function stack_get_string
2377 
2384  function stack_get_real(specificstack, i)
2385  type(stack_type), intent(inout) :: specificstack
2386  integer, intent(in) :: i
2387  real(kind=DEFAULT_PRECISION) :: stack_get_real
2388 
2389  class(*), pointer :: generic
2390 
2391  generic=>stack_get_generic(specificstack, i)
2392  if (.not. associated(generic)) call log_log(log_error, "Can not get real from stack at index "//trim(conv_to_string(i)))
2393  select type(vr=>generic)
2394  type is (real(kind=default_precision))
2395  stack_get_real=vr
2396  type is (real)
2397  stack_get_real=conv_single_real_to_double(vr)
2398  type is (integer)
2399  stack_get_real=conv_single_real_to_double(conv_to_real(vr))
2400  end select
2401  end function stack_get_real
2402 
2409  function stack_get_logical(specificstack, i)
2410  type(stack_type), intent(inout) :: specificstack
2411  integer, intent(in) :: i
2412  logical :: stack_get_logical
2413 
2414  class(*), pointer :: generic
2415 
2416  generic=>stack_get_generic(specificstack, i)
2417  if (.not. associated(generic)) call log_log(log_error, "Can not get logical from stack at index "//trim(conv_to_string(i)))
2418  stack_get_logical=conv_to_logical(generic, .false.)
2419  end function stack_get_logical
2420 
2427  function stack_get_generic(specificstack, i)
2428  type(stack_type), intent(inout) :: specificstack
2429  integer, intent(in) :: i
2430  class(*), pointer :: stack_get_generic
2431 
2432  stack_get_generic=>list_get_generic(specificstack%stack_ds, i)
2433  end function stack_get_generic
2434 
2440  integer function stack_size(specificstack)
2441  type(stack_type), intent(inout) :: specificstack
2442 
2443  stack_size = list_size(specificstack%stack_ds)
2444  end function stack_size
2445 
2451  logical function stack_is_empty(specificstack)
2452  type(stack_type), intent(inout) :: specificstack
2453 
2454  stack_is_empty = list_is_empty(specificstack%stack_ds)
2455  end function stack_is_empty
2456 
2463  subroutine stack_free(specificstack)
2464  type(stack_type), intent(inout) :: specificstack
2465 
2466  call list_free(specificstack%stack_ds)
2467  end subroutine stack_free
2468 
2472  type(iterator_type) function queue_get_iterator(specificqueue)
2473  type(queue_type), intent(inout) :: specificqueue
2474 
2475  queue_get_iterator%next_item=>specificqueue%queue_ds%head
2476  queue_get_iterator%hash_structure=>null()
2477  queue_get_iterator%hash_ptr=0
2478  end function queue_get_iterator
2479 
2485  subroutine queue_push_int(specificqueue, int_data)
2486  type(queue_type), intent(inout) :: specificqueue
2487  integer, intent(in) :: int_data
2488 
2489  class(*), pointer :: generic
2490 
2491  generic=>conv_to_generic(int_data, .true.)
2492  call queue_push_generic(specificqueue, generic, .true.)
2493  end subroutine queue_push_int
2494 
2500  subroutine queue_push_string(specificqueue, str_data)
2501  type(queue_type), intent(inout) :: specificqueue
2502  character(len=STRING_LENGTH), intent(in) :: str_data
2503 
2504  class(*), pointer :: generic
2505 
2506  generic=>conv_to_generic(str_data, .true.)
2507  call queue_push_generic(specificqueue, generic, .true.)
2508  end subroutine queue_push_string
2509 
2515  subroutine queue_push_real(specificqueue, real_data)
2516  type(queue_type), intent(inout) :: specificqueue
2517  real(kind=DEFAULT_PRECISION), intent(in) :: real_data
2518 
2519  class(*), pointer :: generic
2520 
2521  generic=>conv_to_generic(real_data, .true.)
2522  call queue_push_generic(specificqueue, generic, .true.)
2523  end subroutine queue_push_real
2524 
2530  subroutine queue_push_logical(specificqueue, logical_data)
2531  type(queue_type), intent(inout) :: specificqueue
2532  logical, intent(in) :: logical_data
2533 
2534  class(*), pointer :: generic
2535 
2536  generic=>conv_to_generic(logical_data, .true.)
2537  call queue_push_generic(specificqueue, generic, .true.)
2538  end subroutine queue_push_logical
2539 
2546  subroutine queue_push_generic(specificqueue, data, memory_allocation_automatic)
2547  type(queue_type), intent(inout) :: specificqueue
2548  class(*), pointer, intent(in) :: data
2549  logical, intent(in) :: memory_allocation_automatic
2550 
2551  call list_add_generic(specificqueue%queue_ds, data, memory_allocation_automatic)
2552  end subroutine queue_push_generic
2553 
2559  function queue_pop_int(specificqueue)
2560  type(queue_type), intent(inout) :: specificqueue
2561  integer :: queue_pop_int
2562 
2563  class(*), pointer :: generic
2564 
2565  generic=>queue_pop_generic(specificqueue)
2566  if (.not. associated(generic)) call log_log(log_error, "Can not pop integer from queue")
2567  queue_pop_int=conv_to_integer(generic, .false.)
2568  end function queue_pop_int
2569 
2575  function queue_pop_string(specificqueue)
2576  type(queue_type), intent(inout) :: specificqueue
2577  character(len=STRING_LENGTH) :: queue_pop_string
2578 
2579  class(*), pointer :: generic
2580 
2581  generic=>queue_pop_generic(specificqueue)
2582  if (.not. associated(generic)) call log_log(log_error, "Can not pop string from queue")
2583  queue_pop_string=conv_to_string(generic, .false., string_length)
2584  end function queue_pop_string
2585 
2591  function queue_pop_real(specificqueue)
2592  type(queue_type), intent(inout) :: specificqueue
2593  real(kind=DEFAULT_PRECISION) :: queue_pop_real
2594 
2595  class(*), pointer :: generic
2596 
2597  generic=>queue_pop_generic(specificqueue)
2598  if (.not. associated(generic)) call log_log(log_error, "Can not pop real from queue")
2599  select type(vr=>generic)
2600  type is (real(kind=default_precision))
2601  queue_pop_real=vr
2602  type is (real)
2603  queue_pop_real=conv_single_real_to_double(vr)
2604  type is (integer)
2605  queue_pop_real=conv_single_real_to_double(conv_to_real(vr))
2606  end select
2607  end function queue_pop_real
2608 
2614  function queue_pop_logical(specificqueue)
2615  type(queue_type), intent(inout) :: specificqueue
2616  logical :: queue_pop_logical
2617 
2618  class(*), pointer :: generic
2619 
2620  generic=>queue_pop_generic(specificqueue)
2621  if (.not. associated(generic)) call log_log(log_error, "Can not pop logical from queue")
2622  queue_pop_logical=conv_to_logical(generic, .false.)
2623  end function queue_pop_logical
2624 
2630  function queue_pop_generic(specificqueue)
2631  type(queue_type), intent(inout) :: specificqueue
2632  class(*), pointer :: queue_pop_generic
2633 
2634  queue_pop_generic=>queue_get_generic(specificqueue, 1)
2635  call list_remove(specificqueue%queue_ds, 1)
2636  end function queue_pop_generic
2637 
2644  function queue_get_int(specificqueue, i)
2645  type(queue_type), intent(inout) :: specificqueue
2646  integer, intent(in) :: i
2647  integer :: queue_get_int
2648 
2649  class(*), pointer :: generic
2650 
2651  generic=>queue_get_generic(specificqueue, i)
2652  if (.not. associated(generic)) call log_log(log_error, "Can not get integer from queue at index "//trim(conv_to_string(i)))
2653  queue_get_int=conv_to_integer(generic, .false.)
2654  end function queue_get_int
2655 
2662  function queue_get_string(specificqueue, i)
2663  type(queue_type), intent(inout) :: specificqueue
2664  integer, intent(in) :: i
2665  character(len=STRING_LENGTH) :: queue_get_string
2666 
2667  class(*), pointer :: generic
2668 
2669  generic=>queue_get_generic(specificqueue, i)
2670  if (.not. associated(generic)) call log_log(log_error, "Can not get string from queue at index "//trim(conv_to_string(i)))
2671  queue_get_string=conv_to_string(generic, .false., string_length)
2672  end function queue_get_string
2673 
2680  function queue_get_real(specificqueue, i)
2681  type(queue_type), intent(inout) :: specificqueue
2682  integer, intent(in) :: i
2683  real(kind=DEFAULT_PRECISION) :: queue_get_real
2684 
2685  class(*), pointer :: generic
2686 
2687  generic=>queue_get_generic(specificqueue, i)
2688  if (.not. associated(generic)) call log_log(log_error, "Can not get real from queue at index "//trim(conv_to_string(i)))
2689  select type(vr=>generic)
2690  type is (real(kind=default_precision))
2691  queue_get_real=vr
2692  type is (real)
2693  queue_get_real=conv_single_real_to_double(vr)
2694  type is (integer)
2695  queue_get_real=conv_single_real_to_double(conv_to_real(vr))
2696  end select
2697  end function queue_get_real
2698 
2705  function queue_get_logical(specificqueue, i)
2706  type(queue_type), intent(inout) :: specificqueue
2707  integer, intent(in) :: i
2708  logical :: queue_get_logical
2709 
2710  class(*), pointer :: generic
2711 
2712  generic=>queue_get_generic(specificqueue, i)
2713  if (.not. associated(generic)) call log_log(log_error, "Can not get logical from queue at index "//trim(conv_to_string(i)))
2714  queue_get_logical=conv_to_logical(generic, .false.)
2715  end function queue_get_logical
2716 
2723  function queue_get_generic(specificqueue, i)
2724  type(queue_type), intent(inout) :: specificqueue
2725  integer, intent(in) :: i
2726  class(*), pointer :: queue_get_generic
2727 
2728  queue_get_generic=>list_get_generic(specificqueue%queue_ds, i)
2729  end function queue_get_generic
2730 
2736  integer function queue_size(specificqueue)
2737  type(queue_type), intent(inout) :: specificqueue
2738 
2739  queue_size = list_size(specificqueue%queue_ds)
2740  end function queue_size
2741 
2747  logical function queue_is_empty(specificqueue)
2748  type(queue_type), intent(inout) :: specificqueue
2749 
2750  queue_is_empty = list_is_empty(specificqueue%queue_ds)
2751  end function queue_is_empty
2752 
2759  subroutine queue_free(specificqueue)
2760  type(queue_type), intent(inout) :: specificqueue
2761 
2762  call list_free(specificqueue%queue_ds)
2763  end subroutine queue_free
2764 
2768  type(iterator_type) function list_get_iterator(specificlist)
2769  type(list_type), intent(inout) :: specificlist
2770 
2771  list_get_iterator%next_item=>specificlist%head
2772  list_get_iterator%hash_structure=>null()
2773  list_get_iterator%hash_ptr=0
2774  end function list_get_iterator
2775 
2782  subroutine list_insert_int(specificlist, int_data, i)
2783  type(list_type), intent(inout) :: specificlist
2784  integer, intent(in) :: i, int_data
2785 
2786  class(*), pointer :: generic
2787 
2788  generic=>conv_to_generic(int_data, .true.)
2789  call list_insert_generic(specificlist, generic, i, .true.)
2790  end subroutine list_insert_int
2791 
2798  subroutine list_insert_string(specificlist, str_data, i)
2799  type(list_type), intent(inout) :: specificlist
2800  integer, intent(in) :: i
2801  character(len=STRING_LENGTH), intent(in) :: str_data
2802 
2803  class(*), pointer :: generic
2804 
2805  generic=>conv_to_generic(str_data, .true.)
2806  call list_insert_generic(specificlist, generic, i, .true.)
2807  end subroutine list_insert_string
2808 
2815  subroutine list_insert_real(specificlist, real_data, i)
2816  type(list_type), intent(inout) :: specificlist
2817  integer, intent(in) :: i
2818  real(kind=DEFAULT_PRECISION), intent(in) :: real_data
2819 
2820  class(*), pointer :: generic
2821 
2822  generic=>conv_to_generic(real_data, .true.)
2823  call list_insert_generic(specificlist, generic, i, .true.)
2824  end subroutine list_insert_real
2825 
2832  subroutine list_insert_logical(specificlist, logical_data, i)
2833  type(list_type), intent(inout) :: specificlist
2834  integer, intent(in) :: i
2835  logical, intent(in) :: logical_data
2836 
2837  class(*), pointer :: generic
2838 
2839  generic=>conv_to_generic(logical_data, .true.)
2840  call list_insert_generic(specificlist, generic, i, .true.)
2841  end subroutine list_insert_logical
2842 
2849  subroutine list_insert_generic(specificlist, data, i, memory_allocation_automatic)
2850  type(list_type), intent(inout) :: specificlist
2851  integer, intent(in) :: i
2852  class(*), pointer, intent(in) :: data
2853  logical, intent(in) :: memory_allocation_automatic
2854 
2855  integer ::j
2856  type(listnode_type), pointer :: newnode, node
2857 
2858  allocate(newnode)
2859  newnode%data => data
2860 
2861  j=1
2862  node => specificlist%head
2863  if (associated(node)) then
2864  do while(j .lt. i)
2865  if (.not. associated(node%next)) exit
2866  node => node%next
2867  j=j+1
2868  end do
2869  if (j .eq. i) then
2870  ! Insert node
2871  newnode%next => node
2872  newnode%prev => node%prev
2873  newnode%memory_allocation_automatic=memory_allocation_automatic
2874  if (associated(node%prev)) node%prev%next=>newnode
2875  node%prev => newnode
2876  if (associated(node, target=specificlist%head)) specificlist%head=>newnode
2877  else
2878  ! Ran out of list nodes so add this one onto the end
2879  newnode%prev=>specificlist%tail
2880  if (associated(specificlist%tail)) then
2881  specificlist%tail%next => newnode
2882  end if
2883  specificlist%tail => newnode
2884 
2885  if (associated(specificlist%head) .eqv. .false.) then
2886  specificlist%head=>newnode
2887  end if
2888  end if
2889  else
2890  ! No current list data so set up the list with this node
2891  specificlist%head => newnode
2892  specificlist%tail => newnode
2893  end if
2894  specificlist%size=specificlist%size+1
2895  end subroutine list_insert_generic
2896 
2902  subroutine list_add_int(specificlist, int_data)
2903  type(list_type), intent(inout) :: specificlist
2904  integer, intent(in) :: int_data
2905 
2906  class(*), pointer :: generic
2907 
2908  generic=>conv_to_generic(int_data, .true.)
2909  call list_add_generic(specificlist, generic, .true.)
2910  end subroutine list_add_int
2911 
2917  subroutine list_add_string(specificlist, str_data)
2918  type(list_type), intent(inout) :: specificlist
2919  character(len=STRING_LENGTH), intent(in) :: str_data
2920 
2921  class(*), pointer :: generic
2922 
2923  generic=>conv_to_generic(str_data, .true.)
2924  call list_add_generic(specificlist, generic, .true.)
2925  end subroutine list_add_string
2926 
2932  subroutine list_add_real(specificlist, real_data)
2933  type(list_type), intent(inout) :: specificlist
2934  real(kind=DEFAULT_PRECISION), intent(in) :: real_data
2935 
2936  class(*), pointer :: generic
2937 
2938  generic=>conv_to_generic(real_data, .true.)
2939  call list_add_generic(specificlist, generic, .true.)
2940  end subroutine list_add_real
2941 
2947  subroutine list_add_logical(specificlist, logical_data)
2948  type(list_type), intent(inout) :: specificlist
2949  logical, intent(in) :: logical_data
2950 
2951  class(*), pointer :: generic
2952 
2953  generic=>conv_to_generic(logical_data, .true.)
2954  call list_add_generic(specificlist, generic, .true.)
2955  end subroutine list_add_logical
2956 
2963  subroutine list_add_generic(specificlist, data, memory_allocation_automatic)
2964  type(list_type), intent(inout) :: specificlist
2965  class(*), pointer, intent(in) :: data
2966  logical, intent(in) :: memory_allocation_automatic
2967 
2968  type(listnode_type), pointer :: newnode
2969 
2970  allocate(newnode)
2971  newnode%data => data
2972 
2973  newnode%prev=>specificlist%tail
2974  newnode%memory_allocation_automatic=memory_allocation_automatic
2975  if (associated(specificlist%tail)) then
2976  specificlist%tail%next => newnode
2977  end if
2978  specificlist%tail => newnode
2979 
2980  if (associated(specificlist%head) .eqv. .false.) then
2981  specificlist%head=>newnode
2982  end if
2983 
2984  specificlist%size=specificlist%size+1
2985  end subroutine list_add_generic
2986 
2992  subroutine list_remove(specificlist, i)
2993  type(list_type), intent(inout) :: specificlist
2994  integer, intent(in) :: i
2995 
2996  integer ::j
2997  type(listnode_type), pointer :: node
2998 
2999  j=1
3000  if (i .le. specificlist%size) then
3001  node => specificlist%head
3002  do while(j .lt. i)
3003  if (.not. associated(node)) exit
3004  node => node%next
3005  j=j+1
3006  end do
3007  if (associated(node)) then
3008  if (associated(node%prev)) node%prev%next => node%next
3009  if (associated(node%next)) node%next%prev => node%prev
3010  if (associated(node, target=specificlist%head)) specificlist%head => node%next
3011  if (associated(node, target=specificlist%tail)) specificlist%tail => node%prev
3012  if (node%memory_allocation_automatic) then
3013  if (associated(node%data)) deallocate(node%data)
3014  end if
3015  deallocate(node)
3016  specificlist%size = specificlist%size - 1
3017  end if
3018  end if
3019  end subroutine list_remove
3020 
3026  logical function list_is_empty(specificlist)
3027  type(list_type), intent(in) :: specificlist
3028 
3029  list_is_empty = specificlist%size == 0
3030  end function list_is_empty
3031 
3038  function list_get_int(specificlist, i)
3039  type(list_type), intent(inout) :: specificlist
3040  integer, intent(in) :: i
3041  integer :: list_get_int
3042 
3043  class(*), pointer :: generic
3044 
3045  generic=>list_get_generic(specificlist, i)
3046  if (.not. associated(generic)) call log_log(log_error, "Can not get integer from list at index "//trim(conv_to_string(i)))
3047  list_get_int=conv_to_integer(generic, .false.)
3048  end function list_get_int
3049 
3056  function list_get_string(specificlist, i)
3057  type(list_type), intent(inout) :: specificlist
3058  integer, intent(in) :: i
3059  character(len=STRING_LENGTH) :: list_get_string
3060 
3061  class(*), pointer :: generic
3062 
3063  generic=>list_get_generic(specificlist, i)
3064  if (.not. associated(generic)) call log_log(log_error, "Can not get string from list at index "//trim(conv_to_string(i)))
3065  list_get_string=conv_to_string(generic, .false., string_length)
3066  end function list_get_string
3067 
3074  function list_get_real(specificlist, i)
3075  type(list_type), intent(inout) :: specificlist
3076  integer, intent(in) :: i
3077  real(kind=DEFAULT_PRECISION) :: list_get_real
3078 
3079  class(*), pointer :: generic
3080 
3081  generic=>list_get_generic(specificlist, i)
3082  if (.not. associated(generic)) call log_log(log_error, "Can not get real from list at index "//trim(conv_to_string(i)))
3083  select type(vr=>generic)
3084  type is (real(kind=default_precision))
3085  list_get_real=vr
3086  type is (real)
3087  list_get_real=conv_single_real_to_double(vr)
3088  type is (integer)
3089  list_get_real=conv_single_real_to_double(conv_to_real(vr))
3090  end select
3091  end function list_get_real
3092 
3099  function list_get_logical(specificlist, i)
3100  type(list_type), intent(inout) :: specificlist
3101  integer, intent(in) :: i
3102  logical :: list_get_logical
3103 
3104  class(*), pointer :: generic
3105 
3106  generic=>list_get_generic(specificlist, i)
3107  if (.not. associated(generic)) call log_log(log_error, "Can not get logical from list at index "//trim(conv_to_string(i)))
3108  list_get_logical=conv_to_logical(generic, .false.)
3109  end function list_get_logical
3110 
3117  function list_get_generic(specificlist, i)
3118  type(list_type), intent(inout) :: specificlist
3119  integer, intent(in) :: i
3120  class(*), pointer :: list_get_generic
3121 
3122  integer :: j
3123  type(listnode_type), pointer :: node
3124 
3125  j=1
3126  if (specificlist%size .lt. i) then
3127  list_get_generic => null()
3128  return
3129  end if
3130  node => specificlist%head
3131  do while(j .lt. i)
3132  if (.not. associated(node)) exit
3133  node => node%next
3134  j=j+1
3135  end do
3136  list_get_generic => node%data
3137  end function list_get_generic
3138 
3145  subroutine list_free(specificlist)
3146  type(list_type), intent(inout) :: specificlist
3147 
3148  type(listnode_type), pointer :: node, previousnode
3149 
3150  node=>specificlist%head
3151  previousnode=>null()
3152 
3153  if (associated(node)) then
3154  do while(1==1)
3155  previousnode=>node
3156  node=>node%next
3157  if (previousnode%memory_allocation_automatic) then
3158  if (associated(previousnode%data)) deallocate(previousnode%data)
3159  end if
3160  deallocate(previousnode)
3161  if (.not. associated(node)) exit
3162  end do
3163  end if
3164 
3165  specificlist%tail=>null()
3166  specificlist%head=>null()
3167  specificlist%size=0
3168  end subroutine list_free
3169 
3175  integer function list_size(specificlist)
3176  type(list_type), intent(in) :: specificlist
3177 
3178  list_size = specificlist%size
3179  end function list_size
3180 
3184  logical function iteratior_has_next(iterator)
3185  type(iterator_type), intent(inout) :: iterator
3186 
3187  iteratior_has_next=associated(iterator%next_item)
3188  end function iteratior_has_next
3189 
3193  integer function iterator_get_next_integer(iterator)
3194  type(iterator_type), intent(inout) :: iterator
3195 
3196  class(*), pointer :: generic
3197 
3198  generic=>iterator_get_next_generic(iterator)
3199  if (associated(generic)) then
3200  iterator_get_next_integer=conv_to_integer(generic, .false.)
3201  else
3202  call log_log(log_error, "Can not get next integer in iterator as iterator has reached end of collection")
3203  end if
3204  end function iterator_get_next_integer
3205 
3209  character(len=STRING_LENGTH) function iterator_get_next_string(iterator)
3210  type(iterator_type), intent(inout) :: iterator
3211 
3212  class(*), pointer :: generic
3213 
3214  generic=>iterator_get_next_generic(iterator)
3215  if (associated(generic)) then
3216  select type(generic)
3217  type is (setnode_type)
3218  iterator_get_next_string=generic%key
3219  class default
3220  iterator_get_next_string=conv_to_string(generic, .false., string_length)
3221  end select
3222  else
3223  call log_log(log_error, "Can not get next string in iterator as iterator has reached end of collection")
3224  end if
3225  end function iterator_get_next_string
3226 
3231  real(kind=DEFAULT_PRECISION) function iterator_get_next_real(iterator)
3232  type(iterator_type), intent(inout) :: iterator
3233 
3234  class(*), pointer :: generic
3235 
3236  generic=>iterator_get_next_generic(iterator)
3237  if (associated(generic)) then
3238  select type(vr=>generic)
3239  type is (real(kind=default_precision))
3241  type is (real)
3242  iterator_get_next_real=conv_single_real_to_double(vr)
3243  type is (integer)
3244  iterator_get_next_real=conv_single_real_to_double(conv_to_real(vr))
3245  end select
3246  else
3247  call log_log(log_error, "Can not get next real in iterator as iterator has reached end of collection")
3248  end if
3249  end function iterator_get_next_real
3250 
3254  logical function iterator_get_next_logical(iterator)
3255  type(iterator_type), intent(inout) :: iterator
3256 
3257  class(*), pointer :: generic
3258 
3259  generic=>iterator_get_next_generic(iterator)
3260  if (associated(generic)) then
3261  iterator_get_next_logical=conv_to_logical(generic, .false.)
3262  else
3263  call log_log(log_error, "Can not get next logical in iterator as iterator has reached end of collection")
3264  end if
3265  end function iterator_get_next_logical
3266 
3271  function iterator_get_next_mapentry(iterator)
3272  type(iterator_type), intent(inout) :: iterator
3273  type(mapentry_type) :: iterator_get_next_mapentry
3274 
3275  class(*), pointer :: generic
3276 
3277  generic=>iterator_get_next_generic(iterator)
3278  if (associated(generic)) then
3279  select type(generic)
3280  type is (mapnode_type)
3281  iterator_get_next_mapentry%key=generic%key
3282  iterator_get_next_mapentry%value=>generic%value
3283  class default
3284  call log_log(log_error, "Next item in iterator is not a map entry")
3285  end select
3286  else
3287  call log_log(log_error, "Can not get next map entry in iterator as iterator has reached end of collection")
3288  end if
3289  end function iterator_get_next_mapentry
3290 
3294  function iterator_get_next_generic(iterator)
3295  type(iterator_type), intent(inout) :: iterator
3296  class(*), pointer :: iterator_get_next_generic
3297 
3298  integer :: i
3299 
3300  if (associated(iterator%next_item)) then
3301  iterator_get_next_generic=>iterator%next_item%data
3302  iterator%next_item=>iterator%next_item%next
3303  if (.not. associated(iterator%next_item) .and. associated(iterator%hash_structure) .and. &
3304  iterator%hash_ptr .le. size(iterator%hash_structure)) then
3305  do i=iterator%hash_ptr, size(iterator%hash_structure)
3306  if (iterator%hash_structure(i)%size .gt. 0) then
3307  iterator%next_item=>iterator%hash_structure(i)%head
3308  exit
3309  end if
3310  end do
3311  iterator%hash_ptr=i+1
3312  end if
3313  else
3314  iterator_get_next_generic=>null()
3315  end if
3316  end function iterator_get_next_generic
3317 
3320  function mapentry_get_int(mapentry_item)
3321  type(mapentry_type), intent(in) :: mapentry_item
3322  integer :: mapentry_get_int
3323 
3324  class(*), pointer :: generic
3325 
3326  generic=>mapentry_item%value
3327  if (.not. associated(generic)) call log_log(log_error, "Can not get integer from map entry")
3328  mapentry_get_int=conv_to_integer(generic, .false.)
3329  end function mapentry_get_int
3330 
3333  function mapentry_get_string(mapentry_item)
3334  type(mapentry_type), intent(in) :: mapentry_item
3335  character(len=STRING_LENGTH) :: mapentry_get_string
3336 
3337  class(*), pointer :: generic
3338 
3339  generic=>mapentry_item%value
3340  if (.not. associated(generic)) call log_log(log_error, "Can not get string from map entry")
3341  mapentry_get_string=conv_to_string(generic, .false., string_length)
3342  end function mapentry_get_string
3343 
3346  function mapentry_get_real(mapentry_item)
3347  type(mapentry_type), intent(in) :: mapentry_item
3348  real(kind=DEFAULT_PRECISION) :: mapentry_get_real
3349 
3350  class(*), pointer :: generic
3351 
3352  generic=>mapentry_item%value
3353  if (.not. associated(generic)) call log_log(log_error, "Can not get real from map entry")
3354  select type(vr=>generic)
3355  type is (real(kind=default_precision))
3356  mapentry_get_real=vr
3357  type is (real)
3358  mapentry_get_real=conv_single_real_to_double(vr)
3359  type is (integer)
3360  mapentry_get_real=conv_single_real_to_double(conv_to_real(vr))
3361  end select
3362  end function mapentry_get_real
3363 
3366  function mapentry_get_logical(mapentry_item)
3367  type(mapentry_type), intent(in) :: mapentry_item
3368  logical :: mapentry_get_logical
3369 
3370  class(*), pointer :: generic
3371 
3372  generic=>mapentry_item%value
3373  if (.not. associated(generic)) call log_log(log_error, "Can not get logical from map entry")
3374  mapentry_get_logical=conv_to_logical(generic, .false.)
3375  end function mapentry_get_logical
3376 
3379  function mapentry_get_generic(mapentry_item)
3380  type(mapentry_type), intent(in) :: mapentry_item
3381  class(*), pointer :: mapentry_get_generic
3382 
3383  mapentry_get_generic=>mapentry_item%value
3384  end function mapentry_get_generic
3385 end module collections_mod
Adds a double precision real element to the end of the list.
type(mapentry_type) function iterator_get_next_mapentry(iterator)
Returns the next mapentry referenced by the iterator and advanced it, or an error if it has reached t...
Private list node which holds the raw generic node data and pointers to next and previous list nodes...
Definition: collections.F90:23
Gets a specific logical element out of the list, stack, queue or map with the corresponding key...
subroutine hashmap_put_logical(specificmap, key, logical_data)
Puts a specific key-value pair into the hashmap.
Retrieves the string value held at the specific map index or null if index > map elements.
subroutine list_add_int(specificlist, int_data)
Adds an element to the end of the list.
integer function mapentry_get_int(mapentry_item)
Retrieves the integer value from a map entry.
subroutine queue_push_real(specificqueue, real_data)
Adds an element to the end of the queue (FIFO)
type(iterator_type) function list_get_iterator(specificlist)
Retrieves an iterator representation of the list, ready to access the first element.
subroutine list_add_string(specificlist, str_data)
Adds an element to the end of the list.
Retrieves the integer value held at the specific map index or null if index > map elements...
subroutine hashmap_put_generic(specificmap, key, data, memory_allocation_automatic)
Puts a specific key-value pair into the hashmap.
real(kind=default_precision) function stack_pop_real(specificstack)
Pops an element off the stack (LIFO). Converts between precision and from int.
subroutine hashset_free(specificset)
Frees up all the allocatable, heap, memory associated with a specific set.
subroutine list_remove(specificlist, i)
Removes an element from the list at a specific index.
subroutine queue_free(specificqueue)
Frees up all the allocatable, heap, memory associated with a specific queue.
subroutine map_remove(specificmap, key)
Removes a specific key-value pair from the map.
logical function hashset_is_empty(specificset)
Determines whether or not the hashset is empty.
integer, parameter, private hash_size
Number of entries in the hash table, this is a tradeoff - larger means more memory but smaller runtim...
Definition: collections.F90:20
Adds a logical element to the end of the list.
logical function stack_get_logical(specificstack, i)
Gets a specific element from the stack at index specified.
logical function hashmap_get_logical(specificmap, key)
Gets a specific element out of the hashmap with the corresponding key.
subroutine stack_push_logical(specificstack, logical_data)
Pushes an element onto the stack (LIFO)
logical function map_generic_entry_at(specificmap, i, key, val)
Retrieves the entry at a specific map index or null if index > map elements.
Retrieves the key currently being held at a specific index in the map or "" if the index > map elemen...
logical function map_logical_at(specificmap, i)
Retrieves the logical value held at the specific map index.
Gets a specific generic element out of the list, stack, queue or map with the corresponding key...
subroutine list_insert_int(specificlist, int_data, i)
Inserts an element into the list or places at the end if the index > list size.
subroutine queue_push_string(specificqueue, str_data)
Adds an element to the end of the queue (FIFO)
Private set key structure.
Definition: collections.F90:41
Returns whether a collection is empty.
Puts an integer key-value pair into the map.
logical function map_contains_key(specificmap, key)
Determines whether or not a map contains a specific key.
logical function queue_is_empty(specificqueue)
Returns whether a queue is empty.
logical function map_real_entry_at(specificmap, i, key, real_val)
Retrieves the entry at a specific map index or null if index > map elements. This converts precision ...
Inserts a generic element into the list or places at the end if the index > list size.
integer function hashmap_real_at(specificmap, i)
Retrieves the value held at the specific hashmap index. Converts between precision and from int...
subroutine map_free(specificmap)
Frees up all the allocatable, heap, memory associated with a specific map.
class(*) function, pointer queue_get_generic(specificqueue, i)
Returns a specific queue element at an index or null if index > queue size.
Inserts an integer element into the list or places at the end if the index > list size...
real(kind=default_precision) function queue_get_real(specificqueue, i)
Returns a specific queue element at an index. Converts between precision and from int...
integer function list_get_int(specificlist, i)
Retrieves the element at index i from the list.
Pushes a generic element onto the stack or queue.
integer, parameter, public log_error
Only log ERROR messages.
Definition: logging.F90:11
subroutine list_add_real(specificlist, real_data)
Adds an element to the end of the list.
subroutine map_put_generic(specificmap, key, data, memory_allocation_automatic)
Puts a specific key-value pair into the map.
logical function hashset_contains(specificset, key)
Determines wheter the hashset contains a specific key or not.
logical function mapentry_get_logical(mapentry_item)
Retrieves the logical value from a map entry.
class(*) function, pointer map_getnode(specificmap, key, foundindex)
This gets the map node that the key represents (rather than the specific value)
subroutine queue_push_logical(specificqueue, logical_data)
Adds an element to the end of the queue (FIFO)
Logging utility.
Definition: logging.F90:2
character(len=string_length) function hashmap_key_at(specificmap, i)
Retrieves the key currently being held at a specific index in the hashmap or "" if the index > map el...
real(kind=default_precision) function mapentry_get_real(mapentry_item)
Retrieves the double precision real value from a map entry.
subroutine hashmap_put_string(specificmap, key, str_data)
Puts a specific key-value pair into the hashmap.
logical function queue_pop_logical(specificqueue)
Pops the queue element off the head of the queue (FIFO)
subroutine map_put_real(specificmap, key, real_data)
Puts a specific key-value pair into the map.
integer, parameter, public default_precision
MPI communication type which we use for the prognostic and calculation data.
Definition: datadefn.F90:17
integer function map_size(specificmap)
Returns the number of elements in the map.
character(len=string_length) function iterator_get_next_string(iterator)
Returns the next string referenced by the iterator and advanced it, or an error if it has reached the...
class(*) function, pointer map_get_generic(specificmap, key)
Gets a specific element out of the map with the corresponding key.
class(*) function, pointer queue_pop_generic(specificqueue)
Pops the queue element off the head of the queue (FIFO)
subroutine list_insert_generic(specificlist, data, i, memory_allocation_automatic)
Inserts an element into the list or places at the end if the index > list size.
logical function map_get_logical(specificmap, key)
Gets a specific element out of the map with the corresponding key.
class(*) function, pointer hashmap_getnode_atindex(specificmap, index)
This gets the hashmap node at a specific index, from the first hash linked list to the end...
Converts a data type into the generic (class *) form.
Definition: conversions.F90:23
logical function list_is_empty(specificlist)
Determines whether or not the list is empty.
Contains common definitions for the data and datatypes used by MONC.
Definition: datadefn.F90:2
real(kind=default_precision) function list_get_real(specificlist, i)
Retrieves the element at index i from the list. Converts between precision and from int...
subroutine stack_push_int(specificstack, int_data)
Pushes an element onto the stack (LIFO)
Adds an integer element to the end of the list.
Pushes a double precision real element onto the stack or queue.
Pops a generic element off the stack or queue.
logical function hashmap_is_empty(specificmap)
Returns whether a hashmap is empty.
A hashmap structure, the same as a map but uses hashing for greatly improved performance when storing...
Definition: collections.F90:94
character(len=string_length) function hashset_get_string(specificset, index)
Retrieves the key at index i from the set or empty string if index < list size.
subroutine hashmap_remove(specificmap, key)
Removes a specific key-value pair from the hashmap.
character(len=string_length) function hashmap_get_string(specificmap, key)
Gets a specific element out of the hashmap with the corresponding key.
subroutine map_put_logical(specificmap, key, logical_data)
Puts a specific key-value pair into the map.
character(len=string_length) function stack_pop_string(specificstack)
Pops an element off the stack (LIFO)
real(kind=default_precision) function map_get_real(specificmap, key)
Gets a specific element out of the map with the corresponding key. This converts between precision an...
logical function iteratior_has_next(iterator)
Deduces whether an iterator has a next entry or not.
Inserts a logical element into the list or places at the end if the index > list size.
logical function queue_get_logical(specificqueue, i)
Returns a specific queue element at an index.
logical function hashmap_logical_entry_at(specificmap, i, key, logical_val)
Retrieves the entry at a specific map index.
Gets a specific integer element out of the list, stack, queue or map with the corresponding key...
Conversion between common inbuilt FORTRAN data types.
Definition: conversions.F90:5
character(len=string_length) function map_string_at(specificmap, i)
Retrieves the string value held at the specific map index.
Converts data types to strings.
Definition: conversions.F90:36
subroutine map_put_int(specificmap, key, int_data)
Puts a specific key-value pair into the map.
Puts a string key-value pair into the map.
subroutine map_put_string(specificmap, key, str_data)
Puts a specific key-value pair into the map.
integer function get_hashkey(key)
Translates the string key into a hash from 1 to hash_size (inclusive.) This encoding is deterministic...
logical function hashmap_contains_key(specificmap, key)
Determines whether or not a hashmap contains a specific key.
logical function stack_pop_logical(specificstack)
Pops an element off the stack (LIFO)
class(*) function, pointer hashmap_get_generic(specificmap, key)
Gets a specific element out of the hashmap with the corresponding key.
type(iterator_type) function stack_get_iterator(specificstack)
Retrieves an iterator representation of the stack, ready to access the first element.
subroutine, public log_log(level, message, str)
Logs a message at the specified level. If the level is above the current level then the message is ig...
Definition: logging.F90:75
Converts data types to logical.
Definition: conversions.F90:69
Puts a logical key-value pair into the map.
logical function map_logical_entry_at(specificmap, i, key, logical_val)
Retrieves the entry at a specific map index or null if index > map elements.
Pops a string off the stack or queue.
integer function stack_pop_int(specificstack)
Pops an element off the stack (LIFO)
real(kind=default_precision) function stack_get_real(specificstack, i)
Gets a specific element from the stack at index specified. Converts between precision and from int...
Private map key-value pair data structure.
Definition: collections.F90:32
integer function hashmap_size(specificmap)
Returns the number of elements in the hashmap.
real(kind=default_precision) function iterator_get_next_real(iterator)
Returns the next real (double precision) referenced by the iterator and advanced it, or an error if it has reached the end of iteration.
integer function stack_size(specificstack)
Returns the number of elements held on the stack.
integer function map_integer_at(specificmap, i)
Retrieves the integer value held at the specific map index.
subroutine list_add_generic(specificlist, data, memory_allocation_automatic)
Adds an element to the end of the list.
Pops a logical element off the stack or queue.
Map data structure that holds string (length 20 maximum) key value pairs.
Definition: collections.F90:86
logical function hashmap_generic_entry_at(specificmap, i, key, val)
Retrieves the entry at a specific map index or null if index > map elements.
character(len=string_length) function queue_get_string(specificqueue, i)
Returns a specific queue element at an index.
subroutine stack_push_string(specificstack, str_data)
Pushes an element onto the stack (LIFO)
integer function queue_get_int(specificqueue, i)
Returns a specific queue element at an index.
Returns the number of elements in the collection.
Inserts a string into the list or places at the end if the index > list size.
character(len=string_length) function queue_pop_string(specificqueue)
Pops the queue element off the head of the queue (FIFO)
subroutine stack_push_real(specificstack, real_data)
Pushes an element onto the stack (LIFO)
real(kind=default_precision) function map_real_at(specificmap, i)
Retrieves the real value held at the specific map index. Converts between precision and int...
type(iterator_type) function hashset_get_iterator(specificset)
Retrieves an iterator representation of the hashset, ready to access the first element.
integer function list_size(specificlist)
Returns the number of elements in a list.
logical function hashmap_logical_at(specificmap, i)
Retrieves the value held at the specific hashmap index. Note that this is an expensive operation has ...
Collection data structures.
Definition: collections.F90:7
subroutine hashset_remove(specificset, key)
Removes a string from the hashset.
subroutine queue_push_int(specificqueue, int_data)
Adds an element to the end of the queue (FIFO)
type(iterator_type) function queue_get_iterator(specificqueue)
Retrieves an iterator representation of the queue, ready to access the first element.
subroutine list_add_logical(specificlist, logical_data)
Adds an element to the end of the list.
type(iterator_type) function map_get_iterator(specificmap)
Retrieves an iterator representation of the map, ready to access the first element.
type(iterator_type) function hashmap_get_iterator(specificmap)
Retrieves an iterator representation of the hashmap, ready to access the first element.
Retrieves a map entry at a specific index. This is more efficient than calling key at and then value ...
Pushes a string element onto the stack or queue.
logical function hashmap_real_entry_at(specificmap, i, key, real_val)
Retrieves the entry at a specific map index. This converts between precision and from int...
Inserts a double precision real element into the list or places at the end if the index > list size...
logical function map_is_empty(specificmap)
Returns whether a map is empty.
integer function hashmap_get_int(specificmap, key)
Gets a specific element out of the hashmap with the corresponding key.
integer function iterator_get_next_integer(iterator)
Returns the next integer referenced by the iterator and advanced it, or an error if it has reached th...
integer function stack_get_int(specificstack, i)
Gets a specific element from the stack at index specified.
Converts data types to real.
Definition: conversions.F90:58
real(kind=default_precision) function hashmap_get_real(specificmap, key)
Gets a specific element out of the hashmap with the corresponding key. Converts between precision and...
logical function hashmap_integer_entry_at(specificmap, i, key, int_val)
Retrieves the entry at a specific map index.
integer, parameter, public string_length
Default length of strings.
Definition: datadefn.F90:10
character(len=string_length) function map_key_at(specificmap, i)
Retrieves the key currently being held at a specific index in the map or "" if the index > map elemen...
subroutine hashmap_put_int(specificmap, key, int_data)
Puts a specific key-value pair into the hashmap.
Retrieves a map entry at a specific index or null if index > map elements. This is more efficient tha...
character(len=string_length) function hashmap_string_at(specificmap, i)
Retrieves the value held at the specific hashmap index. Note that this is an expensive operation has ...
character(len=string_length) function list_get_string(specificlist, i)
Retrieves the element at index i from the list.
List data structure which implements a doubly linked list. This list will preserve its order...
Definition: collections.F90:60
subroutine hashset_getlocation(specificset, key, hash, key_location)
Determines the location and hash of a key within a specific hashset. The hash is set regardless of wh...
Queue (FIFO) data structure.
Definition: collections.F90:70
real(kind=default_precision) function, pointer, public generic_to_double_real(generic, makecopy)
Converts a generic to a double real.
subroutine hashset_add(specificset, key)
Adds a string to the hashset which stores unique strings, therefore if the string already exists then...
logical function stack_is_empty(specificstack)
Returns whether a stack is empty.
subroutine list_free(specificlist)
Frees up all the allocatable, heap, memory associated with a specific list.
class(*) function, pointer hashmap_getnode(specificmap, key, key_location)
This gets the hashmap node that the key represents (rather than the specific value) ...
Adds a generic element to the end of the list.
subroutine stack_free(specificstack)
Frees up all the allocatable, heap, memory associated with a specific stack.
subroutine list_insert_string(specificlist, str_data, i)
Inserts an element into the list or places at the end if the index > list size.
subroutine stack_push_generic(specificstack, data, memory_allocation_automatic)
Pushes an element onto the stack (LIFO)
class(*) function, pointer stack_pop_generic(specificstack)
Pops an element off the stack (LIFO)
Pushes a logical element onto the stack or queue.
logical function map_integer_entry_at(specificmap, i, key, int_val)
Retrieves the entry at a specific map index or null if index > map elements.
integer function hashset_size(specificset)
Returns the number of elements in a list.
Pops an integer element off the stack or queue.
Frees up all the allocatable, heap, memory associated with a list, stack, queue or map...
class(*) function, pointer iterator_get_next_generic(iterator)
Returns the next generic referenced by the iterator and advanced it, or null if it has reached the en...
Retrieves the logical value held at the specific map index or null if index > map elements...
class(*) function, pointer stack_get_generic(specificstack, i)
Gets a specific element from the stack at index specified or null if the index > stack size...
real(kind=default_precision) function queue_pop_real(specificqueue)
Pops the queue element off the head of the queue (FIFO). Converts between precision and from int...
class(*) function, pointer mapentry_get_generic(mapentry_item)
Retrieves the generic value from a map entry.
class(*) function, pointer hashmap_generic_at(specificmap, i)
Retrieves the value held at the specific hashmap index or null if index > map elements. Note that this is an expensive operation has it has to potentially process all internal hashed lists so avoid if can.
subroutine list_insert_logical(specificlist, logical_data, i)
Inserts an element into the list or places at the end if the index > list size.
Puts a generic key-value pair into the map.
logical function hashmap_string_entry_at(specificmap, i, key, str_val)
Retrieves the entry at a specific map index.
integer function queue_pop_int(specificqueue)
Pops the queue element off the head of the queue (FIFO)
integer function map_get_int(specificmap, key)
Gets a specific element out of the map with the corresponding key.
subroutine hashmap_put_real(specificmap, key, real_data)
Puts a specific key-value pair into the hashmap.
integer function queue_size(specificqueue)
Returns the number of elements held in a queue.
Retrieves the generic value held at the specific map index or null if index > map elements...
Pushes an integer element onto the stack or queue.
Hashset structure which will store unique strings. The hashing aspect means that lookup is very fast ...
Stack (FILO) data structure.
Definition: collections.F90:78
character(len=string_length) function map_get_string(specificmap, key)
Gets a specific element out of the map with the corresponding key.
character(len=string_length) function mapentry_get_string(mapentry_item)
Retrieves the string value from a map entry.
Converts data types to integers.
Definition: conversions.F90:47
character(len=string_length) function stack_get_string(specificstack, i)
Gets a specific element from the stack at index specified.
Determines whether or not a map contains a specific key.
Gets a specific double precision real element out of the list, stack, queue or map with the correspon...
logical function iterator_get_next_logical(iterator)
Returns the next logical referenced by the iterator and advanced it, or an error if it has reached th...
Adds a string to the end of the list.
subroutine hashmap_free(specificmap)
Frees up all the allocatable, heap, memory associated with a specific hashmap.
Retrieves a map entry at a specific index. This is more efficient than calling key at and then value ...
logical function list_get_logical(specificlist, i)
Retrieves the element at index i from the list.
integer function hashmap_integer_at(specificmap, i)
Retrieves the value held at the specific hashmap index. Note that this is an expensive operation has ...
logical function map_string_entry_at(specificmap, i, key, str_val)
Retrieves the entry at a specific map index or null if index > map elements.
Retrieves a map entry at a specific index. This is more efficient than calling key at and then value ...
subroutine list_insert_real(specificlist, real_data, i)
Inserts an element into the list or places at the end if the index > list size.
Gets a specific string element out of the list, stack, queue or map with the corresponding key...
Retrieves the double precision real value held at the specific map index or null if index > map eleme...
Pops a double precision real element off the stack or queue.
subroutine queue_push_generic(specificqueue, data, memory_allocation_automatic)
Adds an element to the end of the queue (FIFO)
real(kind=double_precision) function, public conv_single_real_to_double(input_real)
Converts from a single to double precision real. This applies some rounding to a certain number of de...
Retrieves a map entry at a specific index. This is more efficient than calling key at and then value ...
Puts a double precision real key-value pair into the map.
class(*) function, pointer map_generic_at(specificmap, i)
Retrieves the generic value held at the specific map index or null if index > map elements...
Removes a specific element from the list or map.
class(*) function, pointer list_get_generic(specificlist, i)
Retrieves the element at index i from the list or null if index < list size.