24#include "../base/base_uses.f90"
28 LOGICAL,
PRIVATE,
PARAMETER :: debug_this_module = .true.
29 CHARACTER(len=*),
PRIVATE,
PARAMETER :: moduleN =
'cp_array_utils'
100 REAL(kind=
dp),
dimension(:),
pointer :: array => null()
110 REAL(kind=
dp),
dimension(:, :),
pointer :: array => null()
120 REAL(kind=
dp),
dimension(:, :, :),
pointer :: array => null()
130 REAL(kind=
dp),
dimension(:),
contiguous,
pointer :: array => null()
140 REAL(kind=
dp),
dimension(:, :),
contiguous,
pointer :: array => null()
150 REAL(kind=
dp),
dimension(:, :, :),
contiguous,
pointer :: array => null()
161 COMPLEX(KIND=dp),
dimension(:),
pointer :: array => null()
171 COMPLEX(KIND=dp),
dimension(:, :),
pointer :: array => null()
181 COMPLEX(KIND=dp),
dimension(:, :, :),
pointer :: array => null()
191 COMPLEX(KIND=dp),
dimension(:),
contiguous,
pointer :: array => null()
201 COMPLEX(KIND=dp),
dimension(:, :),
contiguous,
pointer :: array => null()
211 COMPLEX(KIND=dp),
dimension(:, :, :),
contiguous,
pointer :: array => null()
222 INTEGER(kind=int_4),
dimension(:),
pointer :: array => null()
232 INTEGER(kind=int_4),
dimension(:, :),
pointer :: array => null()
242 INTEGER(kind=int_4),
dimension(:, :, :),
pointer :: array => null()
252 INTEGER(kind=int_4),
dimension(:),
contiguous,
pointer :: array => null()
262 INTEGER(kind=int_4),
dimension(:, :),
contiguous,
pointer :: array => null()
272 INTEGER(kind=int_4),
dimension(:, :, :),
contiguous,
pointer :: array => null()
283 logical,
dimension(:),
pointer :: array => null()
293 logical,
dimension(:, :),
pointer :: array => null()
303 logical,
dimension(:, :, :),
pointer :: array => null()
313 logical,
dimension(:),
contiguous,
pointer :: array => null()
323 logical,
dimension(:, :),
contiguous,
pointer :: array => null()
333 logical,
dimension(:, :, :),
contiguous,
pointer :: array => null()
351 REAL(kind=
dp),
INTENT(in) :: array(:)
352 INTEGER,
INTENT(in) :: unit_nr
353 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: el_format
356 CHARACTER(len=*),
PARAMETER :: defaultformat =
"(es14.6)"
358 WRITE (unit=unit_nr, fmt=
"('( ')", advance=
"no", iostat=iostat)
359 cpassert(iostat == 0)
360 IF (
PRESENT(el_format))
THEN
361 DO i = 1,
SIZE(array) - 1
362 WRITE (unit=unit_nr, fmt=el_format, advance=
"no") array(i)
363 IF (mod(i, 5) .EQ. 0)
THEN
364 WRITE (unit=unit_nr, fmt=
"(',')")
366 WRITE (unit=unit_nr, fmt=
"(',')", advance=
"no")
369 IF (
SIZE(array) > 0) &
370 WRITE (unit=unit_nr, fmt=el_format, advance=
"no") array(
SIZE(array))
372 DO i = 1,
SIZE(array) - 1
373 WRITE (unit=unit_nr, fmt=defaultformat, advance=
"no") array(i)
374 IF (mod(i, 5) .EQ. 0)
THEN
375 WRITE (unit=unit_nr, fmt=
"(',')")
377 WRITE (unit=unit_nr, fmt=
"(',')", advance=
"no")
380 IF (
SIZE(array) > 0) &
381 WRITE (unit=unit_nr, fmt=defaultformat, advance=
"no") array(
SIZE(array))
383 WRITE (unit=unit_nr, fmt=
"(' )')")
400 REAL(kind=
dp),
INTENT(in) :: array(:, :)
401 INTEGER,
INTENT(in) :: unit_nr
402 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: el_format
405 CHARACTER(len=*),
PARAMETER :: defaultformat =
"(es14.6)"
406 CHARACTER(len=200) :: fmtstr
407 CHARACTER(len=10) :: nriga
410 DO i = 1,
SIZE(array, 1)
411 IF (
PRESENT(el_format))
THEN
412 fmtstr =
'(" ",'//nriga//el_format//
')'
413 WRITE (unit=unit_nr, fmt=fmtstr, iostat=iostat) array(i, :)
415 fmtstr =
'(" ",'//nriga//defaultformat//
')'
416 WRITE (unit=unit_nr, fmt=fmtstr, iostat=iostat) array(i, :)
418 cpassert(iostat == 0)
441 REAL(kind=
dp),
POINTER :: array(:)
442 INTEGER,
INTENT(in) :: n
445 IF (
ASSOCIATED(array))
THEN
446 IF (
SIZE(array) /= n)
THEN
447 cpwarn(
'size has changed')
451 IF (.NOT.
ASSOCIATED(array))
THEN
474 REAL(kind=
dp),
POINTER :: array(:, :)
475 INTEGER,
INTENT(in) :: n_rows, n_cols
477 cpassert(n_cols >= 0)
478 cpassert(n_rows >= 0)
479 IF (
ASSOCIATED(array))
THEN
480 IF (
SIZE(array, 1) /= n_rows .OR.
SIZE(array, 2) /= n_cols)
THEN
481 cpwarn(
'size has changed')
485 IF (.NOT.
ASSOCIATED(array))
THEN
486 ALLOCATE (array(n_rows, n_cols))
508 REAL(kind=
dp),
intent(in) :: array(:)
509 REAL(kind=
dp),
intent(in) :: el
510 INTEGER,
INTENT(in),
OPTIONAL :: l_index, u_index
513 INTEGER :: lindex, uindex, aindex
517 if (
present(l_index)) lindex = l_index
518 if (
present(u_index)) uindex = u_index
519 DO WHILE (lindex <= uindex)
520 aindex = (lindex + uindex)/2
521 IF ( array(aindex) < el)
THEN
541 COMPLEX(KIND=dp),
INTENT(in) :: array(:)
542 INTEGER,
INTENT(in) :: unit_nr
543 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: el_format
546 CHARACTER(len=*),
PARAMETER :: defaultformat =
"(es14.6)"
548 WRITE (unit=unit_nr, fmt=
"('( ')", advance=
"no", iostat=iostat)
549 cpassert(iostat == 0)
550 IF (
PRESENT(el_format))
THEN
551 DO i = 1,
SIZE(array) - 1
552 WRITE (unit=unit_nr, fmt=el_format, advance=
"no") array(i)
553 IF (mod(i, 5) .EQ. 0)
THEN
554 WRITE (unit=unit_nr, fmt=
"(',')")
556 WRITE (unit=unit_nr, fmt=
"(',')", advance=
"no")
559 IF (
SIZE(array) > 0) &
560 WRITE (unit=unit_nr, fmt=el_format, advance=
"no") array(
SIZE(array))
562 DO i = 1,
SIZE(array) - 1
563 WRITE (unit=unit_nr, fmt=defaultformat, advance=
"no") array(i)
564 IF (mod(i, 5) .EQ. 0)
THEN
565 WRITE (unit=unit_nr, fmt=
"(',')")
567 WRITE (unit=unit_nr, fmt=
"(',')", advance=
"no")
570 IF (
SIZE(array) > 0) &
571 WRITE (unit=unit_nr, fmt=defaultformat, advance=
"no") array(
SIZE(array))
573 WRITE (unit=unit_nr, fmt=
"(' )')")
590 COMPLEX(KIND=dp),
INTENT(in) :: array(:, :)
591 INTEGER,
INTENT(in) :: unit_nr
592 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: el_format
595 CHARACTER(len=*),
PARAMETER :: defaultformat =
"(es14.6)"
596 CHARACTER(len=200) :: fmtstr
597 CHARACTER(len=10) :: nriga
600 DO i = 1,
SIZE(array, 1)
601 IF (
PRESENT(el_format))
THEN
602 fmtstr =
'(" ",'//nriga//el_format//
')'
603 WRITE (unit=unit_nr, fmt=fmtstr, iostat=iostat) array(i, :)
605 fmtstr =
'(" ",'//nriga//defaultformat//
')'
606 WRITE (unit=unit_nr, fmt=fmtstr, iostat=iostat) array(i, :)
608 cpassert(iostat == 0)
631 COMPLEX(KIND=dp),
POINTER :: array(:)
632 INTEGER,
INTENT(in) :: n
635 IF (
ASSOCIATED(array))
THEN
636 IF (
SIZE(array) /= n)
THEN
637 cpwarn(
'size has changed')
641 IF (.NOT.
ASSOCIATED(array))
THEN
664 COMPLEX(KIND=dp),
POINTER :: array(:, :)
665 INTEGER,
INTENT(in) :: n_rows, n_cols
667 cpassert(n_cols >= 0)
668 cpassert(n_rows >= 0)
669 IF (
ASSOCIATED(array))
THEN
670 IF (
SIZE(array, 1) /= n_rows .OR.
SIZE(array, 2) /= n_cols)
THEN
671 cpwarn(
'size has changed')
675 IF (.NOT.
ASSOCIATED(array))
THEN
676 ALLOCATE (array(n_rows, n_cols))
698 COMPLEX(KIND=dp),
intent(in) :: array(:)
699 COMPLEX(KIND=dp),
intent(in) :: el
700 INTEGER,
INTENT(in),
OPTIONAL :: l_index, u_index
703 INTEGER :: lindex, uindex, aindex
707 if (
present(l_index)) lindex = l_index
708 if (
present(u_index)) uindex = u_index
709 DO WHILE (lindex <= uindex)
710 aindex = (lindex + uindex)/2
711 IF (real(array(aindex)) < real(el) .OR. (abs(real(array(aindex))-real(el)) < epsilon(max(abs(real(array(aindex))),&
712 & abs(real(el)))) .and. aimag(array(aindex)) < aimag(el)))
THEN
732 INTEGER(kind=int_4),
INTENT(in) :: array(:)
733 INTEGER,
INTENT(in) :: unit_nr
734 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: el_format
737 CHARACTER(len=*),
PARAMETER :: defaultformat =
"(i6)"
739 WRITE (unit=unit_nr, fmt=
"('( ')", advance=
"no", iostat=iostat)
740 cpassert(iostat == 0)
741 IF (
PRESENT(el_format))
THEN
742 DO i = 1,
SIZE(array) - 1
743 WRITE (unit=unit_nr, fmt=el_format, advance=
"no") array(i)
744 IF (mod(i, 5) .EQ. 0)
THEN
745 WRITE (unit=unit_nr, fmt=
"(',')")
747 WRITE (unit=unit_nr, fmt=
"(',')", advance=
"no")
750 IF (
SIZE(array) > 0) &
751 WRITE (unit=unit_nr, fmt=el_format, advance=
"no") array(
SIZE(array))
753 DO i = 1,
SIZE(array) - 1
754 WRITE (unit=unit_nr, fmt=defaultformat, advance=
"no") array(i)
755 IF (mod(i, 5) .EQ. 0)
THEN
756 WRITE (unit=unit_nr, fmt=
"(',')")
758 WRITE (unit=unit_nr, fmt=
"(',')", advance=
"no")
761 IF (
SIZE(array) > 0) &
762 WRITE (unit=unit_nr, fmt=defaultformat, advance=
"no") array(
SIZE(array))
764 WRITE (unit=unit_nr, fmt=
"(' )')")
781 INTEGER(kind=int_4),
INTENT(in) :: array(:, :)
782 INTEGER,
INTENT(in) :: unit_nr
783 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: el_format
786 CHARACTER(len=*),
PARAMETER :: defaultformat =
"(i6)"
787 CHARACTER(len=200) :: fmtstr
788 CHARACTER(len=10) :: nriga
791 DO i = 1,
SIZE(array, 1)
792 IF (
PRESENT(el_format))
THEN
793 fmtstr =
'(" ",'//nriga//el_format//
')'
794 WRITE (unit=unit_nr, fmt=fmtstr, iostat=iostat) array(i, :)
796 fmtstr =
'(" ",'//nriga//defaultformat//
')'
797 WRITE (unit=unit_nr, fmt=fmtstr, iostat=iostat) array(i, :)
799 cpassert(iostat == 0)
822 INTEGER(kind=int_4),
POINTER :: array(:)
823 INTEGER,
INTENT(in) :: n
826 IF (
ASSOCIATED(array))
THEN
827 IF (
SIZE(array) /= n)
THEN
828 cpwarn(
'size has changed')
832 IF (.NOT.
ASSOCIATED(array))
THEN
855 INTEGER(kind=int_4),
POINTER :: array(:, :)
856 INTEGER,
INTENT(in) :: n_rows, n_cols
858 cpassert(n_cols >= 0)
859 cpassert(n_rows >= 0)
860 IF (
ASSOCIATED(array))
THEN
861 IF (
SIZE(array, 1) /= n_rows .OR.
SIZE(array, 2) /= n_cols)
THEN
862 cpwarn(
'size has changed')
866 IF (.NOT.
ASSOCIATED(array))
THEN
867 ALLOCATE (array(n_rows, n_cols))
889 INTEGER(kind=int_4),
intent(in) :: array(:)
890 INTEGER(kind=int_4),
intent(in) :: el
891 INTEGER,
INTENT(in),
OPTIONAL :: l_index, u_index
894 INTEGER :: lindex, uindex, aindex
898 if (
present(l_index)) lindex = l_index
899 if (
present(u_index)) uindex = u_index
900 DO WHILE (lindex <= uindex)
901 aindex = (lindex + uindex)/2
902 IF ( array(aindex) < el)
THEN
922 logical,
INTENT(in) :: array(:)
923 INTEGER,
INTENT(in) :: unit_nr
924 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: el_format
927 CHARACTER(len=*),
PARAMETER :: defaultformat =
"(l1)"
929 WRITE (unit=unit_nr, fmt=
"('( ')", advance=
"no", iostat=iostat)
930 cpassert(iostat == 0)
931 IF (
PRESENT(el_format))
THEN
932 DO i = 1,
SIZE(array) - 1
933 WRITE (unit=unit_nr, fmt=el_format, advance=
"no") array(i)
934 IF (mod(i, 5) .EQ. 0)
THEN
935 WRITE (unit=unit_nr, fmt=
"(',')")
937 WRITE (unit=unit_nr, fmt=
"(',')", advance=
"no")
940 IF (
SIZE(array) > 0) &
941 WRITE (unit=unit_nr, fmt=el_format, advance=
"no") array(
SIZE(array))
943 DO i = 1,
SIZE(array) - 1
944 WRITE (unit=unit_nr, fmt=defaultformat, advance=
"no") array(i)
945 IF (mod(i, 5) .EQ. 0)
THEN
946 WRITE (unit=unit_nr, fmt=
"(',')")
948 WRITE (unit=unit_nr, fmt=
"(',')", advance=
"no")
951 IF (
SIZE(array) > 0) &
952 WRITE (unit=unit_nr, fmt=defaultformat, advance=
"no") array(
SIZE(array))
954 WRITE (unit=unit_nr, fmt=
"(' )')")
971 logical,
INTENT(in) :: array(:, :)
972 INTEGER,
INTENT(in) :: unit_nr
973 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: el_format
976 CHARACTER(len=*),
PARAMETER :: defaultformat =
"(l1)"
977 CHARACTER(len=200) :: fmtstr
978 CHARACTER(len=10) :: nriga
981 DO i = 1,
SIZE(array, 1)
982 IF (
PRESENT(el_format))
THEN
983 fmtstr =
'(" ",'//nriga//el_format//
')'
984 WRITE (unit=unit_nr, fmt=fmtstr, iostat=iostat) array(i, :)
986 fmtstr =
'(" ",'//nriga//defaultformat//
')'
987 WRITE (unit=unit_nr, fmt=fmtstr, iostat=iostat) array(i, :)
989 cpassert(iostat == 0)
1012 logical,
POINTER :: array(:)
1013 INTEGER,
INTENT(in) :: n
1016 IF (
ASSOCIATED(array))
THEN
1017 IF (
SIZE(array) /= n)
THEN
1018 cpwarn(
'size has changed')
1022 IF (.NOT.
ASSOCIATED(array))
THEN
1045 logical,
POINTER :: array(:, :)
1046 INTEGER,
INTENT(in) :: n_rows, n_cols
1048 cpassert(n_cols >= 0)
1049 cpassert(n_rows >= 0)
1050 IF (
ASSOCIATED(array))
THEN
1051 IF (
SIZE(array, 1) /= n_rows .OR.
SIZE(array, 2) /= n_cols)
THEN
1052 cpwarn(
'size has changed')
1056 IF (.NOT.
ASSOCIATED(array))
THEN
1057 ALLOCATE (array(n_rows, n_cols))
1079 logical,
intent(in) :: array(:)
1080 logical,
intent(in) :: el
1081 INTEGER,
INTENT(in),
OPTIONAL :: l_index, u_index
1084 INTEGER :: lindex, uindex, aindex
1087 uindex =
size(array)
1088 if (
present(l_index)) lindex = l_index
1089 if (
present(u_index)) uindex = u_index
1090 DO WHILE (lindex <= uindex)
1091 aindex = (lindex + uindex)/2
1092 IF ( (.not. array(aindex)) .and. el)
THEN
various utilities that regard array of different kinds: output, allocation,... maybe it is not a good...
subroutine, public cp_2d_c_guarantee_size(array, n_rows, n_cols)
If the size of the array is changes reallocate it. Issues a warning when the size changes (but not on...
subroutine, public cp_1d_i_guarantee_size(array, n)
If the size of the array is changes reallocate it. Issues a warning when the size changes (but not on...
subroutine, public cp_2d_r_guarantee_size(array, n_rows, n_cols)
If the size of the array is changes reallocate it. Issues a warning when the size changes (but not on...
integer function, public cp_1d_logical_bsearch(array, el, l_index, u_index)
returns the index at which the element el should be inserted in the array to keep it ordered (array(i...
integer function, public cp_1d_c_bsearch(array, el, l_index, u_index)
returns the index at which the element el should be inserted in the array to keep it ordered (array(i...
subroutine, public cp_1d_i_write(array, unit_nr, el_format)
writes an array to the given unit
subroutine, public cp_1d_logical_write(array, unit_nr, el_format)
writes an array to the given unit
integer function, public cp_1d_i_bsearch(array, el, l_index, u_index)
returns the index at which the element el should be inserted in the array to keep it ordered (array(i...
subroutine, public cp_2d_i_guarantee_size(array, n_rows, n_cols)
If the size of the array is changes reallocate it. Issues a warning when the size changes (but not on...
subroutine, public cp_2d_c_write(array, unit_nr, el_format)
writes an array to the given unit
subroutine, public cp_1d_r_write(array, unit_nr, el_format)
writes an array to the given unit
subroutine, public cp_1d_logical_guarantee_size(array, n)
If the size of the array is changes reallocate it. Issues a warning when the size changes (but not on...
integer function, public cp_1d_r_bsearch(array, el, l_index, u_index)
returns the index at which the element el should be inserted in the array to keep it ordered (array(i...
subroutine, public cp_1d_c_guarantee_size(array, n)
If the size of the array is changes reallocate it. Issues a warning when the size changes (but not on...
subroutine, public cp_2d_logical_write(array, unit_nr, el_format)
writes an array to the given unit
subroutine, public cp_2d_logical_guarantee_size(array, n_rows, n_cols)
If the size of the array is changes reallocate it. Issues a warning when the size changes (but not on...
subroutine, public cp_1d_c_write(array, unit_nr, el_format)
writes an array to the given unit
subroutine, public cp_2d_r_write(array, unit_nr, el_format)
writes an array to the given unit
subroutine, public cp_1d_r_guarantee_size(array, n)
If the size of the array is changes reallocate it. Issues a warning when the size changes (but not on...
subroutine, public cp_2d_i_write(array, unit_nr, el_format)
writes an array to the given unit
various routines to log and control the output. The idea is that decisions about where to log should ...
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public int_4
Machine interface based on Fortran 2003 and POSIX.
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
represent a pointer to a contiguous 1d array
represent a pointer to a 1d array
represent a pointer to a contiguous 1d array
represent a pointer to a 1d array
represent a pointer to a contiguous 1d array
represent a pointer to a 1d array
represent a pointer to a contiguous 1d array
represent a pointer to a 1d array
represent a pointer to a contiguous 2d array
represent a pointer to a 2d array
represent a pointer to a contiguous 2d array
represent a pointer to a 2d array
represent a pointer to a contiguous 2d array
represent a pointer to a 2d array
represent a pointer to a contiguous 2d array
represent a pointer to a 2d array
represent a pointer to a contiguous 3d array
represent a pointer to a 3d array
represent a pointer to a contiguous 3d array
represent a pointer to a 3d array
represent a pointer to a contiguous 3d array
represent a pointer to a 3d array
represent a pointer to a contiguous 3d array
represent a pointer to a 3d array