comp-chem/cp2k
1
0
Fork 0
mirror of https://github.com/cp2k/cp2k.git synced 2026-07-28 22:25:32 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions

Activate pretty for .f90 files

Browse source 
svn-origin-rev: 18333
This commit is contained in:
Alfio Lazzaro 2018-03-20 09:27:36 +00:00
parent dcd8c0de6d
commit 8eef230c00
25 changed files with 29371 additions and 29377 deletions
Download patch file Download diff file Expand all files Collapse all files

4
makefiles/Makefile
View file

@ -83,7 +83,7 @@ OBJ_SRC_FILES += $(LIBCUSMM_DIR)/libcusmm.cu
endif
# Included files used by Fypp preprocessor and standard includes
INCLUDED_SRC_FILES = $(notdir $(shell find $(SRCDIR) ! -path "*/preprettify/*" -name "*.f90"))
INCLUDED_SRC_FILES = $(filter-out base_uses.f90, $(notdir $(shell find $(SRCDIR) ! -path "*/preprettify/*" -name "*.f90")))
# Include also source files which won't compile into an object file
ALL_SRC_FILES = $(strip $(subst $(NULL) .,$(NULL) $(SRCDIR),$(NULL) $(OBJ_SRC_FILES)))
@ -303,8 +303,8 @@ $(PRETTYOBJDIR)/%.pretty: %.F $(DOXIFYOBJDIR)/%.doxified
@touch $@
$(PRETTYOBJDIR)/%.pretty_included: %.f90 $(DOXIFYOBJDIR)/%.doxified_included
# TODO: call indent here?
@mkdir -p $(PRETTYOBJDIR)
cd $(dir $<); $(TOOLSRC)/prettify/fprettify.py --do-backup --backup-dir=$(PRETTYOBJDIR) $(notdir $<)
@touch $@
$(PRETTYOBJDIR)/%.pretty: %.c $(DOXIFYOBJDIR)/%.doxified

66
src/call_collocate.f90
View file

@ -1,35 +1,35 @@
SELECT CASE(lp)
CASE(0)
CALL collocate_core_0(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(1)
CALL collocate_core_1(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(2)
CALL collocate_core_2(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(3)
CALL collocate_core_3(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(4)
CALL collocate_core_4(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(5)
CALL collocate_core_5(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(6)
CALL collocate_core_6(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(7)
CALL collocate_core_7(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(8)
CALL collocate_core_8(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(9)
CALL collocate_core_9(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
SELECT CASE (lp)
CASE (0)
CALL collocate_core_0(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (1)
CALL collocate_core_1(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (2)
CALL collocate_core_2(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (3)
CALL collocate_core_3(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (4)
CALL collocate_core_4(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (5)
CALL collocate_core_5(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (6)
CALL collocate_core_6(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (7)
CALL collocate_core_7(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (8)
CALL collocate_core_8(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (9)
CALL collocate_core_9(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE DEFAULT
CALL collocate_core_default(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax),pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),lp,cmax,gridbounds(1,1))
CALL collocate_core_default(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), lp, cmax, gridbounds(1, 1))
END SELECT

66
src/call_collocate_omp.f90
View file

@ -1,35 +1,35 @@
SELECT CASE(lp)
CASE(0)
CALL collocate_core_0(lgrid%r(1,ithread_l),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(1)
CALL collocate_core_1(lgrid%r(1,ithread_l),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(2)
CALL collocate_core_2(lgrid%r(1,ithread_l),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(3)
CALL collocate_core_3(lgrid%r(1,ithread_l),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(4)
CALL collocate_core_4(lgrid%r(1,ithread_l),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(5)
CALL collocate_core_5(lgrid%r(1,ithread_l),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(6)
CALL collocate_core_6(lgrid%r(1,ithread_l),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(7)
CALL collocate_core_7(lgrid%r(1,ithread_l),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(8)
CALL collocate_core_8(lgrid%r(1,ithread_l),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(9)
CALL collocate_core_9(lgrid%r(1,ithread_l),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
SELECT CASE (lp)
CASE (0)
CALL collocate_core_0(lgrid%r(1, ithread_l), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (1)
CALL collocate_core_1(lgrid%r(1, ithread_l), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (2)
CALL collocate_core_2(lgrid%r(1, ithread_l), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (3)
CALL collocate_core_3(lgrid%r(1, ithread_l), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (4)
CALL collocate_core_4(lgrid%r(1, ithread_l), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (5)
CALL collocate_core_5(lgrid%r(1, ithread_l), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (6)
CALL collocate_core_6(lgrid%r(1, ithread_l), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (7)
CALL collocate_core_7(lgrid%r(1, ithread_l), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (8)
CALL collocate_core_8(lgrid%r(1, ithread_l), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (9)
CALL collocate_core_9(lgrid%r(1, ithread_l), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE DEFAULT
CALL collocate_core_default(lgrid%r(1,ithread_l),coef_xyz(1),pol_x(0,-cmax),pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),lp,cmax,gridbounds(1,1))
CALL collocate_core_default(lgrid%r(1, ithread_l), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), lp, cmax, gridbounds(1, 1))
END SELECT

66
src/call_integrate.f90
View file

@ -1,35 +1,35 @@
SELECT CASE(lp)
CASE(0)
CALL integrate_core_0(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(1)
CALL integrate_core_1(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(2)
CALL integrate_core_2(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(3)
CALL integrate_core_3(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(4)
CALL integrate_core_4(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(5)
CALL integrate_core_5(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(6)
CALL integrate_core_6(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(7)
CALL integrate_core_7(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(8)
CALL integrate_core_8(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
CASE(9)
CALL integrate_core_9(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax), pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),cmax,gridbounds(1,1))
SELECT CASE (lp)
CASE (0)
CALL integrate_core_0(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (1)
CALL integrate_core_1(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (2)
CALL integrate_core_2(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (3)
CALL integrate_core_3(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (4)
CALL integrate_core_4(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (5)
CALL integrate_core_5(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (6)
CALL integrate_core_6(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (7)
CALL integrate_core_7(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (8)
CALL integrate_core_8(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE (9)
CALL integrate_core_9(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), cmax, gridbounds(1, 1))
CASE DEFAULT
CALL integrate_core_default(grid(1,1,1),coef_xyz(1),pol_x(0,-cmax),pol_y(1,0,-cmax),pol_z(1,0,-cmax), &
map(-cmax,1),sphere_bounds(1),lp,cmax,gridbounds(1,1))
CALL integrate_core_default(grid(1, 1, 1), coef_xyz(1), pol_x(0, -cmax), pol_y(1, 0, -cmax), pol_z(1, 0, -cmax), &
map(-cmax, 1), sphere_bounds(1), lp, cmax, gridbounds(1, 1))
END SELECT

46
src/common/sort_m.f90
View file

@ -1,18 +1,18 @@
isize = iend-istart+1
isize = iend-istart+1
! Initialize the INDEX array only for the first row..
IF (j==1) THEN
DO i = 1,isize
IF (j == 1) THEN
DO i = 1, isize
INDEX(i) = i
ENDDO
END IF
! Allocate scratch arrays
ALLOCATE(work(isize), work2(isize), tmp_index(isize), bck_index(isize))
ALLOCATE (work(isize), work2(isize), tmp_index(isize), bck_index(isize))
ind = 0
DO i = istart, iend
ind = ind + 1
work(ind) = matrix(j,i)
bck_index(ind) = INDEX(i)
ind = ind+1
work(ind) = matrix(j, i)
bck_index(ind) = INDEX(i)
END DO
! Ordering row (j) interval istart..iend
@ -21,44 +21,44 @@
! Copy into global INDEX array with a proper mapping
ind = 0
DO i = istart, iend
ind = ind + 1
INDEX(i)=bck_index(tmp_index(ind))
matrix(j,i)=work(ind)
ind = ind+1
INDEX(i) = bck_index(tmp_index(ind))
matrix(j, i) = work(ind)
END DO
! Reorder the rest of the array according the present reordering
DO k = j+1, jsize
ind = 0
DO i = istart, iend
ind = ind + 1
work2(ind) = matrix(k,i)
ind = ind+1
work2(ind) = matrix(k, i)
END DO
ind = 0
DO i = istart, iend
ind = ind + 1
matrix(k,i)=work2(tmp_index(ind))
ind = ind+1
matrix(k, i) = work2(tmp_index(ind))
END DO
END DO
! There are more rows to order..
IF (j<jsize) THEN
IF (j < jsize) THEN
kstart = istart
item = work(1)
ind = 0
item = work(1)
ind = 0
DO i = istart, iend
ind = ind + 1
IF (item/=work(ind)) THEN
ind = ind+1
IF (item /= work(ind)) THEN
kend = i-1
IF (kstart/=kend) THEN
IF (kstart /= kend) THEN
CALL sort(matrix, kstart, kend, j+1, jsize, INDEX)
END IF
item = work(ind)
item = work(ind)
kstart = i
END IF
END DO
kend = i-1
IF (kstart/=kend) THEN
IF (kstart /= kend) THEN
CALL sort(matrix, kstart, kend, j+1, jsize, INDEX)
END IF
END IF
DEALLOCATE(work, work2, tmp_index, bck_index)
DEALLOCATE (work, work2, tmp_index, bck_index)

184
src/dbcsr/base/dbcsr_hash_table.f90
View file

@ -12,45 +12,45 @@
!> \return ...
! **************************************************************************************************
FUNCTION matching_prime(i) RESULT(res)
INTEGER, INTENT(IN) :: i
INTEGER :: res
INTEGER, INTENT(IN) :: i
INTEGER :: res
INTEGER :: j
INTEGER :: j
res=i
j=0
DO WHILE (j<res)
DO j=2,res-1
IF (MOD(res,j)==0) THEN
res=res+1
EXIT
ENDIF
ENDDO
ENDDO
res = i
j = 0
DO WHILE (j < res)
DO j = 2, res-1
IF (MOD(res, j) == 0) THEN
res = res+1
EXIT
ENDIF
ENDDO
ENDDO
END FUNCTION
! *****************************************************************************
!> \brief create a hash_table of given initial size.
!> \brief create a hash_table of given initial size.
!> the hash table will expand as needed (but this requires rehashing)
!> \param hash_table ...
!> \param table_size ...
! **************************************************************************************************
SUBROUTINE hash_table_create(hash_table,table_size)
TYPE(hash_table_type) :: hash_table
INTEGER, INTENT(IN) :: table_size
SUBROUTINE hash_table_create(hash_table, table_size)
TYPE(hash_table_type) :: hash_table
INTEGER, INTENT(IN) :: table_size
INTEGER :: j
INTEGER :: j
! guarantee a minimal hash table size (8), so that expansion works
! guarantee a minimal hash table size (8), so that expansion works
j=3
DO WHILE(2**j-1<table_size)
j=j+1
ENDDO
hash_table%nmax=2**j-1
hash_table%prime=matching_prime(hash_table%nmax)
hash_table%nele=0
ALLOCATE(hash_table%table(0:hash_table%nmax))
j = 3
DO WHILE (2**j-1 < table_size)
j = j+1
ENDDO
hash_table%nmax = 2**j-1
hash_table%prime = matching_prime(hash_table%nmax)
hash_table%nele = 0
ALLOCATE (hash_table%table(0:hash_table%nmax))
END SUBROUTINE hash_table_create
! *****************************************************************************
@ -58,11 +58,11 @@
!> \param hash_table ...
! **************************************************************************************************
SUBROUTINE hash_table_release(hash_table)
TYPE(hash_table_type) :: hash_table
TYPE(hash_table_type) :: hash_table
hash_table%nmax=0
hash_table%nele=0
DEALLOCATE(hash_table%table)
hash_table%nmax = 0
hash_table%nele = 0
DEALLOCATE (hash_table%table)
END SUBROUTINE hash_table_release
@ -72,49 +72,49 @@
!> \param c this value is being hashed
!> \param p this is being stored
! **************************************************************************************************
RECURSIVE SUBROUTINE hash_table_add(hash_table,c,p)
TYPE(hash_table_type), INTENT(INOUT) :: hash_table
INTEGER, INTENT(IN) :: c, p
RECURSIVE SUBROUTINE hash_table_add(hash_table, c, p)
TYPE(hash_table_type), INTENT(INOUT) :: hash_table
INTEGER, INTENT(IN) :: c, p
REAL(KIND=real_8), PARAMETER :: hash_table_expand = 1.5_real_8, &
inv_hash_table_fill = 2.5_real_8
REAL(KIND=real_8), PARAMETER :: hash_table_expand = 1.5_real_8, &
inv_hash_table_fill = 2.5_real_8
INTEGER :: i, j
TYPE(ele_type), ALLOCATABLE, &
DIMENSION(:) :: tmp_hash
INTEGER :: i, j
TYPE(ele_type), ALLOCATABLE, &
DIMENSION(:) :: tmp_hash
! if too small, make a copy and rehash in a larger table
IF (hash_table%nele*inv_hash_table_fill>hash_table%nmax) THEN
ALLOCATE(tmp_hash(LBOUND(hash_table%table,1):UBOUND(hash_table%table,1)))
tmp_hash(:)=hash_table%table
CALL hash_table_release(hash_table)
CALL hash_table_create(hash_table,INT((UBOUND(tmp_hash,1)+8)*hash_table_expand))
DO i=LBOUND(tmp_hash,1),UBOUND(tmp_hash,1)
IF (tmp_hash(i)%c.NE.0) THEN
CALL hash_table_add(hash_table,tmp_hash(i)%c,tmp_hash(i)%p)
ENDIF
ENDDO
DEALLOCATE(tmp_hash)
ENDIF
IF (hash_table%nele*inv_hash_table_fill > hash_table%nmax) THEN
ALLOCATE (tmp_hash(LBOUND(hash_table%table, 1):UBOUND(hash_table%table, 1)))
tmp_hash(:) = hash_table%table
CALL hash_table_release(hash_table)
CALL hash_table_create(hash_table, INT((UBOUND(tmp_hash, 1)+8)*hash_table_expand))
DO i = LBOUND(tmp_hash, 1), UBOUND(tmp_hash, 1)
IF (tmp_hash(i)%c .NE. 0) THEN
CALL hash_table_add(hash_table, tmp_hash(i)%c, tmp_hash(i)%p)
ENDIF
ENDDO
DEALLOCATE (tmp_hash)
ENDIF
hash_table%nele=hash_table%nele+1
i=IAND(c*hash_table%prime,hash_table%nmax)
hash_table%nele = hash_table%nele+1
i = IAND(c*hash_table%prime, hash_table%nmax)
DO j=i,hash_table%nmax
IF (hash_table%table(j)%c==0 .OR. hash_table%table(j)%c==c) THEN
hash_table%table(j)%c=c
hash_table%table(j)%p=p
RETURN
ENDIF
ENDDO
DO j=0,i-1
IF (hash_table%table(j)%c==0 .OR. hash_table%table(j)%c==c) THEN
hash_table%table(j)%c=c
hash_table%table(j)%p=p
RETURN
ENDIF
ENDDO
DO j = i, hash_table%nmax
IF (hash_table%table(j)%c == 0 .OR. hash_table%table(j)%c == c) THEN
hash_table%table(j)%c = c
hash_table%table(j)%p = p
RETURN
ENDIF
ENDDO
DO j = 0, i-1
IF (hash_table%table(j)%c == 0 .OR. hash_table%table(j)%c == c) THEN
hash_table%table(j)%c = c
hash_table%table(j)%p = p
RETURN
ENDIF
ENDDO
END SUBROUTINE hash_table_add
@ -124,36 +124,36 @@
!> \param c ...
!> \return ...
! **************************************************************************************************
PURE FUNCTION hash_table_get(hash_table,c) RESULT(p)
TYPE(hash_table_type), INTENT(IN) :: hash_table
INTEGER, INTENT(IN) :: c
INTEGER :: p
PURE FUNCTION hash_table_get(hash_table, c) RESULT(p)
TYPE(hash_table_type), INTENT(IN) :: hash_table
INTEGER, INTENT(IN) :: c
INTEGER :: p
INTEGER :: i, j
INTEGER :: i, j
i=IAND(c*hash_table%prime,hash_table%nmax)
i = IAND(c*hash_table%prime, hash_table%nmax)
! catch the likely case first
IF (hash_table%table(i)%c==c) THEN
p=hash_table%table(i)%p
RETURN
ENDIF
! catch the likely case first
IF (hash_table%table(i)%c == c) THEN
p = hash_table%table(i)%p
RETURN
ENDIF
DO j=i,hash_table%nmax
IF (hash_table%table(j)%c==0 .OR. hash_table%table(j)%c==c) THEN
p=hash_table%table(j)%p
RETURN
ENDIF
ENDDO
DO j=0,i-1
IF (hash_table%table(j)%c==0 .OR. hash_table%table(j)%c==c) THEN
p=hash_table%table(j)%p
RETURN
ENDIF
ENDDO
DO j = i, hash_table%nmax
IF (hash_table%table(j)%c == 0 .OR. hash_table%table(j)%c == c) THEN
p = hash_table%table(j)%p
RETURN
ENDIF
ENDDO
DO j = 0, i-1
IF (hash_table%table(j)%c == 0 .OR. hash_table%table(j)%c == c) THEN
p = hash_table%table(j)%p
RETURN
ENDIF
ENDDO
! we should never reach this point.
p=HUGE(p)
! we should never reach this point.
p = HUGE(p)
END FUNCTION hash_table_get

10
src/dbcsr/base/dbcsr_hash_table_types.f90
View file

@ -2,13 +2,13 @@
!> \brief Types needed for the hashtable.
! *****************************************************************************
TYPE ele_type
INTEGER :: c=0
INTEGER :: p=0
INTEGER :: c = 0
INTEGER :: p = 0
END TYPE ele_type
TYPE hash_table_type
TYPE(ele_type), DIMENSION(:), POINTER :: table
INTEGER :: nele=0
INTEGER :: nmax=0
INTEGER :: prime=0
INTEGER :: nele = 0
INTEGER :: nmax = 0
INTEGER :: prime = 0
END TYPE hash_table_type

184
src/dbcsrx/hash_table.f90
View file

@ -12,45 +12,45 @@
!> \return ...
! **************************************************************************************************
FUNCTION matching_prime(i) RESULT(res)
INTEGER, INTENT(IN) :: i
INTEGER :: res
INTEGER, INTENT(IN) :: i
INTEGER :: res
INTEGER :: j
INTEGER :: j
res=i
j=0
DO WHILE (j<res)
DO j=2,res-1
IF (MOD(res,j)==0) THEN
res=res+1
EXIT
ENDIF
ENDDO
ENDDO
res = i
j = 0
DO WHILE (j < res)
DO j = 2, res-1
IF (MOD(res, j) == 0) THEN
res = res+1
EXIT
ENDIF
ENDDO
ENDDO
END FUNCTION
! *****************************************************************************
!> \brief create a hash_table of given initial size.
!> \brief create a hash_table of given initial size.
!> the hash table will expand as needed (but this requires rehashing)
!> \param hash_table ...
!> \param table_size ...
! **************************************************************************************************
SUBROUTINE hash_table_create(hash_table,table_size)
TYPE(hash_table_type) :: hash_table
INTEGER, INTENT(IN) :: table_size
SUBROUTINE hash_table_create(hash_table, table_size)
TYPE(hash_table_type) :: hash_table
INTEGER, INTENT(IN) :: table_size
INTEGER :: j
INTEGER :: j
! guarantee a minimal hash table size (8), so that expansion works
! guarantee a minimal hash table size (8), so that expansion works
j=3
DO WHILE(2**j-1<table_size)
j=j+1
ENDDO
hash_table%nmax=2**j-1
hash_table%prime=matching_prime(hash_table%nmax)
hash_table%nele=0
ALLOCATE(hash_table%table(0:hash_table%nmax))
j = 3
DO WHILE (2**j-1 < table_size)
j = j+1
ENDDO
hash_table%nmax = 2**j-1
hash_table%prime = matching_prime(hash_table%nmax)
hash_table%nele = 0
ALLOCATE (hash_table%table(0:hash_table%nmax))
END SUBROUTINE hash_table_create
! *****************************************************************************
@ -58,11 +58,11 @@
!> \param hash_table ...
! **************************************************************************************************
SUBROUTINE hash_table_release(hash_table)
TYPE(hash_table_type) :: hash_table
TYPE(hash_table_type) :: hash_table
hash_table%nmax=0
hash_table%nele=0
DEALLOCATE(hash_table%table)
hash_table%nmax = 0
hash_table%nele = 0
DEALLOCATE (hash_table%table)
END SUBROUTINE hash_table_release
@ -72,49 +72,49 @@
!> \param c this value is being hashed
!> \param p this is being stored
! **************************************************************************************************
RECURSIVE SUBROUTINE hash_table_add(hash_table,c,p)
TYPE(hash_table_type), INTENT(INOUT) :: hash_table
INTEGER, INTENT(IN) :: c, p
RECURSIVE SUBROUTINE hash_table_add(hash_table, c, p)
TYPE(hash_table_type), INTENT(INOUT) :: hash_table
INTEGER, INTENT(IN) :: c, p
REAL(KIND=real_8), PARAMETER :: hash_table_expand = 1.5_real_8, &
inv_hash_table_fill = 2.5_real_8
REAL(KIND=real_8), PARAMETER :: hash_table_expand = 1.5_real_8, &
inv_hash_table_fill = 2.5_real_8
INTEGER :: i, j
TYPE(ele_type), ALLOCATABLE, &
DIMENSION(:) :: tmp_hash
INTEGER :: i, j
TYPE(ele_type), ALLOCATABLE, &
DIMENSION(:) :: tmp_hash
! if too small, make a copy and rehash in a larger table
IF (hash_table%nele*inv_hash_table_fill>hash_table%nmax) THEN
ALLOCATE(tmp_hash(LBOUND(hash_table%table,1):UBOUND(hash_table%table,1)))
tmp_hash(:)=hash_table%table
CALL hash_table_release(hash_table)
CALL hash_table_create(hash_table,INT((UBOUND(tmp_hash,1)+8)*hash_table_expand))
DO i=LBOUND(tmp_hash,1),UBOUND(tmp_hash,1)
IF (tmp_hash(i)%c.NE.0) THEN
CALL hash_table_add(hash_table,tmp_hash(i)%c,tmp_hash(i)%p)
ENDIF
ENDDO
DEALLOCATE(tmp_hash)
ENDIF
IF (hash_table%nele*inv_hash_table_fill > hash_table%nmax) THEN
ALLOCATE (tmp_hash(LBOUND(hash_table%table, 1):UBOUND(hash_table%table, 1)))
tmp_hash(:) = hash_table%table
CALL hash_table_release(hash_table)
CALL hash_table_create(hash_table, INT((UBOUND(tmp_hash, 1)+8)*hash_table_expand))
DO i = LBOUND(tmp_hash, 1), UBOUND(tmp_hash, 1)
IF (tmp_hash(i)%c .NE. 0) THEN
CALL hash_table_add(hash_table, tmp_hash(i)%c, tmp_hash(i)%p)
ENDIF
ENDDO
DEALLOCATE (tmp_hash)
ENDIF
hash_table%nele=hash_table%nele+1
i=IAND(c*hash_table%prime,hash_table%nmax)
hash_table%nele = hash_table%nele+1
i = IAND(c*hash_table%prime, hash_table%nmax)
DO j=i,hash_table%nmax
IF (hash_table%table(j)%c==0 .OR. hash_table%table(j)%c==c) THEN
hash_table%table(j)%c=c
hash_table%table(j)%p=p
RETURN
ENDIF
ENDDO
DO j=0,i-1
IF (hash_table%table(j)%c==0 .OR. hash_table%table(j)%c==c) THEN
hash_table%table(j)%c=c
hash_table%table(j)%p=p
RETURN
ENDIF
ENDDO
DO j = i, hash_table%nmax
IF (hash_table%table(j)%c == 0 .OR. hash_table%table(j)%c == c) THEN
hash_table%table(j)%c = c
hash_table%table(j)%p = p
RETURN
ENDIF
ENDDO
DO j = 0, i-1
IF (hash_table%table(j)%c == 0 .OR. hash_table%table(j)%c == c) THEN
hash_table%table(j)%c = c
hash_table%table(j)%p = p
RETURN
ENDIF
ENDDO
END SUBROUTINE hash_table_add
@ -124,36 +124,36 @@
!> \param c ...
!> \return ...
! **************************************************************************************************
PURE FUNCTION hash_table_get(hash_table,c) RESULT(p)
TYPE(hash_table_type), INTENT(IN) :: hash_table
INTEGER, INTENT(IN) :: c
INTEGER :: p
PURE FUNCTION hash_table_get(hash_table, c) RESULT(p)
TYPE(hash_table_type), INTENT(IN) :: hash_table
INTEGER, INTENT(IN) :: c
INTEGER :: p
INTEGER :: i, j
INTEGER :: i, j
i=IAND(c*hash_table%prime,hash_table%nmax)
i = IAND(c*hash_table%prime, hash_table%nmax)
! catch the likely case first
IF (hash_table%table(i)%c==c) THEN
p=hash_table%table(i)%p
RETURN
ENDIF
! catch the likely case first
IF (hash_table%table(i)%c == c) THEN
p = hash_table%table(i)%p
RETURN
ENDIF
DO j=i,hash_table%nmax
IF (hash_table%table(j)%c==0 .OR. hash_table%table(j)%c==c) THEN
p=hash_table%table(j)%p
RETURN
ENDIF
ENDDO
DO j=0,i-1
IF (hash_table%table(j)%c==0 .OR. hash_table%table(j)%c==c) THEN
p=hash_table%table(j)%p
RETURN
ENDIF
ENDDO
DO j = i, hash_table%nmax
IF (hash_table%table(j)%c == 0 .OR. hash_table%table(j)%c == c) THEN
p = hash_table%table(j)%p
RETURN
ENDIF
ENDDO
DO j = 0, i-1
IF (hash_table%table(j)%c == 0 .OR. hash_table%table(j)%c == c) THEN
p = hash_table%table(j)%p
RETURN
ENDIF
ENDDO
! we should never reach this point.
p=HUGE(p)
! we should never reach this point.
p = HUGE(p)
END FUNCTION hash_table_get

10
src/dbcsrx/hash_table_types.f90
View file

@ -2,13 +2,13 @@
!> \brief Types needed for the hashtable.
! *****************************************************************************
TYPE ele_type
INTEGER :: c=0
INTEGER :: p=0
INTEGER :: c = 0
INTEGER :: p = 0
END TYPE ele_type
TYPE hash_table_type
TYPE(ele_type), DIMENSION(:), POINTER :: table
INTEGER :: nele=0
INTEGER :: nmax=0
INTEGER :: prime=0
INTEGER :: nele = 0
INTEGER :: nmax = 0
INTEGER :: prime = 0
END TYPE hash_table_type

4
src/grid/collocate_fast.f90
View file

@ -36,8 +36,8 @@
#else
This is an error, and unknown definition of GRID_CORE (__GRID_CORE) has been used
This is an error, and unknown definition of GRID_CORE(__GRID_CORE) has been used
#endif
#endif
#endif

6152
src/grid/collocate_fast_1.f90
View file

File diff suppressed because it is too large Load diff

3868
src/grid/collocate_fast_2.f90
View file

File diff suppressed because it is too large Load diff

5458
src/grid/collocate_fast_3.f90
View file

File diff suppressed because it is too large Load diff

4518
src/grid/collocate_fast_4.f90
View file

File diff suppressed because it is too large Load diff

5392
src/grid/collocate_fast_5.f90
View file

File diff suppressed because it is too large Load diff

4966
src/grid/collocate_fast_6.f90
View file

File diff suppressed because it is too large Load diff

8
src/grid/integrate_fast.f90
View file

@ -3,7 +3,7 @@
! the included fortran files represent the same kernel, with a fortran representation that optimizes best for a given compiler
#ifdef __HAS_LIBGRID
! Nothing here, the libgrid.a is present
! Nothing here, the libgrid.a is present
#else
#if !defined(__GRID_CORE)
@ -36,10 +36,8 @@
#else
This is an error, and unknown definition of GRID_CORE (__GRID_CORE) has been used
This is an error, and unknown definition of GRID_CORE(__GRID_CORE) has been used
#endif
#endif
#endif

6130
src/grid/integrate_fast_1.f90
View file

File diff suppressed because it is too large Load diff

2336
src/grid/integrate_fast_2.f90
View file

File diff suppressed because it is too large Load diff

5004
src/grid/integrate_fast_3.f90
View file

File diff suppressed because it is too large Load diff

5687
src/grid/integrate_fast_4.f90
View file

File diff suppressed because it is too large Load diff

2900
src/grid/integrate_fast_5.f90
View file

File diff suppressed because it is too large Load diff

5420
src/grid/integrate_fast_6.f90
View file

File diff suppressed because it is too large Load diff

112
src/hfx_get_pmax_val.f90
View file

@ -22,209 +22,207 @@
iset, jset, kset, lset, &
pmax_val, swap_id)
REAL(dp), DIMENSION(:,:), POINTER :: ptr_p_1, ptr_p_2, ptr_p_3, ptr_p_4
INTEGER, INTENT(IN) :: iset, jset, kset, lset
REAL(dp), DIMENSION(:, :), POINTER :: ptr_p_1, ptr_p_2, ptr_p_3, ptr_p_4
INTEGER, INTENT(IN) :: iset, jset, kset, lset
REAL(dp), INTENT(OUT) :: pmax_val
INTEGER, INTENT(IN) :: swap_id
REAL(dp), INTENT(OUT) :: pmax_val
INTEGER, INTENT(IN) :: swap_id
REAL(dp) :: pmax_1, pmax_2, pmax_3, pmax_4
REAL(dp) :: pmax_1, pmax_2, pmax_3, pmax_4
SELECT CASE(swap_id)
CASE (0)
SELECT CASE (swap_id)
CASE (0)
pmax_1 = ptr_p_1(kset, iset)
pmax_2 = ptr_p_2(lset, jset)
pmax_3 = ptr_p_3(lset, iset)
pmax_4 = ptr_p_4(kset, jset)
pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
CASE (1)
CASE (1)
pmax_1 = ptr_p_1(iset, kset)
pmax_2 = ptr_p_2(lset, jset)
pmax_3 = ptr_p_3(lset, iset)
pmax_4 = ptr_p_4(kset, jset)
pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
CASE (2)
CASE (2)
pmax_1 = ptr_p_1(kset, iset)
pmax_2 = ptr_p_2(jset, lset)
pmax_3 = ptr_p_3(lset, iset)
pmax_4 = ptr_p_4(kset, jset)
pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
CASE (3)
CASE (3)
pmax_1 = ptr_p_1(iset, kset)
pmax_2 = ptr_p_2(jset, lset)
pmax_3 = ptr_p_3(lset, iset)
pmax_4 = ptr_p_4(kset, jset)
pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
CASE (4)
CASE (4)
pmax_1 = ptr_p_1(kset, iset)
pmax_2 = ptr_p_2(lset, jset)
pmax_3 = ptr_p_3(iset, lset)
pmax_4 = ptr_p_4(kset, jset)
pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
CASE (5)
CASE (5)
pmax_1 = ptr_p_1(iset, kset)
pmax_2 = ptr_p_2(lset, jset)
pmax_3 = ptr_p_3(iset, lset)
pmax_4 = ptr_p_4(kset, jset)
pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
CASE (6)
CASE (6)
pmax_1 = ptr_p_1(kset, iset)
pmax_2 = ptr_p_2(jset, lset)
pmax_3 = ptr_p_3(iset, lset)
pmax_4 = ptr_p_4(kset, jset)
pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
CASE (7)
CASE (7)
pmax_1 = ptr_p_1(iset, kset)
pmax_2 = ptr_p_2(jset, lset)
pmax_3 = ptr_p_3(iset, lset)
pmax_4 = ptr_p_4(kset, jset)
pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
CASE (8)
CASE (8)
pmax_1 = ptr_p_1(kset, iset)
pmax_2 = ptr_p_2(lset, jset)
pmax_3 = ptr_p_3(lset, iset)
pmax_4 = ptr_p_4(jset, kset)
pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
CASE (9)
CASE (9)
pmax_1 = ptr_p_1(iset, kset)
pmax_2 = ptr_p_2(lset, jset)
pmax_3 = ptr_p_3(lset, iset)
pmax_4 = ptr_p_4(jset, kset)
pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
CASE (10)
CASE (10)
pmax_1 = ptr_p_1(kset, iset)
pmax_2 = ptr_p_2(jset, lset)
pmax_3 = ptr_p_3(lset, iset)
pmax_4 = ptr_p_4(jset, kset)
pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
CASE (11)
CASE (11)
pmax_1 = ptr_p_1(iset, kset)
pmax_2 = ptr_p_2(jset, lset)
pmax_3 = ptr_p_3(lset, iset)
pmax_4 = ptr_p_4(jset, kset)
pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
CASE (12)
CASE (12)
pmax_1 = ptr_p_1(kset, iset)
pmax_2 = ptr_p_2(lset, jset)
pmax_3 = ptr_p_3(iset, lset)
pmax_4 = ptr_p_4(jset, kset)
pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
CASE (13)
CASE (13)
pmax_1 = ptr_p_1(iset, kset)
pmax_2 = ptr_p_2(lset, jset)
pmax_3 = ptr_p_3(iset, lset)
pmax_4 = ptr_p_4(jset, kset)
pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
CASE (14)
CASE (14)
pmax_1 = ptr_p_1(kset, iset)
pmax_2 = ptr_p_2(jset, lset)
pmax_3 = ptr_p_3(iset, lset)
pmax_4 = ptr_p_4(jset, kset)
pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
CASE (15)
CASE (15)
pmax_1 = ptr_p_1(iset, kset)
pmax_2 = ptr_p_2(jset, lset)
pmax_3 = ptr_p_3(iset, lset)
pmax_4 = ptr_p_4(jset, kset)
pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
CASE (16)
CASE (16)
pmax_1 = ptr_p_1(kset, iset)
pmax_2 = ptr_p_2(lset, jset)
pmax_3 = ptr_p_3(lset, iset)
pmax_4 = ptr_p_4(kset, jset)
pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
CASE (17)
pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4)
CASE (17)
pmax_1 = ptr_p_1(iset, kset)
pmax_2 = ptr_p_2(lset, jset)
pmax_3 = ptr_p_3(lset, iset)
pmax_4 = ptr_p_4(kset, jset)
pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
CASE (18)
pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4)
CASE (18)
pmax_1 = ptr_p_1(kset, iset)
pmax_2 = ptr_p_2(jset, lset)
pmax_3 = ptr_p_3(lset, iset)
pmax_4 = ptr_p_4(kset, jset)
pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
CASE (19)
pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4)
CASE (19)
pmax_1 = ptr_p_1(iset, kset)
pmax_2 = ptr_p_2(jset, lset)
pmax_3 = ptr_p_3(lset, iset)
pmax_4 = ptr_p_4(kset, jset)
pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
CASE (20)
pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4)
CASE (20)
pmax_1 = ptr_p_1(kset, iset)
pmax_2 = ptr_p_2(lset, jset)
pmax_3 = ptr_p_3(iset, lset)
pmax_4 = ptr_p_4(kset, jset)
pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
CASE (21)
pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4)
CASE (21)
pmax_1 = ptr_p_1(iset, kset)
pmax_2 = ptr_p_2(lset, jset)
pmax_3 = ptr_p_3(iset, lset)
pmax_4 = ptr_p_4(kset, jset)
pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
CASE (22)
pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4)
CASE (22)
pmax_1 = ptr_p_1(kset, iset)
pmax_2 = ptr_p_2(jset, lset)
pmax_3 = ptr_p_3(iset, lset)
pmax_4 = ptr_p_4(kset, jset)
pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
CASE (23)
pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4)
CASE (23)
pmax_1 = ptr_p_1(iset, kset)
pmax_2 = ptr_p_2(jset, lset)
pmax_3 = ptr_p_3(iset, lset)
pmax_4 = ptr_p_4(kset, jset)
pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
CASE (24)
pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4)
CASE (24)
pmax_1 = ptr_p_1(kset, iset)
pmax_2 = ptr_p_2(lset, jset)
pmax_3 = ptr_p_3(lset, iset)
pmax_4 = ptr_p_4(jset, kset)
pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
CASE (25)
pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4)
CASE (25)
pmax_1 = ptr_p_1(iset, kset)
pmax_2 = ptr_p_2(lset, jset)
pmax_3 = ptr_p_3(lset, iset)
pmax_4 = ptr_p_4(jset, kset)
pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
CASE (26)
pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4)
CASE (26)
pmax_1 = ptr_p_1(kset, iset)
pmax_2 = ptr_p_2(jset, lset)
pmax_3 = ptr_p_3(lset, iset)
pmax_4 = ptr_p_4(jset, kset)
pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
CASE (27)
pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4)
CASE (27)
pmax_1 = ptr_p_1(iset, kset)
pmax_2 = ptr_p_2(jset, lset)
pmax_3 = ptr_p_3(lset, iset)
pmax_4 = ptr_p_4(jset, kset)
pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
CASE (28)
pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4)
CASE (28)
pmax_1 = ptr_p_1(kset, iset)
pmax_2 = ptr_p_2(lset, jset)
pmax_3 = ptr_p_3(iset, lset)
pmax_4 = ptr_p_4(jset, kset)
pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
CASE (29)
pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4)
CASE (29)
pmax_1 = ptr_p_1(iset, kset)
pmax_2 = ptr_p_2(lset, jset)
pmax_3 = ptr_p_3(iset, lset)
pmax_4 = ptr_p_4(jset, kset)
pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
CASE (30)
pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4)
CASE (30)
pmax_1 = ptr_p_1(kset, iset)
pmax_2 = ptr_p_2(jset, lset)
pmax_3 = ptr_p_3(iset, lset)
pmax_4 = ptr_p_4(jset, kset)
pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
CASE (31)
pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4)
CASE (31)
pmax_1 = ptr_p_1(iset, kset)
pmax_2 = ptr_p_2(jset, lset)
pmax_3 = ptr_p_3(iset, lset)
pmax_4 = ptr_p_4(jset, kset)
pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
END SELECT
pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4)
END SELECT
END SUBROUTINE get_pmax_val

157
src/prep.f90
View file

@ -6,92 +6,91 @@
! exp( -a*(x+d)**2)=exp(-a*x**2)*(-2*a*x*d)*exp(-a*d**2)
! exp(-2*a*(x+d)*d)=exp(-2*a*x*d)*exp(-2*a*d**2)
iaxis=3
t_exp_1=EXP(-zetp*dr(iaxis)**2)
t_exp_2=t_exp_1**2
t_exp_min_1=EXP(-zetp*(+dr(iaxis)- roffset(iaxis))**2)
t_exp_min_2=EXP(-2*zetp*(+dr(iaxis)- roffset(iaxis))*(-dr(iaxis)))
t_exp_plus_1=EXP(-zetp*( - roffset(iaxis))**2)
t_exp_plus_2=EXP(-2*zetp*( - roffset(iaxis))*(+dr(iaxis)))
DO ig=0,lb_cube(iaxis),-1
rpg = REAL(ig,dp)*dr(iaxis) - roffset(iaxis)
t_exp_min_1=t_exp_min_1*t_exp_min_2*t_exp_1
t_exp_min_2=t_exp_min_2*t_exp_2
pg = t_exp_min_1
! pg = EXP(-zetp*rpg**2)
DO icoef=0,lp
pol_z(1,icoef,ig)=pg
pg=pg*(rpg)
ENDDO
iaxis = 3
t_exp_1 = EXP(-zetp*dr(iaxis)**2)
t_exp_2 = t_exp_1**2
t_exp_min_1 = EXP(-zetp*(+dr(iaxis)-roffset(iaxis))**2)
t_exp_min_2 = EXP(-2*zetp*(+dr(iaxis)-roffset(iaxis))*(-dr(iaxis)))
t_exp_plus_1 = EXP(-zetp*(-roffset(iaxis))**2)
t_exp_plus_2 = EXP(-2*zetp*(-roffset(iaxis))*(+dr(iaxis)))
DO ig = 0, lb_cube(iaxis), -1
rpg = REAL(ig, dp)*dr(iaxis)-roffset(iaxis)
t_exp_min_1 = t_exp_min_1*t_exp_min_2*t_exp_1
t_exp_min_2 = t_exp_min_2*t_exp_2
pg = t_exp_min_1
! pg = EXP(-zetp*rpg**2)
DO icoef = 0, lp
pol_z(1, icoef, ig) = pg
pg = pg*(rpg)
ENDDO
rpg = REAL(1-ig,dp)*dr(iaxis) - roffset(iaxis)
t_exp_plus_1=t_exp_plus_1*t_exp_plus_2*t_exp_1
t_exp_plus_2=t_exp_plus_2*t_exp_2
pg = t_exp_plus_1
! pg = EXP(-zetp*rpg**2)
DO icoef=0,lp
pol_z(2,icoef,ig)=pg
pg=pg*(rpg)
ENDDO
rpg = REAL(1-ig, dp)*dr(iaxis)-roffset(iaxis)
t_exp_plus_1 = t_exp_plus_1*t_exp_plus_2*t_exp_1
t_exp_plus_2 = t_exp_plus_2*t_exp_2
pg = t_exp_plus_1
! pg = EXP(-zetp*rpg**2)
DO icoef = 0, lp
pol_z(2, icoef, ig) = pg
pg = pg*(rpg)
ENDDO
ENDDO
iaxis=2
t_exp_1=EXP(-zetp*dr(iaxis)**2)
t_exp_2=t_exp_1**2
t_exp_min_1=EXP(-zetp*(+dr(iaxis)- roffset(iaxis))**2)
t_exp_min_2=EXP(-2*zetp*(+dr(iaxis)- roffset(iaxis))*(-dr(iaxis)))
t_exp_plus_1=EXP(-zetp*( - roffset(iaxis))**2)
t_exp_plus_2=EXP(-2*zetp*( - roffset(iaxis))*(+dr(iaxis)))
DO ig=0,lb_cube(iaxis),-1
rpg = REAL(ig,dp)*dr(iaxis) - roffset(iaxis)
t_exp_min_1=t_exp_min_1*t_exp_min_2*t_exp_1
t_exp_min_2=t_exp_min_2*t_exp_2
pg = t_exp_min_1
! pg = EXP(-zetp*rpg**2)
DO icoef=0,lp
pol_y(1,icoef,ig)=pg
pg=pg*(rpg)
ENDDO
iaxis = 2
t_exp_1 = EXP(-zetp*dr(iaxis)**2)
t_exp_2 = t_exp_1**2
t_exp_min_1 = EXP(-zetp*(+dr(iaxis)-roffset(iaxis))**2)
t_exp_min_2 = EXP(-2*zetp*(+dr(iaxis)-roffset(iaxis))*(-dr(iaxis)))
t_exp_plus_1 = EXP(-zetp*(-roffset(iaxis))**2)
t_exp_plus_2 = EXP(-2*zetp*(-roffset(iaxis))*(+dr(iaxis)))
DO ig = 0, lb_cube(iaxis), -1
rpg = REAL(ig, dp)*dr(iaxis)-roffset(iaxis)
t_exp_min_1 = t_exp_min_1*t_exp_min_2*t_exp_1
t_exp_min_2 = t_exp_min_2*t_exp_2
pg = t_exp_min_1
! pg = EXP(-zetp*rpg**2)
DO icoef = 0, lp
pol_y(1, icoef, ig) = pg
pg = pg*(rpg)
ENDDO
rpg = REAL(1-ig,dp)*dr(iaxis) - roffset(iaxis)
t_exp_plus_1=t_exp_plus_1*t_exp_plus_2*t_exp_1
t_exp_plus_2=t_exp_plus_2*t_exp_2
pg = t_exp_plus_1
! pg = EXP(-zetp*rpg**2)
DO icoef=0,lp
pol_y(2,icoef,ig)=pg
pg=pg*(rpg)
ENDDO
rpg = REAL(1-ig, dp)*dr(iaxis)-roffset(iaxis)
t_exp_plus_1 = t_exp_plus_1*t_exp_plus_2*t_exp_1
t_exp_plus_2 = t_exp_plus_2*t_exp_2
pg = t_exp_plus_1
! pg = EXP(-zetp*rpg**2)
DO icoef = 0, lp
pol_y(2, icoef, ig) = pg
pg = pg*(rpg)
ENDDO
ENDDO
iaxis=1
t_exp_1=EXP(-zetp*dr(iaxis)**2)
t_exp_2=t_exp_1**2
t_exp_min_1=EXP(-zetp*(+dr(iaxis)- roffset(iaxis))**2)
t_exp_min_2=EXP(-2*zetp*(+dr(iaxis)- roffset(iaxis))*(-dr(iaxis)))
t_exp_plus_1=EXP(-zetp*( - roffset(iaxis))**2)
t_exp_plus_2=EXP(-2*zetp*( - roffset(iaxis))*(+dr(iaxis)))
DO ig=0,lb_cube(1),-1
iaxis = 1
t_exp_1 = EXP(-zetp*dr(iaxis)**2)
t_exp_2 = t_exp_1**2
t_exp_min_1 = EXP(-zetp*(+dr(iaxis)-roffset(iaxis))**2)
t_exp_min_2 = EXP(-2*zetp*(+dr(iaxis)-roffset(iaxis))*(-dr(iaxis)))
t_exp_plus_1 = EXP(-zetp*(-roffset(iaxis))**2)
t_exp_plus_2 = EXP(-2*zetp*(-roffset(iaxis))*(+dr(iaxis)))
DO ig = 0, lb_cube(1), -1
rpg = REAL(ig,dp)*dr(1) - roffset(1)
t_exp_min_1=t_exp_min_1*t_exp_min_2*t_exp_1
t_exp_min_2=t_exp_min_2*t_exp_2
pg = t_exp_min_1
!pg = EXP(-zetp*rpg**2)
DO icoef=0,lp
pol_x(icoef,ig)=pg
pg=pg*(rpg)
ENDDO
rpg = REAL(ig, dp)*dr(1)-roffset(1)
t_exp_min_1 = t_exp_min_1*t_exp_min_2*t_exp_1
t_exp_min_2 = t_exp_min_2*t_exp_2
pg = t_exp_min_1
!pg = EXP(-zetp*rpg**2)
DO icoef = 0, lp
pol_x(icoef, ig) = pg
pg = pg*(rpg)
ENDDO
rpg = REAL(1-ig,dp)*dr(1) - roffset(1)
t_exp_plus_1=t_exp_plus_1*t_exp_plus_2*t_exp_1
t_exp_plus_2=t_exp_plus_2*t_exp_2
pg = t_exp_plus_1
! pg = EXP(-zetp*rpg**2)
DO icoef=0,lp
pol_x(icoef,1-ig)=pg
pg=pg*(rpg)
ENDDO
rpg = REAL(1-ig, dp)*dr(1)-roffset(1)
t_exp_plus_1 = t_exp_plus_1*t_exp_plus_2*t_exp_1
t_exp_plus_2 = t_exp_plus_2*t_exp_2
pg = t_exp_plus_1
! pg = EXP(-zetp*rpg**2)
DO icoef = 0, lp
pol_x(icoef, 1-ig) = pg
pg = pg*(rpg)
ENDDO
ENDDO