12#include "../base/base_uses.f90"
31 LOGICAL,
PRIVATE,
PARAMETER :: debug_this_module = .true.
170 INTERFACE cp_insert_at
238 integer :: first_el = 0
264 REAL(kind=
dp) :: first_el = 0.0_dp
290 logical :: first_el = .false.
316 character(len=default_string_length) :: first_el =
""
414 integer,
intent(in),
OPTIONAL :: first_el
417 IF (.NOT.
PRESENT(first_el))
THEN
419 IF (
PRESENT(rest)) sll => rest
422 sll%first_el =first_el
424 IF (
PRESENT(rest)) sll%rest => rest
438 REAL(kind=
dp),
intent(in),
OPTIONAL :: first_el
441 IF (.NOT.
PRESENT(first_el))
THEN
443 IF (
PRESENT(rest)) sll => rest
446 sll%first_el =first_el
448 IF (
PRESENT(rest)) sll%rest => rest
462 logical,
intent(in),
OPTIONAL :: first_el
465 IF (.NOT.
PRESENT(first_el))
THEN
467 IF (
PRESENT(rest)) sll => rest
470 sll%first_el =first_el
472 IF (
PRESENT(rest)) sll%rest => rest
486 character(len=default_string_length),
intent(in),
OPTIONAL :: first_el
489 IF (.NOT.
PRESENT(first_el))
THEN
491 IF (
PRESENT(rest)) sll => rest
494 sll%first_el =first_el
496 IF (
PRESENT(rest)) sll%rest => rest
510 type(
val_type),
pointer,
intent(in),
OPTIONAL :: first_el
513 IF (.NOT.
PRESENT(first_el))
THEN
515 IF (
PRESENT(rest)) sll => rest
518 sll%first_el =>first_el
520 IF (
PRESENT(rest)) sll%rest => rest
614 SUBROUTINE cp_sll_int_dealloc_node(sll)
618 END SUBROUTINE cp_sll_int_dealloc_node
626 SUBROUTINE cp_sll_real_dealloc_node(sll)
630 END SUBROUTINE cp_sll_real_dealloc_node
638 SUBROUTINE cp_sll_logical_dealloc_node(sll)
642 END SUBROUTINE cp_sll_logical_dealloc_node
650 SUBROUTINE cp_sll_char_dealloc_node(sll)
654 END SUBROUTINE cp_sll_char_dealloc_node
662 SUBROUTINE cp_sll_val_dealloc_node(sll)
666 END SUBROUTINE cp_sll_val_dealloc_node
722 character(len=default_string_length) :: res
755 INTEGER,
OPTIONAL :: iter
761 IF (.NOT.
ASSOCIATED(sll))
THEN
764 IF (
PRESENT(iter))
THEN
767 IF (
ASSOCIATED(res%rest))
THEN
770 cpabort(
"tried to go past end")
775 IF (.NOT.
ASSOCIATED(res%rest))
EXIT
798 INTEGER,
OPTIONAL :: iter
804 IF (.NOT.
ASSOCIATED(sll))
THEN
807 IF (
PRESENT(iter))
THEN
810 IF (
ASSOCIATED(res%rest))
THEN
813 cpabort(
"tried to go past end")
818 IF (.NOT.
ASSOCIATED(res%rest))
EXIT
841 INTEGER,
OPTIONAL :: iter
847 IF (.NOT.
ASSOCIATED(sll))
THEN
850 IF (
PRESENT(iter))
THEN
853 IF (
ASSOCIATED(res%rest))
THEN
856 cpabort(
"tried to go past end")
861 IF (.NOT.
ASSOCIATED(res%rest))
EXIT
884 INTEGER,
OPTIONAL :: iter
890 IF (.NOT.
ASSOCIATED(sll))
THEN
893 IF (
PRESENT(iter))
THEN
896 IF (
ASSOCIATED(res%rest))
THEN
899 cpabort(
"tried to go past end")
904 IF (.NOT.
ASSOCIATED(res%rest))
EXIT
927 INTEGER,
OPTIONAL :: iter
933 IF (.NOT.
ASSOCIATED(sll))
THEN
936 IF (
PRESENT(iter))
THEN
939 IF (
ASSOCIATED(res%rest))
THEN
942 cpabort(
"tried to go past end")
947 IF (.NOT.
ASSOCIATED(res%rest))
EXIT
976 IF (
ASSOCIATED(iterator))
THEN
978 iterator => iterator%rest
1003 IF (
ASSOCIATED(iterator))
THEN
1005 iterator => iterator%rest
1030 IF (
ASSOCIATED(iterator))
THEN
1032 iterator => iterator%rest
1057 IF (
ASSOCIATED(iterator))
THEN
1059 iterator => iterator%rest
1084 IF (
ASSOCIATED(iterator))
THEN
1086 iterator => iterator%rest
1107 INTEGER,
INTENT(in) :: index
1111 IF (index == -1)
THEN
1116 cpassert(
ASSOCIATED(pos))
1132 REAL(kind=
dp) :: res
1134 INTEGER,
INTENT(in) :: index
1138 IF (index == -1)
THEN
1143 cpassert(
ASSOCIATED(pos))
1161 INTEGER,
INTENT(in) :: index
1165 IF (index == -1)
THEN
1170 cpassert(
ASSOCIATED(pos))
1186 character(len=default_string_length) :: res
1188 INTEGER,
INTENT(in) :: index
1192 IF (index == -1)
THEN
1197 cpassert(
ASSOCIATED(pos))
1215 INTEGER,
INTENT(in) :: index
1219 IF (index == -1)
THEN
1224 cpassert(
ASSOCIATED(pos))
1242 integer,
intent(in) :: value
1244 INTEGER,
INTENT(in) :: index
1248 IF (index == -1)
THEN
1253 cpassert(
ASSOCIATED(pos))
1270 REAL(kind=
dp),
intent(in) ::
value
1272 INTEGER,
INTENT(in) :: index
1276 IF (index == -1)
THEN
1281 cpassert(
ASSOCIATED(pos))
1298 logical,
intent(in) :: value
1300 INTEGER,
INTENT(in) :: index
1304 IF (index == -1)
THEN
1309 cpassert(
ASSOCIATED(pos))
1326 character(len=default_string_length),
intent(in) :: value
1328 INTEGER,
INTENT(in) :: index
1332 IF (index == -1)
THEN
1337 cpassert(
ASSOCIATED(pos))
1354 type(
val_type),
pointer,
intent(in) :: value
1356 INTEGER,
INTENT(in) :: index
1360 IF (index == -1)
THEN
1365 cpassert(
ASSOCIATED(pos))
1367 pos%first_el =>
value
1384 integer,
intent(out),
OPTIONAL :: el_att
1387 IF (
ASSOCIATED(iterator))
THEN
1389 if (
present(el_att)) el_att =iterator%first_el
1390 iterator => iterator%rest
1407 REAL(kind=
dp),
intent(out),
OPTIONAL :: el_att
1410 IF (
ASSOCIATED(iterator))
THEN
1412 if (
present(el_att)) el_att =iterator%first_el
1413 iterator => iterator%rest
1430 logical,
intent(out),
OPTIONAL :: el_att
1433 IF (
ASSOCIATED(iterator))
THEN
1435 if (
present(el_att)) el_att =iterator%first_el
1436 iterator => iterator%rest
1453 character(len=default_string_length),
intent(out),
OPTIONAL :: el_att
1456 IF (
ASSOCIATED(iterator))
THEN
1458 if (
present(el_att)) el_att =iterator%first_el
1459 iterator => iterator%rest
1476 type(
val_type),
pointer,
intent(out),
OPTIONAL :: el_att
1479 IF (
ASSOCIATED(iterator))
THEN
1481 if (
present(el_att)) el_att =>iterator%first_el
1482 iterator => iterator%rest
1503 integer,
intent(in):: el
1526 REAL(kind=
dp),
intent(in):: el
1549 logical,
intent(in):: el
1572 character(len=default_string_length),
intent(in):: el
1595 type(
val_type),
pointer,
intent(in):: el
1621 IF (
ASSOCIATED(sll))
THEN
1623 CALL cp_sll_int_dealloc_node(node_to_rm)
1625 cpabort(
"tried to remove first el of an empty list")
1643 IF (
ASSOCIATED(sll))
THEN
1645 CALL cp_sll_real_dealloc_node(node_to_rm)
1647 cpabort(
"tried to remove first el of an empty list")
1665 IF (
ASSOCIATED(sll))
THEN
1667 CALL cp_sll_logical_dealloc_node(node_to_rm)
1669 cpabort(
"tried to remove first el of an empty list")
1687 IF (
ASSOCIATED(sll))
THEN
1689 CALL cp_sll_char_dealloc_node(node_to_rm)
1691 cpabort(
"tried to remove first el of an empty list")
1709 IF (
ASSOCIATED(sll))
THEN
1711 CALL cp_sll_val_dealloc_node(node_to_rm)
1713 cpabort(
"tried to remove first el of an empty list")
1730 integer,
intent(in) :: el
1731 INTEGER,
INTENT(in) :: index
1736 IF (index == 1)
THEN
1739 IF (index == -1)
THEN
1744 cpassert(
ASSOCIATED(pos))
1761 REAL(kind=
dp),
intent(in) :: el
1762 INTEGER,
INTENT(in) :: index
1767 IF (index == 1)
THEN
1770 IF (index == -1)
THEN
1775 cpassert(
ASSOCIATED(pos))
1792 logical,
intent(in) :: el
1793 INTEGER,
INTENT(in) :: index
1798 IF (index == 1)
THEN
1801 IF (index == -1)
THEN
1806 cpassert(
ASSOCIATED(pos))
1823 character(len=default_string_length),
intent(in) :: el
1824 INTEGER,
INTENT(in) :: index
1829 IF (index == 1)
THEN
1832 IF (index == -1)
THEN
1837 cpassert(
ASSOCIATED(pos))
1854 type(
val_type),
pointer,
intent(in) :: el
1855 INTEGER,
INTENT(in) :: index
1860 IF (index == 1)
THEN
1863 IF (index == -1)
THEN
1868 cpassert(
ASSOCIATED(pos))
1885 INTEGER,
INTENT(in)::index
1889 IF (index == 1)
THEN
1892 IF (index == -1)
THEN
1897 cpassert(
ASSOCIATED(pos))
1913 INTEGER,
INTENT(in)::index
1917 IF (index == 1)
THEN
1920 IF (index == -1)
THEN
1925 cpassert(
ASSOCIATED(pos))
1941 INTEGER,
INTENT(in)::index
1945 IF (index == 1)
THEN
1948 IF (index == -1)
THEN
1953 cpassert(
ASSOCIATED(pos))
1969 INTEGER,
INTENT(in)::index
1973 IF (index == 1)
THEN
1976 IF (index == -1)
THEN
1981 cpassert(
ASSOCIATED(pos))
1997 INTEGER,
INTENT(in)::index
2001 IF (index == 1)
THEN
2004 IF (index == -1)
THEN
2009 cpassert(
ASSOCIATED(pos))
2030 IF (.NOT.
ASSOCIATED(actual_node))
EXIT
2031 next_node => actual_node%rest
2032 CALL cp_sll_int_dealloc_node(actual_node)
2033 actual_node => next_node
2053 IF (.NOT.
ASSOCIATED(actual_node))
EXIT
2054 next_node => actual_node%rest
2055 CALL cp_sll_real_dealloc_node(actual_node)
2056 actual_node => next_node
2076 IF (.NOT.
ASSOCIATED(actual_node))
EXIT
2077 next_node => actual_node%rest
2078 CALL cp_sll_logical_dealloc_node(actual_node)
2079 actual_node => next_node
2099 IF (.NOT.
ASSOCIATED(actual_node))
EXIT
2100 next_node => actual_node%rest
2101 CALL cp_sll_char_dealloc_node(actual_node)
2102 actual_node => next_node
2122 IF (.NOT.
ASSOCIATED(actual_node))
EXIT
2123 next_node => actual_node%rest
2124 CALL cp_sll_val_dealloc_node(actual_node)
2125 actual_node => next_node
2141 integer,
DIMENSION(:),
POINTER :: res
2151 res(i) =iter%first_el
2153 cpassert(ok .OR. i == len)
2167 REAL(kind=
dp),
DIMENSION(:),
POINTER :: res
2177 res(i) =iter%first_el
2179 cpassert(ok .OR. i == len)
2193 logical,
DIMENSION(:),
POINTER :: res
2203 res(i) =iter%first_el
2205 cpassert(ok .OR. i == len)
2219 character(len=default_string_length),
DIMENSION(:),
POINTER :: res
2229 res(i) =iter%first_el
2231 cpassert(ok .OR. i == len)
2245 type(
val_p_type),
DIMENSION(:),
POINTER :: res
2255 res(i) %val=>iter%first_el
2257 cpassert(ok .OR. i == len)
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...