12 #include "../base/base_uses.f90"
31 LOGICAL,
PRIVATE,
PARAMETER :: debug_this_module = .true.
35 PUBLIC :: cp_sll_int_type, cp_sll_int_p_type
36 PUBLIC :: cp_sll_real_type, cp_sll_real_p_type
37 PUBLIC :: cp_sll_logical_type, cp_sll_logical_p_type
38 PUBLIC :: cp_sll_char_type, cp_sll_char_p_type
39 PUBLIC :: cp_sll_val_type, cp_sll_val_p_type
42 PUBLIC :: cp_create, cp_dealloc, cp_next
44 PUBLIC :: cp_get_first_el, cp_get_rest, cp_get_length, cp_get_element_at, cp_to_array
46 PUBLIC :: cp_set_element_at
48 PUBLIC :: cp_insert, cp_remove_first_el, cp_remove_el, cp_remove_all
123 INTERFACE cp_get_first_el
131 INTERFACE cp_get_rest
139 INTERFACE cp_get_length
147 INTERFACE cp_get_element_at
155 INTERFACE cp_set_element_at
170 INTERFACE cp_insert_at
178 INTERFACE cp_remove_el
191 INTERFACE cp_remove_first_el
199 INTERFACE cp_remove_all
207 INTERFACE cp_to_array
238 integer :: first_el = 0
239 TYPE(cp_sll_int_type),
POINTER :: rest => null()
240 END TYPE cp_sll_int_type
263 TYPE cp_sll_real_type
264 REAL(kind=
dp) :: first_el = 0.0_dp
265 TYPE(cp_sll_real_type),
POINTER :: rest => null()
266 END TYPE cp_sll_real_type
289 TYPE cp_sll_logical_type
290 logical :: first_el = .false.
291 TYPE(cp_sll_logical_type),
POINTER :: rest => null()
292 END TYPE cp_sll_logical_type
315 TYPE cp_sll_char_type
316 character(len=default_string_length) :: first_el =
""
317 TYPE(cp_sll_char_type),
POINTER :: rest => null()
318 END TYPE cp_sll_char_type
342 type(val_type),
pointer :: first_el => null()
343 TYPE(cp_sll_val_type),
POINTER :: rest => null()
344 END TYPE cp_sll_val_type
353 TYPE cp_sll_int_p_type
354 TYPE(cp_sll_int_type),
POINTER :: list => null()
355 END TYPE cp_sll_int_p_type
363 TYPE cp_sll_real_p_type
364 TYPE(cp_sll_real_type),
POINTER :: list => null()
365 END TYPE cp_sll_real_p_type
373 TYPE cp_sll_logical_p_type
374 TYPE(cp_sll_logical_type),
POINTER :: list => null()
375 END TYPE cp_sll_logical_p_type
383 TYPE cp_sll_char_p_type
384 TYPE(cp_sll_char_type),
POINTER :: list => null()
385 END TYPE cp_sll_char_p_type
393 TYPE cp_sll_val_p_type
394 TYPE(cp_sll_val_type),
POINTER :: list => null()
395 END TYPE cp_sll_val_p_type
412 TYPE(cp_sll_int_type),
POINTER :: sll
413 integer,
intent(in),
OPTIONAL :: first_el
414 TYPE(cp_sll_int_type),
POINTER,
OPTIONAL :: rest
416 IF (.NOT.
PRESENT(first_el))
THEN
418 IF (
PRESENT(rest)) sll => rest
421 sll%first_el =first_el
423 IF (
PRESENT(rest)) sll%rest => rest
436 TYPE(cp_sll_real_type),
POINTER :: sll
437 REAL(kind=
dp),
intent(in),
OPTIONAL :: first_el
438 TYPE(cp_sll_real_type),
POINTER,
OPTIONAL :: rest
440 IF (.NOT.
PRESENT(first_el))
THEN
442 IF (
PRESENT(rest)) sll => rest
445 sll%first_el =first_el
447 IF (
PRESENT(rest)) sll%rest => rest
460 TYPE(cp_sll_logical_type),
POINTER :: sll
461 logical,
intent(in),
OPTIONAL :: first_el
462 TYPE(cp_sll_logical_type),
POINTER,
OPTIONAL :: rest
464 IF (.NOT.
PRESENT(first_el))
THEN
466 IF (
PRESENT(rest)) sll => rest
469 sll%first_el =first_el
471 IF (
PRESENT(rest)) sll%rest => rest
484 TYPE(cp_sll_char_type),
POINTER :: sll
485 character(len=default_string_length),
intent(in),
OPTIONAL :: first_el
486 TYPE(cp_sll_char_type),
POINTER,
OPTIONAL :: rest
488 IF (.NOT.
PRESENT(first_el))
THEN
490 IF (
PRESENT(rest)) sll => rest
493 sll%first_el =first_el
495 IF (
PRESENT(rest)) sll%rest => rest
508 TYPE(cp_sll_val_type),
POINTER :: sll
509 type(val_type),
pointer,
intent(in),
OPTIONAL :: first_el
510 TYPE(cp_sll_val_type),
POINTER,
OPTIONAL :: rest
512 IF (.NOT.
PRESENT(first_el))
THEN
514 IF (
PRESENT(rest)) sll => rest
517 sll%first_el =>first_el
519 IF (
PRESENT(rest)) sll%rest => rest
535 TYPE(cp_sll_int_type),
POINTER :: sll
551 TYPE(cp_sll_real_type),
POINTER :: sll
567 TYPE(cp_sll_logical_type),
POINTER :: sll
583 TYPE(cp_sll_char_type),
POINTER :: sll
599 TYPE(cp_sll_val_type),
POINTER :: sll
613 SUBROUTINE cp_sll_int_dealloc_node(sll)
614 TYPE(cp_sll_int_type),
POINTER :: sll
617 END SUBROUTINE cp_sll_int_dealloc_node
625 SUBROUTINE cp_sll_real_dealloc_node(sll)
626 TYPE(cp_sll_real_type),
POINTER :: sll
629 END SUBROUTINE cp_sll_real_dealloc_node
637 SUBROUTINE cp_sll_logical_dealloc_node(sll)
638 TYPE(cp_sll_logical_type),
POINTER :: sll
641 END SUBROUTINE cp_sll_logical_dealloc_node
649 SUBROUTINE cp_sll_char_dealloc_node(sll)
650 TYPE(cp_sll_char_type),
POINTER :: sll
653 END SUBROUTINE cp_sll_char_dealloc_node
661 SUBROUTINE cp_sll_val_dealloc_node(sll)
662 TYPE(cp_sll_val_type),
POINTER :: sll
665 END SUBROUTINE cp_sll_val_dealloc_node
678 TYPE(cp_sll_int_type),
POINTER :: sll
692 TYPE(cp_sll_real_type),
POINTER :: sll
706 TYPE(cp_sll_logical_type),
POINTER :: sll
720 TYPE(cp_sll_char_type),
POINTER :: sll
721 character(len=default_string_length) :: res
734 TYPE(cp_sll_val_type),
POINTER :: sll
735 type(val_type),
pointer :: res
753 TYPE(cp_sll_int_type),
POINTER :: sll
754 INTEGER,
OPTIONAL :: iter
756 TYPE(cp_sll_int_type),
POINTER :: res
760 IF (.NOT.
ASSOCIATED(sll))
THEN
763 IF (
PRESENT(iter))
THEN
766 IF (
ASSOCIATED(res%rest))
THEN
769 cpabort(
"tried to go past end")
774 IF (.NOT.
ASSOCIATED(res%rest))
EXIT
796 TYPE(cp_sll_real_type),
POINTER :: sll
797 INTEGER,
OPTIONAL :: iter
799 TYPE(cp_sll_real_type),
POINTER :: res
803 IF (.NOT.
ASSOCIATED(sll))
THEN
806 IF (
PRESENT(iter))
THEN
809 IF (
ASSOCIATED(res%rest))
THEN
812 cpabort(
"tried to go past end")
817 IF (.NOT.
ASSOCIATED(res%rest))
EXIT
839 TYPE(cp_sll_logical_type),
POINTER :: sll
840 INTEGER,
OPTIONAL :: iter
842 TYPE(cp_sll_logical_type),
POINTER :: res
846 IF (.NOT.
ASSOCIATED(sll))
THEN
849 IF (
PRESENT(iter))
THEN
852 IF (
ASSOCIATED(res%rest))
THEN
855 cpabort(
"tried to go past end")
860 IF (.NOT.
ASSOCIATED(res%rest))
EXIT
882 TYPE(cp_sll_char_type),
POINTER :: sll
883 INTEGER,
OPTIONAL :: iter
885 TYPE(cp_sll_char_type),
POINTER :: res
889 IF (.NOT.
ASSOCIATED(sll))
THEN
892 IF (
PRESENT(iter))
THEN
895 IF (
ASSOCIATED(res%rest))
THEN
898 cpabort(
"tried to go past end")
903 IF (.NOT.
ASSOCIATED(res%rest))
EXIT
925 TYPE(cp_sll_val_type),
POINTER :: sll
926 INTEGER,
OPTIONAL :: iter
928 TYPE(cp_sll_val_type),
POINTER :: res
932 IF (.NOT.
ASSOCIATED(sll))
THEN
935 IF (
PRESENT(iter))
THEN
938 IF (
ASSOCIATED(res%rest))
THEN
941 cpabort(
"tried to go past end")
946 IF (.NOT.
ASSOCIATED(res%rest))
EXIT
967 TYPE(cp_sll_int_type),
pointer :: sll
970 TYPE(cp_sll_int_type),
POINTER :: iterator
975 IF (
ASSOCIATED(iterator))
THEN
977 iterator => iterator%rest
994 TYPE(cp_sll_real_type),
pointer :: sll
997 TYPE(cp_sll_real_type),
POINTER :: iterator
1002 IF (
ASSOCIATED(iterator))
THEN
1004 iterator => iterator%rest
1021 TYPE(cp_sll_logical_type),
pointer :: sll
1024 TYPE(cp_sll_logical_type),
POINTER :: iterator
1029 IF (
ASSOCIATED(iterator))
THEN
1031 iterator => iterator%rest
1048 TYPE(cp_sll_char_type),
pointer :: sll
1051 TYPE(cp_sll_char_type),
POINTER :: iterator
1056 IF (
ASSOCIATED(iterator))
THEN
1058 iterator => iterator%rest
1075 TYPE(cp_sll_val_type),
pointer :: sll
1078 TYPE(cp_sll_val_type),
POINTER :: iterator
1083 IF (
ASSOCIATED(iterator))
THEN
1085 iterator => iterator%rest
1105 TYPE(cp_sll_int_type),
POINTER :: sll
1106 INTEGER,
INTENT(in) :: index
1108 TYPE(cp_sll_int_type),
POINTER :: pos
1110 IF (index == -1)
THEN
1115 cpassert(
ASSOCIATED(pos))
1131 REAL(kind=
dp) :: res
1132 TYPE(cp_sll_real_type),
POINTER :: sll
1133 INTEGER,
INTENT(in) :: index
1135 TYPE(cp_sll_real_type),
POINTER :: pos
1137 IF (index == -1)
THEN
1142 cpassert(
ASSOCIATED(pos))
1159 TYPE(cp_sll_logical_type),
POINTER :: sll
1160 INTEGER,
INTENT(in) :: index
1162 TYPE(cp_sll_logical_type),
POINTER :: pos
1164 IF (index == -1)
THEN
1169 cpassert(
ASSOCIATED(pos))
1185 character(len=default_string_length) :: res
1186 TYPE(cp_sll_char_type),
POINTER :: sll
1187 INTEGER,
INTENT(in) :: index
1189 TYPE(cp_sll_char_type),
POINTER :: pos
1191 IF (index == -1)
THEN
1196 cpassert(
ASSOCIATED(pos))
1212 type(val_type),
pointer :: res
1213 TYPE(cp_sll_val_type),
POINTER :: sll
1214 INTEGER,
INTENT(in) :: index
1216 TYPE(cp_sll_val_type),
POINTER :: pos
1218 IF (index == -1)
THEN
1223 cpassert(
ASSOCIATED(pos))
1241 integer,
intent(in) :: value
1242 TYPE(cp_sll_int_type),
POINTER :: sll
1243 INTEGER,
INTENT(in) :: index
1245 TYPE(cp_sll_int_type),
POINTER :: pos
1247 IF (index == -1)
THEN
1252 cpassert(
ASSOCIATED(pos))
1269 REAL(kind=
dp),
intent(in) ::
value
1270 TYPE(cp_sll_real_type),
POINTER :: sll
1271 INTEGER,
INTENT(in) :: index
1273 TYPE(cp_sll_real_type),
POINTER :: pos
1275 IF (index == -1)
THEN
1280 cpassert(
ASSOCIATED(pos))
1297 logical,
intent(in) :: value
1298 TYPE(cp_sll_logical_type),
POINTER :: sll
1299 INTEGER,
INTENT(in) :: index
1301 TYPE(cp_sll_logical_type),
POINTER :: pos
1303 IF (index == -1)
THEN
1308 cpassert(
ASSOCIATED(pos))
1325 character(len=default_string_length),
intent(in) :: value
1326 TYPE(cp_sll_char_type),
POINTER :: sll
1327 INTEGER,
INTENT(in) :: index
1329 TYPE(cp_sll_char_type),
POINTER :: pos
1331 IF (index == -1)
THEN
1336 cpassert(
ASSOCIATED(pos))
1353 type(val_type),
pointer,
intent(in) :: value
1354 TYPE(cp_sll_val_type),
POINTER :: sll
1355 INTEGER,
INTENT(in) :: index
1357 TYPE(cp_sll_val_type),
POINTER :: pos
1359 IF (index == -1)
THEN
1364 cpassert(
ASSOCIATED(pos))
1366 pos%first_el =>
value
1382 TYPE(cp_sll_int_type),
POINTER :: iterator
1383 integer,
intent(out),
OPTIONAL :: el_att
1386 IF (
ASSOCIATED(iterator))
THEN
1388 if (
present(el_att)) el_att =iterator%first_el
1389 iterator => iterator%rest
1405 TYPE(cp_sll_real_type),
POINTER :: iterator
1406 REAL(kind=
dp),
intent(out),
OPTIONAL :: el_att
1409 IF (
ASSOCIATED(iterator))
THEN
1411 if (
present(el_att)) el_att =iterator%first_el
1412 iterator => iterator%rest
1428 TYPE(cp_sll_logical_type),
POINTER :: iterator
1429 logical,
intent(out),
OPTIONAL :: el_att
1432 IF (
ASSOCIATED(iterator))
THEN
1434 if (
present(el_att)) el_att =iterator%first_el
1435 iterator => iterator%rest
1451 TYPE(cp_sll_char_type),
POINTER :: iterator
1452 character(len=default_string_length),
intent(out),
OPTIONAL :: el_att
1455 IF (
ASSOCIATED(iterator))
THEN
1457 if (
present(el_att)) el_att =iterator%first_el
1458 iterator => iterator%rest
1474 TYPE(cp_sll_val_type),
POINTER :: iterator
1475 type(val_type),
pointer,
intent(out),
OPTIONAL :: el_att
1478 IF (
ASSOCIATED(iterator))
THEN
1480 if (
present(el_att)) el_att =>iterator%first_el
1481 iterator => iterator%rest
1501 TYPE(cp_sll_int_type),
POINTER :: sll
1502 integer,
intent(in):: el
1504 TYPE(cp_sll_int_type),
POINTER :: newslot
1524 TYPE(cp_sll_real_type),
POINTER :: sll
1525 REAL(kind=
dp),
intent(in):: el
1527 TYPE(cp_sll_real_type),
POINTER :: newslot
1547 TYPE(cp_sll_logical_type),
POINTER :: sll
1548 logical,
intent(in):: el
1550 TYPE(cp_sll_logical_type),
POINTER :: newslot
1570 TYPE(cp_sll_char_type),
POINTER :: sll
1571 character(len=default_string_length),
intent(in):: el
1573 TYPE(cp_sll_char_type),
POINTER :: newslot
1593 TYPE(cp_sll_val_type),
POINTER :: sll
1594 type(val_type),
pointer,
intent(in):: el
1596 TYPE(cp_sll_val_type),
POINTER :: newslot
1615 TYPE(cp_sll_int_type),
POINTER :: sll
1617 TYPE(cp_sll_int_type),
POINTER :: node_to_rm
1620 IF (
ASSOCIATED(sll))
THEN
1622 CALL cp_sll_int_dealloc_node(node_to_rm)
1624 cpabort(
"tried to remove first el of an empty list")
1637 TYPE(cp_sll_real_type),
POINTER :: sll
1639 TYPE(cp_sll_real_type),
POINTER :: node_to_rm
1642 IF (
ASSOCIATED(sll))
THEN
1644 CALL cp_sll_real_dealloc_node(node_to_rm)
1646 cpabort(
"tried to remove first el of an empty list")
1659 TYPE(cp_sll_logical_type),
POINTER :: sll
1661 TYPE(cp_sll_logical_type),
POINTER :: node_to_rm
1664 IF (
ASSOCIATED(sll))
THEN
1666 CALL cp_sll_logical_dealloc_node(node_to_rm)
1668 cpabort(
"tried to remove first el of an empty list")
1681 TYPE(cp_sll_char_type),
POINTER :: sll
1683 TYPE(cp_sll_char_type),
POINTER :: node_to_rm
1686 IF (
ASSOCIATED(sll))
THEN
1688 CALL cp_sll_char_dealloc_node(node_to_rm)
1690 cpabort(
"tried to remove first el of an empty list")
1703 TYPE(cp_sll_val_type),
POINTER :: sll
1705 TYPE(cp_sll_val_type),
POINTER :: node_to_rm
1708 IF (
ASSOCIATED(sll))
THEN
1710 CALL cp_sll_val_dealloc_node(node_to_rm)
1712 cpabort(
"tried to remove first el of an empty list")
1729 integer,
intent(in) :: el
1730 INTEGER,
INTENT(in) :: index
1731 TYPE(cp_sll_int_type),
POINTER :: sll
1733 TYPE(cp_sll_int_type),
POINTER :: pos
1735 IF (index == 1)
THEN
1738 IF (index == -1)
THEN
1743 cpassert(
ASSOCIATED(pos))
1760 REAL(kind=
dp),
intent(in) :: el
1761 INTEGER,
INTENT(in) :: index
1762 TYPE(cp_sll_real_type),
POINTER :: sll
1764 TYPE(cp_sll_real_type),
POINTER :: pos
1766 IF (index == 1)
THEN
1769 IF (index == -1)
THEN
1774 cpassert(
ASSOCIATED(pos))
1791 logical,
intent(in) :: el
1792 INTEGER,
INTENT(in) :: index
1793 TYPE(cp_sll_logical_type),
POINTER :: sll
1795 TYPE(cp_sll_logical_type),
POINTER :: pos
1797 IF (index == 1)
THEN
1800 IF (index == -1)
THEN
1805 cpassert(
ASSOCIATED(pos))
1822 character(len=default_string_length),
intent(in) :: el
1823 INTEGER,
INTENT(in) :: index
1824 TYPE(cp_sll_char_type),
POINTER :: sll
1826 TYPE(cp_sll_char_type),
POINTER :: pos
1828 IF (index == 1)
THEN
1831 IF (index == -1)
THEN
1836 cpassert(
ASSOCIATED(pos))
1853 type(val_type),
pointer,
intent(in) :: el
1854 INTEGER,
INTENT(in) :: index
1855 TYPE(cp_sll_val_type),
POINTER :: sll
1857 TYPE(cp_sll_val_type),
POINTER :: pos
1859 IF (index == 1)
THEN
1862 IF (index == -1)
THEN
1867 cpassert(
ASSOCIATED(pos))
1883 TYPE(cp_sll_int_type),
POINTER :: sll
1884 INTEGER,
INTENT(in)::index
1886 TYPE(cp_sll_int_type),
POINTER :: pos
1888 IF (index == 1)
THEN
1891 IF (index == -1)
THEN
1896 cpassert(
ASSOCIATED(pos))
1911 TYPE(cp_sll_real_type),
POINTER :: sll
1912 INTEGER,
INTENT(in)::index
1914 TYPE(cp_sll_real_type),
POINTER :: pos
1916 IF (index == 1)
THEN
1919 IF (index == -1)
THEN
1924 cpassert(
ASSOCIATED(pos))
1939 TYPE(cp_sll_logical_type),
POINTER :: sll
1940 INTEGER,
INTENT(in)::index
1942 TYPE(cp_sll_logical_type),
POINTER :: pos
1944 IF (index == 1)
THEN
1947 IF (index == -1)
THEN
1952 cpassert(
ASSOCIATED(pos))
1967 TYPE(cp_sll_char_type),
POINTER :: sll
1968 INTEGER,
INTENT(in)::index
1970 TYPE(cp_sll_char_type),
POINTER :: pos
1972 IF (index == 1)
THEN
1975 IF (index == -1)
THEN
1980 cpassert(
ASSOCIATED(pos))
1995 TYPE(cp_sll_val_type),
POINTER :: sll
1996 INTEGER,
INTENT(in)::index
1998 TYPE(cp_sll_val_type),
POINTER :: pos
2000 IF (index == 1)
THEN
2003 IF (index == -1)
THEN
2008 cpassert(
ASSOCIATED(pos))
2023 TYPE(cp_sll_int_type),
POINTER :: sll
2025 TYPE(cp_sll_int_type),
POINTER :: next_node, actual_node
2029 IF (.NOT.
ASSOCIATED(actual_node))
EXIT
2030 next_node => actual_node%rest
2031 CALL cp_sll_int_dealloc_node(actual_node)
2032 actual_node => next_node
2046 TYPE(cp_sll_real_type),
POINTER :: sll
2048 TYPE(cp_sll_real_type),
POINTER :: next_node, actual_node
2052 IF (.NOT.
ASSOCIATED(actual_node))
EXIT
2053 next_node => actual_node%rest
2054 CALL cp_sll_real_dealloc_node(actual_node)
2055 actual_node => next_node
2069 TYPE(cp_sll_logical_type),
POINTER :: sll
2071 TYPE(cp_sll_logical_type),
POINTER :: next_node, actual_node
2075 IF (.NOT.
ASSOCIATED(actual_node))
EXIT
2076 next_node => actual_node%rest
2077 CALL cp_sll_logical_dealloc_node(actual_node)
2078 actual_node => next_node
2092 TYPE(cp_sll_char_type),
POINTER :: sll
2094 TYPE(cp_sll_char_type),
POINTER :: next_node, actual_node
2098 IF (.NOT.
ASSOCIATED(actual_node))
EXIT
2099 next_node => actual_node%rest
2100 CALL cp_sll_char_dealloc_node(actual_node)
2101 actual_node => next_node
2115 TYPE(cp_sll_val_type),
POINTER :: sll
2117 TYPE(cp_sll_val_type),
POINTER :: next_node, actual_node
2121 IF (.NOT.
ASSOCIATED(actual_node))
EXIT
2122 next_node => actual_node%rest
2123 CALL cp_sll_val_dealloc_node(actual_node)
2124 actual_node => next_node
2139 TYPE(cp_sll_int_type),
POINTER :: sll
2140 integer,
DIMENSION(:),
POINTER :: res
2144 TYPE(cp_sll_int_type),
POINTER :: iter
2150 res(i) =iter%first_el
2152 cpassert(ok .OR. i == len)
2165 TYPE(cp_sll_real_type),
POINTER :: sll
2166 REAL(kind=
dp),
DIMENSION(:),
POINTER :: res
2170 TYPE(cp_sll_real_type),
POINTER :: iter
2176 res(i) =iter%first_el
2178 cpassert(ok .OR. i == len)
2191 TYPE(cp_sll_logical_type),
POINTER :: sll
2192 logical,
DIMENSION(:),
POINTER :: res
2196 TYPE(cp_sll_logical_type),
POINTER :: iter
2202 res(i) =iter%first_el
2204 cpassert(ok .OR. i == len)
2217 TYPE(cp_sll_char_type),
POINTER :: sll
2218 character(len=default_string_length),
DIMENSION(:),
POINTER :: res
2222 TYPE(cp_sll_char_type),
POINTER :: iter
2228 res(i) =iter%first_el
2230 cpassert(ok .OR. i == len)
2243 TYPE(cp_sll_val_type),
POINTER :: sll
2244 type(val_p_type),
DIMENSION(:),
POINTER :: res
2248 TYPE(cp_sll_val_type),
POINTER :: iter
2254 res(i) %val=>iter%first_el
2256 cpassert(ok .OR. i == len)
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length