diff --git a/CMakeLists.txt b/CMakeLists.txt index 90a5cf2..f8414e3 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -137,6 +137,8 @@ option(EXT_SPEEDTEST "Enable speed tests targets" OFF) option(EXT_STATICPACK "Produce static packaging if possible" OFF) option(EXT_DETAIL "Produce more detailed config output" OFF) option(EXT_NVTX "Turn on Nvidia NVTX ranges" OFF) +option(EXT_OMP "Use OpenMP" ON) +option(EXT_PROFILED "Use profiled compile option" OFF) set(EXT_BLAS_LIB "" CACHE STRING "Blas libraries") set(EXT_LAPACK_LIB "" CACHE STRING "Lapack libraries") @@ -297,6 +299,27 @@ foreach(OTHER_LIB ${EXT_OTHER_LIB}) link_libraries(${OTHER_LIB}) endforeach() +find_package(TREXIO) +if (TREXIO_FOUND) + list( APPEND PPDIRECTIVES _TREXIO ) + link_libraries(${TREXIO_LIBRARIES}) + include_directories( ${TREXIO_INCLUDE_DIRS} ) +endif() + +find_package(QMCKL) +if (QMCKL_FOUND) + list( APPEND PPDIRECTIVES _QMCKL ) + link_libraries(${QMCKL_LIBRARIES}) + include_directories( ${QMCKL_INCLUDE_DIRS} ) +endif() + +find_package(QMCKL_GPU) +if (QMCKL_GPU_FOUND) + list( APPEND PPDIRECTIVES _QMCKL_GPU ) + link_libraries(${QMCKL_GPU_LIBRARIES}) + include_directories( ${QMCKL_GPU_INCLUDE_DIRS} ) +endif() + ###################################################################### # # Setting native OMP to off @@ -307,7 +330,9 @@ set( NATIVE_OMP_B OFF ) # ###################################################################### -find_package(OpenMP) +if(${EXT_OMP}) + find_package(OpenMP) +endif() find_package(Threads) if(EXT_GPU) @@ -588,6 +613,7 @@ if(EXT_MODTEST) add_target_exe_serial_wrapper(test_openmp_reduction_complex test_tools) add_target_exe_serial_wrapper(test_upwinvp test_tools) add_target_exe_serial_wrapper(test_upwinvp_complex test_tools) + add_target_exe_serial_wrapper(test_makefun test_tools) #add_target_exe_serial_wrapper(test_upwinvp_pfaff test_tools) #add_target_exe_serial_wrapper(test_upwinvp_pfaff_complex test_tools) diff --git a/Makefile b/Makefile index 2249c9c..78d20d9 100644 --- a/Makefile +++ b/Makefile @@ -28,12 +28,15 @@ ifeq ($(make_inc_c) ,c) $(info ) $(info 1 GNU Fortran Compiler ) $(info 2 GNU Fortran Compiler with MPI) + $(info 3 Intel Fortran Compiler with MPI) $(info ) - $(shell read -p "Select an example [1-2]: " ans; \ + $(shell read -p "Select an example [1-3]: " ans; \ if [ "$$ans" = "1" ]; then \ cp devel_tools/make.inc.examples/make.inc.example.gcc make.inc; \ elif [ "$$ans" = "2" ]; then \ cp devel_tools/configs/make.inc.example.gccmpi make.inc; \ + elif [ "$$ans" = "3" ]; then \ + cp devel_tools/configs/make.inc.example.mpiifort make.inc; \ fi) endif diff --git a/cmake/FindQMCKL_GPU.cmake b/cmake/FindQMCKL_GPU.cmake new file mode 100644 index 0000000..f80f6ac --- /dev/null +++ b/cmake/FindQMCKL_GPU.cmake @@ -0,0 +1,79 @@ +#=========================================== + +# Try to find the QMCkl GPU library; +# If found, it will define the following variables (note the plural form): +# QMCKL_GPU_FOUND - System has libqmckl; +# QMCKL_GPU_INCLUDE_DIRS - The QMCKL GPU include directories; +# QMCKL_GPU_LIBRARIES - The libraries needed to use QMCKL GPU; + +# If QMCKL GPU has been installed in a non-standard location, one can set an +# environment variable $QMCKL_GPU_DIR in the current shell: +# $ export QMCKL_GPU_DIR= +# to indicate the prefix used during the QMCKL installation +# (typically `./configure prefix= ..` or `cmake -DCMAKE_INSTALL_DIR= ..`) + +# This file should be located WITHIN your project source tree. +# (e.g. in cmake/FindQMCKL_GPU.cmake) +# How to use it in your project CMakeLists.txt: + +# This is needed to locate FindQMCKL_GPU.cmake file, modify it according to your source tree. +# list(APPEND CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake/") + +# find_package(QMCKL_GPU) +# if (QMCKL_GPU_FOUND) +# include_directories(${QMCKL_GPU_INCLUDE_DIRS}) +# target_link_libraries(your_target ${QMCKL_GPU_LIBRARIES}) +# endif() + +#=========================================== + +# This file is distirbuted under the BSD 3-Clause License. +# Copyright (c) 2021, TREX Center of Excellence + +#=========================================== + +message(" ") +message("Looking for the QMCKL_GPU library:") + +set(QMCKL_GPU_SEARCH_PATHS + ~/Library/Frameworks + /Library/Frameworks + /usr/local + /usr + /sw # Fink + /opt/local # DarwinPorts + /opt/csw # Blastwave + /opt +) + +find_path(QMCKL_GPU_INCLUDE_DIR + NAMES qmckl_gpu_f.F90 + HINTS $ENV{QMCKL_GPU_DIR} + PATH_SUFFIXES include + PATHS ${QMCKL_GPU_SEARCH_PATHS} + ) + + +# No need to specify platform-specific prefix (e.g. libqmckl_gpu on Unix) or +# suffix (e.g. .so on Unix or .dylib on MacOS) in NAMES. CMake takes care of that. +find_library(QMCKL_GPU_LIBRARY + NAMES qmckl_gpu + HINTS $ENV{QMCKL_GPU_DIR} + PATH_SUFFIXES lib64 lib + PATHS ${QMCKL_GPU_SEARCH_PATHS} + ) + +get_filename_component(QMCKL_GPU_LIBRARY_DIR ${QMCKL_GPU_LIBRARY} DIRECTORY) + +set(QMCKL_GPU_LIBRARIES "-L${QMCKL_GPU_LIBRARY_DIR} -lqmckl_gpu") + +# Handle the QUIETLY and REQUIRED arguments and set QMCKL_GPU_FOUND to TRUE if +# all listed variables are TRUE. +INCLUDE(FindPackageHandleStandardArgs) +FIND_PACKAGE_HANDLE_STANDARD_ARGS(QMCKL_GPU DEFAULT_GPU_MSG QMCKL_GPU_LIBRARY QMCKL_GPU_INCLUDE_DIR ) +MARK_AS_ADVANCED(QMCKL_GPU_INCLUDE_DIR QMCKL_GPU_LIBRARY) + +# Mot setting _INCLUDE_DIR and _LIBRARIES is considered a bug, +# see https://gitlab.kitware.com/cmake/community/-/wikis/doc/tutorials/How-To-Find-Libraries +set(QMCKL_GPU_INCLUDE_DIRS ${QMCKL_GPU_INCLUDE_DIR}) + diff --git a/cmake/compilers/GNU/CMakeLists.txt b/cmake/compilers/GNU/CMakeLists.txt index b8ab2e1..42633b2 100644 --- a/cmake/compilers/GNU/CMakeLists.txt +++ b/cmake/compilers/GNU/CMakeLists.txt @@ -30,6 +30,10 @@ macro(SET_GNU_FORTRAN_COMPILER) check_Fortran_compiler_flag("-ffree-line-length-none" _free_line_length_none_works) + if (${EXT_PROFILED}) + add_fortran_flag_if_avail( "-pg" ) + endif() + if(EXT_GPU) add_fortran_flag_if_avail( "-fno-whole-file" "GNU Fortran compiler does not supports no-whole-flag, turn off GPU support" ) add_fortran_flag_if_avail( "-fopenmp" ) @@ -58,6 +62,15 @@ macro(SET_GNU_FORTRAN_COMPILER) endif() endforeach() endif() + + foreach( TARGET IN LISTS EXECUTABLES_S_L + EXECUTABLES_P_L + LIBRARIES_S_L + LIBRARIES_P_L) + if (${EXT_PROFILED}) + target_link_options( ${TARGET} PRIVATE "-pg" ) + endif() + endforeach() add_fortran_flag_if_avail( "-march=native" ) add_fortran_flag_if_avail( "-mtune=native" ) @@ -123,6 +136,10 @@ macro(SET_GNU_C_COMPILER) add_c_flag_if_avail( "-g" ) + if (${EXT_PROFILED}) + add_c_flag_if_avail( "-pg" ) + endif() + if( ${EXT_OPT} ) add_c_flag_if_avail( "-O3" ) else() diff --git a/cmake/compilers/intel/CMakeLists.txt b/cmake/compilers/intel/CMakeLists.txt index 1fdc575..e8606f7 100644 --- a/cmake/compilers/intel/CMakeLists.txt +++ b/cmake/compilers/intel/CMakeLists.txt @@ -16,18 +16,42 @@ macro(SET_INTEL_FORTRAN_COMPILER) endif() add_fortran_flag_if_avail( "-fpp" "Intel (Legacy) Fortran compiler does not supports c preprocessor" ) - add_fortran_flag_if_avail( "-qopenmp" ) + add_fortran_flag_if_avail( "-march=core-avx2" ) + add_fortran_flag_if_avail( "-qopt-report" ) + add_fortran_flag_if_avail( "-g" ) - - #message(${CMAKE_APPLE_SILICON_PROCESSOR}) - #if( ${CMAKE_APPLE_SILICON_PROCESSOR} MATCHES x86_64 ) - # add_fortran_flag_if_avail( "-arch=x86_64" ) - #endif() + + if( ${EXT_PROFILED} ) + add_fortran_flag_if_avail( "-pg" ) + endif() + + # If OpenMP is yes nad NATIVE_OMP_B is false, the compile with OpenMP + if( ${EXT_OMP} ) + if( ${OPENMP} ) + if( NOT ${NATIVE_OMP_B} ) + add_fortran_flag_if_avail( "-qopenmp" ) + endif() + endif() + endif() if ( ${APPLE} ) add_fortran_flag_if_avail( "-fno-common" ) endif() + foreach( LIBRARY IN LISTS LIBRARIES_S_L + LIBRARIES_P_L + EXECUTABLES_S_L + EXECUTABLES_P_L + ) + if( ${EXT_OMP} ) + target_link_options(${LIBRARY} PRIVATE -qopenmp) + endif() + if( ${EXT_PROFILED} ) + target_link_options(${LIBRARY} PRIVATE -pg) + endif() + + endforeach() + # Set optimization flags for all executables: foreach( LIBRARY IN LISTS LIBRARIES_S_L LIBRARIES_P_L diff --git a/cmake/compilers/oneapi/CMakeLists.txt b/cmake/compilers/oneapi/CMakeLists.txt index 8e254eb..01b77e1 100644 --- a/cmake/compilers/oneapi/CMakeLists.txt +++ b/cmake/compilers/oneapi/CMakeLists.txt @@ -9,6 +9,9 @@ macro(SET_ONEAPI_FORTRAN_COMPILER) message( STATUS "Using Intel oneAPI Compiler" ) add_fortran_flag_if_avail( "-fpp" "Intel LLVM Fortran compiler does not supports C preprocessor" ) + add_fortran_flag_if_avail( "-xHost" ) + add_fortran_flag_if_avail( "-finline-functions" ) + add_fortran_flag_if_avail( "-qopt-report" ) set(AGRESSIVE_F "-Ofast") if( ${EXT_OPT} ) @@ -20,6 +23,23 @@ macro(SET_ONEAPI_FORTRAN_COMPILER) set(PASIVE_F "-O0") endif() + if( ${EXT_PROFILED} ) + add_fortran_flag_if_avail( "-pg" ) + endif() + + foreach( LIBRARY IN LISTS LIBRARIES_S_L + LIBRARIES_P_L + EXECUTABLES_S_L + EXECUTABLES_P_L + ) + if( ${EXT_PROFILED} ) + target_link_options( ${LIBRARY} PRIVATE "-pg" ) + endif() + if( ${EXT_OMP} ) + target_link_options( ${LIBRARY} PRIVATE "-qopenmp" ) + endif() + endforeach() + # Set optimization flags: foreach( LIBRARY IN LISTS LIBRARIES_S_L LIBRARIES_P_L @@ -68,6 +88,10 @@ macro(SET_ONEAPI_C_COMPILER) add_c_flag_if_avail( "-g" ) + if( ${EXT_PROFILED} ) + add_c_flag_if_avail( "-pg" ) + endif() + if( ${EXT_OPT} ) add_c_flag_if_avail( "-O3" ) else() diff --git a/devel_tools/adjoints/make0branch.sh b/devel_tools/adjoints/make0branch.sh index c89a17d..6d517c6 100755 --- a/devel_tools/adjoints/make0branch.sh +++ b/devel_tools/adjoints/make0branch.sh @@ -16,25 +16,25 @@ # Otto Kohulák created on 5th Nov. 2021. # copy in the present directory makefuns -cp ../../src/makefun.f90 . -cp ../../AD/reverse_cell/makefun_b.f90 . -cp ../../src/makefun_pbc.f90 . -cp ../../AD/reverse_cell/makefun_pbc_b.f90 . -cp ../../src/makefun_bump.f90 . -cp ../../AD/reverse_cell/makefun_bump_b.f90 . +cp ../../src/c_adjoint_forward/makefun.f90 . +cp ../../src/c_adjoint_backward/makefun_b.f90 . +cp ../../src/c_adjoint_forward/makefun_pbc.f90 . +cp ../../src/c_adjoint_backward/makefun_pbc_b.f90 . +cp ../../src/c_adjoint_forward/makefun_bump.f90 . +cp ../../src/c_adjoint_backward/makefun_bump_b.f90 . # process the mkefuns -python preprocess.py -c makefun0:[i0=0,indtmin=0,indtm=0] -o makefun0.f90 makefun.f90 -python preprocess.py -c makefun0_b:[i0=0,indtmin=0,indtm=0] -o makefun0_b.f90 makefun_b.f90 -python preprocess.py -c makefun0_pbc:[i0=0,indtmin=0,indtm=0] -o makefun0_pbc.f90 makefun_pbc.f90 -python preprocess.py -c makefun0_pbc_b:[i0=0,indtmin=0,indtm=0] -o makefun0_pbc_b.f90 makefun_pbc_b.f90 -python preprocess.py -c makefun0_bump:[i0=0,indtmin=0,indtm=0] -o makefun0_bump.f90 makefun_bump.f90 -python preprocess.py -c makefun0_bump_b:[i0=0,indtmin=0,indtm=0] -o makefun0_bump_b.f90 makefun_bump_b.f90 +python3 preprocess.py -c makefun0:[i0=0,indtmin=0,indtm=0] -o makefun0.f90 makefun.f90 +python3 preprocess.py -c makefun0_b:[i0=0,indtmin=0,indtm=0] -o makefun0_b.f90 makefun_b.f90 +python3 preprocess.py -c makefun0_pbc:[i0=0,indtmin=0,indtm=0] -o makefun0_pbc.f90 makefun_pbc.f90 +python3 preprocess.py -c makefun0_pbc_b:[i0=0,indtmin=0,indtm=0] -o makefun0_pbc_b.f90 makefun_pbc_b.f90 +python3 preprocess.py -c makefun0_bump:[i0=0,indtmin=0,indtm=0] -o makefun0_bump.f90 makefun_bump.f90 +python3 preprocess.py -c makefun0_bump_b:[i0=0,indtmin=0,indtm=0] -o makefun0_bump_b.f90 makefun_bump_b.f90 # copy makefuns0 -cp makefun0.f90 ../../src/makefun0.f90 -cp makefun0_b.f90 ../../AD/reverse_cell/ -cp makefun0_pbc.f90 ../../src/makefun0_pbc.f90 -cp makefun0_pbc_b.f90 ../../AD/reverse_cell/ -cp makefun0_bump.f90 ../../src/makefun0_bump.f90 -cp makefun0_bump_b.f90 ../../AD/reverse_cell/ +cp makefun0.f90 ../../src/c_adjoint_forward/makefun0.f90 +cp makefun0_b.f90 ../../src/c_adjoint_backward/ +cp makefun0_pbc.f90 ../../src/c_adjoint_forward/makefun0_pbc.f90 +cp makefun0_pbc_b.f90 ../../src/c_adjoint_backward/ +cp makefun0_bump.f90 ../../src/c_adjoint_forward/makefun0_bump.f90 +cp makefun0_bump_b.f90 ../../src/c_adjoint_backward/ diff --git a/devel_tools/configs/make.inc.example.mpiifort b/devel_tools/configs/make.inc.example.mpiifort new file mode 100644 index 0000000..22149f3 --- /dev/null +++ b/devel_tools/configs/make.inc.example.mpiifort @@ -0,0 +1,79 @@ +# Makefile inc for TurboRVB + +# This make.inc is also a tutorial how to setup Makefile for TurboRVB. +# This one is set up for Intel Fortran compiler with MKL library. +# You might have to check your compiler and LAPACK installation and change + +# First we specifies suffix for our executable. This is not necessary but it is good practice. + +SUFFIX=-mpi.x + +# This Makefile uses out-of-source build. This means that all object files and modules +# will be stored in separate directory. This directory is specified here. +# Keep in mind this have to be ABSOLUTE PATH. This file is loaded by sub-makefiles +# therefore $(pwd) or $(CURDIR) will not work. + +BUILD_DIR=/home/addman/Software/turborvb-rm/build-mpi + +# Setup compilers Fortran and C. For this FC and CC variables are used respectively. + +FC=mpiifort +CC=mpiicx + +# Setup compiler flags. Note that for MPI version Fortran compiler wrapper should be used. +# For this FCFLAGS and CFLAGS variables are used respectively. + +# It is important NOT to specify optimization flags here! + +# First we have to specify that Fortran should use C preprocessor. +# This is done by "-fpp" flag. This works for Intel Fortran compiler. + +FCFLAGS=-fpp + +# One might like to use OpenMP parallelism + +FCFLAGS+=-qopenmp + +# Setting up optimization flags: + +FCFLAGS+=-march=core-avx2 + +# Debug -g flag is not slowing down modern code so we can use it all the time. + +FCFLAGS+=-g + +# Here we specify optimization flags. +# C optimization flags CAN be specified here. +# This is one difference between C and Fortran flags. + +CFLAGS=-O3 -g -qopenmp + +# Here we specify flags for aggressive optimization. +# Not all source files can be compiled with aggressive optimization. These files has to +# carefully selected and precified in the file make.txt + +FCFLAGS_AGGRESSIVE=-O3 -funroll-loops +FCFLAGS_PASSIVE=-O0 + +# Here we specify flags that control storing and including of modules. +# For intel fortran it is "-module" and "-I" flags respectively. +# This is true for most compilers. Normally, it is not necessary to specify these flags. + +MODULE_STORE=-module +MODULE_INCLUDE=-I + +# Here we can add preprocessort directives. Keep in mind it is good add them to FCFLAGS +# as well as to CFLAGS. For this a helper variable PP_DIRECTIVES is used. + +PP_DIRECTIVES=-D_TIME -D_SCALAPACK + +FCFLAGS+=$(PP_DIRECTIVES) +CFLAGS+=$(PP_DIRECTIVES) + +# Link options. Here we specify libraries that are needed for linking. + +FLINK=-qopenmp + +# Here we specify libraries that are needed for linking. + +LINK_LIBS=-L${MKLROOT}/lib -lmkl_scalapack_lp64 -lmkl_intel_lp64 -lmkl_intel_thread -lmkl_core -lmkl_blacs_intelmpi_lp64 -liomp5 -lpthread -lm -ldl diff --git a/devel_tools/makefun_factory/construct.py b/devel_tools/makefun_factory/construct.py new file mode 100644 index 0000000..e8a8911 --- /dev/null +++ b/devel_tools/makefun_factory/construct.py @@ -0,0 +1,25 @@ +import glob + +# Load header +with open('makefun_header.f90', 'r') as f: + header = f.read() + +# Load footer +with open('makefun_footer.f90', 'r') as f: + footer = f.read() + +# Load orbitals +# search for all file that fits name pattern orb_*.f90 +orb_files = glob.glob('orb_*.f90') +# read files +orbitals = {f.replace("orb_", "").replace(".f90",""): open(f, 'r').read() for f in orb_files} + +# Assemble output +with open('makefun_out.f90', 'w') as f: + f.write(header) + f.write('select case (iopt)\n') + for k, v in orbitals.items(): + f.write(f'case ({k})\n') + f.write(v) + f.write(footer) + diff --git a/devel_tools/makefun_factory/makefun_footer.f90 b/devel_tools/makefun_factory/makefun_footer.f90 new file mode 100644 index 0000000..42672b6 --- /dev/null +++ b/devel_tools/makefun_factory/makefun_footer.f90 @@ -0,0 +1,10 @@ +case default +write(6,*) 'WARNING makefun: orbital',iopt,'not found' + +iflagerr=1 + +end select +! ** ** ** ** ** ** ** END OF JASTROW ORBITALS ** ** ** ** ** ** ** ** * + +return +end diff --git a/devel_tools/makefun_factory/makefun_header.f90 b/devel_tools/makefun_factory/makefun_header.f90 new file mode 100644 index 0000000..7efdee8 --- /dev/null +++ b/devel_tools/makefun_factory/makefun_header.f90 @@ -0,0 +1,40 @@ +!TL off +subroutine makefun(iopt,indt,i0,indtmin,indtm,typec,indpar & + &,indorb,indshell,nelskip,z,dd,zeta,r,rmu,distp & + &,iflagnorm_unused,cr) + use constants + implicit none + integer iopt,indt,i,k,nelskip,indpar,indorbp & + &,indorb,indshell,indshellp,ic,indtmin,i0 & + &,iflagnorm_unused,indparp,indtm,npower,typec & + &,ii,jj,kk + real*8 z(nelskip,i0:*),dd(*),zeta(*),rmu(3,0:indtm) & + &,r(0:indtm) & + &,distp(0:indtm,20),peff,fun,fun0,fun2 & + &,rp1,rp2,rp3,rp4,rp5,rp6,rp7,rp8 & + &,dd1,dd2,dd3,dd4,dd5,c,cr,funp,fun2p,funb & + &,peff2,arg,c0,c1,cost,zv(6),yv(6),xv(6),r2,r4,r6 ! up to i + + integer :: count, multiplicity + integer, parameter :: max_power = 20 + real*8 :: powers(3,-2:max_power,0:indtm) + ! + ! indorb are the number of orbitals occupied before calling + ! this subroutine + ! + ! indpar is the number of variational parameters used + ! before calling this subroutine + ! + ! indshell is the index of the last occupied orbital + ! in the shell, characterized by occupation number iocc(indshell) + ! + ! z(i,indt+4) contains the laplacian of the orbital i + ! z(i,indt+mu) contains the gradient of the orbital i (mu=1,2,3) + ! In the following given a radial part of the orbital f(r) + ! fun=1/r d f(r)/d r + + !print *,__FILE__ + !print *,'makefun: iopt=',iopt + !print *,'makefun: i=',i0,' a=',indtmin,' b=',indtm + !print *,'makefun: indpar=',indpar,' indorb=',indorb,' indshell=',indshell + !print *,'makefun: nelskip=',nelskip diff --git a/devel_tools/makefun_factory/orb_1.f90 b/devel_tools/makefun_factory/orb_1.f90 new file mode 100644 index 0000000..129eb03 --- /dev/null +++ b/devel_tools/makefun_factory/orb_1.f90 @@ -0,0 +1,36 @@ + ! s orbital + ! + ! - angmom = 0 + ! - type = Slater + ! - normalized = yes + ! - angtype = spherical + ! - npar = 1 + ! - multiplicity = 1 + ! + + indshellp=indshell+1 + dd1=dd(indpar+1) + c=dd1*dsqrt(dd1)*0.56418958354775628695d0 + + indorbp=indorb+1 + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + end do + + do i=i0,indtm + z(indorbp,i)=distp(i,1) + end do + + if(typec.ne.1) then + fun=-dd1*distp(0,1) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0)/r(0) + end do + + z(indorbp,indt+4)=(-2.d0*dd1/r(0)+dd1**2)*distp(0,1) + end if + + indorb=indorbp + indpar=indpar+1 + indshell=indshellp diff --git a/devel_tools/makefun_factory/orb_10.f90 b/devel_tools/makefun_factory/orb_10.f90 new file mode 100644 index 0000000..a7b7661 --- /dev/null +++ b/devel_tools/makefun_factory/orb_10.f90 @@ -0,0 +1,41 @@ + ! s orbital + ! + ! - angmom = 0 + ! - type = Slater + ! - normalized = yes + ! - angtype = spherical + ! - npar = 1 + ! - multiplicity = 1 + ! + ! = N * R + ! + ! 3s single zeta + ! and R is the radial part + ! R(r) = r**2*exp(-z1*r) + ! + + indshellp=indshell+1 + indorbp=indorb+1 + dd1=dd(indpar+1) + c=dd1**3.5d0*0.11894160774351807429d0 + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + end do + + do i=i0,indtm + z(indorbp,i)=distp(i,1)*r(i)**2 + end do + + if(typec.ne.1) then + fun=(2.d0-dd1*r(0))*distp(0,1) + fun2=(2.d0-4*dd1*r(0)+(dd1*r(0))**2)*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + + indorb=indorbp + indpar=indpar+1 + indshell=indshellp diff --git a/devel_tools/makefun_factory/orb_100.f90 b/devel_tools/makefun_factory/orb_100.f90 new file mode 100644 index 0000000..d8a6ccc --- /dev/null +++ b/devel_tools/makefun_factory/orb_100.f90 @@ -0,0 +1,37 @@ + ! 2s single gaussian + ! exp(-dd2*r^2) + + + dd2=dd(indpar+1) + + + indorbp=indorb+1 + indshellp=indshell+1 + do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)*r(k)) + end do + + ! if(iocc(indshellp).eq.1) then + do i=i0,indtm + z(indorbp,i)=distp(i,1) + end do + ! endif + + + if(typec.ne.1) then + fun=-dd2*distp(0,1)*2.d0 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*dd2*(-3.d0+2.d0*dd2*r(0)**2)* & + distp(0,1) + !endif for indt + end if + + indpar=indpar+1 + indshell=indshellp + indorb=indorbp + + + diff --git a/devel_tools/makefun_factory/orb_10000:11000.f90 b/devel_tools/makefun_factory/orb_10000:11000.f90 new file mode 100644 index 0000000..f899e5f --- /dev/null +++ b/devel_tools/makefun_factory/orb_10000:11000.f90 @@ -0,0 +1,2 @@ + ! Reserved for dummy orbitals + diff --git a/devel_tools/makefun_factory/orb_1000:1099.f90 b/devel_tools/makefun_factory/orb_1000:1099.f90 new file mode 100644 index 0000000..273c253 --- /dev/null +++ b/devel_tools/makefun_factory/orb_1000:1099.f90 @@ -0,0 +1,43 @@ +! s gaussian r**(2*npower)*exp(-alpha*r**2) + +npower=iopt-1000 + +indorbp=indorb+1 +indshellp=indshell+1 + +dd2=dd(indpar+1) +do k=indtmin,indtm + distp(k,1)=r(k)**(2*npower)*dexp(-dd2*r(k)**2) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1) +end do +! endif + + +if(typec.ne.1) then + + + rp1=r(0)**2 + fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 + fun2=(npower*(2.d0*npower-1.d0)- & + (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & + distp(0,1)*2.d0/rp1 + + ! if(iocc(indshellp).eq.1) then + do i=1,3 + z(indorbp,indt+i)=rmu(i,0)*fun + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + ! endif + + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshell+1 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_101.f90 b/devel_tools/makefun_factory/orb_101.f90 new file mode 100644 index 0000000..e61872b --- /dev/null +++ b/devel_tools/makefun_factory/orb_101.f90 @@ -0,0 +1,39 @@ + ! 2s without cusp condition + ! dd1*( dd3 +exp(-dd2*r^2)) + + + dd2=dd(indpar+1) + dd3=dd(indpar+2) + + indorbp=indorb+1 + indshellp=indshell+1 + do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)*r(k)) + end do + + ! if(iocc(indshellp).eq.1) then + do i=i0,indtm + z(indorbp,i)=distp(i,1)+dd3 + end do + ! endif + + + if(typec.ne.1) then + fun=-dd2*distp(0,1)*2.d0 + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*dd2*(-3.d0+2.d0*dd2*r(0)**2)* & + distp(0,1) + + + !endif for indt + end if + + indpar=indpar+2 + indshell=indshellp + indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_102.f90 b/devel_tools/makefun_factory/orb_102.f90 new file mode 100644 index 0000000..c0f72dd --- /dev/null +++ b/devel_tools/makefun_factory/orb_102.f90 @@ -0,0 +1,52 @@ + ! 2s double gaussian with constant + ! (dd3+ exp (-dd2 r^2)+dd4*exp(-dd5*r^2)) + + + + dd2=dd(indpar+1) + dd3=dd(indpar+2) + dd4=dd(indpar+3) + dd5=dd(indpar+4) + + indorbp=indorb+1 + indshellp=indshell+1 + do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)*r(k)) + distp(k,2)=dexp(-dd5*r(k)*r(k)) + end do + + ! if(iocc(indshellp).eq.1) then + do i=i0,indtm + z(indorbp,i)=(distp(i,1)+dd3+dd4*distp(i,2)) +! write(6,*) ' function inside = ',z(indorbp,i) +end do +! endif + + +if(typec.ne.1) then + fun=-2.d0*(dd2*distp(0,1)+dd5*dd4*distp(0,2)) + fun2=r(0)**2 + + ! write(6,*) ' fun inside = ',fun,fun2 + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*(dd2*(-3.d0+2.d0*dd2*fun2)* & + distp(0,1)+dd5*dd4*(-3.d0+2.d0*dd5*fun2)*distp(0,2)) + + ! write(6,*) ' lap 106 =',z(indorbp,indt+4) + + + ! stop + + !endif for indt +end if + +indpar=indpar+4 +indshell=indshellp +indorb=indorbp + + + diff --git a/devel_tools/makefun_factory/orb_103.f90 b/devel_tools/makefun_factory/orb_103.f90 new file mode 100644 index 0000000..6c91ea8 --- /dev/null +++ b/devel_tools/makefun_factory/orb_103.f90 @@ -0,0 +1,49 @@ +! 2p single gaussian + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)**2) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif +end do + + +if(typec.ne.1) then + fun0=distp(0,1) + fun=-dd2*distp(0,1)*2.d0 + fun2=2.d0*dd2*(-1.d0+2.d0*dd2*r(0)**2)* & + distp(0,1) + + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + end do + z(indorbp,indt+ic)=z(indorbp,indt+ic)+fun0 + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_104.f90 b/devel_tools/makefun_factory/orb_104.f90 new file mode 100644 index 0000000..f80b61e --- /dev/null +++ b/devel_tools/makefun_factory/orb_104.f90 @@ -0,0 +1,56 @@ +! 2p double gaussian +! dd1 * x_mu (exp(-dd2 r^2)+dd3 * exp(-dd4*r^2)) + + +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) + + +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)**2) + distp(k,2)=dexp(-dd4*r(k)**2) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*(distp(i,1)+dd3*distp(i,2)) + end do + ! endif +end do + + +if(typec.ne.1) then + fun0=(distp(0,1)+dd3*distp(0,2)) + fun=2.d0*(-dd2*distp(0,1) & + -dd4*dd3*distp(0,2)) + fun2=2.d0*(dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0,1) & + +dd4*dd3*(-1.d0+2.d0*dd4*r(0)**2)*distp(0,2)) + + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + + !endif for indt +end if + +indpar=indpar+3 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_105.f90 b/devel_tools/makefun_factory/orb_105.f90 new file mode 100644 index 0000000..011a2fc --- /dev/null +++ b/devel_tools/makefun_factory/orb_105.f90 @@ -0,0 +1,51 @@ +! 2s double gaussian without constant +! (exp (-dd2 r^2)+dd4*exp(-dd5*r^2)) + + + +! dd1=1.d0 +dd2=dd(indpar+1) +! dd3=dd(indpar+2) +! dd4=dd(indpar+3) +! dd5=dd(indpar+4) +dd4=dd(indpar+2) +dd5=dd(indpar+3) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)*r(k)) + distp(k,2)=dexp(-dd5*r(k)*r(k)) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1)+dd4*distp(i,2) +! write(6,*) ' function inside = ',z(indorbp,i) +end do +! endif + + +if(typec.ne.1) then + fun=-2.d0*(dd2*distp(0,1)+dd5*dd4*distp(0,2)) + fun2=r(0)**2 + + ! write(6,*) ' fun inside = ',fun,fun2 + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*(dd2*(-3.d0+2.d0*dd2*fun2)* & + distp(0,1)+dd5*dd4*(-3.d0+2.d0*dd5*fun2)*distp(0,2)) + + + + + !endif for indt +end if + +indpar=indpar+3 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_106.f90 b/devel_tools/makefun_factory/orb_106.f90 new file mode 100644 index 0000000..b2668ea --- /dev/null +++ b/devel_tools/makefun_factory/orb_106.f90 @@ -0,0 +1,38 @@ +! 2s without cusp condition +! dd1*( dd3 +1/(1+dd2*r^2)) + + +dd2=dd(indpar+1) +dd3=dd(indpar+2) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=1.d0/(1.d0+dd2*r(k)*r(k)) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1)+dd3 +end do +! endif + + +if(typec.ne.1) then + fun=-dd2*distp(0,1)**2*2.d0 + fun2=fun*distp(0,1)*(1.-3.d0*dd2*r(0)**2) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=fun2+2.d0*fun + + + !endif for indt +end if + +indpar=indpar+2 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_107.f90 b/devel_tools/makefun_factory/orb_107.f90 new file mode 100644 index 0000000..0aa0349 --- /dev/null +++ b/devel_tools/makefun_factory/orb_107.f90 @@ -0,0 +1,50 @@ +! 2p single lorentian parent of 103 + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=1.d0/(1.d0+dd2*r(k)**2) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif +end do + + +if(typec.ne.1) then + fun0=distp(0,1) + fun=-dd2*distp(0,1)**2*2.d0 + fun2=fun*distp(0,1)*(1.d0-3.d0*dd2*r(0)**2) + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_108.f90 b/devel_tools/makefun_factory/orb_108.f90 new file mode 100644 index 0000000..9e902ea --- /dev/null +++ b/devel_tools/makefun_factory/orb_108.f90 @@ -0,0 +1,48 @@ +! 2s double lorentian with constant parent of 102 +! (dd3+ L(dd2 r^2)+dd4*L(dd5*r^2)) ; L(x)=1/1+x^2 + + + +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) +dd5=dd(indpar+4) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=1.d0/(1.d0+dd2*r(k)*r(k)) + distp(k,2)=1.d0/(1.d0+dd5*r(k)*r(k)) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=(distp(i,1)+dd3+dd4*distp(i,2)) +! write(6,*) ' function inside = ',z(indorbp,i) +end do +! endif + + +if(typec.ne.1) then + fun=-2.d0*(dd2*distp(0,1)**2+dd5*dd4*distp(0,2)**2) + fun2=2.d0*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) & + +2.d0*dd5*dd4*distp(0,2)**3*(-1.d0+3.d0*dd5*r(0)**2) + + ! write(6,*) ' fun inside = ',fun,fun2 + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=fun2+2.d0*fun + + ! write(6,*) ' lap 106 =',z(indorbp,indt+4) + + !endif for indt +end if + +indpar=indpar+4 +indshell=indshellp +indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_109.f90 b/devel_tools/makefun_factory/orb_109.f90 new file mode 100644 index 0000000..88ce950 --- /dev/null +++ b/devel_tools/makefun_factory/orb_109.f90 @@ -0,0 +1,58 @@ +! 2p double Lorentian +! dd1 * x_mu (L(dd2 r^2)+dd3 * L(dd4*r^2)) ; L(x)=1/(1+x^2) + + + +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) + +do k=indtmin,indtm + distp(k,1)=1.d0/(1.d0+dd2*r(k)**2) + distp(k,2)=1.d0/(1.d0+dd4*r(k)**2) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*(distp(i,1)+dd3*distp(i,2)) + end do + ! endif +end do + + +if(typec.ne.1) then + fun0=distp(0,1)+dd3*distp(0,2) + + fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) + ! fun2=2.d0*(dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0,1) + ! 1+dd4*dd3*(-1.d0+2.d0*dd4*r(0)**2)*distp(0,2)) + + fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) & + +2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + + !endif for indt +end if + +indpar=indpar+3 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_11.f90 b/devel_tools/makefun_factory/orb_11.f90 new file mode 100644 index 0000000..2889c99 --- /dev/null +++ b/devel_tools/makefun_factory/orb_11.f90 @@ -0,0 +1,52 @@ + ! R(r)=r**2*(exp(-z1*r)+p*exp(-z2*r)) + + + + indshellp=indshell+1 + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + ! if(iflagnorm.gt.2) then + c=1.d0/2.d0/dsqrt(pi*720.d0*(1.d0/(2.d0*dd1)**7+ & + 2.d0*peff/(dd1+dd2)**7+peff**2/(2.d0*dd2)**7)) + ! endif + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + end do + + do i=i0,indtm + z(indorbp,i)=(distp(i,1)+peff*distp(i,2))*r(i)**2 + end do + + if(typec.ne.1) then + rp1=r(0)**2 + ! the first derivative + fun=distp(0,1)*(2.d0*r(0)-dd1*rp1) & + +peff*distp(0,2)*(2.d0*r(0)-dd2*rp1) + ! + ! the second derivative + fun2=distp(0,1)*(2.d0-4.d0*dd1*r(0)+dd1**2*rp1) & + +peff*distp(0,2)*(2.d0-4.d0*dd2*r(0)+dd2**2*rp1) + ! + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0)/r(0) + end do + + z(indorbp,indt+4)=2.d0*fun/r(0)+fun2 + + end if + + indorb=indorbp + + ! endif + indpar=indpar+3 + indshell=indshellp + + + ! 4s single zeta diff --git a/devel_tools/makefun_factory/orb_110.f90 b/devel_tools/makefun_factory/orb_110.f90 new file mode 100644 index 0000000..b037462 --- /dev/null +++ b/devel_tools/makefun_factory/orb_110.f90 @@ -0,0 +1,38 @@ +! 2s without cusp condition +! dd1*( dd3 +1/(1+dd2*r^3)) + + +dd2=dd(indpar+1) +dd3=dd(indpar+2) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=1.d0/(1.d0+dd2*r(k)**3) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1)+dd3 +end do +! endif + + +if(typec.ne.1) then + fun=-dd2*distp(0,1)**2*3.d0*r(0) + fun2=fun*distp(0,1)*(2.d0-4.d0*dd2*r(0)**3) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=fun2+2.d0*fun + + + !endif for indt +end if + +indpar=indpar+2 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_1100:1199.f90 b/devel_tools/makefun_factory/orb_1100:1199.f90 new file mode 100644 index 0000000..d5525e8 --- /dev/null +++ b/devel_tools/makefun_factory/orb_1100:1199.f90 @@ -0,0 +1,53 @@ +! p gaussian r**(2*npower)*exp(-alpha*r**2) + +npower=iopt-1100 + +! indorbp=indorb + +dd2=dd(indpar+1) +do k=indtmin,indtm + distp(k,1)=r(k)**(2*npower)*dexp(-dd2*r(k)**2) +end do + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif +end do + + +if(typec.ne.1) then + + + rp1=r(0)**2 + fun0=distp(0,1) + fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 + fun2=(npower*(2.d0*npower-1.d0)- & + (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & + distp(0,1)*2.d0/rp1 + + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)*fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + ! endif + end do + + + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_111.f90 b/devel_tools/makefun_factory/orb_111.f90 new file mode 100644 index 0000000..f8b4ef7 --- /dev/null +++ b/devel_tools/makefun_factory/orb_111.f90 @@ -0,0 +1,49 @@ +! 2p single r_mu/(1+b r^3) parent of 103 + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=1.d0/(1.d0+dd2*r(k)**3) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif +end do + + +if(typec.ne.1) then + fun0=distp(0,1) + fun=-dd2*distp(0,1)**2*3.d0*r(0) + fun2=fun*distp(0,1)*(2.d0-4.d0*dd2*r(0)**3) + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp diff --git a/devel_tools/makefun_factory/orb_112.f90 b/devel_tools/makefun_factory/orb_112.f90 new file mode 100644 index 0000000..2764585 --- /dev/null +++ b/devel_tools/makefun_factory/orb_112.f90 @@ -0,0 +1,51 @@ +! 2p single r_mu/(1+b r)^3 parent of 103 + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=1.d0/(1.d0+dd2*r(k))**3 +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif +end do + + + +if(typec.ne.1) then + + fun0=distp(0,1) + fun=-3.d0*dd2*distp(0,1)/(r(0)*(1.d0+dd2*r(0))) + fun2=12.d0*dd2**2/(1.+dd2*r(0))**5 + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_113.f90 b/devel_tools/makefun_factory/orb_113.f90 new file mode 100644 index 0000000..d756d5b --- /dev/null +++ b/devel_tools/makefun_factory/orb_113.f90 @@ -0,0 +1,38 @@ +! 2s without cusp condition +! dd1*( dd3 +r^2/(1+dd2*r)^4) + + +dd2=dd(indpar+1) +dd3=dd(indpar+2) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=r(k)**2/(1.d0+dd2*r(k))**4 +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1)+dd3 +end do +! endif + + +if(typec.ne.1) then + fun= (2.d0-2.d0*dd2*r(0))/(1+dd2*r(0))**5 + fun2=2.d0*(1.d0-6.d0*dd2*r(0)+3.d0*(dd2*r(0))**2) & + /(1+dd2*r(0))**6 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=fun2+2.d0*fun + + + !endif for indt +end if + +indpar=indpar+2 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_114.f90 b/devel_tools/makefun_factory/orb_114.f90 new file mode 100644 index 0000000..afcd2ba --- /dev/null +++ b/devel_tools/makefun_factory/orb_114.f90 @@ -0,0 +1,38 @@ +! 2s without cusp condition +! dd1*( dd3 +r^2/(1+dd2*r)^3) + + +dd2=dd(indpar+1) +dd3=dd(indpar+2) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=r(k)**2/(1.d0+dd2*r(k))**3 +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1)+dd3 +end do +! endif + + +if(typec.ne.1) then + fun= (2.d0-dd2*r(0))/(1+dd2*r(0))**4 + fun2=2.d0*(1.d0-4.d0*dd2*r(0)+(dd2*r(0))**2) & + /(1+dd2*r(0))**5 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=fun2+2.d0*fun + + + !endif for indt +end if + +indpar=indpar+2 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_115.f90 b/devel_tools/makefun_factory/orb_115.f90 new file mode 100644 index 0000000..0c00200 --- /dev/null +++ b/devel_tools/makefun_factory/orb_115.f90 @@ -0,0 +1,52 @@ +! 2s double lorentian with constant parent of 102 +! (dd3+ r^2/(1+dd2*r)^3+dd4*r^3/(1+dd5*r)^4; + + + +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) +dd5=dd(indpar+4) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=r(k)**2/(1.d0+dd2*r(k))**3 + distp(k,2)=r(k)**3/(1.d0+dd5*r(k))**4 +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=(distp(i,1)+dd3+dd4*distp(i,2)) +! write(6,*) ' function inside = ',z(indorbp,i) +end do +! endif + + +if(typec.ne.1) then + + fun= (2.d0-dd2*r(0))/(1+dd2*r(0))**4 & + -dd4*r(0)*(-3.d0+dd5*r(0))/(1.d0+dd5*r(0))**5 + fun2=2.d0*(1.d0-4.d0*dd2*r(0)+(dd2*r(0))**2) & + /(1+dd2*r(0))**5 & + +dd4*2.d0*r(0)*(3.d0-6.d0*dd5*r(0)+(dd5*r(0))**2) & + /(1.d0+dd5*r(0))**6 + + + ! write(6,*) ' fun inside = ',fun,fun2 + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=fun2+2.d0*fun + + ! write(6,*) ' lap 106 =',z(indorbp,indt+4) + + !endif for indt +end if + +indpar=indpar+4 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_116.f90 b/devel_tools/makefun_factory/orb_116.f90 new file mode 100644 index 0000000..e5f3f4a --- /dev/null +++ b/devel_tools/makefun_factory/orb_116.f90 @@ -0,0 +1,66 @@ +! 2p double Lorentian +! dd1 * x_mu (L^3(dd2 r)+dd3 r * L(dd4*r)^4) ; L(x)=1/(1+x) + + + +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) + +do k=indtmin,indtm + distp(k,1)=1.d0/(1.d0+dd2*r(k))**3 + distp(k,2)=r(k)/(1.d0+dd4*r(k))**4 +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*(distp(i,1)+dd3*distp(i,2)) + end do + ! endif +end do + + +if(typec.ne.1) then + + + fun0=distp(0,1)+dd3*distp(0,2) + fun=-3.d0*dd2*distp(0,1)/(r(0)*(1.d0+dd2*r(0))) & + +dd3*distp(0,2)/r(0)**2*(1.d0-3*dd4*r(0)) & + /(1.d0+dd4*r(0)) + fun2=12.d0*dd2**2/(1.+dd2*r(0))**5 & + +dd3*4.d0*dd4*(-2.d0+3.d0*dd4*r(0))/(1.+dd4*r(0))**6 + + ! fun0=distp(0,1)+dd3*distp(0,2) + ! fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) + + ! fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) + ! 1+2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + + + + !endif for indt +end if + +indpar=indpar+3 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_117.f90 b/devel_tools/makefun_factory/orb_117.f90 new file mode 100644 index 0000000..7b06b8c --- /dev/null +++ b/devel_tools/makefun_factory/orb_117.f90 @@ -0,0 +1,48 @@ +! 2s double lorentian with constant parent of 102 +! (dd3+r^3/(1+dd5*r)^4; + + + +dd3=dd(indpar+1) +dd5=dd(indpar+2) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=r(k)**3/(1.d0+dd5*r(k))**4 +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=dd3+distp(i,1) +! write(6,*) ' function inside = ',z(indorbp,i) +end do +! endif + + +if(typec.ne.1) then + + fun= & + -r(0)*(-3.d0+dd5*r(0))/(1.d0+dd5*r(0))**5 + fun2= & + +2.d0*r(0)*(3.d0-6.d0*dd5*r(0)+(dd5*r(0))**2) & + /(1.d0+dd5*r(0))**6 + + + ! write(6,*) ' fun inside = ',fun,fun2 + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=fun2+2.d0*fun + + ! write(6,*) ' lap 106 =',z(indorbp,indt+4) + + !endif for indt +end if + +indpar=indpar+2 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_118.f90 b/devel_tools/makefun_factory/orb_118.f90 new file mode 100644 index 0000000..544453b --- /dev/null +++ b/devel_tools/makefun_factory/orb_118.f90 @@ -0,0 +1,52 @@ +! 2s double lorentian with constant parent of 102 +! (dd1+ 1/ (1 + Exp[ dd2 (r^2 - r_0^2) ] ) | dd3=r_0 +! Fermi distribution with r^2 + + +dd1=dd(indpar+1) +dd2=dd(indpar+2) +dd3=-dd2*dd(indpar+3)**2 + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + arg=dd2*r(k)**2+dd3 + if(arg.gt.200) then + distp(k,1)=dexp(200.d0) + else + distp(k,1)=dexp(arg) + end if +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=dd1+1.d0/(1.d0+distp(i,1)) +! write(6,*) ' function inside = ',z(indorbp,i) +end do +! endif + + +if(typec.ne.1) then + + fun= -2.d0*dd2*distp(0,1)/(1.d0+distp(0,1))**2 + fun2=-2.d0*dd2*(-distp(0,1)*(-1.d0-2.d0*dd2*r(0)**2) & + +distp(0,1)**2*(1.d0-2.d0*dd2*r(0)**2))/(1.d0+distp(0,1))**3 + + + ! write(6,*) ' fun inside = ',fun,fun2 + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=fun2+2.d0*fun + + ! write(6,*) ' lap 106 =',z(indorbp,indt+4) + + !endif for indt +end if + +indpar=indpar+3 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_119.f90 b/devel_tools/makefun_factory/orb_119.f90 new file mode 100644 index 0000000..133eb13 --- /dev/null +++ b/devel_tools/makefun_factory/orb_119.f90 @@ -0,0 +1,52 @@ +! 2p single r_mu/(1+b r^2)^(3/2) parent of 103 + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=1.d0/(1.d0+dd2*r(k)**2)**1.5d0 +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif +end do + + + +if(typec.ne.1) then + + fun0=distp(0,1) + fun=-3.d0*dd2*distp(0,1)/(1.d0+dd2*r(0)**2) + fun2=3.d0*dd2*(-1.d0+4.d0*dd2*r(0)**2) & + /(1.d0+dd2*r(0)**2)**3.5d0 + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_12.f90 b/devel_tools/makefun_factory/orb_12.f90 new file mode 100644 index 0000000..bd4c737 --- /dev/null +++ b/devel_tools/makefun_factory/orb_12.f90 @@ -0,0 +1,50 @@ + ! R(r)=r**3*exp(-z1*r) + ! + indshellp=indshell+1 + + + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 + c=dd1**4.5d0*.03178848180059307346d0 + ! endif + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + end do + + do i=i0,indtm + z(indorbp,i)=distp(i,1)*r(i)**3 + end do + + if(typec.ne.1) then + rp1=r(0)**3 + rp2=r(0)**2 + ! + !c the first derivative + fun=distp(0,1)*(3.d0*rp2-dd1*rp1) + !c + !c the second derivative + fun2=distp(0,1)*(6.d0*r(0)-6.d0*dd1*rp2+dd1**2*rp1) + !c + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0)/r(0) + end do + + z(indorbp,indt+4)=2.d0*fun/r(0)+fun2 + + end if + ! + indorb=indorbp + ! + ! endif + indpar=indpar+1 + indshell=indshellp + ! + + + ! 4s double zeta diff --git a/devel_tools/makefun_factory/orb_120.f90 b/devel_tools/makefun_factory/orb_120.f90 new file mode 100644 index 0000000..fd62a42 --- /dev/null +++ b/devel_tools/makefun_factory/orb_120.f90 @@ -0,0 +1,63 @@ +! 2p double cubic +! dd1 * x_mu (L^3(dd2 r)+dd3 L(dd4*r)^3) ; L(x)=1/(1+x) + + + +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) + +do k=indtmin,indtm + distp(k,1)=1.d0/(1.d0+dd2*r(k))**3 + distp(k,2)=1.d0/(1.d0+dd4*r(k))**3 +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*(distp(i,1)+dd3*distp(i,2)) + end do + ! endif +end do + + +if(typec.ne.1) then + + + fun0=distp(0,1)+dd3*distp(0,2) + fun=-3.d0*dd2*distp(0,1)/(r(0)*(1.d0+dd2*r(0))) & + -3.d0*dd4*dd3*distp(0,2)/(r(0)*(1.d0+dd4*r(0))) + fun2=12.d0*dd2**2/(1.+dd2*r(0))**5 & + +12.d0*dd3*dd4**2/(1.+dd4*r(0))**5 + + ! fun0=distp(0,1)+dd3*distp(0,2) + ! fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) + + ! fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) + ! 1+2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + + !endif for indt +end if + +indpar=indpar+3 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_1200:1299.f90 b/devel_tools/makefun_factory/orb_1200:1299.f90 new file mode 100644 index 0000000..592fa25 --- /dev/null +++ b/devel_tools/makefun_factory/orb_1200:1299.f90 @@ -0,0 +1,107 @@ +! d gaussian r**(2*npower)*exp(-alpha*r**2) + +npower=iopt-1200 + +! indorbp=indorb + +dd2=dd(indpar+1) +do k=indtmin,indtm + distp(k,1)=r(k)**(2*npower)*dexp(-dd2*r(k)**2) +end do + +do i=indtmin,indtm + distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d + distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d + distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d +end do + +do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=distp(i,1+ic)*distp(i,1) + end do + ! endif +end do + +if(typec.ne.1) then + + + rp1=r(0)**2 + fun0=distp(0,1) + fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 + fun2=(npower*(2.d0*npower-1.d0)- & + (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & + distp(0,1)*2.d0/rp1 + + + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshell+5 +indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_121.f90 b/devel_tools/makefun_factory/orb_121.f90 new file mode 100644 index 0000000..8c4a813 --- /dev/null +++ b/devel_tools/makefun_factory/orb_121.f90 @@ -0,0 +1,52 @@ +! 2p single exponential + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif +end do + + +if(typec.ne.1) then + + + fun0=distp(0,1) + fun=-dd2*distp(0,1)/r(0) + fun2=dd2**2*distp(0,1) + + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + + + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_122.f90 b/devel_tools/makefun_factory/orb_122.f90 new file mode 100644 index 0000000..6b55e6e --- /dev/null +++ b/devel_tools/makefun_factory/orb_122.f90 @@ -0,0 +1,34 @@ +! 2s with cusp condition +! dd1*( dd3 +exp(-dd2*r)*(1+dd2*r)) + + +dd2=dd(indpar+1) +dd3=dd(indpar+2) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1)*(1.d0+dd2*r(i))+dd3 +end do +! endif + + +if(typec.ne.1) then + fun=-dd2**2*distp(0,1) + fun2=fun*(1.d0-dd2*r(0)) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if + +indpar=indpar+2 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_123.f90 b/devel_tools/makefun_factory/orb_123.f90 new file mode 100644 index 0000000..ef0c1db --- /dev/null +++ b/devel_tools/makefun_factory/orb_123.f90 @@ -0,0 +1,57 @@ +! 2p double exp +! dd1 * x_mu (exp(-dd2 r)+dd3 * exp(-dd4*r)) + + +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) + + +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)) + distp(k,2)=dexp(-dd4*r(k)) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*(distp(i,1)+dd3*distp(i,2)) + end do + ! endif +end do + + +if(typec.ne.1) then + + fun0=distp(0,1)+dd3*distp(0,2) + fun=-(dd2*distp(0,1)+dd3*dd4*distp(0,2))/r(0) + fun2=dd2**2*distp(0,1)+dd3*dd4**2*distp(0,2) + + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + + + + !endif for indt +end if + +indpar=indpar+3 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_124.f90 b/devel_tools/makefun_factory/orb_124.f90 new file mode 100644 index 0000000..10894fa --- /dev/null +++ b/devel_tools/makefun_factory/orb_124.f90 @@ -0,0 +1,49 @@ +! 2s double exp with constant and cusp cond. +! (dd3+ exp (-dd2 r)*(1+dd2*r)+dd4*exp(-dd5*r)*(1+dd5*r)) + + + +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) +dd5=dd(indpar+4) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,3)=dexp(-dd2*r(k)) + distp(k,4)=dexp(-dd5*r(k)) + distp(k,1)=distp(k,3)*(1.d0+dd2*r(k)) + distp(k,2)=distp(k,4)*(1.d0+dd5*r(k)) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1)+dd3+dd4*distp(i,2) +! write(6,*) ' function inside = ',z(indorbp,i) +end do +! endif + + +if(typec.ne.1) then + + fun=-dd2**2*distp(0,3)-dd5**2*dd4*distp(0,4) + fun2=-dd2**2*distp(0,3)*(1.d0-dd2*r(0)) & + -dd4*dd5**2*distp(0,4)*(1.d0-dd5*r(0)) + + + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + + !endif for indt +end if + +indpar=indpar+4 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_125.f90 b/devel_tools/makefun_factory/orb_125.f90 new file mode 100644 index 0000000..af3d041 --- /dev/null +++ b/devel_tools/makefun_factory/orb_125.f90 @@ -0,0 +1,41 @@ +! 2s with cusp condition +! dd1*( dd3 +exp(-dd2*r)) ! with no cusp condition + + +dd2=dd(indpar+1) +dd3=dd(indpar+2) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1)+dd3 +end do +! endif + + +if(typec.ne.1) then + fun=-dd2*distp(0,1)/r(0) + fun2=dd2**2*distp(0,1) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + + + + + !endif for indt +end if + +indpar=indpar+2 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_126.f90 b/devel_tools/makefun_factory/orb_126.f90 new file mode 100644 index 0000000..0c8c8fa --- /dev/null +++ b/devel_tools/makefun_factory/orb_126.f90 @@ -0,0 +1,48 @@ +! 2s double exp with constant +! (dd3+ exp (-dd2 r)+dd4*exp(-dd5*r)) + + + +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) +dd5=dd(indpar+4) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)) + distp(k,2)=dexp(-dd5*r(k)) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1)+dd3+dd4*distp(i,2) +! write(6,*) ' function inside = ',z(indorbp,i) +end do +! endif + + +if(typec.ne.1) then + + + fun=-(dd2*distp(0,1)+dd5*dd4*distp(0,2))/r(0) + fun2=dd2**2*distp(0,1)+dd4*dd5**2*distp(0,2) + + + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + + + !endif for indt +end if + +indpar=indpar+4 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_127.f90 b/devel_tools/makefun_factory/orb_127.f90 new file mode 100644 index 0000000..43632d9 --- /dev/null +++ b/devel_tools/makefun_factory/orb_127.f90 @@ -0,0 +1,101 @@ +! 3d without cusp and one parmater + + +dd1=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)) +end do + +do i=indtmin,indtm + distp(i,3)=distp(i,1) + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d +end do + +! indorbp=indorb + +do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif +end do + +if(typec.ne.1) then + fun0=distp(0,3) + fun=-dd1*distp(0,1) + fun2=dd1**2*distp(0,1) + + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + + !endif for indt +end if +! +indpar=indpar+1 +indshell=indshell+5 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_128.f90 b/devel_tools/makefun_factory/orb_128.f90 new file mode 100644 index 0000000..771da5f --- /dev/null +++ b/devel_tools/makefun_factory/orb_128.f90 @@ -0,0 +1,36 @@ +! 2s with cusp condition +! ( r^2*exp(-dd2*r)) ! with no cusp condition + + +dd2=dd(indpar+1) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1)*r(i)**2 +end do +! endif + + +if(typec.ne.1) then + fun=(2.d0-dd2*r(0))*distp(0,1) + fun2=(2.d0-4*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_129.f90 b/devel_tools/makefun_factory/orb_129.f90 new file mode 100644 index 0000000..80583ef --- /dev/null +++ b/devel_tools/makefun_factory/orb_129.f90 @@ -0,0 +1,46 @@ +! 2p single exponential r e^{-z r} ! parent of 121 + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i) + end do + ! endif +end do + + +if(typec.ne.1) then + + fun0=distp(0,1)*r(0) + fun=distp(0,1)*(1.d0-dd2*r(0))/r(0) + fun2=dd2*(dd2*r(0)-2.d0)*distp(0,1) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_13.f90 b/devel_tools/makefun_factory/orb_13.f90 new file mode 100644 index 0000000..0c4abb9 --- /dev/null +++ b/devel_tools/makefun_factory/orb_13.f90 @@ -0,0 +1,54 @@ + ! R(r)=r**3*(exp(-z1*r)+z3*exp(-z2*r)) + ! + indshellp=indshell+1 + + ! + ! + ! if(iocc(indshellp).eq.1) then + ! + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + dd3=dd(indpar+3) + ! if(iflagnorm.gt.2) then + c=1.d0/2.d0/dsqrt(pi*40320.d0*(1.d0/(2.d0*dd1)**9+ & + 2.d0*dd3/(dd1+dd2)**9+dd3**2/(2.d0*dd2)**9)) + ! endif + + ! + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + end do + + do i=i0,indtm + z(indorbp,i)=(distp(i,1)+dd3*distp(i,2))*r(i)**3 + end do + ! + if(typec.ne.1) then + rp1=r(0)**3 + rp2=r(0)**2 + ! + !c the first derivative + fun=distp(0,1)*(3.d0*rp2-dd1*rp1) & + +dd3*distp(0,2)*(3.d0*rp2-dd2*rp1) + !c + ! the second derivative + fun2=distp(0,1)*(6.d0*r(0)-6.d0*dd1*rp2+dd1**2*rp1) & + +dd3*distp(0,2)*(6.d0*r(0)-6.d0*dd2*rp2+dd2**2*rp1) + !c + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0)/r(0) + end do + ! + z(indorbp,indt+4)=2.d0*fun/r(0)+fun2 + ! + end if + + indorb=indorbp + + ! endif + indpar=indpar+3 + indshell=indshellp + + ! 1s single Z pseudo diff --git a/devel_tools/makefun_factory/orb_130.f90 b/devel_tools/makefun_factory/orb_130.f90 new file mode 100644 index 0000000..23707fd --- /dev/null +++ b/devel_tools/makefun_factory/orb_130.f90 @@ -0,0 +1,46 @@ +! 2p single exponential r^2 e^{-z r} ! parent of 121 + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**2 + end do + ! endif +end do + + +if(typec.ne.1) then + + fun0=distp(0,1)*r(0)**2 + fun=distp(0,1)*(2.d0-dd2*r(0)) + fun2=(2.d0-4.d0*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_131.f90 b/devel_tools/makefun_factory/orb_131.f90 new file mode 100644 index 0000000..897da24 --- /dev/null +++ b/devel_tools/makefun_factory/orb_131.f90 @@ -0,0 +1,38 @@ +! 2s without cusp condition +! dd1*(r^2*exp(-dd2*r^2)) + + +dd2=dd(indpar+1) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)*r(k)) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1)*r(i)**2 +end do +! endif + + +if(typec.ne.1) then + fun0=dd2*r(0)**2 + fun=2.d0*distp(0,1)*(1.d0-fun0) + fun2=2.d0*distp(0,1)*(1.d0-5.d0*fun0+2.d0*fun0**2) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_132.f90 b/devel_tools/makefun_factory/orb_132.f90 new file mode 100644 index 0000000..749ad5b --- /dev/null +++ b/devel_tools/makefun_factory/orb_132.f90 @@ -0,0 +1,37 @@ +! 2s with cusp condition +! ( r^3*exp(-dd2*r)) ! with no cusp condition + + +dd2=dd(indpar+1) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k))*r(k) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1)*r(i)**2 +end do +! endif + + +if(typec.ne.1) then + fun=(3.d0-dd2*r(0))*distp(0,1) + fun2=(6.d0-6*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshellp +indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_133.f90 b/devel_tools/makefun_factory/orb_133.f90 new file mode 100644 index 0000000..8c55250 --- /dev/null +++ b/devel_tools/makefun_factory/orb_133.f90 @@ -0,0 +1,100 @@ +! 4d one parmater + + +dd1=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)) +end do + +do i=indtmin,indtm + distp(i,3)=distp(i,1)*r(i) + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d +end do + +! indorbp=indorb + +do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif +end do + +if(typec.ne.1) then + fun0=distp(0,3) + fun=(1.d0-dd1*r(0))*distp(0,1) + fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) + + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + !endif for indt +end if +! +indpar=indpar+1 +indshell=indshell+5 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_134.f90 b/devel_tools/makefun_factory/orb_134.f90 new file mode 100644 index 0000000..4fb2e24 --- /dev/null +++ b/devel_tools/makefun_factory/orb_134.f90 @@ -0,0 +1,49 @@ +! 2p single exponential r^3 e^{-z r} ! + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**3 + end do + ! endif +end do + +if(typec.ne.1) then + + fun0=distp(0,1)*r(0)**3 + fun=distp(0,1)*(3.d0-dd2*r(0))*r(0) + ! fun= derivative of fun0 respect to r divided dy r + fun2=distp(0,1)*(dd2**2*r(0)**3-6*dd2*r(0)**2 & + +6*r(0)) + ! fun2= second derivative of fun0 respect to r + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_135.f90 b/devel_tools/makefun_factory/orb_135.f90 new file mode 100644 index 0000000..e8fbca9 --- /dev/null +++ b/devel_tools/makefun_factory/orb_135.f90 @@ -0,0 +1,47 @@ +! 2p single exponential r^4 e^{-z r} ! + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**4 + end do + ! endif +end do + +if(typec.ne.1) then + + fun0=distp(0,1)*r(0)**4 + fun=distp(0,1)*(4.d0-dd2*r(0))*r(0)**2 + fun2=distp(0,1)*(12*r(0)**2-8*dd2*r(0)**3 & + +dd2**2*r(0)**4) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_136.f90 b/devel_tools/makefun_factory/orb_136.f90 new file mode 100644 index 0000000..ba7a896 --- /dev/null +++ b/devel_tools/makefun_factory/orb_136.f90 @@ -0,0 +1,46 @@ +! 2p single exponential r^5 e^{-z r} ! + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**5 + end do + ! endif +end do + +if(typec.ne.1) then + + fun0=distp(0,1)*r(0)**5 + fun=distp(0,1)*(5.d0-dd2*r(0))*r(0)**3 + fun2=distp(0,1)*(20*r(0)**3-10*dd2*r(0)**4 & + +dd2**2*r(0)**5) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_137.f90 b/devel_tools/makefun_factory/orb_137.f90 new file mode 100644 index 0000000..cf21f51 --- /dev/null +++ b/devel_tools/makefun_factory/orb_137.f90 @@ -0,0 +1,43 @@ +! 2s with cusp condition +! dd1*(exp(-dd2*r)*(1+dd2*r)) + + +dd2=dd(indpar+1) + +! if(iflagnorm.gt.2) then +! c=1.d0/dsqrt(1/4.d0/dd2**3+12*dd2/(2.d0*dd2)**4+ +! &3*dd2**2/4/dd2**5)/dsqrt(4.0*pi) + ! endif + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1)*(1.d0+dd2*r(i)) +end do +! endif + + +if(typec.ne.1) then + fun=-dd2**2*distp(0,1) + fun2=fun*(1.d0-dd2*r(0)) + + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_138.f90 b/devel_tools/makefun_factory/orb_138.f90 new file mode 100644 index 0000000..40de02a --- /dev/null +++ b/devel_tools/makefun_factory/orb_138.f90 @@ -0,0 +1,36 @@ +! 2s with cusp condition +! ( -dd2*r^2*exp(-dd2*r)) ! with no cusp condition der of 137 + + +dd2=dd(indpar+1) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=-dd2*dexp(-dd2*r(k)) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1)*r(i)**2 +end do +! endif + + +if(typec.ne.1) then + fun=(2.d0-dd2*r(0))*distp(0,1) + fun2=(2.d0-4*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_139.f90 b/devel_tools/makefun_factory/orb_139.f90 new file mode 100644 index 0000000..8ffc4b2 --- /dev/null +++ b/devel_tools/makefun_factory/orb_139.f90 @@ -0,0 +1,37 @@ +! 2s with cusp condition +! ( r^3*exp(-dd2*r)) ! der of 128 + + +dd2=dd(indpar+1) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=-dexp(-dd2*r(k))*r(k) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1)*r(i)**2 +end do +! endif + + +if(typec.ne.1) then + fun=(3.d0-dd2*r(0))*distp(0,1) + fun2=(6.d0-6*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshellp +indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_14.f90 b/devel_tools/makefun_factory/orb_14.f90 new file mode 100644 index 0000000..23fb46c --- /dev/null +++ b/devel_tools/makefun_factory/orb_14.f90 @@ -0,0 +1,42 @@ + ! (1.d0 + dd1 r) * exp(-dd1 * r) ! normalized + + + indshellp=indshell+1 + + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + + do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)) + end do + + ! if(iflagnorm.gt.2) then + ! c=dsqrt(dd1**3.d0/7.d0/pi) + c=dd1**1.5d0*0.213243618622923d0 + ! endif + + do i=i0,indtm + z(indorbp,i)=c*(1.d0+dd1*r(i))*distp(i,1) + end do + + if(typec.ne.1) then + fun=-distp(0,1)*dd1**2*r(0) + fun2=-distp(0,1)*dd1**2*(1.d0-dd1*r(0)) + do i=1,3 + z(indorbp,indt+i)=c*fun*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=c*2.d0*fun/r(0)+c*fun2 + end if + + indorb=indorbp + + ! endif + indpar=indpar+1 + indshell=indshellp + + + + ! 1s single Z pseudo diff --git a/devel_tools/makefun_factory/orb_140.f90 b/devel_tools/makefun_factory/orb_140.f90 new file mode 100644 index 0000000..0da5a4b --- /dev/null +++ b/devel_tools/makefun_factory/orb_140.f90 @@ -0,0 +1,46 @@ +! 2p single exponential -r e^{-z r} ! der of 121 + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=-dexp(-dd2*r(k)) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i) + end do + ! endif +end do + + +if(typec.ne.1) then + + fun0=distp(0,1)*r(0) + fun=distp(0,1)*(1.d0-dd2*r(0))/r(0) + fun2=dd2*(dd2*r(0)-2.d0)*distp(0,1) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_141.f90 b/devel_tools/makefun_factory/orb_141.f90 new file mode 100644 index 0000000..c5181f1 --- /dev/null +++ b/devel_tools/makefun_factory/orb_141.f90 @@ -0,0 +1,47 @@ +! 2p single exponential r^2 e^{-z r} ! parent of 121 + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=-dexp(-dd2*r(k)) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**2 + end do + ! endif +end do + + +if(typec.ne.1) then + + fun0=distp(0,1)*r(0)**2 + fun=distp(0,1)*(2.d0-dd2*r(0)) + fun2=(2.d0-4.d0*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + +! der of 127 diff --git a/devel_tools/makefun_factory/orb_142.f90 b/devel_tools/makefun_factory/orb_142.f90 new file mode 100644 index 0000000..9b3c822 --- /dev/null +++ b/devel_tools/makefun_factory/orb_142.f90 @@ -0,0 +1,101 @@ +! 4d one parmater + + +dd1=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)) +end do + +do i=indtmin,indtm + distp(i,3)=distp(i,1)*r(i) + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d +end do + +! indorbp=indorb + +do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=-distp(i,3+ic)*distp(i,3) + end do + ! endif +end do + +if(typec.ne.1) then + fun0=-distp(0,3) + fun=-(1.d0-dd1*r(0))*distp(0,1) + fun2=-dd1*(dd1*r(0)-2.d0)*distp(0,1) + + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + + !endif for indt +end if +! +indpar=indpar+1 +indshell=indshell+5 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_143.f90 b/devel_tools/makefun_factory/orb_143.f90 new file mode 100644 index 0000000..9663f22 --- /dev/null +++ b/devel_tools/makefun_factory/orb_143.f90 @@ -0,0 +1,100 @@ +! 4d one parmater der of 133 + + +dd1=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)) +end do + +do i=indtmin,indtm + distp(i,3)=distp(i,1)*r(i)**2 + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d +end do + +! indorbp=indorb + +do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=-distp(i,3+ic)*distp(i,3) + end do + ! endif +end do + +if(typec.ne.1) then + fun0=-distp(0,3) + fun=-(-2.d0+dd1*r(0))*distp(0,1) + fun2=((dd1*r(0))**2 -4.d0*r(0)*dd1+2.d0)*distp(0,1) + + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + !endif for indt +end if +! +indpar=indpar+1 +indshell=indshell+5 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_144.f90 b/devel_tools/makefun_factory/orb_144.f90 new file mode 100644 index 0000000..4c9034e --- /dev/null +++ b/devel_tools/makefun_factory/orb_144.f90 @@ -0,0 +1,48 @@ +! 2p single exponential -r^3 e^{-z r} ! derivative of 130 + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=-dexp(-dd2*r(k)) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**3 + end do + ! endif +end do + +if(typec.ne.1) then + + fun0=distp(0,1)*r(0)**3 + fun=distp(0,1)*(3.d0-dd2*r(0))*r(0) + ! fun= derivative of fun0 respect to r divided dy r + fun2=distp(0,1)*(dd2**2*r(0)**3-6*dd2*r(0)**2 & + +6*r(0)) + ! fun2= second derivative of fun0 respect to r + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_145.f90 b/devel_tools/makefun_factory/orb_145.f90 new file mode 100644 index 0000000..d25558a --- /dev/null +++ b/devel_tools/makefun_factory/orb_145.f90 @@ -0,0 +1,38 @@ +! 2s without cusp condition !derivative 100 +! -(r^2*exp(-dd2*r^2)) + + +dd2=dd(indpar+1) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)*r(k)) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=-distp(i,1)*r(i)**2 +end do +! endif + + +if(typec.ne.1) then + fun0=dd2*r(0)**2 + fun=-2.d0*distp(0,1)*(1.d0-fun0) + fun2=-2.d0*distp(0,1)*(1.d0-5.d0*fun0+2.d0*fun0**2) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_146.f90 b/devel_tools/makefun_factory/orb_146.f90 new file mode 100644 index 0000000..2b55098 --- /dev/null +++ b/devel_tools/makefun_factory/orb_146.f90 @@ -0,0 +1,46 @@ +! 2p single exponential -r^2 e^{-z r^2} ! derivative of 103 + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)*r(k)) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=-rmu(ic,i)*distp(i,1)*r(i)*r(i) + end do + ! endif +end do + + +if(typec.ne.1) then + rp2=dd2*r(0)*r(0) + fun0=-distp(0,1)*r(0)*r(0) + fun=distp(0,1)*(-2.d0+2.d0*rp2) + fun2=(-2.d0+10.d0*rp2-4.d0*rp2*rp2)*distp(0,1) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_147.f90 b/devel_tools/makefun_factory/orb_147.f90 new file mode 100644 index 0000000..fd28b76 --- /dev/null +++ b/devel_tools/makefun_factory/orb_147.f90 @@ -0,0 +1,103 @@ +! 3d single gaussian + + +dd1=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)**2) +end do + +do i=indtmin,indtm + distp(i,3)=distp(i,1) + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d +end do + +! indorbp=indorb + +do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif +end do + +if(typec.ne.1) then + fun0=distp(0,3) + fun=-2.d0*dd1*distp(0,1) + fun2=((2.d0*dd1*r(0))**2-2.d0*dd1)*distp(0,1) + + ! indorbp=indorb + + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0)*fun + end do + if(ic.eq.1) then + ! if(i.ne.3) then + z(indorbp,indt+1)=z(indorbp,indt+1)- & + 2.d0*rmu(1,0)*fun0*cost1d + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 2.d0*rmu(2,0)*fun0*cost1d + ! else + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + 4.d0*rmu(3,0)*fun0*cost1d + ! endif + elseif(ic.eq.2) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 2.d0*rmu(1,0)*fun0*cost2d + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 2.d0*rmu(2,0)*fun0*cost2d + ! endif + elseif(ic.eq.3) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + rmu(2,0)*fun0*cost3d + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + rmu(1,0)*fun0*cost3d + ! endif + elseif(ic.eq.4) then + ! if(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + rmu(3,0)*fun0*cost3d + ! elseif(i.eq.3) then + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + rmu(2,0)*fun0*cost3d + ! endif + elseif(ic.eq.5) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + rmu(3,0)*fun0*cost3d + ! elseif(i.eq.3) then + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + rmu(1,0)*fun0*cost3d + !endif for i + ! endif + !endif for ic + end if + !enddo for i + ! enddo + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + !endif for indt +end if +! +indpar=indpar+1 +indshell=indshell+5 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_148.f90 b/devel_tools/makefun_factory/orb_148.f90 new file mode 100644 index 0000000..ffdb3fe --- /dev/null +++ b/devel_tools/makefun_factory/orb_148.f90 @@ -0,0 +1,102 @@ +! derivative of 147 with respect to dd1 + + +dd1=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)**2) +end do + +do i=indtmin,indtm + distp(i,3)=-r(i)**2*distp(i,1) + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d +end do + +! indorbp=indorb + +do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif +end do + +if(typec.ne.1) then + fun0=distp(0,3) + fun=2.d0*(dd1*r(0)**2-1.d0)*r(0)*distp(0,1) + fun2=-2.d0*(2.d0*dd1**2*r(0)**4+1.d0 & + -5.d0*dd1*r(0)**2)*distp(0,1) + + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + + !endif for indt +end if +! +indpar=indpar+1 +indshell=indshell+5 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_149.f90 b/devel_tools/makefun_factory/orb_149.f90 new file mode 100644 index 0000000..484c547 --- /dev/null +++ b/devel_tools/makefun_factory/orb_149.f90 @@ -0,0 +1,39 @@ +! derivative of 131 with respect z_1 +! - r^4 exp(-z_1 r^2) + + + +dd2=dd(indpar+1) + +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)*r(k)) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=-distp(i,1)*r(i)**4 +end do +! endif + + +if(typec.ne.1) then + fun0=dd2*r(0)**2 + fun=-2.d0*r(0)**2*distp(0,1)*(2.d0-fun0) + fun2=-2.d0*r(0)**2*distp(0,1)*(6.d0-9.d0*fun0+2.d0*fun0**2) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshellp +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_15.f90 b/devel_tools/makefun_factory/orb_15.f90 new file mode 100644 index 0000000..beafb32 --- /dev/null +++ b/devel_tools/makefun_factory/orb_15.f90 @@ -0,0 +1,44 @@ + ! (r**2 + dd2*(1 + dd1*r))*exp(-dd1*r) ! normalized + + + indshellp=indshell+1 + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + + c=dsqrt(2.d0*dd1**7/pi/ & + (45.d0+42.d0*dd1**2*dd2+14.d0*dd1**4*dd2**2)) + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + end do + + + do i=i0,indtm + z(indorbp,i)=(r(i)**2+dd2*(1.d0+dd1*r(i))) & + *distp(i,1) + end do + + if(typec.ne.1) then + + fun=distp(0,1)*r(0)*(2.d0-dd1**2*dd2-dd1*r(0)) + fun2=distp(0,1)*((1.d0-dd1*r(0)) & + *(3.d0-dd1**2*dd2-dd1*r(0))-1.d0) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=2.d0*fun/r(0)+fun2 + + end if + + indorb=indorbp + + ! endif + indpar=indpar+2 + indshell=indshellp + + ! 2s gaussian for pseudo diff --git a/devel_tools/makefun_factory/orb_150.f90 b/devel_tools/makefun_factory/orb_150.f90 new file mode 100644 index 0000000..c4592d2 --- /dev/null +++ b/devel_tools/makefun_factory/orb_150.f90 @@ -0,0 +1,47 @@ +! 2p single exponential r e^{-z r^2} + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)**2) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i) + end do + ! endif +end do + + +if(typec.ne.1) then + + fun0=distp(0,1)*r(0) + cost=2.d0*dd2*r(0)**2 + fun=distp(0,1)*(1.d0-cost)/r(0) + fun2=2.d0*dd2*fun0*(cost-3.d0) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_151.f90 b/devel_tools/makefun_factory/orb_151.f90 new file mode 100644 index 0000000..e3eff62 --- /dev/null +++ b/devel_tools/makefun_factory/orb_151.f90 @@ -0,0 +1,49 @@ +! 2p single exponential -r^3 e^{-z r^2} ! parent of 150 + + + +dd2=dd(indpar+1) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)**2) +end do + +! indorbp=indorb + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=-rmu(ic,i)*distp(i,1)*r(i)**3 + end do + ! endif +end do + + +if(typec.ne.1) then + + fun0=-distp(0,1)*r(0)**3 + cost=dd2*r(0)**2 + fun=distp(0,1)*(-3.d0+2.d0*cost)*r(0) + fun2=-2.d0*distp(0,1)*r(0)*(3.d0-7.d0*cost+2.d0*cost**2) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + + + diff --git a/devel_tools/makefun_factory/orb_152.f90 b/devel_tools/makefun_factory/orb_152.f90 new file mode 100644 index 0000000..cd3bf03 --- /dev/null +++ b/devel_tools/makefun_factory/orb_152.f90 @@ -0,0 +1,27 @@ +! 2s with cusp condition +! ( r^3*exp(-dd2*r^2)) ! with no cusp condition + +dd2=dd(indpar+1) +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)**2)*r(k) +end do +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1)*r(i)**2 +end do +! endif +if(typec.ne.1) then + rp1=r(0)**2*dd2 + fun=(3.d0-2.d0*rp1)*distp(0,1) + fun2=(6.d0-14.d0*rp1+4.d0*rp1**2)*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if +indpar=indpar+1 +indshell=indshellp +indorb=indorbp diff --git a/devel_tools/makefun_factory/orb_153.f90 b/devel_tools/makefun_factory/orb_153.f90 new file mode 100644 index 0000000..d6b423d --- /dev/null +++ b/devel_tools/makefun_factory/orb_153.f90 @@ -0,0 +1,29 @@ +! 2s with cusp condition +! (-r^5*exp(-dd2*r^2)) ! derivative of 152 + +dd2=dd(indpar+1) +indorbp=indorb+1 +indshellp=indshell+1 +do k=indtmin,indtm + distp(k,1)=dexp(-dd2*r(k)**2)*r(k)**3 +end do +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=-distp(i,1)*r(i)**2 +end do +! endif +if(typec.ne.1) then + rp1=dd2*r(0)**2 + fun=(-5.d0+2.d0*rp1)*distp(0,1) + fun2=(-20.d0+22.d0*rp1-4.d0*rp1**2)*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if +indpar=indpar+1 +indshell=indshellp +indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_154.f90 b/devel_tools/makefun_factory/orb_154.f90 new file mode 100644 index 0000000..0b42a0e --- /dev/null +++ b/devel_tools/makefun_factory/orb_154.f90 @@ -0,0 +1,128 @@ +! Jastrow single gaussian f orbital +! R(r)= exp(-alpha r^2) +! unnormalized + + +! indorbp=indorb +indparp=indpar+1 + +dd1=dd(indparp) + +do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)**2) +end do + + +do i=indtmin,indtm + distp(i,2)=cost1f*rmu(3,i) & + *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=0 + distp(i,3)=cost2f*rmu(1,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2f*rmu(2,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3f*rmu(3,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-2 + distp(i,6)=cost3f*2.d0*rmu(3,i) & + *rmu(1,i)*rmu(2,i) + ! lz=+/-2 + distp(i,7)=cost4f*rmu(1,i) & + *(rmu(1,i)**2-3.d0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4f*rmu(2,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 +end do + + +do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif +end do + + +if(typec.ne.1) then + + ! dd1=dd(indparp) + fun0=distp(0,1) + fun=-2.d0*dd1*distp(0,1) + fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + + + ! indorbp=indorb + + + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + end do + if(ic.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1)- & + 6.d0*cost1f*fun0*rmu(1,0)*rmu(3,0) + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 6.d0*cost1f*fun0*rmu(2,0)*rmu(3,0) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + cost1f*fun0*(9.d0*rmu(3,0)**2-3.d0*r(0)**2) + elseif(ic.eq.2) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2-2.d0*rmu(1,0)**2) + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 2.d0*cost2f*fun0*rmu(2,0)*rmu(1,0) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + 8.d0*cost2f*fun0*rmu(3,0)*rmu(1,0) + elseif(ic.eq.3) then + z(indorbp,indt+1)=z(indorbp,indt+1)- & + 2.d0*cost2f*fun0*rmu(1,0)*rmu(2,0) + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2-2.d0*rmu(2,0)**2) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + 8.d0*cost2f*fun0*rmu(3,0)*rmu(2,0) + elseif(ic.eq.4) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + elseif(ic.eq.5) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) + elseif(ic.eq.6) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + else + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt +end if + +indpar=indpar+1 +indshell=indshell+7 +indorb=indorbp + + + diff --git a/devel_tools/makefun_factory/orb_155.f90 b/devel_tools/makefun_factory/orb_155.f90 new file mode 100644 index 0000000..9e09c16 --- /dev/null +++ b/devel_tools/makefun_factory/orb_155.f90 @@ -0,0 +1,151 @@ +! Jastrow single gaussian f orbital +! derivative of 154 with respect to z +! unnormalized f orbitals +! R(r)= -r^2*exp(-z r^2) + + + +! indorbp=indorb +indparp=indpar+1 +dd1=dd(indparp) + + +do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)**2) +end do + + +do i=indtmin,indtm + distp(i,2)=cost1f*rmu(3,i) & + *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=0 + distp(i,3)=cost2f*rmu(1,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2f*rmu(2,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3f*rmu(3,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-2 + distp(i,6)=cost3f*2.d0*rmu(3,i) & + *rmu(1,i)*rmu(2,i) + ! lz=+/-2 + distp(i,7)=cost4f*rmu(1,i) & + *(rmu(1,i)**2-3.d0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4f*rmu(2,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 +end do + + +do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=-r(k)**2*distp(k,1)*distp(k,1+ic) + end do + ! endif +end do + + +if(typec.ne.1) then + + dd1=dd(indparp) + fun0=-r(0)**2*distp(0,1) + fun=2.d0*(dd1*r(0)**2-1.d0)*distp(0,1) + fun2=-2.d0*(2.d0*dd1**2*r(0)**4+1.d0 & + -5.d0*dd1*r(0)**2)*distp(0,1) + + ! indorbp=indorb + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) + if(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) + end if + elseif(ic.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + end if + elseif(ic.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + end if + else + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshell+7 +indorb=indorbp + + + diff --git a/devel_tools/makefun_factory/orb_16.f90 b/devel_tools/makefun_factory/orb_16.f90 new file mode 100644 index 0000000..816591f --- /dev/null +++ b/devel_tools/makefun_factory/orb_16.f90 @@ -0,0 +1,68 @@ + ! s orbital + ! + ! - angmom = 0 + ! - type = Gaussian + ! - normalized = yes + ! - angtype = spherical + ! - npar = 1 + ! - multiplicity = 1 + ! + ! = N * R + ! + ! where N is the normalization constant + ! N = (2*alpha/pi)**(3/4) + ! + ! and R is the radial part + ! R = exp(-alpha*r**2) + ! + + + indshellp=indshell+1 + indorbp=indorb+1 + dd1=dd(indpar+1) + + if(dd1.ne.0.) then + c=0.71270547035499016d0*dd1**0.75d0 + else + c=1.d0 + end if + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + do i=i0,indtm + z(indorbp,i)=distp(i,1) + end do + + if(typec.ne.1) then + ! the first derivative /r + fun=-2.d0*dd1*distp(0,1) + + ! the second derivative + fun2=fun*(1.d0-2.d0*dd1*r(0)*r(0)) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + if(typec.eq.2) then + ! Backflow + funb=(fun2-fun)/(r(0)*r(0)) + + z(indorbp,indt+5)=funb*rmu(1,0)*rmu(1,0)+fun + z(indorbp,indt+6)=funb*rmu(2,0)*rmu(2,0)+fun + z(indorbp,indt+7)=funb*rmu(3,0)*rmu(3,0)+fun + z(indorbp,indt+8)=funb*rmu(1,0)*rmu(2,0) + z(indorbp,indt+9)=funb*rmu(1,0)*rmu(3,0) + z(indorbp,indt+10)=funb*rmu(2,0)*rmu(3,0) + + end if + end if + + indorb=indorbp + indpar=indpar+1 + indshell=indshellp + diff --git a/devel_tools/makefun_factory/orb_17.f90 b/devel_tools/makefun_factory/orb_17.f90 new file mode 100644 index 0000000..ab8a3e3 --- /dev/null +++ b/devel_tools/makefun_factory/orb_17.f90 @@ -0,0 +1,43 @@ + ! 2s gaussian for pseudo + ! R(r)=r**2*exp(-z*r**2) single zeta + + indshellp=indshell+1 + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + + ! if(iflagnorm.gt.2) then + ! c=4.d0*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)/dsqrt(15.d0) + c=.73607904464954686606d0*dd1**1.75d0 + ! endif + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + do i=i0,indtm + z(indorbp,i)=distp(i,1)*r(i)**2 + end do + + if(typec.ne.1) then + rp1=r(0)**2 + ! the first derivative / r + fun=2.d0*distp(0,1)*(1.d0-dd1*rp1) + ! the second derivative + fun2=2.d0*distp(0,1)*(1.d0-5.d0*dd1*rp1+2.d0*dd1**2*rp1**2) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + + indorb=indorbp + + ! endif + + indpar=indpar+1 + indshell=indshellp + + ! 2s gaussian for pseudo diff --git a/devel_tools/makefun_factory/orb_18.f90 b/devel_tools/makefun_factory/orb_18.f90 new file mode 100644 index 0000000..cc7037d --- /dev/null +++ b/devel_tools/makefun_factory/orb_18.f90 @@ -0,0 +1,49 @@ + ! R(r)=r**4*exp(-z*r**2) single zeta + + + + indshellp=indshell+1 + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + + ! if(iflagnorm.gt.2) then + ! c=(2.d0*dd1**11/pi)**(1.d0/4.d0)*(512.d0/945.d0/pi) + c=dd1**2.75d0*0.1540487967684377d0 + ! endif + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + do i=i0,indtm + z(indorbp,i)=r(i)**4*distp(i,1) + end do + + if(typec.ne.1) then + rp1=r(0)**2 + + ! the first derivative + fun=distp(0,1)*rp1*(4.d0-2.d0*dd1*rp1) + + ! the second derivative + fun2=distp(0,1)*rp1*(12.d0-18.d0*dd1*rp1 & + +4.d0*dd1**2*rp1**2) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + end if + + indorb=indorbp + + ! endif + indpar=indpar+1 + indshell=indshellp + + ! derivative of 16 with respect to z diff --git a/devel_tools/makefun_factory/orb_19.f90 b/devel_tools/makefun_factory/orb_19.f90 new file mode 100644 index 0000000..ba06d4f --- /dev/null +++ b/devel_tools/makefun_factory/orb_19.f90 @@ -0,0 +1,56 @@ + ! R(r)=c*exp(-z*r**2)*(3/4/z-r**2) + + + + + indshellp=indshell+1 + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + + dd1=dd(indpar+1) + + ! if(iflagnorm.gt.2) then + ! if(dd1.ne.0.) then + ! c=(2.d0*dd1/pi)**(3.d0/4.d0) + c=0.71270547035499016d0*dd1**0.75d0 + ! else + ! c=1.d0 + ! endif + ! endif + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + do i=i0,indtm + z(indorbp,i)=distp(i,1)*(3.d0/4.d0/dd1-r(i)**2) + end do + + if(typec.ne.1) then + ! the first derivative /r + fun=distp(0,1)*(2.d0*dd1*r(0)**2-7.d0/2.d0) + + ! the second derivative + fun2=distp(0,1)*(-4.d0*dd1**2*r(0)**4 & + +13.d0*dd1*r(0)**2-7.d0/2.d0) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + end if + + indorb=indorbp + + ! endif + + indpar=indpar+1 + indshell=indshellp + + + + ! 2p single zeta diff --git a/devel_tools/makefun_factory/orb_199.f90 b/devel_tools/makefun_factory/orb_199.f90 new file mode 100644 index 0000000..76b7ddc --- /dev/null +++ b/devel_tools/makefun_factory/orb_199.f90 @@ -0,0 +1,22 @@ +! derivative of 200 LA COSTANTE + +indorbp=indorb+1 +indshellp=indshell+1 + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=0.d0 +end do +! endif + +if(typec.ne.1) then + do i=1,3 + z(indorbp,indt+i)=0.d0 + end do + + z(indorbp,indt+4)=0 + !endif for indt +end if + +indshell=indshellp +indorb=indorbp diff --git a/devel_tools/makefun_factory/orb_2.f90 b/devel_tools/makefun_factory/orb_2.f90 new file mode 100644 index 0000000..8e1c650 --- /dev/null +++ b/devel_tools/makefun_factory/orb_2.f90 @@ -0,0 +1,51 @@ + ! + + + + indshellp=indshell+1 + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=(zeta(1)-dd1)/(dd2-zeta(1)) + + ! if(iflagnorm.gt.2) then + c=1.d0/2.d0/dsqrt(2.d0*pi*(1.d0/(2.d0*dd1)**3 & + +2.d0*peff/(dd1+dd2)**3+peff**2/(2.d0*dd2)**3)) + ! endif + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + end do + + do i=i0,indtm + z(indorbp,i)=distp(i,1)+peff*distp(i,2) + end do + + if(typec.ne.1) then + fun=(-dd1*distp(0,1)-dd2*distp(0,2)*peff)/r(0) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=(-2.d0*dd1/r(0)+dd1**2) & + *distp(0,1)+peff*(-2.d0*dd2/r(0)+dd2**2) & + *distp(0,2) + + + end if + + indorb=indorbp + + ! endif + + indpar=indpar+2 + indshell=indshellp + + + ! 1s double Z NO CUSP diff --git a/devel_tools/makefun_factory/orb_20.f90 b/devel_tools/makefun_factory/orb_20.f90 new file mode 100644 index 0000000..301cbdb --- /dev/null +++ b/devel_tools/makefun_factory/orb_20.f90 @@ -0,0 +1,51 @@ + ! 2p single Z with no cusp condition + + + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=dsqrt((2.d0*dd1)**5/8.d0/pi)/2.d0 + c=dd1**2.5d0*0.5641895835477562d0 + ! endif + + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + end do + + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif + end do + + if(typec.ne.1) then + fun0=distp(0,1) + fun=-dd1*distp(0,1) + fun2=dd1**2*distp(0,1) + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun/r(0) + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun/r(0)+fun2) + ! endif + end do + end if + + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp + + + ! 2p double zeta diff --git a/devel_tools/makefun_factory/orb_200.f90 b/devel_tools/makefun_factory/orb_200.f90 new file mode 100644 index 0000000..a1ef26d --- /dev/null +++ b/devel_tools/makefun_factory/orb_200.f90 @@ -0,0 +1,24 @@ +! THE COSTANT + +indorbp=indorb+1 +indshellp=indshell+1 + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=1.d0 +end do +! endif + +if(typec.ne.1) then + do i=1,3 + z(indorbp,indt+i)=0 + end do + + z(indorbp,indt+4)=0 + !endif for indt +end if + +indshell=indshellp +indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_2000:2099.f90 b/devel_tools/makefun_factory/orb_2000:2099.f90 new file mode 100644 index 0000000..38c127e --- /dev/null +++ b/devel_tools/makefun_factory/orb_2000:2099.f90 @@ -0,0 +1,46 @@ +! s gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative of 1000 + +npower=iopt+1-2000 + +indorbp=indorb+1 +indshellp=indshell+1 + + +dd2=dd(indpar+1) +do k=indtmin,indtm + distp(k,1)=-r(k)**(2*npower)*dexp(-dd2*r(k)**2) +end do + +! if(iocc(indshellp).eq.1) then +do i=i0,indtm + z(indorbp,i)=distp(i,1) +end do +! endif + + +if(typec.ne.1) then + + + rp1=r(0)**2 + fun0=distp(0,1) + fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 + fun2=(npower*(2.d0*npower-1.d0)- & + (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & + distp(0,1)*2.d0/rp1 + + ! if(iocc(indshellp).eq.1) then + do i=1,3 + z(indorbp,indt+i)=rmu(i,0)*fun + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + ! endif + + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshell+1 +indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_21.f90 b/devel_tools/makefun_factory/orb_21.f90 new file mode 100644 index 0000000..3741410 --- /dev/null +++ b/devel_tools/makefun_factory/orb_21.f90 @@ -0,0 +1,57 @@ + ! 2p without cusp condition + + + + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + c=0.5d0/dsqrt(8.d0*pi*(1.d0/(2.d0*dd1)**5 & + +2.d0*peff/(dd1+dd2)**5+peff**2/(2.d0*dd2)**5)) + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + end do + + do i=indtmin,indtm + distp(i,3)=distp(i,1)+peff*distp(i,2) + end do + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,3) + end do + ! endif + end do + + + if(typec.ne.1) then + fun=(-dd1*distp(0,1)-dd2*peff*distp(0,2))/r(0) + fun2=dd1**2*distp(0,1)+peff*dd2**2*distp(0,2) + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)*fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+distp(0,3) + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + ! endif + end do + + + !endif for indt + end if + + indpar=indpar+3 + indshell=indshell+3 + indorb=indorbp + + + ! 3p single zeta diff --git a/devel_tools/makefun_factory/orb_2100:2199.f90 b/devel_tools/makefun_factory/orb_2100:2199.f90 new file mode 100644 index 0000000..483fe39 --- /dev/null +++ b/devel_tools/makefun_factory/orb_2100:2199.f90 @@ -0,0 +1,53 @@ +! p gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative 1100 + +npower=iopt+1-2100 + +! indorbp=indorb + +dd2=dd(indpar+1) +do k=indtmin,indtm + distp(k,1)=-r(k)**(2*npower)*dexp(-dd2*r(k)**2) +end do + +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif +end do + + +if(typec.ne.1) then + + + rp1=r(0)**2 + fun0=distp(0,1) + fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 + fun2=(npower*(2.d0*npower-1.d0)- & + (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & + distp(0,1)*2.d0/rp1 + + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)*fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + ! endif + end do + + + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_22.f90 b/devel_tools/makefun_factory/orb_22.f90 new file mode 100644 index 0000000..2e0af51 --- /dev/null +++ b/devel_tools/makefun_factory/orb_22.f90 @@ -0,0 +1,57 @@ + ! 3p without cusp condition + ! r e^{-z1 r } + + + + dd1=dd(indpar+1) + ! c=dsqrt((2.d0*dd1)**7/240.d0/pi)/2.d0 + c=dd1**3.5d0*0.2060129077457011d0 + ! + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=r(k)*distp(k,1) + end do + ! + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,2) + end do + ! endif + end do + ! + ! + if(typec.ne.1) then + fun0=distp(0,2) + fun=(1.d0-dd1*r(0))*distp(0,1) + fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) + ! + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun/r(0) + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)* & + (4.d0*fun/r(0)+fun2) + ! + ! endif + end do + ! + ! + !endif for indt + end if + ! + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp + + + ! 3p double zeta diff --git a/devel_tools/makefun_factory/orb_2200:2299.f90 b/devel_tools/makefun_factory/orb_2200:2299.f90 new file mode 100644 index 0000000..dc02b2d --- /dev/null +++ b/devel_tools/makefun_factory/orb_2200:2299.f90 @@ -0,0 +1,105 @@ +! d gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative 1200 + +npower=iopt+1-2200 + +! indorbp=indorb + +dd2=dd(indpar+1) +do k=indtmin,indtm + distp(k,1)=-r(k)**(2*npower)*dexp(-dd2*r(k)**2) +end do + +do i=indtmin,indtm + distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d + distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d + distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d +end do + +do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=distp(i,1+ic)*distp(i,1) + end do + ! endif +end do + +if(typec.ne.1) then + + + rp1=r(0)**2 + fun0=distp(0,1) + fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 + fun2=(npower*(2.d0*npower-1.d0)- & + (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & + distp(0,1)*2.d0/rp1 + + + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + !endif for indt +end if + +indpar=indpar+1 +indshell=indshell+5 +indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_23.f90 b/devel_tools/makefun_factory/orb_23.f90 new file mode 100644 index 0000000..13464cc --- /dev/null +++ b/devel_tools/makefun_factory/orb_23.f90 @@ -0,0 +1,68 @@ + ! 3p without cusp condition + ! r ( e^{-z2 r } + z1 e^{-z3 r } ) + + + + dd1=dd(indpar+1) + dd2=dd(indpar+2) + dd3=dd(indpar+3) + ! if(iflagnorm.gt.2) then + c=1.d0/2.d0/dsqrt(240.d0*pi*(1.d0/(2.d0*dd1)**7 & + +2.d0*dd3/(dd1+dd2)**7+dd3**2/(2.d0*dd2)**7)) + ! endif + ! + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + end do + ! + do i=indtmin,indtm + distp(i,3)=r(i)*(distp(i,1)+dd3*distp(i,2)) + end do + ! + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,3) + end do + ! endif + end do + ! + ! + if(typec.ne.1) then + fun0=distp(0,3) + fun=(1.d0-dd1*r(0))*distp(0,1) & + +dd3*(1.d0-dd2*r(0))*distp(0,2) + fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) & + +dd3*dd2*(dd2*r(0)-2.d0)*distp(0,2) + ! + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun/r(0) + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)* & + (4.d0*fun/r(0)+fun2) + ! + ! endif + end do + ! + ! + !endif for indt + end if + ! + indpar=indpar+3 + indshell=indshell+3 + indorb=indorbp + + + + ! 4p single zeta diff --git a/devel_tools/makefun_factory/orb_24.f90 b/devel_tools/makefun_factory/orb_24.f90 new file mode 100644 index 0000000..979ae2a --- /dev/null +++ b/devel_tools/makefun_factory/orb_24.f90 @@ -0,0 +1,56 @@ + !c 4p without cusp condition + !c r^2 e^{-z1 r } + + + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=dsqrt((2.d0*dd1)**9/120960.d0/pi)/2.d0 + c=dd1**4.5d0*0.01835308852470193d0 + ! endif + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + end do + + do i=indtmin,indtm + distp(i,3)=r(i)**2*distp(i,1) + end do + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,3) + end do + ! endif + end do + + + if(typec.ne.1) then + fun0=distp(0,3) + fun=(2.d0*r(0)-dd1*r(0)**2)*distp(0,1) + fun2=((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))*distp(0,1) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun/r(0) + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun/r(0)+fun2) + ! endif + end do + + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp + + + ! 4p double zeta diff --git a/devel_tools/makefun_factory/orb_25.f90 b/devel_tools/makefun_factory/orb_25.f90 new file mode 100644 index 0000000..6343dee --- /dev/null +++ b/devel_tools/makefun_factory/orb_25.f90 @@ -0,0 +1,61 @@ + ! 4p without cusp condition + ! r^2 ( e^{-z2 r } + z1 e^{-z3 r } ) + + + + dd1=dd(indpar+1) + dd2=dd(indpar+2) + dd3=dd(indpar+3) + ! if(iflagnorm.gt.2) then + c=1.d0/2.d0/dsqrt(120960.d0*pi*(1.d0/(2.d0*dd1)**9 & + +2.d0*dd3/(dd1+dd2)**9+dd3**2/(2.d0*dd2)**9)) + ! endif + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + end do + + do i=indtmin,indtm + distp(i,3)=r(i)**2*(distp(i,1)+dd3*distp(i,2)) + end do + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,3) + end do + ! endif + end do + + + if(typec.ne.1) then + fun0=distp(0,3) + fun=(2.d0*r(0)-dd1*r(0)**2)*distp(0,1) & + +dd3*(2.d0*r(0)-dd2*r(0)**2)*distp(0,2) + fun2=((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))*distp(0,1) & + +dd3*((dd2*r(0))**2+2.d0-4.d0*dd2*r(0))*distp(0,2) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun/r(0) + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun/r(0)+fun2) + ! endif + end do + + !endif for indt + end if + + indpar=indpar+3 + indshell=indshell+3 + indorb=indorbp + + + ! 2p triple zeta diff --git a/devel_tools/makefun_factory/orb_26.f90 b/devel_tools/makefun_factory/orb_26.f90 new file mode 100644 index 0000000..0ace878 --- /dev/null +++ b/devel_tools/makefun_factory/orb_26.f90 @@ -0,0 +1,59 @@ + ! s orbital + ! + ! - angmom = 1 + ! - type = Slater + ! - normalized = yes + ! - angtype = spherical + ! - npar = 5 + ! - multiplicity = 3 + ! + ! 2p with cusp conditions + ! + + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + dd3=dd(indpar+4) + peff2=dd(indpar+5) + + c=1.d0/2.d0/dsqrt(8.d0*pi*(1.d0/(2.d0*dd1)**5 & + +2.d0*peff/(dd1+dd2)**5+peff**2/(2.d0*dd2)**5 & + +2.d0*peff2/(dd1+dd3)**5+peff2**2/(2.d0*dd3)**5 & + +2.d0*peff2*peff/(dd2+dd3)**5)) + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + distp(k,3)=c*dexp(-dd3*r(k)) + end do + + do i=indtmin,indtm + distp(i,4)=distp(i,1)+peff*distp(i,2)+peff2*distp(i,3) + end do + + do ic=1,3 + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,4) + end do + end do + + if(typec.ne.1) then + fun=(-dd1*distp(0,1)-dd2*peff*distp(0,2) & + -dd3*peff2*distp(0,3))/r(0) + fun2=dd1**2*distp(0,1)+peff*dd2**2*distp(0,2) & + +peff2*dd3**2*distp(0,3) + + do ic=1,3 + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)*fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+distp(0,4) + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + end do + end if + + indpar=indpar+5 + indshell=indshell+3 + indorb=indorbp diff --git a/devel_tools/makefun_factory/orb_27.f90 b/devel_tools/makefun_factory/orb_27.f90 new file mode 100644 index 0000000..71e32bc --- /dev/null +++ b/devel_tools/makefun_factory/orb_27.f90 @@ -0,0 +1,73 @@ + ! 2p without cusp condition + + + + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + dd3=dd(indpar+4) + peff2=dd(indpar+5) + + ! if(iflagnorm.gt.2) then + c=1.d0/2.d0/dsqrt(240.d0*pi*(1.d0/(2.d0*dd1)**7 & + +2.d0*peff/(dd1+dd2)**7+peff**2/(2.d0*dd2)**7 & + +2.d0*peff2/(dd1+dd3)**7+peff2**2/(2.d0*dd3)**7 & + +2.d0*peff2*peff/(dd2+dd3)**7)) + ! endif + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + distp(k,3)=c*dexp(-dd3*r(k)) + end do + + do i=indtmin,indtm + distp(i,4)=r(i)*(distp(i,1)+peff*distp(i,2) & + +peff2*distp(i,3)) + end do + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,4) + end do + ! endif + end do + + + if(typec.ne.1) then + fun0=distp(0,4) + fun=(1.d0-dd1*r(0))*distp(0,1) & + +peff*(1.d0-dd2*r(0))*distp(0,2) & + +peff2*(1.d0-dd3*r(0))*distp(0,3) + fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) & + +peff*dd2*(dd2*r(0)-2.d0)*distp(0,2) & + +peff2*dd3*(dd3*r(0)-2.d0)*distp(0,3) + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun/r(0) + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)* & + (4.d0*fun/r(0)+fun2) + ! endif + end do + + + !endif for indt + end if + + indpar=indpar+5 + indshell=indshell+3 + indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_28.f90 b/devel_tools/makefun_factory/orb_28.f90 new file mode 100644 index 0000000..29dcaf7 --- /dev/null +++ b/devel_tools/makefun_factory/orb_28.f90 @@ -0,0 +1,56 @@ + ! R(r)=(Z*b*r)^4/(1+(Z*b*r)^4)*exp(-z*r) orbital 1s (no cusp) + ! d -> b1s (defined in module constants) + ! normadization: cost1s, depends on b1s + + + indshellp=indshell+1 + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + + dd1=dd(indpar+1) + + ! if(iflagnorm.gt.2) then + ! if(dd1.gt.0.) then + c=cost1s*dd1**1.5d0 + ! else + ! c=1.d0 + ! endif + ! endif + + do i=indtmin,indtm + distp(i,1)=c*dexp(-dd1*r(i)) + end do + + do i=i0,indtm + rp4=(dd1*b1s*r(i))**4 + z(indorbp,i)=distp(i,1)*rp4/(1.d0+rp4) + end do + + if(typec.ne.1) then + rp1=dd1*b1s*r(0) + rp2=rp1**2 + rp4=rp2**2 + rp5=r(0)*dd1 + rp6=(b1s*dd1)**2*rp2 + ! the first derivative /r + fun=-distp(0,1)*rp6*(-4.d0+rp5+rp4*rp5)/(1.d0+rp4)**2 + ! the second derivative derivative + fun2=distp(0,1)*rp6*(12.d0-8*rp5+rp5**2-20*rp4- & + 8*rp4*rp5+2*rp4*rp5**2+(rp4*rp5)**2)/(1.d0+rp4)**3 + ! gradient: dR(r)/dr_i=r_i*fun + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + ! laplacian = 2*fun+fun2 + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + + indorb=indorbp + + ! endif + + indpar=indpar+1 + indshell=indshellp + diff --git a/devel_tools/makefun_factory/orb_29.f90 b/devel_tools/makefun_factory/orb_29.f90 new file mode 100644 index 0000000..7e3d948 --- /dev/null +++ b/devel_tools/makefun_factory/orb_29.f90 @@ -0,0 +1,73 @@ + ! derivative of (28) + + + indshellp=indshell+1 + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + + dd1=dd(indpar+1) + + ! if(iflagnorm.gt.2) then + ! if(dd1.gt.0.) then + c=cost1s*dd1**1.5d0 + ! else + ! c=1.d0 + ! endif + ! endif + ! if(dd1.gt.0.) then + c1=1.5d0/dd1 + ! else + ! c1=0.d0 + ! endif + + do i=indtmin,indtm + distp(i,1)=c*dexp(-dd1*r(i)) + end do + + do i=i0,indtm + ! rp1=(b1s*r(i))**4*dd1**3 + ! rp4=rp1*dd1 + ! rp5=dd1*r(i) + ! z(indorbp,i)=distp(i,1)* & + ! &(c1*rp4/(1+rp4)-rp1*(-4+rp5+rp4*rp5)/(1+rp4)**2) + rp4=(b1s*dd1*r(i))**4 + rp5=dd1*r(i) + z(indorbp,i)=distp(i,1)*rp4/(1+rp4)* & + (c1 - (1.d0/dd1)*(-4+rp5+rp4*rp5)/(1+rp4)) + end do + + if(typec.ne.1) then + rp1=dd1*b1s*r(0) + rp2=rp1**2 + rp4=rp2**2 + rp5=rp4*rp1 + rp8=rp4*rp4 + + fun=distp(0,1)* (dd1*rp2*(4*b1s**2*(11-5*rp4) +2*(rp1+rp5)**2 & + -b1s*rp1*(21+26*rp4+5*rp8)))/(2.*(1+rp4)**3) + + fun2=distp(0,1)*(dd1*rp2*(b1s*(31 + 7*rp4)*(rp1 + rp5)**2 & + - 2*(rp1 + rp5)**3 + 64*b1s**2*rp1*(-2 - rp4 + rp8) + & + 4*b1s**3*(33 - 134*rp4 + 25*rp8)))/(2.*b1s*(1 + rp4)**4) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + ! endif + + indorb=indorbp + + end if + + indpar=indpar+1 + indshell=indshellp + + + + + diff --git a/devel_tools/makefun_factory/orb_3.f90 b/devel_tools/makefun_factory/orb_3.f90 new file mode 100644 index 0000000..189132d --- /dev/null +++ b/devel_tools/makefun_factory/orb_3.f90 @@ -0,0 +1,51 @@ + ! + + + + indshellp=indshell+1 + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + + ! if(iflagnorm.gt.2) then + c=1.d0/2.d0/dsqrt(2.d0*pi*(1.d0/(2.d0*dd1)**3 & + +2.d0*peff/(dd1+dd2)**3+peff**2/(2.d0*dd2)**3)) + ! endif + + do i=indpar+1,indpar+2 + do k=indtmin,indtm + distp(k,i-indpar)=c*dexp(-dd(i)*r(k)) + end do + end do + + do i=i0,indtm + z(indorbp,i)=distp(i,1)+peff*distp(i,2) + end do + + if(typec.ne.1) then + fun=-dd1*distp(0,1)-peff*dd2*distp(0,2) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0)/r(0) + end do + + z(indorbp,indt+4)=(-2.d0*dd1/r(0)+dd1**2) & + *distp(0,1)+peff*(-2.d0*dd2/r(0)+dd2**2) & + *distp(0,2) + + + end if + + indorb=indorbp + + ! endif + + indpar=indpar+3 + indshell=indshellp + + ! 2s 2pz Hybryd single Z diff --git a/devel_tools/makefun_factory/orb_30.f90 b/devel_tools/makefun_factory/orb_30.f90 new file mode 100644 index 0000000..2452bb1 --- /dev/null +++ b/devel_tools/makefun_factory/orb_30.f90 @@ -0,0 +1,109 @@ + ! 3d without cusp and one parmater + + + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c= & + ! &1.d0/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) + c=dd1**3.5d0*0.26596152026762178d0 + ! endif + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + end do + + do i=indtmin,indtm + distp(i,3)=distp(i,1) + ! lz=0 + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/-2 + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d + end do + + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif + end do + + if(typec.ne.1) then + fun0=distp(0,3) + fun=-dd1*distp(0,1) + fun2=dd1**2*distp(0,1) + + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + ! + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_31.f90 b/devel_tools/makefun_factory/orb_31.f90 new file mode 100644 index 0000000..92e4a07 --- /dev/null +++ b/devel_tools/makefun_factory/orb_31.f90 @@ -0,0 +1,115 @@ + ! 3d without cusp condition double Z + + + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + ! if(iflagnorm.gt.2) then + c=1/2.d0*dsqrt(5.d0/pi) & + /dsqrt(1/dd1**7/128.d0+2*peff/(dd1+dd2)**7 & + +peff**2/dd2**7/128.d0)/dsqrt(720.d0) + ! endif + + do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)) + distp(k,2)=dexp(-dd2*r(k)) + end do + + do i=indtmin,indtm + distp(i,3)=c*(distp(i,1)+peff*distp(i,2)) + !lz=0 + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + !lz=+/-2 + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/- 2 + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d + end do + + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif + end do + + if(typec.ne.1) then + fun0=distp(0,3) + fun=c*(-dd1*distp(0,1)-peff*dd2*distp(0,2)) + fun2=c*(dd1**2*distp(0,1) & + +peff*dd2**2*distp(0,2)) + + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0)*fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + + !endif for indt + end if + + indpar=indpar+3 + indshell=indshell+5 + indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_32.f90 b/devel_tools/makefun_factory/orb_32.f90 new file mode 100644 index 0000000..0b1978d --- /dev/null +++ b/devel_tools/makefun_factory/orb_32.f90 @@ -0,0 +1,120 @@ + ! 3d without cusp condition triple Z + + + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + dd3=dd(indpar+4) + peff2=dd(indpar+5) + + ! if(iflagnorm.gt.2) then + c=1/2.d0*dsqrt(5.d0/pi) & + /dsqrt(1/(2.d0*dd1)**7+2*peff/(dd1+dd2)**7 & + +peff**2/(2.d0*dd2)**7+2*peff2/(dd1+dd3)**7 & + +peff2**2/(2.d0*dd3)**7+2*peff*peff2/(dd2+dd3)**7)/dsqrt(720.d0) + ! endif + + do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)) + distp(k,2)=dexp(-dd2*r(k)) + distp(k,3)=dexp(-dd3*r(k)) + end do + + do i=indtmin,indtm + distp(i,4)=c*(distp(i,1)+peff*distp(i,2)+peff2*distp(i,3)) + !lz=0 + distp(i,5)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + !lz=+/-2 + distp(i,6)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/- 2 + distp(i,7)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,8)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,9)=rmu(1,i)*rmu(3,i)*cost3d + end do + + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=distp(i,4+ic)*distp(i,4) + end do + ! endif + end do + + if(typec.ne.1) then + fun0=distp(0,4) + fun=c*(-dd1*distp(0,1)-peff*dd2*distp(0,2) & + -peff2*dd3*distp(0,3)) + fun2=c*(dd1**2*distp(0,1)+peff*dd2**2*distp(0,2) & + +peff2*dd3**2*distp(0,3)) + + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,4+ic)*rmu(i,0)*fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,4+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + + !endif for indt + end if + + indpar=indpar+5 + indshell=indshell+5 + indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_33.f90 b/devel_tools/makefun_factory/orb_33.f90 new file mode 100644 index 0000000..52db0ce --- /dev/null +++ b/devel_tools/makefun_factory/orb_33.f90 @@ -0,0 +1,112 @@ + ! 4d without cusp and one parmater + + + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c= + ! &1/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) + ! c= & + ! &1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) + c=dd1**4.5d0*0.0710812062076410d0 + ! endif + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + end do + + do i=indtmin,indtm + distp(i,3)=distp(i,1)*r(i) + ! lz=0 + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/ + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d + end do + + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif + end do + + if(typec.ne.1) then + fun0=distp(0,3) + fun=-dd1*distp(0,3)+distp(0,1) + fun2=dd1**2*distp(0,3)-2.d0*dd1*distp(0,1) + + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + end if + ! + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp + + + ! 2s single Z WITH CUSP zero diff --git a/devel_tools/makefun_factory/orb_34.f90 b/devel_tools/makefun_factory/orb_34.f90 new file mode 100644 index 0000000..2a2ee79 --- /dev/null +++ b/devel_tools/makefun_factory/orb_34.f90 @@ -0,0 +1,52 @@ + ! normalized + ! exp(-dd1*r) + dd1*r*exp(-dd1*r) + + + indshellp=indshell+1 + + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + ! peff=dd1 + + + ! if(iflagnorm.gt.2) then + ! c=1.d0/dsqrt(1.d0/4.d0/dd1**3+12.d0*dd1/(2.d0*dd1)**4+& + ! &3.d0*dd1**2/4.d0/dd1**5)/dsqrt(4.d0*pi) + ! c=dd1*dsqrt(dd1)/dsqrt(7.d0*pi) + c=dd1*dsqrt(dd1)*.2132436186229231d0 + ! endif + + do i=indtmin,indtm + distp(i,1)=c*dexp(-dd1*r(i)) + end do + + do i=i0,indtm + z(indorbp,i)=distp(i,1)*(1.d0+r(i)*dd1) + end do + + if(typec.ne.1) then + + fun=-dd1**2*distp(0,1) + fun2=fun*(1.d0-dd1*r(0)) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=(2.d0*fun+fun2) + + end if + + indorb=indorbp + + ! endif + indpar=indpar+1 + indshell=indshellp + + + + + ! 2s single Z WITH CUSP diff --git a/devel_tools/makefun_factory/orb_35.f90 b/devel_tools/makefun_factory/orb_35.f90 new file mode 100644 index 0000000..81ae0d1 --- /dev/null +++ b/devel_tools/makefun_factory/orb_35.f90 @@ -0,0 +1,48 @@ + ! normalized + ! exp(-dd1*r) + dd1* r * exp(-dd2*r) + + + indshellp=indshell+1 + + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd1 + + do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)) + distp(k,2)=dexp(-dd2*r(k)) + end do + + ! if(iflagnorm.gt.2) then + c=1.d0/dsqrt(1/4.d0/dd1**3+12*peff/(dd1+dd2)**4+ & + 3*peff**2/4/dd2**5)/dsqrt(4.0*pi) + ! endif + + do i=i0,indtm + z(indorbp,i)=c*(distp(i,1)+r(i)*distp(i,2)*peff) + end do + + if(typec.ne.1) then + + fun=-dd1*distp(0,1)+peff*distp(0,2)*(1.d0-dd2*r(0)) + fun2=distp(0,1)*dd1**2 & + +peff*distp(0,2)*(dd2**2*r(0)-2.d0*dd2) + + do i=1,3 + z(indorbp,indt+i)=fun*c*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=c*(2.d0*fun/r(0)+fun2) + + end if + + indorb=indorbp + + ! endif + indpar=indpar+2 + indshell=indshellp + + ! single gaussian p orbitals diff --git a/devel_tools/makefun_factory/orb_36.f90 b/devel_tools/makefun_factory/orb_36.f90 new file mode 100644 index 0000000..b11c00b --- /dev/null +++ b/devel_tools/makefun_factory/orb_36.f90 @@ -0,0 +1,42 @@ + ! p orbital + ! + ! - angmom = 1 + ! - type = Gaussian + ! - normalized = yes + ! - angtype = spherical + ! - npar = 1 + ! - multiplicity = 3 + ! + + dd1=dd(indpar+1) + c=dd1**1.25d0*1.42541094070998d0 + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + do ic=1,3 + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + end do + + if(typec.ne.1) then + fun0=distp(0,1) + fun=-2.d0*dd1*distp(0,1) + fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + + do ic=1,3 + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)*fun + end do + z(indorbp,indt+ic)=z(indorbp,indt+ic)+fun0 + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + end do + end if + + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp diff --git a/devel_tools/makefun_factory/orb_37,68.f90 b/devel_tools/makefun_factory/orb_37,68.f90 new file mode 100644 index 0000000..735445e --- /dev/null +++ b/devel_tools/makefun_factory/orb_37,68.f90 @@ -0,0 +1,86 @@ + ! d orbital + ! + ! - angmom = 2 + ! - type = Gaussian + ! - normalized = yes + ! - angtype = spherical + ! - npar = 1 + ! - multiplicity = 5 + ! + + indparp=indpar+1 + dd1=dd(indparp) + c=dd1**1.75d0*1.64592278064948967213d0 + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + do i=indtmin,indtm + ! lz=0 + distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/-2 + distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d + end do + + do ic=1,5 + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + end do + + if(typec.ne.1) then + + dd1=dd(indparp) + fun0=distp(0,1) + fun=-2.d0*dd1*distp(0,1) + fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + + do ic=1,5 + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + end do + if(ic.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1)- & + 2.d0*rmu(1,0)*fun0*cost1d + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 2.d0*rmu(2,0)*fun0*cost1d + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + 4.d0*rmu(3,0)*fun0*cost1d + elseif(ic.eq.2) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 2.d0*rmu(1,0)*fun0*cost2d + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 2.d0*rmu(2,0)*fun0*cost2d + elseif(ic.eq.3) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + rmu(2,0)*fun0*cost3d + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + rmu(1,0)*fun0*cost3d + elseif(ic.eq.4) then + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + rmu(3,0)*fun0*cost3d + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + rmu(2,0)*fun0*cost3d + elseif(ic.eq.5) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + rmu(3,0)*fun0*cost3d + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + rmu(1,0)*fun0*cost3d + end if + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + end do + end if + + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp diff --git a/devel_tools/makefun_factory/orb_38.f90 b/devel_tools/makefun_factory/orb_38.f90 new file mode 100644 index 0000000..34c6b64 --- /dev/null +++ b/devel_tools/makefun_factory/orb_38.f90 @@ -0,0 +1,51 @@ + ! R(r)=r**2*exp(-z1*r) + + + + indshellp=indshell+1 + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=1.d0/dsqrt(1.d0/4.d0/dd1**3+12.d0*dd1/(2.d0*dd1)**4+& + ! &3.d0*dd1**2/4.d0/dd1**5)/dsqrt(4.d0*pi) + ! c=dd1*dsqrt(dd1)/dsqrt(7.d0*pi) + c=dd1*dsqrt(dd1)*0.21324361862292308211d0 + ! endif + + c0=-c*dd1 + + c1=1.5d0*c/dd1 + + + + do i=indtmin,indtm + distp(i,1)=dexp(-dd1*r(i)) + end do + + do i=i0,indtm + z(indorbp,i)=(c0*r(i)**2+c1*(1.d0+dd1*r(i))) & + *distp(i,1) + end do + + c1=c1*dd1**2 + + if(typec.ne.1) then + fun=(c0*(2.d0-dd1*r(0))-c1)*distp(0,1) + fun2=(c0*(2.d0-4*dd1*r(0)+(dd1*r(0))**2) & + +c1*(dd1*r(0)-1.d0))*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + + indorb=indorbp + + ! endif + indpar=indpar+1 + indshell=indshellp + + ! 4s single zeta derivative of 10 diff --git a/devel_tools/makefun_factory/orb_39.f90 b/devel_tools/makefun_factory/orb_39.f90 new file mode 100644 index 0000000..2460e84 --- /dev/null +++ b/devel_tools/makefun_factory/orb_39.f90 @@ -0,0 +1,61 @@ + ! R(r)=r**3*exp(-z1*r) + ! + indshellp=indshell+1 + + + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 + ! c=dsqrt((2*dd1)**7/720.d0/pi)/2.d0 + c=dd1**3.5d0*0.11894160774351807429d0 + ! c=-c + ! endif + + c0=-c + c1=3.5d0*c/dd1 + + do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)) + end do + + do i=i0,indtm + z(indorbp,i)=(c0*r(i)**3+c1*r(i)**2)*distp(i,1) + end do + + if(typec.ne.1) then + rp1=r(0)**3 + rp2=r(0)**2 + + ! fun=(2.d0-dd1*r(0))*distp(0,1) + ! fun2=(2.d0-4*dd1*r(0)+(dd1*r(0))**2)*distp(0,1) + ! + !c the first derivative/r + fun=distp(0,1)*(c0*(3.d0*r(0)-dd1*rp2) & + +c1*(2.d0-dd1*r(0))) + + !c + + !c the second derivative + fun2=distp(0,1)* & + (c0*(6.d0*r(0)-6.d0*dd1*rp2+dd1**2*rp1) & + +c1*(2.d0-4*dd1*r(0)+(dd1*r(0))**2)) + !c + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + end if + ! + indorb=indorbp + ! + ! endif + indpar=indpar+1 + indshell=indshellp + ! + ! 3p single zeta diff --git a/devel_tools/makefun_factory/orb_4.f90 b/devel_tools/makefun_factory/orb_4.f90 new file mode 100644 index 0000000..7e0bd81 --- /dev/null +++ b/devel_tools/makefun_factory/orb_4.f90 @@ -0,0 +1,48 @@ + ! normalized + + indshellp=indshell+1 + + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + + ! if(iflagnorm.gt.2) then + c=dd1**2.5d0/dsqrt(3.d0*pi*(1.d0+dd2**2/3.d0)) + ! endif + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + end do + + + do i=i0,indtm + z(indorbp,i)=(r(i)+dd2*rmu(3,i))*distp(i,1) + end do + + if(typec.ne.1) then + + fun=distp(0,1)*(1.d0-dd1*r(0)) + funp=-dd2*dd1*distp(0,1)*rmu(3,0) + fun2=distp(0,1)*(dd1**2*r(0)-2.d0*dd1) + fun2p=dd1**2*dd2*distp(0,1)*rmu(3,0) + + do i=1,3 + z(indorbp,indt+i)=(fun+funp)*rmu(i,0)/r(0) + end do + z(indorbp,indt+3)=z(indorbp,indt+3)+dd2*distp(0,1) + z(indorbp,indt+4)=(2.d0*fun+4.d0*funp)/r(0) & + +(fun2+fun2p) + + end if + + indorb=indorbp + + ! endif + indpar=indpar+2 + indshell=indshellp + + + ! 2s single Z NO CUSP diff --git a/devel_tools/makefun_factory/orb_40.f90 b/devel_tools/makefun_factory/orb_40.f90 new file mode 100644 index 0000000..79d1ba4 --- /dev/null +++ b/devel_tools/makefun_factory/orb_40.f90 @@ -0,0 +1,63 @@ + ! 3p without cusp condition derivative of 20 + ! r e^{-z1 r } + + + + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=dsqrt((2.d0*dd1)**5/8.d0/pi)/2.d0 + c=dd1**2.5d0*0.5641895835477562d0 + ! endif + + c0=-c + c1=2.5d0*c/dd1 + + ! + do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)) + distp(k,2)=r(k)*distp(k,1) + end do + ! + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*(c0*distp(i,2)+c1*distp(i,1)) + end do + ! endif + end do + ! + ! + if(typec.ne.1) then + fun0=c0*distp(0,2)+c1*distp(0,1) + fun=(c0*(1.d0-dd1*r(0))-c1*dd1)*distp(0,1) + fun2=(c0*dd1*(dd1*r(0)-2.d0)+c1*dd1**2)*distp(0,1) + ! + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun/r(0) + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)* & + (4.d0*fun/r(0)+fun2) + ! + ! endif + end do + ! + ! + !endif for indt + end if + ! + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp + + + ! 4p single zeta diff --git a/devel_tools/makefun_factory/orb_41.f90 b/devel_tools/makefun_factory/orb_41.f90 new file mode 100644 index 0000000..b6712c1 --- /dev/null +++ b/devel_tools/makefun_factory/orb_41.f90 @@ -0,0 +1,61 @@ + !c 4p without cusp condition derivative of 22 + !c r^2 e^{-z1 r } + + + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=dsqrt((2.d0*dd1)**7/240.d0/pi)/2.d0 + c=dd1**3.5d0*0.2060129077457011d0 + ! endif + c0=-c + + c1=3.5d0*c/dd1 + + do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)) + end do + + do i=indtmin,indtm + distp(i,3)=r(i)**2*distp(i,1) + end do + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*(c0*distp(i,3)+c1*r(i)*distp(i,1)) + end do + ! endif + end do + + + if(typec.ne.1) then + ! fun=(1.d0-dd1*r(0))*distp(0,1) + ! fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) + + fun0=c0*distp(0,3)+c1*r(0)*distp(0,1) + fun=(c0*(2.d0-dd1*r(0))*r(0) & + +c1*(1.d0-dd1*r(0)))*distp(0,1) + fun2=(c0*((dd1*r(0))**2+2.d0-4.d0*dd1*r(0)) & + +c1*dd1*(dd1*r(0)-2.d0))*distp(0,1) + + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun/r(0) + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun/r(0)+fun2) + ! endif + end do + end if + + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_42.f90 b/devel_tools/makefun_factory/orb_42.f90 new file mode 100644 index 0000000..2ac8f3e --- /dev/null +++ b/devel_tools/makefun_factory/orb_42.f90 @@ -0,0 +1,115 @@ + ! 4d without cusp and one parmater derivative of 30 + + + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c= & + ! &1.d0/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) + c=dd1**3.5d0*0.26596152026762178d0 + ! c= + ! &1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) + ! endif + + c0=-c + c1=3.5d0*c/dd1 + + do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)) + end do + + do i=indtmin,indtm + distp(i,3)=distp(i,1)*(c0*r(i)+c1) + ! lz=0 + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/ + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d + end do + + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif + end do + + if(typec.ne.1) then + fun0=distp(0,3) + fun=-dd1*distp(0,3)+c0*distp(0,1) + fun2=dd1**2*distp(0,3)-2.d0*dd1*c0*distp(0,1) + + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + !endif for indt + end if + ! + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_43.f90 b/devel_tools/makefun_factory/orb_43.f90 new file mode 100644 index 0000000..3fedb51 --- /dev/null +++ b/devel_tools/makefun_factory/orb_43.f90 @@ -0,0 +1,114 @@ + ! 4d without cusp and one parmater derivative of 33 + + + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c= & + ! &1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) + c=dd1**4.5d0*0.0710812062076410d0 + ! endif + + c0=-c + c1=4.5d0*c/dd1 + + + do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)) + end do + + do i=indtmin,indtm + distp(i,3)=distp(i,1)*(c0*r(i)**2+c1*r(i)) + ! lz=0 + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/ + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d + end do + + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif + end do + + if(typec.ne.1) then + fun0=distp(0,3) + fun=-dd1*distp(0,3)+distp(0,1)*(2.d0*c0*r(0)+c1) + fun2=dd1**2*distp(0,3)+distp(0,1)* & + (-2.d0*dd1*(2.d0*c0*r(0)+c1)+2.d0*c0) + ! indorbp=indorb + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + end if + ! + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp + + + ! derivative of 36 with respect zeta diff --git a/devel_tools/makefun_factory/orb_44.f90 b/devel_tools/makefun_factory/orb_44.f90 new file mode 100644 index 0000000..0916af0 --- /dev/null +++ b/devel_tools/makefun_factory/orb_44.f90 @@ -0,0 +1,54 @@ + ! R(r)=x*exp(-z*r**2)*(5/4/z-r**2) + + + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0 + c=dd1**1.25d0*1.42541094070998d0 + ! endif + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1)* & + (5.d0/4.d0/dd1-r(i)**2) + end do + ! endif + end do + + if(typec.ne.1) then + fun0=distp(0,1)*(5.d0/4.d0/dd1-r(0)**2) + fun=distp(0,1)*(2.d0*dd1*r(0)**2-9.d0/2.d0) + fun2=distp(0,1)*(-4.d0*dd1**2*r(0)**4 & + +15.d0*dd1*r(0)**2-9.d0/2.d0) + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + ! endif + end do + + + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp + + + ! derivative of 37 with respect to z diff --git a/devel_tools/makefun_factory/orb_45,69.f90 b/devel_tools/makefun_factory/orb_45,69.f90 new file mode 100644 index 0000000..a3f9ac3 --- /dev/null +++ b/devel_tools/makefun_factory/orb_45,69.f90 @@ -0,0 +1,122 @@ + ! d orbitals + ! R(r)= c*exp(-z r^2)*(7/4/z-r^2) + + + + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) + c=dd1**1.75d0*1.64592278064948967213d0 + ! endif + + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + + do i=indtmin,indtm + ! lz=0 + distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/-2 + distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d + end do + + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*(7.d0/4.d0/dd1-r(k)**2)* & + distp(k,1+ic) + end do + ! endif + end do + + + if(typec.ne.1) then + + dd1=dd(indparp) + fun0=distp(0,1)*(7.d0/4.d0/dd1-r(0)**2) + fun=distp(0,1)*(2.d0*dd1*r(0)**2-11.d0/2.d0) + fun2=distp(0,1)*(-4.d0*dd1**2*r(0)**4 & + +17.d0*dd1*r(0)**2-11.d0/2.d0) + + + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp + + ! derivative of 17 with respect to z diff --git a/devel_tools/makefun_factory/orb_46.f90 b/devel_tools/makefun_factory/orb_46.f90 new file mode 100644 index 0000000..a79e1f3 --- /dev/null +++ b/devel_tools/makefun_factory/orb_46.f90 @@ -0,0 +1,45 @@ + ! R(r)=c*r**2*exp(-z*r**2)*(7/4/z-r**2) + + + indshellp=indshell+1 + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + + ! if(iflagnorm.gt.2) then + c=4.d0*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)/dsqrt(15.d0) + ! endif + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + do i=i0,indtm + z(indorbp,i)=distp(i,1)*(7.d0/4.d0/dd1*r(i)**2 & + -r(i)**4) + end do + + if(typec.ne.1) then + rp1=r(0)**2 + ! the first derivative / r + fun=distp(0,1)*(7.d0-15.d0*dd1*rp1 & + +4.d0*(dd1*rp1)**2)/2.d0/dd1 + ! the second derivative + fun2=distp(0,1)*(7.d0-59*dd1*rp1+50*(dd1*rp1)**2 & + -8*(dd1*rp1)**3)/2.d0/dd1 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + + indorb=indorbp + + ! endif + + indpar=indpar+1 + indshell=indshellp + + ! 5s single zeta derivative of 12 diff --git a/devel_tools/makefun_factory/orb_47.f90 b/devel_tools/makefun_factory/orb_47.f90 new file mode 100644 index 0000000..24af896 --- /dev/null +++ b/devel_tools/makefun_factory/orb_47.f90 @@ -0,0 +1,111 @@ + ! d orbitals cartesian !!! + ! R(r)= exp(-alpha r^2) + ! each gaussian term is normalized + + + + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + + ! if(iflagnorm.gt.2) then + ! overall normalization + c=dd1**1.75d0*1.64592278064948967213d0 + ! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) + ! endif + + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + + do i=indtmin,indtm + distp(i,2)=rmu(1,i)**2 + distp(i,3)=rmu(2,i)**2 + distp(i,4)=rmu(3,i)**2 + ! lz=+/-2 + distp(i,5)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,6)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,7)=rmu(1,i)*rmu(3,i)*cost3d + end do + + + do ic=1,6 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + + + if(typec.ne.1) then + + dd1=dd(indparp) + fun0=distp(0,1) + fun=-2.d0*dd1*distp(0,1) + fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + + ! indorbp=indorb + do ic=1,6 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.le.3) then + if(i.eq.ic) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0 + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + if(ic.le.3) then + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2)+2.d0*distp(0,1) + else + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + end if + !endif for iocc + ! endif + ! enddo fot ic + end do + + + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+6 + indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_48.f90 b/devel_tools/makefun_factory/orb_48.f90 new file mode 100644 index 0000000..dd90854 --- /dev/null +++ b/devel_tools/makefun_factory/orb_48.f90 @@ -0,0 +1,118 @@ + ! f orbital + ! + ! - angmom = 3 + ! - type = Gaussian + ! - normalized = yes + ! - angtype = spherical + ! - npar = 1 + ! - multiplicity = 7 + ! + + indparp=indpar+1 + dd1=dd(indparp) + + c=dd1**2.25d0*1.47215808929909374563d0 + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + do i=indtmin,indtm + distp(i,2)=cost1f*rmu(3,i) & + *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=0 + distp(i,3)=cost2f*rmu(1,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2f*rmu(2,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3f*rmu(3,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-2 + distp(i,6)=cost3f*2.d0*rmu(3,i) & + *rmu(1,i)*rmu(2,i) + ! lz=+/-2 + distp(i,7)=cost4f*rmu(1,i) & + *(rmu(1,i)**2-3.d0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4f*rmu(2,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + end do + + do ic=1,7 + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + end do + + + if(typec.ne.1) then + + dd1=dd(indparp) + fun0=distp(0,1) + fun=-2.d0*dd1*distp(0,1) + fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + + do ic=1,7 + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + end do + if(ic.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1)- & + 6.d0*cost1f*fun0*rmu(1,0)*rmu(3,0) + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 6.d0*cost1f*fun0*rmu(2,0)*rmu(3,0) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + cost1f*fun0*(9.d0*rmu(3,0)**2-3.d0*r(0)**2) + elseif(ic.eq.2) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2-2.d0*rmu(1,0)**2) + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 2.d0*cost2f*fun0*rmu(2,0)*rmu(1,0) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + 8.d0*cost2f*fun0*rmu(3,0)*rmu(1,0) + elseif(ic.eq.3) then + z(indorbp,indt+1)=z(indorbp,indt+1)- & + 2.d0*cost2f*fun0*rmu(1,0)*rmu(2,0) + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2-2.d0*rmu(2,0)**2) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + 8.d0*cost2f*fun0*rmu(3,0)*rmu(2,0) + elseif(ic.eq.4) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + elseif(ic.eq.5) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) + elseif(ic.eq.6) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + else + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) + end do + end if + + indpar=indpar+1 + indshell=indshell+7 + indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_49.f90 b/devel_tools/makefun_factory/orb_49.f90 new file mode 100644 index 0000000..d027586 --- /dev/null +++ b/devel_tools/makefun_factory/orb_49.f90 @@ -0,0 +1,157 @@ + ! f orbitals + ! R(r)= c*exp(-z r^2)*(9/4/z-r^2) + + + + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) + c=dd1**2.25d0*1.47215808929909374563d0 + ! endif + + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + + do i=indtmin,indtm + distp(i,2)=cost1f*rmu(3,i) & + *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=0 + distp(i,3)=cost2f*rmu(1,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2f*rmu(2,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3f*rmu(3,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-2 + distp(i,6)=cost3f*2.d0*rmu(3,i) & + *rmu(1,i)*rmu(2,i) + ! lz=+/-2 + distp(i,7)=cost4f*rmu(1,i) & + *(rmu(1,i)**2-3.d0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4f*rmu(2,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + end do + + + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*(9.d0/4.d0/dd1-r(k)**2)* & + distp(k,1+ic) + end do + ! endif + end do + + + if(typec.ne.1) then + + dd1=dd(indparp) + fun0=distp(0,1)*(9.d0/4.d0/dd1-r(0)**2) + fun=distp(0,1)*(2.d0*dd1*r(0)**2-13.d0/2.d0) + fun2=distp(0,1)*(-4.d0*dd1**2*r(0)**4 & + +19.d0*dd1*r(0)**2-13.d0/2.d0) + + + ! indorbp=indorb + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) + if(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) + end if + elseif(ic.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + end if + elseif(ic.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + end if + else + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+7 + indorb=indorbp + + + diff --git a/devel_tools/makefun_factory/orb_5.f90 b/devel_tools/makefun_factory/orb_5.f90 new file mode 100644 index 0000000..fe5dd39 --- /dev/null +++ b/devel_tools/makefun_factory/orb_5.f90 @@ -0,0 +1,43 @@ + ! normalized + + indshellp=indshell+1 + + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + + do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)) + end do + + ! if(iflagnorm.gt.2) then + ! c=dd1**2.5d0/dsqrt(3.d0*pi) + c=dd1**2.5d0*0.32573500793527994772d0 + ! endif + + do i=i0,indtm + z(indorbp,i)=c*r(i)*distp(i,1) + end do + + if(typec.ne.1) then + + fun=distp(0,1)*(1.d0-dd1*r(0)) + fun2=distp(0,1)*(dd1**2*r(0)-2.d0*dd1) + + do i=1,3 + z(indorbp,indt+i)=c*fun*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=c*2.d0*fun/r(0)+c*fun2 + + end if + + indorb=indorbp + + ! endif + indpar=indpar+1 + indshell=indshellp + + + ! 2s double Z NO CUSP diff --git a/devel_tools/makefun_factory/orb_50.f90 b/devel_tools/makefun_factory/orb_50.f90 new file mode 100644 index 0000000..feee58d --- /dev/null +++ b/devel_tools/makefun_factory/orb_50.f90 @@ -0,0 +1,55 @@ + ! R(r)=(c0*r**4+c1*r**3)*exp(-z1*r) + ! + indshellp=indshell+1 + + + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 + ! endif + + c0=-c + c1=4.5d0*c/dd1 + + do k=indtmin,indtm + distp(k,1)=r(k)*dexp(-dd1*r(k)) + end do + + do i=i0,indtm + z(indorbp,i)=(c0*r(i)**3+c1*r(i)**2)*distp(i,1) + end do + + if(typec.ne.1) then + rp1=r(0)*dd1 + rp2=rp1*rp1 + + !c the first derivative/r + fun=-distp(0,1)*(c0*r(0)*(rp1-4.d0)+c1*(rp1-3.d0)) + + !c + + !c the second derivative + fun2=distp(0,1)* & + (c0*r(0)*(12.d0-8.d0*rp1+rp2)+c1*(6.d0-6*rp1+rp2)) + !c + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + + end if + ! + indorb=indorbp + ! + ! endif + indpar=indpar+1 + indshell=indshellp + ! + + + diff --git a/devel_tools/makefun_factory/orb_51.f90 b/devel_tools/makefun_factory/orb_51.f90 new file mode 100644 index 0000000..fda86ad --- /dev/null +++ b/devel_tools/makefun_factory/orb_51.f90 @@ -0,0 +1,189 @@ + ! g single gaussian orbital + ! R(r)= exp(-alpha r^2) + ! normalized + + + ! indorbp=indorb + indparp=indpar+1 + + dd1=dd(indparp) + + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0) + c=dd1**2.75d0*1.11284691281640568826d0 + ! endif + + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + + do i=indtmin,indtm + distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & + -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) + ! lz=0 + distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & + *(rmu(1,i)**2-3.0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + distp(i,9)=cost5g*(rmu(1,i)**4 & + -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) + ! lz=+/-4 + distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-4 + end do + + + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + + + if(typec.ne.1) then + + dd1=dd(indparp) + fun0=distp(0,1) + fun=-2.d0*dd1*distp(0,1) + fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + + + ! indorbp=indorb + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun + end do + if(ic.eq.1) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) + ! else + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) + ! endif + elseif(ic.eq.2) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + ! else + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + ! endif + elseif(ic.eq.3) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + ! else + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + ! endif + elseif(ic.eq.4) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) + ! else + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) + ! endif + elseif(ic.eq.5) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) + ! else + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + ! endif + elseif(ic.eq.6) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + ! else + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + ! endif + elseif(ic.eq.7) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + ! else + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + ! endif + elseif(ic.eq.8) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) + ! endif + elseif(ic.eq.9) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + ! endif + end if + !enddo for i + ! enddo + z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+9 + indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_52.f90 b/devel_tools/makefun_factory/orb_52.f90 new file mode 100644 index 0000000..b2a04e9 --- /dev/null +++ b/devel_tools/makefun_factory/orb_52.f90 @@ -0,0 +1,193 @@ + ! g single gaussian orbital + ! derivative of 51 + ! R(r)= exp(-alpha r^2) + ! normalized + + + ! indorbp=indorb + indparp=indpar+1 + + dd1=dd(indparp) + + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0) + c=dd1**2.75d0*1.11284691281640568826d0 + ! endif + + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + + do i=indtmin,indtm + distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & + -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) + ! lz=0 + distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & + *(rmu(1,i)**2-3.0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + distp(i,9)=cost5g*(rmu(1,i)**4 & + -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) + ! lz=+/-4 + distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-4 + end do + + + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*(11.d0/4.d0/dd1-r(k)**2)* & + distp(k,1+ic) + end do + ! endif + end do + + + if(typec.ne.1) then + + dd1=dd(indparp) + fun0=distp(0,1)*(11.d0/4.d0/dd1-r(0)**2) + fun=distp(0,1)*(2.d0*dd1*r(0)**2-15.d0/2.d0) + fun2=distp(0,1)*(-4.d0*dd1**2*r(0)**4 & + +21.d0*dd1*r(0)**2-15.d0/2.d0) + + + ! indorbp=indorb + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun + if(ic.eq.1) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + elseif(ic.eq.7) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + end if + elseif(ic.eq.8) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) + end if + elseif(ic.eq.9) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+9 + indorb=indorbp + + + + diff --git a/devel_tools/makefun_factory/orb_55.f90 b/devel_tools/makefun_factory/orb_55.f90 new file mode 100644 index 0000000..a929d2b --- /dev/null +++ b/devel_tools/makefun_factory/orb_55.f90 @@ -0,0 +1,191 @@ + ! g single Slater orbital + ! R(r)= exp(-alpha r) + ! normalized + + + ! indorbp=indorb + indparp=indpar+1 + + dd1=dd(indparp) + + ! if(iflagnorm.gt.2) then + ! overall normalization + ! l = 4 + ! \int d\omega Y*Y = 4 pi / (2 l + 1) + ! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5**2 * 3**4 / 2**3 / dd1**11 + ! c=1.d0/dsqrt(7.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(11.d0/2.d0)/3.d0/5.d0 + c=dd1**5.5d0*.020104801169736915d0 + ! endif + + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + end do + + + do i=indtmin,indtm + distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & + -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) + ! lz=0 + distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & + *(rmu(1,i)**2-3.0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + distp(i,9)=cost5g*(rmu(1,i)**4 & + -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) + ! lz=+/-4 + distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-4 + end do + + + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + + + if(typec.ne.1) then + + dd1=dd(indparp) + fun0=distp(0,1) + fun=-dd1*distp(0,1)/r(0) + fun2=dd1**2*distp(0,1) + + + ! indorbp=indorb + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun + if(ic.eq.1) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + elseif(ic.eq.7) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + end if + elseif(ic.eq.8) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) + end if + elseif(ic.eq.9) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+9 + indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_56.f90 b/devel_tools/makefun_factory/orb_56.f90 new file mode 100644 index 0000000..69e6003 --- /dev/null +++ b/devel_tools/makefun_factory/orb_56.f90 @@ -0,0 +1,191 @@ + ! g single Slater orbital derivative of 55 + ! R(r)= (11.d0/2.0 1/dd1 - r) * exp(-alpha r) + ! normalized + + + ! indorbp=indorb + indparp=indpar+1 + + dd1=dd(indparp) + + ! if(iflagnorm.gt.2) then + ! overall normalization + ! l = 4 + ! \int d\omega Y*Y = 4 pi / (2 l + 1) + ! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5**2 * 3**4 / 2**3 / dd1**11 + c=dd1**5.5d0*.020104801169736915d0 + ! c=1.d0/dsqrt(7.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(11.d0/2.d0)/3.d0/5.d0 + ! endif + + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + end do + + + do i=indtmin,indtm + distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & + -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) + ! lz=0 + distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & + *(rmu(1,i)**2-3.0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + distp(i,9)=cost5g*(rmu(1,i)**4 & + -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) + ! lz=+/-4 + distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-4 + end do + + + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*distp(k,1+ic)*(11.d0/2.d0/dd1 - r(k)) + end do + ! endif + end do + + + if(typec.ne.1) then + + dd1=dd(indparp) + fun0=distp(0,1)*(11.d0/2.d0/dd1-r(0)) + fun=distp(0,1)*(dd1-13.d0/2.d0/r(0)) + fun2=dd1*distp(0,1)*(15.d0/2.d0-dd1*r(0)) + + + ! indorbp=indorb + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun + if(ic.eq.1) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + elseif(ic.eq.7) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + end if + elseif(ic.eq.8) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) + end if + elseif(ic.eq.9) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+9 + indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_57.f90 b/devel_tools/makefun_factory/orb_57.f90 new file mode 100644 index 0000000..f6727bf --- /dev/null +++ b/devel_tools/makefun_factory/orb_57.f90 @@ -0,0 +1,72 @@ + ! orbital 1s (no cusp) - STO regolarized for r->0 + ! R(r)= C(z) * P(z*r) * exp(-z*r) + ! P(x) = (x+a)^n/(1+(x+a)^n) with a so that P(0)==dP(0)/dx + ! C(z) = const * z^(3/2) normalization + ! the following definitions are in module constants + ! n -> costSTO1s_n = 4 + ! a -> costSTO1s_a = 1.2263393530877080588 + ! const(n) -> costSTO1s_c = 0.58542132302621750732 + ! + ! + + + indshellp=indshell+1 + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + + dd1=dd(indpar+1) + + ! if(iflagnorm.gt.2) then + ! if(dd1.gt.0.) then + c=costSTO1s_c*dd1**1.5d0 + ! else + ! c=1.d0 + ! endif + ! endif + + do i=indtmin,indtm + distp(i,1)=c*dexp(-dd1*r(i)) + end do + + do i=i0,indtm + rp4=(dd1*r(i)+costSTO1s_a)**costSTO1s_n + z(indorbp,i)=distp(i,1)*rp4/(1.d0+rp4) + end do + + if(typec.ne.1) then + rp1=dd1*r(0)+costSTO1s_a + rp2=rp1**2 + rp4=rp1**costSTO1s_n + rp6=rp4**2 + ! the first derivative /r + !fun=-z(indorbp,0)*((dd1**2*(-costSTO1s_n+rp1+rp1*rp4))/ & + ! &(rp1*(-costSTO1s_a+rp1)*(1.d0+rp4))) + fun=-distp(0,1)*rp4* & + ((dd1**2*(-costSTO1s_n+rp1+rp1*rp4))/ & + (rp1*(-costSTO1s_a+rp1)*(1.d0+rp4)**2)) + ! the second derivative derivative + fun2=+distp(0,1)*rp4*(dd1**2*(-(costSTO1s_n**2* & + (-1.d0+rp4))-costSTO1s_n*(1.d0+2.d0*rp1)*(1.d0+rp4) & + +rp2*(1.d0+rp4)**2)) / (rp2*(1.d0+rp4)**3) + ! gradient: dR(r)/dr_i=r_i*fun + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + ! laplacian = 2*fun+fun2 + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + + indorb=indorbp + + ! endif + + indpar=indpar+1 + indshell=indshellp + + + + + + diff --git a/devel_tools/makefun_factory/orb_6.f90 b/devel_tools/makefun_factory/orb_6.f90 new file mode 100644 index 0000000..21b82f2 --- /dev/null +++ b/devel_tools/makefun_factory/orb_6.f90 @@ -0,0 +1,52 @@ + ! normalized + + indshellp=indshell+1 + + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + + ! if(iflagnorm.gt.2) then + ! c= WRONG + ! &0.5*dsqrt((1.d0/dd1**5/32.d0+2.d0*peff/(dd1+dd2)**5 + ! &+peff**2/dd2**5/32.d0)/(24.d0*pi)) + + c=1.d0/dsqrt((3.d0*pi)* & + (1.d0/dd1**5+ 64.d0*peff/(dd1+dd2)**5+peff**2/dd2**5)) + + ! endif + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + end do + + do i=i0,indtm + z(indorbp,i)=r(i)*(distp(i,1)+distp(i,2)*peff) + end do + + if(typec.ne.1) then + + fun=distp(0,1)*(1.d0-dd1*r(0)) & + +peff*distp(0,2)*(1.d0-dd2*r(0)) + fun2=distp(0,1)*(dd1**2*r(0)-2.d0*dd1)+peff*distp(0,2) & + *(dd2**2*r(0)-2.d0*dd2) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=(2.d0*fun/r(0)+fun2) + + end if + + indorb=indorbp + + ! endif + indpar=indpar+3 + indshell=indshellp + + ! 2s double Z NO CUSP diff --git a/devel_tools/makefun_factory/orb_60.f90 b/devel_tools/makefun_factory/orb_60.f90 new file mode 100644 index 0000000..12d3099 --- /dev/null +++ b/devel_tools/makefun_factory/orb_60.f90 @@ -0,0 +1,44 @@ + ! R(r)=r**3*exp(-z*r**2) single zeta + + + + indshellp=indshell+1 + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + + ! if(iflagnorm.gt.2) then + ! c=2.d0/pi**(3.d0/4.d0)*(2.d0*dd1)**(9.d0/4.d0)*dsqrt(2.d0/105.d0) + c=dd1**2.25d0*.55642345640820284397d0 + ! endif + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2)*r(k) + end do + + do i=i0,indtm + z(indorbp,i)=distp(i,1)*r(i)**2 + end do + + if(typec.ne.1) then + rp1=r(0)**2*dd1 + ! the first derivative / r + fun=distp(0,1)*(3.d0-2.d0*rp1) + ! the second derivative + fun2=distp(0,1)*(6.d0-14.d0*rp1+4.d0*rp1**2) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + + indorb=indorbp + + ! endif + + indpar=indpar+1 + indshell=indshellp + + ! 3s -derivative of 60 with respect to dd1 diff --git a/devel_tools/makefun_factory/orb_61.f90 b/devel_tools/makefun_factory/orb_61.f90 new file mode 100644 index 0000000..aa90f8b --- /dev/null +++ b/devel_tools/makefun_factory/orb_61.f90 @@ -0,0 +1,49 @@ + ! R(r)=c (-r**5*exp(-z1*r**2)+c1 r**3 exp(-z1*r**2)) + + + indshellp=indshell+1 + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + + ! if(iflagnorm.gt.2) then + ! c=2.d0/pi**(3.d0/4.d0)*(2.d0*dd1)**(9.d0/4.d0)*dsqrt(2.d0/105.d0) + c=dd1**2.25d0*.55642345640820284397d0 + ! endif + + c1=2.25d0/dd1 + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2)*r(k) + end do + + do i=i0,indtm + z(indorbp,i)=(-r(i)**4+c1*r(i)**2)*distp(i,1) + end do + + + if(typec.ne.1) then + rp1=r(0)**2 + rp2=rp1*dd1 + + fun=c1*distp(0,1)*(3.d0-2.d0*rp2) & + +distp(0,1)*rp1*(-5.d0+2.d0*rp2) + ! the second derivative + fun2=c1*distp(0,1)*(6.d0-14.d0*rp2+4.d0*rp2**2) & + +distp(0,1)*rp1*(-20.d0+22.d0*rp2-4.d0*rp2**2) + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + + indorb=indorbp + + ! endif + indpar=indpar+1 + indshell=indshellp + + ! single gaussianx r p orbitals diff --git a/devel_tools/makefun_factory/orb_62.f90 b/devel_tools/makefun_factory/orb_62.f90 new file mode 100644 index 0000000..b2438e6 --- /dev/null +++ b/devel_tools/makefun_factory/orb_62.f90 @@ -0,0 +1,54 @@ + + + + dd1=dd(indpar+1) + + + ! if(iflagnorm.gt.2) then + ! c=2.d0/pi**0.75d0*(2.d0*dd1)**1.75d0/dsqrt(5.d0) + c=dd1**1.75d0*1.2749263037197753d0 + ! endif + + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i) + end do + ! endif + end do + + if(typec.ne.1) then + fun0=distp(0,1)*r(0) + cost=2.d0*dd1*r(0)**2 + fun=distp(0,1)*(1.d0-cost)/r(0) + fun2=2.d0*dd1*fun0*(cost-3.d0) + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + ! endif + end do + + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp + + ! derivative of 62 with respect zeta diff --git a/devel_tools/makefun_factory/orb_63.f90 b/devel_tools/makefun_factory/orb_63.f90 new file mode 100644 index 0000000..f00a781 --- /dev/null +++ b/devel_tools/makefun_factory/orb_63.f90 @@ -0,0 +1,62 @@ + ! R(r)=c x*exp(-z*r**2)*r (c1 - r^2) + + + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + c=dd1**1.75d0*1.2749263037197753d0 + ! c=2.d0/pi**0.75d0*(2.d0*dd1)**1.75d0/dsqrt(5.d0) + ! endif + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + c1=1.75d0/dd1 + + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1)* & + (c1-r(i)**2)*r(i) + end do + ! endif + end do + + if(typec.ne.1) then + + + + rp1=dd1*r(0)**2 + cost=2.d0*rp1 + + fun0=distp(0,1)*r(0)*(c1-r(0)**2) + fun=distp(0,1)*(c1*(1.d0-cost)/r(0)+ & + (-3.d0+cost)*r(0)) + ! My bug !!! + ! fun2=distp(0,1)*(c1*2.d0*dd1*fun0*(cost-3.d0) + ! &-2.d0*r(0)*(3.d0-7.d0*rp1+2.d0*rp1**2)) + fun2=-2.d0*distp(0,1)*r(0)* & + (3.d0-7.d0*rp1+2.d0*rp1**2+c1*dd1*(3.d0-cost)) + + + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + ! endif + end do + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_64.f90 b/devel_tools/makefun_factory/orb_64.f90 new file mode 100644 index 0000000..654685f --- /dev/null +++ b/devel_tools/makefun_factory/orb_64.f90 @@ -0,0 +1,121 @@ + ! d orbitals + ! R(r)= r exp(-alpha r^2) + ! each gaussian term is normalized + + + + ! indorbp=indorb + indparp=indpar+1 + + dd1=dd(indparp) + + ! if(iflagnorm.gt.2) then + ! c=8.d0/dsqrt(21.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) + c=dd1**2.25d0*1.24420067280413253d0 + ! endif + + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + + do i=indtmin,indtm + ! lz=0 + distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/-2 + distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d + end do + + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*distp(k,1+ic)*r(k) + end do + ! endif + end do + + + if(typec.ne.1) then + + dd1=dd(indparp) + + rp1=2.d0*dd1*r(0) + rp2=rp1*r(0) + fun0=distp(0,1)*r(0) + fun=(1.d0-rp2)*distp(0,1)/r(0) + fun2=distp(0,1)*rp1*(rp2-3.d0) + + + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + end if + + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_65.f90 b/devel_tools/makefun_factory/orb_65.f90 new file mode 100644 index 0000000..a53a53c --- /dev/null +++ b/devel_tools/makefun_factory/orb_65.f90 @@ -0,0 +1,135 @@ + ! d orbitals + ! R(r)= c0 r^3 exp(-alpha r^2)+ c1 r exp(-alpha r^2) + ! each gaussian term is normalized + + + + ! indorbp=indorb + indparp=indpar+1 + + dd1=dd(indparp) + + ! if(iflagnorm.gt.2) then + ! overall normalization to be done + ! c=8.d0/dsqrt(21.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) + c=dd1**2.25d0*1.24420067280413253d0 + ! endif + + c0=-c + + c1=2.25d0*c/dd1 + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + + do i=indtmin,indtm + ! lz=0 + distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/-2 + distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d + end do + + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*(c0*distp(k,1+ic)*r(k)**3+ & + c1*r(k)) + end do + ! endif + end do + + + if(typec.ne.1) then + + dd1=dd(indparp) + + rp1=2.d0*dd1*r(0) + rp2=rp1*r(0) + fun0=distp(0,1)*(c1*r(0)+c0*r(0)**3) + fun=(c1*(1.d0-rp2)+c0*r(0)**2*(3.d0-rp2)) & + *distp(0,1)/r(0) + + fun2=distp(0,1)*(c1*rp1*(rp2-3.d0)+c0*r(0) & + *(3.d0-3.5d0*rp2+0.5d0*rp2**2)) + + + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp + + + + + ! ******************* END GAUSSIAN BASIS ************************ + + ! ** ** ** ** ** ** ** JASTROW ORBITALS ** ** ** ** ** ** ** ** * diff --git a/devel_tools/makefun_factory/orb_66.f90 b/devel_tools/makefun_factory/orb_66.f90 new file mode 100644 index 0000000..bfb303d --- /dev/null +++ b/devel_tools/makefun_factory/orb_66.f90 @@ -0,0 +1,101 @@ + ! derivative of 57 (orbital 1s STO regolarized for r->0) + ! dR(r)/dz with R(r)= C(z) * P(z*r) * exp(-z*r) + ! P(x) = (x+a)^n/(1+(x+a)^n) with a so that P(0)==dP(0)/dx + ! C(z) = const * z^(3/2) normalization + ! the following definitions are in module constants + ! n -> costSTO1s_n = 4 + ! a -> costSTO1s_a = 1.2263393530877080588 + ! const(n) -> costSTO1s_c = 0.58542132302621750732 + ! + + + indshellp=indshell+1 + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + + dd1=dd(indpar+1) + + ! if(iflagnorm.gt.2) then + ! if(dd1.gt.0.) then + c=costSTO1s_c*dd1**1.5d0 + ! else + ! c=1.d0 + ! endif + ! endif + + do i=indtmin,indtm + distp(i,1)=c*dexp(-dd1*r(i)) + end do + + do i=i0,indtm + rp1=dd1*r(i)+costSTO1s_a + rp4=rp1**costSTO1s_n + z(indorbp,i)=distp(i,1)*rp4/(1.d0+rp4)* & + (1.5d0/dd1 + r(i)* & + (-1.d0+(costSTO1s_n)/(rp1*(1.d0+rp4)))) + end do + + if(typec.ne.1) then + rp1=dd1*r(0)+costSTO1s_a + rp2=rp1**2 + rp4=rp1**costSTO1s_n + rp6=rp4**2 + ! the first derivative /r + fun=distp(0,1)*(dd1*rp4*(-2.d0*costSTO1s_a*(costSTO1s_n**2* & + (-1.d0+rp4)+costSTO1s_n*(1.d0+2.d0*rp1)*(1.d0+rp4)-rp2* & + (1.d0+rp4)**2) +rp1*(2*costSTO1s_n**2*(-1+rp4)+costSTO1s_n & + *(-3.d0+4.d0*rp1)*(1.d0+rp4)-rp1*(-5.d0+2.d0*rp1)*(1.d0+ & + rp4)**2)))/(2.d0*rp2*(costSTO1s_a-rp1)*(1.d0+rp4)**3) + + ! fun=+distp(0,1)*rp4/(1.d0+rp4)*(1.5d0/dd1 + r(0)* & + ! &(-1.d0+(costSTO1s_n)/(rp1*(1.d0+rp4)))) & + ! &*(dd1*(2.d0 + 5.d0/(-dd1*r(0)) + & + ! &(4.d0*costSTO1s_n**2)/(rp2*(1.d0+rp4)**2) + & + ! &(costSTO1s_n*((3.d0 - 2.d0*costSTO1s_n - 4.d0*rp1)*rp1& + ! &+ 2.d0*costSTO1s_a*(1.d0+costSTO1s_n+2.d0*rp1)))/ & + ! &(rp2*(dd1*r(0))*(1 + rp4))))/2.d0 + + ! the second derivative derivative + fun2=-distp(0,1)*(dd1*rp4*(rp1*(-(costSTO1s_n*(-3.d0-8.d0*rp1+ & + 6.d0*rp2)*(1.d0+rp4)**2)+rp2*(-7.d0+2.d0*rp1)*(1.d0+rp4)**3- & + costSTO1s_n**2*(-1.d0+6.d0*rp1)*(-1.d0+rp6)-2*costSTO1s_n**3*& + (1.d0+rp4*(-4.d0+rp4))) + 2.d0*costSTO1s_a*(-(rp1*rp2*(1.d0 +& + rp4)**3) + 3.d0*costSTO1s_n**2*(1.d0+rp1)*(-1.d0+rp6)+ & + costSTO1s_n*(1.d0+rp4)**2*(2.d0+3.d0*rp1*(1.d0+rp1)) + & + costSTO1s_n**3*(1.d0+rp4*(-4.d0+rp4)))))/ & + (2.d0*rp1*rp2*(1+rp4)**4) + + ! fun2=-distp(0,1)*rp4/(1.d0+rp4)*(1.5d0/dd1 + r(0)*& + ! &(-1.d0+(costSTO1s_n)/(rp1*(1.d0+rp4)))) & + ! &*(dd1*(rp1*(-(costSTO1s_n*(-3 - 8*rp1 & + ! &+ 6*rp2)*(1 + rp4)**2) + rp2*(-7 + 2*rp1)*(1 + rp4)**3 - & + ! &costSTO1s_n**2*(-1 + 6*rp1)*(-1 + rp6) - 2*costSTO1s_n**3* & + ! &(1 + rp4*(-4 + rp4))) - 2*costSTO1s_a*(-(rp1*rp2*(1 + rp4)**3)& + ! &+ 3*costSTO1s_n**2*(1 + rp1)*(-1 + rp6) + costSTO1s_n*(1 + & + ! &rp4)**2 *(2 + 3*rp1*(1 +rp1)) + costSTO1s_n**3*(1 + rp4*(-4 +& + ! &rp4)))))/(2.*rp1*rp2*(1 + rp4)**3) + + ! gradient: dR(r)/dr_i=r_i*fun + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + ! laplacian = 2*fun+fun2 + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + + indorb=indorbp + + ! endif + + indpar=indpar+1 + indshell=indshellp + + + + + + + + diff --git a/devel_tools/makefun_factory/orb_7.f90 b/devel_tools/makefun_factory/orb_7.f90 new file mode 100644 index 0000000..68eba42 --- /dev/null +++ b/devel_tools/makefun_factory/orb_7.f90 @@ -0,0 +1,48 @@ + ! normalized IS WRONG!!! + + indshellp=indshell+1 + + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + + do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)) + distp(k,2)=dexp(-dd2*r(k)) + end do + ! if(iflagnorm.gt.2) then + c= & + 1/dsqrt(1/(3.D0/4.D0/dd1**5+peff**2/dd2**3/4+12*peff/ & + (dd1+dd2)**4))*1.d0/dsqrt(4.0*pi) + ! endif + + do i=i0,indtm + z(indorbp,i)=c*(distp(i,1)+r(i)*distp(i,2)*peff) + end do + + if(typec.ne.1) then + + fun=-dd1*distp(0,1)+peff*distp(0,2)*(1.d0-dd2*r(0)) + fun2=distp(0,1)*dd1**2 & + +peff*distp(0,2)*(dd2**2*r(0)-2.d0*dd2) + + do i=1,3 + z(indorbp,indt+i)=fun*c*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=c*(2.d0*fun/r(0)+fun2) + + end if + + indorb=indorbp + + ! endif + indpar=indpar+3 + indshell=indshellp + + + + ! 2s double Z WITH CUSP diff --git a/devel_tools/makefun_factory/orb_70.f90 b/devel_tools/makefun_factory/orb_70.f90 new file mode 100644 index 0000000..e0f7897 --- /dev/null +++ b/devel_tools/makefun_factory/orb_70.f90 @@ -0,0 +1,158 @@ + ! f single Slater orbital + ! R(r)= exp(-alpha r) + ! normalized + + + ! indorbp=indorb + indparp=indpar+1 + + dd1=dd(indparp) + + ! if(iflagnorm.gt.2) then + ! overall normalization + ! l = 3 + ! \int d\omega Y*Y = 4 pi / (2 l + 1) + ! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5 * 3**2 / 2**2 / dd1**9 + ! c=1.d0/dsqrt(10.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(9.d0/2.d0)/3.d0 + c=dd1**4.5d0*0.084104417400672d0 + ! endif + + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + end do + + + do i=indtmin,indtm + distp(i,2)=cost1f*rmu(3,i) & + *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=0 + distp(i,3)=cost2f*rmu(1,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2f*rmu(2,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3f*rmu(3,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-2 + distp(i,6)=cost3f*2.d0*rmu(3,i) & + *rmu(1,i)*rmu(2,i) + ! lz=+/-2 + distp(i,7)=cost4f*rmu(1,i) & + *(rmu(1,i)**2-3.d0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4f*rmu(2,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + end do + + + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + + + if(typec.ne.1) then + + dd1=dd(indparp) + fun0=distp(0,1) + fun=-dd1*distp(0,1)/r(0) + fun2=dd1**2*distp(0,1) + + ! indorbp=indorb + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) + if(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) + end if + elseif(ic.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + end if + elseif(ic.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + end if + else + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+7 + indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_71.f90 b/devel_tools/makefun_factory/orb_71.f90 new file mode 100644 index 0000000..3f7da00 --- /dev/null +++ b/devel_tools/makefun_factory/orb_71.f90 @@ -0,0 +1,160 @@ + ! f single Slater orbital derivative of 70 + ! R(r)= (9.d0/2.0 1/dd1 - r) * exp(-alpha r) + ! normalized + + + ! indorbp=indorb + indparp=indpar+1 + + dd1=dd(indparp) + + ! if(iflagnorm.gt.2) then + ! overall normalization + ! l = 3 + ! \int d\omega Y*Y = 4 pi / (2 l + 1) + ! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5 * 3**2 / 2**2 / dd1**9 + ! c=1.d0/dsqrt(10.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(9.d0/2.d0)/3.d0 + c=dd1**4.5d0*0.084104417400672d0 + ! endif + + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)) + end do + + + do i=indtmin,indtm + distp(i,2)=cost1f*rmu(3,i) & + *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=0 + distp(i,3)=cost2f*rmu(1,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2f*rmu(2,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3f*rmu(3,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-2 + distp(i,6)=cost3f*2.d0*rmu(3,i) & + *rmu(1,i)*rmu(2,i) + ! lz=+/-2 + distp(i,7)=cost4f*rmu(1,i) & + *(rmu(1,i)**2-3.d0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4f*rmu(2,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + end do + + + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*distp(k,1+ic)*(9.d0/2.d0/dd1 - r(k)) + end do + ! endif + end do + + + if(typec.ne.1) then + + dd1=dd(indparp) + fun0=distp(0,1)*(9.d0/2.d0/dd1-r(0)) + fun=distp(0,1)*(dd1-11.d0/2.d0/r(0)) + fun2=dd1*distp(0,1)*(13.d0/2.d0-dd1*r(0)) + + ! indorbp=indorb + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) + if(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) + end if + elseif(ic.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + end if + elseif(ic.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + end if + else + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+7 + indorb=indorbp + + + + ! 3s -derivative of 34 with respect to dd1 diff --git a/devel_tools/makefun_factory/orb_72.f90 b/devel_tools/makefun_factory/orb_72.f90 new file mode 100644 index 0000000..32abbe3 --- /dev/null +++ b/devel_tools/makefun_factory/orb_72.f90 @@ -0,0 +1,186 @@ + + + ! indorbp=indorb + indparp=indpar+1 + + dd1=dd(indparp) + + ! if(iflagnorm.gt.2) then + ! overall normalization obtained by Mathematica + c=dd1**3.25d0*0.79296269381073167718d0 + ! C= dd1^13/4 /Sqrt[Integrate[x^12 Exp[-2 x^2],{x,0,Infinity}]] + ! endif + + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + do i=indtmin,indtm + do k=1,5 + zv(k)=rmu(3,i)**k + yv(k)=rmu(2,i)**k + xv(k)=rmu(1,i)**k + end do + r2=xv(2)+yv(2)+zv(2) + r4=r2*r2 + ! lz=0 + distp(i,2)=cost1h*(63.d0*zv(5)-70.d0*zv(3)*r2+15.d0*zv(1)*r4) + + cost=(21.d0*zv(4)-14.d0*zv(2)*r2+r4) + ! lz=+/-1 + distp(i,3)=cost2h*rmu(1,i)*cost + ! lz=+/-1 + distp(i,4)=cost2h*rmu(2,i)*cost + + cost=3.d0*zv(3)-zv(1)*r2 + ! lz=+/-2 + distp(i,5)=cost3h*(xv(2)-yv(2))*cost + ! lz=+/-2 + distp(i,6)=2.d0*cost3h*xv(1)*yv(1)*cost + + cost=9.d0*zv(2)-r2 + ! lz=+/-3 + distp(i,7)=cost4h*(xv(3)-3.d0*xv(1)*yv(2))*cost + ! lz=+/-3 + distp(i,8)=-cost4h*(yv(3)-3.d0*yv(1)*xv(2))*cost + + ! lz=+/-4 + distp(i,9)=cost5h*(xv(4)-6.d0*xv(2)*yv(2)+yv(4))*zv(1) + ! lz=+/-4 + distp(i,10)=cost5h*4.d0*(xv(3)*yv(1)-yv(3)*xv(1))*zv(1) + ! lz=+/-5 + distp(i,11)=cost6h*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4)) + ! lz=+/-5 + distp(i,12)=-cost6h*(-5.d0*xv(4)*yv(1)+10.d0*xv(2)*yv(3)-yv(5)) + + end do + + + do ic=1,11 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + + + if(typec.ne.1) then + + dd1=dd(indparp) + fun0=distp(0,1) + fun=-2.d0*dd1*distp(0,1) + fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + do k=1,5 + zv(k)=rmu(3,0)**k + yv(k)=rmu(2,0)**k + xv(k)=rmu(1,0)**k + end do + + r2=xv(2)+yv(2)+zv(2) + r4=r2*r2 + + + ! indorbp=indorb + do ic=1,11 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun + end do + if(ic.eq.1) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost1h*fun0*20.d0*xv(1)*zv(1)*(3.d0*xv(2)+3.d0*yv(2)-4.d0*zv(2)) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost1h*fun0*20.d0*yv(1)*zv(1)*(3.d0*xv(2)+3.d0*yv(2)-4.d0*zv(2)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost1h*fun0*(175.d0*zv(4)-150.d0*zv(2)*r2+15.d0*r4) + elseif(ic.eq.2) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost2h*fun0*(5.d0*xv(4)+6.d0*xv(2)*yv(2)+yv(4)-36.d0*xv(2)*zv(2)& + -12.d0*yv(2)*zv(2)+8.d0*zv(4)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost2h*fun0*(4.d0*xv(3)*yv(1)+4.d0*xv(1)*yv(3)-24.d0*xv(1)*yv(1)*zv(2)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost2h*fun0*(-24.d0*xv(3)*zv(1)-24.d0*xv(1)*yv(2)*zv(1)+32.d0*zv(3)*xv(1)) + elseif(ic.eq.3) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost2h*fun0*(-4.d0*xv(3)*yv(1)-4.d0*xv(1)*yv(3)+24.d0*xv(1)*yv(1)*zv(2)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost2h*fun0*(5.d0*yv(4)+6.d0*xv(2)*yv(2)+xv(4)-36.d0*yv(2)*zv(2)& + -12.d0*xv(2)*zv(2)+8.d0*zv(4)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost2h*fun0*(-24.d0*yv(3)*zv(1)-24.d0*yv(1)*xv(2)*zv(1) & + +32.d0*zv(3)*yv(1)) + elseif(ic.eq.4) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost3h*fun0*(-4.d0*xv(3)*zv(1)+4.d0*xv(1)*zv(3)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost3h*fun0*(4.d0*yv(3)*zv(1)-4.d0*yv(1)*zv(3)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost3h*fun0*(-xv(4)+yv(4)+6.d0*xv(2)*zv(2)-6.d0*yv(2)*zv(2)) + elseif(ic.eq.5) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost3h*fun0*(6.d0*xv(2)*yv(1)*zv(1)+2.d0*yv(3)*zv(1)-4.d0*yv(1)*zv(3)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost3h*fun0*(2.d0*xv(3)*zv(1)+6.d0*xv(1)*yv(2)*zv(1)-4.d0*xv(1)*zv(3)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + -cost3h*fun0*(2.d0*xv(3)*yv(1)+2.d0*xv(1)*yv(3)-12.d0*xv(1)*yv(1)*zv(2)) + elseif(ic.eq.6) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost4h*fun0*(-5.d0*xv(4)+6.d0*xv(2)*yv(2)+3.d0*yv(4)+24.d0*xv(2)*zv(2)-24.d0*yv(2)*zv(2)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost4h*fun0*(4.d0*xv(3)*yv(1)+12.d0*xv(1)*yv(3)-48.d0*xv(1)*yv(1)*zv(2)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost4h*fun0*(16.d0*xv(3)*zv(1)-48.d0*xv(1)*yv(2)*zv(1)) + elseif(ic.eq.7) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost4h*fun0*(12.d0*xv(3)*yv(1)+4.d0*xv(1)*yv(3)-48.d0*xv(1)*yv(1)*zv(2)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost4h*fun0*(3.d0*xv(4)+6.d0*xv(2)*yv(2)-5.d0*yv(4)-24.d0*xv(2)*zv(2)+24.d0*yv(2)*zv(2)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + -cost4h*fun0*(-48.d0*xv(2)*yv(1)*zv(1)+16.d0*yv(3)*zv(1)) + elseif(ic.eq.8) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost5h*fun0*(4.d0*xv(3)*zv(1)-12.d0*xv(1)*yv(2)*zv(1)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost5h*fun0*(-12.d0*xv(2)*yv(1)*zv(1)+4.d0*yv(3)*zv(1)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost5h*fun0*(xv(4)-6.d0*xv(2)*yv(2)+yv(4)) + elseif(ic.eq.9) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost5h*fun0*(-12.d0*xv(2)*yv(1)*zv(1)+4.d0*yv(3)*zv(1)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost5h*fun0*(-4.d0*xv(3)*zv(1)+12.d0*xv(1)*yv(2)*zv(1)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + -cost5h*fun0*(-4.d0*xv(3)*yv(1)+4.d0*xv(1)*yv(3)) + elseif(ic.eq.10) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost6h*fun0*(5.d0*xv(4)-30.d0*xv(2)*yv(2)+5.d0*yv(4)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost6h*fun0*(-20.d0*xv(3)*yv(1)+20.d0*xv(1)*yv(3)) + elseif(ic.eq.11) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost6h*fun0*(-20.d0*xv(3)*yv(1)+20.d0*xv(1)*yv(3)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost6h*fun0*(-5.d0*xv(4)+30.d0*xv(2)*yv(2)-5.d0*yv(4)) + end if + z(indorbp,indt+4)=distp(0,1+ic)*(12.d0*fun+fun2) + !endif for iocc + ! endif + end do ! enddo fot ic + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+11 + indorb=indorbp + + + + ! 2s gaussian for pseudo + diff --git a/devel_tools/makefun_factory/orb_73.f90 b/devel_tools/makefun_factory/orb_73.f90 new file mode 100644 index 0000000..f01382f --- /dev/null +++ b/devel_tools/makefun_factory/orb_73.f90 @@ -0,0 +1,235 @@ + + + ! indorbp=indorb + indparp=indpar+1 + + dd1=dd(indparp) + + ! if(iflagnorm.gt.2) then + ! overall normalization obtained by Mathematica + c=dd1**3.75d0*0.43985656185609913955d0 + ! C= dd1^15/4 /Sqrt[Integrate[x^14 Exp[-2 x^2],{x,0,Infinity}]] + ! endif + + + do k=indtmin,indtm + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + + do i=indtmin,indtm + do k=1,6 + zv(k)=rmu(3,i)**k + yv(k)=rmu(2,i)**k + xv(k)=rmu(1,i)**k + end do + r2=xv(2)+yv(2)+zv(2) + r4=r2*r2 + r6=r2*r4 + ! lz=0 + distp(i,2)=cost1i*(231.d0*zv(6)-315.d0*zv(4)*r2+105.d0*zv(2)*r4-5.d0*r6) + + cost=(33.d0*zv(5)-30.d0*zv(3)*r2+5.d0*zv(1)*r4) + ! lz=+/-1 + distp(i,3)=cost2i*rmu(1,i)*cost + ! lz=+/-1 + distp(i,4)=cost2i*rmu(2,i)*cost + + cost=33.d0*zv(4)-18.d0*zv(2)*r2+r4 + ! lz=+/-2 + distp(i,5)=cost3i*(xv(2)-yv(2))*cost + ! lz=+/-2 + distp(i,6)=2.d0*cost3i*xv(1)*yv(1)*cost + + + + cost=11.d0*zv(3)-3.d0*zv(1)*r2 + ! lz=+/-3 + distp(i,7)=cost4i*(xv(3)-3.d0*xv(1)*yv(2))*cost + ! lz=+/-3 + distp(i,8)=-cost4i*(yv(3)-3.d0*yv(1)*xv(2))*cost + + + cost=11.d0*zv(2)-r2 + ! lz=+/-4 + distp(i,9)=cost5i*(xv(4)-6.d0*xv(2)*yv(2)+yv(4))*cost + ! lz=+/-4 + distp(i,10)=cost5i*4.d0*(xv(3)*yv(1)-yv(3)*xv(1))*cost + + + ! lz=+/-5 + distp(i,11)=cost6i*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4))*zv(1) + ! lz=+/-5 + distp(i,12)=-cost6i*(-5.d0*xv(4)*yv(1)+10.d0*xv(2)*yv(3)-yv(5))*zv(1) + + ! lz=+/-6 + distp(i,13)=cost7i*(xv(6)-15.d0*xv(4)*yv(2)+15.d0*xv(2)*yv(4)-yv(6)) + ! lz=+/-6 + distp(i,14)=-cost7i*(-6.d0*xv(5)*yv(1)+20.d0*xv(3)*yv(3)-6.d0*yv(5)*xv(1)) + + + + end do + + + do ic=1,13 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + + + if(typec.ne.1) then + + dd1=dd(indparp) + fun0=distp(0,1) + fun=-2.d0*dd1*distp(0,1) + fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + do k=1,6 + zv(k)=rmu(3,0)**k + yv(k)=rmu(2,0)**k + xv(k)=rmu(1,0)**k + end do + + r2=xv(2)+yv(2)+zv(2) + r4=r2*r2 + r6=r2*r4 + + ! indorbp=indorb + do ic=1,13 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun + end do + if(ic.eq.1) then + ! if(i.eq.1) then + ! lz =0 + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost1i*fun0*(-30.d0*xv(5)-60.d0*xv(3)*yv(2)-30.d0*xv(1)*yv(4)& + +360.d0*xv(3)*zv(2)+360.d0*xv(1)*yv(2)*zv(2)-240.d0*xv(1)*zv(4)) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost1i*fun0*(-30.d0*xv(4)*yv(1)-60.d0*xv(2)*yv(3)-30.d0*yv(5)& + +360.d0*xv(2)*yv(1)*zv(2)+360.d0*yv(3)*zv(2)-240.d0*yv(1)*zv(4)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost1i*fun0*(180.d0*xv(4)*zv(1)+360.d0*xv(2)*yv(2)*zv(1)+180.d0*yv(4)*zv(1)& + -480.d0*xv(2)*zv(3)-480.d0*yv(2)*zv(3)+96.d0*zv(5)) + elseif(ic.eq.2) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost2i*fun0*(25.d0*xv(4)*zv(1)+30.d0*xv(2)*yv(2)*zv(1)+5.d0*yv(4)*zv(1)& + -60.d0*xv(2)*zv(3)-20.d0*yv(2)*zv(3)+8.d0*zv(5)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost2i*fun0*(20.d0*xv(3)*yv(1)*zv(1)+20.d0*xv(1)*yv(3)*zv(1)& + -40.d0*xv(1)*yv(1)*zv(3)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost2i*fun0*(5.d0*xv(5)+10.d0*xv(3)*yv(2)+5.d0*yv(4)*xv(1)& + -60.d0*xv(3)*zv(2)-60.d0*xv(1)*yv(2)*zv(2)+40.d0*xv(1)*zv(4)) + elseif(ic.eq.3) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost2i*fun0*(-20.d0*xv(3)*yv(1)*zv(1)-20.d0*xv(1)*yv(3)*zv(1)& + +40.d0*xv(1)*yv(1)*zv(3)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost2i*fun0*(-5.d0*xv(4)*zv(1)-30.d0*xv(2)*yv(2)*zv(1)-25.d0*yv(4)*zv(1)& + +20.d0*xv(2)*zv(3)+60.d0*yv(2)*zv(3)-8.d0*zv(5)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + -cost2i*fun0*(-5.d0*xv(4)*yv(1)-10.d0*xv(2)*yv(3)-5.d0*yv(5)& + +60.d0*xv(2)*yv(1)*zv(2)+60.d0*yv(3)*zv(2)-40.d0*yv(1)*zv(4)) + elseif(ic.eq.4) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost3i*fun0*(6.d0*xv(5)+4.d0*xv(3)*yv(2)-2.d0*xv(1)*yv(4)& + -64.d0*xv(3)*zv(2)+32.d0*xv(1)*zv(4)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost3i*fun0*(2.d0*xv(4)*yv(1)-4.d0*xv(2)*yv(3)-6.d0*yv(5)& + +64.d0*yv(3)*zv(2)-32.d0*yv(1)*zv(4)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost3i*fun0*(-32.d0*xv(4)*zv(1)+32.d0*yv(4)*zv(1)+64.d0*xv(2)*zv(3)& + -64.d0*yv(2)*zv(3)) + + elseif(ic.eq.5) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost3i*fun0*(-10.d0*xv(4)*yv(1)-12.d0*xv(2)*yv(3)-2.d0*yv(5)& + +96.d0*xv(2)*yv(1)*zv(2)+32.d0*yv(3)*zv(2)-32.d0*yv(1)*zv(4)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost3i*fun0*(-2.d0*xv(5)-12.d0*xv(3)*yv(2)-10.d0*xv(1)*yv(4)& + +32.d0*xv(3)*zv(2)+96.d0*xv(1)*yv(2)*zv(2)-32.d0*xv(1)*zv(4)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + -cost3i*fun0*(64.d0*xv(3)*yv(1)*zv(1)+64.d0*xv(1)*yv(3)*zv(1)-128.d0*xv(1)*yv(1)*zv(3)) + elseif(ic.eq.6) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost4i*fun0*(-15.d0*xv(4)*zv(1)+18.d0*xv(2)*yv(2)*zv(1)+9.d0*yv(4)*zv(1)& + +24.d0*xv(2)*zv(3)-24.d0*yv(2)*zv(3)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost4i*fun0*(12.d0*xv(3)*yv(1)*zv(1)+36.d0*xv(1)*yv(3)*zv(1)-48.d0*xv(1)*yv(1)*zv(3)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost4i*fun0*(-3.d0*xv(5)+6.d0*xv(3)*yv(2)+9.d0*xv(1)*yv(4)+24.d0*xv(3)*zv(2)& + -72.d0*xv(1)*yv(2)*zv(2)) + elseif(ic.eq.7) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost4i*fun0*(36.d0*xv(3)*yv(1)*zv(1)+12.d0*xv(1)*yv(3)*zv(1)-48.d0*xv(1)*yv(1)*zv(3)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost4i*fun0*(9.d0*xv(4)*zv(1)+18.d0*xv(2)*yv(2)*zv(1)-15.d0*yv(4)*zv(1)& + -24.d0*xv(2)*zv(3)+24.d0*yv(2)*zv(3)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + -cost4i*fun0*(9.d0*xv(4)*yv(1)+6.d0*xv(2)*yv(3)-3.d0*yv(5)& + -72.d0*xv(2)*yv(1)*zv(2)+24.d0*yv(3)*zv(2)) + elseif(ic.eq.8) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost5i*fun0*(-6.d0*xv(5)+20.d0*xv(3)*yv(2)+10.d0*xv(1)*yv(4)& + +40.d0*xv(3)*zv(2)-120.d0*xv(1)*yv(2)*zv(2)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost5i*fun0*(10.d0*xv(4)*yv(1)+20.d0*xv(2)*yv(3)-6.d0*yv(5)& + -120.d0*xv(2)*yv(1)*zv(2)+40.d0*yv(3)*zv(2)) + + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost5i*fun0*(20.d0*xv(4)*zv(1)-120.d0*xv(2)*yv(2)*zv(1)+20.d0*yv(4)*zv(1)) + elseif(ic.eq.9) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost5i*fun0*(20.d0*xv(4)*yv(1)-4.d0*yv(5)-120.d0*xv(2)*yv(1)*zv(2)& + +40.d0*yv(3)*zv(2)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost5i*fun0*(4.d0*xv(5)-20.d0*xv(1)*yv(4)-40.d0*xv(3)*zv(2)& + +120.d0*xv(1)*yv(2)*zv(2)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + -cost5i*fun0*(-80.d0*xv(3)*yv(1)*zv(1)+80.d0*xv(1)*yv(3)*zv(1)) + elseif(ic.eq.10) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost6i*fun0*(5.d0*xv(4)*zv(1)-30.d0*xv(2)*yv(2)*zv(1)+5.d0*yv(4)*zv(1)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost6i*fun0*(-20.d0*xv(3)*yv(1)*zv(1)+20.d0*xv(1)*yv(3)*zv(1)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost6i*fun0*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4)) + elseif(ic.eq.11) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost6i*fun0*(-20.d0*xv(3)*yv(1)*zv(1)+20.d0*xv(1)*yv(3)*zv(1)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost6i*fun0*(-5.d0*xv(4)*zv(1)+30.d0*xv(2)*yv(2)*zv(1)-5.d0*yv(4)*zv(1)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + -cost6i*fun0*(-5.d0*xv(4)*yv(1)+10.d0*xv(2)*yv(3)-yv(5)) + elseif(ic.eq.12) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost7i*fun0*(6.d0*xv(5)-60.d0*xv(3)*yv(2)+30.d0*xv(1)*yv(4)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost7i*fun0*(-30.d0*xv(4)*yv(1)+60.d0*xv(2)*yv(3)-6.d0*yv(5)) + elseif(ic.eq.13) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost7i*fun0*(-30.d0*xv(4)*yv(1)+60.d0*xv(2)*yv(3)-6.d0*yv(5)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost7i*fun0*(-6.d0*xv(5)+60.d0*xv(3)*yv(2)-30.d0*xv(1)*yv(4)) + end if + z(indorbp,indt+4)=distp(0,1+ic)*(14.d0*fun+fun2) + !endif for iocc + ! endif + end do ! enddo fot ic + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+13 + indorb=indorbp + + + + ! 2s gaussian for pseudo diff --git a/devel_tools/makefun_factory/orb_8.f90 b/devel_tools/makefun_factory/orb_8.f90 new file mode 100644 index 0000000..d5f7bad --- /dev/null +++ b/devel_tools/makefun_factory/orb_8.f90 @@ -0,0 +1,45 @@ + ! s orbital + ! + ! - angmom = 0 + ! - type = Gaussian + ! - normalized = yes + ! - angtype = spherical + ! - npar = 2 + ! - multiplicity = 1 + ! + ! = exp(-dd1*r) + (dd1-zeta) * r * exp(-dd2*r) + ! + ! 2s double Z WITH CUSP + ! + + indshellp=indshell+1 + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd1-zeta(1) + + do k=indtmin,indtm + distp(k,1)=dexp(-dd1*r(k)) + distp(k,2)=dexp(-dd2*r(k)) + end do + + c= 1.d0/dsqrt(1.d0/4.d0/dd1**3+12.d0*peff/(dd1+dd2)**4& + &+ 3*peff**2/4/dd2**5)/dsqrt(4.0*pi) + + do i=i0,indtm + z(indorbp,i)=c*(distp(i,1)+r(i)*distp(i,2)*peff) + end do + + if(typec.ne.1) then + fun=-dd1*distp(0,1)+peff*distp(0,2)*(1.d0-dd2*r(0)) + fun2=distp(0,1)*dd1**2& + &+ peff*distp(0,2)*(dd2**2*r(0)-2.d0*dd2) + do i=1,3 + z(indorbp,indt+i)=fun*c*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=c*(2.d0*fun/r(0)+fun2) + end if + + indorb=indorbp + indpar=indpar+2 + indshell=indshellp diff --git a/devel_tools/makefun_factory/orb_80.f90 b/devel_tools/makefun_factory/orb_80.f90 new file mode 100644 index 0000000..21b0847 --- /dev/null +++ b/devel_tools/makefun_factory/orb_80.f90 @@ -0,0 +1,45 @@ + ! R(r)=exp(-z*r**2) single zeta + + indshellp=indshell+1 + indorbp=indorb+1 + + dd1=dd(indpar+1) + dd2=dsqrt(dd1) + + ! if(iflagnorm.gt.2) then + ! c=(2.d0*dd1/pi)**(3.d0/4.d0)*ratiocs + ! ratiocs--> ratiocs*(2/pi)**3/4 + c=dd1**0.75d0*ratiocs + ! endif + + do k=indtmin,indtm + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + + do i=i0,indtm + z(indorbp,i)=distp(i,1) + end do + + if(typec.ne.1) then + ! the first derivative /r + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + + fun=-dd1*distp(0,1)*(2.d0+rp2)/rp3 + + ! the second derivative + fun2=dd1*distp(0,1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**2)/rp3**2 + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + + indorb=indorbp + indpar=indpar+1 + indshell=indshellp + diff --git a/devel_tools/makefun_factory/orb_81.f90 b/devel_tools/makefun_factory/orb_81.f90 new file mode 100644 index 0000000..b9fd564 --- /dev/null +++ b/devel_tools/makefun_factory/orb_81.f90 @@ -0,0 +1,50 @@ + ! R(r)=c*exp(-z*r**2)*(3/4/z-r**2) + + indshellp=indshell+1 + + ! if(iocc(indshellp).eq.1) then + + indorbp=indorb+1 + + dd1=dd(indpar+1) + dd2=dsqrt(dd1) + + ! c=(2.d0*dd1/pi)**(3.d0/4.d0)*ratiocs + c=dd1**0.75d0*ratiocs + + do k=indtmin,indtm + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + + do i=i0,indtm + cost=(1.d0+0.5d0*dd2*r(i))/(1.d0+dd2*r(i))**2 + z(indorbp,i)=distp(i,1)*(3.d0/4.d0/dd1-r(i)**2*cost) + end do + + if(typec.ne.1) then + ! the first derivative /r + + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + + fun=0.25d0*distp(0,1)* & + (-14.d0-29.d0*rp2-12.d0*rp1+3.d0*rp1*rp2+2.d0*rp1**2)/rp3**2 + ! the second derivative + fun2=0.25d0*distp(0,1)* & + (-14.d0-30.d0*rp2+34.d0*rp1+118.d0*rp1*rp2+87.d0*rp1**2 & + +18.d0*rp1**2*rp2-5.d0*rp1**3-2.d0*rp1**3*rp2)/rp3**3 + + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + + indorb=indorbp + + indpar=indpar+1 + indshell=indshellp + diff --git a/devel_tools/makefun_factory/orb_82.f90 b/devel_tools/makefun_factory/orb_82.f90 new file mode 100644 index 0000000..f187499 --- /dev/null +++ b/devel_tools/makefun_factory/orb_82.f90 @@ -0,0 +1,52 @@ + + dd1=dd(indpar+1) + dd2=dsqrt(dd1) + + ! if(iflagnorm.gt.2) then + ! ratiocp--> ratiocp*dsqrt(2.d0)*pi**(-0.75d0)*2**1.25 + ! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0*ratiocp + c=dd1**1.25d0*ratiocp + ! endif + + do k=indtmin,indtm + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + ! indorbp=indorb + ! + do ic=1,3 + indorbp=indorb+ic + do i=i0,indtm + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + end do + + if(typec.ne.1) then + fun0=distp(0,1) + ! fun=-2.d0*dd1*distp(0,1) + ! fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + + fun=-dd1*distp(0,1)*(2.d0+rp2)/rp3 + + ! the second derivative + fun2=dd1*distp(0,1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**2)/rp3**2 + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + end do + end if + + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_83.f90 b/devel_tools/makefun_factory/orb_83.f90 new file mode 100644 index 0000000..55caae9 --- /dev/null +++ b/devel_tools/makefun_factory/orb_83.f90 @@ -0,0 +1,56 @@ + ! R(r)=x*exp(-z*r**2)*(5/4/z-r**2) + + dd1=dd(indpar+1) + dd2=dsqrt(dd1) + c=dd1**1.25d0*ratiocp + + do k=indtmin,indtm + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=i0,indtm + cost=(1.d0+0.5d0*dd2*r(i))/(1.d0+dd2*r(i))**2 + z(indorbp,i)=rmu(ic,i)*distp(i,1)*(1.25d0/dd1-r(i)**2*cost) + end do + ! endif + end do + + if(typec.ne.1) then + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + cost=(1.d0+0.5d0*rp2)/rp3 + fun0=distp(0,1)*(1.25d0/dd1-r(0)**2*cost) + fun=0.25d0*distp(0,1)* & + (-18.d0-39.d0*rp2-20.d0*rp1+rp1*rp2+2.d0*rp1**2)/rp3**2 + fun2=0.25d0*distp(0,1)* & + (-18.d0-42.d0*rp2+30.d0*rp1+138.d0*rp1*rp2+113.d0*rp1**2 & + +30.d0*rp1**2*rp2-3.d0*rp1**3-2.d0*rp1**3*rp2)/rp3**3 + + ! indorbp=indorb + + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + ! endif + end do + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp + + + diff --git a/devel_tools/makefun_factory/orb_84.f90 b/devel_tools/makefun_factory/orb_84.f90 new file mode 100644 index 0000000..1417ff1 --- /dev/null +++ b/devel_tools/makefun_factory/orb_84.f90 @@ -0,0 +1,131 @@ + ! d orbitals + ! R(r)= exp(-alpha r^2) + ! each gaussian term is normalized + + + + ! indorbp=indorb + indparp=indpar+1 + + dd1=dd(indparp) + dd2=dsqrt(dd1) + + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)*ratiocd + c=ratiocd*dd1**1.75d0 + ! endif + + do k=indtmin,indtm + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + + + + + + do i=indtmin,indtm + ! lz=0 + distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/-2 + distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d + end do + + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + + + if(typec.ne.1) then + + fun0=distp(0,1) + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + + fun=-dd1*distp(0,1)*(2.d0+rp2)/rp3 + + + ! the second derivative + fun2=dd1*distp(0,1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**2)/rp3**2 + + + + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp + + ! derivative of 37 with respect to z diff --git a/devel_tools/makefun_factory/orb_85.f90 b/devel_tools/makefun_factory/orb_85.f90 new file mode 100644 index 0000000..7b9dee4 --- /dev/null +++ b/devel_tools/makefun_factory/orb_85.f90 @@ -0,0 +1,130 @@ + ! d orbitals + ! R(r)= c*exp(-z r^2)*(7/4/z-r^2) + + + + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + dd2=dsqrt(dd1) + + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)*ratiocd + c=dd1**1.75d0*ratiocd + ! endif + + + do k=indtmin,indtm + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + + + + + do i=indtmin,indtm + ! lz=0 + distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/-2 + distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d + end do + + + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + cost=(1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 + z(indorbp,k)=distp(k,1)*(7.d0/4.d0/dd1-r(k)**2*cost)* & + distp(k,1+ic) + end do + ! endif + end do + + + if(typec.ne.1) then + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + + cost=(1.d0+0.5d0*rp2)/rp3 + fun0=distp(0,1)*(7.d0/4.d0/dd1-r(0)**2*cost) + + fun=0.25d0*distp(0,1)* & + (-22.d0-49.d0*rp2-28.d0*rp1-rp1*rp2+2.d0*rp1**2)/rp3**2 + fun2=-0.25d0*distp(0,1)* & + (22.d0+54.d0*rp2-26.d0*rp1-158.d0*rp1*rp2-139.d0*rp1**2 & + -42.d0*rp1**2*rp2+rp1**3+2.d0*rp1**3*rp2)/rp3**3 + + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_86.f90 b/devel_tools/makefun_factory/orb_86.f90 new file mode 100644 index 0000000..a6a0e1c --- /dev/null +++ b/devel_tools/makefun_factory/orb_86.f90 @@ -0,0 +1,161 @@ + ! f single gaussian orbital + ! R(r)= exp(-alpha r^2) + ! normalized + + + ! indorbp=indorb + indparp=indpar+1 + + dd1=dd(indparp) + dd2=dsqrt(dd1) + + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0)*ratiocf + c=dd1**2.25d0*ratiocf + ! endif + + do k=indtmin,indtm + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + + do i=indtmin,indtm + distp(i,2)=cost1f*rmu(3,i) & + *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=0 + distp(i,3)=cost2f*rmu(1,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2f*rmu(2,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3f*rmu(3,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-2 + distp(i,6)=cost3f*2.d0*rmu(3,i) & + *rmu(1,i)*rmu(2,i) + ! lz=+/-2 + distp(i,7)=cost4f*rmu(1,i) & + *(rmu(1,i)**2-3.d0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4f*rmu(2,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + end do + + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + + if(typec.ne.1) then + + fun0=distp(0,1) + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + + fun=-dd1*distp(0,1)*(2.d0+rp2)/rp3 + + + ! the second derivative + fun2=dd1*distp(0,1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**2)/rp3**2 + + + + ! indorbp=indorb + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) + if(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) + end if + elseif(ic.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + end if + elseif(ic.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + end if + else + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+7 + indorb=indorbp + + + ! derivative of 48 with respect to z diff --git a/devel_tools/makefun_factory/orb_87.f90 b/devel_tools/makefun_factory/orb_87.f90 new file mode 100644 index 0000000..c4397d7 --- /dev/null +++ b/devel_tools/makefun_factory/orb_87.f90 @@ -0,0 +1,165 @@ + ! f orbitals + ! R(r)= c*exp(-z r^2)*(9/4/z-r^2) + + + + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + dd2=dsqrt(dd1) + + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0)*ratiocf + c=dd1**2.25d0*ratiocf + ! endif + + do k=indtmin,indtm + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + + + + do i=indtmin,indtm + distp(i,2)=cost1f*rmu(3,i) & + *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=0 + distp(i,3)=cost2f*rmu(1,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2f*rmu(2,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3f*rmu(3,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-2 + distp(i,6)=cost3f*2.d0*rmu(3,i) & + *rmu(1,i)*rmu(2,i) + ! lz=+/-2 + distp(i,7)=cost4f*rmu(1,i) & + *(rmu(1,i)**2-3.d0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4f*rmu(2,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + end do + + + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + cost=(1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 + z(indorbp,k)=distp(k,1)*(9.d0/4.d0/dd1-r(k)**2*cost)* & + distp(k,1+ic) + end do + ! endif + end do + + + if(typec.ne.1) then + + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + + cost=(1.d0+0.5d0*rp2)/rp3 + fun0=distp(0,1)*(9.d0/4.d0/dd1-r(0)**2*cost) + + fun=0.25d0*distp(0,1)* & + (-26.d0-59.d0*rp2-36.d0*rp1-3.d0*rp1*rp2+2.d0*rp1**2)/rp3**2 + fun2=0.25d0*distp(0,1)* & + (-26.d0-66.d0*rp2+22.d0*rp1+178.d0*rp1*rp2+165.d0*rp1**2 & + +54.d0*rp1**2*rp2+rp1**3-2.d0*rp1**3*rp2)/rp3**3 + + + ! indorbp=indorb + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) + if(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) + end if + elseif(ic.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + end if + elseif(ic.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + end if + else + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+7 + indorb=indorbp + diff --git a/devel_tools/makefun_factory/orb_88.f90 b/devel_tools/makefun_factory/orb_88.f90 new file mode 100644 index 0000000..7a8aeb3 --- /dev/null +++ b/devel_tools/makefun_factory/orb_88.f90 @@ -0,0 +1,197 @@ + ! g single gaussian orbital + ! R(r)= exp(-alpha r^2) + ! normalized + + ! indorbp=indorb + indparp=indpar+1 + + dd1=dd(indparp) + dd2=dsqrt(dd1) + + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0)*ratiocg + c=dd1**2.75d0*ratiocg + ! endif + + do k=indtmin,indtm + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + + + + + do i=indtmin,indtm + distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & + -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) + ! lz=0 + distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & + *(rmu(1,i)**2-3.0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + distp(i,9)=cost5g*(rmu(1,i)**4 & + -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) + ! lz=+/-4 + distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-4 + end do + + + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + + + if(typec.ne.1) then + + + fun0=distp(0,1) + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + + fun=-dd1*distp(0,1)*(2.d0+rp2)/rp3 + + + ! the second derivative + fun2=dd1*distp(0,1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**2)/rp3**2 + + + + + ! indorbp=indorb + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun + if(ic.eq.1) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + elseif(ic.eq.7) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + end if + elseif(ic.eq.8) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) + end if + elseif(ic.eq.9) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+9 + indorb=indorbp + + diff --git a/devel_tools/makefun_factory/orb_89.f90 b/devel_tools/makefun_factory/orb_89.f90 new file mode 100644 index 0000000..dbc0acf --- /dev/null +++ b/devel_tools/makefun_factory/orb_89.f90 @@ -0,0 +1,206 @@ + ! g single gaussian orbital + ! derivative of 51 + ! R(r)= exp(-alpha r^2) + ! normalized + + + ! indorbp=indorb + indparp=indpar+1 + + dd1=dd(indparp) + dd2=dsqrt(dd1) + + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0)*ratiocg + c=dd1**2.75d0*ratiocg + ! endif + + do k=indtmin,indtm + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + + + + + do i=indtmin,indtm + distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & + -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) + ! lz=0 + distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & + *(rmu(1,i)**2-3.0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + distp(i,9)=cost5g*(rmu(1,i)**4 & + -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) + ! lz=+/-4 + distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-4 + end do + + + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=i0,indtm + cost=(1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 + z(indorbp,k)=distp(k,1)*(11.d0/4.d0/dd1-r(k)**2*cost)* & + distp(k,1+ic) + end do + ! endif + end do + + + if(typec.ne.1) then + + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + + cost=(1.d0+0.5d0*rp2)/rp3 + fun0=distp(0,1)*(11.d0/4.d0/dd1-r(0)**2*cost) + + fun=0.25d0*distp(0,1)* & + (-30.d0-69.d0*rp2-44.d0*rp1-5.d0*rp1*rp2+2.d0*rp1**2)/rp3**2 + fun2=0.25d0*distp(0,1)* & + (-30.d0-78.d0*rp2+18.d0*rp1+198.d0*rp1*rp2+191.d0*rp1**2 & + +66.d0*rp1**2*rp2+3.d0*rp1**3-2.d0*rp1**3*rp2)/rp3**3 + + + ! indorbp=indorb + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun + if(ic.eq.1) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + elseif(ic.eq.7) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + end if + elseif(ic.eq.8) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) + end if + elseif(ic.eq.9) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + + !endif for indt + end if + + indpar=indpar+1 + indshell=indshell+9 + indorb=indorbp + + ! WARNING IN DFT it is assumed that UMRIGAR orbitals could be extended + ! up to number 99, so i,h,... are possible extensions. + + + + ! 1s single Z NO CUSP! diff --git a/devel_tools/makefun_factory/orb_90:99.f90 b/devel_tools/makefun_factory/orb_90:99.f90 new file mode 100644 index 0000000..6db3040 --- /dev/null +++ b/devel_tools/makefun_factory/orb_90:99.f90 @@ -0,0 +1,273 @@ + ! cartesian orbitals + ! + ! - angmom := iopt - 90 + ! - type = Gaussian + ! - normalized = yes + ! - angtype = cartesian + ! - npar = 1 + ! - multiplicity := (iopt - 90 + 2) * (iopt - 90 + 1) // 2 + ! + + indshellp=indshell+1 + indorbp=indorb+1 + dd1=dd(indpar+1) + + multiplicity = (iopt - 90 + 2) * (iopt - 90 + 1) / 2 + + powers(:,-2,:) = 0.0d0 + powers(:,-1,:) = 0.0d0 + powers(:,0,:) = 1.0d0 + + do ii = 1, iopt - 90 + do k = indtmin, indtm + powers(1, ii, k) = powers(1, ii-1, k) * rmu(1, k) + powers(2, ii, k) = powers(2, ii-1, k) * rmu(2, k) + powers(3, ii, k) = powers(3, ii-1, k) * rmu(3, k) + end do + end do + + c = 0.712705470354990_8 * dd1 ** 0.75_8! * 2.829 + if (iopt - 90 .ne. 0) then + c = c * (8_4 * dd1) ** ((iopt - 90)/2.0_8) + end if + do k = i0, indtm + distp(k,1) = dexp(-1.0_8 * dd1 * r(k) * r(k)) * c + end do + do k = i0, indtm + count = 0 + do ii = (iopt - 90), 0, -1 + do jj = (iopt - 90) - ii, 0, -1 + kk = (iopt - 90) - ii - jj + z(indorbp + count, k) = 1.0_8 + rp1 = 1.0_8 + do i = ii + 1, 2 * ii + rp1 = rp1 * i + end do + z(indorbp + count, k) = z(indorbp + count, k) / dsqrt(rp1) + rp1 = 1.0_8 + do i = jj + 1, 2 * jj + rp1 = rp1 * i + end do + z(indorbp + count, k) = z(indorbp + count, k) / dsqrt(rp1) + rp1 = 1.0_8 + do i = kk + 1, 2 * kk + rp1 = rp1 * i + end do + z(indorbp + count, k) = z(indorbp + count, k) / dsqrt(rp1) + count = count + 1 + end do + end do + end do + + ! We need to calculate it again for derivatives, it could not be done in previous loop because of case if i0 /= indtmin + if (typec .ne. 1) then + count = 0 + do ii = (iopt - 90), 0, -1 + do jj = (iopt - 90) - ii, 0, -1 + kk = (iopt - 90) - ii - jj + z(indorbp + count, indt + 1) = 1.0_8 + z(indorbp + count, indt + 2) = 1.0_8 + z(indorbp + count, indt + 3) = 1.0_8 + z(indorbp + count, indt + 4) = 1.0_8 + rp1 = 1.0_8 + do i = ii + 1, 2 * ii + rp1 = rp1 * i + end do + z(indorbp + count, indt + 1) = z(indorbp + count, indt + 1) / dsqrt(rp1) + z(indorbp + count, indt + 2) = z(indorbp + count, indt + 2) / dsqrt(rp1) + z(indorbp + count, indt + 3) = z(indorbp + count, indt + 3) / dsqrt(rp1) + z(indorbp + count, indt + 4) = z(indorbp + count, indt + 4) / dsqrt(rp1) + rp1 = 1.0_8 + do i = jj + 1, 2 * jj + rp1 = rp1 * i + end do + z(indorbp + count, indt + 1) = z(indorbp + count, indt + 1) / dsqrt(rp1) + z(indorbp + count, indt + 2) = z(indorbp + count, indt + 2) / dsqrt(rp1) + z(indorbp + count, indt + 3) = z(indorbp + count, indt + 3) / dsqrt(rp1) + z(indorbp + count, indt + 4) = z(indorbp + count, indt + 4) / dsqrt(rp1) + rp1 = 1.0_8 + do i = kk + 1, 2 * kk + rp1 = rp1 * i + end do + z(indorbp + count, indt + 1) = z(indorbp + count, indt + 1) / dsqrt(rp1) + z(indorbp + count, indt + 2) = z(indorbp + count, indt + 2) / dsqrt(rp1) + z(indorbp + count, indt + 3) = z(indorbp + count, indt + 3) / dsqrt(rp1) + z(indorbp + count, indt + 4) = z(indorbp + count, indt + 4) / dsqrt(rp1) + count = count + 1 + end do + end do + end if + + ! Initialize gradients and laplacians (radial part) + + if (typec .ne. 1) then + distp(indt + 1, 1) = -2.0d0 * dd1 * rmu(1, 0) * distp(0, 1) + distp(indt + 2, 1) = -2.0d0 * dd1 * rmu(2, 0) * distp(0, 1) + distp(indt + 3, 1) = -2.0d0 * dd1 * rmu(3, 0) * distp(0, 1) + distp(indt + 4, 1) = dd1 * (4.0d0 * dd1 * (r(0) * r(0)) - 6.0d0) * distp(0, 1) + end if + + do k = i0, indtm + count = 0 + do ii = (iopt - 90), 0, -1 + do jj = (iopt - 90) - ii, 0, -1 + kk = (iopt - 90) - ii - jj + z(indorbp + count, k) = z(indorbp + count, k) * powers(1, ii, k) + z(indorbp + count, k) = z(indorbp + count, k) * powers(2, jj, k) + z(indorbp + count, k) = z(indorbp + count, k) * powers(3, kk, k) + count = count + 1 + end do + end do + end do + + if (typec .ne. 1) then + ! Solve ang_mom = 0, 1 separately + if (iopt - 90 .eq. 0) then + z(indorbp, indt + 1) = distp(indt + 1, 1) + z(indorbp, indt + 2) = distp(indt + 2, 1) + z(indorbp, indt + 3) = distp(indt + 3, 1) + z(indorbp, indt + 4) = distp(indt + 4, 1) + else if (iopt - 90 .eq. 1) then + rp1 = dsqrt(2.0_8) + z(indorbp , indt + 1) = (distp(indt + 1, 1) * rmu(1, indtmin) + distp(0, 1)) / rp1 + z(indorbp , indt + 2) = (distp(indt + 2, 1) * rmu(1, indtmin)) / rp1 + z(indorbp , indt + 3) = (distp(indt + 3, 1) * rmu(1, indtmin)) / rp1 + + z(indorbp + 1, indt + 1) = (distp(indt + 1, 1) * rmu(2, indtmin)) / rp1 + z(indorbp + 1, indt + 2) = (distp(indt + 2, 1) * rmu(2, indtmin) + distp(0, 1)) / rp1 + z(indorbp + 1, indt + 3) = (distp(indt + 3, 1) * rmu(2, indtmin)) / rp1 + + z(indorbp + 2, indt + 1) = (distp(indt + 1, 1) * rmu(3, indtmin)) / rp1 + z(indorbp + 2, indt + 2) = (distp(indt + 2, 1) * rmu(3, indtmin)) / rp1 + z(indorbp + 2, indt + 3) = (distp(indt + 3, 1) * rmu(3, indtmin) + distp(0, 1)) / rp1 + + z(indorbp , indt + 4) = (distp(indt + 4, 1) * rmu(1, indtmin) + 2.0d0 * distp(indt + 1, 1)) / rp1 + z(indorbp + 1, indt + 4) = (distp(indt + 4, 1) * rmu(2, indtmin) + 2.0d0 * distp(indt + 2, 1)) / rp1 + z(indorbp + 2, indt + 4) = (distp(indt + 4, 1) * rmu(3, indtmin) + 2.0d0 * distp(indt + 3, 1)) / rp1 + else if (iopt - 90 .eq. 2) then + rp1 = 2.0_8 + rp2 = dsqrt(12.0_8) + z(indorbp , indt + 1) = (distp(indt + 1, 1) & + & * rmu(1, indtmin) * rmu(1, indtmin) + 2 * rmu(1, indtmin) * distp(0, 1)) / rp2 + z(indorbp , indt + 2) = (distp(indt + 2, 1) & + & * rmu(1, indtmin) * rmu(1, indtmin)) / rp2 + z(indorbp , indt + 3) = (distp(indt + 3, 1) & + & * rmu(1, indtmin) * rmu(1, indtmin)) / rp2 + + z(indorbp + 1, indt + 1) = (distp(indt + 1, 1) & + & * rmu(1, indtmin) * rmu(2, indtmin) + rmu(2, indtmin) * distp(0, 1)) / rp1 + z(indorbp + 1, indt + 2) = (distp(indt + 2, 1) & + & * rmu(1, indtmin) * rmu(2, indtmin) + rmu(1, indtmin) * distp(0, 1)) / rp1 + z(indorbp + 1, indt + 3) = (distp(indt + 3, 1) & + & * rmu(1, indtmin) * rmu(2, indtmin)) / rp1 + + z(indorbp + 2, indt + 1) = (distp(indt + 1, 1) & + & * rmu(1, indtmin) * rmu(3, indtmin) + rmu(3, indtmin) * distp(0, 1)) / rp1 + z(indorbp + 2, indt + 2) = (distp(indt + 2, 1) & + & * rmu(1, indtmin) * rmu(3, indtmin)) / rp1 + z(indorbp + 2, indt + 3) = (distp(indt + 3, 1) & + & * rmu(1, indtmin) * rmu(3, indtmin)) + rmu(1, indtmin) * distp(0, 1)/ rp1 + + z(indorbp + 3, indt + 1) = (distp(indt + 1, 1) & + & * rmu(2, indtmin) * rmu(2, indtmin)) / rp2 + z(indorbp + 3, indt + 2) = (distp(indt + 2, 1) & + & * rmu(2, indtmin) * rmu(2, indtmin) + 2 * rmu(2, indtmin) * distp(0, 1)) / rp2 + z(indorbp + 3, indt + 3) = (distp(indt + 3, 1) & + & * rmu(2, indtmin) * rmu(2, indtmin)) / rp2 + + z(indorbp + 4, indt + 1) = (distp(indt + 1, 1) & + & * rmu(2, indtmin) * rmu(3, indtmin)) / rp1 + z(indorbp + 4, indt + 2) = (distp(indt + 2, 1) & + & * rmu(2, indtmin) * rmu(3, indtmin) + rmu(3, indtmin) * distp(0, 1)) / rp1 + z(indorbp + 4, indt + 3) = (distp(indt + 3, 1) & + & * rmu(2, indtmin) * rmu(3, indtmin) + rmu(2, indtmin) * distp(0, 1)) / rp1 + + z(indorbp + 5, indt + 1) = (distp(indt + 1, 1) & + & * rmu(3, indtmin) * rmu(3, indtmin)) / rp2 + z(indorbp + 5, indt + 2) = (distp(indt + 2, 1) & + & * rmu(3, indtmin) * rmu(3, indtmin)) / rp2 + z(indorbp + 5, indt + 3) = (distp(indt + 3, 1) & + & * rmu(3, indtmin) * rmu(3, indtmin) + 2 * rmu(3, indtmin) * distp(0, 1)) / rp2 + + z(indorbp , indt + 4) = (1.0d0 * distp(indt + 4, 1) * rmu(1, indtmin) * rmu(1, indtmin)& + & + 4.0d0 * distp(indt + 1, 1) * rmu(1, indtmin)& + & + 2.0d0 * distp(0, 1)) / rp2 + z(indorbp + 1, indt + 4) = (1.0d0 * distp(indt + 4, 1) * rmu(1, indtmin) * rmu(2, indtmin)& + & + 2.0d0 * distp(indt + 2, 1) * rmu(1, indtmin)& + & + 2.0d0 * distp(indt + 1, 1) * rmu(2, indtmin)) / rp1 + z(indorbp + 2, indt + 4) = (1.0d0 * distp(indt + 4, 1) * rmu(1, indtmin) * rmu(3, indtmin)& + & + 2.0d0 * distp(indt + 3, 1) * rmu(1, indtmin)& + & + 2.0d0 * distp(indt + 1, 1) * rmu(3, indtmin)) / rp1 + z(indorbp + 3, indt + 4) = (1.0d0 * distp(indt + 4, 1) * rmu(2, indtmin) * rmu(2, indtmin)& + & + 4.0d0 * distp(indt + 2, 1) * rmu(2, indtmin)& + & + 2.0d0 * distp(0, 1)) / rp2 + z(indorbp + 4, indt + 4) = (1.0d0 * distp(indt + 4, 1) * rmu(2, indtmin) * rmu(3, indtmin)& + & + 2.0d0 * distp(indt + 3, 1) * rmu(2, indtmin)& + & + 2.0d0 * distp(indt + 2, 1) * rmu(3, indtmin)) / rp1 + z(indorbp + 5, indt + 4) = (1.0d0 * distp(indt + 4, 1) * rmu(3, indtmin) * rmu(3, indtmin)& + & + 4.0d0 * distp(indt + 3, 1) * rmu(3, indtmin)& + & + 2.0d0 * distp(0, 1)) / rp2 + else + count = 0 + do ii = (iopt - 90), 0, -1 + do jj = (iopt - 90) - ii, 0, -1 + kk = (iopt - 90) - ii - jj + + ! First store polynomial part into respective places + ! Then solve full laplacian using using lower derivatives + ! Then do the same thing for gradients + ! Then finally the values + + z(indorbp + count, indt + 1) = z(indorbp + count, indt + 1) * powers(1, ii-1, 0) + z(indorbp + count, indt + 1) = z(indorbp + count, indt + 1) * powers(2, jj, 0) + z(indorbp + count, indt + 1) = z(indorbp + count, indt + 1) * powers(3, kk, 0) + z(indorbp + count, indt + 1) = z(indorbp + count, indt + 1) * ii + + z(indorbp + count, indt + 2) = z(indorbp + count, indt + 2) * powers(1, ii, 0) + z(indorbp + count, indt + 2) = z(indorbp + count, indt + 2) * powers(2, jj-1, 0) + z(indorbp + count, indt + 2) = z(indorbp + count, indt + 2) * powers(3, kk, 0) + z(indorbp + count, indt + 2) = z(indorbp + count, indt + 2) * jj + + z(indorbp + count, indt + 3) = z(indorbp + count, indt + 3) * powers(1, ii, 0) + z(indorbp + count, indt + 3) = z(indorbp + count, indt + 3) * powers(2, jj, 0) + z(indorbp + count, indt + 3) = z(indorbp + count, indt + 3) * powers(3, kk-1, 0) + z(indorbp + count, indt + 3) = z(indorbp + count, indt + 3) * kk + + z(indorbp + count, indt + 4) = z(indorbp + count, indt + 4) & + & * (powers(1, ii-2, 0) * powers(2, jj, 0) * powers(3, kk, 0) * ii * (ii-1)& + & + powers(1, ii, 0) * powers(2, jj-2, 0) * powers(3, kk, 0) * jj * (jj-1)& + & + powers(1, ii, 0) * powers(2, jj, 0) * powers(3, kk-2, 0) * kk * (kk-1)) + + + ! All polynomial parts are now stored + ! Now solve laplacian + z(indorbp + count, indt + 4) = z(indorbp + count, indt + 4) * distp(0, 1) & + & + 2.0_8 * z(indorbp + count, indt + 1) * distp(indt + 1, 1) & + & + 2.0_8 * z(indorbp + count, indt + 2) * distp(indt + 2, 1) & + & + 2.0_8 * z(indorbp + count, indt + 3) * distp(indt + 3, 1) & + & + z(indorbp + count, indtmin) * distp(indt + 4, 1) + + ! Now solve gradients + z(indorbp + count, indt + 1) = z(indorbp + count, indt + 1) * distp(0, 1) & + & + z(indorbp + count, indtmin) * distp(indt + 1, 1) + z(indorbp + count, indt + 2) = z(indorbp + count, indt + 2) * distp(0, 1) & + & + z(indorbp + count, indtmin) * distp(indt + 2, 1) + z(indorbp + count, indt + 3) = z(indorbp + count, indt + 3) * distp(0, 1) & + & + z(indorbp + count, indtmin) * distp(indt + 3, 1) + count = count + 1 + end do + end do + end if + + end if + + ! Multiply by radial part for values + do ii = 1, multiplicity + do kk = i0, indtm + z(indorbp + ii - 1, kk) = z(indorbp + ii - 1, kk) * distp(kk, 1) + end do + end do + + indpar=indpar + 1 + indshell=indshell + multiplicity + indorb=indorb + multiplicity diff --git a/src/a_module_tests/CMakeLists.txt b/src/a_module_tests/CMakeLists.txt index 8c3294d..ff2e240 100644 --- a/src/a_module_tests/CMakeLists.txt +++ b/src/a_module_tests/CMakeLists.txt @@ -295,4 +295,27 @@ foreach( EXECUTABLE IN LISTS EXECUTABLES_S_L ) endif() + if(${EXECUTABLE} STREQUAL test_makefun) + set_target_properties( ${EXECUTABLE} PROPERTIES SUFFIX ".x") + + target_sources( ${EXECUTABLE} + PRIVATE + ${EXECUTABLE}.f90 + c_lister.h + c_lister.c + ) + + if(EXT_GPU) + target_link_libraries( ${EXECUTABLE} + PRIVATE + complex-nogpu-serial + ) + else() + target_link_libraries( ${EXECUTABLE} + PRIVATE + complex-serial + ) + endif() + endif() + endforeach() diff --git a/src/a_module_tests/c_lister.c b/src/a_module_tests/c_lister.c new file mode 100644 index 0000000..8ab1a43 --- /dev/null +++ b/src/a_module_tests/c_lister.c @@ -0,0 +1,59 @@ +#include +#include +#include +#include +#include +#include "c_lister.h" + +extern void list_directory(char *path, int path_length, char *files, int *num_files, char *prefix, int prefix_length) { + + struct dirent *entry; + + char cpath[path_length + 1]; + strncpy(cpath, path, path_length); + cpath[path_length] = '\0'; + + DIR *dir = opendir(cpath); + + int count = 0; + + // Clean files + int i; + for (i = 0; i < MAX_FILES * MAX_FILE_LENGTH; i++) { + files[i] = ' '; + } + + while ((entry = readdir(dir)) != NULL && count < MAX_FILES) { + if (entry->d_name[0] == '.') { + continue; + } + if (strlen(entry->d_name) < prefix_length) { + continue; + } + bool match = true; + for (i = 0; i < prefix_length; i++) { + if (entry->d_name[i] != prefix[i]) { + match = false; + break; + } + } + if (!match) { + continue; + } + //if (entry->d_name+strlen(entry->d_name) - 1 != "t") continue; + //if (entry->d_name+strlen(entry->d_name) - 2 != "a") continue; + //if (entry->d_name+strlen(entry->d_name) - 3 != "d") continue; + //if (entry->d_name+strlen(entry->d_name) - 4 != ".") continue; + + strcpy(files + count * MAX_FILE_LENGTH, entry->d_name); + count++; + } + *num_files = count; + + closedir(dir); +} + + + + + diff --git a/src/a_module_tests/c_lister.h b/src/a_module_tests/c_lister.h new file mode 100644 index 0000000..30a00da --- /dev/null +++ b/src/a_module_tests/c_lister.h @@ -0,0 +1,7 @@ +#ifndef C_LISTER_H +#define C_LISTER_H + +#define MAX_FILES 65536 +#define MAX_FILE_LENGTH 30 + +#endif diff --git a/src/a_module_tests/test_dgemm.f90 b/src/a_module_tests/test_dgemm.f90 index f162b95..e8a39da 100644 --- a/src/a_module_tests/test_dgemm.f90 +++ b/src/a_module_tests/test_dgemm.f90 @@ -103,7 +103,7 @@ program test_dgemm close (10) else if (gen .eq. 0) then C = C - C_orig - if (maxval(C) > 1.0d-10) then + if (maxval(abs(C)) > 1.0d-10) then print *, "ERROR" else print *, "OK" diff --git a/src/a_module_tests/test_makefun.f90 b/src/a_module_tests/test_makefun.f90 new file mode 100644 index 0000000..70fc10c --- /dev/null +++ b/src/a_module_tests/test_makefun.f90 @@ -0,0 +1,585 @@ +#include "c_lister.h" + +program makefun_tester + + implicit none + + interface + subroutine list_directory(path, path_length, files, num_files, prefix& + &, prefix_length) bind(C, name="list_directory") + use, intrinsic :: iso_c_binding + character(c_char), intent(in) :: path(*) + character(c_char), intent(in) :: prefix(*) + character(c_char), intent(out) :: files(MAX_FILE_LENGTH, MAX_FILES) + integer(c_int), intent(in), value :: prefix_length + integer(c_int), intent(in), value :: path_length + integer(c_int), intent(out) :: num_files + end subroutine list_directory + end interface + + integer*4 :: iorb, indt, indpar, indorb, indshell, i0, iflagnorm_unused& + &, indtm, indtmin, typec, nelskip, num_lines, ii, iostat + real*8 :: cr + real*8, dimension(:), allocatable :: dd, zeta, r + real*8, dimension(:,:), allocatable :: z, rmu, distp + + integer*4, dimension(:), allocatable :: iorbs, multiplicities, npars& + &, failed_test + character*80 :: dummy_1, dummy_2, dummy_3, dummy_4 + + character*12000 :: error_message = "", tmp + + logical :: failed + + call initialize() + + cr = 0.0d0 + iflagnorm_unused = 0 + indtm = 5 + indt = 10 + + ! Load parameters form file parameters.csv + open(unit=10, file='parameters.csv', status='old', action='read') + ! Skip header + read(10,*) + ! Count number of lines + num_lines = 0 + do + read(10,*,iostat=iostat) + if (iostat /= 0) exit + num_lines = num_lines + 1 + end do + ! Allocate arrays + if (allocated(iorbs)) deallocate(iorbs) + allocate(iorbs(num_lines)) + if (allocated(multiplicities)) deallocate(multiplicities) + allocate(multiplicities(num_lines)) + if (allocated(npars)) deallocate(npars) + allocate(npars(num_lines)) + if (allocated(failed_test)) deallocate(failed_test) + allocate(failed_test(num_lines)) + if (allocated(zeta)) deallocate(zeta) + allocate(zeta(3)) ! Zeta is never more than 3 + + ! Set default zeta. Zeta is technically not used anymore + ! is here only for legacy reasons + zeta = 1.0_8 + + ! -1 means that test not failed + failed_test = -1 + + ! Rewind file + rewind(10) + ! Skip header + read(10,*) + ! Read data + do ii = 1, num_lines + read(10,*) iorbs(ii)& + &, dummy_1& + &, dummy_2& + &, dummy_3& + &, dummy_4& + &, multiplicities(ii)& + &, npars(ii) + end do + close(10) + + do ii = 1, num_lines + failed = .false. + write(*,'("Checking orbital index ", I3)') iorbs(ii) + write(*, *) + + if (allocated(dd)) deallocate(dd) + allocate(dd(npars(ii))) + + if (allocated(rmu)) deallocate(rmu) + allocate(rmu(3,0:indtm)) + + if (allocated(r)) deallocate(r) + allocate(r(0:indtm)) + + if (allocated(z)) deallocate(z) + allocate(z(multiplicities(ii),0:indt+4)) + + if (allocated(distp)) deallocate(distp) + allocate(distp(0:indtm,20)) + + !call create_single_value() + !call create_pa_value() + !call create_svgl_value() + call check_index_movement() + call check_single_value() + call check_svgl_value() + call check_pa_value() + + if (failed) then + failed_test(ii) = 1 + tmp = trim(error_message) + write(error_message, '(A,A,I3.3)') trim(tmp), ",", iorbs(ii) + end if + + deallocate(distp) + deallocate(z) + deallocate(r) + deallocate(dd) + deallocate(rmu) + + write(*, *) + write(*, '("Result = ", L1)') .not. failed + write(*, *) + write(*, '("######################################")') + end do + + if (allocated(iorbs)) deallocate(iorbs) + if (allocated(multiplicities)) deallocate(multiplicities) + if (allocated(npars)) deallocate(npars) + if (allocated(failed_test)) deallocate(failed_test) + + if (allocated(zeta)) deallocate(zeta) + if (allocated(r)) deallocate(r) + stop + + print *, "Failed tests: ", trim(error_message) + if (len_trim(error_message) > 0) then + stop 1 + else + stop 0 + end if + +contains + +function random_string(length) result(str) + + implicit none + + integer, intent(in) :: length + character(len=length) :: str + integer :: i + real*8 :: r + character(len=29) :: letters = 'abcdefghijklmnopqrstuvwxyz148' + + do i = 1, length + ! Generate random number between 1 and 29 + call random_number(r) + r = r * 29 + 1 + str(i:i) = letters(int(r):int(r)) + end do + +end function random_string + +subroutine initialize + + implicit none + logical :: data_dir_exists + + ! Initialize random number generator + call random_seed() + + ! Check if data directory exists, and create it if not + + inquire(file='data', exist=data_dir_exists) + if (.not. data_dir_exists) then + ! Create directory TODO: make it cross-platform + call system('mkdir data') + end if + +end subroutine initialize + +subroutine run_random + + implicit none + + ! Generate random points + call random_number(rmu) + rmu = rmu * 2.0d0 - 1.0d0 + + r = sqrt(sum(rmu**2, dim=1)) + + ! Randomize parameters + call random_number(dd) + + i0 = 0 + indtmin = 0 + typec = 0 + indpar = 0 + indorb = 0 + indshell = 0 + z = 0.0d0 + + call makefun(iorbs(ii),indt,i0,indtmin,indtm,typec,indpar & + &,indorb,indshell,multiplicities(ii),z,dd,zeta,r,rmu,distp & + &,iflagnorm_unused,cr) + + print *, "indorb = ", indorb + print *, "indshell = ", indshell + print *, "indpar = ", indpar + +end subroutine run_random + +subroutine check_index_movement + + implicit none + + write(*, '(A)') 'Test: index movement' + + failed = .false. + + ! Generate random points + call random_number(rmu) + rmu = rmu * 2.0d0 - 1.0d0 + + r = sqrt(sum(rmu**2, dim=1)) + + ! Randomize parameters + call random_number(dd) + + i0 = 0 + indtmin = 0 + typec = 0 + indpar = 0 + indorb = 0 + indshell = 0 + z = 0.0d0 + + call makefun(iorbs(ii),indt,i0,indtmin,indtm,typec,indpar & + &,indorb,indshell,multiplicities(ii),z,dd,zeta,r,rmu,distp & + &,iflagnorm_unused,cr) + + write(*,'("indorb = ",I3)', advance="no") indorb + if (indorb /= multiplicities(ii)) then + write(*,'(" FAILED")') + failed = .true. + else + write(*,'(" OK")') + end if + + write(*,'("indshell = ",I3)', advance="no") indshell + if (indshell /= multiplicities(ii)) then + write(*,'(" FAILED")') + failed = .true. + else + write(*,'(" OK")') + end if + + write(*,'("indpar = ",I3)', advance="no") indpar + if (indpar /= npars(ii)) then + write(*,'(" FAILED")') + failed = .true. + else + write(*,'(" OK")') + end if + + write(*, *) + +end subroutine check_index_movement + +subroutine create_pa_value + + implicit none + character*80 :: filename + + ! Generate random points + call random_number(rmu) + rmu = rmu * 4.0d0 - 2.0d0 + + r = sqrt(sum(rmu**2, dim=1)) + + ! Randomize parameters + call random_number(dd) + + i0 = 0 + indtmin = 0 + indpar = 0 + indorb = 0 + indshell = 0 + typec = 1 + z = 0.0d0 + + call makefun(iorbs(ii),indt,i0,indtmin,indtm,typec,indpar & + &,indorb,indshell,multiplicities(ii),z,dd,zeta,r,rmu,distp & + &,iflagnorm_unused,cr) + + ! In a binary file data/sv.dat we store the following data: + ! 1. iorbs(ii) + ! 2. dd array + ! 3. rmu array + + write(filename, '(A,I3.3,A,A,A,A)') 'data/pa_', iorbs(ii), "_", random_string(15), '.dat' + open(unit=20, file=filename, form='unformatted', status='replace', action='write') + write(20) dd + write(20) rmu(:,:) + write(20) z(:, 0:indtm) + close(20) + +end subroutine create_pa_value + +subroutine create_svgl_value + + implicit none + character*80 :: filename + + ! Generate random points + call random_number(rmu) + rmu = rmu * 4.0d0 - 2.0d0 + + r = sqrt(sum(rmu**2, dim=1)) + + ! Randomize parameters + call random_number(dd) + + i0 = 0 + indtmin = 0 + indpar = 0 + indorb = 0 + indshell = 0 + typec = 0 + z = 0.0d0 + + call makefun(iorbs(ii),0,i0,indtmin,0,typec,indpar & + &,indorb,indshell,multiplicities(ii),z,dd,zeta,r,rmu,distp & + &,iflagnorm_unused,cr) + + ! In a binary file data/sv.dat we store the following data: + ! 1. iorbs(ii) + ! 2. dd array + ! 3. rmu array + + write(filename, '(A,I3.3,A,A,A,A)') 'data/svgl_', iorbs(ii), "_", random_string(15), '.dat' + open(unit=20, file=filename, form='unformatted', status='replace', action='write') + write(20) dd + write(20) rmu(:,0) + write(20) z(:, 0:3) + close(20) + +end subroutine create_svgl_value + +subroutine create_single_value + + implicit none + character*80 :: filename + + ! Generate random points + call random_number(rmu) + rmu = rmu * 2.0d0 - 1.0d0 + + r = sqrt(sum(rmu**2, dim=1)) + + ! Randomize parameters + call random_number(dd) + + i0 = 0 + indtmin = 0 + indpar = 0 + indorb = 0 + indshell = 0 + typec = 1 + z = 0.0d0 + + call makefun(iorbs(ii),indt,i0,indtmin,0,typec,indpar & + &,indorb,indshell,multiplicities(ii),z,dd,zeta,r,rmu,distp & + &,iflagnorm_unused,cr) + + ! In a binary file data/sv.dat we store the following data: + ! 1. iorbs(ii) + ! 2. dd array + ! 3. rmu array + + write(filename, '(A,I3.3,A,A,A,A)') 'data/sv_', iorbs(ii), "_", random_string(15), '.dat' + open(unit=20, file=filename, form='unformatted', status='replace', action='write') + write(20) dd + write(20) rmu(:,0) + write(20) z(:, 0) + close(20) + +end subroutine create_single_value + +subroutine check_single_value + + implicit none + + character :: files(MAX_FILE_LENGTH, MAX_FILES) + character*MAX_FILE_LENGTH :: filename + integer*4 :: num_files, i, j, iorb_test, ios, count_tests, count_failed + real*8 :: z_test(multiplicities(ii), 0:0) + + write(*, '(A)') 'Test: single value' + + call list_directory('data', 4, files, num_files, 'sv_', 3) + + count_tests = 0 + count_failed = 0 + do i = 1, num_files + do j = 1, MAX_FILE_LENGTH + filename(j:j) = files(j,i) + end do + + read(filename(4:6), '(I3)', iostat=ios ) iorb_test + if (ios /= 0) then + cycle + end if + if (iorb_test /= iorbs(ii)) then + cycle + else + end if + + open(unit=20, file='data/'//trim(filename), form='unformatted'& + &, status='old', action='read') + read(20) dd + read(20) rmu(:,0) + read(20) z_test(:, 0) + close(20) + + i0 = 0 + indtmin = 0 + typec = 1 + indpar = 0 + indorb = 0 + indshell = 0 + r = sqrt(sum(rmu**2, dim=1)) + z = 0.0d0 + + call makefun(iorbs(ii),indt,i0,indtmin,0,typec,indpar & + &,indorb,indshell,multiplicities(ii),z,dd,zeta,r,rmu,distp& + &,iflagnorm_unused,cr) + + if (any(abs(z_test - z) > 1.0d-10)) then + failed = .true. + count_failed = count_failed + 1 + end if + count_tests = count_tests + 1 + + end do + + write(*, '("tests/failed = ",I3, "/",I3)') count_tests, count_failed + write(*, *) + +end subroutine check_single_value + +subroutine check_pa_value + + implicit none + + character :: files(MAX_FILE_LENGTH, MAX_FILES) + character*MAX_FILE_LENGTH :: filename + integer*4 :: num_files, i, j, iorb_test, ios, count_tests, count_failed + real*8 :: z_test(multiplicities(ii), 0:indtm) + character(*), parameter :: prefix = 'pa_' + + write(*, '(A)') 'Test: calculate values for pseudo average' + + call list_directory('data', 4, files, num_files, prefix, len_trim(prefix)) + + count_tests = 0 + count_failed = 0 + do i = 1, num_files + do j = 1, MAX_FILE_LENGTH + filename(j:j) = files(j,i) + end do + + read(filename(len_trim(prefix)+1:len_trim(prefix)+3), '(I3)', iostat=ios ) iorb_test + if (ios /= 0) then + cycle + end if + if (iorb_test /= iorbs(ii)) then + cycle + else + end if + + open(unit=20, file='data/'//trim(filename), form='unformatted', status='old', action='read') + read(20) dd + read(20) rmu(:,:) + read(20) z_test(:, 0:indtm) + close(20) + + i0 = 0 + indtmin = 0 + typec = 1 + indpar = 0 + indorb = 0 + indshell = 0 + r = sqrt(sum(rmu**2, dim=1)) + z = 0.0d0 + + call makefun(iorbs(ii),indt,i0,indtmin,indtm,typec,indpar & + &,indorb,indshell,multiplicities(ii),z,dd,zeta,r,rmu,distp& + &,iflagnorm_unused,cr) + + ! Check if values are the same + ! Check if other values remained untouched + if ( any(abs(z_test(:,0:indtm) - z(:,0:indtm)) > 1.0d-10) & + .or. any(abs(z(:,indtm+1:indt)) > 10d-10)) then + failed = .true. + count_failed = count_failed + 1 + end if + count_tests = count_tests + 1 + + end do + + write(*, '("tests/failed = ",I3, "/",I3)') count_tests, count_failed + write(*, *) + +end subroutine check_pa_value + +subroutine check_svgl_value + + implicit none + + character :: files(MAX_FILE_LENGTH, MAX_FILES) + character*MAX_FILE_LENGTH :: filename + integer*4 :: num_files, i, j, iorb_test, ios, count_tests, count_failed + real*8 :: z_test(multiplicities(ii), 0:3) + character(*), parameter :: prefix = 'svgl_' + + write(*, '(A)') 'Test: single value gradient and laplacian' + + call list_directory('data', 4, files, num_files, prefix, len_trim(prefix)) + + count_tests = 0 + count_failed = 0 + do i = 1, num_files + do j = 1, MAX_FILE_LENGTH + filename(j:j) = files(j,i) + end do + + read(filename(len_trim(prefix)+1:len_trim(prefix)+3), '(I3)', iostat=ios ) iorb_test + if (ios /= 0) then + cycle + end if + if (iorb_test /= iorbs(ii)) then + cycle + else + end if + + open(unit=20, file='data/'//trim(filename), form='unformatted', status='old', action='read') + read(20) dd + read(20) rmu(:,0) + read(20) z_test(:, 0:3) + close(20) + + i0 = 0 + indtmin = 0 + typec = 0 + indpar = 0 + indorb = 0 + indshell = 0 + r = sqrt(sum(rmu**2, dim=1)) + z = 0.0d0 + + call makefun(iorbs(ii),0,i0,indtmin,0,typec,indpar & + &,indorb,indshell,multiplicities(ii),z,dd,zeta,r,rmu,distp& + &,iflagnorm_unused,cr) + + if (any(abs(z_test(:,0:3) - z(:,0:3)) > 1.0d-10)) then + failed = .true. + count_failed = count_failed + 1 + end if + count_tests = count_tests + 1 + + end do + + write(*, '("tests/failed = ",I3, "/",I3)') count_tests, count_failed + write(*, *) + +end subroutine check_svgl_value + +end program makefun_tester diff --git a/src/a_turborvb/Makefile b/src/a_turborvb/Makefile index bc29d08..cc27c8d 100644 --- a/src/a_turborvb/Makefile +++ b/src/a_turborvb/Makefile @@ -72,7 +72,7 @@ $(TARGET): $(TARGET_MODULES) $(OBJS) $(BUILD_DIR)/common.a \ $(BUILD_DIR)/common_module.a \ $(BUILD_DIR)/pfapack.a \ - -J $(MODULE_DIR) \ + $(MODULE_STORE) $(MODULE_DIR) \ $(LINK_LIBS) \ -o $(TARGET) diff --git a/src/a_turborvb/main.f90 b/src/a_turborvb/main.f90 index 81e897b..a459169 100644 --- a/src/a_turborvb/main.f90 +++ b/src/a_turborvb/main.f90 @@ -18,6 +18,7 @@ program main use allio use convertmod use IO_m + use trexio ! by E. Coccia (8/11/10) use extpot ! by E. Coccia (28/12/10) @@ -5444,6 +5445,7 @@ end subroutine writeandbranch subroutine Initializeall use allio + use qmckl ! by E. Coccia (9/11/10) use extpot, only: mm_restr, n_x, n_y, n_z, delta, x0, ext_pot, link_atom, write_rwalk use splines, only: bscoef @@ -5466,6 +5468,7 @@ subroutine Initializeall call omp_set_num_threads(1) ! scalar code #endif + ! Definition once for all machine precision and safemin as in lapack (more strict) epsmach = dlamch('e') safemin = 10000.d0*dlamch('s') @@ -8703,6 +8706,52 @@ subroutine Initializeall write (6, *) ' Warning using SPARSE matrix algorithm for Jastrow ' end if enerdiff = 0.d0 ! just to be sure it is initialized. + + ! Set QMCkl context to zero + qmckl_ctx = 0_8 + use_qmckl = .false. + + if (trexiofile.ne.'') then +#ifdef _QMCKL + ! If trexio file is fort.10 the is not a trexio file + ! in this case load qmckl context from fort.10 + if (trexiofile.eq.'fort.10') then + call setup_qmckl_ctx(nion& + &, nshell& + &, atom_number& + &, rion& + &, kion& + &, ioptorb& + &, dup_c& + &, qmckl_ctx) + if (qmckl_ctx.ne.0_8) then + write (6, *) "Loading QMCKL data from fort.10" + use_qmckl = .true. + else + write (6, *) "Failed to load QMCKL data from fort.10" + end if + else + ! Load data from trexio file + + qmckl_ctx = qmckl_context_create() + if (qmckl_ctx.eq.0_8) then + write (6, *) "Failed to create QMCKL context" + stop + end if + + use_qmckl = (QMCKL_SUCCESS.eq.qmckl_trexio_read(qmckl_ctx& + & , trim(trexiofile)& + , 1_8*len(trim(trexiofile)))) + if (use_qmckl) then + write (6, *) "Loading TREXIO file:", trexiofile + else + write (6, *) "Failed to load TREXIO file:", trexiofile + end if + end if +#else + write (6, *) "Ignoring TREXIO file, TurboRVB was not compiled with QMCkl support" +#endif + end if end subroutine Initializeall subroutine Finalizeall @@ -8711,16 +8760,25 @@ subroutine Finalizeall use extpot, only: ext_pot, mm_restr, write_rwalk ! by E. Coccia (4/2/11): deallocate arrays for van_der_waals use van_der_waals, only: vdw + use qmckl implicit none real*8, external :: dnrm2 real*8 drand1, enercont, jacobian, mapping integer iend_sav + integer(kind=qmckl_exit_code) :: rc #if defined (_OPENMP) && defined (__NOOMP) integer, external :: omp_get_max_threads call omp_set_num_threads(1) ! scalar code #endif +#ifdef _QMCKL + rc = qmckl_context_destroy(qmckl_ctx) + if (rc.ne.QMCKL_SUCCESS) then + write (0, *) "Unable to destroy QMCkl context" + end if +#endif + ! by E. Coccia (20/12/11): writing electronic random walk if (rank .eq. 0 .and. write_rwalk) close (671) diff --git a/src/b_complex/read_datas.f90 b/src/b_complex/read_datas.f90 index 5cd7992..383060c 100644 --- a/src/b_complex/read_datas.f90 +++ b/src/b_complex/read_datas.f90 @@ -17,12 +17,18 @@ subroutine read_datasmin use allio use Thomas_Fermi_model !!!! new !!!! added by K.Nakano 11/09/2019 use dielectric + use qmckl implicit none - integer :: i, j, ind + integer :: i, ii, j, ind real(8) :: num_ele_core_r_c, r_c, beta_for_r_c, kappa_for_r_c !!!! new !!!! added by K.Nakano 11/09/2019 real(8), external :: dlamch logical noreadnpbra, def_nscra real*8 derfc, err_derfc + integer(kind=qmckl_exit_code) :: rc + integer(kind=8) :: qmckl_shell_num, qmckl_prim_num, qmckl_index(10000), npoints_qmckl, ao_num + integer(kind=4) :: qmckl_index4(10000) + real*8 :: electrons(3, 2) + real*8, allocatable :: ao_value_qmckl(:) #ifdef _OFFLOAD integer*8, parameter :: max_sparse = 40 #else @@ -653,6 +659,19 @@ subroutine read_datasmin write (6, *) 'dumping configurations each', ifreqdump, 'generations' end if + if (trexiofile.ne.'') then +#ifdef _QMCKL + use_qmckl = (QMCKL_SUCCESS.eq.qmckl_trexio_read(qmckl_ctx, trim(trexiofile), 1_8*len(trim(trexiofile)))) + if (use_qmckl) then + write (6, *) "Loading TREXIO file:", trexiofile + else + write (6, *) "Failed to load TREXIO file:", trexiofile + end if +#else + write (6, *) "Ignoring TREXIO file, TurboRVB was not compiled with QMCkl support" + use_qmckl = .false. +#endif + end if ! default values parameters vmc with calculation of variance ieser = -1 @@ -1915,6 +1934,7 @@ subroutine read_datasmin call mpi_bcast(link_atom, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) call mpi_bcast(calpha, maxcap, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) call mpi_bcast(wherescratch, 60 + lchlen, MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr) + call mpi_bcast(trexiofile, 60 + lchlen, MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr) call mpi_bcast(writescratch, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) call mpi_bcast(freqcheck, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) call mpi_bcast(ifreqdump, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) diff --git a/src/c_adjoint_backward/makefun0_b.f90 b/src/c_adjoint_backward/makefun0_b.f90 index 18526d1..4e48112 100644 --- a/src/c_adjoint_backward/makefun0_b.f90 +++ b/src/c_adjoint_backward/makefun0_b.f90 @@ -1,4 +1,3 @@ -!TL off !########################################################### @@ -13,6 +12,7 @@ ! Differentiation of makefun in reverse (adjoint) mode: ! gradient, with respect to input variables: dd r z rmu distp ! of linear combination of output variables: dd r z rmu +!TL off SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,ddb,zeta,r,rb,rmu,rmub,distp,distpb,iflagnorm_unused,cr) USE CONSTANTS @@ -21,2653 +21,2632 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd integer :: adi4ibuf,adr8ibuf,adi4buf(1024) real*8 :: adr8buf(1024) ! --- - INTEGER :: iopt, indt, i, k, nelskip, indpar, indorbp, indorb, indshell, indshellp, ic, iflagnorm_unused, indparp, npower, typec + INTEGER :: iopt, indt, i, k, nelskip, indpar, indorbp, indorb, indshell, indshellp, ic, iflagnorm_unused, indparp, npower, typec, ii, jj, kk ! up to i - REAL*8 :: z(nelskip, 0:*), dd(*), zeta(*), rmu(3, 0:0), r(0:0 ), distp(0:0, 20), peff, fun, fun0, fun2, rp1, rp2, rp3, rp4, rp5 , rp6, rp7, rp8, dd1, dd2, dd3, dd4, dd5, c, cr, funp, fun2p, peff2, arg, c0, c1, cost, zv(6), yv(6), xv(6), r2, r4, r6 - REAL*8 :: zb(nelskip, 0:*), ddb(*), rmub(3, 0:0), rb(0:0), distpb(0:0, 20), peffb, funb, fun0b, fun2b, rp1b, rp2b, rp3b, rp4b , rp5b, rp6b, rp8b, dd1b, dd2b, dd3b, dd4b, dd5b, cb, funpb, fun2pb, peff2b, argb, c0b, c1b, costb, zvb(6), yvb(6), xvb(6), r2b, r4b, r6b + REAL*8 :: z(nelskip, 0:*), dd(*), zeta(*), rmu(3, 0:0), r(0:0 ), distp(0:0, 20), peff, fun, fun0, fun2, rp1, rp2, rp3, rp4, rp5 , rp6, rp7, rp8, dd1, dd2, dd3, dd4, dd5, c, cr, funp, fun2p, funb, peff2, arg, c0, c1, cost, zv(6), yv(6), xv(6), r2, r4, r6 + REAL*8 :: zb(nelskip, 0:*), ddb(*), rmub(3, 0:0), rb(0:0), distpb(0:0, 20), peffb, funb0, fun0b, fun2b, rp1b, rp2b, rp3b, rp4b, rp5b, rp6b, rp8b, dd1b, dd2b, dd3b, dd4b, dd5b, cb, funpb, fun2pb, funbb, peff2b, argb, c0b, c1b, costb, zvb(6), yvb(6), xvb(6), r2b, r4b, r6b + INTEGER :: count, multiplicity + INTEGER, PARAMETER :: max_power=20 + REAL*8 :: powers(3, -2:max_power, 0:0) + REAL*8 :: powersb(3, -2:max_power, 0:0) + REAL*8 :: tmp + REAL*8 :: tmp0 + REAL*8 :: tmp1 + REAL*8 :: tmp2 + REAL*8 :: tmp3 + REAL*8 :: tmp4 + REAL*8 :: tmp5 + REAL*8 :: tmp6 INTEGER :: branch INTEGER :: ad_from + INTEGER :: ad_from0 + INTEGER :: ad_from1 + INTEGER :: ad_from2 + INTEGER :: ad_from3 INTEGER :: ad_to - REAL*8 :: temp3 - DOUBLE PRECISION :: temp29 - REAL*8 :: temp42b3 - REAL*8 :: temp57b7 - REAL*8 :: temp57b18 - REAL*8 :: temp68b43 + DOUBLE PRECISION :: temp3 + DOUBLE PRECISION :: temp8b56 + REAL*8 :: temp29 + REAL*8 :: temp25b2 + REAL*8 :: temp131b11 + REAL*8 :: temp131b48 + REAL*8 :: temp135b26 REAL*8 :: temp153b + REAL*8 :: temp155b0 + REAL*8 :: temp172b1 + REAL*8 :: temp197b55 REAL*8 :: temp234b + REAL*8 :: temp253b1 + REAL*8 :: temp253b52 REAL*8 :: temp296 - REAL*8 :: temp315b + REAL*8 :: temp317b0 + REAL*8 :: temp332b18 + REAL*8 :: temp335b24 + REAL*8 :: temp340b37 REAL*8 :: temp340 - REAL*8 :: temp373b22 - REAL*8 :: temp373b59 - DOUBLE PRECISION :: temp377 - REAL*8 :: temp379b71 - REAL*8 :: temp386b28 - REAL*8 :: temp388b2 - REAL*8 :: temp388b62 - REAL*8 :: temp404b27 - REAL*8 :: temp415b1 + REAL*8 :: temp377 REAL*8 :: temp421 + REAL*8 :: temp432b2 + REAL*8 :: temp448b74 REAL*8 :: temp458 REAL*8 :: temp486b3 - REAL*8 :: temp496b35 REAL*8 :: temp502 - REAL*8 :: temp513b2 REAL*8 :: temp2 + REAL*8 :: temp8b55 REAL*8 :: temp28 + REAL*8 :: temp25b1 REAL*8 :: temp42b2 - REAL*8 :: temp57b6 - REAL*8 :: temp57b17 - REAL*8 :: temp68b42 + REAL*8 :: temp131b10 + REAL*8 :: temp131b47 + REAL*8 :: temp135b25 + REAL*8 :: temp172b0 + REAL*8 :: temp197b54 + REAL*8 :: temp198b REAL*8 :: temp242b - DOUBLE PRECISION :: temp295 - REAL*8 :: temp373b21 - REAL*8 :: temp373b58 - DOUBLE PRECISION :: temp376 - REAL*8 :: temp379b70 - REAL*8 :: temp386b27 - REAL*8 :: temp388b1 - REAL*8 :: temp388b61 - REAL*8 :: temp404b - REAL*8 :: temp404b26 + REAL*8 :: temp253b0 + REAL*8 :: temp253b51 + REAL*8 :: temp279b + REAL*8 :: temp295 + REAL*8 :: temp323b + REAL*8 :: temp332b17 + REAL*8 :: temp335b23 + REAL*8 :: temp340b36 + REAL*8 :: temp344b9 + REAL*8 :: temp376 + DOUBLE PRECISION :: temp404b REAL*8 :: temp415b0 REAL*8 :: temp420 - DOUBLE PRECISION :: temp457 - REAL*8 :: temp469b1 + REAL*8 :: temp432b1 + REAL*8 :: temp448b73 + REAL*8 :: temp457 + DOUBLE PRECISION :: temp469b1 REAL*8 :: temp486b2 - REAL*8 :: temp496b34 - INTEGER :: temp501 - REAL*8 :: temp513b1 + REAL*8 :: temp501 REAL*8 :: temp1 - REAL*8 :: temp25b0 + REAL*8 :: temp8b54 REAL*8 :: temp27 + REAL*8 :: temp25b0 REAL*8 :: temp42b1 - REAL*8 :: temp57b5 - REAL*8 :: temp57b16 - REAL*8 :: temp68b41 - REAL*8 :: temp79b1 - REAL*8 :: temp150b3 - DOUBLE PRECISION :: temp250b - DOUBLE PRECISION :: temp294 + REAL*8 :: temp131b46 + REAL*8 :: temp135b24 + REAL*8 :: temp197b53 + REAL*8 :: temp250b + REAL*8 :: temp253b50 + REAL*8 :: temp287b + REAL*8 :: temp294 REAL*8 :: temp331b - REAL*8 :: temp373b20 - REAL*8 :: temp373b57 + REAL*8 :: temp332b16 + REAL*8 :: temp335b22 + REAL*8 :: temp340b35 + REAL*8 :: temp344b8 DOUBLE PRECISION :: temp375 - REAL*8 :: temp386b26 - REAL*8 :: temp388b0 - REAL*8 :: temp388b60 - REAL*8 :: temp404b25 REAL*8 :: temp412b - DOUBLE PRECISION :: temp456 - REAL*8 :: temp469b0 + REAL*8 :: temp432b0 + REAL*8 :: temp448b72 + REAL*8 :: temp449b + REAL*8 :: temp456 + DOUBLE PRECISION :: temp469b0 REAL*8 :: temp486b1 - REAL*8 :: temp496b33 REAL*8 :: temp500 - REAL*8 :: temp513b0 + REAL*8 :: tmp4b REAL*8 :: temp0 - REAL*8 :: temp13b - REAL*8 :: temp26 - REAL*8 :: temp42b0 - REAL*8 :: temp57b4 - REAL*8 :: temp57b15 - REAL*8 :: temp68b40 - REAL*8 :: temp79b0 - REAL*8 :: temp91b6 - REAL*8 :: temp150b2 + REAL*8 :: temp8b53 + DOUBLE PRECISION :: temp26 + DOUBLE PRECISION :: temp42b0 + DOUBLE PRECISION :: temp116b0 + REAL*8 :: temp131b45 + REAL*8 :: temp133b1 + REAL*8 :: temp135b23 + REAL*8 :: temp197b52 REAL*8 :: temp293 - REAL*8 :: temp312b2 - REAL*8 :: temp373b56 + REAL*8 :: temp332b15 + REAL*8 :: temp335b21 + REAL*8 :: temp340b34 + REAL*8 :: temp344b7 DOUBLE PRECISION :: temp374 - REAL*8 :: temp376b - REAL*8 :: temp386b25 - REAL*8 :: temp404b24 REAL*8 :: temp420b + REAL*8 :: temp448b71 REAL*8 :: temp455 - REAL*8 :: temp481b5 + REAL*8 :: temp457b REAL*8 :: temp486b0 - REAL*8 :: temp488b13 - REAL*8 :: temp496b9 - REAL*8 :: temp496b32 REAL*8 :: temp501b REAL*8 :: temp7b + REAL*8 :: temp8b52 REAL*8 :: temp21b - REAL*8 :: temp25 - REAL*8 :: temp57b3 - REAL*8 :: temp57b14 + DOUBLE PRECISION :: temp25 REAL*8 :: temp58b - REAL*8 :: temp91b5 - REAL*8 :: temp150b1 + REAL*8 :: temp131b44 + REAL*8 :: temp133b0 + REAL*8 :: temp135b22 + REAL*8 :: temp191b39 + REAL*8 :: temp197b51 + REAL*8 :: temp224b9 + REAL*8 :: temp225b13 REAL*8 :: temp292 - REAL*8 :: temp312b1 - REAL*8 :: temp373b55 - REAL*8 :: temp373 - REAL*8 :: temp386b24 - REAL*8 :: temp404b23 - REAL*8 :: temp454 + REAL*8 :: temp332b14 + REAL*8 :: temp335b20 + REAL*8 :: temp340b33 + REAL*8 :: temp344b6 + DOUBLE PRECISION :: temp373 + REAL*8 :: temp384b + REAL*8 :: temp448b70 + DOUBLE PRECISION :: temp454 REAL*8 :: temp465b - REAL*8 :: temp481b4 - REAL*8 :: temp488b12 - REAL*8 :: temp496b8 - REAL*8 :: temp496b31 + REAL*8 :: temp464b3 + REAL*8 :: temp8b51 REAL*8 :: temp24 - REAL*8 :: temp57b2 - REAL*8 :: temp57b13 + REAL*8 :: temp50b29 REAL*8 :: temp66b - REAL*8 :: temp91b4 - REAL*8 :: temp150b0 - DOUBLE PRECISION :: temp291 + REAL*8 :: temp74b3 + REAL*8 :: temp118b11 + REAL*8 :: temp131b43 + REAL*8 :: temp135b21 + REAL*8 :: temp191b38 + REAL*8 :: temp197b9 + REAL*8 :: temp197b50 + REAL*8 :: temp224b8 + REAL*8 :: temp225b12 + REAL*8 :: temp291 REAL*8 :: temp312b0 - REAL*8 :: temp322b9 - REAL*8 :: temp349b0 - REAL*8 :: temp372 - REAL*8 :: temp373b54 - REAL*8 :: temp386b23 + REAL*8 :: temp332b13 + REAL*8 :: temp335b56 + REAL*8 :: temp340b32 + REAL*8 :: temp344b5 + REAL*8 :: temp344b10 + DOUBLE PRECISION :: temp372 REAL*8 :: temp392b - REAL*8 :: temp404b22 REAL*8 :: temp453 - REAL*8 :: temp473b - REAL*8 :: temp481b3 - REAL*8 :: temp488b11 - REAL*8 :: temp496b7 - REAL*8 :: temp496b30 + REAL*8 :: temp464b2 INTRINSIC DEXP + REAL*8 :: temp8b50 REAL*8 :: temp23 - REAL*8 :: temp57b1 - REAL*8 :: temp57b12 - REAL*8 :: temp57b49 - REAL*8 :: temp91b3 - REAL*8 :: temp109b5 - REAL*8 :: temp111b - REAL*8 :: temp119 + REAL*8 :: temp50b28 + REAL*8 :: temp74b + REAL*8 :: temp74b2 + DOUBLE PRECISION :: temp119 + REAL*8 :: temp118b10 + REAL*8 :: temp131b42 + REAL*8 :: temp135b20 REAL*8 :: temp148b + REAL*8 :: temp191b37 + REAL*8 :: temp197b8 + REAL*8 :: temp224b7 + REAL*8 :: temp225b11 REAL*8 :: temp229b - REAL*8 :: temp280b5 - DOUBLE PRECISION :: temp290 - REAL*8 :: temp322b8 + REAL*8 :: temp290 + REAL*8 :: temp332b12 + REAL*8 :: temp335b55 + REAL*8 :: temp340b31 REAL*8 :: temp344b4 - REAL*8 :: temp361b5 REAL*8 :: temp371 - REAL*8 :: temp373b53 - REAL*8 :: temp386b22 - REAL*8 :: temp388b93 - REAL*8 :: temp404b21 + REAL*8 :: temp447b0 REAL*8 :: temp452 + REAL*8 :: temp464b1 REAL*8 :: temp481b - REAL*8 :: temp481b2 - REAL*8 :: temp488b10 DOUBLE PRECISION :: temp489 - REAL*8 :: temp496b6 - REAL*8 :: temp22 - REAL*8 :: temp18b3 + REAL*8 :: temp20b0 + DOUBLE PRECISION :: temp22 + REAL*8 :: temp50b27 REAL*8 :: temp57b0 - REAL*8 :: temp57b11 - REAL*8 :: temp57b48 DOUBLE PRECISION :: temp59 - REAL*8 :: temp91b2 - REAL*8 :: temp109b4 - REAL*8 :: temp111b1 - REAL*8 :: temp118 - REAL*8 :: temp156b + REAL*8 :: temp74b1 + REAL*8 :: temp82b + DOUBLE PRECISION :: temp83b12 + DOUBLE PRECISION :: temp118 + REAL*8 :: temp131b41 + REAL*8 :: temp131b78 + REAL*8 :: temp148b1 + DOUBLE PRECISION :: temp156b + REAL*8 :: temp191b36 + REAL*8 :: temp197b7 + REAL*8 :: temp200b + REAL*8 :: temp224b6 + REAL*8 :: temp225b10 + REAL*8 :: temp226b19 REAL*8 :: temp237b - REAL*8 :: temp280b4 REAL*8 :: temp318b - REAL*8 :: temp322b7 + REAL*8 :: temp332b11 + REAL*8 :: temp335b54 + REAL*8 :: temp340b30 REAL*8 :: temp344b3 - REAL*8 :: temp361b4 REAL*8 :: temp370 - REAL*8 :: temp373b52 - REAL*8 :: temp386b21 - REAL*8 :: temp386b58 - REAL*8 :: temp388b92 - REAL*8 :: temp404b20 - REAL*8 :: temp408b2 + REAL*8 :: temp383b0 REAL*8 :: temp451 - REAL*8 :: temp474b9 + REAL*8 :: temp464b0 REAL*8 :: temp481b1 - REAL*8 :: temp488 - REAL*8 :: temp496b5 + DOUBLE PRECISION :: temp488 REAL*8 :: temp21 - REAL*8 :: temp18b2 - REAL*8 :: temp57b10 - REAL*8 :: temp57b47 - REAL*8 :: temp58 - REAL*8 :: temp91b1 - REAL*8 :: temp109b3 - REAL*8 :: temp111b0 + REAL*8 :: temp50b26 + DOUBLE PRECISION :: temp58 + REAL*8 :: temp74b0 + DOUBLE PRECISION :: temp83b11 REAL*8 :: temp117 + REAL*8 :: temp131b40 + REAL*8 :: temp131b77 REAL*8 :: temp148b0 REAL*8 :: temp164b - REAL*8 :: temp245b - REAL*8 :: temp280b3 - REAL*8 :: temp322b6 + REAL*8 :: temp191b35 + REAL*8 :: temp197b6 + REAL*8 :: temp224b5 + REAL*8 :: temp226b18 + REAL*8 :: temp263b2 + REAL*8 :: temp326b + REAL*8 :: temp332b10 + REAL*8 :: temp335b53 REAL*8 :: temp344b2 - REAL*8 :: temp361b3 - REAL*8 :: temp373b51 - REAL*8 :: temp386b20 - REAL*8 :: temp386b57 - REAL*8 :: temp387b29 - REAL*8 :: temp388b91 - REAL*8 :: temp407b - REAL*8 :: temp408b1 REAL*8 :: temp450 - REAL*8 :: temp474b8 REAL*8 :: temp479b3 REAL*8 :: temp481b0 REAL*8 :: temp487 - REAL*8 :: temp496b4 - REAL*8 :: temp18b1 REAL*8 :: temp20 - REAL*8 :: temp57b46 + REAL*8 :: temp50b25 REAL*8 :: temp57 - REAL*8 :: temp58b18 - REAL*8 :: temp91b0 - REAL*8 :: temp109b2 - REAL*8 :: temp116 - REAL*8 :: temp202b8 + DOUBLE PRECISION :: temp83b10 + DOUBLE PRECISION :: temp116 + REAL*8 :: temp124b29 + REAL*8 :: temp131b76 + REAL*8 :: temp172b + REAL*8 :: temp191b34 + REAL*8 :: temp197b5 + REAL*8 :: temp207b3 + REAL*8 :: temp224b4 + REAL*8 :: temp226b17 REAL*8 :: temp246b0 - REAL*8 :: temp280b2 - REAL*8 :: temp322b5 - DOUBLE PRECISION :: temp334b + REAL*8 :: temp253b + REAL*8 :: temp263b1 + REAL*8 :: temp335b52 REAL*8 :: temp344b1 - REAL*8 :: temp361b2 - REAL*8 :: temp373b50 - REAL*8 :: temp386b56 - REAL*8 :: temp387b28 - REAL*8 :: temp388b90 - REAL*8 :: temp408b0 REAL*8 :: temp415b - REAL*8 :: temp474b7 + REAL*8 :: temp420b6 REAL*8 :: temp479b2 REAL*8 :: temp486 - REAL*8 :: temp496b3 REAL*8 :: temp16b - REAL*8 :: temp18b0 + REAL*8 :: temp49b26 + REAL*8 :: temp50b24 REAL*8 :: temp56 - REAL*8 :: temp57b45 - REAL*8 :: temp58b17 - REAL*8 :: temp109b1 - DOUBLE PRECISION :: temp115 - REAL*8 :: temp202b7 - REAL*8 :: temp280b1 + REAL*8 :: temp115 + REAL*8 :: temp124b28 + REAL*8 :: temp131b75 + REAL*8 :: temp180b + REAL*8 :: temp191b33 + REAL*8 :: temp197b4 + REAL*8 :: temp207b2 + REAL*8 :: temp224b3 + REAL*8 :: temp226b16 + REAL*8 :: temp261b + REAL*8 :: temp263b0 REAL*8 :: temp298b - REAL*8 :: temp322b4 + REAL*8 :: temp335b51 REAL*8 :: temp342b REAL*8 :: temp344b0 - REAL*8 :: temp361b1 - REAL*8 :: temp379b - REAL*8 :: temp386b55 - REAL*8 :: temp387b27 - REAL*8 :: temp425b0 - REAL*8 :: temp474b6 + REAL*8 :: temp420b5 REAL*8 :: temp479b1 REAL*8 :: temp485 - REAL*8 :: temp496b2 - REAL*8 :: temp504b + REAL*8 :: temp506b0 + REAL*8 :: temp523b1 REAL*8 :: temp24b - REAL*8 :: temp55 - REAL*8 :: temp57b44 - REAL*8 :: temp58b16 - REAL*8 :: temp109b0 - DOUBLE PRECISION :: temp114 - REAL*8 :: temp202b6 + REAL*8 :: temp49b25 + REAL*8 :: temp50b23 + DOUBLE PRECISION :: temp55 + REAL*8 :: temp114 + REAL*8 :: temp124b27 + REAL*8 :: temp131b74 + REAL*8 :: temp191b32 + REAL*8 :: temp197b3 + REAL*8 :: temp207b1 + REAL*8 :: temp224b2 + REAL*8 :: temp226b15 REAL*8 :: temp280b0 - REAL*8 :: temp321b19 - REAL*8 :: temp322b3 - REAL*8 :: temp350b - REAL*8 :: temp361b0 - REAL*8 :: temp386b54 + REAL*8 :: temp335b50 REAL*8 :: temp387b - REAL*8 :: temp387b26 - REAL*8 :: temp474b5 + REAL*8 :: temp420b4 + REAL*8 :: temp431b + DOUBLE PRECISION :: temp442b0 + REAL*8 :: temp468b REAL*8 :: temp479b0 REAL*8 :: temp484 - REAL*8 :: temp496b1 REAL*8 :: temp512b + REAL*8 :: temp523b0 + REAL*8 :: tempb9 + REAL*8 :: temp32b + REAL*8 :: temp49b24 + REAL*8 :: temp50b22 REAL*8 :: temp54 - REAL*8 :: temp57b43 - REAL*8 :: temp58b15 + REAL*8 :: temp50b59 REAL*8 :: temp69b + REAL*8 :: temp106b DOUBLE PRECISION :: temp113 - REAL*8 :: temp202b5 - REAL*8 :: temp321b18 - REAL*8 :: temp322b2 - REAL*8 :: temp386b53 - REAL*8 :: temp387b25 + REAL*8 :: temp124b26 + REAL*8 :: temp131b73 + REAL*8 :: temp143b1 + REAL*8 :: temp191b31 + REAL*8 :: temp197b2 + REAL*8 :: temp207b0 + REAL*8 :: temp224b1 + REAL*8 :: temp226b14 + REAL*8 :: temp340b62 REAL*8 :: temp395b - REAL*8 :: temp474b4 + REAL*8 :: temp420b3 REAL*8 :: temp476b REAL*8 :: temp483 - REAL*8 :: temp489b8 REAL*8 :: temp496b0 REAL*8 :: temp520b - REAL*8 :: temp4b0 - REAL*8 :: temp40b + REAL*8 :: tempb8 + REAL*8 :: temp49b23 + REAL*8 :: temp50b21 REAL*8 :: temp53 - REAL*8 :: temp57b42 - REAL*8 :: temp58b14 + REAL*8 :: temp50b58 REAL*8 :: temp77b DOUBLE PRECISION :: temp112 + REAL*8 :: temp114b + REAL*8 :: temp124b25 + REAL*8 :: temp131b72 + REAL*8 :: temp143b0 REAL*8 :: temp149 - REAL*8 :: temp202b4 - REAL*8 :: temp315b9 - REAL*8 :: temp321b17 - REAL*8 :: temp322b1 - REAL*8 :: temp386b52 - REAL*8 :: temp387b24 - REAL*8 :: temp474b3 + REAL*8 :: temp191b30 + REAL*8 :: temp197b1 + REAL*8 :: temp224b0 + REAL*8 :: temp226b13 + REAL*8 :: temp340b61 + REAL*8 :: temp420b2 + REAL*8 :: temp431b24 REAL*8 :: temp482 - REAL*8 :: temp489b7 - REAL*8 :: temp52 - REAL*8 :: temp57b41 - REAL*8 :: temp58b13 - REAL*8 :: temp85b - DOUBLE PRECISION :: temp89 - REAL*8 :: temp99b7 - REAL*8 :: temp111 + REAL*8 :: temp484b + REAL*8 :: tempb7 + REAL*8 :: temp49b22 + REAL*8 :: temp50b20 + DOUBLE PRECISION :: temp52 + REAL*8 :: temp50b57 + REAL*8 :: temp89 + DOUBLE PRECISION :: temp111 + REAL*8 :: temp124b24 + REAL*8 :: temp131b71 REAL*8 :: temp148 - REAL*8 :: temp202b3 + REAL*8 :: temp197b0 REAL*8 :: temp203b - DOUBLE PRECISION :: temp229 - REAL*8 :: temp241b0 - REAL*8 :: temp315b8 - REAL*8 :: temp321b16 + REAL*8 :: temp226b12 + REAL*8 :: temp229 REAL*8 :: temp322b0 - REAL*8 :: temp380b39 - REAL*8 :: temp386b51 - REAL*8 :: temp387b23 - REAL*8 :: temp474b2 + REAL*8 :: temp332b9 + REAL*8 :: temp340b60 + REAL*8 :: temp420b1 + REAL*8 :: temp431b23 REAL*8 :: temp481 - REAL*8 :: temp489b6 REAL*8 :: temp492b - REAL*8 :: temp501b1 - REAL*8 :: temp13b0 - REAL*8 :: temp51 - REAL*8 :: temp57b40 - REAL*8 :: temp58b12 - REAL*8 :: temp88 + REAL*8 :: tempb6 + REAL*8 :: temp49b21 + DOUBLE PRECISION :: temp51 + REAL*8 :: temp50b56 + DOUBLE PRECISION :: temp88 REAL*8 :: temp93b - REAL*8 :: temp99b6 - REAL*8 :: temp110 + DOUBLE PRECISION :: temp110 + REAL*8 :: temp124b23 REAL*8 :: temp130b + REAL*8 :: temp131b70 REAL*8 :: temp147 - REAL*8 :: temp202b2 + REAL*8 :: temp226b11 REAL*8 :: temp228 - REAL*8 :: temp300b3 - REAL*8 :: temp309 - REAL*8 :: temp315b7 - REAL*8 :: temp321b15 + REAL*8 :: temp248b + REAL*8 :: temp290b5 + DOUBLE PRECISION :: temp309 REAL*8 :: temp329b - REAL*8 :: temp380b38 - REAL*8 :: temp386b9 - REAL*8 :: temp386b50 - REAL*8 :: temp387b22 - REAL*8 :: temp387b59 + REAL*8 :: temp332b8 REAL*8 :: temp420b0 - REAL*8 :: temp474b1 + REAL*8 :: temp431b22 + REAL*8 :: temp457b0 REAL*8 :: temp480 - REAL*8 :: temp489b5 REAL*8 :: temp501b0 - REAL*8 :: temp50 - REAL*8 :: temp58b11 - REAL*8 :: temp87 - REAL*8 :: temp99b5 + REAL*8 :: tempb5 + REAL*8 :: temp49b20 + REAL*8 :: temp50b55 + DOUBLE PRECISION :: temp50 + DOUBLE PRECISION :: temp87 + REAL*8 :: temp124b22 REAL*8 :: temp146 - REAL*8 :: temp175b - REAL*8 :: temp202b1 + REAL*8 :: temp226b10 REAL*8 :: temp227 + REAL*8 :: temp256b + REAL*8 :: temp290b4 REAL*8 :: temp300b - REAL*8 :: temp300b2 REAL*8 :: temp308 - REAL*8 :: temp315b6 - REAL*8 :: temp321b14 + REAL*8 :: temp332b7 REAL*8 :: temp337b - REAL*8 :: temp379b39 - REAL*8 :: temp380b37 - REAL*8 :: temp386b8 - REAL*8 :: temp387b21 - REAL*8 :: temp387b58 - REAL*8 :: temp418b - REAL*8 :: temp474b0 - REAL*8 :: temp489b4 + REAL*8 :: temp431b21 + REAL*8 :: tempb4 REAL*8 :: temp19b - REAL*8 :: temp58b10 - REAL*8 :: temp86 - REAL*8 :: temp99b4 - DOUBLE PRECISION :: temp145 - REAL*8 :: temp202b0 + REAL*8 :: temp50b54 + DOUBLE PRECISION :: temp86 + REAL*8 :: temp124b21 + REAL*8 :: temp131b9 + REAL*8 :: temp145 + REAL*8 :: temp183b REAL*8 :: temp226 - DOUBLE PRECISION :: temp264b - DOUBLE PRECISION :: temp273b2 + REAL*8 :: temp253b19 + REAL*8 :: temp264b + REAL*8 :: temp277b13 + REAL*8 :: temp290b3 REAL*8 :: temp300b1 REAL*8 :: temp307 - REAL*8 :: temp315b5 - REAL*8 :: temp321b13 + REAL*8 :: temp332b6 REAL*8 :: temp345b - REAL*8 :: temp379b38 - REAL*8 :: temp380b36 - REAL*8 :: temp386b7 - REAL*8 :: temp387b20 - REAL*8 :: temp387b57 - REAL*8 :: temp388b29 - REAL*8 :: temp418b1 + REAL*8 :: temp371b3 REAL*8 :: temp426b - REAL*8 :: temp489b3 + REAL*8 :: temp431b20 REAL*8 :: temp507b - REAL*8 :: temp27b - REAL*8 :: temp85 - REAL*8 :: temp99b3 + REAL*8 :: tempb3 + REAL*8 :: temp50b53 + DOUBLE PRECISION :: temp85 + REAL*8 :: temp124b20 + REAL*8 :: temp131b8 REAL*8 :: temp144 + REAL*8 :: temp191b + REAL*8 :: temp206b29 REAL*8 :: temp225 - REAL*8 :: temp272b - DOUBLE PRECISION :: temp273b1 + REAL*8 :: temp253b18 + REAL*8 :: temp256b0 + REAL*8 :: temp277b12 + REAL*8 :: temp290b2 REAL*8 :: temp300b0 DOUBLE PRECISION :: temp306 - REAL*8 :: temp315b4 - REAL*8 :: temp321b12 - REAL*8 :: temp379b37 - REAL*8 :: temp380b35 - REAL*8 :: temp386b6 - REAL*8 :: temp387b56 - REAL*8 :: temp388b28 - REAL*8 :: temp418b0 - REAL*8 :: temp434b - REAL*8 :: temp489b2 - REAL*8 :: temp515b - REAL*8 :: temp28b0 - REAL*8 :: temp35b + REAL*8 :: temp332b5 + REAL*8 :: temp353b + REAL*8 :: temp371b2 + REAL*8 :: temp467b6 + REAL*8 :: tempb2 + REAL*8 :: temp45b1 + REAL*8 :: temp50b52 DOUBLE PRECISION :: temp84 - REAL*8 :: temp99b2 REAL*8 :: temp109b + REAL*8 :: temp131b7 REAL*8 :: temp143 - REAL*8 :: temp224 - DOUBLE PRECISION :: temp273b0 + REAL*8 :: temp206b28 + DOUBLE PRECISION :: temp224 + REAL*8 :: temp253b17 + REAL*8 :: temp277b11 REAL*8 :: temp280b + REAL*8 :: temp290b1 DOUBLE PRECISION :: temp305 - REAL*8 :: temp315b3 - REAL*8 :: temp321b11 - REAL*8 :: temp354b0 - REAL*8 :: temp361b - REAL*8 :: temp379b36 - REAL*8 :: temp380b34 - REAL*8 :: temp386b5 - REAL*8 :: temp387b55 - REAL*8 :: temp388b27 - REAL*8 :: temp398b + REAL*8 :: temp332b4 + REAL*8 :: temp371b1 + DOUBLE PRECISION :: temp398b + REAL*8 :: temp442b + REAL*8 :: temp448b39 + REAL*8 :: temp467b5 REAL*8 :: temp479b - REAL*8 :: temp489b1 - REAL*8 :: temp516b0 + REAL*8 :: temp523b + REAL*8 :: tempb1 REAL*8 :: temp43b - REAL*8 :: temp83 - REAL*8 :: temp99b1 - DOUBLE PRECISION :: temp142 - DOUBLE PRECISION :: temp179 + REAL*8 :: temp45b0 + REAL*8 :: temp50b51 + DOUBLE PRECISION :: temp83 + REAL*8 :: temp117b + REAL*8 :: temp131b6 + REAL*8 :: temp136b1 + REAL*8 :: temp142 + REAL*8 :: temp179 + REAL*8 :: temp197b19 + REAL*8 :: temp206b27 REAL*8 :: temp223 + REAL*8 :: temp253b16 + REAL*8 :: temp277b10 + REAL*8 :: temp290b0 DOUBLE PRECISION :: temp304 - REAL*8 :: temp315b2 - REAL*8 :: temp321b10 - REAL*8 :: temp322b19 - REAL*8 :: temp379b35 - REAL*8 :: temp380b33 - REAL*8 :: temp386b4 - REAL*8 :: temp387b54 - REAL*8 :: temp388b26 - REAL*8 :: temp450b - REAL*8 :: temp478b17 + REAL*8 :: temp332b3 + REAL*8 :: temp371b0 + REAL*8 :: temp448b38 + REAL*8 :: temp467b4 REAL*8 :: temp487b - REAL*8 :: temp489b0 + REAL*8 :: temp499b9 + REAL*8 :: tempb0 REAL*8 :: temp0b - REAL*8 :: temp51b - REAL*8 :: temp82 - REAL*8 :: temp88b + REAL*8 :: temp8b19 + REAL*8 :: temp50b50 + DOUBLE PRECISION :: temp82 REAL*8 :: temp99b0 + REAL*8 :: temp125b + REAL*8 :: temp131b5 + REAL*8 :: temp136b0 REAL*8 :: temp141 - DOUBLE PRECISION :: temp178 + REAL*8 :: temp178 + REAL*8 :: temp197b18 + REAL*8 :: temp206b + REAL*8 :: temp206b26 REAL*8 :: temp222 + REAL*8 :: temp253b15 REAL*8 :: temp259 DOUBLE PRECISION :: temp303 - REAL*8 :: temp315b1 - REAL*8 :: temp322b18 - REAL*8 :: temp379b34 - REAL*8 :: temp380b32 - REAL*8 :: temp380b69 - REAL*8 :: temp386b3 - REAL*8 :: temp387b53 - REAL*8 :: temp388b25 - REAL*8 :: temp478b16 + REAL*8 :: temp332b2 + REAL*8 :: temp448b37 + REAL*8 :: temp467b3 REAL*8 :: temp495b - REAL*8 :: temp77b3 - DOUBLE PRECISION :: temp81 + REAL*8 :: temp499b8 + REAL*8 :: temp8b18 + REAL*8 :: temp81 + REAL*8 :: temp96b + REAL*8 :: temp131b4 + REAL*8 :: temp133b REAL*8 :: temp140 REAL*8 :: temp153b0 REAL*8 :: temp177 + REAL*8 :: temp197b17 + REAL*8 :: temp206b25 REAL*8 :: temp221 - DOUBLE PRECISION :: temp258 + REAL*8 :: temp234b0 + REAL*8 :: temp253b14 + REAL*8 :: temp258 REAL*8 :: temp302 - REAL*8 :: temp315b0 - REAL*8 :: temp322b17 + REAL*8 :: temp332b1 REAL*8 :: temp339 - REAL*8 :: temp379b33 - REAL*8 :: temp380b31 - REAL*8 :: temp380b68 - REAL*8 :: temp386b2 - REAL*8 :: temp387b52 - REAL*8 :: temp388b24 - REAL*8 :: temp478b15 - REAL*8 :: temp23b1 - REAL*8 :: temp38b5 - REAL*8 :: temp77b2 + REAL*8 :: temp448b36 + REAL*8 :: temp467b2 + REAL*8 :: temp499b7 + REAL*8 :: temp8b17 DOUBLE PRECISION :: temp80 + REAL*8 :: temp131b3 + REAL*8 :: temp141b + REAL*8 :: temp170b0 REAL*8 :: temp176 REAL*8 :: temp178b + REAL*8 :: temp197b16 + REAL*8 :: temp206b24 REAL*8 :: temp220 REAL*8 :: temp222b - DOUBLE PRECISION :: temp257 + REAL*8 :: temp253b13 + REAL*8 :: temp257 REAL*8 :: temp259b - DOUBLE PRECISION :: temp301 - DOUBLE PRECISION :: temp303b - REAL*8 :: temp322b16 - DOUBLE PRECISION :: temp332b0 - DOUBLE PRECISION :: temp338 - REAL*8 :: temp369b0 - REAL*8 :: temp379b9 - REAL*8 :: temp379b32 - REAL*8 :: temp379b69 - REAL*8 :: temp380b30 - REAL*8 :: temp380b67 + REAL*8 :: temp301 + REAL*8 :: temp303b + REAL*8 :: temp332b0 + REAL*8 :: temp338 REAL*8 :: temp386b1 - REAL*8 :: temp387b51 - REAL*8 :: temp388b23 - REAL*8 :: temp413b0 REAL*8 :: temp419 - REAL*8 :: temp478b14 + REAL*8 :: temp448b35 + REAL*8 :: temp467b1 + REAL*8 :: temp499b6 + REAL*8 :: temp8b16 REAL*8 :: temp23b0 - REAL*8 :: temp38b4 - REAL*8 :: temp77b1 + REAL*8 :: temp131b2 + REAL*8 :: temp155b39 REAL*8 :: temp175 - REAL*8 :: temp186b + REAL*8 :: temp197b15 + REAL*8 :: temp206b23 REAL*8 :: temp230b + REAL*8 :: temp253b12 + REAL*8 :: temp253b49 REAL*8 :: temp256 REAL*8 :: temp300 REAL*8 :: temp311b - REAL*8 :: temp322b15 REAL*8 :: temp337 - REAL*8 :: temp348b - REAL*8 :: temp373b19 - REAL*8 :: temp379b8 - REAL*8 :: temp379b31 - REAL*8 :: temp379b68 - REAL*8 :: temp380b66 REAL*8 :: temp386b0 - REAL*8 :: temp387b50 - REAL*8 :: temp388b22 - REAL*8 :: temp388b59 REAL*8 :: temp418 REAL*8 :: temp429b - REAL*8 :: temp478b13 - REAL*8 :: temp509b3 - REAL*8 :: temp38b3 - REAL*8 :: temp40b0 - REAL*8 :: temp68b39 - REAL*8 :: temp77b0 + REAL*8 :: temp445b4 + REAL*8 :: temp448b34 + REAL*8 :: temp467b0 + REAL*8 :: tmpb + REAL*8 :: temp499b5 + REAL*8 :: tempb11 + REAL*8 :: temp8b15 + REAL*8 :: temp50b9 + REAL*8 :: temp114b0 + REAL*8 :: temp124b9 + REAL*8 :: temp131b1 + REAL*8 :: temp155b38 + REAL*8 :: temp168b1 REAL*8 :: temp174 + REAL*8 :: temp197b14 + REAL*8 :: temp206b22 + REAL*8 :: temp253b11 + REAL*8 :: temp253b48 REAL*8 :: temp255 - DOUBLE PRECISION :: temp283b3 - REAL*8 :: temp322b14 REAL*8 :: temp336 - REAL*8 :: temp356b - REAL*8 :: temp373b18 - REAL*8 :: temp379b7 - REAL*8 :: temp379b30 - REAL*8 :: temp379b67 - REAL*8 :: temp380b65 - REAL*8 :: temp388b21 - REAL*8 :: temp388b58 + DOUBLE PRECISION :: temp356b REAL*8 :: temp400b REAL*8 :: temp417 - REAL*8 :: temp437b - REAL*8 :: temp478b12 - REAL*8 :: temp494b9 - REAL*8 :: temp509b2 - REAL*8 :: temp38b - REAL*8 :: temp38b2 - REAL*8 :: temp68b38 - REAL*8 :: temp129b3 - DOUBLE PRECISION :: temp173 + REAL*8 :: temp440b8 + REAL*8 :: temp445b3 + REAL*8 :: temp448b33 + REAL*8 :: temp484b0 + REAL*8 :: temp499b4 + REAL*8 :: temp499b37 + REAL*8 :: temp518b + REAL*8 :: tempb10 + REAL*8 :: temp8b14 + REAL*8 :: temp50b8 + REAL*8 :: temp124b8 + REAL*8 :: temp131b0 + REAL*8 :: temp155b37 + REAL*8 :: temp168b0 + REAL*8 :: temp173 + REAL*8 :: temp197b13 + REAL*8 :: temp206b21 + REAL*8 :: temp253b10 + REAL*8 :: temp253b47 REAL*8 :: temp254 - DOUBLE PRECISION :: temp249b0 - DOUBLE PRECISION :: temp283b - DOUBLE PRECISION :: temp283b2 - REAL*8 :: temp322b13 - REAL*8 :: temp335 - REAL*8 :: temp364b - REAL*8 :: temp373b17 - REAL*8 :: temp379b6 - REAL*8 :: temp379b66 - REAL*8 :: temp380b64 - REAL*8 :: temp388b20 - REAL*8 :: temp388b57 + REAL*8 :: temp283b + REAL*8 :: temp335b19 + INTEGER :: temp335 REAL*8 :: temp416 + REAL*8 :: temp440b7 REAL*8 :: temp445b - REAL*8 :: temp478b11 - REAL*8 :: temp494b8 - REAL*8 :: temp509b1 - REAL*8 :: temp38b1 - REAL*8 :: temp46b - REAL*8 :: temp68b37 - REAL*8 :: temp129b2 - DOUBLE PRECISION :: temp172 - REAL*8 :: temp253 - DOUBLE PRECISION :: temp283b1 - REAL*8 :: temp322b12 - DOUBLE PRECISION :: temp334 - REAL*8 :: temp347b0 + REAL*8 :: temp445b2 + REAL*8 :: temp448b32 + REAL*8 :: temp448b69 + REAL*8 :: tmp0b + REAL*8 :: temp499b3 + REAL*8 :: temp499b36 + REAL*8 :: temp522b11 + REAL*8 :: temp526b + REAL*8 :: temp8b13 + REAL*8 :: temp50b7 + REAL*8 :: temp124b7 + REAL*8 :: temp155b36 + REAL*8 :: temp172 + REAL*8 :: temp185b0 + REAL*8 :: temp197b12 + REAL*8 :: temp197b49 + REAL*8 :: temp206b20 + REAL*8 :: temp253b46 + INTEGER :: temp253 + REAL*8 :: temp334 + REAL*8 :: temp335b18 REAL*8 :: temp372b - REAL*8 :: temp373b16 - REAL*8 :: temp379b5 - REAL*8 :: temp379b65 - REAL*8 :: temp380b63 - REAL*8 :: temp388b56 REAL*8 :: temp415 - REAL*8 :: temp428b0 + REAL*8 :: temp440b6 REAL*8 :: temp445b1 + REAL*8 :: temp448b31 + REAL*8 :: temp448b68 REAL*8 :: temp453b - REAL*8 :: temp478b10 - REAL*8 :: temp494b7 - REAL*8 :: temp496b29 + REAL*8 :: temp499b2 + REAL*8 :: temp499b35 REAL*8 :: temp509b0 - REAL*8 :: temp521b6 + REAL*8 :: temp522b10 REAL*8 :: temp3b - REAL*8 :: temp38b0 - REAL*8 :: temp54b - REAL*8 :: temp68b36 - REAL*8 :: temp128b - REAL*8 :: temp129b1 + REAL*8 :: temp8b12 + REAL*8 :: temp8b49 + REAL*8 :: temp50b6 + REAL*8 :: temp124b6 + REAL*8 :: temp135b19 + REAL*8 :: temp155b35 REAL*8 :: temp171 - DOUBLE PRECISION :: temp252 + REAL*8 :: temp197b11 + REAL*8 :: temp197b48 + REAL*8 :: temp252 + REAL*8 :: temp253b45 REAL*8 :: temp289 - DOUBLE PRECISION :: temp283b0 - REAL*8 :: temp322b11 + REAL*8 :: temp283b0 REAL*8 :: temp333 - REAL*8 :: temp373b15 - REAL*8 :: temp374b9 - REAL*8 :: temp379b4 - REAL*8 :: temp379b64 + REAL*8 :: temp335b17 REAL*8 :: temp380b - REAL*8 :: temp380b62 - REAL*8 :: temp388b55 - REAL*8 :: temp406b3 REAL*8 :: temp414 + REAL*8 :: temp440b5 REAL*8 :: temp445b0 + REAL*8 :: temp448b30 + REAL*8 :: temp448b67 REAL*8 :: temp461b - REAL*8 :: temp477b5 - REAL*8 :: temp494b6 - REAL*8 :: temp496b28 - REAL*8 :: temp521b5 - REAL*8 :: temp55b0 - REAL*8 :: temp68b35 + REAL*8 :: temp498b + REAL*8 :: temp499b1 + REAL*8 :: temp499b34 + REAL*8 :: temp526b0 + REAL*8 :: temp8b11 + REAL*8 :: temp8b48 + REAL*8 :: temp16b3 + REAL*8 :: temp50b5 REAL*8 :: temp99b + REAL*8 :: temp124b5 REAL*8 :: temp129b0 + REAL*8 :: temp135b18 + REAL*8 :: temp136b + REAL*8 :: temp155b34 REAL*8 :: temp170 - REAL*8 :: temp217b + REAL*8 :: temp180b3 + REAL*8 :: temp197b10 + REAL*8 :: temp197b47 REAL*8 :: temp251 + REAL*8 :: temp253b44 REAL*8 :: temp288 - REAL*8 :: temp298b3 - REAL*8 :: temp322b10 - DOUBLE PRECISION :: temp332 + REAL*8 :: temp332 + REAL*8 :: temp335b16 + REAL*8 :: temp340b29 REAL*8 :: temp369 - REAL*8 :: temp373b14 - REAL*8 :: temp374b8 - REAL*8 :: temp379b3 - REAL*8 :: temp379b63 - REAL*8 :: temp380b61 - REAL*8 :: temp388b54 - REAL*8 :: temp404b19 - REAL*8 :: temp406b2 REAL*8 :: temp413 - REAL*8 :: temp462b0 - REAL*8 :: temp477b4 - REAL*8 :: temp494b5 - REAL*8 :: temp496b27 - REAL*8 :: temp521b4 - REAL*8 :: temp68b34 + REAL*8 :: temp440b4 + REAL*8 :: temp448b66 + DOUBLE PRECISION :: temp462b0 + REAL*8 :: temp499b0 + REAL*8 :: temp499b33 + REAL*8 :: temp7b0 + REAL*8 :: temp8b10 + REAL*8 :: temp8b47 + REAL*8 :: temp16b2 + REAL*8 :: temp50b4 REAL*8 :: temp70b + REAL*8 :: temp124b4 + REAL*8 :: temp131b39 + REAL*8 :: temp135b17 REAL*8 :: temp144b - REAL*8 :: temp146b0 + REAL*8 :: temp155b33 + REAL*8 :: temp180b2 + REAL*8 :: temp197b46 REAL*8 :: temp225b REAL*8 :: temp227b0 - DOUBLE PRECISION :: temp250 - DOUBLE PRECISION :: temp287 - REAL*8 :: temp298b2 + REAL*8 :: temp250 + REAL*8 :: temp253b43 + REAL*8 :: temp287 REAL*8 :: temp331 - INTEGER :: temp368 - REAL*8 :: temp373b13 - REAL*8 :: temp374b7 - REAL*8 :: temp379b2 - REAL*8 :: temp379b62 - REAL*8 :: temp380b60 - REAL*8 :: temp386b19 - REAL*8 :: temp388b53 - REAL*8 :: temp404b18 - REAL*8 :: temp406b1 + REAL*8 :: temp335b15 + REAL*8 :: temp340b28 + DOUBLE PRECISION :: temp368 REAL*8 :: temp412 + REAL*8 :: temp440b3 + REAL*8 :: temp448b65 REAL*8 :: temp449 - REAL*8 :: temp477b3 - REAL*8 :: temp494b4 - REAL*8 :: temp496b26 - REAL*8 :: temp521b3 + REAL*8 :: temp499b32 + REAL*8 :: temp8b46 REAL*8 :: temp16b1 REAL*8 :: temp19 - REAL*8 :: temp68b33 + REAL*8 :: temp50b3 + REAL*8 :: temp124b3 + REAL*8 :: temp131b38 + REAL*8 :: temp135b16 + REAL*8 :: temp155b32 + REAL*8 :: temp180b1 REAL*8 :: temp189b - DOUBLE PRECISION :: temp286 - REAL*8 :: temp298b1 + REAL*8 :: temp197b45 + REAL*8 :: temp233b + REAL*8 :: temp244b0 + REAL*8 :: temp253b42 + REAL*8 :: temp286 REAL*8 :: temp314b + REAL*8 :: temp325b0 REAL*8 :: temp330 + REAL*8 :: temp335b9 + REAL*8 :: temp335b14 + REAL*8 :: temp340b27 DOUBLE PRECISION :: temp367 - REAL*8 :: temp373b12 - REAL*8 :: temp373b49 - REAL*8 :: temp374b6 - REAL*8 :: temp379b1 - REAL*8 :: temp379b61 - REAL*8 :: temp386b18 - REAL*8 :: temp388b52 - REAL*8 :: temp388b89 - REAL*8 :: temp404b17 - REAL*8 :: temp406b0 REAL*8 :: temp411 - DOUBLE PRECISION :: temp448 - REAL*8 :: temp477b2 - REAL*8 :: temp494b3 - REAL*8 :: temp496b25 - REAL*8 :: temp521b2 + REAL*8 :: temp440b2 + REAL*8 :: temp448b64 + REAL*8 :: temp448 + REAL*8 :: temp499b31 + REAL*8 :: temp8b45 REAL*8 :: temp16b0 REAL*8 :: temp18 - REAL*8 :: temp68b32 - REAL*8 :: temp139b6 - REAL*8 :: temp241b - DOUBLE PRECISION :: temp285 + REAL*8 :: temp50b2 + REAL*8 :: temp107b1 + REAL*8 :: temp124b2 + REAL*8 :: temp131b37 + REAL*8 :: temp135b15 + REAL*8 :: temp155b31 + REAL*8 :: temp180b0 + REAL*8 :: temp190b9 + REAL*8 :: temp197b + REAL*8 :: temp197b44 + REAL*8 :: temp253b41 + REAL*8 :: temp261b0 + REAL*8 :: temp278b + REAL*8 :: temp285 REAL*8 :: temp298b0 REAL*8 :: temp322b + REAL*8 :: temp335b8 + REAL*8 :: temp335b13 + REAL*8 :: temp340b26 REAL*8 :: temp342b0 REAL*8 :: temp366 - REAL*8 :: temp373b11 - REAL*8 :: temp373b48 - REAL*8 :: temp374b5 - REAL*8 :: temp379b0 - REAL*8 :: temp379b60 - REAL*8 :: temp386b17 - REAL*8 :: temp388b51 - REAL*8 :: temp388b88 - REAL*8 :: temp404b16 REAL*8 :: temp410 REAL*8 :: temp440b1 - DOUBLE PRECISION :: temp447 - REAL*8 :: temp477b1 - REAL*8 :: temp494b2 - REAL*8 :: temp496b24 - REAL*8 :: temp504b0 - REAL*8 :: temp521b1 + REAL*8 :: temp447 + REAL*8 :: temp448b63 + REAL*8 :: temp455b5 + REAL*8 :: temp499b30 + REAL*8 :: temp8b44 REAL*8 :: temp17 - REAL*8 :: temp68b31 - REAL*8 :: temp139b5 - REAL*8 :: temp178b2 + REAL*8 :: temp50b1 + REAL*8 :: temp107b0 + REAL*8 :: temp124b1 + REAL*8 :: temp131b36 + REAL*8 :: temp135b14 + REAL*8 :: temp155b30 + REAL*8 :: temp190b8 + REAL*8 :: temp197b43 + REAL*8 :: temp253b40 DOUBLE PRECISION :: temp284 + REAL*8 :: temp286b + REAL*8 :: temp303b2 REAL*8 :: temp330b - DOUBLE PRECISION :: temp365 - REAL*8 :: temp367b - REAL*8 :: temp373b10 - REAL*8 :: temp373b47 - REAL*8 :: temp374b4 - REAL*8 :: temp386b16 - REAL*8 :: temp388b50 - REAL*8 :: temp388b87 - DOUBLE PRECISION :: temp396b0 - REAL*8 :: temp404b15 + REAL*8 :: temp335b7 + REAL*8 :: temp335b12 + REAL*8 :: temp335b49 + REAL*8 :: temp340b25 + REAL*8 :: temp365 REAL*8 :: temp411b REAL*8 :: temp440b0 REAL*8 :: temp446 REAL*8 :: temp448b - REAL*8 :: temp477b0 - REAL*8 :: temp494b1 - REAL*8 :: temp496b23 + REAL*8 :: temp448b62 + REAL*8 :: temp455b4 + REAL*8 :: tmp3b REAL*8 :: temp521b0 - REAL*8 :: temp12b + REAL*8 :: temp8b43 REAL*8 :: temp16 - REAL*8 :: temp43b8 REAL*8 :: temp49b - REAL*8 :: temp68b30 - REAL*8 :: temp87b0 - REAL*8 :: temp139b4 - REAL*8 :: temp178b1 - REAL*8 :: temp216b13 + REAL*8 :: temp50b0 + REAL*8 :: temp124b0 + REAL*8 :: temp131b35 + REAL*8 :: temp135b13 + REAL*8 :: temp190b7 + REAL*8 :: temp197b42 + REAL*8 :: temp205b0 DOUBLE PRECISION :: temp283 - DOUBLE PRECISION :: temp303b1 - REAL*8 :: temp364 - REAL*8 :: temp373b46 - REAL*8 :: temp374b3 - REAL*8 :: temp386b15 - REAL*8 :: temp388b86 - REAL*8 :: temp404b14 + REAL*8 :: temp294b + REAL*8 :: temp303b1 + REAL*8 :: temp335b6 + REAL*8 :: temp335b11 + REAL*8 :: temp335b48 + REAL*8 :: temp340b24 + DOUBLE PRECISION :: temp364 REAL*8 :: temp445 + REAL*8 :: temp448b61 + REAL*8 :: temp455b3 REAL*8 :: temp456b - REAL*8 :: temp494b0 - REAL*8 :: temp496b22 REAL*8 :: temp500b + REAL*8 :: temp526 + REAL*8 :: temp2b0 + REAL*8 :: temp8b42 REAL*8 :: temp15 REAL*8 :: temp20b - REAL*8 :: temp43b7 REAL*8 :: temp57b - REAL*8 :: temp139b3 - REAL*8 :: temp178b0 - REAL*8 :: temp216b12 + REAL*8 :: temp131b34 + REAL*8 :: temp135b12 + REAL*8 :: temp141b0 + REAL*8 :: temp190b6 + REAL*8 :: temp191b29 + REAL*8 :: temp197b41 REAL*8 :: temp222b0 - REAL*8 :: temp282 - DOUBLE PRECISION :: temp303b0 + DOUBLE PRECISION :: temp282 + REAL*8 :: temp303b0 + REAL*8 :: temp313b9 + REAL*8 :: temp335b5 + REAL*8 :: temp335b10 + REAL*8 :: temp335b47 + REAL*8 :: temp340b23 DOUBLE PRECISION :: temp363 - REAL*8 :: temp373b45 - REAL*8 :: temp374b2 - REAL*8 :: temp374b17 - REAL*8 :: temp386b14 - REAL*8 :: temp388b85 - REAL*8 :: temp404b13 - REAL*8 :: temp444 - REAL*8 :: temp496b21 - REAL*8 :: temp14 - REAL*8 :: temp43b6 - REAL*8 :: temp65b + REAL*8 :: temp383b + DOUBLE PRECISION :: temp444 + REAL*8 :: temp448b60 + REAL*8 :: temp455b2 + REAL*8 :: temp464b + REAL*8 :: temp525 + REAL*8 :: temp8b41 + DOUBLE PRECISION :: temp14 + REAL*8 :: temp50b19 + REAL*8 :: temp102b + REAL*8 :: temp131b33 + REAL*8 :: temp135b11 REAL*8 :: temp139b - REAL*8 :: temp139b2 - REAL*8 :: temp216b11 - REAL*8 :: temp281 - REAL*8 :: temp320b0 + REAL*8 :: temp190b5 + REAL*8 :: temp191b28 + REAL*8 :: temp197b40 + DOUBLE PRECISION :: temp281 + REAL*8 :: temp313b8 REAL*8 :: temp335b4 + REAL*8 :: temp335b46 + REAL*8 :: temp340b22 + REAL*8 :: temp340b59 REAL*8 :: temp362 - REAL*8 :: temp373b44 - REAL*8 :: temp374b1 - REAL*8 :: temp374b16 - REAL*8 :: temp386b13 - REAL*8 :: temp388b84 - REAL*8 :: temp391b REAL*8 :: temp399 - REAL*8 :: temp404b12 - REAL*8 :: temp438b0 + REAL*8 :: temp391b REAL*8 :: temp443 - REAL*8 :: temp472b - REAL*8 :: temp496b20 + REAL*8 :: temp448b9 + REAL*8 :: temp455b1 + REAL*8 :: temp524 + REAL*8 :: temp8b40 REAL*8 :: temp13 - REAL*8 :: temp43b5 - REAL*8 :: temp53b24 - REAL*8 :: temp57b39 - REAL*8 :: temp58b9 + REAL*8 :: temp48b0 + REAL*8 :: temp50b18 + REAL*8 :: temp73b REAL*8 :: temp109 REAL*8 :: temp110b - REAL*8 :: temp139b1 - REAL*8 :: temp147b - REAL*8 :: temp156b2 - REAL*8 :: temp216b10 + REAL*8 :: temp117b5 + REAL*8 :: temp131b32 + REAL*8 :: temp131b69 + REAL*8 :: temp135b10 + REAL*8 :: temp190b4 + REAL*8 :: temp191b27 REAL*8 :: temp228b REAL*8 :: temp280 - REAL*8 :: temp309b REAL*8 :: temp313b7 - REAL*8 :: temp315b29 + REAL*8 :: temp318b2 REAL*8 :: temp335b3 + REAL*8 :: temp335b45 + REAL*8 :: temp340b21 + REAL*8 :: temp340b58 REAL*8 :: temp361 - REAL*8 :: temp373b43 - REAL*8 :: temp374b0 - REAL*8 :: temp374b15 - REAL*8 :: temp386b12 - REAL*8 :: temp386b49 - REAL*8 :: temp388b83 - REAL*8 :: temp398 - REAL*8 :: temp404b11 - REAL*8 :: temp442 + DOUBLE PRECISION :: temp398 + DOUBLE PRECISION :: temp442 + REAL*8 :: temp448b8 REAL*8 :: temp455b0 REAL*8 :: temp479 REAL*8 :: temp480b + REAL*8 :: temp523 REAL*8 :: temp12 - REAL*8 :: temp43b4 + REAL*8 :: temp49b19 REAL*8 :: temp49 - REAL*8 :: temp53b23 - REAL*8 :: temp57b38 - REAL*8 :: temp58b8 - REAL*8 :: temp108 + REAL*8 :: temp50b17 + REAL*8 :: temp82b1 + REAL*8 :: temp81b + DOUBLE PRECISION :: temp108 + REAL*8 :: temp117b4 + REAL*8 :: temp131b31 + REAL*8 :: temp131b68 REAL*8 :: temp139b0 REAL*8 :: temp155b - REAL*8 :: temp156b1 - REAL*8 :: temp237b1 + DOUBLE PRECISION :: temp156b1 + REAL*8 :: temp190b3 + REAL*8 :: temp191b26 REAL*8 :: temp313b6 - REAL*8 :: temp315b28 + REAL*8 :: temp317b + REAL*8 :: temp318b1 REAL*8 :: temp335b2 - REAL*8 :: temp360 - REAL*8 :: temp373b42 - REAL*8 :: temp374b14 - REAL*8 :: temp386b11 - REAL*8 :: temp386b48 - REAL*8 :: temp388b82 - DOUBLE PRECISION :: temp391b0 - REAL*8 :: temp397 - REAL*8 :: temp404b10 + REAL*8 :: temp335b44 + REAL*8 :: temp340b20 + REAL*8 :: temp340b57 + DOUBLE PRECISION :: temp360 + DOUBLE PRECISION :: temp397 REAL*8 :: temp441 - REAL*8 :: temp472b0 + REAL*8 :: temp448b7 REAL*8 :: temp478 - REAL*8 :: temp11 - REAL*8 :: temp43b3 + REAL*8 :: temp522 + DOUBLE PRECISION :: temp11 REAL*8 :: temp48 - REAL*8 :: temp53b22 - REAL*8 :: temp57b37 - REAL*8 :: temp58b7 + REAL*8 :: temp49b18 + REAL*8 :: temp50b16 + REAL*8 :: temp82b0 REAL*8 :: temp107 - REAL*8 :: temp156b0 - REAL*8 :: temp237b0 + REAL*8 :: temp117b3 + REAL*8 :: temp131b30 + REAL*8 :: temp131b67 + DOUBLE PRECISION :: temp156b0 + REAL*8 :: temp163b + REAL*8 :: temp190b2 + REAL*8 :: temp191b25 + REAL*8 :: temp244b + REAL*8 :: temp243b18 REAL*8 :: temp313b5 - REAL*8 :: temp315b27 + REAL*8 :: temp318b0 + REAL*8 :: temp325b REAL*8 :: temp328b9 REAL*8 :: temp335b1 - REAL*8 :: temp373b41 - REAL*8 :: temp374b13 - REAL*8 :: temp386b10 - REAL*8 :: temp386b47 - REAL*8 :: temp387b19 - REAL*8 :: temp388b81 - DOUBLE PRECISION :: temp396 - REAL*8 :: temp406b + REAL*8 :: temp335b43 + REAL*8 :: temp340b56 + REAL*8 :: temp396 + REAL*8 :: temp431b19 REAL*8 :: temp440 + REAL*8 :: temp448b6 + REAL*8 :: temp448b93 REAL*8 :: temp477 REAL*8 :: temp487b3 - REAL*8 :: temp10 - REAL*8 :: temp43b2 - DOUBLE PRECISION :: temp47 - REAL*8 :: temp53b21 - REAL*8 :: temp57b36 - REAL*8 :: temp58b6 - REAL*8 :: temp106 - REAL*8 :: temp252b + REAL*8 :: temp521 + DOUBLE PRECISION :: temp10 + REAL*8 :: temp47 + REAL*8 :: temp49b17 + REAL*8 :: temp50b15 + DOUBLE PRECISION :: temp106 + REAL*8 :: temp117b2 + REAL*8 :: temp124b19 + REAL*8 :: temp131b66 + REAL*8 :: temp134b3 + REAL*8 :: temp171b + REAL*8 :: temp190b1 + REAL*8 :: temp191b24 + REAL*8 :: temp243b17 REAL*8 :: temp313b4 - REAL*8 :: temp315b26 REAL*8 :: temp328b8 REAL*8 :: temp333b REAL*8 :: temp335b0 - REAL*8 :: temp373b40 - REAL*8 :: temp374b12 - REAL*8 :: temp386b46 - REAL*8 :: temp387b18 - REAL*8 :: temp388b80 + REAL*8 :: temp335b42 + REAL*8 :: temp340b55 REAL*8 :: temp395 + REAL*8 :: temp416b0 REAL*8 :: temp414b + REAL*8 :: temp431b18 + REAL*8 :: temp448b5 + REAL*8 :: temp448b92 REAL*8 :: temp476 REAL*8 :: temp487b2 + REAL*8 :: tmp6b REAL*8 :: temp520 - REAL*8 :: temp43b1 - DOUBLE PRECISION :: temp46 - REAL*8 :: temp53b20 - REAL*8 :: temp57b35 - REAL*8 :: temp58b5 + REAL*8 :: temp15b + REAL*8 :: temp46 + REAL*8 :: temp49b16 + REAL*8 :: temp50b14 DOUBLE PRECISION :: temp105 - REAL*8 :: temp186b10 + REAL*8 :: temp117b1 + REAL*8 :: temp124b18 + REAL*8 :: temp131b65 + REAL*8 :: temp134b2 + REAL*8 :: temp190b0 + REAL*8 :: temp191b23 + REAL*8 :: temp243b16 REAL*8 :: temp260b - REAL*8 :: temp271b0 REAL*8 :: temp297b REAL*8 :: temp313b3 - REAL*8 :: temp315b25 REAL*8 :: temp328b7 + REAL*8 :: temp335b41 + REAL*8 :: temp340b54 REAL*8 :: temp341b - REAL*8 :: temp374b11 - REAL*8 :: temp378b - REAL*8 :: temp386b45 - REAL*8 :: temp387b17 - REAL*8 :: temp389b0 REAL*8 :: temp394 + DOUBLE PRECISION :: temp389b0 REAL*8 :: temp422b + REAL*8 :: temp431b17 + REAL*8 :: temp448b4 + REAL*8 :: temp448b91 REAL*8 :: temp459b REAL*8 :: temp475 REAL*8 :: temp487b1 - REAL*8 :: temp497b24 REAL*8 :: temp503b - REAL*8 :: temp9b REAL*8 :: temp23b REAL*8 :: temp43b0 - DOUBLE PRECISION :: temp45 - REAL*8 :: temp53b9 - REAL*8 :: temp57b34 - REAL*8 :: temp58b4 - DOUBLE PRECISION :: temp104 + INTEGER :: temp45 + REAL*8 :: temp49b15 + REAL*8 :: temp50b13 + REAL*8 :: temp104 + REAL*8 :: temp117b0 + REAL*8 :: temp124b17 + REAL*8 :: temp131b64 + REAL*8 :: temp134b1 + REAL*8 :: temp151b2 + REAL*8 :: temp191b22 + REAL*8 :: temp243b15 REAL*8 :: temp313b2 - REAL*8 :: temp315b24 REAL*8 :: temp328b6 - REAL*8 :: temp373b75 - REAL*8 :: temp374b10 + REAL*8 :: temp330b3 + REAL*8 :: temp335b40 + REAL*8 :: temp340b53 + REAL*8 :: temp345b7 + REAL*8 :: temp384b4 REAL*8 :: temp386b - REAL*8 :: temp386b44 - REAL*8 :: temp387b16 REAL*8 :: temp393 - REAL*8 :: temp404b43 - REAL*8 :: temp430b - REAL*8 :: temp450b0 + REAL*8 :: temp431b16 + REAL*8 :: temp448b3 + REAL*8 :: temp448b90 REAL*8 :: temp467b REAL*8 :: temp474 REAL*8 :: temp487b0 - REAL*8 :: temp497b9 - REAL*8 :: temp497b23 - REAL*8 :: temp511b REAL*8 :: temp31b - DOUBLE PRECISION :: temp44 - REAL*8 :: temp53b8 - REAL*8 :: temp57b33 - REAL*8 :: temp58b3 + REAL*8 :: temp44 + REAL*8 :: temp49b14 + REAL*8 :: temp50b12 + REAL*8 :: temp50b49 REAL*8 :: temp68b - DOUBLE PRECISION :: temp103 - REAL*8 :: temp188b1 + REAL*8 :: temp92b5 + REAL*8 :: temp103 + REAL*8 :: temp124b16 + REAL*8 :: temp131b63 + REAL*8 :: temp134b0 + REAL*8 :: temp151b1 + REAL*8 :: temp191b21 + REAL*8 :: temp225b9 + REAL*8 :: temp243b14 REAL*8 :: temp313b1 - REAL*8 :: temp315b23 REAL*8 :: temp328b5 REAL*8 :: temp330b2 - REAL*8 :: temp373b74 - REAL*8 :: temp386b43 - REAL*8 :: temp387b15 - REAL*8 :: temp392 - REAL*8 :: temp394b - REAL*8 :: temp404b42 + REAL*8 :: temp340b52 + REAL*8 :: temp345b6 + REAL*8 :: temp384b3 + DOUBLE PRECISION :: temp392 + REAL*8 :: temp431b15 REAL*8 :: temp448b2 REAL*8 :: temp473 REAL*8 :: temp475b - REAL*8 :: temp497b8 - REAL*8 :: temp497b22 REAL*8 :: temp43 - REAL*8 :: temp53b7 - REAL*8 :: temp57b32 - REAL*8 :: temp58b2 - DOUBLE PRECISION :: temp102 + REAL*8 :: temp49b13 + REAL*8 :: temp50b11 + REAL*8 :: temp50b48 + REAL*8 :: temp76b + REAL*8 :: temp92b4 + REAL*8 :: temp102 + REAL*8 :: temp124b15 + REAL*8 :: temp131b62 REAL*8 :: temp139 + REAL*8 :: temp151b0 REAL*8 :: temp188b0 + REAL*8 :: temp191b20 + REAL*8 :: temp225b8 + REAL*8 :: temp243b13 REAL*8 :: temp313b0 - REAL*8 :: temp315b22 REAL*8 :: temp328b4 REAL*8 :: temp330b1 - REAL*8 :: temp367b1 - REAL*8 :: temp373b73 - REAL*8 :: temp386b42 - REAL*8 :: temp387b14 - DOUBLE PRECISION :: temp391 - REAL*8 :: temp404b9 - REAL*8 :: temp404b41 + REAL*8 :: temp340b51 + REAL*8 :: temp345b5 + REAL*8 :: temp384b2 + REAL*8 :: temp391 + REAL*8 :: temp411b1 + REAL*8 :: temp431b14 REAL*8 :: temp448b1 - REAL*8 :: temp472 + DOUBLE PRECISION :: temp472 REAL*8 :: temp483b - REAL*8 :: temp497b7 - REAL*8 :: temp497b21 - REAL*8 :: temp42 - REAL*8 :: temp53b6 - REAL*8 :: temp57b31 + DOUBLE PRECISION :: temp42 + REAL*8 :: temp49b12 + REAL*8 :: temp50b10 + REAL*8 :: temp50b47 REAL*8 :: temp58b1 - DOUBLE PRECISION :: temp79 + REAL*8 :: temp79 REAL*8 :: temp92b3 DOUBLE PRECISION :: temp101 + REAL*8 :: temp124b14 + REAL*8 :: temp131b61 REAL*8 :: temp138 - REAL*8 :: temp202b REAL*8 :: temp219 + REAL*8 :: temp225b7 REAL*8 :: temp239b - REAL*8 :: temp315b21 + REAL*8 :: temp243b12 REAL*8 :: temp328b3 REAL*8 :: temp330b0 - REAL*8 :: temp367b0 - REAL*8 :: temp373b72 - REAL*8 :: temp380b29 - REAL*8 :: temp386b41 - REAL*8 :: temp387b13 - REAL*8 :: temp390 - REAL*8 :: temp404b8 - REAL*8 :: temp404b40 + REAL*8 :: temp340b9 + REAL*8 :: temp340b50 + REAL*8 :: temp345b4 + REAL*8 :: temp384b1 + DOUBLE PRECISION :: temp390 + REAL*8 :: temp411b0 + REAL*8 :: temp431b13 REAL*8 :: temp448b0 - REAL*8 :: temp465b1 - REAL*8 :: temp471 - REAL*8 :: temp491b + DOUBLE PRECISION :: temp471 REAL*8 :: temp497b6 - REAL*8 :: temp497b20 REAL*8 :: temp41 - REAL*8 :: temp53b5 - REAL*8 :: temp57b30 + REAL*8 :: temp49b11 + REAL*8 :: temp50b46 REAL*8 :: temp58b0 - REAL*8 :: temp68b9 - REAL*8 :: temp78 + REAL*8 :: temp75b1 + DOUBLE PRECISION :: temp78 REAL*8 :: temp92b REAL*8 :: temp92b2 - DOUBLE PRECISION :: temp100 - DOUBLE PRECISION :: temp112b1 + REAL*8 :: temp100 + REAL*8 :: temp124b13 + REAL*8 :: temp131b60 DOUBLE PRECISION :: temp137 - REAL*8 :: temp149b1 REAL*8 :: temp166b - REAL*8 :: temp166b2 - REAL*8 :: temp218 - REAL*8 :: temp247b - REAL*8 :: temp315b20 + REAL*8 :: temp183b3 + DOUBLE PRECISION :: temp218 + REAL*8 :: temp225b6 + REAL*8 :: temp243b11 + REAL*8 :: temp264b3 REAL*8 :: temp328b REAL*8 :: temp328b2 + REAL*8 :: temp340b8 REAL*8 :: temp345b3 - REAL*8 :: temp373b71 - REAL*8 :: temp380b28 - REAL*8 :: temp386b40 - REAL*8 :: temp387b12 - REAL*8 :: temp387b49 - REAL*8 :: temp404b7 + REAL*8 :: temp384b0 REAL*8 :: temp409b - REAL*8 :: temp465b0 - REAL*8 :: temp470 + REAL*8 :: temp421b8 + REAL*8 :: temp431b12 + DOUBLE PRECISION :: temp470 REAL*8 :: temp497b5 REAL*8 :: temp40 - REAL*8 :: temp53b4 - REAL*8 :: temp68b8 + REAL*8 :: temp49b10 + REAL*8 :: temp50b45 + REAL*8 :: temp75b0 REAL*8 :: temp77 REAL*8 :: temp92b1 - DOUBLE PRECISION :: temp112b0 - DOUBLE PRECISION :: temp136 + REAL*8 :: temp124b12 + REAL*8 :: temp136 REAL*8 :: temp149b0 - REAL*8 :: temp166b1 REAL*8 :: temp174b - REAL*8 :: temp217 + REAL*8 :: temp183b2 + DOUBLE PRECISION :: temp217 + REAL*8 :: temp225b5 + REAL*8 :: temp243b10 REAL*8 :: temp255b - REAL*8 :: temp281b3 + REAL*8 :: temp264b2 REAL*8 :: temp328b1 - REAL*8 :: temp328b25 - REAL*8 :: temp336b + REAL*8 :: temp340b7 REAL*8 :: temp345b2 - REAL*8 :: temp373b70 - REAL*8 :: temp379b29 - REAL*8 :: temp380b27 - REAL*8 :: temp387b11 - REAL*8 :: temp387b48 - REAL*8 :: temp404b6 REAL*8 :: temp417b + REAL*8 :: temp421b7 + REAL*8 :: temp431b11 REAL*8 :: temp497b4 - REAL*8 :: temp18b - REAL*8 :: temp53b3 - REAL*8 :: temp68b7 - DOUBLE PRECISION :: temp76 + REAL*8 :: temp31b7 + REAL*8 :: temp50b44 + REAL*8 :: temp76 REAL*8 :: temp92b0 - REAL*8 :: temp135 - REAL*8 :: temp166b0 + REAL*8 :: temp124b11 + DOUBLE PRECISION :: temp135 + REAL*8 :: temp182b + REAL*8 :: temp183b1 REAL*8 :: temp216 - REAL*8 :: temp247b0 + REAL*8 :: temp225b4 + REAL*8 :: temp242b5 + REAL*8 :: temp263b REAL*8 :: temp264b1 - REAL*8 :: temp281b2 REAL*8 :: temp328b0 - REAL*8 :: temp328b24 + REAL*8 :: temp340b6 REAL*8 :: temp344b REAL*8 :: temp345b1 - REAL*8 :: temp379b28 - REAL*8 :: temp380b26 - REAL*8 :: temp387b10 - REAL*8 :: temp387b47 - REAL*8 :: temp388b19 - REAL*8 :: temp404b5 - REAL*8 :: temp409b0 - REAL*8 :: temp425b + REAL*8 :: temp421b6 + REAL*8 :: temp431b10 REAL*8 :: temp497b3 - REAL*8 :: temp42b24 - REAL*8 :: temp53b2 - REAL*8 :: temp68b6 + REAL*8 :: temp506b + REAL*8 :: temp19b0 + REAL*8 :: temp31b6 + REAL*8 :: temp50b43 REAL*8 :: temp75 + REAL*8 :: temp124b10 REAL*8 :: temp134 + REAL*8 :: temp183b0 + REAL*8 :: temp190b + REAL*8 :: temp206b19 REAL*8 :: temp215 + REAL*8 :: temp225b3 + REAL*8 :: temp242b4 REAL*8 :: temp264b0 - REAL*8 :: temp271b - REAL*8 :: temp281b1 - REAL*8 :: temp328b23 + REAL*8 :: temp340b5 REAL*8 :: temp345b0 - REAL*8 :: temp379b27 - REAL*8 :: temp380b25 - REAL*8 :: temp387b46 - REAL*8 :: temp388b18 REAL*8 :: temp389b - REAL*8 :: temp404b4 + REAL*8 :: temp421b5 + REAL*8 :: temp443b1 REAL*8 :: temp497b2 + REAL*8 :: temp507b0 + REAL*8 :: temp31b5 REAL*8 :: temp34b - REAL*8 :: temp42b23 - REAL*8 :: temp53b1 - REAL*8 :: temp68b5 + REAL*8 :: temp50b42 REAL*8 :: temp74 - DOUBLE PRECISION :: temp133 + REAL*8 :: temp133 + REAL*8 :: temp206b18 DOUBLE PRECISION :: temp214 + REAL*8 :: temp220b7 + REAL*8 :: temp225b2 + REAL*8 :: temp242b3 REAL*8 :: temp281b0 - REAL*8 :: temp328b22 - REAL*8 :: temp360b - REAL*8 :: temp379b26 - REAL*8 :: temp380b24 - REAL*8 :: temp387b45 - REAL*8 :: temp388b17 - REAL*8 :: temp397b - REAL*8 :: temp404b3 + REAL*8 :: temp340b4 + DOUBLE PRECISION :: temp397b + REAL*8 :: temp421b4 REAL*8 :: temp441b + REAL*8 :: temp443b0 + REAL*8 :: temp448b29 + REAL*8 :: temp460b1 + REAL*8 :: temp475b5 REAL*8 :: temp478b REAL*8 :: temp497b1 + REAL*8 :: temp522b + REAL*8 :: temp31b4 REAL*8 :: temp42b - REAL*8 :: temp42b22 - REAL*8 :: temp53b0 - REAL*8 :: temp68b4 - DOUBLE PRECISION :: temp73 + REAL*8 :: temp50b41 + REAL*8 :: temp73 REAL*8 :: temp79b - DOUBLE PRECISION :: temp132 - DOUBLE PRECISION :: temp169 + REAL*8 :: temp116b + REAL*8 :: temp132 + REAL*8 :: temp169 + REAL*8 :: temp191b50 + REAL*8 :: temp206b17 DOUBLE PRECISION :: temp213 - REAL*8 :: temp328b21 - REAL*8 :: temp379b25 - REAL*8 :: temp380b23 - REAL*8 :: temp387b44 - REAL*8 :: temp388b16 - REAL*8 :: temp404b2 + REAL*8 :: temp220b6 + REAL*8 :: temp225b1 + REAL*8 :: temp242b2 + REAL*8 :: temp323b2 + REAL*8 :: temp340b3 + REAL*8 :: temp421b3 + REAL*8 :: temp432b16 + REAL*8 :: temp448b28 + REAL*8 :: temp460b0 REAL*8 :: temp475b4 REAL*8 :: temp486b REAL*8 :: temp497b0 - REAL*8 :: temp517b7 - REAL*8 :: temp5b0 - REAL*8 :: temp42b21 + REAL*8 :: temp31b3 REAL*8 :: temp50b - REAL*8 :: temp68b3 - DOUBLE PRECISION :: temp72 - REAL*8 :: temp87b - DOUBLE PRECISION :: temp131 - DOUBLE PRECISION :: temp168 + REAL*8 :: temp50b40 + REAL*8 :: temp70b0 + REAL*8 :: temp72 + REAL*8 :: temp124b + REAL*8 :: temp131 + REAL*8 :: temp168 + REAL*8 :: temp205b + REAL*8 :: temp206b16 REAL*8 :: temp212 - DOUBLE PRECISION :: temp249 - REAL*8 :: temp328b20 - REAL*8 :: temp379b24 - REAL*8 :: temp380b22 - REAL*8 :: temp380b59 - REAL*8 :: temp387b43 - REAL*8 :: temp388b15 - REAL*8 :: temp394b3 + REAL*8 :: temp220b5 + REAL*8 :: temp225b0 + REAL*8 :: temp242b1 + REAL*8 :: temp249 + REAL*8 :: temp323b1 + REAL*8 :: temp340b2 REAL*8 :: temp404b1 + REAL*8 :: temp421b2 + REAL*8 :: temp432b15 + REAL*8 :: temp448b27 REAL*8 :: temp475b3 - REAL*8 :: temp494b - REAL*8 :: temp517b6 REAL*8 :: tempb - REAL*8 :: temp42b20 - REAL*8 :: temp68b2 - DOUBLE PRECISION :: temp71 - DOUBLE PRECISION :: temp130 - DOUBLE PRECISION :: temp167 - REAL*8 :: temp176b4 + REAL*8 :: temp31b2 + REAL*8 :: temp71 + REAL*8 :: temp95b + REAL*8 :: temp130 + REAL*8 :: temp132b + REAL*8 :: temp167 + REAL*8 :: temp169b + REAL*8 :: temp198b0 + REAL*8 :: temp206b15 REAL*8 :: temp211 - REAL*8 :: temp203b3 + REAL*8 :: temp220b4 REAL*8 :: temp242b0 - DOUBLE PRECISION :: temp248 + REAL*8 :: temp248 + REAL*8 :: temp279b0 + REAL*8 :: temp323b0 REAL*8 :: temp329 - REAL*8 :: temp379b23 - REAL*8 :: temp380b21 - REAL*8 :: temp380b58 - REAL*8 :: temp387b42 - REAL*8 :: temp388b14 - REAL*8 :: temp394b2 + REAL*8 :: temp340b1 REAL*8 :: temp404b0 + REAL*8 :: temp421b1 + REAL*8 :: temp432b14 + REAL*8 :: temp448b26 REAL*8 :: temp475b2 - REAL*8 :: temp492b3 - REAL*8 :: temp517b5 - REAL*8 :: temp14b0 - REAL*8 :: temp68b1 + REAL*8 :: temp31b1 REAL*8 :: temp70 + REAL*8 :: temp137b6 REAL*8 :: temp140b - DOUBLE PRECISION :: temp166 - REAL*8 :: temp176b3 + REAL*8 :: temp166 REAL*8 :: temp177b + REAL*8 :: temp206b14 DOUBLE PRECISION :: temp210 - REAL*8 :: temp203b2 + REAL*8 :: temp220b3 REAL*8 :: temp221b - REAL*8 :: temp247 - DOUBLE PRECISION :: temp258b + DOUBLE PRECISION :: temp247 + REAL*8 :: temp257b3 REAL*8 :: temp302b - REAL*8 :: temp316b7 - DOUBLE PRECISION :: temp328 - REAL*8 :: temp338b3 + REAL*8 :: temp328 + REAL*8 :: temp339b REAL*8 :: temp340b0 - REAL*8 :: temp379b22 - REAL*8 :: temp379b59 - REAL*8 :: temp380b20 - REAL*8 :: temp380b57 - REAL*8 :: temp387b9 - REAL*8 :: temp387b41 - REAL*8 :: temp388b13 - REAL*8 :: temp394b1 REAL*8 :: temp409 REAL*8 :: temp421b0 + REAL*8 :: temp431b9 + REAL*8 :: temp432b13 + REAL*8 :: temp448b25 REAL*8 :: temp475b1 - REAL*8 :: temp492b2 - REAL*8 :: temp517b4 + REAL*8 :: temp499b29 REAL*8 :: temp31b0 REAL*8 :: temp68b0 + REAL*8 :: temp137b5 + REAL*8 :: temp155b29 REAL*8 :: temp165 - REAL*8 :: temp176b2 - REAL*8 :: temp203b1 - REAL*8 :: temp246 - REAL*8 :: temp310b - REAL*8 :: temp316b6 - REAL*8 :: temp321b33 - DOUBLE PRECISION :: temp327 - REAL*8 :: temp338b2 - REAL*8 :: temp347b - REAL*8 :: temp379b21 - REAL*8 :: temp379b58 - REAL*8 :: temp380b56 - REAL*8 :: temp387b8 - REAL*8 :: temp387b40 - REAL*8 :: temp388b12 - REAL*8 :: temp388b49 - REAL*8 :: temp394b0 - REAL*8 :: temp408 + REAL*8 :: temp185b + REAL*8 :: temp206b13 + REAL*8 :: temp220b2 + DOUBLE PRECISION :: temp246 + REAL*8 :: temp253b39 + REAL*8 :: temp257b2 + REAL*8 :: temp301b2 + REAL*8 :: temp327 + REAL*8 :: temp372b4 + DOUBLE PRECISION :: temp408 REAL*8 :: temp428b + REAL*8 :: temp431b8 + REAL*8 :: temp432b12 + REAL*8 :: temp448b24 REAL*8 :: temp475b0 REAL*8 :: temp485b9 - REAL*8 :: temp492b1 + REAL*8 :: temp499b28 REAL*8 :: temp509b - REAL*8 :: temp517b3 - REAL*8 :: temp29b - REAL*8 :: temp68b29 - DOUBLE PRECISION :: temp100b4 + REAL*8 :: temp137b4 + REAL*8 :: temp155b28 REAL*8 :: temp164 - REAL*8 :: temp176b1 - REAL*8 :: temp203b0 - REAL*8 :: temp245 - REAL*8 :: temp316b5 - REAL*8 :: temp321b32 - DOUBLE PRECISION :: temp326 - REAL*8 :: temp338b1 + REAL*8 :: temp206b12 + REAL*8 :: temp220b1 + DOUBLE PRECISION :: temp245 + REAL*8 :: temp253b38 + REAL*8 :: temp257b1 + REAL*8 :: temp301b1 + REAL*8 :: temp326 REAL*8 :: temp355b - REAL*8 :: temp379b20 - REAL*8 :: temp379b57 - REAL*8 :: temp380b55 - REAL*8 :: temp387b7 - REAL*8 :: temp388b11 - REAL*8 :: temp388b48 + REAL*8 :: temp372b3 REAL*8 :: temp407 - REAL*8 :: temp436b + REAL*8 :: temp431b7 + REAL*8 :: temp432b11 + REAL*8 :: temp448b23 REAL*8 :: temp485b8 REAL*8 :: temp492b0 - REAL*8 :: temp517b - REAL*8 :: temp517b2 + REAL*8 :: temp499b27 REAL*8 :: temp0b0 - REAL*8 :: temp68b28 - DOUBLE PRECISION :: temp100b3 - DOUBLE PRECISION :: temp163 + REAL*8 :: temp37b + REAL*8 :: temp137b3 + REAL*8 :: temp155b27 + REAL*8 :: temp163 REAL*8 :: temp176b0 - REAL*8 :: temp186b9 - REAL*8 :: temp244 - REAL*8 :: temp282b - REAL*8 :: temp316b4 - REAL*8 :: temp321b31 - DOUBLE PRECISION :: temp325 + REAL*8 :: temp206b11 + REAL*8 :: temp220b0 + DOUBLE PRECISION :: temp244 + REAL*8 :: temp253b37 + REAL*8 :: temp257b0 + REAL*8 :: temp301b0 + REAL*8 :: temp325 REAL*8 :: temp338b0 REAL*8 :: temp355b1 - REAL*8 :: temp363b - REAL*8 :: temp379b56 - REAL*8 :: temp380b54 - REAL*8 :: temp387b6 - REAL*8 :: temp388b10 - REAL*8 :: temp388b47 + REAL*8 :: temp372b2 REAL*8 :: temp406 + REAL*8 :: temp431b6 + REAL*8 :: temp432b10 + DOUBLE PRECISION :: temp444b + REAL*8 :: temp448b22 + REAL*8 :: temp448b59 REAL*8 :: temp485b7 - REAL*8 :: temp517b1 - REAL*8 :: temp29b0 - REAL*8 :: temp68b27 - DOUBLE PRECISION :: temp100b2 - REAL*8 :: temp119b - DOUBLE PRECISION :: temp162 - REAL*8 :: temp186b8 - DOUBLE PRECISION :: temp199 - REAL*8 :: temp218b2 + REAL*8 :: temp499b26 + REAL*8 :: temp525b + REAL*8 :: temp45b + REAL*8 :: temp137b2 + REAL*8 :: temp155b26 + REAL*8 :: temp162 + REAL*8 :: temp197b39 + REAL*8 :: temp199 + REAL*8 :: temp206b10 + DOUBLE PRECISION :: temp224b29 REAL*8 :: temp243 - REAL*8 :: temp316b3 - REAL*8 :: temp321b30 - DOUBLE PRECISION :: temp324 + REAL*8 :: temp253b36 + REAL*8 :: temp290b + REAL*8 :: temp311b8 + REAL*8 :: temp324 REAL*8 :: temp355b0 - REAL*8 :: temp379b55 - REAL*8 :: temp380b53 - REAL*8 :: temp387b5 - REAL*8 :: temp388b46 + REAL*8 :: temp371b + REAL*8 :: temp372b1 REAL*8 :: temp405 + REAL*8 :: temp431b5 + REAL*8 :: temp448b21 + REAL*8 :: temp448b58 + REAL*8 :: temp452b + REAL*8 :: temp453b1 REAL*8 :: temp485b6 - REAL*8 :: temp489b - REAL*8 :: temp496b19 - REAL*8 :: temp517b0 - REAL*8 :: temp39b8 - REAL*8 :: temp46b0 - REAL*8 :: temp53b - REAL*8 :: temp68b26 - REAL*8 :: temp100b1 + REAL*8 :: temp499b25 + REAL*8 :: temp2b + REAL*8 :: temp8b39 + REAL*8 :: temp127b + REAL*8 :: temp137b1 + REAL*8 :: temp155b25 REAL*8 :: temp161 - REAL*8 :: temp186b7 + REAL*8 :: temp197b38 REAL*8 :: temp198 - REAL*8 :: temp218b1 + REAL*8 :: temp224b28 REAL*8 :: temp242 - DOUBLE PRECISION :: temp279 - REAL*8 :: temp316b2 - DOUBLE PRECISION :: temp323 - REAL*8 :: temp379b54 - REAL*8 :: temp380b52 - REAL*8 :: temp387b4 - REAL*8 :: temp388b45 - REAL*8 :: temp404 + REAL*8 :: temp253b35 + REAL*8 :: temp279 + REAL*8 :: temp311b7 + REAL*8 :: temp323 + REAL*8 :: temp372b0 + DOUBLE PRECISION :: temp404 + REAL*8 :: temp431b4 + REAL*8 :: temp448b20 + REAL*8 :: temp448b57 REAL*8 :: temp453b0 - REAL*8 :: temp474b21 + REAL*8 :: temp460b + REAL*8 :: temp468b4 REAL*8 :: temp485b5 - REAL*8 :: temp496b18 REAL*8 :: temp497b - REAL*8 :: temp39b7 - REAL*8 :: temp61b - REAL*8 :: temp68b25 - REAL*8 :: temp100b0 + REAL*8 :: temp499b24 + REAL*8 :: temp8b9 + REAL*8 :: temp8b38 + REAL*8 :: temp24b3 + REAL*8 :: temp135b + REAL*8 :: temp137b0 + REAL*8 :: temp154b1 + REAL*8 :: temp155b24 REAL*8 :: temp160 - REAL*8 :: temp186b6 - REAL*8 :: temp197 - REAL*8 :: temp216b - REAL*8 :: temp218b0 - REAL*8 :: temp235b1 + REAL*8 :: temp197b37 + DOUBLE PRECISION :: temp197 + REAL*8 :: temp224b27 REAL*8 :: temp241 + REAL*8 :: temp253b34 REAL*8 :: temp278 - REAL*8 :: temp316b1 - DOUBLE PRECISION :: temp322 + REAL*8 :: temp311b6 + REAL*8 :: temp322 + REAL*8 :: temp340b19 DOUBLE PRECISION :: temp359 - REAL*8 :: temp379b53 - REAL*8 :: temp380b51 - REAL*8 :: temp387b3 - REAL*8 :: temp388b44 DOUBLE PRECISION :: temp403 - REAL*8 :: temp470b0 - REAL*8 :: temp474b20 + REAL*8 :: temp431b3 + REAL*8 :: temp448b56 + REAL*8 :: temp468b3 REAL*8 :: temp485b4 - REAL*8 :: temp496b17 - REAL*8 :: temp39b6 - REAL*8 :: temp68b24 + REAL*8 :: temp499b23 + REAL*8 :: temp8b8 + REAL*8 :: temp8b37 + REAL*8 :: temp24b2 + REAL*8 :: temp95b4 + REAL*8 :: temp131b29 + REAL*8 :: temp143b REAL*8 :: temp154b0 - REAL*8 :: temp186b5 + REAL*8 :: temp155b23 DOUBLE PRECISION :: temp196 + REAL*8 :: temp197b36 REAL*8 :: temp224b + REAL*8 :: temp224b26 REAL*8 :: temp235b0 REAL*8 :: temp240 + REAL*8 :: temp253b33 REAL*8 :: temp277 - REAL*8 :: temp316b0 - REAL*8 :: temp321 - REAL*8 :: temp333b1 + REAL*8 :: temp311b5 + DOUBLE PRECISION :: temp321 + REAL*8 :: temp340b18 DOUBLE PRECISION :: temp358 - REAL*8 :: temp379b52 - REAL*8 :: temp380b50 - REAL*8 :: temp387b2 - REAL*8 :: temp388b43 - REAL*8 :: temp402 - REAL*8 :: temp414b1 - REAL*8 :: temp439 + DOUBLE PRECISION :: temp402 + REAL*8 :: temp431b2 + DOUBLE PRECISION :: temp439 + REAL*8 :: temp448b55 + REAL*8 :: temp468b2 REAL*8 :: temp485b3 - REAL*8 :: temp496b16 - REAL*8 :: temp39b5 - REAL*8 :: temp68b23 + REAL*8 :: temp499b22 + REAL*8 :: temp8b7 + REAL*8 :: temp8b36 + REAL*8 :: temp24b1 + REAL*8 :: temp95b3 + REAL*8 :: temp131b28 + REAL*8 :: temp132b3 REAL*8 :: temp151b - REAL*8 :: temp164b8 - REAL*8 :: temp186b4 + REAL*8 :: temp155b22 + REAL*8 :: temp171b0 REAL*8 :: temp188b DOUBLE PRECISION :: temp195 - REAL*8 :: temp232b - REAL*8 :: temp269b - DOUBLE PRECISION :: temp252b0 - DOUBLE PRECISION :: temp276 + REAL*8 :: temp197b35 + REAL*8 :: temp224b25 + REAL*8 :: temp253b32 + REAL*8 :: temp276 + REAL*8 :: temp311b4 REAL*8 :: temp313b REAL*8 :: temp320 REAL*8 :: temp333b0 + REAL*8 :: temp340b17 DOUBLE PRECISION :: temp357 - REAL*8 :: temp373b39 - REAL*8 :: temp379b51 - REAL*8 :: temp387b1 - REAL*8 :: temp388b42 - REAL*8 :: temp388b79 REAL*8 :: temp401 - REAL*8 :: temp414b0 - REAL*8 :: temp438 + REAL*8 :: temp431b1 + DOUBLE PRECISION :: temp438 + REAL*8 :: temp448b54 + REAL*8 :: temp463b6 + REAL*8 :: temp468b1 REAL*8 :: temp485b2 - REAL*8 :: temp496b15 + REAL*8 :: temp499b21 + REAL*8 :: temp512b1 REAL*8 :: temp519 + REAL*8 :: temp8b6 + REAL*8 :: temp8b35 REAL*8 :: temp24b0 - REAL*8 :: temp39b4 - REAL*8 :: temp53b19 - REAL*8 :: temp68b22 - REAL*8 :: temp164b7 - REAL*8 :: temp186b3 - REAL*8 :: temp194 + REAL*8 :: temp73b6 + REAL*8 :: temp95b2 + REAL*8 :: temp115b1 + REAL*8 :: temp131b27 + REAL*8 :: temp132b2 + REAL*8 :: temp155b21 + DOUBLE PRECISION :: temp194 + REAL*8 :: temp197b34 + REAL*8 :: temp224b24 REAL*8 :: temp240b + REAL*8 :: temp253b31 DOUBLE PRECISION :: temp275 + REAL*8 :: temp277b + REAL*8 :: temp311b3 REAL*8 :: temp321b - REAL*8 :: temp322b34 - REAL*8 :: temp348b3 - REAL*8 :: temp350b0 + REAL*8 :: temp340b16 DOUBLE PRECISION :: temp356 - REAL*8 :: temp358b - REAL*8 :: temp373b38 - REAL*8 :: temp379b50 REAL*8 :: temp387b0 - REAL*8 :: temp388b41 - REAL*8 :: temp388b78 - REAL*8 :: temp400 - REAL*8 :: temp402b + DOUBLE PRECISION :: temp400 + REAL*8 :: temp431b0 REAL*8 :: temp437 - REAL*8 :: temp439b - REAL*8 :: temp478b9 + REAL*8 :: temp448b53 + REAL*8 :: temp463b5 + REAL*8 :: temp468b0 REAL*8 :: temp485b1 - REAL*8 :: temp496b14 + REAL*8 :: temp499b20 REAL*8 :: temp512b0 REAL*8 :: temp518 - REAL*8 :: temp39b3 - REAL*8 :: temp53b18 - REAL*8 :: temp68b21 - REAL*8 :: temp78b0 - REAL*8 :: temp164b6 - REAL*8 :: temp186b2 - REAL*8 :: temp193 + REAL*8 :: temp522b9 + REAL*8 :: temp8b5 + REAL*8 :: temp8b34 + REAL*8 :: temp73b5 + REAL*8 :: temp95b1 + REAL*8 :: temp115b0 + REAL*8 :: temp131b26 + REAL*8 :: temp132b1 + REAL*8 :: temp155b20 + REAL*8 :: temp181b7 + DOUBLE PRECISION :: temp193 + REAL*8 :: temp197b33 + REAL*8 :: temp206b9 + REAL*8 :: temp224b23 + REAL*8 :: temp253b30 DOUBLE PRECISION :: temp274 - REAL*8 :: temp309b5 - REAL*8 :: temp322b33 - REAL*8 :: temp348b2 + REAL*8 :: temp285b + REAL*8 :: temp311b2 + REAL*8 :: temp335b39 + REAL*8 :: temp340b15 REAL*8 :: temp355 - REAL*8 :: temp366b - REAL*8 :: temp373b37 - REAL*8 :: temp388b40 - REAL*8 :: temp388b77 - REAL*8 :: temp410b REAL*8 :: temp436 REAL*8 :: temp447b - REAL*8 :: temp478b8 + REAL*8 :: temp446b3 + REAL*8 :: temp448b52 + REAL*8 :: temp448b89 + REAL*8 :: temp463b4 REAL*8 :: temp485b0 - REAL*8 :: temp496b13 - INTEGER :: temp517 - REAL*8 :: temp39b2 + REAL*8 :: tmp2b + DOUBLE PRECISION :: temp517 + REAL*8 :: temp522b8 + REAL*8 :: temp3b9 + REAL*8 :: temp8b4 + REAL*8 :: temp8b33 REAL*8 :: temp48b - REAL*8 :: temp53b17 - REAL*8 :: temp68b20 - REAL*8 :: temp164b5 - REAL*8 :: temp186b1 + REAL*8 :: temp56b3 + REAL*8 :: temp73b4 + REAL*8 :: temp95b0 + REAL*8 :: temp131b25 + REAL*8 :: temp132b0 + REAL*8 :: temp169b0 + REAL*8 :: temp181b6 DOUBLE PRECISION :: temp192 - DOUBLE PRECISION :: temp273 - REAL*8 :: temp309b4 - REAL*8 :: temp322b32 - REAL*8 :: temp348b1 + REAL*8 :: temp197b32 + REAL*8 :: temp206b8 + REAL*8 :: temp224b22 + REAL*8 :: temp273 + REAL*8 :: temp311b1 + REAL*8 :: temp335b38 + REAL*8 :: temp340b14 + REAL*8 :: temp343b6 REAL*8 :: temp354 - REAL*8 :: temp373b36 - REAL*8 :: temp374b - REAL*8 :: temp388b76 - REAL*8 :: temp429b1 - REAL*8 :: temp435 + DOUBLE PRECISION :: temp435 + REAL*8 :: temp446b2 + REAL*8 :: temp448b51 + REAL*8 :: temp448b88 REAL*8 :: temp455b - REAL*8 :: temp478b7 - REAL*8 :: temp480b4 - REAL*8 :: temp496b12 + REAL*8 :: temp463b3 REAL*8 :: temp516 + REAL*8 :: temp522b7 + REAL*8 :: temp3b8 REAL*8 :: temp5b - REAL*8 :: temp39b1 - REAL*8 :: temp53b16 + REAL*8 :: temp8b3 + REAL*8 :: temp8b32 + REAL*8 :: temp56b + REAL*8 :: temp56b2 + REAL*8 :: temp73b3 + REAL*8 :: temp131b24 REAL*8 :: temp164b4 - REAL*8 :: temp186b0 + REAL*8 :: temp181b5 + REAL*8 :: temp190b10 + REAL*8 :: temp191b19 DOUBLE PRECISION :: temp191 + REAL*8 :: temp197b31 + REAL*8 :: temp206b7 + REAL*8 :: temp224b21 + REAL*8 :: temp228b3 REAL*8 :: temp272 - REAL*8 :: temp309b3 - REAL*8 :: temp321b9 - REAL*8 :: temp322b31 - REAL*8 :: temp348b0 - DOUBLE PRECISION :: temp353 - REAL*8 :: temp373b35 - REAL*8 :: temp388b75 - REAL*8 :: temp397b6 - REAL*8 :: temp429b0 - REAL*8 :: temp434 + REAL*8 :: temp277b9 + REAL*8 :: temp311b0 + REAL*8 :: temp335b37 + REAL*8 :: temp340b13 + REAL*8 :: temp343b5 + REAL*8 :: temp353 + REAL*8 :: temp382b + REAL*8 :: temp382b2 + DOUBLE PRECISION :: temp434 + REAL*8 :: temp446b1 + REAL*8 :: temp448b50 + REAL*8 :: temp448b87 REAL*8 :: temp463b - REAL*8 :: temp478b6 - REAL*8 :: temp480b3 - REAL*8 :: temp496b11 + REAL*8 :: temp463b2 REAL*8 :: temp515 - REAL*8 :: temp39b0 - REAL*8 :: temp53b15 - REAL*8 :: temp64b - REAL*8 :: temp68b55 - REAL*8 :: temp138b + REAL*8 :: temp522b6 + REAL*8 :: temp3b7 + REAL*8 :: temp8b2 + REAL*8 :: temp8b31 + REAL*8 :: temp34b5 + REAL*8 :: temp49b9 + REAL*8 :: temp56b1 + REAL*8 :: temp73b2 + REAL*8 :: temp101b + REAL*8 :: temp131b23 REAL*8 :: temp164b3 - DOUBLE PRECISION :: temp190 - REAL*8 :: temp219b - REAL*8 :: temp271 - REAL*8 :: temp309b2 - REAL*8 :: temp321b8 - REAL*8 :: temp322b30 + REAL*8 :: temp181b4 + REAL*8 :: temp190 + REAL*8 :: temp191b18 + REAL*8 :: temp197b30 + REAL*8 :: temp206b6 + REAL*8 :: temp224b20 + REAL*8 :: temp228b2 + DOUBLE PRECISION :: temp271 + REAL*8 :: temp277b8 + REAL*8 :: temp335b36 + REAL*8 :: temp340b12 + REAL*8 :: temp340b49 + REAL*8 :: temp343b4 DOUBLE PRECISION :: temp352 - REAL*8 :: temp373b34 - REAL*8 :: temp388b74 - REAL*8 :: temp389 - REAL*8 :: temp390b - REAL*8 :: temp397b5 - REAL*8 :: temp404b39 - REAL*8 :: temp433 + REAL*8 :: temp382b1 + DOUBLE PRECISION :: temp389 + DOUBLE PRECISION :: temp390b + DOUBLE PRECISION :: temp433 REAL*8 :: temp446b0 - REAL*8 :: temp471b - REAL*8 :: temp478b5 - REAL*8 :: temp480b2 - REAL*8 :: temp496b10 - REAL*8 :: temp497b19 - REAL*8 :: temp514 - REAL*8 :: temp53b14 - REAL*8 :: temp57b29 - REAL*8 :: temp68b54 + REAL*8 :: temp448b86 + REAL*8 :: temp463b1 + DOUBLE PRECISION :: temp514 + REAL*8 :: temp522b5 + REAL*8 :: temp3b6 + REAL*8 :: temp8b1 + REAL*8 :: temp8b30 + REAL*8 :: temp34b4 + REAL*8 :: temp49b8 + REAL*8 :: temp56b0 + REAL*8 :: temp72b + REAL*8 :: temp73b1 + REAL*8 :: temp131b22 + REAL*8 :: temp131b59 REAL*8 :: temp146b REAL*8 :: temp164b2 + REAL*8 :: temp181b3 + REAL*8 :: temp191b17 + REAL*8 :: temp206b5 REAL*8 :: temp227b - REAL*8 :: temp270 - REAL*8 :: temp309b1 - REAL*8 :: temp315b19 - REAL*8 :: temp321b7 + REAL*8 :: temp228b1 + DOUBLE PRECISION :: temp270 + REAL*8 :: temp277b7 + REAL*8 :: temp335b35 + REAL*8 :: temp340b11 + REAL*8 :: temp340b48 + REAL*8 :: temp343b3 DOUBLE PRECISION :: temp351 - REAL*8 :: temp373b33 - REAL*8 :: temp386b39 - REAL*8 :: temp388b73 - REAL*8 :: temp388 - REAL*8 :: temp397b4 - REAL*8 :: temp404b38 - REAL*8 :: temp432 + REAL*8 :: temp382b0 + DOUBLE PRECISION :: temp388 + DOUBLE PRECISION :: temp432 + REAL*8 :: temp448b85 REAL*8 :: temp463b0 - REAL*8 :: temp469 - REAL*8 :: temp478b4 - REAL*8 :: temp480b1 - REAL*8 :: temp497b18 - INTEGER :: temp513 - REAL*8 :: temp39 - REAL*8 :: temp53b13 - REAL*8 :: temp57b28 - REAL*8 :: temp68b53 - REAL*8 :: temp147b0 + DOUBLE PRECISION :: temp469 + DOUBLE PRECISION :: temp513 + REAL*8 :: temp522b4 + REAL*8 :: temp3b5 + REAL*8 :: temp8b0 + REAL*8 :: temp34b3 + DOUBLE PRECISION :: temp39 + REAL*8 :: temp49b7 + REAL*8 :: temp66b8 + REAL*8 :: temp73b0 + REAL*8 :: temp80b + REAL*8 :: temp83b9 + REAL*8 :: temp110b0 + REAL*8 :: temp131b21 + REAL*8 :: temp131b58 REAL*8 :: temp154b REAL*8 :: temp164b1 + REAL*8 :: temp181b2 + REAL*8 :: temp191b16 + REAL*8 :: temp206b4 + REAL*8 :: temp228b0 REAL*8 :: temp235b - REAL*8 :: temp309b0 - REAL*8 :: temp315b18 + REAL*8 :: temp277b6 REAL*8 :: temp316b - REAL*8 :: temp321b6 - DOUBLE PRECISION :: temp350 - REAL*8 :: temp373b32 - REAL*8 :: temp373b69 - REAL*8 :: temp386b38 + REAL*8 :: temp335b34 + REAL*8 :: temp340b10 + REAL*8 :: temp340b47 + REAL*8 :: temp343b2 + REAL*8 :: temp350 REAL*8 :: temp387 - REAL*8 :: temp388b72 - REAL*8 :: temp397b3 - REAL*8 :: temp404b37 REAL*8 :: temp431 + REAL*8 :: temp448b84 REAL*8 :: temp468 - REAL*8 :: temp478b3 REAL*8 :: temp480b0 - REAL*8 :: temp490b9 - REAL*8 :: temp497b17 - REAL*8 :: temp512 + DOUBLE PRECISION :: temp512 + REAL*8 :: temp522b3 + REAL*8 :: temp3b4 + REAL*8 :: temp34b2 REAL*8 :: temp38 - REAL*8 :: temp53b12 - REAL*8 :: temp57b27 - REAL*8 :: temp68b52 + REAL*8 :: temp49b6 + REAL*8 :: temp66b7 + REAL*8 :: temp83b8 + REAL*8 :: temp131b20 + REAL*8 :: temp131b57 + REAL*8 :: temp162b REAL*8 :: temp164b0 + REAL*8 :: temp181b1 + REAL*8 :: temp191b15 + REAL*8 :: temp199b + REAL*8 :: temp206b3 REAL*8 :: temp243b - REAL*8 :: temp299b1 - REAL*8 :: temp315b17 - REAL*8 :: temp321b5 - REAL*8 :: temp373b31 - REAL*8 :: temp373b68 - REAL*8 :: temp386b37 + REAL*8 :: temp277b5 + REAL*8 :: temp324b + REAL*8 :: temp326b0 + REAL*8 :: temp335b33 + REAL*8 :: temp340b46 + REAL*8 :: temp343b1 REAL*8 :: temp386 - REAL*8 :: temp388b71 - REAL*8 :: temp397b2 - REAL*8 :: temp404b36 REAL*8 :: temp405b REAL*8 :: temp430 + REAL*8 :: temp448b83 REAL*8 :: temp467 - REAL*8 :: temp478b2 - REAL*8 :: temp490b8 - REAL*8 :: temp497b16 - REAL*8 :: temp505b1 REAL*8 :: temp511 + REAL*8 :: temp522b2 + REAL*8 :: temp3b3 REAL*8 :: temp17b0 + REAL*8 :: temp34b1 REAL*8 :: temp37 - REAL*8 :: temp53b11 - REAL*8 :: temp57b26 - REAL*8 :: temp68b51 - REAL*8 :: temp174b8 + REAL*8 :: temp49b5 + REAL*8 :: temp66b6 + REAL*8 :: temp83b7 + REAL*8 :: temp131b56 + REAL*8 :: temp170b + REAL*8 :: temp181b0 + REAL*8 :: temp191b9 + REAL*8 :: temp191b14 + REAL*8 :: temp201b7 + REAL*8 :: temp206b2 REAL*8 :: temp251b + REAL*8 :: temp277b4 + REAL*8 :: temp288b REAL*8 :: temp299b0 - REAL*8 :: temp315b16 - REAL*8 :: temp321b4 + REAL*8 :: temp319b7 REAL*8 :: temp332b - REAL*8 :: temp369b - REAL*8 :: temp373b30 - REAL*8 :: temp373b67 - DOUBLE PRECISION :: temp385 - REAL*8 :: temp386b36 - REAL*8 :: temp388b70 - REAL*8 :: temp397b1 - REAL*8 :: temp404b35 + REAL*8 :: temp335b32 + REAL*8 :: temp340b45 + REAL*8 :: temp343b0 + REAL*8 :: temp353b9 + REAL*8 :: temp385 REAL*8 :: temp413b REAL*8 :: temp424b0 - REAL*8 :: temp466 - REAL*8 :: temp478b1 - REAL*8 :: temp490b7 - REAL*8 :: temp497b15 + REAL*8 :: temp441b1 + REAL*8 :: temp448b82 + DOUBLE PRECISION :: temp466 + REAL*8 :: tmp5b REAL*8 :: temp505b0 REAL*8 :: temp510 - REAL*8 :: temp14b + REAL*8 :: temp522b1 + REAL*8 :: temp3b2 + REAL*8 :: temp34b0 REAL*8 :: temp36 - REAL*8 :: temp53b10 - REAL*8 :: temp57b25 - REAL*8 :: temp68b50 - REAL*8 :: temp174b7 - REAL*8 :: temp315b15 - REAL*8 :: temp321b3 + REAL*8 :: temp49b4 + REAL*8 :: temp66b5 + REAL*8 :: temp83b6 + REAL*8 :: temp118b9 + REAL*8 :: temp125b1 + REAL*8 :: temp131b55 + REAL*8 :: temp191b8 + REAL*8 :: temp191b13 + REAL*8 :: temp201b6 + REAL*8 :: temp206b1 + REAL*8 :: temp277b3 + REAL*8 :: temp296b + REAL*8 :: temp319b6 + REAL*8 :: temp335b31 REAL*8 :: temp340b - REAL*8 :: temp360b0 - REAL*8 :: temp373b66 - DOUBLE PRECISION :: temp384 - REAL*8 :: temp386b35 - REAL*8 :: temp397b0 - REAL*8 :: temp404b34 + REAL*8 :: temp340b44 + REAL*8 :: temp353b8 + REAL*8 :: temp384 REAL*8 :: temp421b - REAL*8 :: temp465 - REAL*8 :: temp478b0 - REAL*8 :: temp488b9 - REAL*8 :: temp490b6 - REAL*8 :: temp497b14 + REAL*8 :: temp441b0 + REAL*8 :: temp448b81 + DOUBLE PRECISION :: temp465 + REAL*8 :: temp522b0 + REAL*8 :: temp3b1 REAL*8 :: temp8b - REAL*8 :: temp35 - REAL*8 :: temp54b18 - REAL*8 :: temp57b24 - REAL*8 :: temp59b - REAL*8 :: temp88b0 - REAL*8 :: temp174b6 - REAL*8 :: temp216b9 - REAL*8 :: temp223b1 - REAL*8 :: temp315b14 - REAL*8 :: temp321b2 - REAL*8 :: temp373b65 - DOUBLE PRECISION :: temp383 - REAL*8 :: temp386b34 - REAL*8 :: temp404b33 - REAL*8 :: temp456b3 + REAL*8 :: temp22b + DOUBLE PRECISION :: temp35 + REAL*8 :: temp49b3 + REAL*8 :: temp66b4 + REAL*8 :: temp83b5 + REAL*8 :: temp118b8 + REAL*8 :: temp125b0 + REAL*8 :: temp131b54 + REAL*8 :: temp135b9 + REAL*8 :: temp191b7 + REAL*8 :: temp191b12 + REAL*8 :: temp191b49 + REAL*8 :: temp201b5 + REAL*8 :: temp206b0 + REAL*8 :: temp277b2 + REAL*8 :: temp319b5 + REAL*8 :: temp335b30 + REAL*8 :: temp340b43 + REAL*8 :: temp353b7 + REAL*8 :: temp383 + REAL*8 :: temp385b + REAL*8 :: temp448b80 REAL*8 :: temp464 - REAL*8 :: temp488b8 - REAL*8 :: temp490b5 - REAL*8 :: temp496b41 - REAL*8 :: temp497b13 - REAL*8 :: temp34 - REAL*8 :: temp54b17 - REAL*8 :: temp57b23 - REAL*8 :: temp120b4 - REAL*8 :: temp174b5 - REAL*8 :: temp216b8 - REAL*8 :: temp223b0 - REAL*8 :: temp315b13 - REAL*8 :: temp321b1 - REAL*8 :: temp328b19 - REAL*8 :: temp373b64 - DOUBLE PRECISION :: temp382 - REAL*8 :: temp386b33 - REAL*8 :: temp393b - REAL*8 :: temp402b1 - REAL*8 :: temp404b32 - REAL*8 :: temp456b2 - DOUBLE PRECISION :: temp463 - REAL*8 :: temp474b - REAL*8 :: temp488b7 - REAL*8 :: temp490b4 - REAL*8 :: temp496b40 - REAL*8 :: temp497b12 - REAL*8 :: temp27b5 + REAL*8 :: temp510b + REAL*8 :: temp3b0 + DOUBLE PRECISION :: temp34 + REAL*8 :: temp49b2 + REAL*8 :: temp50b39 + REAL*8 :: temp66b3 + REAL*8 :: temp67b + REAL*8 :: temp83b4 + REAL*8 :: temp104b + REAL*8 :: temp118b7 + REAL*8 :: temp131b53 + REAL*8 :: temp135b8 + REAL*8 :: temp191b6 + REAL*8 :: temp191b11 + REAL*8 :: temp191b48 + REAL*8 :: temp201b4 + REAL*8 :: temp277b1 + REAL*8 :: temp319b4 + REAL*8 :: temp340b42 + REAL*8 :: temp353b6 + REAL*8 :: temp370b7 + REAL*8 :: temp382 + REAL*8 :: temp463 REAL*8 :: temp33 - REAL*8 :: temp42b19 - REAL*8 :: temp54b16 - REAL*8 :: temp57b22 - DOUBLE PRECISION :: temp112b - REAL*8 :: temp120b3 + REAL*8 :: temp49b1 + REAL*8 :: temp50b38 + REAL*8 :: temp66b2 + REAL*8 :: temp75b + REAL*8 :: temp83b3 + REAL*8 :: temp118b6 REAL*8 :: temp129 + REAL*8 :: temp131b52 + REAL*8 :: temp135b7 + REAL*8 :: temp135b30 REAL*8 :: temp149b - REAL*8 :: temp174b4 - REAL*8 :: temp216b7 - REAL*8 :: temp315b12 - REAL*8 :: temp321b0 - REAL*8 :: temp328b18 - REAL*8 :: temp373b63 - DOUBLE PRECISION :: temp381 - REAL*8 :: temp386b32 - REAL*8 :: temp392b2 - REAL*8 :: temp402b0 - REAL*8 :: temp404b31 - REAL*8 :: temp439b0 - REAL*8 :: temp456b1 - REAL*8 :: temp462 - REAL*8 :: temp473b2 - REAL*8 :: temp488b6 - REAL*8 :: temp490b3 - REAL*8 :: temp497b11 + REAL*8 :: temp191b5 + REAL*8 :: temp191b10 + REAL*8 :: temp191b47 + REAL*8 :: temp201b3 + REAL*8 :: temp277b0 + REAL*8 :: temp319b3 + REAL*8 :: temp340b41 + REAL*8 :: temp353b5 + REAL*8 :: temp353b10 + REAL*8 :: temp370b6 + REAL*8 :: temp381 + DOUBLE PRECISION :: temp462 REAL*8 :: temp499 - REAL*8 :: temp27b4 - DOUBLE PRECISION :: temp32 - REAL*8 :: temp42b18 - REAL*8 :: temp54b15 - REAL*8 :: temp57b21 + REAL*8 :: temp32 + REAL*8 :: temp44b5 + REAL*8 :: temp49b0 + REAL*8 :: temp50b37 + REAL*8 :: temp66b1 REAL*8 :: temp69 + REAL*8 :: temp83b + REAL*8 :: temp83b2 REAL*8 :: temp118b5 - REAL*8 :: temp120b - REAL*8 :: temp120b2 - REAL*8 :: temp128 - REAL*8 :: temp174b3 + DOUBLE PRECISION :: temp128 + REAL*8 :: temp131b51 + REAL*8 :: temp135b6 + REAL*8 :: temp191b4 + REAL*8 :: temp191b46 + REAL*8 :: temp201b + REAL*8 :: temp201b2 DOUBLE PRECISION :: temp209 - REAL*8 :: temp216b6 REAL*8 :: temp238b - REAL*8 :: temp315b11 - REAL*8 :: temp328b17 - REAL*8 :: temp373b62 - REAL*8 :: temp380b19 - DOUBLE PRECISION :: temp380 - REAL*8 :: temp386b31 - REAL*8 :: temp392b1 - REAL*8 :: temp404b30 + REAL*8 :: temp319b + REAL*8 :: temp319b2 + REAL*8 :: temp340b40 + REAL*8 :: temp353b4 + REAL*8 :: temp370b5 + REAL*8 :: temp380 REAL*8 :: temp456b0 REAL*8 :: temp461 - REAL*8 :: temp473b1 - REAL*8 :: temp488b5 REAL*8 :: temp490b - REAL*8 :: temp490b2 - REAL*8 :: temp497b10 REAL*8 :: temp498 REAL*8 :: temp500b0 - REAL*8 :: temp27b3 - DOUBLE PRECISION :: temp31 - REAL*8 :: temp42b17 - REAL*8 :: temp54b14 - REAL*8 :: temp57b20 - DOUBLE PRECISION :: temp68 - REAL*8 :: temp91b + REAL*8 :: temp31 + REAL*8 :: temp44b4 + REAL*8 :: temp50b36 + REAL*8 :: temp66b0 + REAL*8 :: temp68 + REAL*8 :: temp83b1 REAL*8 :: temp118b4 - REAL*8 :: temp120b1 DOUBLE PRECISION :: temp127 - REAL*8 :: temp165b - REAL*8 :: temp174b2 - REAL*8 :: temp208 - REAL*8 :: temp216b5 + REAL*8 :: temp131b50 + REAL*8 :: temp135b5 + REAL*8 :: temp191b3 + REAL*8 :: temp191b45 + REAL*8 :: temp201b1 + DOUBLE PRECISION :: temp208 REAL*8 :: temp246b - REAL*8 :: temp272b3 - REAL*8 :: temp315b10 - REAL*8 :: temp328b16 - REAL*8 :: temp373b61 - REAL*8 :: temp380b18 - REAL*8 :: temp386b30 - REAL*8 :: temp387b39 - REAL*8 :: temp392b0 - REAL*8 :: temp408b + REAL*8 :: temp319b1 + REAL*8 :: temp353b3 + REAL*8 :: temp370b4 + DOUBLE PRECISION :: temp392b0 REAL*8 :: temp460 - REAL*8 :: temp473b0 - REAL*8 :: temp488b4 - REAL*8 :: temp490b1 - INTEGER :: temp497 - REAL*8 :: temp27b2 - DOUBLE PRECISION :: temp30 - REAL*8 :: temp42b16 - REAL*8 :: temp54b13 - REAL*8 :: temp57b56 + REAL(8) :: temp497 + REAL*8 :: temp3b17 + REAL*8 :: temp22b7 + REAL*8 :: temp30 + REAL*8 :: temp44b3 + REAL*8 :: temp50b35 REAL*8 :: temp67 + REAL*8 :: temp83b0 REAL*8 :: temp118b3 - REAL*8 :: temp120b0 - DOUBLE PRECISION :: temp126 + REAL*8 :: temp126 + REAL*8 :: temp135b4 REAL*8 :: temp174b1 - REAL*8 :: temp207 - REAL*8 :: temp216b4 - REAL*8 :: temp272b2 - REAL*8 :: temp328b15 + REAL*8 :: temp189b5 + REAL*8 :: temp191b2 + REAL*8 :: temp191b44 + REAL*8 :: temp201b0 + DOUBLE PRECISION :: temp207 + REAL*8 :: temp319b0 REAL*8 :: temp335b - REAL*8 :: temp373b60 - REAL*8 :: temp379b19 - REAL*8 :: temp380b17 - REAL*8 :: temp387b38 + REAL*8 :: temp353b2 + REAL*8 :: temp370b3 REAL*8 :: temp416b - REAL*8 :: temp417b1 - REAL*8 :: temp485b11 - REAL*8 :: temp488b3 - REAL*8 :: temp490b0 REAL*8 :: temp496 + REAL*8 :: temp3b16 REAL*8 :: temp17b - REAL*8 :: temp27b1 - REAL*8 :: temp42b15 - REAL*8 :: temp54b12 - REAL*8 :: temp57b55 + DOUBLE PRECISION :: temp22b6 + REAL*8 :: temp44b2 + REAL*8 :: temp50b34 REAL*8 :: temp66 REAL*8 :: temp118b2 REAL*8 :: temp125 + REAL*8 :: temp135b3 REAL*8 :: temp174b0 - DOUBLE PRECISION :: temp206 - REAL*8 :: temp216b3 - REAL*8 :: temp272b1 + REAL*8 :: temp181b + REAL*8 :: temp189b4 + REAL*8 :: temp191b1 + REAL*8 :: temp191b43 + REAL*8 :: temp206 REAL*8 :: temp299b - REAL*8 :: temp328b14 - REAL*8 :: temp336b0 REAL*8 :: temp343b - REAL*8 :: temp379b18 - REAL*8 :: temp380b16 - REAL*8 :: temp387b37 - REAL*8 :: temp417b0 + REAL*8 :: temp353b1 + REAL*8 :: temp370b2 REAL*8 :: temp424b - REAL*8 :: temp485b10 - REAL*8 :: temp488b2 REAL*8 :: temp495 REAL*8 :: temp505b + REAL*8 :: temp3b15 + REAL*8 :: temp22b5 REAL*8 :: temp25b - REAL*8 :: temp27b0 - REAL*8 :: temp42b14 - REAL*8 :: temp54b11 - REAL*8 :: temp57b54 - REAL*8 :: temp65 + REAL*8 :: temp44b1 + REAL*8 :: temp50b33 + DOUBLE PRECISION :: temp65 REAL*8 :: temp118b1 REAL*8 :: temp124 + REAL*8 :: temp135b2 REAL*8 :: temp189b3 - DOUBLE PRECISION :: temp205 - REAL*8 :: temp216b2 - REAL*8 :: temp272b0 + REAL*8 :: temp191b0 + REAL*8 :: temp191b42 + REAL*8 :: temp205 REAL*8 :: temp314b3 - REAL*8 :: temp321b29 - REAL*8 :: temp328b13 + REAL*8 :: temp353b0 REAL*8 :: temp370b1 - REAL*8 :: temp379b17 - REAL*8 :: temp380b15 - REAL*8 :: temp387b36 - REAL*8 :: temp388b REAL*8 :: temp432b - REAL*8 :: temp451b1 - REAL*8 :: temp469b - REAL*8 :: temp488b1 + DOUBLE PRECISION :: temp469b REAL*8 :: temp494 - REAL*8 :: temp513b - REAL*8 :: temp33b - REAL*8 :: temp42b13 + REAL*8 :: temp3b14 + REAL*8 :: temp22b4 REAL*8 :: temp44b0 - REAL*8 :: temp54b9 - REAL*8 :: temp54b10 - REAL*8 :: temp57b53 - REAL*8 :: temp64 + REAL*8 :: temp50b32 + DOUBLE PRECISION :: temp64 + REAL*8 :: temp107b REAL*8 :: temp118b0 DOUBLE PRECISION :: temp123 + REAL*8 :: temp135b1 REAL*8 :: temp189b2 + REAL*8 :: temp191b41 DOUBLE PRECISION :: temp204 - REAL*8 :: temp216b1 + REAL*8 :: temp226b24 REAL*8 :: temp314b2 - REAL*8 :: temp321b28 - REAL*8 :: temp328b12 REAL*8 :: temp370b0 - REAL*8 :: temp379b16 - REAL*8 :: temp380b9 - REAL*8 :: temp380b14 - REAL*8 :: temp387b35 - REAL*8 :: temp396b - REAL*8 :: temp412b3 REAL*8 :: temp440b - REAL*8 :: temp451b0 + REAL*8 :: temp448b19 REAL*8 :: temp477b - REAL*8 :: temp488b0 - DOUBLE PRECISION :: temp493 + INTEGER :: temp493 REAL*8 :: temp521b - REAL*8 :: temp42b12 - REAL*8 :: temp54b8 - REAL*8 :: temp57b52 + REAL*8 :: temp3b13 + REAL*8 :: temp22b3 + REAL*8 :: temp41b + REAL*8 :: temp50b31 REAL*8 :: temp63 - REAL*8 :: temp61b0 REAL*8 :: temp78b + REAL*8 :: temp115b DOUBLE PRECISION :: temp122 - REAL*8 :: temp128b8 + REAL*8 :: temp135b0 DOUBLE PRECISION :: temp159 REAL*8 :: temp189b1 + REAL*8 :: temp191b40 DOUBLE PRECISION :: temp203 - REAL*8 :: temp216b0 + REAL*8 :: temp226b9 + REAL*8 :: temp226b23 + REAL*8 :: temp233b1 REAL*8 :: temp314b1 - REAL*8 :: temp321b27 - REAL*8 :: temp328b11 - REAL*8 :: temp379b15 - REAL*8 :: temp380b8 - REAL*8 :: temp380b13 - REAL*8 :: temp387b34 - REAL*8 :: temp412b2 - REAL*8 :: temp474b19 - REAL*8 :: temp483b4 + REAL*8 :: temp385b3 + REAL*8 :: temp448b18 REAL*8 :: temp485b REAL*8 :: temp492 - REAL*8 :: temp42b11 - REAL*8 :: temp54b7 - REAL*8 :: temp57b51 - DOUBLE PRECISION :: temp62 - REAL*8 :: temp86b + REAL*8 :: temp3b12 + REAL*8 :: temp22b2 + REAL*8 :: temp50b30 + REAL*8 :: temp62 REAL*8 :: temp99 DOUBLE PRECISION :: temp121 - REAL*8 :: temp128b7 DOUBLE PRECISION :: temp158 REAL*8 :: temp189b0 - REAL*8 :: temp202 + DOUBLE PRECISION :: temp202 + REAL*8 :: temp226b8 + REAL*8 :: temp226b22 + REAL*8 :: temp233b0 REAL*8 :: temp239 + REAL*8 :: temp243b9 REAL*8 :: temp314b0 - REAL*8 :: temp321b26 - REAL*8 :: temp328b10 - REAL*8 :: temp331b1 - REAL*8 :: temp379b14 - REAL*8 :: temp380b7 - REAL*8 :: temp380b12 - REAL*8 :: temp380b49 - REAL*8 :: temp387b33 - REAL*8 :: temp412b1 - REAL*8 :: temp474b18 - REAL*8 :: temp483b3 - REAL*8 :: temp491 + REAL*8 :: temp385b2 + REAL*8 :: temp448b17 + DOUBLE PRECISION :: temp491 REAL*8 :: temp493b - REAL*8 :: temp42b10 - REAL*8 :: temp54b6 - REAL*8 :: temp57b50 + REAL*8 :: temp3b11 + REAL*8 :: temp22b1 DOUBLE PRECISION :: temp61 + REAL*8 :: temp94b REAL*8 :: temp98 DOUBLE PRECISION :: temp120 - REAL*8 :: temp128b6 + REAL*8 :: temp131b DOUBLE PRECISION :: temp157 - REAL*8 :: temp201 + REAL*8 :: temp168b + DOUBLE PRECISION :: temp201 + REAL*8 :: temp226b7 + REAL*8 :: temp226b21 REAL*8 :: temp238 + REAL*8 :: temp243b8 REAL*8 :: temp249b - DOUBLE PRECISION :: temp319 - REAL*8 :: temp321b25 + REAL*8 :: temp319 REAL*8 :: temp331b0 - REAL*8 :: temp346b4 - REAL*8 :: temp379b13 - REAL*8 :: temp380b6 - REAL*8 :: temp380b11 - REAL*8 :: temp380b48 - REAL*8 :: temp387b32 - REAL*8 :: temp412b0 - REAL*8 :: temp474b17 - REAL*8 :: temp483b2 - REAL*8 :: temp490 - REAL*8 :: temp54b5 + REAL*8 :: temp385b1 + REAL*8 :: temp448b16 + DOUBLE PRECISION :: temp490 + REAL*8 :: temp510b1 + REAL*8 :: temp3b10 + REAL*8 :: temp22b0 DOUBLE PRECISION :: temp60 - REAL*8 :: temp59b0 REAL*8 :: temp97 - REAL*8 :: temp93b2 - REAL*8 :: temp128b5 - REAL*8 :: temp130b2 + REAL*8 :: temp124b32 DOUBLE PRECISION :: temp156 REAL*8 :: temp176b - DOUBLE PRECISION :: temp200 + REAL*8 :: temp184b3 + REAL*8 :: temp200 + REAL*8 :: temp220b + REAL*8 :: temp226b6 + REAL*8 :: temp226b20 REAL*8 :: temp237 - DOUBLE PRECISION :: temp257b + REAL*8 :: temp243b7 + REAL*8 :: temp257b REAL*8 :: temp301b - DOUBLE PRECISION :: temp318 - REAL*8 :: temp321b24 + REAL*8 :: temp318 REAL*8 :: temp338b - DOUBLE PRECISION :: temp346b3 - REAL*8 :: temp379b12 - REAL*8 :: temp379b49 REAL*8 :: temp380b5 - REAL*8 :: temp380b10 - REAL*8 :: temp380b47 - REAL*8 :: temp387b31 - REAL*8 :: temp474b16 - REAL*8 :: temp483b1 - REAL*8 :: temp54b4 + REAL*8 :: temp385b0 + REAL*8 :: temp419b + REAL*8 :: temp448b15 + REAL*8 :: temp499b19 + REAL*8 :: temp510b0 REAL*8 :: temp96 - REAL*8 :: temp93b1 - REAL*8 :: temp128b4 - REAL*8 :: temp130b1 + REAL*8 :: temp124b31 + REAL*8 :: temp155b19 REAL*8 :: temp155 + REAL*8 :: temp184b + REAL*8 :: temp184b2 + REAL*8 :: temp226b5 DOUBLE PRECISION :: temp236 - REAL*8 :: temp265b - REAL*8 :: temp297b7 - DOUBLE PRECISION :: temp317 - REAL*8 :: temp321b23 - REAL*8 :: temp346b - REAL*8 :: temp346b2 - REAL*8 :: temp379b11 - REAL*8 :: temp379b48 + REAL*8 :: temp243b6 + REAL*8 :: temp253b29 + REAL*8 :: temp317 REAL*8 :: temp380b4 - REAL*8 :: temp380b46 - REAL*8 :: temp387b30 - REAL*8 :: temp388b39 - REAL*8 :: temp474b15 + REAL*8 :: temp427b + REAL*8 :: temp448b14 REAL*8 :: temp483b0 - REAL*8 :: temp486b12 - REAL*8 :: temp508b - REAL*8 :: temp28b - REAL*8 :: temp54b3 - REAL*8 :: temp68b19 + REAL*8 :: temp499b18 REAL*8 :: temp95 - REAL*8 :: temp93b0 - REAL*8 :: temp128b3 - REAL*8 :: temp130b0 + REAL*8 :: temp124b30 REAL*8 :: temp154 - REAL*8 :: temp235 - REAL*8 :: temp273b - REAL*8 :: temp297b6 - DOUBLE PRECISION :: temp316 - REAL*8 :: temp321b22 - REAL*8 :: temp329b0 - REAL*8 :: temp346b1 + REAL*8 :: temp155b18 + REAL*8 :: temp162b5 + REAL*8 :: temp184b1 + REAL*8 :: temp226b4 + DOUBLE PRECISION :: temp235 + REAL*8 :: temp243b5 + REAL*8 :: temp253b28 + REAL*8 :: temp316 REAL*8 :: temp354b - REAL*8 :: temp379b10 - REAL*8 :: temp379b47 REAL*8 :: temp380b3 - REAL*8 :: temp380b45 - REAL*8 :: temp388b38 - REAL*8 :: temp474b14 - REAL*8 :: temp486b11 - REAL*8 :: temp516b - REAL*8 :: temp36b - REAL*8 :: temp54b2 - REAL*8 :: temp68b18 - DOUBLE PRECISION :: temp94 - REAL*8 :: temp128b2 + REAL*8 :: temp448b13 + REAL*8 :: temp499b17 + REAL*8 :: temp15b5 + REAL*8 :: temp94 REAL*8 :: temp153 - DOUBLE PRECISION :: temp234 + REAL*8 :: temp155b17 + REAL*8 :: temp162b4 + REAL*8 :: temp184b0 + REAL*8 :: temp221b8 + REAL*8 :: temp226b3 + REAL*8 :: temp234 + REAL*8 :: temp243b4 + REAL*8 :: temp253b27 REAL*8 :: temp281b - REAL*8 :: temp282b1 - REAL*8 :: temp297b5 REAL*8 :: temp315 - REAL*8 :: temp321b21 - REAL*8 :: temp346b0 - REAL*8 :: temp362b - REAL*8 :: temp379b46 REAL*8 :: temp380b2 - REAL*8 :: temp380b44 - REAL*8 :: temp388b37 + REAL*8 :: temp399b REAL*8 :: temp443b - REAL*8 :: temp474b13 - REAL*8 :: temp486b10 - REAL*8 :: temp508b0 + REAL*8 :: temp448b12 + REAL*8 :: temp448b49 + REAL*8 :: temp499b16 + REAL*8 :: temp15b4 + REAL*8 :: temp37b0 REAL*8 :: temp44b - REAL*8 :: temp54b1 - REAL*8 :: temp68b17 - REAL*8 :: temp71b2 - DOUBLE PRECISION :: temp93 + REAL*8 :: temp93 REAL*8 :: temp118b - REAL*8 :: temp128b1 - REAL*8 :: temp145b2 - DOUBLE PRECISION :: temp152 - DOUBLE PRECISION :: temp189 - DOUBLE PRECISION :: temp233 - REAL*8 :: temp282b0 - REAL*8 :: temp297b4 - REAL*8 :: temp314 - REAL*8 :: temp321b20 - REAL*8 :: temp322b29 + REAL*8 :: temp152 + REAL*8 :: temp155b16 + REAL*8 :: temp162b3 + REAL*8 :: temp189 + REAL*8 :: temp197b29 + REAL*8 :: temp221b7 + REAL*8 :: temp224b19 + REAL*8 :: temp226b2 + REAL*8 :: temp233 + REAL*8 :: temp243b3 + REAL*8 :: temp253b26 + INTEGER :: temp314 REAL*8 :: temp370b - REAL*8 :: temp373b9 - REAL*8 :: temp379b45 REAL*8 :: temp380b1 - REAL*8 :: temp380b43 - REAL*8 :: temp388b36 + REAL*8 :: temp448b11 + REAL*8 :: temp448b48 REAL*8 :: temp451b - REAL*8 :: temp474b12 + REAL*8 :: temp461b1 REAL*8 :: temp488b - DOUBLE PRECISION :: temp493b6 + REAL*8 :: temp499b15 REAL*8 :: temp1b - REAL*8 :: temp54b0 - REAL*8 :: temp68b16 - REAL*8 :: temp71b1 + REAL*8 :: temp8b29 + REAL*8 :: temp15b3 REAL*8 :: temp92 - REAL*8 :: temp128b0 - REAL*8 :: temp145b1 + REAL*8 :: temp126b DOUBLE PRECISION :: temp151 + REAL*8 :: temp155b15 + REAL*8 :: temp162b2 REAL*8 :: temp188 + REAL*8 :: temp197b28 + REAL*8 :: temp207b + REAL*8 :: temp221b6 + REAL*8 :: temp224b18 + REAL*8 :: temp226b1 REAL*8 :: temp232 + REAL*8 :: temp243b2 + REAL*8 :: temp253b25 REAL*8 :: temp269 - REAL*8 :: temp297b3 REAL*8 :: temp313 - REAL*8 :: temp322b28 - REAL*8 :: temp373b8 - REAL*8 :: temp379b44 + REAL*8 :: temp341b3 REAL*8 :: temp380b0 - REAL*8 :: temp380b42 - REAL*8 :: temp388b35 - REAL*8 :: temp395b4 - REAL*8 :: temp474b11 + REAL*8 :: temp448b10 + REAL*8 :: temp448b47 + REAL*8 :: temp461b0 REAL*8 :: temp493b5 REAL*8 :: temp496b + REAL*8 :: temp499b14 INTRINSIC DSQRT REAL*8 :: temp - REAL*8 :: temp68b15 - REAL*8 :: temp71b0 + REAL*8 :: temp8b28 + REAL*8 :: temp15b2 + REAL*8 :: temp32b3 REAL*8 :: temp91 - REAL*8 :: temp138b8 - DOUBLE PRECISION :: temp145b0 - REAL*8 :: temp150 + REAL*8 :: temp97b + REAL*8 :: temp134b + DOUBLE PRECISION :: temp150 + REAL*8 :: temp155b9 + REAL*8 :: temp155b14 + REAL*8 :: temp162b1 REAL*8 :: temp187 + REAL*8 :: temp197b27 + REAL*8 :: temp221b5 + REAL*8 :: temp224b17 + REAL*8 :: temp226b0 REAL*8 :: temp231 - DOUBLE PRECISION :: temp268 - REAL*8 :: temp297b2 + REAL*8 :: temp243b1 + REAL*8 :: temp253b24 + REAL*8 :: temp268 REAL*8 :: temp312 - REAL*8 :: temp322b27 + REAL*8 :: temp341b2 REAL*8 :: temp349 - REAL*8 :: temp373b7 - REAL*8 :: temp379b43 - REAL*8 :: temp380b41 - REAL*8 :: temp387b62 - REAL*8 :: temp388b34 - REAL*8 :: temp395b3 - REAL*8 :: temp405b1 - REAL*8 :: temp474b10 - REAL*8 :: temp476b3 + REAL*8 :: temp448b46 REAL*8 :: temp493b4 - REAL*8 :: temp68b14 - DOUBLE PRECISION :: temp90 - REAL*8 :: temp138b7 + REAL*8 :: temp499b13 + REAL*8 :: temp8b27 + REAL*8 :: temp15b1 + REAL*8 :: temp32b2 + REAL*8 :: temp90 + REAL*8 :: temp131b19 + REAL*8 :: temp142b + REAL*8 :: temp155b8 + REAL*8 :: temp155b13 + REAL*8 :: temp162b0 + REAL*8 :: temp179b REAL*8 :: temp186 - REAL*8 :: temp223b + REAL*8 :: temp197b26 + REAL*8 :: temp221b4 + REAL*8 :: temp224b16 REAL*8 :: temp230 - REAL*8 :: temp267 - REAL*8 :: temp297b1 + REAL*8 :: temp243b0 + REAL*8 :: temp253b9 + REAL*8 :: temp253b23 + DOUBLE PRECISION :: temp267 REAL*8 :: temp311 - REAL*8 :: temp322b26 - REAL*8 :: temp348 - REAL*8 :: temp373b6 - REAL*8 :: temp379b42 - REAL*8 :: temp380b40 - REAL*8 :: temp387b61 - REAL*8 :: temp388b33 - REAL*8 :: temp395b2 - REAL*8 :: temp405b0 - REAL*8 :: temp422b1 + REAL*8 :: temp324b0 + REAL*8 :: temp341b1 + DOUBLE PRECISION :: temp348 REAL*8 :: temp429 - REAL*8 :: temp476b2 + REAL*8 :: temp448b45 + REAL*8 :: temp459b1 REAL*8 :: temp493b3 - REAL*8 :: temp68b13 - REAL*8 :: temp138b6 + REAL*8 :: temp499b12 + REAL*8 :: temp8b26 + REAL*8 :: temp15b0 + REAL*8 :: temp32b1 + REAL*8 :: temp131b18 REAL*8 :: temp150b - DOUBLE PRECISION :: temp185 + REAL*8 :: temp155b7 + REAL*8 :: temp155b12 + INTEGER :: temp185 REAL*8 :: temp187b - REAL*8 :: temp266 + REAL*8 :: temp197b25 + REAL*8 :: temp221b3 + REAL*8 :: temp224b15 + REAL*8 :: temp231b + REAL*8 :: temp253b8 + REAL*8 :: temp253b22 REAL*8 :: temp260b0 + DOUBLE PRECISION :: temp266 REAL*8 :: temp297b0 - REAL*8 :: temp302b3 - REAL*8 :: temp310 + DOUBLE PRECISION :: temp310 REAL*8 :: temp312b - REAL*8 :: temp322b25 + REAL*8 :: temp339b3 REAL*8 :: temp341b0 - REAL*8 :: temp347 - REAL*8 :: temp349b - REAL*8 :: temp373b5 - REAL*8 :: temp373b29 - REAL*8 :: temp378b0 - REAL*8 :: temp379b41 - REAL*8 :: temp380b76 - REAL*8 :: temp387b60 - REAL*8 :: temp388b9 - REAL*8 :: temp388b32 - REAL*8 :: temp388b69 - REAL*8 :: temp390b6 - REAL*8 :: temp395b1 + DOUBLE PRECISION :: temp347 REAL*8 :: temp422b0 REAL*8 :: temp428 - REAL*8 :: temp476b1 + REAL*8 :: temp432b9 + REAL*8 :: temp448b44 + REAL*8 :: temp459b0 REAL*8 :: temp493b2 - INTEGER :: temp509 - REAL*8 :: temp9 - REAL*8 :: temp42b9 - REAL*8 :: temp68b12 - REAL*8 :: temp68b49 + REAL*8 :: temp499b11 + REAL*8 :: temp509 + REAL*8 :: temp8b25 + DOUBLE PRECISION :: temp9 + REAL*8 :: temp32b0 REAL*8 :: temp69b0 - REAL*8 :: temp138b5 - DOUBLE PRECISION :: temp184 - REAL*8 :: temp265 - REAL*8 :: temp302b2 + REAL*8 :: temp131b17 + REAL*8 :: temp155b6 + REAL*8 :: temp155b11 + REAL*8 :: temp184 + REAL*8 :: temp197b24 + REAL*8 :: temp221b2 + REAL*8 :: temp224b14 + REAL*8 :: temp253b7 + REAL*8 :: temp253b21 + DOUBLE PRECISION :: temp265 REAL*8 :: temp320b - REAL*8 :: temp322b24 + REAL*8 :: temp339b2 DOUBLE PRECISION :: temp346 - REAL*8 :: temp373b4 - REAL*8 :: temp373b28 - REAL*8 :: temp379b40 - REAL*8 :: temp380b75 - REAL*8 :: temp388b8 - REAL*8 :: temp388b31 - REAL*8 :: temp388b68 - REAL*8 :: temp390b5 - REAL*8 :: temp395b0 - REAL*8 :: temp401b + DOUBLE PRECISION :: temp356b3 REAL*8 :: temp427 - REAL*8 :: temp438b - REAL*8 :: temp476b0 - REAL*8 :: temp486b9 + REAL*8 :: temp432b8 + REAL*8 :: temp448b43 REAL*8 :: temp493b1 - REAL*8 :: temp508 - REAL*8 :: temp520b0 + REAL*8 :: temp499b10 + INTEGER :: temp508 REAL*8 :: temp519b - REAL*8 :: temp8 - REAL*8 :: temp39b - REAL*8 :: temp42b8 - REAL*8 :: temp68b11 - REAL*8 :: temp68b48 - REAL*8 :: temp138b4 - REAL*8 :: temp140b1 + REAL*8 :: temp520b0 + REAL*8 :: temp8b24 + DOUBLE PRECISION :: temp8 + REAL*8 :: temp131b16 + REAL*8 :: temp155b5 + REAL*8 :: temp155b10 + REAL*8 :: temp177b1 REAL*8 :: temp183 + REAL*8 :: temp197b23 + REAL*8 :: temp206b31 + REAL*8 :: temp221b1 + REAL*8 :: temp224b13 + REAL*8 :: temp253b6 + REAL*8 :: temp253b20 DOUBLE PRECISION :: temp264 - REAL*8 :: temp302b1 - REAL*8 :: temp322b23 - REAL*8 :: temp345 - REAL*8 :: temp365b - REAL*8 :: temp373b3 - REAL*8 :: temp373b27 - REAL*8 :: temp380b74 - REAL*8 :: temp388b7 - REAL*8 :: temp388b30 - REAL*8 :: temp388b67 - REAL*8 :: temp390b4 + REAL*8 :: temp335b29 + REAL*8 :: temp339b1 + DOUBLE PRECISION :: temp345 + DOUBLE PRECISION :: temp356b2 REAL*8 :: temp426 + REAL*8 :: temp432b7 REAL*8 :: temp446b - REAL*8 :: temp486b8 + REAL*8 :: temp448b42 + REAL*8 :: temp448b79 REAL*8 :: temp493b0 + REAL*8 :: tmp1b REAL*8 :: temp507 - REAL*8 :: temp1b0 REAL*8 :: temp7 - REAL*8 :: temp10b - REAL*8 :: temp42b7 - REAL*8 :: temp68b10 - REAL*8 :: temp68b47 - REAL*8 :: temp138b3 + REAL*8 :: temp8b23 + REAL*8 :: temp47b + REAL*8 :: temp131b15 REAL*8 :: temp140b0 + REAL*8 :: temp155b4 + REAL*8 :: temp172b5 + REAL*8 :: temp177b0 REAL*8 :: temp182 - DOUBLE PRECISION :: temp263 - REAL*8 :: temp302b0 - REAL*8 :: temp322b22 + REAL*8 :: temp197b22 + REAL*8 :: temp206b30 + REAL*8 :: temp221b0 + REAL*8 :: temp224b12 + REAL*8 :: temp253b5 + REAL*8 :: temp253b56 + REAL*8 :: temp263 + REAL*8 :: temp292b + REAL*8 :: temp335b28 + REAL*8 :: temp339b0 REAL*8 :: temp344 - REAL*8 :: temp373b - REAL*8 :: temp373b2 - REAL*8 :: temp373b26 - REAL*8 :: temp379b75 - REAL*8 :: temp380b73 - REAL*8 :: temp388b6 - REAL*8 :: temp388b66 - REAL*8 :: temp390b3 - REAL*8 :: temp425 - REAL*8 :: temp454b - REAL*8 :: temp486b7 - REAL*8 :: temp496b39 + DOUBLE PRECISION :: temp356b1 + DOUBLE PRECISION :: temp425 + REAL*8 :: temp432b6 + REAL*8 :: temp448b41 + REAL*8 :: temp448b78 REAL*8 :: temp506 - REAL*8 :: temp4b DOUBLE PRECISION :: temp6 - REAL*8 :: temp42b6 - REAL*8 :: temp55b - REAL*8 :: temp68b46 + REAL*8 :: temp8b22 REAL*8 :: temp129b - REAL*8 :: temp138b2 - DOUBLE PRECISION :: temp181 - DOUBLE PRECISION :: temp262 + REAL*8 :: temp131b14 + REAL*8 :: temp135b29 + REAL*8 :: temp155b3 + REAL*8 :: temp172b4 + REAL*8 :: temp181 + REAL*8 :: temp197b21 + REAL*8 :: temp224b11 + REAL*8 :: temp253b4 + REAL*8 :: temp253b55 + REAL*8 :: temp262 REAL*8 :: temp299 - REAL*8 :: temp322b21 - REAL*8 :: temp343 - REAL*8 :: temp373b1 - REAL*8 :: temp373b25 - REAL*8 :: temp379b74 - REAL*8 :: temp380b72 - REAL*8 :: temp388b5 - REAL*8 :: temp388b65 - REAL*8 :: temp390b2 - REAL*8 :: temp424 - REAL*8 :: temp437b0 + REAL*8 :: temp335b27 + DOUBLE PRECISION :: temp343 + DOUBLE PRECISION :: temp356b0 + REAL*8 :: temp381b + REAL*8 :: temp400b0 + DOUBLE PRECISION :: temp424 + REAL*8 :: temp432b5 + REAL*8 :: temp448b40 + REAL*8 :: temp448b77 REAL*8 :: temp462b - REAL*8 :: temp486b6 - REAL*8 :: temp496b38 REAL*8 :: temp499b - INTEGER :: temp505 + REAL*8 :: temp505 DOUBLE PRECISION :: temp5 - REAL*8 :: temp42b5 - REAL*8 :: temp57b9 - REAL*8 :: temp63b - REAL*8 :: temp68b45 + REAL*8 :: temp8b21 + DOUBLE PRECISION :: temp8b58 REAL*8 :: temp100b - REAL*8 :: temp138b1 - DOUBLE PRECISION :: temp180 - REAL*8 :: temp218b - REAL*8 :: temp219b1 - REAL*8 :: temp261 + REAL*8 :: temp131b13 + REAL*8 :: temp135b28 + REAL*8 :: temp137b + REAL*8 :: temp155b2 + REAL*8 :: temp172b3 + REAL*8 :: temp180 + REAL*8 :: temp197b20 + REAL*8 :: temp197b57 + REAL*8 :: temp224b10 + REAL*8 :: temp253b3 + REAL*8 :: temp253b54 + DOUBLE PRECISION :: temp261 REAL*8 :: temp298 - REAL*8 :: temp322b20 + REAL*8 :: temp335b26 + REAL*8 :: temp340b39 REAL*8 :: temp342 - REAL*8 :: temp373b0 - REAL*8 :: temp373b24 - REAL*8 :: temp379b73 - REAL*8 :: temp379 - REAL*8 :: temp380b71 - REAL*8 :: temp388b4 - REAL*8 :: temp388b64 - REAL*8 :: temp390b1 - REAL*8 :: temp404b29 - REAL*8 :: temp423 - REAL*8 :: temp454b0 - REAL*8 :: temp470b - REAL*8 :: temp486b5 - REAL*8 :: temp496b37 + DOUBLE PRECISION :: temp379 + DOUBLE PRECISION :: temp423 + REAL*8 :: temp432b4 + REAL*8 :: temp448b76 REAL*8 :: temp504 - REAL*8 :: temp4 - REAL*8 :: temp42b4 - REAL*8 :: temp57b8 - REAL*8 :: temp57b19 - REAL*8 :: temp68b44 - REAL*8 :: temp71b - REAL*8 :: temp138b0 - REAL*8 :: temp145b - REAL*8 :: temp219b0 - DOUBLE PRECISION :: temp260 + DOUBLE PRECISION :: temp4 + REAL*8 :: temp8b20 + DOUBLE PRECISION :: temp8b57 + REAL*8 :: temp131b12 + REAL*8 :: temp131b49 + REAL*8 :: temp135b27 + REAL*8 :: temp155b1 + REAL*8 :: temp172b2 + REAL*8 :: temp197b56 + REAL*8 :: temp226b + REAL*8 :: temp253b2 + REAL*8 :: temp253b53 + REAL*8 :: temp260 REAL*8 :: temp297 + REAL*8 :: temp335b25 + REAL*8 :: temp340b38 REAL*8 :: temp341 - REAL*8 :: temp373b23 - REAL*8 :: temp378 - REAL*8 :: temp379b72 - REAL*8 :: temp380b70 - REAL*8 :: temp386b29 - REAL*8 :: temp388b3 - REAL*8 :: temp388b63 - REAL*8 :: temp390b0 - REAL*8 :: temp404b28 - REAL*8 :: temp422 + DOUBLE PRECISION :: temp378 + DOUBLE PRECISION :: temp422 + REAL*8 :: temp432b3 + REAL*8 :: temp448b75 REAL*8 :: temp459 - REAL*8 :: temp471b0 - REAL*8 :: temp486b4 - REAL*8 :: temp496b36 REAL*8 :: temp503 - REAL*8 :: temp513b3 ! -! indorb are the number of orbitals occupied before calling -! this subroutine +! indorb are the number of orbitals occupied before calling +! this subroutine ! -! indpar is the number of variational parameters used -! before calling this subroutine +! indpar is the number of variational parameters used +! before calling this subroutine ! -! indshell is the index of the last occupied orbital -! in the shell, characterized by occupation number iocc(indshell) +! indshell is the index of the last occupied orbital +! in the shell, characterized by occupation number iocc(indshell) ! -! z(i,indt+4) contains the laplacian of the orbital i -! z(i,indt+mu) contains the gradient of the orbital i (mu=1,2,3) -! In the following given a radial part of the orbital f(r) -! fun=1/r d f(r)/d r -! fun2= d^2 f(r)/dr^2 +! z(i,indt+4) contains the laplacian of the orbital i +! z(i,indt+mu) contains the gradient of the orbital i (mu=1,2,3) +! In the following given a radial part of the orbital f(r) +! fun=1/r d f(r)/d r +!print *,"minicode/src/c_adjoint_forward/makefun.f90" +!print *,'makefun: iopt=',iopt +!print *,'makefun: i=',0,' a=',0,' b=',0 +!print *,'makefun: indpar=',indpar,' indorb=',indorb,' indshell=',indshell +!print *,'makefun: nelskip=',nelskip adi4ibuf=1 adr8ibuf=1 SELECT CASE (iopt) - CASE (80) -! Cyrus basis -! R(r)=exp(-z*r**2) single zeta -! if(iocc(indshellp).eq.1) then + CASE (105) +! 2s double gaussian without constant +! (exp (-dd2 r^2)+dd4*exp(-dd5*r^2)) +! dd1=1.d0 + dd2 = dd(indpar+1) +! dd3=dd(indpar+2) +! dd4=dd(indpar+3) +! dd5=dd(indpar+4) + dd4 = dd(indpar+2) + dd5 = dd(indpar+3) indorbp = indorb + 1 - dd1 = dd(indpar+1) - dd2 = DSQRT(dd1) -! if(iflagnorm.gt.2) then -! c=(2.d0*dd1/pi)**(3.d0/4.d0)*ratiocs -! ratiocs--> ratiocs*(2/pi)**3/4 - c = dd1**0.75d0*ratiocs -! endif DO k=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) + distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) + distp(k, 2) = DEXP(-(dd5*r(k)*r(k))) END DO +! write(6,*) ' function inside = ',z(indorbp,i) +! endif IF (typec .NE. 1) THEN -! the first derivative /r - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) -! the second derivative - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp2 = rp3**2 - temp1b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& -& temp2 - temp1 = dd1*distp(0, 1)/temp2 - temp1b0 = temp1*fun2b - rp1b = (2*rp1+4.d0*rp2+4.d0)*temp1b0 - temp0b0 = -(distp(0, 1)*(rp2+2.d0)*funb/rp3) - dd1b = temp0b0 + r(0)**2*rp1b + distp(0, 1)*temp1b - temp0 = dd1/rp3 - distpb(0, 1) = dd1*temp1b - temp0*(rp2+2.d0)*funb - rp3b = -(temp0*temp0b0) - temp1*2*rp3*temp1b - rp2b = 2*(rp2+1.d0)*rp3b - temp0*distp(0, 1)*funb + (4.d0*rp1-2.d0& -& )*temp1b0 - dd2b = r(0)*rp2b - rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b - ELSE + fun = -(2.d0*(dd2*distp(0, 1)+dd5*dd4*distp(0, 2))) + fun2 = r(0)**2 distpb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 - END IF - DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - cb = 0.0_8 - DO k=0,0,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) - distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp = dd2*r(k) + 1.d0 - temp0b = costb/temp - tempb = -(dd1*r(k)**2*temp0b/temp) - dd1b = dd1b + r(k)**2*temp0b - rb(k) = rb(k) + dd2*tempb + dd1*2*r(k)*temp0b - dd2b = dd2b + r(k)*tempb - END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocs*0.75d0*dd1**(-0.25D0)*cb - ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocs*0.75d0*dd1**(& -& -0.25D0)*cb - END IF - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (81) -! derivative of bump gaussian -! R(r)=c*exp(-z*r**2)*(3/4/z-r**2) -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) - dd2 = DSQRT(dd1) -! c=(2.d0*dd1/pi)**(3.d0/4.d0)*ratiocs - c = dd1**0.75d0*ratiocs - DO k=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) - END DO - DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*dd2*r(i))/(1.d0+dd2*r(i))**2 - END DO - IF (typec .NE. 1) THEN -! the first derivative /r - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - fun = 0.25d0*distp(0, 1)*(-14.d0-29.d0*rp2-12.d0*rp1+3.d0*rp1*rp2+& -& 2.d0*rp1**2)/rp3**2 -! the second derivative - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) + tempb2 = 2.d0*zb(indorbp, indt+4) + tempb3 = dd2*distp(0, 1)*2.d0*tempb2 + tempb4 = (2.d0*(dd2*fun2)-3.d0)*tempb2 + tempb5 = (2.d0*(dd5*fun2)-3.d0)*tempb2 + tempb6 = dd5*dd4*distp(0, 2)*2.d0*tempb2 + dd2b = distp(0, 1)*tempb4 + fun2*tempb3 + fun2b = dd5*tempb6 + dd2*tempb3 + distpb(0, 1) = dd2*tempb4 + dd5b = fun2*tempb6 + distp(0, 2)*dd4*tempb5 + dd4b = distp(0, 2)*dd5*tempb5 + distpb(0, 2) = dd5*dd4*tempb5 zb(indorbp, indt+4) = 0.0_8 + funb0 = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO - distpb = 0.0_8 - temp11 = rp3**3 - temp9 = distp(0, 1)/temp11 - temp10 = rp1**3 - temp10b = 0.25d0*temp9*fun2b - temp9b = 0.25d0*(34.d0*rp1-30.d0*rp2+118.d0*(rp1*rp2)+87.d0*rp1**2& -& +18.d0*(rp1**2*rp2)-5.d0*rp1**3-2.d0*(temp10*rp2)-14.d0)*fun2b/& -& temp11 - temp8 = rp3**2 - temp7 = distp(0, 1)/temp8 - temp8b = 0.25d0*temp7*funb - rp1b = (2.d0*2*rp1+3.d0*rp2-12.d0)*temp8b + (18.d0*rp2*2*rp1-5.d0*& -& 3*rp1**2-2.d0*rp2*3*rp1**2+87.d0*2*rp1+118.d0*rp2+34.d0)*temp10b - temp7b = 0.25d0*(3.d0*(rp1*rp2)-12.d0*rp1-29.d0*rp2+2.d0*rp1**2-& -& 14.d0)*funb/temp8 - rp3b = -(temp7*2*rp3*temp7b) - temp9*3*rp3**2*temp9b - rp2b = (3.d0*rp1-29.d0)*temp8b + 2*(rp2+1.d0)*rp3b + (18.d0*rp1**2& -& -2.d0*temp10+118.d0*rp1-30.d0)*temp10b - distpb(0, 1) = temp7b + temp9b - dd2b = r(0)*rp2b - rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b - dd1b = r(0)**2*rp1b + rb(0) = rb(0) + 2*r(0)*fun2b + tempb1 = -(2.d0*funb0) + dd2b = dd2b + distp(0, 1)*tempb1 + distpb(0, 1) = distpb(0, 1) + dd2*tempb1 + dd5b = dd5b + distp(0, 2)*dd4*tempb1 + dd4b = dd4b + distp(0, 2)*dd5*tempb1 + distpb(0, 2) = distpb(0, 2) + dd5*dd4*tempb1 ELSE distpb = 0.0_8 - dd1b = 0.0_8 dd2b = 0.0_8 + dd4b = 0.0_8 + dd5b = 0.0_8 END IF DO i=0,0,-1 - temp6 = 4.d0*dd1 - temp5 = 3.d0/temp6 - temp5b = distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + (temp5-r(i)**2*cost)*zb(indorbp, i) - dd1b = dd1b - temp5*4.d0*temp5b/temp6 - costb = -(r(i)**2*temp5b) - temp4 = dd2*r(i) + 1.d0 - temp5b0 = costb/temp4**2 - temp4b0 = -((0.5d0*(dd2*r(i))+1.d0)*2*temp5b0/temp4) - rb(i) = rb(i) + 0.5d0*dd2*temp5b0 + dd2*temp4b0 - cost*2*r(i)*& -& temp5b + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd4b = dd4b + distp(i, 2)*zb(indorbp, i) + distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) zb(indorbp, i) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = dd2b + r(i)*temp4b0 + 0.5d0*r(i)*temp5b0 END DO - cb = 0.0_8 DO k=0,0,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) + tempb = DEXP(-(dd5*r(k)**2))*distpb(k, 2) + dd5b = dd5b - r(k)**2*tempb + distpb(k, 2) = 0.0_8 + tempb0 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + rb(k) = rb(k) - dd2*2*r(k)*tempb0 - dd5*2*r(k)*tempb + dd2b = dd2b - r(k)**2*tempb0 distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp3 = dd2*r(k) + 1.d0 - temp4b = costb/temp3 - temp3b = -(dd1*r(k)**2*temp4b/temp3) - dd1b = dd1b + r(k)**2*temp4b - rb(k) = rb(k) + dd2*temp3b + dd1*2*r(k)*temp4b - dd2b = dd2b + r(k)*temp3b END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocs*0.75d0*dd1**(-0.25D0)*cb - ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocs*0.75d0*dd1**(& -& -0.25D0)*cb - END IF - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (82) + ddb(indpar+3) = ddb(indpar+3) + dd5b + ddb(indpar+2) = ddb(indpar+2) + dd4b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (40) +! 3p without cusp condition derivative of 20 +! r e^{-z1 r } dd1 = dd(indpar+1) - dd2 = DSQRT(dd1) ! if(iflagnorm.gt.2) then -! ratiocp--> ratiocp*dsqrt(2.d0)*pi**(-0.75d0)*2**1.25 -! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0*ratiocp - c = dd1**1.25d0*ratiocp +! c=dsqrt((2.d0*dd1)**5/8.d0/pi)/2.d0 + c = dd1**2.5d0*0.5641895835477562d0 ! endif + c0 = -c + c1 = 2.5d0*c/dd1 +! DO k=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) + distp(k, 1) = DEXP(-(dd1*r(k))) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(k, 2)) + distp(k, 2) = r(k)*distp(k, 1) END DO +! ! indorbp=indorb ! DO ic=1,3 @@ -2676,20 +2655,17 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd indorbp = indorb + ic END DO ! endif +! +! IF (typec .NE. 1) THEN -! fun=-2.d0*dd1*distp(0,1) -! fun2=fun*(1.d0-2.d0*dd1*r(0)**2) - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) -! the second derivative - fun2 = dd1*distp(0, 1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**& -& 2)/rp3**2 + fun = (c0*(1.d0-dd1*r(0))-c1*dd1)*distp(0, 1) + fun2 = (c0*dd1*(dd1*r(0)-2.d0)+c1*dd1**2)*distp(0, 1) +! ! indorbp=indorb +! DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -2699,501 +2675,642 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp16b0 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp16b0 - fun2b = fun2b + temp16b0 + temp1 = fun/r(0) + temp2b = rmu(ic, 0)*zb(indorbp, indt+4) + temp1b = 4.d0*temp2b/r(0) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp1+fun2)*zb(indorbp, indt+4& +& ) + funb0 = funb0 + temp1b + rb(0) = rb(0) - temp1*temp1b + fun2b = fun2b + temp2b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp16b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp16b - funb = funb + rmu(ic, 0)*temp16b - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + temp0 = fun/r(0) + temp0b0 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(ic, 0) = rmub(ic, 0) + temp0*rmu(i, 0)*zb(indorbp, indt+i& +& ) + rmub(i, 0) = rmub(i, 0) + temp0*rmu(ic, 0)*zb(indorbp, indt+i) + funb0 = funb0 + temp0b0 + rb(0) = rb(0) - temp0*temp0b0 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp15 = rp3**2 - temp14b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& -& temp15 - temp14 = dd1*distp(0, 1)/temp15 - temp14b0 = temp14*fun2b - rp1b = (2*rp1+4.d0*rp2+4.d0)*temp14b0 - temp13b0 = -(distp(0, 1)*(rp2+2.d0)*funb/rp3) - dd1b = temp13b0 + r(0)**2*rp1b + distp(0, 1)*temp14b - temp13 = dd1/rp3 - distpb(0, 1) = fun0b - temp13*(rp2+2.d0)*funb + dd1*temp14b - rp3b = -(temp13*temp13b0) - temp14*2*rp3*temp14b - rp2b = 2*(rp2+1.d0)*rp3b - temp13*distp(0, 1)*funb + (4.d0*rp1-& -& 2.d0)*temp14b0 - dd2b = r(0)*rp2b - rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b + temp0b = distp(0, 1)*fun2b + temp = dd1*r(0) - 2.d0 + tempb10 = c0*dd1*temp0b + tempb11 = distp(0, 1)*funb0 + c0b = (1.d0-dd1*r(0))*tempb11 + distp(0, 2)*fun0b + temp*dd1*& +& temp0b + dd1b = (-c1-c0*r(0))*tempb11 + r(0)*tempb10 + (c1*2*dd1+temp*c0)*& +& temp0b + rb(0) = rb(0) + dd1*tempb10 - c0*dd1*tempb11 + c1b = distp(0, 1)*fun0b - dd1*tempb11 + dd1**2*temp0b + distpb(0, 1) = (c0*(1.d0-dd1*r(0))-c1*dd1)*funb0 + (c0*dd1*temp+c1& +& *dd1**2)*fun2b + distpb(0, 2) = distpb(0, 2) + c0*fun0b + distpb(0, 1) = distpb(0, 1) + c1*fun0b ELSE distpb = 0.0_8 + c0b = 0.0_8 + c1b = 0.0_8 dd1b = 0.0_8 - dd2b = 0.0_8 END IF DO ic=3,1,-1 DO i=0,0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + tempb9 = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + (c0*distp(i, 2)+c1*distp(i, 1))*zb(& +& indorbp, i) + c0b = c0b + distp(i, 2)*tempb9 + distpb(i, 2) = distpb(i, 2) + c0*tempb9 + c1b = c1b + distp(i, 1)*tempb9 + distpb(i, 1) = distpb(i, 1) + c1*tempb9 zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - cb = 0.0_8 DO k=0,0,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) + CALL POPREAL8(adr8ibuf,adr8buf,distp(k, 2)) + rb(k) = rb(k) + distp(k, 1)*distpb(k, 2) + distpb(k, 1) = distpb(k, 1) + r(k)*distpb(k, 2) + distpb(k, 2) = 0.0_8 + tempb8 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*tempb8 + rb(k) = rb(k) - dd1*tempb8 distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp12 = dd2*r(k) + 1.d0 - temp13b = costb/temp12 - temp12b = -(dd1*r(k)**2*temp13b/temp12) - dd1b = dd1b + r(k)**2*temp13b - rb(k) = rb(k) + dd2*temp12b + dd1*2*r(k)*temp13b - dd2b = dd2b + r(k)*temp12b END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocp*1.25d0*dd1**0.25D0*cb - ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocp*1.25d0*dd1**0.25D0*& -& cb - END IF + tempb7 = 2.5d0*c1b/dd1 + cb = tempb7 - c0b + dd1b = dd1b + 0.5641895835477562d0*2.5d0*dd1**1.5D0*cb - c*tempb7/& +& dd1 ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (83) -! derivative of 36 -! R(r)=x*exp(-z*r**2)*(5/4/z-r**2) - dd1 = dd(indpar+1) - dd2 = DSQRT(dd1) + CASE (52) +! 4p single zeta +! g single gaussian orbital +! derivative of 51 +! R(r)= exp(-alpha r^2) +! normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) ! if(iflagnorm.gt.2) then -! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0*ratiocp - c = dd1**1.25d0*ratiocp +! overall normalization +! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0) + c = dd1**2.75d0*1.11284691281640568826d0 ! endif DO k=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO -! indorbp=indorb -! - DO ic=1,3 + DO i=0,0 + distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& +& 2+3.d0*r(i)**4) +! lz=0 + distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& +& 2-r(i)**2) +! lz=+/-2 + distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& +& (i)**2) +! lz=+/-2 + distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & +& i)**2) +! lz=+/-3 + distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& +& , i)**2) +! lz=+/-3 + distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& +& rmu(2, i)**4) +! lz=+/-4 + distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& +& , i)**2) + END DO +! lz=+/-4 + DO ic=1,9 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*dd2*r(i))/(1.d0+dd2*r(i))**2 - END DO END DO ! endif IF (typec .NE. 1) THEN - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*rp2)/rp3 - fun = 0.25d0*distp(0, 1)*(-18.d0-39.d0*rp2-20.d0*rp1+rp1*rp2+2.d0*& -& rp1**2)/rp3**2 - fun2 = 0.25d0*distp(0, 1)*(-18.d0-42.d0*rp2+30.d0*rp1+138.d0*rp1*& -& rp2+113.d0*rp1**2+30.d0*rp1**2*rp2-3.d0*rp1**3-2.d0*rp1**3*rp2)/& -& rp3**3 -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp23b0 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp23b0 - fun2b = fun2b + temp23b0 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp23b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp23b - funb = funb + rmu(ic, 0)*temp23b - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - distpb = 0.0_8 - temp22 = rp3**3 - temp20 = distp(0, 1)/temp22 - temp21 = rp1**3 - temp21b = 0.25d0*temp20*fun2b - temp20b = 0.25d0*(30.d0*rp1-42.d0*rp2+138.d0*(rp1*rp2)+113.d0*rp1& -& **2+30.d0*(rp1**2*rp2)-3.d0*rp1**3-2.d0*(temp21*rp2)-18.d0)*& -& fun2b/temp22 - temp19 = rp3**2 - temp18 = distp(0, 1)/temp19 - temp19b = 0.25d0*temp18*funb - rp1b = (2.d0*2*rp1+rp2-20.d0)*temp19b + (30.d0*rp2*2*rp1-3.d0*3*& -& rp1**2-2.d0*rp2*3*rp1**2+113.d0*2*rp1+138.d0*rp2+30.d0)*temp21b - temp18b2 = 0.25d0*(rp1*rp2-20.d0*rp1-39.d0*rp2+2.d0*rp1**2-18.d0)*& -& funb/temp19 - temp18b3 = distp(0, 1)*fun0b - costb = -(r(0)**2*temp18b3) - rp3b = -(temp18*2*rp3*temp18b2) - (0.5d0*rp2+1.d0)*costb/rp3**2 - & -& temp20*3*rp3**2*temp20b - rp2b = (rp1-39.d0)*temp19b + 2*(rp2+1.d0)*rp3b + 0.5d0*costb/rp3 +& -& (30.d0*rp1**2-2.d0*temp21+138.d0*rp1-42.d0)*temp21b - distpb(0, 1) = temp18b2 + (1.25d0/dd1-r(0)**2*cost)*fun0b + & -& temp20b - dd1b = r(0)**2*rp1b - 1.25d0*temp18b3/dd1**2 - rb(0) = rb(0) + dd2*rp2b + dd1*2*r(0)*rp1b - cost*2*r(0)*temp18b3 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = r(0)*rp2b - ELSE - distpb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 - END IF - DO ic=3,1,-1 - DO i=0,0,-1 - temp18b = (1.25d0/dd1-r(i)**2*cost)*zb(indorbp, i) - temp18b0 = rmu(ic, i)*distp(i, 1)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp18b - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp18b - dd1b = dd1b - 1.25d0*temp18b0/dd1**2 - costb = -(r(i)**2*temp18b0) - temp17 = dd2*r(i) + 1.d0 - temp18b1 = costb/temp17**2 - temp17b0 = -((0.5d0*(dd2*r(i))+1.d0)*2*temp18b1/temp17) - rb(i) = rb(i) + 0.5d0*dd2*temp18b1 + dd2*temp17b0 - cost*2*r(i)*& -& temp18b0 - zb(indorbp, i) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = dd2b + r(i)*temp17b0 + 0.5d0*r(i)*temp18b1 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - cb = 0.0_8 - DO k=0,0,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) - distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp16 = dd2*r(k) + 1.d0 - temp17b = costb/temp16 - temp16b1 = -(dd1*r(k)**2*temp17b/temp16) - dd1b = dd1b + r(k)**2*temp17b - rb(k) = rb(k) + dd2*temp16b1 + dd1*2*r(k)*temp17b - dd2b = dd2b + r(k)*temp16b1 - END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocp*1.25d0*dd1**0.25D0*cb - ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocp*1.25d0*dd1**0.25D0*& -& cb - END IF - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (84) -! d orbitals -! R(r)= exp(-alpha r^2) -! each gaussian term is normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) - dd2 = DSQRT(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)*ratiocd - c = ratiocd*dd1**1.75d0 -! endif - DO k=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) - END DO - DO i=0,0 -! lz=0 - distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d -! lz=+/-2 - distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d -! lz=+/-2 - distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d -! lz=+/-1 - distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d -! lz=+/-1 - distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d - END DO - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun0 = distp(0, 1) - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) -! the second derivative - fun2 = dd1*distp(0, 1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**& -& 2)/rp3**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1)*(11.d0/4.d0/dd1-r(0)**2) + fun = distp(0, 1)*(2.d0*dd1*r(0)**2-15.d0/2.d0) + fun2 = distp(0, 1)*(-(4.d0*dd1**2*r(0)**4)+21.d0*dd1*r(0)**2-15.d0& +& /2.d0) ! indorbp=indorb - DO ic=1,5 + DO ic=1,9 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN + IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) END IF ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) END IF ELSE IF (ic .EQ. 3) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) END IF ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + END IF + ELSE IF (ic .EQ. 6) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + END IF + ELSE IF (ic .EQ. 7) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,21) + END IF + ELSE IF (ic .EQ. 8) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,22) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,24) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,23) + END IF + ELSE IF (ic .EQ. 9) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,26) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,28) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,27) END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,25) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp27b4 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 6.d0*temp27b4 - fun2b = fun2b + temp27b4 + DO ic=9,1,-1 + temp8b55 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 10.d0*temp8b55 + fun2b = fun2b + temp8b55 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp27b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp27b0 - fun0b = fun0b + rmu(i, 0)*temp27b0 + IF (branch .LT. 15) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp8b0 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& +& 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& +& ) + rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& +& , 0)**2)*temp8b0 + rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp8b0 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& +& )*temp8b0 + ELSE + temp8b1 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& +& 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& +& ) + rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& +& , 0)**2)*temp8b1 + rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp8b1 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& +& )*temp8b1 + END IF + ELSE IF (branch .LT. 4) THEN + temp8b2 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& +& 3, 0)*r(0)**2))*zb(indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& +& r(0)**2)*temp8b2 + rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp8b2 + ELSE + temp8b3 = cost2g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& +& , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& +& (indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& +& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp8b3 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp8b3 + rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp8b3 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp8b4 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp8b5 = rmu(2, 0)*rmu(3, 0)*temp8b4 + temp8b6 = fun0*rmu(1, 0)*temp8b4 + fun0b = fun0b + rmu(1, 0)*temp8b5 + rmub(1, 0) = rmub(1, 0) + fun0*temp8b5 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp8b6 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp8b6 ELSE - temp27b1 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp27b1 - fun0b = fun0b + rmu(i, 0)*temp27b1 + temp8b7 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp8b8 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**2& +& )*temp8b7 + temp8b9 = fun0*rmu(1, 0)*temp8b7 + fun0b = fun0b + rmu(1, 0)*temp8b8 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp8b9 + fun0*& +& temp8b8 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp8b9 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp8b9 END IF - ELSE IF (branch .LT. 4) THEN - temp27b2 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp27b2 - fun0b = fun0b + rmu(i, 0)*temp27b2 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp27b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp27b3 - fun0b = fun0b + rmu(i, 0)*temp27b3 ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + temp8b10 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp8b11 = rmu(2, 0)*rmu(3, 0)*temp8b10 + temp8b12 = fun0*rmu(1, 0)*temp8b10 + fun0b = fun0b + rmu(1, 0)*temp8b11 + rmub(1, 0) = rmub(1, 0) + fun0*temp8b11 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp8b12 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp8b12 END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN + ELSE IF (branch .LT. 12) THEN IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + IF (branch .LT. 9) THEN + temp8b13 = cost2g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& +& , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& +& (indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& +& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp8b13 + rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp8b13 + rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp8b13 + ELSE + temp8b14 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp8b15 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**& +& 2)*temp8b14 + temp8b16 = fun0*rmu(2, 0)*temp8b14 + fun0b = fun0b + rmu(2, 0)*temp8b15 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp8b16 + fun0*& +& temp8b15 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp8b16 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp8b16 + END IF + ELSE IF (branch .LT. 11) THEN + temp8b17 = -(cost3g*4.d0*zb(indorbp, indt+i)) + temp8b18 = fun0*temp8b17 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& +& **2))*temp8b17 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& +& **2)*temp8b18 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& +& temp8b18 + ELSE + temp8b19 = cost3g*4.d0*zb(indorbp, indt+i) + temp8b20 = fun0*temp8b19 + fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& +& **2))*temp8b19 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& +& **2)*temp8b20 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& +& temp8b20 END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 14) THEN + IF (branch .LT. 13) THEN + temp8b21 = cost3g*12.d0*zb(indorbp, indt+i) + temp8b22 = fun0*rmu(3, 0)*temp8b21 + temp8b23 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp8b21 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp8b22 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp8b22 + fun0b = fun0b + rmu(3, 0)*temp8b23 + rmub(3, 0) = rmub(3, 0) + fun0*temp8b23 + ELSE + temp8b24 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp8b25 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3, 0& +& )**2)*temp8b24 + temp8b26 = fun0*rmu(2, 0)*temp8b24 + fun0b = fun0b + rmu(2, 0)*temp8b25 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp8b26 + fun0*& +& temp8b25 + rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp8b26 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp8b26 + END IF + ELSE + temp8b27 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp8b28 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0)& +& **2)*temp8b27 + temp8b29 = fun0*rmu(1, 0)*temp8b27 + fun0b = fun0b + rmu(1, 0)*temp8b28 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp8b29 + fun0*& +& temp8b28 + rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp8b29 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp8b29 END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 22) THEN + IF (branch .LT. 19) THEN + IF (branch .LT. 17) THEN + IF (branch .LT. 16) THEN + temp8b30 = cost3g*24.d0*zb(indorbp, indt+i) + temp8b31 = rmu(2, 0)*rmu(3, 0)*temp8b30 + temp8b32 = fun0*rmu(1, 0)*temp8b30 + fun0b = fun0b + rmu(1, 0)*temp8b31 + rmub(1, 0) = rmub(1, 0) + fun0*temp8b31 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp8b32 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp8b32 + ELSE + temp8b33 = cost4g*3.d0*zb(indorbp, indt+i) + temp8b34 = fun0*rmu(3, 0)*temp8b33 + temp8b35 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp8b33 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp8b34 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp8b34 + fun0b = fun0b + rmu(3, 0)*temp8b35 + rmub(3, 0) = rmub(3, 0) + fun0*temp8b35 + END IF + ELSE IF (branch .LT. 18) THEN + temp8b36 = -(cost4g*6.d0*zb(indorbp, indt+i)) + temp8b37 = rmu(2, 0)*rmu(3, 0)*temp8b36 + temp8b38 = fun0*rmu(1, 0)*temp8b36 + fun0b = fun0b + rmu(1, 0)*temp8b37 + rmub(1, 0) = rmub(1, 0) + fun0*temp8b37 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp8b38 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp8b38 + ELSE + temp8b39 = cost4g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& +& (2, 0)**2))*zb(indorbp, indt+i) + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& +& **2)*temp8b39 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp8b39 + END IF + ELSE IF (branch .LT. 21) THEN + IF (branch .LT. 20) THEN + temp8b40 = cost4g*6.d0*zb(indorbp, indt+i) + temp8b41 = rmu(2, 0)*rmu(3, 0)*temp8b40 + temp8b42 = fun0*rmu(1, 0)*temp8b40 + fun0b = fun0b + rmu(1, 0)*temp8b41 + rmub(1, 0) = rmub(1, 0) + fun0*temp8b41 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp8b42 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp8b42 + ELSE + temp8b43 = cost4g*3.d0*zb(indorbp, indt+i) + temp8b44 = fun0*rmu(3, 0)*temp8b43 + temp8b45 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp8b43 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp8b44 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp8b44 + fun0b = fun0b + rmu(3, 0)*temp8b45 + rmub(3, 0) = rmub(3, 0) + fun0*temp8b45 + END IF + ELSE + temp8b46 = cost4g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& +& 2, 0)**3)*zb(indorbp, indt+i) + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp8b46 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& +& 2)*temp8b46 + END IF + ELSE IF (branch .LT. 26) THEN + IF (branch .LT. 24) THEN + IF (branch .LT. 23) THEN + temp8b47 = cost5g*4.d0*zb(indorbp, indt+i) + temp8b48 = fun0*temp8b47 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& +& **2))*temp8b47 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& +& **2)*temp8b48 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp8b48 + END IF + ELSE IF (branch .LT. 25) THEN + temp8b49 = cost5g*4.d0*zb(indorbp, indt+i) + temp8b50 = fun0*temp8b49 + fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& +& ))*temp8b49 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& +& 2)*temp8b50 + rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp8b50 + END IF + ELSE IF (branch .LT. 28) THEN + IF (branch .LT. 27) THEN + temp8b51 = cost5g*4.d0*zb(indorbp, indt+i) + temp8b52 = fun0*temp8b51 + fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& +& 3)*temp8b51 + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp8b52 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& +& 2)*temp8b52 END IF ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + temp8b53 = cost5g*4.d0*zb(indorbp, indt+i) + temp8b54 = fun0*temp8b53 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& +& *temp8b53 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& +& *temp8b54 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp8b54 END IF - temp27b = distp(0, 1+ic)*zb(indorbp, indt+i) + temp8b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp27b - funb = funb + rmu(i, 0)*temp27b + rmub(i, 0) = rmub(i, 0) + fun*temp8b + funb0 = funb0 + rmu(i, 0)*temp8b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp26 = rp3**2 - temp25b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& -& temp26 - temp25 = dd1*distp(0, 1)/temp26 - temp25b0 = temp25*fun2b - rp1b = (2*rp1+4.d0*rp2+4.d0)*temp25b0 - temp24b0 = -(distp(0, 1)*(rp2+2.d0)*funb/rp3) - dd1b = temp24b0 + r(0)**2*rp1b + distp(0, 1)*temp25b - temp24 = dd1/rp3 - distpb(0, 1) = distpb(0, 1) + fun0b - temp24*(rp2+2.d0)*funb + dd1& -& *temp25b - rp3b = -(temp24*temp24b0) - temp25*2*rp3*temp25b - rp2b = 2*(rp2+1.d0)*rp3b - temp24*distp(0, 1)*funb + (4.d0*rp1-& -& 2.d0)*temp25b0 - dd2b = r(0)*rp2b - rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b + temp7 = r(0)**4 + temp7b = distp(0, 1)*fun2b + temp6 = 4.d0*dd1 + temp5 = 11.d0/temp6 + distpb(0, 1) = distpb(0, 1) + (2.d0*(dd1*r(0)**2)-15.d0/2.d0)*& +& funb0 + (temp5-r(0)**2)*fun0b + (21.d0*(dd1*r(0)**2)-15.d0/2.d0-& +& 4.d0*(dd1**2*temp7))*fun2b + temp7b0 = distp(0, 1)*2.d0*funb0 + dd1b = r(0)**2*temp7b0 - distp(0, 1)*temp5*4.d0*fun0b/temp6 + (& +& 21.d0*r(0)**2-4.d0*temp7*2*dd1)*temp7b + rb(0) = rb(0) + dd1*2*r(0)*temp7b0 - distp(0, 1)*2*r(0)*fun0b + (& +& 21.d0*dd1*2*r(0)-4.d0*dd1**2*4*r(0)**3)*temp7b + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 END IF - DO ic=5,1,-1 + dd1b = 0.0_8 + DO ic=9,1,-1 DO k=0,0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + temp5b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) + temp4 = 4.d0*dd1 + temp3 = 11.d0/temp4 + temp3b17 = (temp3-r(k)**2)*zb(indorbp, k) + dd1b = dd1b - temp3*4.d0*temp5b/temp4 + rb(k) = rb(k) - 2*r(k)*temp5b + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp3b17 + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp3b17 zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) + temp3b = cost5g*4.d0*distpb(i, 10) + temp3b0 = (rmu(1, i)**2-rmu(2, i)**2)*temp3b + temp3b1 = rmu(1, i)*rmu(2, i)*temp3b + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp3b1 + rmu(2, i)*temp3b0 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp3b0 - 2*rmu(2, i)*temp3b1 + distpb(i, 10) = 0.0_8 + temp3b2 = cost5g*distpb(i, 9) + rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& +& 1, i))*temp3b2 + distpb(i, 9) = 0.0_8 + temp3b3 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) + temp3b4 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp3b3 - 2*rmu(2, i)*temp3b4 & +& + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*temp3b2 + rmub(3, i) = rmub(3, i) + rmu(2, i)*temp3b3 + distpb(i, 8) = 0.0_8 + temp3b5 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) + temp3b6 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp3b5 + 2*rmu(1, i)*temp3b6 & +& + 3.d0*2*rmu(1, i)*temp3b4 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp3b5 + rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp3b6 + distpb(i, 7) = 0.0_8 + temp3b7 = cost3g*2.d0*distpb(i, 6) + temp3b8 = (7.d0*rmu(3, i)**2-r(i)**2)*temp3b7 + temp3b9 = rmu(1, i)*rmu(2, i)*temp3b7 + rmub(1, i) = rmub(1, i) + rmu(2, i)*temp3b8 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp3b8 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp3b9 distpb(i, 6) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) + temp3b10 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) + temp3b11 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) distpb(i, 5) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) + temp3b12 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) + temp3b13 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) + temp3b14 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) + temp3b15 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) + temp3b16 = cost1g*distpb(i, 2) + rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& +& temp3b16 - 3.d0*2*r(i)*temp3b15 - 2*r(i)*temp3b11 - 3.d0*2*r(i)*& +& temp3b13 - 2*r(i)*temp3b9 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp3b10 + rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp3b10 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp3b11 + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp3b12 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp3b13 + rmu(2, i)*& +& temp3b12 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp3b14 + rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& +& rmu(3, i))*temp3b16 + 7.d0*2*rmu(3, i)*temp3b15 + rmu(1, i)*& +& temp3b14 distpb(i, 2) = 0.0_8 END DO cb = 0.0_8 DO k=0,0,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) + temp2 = r(k)**2 + temp2b0 = c*DEXP(-(dd1*temp2))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp2))*distpb(k, 1) + dd1b = dd1b - temp2*temp2b0 + rb(k) = rb(k) - dd1*2*r(k)*temp2b0 distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp23 = dd2*r(k) + 1.d0 - temp24b = costb/temp23 - temp23b1 = -(dd1*r(k)**2*temp24b/temp23) - dd1b = dd1b + r(k)**2*temp24b - rb(k) = rb(k) + dd2*temp23b1 + dd1*2*r(k)*temp24b - dd2b = dd2b + r(k)*temp23b1 END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocd*1.75d0*dd1**0.75D0*cb - ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocd*1.75d0*dd1**0.75D0*& -& cb - END IF + dd1b = dd1b + 1.11284691281640568826d0*2.75d0*dd1**1.75D0*cb ddb(indparp) = ddb(indparp) + dd1b - CASE (85) -! derivative of 37 with respect to z -! d orbitals -! R(r)= c*exp(-z r^2)*(7/4/z-r^2) -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) - dd2 = DSQRT(dd1) + CASE (31) +! 3d without cusp condition double Z + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd(indpar+3) ! if(iflagnorm.gt.2) then -! overall normalization -! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)*ratiocd - c = dd1**1.75d0*ratiocd + c = 1/2.d0*DSQRT(5.d0/pi)/DSQRT(1/dd1**7/128.d0+2*peff/(dd1+dd2)**7+& +& peff**2/dd2**7/128.d0)/DSQRT(720.d0) ! endif DO k=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) + distp(k, 1) = DEXP(-(dd1*r(k))) + distp(k, 2) = DEXP(-(dd2*r(k))) END DO DO i=0,0 -! lz=0 - distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d -! lz=+/-2 - distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d -! lz=+/-2 - distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = c*(distp(i, 1)+peff*distp(i, 2)) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) +!lz=0 + distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) +!lz=+/-2 + distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) +! lz=+/- 2 + distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) ! lz=+/-1 - distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d + distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) ! lz=+/-1 - distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d + distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d END DO +! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - DO k=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 - END DO END DO ! endif IF (typec .NE. 1) THEN - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*rp2)/rp3 - fun0 = distp(0, 1)*(7.d0/4.d0/dd1-r(0)**2*cost) - fun = 0.25d0*distp(0, 1)*(-22.d0-49.d0*rp2-28.d0*rp1-rp1*rp2+2.d0*& -& rp1**2)/rp3**2 - fun2 = -(0.25d0*distp(0, 1)*(22.d0+54.d0*rp2-26.d0*rp1-158.d0*rp1*& -& rp2-139.d0*rp1**2-42.d0*rp1**2*rp2+rp1**3+2.d0*rp1**3*rp2)/rp3**& -& 3) + fun0 = distp(0, 3) + fun = c*(-(dd1*distp(0, 1))-peff*dd2*distp(0, 2)) + fun2 = c*(dd1**2*distp(0, 1)+peff*dd2**2*distp(0, 2)) ! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -3244,15 +3361,18 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=5,1,-1 - temp38b4 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 6.d0*temp38b4 - fun2b = fun2b + temp38b4 + temp16 = fun/r(0) + temp17b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp16b3 = 6.d0*temp17b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp16+fun2)*zb(& +& indorbp, indt+4) + funb0 = funb0 + temp16b3 + rb(0) = rb(0) - temp16*temp16b3 + fun2b = fun2b + temp17b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -3260,24 +3380,24 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN IF (branch .LT. 2) THEN - temp38b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp38b0 - fun0b = fun0b + rmu(i, 0)*temp38b0 + temp16b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp16b + fun0b = fun0b + rmu(i, 0)*temp16b ELSE - temp38b1 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp38b1 - fun0b = fun0b + rmu(i, 0)*temp38b1 + temp16b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp16b0 + fun0b = fun0b + rmu(i, 0)*temp16b0 END IF ELSE IF (branch .LT. 4) THEN - temp38b2 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp38b2 - fun0b = fun0b + rmu(i, 0)*temp38b2 + temp16b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp16b1 + fun0b = fun0b + rmu(i, 0)*temp16b1 END IF ELSE IF (branch .LT. 7) THEN IF (branch .LT. 6) THEN - temp38b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp38b3 - fun0b = fun0b + rmu(i, 0)*temp38b3 + temp16b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp16b2 + fun0b = fun0b + rmu(i, 0)*temp16b2 ELSE rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) @@ -3307,3074 +3427,2014 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp38b = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & + temp15 = fun/r(0) + temp15b5 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp15*rmu(i, 0)*zb(& +& indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp15*distp(0, 3+ic)*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp38b - funb = funb + rmu(i, 0)*temp38b + funb0 = funb0 + temp15b5 + rb(0) = rb(0) - temp15*temp15b5 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp37 = rp3**3 - temp35 = distp(0, 1)/temp37 - temp36 = rp1**3 - temp36b = -(0.25d0*temp35*fun2b) - temp35b = -(0.25d0*(54.d0*rp2-26.d0*rp1-158.d0*(rp1*rp2)-139.d0*& -& rp1**2+rp1**3-42.d0*(rp1**2*rp2)+2.d0*(temp36*rp2)+22.d0)*fun2b/& -& temp37) - temp34 = rp3**2 - temp33 = distp(0, 1)/temp34 - temp33b = 0.25d0*(2.d0*rp1**2-28.d0*rp1-49.d0*rp2-rp1*rp2-22.d0)*& -& funb/temp34 - temp31b0 = distp(0, 1)*fun0b - costb = -(r(0)**2*temp31b0) - rp3b = -(temp33*2*rp3*temp33b) - (0.5d0*rp2+1.d0)*costb/rp3**2 - & -& temp35*3*rp3**2*temp35b - temp34b = 0.25d0*temp33*funb - rp2b = ((-49.d0)-rp1)*temp34b + 2*(rp2+1.d0)*rp3b + 0.5d0*costb/& -& rp3 + (2.d0*temp36-42.d0*rp1**2-158.d0*rp1+54.d0)*temp36b - rp1b = (2.d0*2*rp1-rp2-28.d0)*temp34b + (2.d0*rp2*3*rp1**2-42.d0*& -& rp2*2*rp1+3*rp1**2-139.d0*2*rp1-158.d0*rp2-26.d0)*temp36b - temp32 = 4.d0*dd1 - temp31 = 7.d0/temp32 - distpb(0, 1) = distpb(0, 1) + temp33b + (temp31-r(0)**2*cost)*& -& fun0b + temp35b - dd1b = r(0)**2*rp1b - temp31*4.d0*temp31b0/temp32 - rb(0) = rb(0) + dd2*rp2b + dd1*2*r(0)*rp1b - cost*2*r(0)*temp31b0 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = r(0)*rp2b + temp15b2 = c*fun2b + temp15b3 = dd2**2*temp15b2 + cb = (-(dd1*distp(0, 1))-peff*dd2*distp(0, 2))*funb0 + (dd1**2*& +& distp(0, 1)+dd2**2*(peff*distp(0, 2)))*fun2b + temp15b4 = c*funb0 + dd1b = distp(0, 1)*2*dd1*temp15b2 - distp(0, 1)*temp15b4 + distpb(0, 1) = distpb(0, 1) + dd1**2*temp15b2 + dd2b = peff*distp(0, 2)*2*dd2*temp15b2 - distp(0, 2)*peff*temp15b4 + peffb = distp(0, 2)*temp15b3 - distp(0, 2)*dd2*temp15b4 + distpb(0, 2) = distpb(0, 2) + peff*temp15b3 + distpb(0, 1) = distpb(0, 1) - dd1*temp15b4 + distpb(0, 2) = distpb(0, 2) - peff*dd2*temp15b4 + distpb(0, 3) = distpb(0, 3) + fun0b ELSE distpb = 0.0_8 + peffb = 0.0_8 dd1b = 0.0_8 dd2b = 0.0_8 + cb = 0.0_8 END IF DO ic=5,1,-1 - DO k=0,0,-1 - temp31b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) - temp30 = 4.d0*dd1 - temp29 = 7.d0/temp30 - temp29b = (temp29-r(k)**2*cost)*zb(indorbp, k) - dd1b = dd1b - temp29*4.d0*temp31b/temp30 - costb = -(r(k)**2*temp31b) - temp28 = dd2*r(k) + 1.d0 - temp29b0 = costb/temp28**2 - temp28b0 = -((0.5d0*(dd2*r(k))+1.d0)*2*temp29b0/temp28) - rb(k) = rb(k) + 0.5d0*dd2*temp29b0 + dd2*temp28b0 - cost*2*r(k)*& -& temp31b - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp29b - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp29b - zb(indorbp, k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = dd2b + r(k)*temp28b0 + 0.5d0*r(k)*temp29b0 + DO i=0,0,-1 + distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + distpb(i, 8) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + temp15b1 = c*distpb(i, 3) + cb = cb + (distp(i, 1)+peff*distp(i, 2))*distpb(i, 3) + distpb(i, 1) = distpb(i, 1) + temp15b1 + peffb = peffb + distp(i, 2)*temp15b1 + distpb(i, 2) = distpb(i, 2) + peff*temp15b1 distpb(i, 3) = 0.0_8 - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) - distpb(i, 2) = 0.0_8 END DO - cb = 0.0_8 DO k=0,0,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) + temp15b = DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp15b + distpb(k, 2) = 0.0_8 + temp15b0 = DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp15b0 - dd2*temp15b + dd1b = dd1b - r(k)*temp15b0 distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp27 = dd2*r(k) + 1.d0 - temp28b = costb/temp27 - temp27b5 = -(dd1*r(k)**2*temp28b/temp27) - dd1b = dd1b + r(k)**2*temp28b - rb(k) = rb(k) + dd2*temp27b5 + dd1*2*r(k)*temp28b - dd2b = dd2b + r(k)*temp27b5 END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocd*1.75d0*dd1**0.75D0*cb + temp14 = 128.d0*dd2**7 + temp13 = peff**2/temp14 + temp12 = (dd1+dd2)**7 + temp11 = 128.d0*dd1**7 + temp8 = 1.0/temp11 + 2*(peff/temp12) + temp13 + temp10 = DSQRT(temp8) + temp9 = 2.d0*DSQRT(720.d0) + IF (temp8 .EQ. 0.0) THEN + temp8b56 = 0.0 ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocd*1.75d0*dd1**0.75D0*& -& cb + temp8b56 = -(DSQRT(5.d0/pi)*cb/(temp9*temp10**2*2.D0*DSQRT(temp8))& +& ) END IF - ddb(indparp) = ddb(indparp) + dd1b - CASE (86) -! f single gaussian orbital -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) - dd2 = DSQRT(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0)*ratiocf - c = dd1**2.25d0*ratiocf -! endif - DO k=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) + temp8b57 = 2*temp8b56/temp12 + temp8b58 = -(peff*7*(dd1+dd2)**6*temp8b57/temp12) + dd1b = dd1b + temp8b58 - 128.d0*7*dd1**6*temp8b56/temp11**2 + peffb = peffb + 2*peff*temp8b56/temp14 + temp8b57 + dd2b = dd2b + temp8b58 - temp13*128.d0*7*dd2**6*temp8b56/temp14 + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (113) +! 2s without cusp condition +! dd1*( dd3 +r^2/(1+dd2*r)^4) + dd2 = dd(indpar+1) + indorbp = indorb + 1 +! endif + IF (typec .NE. 1) THEN + fun = (2.d0-2.d0*dd2*r(0))/(1+dd2*r(0))**5 + fun2b = zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + temp20 = (dd2*r(0)+1)**6 + temp20b = 2.d0*fun2b/temp20 + temp20b0 = -((3.d0*(dd2**2*r(0)**2)-6.d0*(dd2*r(0))+1.d0)*6*(dd2*r& +& (0)+1)**5*temp20b/temp20) + temp19 = (dd2*r(0)+1)**5 + temp19b = funb0/temp19 + temp19b0 = -((2.d0-2.d0*(dd2*r(0)))*5*(dd2*r(0)+1)**4*temp19b/& +& temp19) + dd2b = r(0)*temp19b0 - 2.d0*r(0)*temp19b + r(0)*temp20b0 + (3.d0*r& +& (0)**2*2*dd2-6.d0*r(0))*temp20b + rb(0) = rb(0) + dd2*temp19b0 - 2.d0*dd2*temp19b + dd2*temp20b0 + (& +& 3.d0*dd2**2*2*r(0)-6.d0*dd2)*temp20b + ELSE + dd2b = 0.0_8 + END IF + distpb = 0.0_8 + dd3b = 0.0_8 + DO i=0,0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO - DO i=0,0 - distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) -! lz=0 - distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) -! lz=+/-2 - distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) -! lz=+/-2 - distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) -! lz=+/-3 - distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) + DO k=0,0,-1 + temp17 = dd2*r(k) + 1.d0 + temp18 = temp17**4 + temp17b0 = -(r(k)**2*4*temp17**3*distpb(k, 1)/temp18**2) + rb(k) = rb(k) + dd2*temp17b0 + 2*r(k)*distpb(k, 1)/temp18 + dd2b = dd2b + r(k)*temp17b0 + distpb(k, 1) = 0.0_8 END DO -! lz=+/-3 - DO ic=1,7 + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (10000:11000) + distpb = 0.0_8 + CASE (107) +! Reserved for dummy orbitals +! 2p single lorentian parent of 103 + dd2 = dd(indpar+1) + DO k=0,0 + distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**2) + END DO +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO ! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 1) - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) -! the second derivative - fun2 = dd1*distp(0, 1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**& -& 2)/rp3**2 + fun = -(dd2*distp(0, 1)**2*2.d0) + fun2 = fun*distp(0, 1)*(1.d0-3.d0*dd2*r(0)**2) ! indorbp=indorb - DO ic=1,7 + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp22b2 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp22b2 + fun2b = fun2b + temp22b2 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp22b1 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp22b1 + funb0 = funb0 + rmu(ic, 0)*temp22b1 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + distpb = 0.0_8 + temp22b = (1.d0-3.d0*(dd2*r(0)**2))*fun2b + temp22b0 = -(fun*distp(0, 1)*3.d0*fun2b) + funb0 = funb0 + distp(0, 1)*temp22b + distpb(0, 1) = fun0b - 2.d0*dd2*2*distp(0, 1)*funb0 + fun*temp22b + dd2b = r(0)**2*temp22b0 - 2.d0*distp(0, 1)**2*funb0 + rb(0) = rb(0) + dd2*2*r(0)*temp22b0 + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=0,0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO k=0,0,-1 + temp21 = dd2*r(k)**2 + 1.d0 + temp21b = -(distpb(k, 1)/temp21**2) + dd2b = dd2b + r(k)**2*temp21b + rb(k) = rb(k) + dd2*2*r(k)*temp21b + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (43) +! 4d without cusp and one parmater derivative of 33 + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c= & +! &1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) + c = dd1**4.5d0*0.0710812062076410d0 +! endif + c0 = -c + c1 = 4.5d0*c/dd1 + DO k=0,0 + distp(k, 1) = DEXP(-(dd1*r(k))) + END DO + DO i=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = distp(i, 1)*(c0*r(i)**2+c1*r(i)) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) +! lz=0 + distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) +! lz=+/ + distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) +! lz=+/-2 + distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) +! lz=+/-1 + distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) +! lz=+/-1 + distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d + END DO +! indorbp=indorb + DO ic=1,5 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN + fun0 = distp(0, 3) + fun = -(dd1*distp(0, 3)) + distp(0, 1)*(2.d0*c0*r(0)+c1) + fun2 = dd1**2*distp(0, 3) + distp(0, 1)*(-(2.d0*dd1*(2.d0*c0*r(0)+& +& c1))+2.d0*c0) +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN - IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE + IF (i .NE. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) END IF ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 3) THEN + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 2) THEN + IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 3) THEN + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) END IF ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 1) THEN + IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF - ELSE IF (ic .EQ. 6) THEN - IF (i .EQ. 1) THEN + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) END IF - ELSE IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=7,1,-1 - temp42b23 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 8.d0*temp42b23 - fun2b = fun2b + temp42b23 + DO ic=5,1,-1 + temp24 = fun/r(0) + temp25b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp24b3 = 6.d0*temp25b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp24+fun2)*zb(& +& indorbp, indt+4) + funb0 = funb0 + temp24b3 + rb(0) = rb(0) - temp24*temp24b3 + fun2b = fun2b + temp25b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 11) THEN - IF (branch .LT. 6) THEN - IF (branch .LT. 4) THEN - IF (branch .LT. 3) THEN - IF (.NOT.branch .LT. 2) THEN - temp42b2 = cost1f*zb(indorbp, indt+i) - fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& -& temp42b2 - rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& -& temp42b2 - rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp42b2 - END IF - temp42b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) - temp42b1 = rmu(i, 0)*temp42b0 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp42b0 - fun0b = fun0b + rmu(3, 0)*temp42b1 - rmub(3, 0) = rmub(3, 0) + fun0*temp42b1 - GOTO 100 + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp24b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp24b + fun0b = fun0b + rmu(i, 0)*temp24b ELSE - temp42b5 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp42b5 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp42b5 - rb(0) = rb(0) - fun0*2*r(0)*temp42b5 + temp24b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp24b0 + fun0b = fun0b + rmu(i, 0)*temp24b0 END IF - ELSE IF (.NOT.branch .LT. 5) THEN - temp42b6 = cost2f*10.d0*zb(indorbp, indt+i) - temp42b7 = rmu(i, 0)*temp42b6 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp42b6 - fun0b = fun0b + rmu(1, 0)*temp42b7 - rmub(1, 0) = rmub(1, 0) + fun0*temp42b7 + ELSE IF (branch .LT. 4) THEN + temp24b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp24b1 + fun0b = fun0b + rmu(i, 0)*temp24b1 END IF - temp42b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp42b4 = rmu(i, 0)*temp42b3 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp42b3 - fun0b = fun0b + rmu(1, 0)*temp42b4 - rmub(1, 0) = rmub(1, 0) + fun0*temp42b4 - ELSE IF (branch .LT. 9) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 7) THEN - temp42b10 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp42b10 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp42b10 - rb(0) = rb(0) - fun0*2*r(0)*temp42b10 - END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp24b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp24b2 + fun0b = fun0b + rmu(i, 0)*temp24b2 ELSE - temp42b11 = cost2f*10.d0*zb(indorbp, indt+i) - temp42b12 = rmu(i, 0)*temp42b11 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp42b11 - fun0b = fun0b + rmu(2, 0)*temp42b12 - rmub(2, 0) = rmub(2, 0) + fun0*temp42b12 + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - temp42b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp42b9 = rmu(i, 0)*temp42b8 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp42b8 - fun0b = fun0b + rmu(2, 0)*temp42b9 - rmub(2, 0) = rmub(2, 0) + fun0*temp42b9 - ELSE IF (branch .LT. 10) THEN - temp42b13 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp42b13 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp42b13 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp42b13 - ELSE - temp42b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp42b14 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp42b14 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp42b14 + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 16) THEN - IF (branch .LT. 14) THEN - IF (branch .LT. 13) THEN - IF (branch .LT. 12) THEN - temp42b15 = cost3f*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp42b15 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp42b15 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp42b15 - ELSE - temp42b16 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp42b16 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp42b16 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp42b16 - END IF - ELSE - temp42b17 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp42b17 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp42b17 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp42b17 + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 15) THEN - temp42b18 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp42b18 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp42b18 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp42b18 - ELSE - temp42b19 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp42b19 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp42b19 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp42b19 + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 19) THEN - IF (branch .LT. 18) THEN - IF (.NOT.branch .LT. 17) THEN - temp42b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp42b20 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp42b20 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp42b20 - END IF - ELSE - temp42b21 = cost4f*6.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp42b21 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp42b21 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp42b21 + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF - ELSE IF (.NOT.branch .LT. 20) THEN - temp42b22 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp42b22 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp42b22 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp42b22 + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - 100 temp42b = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & + temp23 = fun/r(0) + temp23b0 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp23*rmu(i, 0)*zb(& +& indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp23*distp(0, 3+ic)*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp42b - funb = funb + rmu(i, 0)*temp42b + funb0 = funb0 + temp23b0 + rb(0) = rb(0) - temp23*temp23b0 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp41 = rp3**2 - temp40b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& -& temp41 - temp40 = dd1*distp(0, 1)/temp41 - temp40b0 = temp40*fun2b - rp1b = (2*rp1+4.d0*rp2+4.d0)*temp40b0 - temp39b8 = -(distp(0, 1)*(rp2+2.d0)*funb/rp3) - dd1b = temp39b8 + r(0)**2*rp1b + distp(0, 1)*temp40b - temp39 = dd1/rp3 - distpb(0, 1) = distpb(0, 1) + fun0b - temp39*(rp2+2.d0)*funb + dd1& -& *temp40b - rp3b = -(temp39*temp39b8) - temp40*2*rp3*temp40b - rp2b = 2*(rp2+1.d0)*rp3b - temp39*distp(0, 1)*funb + (4.d0*rp1-& -& 2.d0)*temp40b0 - dd2b = r(0)*rp2b - rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b + temp22 = 2.d0*c0*r(0) + c1 + temp23b = -(distp(0, 1)*2.d0*fun2b) + temp22b6 = dd1*temp23b + dd1b = temp22*temp23b - distp(0, 3)*funb0 + distp(0, 3)*2*dd1*& +& fun2b + distpb(0, 3) = distpb(0, 3) + dd1**2*fun2b + distpb(0, 1) = distpb(0, 1) + (2.d0*(c0*r(0))+c1)*funb0 + (2.d0*c0& +& -2.d0*(dd1*temp22))*fun2b + temp22b7 = distp(0, 1)*funb0 + c0b = 2.d0*r(0)*temp22b7 + 2.d0*r(0)*temp22b6 + distp(0, 1)*2.d0*& +& fun2b + rb(0) = rb(0) + 2.d0*c0*temp22b7 + 2.d0*c0*temp22b6 + c1b = temp22b7 + temp22b6 + distpb(0, 3) = distpb(0, 3) + fun0b - dd1*funb0 ELSE distpb = 0.0_8 + c0b = 0.0_8 + c1b = 0.0_8 dd1b = 0.0_8 - dd2b = 0.0_8 END IF - DO ic=7,1,-1 - DO k=0,0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) - zb(indorbp, k) = 0.0_8 + DO ic=5,1,-1 + DO i=0,0,-1 + distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - temp39b0 = cost4f*rmu(2, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 8) - 2*rmu(2, i)*temp39b0 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) distpb(i, 8) = 0.0_8 - temp39b1 = cost4f*rmu(1, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& -& distpb(i, 7) + 2*rmu(1, i)*temp39b1 + 3.d0*2*rmu(1, i)*temp39b0 - rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp39b1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) distpb(i, 7) = 0.0_8 - temp39b2 = cost3f*2.d0*distpb(i, 6) - temp39b3 = rmu(2, i)*temp39b2 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp39b3 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp39b3 - rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp39b2 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 - temp39b4 = cost3f*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 5) - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp39b4 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 4) - 2*rmu(2, i)*temp39b4 - temp39b5 = cost2f*rmu(2, i)*distpb(i, 4) - rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp39b5 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - temp39b6 = cost2f*rmu(1, i)*distpb(i, 3) - rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 3) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + temp22b5 = distp(i, 1)*distpb(i, 3) + distpb(i, 1) = distpb(i, 1) + (c0*r(i)**2+c1*r(i))*distpb(i, 3) + c0b = c0b + r(i)**2*temp22b5 + rb(i) = rb(i) + (c1+c0*2*r(i))*temp22b5 + c1b = c1b + r(i)*temp22b5 distpb(i, 3) = 0.0_8 - temp39b7 = cost1f*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - 2*r(i)*temp39b6 - 3.d0*2*r(i)*temp39b7 - 2*r(i)*& -& temp39b5 - rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& -& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp39b7 + 5.d0*2*rmu(3, i)*& -& temp39b6 - distpb(i, 2) = 0.0_8 + END DO + DO k=0,0,-1 + temp22b4 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp22b4 + rb(k) = rb(k) - dd1*temp22b4 + distpb(k, 1) = 0.0_8 + END DO + temp22b3 = 4.5d0*c1b/dd1 + cb = temp22b3 - c0b + dd1b = dd1b + 0.0710812062076410d0*4.5d0*dd1**3.5D0*cb - c*temp22b3/& +& dd1 + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (6) +! derivative of 36 with respect zeta +! normalized +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd(indpar+3) +! if(iflagnorm.gt.2) then +! c= WRONG +! &0.5*dsqrt((1.d0/dd1**5/32.d0+2.d0*peff/(dd1+dd2)**5 +! &+peff**2/dd2**5/32.d0)/(24.d0*pi)) + c = 1.d0/DSQRT(3.d0*pi*(1.d0/dd1**5+64.d0*peff/(dd1+dd2)**5+peff**2/& +& dd2**5)) +! endif + DO k=0,0 + distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 2) = c*DEXP(-(dd2*r(k))) + END DO + IF (typec .NE. 1) THEN + fun = distp(0, 1)*(1.d0-dd1*r(0)) + peff*distp(0, 2)*(1.d0-dd2*r(0& +& )) + temp32b = 2.d0*zb(indorbp, indt+4)/r(0) + funb0 = temp32b + rb(0) = rb(0) - fun*temp32b/r(0) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + temp31 = fun/r(0) + temp31b7 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(i, 0) = rmub(i, 0) + temp31*zb(indorbp, indt+i) + funb0 = funb0 + temp31b7 + rb(0) = rb(0) - temp31*temp31b7 + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp31b2 = distp(0, 1)*fun2b + temp31b3 = (dd2**2*r(0)-2.d0*dd2)*fun2b + temp31b4 = peff*distp(0, 2)*fun2b + distpb(0, 1) = (dd1**2*r(0)-2.d0*dd1)*fun2b + dd1b = (r(0)*2*dd1-2.d0)*temp31b2 - distp(0, 1)*r(0)*funb0 + temp31b5 = peff*distp(0, 2)*funb0 + rb(0) = rb(0) + dd2**2*temp31b4 - dd2*temp31b5 - distp(0, 1)*dd1*& +& funb0 + dd1**2*temp31b2 + temp31b6 = (1.d0-dd2*r(0))*funb0 + peffb = distp(0, 2)*temp31b6 + distp(0, 2)*temp31b3 + distpb(0, 2) = peff*temp31b3 + dd2b = (r(0)*2*dd2-2.d0)*temp31b4 - r(0)*temp31b5 + distpb(0, 1) = distpb(0, 1) + (1.d0-dd1*r(0))*funb0 + distpb(0, 2) = distpb(0, 2) + peff*temp31b6 + ELSE + distpb = 0.0_8 + peffb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 + END IF + DO i=0,0,-1 + temp31b1 = r(i)*zb(indorbp, i) + rb(i) = rb(i) + (distp(i, 1)+distp(i, 2)*peff)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp31b1 + distpb(i, 2) = distpb(i, 2) + peff*temp31b1 + peffb = peffb + distp(i, 2)*temp31b1 + zb(indorbp, i) = 0.0_8 END DO cb = 0.0_8 DO k=0,0,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) + temp31b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp31b + distpb(k, 2) = 0.0_8 + temp31b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp31b0 - dd2*temp31b + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp31b0 distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp38 = dd2*r(k) + 1.d0 - temp39b = costb/temp38 - temp38b5 = -(dd1*r(k)**2*temp39b/temp38) - dd1b = dd1b + r(k)**2*temp39b - rb(k) = rb(k) + dd2*temp38b5 + dd1*2*r(k)*temp39b - dd2b = dd2b + r(k)*temp38b5 END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocf*2.25d0*dd1**1.25D0*cb + temp30 = dd2**5 + temp29 = peff**2/temp30 + temp28 = (dd1+dd2)**5 + temp27 = dd1**5 + temp26 = 3.d0*pi*(1.0/temp27+64.d0*peff/temp28+temp29) + temp25 = DSQRT(temp26) + IF (temp26 .EQ. 0.0) THEN + temp25b0 = 0.0 ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocf*2.25d0*dd1**1.25D0*& -& cb + temp25b0 = -(pi*3.d0*cb/(temp25**2*2.D0*DSQRT(temp26))) END IF - ddb(indparp) = ddb(indparp) + dd1b - CASE (87) -! derivative of 48 with respect to z -! f orbitals -! R(r)= c*exp(-z r^2)*(9/4/z-r^2) -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) - dd2 = DSQRT(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0)*ratiocf - c = dd1**2.25d0*ratiocf -! endif + temp25b1 = 64.d0*temp25b0/temp28 + temp25b2 = -(peff*5*(dd1+dd2)**4*temp25b1/temp28) + dd1b = dd1b + temp25b2 - 5*dd1**4*temp25b0/temp27**2 + peffb = peffb + 2*peff*temp25b0/temp30 + temp25b1 + dd2b = dd2b + temp25b2 - temp29*5*dd2**4*temp25b0/temp30 + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (136) +! 2s double Z NO CUSP +! 2p single exponential r^5 e^{-z r} ! + dd2 = dd(indpar+1) DO k=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) - END DO - DO i=0,0 - distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) -! lz=0 - distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) -! lz=+/-2 - distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) -! lz=+/-2 - distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) -! lz=+/-3 - distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) + distp(k, 1) = DEXP(-(dd2*r(k))) END DO -! lz=+/-3 - DO ic=1,7 +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - DO k=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 - END DO END DO ! endif IF (typec .NE. 1) THEN - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*rp2)/rp3 - fun0 = distp(0, 1)*(9.d0/4.d0/dd1-r(0)**2*cost) - fun = 0.25d0*distp(0, 1)*(-26.d0-59.d0*rp2-36.d0*rp1-3.d0*rp1*rp2+& -& 2.d0*rp1**2)/rp3**2 - fun2 = 0.25d0*distp(0, 1)*(-26.d0-66.d0*rp2+22.d0*rp1+178.d0*rp1*& -& rp2+165.d0*rp1**2+54.d0*rp1**2*rp2+rp1**3-2.d0*rp1**3*rp2)/rp3**& -& 3 + fun = distp(0, 1)*(5.d0-dd2*r(0))*r(0)**3 + fun2 = distp(0, 1)*(20*r(0)**3-10*dd2*r(0)**4+dd2**2*r(0)**5) ! indorbp=indorb - DO ic=1,7 + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF - ELSE IF (ic .EQ. 6) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) - END IF - ELSE IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=7,1,-1 - temp53b23 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 8.d0*temp53b23 - fun2b = fun2b + temp53b23 + DO ic=3,1,-1 + temp34b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp34b0 + fun2b = fun2b + temp34b0 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 11) THEN - IF (branch .LT. 6) THEN - IF (branch .LT. 4) THEN - IF (branch .LT. 3) THEN - IF (.NOT.branch .LT. 2) THEN - temp53b2 = cost1f*zb(indorbp, indt+i) - fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& -& temp53b2 - rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& -& temp53b2 - rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp53b2 - END IF - temp53b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) - temp53b1 = rmu(i, 0)*temp53b0 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp53b0 - fun0b = fun0b + rmu(3, 0)*temp53b1 - rmub(3, 0) = rmub(3, 0) + fun0*temp53b1 - GOTO 110 - ELSE - temp53b5 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp53b5 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp53b5 - rb(0) = rb(0) - fun0*2*r(0)*temp53b5 - END IF - ELSE IF (.NOT.branch .LT. 5) THEN - temp53b6 = cost2f*10.d0*zb(indorbp, indt+i) - temp53b7 = rmu(i, 0)*temp53b6 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp53b6 - fun0b = fun0b + rmu(1, 0)*temp53b7 - rmub(1, 0) = rmub(1, 0) + fun0*temp53b7 - END IF - temp53b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp53b4 = rmu(i, 0)*temp53b3 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp53b3 - fun0b = fun0b + rmu(1, 0)*temp53b4 - rmub(1, 0) = rmub(1, 0) + fun0*temp53b4 - ELSE IF (branch .LT. 9) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 7) THEN - temp53b10 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp53b10 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp53b10 - rb(0) = rb(0) - fun0*2*r(0)*temp53b10 - END IF - ELSE - temp53b11 = cost2f*10.d0*zb(indorbp, indt+i) - temp53b12 = rmu(i, 0)*temp53b11 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp53b11 - fun0b = fun0b + rmu(2, 0)*temp53b12 - rmub(2, 0) = rmub(2, 0) + fun0*temp53b12 - END IF - temp53b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp53b9 = rmu(i, 0)*temp53b8 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp53b8 - fun0b = fun0b + rmu(2, 0)*temp53b9 - rmub(2, 0) = rmub(2, 0) + fun0*temp53b9 - ELSE IF (branch .LT. 10) THEN - temp53b13 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp53b13 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp53b13 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp53b13 - ELSE - temp53b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp53b14 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp53b14 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp53b14 - END IF - ELSE IF (branch .LT. 16) THEN - IF (branch .LT. 14) THEN - IF (branch .LT. 13) THEN - IF (branch .LT. 12) THEN - temp53b15 = cost3f*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp53b15 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp53b15 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp53b15 - ELSE - temp53b16 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp53b16 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp53b16 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp53b16 - END IF - ELSE - temp53b17 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp53b17 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp53b17 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp53b17 - END IF - ELSE IF (branch .LT. 15) THEN - temp53b18 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp53b18 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp53b18 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp53b18 - ELSE - temp53b19 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp53b19 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp53b19 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp53b19 - END IF - ELSE IF (branch .LT. 19) THEN - IF (branch .LT. 18) THEN - IF (.NOT.branch .LT. 17) THEN - temp53b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp53b20 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp53b20 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp53b20 - END IF - ELSE - temp53b21 = cost4f*6.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp53b21 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp53b21 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp53b21 - END IF - ELSE IF (.NOT.branch .LT. 20) THEN - temp53b22 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp53b22 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp53b22 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp53b22 - END IF - 110 temp53b = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp53b - funb = funb + rmu(i, 0)*temp53b + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp34b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp34b + funb0 = funb0 + rmu(ic, 0)*temp34b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp52 = rp3**3 - temp50 = distp(0, 1)/temp52 - temp51 = rp1**3 - temp51b = 0.25d0*temp50*fun2b - temp50b = 0.25d0*(22.d0*rp1-66.d0*rp2+178.d0*(rp1*rp2)+165.d0*rp1& -& **2+54.d0*(rp1**2*rp2)+rp1**3-2.d0*(temp51*rp2)-26.d0)*fun2b/& -& temp52 - temp49 = rp3**2 - temp48 = distp(0, 1)/temp49 - temp49b = 0.25d0*temp48*funb - rp1b = (2.d0*2*rp1-3.d0*rp2-36.d0)*temp49b + (3*rp1**2-2.d0*rp2*3*& -& rp1**2+54.d0*rp2*2*rp1+165.d0*2*rp1+178.d0*rp2+22.d0)*temp51b - temp48b = 0.25d0*(2.d0*rp1**2-36.d0*rp1-59.d0*rp2-3.d0*(rp1*rp2)-& -& 26.d0)*funb/temp49 - temp46b0 = distp(0, 1)*fun0b - costb = -(r(0)**2*temp46b0) - rp3b = -(temp48*2*rp3*temp48b) - (0.5d0*rp2+1.d0)*costb/rp3**2 - & -& temp50*3*rp3**2*temp50b - rp2b = ((-59.d0)-3.d0*rp1)*temp49b + 2*(rp2+1.d0)*rp3b + 0.5d0*& -& costb/rp3 + (54.d0*rp1**2-2.d0*temp51+178.d0*rp1-66.d0)*temp51b - temp47 = 4.d0*dd1 - temp46 = 9.d0/temp47 - distpb(0, 1) = distpb(0, 1) + temp48b + (temp46-r(0)**2*cost)*& -& fun0b + temp50b - dd1b = r(0)**2*rp1b - temp46*4.d0*temp46b0/temp47 - rb(0) = rb(0) + dd2*rp2b + dd1*2*r(0)*rp1b - cost*2*r(0)*temp46b0 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = r(0)*rp2b + distpb = 0.0_8 + temp33 = r(0)**5 + temp32 = r(0)**4 + temp32b2 = distp(0, 1)*fun2b + temp32b3 = r(0)**3*funb0 + distpb(0, 1) = (5.d0-dd2*r(0))*temp32b3 + r(0)**5*fun0b + (20*r(0)& +& **3-10*(dd2*temp32)+dd2**2*temp33)*fun2b + rb(0) = rb(0) + distp(0, 1)*(5.d0-dd2*r(0))*3*r(0)**2*funb0 - & +& distp(0, 1)*dd2*temp32b3 + distp(0, 1)*5*r(0)**4*fun0b + (dd2**2& +& *5*r(0)**4-10*dd2*4*r(0)**3+20*3*r(0)**2)*temp32b2 + dd2b = (temp33*2*dd2-10*temp32)*temp32b2 - distp(0, 1)*r(0)*& +& temp32b3 ELSE distpb = 0.0_8 - dd1b = 0.0_8 dd2b = 0.0_8 END IF - DO ic=7,1,-1 - DO k=0,0,-1 - temp46b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) - temp45 = 4.d0*dd1 - temp44 = 9.d0/temp45 - temp44b = (temp44-r(k)**2*cost)*zb(indorbp, k) - dd1b = dd1b - temp44*4.d0*temp46b/temp45 - costb = -(r(k)**2*temp46b) - temp43 = dd2*r(k) + 1.d0 - temp44b0 = costb/temp43**2 - temp43b8 = -((0.5d0*(dd2*r(k))+1.d0)*2*temp44b0/temp43) - rb(k) = rb(k) + 0.5d0*dd2*temp44b0 + dd2*temp43b8 - cost*2*r(k)*& -& temp46b - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp44b - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp44b - zb(indorbp, k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = dd2b + r(k)*temp43b8 + 0.5d0*r(k)*temp44b0 + DO ic=3,1,-1 + DO i=0,0,-1 + temp32b1 = r(i)**5*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp32b1 + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp32b1 + rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*5*r(i)**4*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=0,0,-1 - temp43b0 = cost4f*rmu(2, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 8) - 2*rmu(2, i)*temp43b0 - distpb(i, 8) = 0.0_8 - temp43b1 = cost4f*rmu(1, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& -& distpb(i, 7) + 2*rmu(1, i)*temp43b1 + 3.d0*2*rmu(1, i)*temp43b0 - rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp43b1 - distpb(i, 7) = 0.0_8 - temp43b2 = cost3f*2.d0*distpb(i, 6) - temp43b3 = rmu(2, i)*temp43b2 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp43b3 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp43b3 - rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp43b2 - distpb(i, 6) = 0.0_8 - temp43b4 = cost3f*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 5) - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp43b4 - distpb(i, 5) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 4) - 2*rmu(2, i)*temp43b4 - temp43b5 = cost2f*rmu(2, i)*distpb(i, 4) - rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp43b5 - distpb(i, 4) = 0.0_8 - temp43b6 = cost2f*rmu(1, i)*distpb(i, 3) - rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 3) - distpb(i, 3) = 0.0_8 - temp43b7 = cost1f*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - 2*r(i)*temp43b6 - 3.d0*2*r(i)*temp43b7 - 2*r(i)*& -& temp43b5 - rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& -& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp43b7 + 5.d0*2*rmu(3, i)*& -& temp43b6 - distpb(i, 2) = 0.0_8 - END DO - cb = 0.0_8 - DO k=0,0,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) - distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp42 = dd2*r(k) + 1.d0 - temp43b = costb/temp42 - temp42b24 = -(dd1*r(k)**2*temp43b/temp42) - dd1b = dd1b + r(k)**2*temp43b - rb(k) = rb(k) + dd2*temp42b24 + dd1*2*r(k)*temp43b - dd2b = dd2b + r(k)*temp42b24 - END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocf*2.25d0*dd1**1.25D0*cb - ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocf*2.25d0*dd1**1.25D0*& -& cb - END IF - ddb(indparp) = ddb(indparp) + dd1b - CASE (88) -! g single gaussian orbital -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) - dd2 = DSQRT(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0)*ratiocg - c = dd1**2.75d0*ratiocg -! endif - DO k=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) - END DO - DO i=0,0 - distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& -& 2+3.d0*r(i)**4) -! lz=0 - distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& -& 2-r(i)**2) -! lz=+/-2 - distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& -& (i)**2) -! lz=+/-2 - distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & -& i)**2) -! lz=+/-3 - distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& -& , i)**2) -! lz=+/-3 - distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& -& rmu(2, i)**4) -! lz=+/-4 - distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& -& , i)**2) - END DO -! lz=+/-4 - DO ic=1,9 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun0 = distp(0, 1) - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) -! the second derivative - fun2 = dd1*distp(0, 1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**& -& 2)/rp3**2 -! indorbp=indorb - DO ic=1,9 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - END IF - ELSE IF (ic .EQ. 6) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - END IF - ELSE IF (ic .EQ. 7) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,21) - END IF - ELSE IF (ic .EQ. 8) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,22) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,24) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,23) - END IF - ELSE IF (ic .EQ. 9) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,26) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,28) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,27) - END IF - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,25) - END IF - END DO - END DO - distpb = 0.0_8 - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=9,1,-1 - temp57b55 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 10.d0*temp57b55 - fun2b = fun2b + temp57b55 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 15) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp57b0 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& -& 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& -& ) - rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp57b0 - rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp57b0 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& -& )*temp57b0 - ELSE - temp57b1 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& -& 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& -& ) - rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp57b1 - rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp57b1 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& -& )*temp57b1 - END IF - ELSE IF (branch .LT. 4) THEN - temp57b2 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& -& 3, 0)*r(0)**2))*zb(indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& -& r(0)**2)*temp57b2 - rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp57b2 - ELSE - temp57b3 = cost2g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& -& , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& -& (indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& -& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp57b3 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp57b3 - rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp57b3 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp57b4 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp57b5 = rmu(2, 0)*rmu(3, 0)*temp57b4 - temp57b6 = fun0*rmu(1, 0)*temp57b4 - fun0b = fun0b + rmu(1, 0)*temp57b5 - rmub(1, 0) = rmub(1, 0) + fun0*temp57b5 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp57b6 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp57b6 - ELSE - temp57b7 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp57b8 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**& -& 2)*temp57b7 - temp57b9 = fun0*rmu(1, 0)*temp57b7 - fun0b = fun0b + rmu(1, 0)*temp57b8 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp57b9 + fun0*& -& temp57b8 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp57b9 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp57b9 - END IF - ELSE - temp57b10 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp57b11 = rmu(2, 0)*rmu(3, 0)*temp57b10 - temp57b12 = fun0*rmu(1, 0)*temp57b10 - fun0b = fun0b + rmu(1, 0)*temp57b11 - rmub(1, 0) = rmub(1, 0) + fun0*temp57b11 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp57b12 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp57b12 - END IF - ELSE IF (branch .LT. 12) THEN - IF (branch .LT. 10) THEN - IF (branch .LT. 9) THEN - temp57b13 = cost2g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& -& , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& -& (indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& -& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp57b13 - rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp57b13 - rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp57b13 - ELSE - temp57b14 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp57b15 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& -& **2)*temp57b14 - temp57b16 = fun0*rmu(2, 0)*temp57b14 - fun0b = fun0b + rmu(2, 0)*temp57b15 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp57b16 + fun0& -& *temp57b15 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp57b16 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp57b16 - END IF - ELSE IF (branch .LT. 11) THEN - temp57b17 = -(cost3g*4.d0*zb(indorbp, indt+i)) - temp57b18 = fun0*temp57b17 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& -& **2))*temp57b17 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp57b18 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& -& temp57b18 - ELSE - temp57b19 = cost3g*4.d0*zb(indorbp, indt+i) - temp57b20 = fun0*temp57b19 - fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& -& **2))*temp57b19 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp57b20 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& -& temp57b20 - END IF - ELSE IF (branch .LT. 14) THEN - IF (branch .LT. 13) THEN - temp57b21 = cost3g*12.d0*zb(indorbp, indt+i) - temp57b22 = fun0*rmu(3, 0)*temp57b21 - temp57b23 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp57b21 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp57b22 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp57b22 - fun0b = fun0b + rmu(3, 0)*temp57b23 - rmub(3, 0) = rmub(3, 0) + fun0*temp57b23 - ELSE - temp57b24 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp57b25 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3, & -& 0)**2)*temp57b24 - temp57b26 = fun0*rmu(2, 0)*temp57b24 - fun0b = fun0b + rmu(2, 0)*temp57b25 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp57b26 + fun0*& -& temp57b25 - rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp57b26 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp57b26 - END IF - ELSE - temp57b27 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp57b28 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0)& -& **2)*temp57b27 - temp57b29 = fun0*rmu(1, 0)*temp57b27 - fun0b = fun0b + rmu(1, 0)*temp57b28 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp57b29 + fun0*& -& temp57b28 - rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp57b29 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp57b29 - END IF - ELSE IF (branch .LT. 22) THEN - IF (branch .LT. 19) THEN - IF (branch .LT. 17) THEN - IF (branch .LT. 16) THEN - temp57b30 = cost3g*24.d0*zb(indorbp, indt+i) - temp57b31 = rmu(2, 0)*rmu(3, 0)*temp57b30 - temp57b32 = fun0*rmu(1, 0)*temp57b30 - fun0b = fun0b + rmu(1, 0)*temp57b31 - rmub(1, 0) = rmub(1, 0) + fun0*temp57b31 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp57b32 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp57b32 - ELSE - temp57b33 = cost4g*3.d0*zb(indorbp, indt+i) - temp57b34 = fun0*rmu(3, 0)*temp57b33 - temp57b35 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp57b33 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp57b34 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp57b34 - fun0b = fun0b + rmu(3, 0)*temp57b35 - rmub(3, 0) = rmub(3, 0) + fun0*temp57b35 - END IF - ELSE IF (branch .LT. 18) THEN - temp57b36 = -(cost4g*6.d0*zb(indorbp, indt+i)) - temp57b37 = rmu(2, 0)*rmu(3, 0)*temp57b36 - temp57b38 = fun0*rmu(1, 0)*temp57b36 - fun0b = fun0b + rmu(1, 0)*temp57b37 - rmub(1, 0) = rmub(1, 0) + fun0*temp57b37 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp57b38 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp57b38 - ELSE - temp57b39 = cost4g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& -& (2, 0)**2))*zb(indorbp, indt+i) - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp57b39 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp57b39 - END IF - ELSE IF (branch .LT. 21) THEN - IF (branch .LT. 20) THEN - temp57b40 = cost4g*6.d0*zb(indorbp, indt+i) - temp57b41 = rmu(2, 0)*rmu(3, 0)*temp57b40 - temp57b42 = fun0*rmu(1, 0)*temp57b40 - fun0b = fun0b + rmu(1, 0)*temp57b41 - rmub(1, 0) = rmub(1, 0) + fun0*temp57b41 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp57b42 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp57b42 - ELSE - temp57b43 = cost4g*3.d0*zb(indorbp, indt+i) - temp57b44 = fun0*rmu(3, 0)*temp57b43 - temp57b45 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp57b43 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp57b44 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp57b44 - fun0b = fun0b + rmu(3, 0)*temp57b45 - rmub(3, 0) = rmub(3, 0) + fun0*temp57b45 - END IF - ELSE - temp57b46 = cost4g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& -& 2, 0)**3)*zb(indorbp, indt+i) - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp57b46 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp57b46 - END IF - ELSE IF (branch .LT. 26) THEN - IF (branch .LT. 24) THEN - IF (branch .LT. 23) THEN - temp57b47 = cost5g*4.d0*zb(indorbp, indt+i) - temp57b48 = fun0*temp57b47 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& -& **2))*temp57b47 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp57b48 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp57b48 - END IF - ELSE IF (branch .LT. 25) THEN - temp57b49 = cost5g*4.d0*zb(indorbp, indt+i) - temp57b50 = fun0*temp57b49 - fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& -& ))*temp57b49 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& -& 2)*temp57b50 - rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp57b50 - END IF - ELSE IF (branch .LT. 28) THEN - IF (branch .LT. 27) THEN - temp57b51 = cost5g*4.d0*zb(indorbp, indt+i) - temp57b52 = fun0*temp57b51 - fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& -& 3)*temp57b51 - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp57b52 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp57b52 - END IF - ELSE - temp57b53 = cost5g*4.d0*zb(indorbp, indt+i) - temp57b54 = fun0*temp57b53 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& -& *temp57b53 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& -& *temp57b54 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp57b54 - END IF - temp57b = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp57b - funb = funb + rmu(i, 0)*temp57b - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - temp56 = rp3**2 - temp55b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& -& temp56 - temp55 = dd1*distp(0, 1)/temp56 - temp55b0 = temp55*fun2b - rp1b = (2*rp1+4.d0*rp2+4.d0)*temp55b0 - temp54b18 = -(distp(0, 1)*(rp2+2.d0)*funb/rp3) - dd1b = temp54b18 + r(0)**2*rp1b + distp(0, 1)*temp55b - temp54 = dd1/rp3 - distpb(0, 1) = distpb(0, 1) + fun0b - temp54*(rp2+2.d0)*funb + dd1& -& *temp55b - rp3b = -(temp54*temp54b18) - temp55*2*rp3*temp55b - rp2b = 2*(rp2+1.d0)*rp3b - temp54*distp(0, 1)*funb + (4.d0*rp1-& -& 2.d0)*temp55b0 - dd2b = r(0)*rp2b - rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b - ELSE - distpb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 - END IF - DO ic=9,1,-1 - DO k=0,0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) - zb(indorbp, k) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO i=0,0,-1 - temp54b0 = cost5g*4.d0*distpb(i, 10) - temp54b1 = (rmu(1, i)**2-rmu(2, i)**2)*temp54b0 - temp54b2 = rmu(1, i)*rmu(2, i)*temp54b0 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp54b2 + rmu(2, i)*& -& temp54b1 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp54b1 - 2*rmu(2, i)*& -& temp54b2 - distpb(i, 10) = 0.0_8 - temp54b3 = cost5g*distpb(i, 9) - rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& -& 1, i))*temp54b3 - distpb(i, 9) = 0.0_8 - temp54b4 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) - temp54b5 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp54b4 - 2*rmu(2, i)*& -& temp54b5 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& -& temp54b3 - rmub(3, i) = rmub(3, i) + rmu(2, i)*temp54b4 - distpb(i, 8) = 0.0_8 - temp54b6 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) - temp54b7 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp54b6 + 2*rmu(1, i)*& -& temp54b7 + 3.d0*2*rmu(1, i)*temp54b5 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp54b6 - rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp54b7 - distpb(i, 7) = 0.0_8 - temp54b8 = cost3g*2.d0*distpb(i, 6) - temp54b9 = (7.d0*rmu(3, i)**2-r(i)**2)*temp54b8 - temp54b10 = rmu(1, i)*rmu(2, i)*temp54b8 - rmub(1, i) = rmub(1, i) + rmu(2, i)*temp54b9 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp54b9 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp54b10 - distpb(i, 6) = 0.0_8 - temp54b11 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) - temp54b12 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - temp54b13 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) - temp54b14 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - temp54b15 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) - temp54b16 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - temp54b17 = cost1g*distpb(i, 2) - rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& -& temp54b17 - 3.d0*2*r(i)*temp54b16 - 2*r(i)*temp54b12 - 3.d0*2*r(& -& i)*temp54b14 - 2*r(i)*temp54b10 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp54b11 - rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp54b11 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp54b12 - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp54b13 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp54b14 + rmu(2, i)*& -& temp54b13 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp54b15 - rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& -& rmu(3, i))*temp54b17 + 7.d0*2*rmu(3, i)*temp54b16 + rmu(1, i)*& -& temp54b15 - distpb(i, 2) = 0.0_8 - END DO - cb = 0.0_8 - DO k=0,0,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) - distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp53 = dd2*r(k) + 1.d0 - temp54b = costb/temp53 - temp53b24 = -(dd1*r(k)**2*temp54b/temp53) - dd1b = dd1b + r(k)**2*temp54b - rb(k) = rb(k) + dd2*temp53b24 + dd1*2*r(k)*temp54b - dd2b = dd2b + r(k)*temp53b24 - END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocg*2.75d0*dd1**1.75D0*cb - ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocg*2.75d0*dd1**1.75D0*& -& cb - END IF - ddb(indparp) = ddb(indparp) + dd1b - CASE (89) -! g single gaussian orbital -! derivative of 51 -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) - dd2 = DSQRT(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0)*ratiocg - c = dd1**2.75d0*ratiocg -! endif - DO k=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) - END DO - DO i=0,0 - distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& -& 2+3.d0*r(i)**4) -! lz=0 - distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& -& 2-r(i)**2) -! lz=+/-2 - distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& -& (i)**2) -! lz=+/-2 - distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & -& i)**2) -! lz=+/-3 - distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& -& , i)**2) -! lz=+/-3 - distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& -& rmu(2, i)**4) -! lz=+/-4 - distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& -& , i)**2) - END DO -! lz=+/-4 - DO ic=1,9 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO k=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 - END DO - END DO -! endif - IF (typec .NE. 1) THEN - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*rp2)/rp3 - fun0 = distp(0, 1)*(11.d0/4.d0/dd1-r(0)**2*cost) - fun = 0.25d0*distp(0, 1)*(-30.d0-69.d0*rp2-44.d0*rp1-5.d0*rp1*rp2+& -& 2.d0*rp1**2)/rp3**2 - fun2 = 0.25d0*distp(0, 1)*(-30.d0-78.d0*rp2+18.d0*rp1+198.d0*rp1*& -& rp2+191.d0*rp1**2+66.d0*rp1**2*rp2+3.d0*rp1**3-2.d0*rp1**3*rp2)/& -& rp3**3 -! indorbp=indorb - DO ic=1,9 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - END IF - ELSE IF (ic .EQ. 6) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - END IF - ELSE IF (ic .EQ. 7) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,21) - END IF - ELSE IF (ic .EQ. 8) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,22) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,24) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,23) - END IF - ELSE IF (ic .EQ. 9) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,26) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,28) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,27) - END IF - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,25) - END IF - END DO - END DO - distpb = 0.0_8 - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=9,1,-1 - temp68b55 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 10.d0*temp68b55 - fun2b = fun2b + temp68b55 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 15) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp68b0 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& -& 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& -& ) - rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp68b0 - rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp68b0 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& -& )*temp68b0 - ELSE - temp68b1 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& -& 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& -& ) - rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp68b1 - rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp68b1 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& -& )*temp68b1 - END IF - ELSE IF (branch .LT. 4) THEN - temp68b2 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& -& 3, 0)*r(0)**2))*zb(indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& -& r(0)**2)*temp68b2 - rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp68b2 - ELSE - temp68b3 = cost2g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& -& , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& -& (indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& -& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp68b3 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp68b3 - rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp68b3 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp68b4 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp68b5 = rmu(2, 0)*rmu(3, 0)*temp68b4 - temp68b6 = fun0*rmu(1, 0)*temp68b4 - fun0b = fun0b + rmu(1, 0)*temp68b5 - rmub(1, 0) = rmub(1, 0) + fun0*temp68b5 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp68b6 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp68b6 - ELSE - temp68b7 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp68b8 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**& -& 2)*temp68b7 - temp68b9 = fun0*rmu(1, 0)*temp68b7 - fun0b = fun0b + rmu(1, 0)*temp68b8 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp68b9 + fun0*& -& temp68b8 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp68b9 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp68b9 - END IF - ELSE - temp68b10 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp68b11 = rmu(2, 0)*rmu(3, 0)*temp68b10 - temp68b12 = fun0*rmu(1, 0)*temp68b10 - fun0b = fun0b + rmu(1, 0)*temp68b11 - rmub(1, 0) = rmub(1, 0) + fun0*temp68b11 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp68b12 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp68b12 - END IF - ELSE IF (branch .LT. 12) THEN - IF (branch .LT. 10) THEN - IF (branch .LT. 9) THEN - temp68b13 = cost2g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& -& , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& -& (indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& -& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp68b13 - rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp68b13 - rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp68b13 - ELSE - temp68b14 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp68b15 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& -& **2)*temp68b14 - temp68b16 = fun0*rmu(2, 0)*temp68b14 - fun0b = fun0b + rmu(2, 0)*temp68b15 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp68b16 + fun0& -& *temp68b15 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp68b16 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp68b16 - END IF - ELSE IF (branch .LT. 11) THEN - temp68b17 = -(cost3g*4.d0*zb(indorbp, indt+i)) - temp68b18 = fun0*temp68b17 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& -& **2))*temp68b17 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp68b18 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& -& temp68b18 - ELSE - temp68b19 = cost3g*4.d0*zb(indorbp, indt+i) - temp68b20 = fun0*temp68b19 - fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& -& **2))*temp68b19 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp68b20 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& -& temp68b20 - END IF - ELSE IF (branch .LT. 14) THEN - IF (branch .LT. 13) THEN - temp68b21 = cost3g*12.d0*zb(indorbp, indt+i) - temp68b22 = fun0*rmu(3, 0)*temp68b21 - temp68b23 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp68b21 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp68b22 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp68b22 - fun0b = fun0b + rmu(3, 0)*temp68b23 - rmub(3, 0) = rmub(3, 0) + fun0*temp68b23 - ELSE - temp68b24 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp68b25 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3, & -& 0)**2)*temp68b24 - temp68b26 = fun0*rmu(2, 0)*temp68b24 - fun0b = fun0b + rmu(2, 0)*temp68b25 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp68b26 + fun0*& -& temp68b25 - rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp68b26 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp68b26 - END IF - ELSE - temp68b27 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp68b28 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0)& -& **2)*temp68b27 - temp68b29 = fun0*rmu(1, 0)*temp68b27 - fun0b = fun0b + rmu(1, 0)*temp68b28 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp68b29 + fun0*& -& temp68b28 - rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp68b29 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp68b29 - END IF - ELSE IF (branch .LT. 22) THEN - IF (branch .LT. 19) THEN - IF (branch .LT. 17) THEN - IF (branch .LT. 16) THEN - temp68b30 = cost3g*24.d0*zb(indorbp, indt+i) - temp68b31 = rmu(2, 0)*rmu(3, 0)*temp68b30 - temp68b32 = fun0*rmu(1, 0)*temp68b30 - fun0b = fun0b + rmu(1, 0)*temp68b31 - rmub(1, 0) = rmub(1, 0) + fun0*temp68b31 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp68b32 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp68b32 - ELSE - temp68b33 = cost4g*3.d0*zb(indorbp, indt+i) - temp68b34 = fun0*rmu(3, 0)*temp68b33 - temp68b35 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp68b33 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp68b34 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp68b34 - fun0b = fun0b + rmu(3, 0)*temp68b35 - rmub(3, 0) = rmub(3, 0) + fun0*temp68b35 - END IF - ELSE IF (branch .LT. 18) THEN - temp68b36 = -(cost4g*6.d0*zb(indorbp, indt+i)) - temp68b37 = rmu(2, 0)*rmu(3, 0)*temp68b36 - temp68b38 = fun0*rmu(1, 0)*temp68b36 - fun0b = fun0b + rmu(1, 0)*temp68b37 - rmub(1, 0) = rmub(1, 0) + fun0*temp68b37 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp68b38 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp68b38 - ELSE - temp68b39 = cost4g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& -& (2, 0)**2))*zb(indorbp, indt+i) - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp68b39 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp68b39 - END IF - ELSE IF (branch .LT. 21) THEN - IF (branch .LT. 20) THEN - temp68b40 = cost4g*6.d0*zb(indorbp, indt+i) - temp68b41 = rmu(2, 0)*rmu(3, 0)*temp68b40 - temp68b42 = fun0*rmu(1, 0)*temp68b40 - fun0b = fun0b + rmu(1, 0)*temp68b41 - rmub(1, 0) = rmub(1, 0) + fun0*temp68b41 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp68b42 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp68b42 - ELSE - temp68b43 = cost4g*3.d0*zb(indorbp, indt+i) - temp68b44 = fun0*rmu(3, 0)*temp68b43 - temp68b45 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp68b43 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp68b44 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp68b44 - fun0b = fun0b + rmu(3, 0)*temp68b45 - rmub(3, 0) = rmub(3, 0) + fun0*temp68b45 - END IF - ELSE - temp68b46 = cost4g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& -& 2, 0)**3)*zb(indorbp, indt+i) - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp68b46 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp68b46 - END IF - ELSE IF (branch .LT. 26) THEN - IF (branch .LT. 24) THEN - IF (branch .LT. 23) THEN - temp68b47 = cost5g*4.d0*zb(indorbp, indt+i) - temp68b48 = fun0*temp68b47 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& -& **2))*temp68b47 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp68b48 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp68b48 - END IF - ELSE IF (branch .LT. 25) THEN - temp68b49 = cost5g*4.d0*zb(indorbp, indt+i) - temp68b50 = fun0*temp68b49 - fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& -& ))*temp68b49 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& -& 2)*temp68b50 - rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp68b50 - END IF - ELSE IF (branch .LT. 28) THEN - IF (branch .LT. 27) THEN - temp68b51 = cost5g*4.d0*zb(indorbp, indt+i) - temp68b52 = fun0*temp68b51 - fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& -& 3)*temp68b51 - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp68b52 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp68b52 - END IF - ELSE - temp68b53 = cost5g*4.d0*zb(indorbp, indt+i) - temp68b54 = fun0*temp68b53 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& -& *temp68b53 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& -& *temp68b54 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp68b54 - END IF - temp68b = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp68b - funb = funb + rmu(i, 0)*temp68b - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - temp67 = rp3**3 - temp65 = distp(0, 1)/temp67 - temp66 = rp1**3 - temp66b = 0.25d0*temp65*fun2b - temp65b = 0.25d0*(18.d0*rp1-78.d0*rp2+198.d0*(rp1*rp2)+191.d0*rp1& -& **2+66.d0*(rp1**2*rp2)+3.d0*rp1**3-2.d0*(temp66*rp2)-30.d0)*& -& fun2b/temp67 - temp64 = rp3**2 - temp63 = distp(0, 1)/temp64 - temp64b = 0.25d0*temp63*funb - rp1b = (2.d0*2*rp1-5.d0*rp2-44.d0)*temp64b + (3.d0*3*rp1**2-2.d0*& -& rp2*3*rp1**2+66.d0*rp2*2*rp1+191.d0*2*rp1+198.d0*rp2+18.d0)*& -& temp66b - temp63b = 0.25d0*(2.d0*rp1**2-44.d0*rp1-69.d0*rp2-5.d0*(rp1*rp2)-& -& 30.d0)*funb/temp64 - temp61b0 = distp(0, 1)*fun0b - costb = -(r(0)**2*temp61b0) - rp3b = -(temp63*2*rp3*temp63b) - (0.5d0*rp2+1.d0)*costb/rp3**2 - & -& temp65*3*rp3**2*temp65b - rp2b = ((-69.d0)-5.d0*rp1)*temp64b + 2*(rp2+1.d0)*rp3b + 0.5d0*& -& costb/rp3 + (66.d0*rp1**2-2.d0*temp66+198.d0*rp1-78.d0)*temp66b - temp62 = 4.d0*dd1 - temp61 = 11.d0/temp62 - distpb(0, 1) = distpb(0, 1) + temp63b + (temp61-r(0)**2*cost)*& -& fun0b + temp65b - dd1b = r(0)**2*rp1b - temp61*4.d0*temp61b0/temp62 - rb(0) = rb(0) + dd2*rp2b + dd1*2*r(0)*rp1b - cost*2*r(0)*temp61b0 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = r(0)*rp2b - ELSE - distpb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 - END IF - DO ic=9,1,-1 - DO k=0,0,-1 - temp61b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) - temp60 = 4.d0*dd1 - temp59 = 11.d0/temp60 - temp59b = (temp59-r(k)**2*cost)*zb(indorbp, k) - dd1b = dd1b - temp59*4.d0*temp61b/temp60 - costb = -(r(k)**2*temp61b) - temp58 = dd2*r(k) + 1.d0 - temp59b0 = costb/temp58**2 - temp58b18 = -((0.5d0*(dd2*r(k))+1.d0)*2*temp59b0/temp58) - rb(k) = rb(k) + 0.5d0*dd2*temp59b0 + dd2*temp58b18 - cost*2*r(k)& -& *temp61b - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp59b - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp59b - zb(indorbp, k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = dd2b + r(k)*temp58b18 + 0.5d0*r(k)*temp59b0 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO i=0,0,-1 - temp58b0 = cost5g*4.d0*distpb(i, 10) - temp58b1 = (rmu(1, i)**2-rmu(2, i)**2)*temp58b0 - temp58b2 = rmu(1, i)*rmu(2, i)*temp58b0 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp58b2 + rmu(2, i)*& -& temp58b1 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp58b1 - 2*rmu(2, i)*& -& temp58b2 - distpb(i, 10) = 0.0_8 - temp58b3 = cost5g*distpb(i, 9) - rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& -& 1, i))*temp58b3 - distpb(i, 9) = 0.0_8 - temp58b4 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) - temp58b5 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp58b4 - 2*rmu(2, i)*& -& temp58b5 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& -& temp58b3 - rmub(3, i) = rmub(3, i) + rmu(2, i)*temp58b4 - distpb(i, 8) = 0.0_8 - temp58b6 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) - temp58b7 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp58b6 + 2*rmu(1, i)*& -& temp58b7 + 3.d0*2*rmu(1, i)*temp58b5 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp58b6 - rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp58b7 - distpb(i, 7) = 0.0_8 - temp58b8 = cost3g*2.d0*distpb(i, 6) - temp58b9 = (7.d0*rmu(3, i)**2-r(i)**2)*temp58b8 - temp58b10 = rmu(1, i)*rmu(2, i)*temp58b8 - rmub(1, i) = rmub(1, i) + rmu(2, i)*temp58b9 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp58b9 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp58b10 - distpb(i, 6) = 0.0_8 - temp58b11 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) - temp58b12 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - temp58b13 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) - temp58b14 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - temp58b15 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) - temp58b16 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - temp58b17 = cost1g*distpb(i, 2) - rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& -& temp58b17 - 3.d0*2*r(i)*temp58b16 - 2*r(i)*temp58b12 - 3.d0*2*r(& -& i)*temp58b14 - 2*r(i)*temp58b10 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp58b11 - rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp58b11 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp58b12 - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp58b13 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp58b14 + rmu(2, i)*& -& temp58b13 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp58b15 - rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& -& rmu(3, i))*temp58b17 + 7.d0*2*rmu(3, i)*temp58b16 + rmu(1, i)*& -& temp58b15 - distpb(i, 2) = 0.0_8 - END DO - cb = 0.0_8 DO k=0,0,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) + temp32b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp32b0 + rb(k) = rb(k) - dd2*temp32b0 distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp57 = dd2*r(k) + 1.d0 - temp58b = costb/temp57 - temp57b56 = -(dd1*r(k)**2*temp58b/temp57) - dd1b = dd1b + r(k)**2*temp58b - rb(k) = rb(k) + dd2*temp57b56 + dd1*2*r(k)*temp58b - dd2b = dd2b + r(k)*temp57b56 END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocg*2.75d0*dd1**1.75D0*cb - ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocg*2.75d0*dd1**1.75D0*& -& cb - END IF - ddb(indparp) = ddb(indparp) + dd1b - CASE (1) -! WARNING IN DFT it is assumed that UMRIGAR orbitals could be extended -! up to number 99, so i,h,... are possible extensions. -! 1s single Z NO CUSP! -! if(iocc(indshellp).eq.1) then - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dd1*dsqrt(dd1)/dsqrt(pi) - c = dd1*DSQRT(dd1)*0.56418958354775628695d0 -! endif + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (200) +! THE COSTANT indorbp = indorb + 1 - DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k))) - END DO +! endif IF (typec .NE. 1) THEN - fun = -(dd1*distp(0, 1)) - distpb = 0.0_8 - temp70 = dd1/r(0) - temp70b = -(distp(0, 1)*2.d0*zb(indorbp, indt+4)/r(0)) - dd1b = temp70b + distp(0, 1)*2*dd1*zb(indorbp, indt+4) - rb(0) = rb(0) - temp70*temp70b - distpb(0, 1) = (dd1**2-2.d0*temp70)*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 - funb = 0.0_8 DO i=3,1,-1 - temp69 = fun/r(0) - temp69b0 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(i, 0) = rmub(i, 0) + temp69*zb(indorbp, indt+i) - funb = funb + temp69b0 - rb(0) = rb(0) - temp69*temp69b0 zb(indorbp, indt+i) = 0.0_8 END DO - dd1b = dd1b - distp(0, 1)*funb - distpb(0, 1) = distpb(0, 1) - dd1*funb - ELSE - distpb = 0.0_8 - dd1b = 0.0_8 END IF DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO - cb = 0.0_8 - DO k=0,0,-1 - temp69b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp69b - rb(k) = rb(k) - dd1*temp69b - distpb(k, 1) = 0.0_8 - END DO - temp68 = DSQRT(dd1) - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + 0.56418958354775628695d0*temp68*cb - ELSE - dd1b = dd1b + (0.56418958354775628695d0*dd1/(2.D0*DSQRT(dd1))+& -& 0.56418958354775628695d0*temp68)*cb - END IF - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (2) -! 1s double Z with cusp cond -! -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) + distpb = 0.0_8 + CASE (118) +! 2s double lorentian with constant parent of 102 +! (dd1+ 1/ (1 + Exp[ dd2 (r^2 - r_0^2) ] ) | dd3=r_0 +! Fermi distribution with r^2 dd2 = dd(indpar+2) - peff = (zeta(1)-dd1)/(dd2-zeta(1)) -! if(iflagnorm.gt.2) then - c = 1.d0/2.d0/DSQRT(2.d0*pi*(1.d0/(2.d0*dd1)**3+2.d0*peff/(dd1+dd2)& -& **3+peff**2/(2.d0*dd2)**3)) -! endif + dd3 = -(dd2*dd(indpar+3)**2) + indorbp = indorb + 1 DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k))) - distp(k, 2) = c*DEXP(-(dd2*r(k))) + CALL PUSHREAL8(adr8ibuf,adr8buf,arg) + arg = dd2*r(k)**2 + dd3 + IF (arg .GT. 200) THEN + distp(k, 1) = DEXP(200.d0) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + distp(k, 1) = DEXP(arg) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF END DO +! write(6,*) ' function inside = ',z(indorbp,i) +! endif IF (typec .NE. 1) THEN - fun = (-(dd1*distp(0, 1))-dd2*distp(0, 2)*peff)/r(0) - distpb = 0.0_8 - temp78 = dd1/r(0) - temp78b = -(distp(0, 1)*2.d0*zb(indorbp, indt+4)/r(0)) - temp78b0 = peff*distp(0, 2)*zb(indorbp, indt+4) - temp77 = dd2/r(0) - temp77b2 = -(2.d0*temp78b0/r(0)) - temp77b3 = (dd2**2-2.d0*temp77)*zb(indorbp, indt+4) - dd1b = temp78b + distp(0, 1)*2*dd1*zb(indorbp, indt+4) - rb(0) = rb(0) - temp77*temp77b2 - temp78*temp78b - distpb(0, 1) = (dd1**2-2.d0*temp78)*zb(indorbp, indt+4) - dd2b = temp77b2 + 2*dd2*temp78b0 - peffb = distp(0, 2)*temp77b3 - distpb(0, 2) = peff*temp77b3 + fun = -(2.d0*dd2*distp(0, 1)/(1.d0+distp(0, 1))**2) + fun2b = zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 - funb = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO - temp77b1 = funb/r(0) - dd1b = dd1b - distp(0, 1)*temp77b1 - distpb(0, 1) = distpb(0, 1) - dd1*temp77b1 - distpb(0, 2) = distpb(0, 2) - dd2*peff*temp77b1 - dd2b = dd2b - distp(0, 2)*peff*temp77b1 - peffb = peffb - distp(0, 2)*dd2*temp77b1 - rb(0) = rb(0) - (-(dd1*distp(0, 1))-distp(0, 2)*(dd2*peff))*& -& temp77b1/r(0) - ELSE - distpb = 0.0_8 - peffb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 - END IF - DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - peffb = peffb + distp(i, 2)*zb(indorbp, i) - distpb(i, 2) = distpb(i, 2) + peff*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - cb = 0.0_8 - DO k=0,0,-1 - temp77b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp77b - distpb(k, 2) = 0.0_8 - temp77b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp77b0 - dd2*temp77b - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp77b0 - distpb(k, 1) = 0.0_8 - END DO - temp76 = 2.d0**3*dd2**3 - temp75 = peff**2/temp76 - temp74 = (dd1+dd2)**3 - temp73 = 2.d0**3*dd1**3 - temp72 = 2.d0*pi*(1.0/temp73+2.d0*peff/temp74+temp75) - temp71 = DSQRT(temp72) - IF (temp72 .EQ. 0.0) THEN - temp71b = 0.0 - ELSE - temp71b = -(pi*cb/(temp71**2*2.D0*DSQRT(temp72))) - END IF - temp71b0 = 2.d0*temp71b/temp74 - temp71b1 = -(peff*3*(dd1+dd2)**2*temp71b0/temp74) - peffb = peffb + 2*peff*temp71b/temp76 + temp71b0 - temp71b2 = peffb/(dd2-zeta(1)) - dd1b = dd1b + temp71b1 - temp71b2 - 2.d0**3*3*dd1**2*temp71b/temp73& -& **2 - dd2b = dd2b + temp71b1 - temp75*2.d0**3*3*dd2**2*temp71b/temp76 - (& -& zeta(1)-dd1)*temp71b2/(dd2-zeta(1)) - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (3) -! 1s double Z NO CUSP -! -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) -! if(iflagnorm.gt.2) then - c = 1.d0/2.d0/DSQRT(2.d0*pi*(1.d0/(2.d0*dd1)**3+2.d0*peff/(dd1+dd2)& -& **3+peff**2/(2.d0*dd2)**3)) - ad_from = indpar + 1 -! endif - DO i=ad_from,indpar+2 - DO k=0,0 - distp(k, i-indpar) = c*DEXP(-(dd(i)*r(k))) - END DO - END DO - CALL PUSHINTEGER4(adi4ibuf,adi4buf,i - 1) - CALL PUSHINTEGER4(adi4ibuf,adi4buf,ad_from) - IF (typec .NE. 1) THEN - fun = -(dd1*distp(0, 1)) - peff*dd2*distp(0, 2) distpb = 0.0_8 - temp88 = dd1/r(0) - temp88b = -(distp(0, 1)*2.d0*zb(indorbp, indt+4)/r(0)) - temp88b0 = peff*distp(0, 2)*zb(indorbp, indt+4) - temp87 = dd2/r(0) - temp87b = -(2.d0*temp88b0/r(0)) - temp87b0 = (dd2**2-2.d0*temp87)*zb(indorbp, indt+4) - dd1b = temp88b + distp(0, 1)*2*dd1*zb(indorbp, indt+4) - rb(0) = rb(0) - temp87*temp87b - temp88*temp88b - distpb(0, 1) = (dd1**2-2.d0*temp88)*zb(indorbp, indt+4) - dd2b = temp87b + 2*dd2*temp88b0 - peffb = distp(0, 2)*temp87b0 - distpb(0, 2) = peff*temp87b0 - zb(indorbp, indt+4) = 0.0_8 - funb = 0.0_8 - DO i=3,1,-1 - temp86 = fun/r(0) - temp86b = rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(i, 0) = rmub(i, 0) + temp86*zb(indorbp, indt+i) - funb = funb + temp86b - rb(0) = rb(0) - temp86*temp86b - zb(indorbp, indt+i) = 0.0_8 - END DO - dd1b = dd1b - distp(0, 1)*funb - distpb(0, 1) = distpb(0, 1) - dd1*funb - peffb = peffb - distp(0, 2)*dd2*funb - dd2b = dd2b - distp(0, 2)*peff*funb - distpb(0, 2) = distpb(0, 2) - peff*dd2*funb + temp36 = (distp(0, 1)+1.d0)**3 + temp35 = -(2.d0*dd2*r(0)**2) - 1.d0 + temp34 = -(2.d0*dd2*r(0)**2) + 1.d0 + temp34b1 = -(2.d0*dd2*fun2b/temp36) + temp34b2 = -(distp(0, 1)**2*2.d0*temp34b1) + temp34b3 = distp(0, 1)*2.d0*temp34b1 + temp34b4 = -(2.d0*(distp(0, 1)**2*temp34-distp(0, 1)*temp35)*fun2b& +& /temp36) + temp34b5 = -(2.d0*funb0/(distp(0, 1)+1.d0)**2) + distpb(0, 1) = (dd2-dd2*distp(0, 1)*2/(distp(0, 1)+1.d0))*temp34b5& +& - dd2*3*(distp(0, 1)+1.d0)**2*temp34b4/temp36 + (temp34*2*distp(& +& 0, 1)-temp35)*temp34b1 + dd2b = distp(0, 1)*temp34b5 + temp34b4 + r(0)**2*temp34b3 + r(0)**& +& 2*temp34b2 + rb(0) = rb(0) + dd2*2*r(0)*temp34b3 + dd2*2*r(0)*temp34b2 ELSE distpb = 0.0_8 - peffb = 0.0_8 - dd1b = 0.0_8 dd2b = 0.0_8 END IF + dd1b = 0.0_8 DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - peffb = peffb + distp(i, 2)*zb(indorbp, i) - distpb(i, 2) = distpb(i, 2) + peff*zb(indorbp, i) + dd1b = dd1b + zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) - zb(indorbp, i)/(distp(i, 1)+1.d0)**2 zb(indorbp, i) = 0.0_8 END DO - cb = 0.0_8 - CALL POPINTEGER4(adi4ibuf,adi4buf,ad_from) - CALL POPINTEGER4(adi4ibuf,adi4buf,ad_to) - DO i=ad_to,ad_from,-1 - DO k=0,0,-1 - temp85 = -(dd(i)*r(k)) - temp85b = c*DEXP(temp85)*distpb(k, i-indpar) - cb = cb + DEXP(temp85)*distpb(k, i-indpar) - ddb(i) = ddb(i) - r(k)*temp85b - rb(k) = rb(k) - dd(i)*temp85b - distpb(k, i-indpar) = 0.0_8 - END DO + dd3b = 0.0_8 + DO k=0,0,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 2) THEN + distpb(k, 1) = 0.0_8 + argb = 0.0_8 + ELSE + argb = DEXP(arg)*distpb(k, 1) + distpb(k, 1) = 0.0_8 + END IF + CALL POPREAL8(adr8ibuf,adr8buf,arg) + dd2b = dd2b + r(k)**2*argb + rb(k) = rb(k) + dd2*2*r(k)*argb + dd3b = dd3b + argb END DO - temp84 = 2.d0**3*dd2**3 - temp83 = peff**2/temp84 - temp82 = (dd1+dd2)**3 - temp81 = 2.d0**3*dd1**3 - temp80 = 2.d0*pi*(1.0/temp81+2.d0*peff/temp82+temp83) - temp79 = DSQRT(temp80) - IF (temp80 .EQ. 0.0) THEN - temp79b = 0.0 - ELSE - temp79b = -(pi*cb/(temp79**2*2.D0*DSQRT(temp80))) - END IF - temp79b0 = 2.d0*temp79b/temp82 - temp79b1 = -(peff*3*(dd1+dd2)**2*temp79b0/temp82) - dd1b = dd1b + temp79b1 - 2.d0**3*3*dd1**2*temp79b/temp81**2 - peffb = peffb + 2*peff*temp79b/temp84 + temp79b0 - dd2b = dd2b + temp79b1 - temp83*2.d0**3*3*dd2**2*temp79b/temp84 - ddb(indpar+3) = ddb(indpar+3) + peffb + dd2b = dd2b - dd(indpar+3)**2*dd3b + ddb(indpar+3) = ddb(indpar+3) - dd2*2*dd(indpar+3)*dd3b ddb(indpar+2) = ddb(indpar+2) + dd2b ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (4) -! 2s 2pz Hybryd single Z -! normalized + CASE (15) +! (r**2 + dd2*(1 + dd1*r))*exp(-dd1*r) ! normalized ! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) dd2 = dd(indpar+2) -! if(iflagnorm.gt.2) then - c = dd1**2.5d0/DSQRT(3.d0*pi*(1.d0+dd2**2/3.d0)) -! endif + c = DSQRT(2.d0*dd1**7/pi/(45.d0+42.d0*dd1**2*dd2+14.d0*dd1**4*dd2**2& +& )) DO k=0,0 distp(k, 1) = c*DEXP(-(dd1*r(k))) END DO IF (typec .NE. 1) THEN - fun = distp(0, 1)*(1.d0-dd1*r(0)) - funp = -(dd2*dd1*distp(0, 1)*rmu(3, 0)) - temp92b = zb(indorbp, indt+4)/r(0) - funb = 2.d0*temp92b - funpb = 4.d0*temp92b - rb(0) = rb(0) - (2.d0*fun+4.d0*funp)*temp92b/r(0) + fun = distp(0, 1)*r(0)*(2.d0-dd1**2*dd2-dd1*r(0)) + temp44b = 2.d0*zb(indorbp, indt+4)/r(0) + funb0 = temp44b + rb(0) = rb(0) - fun*temp44b/r(0) fun2b = zb(indorbp, indt+4) - fun2pb = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 - distpb = 0.0_8 - dd2b = distp(0, 1)*zb(indorbp, indt+3) - distpb(0, 1) = dd2*zb(indorbp, indt+3) DO i=3,1,-1 - temp91b6 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) - temp91 = (fun+funp)/r(0) - funb = funb + temp91b6 - funpb = funpb + temp91b6 - rb(0) = rb(0) - temp91*temp91b6 - rmub(i, 0) = rmub(i, 0) + temp91*zb(indorbp, indt+i) + temp43 = fun/r(0) + temp43b0 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(i, 0) = rmub(i, 0) + temp43*zb(indorbp, indt+i) + funb0 = funb0 + temp43b0 + rb(0) = rb(0) - temp43*temp43b0 zb(indorbp, indt+i) = 0.0_8 END DO - temp91b1 = dd2*distp(0, 1)*fun2pb - temp91b2 = dd1**2*rmu(3, 0)*fun2pb - temp91b3 = distp(0, 1)*fun2b - temp91b4 = -(distp(0, 1)*rmu(3, 0)*funpb) - dd1b = (r(0)*2*dd1-2.d0)*temp91b3 - distp(0, 1)*r(0)*funb + dd2*& -& temp91b4 + rmu(3, 0)*2*dd1*temp91b1 - temp91b5 = -(dd2*dd1*funpb) - rmub(3, 0) = rmub(3, 0) + distp(0, 1)*temp91b5 + dd1**2*temp91b1 - dd2b = dd2b + dd1*temp91b4 + distp(0, 1)*temp91b2 - distpb(0, 1) = distpb(0, 1) + (dd1**2*r(0)-2.d0*dd1)*fun2b + (1.d0& -& -dd1*r(0))*funb + rmu(3, 0)*temp91b5 + dd2*temp91b2 - rb(0) = rb(0) + dd1**2*temp91b3 - distp(0, 1)*dd1*funb + distpb = 0.0_8 + temp42 = -(dd1*r(0)) - dd1**2*dd2 + 3.d0 + temp43b = distp(0, 1)*fun2b + temp42b0 = (1.d0-dd1*r(0))*temp43b + temp42b1 = (2.d0-dd1*r(0)-dd1**2*dd2)*funb0 + distpb(0, 1) = r(0)*temp42b1 + ((1.d0-dd1*r(0))*temp42-1.d0)*fun2b + temp42b2 = distp(0, 1)*r(0)*funb0 + dd1b = (-(dd2*2*dd1)-r(0))*temp42b2 + (-(dd2*2*dd1)-r(0))*temp42b0& +& - temp42*r(0)*temp43b + rb(0) = rb(0) + distp(0, 1)*temp42b1 - dd1*temp42b2 - dd1*temp42b0& +& - temp42*dd1*temp43b + dd2b = -(dd1**2*temp42b2) - dd1**2*temp42b0 ELSE distpb = 0.0_8 dd1b = 0.0_8 dd2b = 0.0_8 END IF DO i=0,0,-1 - temp91b0 = distp(i, 1)*zb(indorbp, i) - rb(i) = rb(i) + temp91b0 - dd2b = dd2b + rmu(3, i)*temp91b0 - rmub(3, i) = rmub(3, i) + dd2*temp91b0 - distpb(i, 1) = distpb(i, 1) + (r(i)+dd2*rmu(3, i))*zb(indorbp, i) + temp42b = distp(i, 1)*zb(indorbp, i) + temp41 = dd1*r(i) + 1.d0 + rb(i) = rb(i) + (dd2*dd1+2*r(i))*temp42b + dd2b = dd2b + temp41*temp42b + dd1b = dd1b + dd2*r(i)*temp42b + distpb(i, 1) = distpb(i, 1) + (r(i)**2+dd2*temp41)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO cb = 0.0_8 DO k=0,0,-1 - temp91b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + temp41b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp91b - rb(k) = rb(k) - dd1*temp91b + dd1b = dd1b - r(k)*temp41b + rb(k) = rb(k) - dd1*temp41b distpb(k, 1) = 0.0_8 END DO - temp90 = 3.d0*pi*(dd2**2/3.d0+1.d0) - temp89 = DSQRT(temp90) - dd1b = dd1b + 2.5d0*dd1**1.5D0*cb/temp89 - IF (.NOT.temp90 .EQ. 0.0) dd2b = dd2b - dd1**2.5d0*pi*2*dd2*cb/(& -& temp89**2*2.D0*DSQRT(temp90)) + temp40 = dd1**4 + temp39 = pi*(42.d0*dd1**2*dd2+14.d0*temp40*dd2**2+45.d0) + temp38 = dd1**7 + temp37 = temp38/temp39 + IF (2.d0*temp37 .EQ. 0.0) THEN + temp37b = 0.0 + ELSE + temp37b = 2.d0*cb/(2.D0*DSQRT(2.d0*temp37)*temp39) + END IF + temp37b0 = -(temp37*pi*temp37b) + dd1b = dd1b + (14.d0*dd2**2*4*dd1**3+42.d0*dd2*2*dd1)*temp37b0 + 7*& +& dd1**6*temp37b + dd2b = dd2b + (14.d0*temp40*2*dd2+42.d0*dd1**2)*temp37b0 ddb(indpar+2) = ddb(indpar+2) + dd2b ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (5) -! 2s single Z NO CUSP -! normalized -! if(iocc(indshellp).eq.1) then + CASE (122) +! 2s gaussian for pseudo +! 2s with cusp condition +! dd1*( dd3 +exp(-dd2*r)*(1+dd2*r)) + dd2 = dd(indpar+1) indorbp = indorb + 1 - dd1 = dd(indpar+1) DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k))) - END DO -! if(iflagnorm.gt.2) then -! c=dd1**2.5d0/dsqrt(3.d0*pi) - c = dd1**2.5d0*0.32573500793527994772d0 + distp(k, 1) = DEXP(-(dd2*r(k))) + END DO +! endif IF (typec .NE. 1) THEN - fun = distp(0, 1)*(1.d0-dd1*r(0)) - fun2 = distp(0, 1)*(dd1**2*r(0)-2.d0*dd1) - temp93b = 2.d0*zb(indorbp, indt+4)/r(0) - cb = fun2*zb(indorbp, indt+4) + fun*temp93b - funb = c*temp93b - rb(0) = rb(0) - c*fun*temp93b/r(0) - fun2b = c*zb(indorbp, indt+4) + fun = -(dd2**2*distp(0, 1)) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - temp92 = rmu(i, 0)/r(0) - temp92b3 = c*fun*zb(indorbp, indt+i)/r(0) - cb = cb + temp92*fun*zb(indorbp, indt+i) - funb = funb + temp92*c*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp92b3 - rb(0) = rb(0) - temp92*temp92b3 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO + funb0 = funb0 + (1.d0-dd2*r(0))*fun2b + dd2b = -(distp(0, 1)*2*dd2*funb0) - fun*r(0)*fun2b + rb(0) = rb(0) - fun*dd2*fun2b distpb = 0.0_8 - temp92b2 = distp(0, 1)*fun2b - distpb(0, 1) = (1.d0-dd1*r(0))*funb + (dd1**2*r(0)-2.d0*dd1)*fun2b - dd1b = (r(0)*2*dd1-2.d0)*temp92b2 - distp(0, 1)*r(0)*funb - rb(0) = rb(0) + dd1**2*temp92b2 - distp(0, 1)*dd1*funb + distpb(0, 1) = -(dd2**2*funb0) ELSE distpb = 0.0_8 - dd1b = 0.0_8 - cb = 0.0_8 + dd2b = 0.0_8 END IF + dd3b = 0.0_8 DO i=0,0,-1 - temp92b1 = distp(i, 1)*zb(indorbp, i) - cb = cb + r(i)*temp92b1 - rb(i) = rb(i) + c*temp92b1 - distpb(i, 1) = distpb(i, 1) + c*r(i)*zb(indorbp, i) + temp44b1 = distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + (dd2*r(i)+1.d0)*zb(indorbp, i) + dd2b = dd2b + r(i)*temp44b1 + rb(i) = rb(i) + dd2*temp44b1 + dd3b = dd3b + zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO - dd1b = dd1b + 0.32573500793527994772d0*2.5d0*dd1**1.5D0*cb DO k=0,0,-1 - temp92b0 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp92b0 - rb(k) = rb(k) - dd1*temp92b0 + temp44b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp44b0 + rb(k) = rb(k) - dd2*temp44b0 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (6) -! 2s double Z NO CUSP -! normalized -! if(iocc(indshellp).eq.1) then + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (128) +! 2s with cusp condition +! ( r^2*exp(-dd2*r)) ! with no cusp condition + dd2 = dd(indpar+1) indorbp = indorb + 1 - dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) -! if(iflagnorm.gt.2) then -! c= WRONG -! &0.5*dsqrt((1.d0/dd1**5/32.d0+2.d0*peff/(dd1+dd2)**5 -! &+peff**2/dd2**5/32.d0)/(24.d0*pi)) - c = 1.d0/DSQRT(3.d0*pi*(1.d0/dd1**5+64.d0*peff/(dd1+dd2)**5+peff**2/& -& dd2**5)) -! endif DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k))) - distp(k, 2) = c*DEXP(-(dd2*r(k))) + distp(k, 1) = DEXP(-(dd2*r(k))) END DO +! endif IF (typec .NE. 1) THEN - fun = distp(0, 1)*(1.d0-dd1*r(0)) + peff*distp(0, 2)*(1.d0-dd2*r(0& -& )) - temp100b = 2.d0*zb(indorbp, indt+4)/r(0) - funb = temp100b - rb(0) = rb(0) - fun*temp100b/r(0) + fun = (2.d0-dd2*r(0))*distp(0, 1) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - temp99 = fun/r(0) - temp99b7 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(i, 0) = rmub(i, 0) + temp99*zb(indorbp, indt+i) - funb = funb + temp99b7 - rb(0) = rb(0) - temp99*temp99b7 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp99b2 = distp(0, 1)*fun2b - temp99b3 = (dd2**2*r(0)-2.d0*dd2)*fun2b - temp99b4 = peff*distp(0, 2)*fun2b - distpb(0, 1) = (dd1**2*r(0)-2.d0*dd1)*fun2b - dd1b = (r(0)*2*dd1-2.d0)*temp99b2 - distp(0, 1)*r(0)*funb - temp99b5 = peff*distp(0, 2)*funb - rb(0) = rb(0) + dd2**2*temp99b4 - dd2*temp99b5 - distp(0, 1)*dd1*& -& funb + dd1**2*temp99b2 - temp99b6 = (1.d0-dd2*r(0))*funb - peffb = distp(0, 2)*temp99b6 + distp(0, 2)*temp99b3 - distpb(0, 2) = peff*temp99b3 - dd2b = (r(0)*2*dd2-2.d0)*temp99b4 - r(0)*temp99b5 - distpb(0, 1) = distpb(0, 1) + (1.d0-dd1*r(0))*funb - distpb(0, 2) = distpb(0, 2) + peff*temp99b6 + temp44b3 = distp(0, 1)*fun2b + temp44b4 = 2*dd2*r(0)*temp44b3 + dd2b = r(0)*temp44b4 - 4*r(0)*temp44b3 - distp(0, 1)*r(0)*funb0 + rb(0) = rb(0) + dd2*temp44b4 - 4*dd2*temp44b3 - distp(0, 1)*dd2*& +& funb0 + distpb(0, 1) = (2.d0-dd2*r(0))*funb0 + ((dd2*r(0))**2-4*(dd2*r(0))& +& +2.d0)*fun2b ELSE distpb = 0.0_8 - peffb = 0.0_8 - dd1b = 0.0_8 dd2b = 0.0_8 END IF DO i=0,0,-1 - temp99b1 = r(i)*zb(indorbp, i) - rb(i) = rb(i) + (distp(i, 1)+distp(i, 2)*peff)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp99b1 - distpb(i, 2) = distpb(i, 2) + peff*temp99b1 - peffb = peffb + distp(i, 2)*temp99b1 + distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO - cb = 0.0_8 DO k=0,0,-1 - temp99b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp99b - distpb(k, 2) = 0.0_8 - temp99b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp99b0 - dd2*temp99b - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp99b0 + temp44b2 = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp44b2 + rb(k) = rb(k) - dd2*temp44b2 distpb(k, 1) = 0.0_8 END DO - temp98 = dd2**5 - temp97 = peff**2/temp98 - temp96 = (dd1+dd2)**5 - temp95 = dd1**5 - temp94 = 3.d0*pi*(1.0/temp95+64.d0*peff/temp96+temp97) - temp93 = DSQRT(temp94) - IF (temp94 .EQ. 0.0) THEN - temp93b0 = 0.0 - ELSE - temp93b0 = -(pi*3.d0*cb/(temp93**2*2.D0*DSQRT(temp94))) - END IF - temp93b1 = 64.d0*temp93b0/temp96 - temp93b2 = -(peff*5*(dd1+dd2)**4*temp93b1/temp96) - dd1b = dd1b + temp93b2 - 5*dd1**4*temp93b0/temp95**2 - peffb = peffb + 2*peff*temp93b0/temp98 + temp93b1 - dd2b = dd2b + temp93b2 - temp97*5*dd2**4*temp93b0/temp98 - ddb(indpar+3) = ddb(indpar+3) + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (7) -! 2s double Z NO CUSP -! normalized IS WRONG!!! -! if(iocc(indshellp).eq.1) then + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (16) +! s orbital +! +! - angmom = 0 +! - type = Gaussian +! - normalized = yes +! - angtype = spherical +! - npar = 1 +! - multiplicity = 1 +! +! = N * R +! +! where N is the normalization constant +! N = (2*alpha/pi)**(3/4) +! +! and R is the radial part +! R = exp(-alpha*r**2) +! indorbp = indorb + 1 dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) + IF (dd1 .NE. 0.) THEN + c = 0.71270547035499016d0*dd1**0.75d0 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + c = 1.d0 + END IF DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k))) - distp(k, 2) = DEXP(-(dd2*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO -! if(iflagnorm.gt.2) then - c = 1/DSQRT(1/(3.d0/4.d0/dd1**5+peff**2/dd2**3/4+12*peff/(dd1+dd2)**& -& 4))*1.d0/DSQRT(4.0*pi) IF (typec .NE. 1) THEN - fun = -(dd1*distp(0, 1)) + peff*distp(0, 2)*(1.d0-dd2*r(0)) - fun2 = distp(0, 1)*dd1**2 + peff*distp(0, 2)*(dd2**2*r(0)-2.d0*dd2& -& ) - temp110 = fun/r(0) - temp110b = c*2.d0*zb(indorbp, indt+4)/r(0) - cb = (2.d0*temp110+fun2)*zb(indorbp, indt+4) - funb = temp110b - rb(0) = rb(0) - temp110*temp110b - fun2b = c*zb(indorbp, indt+4) +! the first derivative /r + fun = -(2.d0*dd1*distp(0, 1)) +! the second derivative + fun2 = fun*(1.d0-2.d0*dd1*r(0)*r(0)) + IF (typec .EQ. 2) THEN +! Backflow + funb = (fun2-fun)/(r(0)*r(0)) + funbb = rmu(3, 0)*rmu(2, 0)*zb(indorbp, indt+10) + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*funb*zb(indorbp, indt+10) + rmub(3, 0) = rmub(3, 0) + funb*rmu(2, 0)*zb(indorbp, indt+10) + zb(indorbp, indt+10) = 0.0_8 + funbb = funbb + rmu(3, 0)*rmu(1, 0)*zb(indorbp, indt+9) + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*funb*zb(indorbp, indt+9) + rmub(3, 0) = rmub(3, 0) + funb*rmu(1, 0)*zb(indorbp, indt+9) + zb(indorbp, indt+9) = 0.0_8 + funbb = funbb + rmu(2, 0)*rmu(1, 0)*zb(indorbp, indt+8) + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*funb*zb(indorbp, indt+8) + rmub(2, 0) = rmub(2, 0) + funb*rmu(1, 0)*zb(indorbp, indt+8) + zb(indorbp, indt+8) = 0.0_8 + funbb = funbb + rmu(3, 0)**2*zb(indorbp, indt+7) + rmub(3, 0) = rmub(3, 0) + funb*2*rmu(3, 0)*zb(indorbp, indt+7) + funb0 = zb(indorbp, indt+7) + zb(indorbp, indt+7) = 0.0_8 + funbb = funbb + rmu(2, 0)**2*zb(indorbp, indt+6) + rmub(2, 0) = rmub(2, 0) + funb*2*rmu(2, 0)*zb(indorbp, indt+6) + funb0 = funb0 + zb(indorbp, indt+6) + zb(indorbp, indt+6) = 0.0_8 + funbb = funbb + rmu(1, 0)**2*zb(indorbp, indt+5) + rmub(1, 0) = rmub(1, 0) + funb*2*rmu(1, 0)*zb(indorbp, indt+5) + temp45b0 = funbb/r(0)**2 + funb0 = funb0 + zb(indorbp, indt+5) - temp45b0 + zb(indorbp, indt+5) = 0.0_8 + fun2b = temp45b0 + rb(0) = rb(0) - (fun2-fun)*2*temp45b0/r(0) + ELSE + funb0 = 0.0_8 + fun2b = 0.0_8 + END IF + funb0 = funb0 + 2.d0*zb(indorbp, indt+4) + fun2b = fun2b + zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - temp109 = rmu(i, 0)/r(0) - temp109b5 = fun*c*zb(indorbp, indt+i)/r(0) - funb = funb + temp109*c*zb(indorbp, indt+i) - cb = cb + temp109*fun*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp109b5 - rb(0) = rb(0) - temp109*temp109b5 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO + temp45b = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp45b - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp45b distpb = 0.0_8 - temp109b1 = (dd2**2*r(0)-2.d0*dd2)*fun2b - temp109b2 = peff*distp(0, 2)*fun2b - distpb(0, 1) = dd1**2*fun2b - dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb - temp109b3 = (1.d0-dd2*r(0))*funb - peffb = distp(0, 2)*temp109b3 + distp(0, 2)*temp109b1 - distpb(0, 2) = peff*temp109b3 + peff*temp109b1 - temp109b4 = peff*distp(0, 2)*funb - dd2b = (r(0)*2*dd2-2.d0)*temp109b2 - r(0)*temp109b4 - rb(0) = rb(0) + dd2**2*temp109b2 - dd2*temp109b4 - distpb(0, 1) = distpb(0, 1) - dd1*funb + distpb(0, 1) = -(2.d0*dd1*funb0) ELSE distpb = 0.0_8 - peffb = 0.0_8 dd1b = 0.0_8 - dd2b = 0.0_8 - cb = 0.0_8 END IF DO i=0,0,-1 - temp109b = c*zb(indorbp, i) - temp109b0 = distp(i, 2)*temp109b - cb = cb + (distp(i, 1)+r(i)*peff*distp(i, 2))*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp109b - rb(i) = rb(i) + peff*temp109b0 - peffb = peffb + r(i)*temp109b0 - distpb(i, 2) = distpb(i, 2) + r(i)*peff*temp109b + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO - temp108 = (dd1+dd2)**4 - temp107 = 4*dd2**3 - temp106 = peff**2/temp107 - temp105 = 4.d0*dd1**5 - temp100 = 3.d0/temp105 + temp106 + 12*(peff/temp108) - temp104 = 1.0/temp100 - temp103 = DSQRT(temp104) - temp102 = DSQRT(4.0*pi) - temp101 = temp102*temp103 - IF (temp104 .EQ. 0.0) THEN - temp100b2 = 0.0 - ELSE - temp100b2 = temp102*temp104*cb/(temp101**2*2.D0*DSQRT(temp104)*& -& temp100) - END IF - temp100b3 = 12*temp100b2/temp108 - temp100b4 = -(peff*4*(dd1+dd2)**3*temp100b3/temp108) - dd1b = dd1b + temp100b4 - 3.d0*4.d0*5*dd1**4*temp100b2/temp105**2 - peffb = peffb + temp100b3 + 2*peff*temp100b2/temp107 - dd2b = dd2b + temp100b4 - temp106*4*3*dd2**2*temp100b2/temp107 + cb = 0.0_8 DO k=0,0,-1 - temp100b0 = DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp100b0 - distpb(k, 2) = 0.0_8 - temp100b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp100b1 - dd2*temp100b0 - dd1b = dd1b - r(k)*temp100b1 + temp44 = r(k)**2 + temp44b5 = c*DEXP(-(dd1*temp44))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp44))*distpb(k, 1) + dd1b = dd1b - temp44*temp44b5 + rb(k) = rb(k) - dd1*2*r(k)*temp44b5 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+3) = ddb(indpar+3) + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 1) dd1b = dd1b + 0.71270547035499016d0*0.75d0*& +& dd1**(-0.25D0)*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (8) -! 2s double Z WITH CUSP -! normalized -! exp(-dd1*r) + (dd1-zeta) * r * exp(-dd2*r) -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd1 - zeta(1) + CASE (2200:2299) +! d gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative 1200 + npower = iopt + 1 - 2200 +! indorbp=indorb + dd2 = dd(indpar+1) DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k))) - distp(k, 2) = DEXP(-(dd2*r(k))) + distp(k, 1) = -(r(k)**(2*npower)*DEXP(-(dd2*r(k)**2))) END DO -! if(iflagnorm.gt.2) then - c = 1.d0/DSQRT(1/4.d0/dd1**3+12*peff/(dd1+dd2)**4+3*peff**2/4/dd2**5& -& )/DSQRT(4.0*pi) + DO i=0,0 + distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d + distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d + distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d + END DO + DO ic=1,5 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif IF (typec .NE. 1) THEN - fun = -(dd1*distp(0, 1)) + peff*distp(0, 2)*(1.d0-dd2*r(0)) - fun2 = distp(0, 1)*dd1**2 + peff*distp(0, 2)*(dd2**2*r(0)-2.d0*dd2& -& ) - temp119 = fun/r(0) - temp119b = c*2.d0*zb(indorbp, indt+4)/r(0) - cb = (2.d0*temp119+fun2)*zb(indorbp, indt+4) - funb = temp119b - rb(0) = rb(0) - temp119*temp119b - fun2b = c*zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - temp118 = rmu(i, 0)/r(0) - temp118b5 = fun*c*zb(indorbp, indt+i)/r(0) - funb = funb + temp118*c*zb(indorbp, indt+i) - cb = cb + temp118*fun*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp118b5 - rb(0) = rb(0) - temp118*temp118b5 - zb(indorbp, indt+i) = 0.0_8 + rp1 = r(0)**2 + fun0 = distp(0, 1) + fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 + fun2 = (npower*(2.d0*npower-1.d0)-(1.d0+4.d0*npower)*dd2*rp1+2.d0*& +& (dd2*rp1)**2)*distp(0, 1)*2.d0/rp1 +! indorbp=indorb + DO ic=1,5 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (ic .EQ. 1) THEN + IF (i .NE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + END IF + END DO + END DO + distpb = 0.0_8 + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=5,1,-1 + temp49b6 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 6.d0*temp49b6 + fun2b = fun2b + temp49b6 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp49b2 = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp49b2 + fun0b = fun0b + rmu(i, 0)*temp49b2 + ELSE + temp49b3 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp49b3 + fun0b = fun0b + rmu(i, 0)*temp49b3 + END IF + ELSE IF (branch .LT. 4) THEN + temp49b4 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp49b4 + fun0b = fun0b + rmu(i, 0)*temp49b4 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp49b5 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp49b5 + fun0b = fun0b + rmu(i, 0)*temp49b5 + ELSE + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + temp49b1 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp49b1 + funb0 = funb0 + rmu(i, 0)*temp49b1 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp118b1 = (dd2**2*r(0)-2.d0*dd2)*fun2b - temp118b2 = peff*distp(0, 2)*fun2b - distpb(0, 1) = dd1**2*fun2b - dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb - temp118b3 = (1.d0-dd2*r(0))*funb - peffb = distp(0, 2)*temp118b3 + distp(0, 2)*temp118b1 - distpb(0, 2) = peff*temp118b3 + peff*temp118b1 - temp118b4 = peff*distp(0, 2)*funb - dd2b = (r(0)*2*dd2-2.d0)*temp118b2 - r(0)*temp118b4 - rb(0) = rb(0) + dd2**2*temp118b2 - dd2*temp118b4 - distpb(0, 1) = distpb(0, 1) - dd1*funb + temp48 = distp(0, 1)/rp1 + temp49b = 2.d0*temp48*fun2b + temp49b0 = -((npower*4.d0+1.d0)*temp49b) + temp48b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& +& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 + temp47 = distp(0, 1)/rp1 + temp48b0 = 2.d0*temp47*funb0 + dd2b = rp1*temp49b0 - rp1*temp48b0 + 2.d0*rp1**2*2*dd2*temp49b + temp47b = 2.d0*(npower-dd2*rp1)*funb0/rp1 + rp1b = dd2*temp49b0 - temp47*temp47b - temp48*temp48b - dd2*& +& temp48b0 + 2.d0*dd2**2*2*rp1*temp49b + distpb(0, 1) = distpb(0, 1) + temp47b + fun0b + temp48b + rb(0) = rb(0) + 2*r(0)*rp1b ELSE distpb = 0.0_8 - peffb = 0.0_8 - dd1b = 0.0_8 dd2b = 0.0_8 - cb = 0.0_8 END IF + DO ic=5,1,-1 + DO i=0,0,-1 + distpb(i, 1+ic) = distpb(i, 1+ic) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + distp(i, 1+ic)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO DO i=0,0,-1 - temp118b = c*zb(indorbp, i) - temp118b0 = distp(i, 2)*temp118b - cb = cb + (distp(i, 1)+r(i)*peff*distp(i, 2))*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp118b - rb(i) = rb(i) + peff*temp118b0 - peffb = peffb + r(i)*temp118b0 - distpb(i, 2) = distpb(i, 2) + r(i)*peff*temp118b - zb(indorbp, i) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) + distpb(i, 2) = 0.0_8 END DO - temp117 = 4*dd2**5 - temp111 = peff**2/temp117 - temp116 = (dd1+dd2)**4 - temp115 = 4.d0*dd1**3 - temp112 = 1.0/temp115 + 12*(peff/temp116) + 3*temp111 - temp114 = DSQRT(temp112) - temp113 = DSQRT(4.0*pi) - IF (temp112 .EQ. 0.0) THEN - temp112b = 0.0 - ELSE - temp112b = -(cb/(temp113*temp114**2*2.D0*DSQRT(temp112))) - END IF - temp112b0 = 12*temp112b/temp116 - temp112b1 = -(peff*4*(dd1+dd2)**3*temp112b0/temp116) - temp111b1 = 3*temp112b/temp117 - dd1b = dd1b + temp112b1 - 4.d0*3*dd1**2*temp112b/temp115**2 - peffb = peffb + 2*peff*temp111b1 + temp112b0 - dd2b = dd2b + temp112b1 - temp111*4*5*dd2**4*temp111b1 DO k=0,0,-1 - temp111b = DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp111b - distpb(k, 2) = 0.0_8 - temp111b0 = DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp111b0 - dd2*temp111b - dd1b = dd1b - r(k)*temp111b0 + temp46 = r(k)**2 + temp45 = 2*npower + temp45b1 = -(r(k)**temp45*DEXP(-(dd2*temp46))*distpb(k, 1)) + IF (r(k) .LE. 0.0 .AND. (temp45 .EQ. 0.0 .OR. temp45 .NE. INT(& +& temp45))) THEN + rb(k) = rb(k) - dd2*2*r(k)*temp45b1 + ELSE + rb(k) = rb(k) - dd2*2*r(k)*temp45b1 - DEXP(-(dd2*temp46))*temp45& +& *r(k)**(temp45-1)*distpb(k, 1) + END IF + dd2b = dd2b - temp46*temp45b1 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (10) -! 3s single zeta -! R(r)=r**2*exp(-z1*r) -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2*dd1)**7/720.d0/pi)/2.d0 - c = dd1**3.5d0*0.11894160774351807429d0 -! endif + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (55) +! g single Slater orbital +! R(r)= exp(-alpha r) +! normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization +! l = 4 +! \int d\omega Y*Y = 4 pi / (2 l + 1) +! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5**2 * 3**4 / 2**3 / dd1**11 +! c=1.d0/dsqrt(7.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(11.d0/2.d0)/3.d0/5.d0 + c = dd1**5.5d0*.020104801169736915d0 +! endif DO k=0,0 distp(k, 1) = c*DEXP(-(dd1*r(k))) END DO + DO i=0,0 + distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& +& 2+3.d0*r(i)**4) +! lz=0 + distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& +& 2-r(i)**2) +! lz=+/-2 + distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& +& (i)**2) +! lz=+/-2 + distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & +& i)**2) +! lz=+/-3 + distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& +& , i)**2) +! lz=+/-3 + distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& +& rmu(2, i)**4) +! lz=+/-4 + distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& +& , i)**2) + END DO +! lz=+/-4 + DO ic=1,9 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif IF (typec .NE. 1) THEN - fun = (2.d0-dd1*r(0))*distp(0, 1) - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1) + fun = -(dd1*distp(0, 1)/r(0)) + fun2 = dd1**2*distp(0, 1) +! indorbp=indorb + DO ic=1,9 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (ic .EQ. 1) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + END IF + ELSE IF (ic .EQ. 6) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + END IF + ELSE IF (ic .EQ. 7) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,21) + END IF + ELSE IF (ic .EQ. 8) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,22) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,24) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,23) + END IF + ELSE IF (ic .EQ. 9) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,26) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,28) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,27) + END IF + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,25) + END IF + END DO + END DO + distpb = 0.0_8 + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=9,1,-1 + temp50b55 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 10.d0*temp50b55 + fun2b = fun2b + temp50b55 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 15) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp50b0 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& +& 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& +& ) + rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& +& , 0)**2)*temp50b0 + rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp50b0 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& +& )*temp50b0 + ELSE + temp50b1 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& +& 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& +& ) + rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& +& , 0)**2)*temp50b1 + rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp50b1 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& +& )*temp50b1 + END IF + ELSE IF (branch .LT. 4) THEN + temp50b2 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& +& 3, 0)*r(0)**2))*zb(indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& +& r(0)**2)*temp50b2 + rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp50b2 + ELSE + temp50b3 = cost2g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& +& , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& +& (indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& +& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp50b3 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp50b3 + rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp50b3 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp50b4 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp50b5 = rmu(2, 0)*rmu(3, 0)*temp50b4 + temp50b6 = fun0*rmu(1, 0)*temp50b4 + fun0b = fun0b + rmu(1, 0)*temp50b5 + rmub(1, 0) = rmub(1, 0) + fun0*temp50b5 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp50b6 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp50b6 + ELSE + temp50b7 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp50b8 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**& +& 2)*temp50b7 + temp50b9 = fun0*rmu(1, 0)*temp50b7 + fun0b = fun0b + rmu(1, 0)*temp50b8 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp50b9 + fun0*& +& temp50b8 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp50b9 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp50b9 + END IF + ELSE + temp50b10 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp50b11 = rmu(2, 0)*rmu(3, 0)*temp50b10 + temp50b12 = fun0*rmu(1, 0)*temp50b10 + fun0b = fun0b + rmu(1, 0)*temp50b11 + rmub(1, 0) = rmub(1, 0) + fun0*temp50b11 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp50b12 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp50b12 + END IF + ELSE IF (branch .LT. 12) THEN + IF (branch .LT. 10) THEN + IF (branch .LT. 9) THEN + temp50b13 = cost2g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& +& , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& +& (indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& +& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp50b13 + rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp50b13 + rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp50b13 + ELSE + temp50b14 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp50b15 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& +& **2)*temp50b14 + temp50b16 = fun0*rmu(2, 0)*temp50b14 + fun0b = fun0b + rmu(2, 0)*temp50b15 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp50b16 + fun0& +& *temp50b15 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp50b16 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp50b16 + END IF + ELSE IF (branch .LT. 11) THEN + temp50b17 = -(cost3g*4.d0*zb(indorbp, indt+i)) + temp50b18 = fun0*temp50b17 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& +& **2))*temp50b17 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& +& **2)*temp50b18 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& +& temp50b18 + ELSE + temp50b19 = cost3g*4.d0*zb(indorbp, indt+i) + temp50b20 = fun0*temp50b19 + fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& +& **2))*temp50b19 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& +& **2)*temp50b20 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& +& temp50b20 + END IF + ELSE IF (branch .LT. 14) THEN + IF (branch .LT. 13) THEN + temp50b21 = cost3g*12.d0*zb(indorbp, indt+i) + temp50b22 = fun0*rmu(3, 0)*temp50b21 + temp50b23 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp50b21 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp50b22 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp50b22 + fun0b = fun0b + rmu(3, 0)*temp50b23 + rmub(3, 0) = rmub(3, 0) + fun0*temp50b23 + ELSE + temp50b24 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp50b25 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3, & +& 0)**2)*temp50b24 + temp50b26 = fun0*rmu(2, 0)*temp50b24 + fun0b = fun0b + rmu(2, 0)*temp50b25 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp50b26 + fun0*& +& temp50b25 + rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp50b26 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp50b26 + END IF + ELSE + temp50b27 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp50b28 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0)& +& **2)*temp50b27 + temp50b29 = fun0*rmu(1, 0)*temp50b27 + fun0b = fun0b + rmu(1, 0)*temp50b28 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp50b29 + fun0*& +& temp50b28 + rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp50b29 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp50b29 + END IF + ELSE IF (branch .LT. 22) THEN + IF (branch .LT. 19) THEN + IF (branch .LT. 17) THEN + IF (branch .LT. 16) THEN + temp50b30 = cost3g*24.d0*zb(indorbp, indt+i) + temp50b31 = rmu(2, 0)*rmu(3, 0)*temp50b30 + temp50b32 = fun0*rmu(1, 0)*temp50b30 + fun0b = fun0b + rmu(1, 0)*temp50b31 + rmub(1, 0) = rmub(1, 0) + fun0*temp50b31 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp50b32 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp50b32 + ELSE + temp50b33 = cost4g*3.d0*zb(indorbp, indt+i) + temp50b34 = fun0*rmu(3, 0)*temp50b33 + temp50b35 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp50b33 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp50b34 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp50b34 + fun0b = fun0b + rmu(3, 0)*temp50b35 + rmub(3, 0) = rmub(3, 0) + fun0*temp50b35 + END IF + ELSE IF (branch .LT. 18) THEN + temp50b36 = -(cost4g*6.d0*zb(indorbp, indt+i)) + temp50b37 = rmu(2, 0)*rmu(3, 0)*temp50b36 + temp50b38 = fun0*rmu(1, 0)*temp50b36 + fun0b = fun0b + rmu(1, 0)*temp50b37 + rmub(1, 0) = rmub(1, 0) + fun0*temp50b37 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp50b38 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp50b38 + ELSE + temp50b39 = cost4g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& +& (2, 0)**2))*zb(indorbp, indt+i) + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& +& **2)*temp50b39 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp50b39 + END IF + ELSE IF (branch .LT. 21) THEN + IF (branch .LT. 20) THEN + temp50b40 = cost4g*6.d0*zb(indorbp, indt+i) + temp50b41 = rmu(2, 0)*rmu(3, 0)*temp50b40 + temp50b42 = fun0*rmu(1, 0)*temp50b40 + fun0b = fun0b + rmu(1, 0)*temp50b41 + rmub(1, 0) = rmub(1, 0) + fun0*temp50b41 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp50b42 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp50b42 + ELSE + temp50b43 = cost4g*3.d0*zb(indorbp, indt+i) + temp50b44 = fun0*rmu(3, 0)*temp50b43 + temp50b45 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp50b43 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp50b44 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp50b44 + fun0b = fun0b + rmu(3, 0)*temp50b45 + rmub(3, 0) = rmub(3, 0) + fun0*temp50b45 + END IF + ELSE + temp50b46 = cost4g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& +& 2, 0)**3)*zb(indorbp, indt+i) + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp50b46 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& +& 2)*temp50b46 + END IF + ELSE IF (branch .LT. 26) THEN + IF (branch .LT. 24) THEN + IF (branch .LT. 23) THEN + temp50b47 = cost5g*4.d0*zb(indorbp, indt+i) + temp50b48 = fun0*temp50b47 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& +& **2))*temp50b47 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& +& **2)*temp50b48 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp50b48 + END IF + ELSE IF (branch .LT. 25) THEN + temp50b49 = cost5g*4.d0*zb(indorbp, indt+i) + temp50b50 = fun0*temp50b49 + fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& +& ))*temp50b49 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& +& 2)*temp50b50 + rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp50b50 + END IF + ELSE IF (branch .LT. 28) THEN + IF (branch .LT. 27) THEN + temp50b51 = cost5g*4.d0*zb(indorbp, indt+i) + temp50b52 = fun0*temp50b51 + fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& +& 3)*temp50b51 + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp50b52 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& +& 2)*temp50b52 + END IF + ELSE + temp50b53 = cost5g*4.d0*zb(indorbp, indt+i) + temp50b54 = fun0*temp50b53 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& +& *temp50b53 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& +& *temp50b54 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp50b54 + END IF + temp50b = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp50b + funb0 = funb0 + rmu(i, 0)*temp50b + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp120b0 = distp(0, 1)*fun2b - temp120b1 = 2*dd1*r(0)*temp120b0 - dd1b = r(0)*temp120b1 - 4*r(0)*temp120b0 - distp(0, 1)*r(0)*funb - rb(0) = rb(0) + dd1*temp120b1 - 4*dd1*temp120b0 - distp(0, 1)*dd1*& -& funb - distpb(0, 1) = (2.d0-dd1*r(0))*funb + ((dd1*r(0))**2-4*(dd1*r(0))+& -& 2.d0)*fun2b + temp49b26 = -(distp(0, 1)*funb0/r(0)) + dd1b = temp49b26 + distp(0, 1)*2*dd1*fun2b + temp49 = dd1/r(0) + distpb(0, 1) = distpb(0, 1) + fun0b - temp49*funb0 + dd1**2*fun2b + rb(0) = rb(0) - temp49*temp49b26 + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd1b = 0.0_8 END IF - DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - cb = 0.0_8 - DO k=0,0,-1 - temp120b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp120b - rb(k) = rb(k) - dd1*temp120b - distpb(k, 1) = 0.0_8 - END DO - dd1b = dd1b + 0.11894160774351807429d0*3.5d0*dd1**2.5D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (11) -! 3s double zeta -! R(r)=r**2*(exp(-z1*r)+p*exp(-z2*r)) -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) -! if(iflagnorm.gt.2) then - c = 1.d0/2.d0/DSQRT(pi*720.d0*(1.d0/(2.d0*dd1)**7+2.d0*peff/(dd1+dd2& -& )**7+peff**2/(2.d0*dd2)**7)) -! endif - DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k))) - distp(k, 2) = c*DEXP(-(dd2*r(k))) - END DO - IF (typec .NE. 1) THEN - rp1 = r(0)**2 -! the first derivative - fun = distp(0, 1)*(2.d0*r(0)-dd1*rp1) + peff*distp(0, 2)*(2.d0*r(0& -& )-dd2*rp1) -! -! the second derivative - temp129b = 2.d0*zb(indorbp, indt+4)/r(0) - funb = temp129b - rb(0) = rb(0) - fun*temp129b/r(0) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - temp128 = fun/r(0) - temp128b8 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(i, 0) = rmub(i, 0) + temp128*zb(indorbp, indt+i) - funb = funb + temp128b8 - rb(0) = rb(0) - temp128*temp128b8 - zb(indorbp, indt+i) = 0.0_8 + DO ic=9,1,-1 + DO k=0,0,-1 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 END DO - distpb = 0.0_8 - temp128b2 = distp(0, 1)*fun2b - temp128b3 = (dd2**2*rp1-4.d0*(dd2*r(0))+2.d0)*fun2b - temp128b4 = peff*distp(0, 2)*fun2b - distpb(0, 1) = (dd1**2*rp1-4.d0*(dd1*r(0))+2.d0)*fun2b - temp128b5 = distp(0, 1)*funb - dd1b = (rp1*2*dd1-4.d0*r(0))*temp128b2 - rp1*temp128b5 - temp128b6 = peff*distp(0, 2)*funb - rp1b = dd2**2*temp128b4 - dd2*temp128b6 - dd1*temp128b5 + dd1**2*& -& temp128b2 - rb(0) = rb(0) + 2.d0*temp128b5 + 2.d0*temp128b6 + 2*r(0)*rp1b - & -& 4.d0*dd2*temp128b4 - 4.d0*dd1*temp128b2 - temp128b7 = (2.d0*r(0)-dd2*rp1)*funb - peffb = distp(0, 2)*temp128b7 + distp(0, 2)*temp128b3 - distpb(0, 2) = peff*temp128b3 - dd2b = (rp1*2*dd2-4.d0*r(0))*temp128b4 - rp1*temp128b6 - distpb(0, 1) = distpb(0, 1) + (2.d0*r(0)-dd1*rp1)*funb - distpb(0, 2) = distpb(0, 2) + peff*temp128b7 - ELSE - distpb = 0.0_8 - peffb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 - END IF - DO i=0,0,-1 - temp128b1 = r(i)**2*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp128b1 - peffb = peffb + distp(i, 2)*temp128b1 - distpb(i, 2) = distpb(i, 2) + peff*temp128b1 - rb(i) = rb(i) + (distp(i, 1)+peff*distp(i, 2))*2*r(i)*zb(indorbp, & -& i) - zb(indorbp, i) = 0.0_8 - END DO - cb = 0.0_8 - DO k=0,0,-1 - temp128b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp128b - distpb(k, 2) = 0.0_8 - temp128b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp128b0 - dd2*temp128b - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp128b0 - distpb(k, 1) = 0.0_8 - END DO - temp127 = 2.d0**7 - temp126 = temp127*dd2**7 - temp125 = peff**2/temp126 - temp124 = (dd1+dd2)**7 - temp123 = 2.d0**7 - temp122 = temp123*dd1**7 - temp121 = 720.d0*pi*(1.0/temp122+2.d0*peff/temp124+temp125) - temp120 = DSQRT(temp121) - IF (temp121 .EQ. 0.0) THEN - temp120b2 = 0.0 - ELSE - temp120b2 = -(pi*720.d0*cb/(2.d0*temp120**2*2.D0*DSQRT(temp121))) - END IF - temp120b3 = 2.d0*temp120b2/temp124 - temp120b4 = -(peff*7*(dd1+dd2)**6*temp120b3/temp124) - dd1b = dd1b + temp120b4 - temp123*7*dd1**6*temp120b2/temp122**2 - peffb = peffb + 2*peff*temp120b2/temp126 + temp120b3 - dd2b = dd2b + temp120b4 - temp125*temp127*7*dd2**6*temp120b2/temp126 - ddb(indpar+3) = ddb(indpar+3) + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (12) -! 4s single zeta -! R(r)=r**3*exp(-z1*r) -! -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 - c = dd1**4.5d0*.03178848180059307346d0 -! endif - DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k))) + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - IF (typec .NE. 1) THEN - rp1 = r(0)**3 - rp2 = r(0)**2 -! -!c the first derivative - fun = distp(0, 1)*(3.d0*rp2-dd1*rp1) -!c -!c the second derivative - temp130b = 2.d0*zb(indorbp, indt+4)/r(0) - funb = temp130b - rb(0) = rb(0) - fun*temp130b/r(0) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - temp129 = fun/r(0) - temp129b3 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(i, 0) = rmub(i, 0) + temp129*zb(indorbp, indt+i) - funb = funb + temp129b3 - rb(0) = rb(0) - temp129*temp129b3 - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp129b1 = distp(0, 1)*fun2b - distpb(0, 1) = (3.d0*rp2-dd1*rp1)*funb + (6.d0*r(0)-6.d0*(dd1*rp2)& -& +dd1**2*rp1)*fun2b - temp129b2 = distp(0, 1)*funb - rp2b = 3.d0*temp129b2 - 6.d0*dd1*temp129b1 - rp1b = dd1**2*temp129b1 - dd1*temp129b2 - rb(0) = rb(0) + 2*r(0)*rp2b + 3*r(0)**2*rp1b + 6.d0*temp129b1 - dd1b = (rp1*2*dd1-6.d0*rp2)*temp129b1 - rp1*temp129b2 - ELSE - distpb = 0.0_8 - dd1b = 0.0_8 - END IF DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**3*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*3*r(i)**2*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + temp49b8 = cost5g*4.d0*distpb(i, 10) + temp49b9 = (rmu(1, i)**2-rmu(2, i)**2)*temp49b8 + temp49b10 = rmu(1, i)*rmu(2, i)*temp49b8 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp49b10 + rmu(2, i)*& +& temp49b9 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp49b9 - 2*rmu(2, i)*& +& temp49b10 + distpb(i, 10) = 0.0_8 + temp49b11 = cost5g*distpb(i, 9) + rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& +& 1, i))*temp49b11 + distpb(i, 9) = 0.0_8 + temp49b12 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) + temp49b13 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp49b12 - 2*rmu(2, i)*& +& temp49b13 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& +& temp49b11 + rmub(3, i) = rmub(3, i) + rmu(2, i)*temp49b12 + distpb(i, 8) = 0.0_8 + temp49b14 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) + temp49b15 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp49b14 + 2*rmu(1, i)*& +& temp49b15 + 3.d0*2*rmu(1, i)*temp49b13 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp49b14 + rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp49b15 + distpb(i, 7) = 0.0_8 + temp49b16 = cost3g*2.d0*distpb(i, 6) + temp49b17 = (7.d0*rmu(3, i)**2-r(i)**2)*temp49b16 + temp49b18 = rmu(1, i)*rmu(2, i)*temp49b16 + rmub(1, i) = rmub(1, i) + rmu(2, i)*temp49b17 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp49b17 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp49b18 + distpb(i, 6) = 0.0_8 + temp49b19 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) + temp49b20 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + temp49b21 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) + temp49b22 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + temp49b23 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) + temp49b24 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + temp49b25 = cost1g*distpb(i, 2) + rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& +& temp49b25 - 3.d0*2*r(i)*temp49b24 - 2*r(i)*temp49b20 - 3.d0*2*r(& +& i)*temp49b22 - 2*r(i)*temp49b18 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp49b19 + rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp49b19 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp49b20 + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp49b21 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp49b22 + rmu(2, i)*& +& temp49b21 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp49b23 + rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& +& rmu(3, i))*temp49b25 + 7.d0*2*rmu(3, i)*temp49b24 + rmu(1, i)*& +& temp49b23 + distpb(i, 2) = 0.0_8 END DO + dd1b = 0.0_8 cb = 0.0_8 DO k=0,0,-1 - temp129b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + temp49b7 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp129b0 - rb(k) = rb(k) - dd1*temp129b0 + dd1b = dd1b - r(k)*temp49b7 + rb(k) = rb(k) - dd1*temp49b7 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + .03178848180059307346d0*4.5d0*dd1**3.5D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (13) -! -! 4s double zeta -! R(r)=r**3*(exp(-z1*r)+z3*exp(-z2*r)) -! -! + dd1b = dd1b + .020104801169736915d0*5.5d0*dd1**4.5D0*cb + ddb(indparp) = ddb(indparp) + dd1b + CASE (2) ! ! if(iocc(indshellp).eq.1) then -! indorbp = indorb + 1 dd1 = dd(indpar+1) dd2 = dd(indpar+2) - dd3 = dd(indpar+3) + peff = (zeta(1)-dd1)/(dd2-zeta(1)) ! if(iflagnorm.gt.2) then - c = 1.d0/2.d0/DSQRT(pi*40320.d0*(1.d0/(2.d0*dd1)**9+2.d0*dd3/(dd1+& -& dd2)**9+dd3**2/(2.d0*dd2)**9)) + c = 1.d0/2.d0/DSQRT(2.d0*pi*(1.d0/(2.d0*dd1)**3+2.d0*peff/(dd1+dd2)& +& **3+peff**2/(2.d0*dd2)**3)) ! endif -! DO k=0,0 distp(k, 1) = c*DEXP(-(dd1*r(k))) distp(k, 2) = c*DEXP(-(dd2*r(k))) END DO -! IF (typec .NE. 1) THEN - rp1 = r(0)**3 - rp2 = r(0)**2 -! -!c the first derivative - fun = distp(0, 1)*(3.d0*rp2-dd1*rp1) + dd3*distp(0, 2)*(3.d0*rp2-& -& dd2*rp1) -!c -! the second derivative - temp139b = 2.d0*zb(indorbp, indt+4)/r(0) - funb = temp139b - rb(0) = rb(0) - fun*temp139b/r(0) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - temp138 = fun/r(0) - temp138b8 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(i, 0) = rmub(i, 0) + temp138*zb(indorbp, indt+i) - funb = funb + temp138b8 - rb(0) = rb(0) - temp138*temp138b8 - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp138b2 = distp(0, 1)*fun2b - temp138b3 = (6.d0*r(0)-6.d0*(dd2*rp2)+dd2**2*rp1)*fun2b - temp138b4 = dd3*distp(0, 2)*fun2b - distpb(0, 1) = (6.d0*r(0)-6.d0*(dd1*rp2)+dd1**2*rp1)*fun2b - temp138b5 = distp(0, 1)*funb - temp138b6 = dd3*distp(0, 2)*funb - rp2b = 3.d0*temp138b5 + 3.d0*temp138b6 - 6.d0*dd2*temp138b4 - 6.d0& -& *dd1*temp138b2 - rp1b = dd2**2*temp138b4 - dd2*temp138b6 - dd1*temp138b5 + dd1**2*& -& temp138b2 - rb(0) = rb(0) + 2*r(0)*rp2b + 3*r(0)**2*rp1b + 6.d0*temp138b4 + & -& 6.d0*temp138b2 - dd1b = (rp1*2*dd1-6.d0*rp2)*temp138b2 - rp1*temp138b5 - temp138b7 = (3.d0*rp2-dd2*rp1)*funb - dd3b = distp(0, 2)*temp138b7 + distp(0, 2)*temp138b3 - distpb(0, 2) = dd3*temp138b3 - dd2b = (rp1*2*dd2-6.d0*rp2)*temp138b4 - rp1*temp138b6 - distpb(0, 1) = distpb(0, 1) + (3.d0*rp2-dd1*rp1)*funb - distpb(0, 2) = distpb(0, 2) + dd3*temp138b7 - ELSE + fun = (-(dd1*distp(0, 1))-dd2*distp(0, 2)*peff)/r(0) distpb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 - dd3b = 0.0_8 - END IF - DO i=0,0,-1 - temp138b1 = r(i)**3*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp138b1 - dd3b = dd3b + distp(i, 2)*temp138b1 - distpb(i, 2) = distpb(i, 2) + dd3*temp138b1 - rb(i) = rb(i) + (distp(i, 1)+dd3*distp(i, 2))*3*r(i)**2*zb(indorbp& -& , i) - zb(indorbp, i) = 0.0_8 - END DO - cb = 0.0_8 - DO k=0,0,-1 - temp138b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp138b - distpb(k, 2) = 0.0_8 - temp138b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp138b0 - dd2*temp138b - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp138b0 - distpb(k, 1) = 0.0_8 - END DO - temp137 = 2.d0**9 - temp136 = temp137*dd2**9 - temp135 = dd3**2/temp136 - temp134 = (dd1+dd2)**9 - temp133 = 2.d0**9 - temp132 = temp133*dd1**9 - temp131 = 40320.d0*pi*(1.0/temp132+2.d0*dd3/temp134+temp135) - temp130 = DSQRT(temp131) - IF (temp131 .EQ. 0.0) THEN - temp130b0 = 0.0 - ELSE - temp130b0 = -(pi*40320.d0*cb/(2.d0*temp130**2*2.D0*DSQRT(temp131))& -& ) - END IF - temp130b1 = 2.d0*temp130b0/temp134 - temp130b2 = -(dd3*9*(dd1+dd2)**8*temp130b1/temp134) - dd1b = dd1b + temp130b2 - temp133*9*dd1**8*temp130b0/temp132**2 - dd3b = dd3b + 2*dd3*temp130b0/temp136 + temp130b1 - dd2b = dd2b + temp130b2 - temp135*temp137*9*dd2**8*temp130b0/temp136 - ddb(indpar+3) = ddb(indpar+3) + dd3b - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (14) -! 1s single Z pseudo -! (1.d0 + dd1 r) * exp(-dd1 * r) ! normalized -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) - DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k))) - END DO -! if(iflagnorm.gt.2) then -! c=dsqrt(dd1**3.d0/7.d0/pi) - c = dd1**1.5d0*0.213243618622923d0 - IF (typec .NE. 1) THEN - fun = -(distp(0, 1)*dd1**2*r(0)) - fun2 = -(distp(0, 1)*dd1**2*(1.d0-dd1*r(0))) - temp140b = 2.d0*zb(indorbp, indt+4)/r(0) - cb = fun2*zb(indorbp, indt+4) + fun*temp140b - funb = c*temp140b - rb(0) = rb(0) - c*fun*temp140b/r(0) - fun2b = c*zb(indorbp, indt+4) + temp57 = dd1/r(0) + temp57b = -(distp(0, 1)*2.d0*zb(indorbp, indt+4)/r(0)) + temp57b0 = peff*distp(0, 2)*zb(indorbp, indt+4) + temp56 = dd2/r(0) + temp56b2 = -(2.d0*temp57b0/r(0)) + temp56b3 = (dd2**2-2.d0*temp56)*zb(indorbp, indt+4) + dd1b = temp57b + distp(0, 1)*2*dd1*zb(indorbp, indt+4) + rb(0) = rb(0) - temp56*temp56b2 - temp57*temp57b + distpb(0, 1) = (dd1**2-2.d0*temp57)*zb(indorbp, indt+4) + dd2b = temp56b2 + 2*dd2*temp57b0 + peffb = distp(0, 2)*temp56b3 + distpb(0, 2) = peff*temp56b3 zb(indorbp, indt+4) = 0.0_8 + funb0 = 0.0_8 DO i=3,1,-1 - temp139 = rmu(i, 0)/r(0) - temp139b6 = c*fun*zb(indorbp, indt+i)/r(0) - cb = cb + temp139*fun*zb(indorbp, indt+i) - funb = funb + temp139*c*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp139b6 - rb(0) = rb(0) - temp139*temp139b6 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO - distpb = 0.0_8 - temp139b3 = -((1.d0-dd1*r(0))*fun2b) - temp139b4 = -(distp(0, 1)*dd1**2*fun2b) - temp139b5 = -(dd1**2*funb) - distpb(0, 1) = r(0)*temp139b5 + dd1**2*temp139b3 - dd1b = distp(0, 1)*2*dd1*temp139b3 - r(0)*temp139b4 - distp(0, 1)*& -& r(0)*2*dd1*funb - rb(0) = rb(0) + distp(0, 1)*temp139b5 - dd1*temp139b4 + temp56b1 = funb0/r(0) + dd1b = dd1b - distp(0, 1)*temp56b1 + distpb(0, 1) = distpb(0, 1) - dd1*temp56b1 + distpb(0, 2) = distpb(0, 2) - dd2*peff*temp56b1 + dd2b = dd2b - distp(0, 2)*peff*temp56b1 + peffb = peffb - distp(0, 2)*dd2*temp56b1 + rb(0) = rb(0) - (-(dd1*distp(0, 1))-distp(0, 2)*(dd2*peff))*& +& temp56b1/r(0) ELSE distpb = 0.0_8 + peffb = 0.0_8 dd1b = 0.0_8 - cb = 0.0_8 + dd2b = 0.0_8 END IF DO i=0,0,-1 - temp139b1 = c*distp(i, 1)*zb(indorbp, i) - temp139b2 = (dd1*r(i)+1.d0)*zb(indorbp, i) - dd1b = dd1b + r(i)*temp139b1 - rb(i) = rb(i) + dd1*temp139b1 - cb = cb + distp(i, 1)*temp139b2 - distpb(i, 1) = distpb(i, 1) + c*temp139b2 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + peffb = peffb + distp(i, 2)*zb(indorbp, i) + distpb(i, 2) = distpb(i, 2) + peff*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO - dd1b = dd1b + 0.213243618622923d0*1.5d0*dd1**0.5D0*cb + cb = 0.0_8 DO k=0,0,-1 - temp139b0 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp139b0 - rb(k) = rb(k) - dd1*temp139b0 + temp56b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp56b + distpb(k, 2) = 0.0_8 + temp56b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp56b0 - dd2*temp56b + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp56b0 distpb(k, 1) = 0.0_8 END DO + temp55 = 2.d0**3*dd2**3 + temp54 = peff**2/temp55 + temp53 = (dd1+dd2)**3 + temp52 = 2.d0**3*dd1**3 + temp51 = 2.d0*pi*(1.0/temp52+2.d0*peff/temp53+temp54) + temp50 = DSQRT(temp51) + IF (temp51 .EQ. 0.0) THEN + temp50b56 = 0.0 + ELSE + temp50b56 = -(pi*cb/(temp50**2*2.D0*DSQRT(temp51))) + END IF + temp50b57 = 2.d0*temp50b56/temp53 + temp50b58 = -(peff*3*(dd1+dd2)**2*temp50b57/temp53) + peffb = peffb + 2*peff*temp50b56/temp55 + temp50b57 + temp50b59 = peffb/(dd2-zeta(1)) + dd1b = dd1b + temp50b58 - temp50b59 - 2.d0**3*3*dd1**2*temp50b56/& +& temp52**2 + dd2b = dd2b + temp50b58 - temp54*2.d0**3*3*dd2**2*temp50b56/temp55 -& +& (zeta(1)-dd1)*temp50b59/(dd2-zeta(1)) + ddb(indpar+2) = ddb(indpar+2) + dd2b ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (15) -! 1s single Z pseudo -! (r**2 + dd2*(1 + dd1*r))*exp(-dd1*r) ! normalized -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 + CASE (23) +! 1s double Z NO CUSP +! 3p without cusp condition +! r ( e^{-z2 r } + z1 e^{-z3 r } ) dd1 = dd(indpar+1) dd2 = dd(indpar+2) - c = DSQRT(2.d0*dd1**7/pi/(45.d0+42.d0*dd1**2*dd2+14.d0*dd1**4*dd2**2& -& )) + dd3 = dd(indpar+3) +! if(iflagnorm.gt.2) then + c = 1.d0/2.d0/DSQRT(240.d0*pi*(1.d0/(2.d0*dd1)**7+2.d0*dd3/(dd1+dd2)& +& **7+dd3**2/(2.d0*dd2)**7)) +! endif +! DO k=0,0 distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 2) = c*DEXP(-(dd2*r(k))) + END DO +! + DO i=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = r(i)*(distp(i, 1)+dd3*distp(i, 2)) + END DO +! +! indorbp=indorb +! + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic END DO +! endif +! +! IF (typec .NE. 1) THEN - fun = distp(0, 1)*r(0)*(2.d0-dd1**2*dd2-dd1*r(0)) - temp147b = 2.d0*zb(indorbp, indt+4)/r(0) - funb = temp147b - rb(0) = rb(0) - fun*temp147b/r(0) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - temp146 = fun/r(0) - temp146b0 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(i, 0) = rmub(i, 0) + temp146*zb(indorbp, indt+i) - funb = funb + temp146b0 - rb(0) = rb(0) - temp146*temp146b0 - zb(indorbp, indt+i) = 0.0_8 + fun = (1.d0-dd1*r(0))*distp(0, 1) + dd3*(1.d0-dd2*r(0))*distp(0, 2& +& ) + fun2 = dd1*(dd1*r(0)-2.d0)*distp(0, 1) + dd3*dd2*(dd2*r(0)-2.d0)*& +& distp(0, 2) +! +! indorbp=indorb +! + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp67 = fun/r(0) + temp68b = rmu(ic, 0)*zb(indorbp, indt+4) + temp67b = 4.d0*temp68b/r(0) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp67+fun2)*zb(indorbp, indt+& +& 4) + funb0 = funb0 + temp67b + rb(0) = rb(0) - temp67*temp67b + fun2b = fun2b + temp68b + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp66 = fun/r(0) + temp66b8 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(ic, 0) = rmub(ic, 0) + temp66*rmu(i, 0)*zb(indorbp, indt+& +& i) + rmub(i, 0) = rmub(i, 0) + temp66*rmu(ic, 0)*zb(indorbp, indt+i& +& ) + funb0 = funb0 + temp66b8 + rb(0) = rb(0) - temp66*temp66b8 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp145 = -(dd1*r(0)) - dd1**2*dd2 + 3.d0 - temp146b = distp(0, 1)*fun2b - temp145b0 = (1.d0-dd1*r(0))*temp146b - temp145b1 = (2.d0-dd1*r(0)-dd1**2*dd2)*funb - distpb(0, 1) = r(0)*temp145b1 + ((1.d0-dd1*r(0))*temp145-1.d0)*& -& fun2b - temp145b2 = distp(0, 1)*r(0)*funb - dd1b = (-(dd2*2*dd1)-r(0))*temp145b2 + (-(dd2*2*dd1)-r(0))*& -& temp145b0 - temp145*r(0)*temp146b - rb(0) = rb(0) + distp(0, 1)*temp145b1 - dd1*temp145b2 - dd1*& -& temp145b0 - temp145*dd1*temp146b - dd2b = -(dd1**2*temp145b2) - dd1**2*temp145b0 + temp66b2 = dd1*distp(0, 1)*fun2b + temp66b3 = (dd1*r(0)-2.d0)*fun2b + temp66b4 = (dd2*r(0)-2.d0)*fun2b + temp66b5 = dd3*dd2*distp(0, 2)*fun2b + dd1b = distp(0, 1)*temp66b3 - distp(0, 1)*r(0)*funb0 + r(0)*& +& temp66b2 + temp66b6 = dd3*distp(0, 2)*funb0 + rb(0) = rb(0) + dd2*temp66b5 - dd2*temp66b6 - distp(0, 1)*dd1*& +& funb0 + dd1*temp66b2 + distpb(0, 1) = dd1*temp66b3 + temp66b7 = (1.d0-dd2*r(0))*funb0 + dd3b = distp(0, 2)*temp66b7 + distp(0, 2)*dd2*temp66b4 + dd2b = r(0)*temp66b5 - r(0)*temp66b6 + distp(0, 2)*dd3*temp66b4 + distpb(0, 2) = dd3*dd2*temp66b4 + distpb(0, 1) = distpb(0, 1) + (1.d0-dd1*r(0))*funb0 + distpb(0, 2) = distpb(0, 2) + dd3*temp66b7 + distpb(0, 3) = distpb(0, 3) + fun0b ELSE distpb = 0.0_8 dd1b = 0.0_8 dd2b = 0.0_8 + dd3b = 0.0_8 END IF + DO ic=3,1,-1 + DO i=0,0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO DO i=0,0,-1 - temp145b = distp(i, 1)*zb(indorbp, i) - temp144 = dd1*r(i) + 1.d0 - rb(i) = rb(i) + (dd2*dd1+2*r(i))*temp145b - dd2b = dd2b + temp144*temp145b - dd1b = dd1b + dd2*r(i)*temp145b - distpb(i, 1) = distpb(i, 1) + (r(i)**2+dd2*temp144)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + temp66b1 = r(i)*distpb(i, 3) + rb(i) = rb(i) + (distp(i, 1)+dd3*distp(i, 2))*distpb(i, 3) + distpb(i, 1) = distpb(i, 1) + temp66b1 + dd3b = dd3b + distp(i, 2)*temp66b1 + distpb(i, 2) = distpb(i, 2) + dd3*temp66b1 + distpb(i, 3) = 0.0_8 END DO cb = 0.0_8 DO k=0,0,-1 - temp144b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + temp66b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp66b + distpb(k, 2) = 0.0_8 + temp66b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp66b0 - dd2*temp66b cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp144b - rb(k) = rb(k) - dd1*temp144b + dd1b = dd1b - r(k)*temp66b0 distpb(k, 1) = 0.0_8 END DO - temp143 = dd1**4 - temp142 = pi*(42.d0*dd1**2*dd2+14.d0*temp143*dd2**2+45.d0) - temp141 = dd1**7 - temp140 = temp141/temp142 - IF (2.d0*temp140 .EQ. 0.0) THEN - temp140b0 = 0.0 + temp65 = 2.d0**7 + temp64 = temp65*dd2**7 + temp63 = dd3**2/temp64 + temp62 = (dd1+dd2)**7 + temp61 = 2.d0**7 + temp60 = temp61*dd1**7 + temp59 = 240.d0*pi*(1.0/temp60+2.d0*dd3/temp62+temp63) + temp58 = DSQRT(temp59) + IF (temp59 .EQ. 0.0) THEN + temp58b = 0.0 ELSE - temp140b0 = 2.d0*cb/(2.D0*DSQRT(2.d0*temp140)*temp142) + temp58b = -(pi*240.d0*cb/(2.d0*temp58**2*2.D0*DSQRT(temp59))) END IF - temp140b1 = -(temp140*pi*temp140b0) - dd1b = dd1b + (14.d0*dd2**2*4*dd1**3+42.d0*dd2*2*dd1)*temp140b1 + 7*& -& dd1**6*temp140b0 - dd2b = dd2b + (14.d0*temp143*2*dd2+42.d0*dd1**2)*temp140b1 + temp58b0 = 2.d0*temp58b/temp62 + temp58b1 = -(dd3*7*(dd1+dd2)**6*temp58b0/temp62) + dd1b = dd1b + temp58b1 - temp61*7*dd1**6*temp58b/temp60**2 + dd3b = dd3b + 2*dd3*temp58b/temp64 + temp58b0 + dd2b = dd2b + temp58b1 - temp63*temp65*7*dd2**6*temp58b/temp64 + ddb(indpar+3) = ddb(indpar+3) + dd3b ddb(indpar+2) = ddb(indpar+2) + dd2b ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (16) -! 2s gaussian for pseudo + CASE (80) +! 4p single zeta ! R(r)=exp(-z*r**2) single zeta -! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) + dd2 = DSQRT(dd1) ! if(iflagnorm.gt.2) then - IF (dd1 .NE. 0.) THEN - c = 0.71270547035499016d0*dd1**0.75d0 -! c=(2.d0*dd1/pi)**(3.d0/4.d0) - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) -! ! the constant - c = 1.d0 - END IF +! c=(2.d0*dd1/pi)**(3.d0/4.d0)*ratiocs +! ratiocs--> ratiocs*(2/pi)**3/4 + c = dd1**0.75d0*ratiocs ! endif DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) END DO IF (typec .NE. 1) THEN -! the first derivative /r - fun = -(2.d0*dd1*distp(0, 1)) -! the second derivative - funb = 2.d0*zb(indorbp, indt+4) +! the first derivative /r + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) +! the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO - temp148b = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp148b - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp148b distpb = 0.0_8 - distpb(0, 1) = -(2.d0*dd1*funb) + temp71 = rp3**2 + temp70b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& +& temp71 + temp70 = dd1*distp(0, 1)/temp71 + temp70b0 = temp70*fun2b + rp1b = (2*rp1+4.d0*rp2+4.d0)*temp70b0 + temp69b0 = -(distp(0, 1)*(rp2+2.d0)*funb0/rp3) + dd1b = temp69b0 + r(0)**2*rp1b + distp(0, 1)*temp70b + temp69 = dd1/rp3 + distpb(0, 1) = dd1*temp70b - temp69*(rp2+2.d0)*funb0 + rp3b = -(temp69*temp69b0) - temp70*2*rp3*temp70b + rp2b = 2*(rp2+1.d0)*rp3b - temp69*distp(0, 1)*funb0 + (4.d0*rp1-& +& 2.d0)*temp70b0 + dd2b = r(0)*rp2b + rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b ELSE distpb = 0.0_8 dd1b = 0.0_8 + dd2b = 0.0_8 END IF DO i=0,0,-1 distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) @@ -6382,16 +5442,23 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO cb = 0.0_8 DO k=0,0,-1 - temp147 = r(k)**2 - temp147b0 = c*DEXP(-(dd1*temp147))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp147))*distpb(k, 1) - dd1b = dd1b - temp147*temp147b0 - rb(k) = rb(k) - dd1*2*r(k)*temp147b0 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp68 = dd2*r(k) + 1.d0 + temp69b = costb/temp68 + temp68b0 = -(dd1*r(k)**2*temp69b/temp68) + dd1b = dd1b + r(k)**2*temp69b + rb(k) = rb(k) + dd2*temp68b0 + dd1*2*r(k)*temp69b + dd2b = dd2b + r(k)*temp68b0 END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 1) dd1b = dd1b + 0.71270547035499016d0*0.75d0*& -& dd1**(-0.25D0)*cb + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocs*0.75d0*dd1**(-0.25D0)*cb + ELSE + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocs*0.75d0*dd1**(& +& -0.25D0)*cb + END IF ddb(indpar+1) = ddb(indpar+1) + dd1b CASE (17) ! 2s gaussian for pseudo @@ -6411,21 +5478,21 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd ! the first derivative / r fun = 2.d0*distp(0, 1)*(1.d0-dd1*rp1) ! the second derivative - funb = 2.d0*zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp149b = 2.d0*distp(0, 1)*fun2b - distpb(0, 1) = 2.d0*(1.d0-dd1*rp1)*funb + 2.d0*(2.d0*(dd1**2*rp1**& -& 2)-5.d0*(dd1*rp1)+1.d0)*fun2b - temp149b0 = 2.d0*distp(0, 1)*funb - dd1b = (2.d0*rp1**2*2*dd1-5.d0*rp1)*temp149b - rp1*temp149b0 - rp1b = (2.d0*dd1**2*2*rp1-5.d0*dd1)*temp149b - dd1*temp149b0 + temp73b = 2.d0*distp(0, 1)*fun2b + distpb(0, 1) = 2.d0*(1.d0-dd1*rp1)*funb0 + 2.d0*(2.d0*(dd1**2*rp1& +& **2)-5.d0*(dd1*rp1)+1.d0)*fun2b + temp73b0 = 2.d0*distp(0, 1)*funb0 + dd1b = (2.d0*rp1**2*2*dd1-5.d0*rp1)*temp73b - rp1*temp73b0 + rp1b = (2.d0*dd1**2*2*rp1-5.d0*dd1)*temp73b - dd1*temp73b0 rb(0) = rb(0) + 2*r(0)*rp1b ELSE distpb = 0.0_8 @@ -6438,622 +5505,781 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO cb = 0.0_8 DO k=0,0,-1 - temp148 = r(k)**2 - temp148b0 = c*DEXP(-(dd1*temp148))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp148))*distpb(k, 1) - dd1b = dd1b - temp148*temp148b0 - rb(k) = rb(k) - dd1*2*r(k)*temp148b0 + temp72 = r(k)**2 + temp72b = c*DEXP(-(dd1*temp72))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp72))*distpb(k, 1) + dd1b = dd1b - temp72*temp72b + rb(k) = rb(k) - dd1*2*r(k)*temp72b distpb(k, 1) = 0.0_8 END DO dd1b = dd1b + .73607904464954686606d0*1.75d0*dd1**0.75D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (18) + CASE (10) ! 2s gaussian for pseudo -! R(r)=r**4*exp(-z*r**2) single zeta -! if(iocc(indshellp).eq.1) then +! s orbital +! +! - angmom = 0 +! - type = Slater +! - normalized = yes +! - angtype = spherical +! - npar = 1 +! - multiplicity = 1 +! +! = N * R +! +! 3s single zeta +! and R is the radial part +! R(r) = r**2*exp(-z1*r) +! indorbp = indorb + 1 dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=(2.d0*dd1**11/pi)**(1.d0/4.d0)*(512.d0/945.d0/pi) - c = dd1**2.75d0*0.1540487967684377d0 + c = dd1**3.5d0*0.11894160774351807429d0 + DO k=0,0 + distp(k, 1) = c*DEXP(-(dd1*r(k))) + END DO + IF (typec .NE. 1) THEN + fun = (2.d0-dd1*r(0))*distp(0, 1) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp73b2 = distp(0, 1)*fun2b + temp73b3 = 2*dd1*r(0)*temp73b2 + dd1b = r(0)*temp73b3 - 4*r(0)*temp73b2 - distp(0, 1)*r(0)*funb0 + rb(0) = rb(0) + dd1*temp73b3 - 4*dd1*temp73b2 - distp(0, 1)*dd1*& +& funb0 + distpb(0, 1) = (2.d0-dd1*r(0))*funb0 + ((dd1*r(0))**2-4*(dd1*r(0))& +& +2.d0)*fun2b + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + END IF + DO i=0,0,-1 + distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + cb = 0.0_8 + DO k=0,0,-1 + temp73b1 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp73b1 + rb(k) = rb(k) - dd1*temp73b1 + distpb(k, 1) = 0.0_8 + END DO + dd1b = dd1b + 0.11894160774351807429d0*3.5d0*dd1**2.5D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (129) +! 2p single exponential r e^{-z r} ! parent of 121 + dd2 = dd(indpar+1) + DO k=0,0 + distp(k, 1) = DEXP(-(dd2*r(k))) + END DO +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO ! endif + IF (typec .NE. 1) THEN + fun = distp(0, 1)*(1.d0-dd2*r(0))/r(0) + fun2 = dd2*(dd2*r(0)-2.d0)*distp(0, 1) +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp74b2 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp74b2 + fun2b = fun2b + temp74b2 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp74b1 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp74b1 + funb0 = funb0 + rmu(ic, 0)*temp74b1 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + distpb = 0.0_8 + temp74b = dd2*distp(0, 1)*fun2b + temp74b0 = (dd2*r(0)-2.d0)*fun2b + temp73 = distp(0, 1)/r(0) + dd2b = distp(0, 1)*temp74b0 - temp73*r(0)*funb0 + r(0)*temp74b + temp73b6 = (1.d0-dd2*r(0))*funb0/r(0) + rb(0) = rb(0) + distp(0, 1)*fun0b - temp73*dd2*funb0 - temp73*& +& temp73b6 + dd2*temp74b + distpb(0, 1) = temp73b6 + r(0)*fun0b + dd2*temp74b0 + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=0,0,-1 + temp73b5 = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*r(i)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + r(i)*temp73b5 + rb(i) = rb(i) + distp(i, 1)*temp73b5 + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO k=0,0,-1 + temp73b4 = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp73b4 + rb(k) = rb(k) - dd2*temp73b4 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (110) +! 2s without cusp condition +! dd1*( dd3 +1/(1+dd2*r^3)) + dd2 = dd(indpar+1) + indorbp = indorb + 1 DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**3) END DO +! endif IF (typec .NE. 1) THEN - rp1 = r(0)**2 -! the first derivative - fun = distp(0, 1)*rp1*(4.d0-2.d0*dd1*rp1) -! the second derivative - funb = 2.d0*zb(indorbp, indt+4) + fun = -(dd2*distp(0, 1)**2*3.d0*r(0)) fun2b = zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp150b = (4.d0*(dd1**2*rp1**2)-18.d0*(dd1*rp1)+12.d0)*fun2b - temp150b0 = distp(0, 1)*rp1*fun2b - temp150b1 = (4.d0-2.d0*(dd1*rp1))*funb - distpb(0, 1) = rp1*temp150b1 + rp1*temp150b - temp150b2 = -(distp(0, 1)*rp1*2.d0*funb) - rp1b = distp(0, 1)*temp150b1 + dd1*temp150b2 + (4.d0*dd1**2*2*rp1-& -& 18.d0*dd1)*temp150b0 + distp(0, 1)*temp150b - dd1b = rp1*temp150b2 + (4.d0*rp1**2*2*dd1-18.d0*rp1)*temp150b0 - rb(0) = rb(0) + 2*r(0)*rp1b + temp75 = r(0)**3 + temp75b = (2.d0-4.d0*(dd2*temp75))*fun2b + temp75b0 = -(fun*distp(0, 1)*4.d0*fun2b) + funb0 = funb0 + distp(0, 1)*temp75b + distpb(0, 1) = fun*temp75b - 3.d0*dd2*r(0)*2*distp(0, 1)*funb0 + temp75b1 = -(3.d0*distp(0, 1)**2*funb0) + dd2b = r(0)*temp75b1 + temp75*temp75b0 + rb(0) = rb(0) + dd2*temp75b1 + dd2*3*r(0)**2*temp75b0 ELSE distpb = 0.0_8 - dd1b = 0.0_8 + dd2b = 0.0_8 END IF + dd3b = 0.0_8 DO i=0,0,-1 - rb(i) = rb(i) + distp(i, 1)*4*r(i)**3*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + r(i)**4*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO - cb = 0.0_8 DO k=0,0,-1 - temp149 = r(k)**2 - temp149b1 = c*DEXP(-(dd1*temp149))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp149))*distpb(k, 1) - dd1b = dd1b - temp149*temp149b1 - rb(k) = rb(k) - dd1*2*r(k)*temp149b1 + temp74 = r(k)**3 + temp74b3 = -(distpb(k, 1)/(dd2*temp74+1.d0)**2) + dd2b = dd2b + temp74*temp74b3 + rb(k) = rb(k) + dd2*3*r(k)**2*temp74b3 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.1540487967684377d0*2.75d0*dd1**1.75D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (19) -! derivative of 16 with respect to z -! R(r)=c*exp(-z*r**2)*(3/4/z-r**2) + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (46) +! R(r)=c*r**2*exp(-z*r**2)*(7/4/z-r**2) ! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! if(dd1.ne.0.) then -! c=(2.d0*dd1/pi)**(3.d0/4.d0) - c = 0.71270547035499016d0*dd1**0.75d0 -! else -! c=1.d0 -! endif -! endif +! if(iflagnorm.gt.2) then + c = 4.d0*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)/DSQRT(15.d0) +! endif DO k=0,0 distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO IF (typec .NE. 1) THEN -! the first derivative /r - fun = distp(0, 1)*(2.d0*dd1*r(0)**2-7.d0/2.d0) + rp1 = r(0)**2 +! the first derivative / r + fun = distp(0, 1)*(7.d0-15.d0*dd1*rp1+4.d0*(dd1*rp1)**2)/2.d0/dd1 ! the second derivative - funb = 2.d0*zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp153 = r(0)**4 - temp153b = distp(0, 1)*fun2b - distpb(0, 1) = (2.d0*(dd1*r(0)**2)-7.d0/2.d0)*funb + (13.d0*(dd1*r& -& (0)**2)-7.d0/2.d0-4.d0*(dd1**2*temp153))*fun2b - temp153b0 = distp(0, 1)*2.d0*funb - dd1b = r(0)**2*temp153b0 + (13.d0*r(0)**2-4.d0*temp153*2*dd1)*& -& temp153b - rb(0) = rb(0) + dd1*2*r(0)*temp153b0 + (13.d0*dd1*2*r(0)-4.d0*dd1& -& **2*4*r(0)**3)*temp153b + temp82 = 2.d0*dd1 + temp81 = distp(0, 1)/temp82 + temp82b = temp81*fun2b + temp82b0 = 50*2*dd1*rp1*temp82b + temp82b1 = -(8*3*dd1**2*rp1**2*temp82b) + temp81b = (50*(dd1*rp1)**2-59*(dd1*rp1)-8*(dd1*rp1)**3+7.d0)*fun2b& +& /temp82 + temp80 = 2.d0*dd1 + temp79 = distp(0, 1)/temp80 + temp80b = temp79*funb0 + temp79b = (4.d0*(dd1**2*rp1**2)-15.d0*(dd1*rp1)+7.d0)*funb0/temp80 + dd1b = (4.d0*rp1**2*2*dd1-15.d0*rp1)*temp80b - temp79*2.d0*temp79b& +& - temp81*2.d0*temp81b + rp1*temp82b1 - 59*rp1*temp82b + rp1*& +& temp82b0 + rp1b = (4.d0*dd1**2*2*rp1-15.d0*dd1)*temp80b + dd1*temp82b1 - 59*& +& dd1*temp82b + dd1*temp82b0 + distpb(0, 1) = temp79b + temp81b + rb(0) = rb(0) + 2*r(0)*rp1b ELSE distpb = 0.0_8 dd1b = 0.0_8 END IF DO i=0,0,-1 - temp152 = 4.d0*dd1 - temp151 = 3.d0/temp152 - temp151b = distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + (temp151-r(i)**2)*zb(indorbp, i) - dd1b = dd1b - temp151*4.d0*temp151b/temp152 - rb(i) = rb(i) - 2*r(i)*temp151b + temp78 = 4.d0*dd1 + temp77 = r(i)**2/temp78 + temp78b = distp(i, 1)*zb(indorbp, i) + temp77b = 7.d0*temp78b/temp78 + distpb(i, 1) = distpb(i, 1) + (7.d0*temp77-r(i)**4)*zb(indorbp, i) + rb(i) = rb(i) + 2*r(i)*temp77b - 4*r(i)**3*temp78b + dd1b = dd1b - temp77*4.d0*temp77b zb(indorbp, i) = 0.0_8 END DO cb = 0.0_8 DO k=0,0,-1 - temp150 = r(k)**2 - temp150b3 = c*DEXP(-(dd1*temp150))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp150))*distpb(k, 1) - dd1b = dd1b - temp150*temp150b3 - rb(k) = rb(k) - dd1*2*r(k)*temp150b3 + temp76 = r(k)**2 + temp76b = c*DEXP(-(dd1*temp76))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp76))*distpb(k, 1) + dd1b = dd1b - temp76*temp76b + rb(k) = rb(k) - dd1*2*r(k)*temp76b distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.71270547035499016d0*0.75d0*dd1**(-0.25D0)*cb + IF (.NOT.(dd1 .LE. 0.0 .AND. (7.d0/4.d0 .EQ. 0.0 .OR. 7.d0/4.d0 .NE.& +& INT(7.d0/4.d0)))) dd1b = dd1b + (2.d0/pi)**(3.d0/4.d0)*7.d0*dd1& +& **(7.d0/4.d0-1)*cb/DSQRT(15.d0) ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (20) -! 2p single zeta -! 2p single Z with no cusp condition + CASE (143) +! 5s single zeta derivative of 12 +! 4d one parmater der of 133 dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2.d0*dd1)**5/8.d0/pi)/2.d0 - c = dd1**2.5d0*0.5641895835477562d0 -! endif DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 1) = DEXP(-(dd1*r(k))) END DO -! indorbp=indorb -! - DO ic=1,3 + DO i=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = distp(i, 1)*r(i)**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) + distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) + distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) + distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) + distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) + distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d + END DO +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = -(dd1*distp(0, 1)) - fun2 = dd1**2*distp(0, 1) + fun0 = -distp(0, 3) + fun = -((-2.d0+dd1*r(0))*distp(0, 1)) + fun2 = ((dd1*r(0))**2-4.d0*r(0)*dd1+2.d0)*distp(0, 1) ! indorbp=indorb - DO ic=1,3 + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + IF (ic .EQ. 1) THEN + IF (i .NE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO END DO - funb = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=3,1,-1 - temp155 = fun/r(0) - temp156b = rmu(ic, 0)*zb(indorbp, indt+4) - temp155b = 4.d0*temp156b/r(0) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp155+fun2)*zb(indorbp, indt& -& +4) - funb = funb + temp155b - rb(0) = rb(0) - temp155*temp155b - fun2b = fun2b + temp156b + DO ic=5,1,-1 + temp83b7 = distp(0, 3+ic)*zb(indorbp, indt+4) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 6.d0*temp83b7 + fun2b = fun2b + temp83b7 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp154 = fun/r(0) - temp154b0 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(ic, 0) = rmub(ic, 0) + temp154*rmu(i, 0)*zb(indorbp, indt& -& +i) - rmub(i, 0) = rmub(i, 0) + temp154*rmu(ic, 0)*zb(indorbp, indt+& -& i) - funb = funb + temp154b0 - rb(0) = rb(0) - temp154*temp154b0 + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp83b3 = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp83b3 + fun0b = fun0b + rmu(i, 0)*temp83b3 + ELSE + temp83b4 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp83b4 + fun0b = fun0b + rmu(i, 0)*temp83b4 + END IF + ELSE IF (branch .LT. 4) THEN + temp83b5 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp83b5 + fun0b = fun0b + rmu(i, 0)*temp83b5 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp83b6 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp83b6 + fun0b = fun0b + rmu(i, 0)*temp83b6 + ELSE + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + temp83b2 = distp(0, 3+ic)*zb(indorbp, indt+i) + distpb(0, 3+ic) = distpb(0, 3+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp83b2 + funb0 = funb0 + rmu(i, 0)*temp83b2 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb - distpb(0, 1) = fun0b - dd1*funb + dd1**2*fun2b + temp83b0 = distp(0, 1)*fun2b + temp83b1 = 2*dd1*r(0)*temp83b0 + dd1b = r(0)*temp83b1 - 4.d0*r(0)*temp83b0 - distp(0, 1)*r(0)*funb0 + rb(0) = rb(0) + dd1*temp83b1 - 4.d0*dd1*temp83b0 - distp(0, 1)*dd1& +& *funb0 + distpb(0, 1) = distpb(0, 1) + ((dd1*r(0))**2-4.d0*(r(0)*dd1)+2.d0)& +& *fun2b - (dd1*r(0)-2.d0)*funb0 + distpb(0, 3) = distpb(0, 3) - fun0b ELSE distpb = 0.0_8 dd1b = 0.0_8 END IF - DO ic=3,1,-1 + DO ic=5,1,-1 DO i=0,0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + distpb(i, 3+ic) = distpb(i, 3+ic) - distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) - distp(i, 3+ic)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - cb = 0.0_8 + DO i=0,0,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + distpb(i, 8) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distpb(i, 1) = distpb(i, 1) + r(i)**2*distpb(i, 3) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + END DO DO k=0,0,-1 - temp154b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp154b - rb(k) = rb(k) - dd1*temp154b + temp83b = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp83b + rb(k) = rb(k) - dd1*temp83b distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.5641895835477562d0*2.5d0*dd1**1.5D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (21) -! 2p double zeta -! 2p without cusp condition - dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) - c = 0.5d0/DSQRT(8.d0*pi*(1.d0/(2.d0*dd1)**5+2.d0*peff/(dd1+dd2)**5+& -& peff**2/(2.d0*dd2)**5)) - DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k))) - distp(k, 2) = c*DEXP(-(dd2*r(k))) - END DO - DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = distp(i, 1) + peff*distp(i, 2) - END DO -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun = (-(dd1*distp(0, 1))-dd2*peff*distp(0, 2))/r(0) - fun2 = dd1**2*distp(0, 1) + peff*dd2**2*distp(0, 2) -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO + CASE (7) +! normalized IS WRONG!!! +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd(indpar+3) + DO k=0,0 + distp(k, 1) = DEXP(-(dd1*r(k))) + distp(k, 2) = DEXP(-(dd2*r(k))) + END DO +! if(iflagnorm.gt.2) then + c = 1/DSQRT(1/(3.d0/4.d0/dd1**5+peff**2/dd2**3/4+12*peff/(dd1+dd2)**& +& 4))*1.d0/DSQRT(4.0*pi) + IF (typec .NE. 1) THEN + fun = -(dd1*distp(0, 1)) + peff*distp(0, 2)*(1.d0-dd2*r(0)) + fun2 = distp(0, 1)*dd1**2 + peff*distp(0, 2)*(dd2**2*r(0)-2.d0*dd2& +& ) + temp93 = fun/r(0) + temp93b = c*2.d0*zb(indorbp, indt+4)/r(0) + cb = (2.d0*temp93+fun2)*zb(indorbp, indt+4) + funb0 = temp93b + rb(0) = rb(0) - temp93*temp93b + fun2b = c*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + temp92 = rmu(i, 0)/r(0) + temp92b5 = fun*c*zb(indorbp, indt+i)/r(0) + funb0 = funb0 + temp92*c*zb(indorbp, indt+i) + cb = cb + temp92*fun*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp92b5 + rb(0) = rb(0) - temp92*temp92b5 + zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - funb = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp164b4 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp164b4 - fun2b = fun2b + temp164b4 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) distpb(0, 3) = distpb(0, 3) + zb(& -& indorbp, indt+i) - temp164b3 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp164b3 - funb = funb + rmu(ic, 0)*temp164b3 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - temp164b1 = dd2**2*fun2b - temp164b2 = funb/r(0) - dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*temp164b2 - distpb(0, 1) = distpb(0, 1) + dd1**2*fun2b - dd2b = peff*distp(0, 2)*2*dd2*fun2b - distp(0, 2)*peff*temp164b2 - peffb = distp(0, 2)*temp164b1 - distp(0, 2)*dd2*temp164b2 - distpb(0, 2) = distpb(0, 2) + peff*temp164b1 - distpb(0, 1) = distpb(0, 1) - dd1*temp164b2 - distpb(0, 2) = distpb(0, 2) - dd2*peff*temp164b2 - rb(0) = rb(0) - (-(dd1*distp(0, 1))-dd2*peff*distp(0, 2))*& -& temp164b2/r(0) + temp92b1 = (dd2**2*r(0)-2.d0*dd2)*fun2b + temp92b2 = peff*distp(0, 2)*fun2b + distpb(0, 1) = dd1**2*fun2b + dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb0 + temp92b3 = (1.d0-dd2*r(0))*funb0 + peffb = distp(0, 2)*temp92b3 + distp(0, 2)*temp92b1 + distpb(0, 2) = peff*temp92b3 + peff*temp92b1 + temp92b4 = peff*distp(0, 2)*funb0 + dd2b = (r(0)*2*dd2-2.d0)*temp92b2 - r(0)*temp92b4 + rb(0) = rb(0) + dd2**2*temp92b2 - dd2*temp92b4 + distpb(0, 1) = distpb(0, 1) - dd1*funb0 ELSE distpb = 0.0_8 peffb = 0.0_8 dd1b = 0.0_8 dd2b = 0.0_8 + cb = 0.0_8 END IF - DO ic=3,1,-1 - DO i=0,0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO DO i=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distpb(i, 1) = distpb(i, 1) + distpb(i, 3) - peffb = peffb + distp(i, 2)*distpb(i, 3) - distpb(i, 2) = distpb(i, 2) + peff*distpb(i, 3) - distpb(i, 3) = 0.0_8 + temp92b = c*zb(indorbp, i) + temp92b0 = distp(i, 2)*temp92b + cb = cb + (distp(i, 1)+r(i)*peff*distp(i, 2))*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp92b + rb(i) = rb(i) + peff*temp92b0 + peffb = peffb + r(i)*temp92b0 + distpb(i, 2) = distpb(i, 2) + r(i)*peff*temp92b + zb(indorbp, i) = 0.0_8 END DO - cb = 0.0_8 + temp91 = (dd1+dd2)**4 + temp90 = 4*dd2**3 + temp89 = peff**2/temp90 + temp88 = 4.d0*dd1**5 + temp83 = 3.d0/temp88 + temp89 + 12*(peff/temp91) + temp87 = 1.0/temp83 + temp86 = DSQRT(temp87) + temp85 = DSQRT(4.0*pi) + temp84 = temp85*temp86 + IF (temp87 .EQ. 0.0) THEN + temp83b10 = 0.0 + ELSE + temp83b10 = temp85*temp87*cb/(temp84**2*2.D0*DSQRT(temp87)*temp83) + END IF + temp83b11 = 12*temp83b10/temp91 + temp83b12 = -(peff*4*(dd1+dd2)**3*temp83b11/temp91) + dd1b = dd1b + temp83b12 - 3.d0*4.d0*5*dd1**4*temp83b10/temp88**2 + peffb = peffb + temp83b11 + 2*peff*temp83b10/temp90 + dd2b = dd2b + temp83b12 - temp89*4*3*dd2**2*temp83b10/temp90 DO k=0,0,-1 - temp164b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp164b + temp83b8 = DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp83b8 distpb(k, 2) = 0.0_8 - temp164b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp164b0 - dd2*temp164b - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp164b0 + temp83b9 = DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp83b9 - dd2*temp83b8 + dd1b = dd1b - r(k)*temp83b9 distpb(k, 1) = 0.0_8 END DO - temp163 = 2.d0**5 - temp162 = temp163*dd2**5 - temp161 = peff**2/temp162 - temp160 = (dd1+dd2)**5 - temp159 = 2.d0**5 - temp158 = temp159*dd1**5 - temp157 = 8.d0*pi*(1.0/temp158+2.d0*peff/temp160+temp161) - temp156 = DSQRT(temp157) - IF (temp157 .EQ. 0.0) THEN - temp156b0 = 0.0 - ELSE - temp156b0 = -(0.5d0*pi*8.d0*cb/(temp156**2*2.D0*DSQRT(temp157))) - END IF - temp156b1 = 2.d0*temp156b0/temp160 - temp156b2 = -(peff*5*(dd1+dd2)**4*temp156b1/temp160) - dd1b = dd1b + temp156b2 - temp159*5*dd1**4*temp156b0/temp158**2 - peffb = peffb + 2*peff*temp156b0/temp162 + temp156b1 - dd2b = dd2b + temp156b2 - temp161*temp163*5*dd2**4*temp156b0/temp162 ddb(indpar+3) = ddb(indpar+3) + peffb ddb(indpar+2) = ddb(indpar+2) + dd2b ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (22) -! 3p single zeta -! 3p without cusp condition -! r e^{-z1 r } - dd1 = dd(indpar+1) -! c=dsqrt((2.d0*dd1)**7/240.d0/pi)/2.d0 - c = dd1**3.5d0*0.2060129077457011d0 + CASE (36) +! 2s double Z WITH CUSP +! p orbital ! +! - angmom = 1 +! - type = Gaussian +! - normalized = yes +! - angtype = spherical +! - npar = 1 +! - multiplicity = 3 +! + dd1 = dd(indpar+1) + c = dd1**1.25d0*1.42541094070998d0 DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k))) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(k, 2)) - distp(k, 2) = r(k)*distp(k, 1) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO -! -! indorbp=indorb -! DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif -! -! IF (typec .NE. 1) THEN - fun = (1.d0-dd1*r(0))*distp(0, 1) - fun2 = dd1*(dd1*r(0)-2.d0)*distp(0, 1) -! -! indorbp=indorb -! + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp165 = fun/r(0) - temp166b = rmu(ic, 0)*zb(indorbp, indt+4) - temp165b = 4.d0*temp166b/r(0) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp165+fun2)*zb(indorbp, indt& -& +4) - funb = funb + temp165b - rb(0) = rb(0) - temp165*temp165b - fun2b = fun2b + temp166b + temp95b1 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp95b1 + fun2b = fun2b + temp95b1 zb(indorbp, indt+4) = 0.0_8 + fun0b = fun0b + zb(indorbp, indt+ic) DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp164 = fun/r(0) - temp164b8 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(ic, 0) = rmub(ic, 0) + temp164*rmu(i, 0)*zb(indorbp, indt& -& +i) - rmub(i, 0) = rmub(i, 0) + temp164*rmu(ic, 0)*zb(indorbp, indt+& -& i) - funb = funb + temp164b8 - rb(0) = rb(0) - temp164*temp164b8 + temp95b0 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp95b0 + funb0 = funb0 + rmu(ic, 0)*temp95b0 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + temp95b = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp95b - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp95b distpb = 0.0_8 - temp164b6 = dd1*distp(0, 1)*fun2b - temp164b7 = (dd1*r(0)-2.d0)*fun2b - dd1b = distp(0, 1)*temp164b7 - distp(0, 1)*r(0)*funb + r(0)*& -& temp164b6 - rb(0) = rb(0) + dd1*temp164b6 - distp(0, 1)*dd1*funb - distpb(0, 1) = (1.d0-dd1*r(0))*funb + dd1*temp164b7 - distpb(0, 2) = distpb(0, 2) + fun0b + distpb(0, 1) = fun0b - 2.d0*dd1*funb0 ELSE distpb = 0.0_8 dd1b = 0.0_8 END IF DO ic=3,1,-1 DO i=0,0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 2)*zb(indorbp, i) - distpb(i, 2) = distpb(i, 2) + rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO cb = 0.0_8 DO k=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(k, 2)) - rb(k) = rb(k) + distp(k, 1)*distpb(k, 2) - distpb(k, 1) = distpb(k, 1) + r(k)*distpb(k, 2) - distpb(k, 2) = 0.0_8 - temp164b5 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp164b5 - rb(k) = rb(k) - dd1*temp164b5 + temp94 = r(k)**2 + temp94b = c*DEXP(-(dd1*temp94))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp94))*distpb(k, 1) + dd1b = dd1b - temp94*temp94b + rb(k) = rb(k) - dd1*2*r(k)*temp94b distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.2060129077457011d0*3.5d0*dd1**2.5D0*cb + dd1b = dd1b + 1.42541094070998d0*1.25d0*dd1**0.25D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (23) -! 3p double zeta -! 3p without cusp condition -! r ( e^{-z2 r } + z1 e^{-z3 r } ) + CASE (29) +! derivative of (28) +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - dd3 = dd(indpar+3) -! if(iflagnorm.gt.2) then - c = 1.d0/2.d0/DSQRT(240.d0*pi*(1.d0/(2.d0*dd1)**7+2.d0*dd3/(dd1+dd2)& -& **7+dd3**2/(2.d0*dd2)**7)) -! endif -! - DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k))) - distp(k, 2) = c*DEXP(-(dd2*r(k))) - END DO -! +! if(iflagnorm.gt.2) then +! if(dd1.gt.0.) then + c = cost1s*dd1**1.5d0 +! else +! c=1.d0 +! endif +! endif +! if(dd1.gt.0.) then + c1 = 1.5d0/dd1 +! else +! c1=0.d0 +! endif DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = r(i)*(distp(i, 1)+dd3*distp(i, 2)) + distp(i, 1) = c*DEXP(-(dd1*r(i))) END DO -! -! indorbp=indorb -! - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic + DO i=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) +! rp1=(b1s*r(i))**4*dd1**3 +! rp4=rp1*dd1 +! rp5=dd1*r(i) +! z(indorbp,i)=distp(i,1)* & +! &(c1*rp4/(1+rp4)-rp1*(-4+rp5+rp4*rp5)/(1+rp4)**2) + rp4 = (b1s*dd1*r(i))**4 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp5) + rp5 = dd1*r(i) END DO -! endif -! -! IF (typec .NE. 1) THEN - fun = (1.d0-dd1*r(0))*distp(0, 1) + dd3*(1.d0-dd2*r(0))*distp(0, 2& -& ) - fun2 = dd1*(dd1*r(0)-2.d0)*distp(0, 1) + dd3*dd2*(dd2*r(0)-2.d0)*& -& distp(0, 2) -! -! indorbp=indorb -! - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp175 = fun/r(0) - temp176b = rmu(ic, 0)*zb(indorbp, indt+4) - temp175b = 4.d0*temp176b/r(0) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp175+fun2)*zb(indorbp, indt& -& +4) - funb = funb + temp175b - rb(0) = rb(0) - temp175*temp175b - fun2b = fun2b + temp176b - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp174 = fun/r(0) - temp174b8 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(ic, 0) = rmub(ic, 0) + temp174*rmu(i, 0)*zb(indorbp, indt& -& +i) - rmub(i, 0) = rmub(i, 0) + temp174*rmu(ic, 0)*zb(indorbp, indt+& -& i) - funb = funb + temp174b8 - rb(0) = rb(0) - temp174*temp174b8 - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + rp1 = dd1*b1s*r(0) + rp2 = rp1**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) + rp4 = rp2**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp5) + rp5 = rp4*rp1 + rp8 = rp4*rp4 + fun = distp(0, 1)*(dd1*rp2*(4*b1s**2*(11-5*rp4)+2*(rp1+rp5)**2-b1s& +& *rp1*(21+26*rp4+5*rp8)))/(2.*(1+rp4)**3) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp174b2 = dd1*distp(0, 1)*fun2b - temp174b3 = (dd1*r(0)-2.d0)*fun2b - temp174b4 = (dd2*r(0)-2.d0)*fun2b - temp174b5 = dd3*dd2*distp(0, 2)*fun2b - dd1b = distp(0, 1)*temp174b3 - distp(0, 1)*r(0)*funb + r(0)*& -& temp174b2 - temp174b6 = dd3*distp(0, 2)*funb - rb(0) = rb(0) + dd2*temp174b5 - dd2*temp174b6 - distp(0, 1)*dd1*& -& funb + dd1*temp174b2 - distpb(0, 1) = dd1*temp174b3 - temp174b7 = (1.d0-dd2*r(0))*funb - dd3b = distp(0, 2)*temp174b7 + distp(0, 2)*dd2*temp174b4 - dd2b = r(0)*temp174b5 - r(0)*temp174b6 + distp(0, 2)*dd3*temp174b4 - distpb(0, 2) = dd3*dd2*temp174b4 - distpb(0, 1) = distpb(0, 1) + (1.d0-dd1*r(0))*funb - distpb(0, 2) = distpb(0, 2) + dd3*temp174b7 - distpb(0, 3) = distpb(0, 3) + fun0b + temp108 = 2.*b1s*(rp4+1)**4 + temp107 = distp(0, 1)*dd1*rp2 + temp104 = temp107/temp108 + temp107b = temp104*fun2b + temp107b0 = b1s*(7*rp4+31)*2*(rp1+rp5)*temp107b + temp107b1 = -(2*3*(rp1+rp5)**2*temp107b) + temp106 = 64*b1s**2 + temp106b = temp106*temp107b + temp105 = 4*b1s**3 + temp104b = (b1s*((7*rp4+31)*(rp1+rp5)**2)-2*(rp1+rp5)**3+temp106*(& +& rp1*(rp8-rp4-2))+temp105*(25*rp8-134*rp4+33))*fun2b/temp108 + temp103 = 2.*(rp4+1)**3 + temp102 = distp(0, 1)*dd1*rp2 + temp99 = temp102/temp103 + temp102b = temp99*funb0 + temp101b = 2**2*(rp1+rp5)*temp102b + rp5b = temp101b + temp107b1 + temp107b0 + temp100b = -(b1s*temp102b) + rp8b = rp1*5*temp100b + temp105*25*temp107b + rp1*temp106b + temp101 = 4*b1s**2 + temp100 = 26*rp4 + 5*rp8 + 21 + temp99b0 = (temp101*(11-5*rp4)+2*(rp1+rp5)**2-b1s*(rp1*temp100))*& +& funb0/temp103 + rp4b = rp1*26*temp100b - temp101*5*temp102b - temp99*2.*3*(rp4+1)& +& **2*temp99b0 + rp1*rp5b + 2*rp4*rp8b - temp104*2.*b1s*4*(rp4+1)& +& **3*temp104b - rp1*temp106b + (7*(b1s*(rp1+rp5)**2)-134*temp105)& +& *temp107b + rp2b = distp(0, 1)*dd1*temp99b0 + 2*rp2*rp4b + distp(0, 1)*dd1*& +& temp104b + rp1b = temp101b + temp100*temp100b + 2*rp1*rp2b + rp4*rp5b + (rp8-& +& rp4-2)*temp106b + temp107b1 + temp107b0 + distpb(0, 1) = dd1*rp2*temp99b0 + dd1*rp2*temp104b + dd1b = distp(0, 1)*rp2*temp99b0 + b1s*r(0)*rp1b + distp(0, 1)*rp2*& +& temp104b + CALL POPREAL8(adr8ibuf,adr8buf,rp5) + CALL POPREAL8(adr8ibuf,adr8buf,rp4) + rb(0) = rb(0) + b1s*dd1*rp1b ELSE distpb = 0.0_8 dd1b = 0.0_8 - dd2b = 0.0_8 - dd3b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=0,0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO + c1b = 0.0_8 DO i=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - temp174b1 = r(i)*distpb(i, 3) - rb(i) = rb(i) + (distp(i, 1)+dd3*distp(i, 2))*distpb(i, 3) - distpb(i, 1) = distpb(i, 1) + temp174b1 - dd3b = dd3b + distp(i, 2)*temp174b1 - distpb(i, 2) = distpb(i, 2) + dd3*temp174b1 - distpb(i, 3) = 0.0_8 + temp95 = rp4/(rp4+1) + temp99b = distp(i, 1)*temp95*zb(indorbp, i) + temp96 = dd1*(rp4+1) + temp97b = -(temp99b/temp96) + temp98 = rp5 + rp4*rp5 - 4 + temp97 = temp98/temp96 + temp96b = -(temp97*temp97b) + temp95b3 = (c1-temp97)*distp(i, 1)*zb(indorbp, i)/(rp4+1) + c1b = c1b + temp99b + rp5b = (rp4+1.0_8)*temp97b + rp4b = (1.0_8-temp95)*temp95b3 + dd1*temp96b + rp5*temp97b + temp95b4 = 4*b1s**4*dd1**3*r(i)**3*rp4b + dd1b = dd1b + r(i)*rp5b + r(i)*temp95b4 + (rp4+1)*temp96b + distpb(i, 1) = distpb(i, 1) + (c1-temp97)*temp95*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,rp5) + rb(i) = rb(i) + dd1*temp95b4 + dd1*rp5b + CALL POPREAL8(adr8ibuf,adr8buf,rp4) END DO cb = 0.0_8 - DO k=0,0,-1 - temp174b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp174b - distpb(k, 2) = 0.0_8 - temp174b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp174b0 - dd2*temp174b - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp174b0 - distpb(k, 1) = 0.0_8 + DO i=0,0,-1 + temp95b2 = c*DEXP(-(dd1*r(i)))*distpb(i, 1) + cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) + dd1b = dd1b - r(i)*temp95b2 + rb(i) = rb(i) - dd1*temp95b2 + distpb(i, 1) = 0.0_8 END DO - temp173 = 2.d0**7 - temp172 = temp173*dd2**7 - temp171 = dd3**2/temp172 - temp170 = (dd1+dd2)**7 - temp169 = 2.d0**7 - temp168 = temp169*dd1**7 - temp167 = 240.d0*pi*(1.0/temp168+2.d0*dd3/temp170+temp171) - temp166 = DSQRT(temp167) - IF (temp167 .EQ. 0.0) THEN - temp166b0 = 0.0 - ELSE - temp166b0 = -(pi*240.d0*cb/(2.d0*temp166**2*2.D0*DSQRT(temp167))) - END IF - temp166b1 = 2.d0*temp166b0/temp170 - temp166b2 = -(dd3*7*(dd1+dd2)**6*temp166b1/temp170) - dd1b = dd1b + temp166b2 - temp169*7*dd1**6*temp166b0/temp168**2 - dd3b = dd3b + 2*dd3*temp166b0/temp172 + temp166b1 - dd2b = dd2b + temp166b2 - temp171*temp173*7*dd2**6*temp166b0/temp172 - ddb(indpar+3) = ddb(indpar+3) + dd3b - ddb(indpar+2) = ddb(indpar+2) + dd2b + dd1b = dd1b + cost1s*1.5d0*dd1**0.5D0*cb - 1.5d0*c1b/dd1**2 ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (24) -! 4p single zeta -!c 4p without cusp condition -!c r^2 e^{-z1 r } + CASE (44) +! R(r)=x*exp(-z*r**2)*(5/4/z-r**2) dd1 = dd(indpar+1) ! if(iflagnorm.gt.2) then -! c=dsqrt((2.d0*dd1)**9/120960.d0/pi)/2.d0 - c = dd1**4.5d0*0.01835308852470193d0 +! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0 + c = dd1**1.25d0*1.42541094070998d0 ! endif DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k))) - END DO - DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = r(i)**2*distp(i, 1) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO ! indorbp=indorb +! DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then @@ -7061,8 +6287,9 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - fun = (2.d0*r(0)-dd1*r(0)**2)*distp(0, 1) - fun2 = ((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))*distp(0, 1) + fun = distp(0, 1)*(2.d0*dd1*r(0)**2-9.d0/2.d0) + fun2 = distp(0, 1)*(-(4.d0*dd1**2*r(0)**4)+15.d0*dd1*r(0)**2-9.d0/& +& 2.d0) ! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -7076,1101 +6303,1252 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp177 = fun/r(0) - temp178b = rmu(ic, 0)*zb(indorbp, indt+4) - temp177b = 4.d0*temp178b/r(0) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp177+fun2)*zb(indorbp, indt& -& +4) - funb = funb + temp177b - rb(0) = rb(0) - temp177*temp177b - fun2b = fun2b + temp178b + temp115b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp115b0 + fun2b = fun2b + temp115b0 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp176 = fun/r(0) - temp176b4 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(ic, 0) = rmub(ic, 0) + temp176*rmu(i, 0)*zb(indorbp, indt& -& +i) - rmub(i, 0) = rmub(i, 0) + temp176*rmu(ic, 0)*zb(indorbp, indt+& -& i) - funb = funb + temp176b4 - rb(0) = rb(0) - temp176*temp176b4 + temp115b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp115b + funb0 = funb0 + rmu(ic, 0)*temp115b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp176b1 = distp(0, 1)*fun2b - temp176b2 = 2*dd1*r(0)*temp176b1 - temp176b3 = distp(0, 1)*funb - dd1b = r(0)*temp176b2 - 4.d0*r(0)*temp176b1 - r(0)**2*temp176b3 - rb(0) = rb(0) + (2.d0-dd1*2*r(0))*temp176b3 - 4.d0*dd1*temp176b1 +& -& dd1*temp176b2 - distpb(0, 1) = (2.d0*r(0)-dd1*r(0)**2)*funb + ((dd1*r(0))**2-4.d0*& -& (dd1*r(0))+2.d0)*fun2b - distpb(0, 3) = distpb(0, 3) + fun0b + temp114 = r(0)**4 + temp114b = distp(0, 1)*fun2b + temp113 = 4.d0*dd1 + temp112 = 5.d0/temp113 + distpb(0, 1) = (2.d0*(dd1*r(0)**2)-9.d0/2.d0)*funb0 + (temp112-r(0& +& )**2)*fun0b + (15.d0*(dd1*r(0)**2)-9.d0/2.d0-4.d0*(dd1**2*& +& temp114))*fun2b + temp114b0 = distp(0, 1)*2.d0*funb0 + dd1b = r(0)**2*temp114b0 - distp(0, 1)*temp112*4.d0*fun0b/temp113 & +& + (15.d0*r(0)**2-4.d0*temp114*2*dd1)*temp114b + rb(0) = rb(0) + dd1*2*r(0)*temp114b0 - distp(0, 1)*2*r(0)*fun0b + & +& (15.d0*dd1*2*r(0)-4.d0*dd1**2*4*r(0)**3)*temp114b ELSE distpb = 0.0_8 dd1b = 0.0_8 END IF DO ic=3,1,-1 DO i=0,0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + rmu(ic, i)*zb(indorbp, i) + temp111 = 4.d0*dd1 + temp110 = 5.d0/temp111 + temp110b = (temp110-r(i)**2)*zb(indorbp, i) + temp110b0 = rmu(ic, i)*distp(i, 1)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp110b + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp110b + dd1b = dd1b - temp110*4.d0*temp110b0/temp111 + rb(i) = rb(i) - 2*r(i)*temp110b0 zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*distpb(i, 3) - distpb(i, 1) = distpb(i, 1) + r(i)**2*distpb(i, 3) - distpb(i, 3) = 0.0_8 - END DO cb = 0.0_8 DO k=0,0,-1 - temp176b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp176b0 - rb(k) = rb(k) - dd1*temp176b0 + temp109 = r(k)**2 + temp109b = c*DEXP(-(dd1*temp109))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp109))*distpb(k, 1) + dd1b = dd1b - temp109*temp109b + rb(k) = rb(k) - dd1*2*r(k)*temp109b distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.01835308852470193d0*4.5d0*dd1**3.5D0*cb + dd1b = dd1b + 1.42541094070998d0*1.25d0*dd1**0.25D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (25) -! 4p double zeta -! 4p without cusp condition -! r^2 ( e^{-z2 r } + z1 e^{-z3 r } ) - dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - dd3 = dd(indpar+3) + CASE (64) +! derivative of 37 with respect to z +! d orbitals +! R(r)= r exp(-alpha r^2) +! each gaussian term is normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) ! if(iflagnorm.gt.2) then - c = 1.d0/2.d0/DSQRT(120960.d0*pi*(1.d0/(2.d0*dd1)**9+2.d0*dd3/(dd1+& -& dd2)**9+dd3**2/(2.d0*dd2)**9)) +! c=8.d0/dsqrt(21.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) + c = dd1**2.25d0*1.24420067280413253d0 ! endif DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k))) - distp(k, 2) = c*DEXP(-(dd2*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = r(i)**2*(distp(i, 1)+dd3*distp(i, 2)) +! lz=0 + distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d +! lz=+/-2 + distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d +! lz=+/-2 + distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d +! lz=+/-1 + distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d +! lz=+/-1 + distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d END DO -! indorbp=indorb - DO ic=1,3 + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO ! endif IF (typec .NE. 1) THEN - fun = (2.d0*r(0)-dd1*r(0)**2)*distp(0, 1) + dd3*(2.d0*r(0)-dd2*r(0& -& )**2)*distp(0, 2) - fun2 = ((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))*distp(0, 1) + dd3*((dd2*& -& r(0))**2+2.d0-4.d0*dd2*r(0))*distp(0, 2) + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + rp1 = 2.d0*dd1*r(0) + rp2 = rp1*r(0) + fun0 = distp(0, 1)*r(0) + fun = (1.d0-rp2)*distp(0, 1)/r(0) + fun2 = distp(0, 1)*rp1*(rp2-3.d0) ! indorbp=indorb - DO ic=1,3 + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + IF (ic .EQ. 1) THEN + IF (i .NE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO END DO - funb = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=3,1,-1 - temp187 = fun/r(0) - temp188b = rmu(ic, 0)*zb(indorbp, indt+4) - temp187b = 4.d0*temp188b/r(0) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp187+fun2)*zb(indorbp, indt& -& +4) - funb = funb + temp187b - rb(0) = rb(0) - temp187*temp187b - fun2b = fun2b + temp188b + DO ic=5,1,-1 + temp117b4 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 6.d0*temp117b4 + fun2b = fun2b + temp117b4 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp186 = fun/r(0) - temp186b10 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(ic, 0) = rmub(ic, 0) + temp186*rmu(i, 0)*zb(indorbp, indt& -& +i) - rmub(i, 0) = rmub(i, 0) + temp186*rmu(ic, 0)*zb(indorbp, indt+& -& i) - funb = funb + temp186b10 - rb(0) = rb(0) - temp186*temp186b10 + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp117b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp117b0 + fun0b = fun0b + rmu(i, 0)*temp117b0 + ELSE + temp117b1 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp117b1 + fun0b = fun0b + rmu(i, 0)*temp117b1 + END IF + ELSE IF (branch .LT. 4) THEN + temp117b2 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp117b2 + fun0b = fun0b + rmu(i, 0)*temp117b2 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp117b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp117b3 + fun0b = fun0b + rmu(i, 0)*temp117b3 + ELSE + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + temp117b = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp117b + funb0 = funb0 + rmu(i, 0)*temp117b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp186b2 = distp(0, 1)*fun2b - temp186b3 = 2*dd1*r(0)*temp186b2 - temp186b4 = dd3*distp(0, 2)*fun2b - temp186b5 = 2*dd2*r(0)*temp186b4 - temp186b6 = ((dd2*r(0))**2-4.d0*(dd2*r(0))+2.d0)*fun2b - temp186b7 = distp(0, 1)*funb - dd1b = r(0)*temp186b3 - 4.d0*r(0)*temp186b2 - r(0)**2*temp186b7 - temp186b8 = dd3*distp(0, 2)*funb - rb(0) = rb(0) + (2.d0-dd1*2*r(0))*temp186b7 + (2.d0-dd2*2*r(0))*& -& temp186b8 - 4.d0*dd2*temp186b4 + dd2*temp186b5 - 4.d0*dd1*& -& temp186b2 + dd1*temp186b3 - distpb(0, 1) = ((dd1*r(0))**2-4.d0*(dd1*r(0))+2.d0)*fun2b - dd2b = r(0)*temp186b5 - 4.d0*r(0)*temp186b4 - r(0)**2*temp186b8 - temp186b9 = (2.d0*r(0)-dd2*r(0)**2)*funb - dd3b = distp(0, 2)*temp186b9 + distp(0, 2)*temp186b6 - distpb(0, 2) = dd3*temp186b6 - distpb(0, 1) = distpb(0, 1) + (2.d0*r(0)-dd1*r(0)**2)*funb - distpb(0, 2) = distpb(0, 2) + dd3*temp186b9 - distpb(0, 3) = distpb(0, 3) + fun0b + temp116 = (-rp2+1.d0)/r(0) + distpb(0, 1) = distpb(0, 1) + temp116*funb0 + r(0)*fun0b + rp1*(& +& rp2-3.d0)*fun2b + temp116b0 = distp(0, 1)*funb0/r(0) + rp2b = distp(0, 1)*rp1*fun2b - temp116b0 + rp1b = r(0)*rp2b + distp(0, 1)*(rp2-3.d0)*fun2b + rb(0) = rb(0) + distp(0, 1)*fun0b + 2.d0*dd1*rp1b + rp1*rp2b - & +& temp116*temp116b0 + dd1b = 2.d0*r(0)*rp1b + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 - dd3b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=0,0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=5,1,-1 + DO k=0,0,-1 + temp116b = distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1) = distpb(k, 1) + r(k)*temp116b + rb(k) = rb(k) + distp(k, 1)*temp116b + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*r(k)*zb(indorbp& +& , k) + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - temp186b1 = r(i)**2*distpb(i, 3) - rb(i) = rb(i) + (distp(i, 1)+dd3*distp(i, 2))*2*r(i)*distpb(i, 3) - distpb(i, 1) = distpb(i, 1) + temp186b1 - dd3b = dd3b + distp(i, 2)*temp186b1 - distpb(i, 2) = distpb(i, 2) + dd3*temp186b1 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) + distpb(i, 2) = 0.0_8 END DO + dd1b = 0.0_8 cb = 0.0_8 DO k=0,0,-1 - temp186b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp186b - distpb(k, 2) = 0.0_8 - temp186b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp186b0 - dd2*temp186b - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp186b0 + temp115 = r(k)**2 + temp115b1 = c*DEXP(-(dd1*temp115))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp115))*distpb(k, 1) + dd1b = dd1b - temp115*temp115b1 + rb(k) = rb(k) - dd1*2*r(k)*temp115b1 distpb(k, 1) = 0.0_8 END DO - temp185 = 2.d0**9 - temp184 = temp185*dd2**9 - temp183 = dd3**2/temp184 - temp182 = (dd1+dd2)**9 - temp181 = 2.d0**9 - temp180 = temp181*dd1**9 - temp179 = 120960.d0*pi*(1.0/temp180+2.d0*dd3/temp182+temp183) - temp178 = DSQRT(temp179) - IF (temp179 .EQ. 0.0) THEN - temp178b0 = 0.0 - ELSE - temp178b0 = -(pi*120960.d0*cb/(2.d0*temp178**2*2.D0*DSQRT(temp179)& -& )) - END IF - temp178b1 = 2.d0*temp178b0/temp182 - temp178b2 = -(dd3*9*(dd1+dd2)**8*temp178b1/temp182) - dd1b = dd1b + temp178b2 - temp181*9*dd1**8*temp178b0/temp180**2 - dd3b = dd3b + 2*dd3*temp178b0/temp184 + temp178b1 - dd2b = dd2b + temp178b2 - temp183*temp185*9*dd2**8*temp178b0/temp184 - ddb(indpar+3) = ddb(indpar+3) + dd3b - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (26) -! 2p triple zeta -! 2p without cusp condition - dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) - dd3 = dd(indpar+4) - peff2 = dd(indpar+5) -! if(iflagnorm.gt.2) then - c = 1.d0/2.d0/DSQRT(8.d0*pi*(1.d0/(2.d0*dd1)**5+2.d0*peff/(dd1+dd2)& -& **5+peff**2/(2.d0*dd2)**5+2.d0*peff2/(dd1+dd3)**5+peff2**2/(2.d0*& -& dd3)**5+2.d0*peff2*peff/(dd2+dd3)**5)) -! endif + dd1b = dd1b + 1.24420067280413253d0*2.25d0*dd1**1.25D0*cb + ddb(indparp) = ddb(indparp) + dd1b + CASE (106) +! 2s without cusp condition +! dd1*( dd3 +1/(1+dd2*r^2)) + dd2 = dd(indpar+1) + indorbp = indorb + 1 DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k))) - distp(k, 2) = c*DEXP(-(dd2*r(k))) - distp(k, 3) = c*DEXP(-(dd3*r(k))) - END DO - DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) - distp(i, 4) = distp(i, 1) + peff*distp(i, 2) + peff2*distp(i, 3) - END DO -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic + distp(k, 1) = 1.d0/(1.d0+dd2*r(k)*r(k)) END DO ! endif IF (typec .NE. 1) THEN - fun = (-(dd1*distp(0, 1))-dd2*peff*distp(0, 2)-dd3*peff2*distp(0, & -& 3))/r(0) - fun2 = dd1**2*distp(0, 1) + peff*dd2**2*distp(0, 2) + peff2*dd3**2& -& *distp(0, 3) -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO + fun = -(dd2*distp(0, 1)**2*2.d0) + fun2b = zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - funb = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp202b6 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp202b6 - fun2b = fun2b + temp202b6 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) distpb(0, 4) = distpb(0, 4) + zb(& -& indorbp, indt+i) - temp202b5 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp202b5 - funb = funb + rmu(ic, 0)*temp202b5 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - temp202b2 = dd2**2*fun2b - temp202b3 = dd3**2*fun2b - temp202b4 = funb/r(0) - dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*temp202b4 - distpb(0, 1) = distpb(0, 1) + dd1**2*fun2b - dd2b = peff*distp(0, 2)*2*dd2*fun2b - distp(0, 2)*peff*temp202b4 - peffb = distp(0, 2)*temp202b2 - distp(0, 2)*dd2*temp202b4 - distpb(0, 2) = distpb(0, 2) + peff*temp202b2 - dd3b = peff2*distp(0, 3)*2*dd3*fun2b - distp(0, 3)*peff2*temp202b4 - peff2b = distp(0, 3)*temp202b3 - distp(0, 3)*dd3*temp202b4 - distpb(0, 3) = distpb(0, 3) + peff2*temp202b3 - distpb(0, 1) = distpb(0, 1) - dd1*temp202b4 - distpb(0, 2) = distpb(0, 2) - dd2*peff*temp202b4 - distpb(0, 3) = distpb(0, 3) - dd3*peff2*temp202b4 - rb(0) = rb(0) - (-(dd1*distp(0, 1))-dd2*peff*distp(0, 2)-dd3*peff2& -& *distp(0, 3))*temp202b4/r(0) + temp118b = (1.-3.d0*(dd2*r(0)**2))*fun2b + temp118b0 = -(fun*distp(0, 1)*3.d0*fun2b) + funb0 = funb0 + distp(0, 1)*temp118b + distpb(0, 1) = fun*temp118b - 2.d0*dd2*2*distp(0, 1)*funb0 + dd2b = r(0)**2*temp118b0 - 2.d0*distp(0, 1)**2*funb0 + rb(0) = rb(0) + dd2*2*r(0)*temp118b0 ELSE distpb = 0.0_8 - peffb = 0.0_8 - dd1b = 0.0_8 dd2b = 0.0_8 - dd3b = 0.0_8 - peff2b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=0,0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 4)*zb(indorbp, i) - distpb(i, 4) = distpb(i, 4) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO + dd3b = 0.0_8 DO i=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - distpb(i, 1) = distpb(i, 1) + distpb(i, 4) - peffb = peffb + distp(i, 2)*distpb(i, 4) - distpb(i, 2) = distpb(i, 2) + peff*distpb(i, 4) - peff2b = peff2b + distp(i, 3)*distpb(i, 4) - distpb(i, 3) = distpb(i, 3) + peff2*distpb(i, 4) - distpb(i, 4) = 0.0_8 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO - cb = 0.0_8 DO k=0,0,-1 - temp202b = c*DEXP(-(dd3*r(k)))*distpb(k, 3) - cb = cb + DEXP(-(dd3*r(k)))*distpb(k, 3) - dd3b = dd3b - r(k)*temp202b - distpb(k, 3) = 0.0_8 - temp202b0 = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - distpb(k, 2) = 0.0_8 - temp202b1 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd2*temp202b0 - dd1*temp202b1 - dd3*temp202b - dd2b = dd2b - r(k)*temp202b0 - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp202b1 + temp117 = dd2*r(k)**2 + 1.d0 + temp117b5 = -(distpb(k, 1)/temp117**2) + dd2b = dd2b + r(k)**2*temp117b5 + rb(k) = rb(k) + dd2*2*r(k)*temp117b5 distpb(k, 1) = 0.0_8 END DO - temp201 = (dd2+dd3)**5 - temp188 = peff2*peff/temp201 - temp200 = 2.d0**5 - temp199 = temp200*dd3**5 - temp198 = peff2**2/temp199 - temp197 = (dd1+dd3)**5 - temp196 = 2.d0**5 - temp195 = temp196*dd2**5 - temp194 = peff**2/temp195 - temp193 = (dd1+dd2)**5 - temp192 = 2.d0**5 - temp191 = temp192*dd1**5 - temp190 = 8.d0*pi*(1.0/temp191+2.d0*peff/temp193+temp194+2.d0*peff2/& -& temp197+temp198+2.d0*temp188) - temp189 = DSQRT(temp190) - IF (temp190 .EQ. 0.0) THEN - temp189b = 0.0 - ELSE - temp189b = -(pi*8.d0*cb/(2.d0*temp189**2*2.D0*DSQRT(temp190))) - END IF - temp189b0 = 2.d0*temp189b/temp193 - temp189b1 = -(peff*5*(dd1+dd2)**4*temp189b0/temp193) - temp189b2 = 2.d0*temp189b/temp197 - temp189b3 = -(peff2*5*(dd1+dd3)**4*temp189b2/temp197) - temp188b0 = 2.d0*temp189b/temp201 - temp188b1 = -(temp188*5*(dd2+dd3)**4*temp188b0) - dd1b = dd1b + temp189b3 + temp189b1 - temp192*5*dd1**4*temp189b/& -& temp191**2 - peffb = peffb + peff2*temp188b0 + 2*peff*temp189b/temp195 + & -& temp189b0 - dd2b = dd2b + temp188b1 - temp194*temp196*5*dd2**4*temp189b/temp195 & -& + temp189b1 - peff2b = peff2b + peff*temp188b0 + 2*peff2*temp189b/temp199 + & -& temp189b2 - dd3b = dd3b + temp188b1 - temp198*temp200*5*dd3**4*temp189b/temp199 & -& + temp189b3 - ddb(indpar+5) = ddb(indpar+5) + peff2b - ddb(indpar+4) = ddb(indpar+4) + dd3b - ddb(indpar+3) = ddb(indpar+3) + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (27) -! 3p triple zeta -! 2p without cusp condition - dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) - dd3 = dd(indpar+4) - peff2 = dd(indpar+5) + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (71) +! f single Slater orbital derivative of 70 +! R(r)= (9.d0/2.0 1/dd1 - r) * exp(-alpha r) +! normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) ! if(iflagnorm.gt.2) then - c = 1.d0/2.d0/DSQRT(240.d0*pi*(1.d0/(2.d0*dd1)**7+2.d0*peff/(dd1+dd2& -& )**7+peff**2/(2.d0*dd2)**7+2.d0*peff2/(dd1+dd3)**7+peff2**2/(2.d0*& -& dd3)**7+2.d0*peff2*peff/(dd2+dd3)**7)) +! overall normalization +! l = 3 +! \int d\omega Y*Y = 4 pi / (2 l + 1) +! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5 * 3**2 / 2**2 / dd1**9 +! c=1.d0/dsqrt(10.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(9.d0/2.d0)/3.d0 + c = dd1**4.5d0*0.084104417400672d0 ! endif DO k=0,0 distp(k, 1) = c*DEXP(-(dd1*r(k))) - distp(k, 2) = c*DEXP(-(dd2*r(k))) - distp(k, 3) = c*DEXP(-(dd3*r(k))) END DO DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) - distp(i, 4) = r(i)*(distp(i, 1)+peff*distp(i, 2)+peff2*distp(i, 3)& -& ) + distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) +! lz=0 + distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) +! lz=+/-2 + distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) +! lz=+/-2 + distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) +! lz=+/-3 + distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) END DO -! indorbp=indorb - DO ic=1,3 +! lz=+/-3 + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO ! endif IF (typec .NE. 1) THEN - fun = (1.d0-dd1*r(0))*distp(0, 1) + peff*(1.d0-dd2*r(0))*distp(0, & -& 2) + peff2*(1.d0-dd3*r(0))*distp(0, 3) - fun2 = dd1*(dd1*r(0)-2.d0)*distp(0, 1) + peff*dd2*(dd2*r(0)-2.d0)*& -& distp(0, 2) + peff2*dd3*(dd3*r(0)-2.d0)*distp(0, 3) + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1)*(9.d0/2.d0/dd1-r(0)) + fun = distp(0, 1)*(dd1-11.d0/2.d0/r(0)) + fun2 = dd1*distp(0, 1)*(13.d0/2.d0-dd1*r(0)) ! indorbp=indorb - DO ic=1,3 + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + IF (ic .EQ. 1) THEN + IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF + ELSE IF (ic .EQ. 6) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + END IF + ELSE IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) END IF END DO END DO - funb = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=3,1,-1 - temp217 = fun/r(0) - temp218b = rmu(ic, 0)*zb(indorbp, indt+4) - temp217b = 4.d0*temp218b/r(0) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp217+fun2)*zb(indorbp, indt& -& +4) - funb = funb + temp217b - rb(0) = rb(0) - temp217*temp217b - fun2b = fun2b + temp218b + DO ic=7,1,-1 + temp124b25 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 8.d0*temp124b25 + fun2b = fun2b + temp124b25 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp216 = fun/r(0) - temp216b13 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(ic, 0) = rmub(ic, 0) + temp216*rmu(i, 0)*zb(indorbp, indt& -& +i) - rmub(i, 0) = rmub(i, 0) + temp216*rmu(ic, 0)*zb(indorbp, indt+& -& i) - funb = funb + temp216b13 - rb(0) = rb(0) - temp216*temp216b13 + IF (branch .LT. 11) THEN + IF (branch .LT. 6) THEN + IF (branch .LT. 4) THEN + IF (branch .LT. 3) THEN + IF (.NOT.branch .LT. 2) THEN + temp124b4 = cost1f*zb(indorbp, indt+i) + fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& +& temp124b4 + rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& +& temp124b4 + rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp124b4 + END IF + temp124b2 = -(cost1f*6.d0*zb(indorbp, indt+i)) + temp124b3 = rmu(i, 0)*temp124b2 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp124b2 + fun0b = fun0b + rmu(3, 0)*temp124b3 + rmub(3, 0) = rmub(3, 0) + fun0*temp124b3 + GOTO 100 + ELSE + temp124b7 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp124b7 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp124b7 + rb(0) = rb(0) - fun0*2*r(0)*temp124b7 + END IF + ELSE IF (.NOT.branch .LT. 5) THEN + temp124b8 = cost2f*10.d0*zb(indorbp, indt+i) + temp124b9 = rmu(i, 0)*temp124b8 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp124b8 + fun0b = fun0b + rmu(1, 0)*temp124b9 + rmub(1, 0) = rmub(1, 0) + fun0*temp124b9 + END IF + temp124b5 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp124b6 = rmu(i, 0)*temp124b5 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp124b5 + fun0b = fun0b + rmu(1, 0)*temp124b6 + rmub(1, 0) = rmub(1, 0) + fun0*temp124b6 + ELSE IF (branch .LT. 9) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 7) THEN + temp124b12 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp124b12 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp124b12 + rb(0) = rb(0) - fun0*2*r(0)*temp124b12 + END IF + ELSE + temp124b13 = cost2f*10.d0*zb(indorbp, indt+i) + temp124b14 = rmu(i, 0)*temp124b13 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp124b13 + fun0b = fun0b + rmu(2, 0)*temp124b14 + rmub(2, 0) = rmub(2, 0) + fun0*temp124b14 + END IF + temp124b10 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp124b11 = rmu(i, 0)*temp124b10 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp124b10 + fun0b = fun0b + rmu(2, 0)*temp124b11 + rmub(2, 0) = rmub(2, 0) + fun0*temp124b11 + ELSE IF (branch .LT. 10) THEN + temp124b15 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp124b15 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp124b15 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp124b15 + ELSE + temp124b16 = -(cost3f*2.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp124b16 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp124b16 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp124b16 + END IF + ELSE IF (branch .LT. 16) THEN + IF (branch .LT. 14) THEN + IF (branch .LT. 13) THEN + IF (branch .LT. 12) THEN + temp124b17 = cost3f*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp124b17 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp124b17 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp124b17 + ELSE + temp124b18 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp124b18 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp124b18 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp124b18 + END IF + ELSE + temp124b19 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp124b19 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp124b19 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp124b19 + END IF + ELSE IF (branch .LT. 15) THEN + temp124b20 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp124b20 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp124b20 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp124b20 + ELSE + temp124b21 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp124b21 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp124b21 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp124b21 + END IF + ELSE IF (branch .LT. 19) THEN + IF (branch .LT. 18) THEN + IF (.NOT.branch .LT. 17) THEN + temp124b22 = -(cost4f*6.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp124b22 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp124b22 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp124b22 + END IF + ELSE + temp124b23 = cost4f*6.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp124b23 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp124b23 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp124b23 + END IF + ELSE IF (.NOT.branch .LT. 20) THEN + temp124b24 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp124b24 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp124b24 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp124b24 + END IF + 100 temp124b1 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp124b1 + funb0 = funb0 + rmu(i, 0)*temp124b1 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp216b3 = dd1*distp(0, 1)*fun2b - temp216b4 = (dd1*r(0)-2.d0)*fun2b - temp216b5 = (dd2*r(0)-2.d0)*fun2b - temp216b6 = peff*dd2*distp(0, 2)*fun2b - temp216b7 = (dd3*r(0)-2.d0)*fun2b - temp216b8 = peff2*dd3*distp(0, 3)*fun2b - dd1b = distp(0, 1)*temp216b4 - distp(0, 1)*r(0)*funb + r(0)*& -& temp216b3 - temp216b9 = peff*distp(0, 2)*funb - temp216b10 = peff2*distp(0, 3)*funb - rb(0) = rb(0) + dd3*temp216b8 - dd2*temp216b9 - dd3*temp216b10 - & -& distp(0, 1)*dd1*funb + dd2*temp216b6 + dd1*temp216b3 - distpb(0, 1) = dd1*temp216b4 - temp216b11 = (1.d0-dd2*r(0))*funb - peffb = distp(0, 2)*temp216b11 + distp(0, 2)*dd2*temp216b5 - dd2b = r(0)*temp216b6 - r(0)*temp216b9 + distp(0, 2)*peff*& -& temp216b5 - distpb(0, 2) = peff*dd2*temp216b5 - temp216b12 = (1.d0-dd3*r(0))*funb - peff2b = distp(0, 3)*temp216b12 + distp(0, 3)*dd3*temp216b7 - dd3b = r(0)*temp216b8 - r(0)*temp216b10 + distp(0, 3)*peff2*& -& temp216b7 - distpb(0, 3) = peff2*dd3*temp216b7 - distpb(0, 1) = distpb(0, 1) + (1.d0-dd1*r(0))*funb - distpb(0, 2) = distpb(0, 2) + peff*temp216b11 - distpb(0, 3) = distpb(0, 3) + peff2*temp216b12 - distpb(0, 4) = distpb(0, 4) + fun0b + temp124b = (13.d0/2.d0-dd1*r(0))*fun2b + temp124b0 = dd1*distp(0, 1)*fun2b + temp121 = 2.d0*dd1 + temp120 = 9.d0/temp121 + dd1b = distp(0, 1)*funb0 - distp(0, 1)*temp120*2.d0*fun0b/temp121 & +& - r(0)*temp124b0 + distp(0, 1)*temp124b + temp123 = 2.d0*r(0) + temp122 = 11.d0/temp123 + distpb(0, 1) = distpb(0, 1) + (dd1-temp122)*funb0 + (temp120-r(0))& +& *fun0b + dd1*temp124b + rb(0) = rb(0) + distp(0, 1)*temp122*2.d0*funb0/temp123 - distp(0, & +& 1)*fun0b - dd1*temp124b0 + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - peffb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 - dd3b = 0.0_8 - peff2b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=0,0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 4)*zb(indorbp, i) - distpb(i, 4) = distpb(i, 4) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + dd1b = 0.0_8 + DO ic=7,1,-1 + DO k=0,0,-1 + temp119 = 2.d0*dd1 + temp118 = 9.d0/temp119 + temp118b10 = (temp118-r(k))*zb(indorbp, k) + temp118b11 = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp118b10 + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp118b10 + dd1b = dd1b - temp118*2.d0*temp118b11/temp119 + rb(k) = rb(k) - temp118b11 + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - temp216b2 = r(i)*distpb(i, 4) - rb(i) = rb(i) + (distp(i, 1)+peff*distp(i, 2)+peff2*distp(i, 3))*& -& distpb(i, 4) - distpb(i, 1) = distpb(i, 1) + temp216b2 - peffb = peffb + distp(i, 2)*temp216b2 - distpb(i, 2) = distpb(i, 2) + peff*temp216b2 - peff2b = peff2b + distp(i, 3)*temp216b2 - distpb(i, 3) = distpb(i, 3) + peff2*temp216b2 + temp118b2 = cost4f*rmu(2, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 8) - 2*rmu(2, i)*temp118b2 + distpb(i, 8) = 0.0_8 + temp118b3 = cost4f*rmu(1, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& +& distpb(i, 7) + 2*rmu(1, i)*temp118b3 + 3.d0*2*rmu(1, i)*& +& temp118b2 + rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp118b3 + distpb(i, 7) = 0.0_8 + temp118b4 = cost3f*2.d0*distpb(i, 6) + temp118b5 = rmu(2, i)*temp118b4 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp118b5 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp118b5 + rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp118b4 + distpb(i, 6) = 0.0_8 + temp118b6 = cost3f*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 5) + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp118b6 + distpb(i, 5) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 4) - 2*rmu(2, i)*temp118b6 + temp118b7 = cost2f*rmu(2, i)*distpb(i, 4) + rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp118b7 distpb(i, 4) = 0.0_8 + temp118b8 = cost2f*rmu(1, i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 3) + distpb(i, 3) = 0.0_8 + temp118b9 = cost1f*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - 2*r(i)*temp118b8 - 3.d0*2*r(i)*temp118b9 - 2*r(i)*& +& temp118b7 + rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& +& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp118b9 + 5.d0*2*rmu(3, i)*& +& temp118b8 + distpb(i, 2) = 0.0_8 END DO cb = 0.0_8 DO k=0,0,-1 - temp216b = c*DEXP(-(dd3*r(k)))*distpb(k, 3) - cb = cb + DEXP(-(dd3*r(k)))*distpb(k, 3) - dd3b = dd3b - r(k)*temp216b - distpb(k, 3) = 0.0_8 - temp216b0 = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - distpb(k, 2) = 0.0_8 - temp216b1 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd2*temp216b0 - dd1*temp216b1 - dd3*temp216b - dd2b = dd2b - r(k)*temp216b0 + temp118b1 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp216b1 + dd1b = dd1b - r(k)*temp118b1 + rb(k) = rb(k) - dd1*temp118b1 distpb(k, 1) = 0.0_8 END DO - temp215 = (dd2+dd3)**7 - temp202 = peff2*peff/temp215 - temp214 = 2.d0**7 - temp213 = temp214*dd3**7 - temp212 = peff2**2/temp213 - temp211 = (dd1+dd3)**7 - temp210 = 2.d0**7 - temp209 = temp210*dd2**7 - temp208 = peff**2/temp209 - temp207 = (dd1+dd2)**7 - temp206 = 2.d0**7 - temp205 = temp206*dd1**7 - temp204 = 240.d0*pi*(1.0/temp205+2.d0*peff/temp207+temp208+2.d0*& -& peff2/temp211+temp212+2.d0*temp202) - temp203 = DSQRT(temp204) - IF (temp204 .EQ. 0.0) THEN - temp203b = 0.0 - ELSE - temp203b = -(pi*240.d0*cb/(2.d0*temp203**2*2.D0*DSQRT(temp204))) - END IF - temp203b0 = 2.d0*temp203b/temp207 - temp203b1 = -(peff*7*(dd1+dd2)**6*temp203b0/temp207) - temp203b2 = 2.d0*temp203b/temp211 - temp203b3 = -(peff2*7*(dd1+dd3)**6*temp203b2/temp211) - temp202b7 = 2.d0*temp203b/temp215 - temp202b8 = -(temp202*7*(dd2+dd3)**6*temp202b7) - dd1b = dd1b + temp203b3 + temp203b1 - temp206*7*dd1**6*temp203b/& -& temp205**2 - peffb = peffb + peff2*temp202b7 + 2*peff*temp203b/temp209 + & -& temp203b0 - dd2b = dd2b + temp202b8 - temp208*temp210*7*dd2**6*temp203b/temp209 & -& + temp203b1 - peff2b = peff2b + peff*temp202b7 + 2*peff2*temp203b/temp213 + & -& temp203b2 - dd3b = dd3b + temp202b8 - temp212*temp214*7*dd3**6*temp203b/temp213 & -& + temp203b3 - ddb(indpar+5) = ddb(indpar+5) + peff2b - ddb(indpar+4) = ddb(indpar+4) + dd3b - ddb(indpar+3) = ddb(indpar+3) + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (28) -! R(r)=(Z*b*r)^4/(1+(Z*b*r)^4)*exp(-z*r) orbital 1s (no cusp) -! d -> b1s (defined in module constants) -! normadization: cost1s, depends on b1s + dd1b = dd1b + 0.084104417400672d0*4.5d0*dd1**3.5D0*cb + ddb(indparp) = ddb(indparp) + dd1b + CASE (14) +! 3s -derivative of 34 with respect to dd1 +! (1.d0 + dd1 r) * exp(-dd1 * r) ! normalized ! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! if(dd1.gt.0.) then - c = cost1s*dd1**1.5d0 -! else -! c=1.d0 -! endif -! endif - DO i=0,0 - distp(i, 1) = c*DEXP(-(dd1*r(i))) - END DO - DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) - rp4 = (dd1*b1s*r(i))**4 + DO k=0,0 + distp(k, 1) = DEXP(-(dd1*r(k))) END DO +! if(iflagnorm.gt.2) then +! c=dsqrt(dd1**3.d0/7.d0/pi) + c = dd1**1.5d0*0.213243618622923d0 IF (typec .NE. 1) THEN - rp1 = dd1*b1s*r(0) - rp2 = rp1**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) - rp4 = rp2**2 - rp5 = r(0)*dd1 - rp6 = (b1s*dd1)**2*rp2 -! the first derivative /r - fun = -(distp(0, 1)*rp6*(-4.d0+rp5+rp4*rp5)/(1.d0+rp4)**2) -! the second derivative derivative - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) + fun = -(distp(0, 1)*dd1**2*r(0)) + fun2 = -(distp(0, 1)*dd1**2*(1.d0-dd1*r(0))) + temp125b = 2.d0*zb(indorbp, indt+4)/r(0) + cb = fun2*zb(indorbp, indt+4) + fun*temp125b + funb0 = c*temp125b + rb(0) = rb(0) - c*fun*temp125b/r(0) + fun2b = c*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + temp124 = rmu(i, 0)/r(0) + temp124b32 = c*fun*zb(indorbp, indt+i)/r(0) + cb = cb + temp124*fun*zb(indorbp, indt+i) + funb0 = funb0 + temp124*c*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp124b32 + rb(0) = rb(0) - temp124*temp124b32 zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp222 = (rp4+1.d0)**3 - temp221 = distp(0, 1)*rp6/temp222 - temp222b = temp221*fun2b - temp222b0 = 2*rp4*rp5*temp222b - temp221b = (rp5**2-8*rp5-20*rp4+2*(rp4*rp5**2)-8*(rp4*rp5)+(rp4*& -& rp5)**2+12.d0)*fun2b/temp222 - temp220 = (rp4+1.d0)**2 - temp219 = distp(0, 1)*rp6/temp220 - temp219b = -(temp219*funb) - rp5b = (rp4+1.0_8)*temp219b + rp4*temp222b0 + (2**2*rp4*rp5-8*rp4+& -& 2*rp5-8)*temp222b - temp219b0 = -((rp5+rp4*rp5-4.d0)*funb/temp220) - rp4b = rp5*temp219b - temp219*2*(rp4+1.d0)*temp219b0 - temp221*3*(& -& rp4+1.d0)**2*temp221b + rp5*temp222b0 + (2*rp5**2-8*rp5-20)*& -& temp222b - distpb(0, 1) = rp6*temp219b0 + rp6*temp221b - rp6b = distp(0, 1)*temp219b0 + distp(0, 1)*temp221b - temp219b1 = b1s**2*rp6b - rp2b = 2*rp2*rp4b + dd1**2*temp219b1 - rp1b = 2*rp1*rp2b - dd1b = r(0)*rp5b + b1s*r(0)*rp1b + rp2*2*dd1*temp219b1 - rb(0) = rb(0) + b1s*dd1*rp1b + dd1*rp5b - CALL POPREAL8(adr8ibuf,adr8buf,rp4) + temp124b29 = -((1.d0-dd1*r(0))*fun2b) + temp124b30 = -(distp(0, 1)*dd1**2*fun2b) + temp124b31 = -(dd1**2*funb0) + distpb(0, 1) = r(0)*temp124b31 + dd1**2*temp124b29 + dd1b = distp(0, 1)*2*dd1*temp124b29 - r(0)*temp124b30 - distp(0, 1& +& )*r(0)*2*dd1*funb0 + rb(0) = rb(0) + distp(0, 1)*temp124b31 - dd1*temp124b30 ELSE distpb = 0.0_8 dd1b = 0.0_8 + cb = 0.0_8 END IF DO i=0,0,-1 - temp218 = rp4/(rp4+1.d0) - temp218b1 = distp(i, 1)*zb(indorbp, i)/(rp4+1.d0) - distpb(i, 1) = distpb(i, 1) + temp218*zb(indorbp, i) - rp4b = (1.0_8-temp218)*temp218b1 + temp124b27 = c*distp(i, 1)*zb(indorbp, i) + temp124b28 = (dd1*r(i)+1.d0)*zb(indorbp, i) + dd1b = dd1b + r(i)*temp124b27 + rb(i) = rb(i) + dd1*temp124b27 + cb = cb + distp(i, 1)*temp124b28 + distpb(i, 1) = distpb(i, 1) + c*temp124b28 zb(indorbp, i) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,rp4) - temp218b2 = 4*b1s**4*dd1**3*r(i)**3*rp4b - dd1b = dd1b + r(i)*temp218b2 - rb(i) = rb(i) + dd1*temp218b2 END DO - cb = 0.0_8 - DO i=0,0,-1 - temp218b0 = c*DEXP(-(dd1*r(i)))*distpb(i, 1) - cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) - dd1b = dd1b - r(i)*temp218b0 - rb(i) = rb(i) - dd1*temp218b0 - distpb(i, 1) = 0.0_8 + dd1b = dd1b + 0.213243618622923d0*1.5d0*dd1**0.5D0*cb + DO k=0,0,-1 + temp124b26 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp124b26 + rb(k) = rb(k) - dd1*temp124b26 + distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + cost1s*1.5d0*dd1**0.5D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (29) -! derivative of (28) + CASE (60) +! 1s single Z pseudo +! R(r)=r**3*exp(-z*r**2) single zeta ! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) ! if(iflagnorm.gt.2) then -! if(dd1.gt.0.) then - c = cost1s*dd1**1.5d0 -! else -! c=1.d0 -! endif +! c=2.d0/pi**(3.d0/4.d0)*(2.d0*dd1)**(9.d0/4.d0)*dsqrt(2.d0/105.d0) + c = dd1**2.25d0*.55642345640820284397d0 ! endif -! if(dd1.gt.0.) then - c1 = 1.5d0/dd1 -! else -! c1=0.d0 -! endif - DO i=0,0 - distp(i, 1) = c*DEXP(-(dd1*r(i))) - END DO - DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) -! rp1=(b1s*r(i))**4*dd1**3 -! rp4=rp1*dd1 -! rp5=dd1*r(i) -! z(indorbp,i)=distp(i,1)*& -! &(c1*rp4/(1+rp4)-rp1*(-4+rp5+rp4*rp5)/(1+rp4)**2) - rp4 = (b1s*dd1*r(i))**4 - CALL PUSHREAL8(adr8ibuf,adr8buf,rp5) - rp5 = dd1*r(i) + DO k=0,0 + distp(k, 1) = c*DEXP(-(dd1*r(k)**2))*r(k) END DO IF (typec .NE. 1) THEN - rp1 = dd1*b1s*r(0) - rp2 = rp1**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) - rp4 = rp2**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,rp5) - rp5 = rp4*rp1 - rp8 = rp4*rp4 - fun = distp(0, 1)*(dd1*rp2*(4*b1s**2*(11-5*rp4)+2*(rp1+rp5)**2-b1s& -& *rp1*(21+26*rp4+5*rp8)))/(2.*(1+rp4)**3) - funb = 2.d0*zb(indorbp, indt+4) + rp1 = r(0)**2*dd1 +! the first derivative / r + fun = distp(0, 1)*(3.d0-2.d0*rp1) +! the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp236 = 2.*b1s*(rp4+1)**4 - temp235 = distp(0, 1)*dd1*rp2 - temp232 = temp235/temp236 - temp235b = temp232*fun2b - temp235b0 = b1s*(7*rp4+31)*2*(rp1+rp5)*temp235b - temp235b1 = -(2*3*(rp1+rp5)**2*temp235b) - temp234 = 64*b1s**2 - temp234b = temp234*temp235b - temp233 = 4*b1s**3 - temp232b = (b1s*((7*rp4+31)*(rp1+rp5)**2)-2*(rp1+rp5)**3+temp234*(& -& rp1*(rp8-rp4-2))+temp233*(25*rp8-134*rp4+33))*fun2b/temp236 - temp231 = 2.*(rp4+1)**3 - temp230 = distp(0, 1)*dd1*rp2 - temp227 = temp230/temp231 - temp230b = temp227*funb - temp229b = 2**2*(rp1+rp5)*temp230b - rp5b = temp229b + temp235b1 + temp235b0 - temp228b = -(b1s*temp230b) - rp8b = rp1*5*temp228b + temp233*25*temp235b + rp1*temp234b - temp229 = 4*b1s**2 - temp228 = 26*rp4 + 5*rp8 + 21 - temp227b0 = (temp229*(11-5*rp4)+2*(rp1+rp5)**2-b1s*(rp1*temp228))*& -& funb/temp231 - rp4b = rp1*26*temp228b - temp229*5*temp230b - temp227*2.*3*(rp4+1)& -& **2*temp227b0 + rp1*rp5b + 2*rp4*rp8b - temp232*2.*b1s*4*(rp4+1)& -& **3*temp232b - rp1*temp234b + (7*(b1s*(rp1+rp5)**2)-134*temp233)& -& *temp235b - rp2b = distp(0, 1)*dd1*temp227b0 + 2*rp2*rp4b + distp(0, 1)*dd1*& -& temp232b - rp1b = temp229b + temp228*temp228b + 2*rp1*rp2b + rp4*rp5b + (rp8-& -& rp4-2)*temp234b + temp235b1 + temp235b0 - distpb(0, 1) = dd1*rp2*temp227b0 + dd1*rp2*temp232b - dd1b = distp(0, 1)*rp2*temp227b0 + b1s*r(0)*rp1b + distp(0, 1)*rp2& -& *temp232b - CALL POPREAL8(adr8ibuf,adr8buf,rp5) - CALL POPREAL8(adr8ibuf,adr8buf,rp4) - rb(0) = rb(0) + b1s*dd1*rp1b + distpb(0, 1) = (3.d0-2.d0*rp1)*funb0 + (4.d0*rp1**2-14.d0*rp1+6.d0& +& )*fun2b + rp1b = (distp(0, 1)*4.d0*2*rp1-distp(0, 1)*14.d0)*fun2b - distp(0& +& , 1)*2.d0*funb0 + rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd1b = r(0)**2*rp1b ELSE distpb = 0.0_8 dd1b = 0.0_8 END IF - c1b = 0.0_8 DO i=0,0,-1 - temp223 = rp4/(rp4+1) - temp227b = distp(i, 1)*temp223*zb(indorbp, i) - temp224 = dd1*(rp4+1) - temp225b = -(temp227b/temp224) - temp226 = rp5 + rp4*rp5 - 4 - temp225 = temp226/temp224 - temp224b = -(temp225*temp225b) - temp223b0 = (c1-temp225)*distp(i, 1)*zb(indorbp, i)/(rp4+1) - c1b = c1b + temp227b - rp5b = (rp4+1.0_8)*temp225b - rp4b = (1.0_8-temp223)*temp223b0 + dd1*temp224b + rp5*temp225b - temp223b1 = 4*b1s**4*dd1**3*r(i)**3*rp4b - dd1b = dd1b + r(i)*rp5b + r(i)*temp223b1 + (rp4+1)*temp224b - distpb(i, 1) = distpb(i, 1) + (c1-temp225)*temp223*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,rp5) - rb(i) = rb(i) + dd1*temp223b1 + dd1*rp5b - CALL POPREAL8(adr8ibuf,adr8buf,rp4) END DO cb = 0.0_8 - DO i=0,0,-1 - temp223b = c*DEXP(-(dd1*r(i)))*distpb(i, 1) - cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) - dd1b = dd1b - r(i)*temp223b - rb(i) = rb(i) - dd1*temp223b - distpb(i, 1) = 0.0_8 + DO k=0,0,-1 + temp125 = r(k)**2 + temp125b0 = c*r(k)*DEXP(-(dd1*temp125))*distpb(k, 1) + temp125b1 = DEXP(-(dd1*temp125))*distpb(k, 1) + dd1b = dd1b - temp125*temp125b0 + rb(k) = rb(k) + c*temp125b1 - dd1*2*r(k)*temp125b0 + cb = cb + r(k)*temp125b1 + distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + cost1s*1.5d0*dd1**0.5D0*cb - 1.5d0*c1b/dd1**2 + dd1b = dd1b + .55642345640820284397d0*2.25d0*dd1**1.25D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (57) -! orbital 1s (no cusp) - STO regolarized for r->0 -! R(r)= C(z) * P(z*r) * exp(-z*r) -! P(x) = (x+a)^n/(1+(x+a)^n) with a so that P(0)==dP(0)/dx -! C(z) = const * z^(3/2) normalization -! the following definitions are in module constants -! n -> costSTO1s_n = 4 -! a -> costSTO1s_a = 1.2263393530877080588 -! const(n) -> costSTO1s_c = 0.58542132302621750732 -! -! + CASE (19) +! 3s -derivative of 60 with respect to dd1 +! R(r)=c*exp(-z*r**2)*(3/4/z-r**2) ! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! if(dd1.gt.0.) then - c = coststo1s_c*dd1**1.5d0 -! else -! c=1.d0 -! endif -! endif - DO i=0,0 - distp(i, 1) = c*DEXP(-(dd1*r(i))) - END DO - DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) - rp4 = (dd1*r(i)+coststo1s_a)**coststo1s_n +! if(iflagnorm.gt.2) then +! if(dd1.ne.0.) then +! c=(2.d0*dd1/pi)**(3.d0/4.d0) + c = 0.71270547035499016d0*dd1**0.75d0 +! else +! c=1.d0 +! endif +! endif + DO k=0,0 + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO IF (typec .NE. 1) THEN - rp1 = dd1*r(0) + coststo1s_a - rp2 = rp1**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) - rp4 = rp1**coststo1s_n ! the first derivative /r -!fun=-z(indorbp,0)*((dd1**2*(-costSTO1s_n+rp1+rp1*rp4))/& -! &(rp1*(-costSTO1s_a+rp1)*(1.d0+rp4))) - fun = -(distp(0, 1)*rp4*(dd1**2*(-coststo1s_n+rp1+rp1*rp4)/(rp1*(-& -& coststo1s_a+rp1)*(1.d0+rp4)**2))) -! the second derivative derivative - funb = 2.d0*zb(indorbp, indt+4) + fun = distp(0, 1)*(2.d0*dd1*r(0)**2-7.d0/2.d0) +! the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp245 = (rp4+1.d0)**3 - temp242 = rp2*temp245 - temp243b = (rp2*(rp4+1.d0)**2-coststo1s_n*((2.d0*rp1+1.d0)*(rp4+& -& 1.d0))-coststo1s_n**2*(rp4-1.d0))*fun2b/temp242 - temp245b = dd1**2*temp243b - temp244 = distp(0, 1)*rp4*dd1**2 - temp243 = temp244/temp242 - temp242b = -(temp243*temp243b) - temp242b0 = temp243*fun2b - temp241 = (rp4+1.d0)**2 - temp238 = rp1*(rp1-coststo1s_a)*temp241 - temp241b = -(funb/temp238) - temp239 = rp1 - coststo1s_n + rp1*rp4 - temp240b = temp239*temp241b - temp241b0 = dd1**2*temp240b - distpb(0, 1) = rp4*temp241b0 + rp4*temp245b - temp240 = distp(0, 1)*rp4*dd1**2 - temp239b = temp240*temp241b - temp238b = -(temp240*temp239*temp241b/temp238) - rp4b = distp(0, 1)*temp241b0 + rp1*temp239b + rp1*(rp1-coststo1s_a& -& )*2*(rp4+1.d0)*temp238b + (rp2*2*(rp4+1.d0)-coststo1s_n*(2.d0*& -& rp1+1.d0)-coststo1s_n**2)*temp242b0 + rp2*3*(rp4+1.d0)**2*& -& temp242b + distp(0, 1)*temp245b - rp2b = (rp4+1.d0)**2*temp242b0 + temp245*temp242b - IF (rp1 .LE. 0.0 .AND. (coststo1s_n .EQ. 0.0 .OR. coststo1s_n .NE.& -& INT(coststo1s_n))) THEN - rp1b = (rp4+1.0_8)*temp239b + (temp241*rp1+temp241*(rp1-& -& coststo1s_a))*temp238b + 2*rp1*rp2b - coststo1s_n*(rp4+1.d0)*& -& 2.d0*temp242b0 - ELSE - rp1b = (rp4+1.0_8)*temp239b + (temp241*rp1+temp241*(rp1-& -& coststo1s_a))*temp238b + 2*rp1*rp2b + coststo1s_n*rp1**(& -& coststo1s_n-1)*rp4b - coststo1s_n*(rp4+1.d0)*2.d0*temp242b0 - END IF - dd1b = distp(0, 1)*rp4*2*dd1*temp240b + r(0)*rp1b + distp(0, 1)*& -& rp4*2*dd1*temp243b - CALL POPREAL8(adr8ibuf,adr8buf,rp4) - rb(0) = rb(0) + dd1*rp1b + temp129 = r(0)**4 + temp129b = distp(0, 1)*fun2b + distpb(0, 1) = (2.d0*(dd1*r(0)**2)-7.d0/2.d0)*funb0 + (13.d0*(dd1*& +& r(0)**2)-7.d0/2.d0-4.d0*(dd1**2*temp129))*fun2b + temp129b0 = distp(0, 1)*2.d0*funb0 + dd1b = r(0)**2*temp129b0 + (13.d0*r(0)**2-4.d0*temp129*2*dd1)*& +& temp129b + rb(0) = rb(0) + dd1*2*r(0)*temp129b0 + (13.d0*dd1*2*r(0)-4.d0*dd1& +& **2*4*r(0)**3)*temp129b ELSE distpb = 0.0_8 dd1b = 0.0_8 END IF DO i=0,0,-1 - temp237 = rp4/(rp4+1.d0) - temp237b0 = distp(i, 1)*zb(indorbp, i)/(rp4+1.d0) - distpb(i, 1) = distpb(i, 1) + temp237*zb(indorbp, i) - rp4b = (1.0_8-temp237)*temp237b0 + temp128 = 4.d0*dd1 + temp127 = 3.d0/temp128 + temp127b = distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + (temp127-r(i)**2)*zb(indorbp, i) + dd1b = dd1b - temp127*4.d0*temp127b/temp128 + rb(i) = rb(i) - 2*r(i)*temp127b zb(indorbp, i) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,rp4) - IF (coststo1s_a + dd1*r(i) .LE. 0.0 .AND. (coststo1s_n .EQ. 0.0 & -& .OR. coststo1s_n .NE. INT(coststo1s_n))) THEN - temp237b1 = 0.0 - ELSE - temp237b1 = coststo1s_n*(coststo1s_a+dd1*r(i))**(coststo1s_n-1)*& -& rp4b - END IF - dd1b = dd1b + r(i)*temp237b1 - rb(i) = rb(i) + dd1*temp237b1 END DO cb = 0.0_8 - DO i=0,0,-1 - temp237b = c*DEXP(-(dd1*r(i)))*distpb(i, 1) - cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) - dd1b = dd1b - r(i)*temp237b - rb(i) = rb(i) - dd1*temp237b - distpb(i, 1) = 0.0_8 + DO k=0,0,-1 + temp126 = r(k)**2 + temp126b = c*DEXP(-(dd1*temp126))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp126))*distpb(k, 1) + dd1b = dd1b - temp126*temp126b + rb(k) = rb(k) - dd1*2*r(k)*temp126b + distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + coststo1s_c*1.5d0*dd1**0.5D0*cb + dd1b = dd1b + 0.71270547035499016d0*0.75d0*dd1**(-0.25D0)*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (66) -! derivative of 57 (orbital 1s STO regolarized for r->0) -! dR(r)/dz with R(r)= C(z) * P(z*r) * exp(-z*r) -! P(x) = (x+a)^n/(1+(x+a)^n) with a so that P(0)==dP(0)/dx -! C(z) = const * z^(3/2) normalization -! the following definitions are in module constants -! n -> costSTO1s_n = 4 -! a -> costSTO1s_a = 1.2263393530877080588 -! const(n) -> costSTO1s_c = 0.58542132302621750732 -! -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! if(dd1.gt.0.) then - c = coststo1s_c*dd1**1.5d0 -! else -! c=1.d0 -! endif -! endif + CASE (51) +! 2p single zeta +! g single gaussian orbital +! R(r)= exp(-alpha r^2) +! normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization +! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0) + c = dd1**2.75d0*1.11284691281640568826d0 +! endif + DO k=0,0 + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + END DO DO i=0,0 - distp(i, 1) = c*DEXP(-(dd1*r(i))) + distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& +& 2+3.d0*r(i)**4) +! lz=0 + distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& +& 2-r(i)**2) +! lz=+/-2 + distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& +& (i)**2) +! lz=+/-2 + distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & +& i)**2) +! lz=+/-3 + distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& +& , i)**2) +! lz=+/-3 + distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& +& rmu(2, i)**4) +! lz=+/-4 + distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& +& , i)**2) END DO - DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) - rp1 = dd1*r(i) + coststo1s_a - CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) - rp4 = rp1**coststo1s_n +! lz=+/-4 + DO ic=1,9 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic END DO +! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) - rp1 = dd1*r(0) + coststo1s_a - rp2 = rp1**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) - rp4 = rp1**coststo1s_n - rp6 = rp4**2 -! the first derivative /r - fun = distp(0, 1)*(dd1*rp4*(-(2.d0*coststo1s_a*(coststo1s_n**2*(-& -& 1.d0+rp4)+coststo1s_n*(1.d0+2.d0*rp1)*(1.d0+rp4)-rp2*(1.d0+rp4)& -& **2))+rp1*(2*coststo1s_n**2*(-1+rp4)+coststo1s_n*(-3.d0+4.d0*rp1& -& )*(1.d0+rp4)-rp1*(-5.d0+2.d0*rp1)*(1.d0+rp4)**2)))/(2.d0*rp2*(& -& coststo1s_a-rp1)*(1.d0+rp4)**3) -! fun=+distp(0,1)*rp4/(1.d0+rp4)*(1.5d0/dd1 + r(0)* & -! &(-1.d0+(costSTO1s_n)/(rp1*(1.d0+rp4)))) & -! & *(dd1*(2.d0 + 5.d0/(-dd1*r(0)) + & -! &(4.d0*costSTO1s_n**2)/(rp2*(1.d0+rp4)**2) + & -! &(costSTO1s_n*((3.d0 - 2.d0*costSTO1s_n - 4.d0*rp1)*rp1& -! & + 2.d0*costSTO1s_a*(1.d0+costSTO1s_n+2.d0*rp1)))/ & -! &(rp2*(dd1*r(0))*(1 + rp4))))/2.d0 -! the second derivative derivative - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1) + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) +! indorbp=indorb + DO ic=1,9 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + IF (ic .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + ELSE IF (ic .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (ic .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE IF (ic .EQ. 4) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (ic .EQ. 5) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + ELSE IF (ic .EQ. 6) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE IF (ic .EQ. 7) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (ic .EQ. 8) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + ELSE IF (ic .EQ. 9) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + END IF END DO distpb = 0.0_8 - temp270 = (rp4+1)**4 - temp257 = 2.d0*rp1*rp2 - temp258 = temp257*temp270 - temp269 = distp(0, 1)*dd1*rp4 - temp259 = temp269/temp258 - temp269b = -(temp259*fun2b) - temp268 = coststo1s_n**3 - temp264 = 6.d0*rp2 - 8.d0*rp1 - 3.d0 - temp267 = (rp4+1.d0)**3 - temp266 = rp2*(2.d0*rp1-7.d0) - temp265 = temp266*temp267 - coststo1s_n*temp264*(rp4+1.d0)**2 - & -& coststo1s_n**2*(6.d0*rp1-1.d0)*(rp6-1.d0) - 2*temp268*(rp4*(rp4-& -& 4.d0)+1.d0) - temp265b = rp1*temp269b - temp264b = -(coststo1s_n*(rp4+1.d0)**2*temp265b) - temp264b0 = -(coststo1s_n**2*temp265b) - temp264b1 = -(temp268*2*temp265b) - temp263 = coststo1s_n**3 - temp262 = 3.d0*rp1*(rp1+1.d0) + 2.d0 - temp261 = (rp4+1.d0)**3 - temp260 = 3.d0*coststo1s_n**2 - temp260b = coststo1s_a*2.d0*temp269b - temp260b0 = coststo1s_n*(rp4+1.d0)**2*3.d0*temp260b - temp259b = -((rp1*temp265+coststo1s_a*2.d0*(temp260*((rp1+1.d0)*(& -& rp6-1.d0))-rp1*rp2*temp261+coststo1s_n*((rp4+1.d0)**2*temp262)+& -& temp263*(rp4*(rp4-4.d0)+1.d0)))*fun2b/temp258) - temp258b = -(temp259*temp259b) - temp257b = temp270*temp258b - temp256 = (rp4+1.d0)**3 - temp249 = 2.d0*rp2*(coststo1s_a-rp1) - temp250 = temp249*temp256 - temp255 = distp(0, 1)*dd1*rp4 - temp251 = temp255/temp250 - temp255b = temp251*funb - temp254 = (rp4+1.d0)**2 - temp253 = rp1*(2.d0*rp1-5.d0) - temp252 = 2*coststo1s_n**2*(rp4-1) + coststo1s_n*(4.d0*rp1-3.d0)*(& -& rp4+1.d0) - temp253*temp254 - temp252b = -(coststo1s_a*2.d0*temp255b) - temp251b = (rp1*temp252-coststo1s_a*2.d0*(coststo1s_n**2*(rp4-1.d0& -& )+coststo1s_n*((2.d0*rp1+1.d0)*(rp4+1.d0))-rp2*(rp4+1.d0)**2))*& -& funb/temp250 - temp250b = -(temp251*temp251b) - temp249b0 = temp256*temp250b - rp2b = (coststo1s_a-rp1)*2.d0*temp249b0 - (rp4+1.d0)**2*temp252b +& -& 2.d0*rp1*temp257b - temp261*rp1*temp260b + 6.d0*temp264b + & -& temp267*(2.d0*rp1-7.d0)*temp265b - rp6b = temp260*(rp1+1.d0)*temp260b + (6.d0*rp1-1.d0)*temp264b0 - temp252b0 = rp1*temp255b - rp4b = (coststo1s_n*(4.d0*rp1-3.d0)-temp253*2*(rp4+1.d0)+2*& -& coststo1s_n**2)*temp252b0 + (coststo1s_n*(2.d0*rp1+1.d0)-rp2*2*(& -& rp4+1.d0)+coststo1s_n**2)*temp252b + distp(0, 1)*dd1*temp251b + & -& temp249*3*(rp4+1.d0)**2*temp250b + 2*rp4*rp6b + temp257*4*(rp4+1& -& )**3*temp258b + distp(0, 1)*dd1*temp259b + (temp263*rp4+temp263*& -& (rp4-4.d0)+coststo1s_n*temp262*2*(rp4+1.d0)-rp1*rp2*3*(rp4+1.d0)& -& **2)*temp260b + (2*rp4-4.d0)*temp264b1 + (temp266*3*(rp4+1.d0)**& -& 2-coststo1s_n*temp264*2*(rp4+1.d0))*temp265b - IF (rp1 .LE. 0.0 .AND. (coststo1s_n .EQ. 0.0 .OR. coststo1s_n .NE.& -& INT(coststo1s_n))) THEN - rp1b = temp252*temp255b + (coststo1s_n*(rp4+1.d0)*4.d0-temp254*(& -& 2.d0*rp1-5.d0)-temp254*rp1*2.d0)*temp252b0 + coststo1s_n*(rp4+& -& 1.d0)*2.d0*temp252b - 2.d0*rp2*temp249b0 + 2*rp1*rp2b + rp2*& -& 2.d0*temp257b + (2*rp1+1.d0)*temp260b0 + (temp260*(rp6-1.d0)-& -& temp261*rp2)*temp260b + (rp6-1.d0)*6.d0*temp264b0 - 8.d0*& -& temp264b + temp267*rp2*2.d0*temp265b + temp265*temp269b - ELSE - rp1b = temp252*temp255b + (coststo1s_n*(rp4+1.d0)*4.d0-temp254*(& -& 2.d0*rp1-5.d0)-temp254*rp1*2.d0)*temp252b0 + coststo1s_n*(rp4+& -& 1.d0)*2.d0*temp252b - 2.d0*rp2*temp249b0 + 2*rp1*rp2b + & -& coststo1s_n*rp1**(coststo1s_n-1)*rp4b + rp2*2.d0*temp257b + (2& -& *rp1+1.d0)*temp260b0 + (temp260*(rp6-1.d0)-temp261*rp2)*& -& temp260b + (rp6-1.d0)*6.d0*temp264b0 - 8.d0*temp264b + temp267& -& *rp2*2.d0*temp265b + temp265*temp269b - END IF - distpb(0, 1) = dd1*rp4*temp251b + dd1*rp4*temp259b - dd1b = distp(0, 1)*rp4*temp251b + r(0)*rp1b + distp(0, 1)*rp4*& -& temp259b - CALL POPREAL8(adr8ibuf,adr8buf,rp4) - CALL POPREAL8(adr8ibuf,adr8buf,rp1) - rb(0) = rb(0) + dd1*rp1b + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=9,1,-1 + temp131b74 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 10.d0*temp131b74 + fun2b = fun2b + temp131b74 + zb(indorbp, indt+4) = 0.0_8 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + IF (branch .LT. 1) THEN + temp131b19 = cost1g*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-60.d0*& +& (rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+2) + cost1g& +& *(12.d0*(rmu(1, 0)*r(0)**2)-60.d0*(rmu(1, 0)*rmu(3, 0)& +& **2))*zb(indorbp, indt+1) + cost1g*(80.d0*rmu(3, 0)**3& +& -48.d0*(rmu(3, 0)*r(0)**2))*zb(indorbp, indt+3) + rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*r(& +& 0)**2)*temp131b19 + temp131b20 = cost1g*fun0*zb(indorbp, indt+2) + temp131b21 = cost1g*fun0*zb(indorbp, indt+1) + rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp131b20 + & +& 12.d0*rmu(1, 0)*2*r(0)*temp131b21 - 48.d0*rmu(3, 0)*2*& +& r(0)*temp131b19 + rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3, 0)& +& **2)*temp131b20 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0)*& +& temp131b20 + rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3, 0)& +& **2)*temp131b21 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0)*& +& temp131b21 + ELSE + temp131b22 = -(cost2g*3.d0*zb(indorbp, indt+3)) + temp131b23 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**& +& 2)*temp131b22 + temp131b24 = fun0*rmu(1, 0)*temp131b22 + temp131b25 = -(cost2g*6.d0*zb(indorbp, indt+2)) + temp131b26 = rmu(2, 0)*rmu(3, 0)*temp131b25 + fun0b = fun0b + rmu(1, 0)*temp131b26 + cost2g*(4.d0*rmu(& +& 3, 0)**3-3.d0*(rmu(2, 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)& +& **2*rmu(3, 0)))*zb(indorbp, indt+1) + rmu(1, 0)*& +& temp131b23 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp131b24 + fun0*& +& temp131b23 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp131b24 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp131b24 + temp131b27 = fun0*rmu(1, 0)*temp131b25 + rmub(1, 0) = rmub(1, 0) + fun0*temp131b26 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp131b27 + temp131b28 = cost2g*fun0*zb(indorbp, indt+1) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*rmu(& +& 2, 0)**2-9.d0*rmu(1, 0)**2)*temp131b28 + rmu(2, 0)*& +& temp131b27 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp131b28 + rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp131b28 + END IF + ELSE + temp131b29 = -(cost2g*3.d0*zb(indorbp, indt+3)) + temp131b30 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**2)& +& *temp131b29 + temp131b31 = fun0*rmu(2, 0)*temp131b29 + temp131b32 = -(cost2g*6.d0*zb(indorbp, indt+1)) + temp131b33 = rmu(2, 0)*rmu(3, 0)*temp131b32 + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2, 0)& +& **2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb(indorbp& +& , indt+2) + rmu(1, 0)*temp131b33 + rmu(2, 0)*temp131b30 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp131b31 + fun0*& +& temp131b30 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp131b31 + temp131b34 = cost2g*fun0*zb(indorbp, indt+2) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*rmu(2& +& , 0)**2-3.d0*rmu(1, 0)**2)*temp131b34 - 4.d0*2*rmu(3, 0)& +& *temp131b31 + rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp131b34 + rmub(1, 0) = rmub(1, 0) + fun0*temp131b33 - 3.d0*rmu(3, 0)& +& *2*rmu(1, 0)*temp131b34 + temp131b35 = fun0*rmu(1, 0)*temp131b32 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp131b35 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp131b35 + END IF + ELSE IF (branch .LT. 4) THEN + temp131b36 = cost3g*12.d0*zb(indorbp, indt+3) + temp131b37 = fun0*rmu(3, 0)*temp131b36 + temp131b38 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp131b36 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp131b37 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp131b37 + temp131b39 = cost3g*4.d0*zb(indorbp, indt+2) + temp131b40 = -(cost3g*4.d0*zb(indorbp, indt+1)) + fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)**2))& +& *temp131b39 + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)**2))& +& *temp131b40 + rmu(3, 0)*temp131b38 + rmub(3, 0) = rmub(3, 0) + fun0*temp131b38 + temp131b41 = fun0*temp131b39 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)**2)& +& *temp131b41 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& +& temp131b41 + temp131b42 = fun0*temp131b40 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)**2)& +& *temp131b42 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& +& temp131b42 + ELSE + temp131b43 = cost3g*24.d0*zb(indorbp, indt+3) + temp131b44 = rmu(2, 0)*rmu(3, 0)*temp131b43 + temp131b45 = fun0*rmu(1, 0)*temp131b43 + temp131b46 = -(cost3g*2.d0*zb(indorbp, indt+2)) + temp131b47 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0)& +& **2)*temp131b46 + temp131b48 = -(cost3g*2.d0*zb(indorbp, indt+1)) + temp131b49 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3, 0)& +& **2)*temp131b48 + fun0b = fun0b + rmu(1, 0)*temp131b47 + rmu(2, 0)*temp131b49 & +& + rmu(1, 0)*temp131b44 + rmub(1, 0) = rmub(1, 0) + fun0*temp131b44 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp131b45 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp131b45 + temp131b50 = fun0*rmu(1, 0)*temp131b46 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp131b50 + fun0*& +& temp131b47 + rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp131b50 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp131b50 + temp131b51 = fun0*rmu(2, 0)*temp131b48 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp131b51 + fun0*& +& temp131b49 + rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp131b51 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp131b51 + END IF + ELSE IF (branch .LT. 8) THEN + IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp131b52 = cost4g*fun0*zb(indorbp, indt+3) + temp131b53 = -(cost4g*6.d0*zb(indorbp, indt+2)) + temp131b54 = rmu(2, 0)*rmu(3, 0)*temp131b53 + temp131b55 = cost4g*3.d0*zb(indorbp, indt+1) + temp131b56 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp131b55 + fun0b = fun0b + rmu(1, 0)*temp131b54 + rmu(3, 0)*& +& temp131b56 + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2& +& , 0)**2))*zb(indorbp, indt+3) + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**& +& 2)*temp131b52 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp131b52 + temp131b57 = fun0*rmu(1, 0)*temp131b53 + rmub(1, 0) = rmub(1, 0) + fun0*temp131b54 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp131b57 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp131b57 + temp131b58 = fun0*rmu(3, 0)*temp131b55 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp131b58 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp131b58 + rmub(3, 0) = rmub(3, 0) + fun0*temp131b56 + ELSE + temp131b59 = cost4g*fun0*zb(indorbp, indt+3) + temp131b60 = cost4g*3.d0*zb(indorbp, indt+2) + temp131b61 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp131b60 + temp131b62 = cost4g*6.d0*zb(indorbp, indt+1) + temp131b63 = rmu(2, 0)*rmu(3, 0)*temp131b62 + fun0b = fun0b + rmu(3, 0)*temp131b61 + rmu(1, 0)*& +& temp131b63 + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2& +& , 0)**3)*zb(indorbp, indt+3) + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp131b59 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& +& 2)*temp131b59 + temp131b64 = fun0*rmu(3, 0)*temp131b60 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp131b64 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp131b64 + rmub(3, 0) = rmub(3, 0) + fun0*temp131b61 + temp131b65 = fun0*rmu(1, 0)*temp131b62 + rmub(1, 0) = rmub(1, 0) + fun0*temp131b63 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp131b65 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp131b65 + END IF + ELSE + temp131b66 = cost5g*4.d0*zb(indorbp, indt+2) + temp131b67 = fun0*temp131b66 + temp131b68 = cost5g*4.d0*zb(indorbp, indt+1) + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& +& *temp131b68 + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)))& +& *temp131b66 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**2)& +& *temp131b67 + temp131b69 = fun0*temp131b68 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& +& *temp131b69 - 3.d0*rmu(2, 0)*2*rmu(1, 0)*temp131b67 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp131b69 + END IF + ELSE IF (.NOT.branch .LT. 9) THEN + temp131b70 = cost5g*4.d0*zb(indorbp, indt+2) + temp131b71 = fun0*temp131b70 + temp131b72 = cost5g*4.d0*zb(indorbp, indt+1) + fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**3)*& +& temp131b72 + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))*& +& temp131b70 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)*& +& temp131b71 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp131b71 + temp131b73 = fun0*temp131b72 + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp131b73 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**2)*& +& temp131b73 + END IF + DO i=3,1,-1 + temp131b18 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp131b18 + funb0 = funb0 + rmu(i, 0)*temp131b18 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + temp131b17 = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp131b17 - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp131b17 + distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb0 + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd1b = 0.0_8 END IF + DO ic=9,1,-1 + DO k=0,0,-1 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO DO i=0,0,-1 - temp246 = rp4/(rp4+1.d0) - temp249b = distp(i, 1)*temp246*zb(indorbp, i) - temp247 = rp1*(rp4+1.d0) - temp248 = coststo1s_n/temp247 - temp247b = -(r(i)*temp248*temp249b/temp247) - temp247b0 = (1.5d0/dd1+r(i)*(temp248-1.d0))*zb(indorbp, i) - temp246b0 = distp(i, 1)*temp247b0/(rp4+1.d0) - rp4b = (1.0_8-temp246)*temp246b0 + rp1*temp247b - IF (rp1 .LE. 0.0 .AND. (coststo1s_n .EQ. 0.0 .OR. coststo1s_n .NE.& -& INT(coststo1s_n))) THEN - rp1b = (rp4+1.d0)*temp247b - ELSE - rp1b = coststo1s_n*rp1**(coststo1s_n-1)*rp4b + (rp4+1.d0)*& -& temp247b - END IF - dd1b = dd1b + r(i)*rp1b - 1.5d0*temp249b/dd1**2 - rb(i) = rb(i) + dd1*rp1b + (temp248-1.d0)*temp249b - distpb(i, 1) = distpb(i, 1) + temp246*temp247b0 - zb(indorbp, i) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,rp4) - CALL POPREAL8(adr8ibuf,adr8buf,rp1) + temp131b = cost5g*4.d0*distpb(i, 10) + temp131b0 = (rmu(1, i)**2-rmu(2, i)**2)*temp131b + temp131b1 = rmu(1, i)*rmu(2, i)*temp131b + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp131b1 + rmu(2, i)*& +& temp131b0 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp131b0 - 2*rmu(2, i)*& +& temp131b1 + distpb(i, 10) = 0.0_8 + temp131b2 = cost5g*distpb(i, 9) + rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& +& 1, i))*temp131b2 + distpb(i, 9) = 0.0_8 + temp131b3 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) + temp131b4 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp131b3 - 2*rmu(2, i)*& +& temp131b4 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& +& temp131b2 + rmub(3, i) = rmub(3, i) + rmu(2, i)*temp131b3 + distpb(i, 8) = 0.0_8 + temp131b5 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) + temp131b6 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp131b5 + 2*rmu(1, i)*& +& temp131b6 + 3.d0*2*rmu(1, i)*temp131b4 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp131b5 + rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp131b6 + distpb(i, 7) = 0.0_8 + temp131b7 = cost3g*2.d0*distpb(i, 6) + temp131b8 = (7.d0*rmu(3, i)**2-r(i)**2)*temp131b7 + temp131b9 = rmu(1, i)*rmu(2, i)*temp131b7 + rmub(1, i) = rmub(1, i) + rmu(2, i)*temp131b8 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp131b8 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp131b9 + distpb(i, 6) = 0.0_8 + temp131b10 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) + temp131b11 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + temp131b12 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) + temp131b13 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + temp131b14 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) + temp131b15 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + temp131b16 = cost1g*distpb(i, 2) + rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& +& temp131b16 - 3.d0*2*r(i)*temp131b15 - 2*r(i)*temp131b11 - 3.d0*2& +& *r(i)*temp131b13 - 2*r(i)*temp131b9 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp131b10 + rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp131b10 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp131b11 + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp131b12 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp131b13 + rmu(2, i)*& +& temp131b12 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp131b14 + rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& +& rmu(3, i))*temp131b16 + 7.d0*2*rmu(3, i)*temp131b15 + rmu(1, i)*& +& temp131b14 + distpb(i, 2) = 0.0_8 END DO + dd1b = 0.0_8 cb = 0.0_8 - DO i=0,0,-1 - temp246b = c*DEXP(-(dd1*r(i)))*distpb(i, 1) - cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) - dd1b = dd1b - r(i)*temp246b - rb(i) = rb(i) - dd1*temp246b - distpb(i, 1) = 0.0_8 + DO k=0,0,-1 + temp130 = r(k)**2 + temp130b = c*DEXP(-(dd1*temp130))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp130))*distpb(k, 1) + dd1b = dd1b - temp130*temp130b + rb(k) = rb(k) - dd1*2*r(k)*temp130b + distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + coststo1s_c*1.5d0*dd1**0.5D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (30) -! 3d without cusp and one parmater + dd1b = dd1b + 1.11284691281640568826d0*2.75d0*dd1**1.75D0*cb + ddb(indparp) = ddb(indparp) + dd1b + CASE (142) +! 4d one parmater dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c= & -! & 1.d0/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) - c = dd1**3.5d0*0.26596152026762178d0 -! endif DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 1) = DEXP(-(dd1*r(k))) END DO DO i=0,0 - distp(i, 3) = distp(i, 1) -! lz=0 + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = distp(i, 1)*r(i) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d -! lz=+/-2 + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d -! lz=+/-2 + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d -! lz=+/-1 + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d -! lz=+/-1 + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d END DO ! indorbp=indorb @@ -8181,9 +7559,9 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 3) - fun = -(dd1*distp(0, 1)) - fun2 = dd1**2*distp(0, 1) + fun0 = -distp(0, 3) + fun = -((1.d0-dd1*r(0))*distp(0, 1)) + fun2 = -(dd1*(dd1*r(0)-2.d0)*distp(0, 1)) ! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -8234,18 +7612,18 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=5,1,-1 - temp272 = fun/r(0) - temp273b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp272b3 = 6.d0*temp273b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp272+fun2)*zb(& + temp132 = fun/r(0) + temp133b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp132b3 = 6.d0*temp133b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp132+fun2)*zb(& & indorbp, indt+4) - funb = funb + temp272b3 - rb(0) = rb(0) - temp272*temp272b3 - fun2b = fun2b + temp273b + funb0 = funb0 + temp132b3 + rb(0) = rb(0) - temp132*temp132b3 + fun2b = fun2b + temp133b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -8253,24 +7631,24 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN IF (branch .LT. 2) THEN - temp272b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp272b - fun0b = fun0b + rmu(i, 0)*temp272b + temp132b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp132b + fun0b = fun0b + rmu(i, 0)*temp132b ELSE - temp272b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp272b0 - fun0b = fun0b + rmu(i, 0)*temp272b0 + temp132b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp132b0 + fun0b = fun0b + rmu(i, 0)*temp132b0 END IF ELSE IF (branch .LT. 4) THEN - temp272b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp272b1 - fun0b = fun0b + rmu(i, 0)*temp272b1 + temp132b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp132b1 + fun0b = fun0b + rmu(i, 0)*temp132b1 END IF ELSE IF (branch .LT. 7) THEN IF (branch .LT. 6) THEN - temp272b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp272b2 - fun0b = fun0b + rmu(i, 0)*temp272b2 + temp132b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp132b2 + fun0b = fun0b + rmu(i, 0)*temp132b2 ELSE rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) @@ -8300,86 +7678,95 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp271 = fun/r(0) - temp271b0 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp271*rmu(i, 0)*zb(& + temp131 = fun/r(0) + temp131b78 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp131*rmu(i, 0)*zb(& & indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp271*distp(0, 3+ic)*zb(indorbp, & + rmub(i, 0) = rmub(i, 0) + temp131*distp(0, 3+ic)*zb(indorbp, & & indt+i) - funb = funb + temp271b0 - rb(0) = rb(0) - temp271*temp271b0 + funb0 = funb0 + temp131b78 + rb(0) = rb(0) - temp131*temp131b78 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb - distpb(0, 1) = distpb(0, 1) + dd1**2*fun2b - dd1*funb - distpb(0, 3) = distpb(0, 3) + fun0b + temp131b76 = -(dd1*distp(0, 1)*fun2b) + temp131b77 = -((dd1*r(0)-2.d0)*fun2b) + dd1b = distp(0, 1)*r(0)*funb0 + distp(0, 1)*temp131b77 + r(0)*& +& temp131b76 + rb(0) = rb(0) + distp(0, 1)*dd1*funb0 + dd1*temp131b76 + distpb(0, 1) = distpb(0, 1) + dd1*temp131b77 - (1.d0-dd1*r(0))*& +& funb0 + distpb(0, 3) = distpb(0, 3) - fun0b ELSE distpb = 0.0_8 dd1b = 0.0_8 END IF DO ic=5,1,-1 DO i=0,0,-1 - distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) + distpb(i, 3+ic) = distpb(i, 3+ic) - distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) - distp(i, 3+ic)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) distpb(i, 8) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) distpb(i, 7) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - distpb(i, 1) = distpb(i, 1) + distpb(i, 3) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distpb(i, 1) = distpb(i, 1) + r(i)*distpb(i, 3) + rb(i) = rb(i) + distp(i, 1)*distpb(i, 3) distpb(i, 3) = 0.0_8 END DO - cb = 0.0_8 DO k=0,0,-1 - temp271b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp271b - rb(k) = rb(k) - dd1*temp271b + temp131b75 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp131b75 + rb(k) = rb(k) - dd1*temp131b75 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.26596152026762178d0*3.5d0*dd1**2.5D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (31) -! 3d without cusp condition double Z + CASE (33) +! 4d without cusp and one parmater dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) -! if(iflagnorm.gt.2) then - c = 1/2.d0*DSQRT(5.d0/pi)/DSQRT(1/dd1**7/128.d0+2*peff/(dd1+dd2)**7+& -& peff**2/dd2**7/128.d0)/DSQRT(720.d0) -! endif +! if(iflagnorm.gt.2) then +! c= +! &1/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) +! c= & +! &1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) + c = dd1**4.5d0*0.0710812062076410d0 +! endif DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k))) - distp(k, 2) = DEXP(-(dd2*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k))) END DO DO i=0,0 CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = c*(distp(i, 1)+peff*distp(i, 2)) + distp(i, 3) = distp(i, 1)*r(i) CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) -!lz=0 +! lz=0 distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) -!lz=+/-2 +! lz=+/ distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) -! lz=+/- 2 +! lz=+/-2 distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) ! lz=+/-1 @@ -8388,17 +7775,17 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd ! lz=+/-1 distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d END DO -! indorbp=indorb +! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN fun0 = distp(0, 3) - fun = c*(-(dd1*distp(0, 1))-peff*dd2*distp(0, 2)) - fun2 = c*(dd1**2*distp(0, 1)+peff*dd2**2*distp(0, 2)) + fun = -(dd1*distp(0, 3)) + distp(0, 1) + fun2 = dd1**2*distp(0, 3) - 2.d0*dd1*distp(0, 1) ! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -8449,18 +7836,18 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=5,1,-1 - temp281 = fun/r(0) - temp282b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp281b3 = 6.d0*temp282b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp281+fun2)*zb(& + temp134 = fun/r(0) + temp135b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp134b3 = 6.d0*temp135b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp134+fun2)*zb(& & indorbp, indt+4) - funb = funb + temp281b3 - rb(0) = rb(0) - temp281*temp281b3 - fun2b = fun2b + temp282b + funb0 = funb0 + temp134b3 + rb(0) = rb(0) - temp134*temp134b3 + fun2b = fun2b + temp135b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -8468,24 +7855,24 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN IF (branch .LT. 2) THEN - temp281b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp281b - fun0b = fun0b + rmu(i, 0)*temp281b + temp134b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp134b + fun0b = fun0b + rmu(i, 0)*temp134b ELSE - temp281b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp281b0 - fun0b = fun0b + rmu(i, 0)*temp281b0 + temp134b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp134b0 + fun0b = fun0b + rmu(i, 0)*temp134b0 END IF ELSE IF (branch .LT. 4) THEN - temp281b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp281b1 - fun0b = fun0b + rmu(i, 0)*temp281b1 + temp134b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp134b1 + fun0b = fun0b + rmu(i, 0)*temp134b1 END IF ELSE IF (branch .LT. 7) THEN IF (branch .LT. 6) THEN - temp281b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp281b2 - fun0b = fun0b + rmu(i, 0)*temp281b2 + temp134b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp134b2 + fun0b = fun0b + rmu(i, 0)*temp134b2 ELSE rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) @@ -8515,38 +7902,26 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp280 = fun/r(0) - temp280b5 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp280*rmu(i, 0)*zb(& + temp133 = fun/r(0) + temp133b1 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp133*rmu(i, 0)*zb(& & indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp280*distp(0, 3+ic)*zb(indorbp, & + rmub(i, 0) = rmub(i, 0) + temp133*distp(0, 3+ic)*zb(indorbp, & & indt+i) - funb = funb + temp280b5 - rb(0) = rb(0) - temp280*temp280b5 + funb0 = funb0 + temp133b1 + rb(0) = rb(0) - temp133*temp133b1 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp280b2 = c*fun2b - temp280b3 = dd2**2*temp280b2 - cb = (-(dd1*distp(0, 1))-peff*dd2*distp(0, 2))*funb + (dd1**2*& -& distp(0, 1)+dd2**2*(peff*distp(0, 2)))*fun2b - temp280b4 = c*funb - dd1b = distp(0, 1)*2*dd1*temp280b2 - distp(0, 1)*temp280b4 - distpb(0, 1) = distpb(0, 1) + dd1**2*temp280b2 - dd2b = peff*distp(0, 2)*2*dd2*temp280b2 - distp(0, 2)*peff*& -& temp280b4 - peffb = distp(0, 2)*temp280b3 - distp(0, 2)*dd2*temp280b4 - distpb(0, 2) = distpb(0, 2) + peff*temp280b3 - distpb(0, 1) = distpb(0, 1) - dd1*temp280b4 - distpb(0, 2) = distpb(0, 2) - peff*dd2*temp280b4 - distpb(0, 3) = distpb(0, 3) + fun0b + dd1b = (distp(0, 3)*2*dd1-2.d0*distp(0, 1))*fun2b - distp(0, 3)*& +& funb0 + distpb(0, 3) = distpb(0, 3) + dd1**2*fun2b + distpb(0, 1) = distpb(0, 1) + funb0 - 2.d0*dd1*fun2b + distpb(0, 3) = distpb(0, 3) + fun0b - dd1*funb0 ELSE distpb = 0.0_8 - peffb = 0.0_8 dd1b = 0.0_8 - dd2b = 0.0_8 - cb = 0.0_8 END IF DO ic=5,1,-1 DO i=0,0,-1 @@ -8554,654 +7929,1005 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO i=0,0,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + distpb(i, 8) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distpb(i, 1) = distpb(i, 1) + r(i)*distpb(i, 3) + rb(i) = rb(i) + distp(i, 1)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + END DO + cb = 0.0_8 + DO k=0,0,-1 + temp133b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp133b0 + rb(k) = rb(k) - dd1*temp133b0 + distpb(k, 1) = 0.0_8 + END DO + dd1b = dd1b + 0.0710812062076410d0*4.5d0*dd1**3.5D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (154) +! 2s single Z WITH CUSP zero +! Jastrow single gaussian f orbital +! R(r)= exp(-alpha r^2) +! unnormalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) + DO k=0,0 + distp(k, 1) = DEXP(-(dd1*r(k)**2)) + END DO + DO i=0,0 + distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) +! lz=0 + distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) +! lz=+/-2 + distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) +! lz=+/-2 + distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) +! lz=+/-3 + distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) + END DO +! lz=+/-3 + DO ic=1,7 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN +! dd1=dd(indparp) + fun0 = distp(0, 1) + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) +! indorbp=indorb + DO ic=1,7 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + IF (ic .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + ELSE IF (ic .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (ic .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE IF (ic .EQ. 4) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (ic .EQ. 5) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + ELSE IF (ic .EQ. 6) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + END IF + END DO + distpb = 0.0_8 + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=7,1,-1 + temp135b30 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 8.d0*temp135b30 + fun2b = fun2b + temp135b30 + zb(indorbp, indt+4) = 0.0_8 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 4) THEN + IF (branch .LT. 2) THEN + IF (branch .LT. 1) THEN + temp135b11 = cost1f*zb(indorbp, indt+3) + temp135b12 = -(cost1f*6.d0*zb(indorbp, indt+2)) + temp135b13 = -(cost1f*6.d0*zb(indorbp, indt+1)) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp135b12 + rmu(3, 0)& +& *rmu(1, 0)*temp135b13 + (9.d0*rmu(3, 0)**2-3.d0*r(0)**2)& +& *temp135b11 + rmub(3, 0) = rmub(3, 0) + fun0*9.d0*2*rmu(3, 0)*temp135b11 + rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp135b11 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp135b12 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp135b12 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp135b13 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp135b13 + ELSE + temp135b14 = cost2f*8.d0*zb(indorbp, indt+3) + temp135b15 = -(cost2f*2.d0*zb(indorbp, indt+2)) + fun0b = fun0b + rmu(1, 0)*rmu(2, 0)*temp135b15 + cost2f*(& +& 5.d0*rmu(3, 0)**2-r(0)**2-2.d0*rmu(1, 0)**2)*zb(indorbp& +& , indt+1) + rmu(1, 0)*rmu(3, 0)*temp135b14 + rmub(3, 0) = rmub(3, 0) + rmu(1, 0)*fun0*temp135b14 + rmub(1, 0) = rmub(1, 0) + fun0*rmu(3, 0)*temp135b14 + rmub(2, 0) = rmub(2, 0) + rmu(1, 0)*fun0*temp135b15 + rmub(1, 0) = rmub(1, 0) + fun0*rmu(2, 0)*temp135b15 + temp135b16 = cost2f*fun0*zb(indorbp, indt+1) + rmub(3, 0) = rmub(3, 0) + 5.d0*2*rmu(3, 0)*temp135b16 + rb(0) = rb(0) - 2*r(0)*temp135b16 + rmub(1, 0) = rmub(1, 0) - 2.d0*2*rmu(1, 0)*temp135b16 + END IF + ELSE IF (branch .LT. 3) THEN + temp135b17 = cost2f*8.d0*zb(indorbp, indt+3) + temp135b18 = -(cost2f*2.d0*zb(indorbp, indt+1)) + fun0b = fun0b + cost2f*(5.d0*rmu(3, 0)**2-r(0)**2-2.d0*rmu(2& +& , 0)**2)*zb(indorbp, indt+2) + rmu(2, 0)*rmu(1, 0)*& +& temp135b18 + rmu(2, 0)*rmu(3, 0)*temp135b17 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*fun0*temp135b17 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(3, 0)*temp135b17 + temp135b19 = cost2f*fun0*zb(indorbp, indt+2) + rmub(3, 0) = rmub(3, 0) + 5.d0*2*rmu(3, 0)*temp135b19 + rb(0) = rb(0) - 2*r(0)*temp135b19 + rmub(2, 0) = rmub(2, 0) - 2.d0*2*rmu(2, 0)*temp135b19 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp135b18 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp135b18 + ELSE + temp135b20 = cost3f*zb(indorbp, indt+3) + temp135b21 = -(cost3f*2.d0*zb(indorbp, indt+2)) + temp135b22 = cost3f*2.d0*zb(indorbp, indt+1) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp135b21 + rmu(3, 0)*& +& rmu(1, 0)*temp135b22 + (rmu(1, 0)**2-rmu(2, 0)**2)*& +& temp135b20 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp135b20 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp135b21 - fun0*2& +& *rmu(2, 0)*temp135b20 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp135b21 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp135b22 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp135b22 + END IF + ELSE IF (branch .LT. 6) THEN + IF (branch .LT. 5) THEN + temp135b23 = cost3f*2.d0*zb(indorbp, indt+3) + temp135b24 = cost3f*2.d0*zb(indorbp, indt+2) + temp135b25 = cost3f*2.d0*zb(indorbp, indt+1) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp135b24 + rmu(3, 0)*& +& rmu(2, 0)*temp135b25 + rmu(2, 0)*rmu(1, 0)*temp135b23 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp135b23 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp135b23 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp135b24 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp135b24 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp135b25 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp135b25 + ELSE + temp135b26 = -(cost4f*6.d0*zb(indorbp, indt+2)) + temp135b27 = cost4f*3.d0*zb(indorbp, indt+1) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp135b27 + rmu& +& (2, 0)*rmu(1, 0)*temp135b26 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp135b26 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp135b26 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp135b27 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp135b27 + END IF + ELSE + temp135b28 = cost4f*3.d0*zb(indorbp, indt+2) + temp135b29 = cost4f*6.d0*zb(indorbp, indt+1) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp135b29 + (rmu(1, 0)**2& +& -rmu(2, 0)**2)*temp135b28 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp135b28 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp135b28 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp135b29 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp135b29 + END IF + DO i=3,1,-1 + temp135b10 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp135b10 + funb0 = funb0 + rmu(i, 0)*temp135b10 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + temp135b9 = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp135b9 - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp135b9 + distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb0 + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + END IF + DO ic=7,1,-1 + DO k=0,0,-1 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO i=0,0,-1 + temp135b1 = cost4f*rmu(2, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 8) - 2*rmu(2, i)*temp135b1 + distpb(i, 8) = 0.0_8 + temp135b2 = cost4f*rmu(1, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& +& distpb(i, 7) + 2*rmu(1, i)*temp135b2 + 3.d0*2*rmu(1, i)*& +& temp135b1 + rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp135b2 + distpb(i, 7) = 0.0_8 + temp135b3 = cost3f*2.d0*distpb(i, 6) + temp135b4 = rmu(2, i)*temp135b3 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp135b4 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp135b4 + rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp135b3 + distpb(i, 6) = 0.0_8 + temp135b5 = cost3f*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 5) + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp135b5 + distpb(i, 5) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 4) - 2*rmu(2, i)*temp135b5 + temp135b6 = cost2f*rmu(2, i)*distpb(i, 4) + rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp135b6 + distpb(i, 4) = 0.0_8 + temp135b7 = cost2f*rmu(1, i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 3) + distpb(i, 3) = 0.0_8 + temp135b8 = cost1f*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - 2*r(i)*temp135b7 - 3.d0*2*r(i)*temp135b8 - 2*r(i)*& +& temp135b6 + rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& +& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp135b8 + 5.d0*2*rmu(3, i)*& +& temp135b7 + distpb(i, 2) = 0.0_8 + END DO + DO k=0,0,-1 + temp135b0 = DEXP(-(dd1*r(k)**2))*distpb(k, 1) + dd1b = dd1b - r(k)**2*temp135b0 + rb(k) = rb(k) - dd1*2*r(k)*temp135b0 + distpb(k, 1) = 0.0_8 + END DO + ddb(indparp) = ddb(indparp) + dd1b + CASE (34) +! normalized +! exp(-dd1*r) + dd1*r*exp(-dd1*r) +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) +! peff=dd1 +! if(iflagnorm.gt.2) then +! c=1.d0/dsqrt(1.d0/4.d0/dd1**3+12.d0*dd1/(2.d0*dd1)**4+& +! &3.d0*dd1**2/4.d0/dd1**5)/dsqrt(4.d0*pi) +! c=dd1*dsqrt(dd1)/dsqrt(7.d0*pi) + c = dd1*DSQRT(dd1)*.2132436186229231d0 +! endif + DO i=0,0 + distp(i, 1) = c*DEXP(-(dd1*r(i))) + END DO + IF (typec .NE. 1) THEN + fun = -(dd1**2*distp(0, 1)) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + funb0 = funb0 + (1.d0-dd1*r(0))*fun2b + dd1b = -(distp(0, 1)*2*dd1*funb0) - fun*r(0)*fun2b + rb(0) = rb(0) - fun*dd1*fun2b + distpb = 0.0_8 + distpb(0, 1) = -(dd1**2*funb0) + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + END IF + DO i=0,0,-1 + temp136b0 = distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + (r(i)*dd1+1.d0)*zb(indorbp, i) + rb(i) = rb(i) + dd1*temp136b0 + dd1b = dd1b + r(i)*temp136b0 + zb(indorbp, i) = 0.0_8 + END DO + cb = 0.0_8 + DO i=0,0,-1 + temp136b = c*DEXP(-(dd1*r(i)))*distpb(i, 1) + cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) + dd1b = dd1b - r(i)*temp136b + rb(i) = rb(i) - dd1*temp136b + distpb(i, 1) = 0.0_8 + END DO + temp135 = DSQRT(dd1) + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + .2132436186229231d0*temp135*cb + ELSE + dd1b = dd1b + (.2132436186229231d0*dd1/(2.D0*DSQRT(dd1))+& +& .2132436186229231d0*temp135)*cb + END IF + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (18) +! 2s single Z WITH CUSP +! R(r)=r**4*exp(-z*r**2) single zeta +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c=(2.d0*dd1**11/pi)**(1.d0/4.d0)*(512.d0/945.d0/pi) + c = dd1**2.75d0*0.1540487967684377d0 +! endif + DO k=0,0 + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + END DO + IF (typec .NE. 1) THEN + rp1 = r(0)**2 +! the first derivative + fun = distp(0, 1)*rp1*(4.d0-2.d0*dd1*rp1) +! the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp137b = (4.d0*(dd1**2*rp1**2)-18.d0*(dd1*rp1)+12.d0)*fun2b + temp137b0 = distp(0, 1)*rp1*fun2b + temp137b1 = (4.d0-2.d0*(dd1*rp1))*funb0 + distpb(0, 1) = rp1*temp137b1 + rp1*temp137b + temp137b2 = -(distp(0, 1)*rp1*2.d0*funb0) + rp1b = distp(0, 1)*temp137b1 + dd1*temp137b2 + (4.d0*dd1**2*2*rp1-& +& 18.d0*dd1)*temp137b0 + distp(0, 1)*temp137b + dd1b = rp1*temp137b2 + (4.d0*rp1**2*2*dd1-18.d0*rp1)*temp137b0 + rb(0) = rb(0) + 2*r(0)*rp1b + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + END IF DO i=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) - distpb(i, 8) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) - distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - temp280b1 = c*distpb(i, 3) - cb = cb + (distp(i, 1)+peff*distp(i, 2))*distpb(i, 3) - distpb(i, 1) = distpb(i, 1) + temp280b1 - peffb = peffb + distp(i, 2)*temp280b1 - distpb(i, 2) = distpb(i, 2) + peff*temp280b1 - distpb(i, 3) = 0.0_8 + rb(i) = rb(i) + distp(i, 1)*4*r(i)**3*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + r(i)**4*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO + cb = 0.0_8 DO k=0,0,-1 - temp280b = DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp280b - distpb(k, 2) = 0.0_8 - temp280b0 = DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp280b0 - dd2*temp280b - dd1b = dd1b - r(k)*temp280b0 + temp136 = r(k)**2 + temp136b1 = c*DEXP(-(dd1*temp136))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp136))*distpb(k, 1) + dd1b = dd1b - temp136*temp136b1 + rb(k) = rb(k) - dd1*2*r(k)*temp136b1 distpb(k, 1) = 0.0_8 END DO - temp279 = 128.d0*dd2**7 - temp278 = peff**2/temp279 - temp277 = (dd1+dd2)**7 - temp276 = 128.d0*dd1**7 - temp273 = 1.0/temp276 + 2*(peff/temp277) + temp278 - temp275 = DSQRT(temp273) - temp274 = 2.d0*DSQRT(720.d0) - IF (temp273 .EQ. 0.0) THEN - temp273b0 = 0.0 - ELSE - temp273b0 = -(DSQRT(5.d0/pi)*cb/(temp274*temp275**2*2.D0*DSQRT(& -& temp273))) - END IF - temp273b1 = 2*temp273b0/temp277 - temp273b2 = -(peff*7*(dd1+dd2)**6*temp273b1/temp277) - dd1b = dd1b + temp273b2 - 128.d0*7*dd1**6*temp273b0/temp276**2 - peffb = peffb + 2*peff*temp273b0/temp279 + temp273b1 - dd2b = dd2b + temp273b2 - temp278*128.d0*7*dd2**6*temp273b0/temp279 - ddb(indpar+3) = ddb(indpar+3) + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b + dd1b = dd1b + 0.1540487967684377d0*2.75d0*dd1**1.75D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (32) -! 3d without cusp condition triple Z + CASE (41) +! derivative of 16 with respect to z +!c 4p without cusp condition derivative of 22 +!c r^2 e^{-z1 r } dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) - dd3 = dd(indpar+4) - peff2 = dd(indpar+5) ! if(iflagnorm.gt.2) then - c = 1/2.d0*DSQRT(5.d0/pi)/DSQRT(1/(2.d0*dd1)**7+2*peff/(dd1+dd2)**7+& -& peff**2/(2.d0*dd2)**7+2*peff2/(dd1+dd3)**7+peff2**2/(2.d0*dd3)**7+& -& 2*peff*peff2/(dd2+dd3)**7)/DSQRT(720.d0) +! c=dsqrt((2.d0*dd1)**7/240.d0/pi)/2.d0 + c = dd1**3.5d0*0.2060129077457011d0 ! endif + c0 = -c + c1 = 3.5d0*c/dd1 DO k=0,0 distp(k, 1) = DEXP(-(dd1*r(k))) - distp(k, 2) = DEXP(-(dd2*r(k))) - distp(k, 3) = DEXP(-(dd3*r(k))) END DO DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) - distp(i, 4) = c*(distp(i, 1)+peff*distp(i, 2)+peff2*distp(i, 3)) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) -!lz=0 - distp(i, 5) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) -!lz=+/-2 - distp(i, 6) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) -! lz=+/- 2 - distp(i, 7) = rmu(1, i)*rmu(2, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) -! lz=+/-1 - distp(i, 8) = rmu(2, i)*rmu(3, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 9)) -! lz=+/-1 - distp(i, 9) = rmu(1, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = r(i)**2*distp(i, 1) END DO ! indorbp=indorb - DO ic=1,5 + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO ! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 4) - fun = c*(-(dd1*distp(0, 1))-peff*dd2*distp(0, 2)-peff2*dd3*distp(0& -& , 3)) - fun2 = c*(dd1**2*distp(0, 1)+peff*dd2**2*distp(0, 2)+peff2*dd3**2*& -& distp(0, 3)) +! fun=(1.d0-dd1*r(0))*distp(0,1) +! fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) + fun = (c0*(2.d0-dd1*r(0))*r(0)+c1*(1.d0-dd1*r(0)))*distp(0, 1) + fun2 = (c0*((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))+c1*dd1*(dd1*r(0)-& +& 2.d0))*distp(0, 1) ! indorbp=indorb - DO ic=1,5 + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp298 = fun/r(0) - temp299b = distp(0, 4+ic)*zb(indorbp, indt+4) - temp298b3 = 6.d0*temp299b/r(0) - distpb(0, 4+ic) = distpb(0, 4+ic) + (6.d0*temp298+fun2)*zb(& -& indorbp, indt+4) - funb = funb + temp298b3 - rb(0) = rb(0) - temp298*temp298b3 - fun2b = fun2b + temp299b + DO ic=3,1,-1 + temp142 = fun/r(0) + temp143b = rmu(ic, 0)*zb(indorbp, indt+4) + temp142b = 4.d0*temp143b/r(0) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp142+fun2)*zb(indorbp, indt& +& +4) + funb0 = funb0 + temp142b + rb(0) = rb(0) - temp142*temp142b + fun2b = fun2b + temp143b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp298b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp298b - fun0b = fun0b + rmu(i, 0)*temp298b - ELSE - temp298b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp298b0 - fun0b = fun0b + rmu(i, 0)*temp298b0 - END IF - ELSE IF (branch .LT. 4) THEN - temp298b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp298b1 - fun0b = fun0b + rmu(i, 0)*temp298b1 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp298b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp298b2 - fun0b = fun0b + rmu(i, 0)*temp298b2 - ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp141 = fun/r(0) + temp141b0 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(ic, 0) = rmub(ic, 0) + temp141*rmu(i, 0)*zb(indorbp, indt& +& +i) + rmub(i, 0) = rmub(i, 0) + temp141*rmu(ic, 0)*zb(indorbp, indt+& +& i) + funb0 = funb0 + temp141b0 + rb(0) = rb(0) - temp141*temp141b0 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + distpb = 0.0_8 + temp141b = distp(0, 1)*fun2b + temp140 = (dd1*r(0))**2 - 4.d0*dd1*r(0) + 2.d0 + temp140b = c0*temp141b + temp140b0 = 2*dd1*r(0)*temp140b + temp139 = dd1*r(0) - 2.d0 + temp139b = c1*dd1*temp141b + temp139b0 = distp(0, 1)*funb0 + temp137 = -(dd1*r(0)) + 2.d0 + c0b = temp137*r(0)*temp139b0 + distp(0, 3)*fun0b + temp140*& +& temp141b + temp138 = c0*r(0) + dd1b = (-(c1*r(0))-temp138*r(0))*temp139b0 + r(0)*temp139b + & +& temp139*c1*temp141b - 4.d0*r(0)*temp140b + r(0)*temp140b0 + rb(0) = rb(0) + (temp137*c0-c1*dd1-temp138*dd1)*temp139b0 + distp(& +& 0, 1)*c1*fun0b + dd1*temp139b - 4.d0*dd1*temp140b + dd1*& +& temp140b0 + c1b = (1.d0-dd1*r(0))*temp139b0 + distp(0, 1)*r(0)*fun0b + temp139& +& *dd1*temp141b + distpb(0, 1) = (temp137*temp138+c1*(1.d0-dd1*r(0)))*funb0 + (c0*& +& temp140+c1*dd1*temp139)*fun2b + distpb(0, 3) = distpb(0, 3) + c0*fun0b + distpb(0, 1) = distpb(0, 1) + c1*r(0)*fun0b + ELSE + distpb = 0.0_8 + c0b = 0.0_8 + c1b = 0.0_8 + dd1b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=0,0,-1 + temp137b5 = rmu(ic, i)*zb(indorbp, i) + temp137b6 = distp(i, 1)*temp137b5 + rmub(ic, i) = rmub(ic, i) + (c0*distp(i, 3)+c1*r(i)*distp(i, 1))& +& *zb(indorbp, i) + c0b = c0b + distp(i, 3)*temp137b5 + distpb(i, 3) = distpb(i, 3) + c0*temp137b5 + c1b = c1b + r(i)*temp137b6 + rb(i) = rb(i) + c1*temp137b6 + distpb(i, 1) = distpb(i, 1) + c1*r(i)*temp137b5 + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO i=0,0,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*distpb(i, 3) + distpb(i, 1) = distpb(i, 1) + r(i)**2*distpb(i, 3) + distpb(i, 3) = 0.0_8 + END DO + DO k=0,0,-1 + temp137b4 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp137b4 + rb(k) = rb(k) - dd1*temp137b4 + distpb(k, 1) = 0.0_8 + END DO + temp137b3 = 3.5d0*c1b/dd1 + cb = temp137b3 - c0b + dd1b = dd1b + 0.2060129077457011d0*3.5d0*dd1**2.5D0*cb - c*temp137b3& +& /dd1 + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (125) +! 2s with cusp condition +! dd1*( dd3 +exp(-dd2*r)) ! with no cusp condition + dd2 = dd(indpar+1) + indorbp = indorb + 1 + DO k=0,0 + distp(k, 1) = DEXP(-(dd2*r(k))) + END DO +! endif + IF (typec .NE. 1) THEN + fun = -(dd2*distp(0, 1)/r(0)) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp143b1 = -(distp(0, 1)*funb0/r(0)) + dd2b = temp143b1 + distp(0, 1)*2*dd2*fun2b + temp143 = dd2/r(0) + distpb(0, 1) = dd2**2*fun2b - temp143*funb0 + rb(0) = rb(0) - temp143*temp143b1 + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + dd3b = 0.0_8 + DO i=0,0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + DO k=0,0,-1 + temp143b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp143b0 + rb(k) = rb(k) - dd2*temp143b0 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (116) +! 2p double Lorentian +! dd1 * x_mu (L^3(dd2 r)+dd3 r * L(dd4*r)^4) ; L(x)=1/(1+x) + dd2 = dd(indpar+1) + dd3 = dd(indpar+2) + dd4 = dd(indpar+3) + DO k=0,0 + distp(k, 1) = 1.d0/(1.d0+dd2*r(k))**3 + distp(k, 2) = r(k)/(1.d0+dd4*r(k))**4 + END DO +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN + fun = -(3.d0*dd2*distp(0, 1)/(r(0)*(1.d0+dd2*r(0)))) + dd3*distp(0& +& , 2)/r(0)**2*(1.d0-3*dd4*r(0))/(1.d0+dd4*r(0)) + fun2 = 12.d0*dd2**2/(1.+dd2*r(0))**5 + dd3*4.d0*dd4*(-2.d0+3.d0*& +& dd4*r(0))/(1.+dd4*r(0))**6 +! fun0=distp(0,1)+dd3*distp(0,2) +! fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) +! fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) +! 1+2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF - temp297 = fun/r(0) - temp297b7 = distp(0, 4+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 4+ic) = distpb(0, 4+ic) + temp297*rmu(i, 0)*zb(& -& indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp297*distp(0, 4+ic)*zb(indorbp, & -& indt+i) - funb = funb + temp297b7 - rb(0) = rb(0) - temp297*temp297b7 + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp154b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp154b0 + fun2b = fun2b + temp154b0 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp154b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp154b + funb0 = funb0 + rmu(ic, 0)*temp154b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp297b3 = c*fun2b - temp297b4 = dd2**2*temp297b3 - temp297b5 = dd3**2*temp297b3 - cb = (-(dd1*distp(0, 1))-peff*dd2*distp(0, 2)-peff2*dd3*distp(0, 3& -& ))*funb + (dd1**2*distp(0, 1)+dd2**2*(peff*distp(0, 2))+dd3**2*(& -& peff2*distp(0, 3)))*fun2b - temp297b6 = c*funb - dd1b = distp(0, 1)*2*dd1*temp297b3 - distp(0, 1)*temp297b6 - distpb(0, 1) = distpb(0, 1) + dd1**2*temp297b3 - dd2b = peff*distp(0, 2)*2*dd2*temp297b3 - distp(0, 2)*peff*& -& temp297b6 - peffb = distp(0, 2)*temp297b4 - distp(0, 2)*dd2*temp297b6 - distpb(0, 2) = distpb(0, 2) + peff*temp297b4 - dd3b = peff2*distp(0, 3)*2*dd3*temp297b3 - distp(0, 3)*peff2*& -& temp297b6 - peff2b = distp(0, 3)*temp297b5 - distp(0, 3)*dd3*temp297b6 - distpb(0, 3) = distpb(0, 3) + peff2*temp297b5 - distpb(0, 1) = distpb(0, 1) - dd1*temp297b6 - distpb(0, 2) = distpb(0, 2) - peff*dd2*temp297b6 - distpb(0, 3) = distpb(0, 3) - peff2*dd3*temp297b6 - distpb(0, 4) = distpb(0, 4) + fun0b + temp153 = (dd2*r(0)+1.)**5 + temp153b = 12.d0*fun2b/temp153 + temp153b0 = -(dd2**2*5*(dd2*r(0)+1.)**4*temp153b/temp153) + temp152 = (dd4*r(0)+1.)**6 + temp151 = 3.d0*dd4*r(0) - 2.d0 + temp151b = 4.d0*fun2b/temp152 + temp151b0 = dd3*dd4*3.d0*temp151b + temp151b1 = -(dd3*dd4*temp151*6*(dd4*r(0)+1.)**5*temp151b/temp152) + temp148 = dd2*r(0) + 1.d0 + temp148b0 = -(3.d0*funb0/(r(0)*temp148)) + temp148b1 = -(dd2*distp(0, 1)*temp148b0/(r(0)*temp148)) + dd2b = distp(0, 1)*temp148b0 + r(0)**2*temp148b1 + r(0)*temp153b0 & +& + 2*dd2*temp153b + temp149 = r(0)**2*(dd4*r(0)+1.d0) + temp151b2 = funb0/temp149 + temp150 = (-3)*(dd4*r(0)) + 1.d0 + temp150b = -(dd3*distp(0, 2)*3*temp151b2) + temp149b = -(dd3*distp(0, 2)*temp150*temp151b2/temp149) + temp149b0 = r(0)**2*temp149b + rb(0) = rb(0) + dd4*temp150b + (dd4*r(0)+1.d0)*2*r(0)*temp149b + & +& dd4*temp149b0 + (r(0)*dd2+temp148)*temp148b1 + dd4*temp151b1 + & +& dd4*temp151b0 + dd2*temp153b0 + dd3b = temp150*distp(0, 2)*temp151b2 + distp(0, 2)*fun0b + temp151& +& *dd4*temp151b + dd4b = r(0)*temp150b + r(0)*temp149b0 + r(0)*temp151b1 + r(0)*& +& temp151b0 + temp151*dd3*temp151b + distpb = 0.0_8 + distpb(0, 2) = temp150*dd3*temp151b2 + distpb(0, 1) = fun0b + dd2*temp148b0 + distpb(0, 2) = distpb(0, 2) + dd3*fun0b ELSE distpb = 0.0_8 - peffb = 0.0_8 - dd1b = 0.0_8 dd2b = 0.0_8 dd3b = 0.0_8 - peff2b = 0.0_8 - cb = 0.0_8 + dd4b = 0.0_8 END IF - DO ic=5,1,-1 + DO ic=3,1,-1 DO i=0,0,-1 - distpb(i, 4+ic) = distpb(i, 4+ic) + distp(i, 4)*zb(indorbp, i) - distpb(i, 4) = distpb(i, 4) + distp(i, 4+ic)*zb(indorbp, i) + temp148b = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& +& indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp148b + dd3b = dd3b + distp(i, 2)*temp148b + distpb(i, 2) = distpb(i, 2) + dd3*temp148b zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 9)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 9) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 9) - distpb(i, 9) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 8) - distpb(i, 8) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 7) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 7) - distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 5) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - temp297b2 = c*distpb(i, 4) - cb = cb + (distp(i, 1)+peff*distp(i, 2)+peff2*distp(i, 3))*distpb(& -& i, 4) - distpb(i, 1) = distpb(i, 1) + temp297b2 - peffb = peffb + distp(i, 2)*temp297b2 - distpb(i, 2) = distpb(i, 2) + peff*temp297b2 - peff2b = peff2b + distp(i, 3)*temp297b2 - distpb(i, 3) = distpb(i, 3) + peff2*temp297b2 - distpb(i, 4) = 0.0_8 - END DO DO k=0,0,-1 - temp297b = DEXP(-(dd3*r(k)))*distpb(k, 3) - dd3b = dd3b - r(k)*temp297b - distpb(k, 3) = 0.0_8 - temp297b0 = DEXP(-(dd2*r(k)))*distpb(k, 2) + temp146 = dd4*r(k) + 1.d0 + temp147 = temp146**4 + temp146b = -(r(k)*4*temp146**3*distpb(k, 2)/temp147**2) + rb(k) = rb(k) + dd4*temp146b + distpb(k, 2)/temp147 + dd4b = dd4b + r(k)*temp146b distpb(k, 2) = 0.0_8 - temp297b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd2*temp297b0 - dd1*temp297b1 - dd3*temp297b - dd2b = dd2b - r(k)*temp297b0 - dd1b = dd1b - r(k)*temp297b1 + temp144 = dd2*r(k) + 1.d0 + temp145 = temp144**3 + temp144b = -(3*temp144**2*distpb(k, 1)/temp145**2) + dd2b = dd2b + r(k)*temp144b + rb(k) = rb(k) + dd2*temp144b distpb(k, 1) = 0.0_8 END DO - temp296 = (dd2+dd3)**7 - temp282 = peff*peff2/temp296 - temp295 = 2.d0**7 - temp294 = temp295*dd3**7 - temp293 = peff2**2/temp294 - temp292 = (dd1+dd3)**7 - temp291 = 2.d0**7 - temp290 = temp291*dd2**7 - temp289 = peff**2/temp290 - temp288 = (dd1+dd2)**7 - temp287 = 2.d0**7 - temp286 = temp287*dd1**7 - temp283 = 1.0/temp286 + 2*(peff/temp288) + temp289 + 2*(peff2/& -& temp292) + temp293 + 2*temp282 - temp285 = DSQRT(temp283) - temp284 = 2.d0*DSQRT(720.d0) - IF (temp283 .EQ. 0.0) THEN - temp283b = 0.0 - ELSE - temp283b = -(DSQRT(5.d0/pi)*cb/(temp284*temp285**2*2.D0*DSQRT(& -& temp283))) - END IF - temp283b0 = 2*temp283b/temp288 - temp283b1 = -(peff*7*(dd1+dd2)**6*temp283b0/temp288) - temp283b2 = 2*temp283b/temp292 - temp283b3 = -(peff2*7*(dd1+dd3)**6*temp283b2/temp292) - temp282b0 = 2*temp283b/temp296 - temp282b1 = -(temp282*7*(dd2+dd3)**6*temp282b0) - dd1b = dd1b + temp283b3 + temp283b1 - temp287*7*dd1**6*temp283b/& -& temp286**2 - peffb = peffb + peff2*temp282b0 + 2*peff*temp283b/temp290 + & -& temp283b0 - dd2b = dd2b + temp282b1 - temp289*temp291*7*dd2**6*temp283b/temp290 & -& + temp283b1 - peff2b = peff2b + peff*temp282b0 + 2*peff2*temp283b/temp294 + & -& temp283b2 - dd3b = dd3b + temp282b1 - temp293*temp295*7*dd3**6*temp283b/temp294 & -& + temp283b3 - ddb(indpar+5) = ddb(indpar+5) + peff2b - ddb(indpar+4) = ddb(indpar+4) + dd3b - ddb(indpar+3) = ddb(indpar+3) + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (33) -! 4d without cusp and one parmater - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c= -! & 1/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) -! c= & -! & 1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) - c = dd1**4.5d0*0.0710812062076410d0 -! endif + ddb(indpar+3) = ddb(indpar+3) + dd4b + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (48) +! f orbital +! +! - angmom = 3 +! - type = Gaussian +! - normalized = yes +! - angtype = spherical +! - npar = 1 +! - multiplicity = 7 +! + indparp = indpar + 1 + dd1 = dd(indparp) + c = dd1**2.25d0*1.47215808929909374563d0 DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = distp(i, 1)*r(i) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) + distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) ! lz=0 - distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) -! lz=+/ - distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) -! lz=+/-2 - distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) + distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) ! lz=+/-1 - distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) + distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) ! lz=+/-1 - distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d + distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) +! lz=+/-2 + distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) +! lz=+/-2 + distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) +! lz=+/-3 + distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) END DO -! indorbp=indorb - DO ic=1,5 +! lz=+/-3 + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 3) - fun = -(dd1*distp(0, 3)) + distp(0, 1) - fun2 = dd1**2*distp(0, 3) - 2.d0*dd1*distp(0, 1) -! indorbp=indorb - DO ic=1,5 + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1) + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - END IF - END DO + IF (ic .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + ELSE IF (ic .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (ic .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE IF (ic .EQ. 4) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (ic .EQ. 5) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + ELSE IF (ic .EQ. 6) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + END IF END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp300 = fun/r(0) - temp301b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp300b3 = 6.d0*temp301b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp300+fun2)*zb(& -& indorbp, indt+4) - funb = funb + temp300b3 - rb(0) = rb(0) - temp300*temp300b3 - fun2b = fun2b + temp301b + DO ic=7,1,-1 + temp155b28 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 8.d0*temp155b28 + fun2b = fun2b + temp155b28 zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp300b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp300b - fun0b = fun0b + rmu(i, 0)*temp300b - ELSE - temp300b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp300b0 - fun0b = fun0b + rmu(i, 0)*temp300b0 - END IF - ELSE IF (branch .LT. 4) THEN - temp300b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp300b1 - fun0b = fun0b + rmu(i, 0)*temp300b1 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp300b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp300b2 - fun0b = fun0b + rmu(i, 0)*temp300b2 - ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 4) THEN + IF (branch .LT. 2) THEN + IF (branch .LT. 1) THEN + temp155b9 = cost1f*zb(indorbp, indt+3) + temp155b10 = -(cost1f*6.d0*zb(indorbp, indt+2)) + temp155b11 = -(cost1f*6.d0*zb(indorbp, indt+1)) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp155b10 + rmu(3, 0)& +& *rmu(1, 0)*temp155b11 + (9.d0*rmu(3, 0)**2-3.d0*r(0)**2)& +& *temp155b9 + rmub(3, 0) = rmub(3, 0) + fun0*9.d0*2*rmu(3, 0)*temp155b9 + rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp155b9 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp155b10 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp155b10 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp155b11 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp155b11 + ELSE + temp155b12 = cost2f*8.d0*zb(indorbp, indt+3) + temp155b13 = -(cost2f*2.d0*zb(indorbp, indt+2)) + fun0b = fun0b + rmu(1, 0)*rmu(2, 0)*temp155b13 + cost2f*(& +& 5.d0*rmu(3, 0)**2-r(0)**2-2.d0*rmu(1, 0)**2)*zb(indorbp& +& , indt+1) + rmu(1, 0)*rmu(3, 0)*temp155b12 + rmub(3, 0) = rmub(3, 0) + rmu(1, 0)*fun0*temp155b12 + rmub(1, 0) = rmub(1, 0) + fun0*rmu(3, 0)*temp155b12 + rmub(2, 0) = rmub(2, 0) + rmu(1, 0)*fun0*temp155b13 + rmub(1, 0) = rmub(1, 0) + fun0*rmu(2, 0)*temp155b13 + temp155b14 = cost2f*fun0*zb(indorbp, indt+1) + rmub(3, 0) = rmub(3, 0) + 5.d0*2*rmu(3, 0)*temp155b14 + rb(0) = rb(0) - 2*r(0)*temp155b14 + rmub(1, 0) = rmub(1, 0) - 2.d0*2*rmu(1, 0)*temp155b14 END IF + ELSE IF (branch .LT. 3) THEN + temp155b15 = cost2f*8.d0*zb(indorbp, indt+3) + temp155b16 = -(cost2f*2.d0*zb(indorbp, indt+1)) + fun0b = fun0b + cost2f*(5.d0*rmu(3, 0)**2-r(0)**2-2.d0*rmu(2& +& , 0)**2)*zb(indorbp, indt+2) + rmu(2, 0)*rmu(1, 0)*& +& temp155b16 + rmu(2, 0)*rmu(3, 0)*temp155b15 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*fun0*temp155b15 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(3, 0)*temp155b15 + temp155b17 = cost2f*fun0*zb(indorbp, indt+2) + rmub(3, 0) = rmub(3, 0) + 5.d0*2*rmu(3, 0)*temp155b17 + rb(0) = rb(0) - 2*r(0)*temp155b17 + rmub(2, 0) = rmub(2, 0) - 2.d0*2*rmu(2, 0)*temp155b17 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp155b16 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp155b16 ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + temp155b18 = cost3f*zb(indorbp, indt+3) + temp155b19 = -(cost3f*2.d0*zb(indorbp, indt+2)) + temp155b20 = cost3f*2.d0*zb(indorbp, indt+1) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp155b19 + rmu(3, 0)*& +& rmu(1, 0)*temp155b20 + (rmu(1, 0)**2-rmu(2, 0)**2)*& +& temp155b18 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp155b18 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp155b19 - fun0*2& +& *rmu(2, 0)*temp155b18 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp155b19 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp155b20 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp155b20 END IF - temp299 = fun/r(0) - temp299b1 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp299*rmu(i, 0)*zb(& -& indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp299*distp(0, 3+ic)*zb(indorbp, & + ELSE IF (branch .LT. 6) THEN + IF (branch .LT. 5) THEN + temp155b21 = cost3f*2.d0*zb(indorbp, indt+3) + temp155b22 = cost3f*2.d0*zb(indorbp, indt+2) + temp155b23 = cost3f*2.d0*zb(indorbp, indt+1) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp155b22 + rmu(3, 0)*& +& rmu(2, 0)*temp155b23 + rmu(2, 0)*rmu(1, 0)*temp155b21 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp155b21 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp155b21 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp155b22 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp155b22 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp155b23 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp155b23 + ELSE + temp155b24 = -(cost4f*6.d0*zb(indorbp, indt+2)) + temp155b25 = cost4f*3.d0*zb(indorbp, indt+1) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp155b25 + rmu& +& (2, 0)*rmu(1, 0)*temp155b24 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp155b24 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp155b24 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp155b25 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp155b25 + END IF + ELSE + temp155b26 = cost4f*3.d0*zb(indorbp, indt+2) + temp155b27 = cost4f*6.d0*zb(indorbp, indt+1) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp155b27 + (rmu(1, 0)**2& +& -rmu(2, 0)**2)*temp155b26 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp155b26 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp155b26 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp155b27 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp155b27 + END IF + DO i=3,1,-1 + temp155b8 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - funb = funb + temp299b1 - rb(0) = rb(0) - temp299*temp299b1 + rmub(i, 0) = rmub(i, 0) + fun*temp155b8 + funb0 = funb0 + rmu(i, 0)*temp155b8 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - dd1b = (distp(0, 3)*2*dd1-2.d0*distp(0, 1))*fun2b - distp(0, 3)*& -& funb - distpb(0, 3) = distpb(0, 3) + dd1**2*fun2b - distpb(0, 1) = distpb(0, 1) + funb - 2.d0*dd1*fun2b - distpb(0, 3) = distpb(0, 3) + fun0b - dd1*funb + temp155b7 = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp155b7 - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp155b7 + distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb0 + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd1b = 0.0_8 END IF - DO ic=5,1,-1 - DO i=0,0,-1 - distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=7,1,-1 + DO k=0,0,-1 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + temp155b = cost4f*rmu(2, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 8) - 2*rmu(2, i)*temp155b distpb(i, 8) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + temp155b0 = cost4f*rmu(1, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& +& distpb(i, 7) + 2*rmu(1, i)*temp155b0 + 3.d0*2*rmu(1, i)*temp155b + rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp155b0 distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + temp155b1 = cost3f*2.d0*distpb(i, 6) + temp155b2 = rmu(2, i)*temp155b1 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp155b2 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp155b2 + rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp155b1 distpb(i, 6) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + temp155b3 = cost3f*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 5) + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp155b3 distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 4) - 2*rmu(2, i)*temp155b3 + temp155b4 = cost2f*rmu(2, i)*distpb(i, 4) + rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp155b4 distpb(i, 4) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distpb(i, 1) = distpb(i, 1) + r(i)*distpb(i, 3) - rb(i) = rb(i) + distp(i, 1)*distpb(i, 3) + temp155b5 = cost2f*rmu(1, i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 3) distpb(i, 3) = 0.0_8 + temp155b6 = cost1f*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - 2*r(i)*temp155b5 - 3.d0*2*r(i)*temp155b6 - 2*r(i)*& +& temp155b4 + rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& +& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp155b6 + 5.d0*2*rmu(3, i)*& +& temp155b5 + distpb(i, 2) = 0.0_8 END DO + dd1b = 0.0_8 cb = 0.0_8 DO k=0,0,-1 - temp299b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp299b0 - rb(k) = rb(k) - dd1*temp299b0 + temp154 = r(k)**2 + temp154b1 = c*DEXP(-(dd1*temp154))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp154))*distpb(k, 1) + dd1b = dd1b - temp154*temp154b1 + rb(k) = rb(k) - dd1*2*r(k)*temp154b1 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.0710812062076410d0*4.5d0*dd1**3.5D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (34) -! 2s single Z WITH CUSP zero -! normalized -! exp(-dd1*r) + dd1*r*exp(-dd1*r) -! if(iocc(indshellp).eq.1) then + dd1b = dd1b + 1.47215808929909374563d0*2.25d0*dd1**1.25D0*cb + ddb(indparp) = ddb(indparp) + dd1b + CASE (102) +! 2s double gaussian with constant +! (dd3+ exp (-dd2 r^2)+dd4*exp(-dd5*r^2)) + dd2 = dd(indpar+1) + dd4 = dd(indpar+3) + dd5 = dd(indpar+4) indorbp = indorb + 1 - dd1 = dd(indpar+1) -! peff=dd1 -! if(iflagnorm.gt.2) then -! c=1.d0/dsqrt(1.d0/4.d0/dd1**3+12.d0*dd1/(2.d0*dd1)**4+ & -! &3.d0*dd1**2/4.d0/dd1**5)/dsqrt(4.d0*pi) -! c=dd1*dsqrt(dd1)/dsqrt(7.d0*pi) - c = dd1*DSQRT(dd1)*.2132436186229231d0 -! endif - DO i=0,0 - distp(i, 1) = c*DEXP(-(dd1*r(i))) + DO k=0,0 + distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) + distp(k, 2) = DEXP(-(dd5*r(k)*r(k))) END DO +! write(6,*) ' function inside = ',z(indorbp,i) +! endif IF (typec .NE. 1) THEN - fun = -(dd1**2*distp(0, 1)) - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) + fun = -(2.d0*(dd2*distp(0, 1)+dd5*dd4*distp(0, 2))) + fun2 = r(0)**2 + distpb = 0.0_8 + temp155b32 = 2.d0*zb(indorbp, indt+4) + temp155b33 = dd2*distp(0, 1)*2.d0*temp155b32 + temp155b34 = (2.d0*(dd2*fun2)-3.d0)*temp155b32 + temp155b35 = (2.d0*(dd5*fun2)-3.d0)*temp155b32 + temp155b36 = dd5*dd4*distp(0, 2)*2.d0*temp155b32 + dd2b = distp(0, 1)*temp155b34 + fun2*temp155b33 + fun2b = dd5*temp155b36 + dd2*temp155b33 + distpb(0, 1) = dd2*temp155b34 + dd5b = fun2*temp155b36 + distp(0, 2)*dd4*temp155b35 + dd4b = distp(0, 2)*dd5*temp155b35 + distpb(0, 2) = dd5*dd4*temp155b35 zb(indorbp, indt+4) = 0.0_8 + funb0 = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO - funb = funb + (1.d0-dd1*r(0))*fun2b - dd1b = -(distp(0, 1)*2*dd1*funb) - fun*r(0)*fun2b - rb(0) = rb(0) - fun*dd1*fun2b - distpb = 0.0_8 - distpb(0, 1) = -(dd1**2*funb) + rb(0) = rb(0) + 2*r(0)*fun2b + temp155b31 = -(2.d0*funb0) + dd2b = dd2b + distp(0, 1)*temp155b31 + distpb(0, 1) = distpb(0, 1) + dd2*temp155b31 + dd5b = dd5b + distp(0, 2)*dd4*temp155b31 + dd4b = dd4b + distp(0, 2)*dd5*temp155b31 + distpb(0, 2) = distpb(0, 2) + dd5*dd4*temp155b31 ELSE distpb = 0.0_8 - dd1b = 0.0_8 + dd2b = 0.0_8 + dd4b = 0.0_8 + dd5b = 0.0_8 END IF + dd3b = 0.0_8 DO i=0,0,-1 - temp302b0 = distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + (r(i)*dd1+1.d0)*zb(indorbp, i) - rb(i) = rb(i) + dd1*temp302b0 - dd1b = dd1b + r(i)*temp302b0 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) + dd4b = dd4b + distp(i, 2)*zb(indorbp, i) + distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO - cb = 0.0_8 - DO i=0,0,-1 - temp302b = c*DEXP(-(dd1*r(i)))*distpb(i, 1) - cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) - dd1b = dd1b - r(i)*temp302b - rb(i) = rb(i) - dd1*temp302b - distpb(i, 1) = 0.0_8 + DO k=0,0,-1 + temp155b29 = DEXP(-(dd5*r(k)**2))*distpb(k, 2) + dd5b = dd5b - r(k)**2*temp155b29 + distpb(k, 2) = 0.0_8 + temp155b30 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + rb(k) = rb(k) - dd2*2*r(k)*temp155b30 - dd5*2*r(k)*temp155b29 + dd2b = dd2b - r(k)**2*temp155b30 + distpb(k, 1) = 0.0_8 END DO - temp301 = DSQRT(dd1) - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + .2132436186229231d0*temp301*cb - ELSE - dd1b = dd1b + (.2132436186229231d0*dd1/(2.D0*DSQRT(dd1))+& -& .2132436186229231d0*temp301)*cb - END IF - ddb(indpar+1) = ddb(indpar+1) + dd1b + ddb(indpar+4) = ddb(indpar+4) + dd5b + ddb(indpar+3) = ddb(indpar+3) + dd4b + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b CASE (35) -! 2s single Z WITH CUSP ! normalized ! exp(-dd1*r) + dd1* r * exp(-dd2*r) ! if(iocc(indshellp).eq.1) then @@ -9220,34 +8946,34 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd fun = -(dd1*distp(0, 1)) + peff*distp(0, 2)*(1.d0-dd2*r(0)) fun2 = distp(0, 1)*dd1**2 + peff*distp(0, 2)*(dd2**2*r(0)-2.d0*dd2& & ) - temp310 = fun/r(0) - temp310b = c*2.d0*zb(indorbp, indt+4)/r(0) - cb = (2.d0*temp310+fun2)*zb(indorbp, indt+4) - funb = temp310b - rb(0) = rb(0) - temp310*temp310b + temp163 = fun/r(0) + temp163b = c*2.d0*zb(indorbp, indt+4)/r(0) + cb = (2.d0*temp163+fun2)*zb(indorbp, indt+4) + funb0 = temp163b + rb(0) = rb(0) - temp163*temp163b fun2b = c*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - temp309 = rmu(i, 0)/r(0) - temp309b5 = fun*c*zb(indorbp, indt+i)/r(0) - funb = funb + temp309*c*zb(indorbp, indt+i) - cb = cb + temp309*fun*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp309b5 - rb(0) = rb(0) - temp309*temp309b5 + temp162 = rmu(i, 0)/r(0) + temp162b5 = fun*c*zb(indorbp, indt+i)/r(0) + funb0 = funb0 + temp162*c*zb(indorbp, indt+i) + cb = cb + temp162*fun*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp162b5 + rb(0) = rb(0) - temp162*temp162b5 zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp309b1 = (dd2**2*r(0)-2.d0*dd2)*fun2b - temp309b2 = peff*distp(0, 2)*fun2b + temp162b1 = (dd2**2*r(0)-2.d0*dd2)*fun2b + temp162b2 = peff*distp(0, 2)*fun2b distpb(0, 1) = dd1**2*fun2b - dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb - temp309b3 = (1.d0-dd2*r(0))*funb - peffb = distp(0, 2)*temp309b3 + distp(0, 2)*temp309b1 - distpb(0, 2) = peff*temp309b3 + peff*temp309b1 - temp309b4 = peff*distp(0, 2)*funb - dd2b = (r(0)*2*dd2-2.d0)*temp309b2 - r(0)*temp309b4 - rb(0) = rb(0) + dd2**2*temp309b2 - dd2*temp309b4 - distpb(0, 1) = distpb(0, 1) - dd1*funb + dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb0 + temp162b3 = (1.d0-dd2*r(0))*funb0 + peffb = distp(0, 2)*temp162b3 + distp(0, 2)*temp162b1 + distpb(0, 2) = peff*temp162b3 + peff*temp162b1 + temp162b4 = peff*distp(0, 2)*funb0 + dd2b = (r(0)*2*dd2-2.d0)*temp162b2 - r(0)*temp162b4 + rb(0) = rb(0) + dd2**2*temp162b2 - dd2*temp162b4 + distpb(0, 1) = distpb(0, 1) - dd1*funb0 ELSE distpb = 0.0_8 peffb = 0.0_8 @@ -9256,57 +8982,238 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd cb = 0.0_8 END IF DO i=0,0,-1 - temp309b = c*zb(indorbp, i) - temp309b0 = distp(i, 2)*temp309b + temp162b = c*zb(indorbp, i) + temp162b0 = distp(i, 2)*temp162b cb = cb + (distp(i, 1)+r(i)*peff*distp(i, 2))*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp309b - rb(i) = rb(i) + peff*temp309b0 - peffb = peffb + r(i)*temp309b0 - distpb(i, 2) = distpb(i, 2) + r(i)*peff*temp309b + distpb(i, 1) = distpb(i, 1) + temp162b + rb(i) = rb(i) + peff*temp162b0 + peffb = peffb + r(i)*temp162b0 + distpb(i, 2) = distpb(i, 2) + r(i)*peff*temp162b zb(indorbp, i) = 0.0_8 END DO - temp308 = 4*dd2**5 - temp302 = peff**2/temp308 - temp307 = (dd1+dd2)**4 - temp306 = 4.d0*dd1**3 - temp303 = 1.0/temp306 + 12*(peff/temp307) + 3*temp302 - temp305 = DSQRT(temp303) - temp304 = DSQRT(4.0*pi) - IF (temp303 .EQ. 0.0) THEN - temp303b = 0.0 + temp161 = 4*dd2**5 + temp155 = peff**2/temp161 + temp160 = (dd1+dd2)**4 + temp159 = 4.d0*dd1**3 + temp156 = 1.0/temp159 + 12*(peff/temp160) + 3*temp155 + temp158 = DSQRT(temp156) + temp157 = DSQRT(4.0*pi) + IF (temp156 .EQ. 0.0) THEN + temp156b = 0.0 ELSE - temp303b = -(cb/(temp304*temp305**2*2.D0*DSQRT(temp303))) + temp156b = -(cb/(temp157*temp158**2*2.D0*DSQRT(temp156))) END IF - temp303b0 = 12*temp303b/temp307 - temp303b1 = -(peff*4*(dd1+dd2)**3*temp303b0/temp307) - temp302b3 = 3*temp303b/temp308 - dd1b = dd1b + temp303b1 - 4.d0*3*dd1**2*temp303b/temp306**2 - peffb = peffb + 2*peff*temp302b3 + temp303b0 - dd2b = dd2b + temp303b1 - temp302*4*5*dd2**4*temp302b3 + temp156b0 = 12*temp156b/temp160 + temp156b1 = -(peff*4*(dd1+dd2)**3*temp156b0/temp160) + temp155b39 = 3*temp156b/temp161 + dd1b = dd1b + temp156b1 - 4.d0*3*dd1**2*temp156b/temp159**2 + peffb = peffb + 2*peff*temp155b39 + temp156b0 + dd2b = dd2b + temp156b1 - temp155*4*5*dd2**4*temp155b39 DO k=0,0,-1 - temp302b1 = DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp302b1 + temp155b37 = DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp155b37 distpb(k, 2) = 0.0_8 - temp302b2 = DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp302b2 - dd2*temp302b1 - dd1b = dd1b - r(k)*temp302b2 + temp155b38 = DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp155b38 - dd2*temp155b37 + dd1b = dd1b - r(k)*temp155b38 distpb(k, 1) = 0.0_8 END DO dd1b = dd1b + peffb ddb(indpar+2) = ddb(indpar+2) + dd2b ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (36) + CASE (103) ! single gaussian p orbitals - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0 - c = dd1**1.25d0*1.42541094070998d0 -! endif +! 2p single gaussian + dd2 = dd(indpar+1) DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + distp(k, 1) = DEXP(-(dd2*r(k)**2)) + END DO +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN + fun = -(dd2*distp(0, 1)*2.d0) + fun2 = 2.d0*dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0, 1) +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp164b3 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp164b3 + fun2b = fun2b + temp164b3 + zb(indorbp, indt+4) = 0.0_8 + fun0b = fun0b + zb(indorbp, indt+ic) + DO i=3,1,-1 + temp164b2 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp164b2 + funb0 = funb0 + rmu(ic, 0)*temp164b2 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + distpb = 0.0_8 + temp164b0 = 2.d0**2*dd2*distp(0, 1)*fun2b + temp164b1 = 2.d0*(2.d0*(dd2*r(0)**2)-1.d0)*fun2b + dd2b = distp(0, 1)*temp164b1 - 2.d0*distp(0, 1)*funb0 + r(0)**2*& +& temp164b0 + rb(0) = rb(0) + dd2*2*r(0)*temp164b0 + distpb(0, 1) = fun0b - 2.d0*dd2*funb0 + dd2*temp164b1 + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=0,0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO k=0,0,-1 + temp164b = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp164b + rb(k) = rb(k) - dd2*2*r(k)*temp164b + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (120) +! 2p double cubic +! dd1 * x_mu (L^3(dd2 r)+dd3 L(dd4*r)^3) ; L(x)=1/(1+x) + dd2 = dd(indpar+1) + dd3 = dd(indpar+2) + dd4 = dd(indpar+3) + DO k=0,0 + distp(k, 1) = 1.d0/(1.d0+dd2*r(k))**3 + distp(k, 2) = 1.d0/(1.d0+dd4*r(k))**3 + END DO +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN + fun = -(3.d0*dd2*distp(0, 1)/(r(0)*(1.d0+dd2*r(0)))) - 3.d0*dd4*& +& dd3*distp(0, 2)/(r(0)*(1.d0+dd4*r(0))) + fun2 = 12.d0*dd2**2/(1.+dd2*r(0))**5 + 12.d0*dd3*dd4**2/(1.+dd4*r(& +& 0))**5 +! fun0=distp(0,1)+dd3*distp(0,2) +! fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) +! fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) +! 1+2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp172b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp172b0 + fun2b = fun2b + temp172b0 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp172b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp172b + funb0 = funb0 + rmu(ic, 0)*temp172b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + temp171 = (dd2*r(0)+1.)**5 + temp171b = 12.d0*fun2b/temp171 + temp171b0 = -(dd2**2*5*(dd2*r(0)+1.)**4*temp171b/temp171) + temp170 = (dd4*r(0)+1.)**5 + temp170b = 12.d0*fun2b/temp170 + temp170b0 = -(dd3*dd4**2*5*(dd4*r(0)+1.)**4*temp170b/temp170) + temp169 = dd2*r(0) + 1.d0 + temp169b = -(3.d0*funb0/(r(0)*temp169)) + temp169b0 = -(dd2*distp(0, 1)*temp169b/(r(0)*temp169)) + dd2b = distp(0, 1)*temp169b + r(0)**2*temp169b0 + r(0)*temp171b0 +& +& 2*dd2*temp171b + temp168 = dd4*r(0) + 1.d0 + temp168b0 = -(3.d0*funb0/(r(0)*temp168)) + temp168b1 = -(dd4*dd3*distp(0, 2)*temp168b0/(r(0)*temp168)) + rb(0) = rb(0) + (r(0)*dd2+temp169)*temp169b0 + (r(0)*dd4+temp168)*& +& temp168b1 + dd4*temp170b0 + dd2*temp171b0 + dd3b = distp(0, 2)*dd4*temp168b0 + distp(0, 2)*fun0b + dd4**2*& +& temp170b + dd4b = distp(0, 2)*dd3*temp168b0 + r(0)**2*temp168b1 + r(0)*& +& temp170b0 + dd3*2*dd4*temp170b + distpb = 0.0_8 + distpb(0, 1) = dd2*temp169b + distpb(0, 2) = dd4*dd3*temp168b0 + distpb(0, 1) = distpb(0, 1) + fun0b + distpb(0, 2) = distpb(0, 2) + dd3*fun0b + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + dd3b = 0.0_8 + dd4b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=0,0,-1 + temp168b = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& +& indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp168b + dd3b = dd3b + distp(i, 2)*temp168b + distpb(i, 2) = distpb(i, 2) + dd3*temp168b + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO k=0,0,-1 + temp166 = dd4*r(k) + 1.d0 + temp167 = temp166**3 + temp166b = -(3*temp166**2*distpb(k, 2)/temp167**2) + dd4b = dd4b + r(k)*temp166b + distpb(k, 2) = 0.0_8 + temp164 = dd2*r(k) + 1.d0 + temp165 = temp164**3 + temp164b4 = -(3*temp164**2*distpb(k, 1)/temp165**2) + rb(k) = rb(k) + dd2*temp164b4 + dd4*temp166b + dd2b = dd2b + r(k)*temp164b4 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+3) = ddb(indpar+3) + dd4b + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (135) +! 2p single exponential r^4 e^{-z r} ! + dd2 = dd(indpar+1) + DO k=0,0 + distp(k, 1) = DEXP(-(dd2*r(k))) END DO ! indorbp=indorb -! DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then @@ -9314,277 +9221,278 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) + fun = distp(0, 1)*(4.d0-dd2*r(0))*r(0)**2 + fun2 = distp(0, 1)*(12*r(0)**2-8*dd2*r(0)**3+dd2**2*r(0)**4) ! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp312b1 = rmu(ic, 0)*zb(indorbp, indt+4) + temp174b0 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp312b1 - fun2b = fun2b + temp312b1 + funb0 = funb0 + 4.d0*temp174b0 + fun2b = fun2b + temp174b0 zb(indorbp, indt+4) = 0.0_8 - fun0b = fun0b + zb(indorbp, indt+ic) DO i=3,1,-1 - temp312b0 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp312b0 - funb = funb + rmu(ic, 0)*temp312b0 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp174b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp174b + funb0 = funb0 + rmu(ic, 0)*temp174b rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp312b = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp312b - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp312b distpb = 0.0_8 - distpb(0, 1) = fun0b - 2.d0*dd1*funb + temp173 = r(0)**4 + temp172 = r(0)**3 + temp172b3 = distp(0, 1)*fun2b + temp172b4 = (4.d0-dd2*r(0))*funb0 + distpb(0, 1) = r(0)**2*temp172b4 + r(0)**4*fun0b + (12*r(0)**2-8*(& +& dd2*temp172)+dd2**2*temp173)*fun2b + temp172b5 = distp(0, 1)*r(0)**2*funb0 + rb(0) = rb(0) + distp(0, 1)*2*r(0)*temp172b4 - dd2*temp172b5 + & +& distp(0, 1)*4*r(0)**3*fun0b + (dd2**2*4*r(0)**3-8*dd2*3*r(0)**2+& +& 12*2*r(0))*temp172b3 + dd2b = (temp173*2*dd2-8*temp172)*temp172b3 - r(0)*temp172b5 ELSE distpb = 0.0_8 - dd1b = 0.0_8 + dd2b = 0.0_8 END IF DO ic=3,1,-1 DO i=0,0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + temp172b2 = r(i)**4*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp172b2 + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp172b2 + rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*4*r(i)**3*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - cb = 0.0_8 DO k=0,0,-1 - temp311 = r(k)**2 - temp311b = c*DEXP(-(dd1*temp311))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp311))*distpb(k, 1) - dd1b = dd1b - temp311*temp311b - rb(k) = rb(k) - dd1*2*r(k)*temp311b + temp172b1 = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp172b1 + rb(k) = rb(k) - dd2*temp172b1 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 1.42541094070998d0*1.25d0*dd1**0.25D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (37, 68) -! d orbitals -! R(r)= exp(-alpha r^2) -! each gaussian term is normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (114) +! 2s without cusp condition +! dd1*( dd3 +r^2/(1+dd2*r)^3) + dd2 = dd(indpar+1) + indorbp = indorb + 1 +! endif + IF (typec .NE. 1) THEN + fun = (2.d0-dd2*r(0))/(1+dd2*r(0))**4 + fun2b = zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + temp177 = (dd2*r(0)+1)**5 + temp177b = 2.d0*fun2b/temp177 + temp177b0 = 2*dd2*r(0)*temp177b + temp177b1 = -(((dd2*r(0))**2-4.d0*(dd2*r(0))+1.d0)*5*(dd2*r(0)+1)& +& **4*temp177b/temp177) + temp176 = (dd2*r(0)+1)**4 + temp176b = funb0/temp176 + temp176b0 = -((2.d0-dd2*r(0))*4*(dd2*r(0)+1)**3*temp176b/temp176) + dd2b = r(0)*temp176b0 - r(0)*temp176b + r(0)*temp177b1 - 4.d0*r(0)& +& *temp177b + r(0)*temp177b0 + rb(0) = rb(0) + dd2*temp176b0 - dd2*temp176b + dd2*temp177b1 - & +& 4.d0*dd2*temp177b + dd2*temp177b0 + ELSE + dd2b = 0.0_8 + END IF + distpb = 0.0_8 + dd3b = 0.0_8 + DO i=0,0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + DO k=0,0,-1 + temp174 = dd2*r(k) + 1.d0 + temp175 = temp174**3 + temp174b1 = -(r(k)**2*3*temp174**2*distpb(k, 1)/temp175**2) + rb(k) = rb(k) + dd2*temp174b1 + 2*r(k)*distpb(k, 1)/temp175 + dd2b = dd2b + r(k)*temp174b1 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (63) +! R(r)=c x*exp(-z*r**2)*r (c1 - r^2) + dd1 = dd(indpar+1) ! if(iflagnorm.gt.2) then -! overall normalization -! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) - c = dd1**1.75d0*1.64592278064948967213d0 + c = dd1**1.75d0*1.2749263037197753d0 +! c=2.d0/pi**0.75d0*(2.d0*dd1)**1.75d0/dsqrt(5.d0) ! endif DO k=0,0 distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO - DO i=0,0 -! lz=0 - distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d -! lz=+/-2 - distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d -! lz=+/-2 - distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d -! lz=+/-1 - distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d -! lz=+/-1 - distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d - END DO - DO ic=1,5 + c1 = 1.75d0/dd1 +! indorbp=indorb +! + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO ! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1) - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) + rp1 = dd1*r(0)**2 + cost = 2.d0*rp1 + fun = distp(0, 1)*(c1*(1.d0-cost)/r(0)+(-3.d0+cost)*r(0)) +! My bug !!! +! fun2=distp(0,1)*(c1*2.d0*dd1*fun0*(cost-3.d0) +! &-2.d0*r(0)*(3.d0-7.d0*rp1+2.d0*rp1**2)) + fun2 = -(2.d0*distp(0, 1)*r(0)*(3.d0-7.d0*rp1+2.d0*rp1**2+c1*dd1*(& +& 3.d0-cost))) ! indorbp=indorb - DO ic=1,5 + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - IF (ic .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) - ELSE IF (ic .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (ic .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE IF (ic .EQ. 4) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (ic .EQ. 5) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp313b6 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 6.d0*temp313b6 - fun2b = fun2b + temp313b6 + DO ic=3,1,-1 + temp181b3 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp181b3 + fun2b = fun2b + temp181b3 zb(indorbp, indt+4) = 0.0_8 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - IF (branch .LT. 1) THEN - temp313b1 = cost1d*4.d0*zb(indorbp, indt+3) - rmub(3, 0) = rmub(3, 0) + fun0*temp313b1 - temp313b2 = -(cost1d*2.d0*zb(indorbp, indt+2)) - temp313b3 = -(cost1d*2.d0*zb(indorbp, indt+1)) - fun0b = fun0b + rmu(2, 0)*temp313b2 + rmu(1, 0)*temp313b3 & -& + rmu(3, 0)*temp313b1 - rmub(2, 0) = rmub(2, 0) + fun0*temp313b2 - rmub(1, 0) = rmub(1, 0) + fun0*temp313b3 - ELSE - temp313b4 = -(cost2d*2.d0*zb(indorbp, indt+2)) - rmub(2, 0) = rmub(2, 0) + fun0*temp313b4 - temp313b5 = cost2d*2.d0*zb(indorbp, indt+1) - fun0b = fun0b + rmu(1, 0)*temp313b5 + rmu(2, 0)*temp313b4 - rmub(1, 0) = rmub(1, 0) + fun0*temp313b5 - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+2) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+1) + & -& cost3d*rmu(1, 0)*zb(indorbp, indt+2) - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+1) - END IF - ELSE IF (branch .LT. 5) THEN - IF (branch .LT. 4) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+2) + & -& cost3d*rmu(2, 0)*zb(indorbp, indt+3) - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+2) - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+1) + cost3d*& -& rmu(1, 0)*zb(indorbp, indt+3) - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+1) - END IF DO i=3,1,-1 - temp313b0 = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp313b0 - funb = funb + rmu(i, 0)*temp313b0 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp181b2 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp181b2 + funb0 = funb0 + rmu(ic, 0)*temp181b2 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp313b = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp313b - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp313b - distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + distpb = 0.0_8 + temp181b = -(2.d0*(2.d0*rp1**2-7.d0*rp1+c1*dd1*(3.d0-cost)+3.d0)*& +& fun2b) + temp181b0 = -(2.d0*distp(0, 1)*r(0)*fun2b) + temp180 = c1*(-cost+1.d0)/r(0) + temp180b1 = (c1-r(0)**2)*fun0b + distpb(0, 1) = (temp180+(cost-3.d0)*r(0))*funb0 + r(0)*temp180b1 +& +& r(0)*temp181b + temp181b1 = distp(0, 1)*funb0 + temp180b2 = temp181b1/r(0) + costb = r(0)*temp181b1 - c1*temp180b2 - c1*dd1*temp181b0 + rp1b = 2.d0*costb + (2.d0*2*rp1-7.d0)*temp181b0 + temp180b3 = distp(0, 1)*r(0)*fun0b + rb(0) = rb(0) + (cost-3.d0)*temp181b1 - temp180*temp180b2 + dd1*2*& +& r(0)*rp1b - 2*r(0)*temp180b3 + distp(0, 1)*temp180b1 + distp(0, & +& 1)*temp181b + c1b = (1.d0-cost)*temp180b2 + temp180b3 + (3.d0-cost)*dd1*& +& temp181b0 + dd1b = r(0)**2*rp1b + (3.d0-cost)*c1*temp181b0 ELSE distpb = 0.0_8 + c1b = 0.0_8 + dd1b = 0.0_8 END IF - DO ic=5,1,-1 - DO k=0,0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) - zb(indorbp, k) = 0.0_8 + DO ic=3,1,-1 + DO i=0,0,-1 + temp179 = c1 - r(i)**2 + temp180b = rmu(ic, i)*temp179*zb(indorbp, i) + temp180b0 = distp(i, 1)*r(i)*zb(indorbp, i) + temp179b = rmu(ic, i)*temp180b0 + distpb(i, 1) = distpb(i, 1) + r(i)*temp180b + rb(i) = rb(i) + distp(i, 1)*temp180b - 2*r(i)*temp179b + rmub(ic, i) = rmub(ic, i) + temp179*temp180b0 + c1b = c1b + temp179b + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=0,0,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) - distpb(i, 2) = 0.0_8 - END DO - dd1b = 0.0_8 + dd1b = dd1b - 1.75d0*c1b/dd1**2 cb = 0.0_8 DO k=0,0,-1 - temp312 = r(k)**2 - temp312b2 = c*DEXP(-(dd1*temp312))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp312))*distpb(k, 1) - dd1b = dd1b - temp312*temp312b2 - rb(k) = rb(k) - dd1*2*r(k)*temp312b2 + temp178 = r(k)**2 + temp178b = c*DEXP(-(dd1*temp178))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp178))*distpb(k, 1) + dd1b = dd1b - temp178*temp178b + rb(k) = rb(k) - dd1*2*r(k)*temp178b distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 1.64592278064948967213d0*1.75d0*dd1**0.75D0*cb - ddb(indparp) = ddb(indparp) + dd1b - CASE (47) -! d orbitals cartesian !!! -! R(r)= exp(-alpha r^2) -! each gaussian term is normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization - c = dd1**1.75d0*1.64592278064948967213d0 -! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) -! endif + dd1b = dd1b + 1.2749263037197753d0*1.75d0*dd1**0.75D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (148) +! derivative of 147 with respect to dd1 + dd1 = dd(indpar+1) DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + distp(k, 1) = DEXP(-(dd1*r(k)**2)) END DO DO i=0,0 - distp(i, 2) = rmu(1, i)**2 - distp(i, 3) = rmu(2, i)**2 - distp(i, 4) = rmu(3, i)**2 -! lz=+/-2 - distp(i, 5) = rmu(1, i)*rmu(2, i)*cost3d -! lz=+/-1 - distp(i, 6) = rmu(2, i)*rmu(3, i)*cost3d -! lz=+/-1 - distp(i, 7) = rmu(1, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = -(r(i)**2*distp(i, 1)) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) + distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) + distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) + distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) + distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) + distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d END DO - DO ic=1,6 +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1) - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) + fun0 = distp(0, 3) + fun = 2.d0*(dd1*r(0)**2-1.d0)*r(0)*distp(0, 1) + fun2 = -(2.d0*(2.d0*dd1**2*r(0)**4+1.d0-5.d0*dd1*r(0)**2)*distp(0& +& , 1)) ! indorbp=indorb - DO ic=1,6 + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (ic .LE. 3) THEN - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE + IF (ic .EQ. 1) THEN + IF (i .NE. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) END IF - ELSE IF (ic .EQ. 4) THEN + ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) ELSE IF (i .EQ. 2) THEN @@ -9592,91 +9500,95 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 2) THEN + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 3) THEN + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) END IF - ELSE IF (ic .EQ. 6) THEN - IF (i .EQ. 1) THEN + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO -!endif for ic -!enddo for i - IF (ic .LE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=6,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 2) THEN - temp314b1 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 6.d0*temp314b1 - fun2b = fun2b + temp314b1 - distpb(0, 1) = distpb(0, 1) + 2.d0*zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - ELSE - temp314b2 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 6.d0*temp314b2 - fun2b = fun2b + temp314b2 - zb(indorbp, indt+4) = 0.0_8 - END IF + DO ic=5,1,-1 + temp183 = fun/r(0) + temp184b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp183b3 = 6.d0*temp184b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp183+fun2)*zb(& +& indorbp, indt+4) + funb0 = funb0 + temp183b3 + rb(0) = rb(0) - temp183*temp183b3 + fun2b = fun2b + temp184b + zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 7) THEN - IF (branch .LT. 4) THEN + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN - IF (.NOT.branch .LT. 2) THEN - rmub(i, 0) = rmub(i, 0) + 2.d0*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + 2.d0*rmu(i, 0)*zb(indorbp, indt+i) + IF (branch .LT. 2) THEN + temp183b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp183b + fun0b = fun0b + rmu(i, 0)*temp183b + ELSE + temp183b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp183b0 + fun0b = fun0b + rmu(i, 0)*temp183b0 END IF + ELSE IF (branch .LT. 4) THEN + temp183b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp183b1 + fun0b = fun0b + rmu(i, 0)*temp183b1 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp183b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp183b2 + fun0b = fun0b + rmu(i, 0)*temp183b2 ELSE rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 6) THEN - IF (.NOT.branch .LT. 5) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - ELSE - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 10) THEN - IF (branch .LT. 9) THEN - IF (.NOT.branch .LT. 8) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 12) THEN - IF (branch .LT. 11) THEN + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF @@ -9684,321 +9596,294 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp314b0 = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & + temp182 = fun/r(0) + temp182b = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp182*rmu(i, 0)*zb(& +& indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp182*distp(0, 3+ic)*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp314b0 - funb = funb + rmu(i, 0)*temp314b0 + funb0 = funb0 + temp182b + rb(0) = rb(0) - temp182*temp182b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp314b = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp314b - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp314b - distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + temp181 = r(0)**4 + temp181b5 = -(2.d0*distp(0, 1)*fun2b) + temp181b6 = 2.d0*r(0)*distp(0, 1)*funb0 + dd1b = r(0)**2*temp181b6 + (2.d0*temp181*2*dd1-5.d0*r(0)**2)*& +& temp181b5 + temp181b7 = 2.d0*(dd1*r(0)**2-1.d0)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp181b6 + distp(0, 1)*temp181b7 + (& +& 2.d0*dd1**2*4*r(0)**3-5.d0*dd1*2*r(0))*temp181b5 + distpb(0, 1) = distpb(0, 1) + r(0)*temp181b7 - 2.d0*(2.d0*(dd1**2*& +& temp181)-5.d0*(dd1*r(0)**2)+1.d0)*fun2b + distpb(0, 3) = distpb(0, 3) + fun0b ELSE distpb = 0.0_8 + dd1b = 0.0_8 END IF - DO ic=6,1,-1 - DO k=0,0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) - zb(indorbp, k) = 0.0_8 + DO ic=5,1,-1 + DO i=0,0,-1 + distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 7) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + distpb(i, 8) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) distpb(i, 7) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 6) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 6) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 5) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 - rmub(3, i) = rmub(3, i) + 2*rmu(3, i)*distpb(i, 4) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - rmub(2, i) = rmub(2, i) + 2*rmu(2, i)*distpb(i, 3) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + rb(i) = rb(i) - distp(i, 1)*2*r(i)*distpb(i, 3) + distpb(i, 1) = distpb(i, 1) - r(i)**2*distpb(i, 3) distpb(i, 3) = 0.0_8 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*distpb(i, 2) - distpb(i, 2) = 0.0_8 END DO - dd1b = 0.0_8 + DO k=0,0,-1 + temp181b4 = DEXP(-(dd1*r(k)**2))*distpb(k, 1) + dd1b = dd1b - r(k)**2*temp181b4 + rb(k) = rb(k) - dd1*2*r(k)*temp181b4 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (12) +! R(r)=r**3*exp(-z1*r) +! +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 + c = dd1**4.5d0*.03178848180059307346d0 +! endif + DO k=0,0 + distp(k, 1) = c*DEXP(-(dd1*r(k))) + END DO + IF (typec .NE. 1) THEN + rp1 = r(0)**3 + rp2 = r(0)**2 +! +!c the first derivative + fun = distp(0, 1)*(3.d0*rp2-dd1*rp1) +!c +!c the second derivative + temp185b = 2.d0*zb(indorbp, indt+4)/r(0) + funb0 = temp185b + rb(0) = rb(0) - fun*temp185b/r(0) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + temp184 = fun/r(0) + temp184b3 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(i, 0) = rmub(i, 0) + temp184*zb(indorbp, indt+i) + funb0 = funb0 + temp184b3 + rb(0) = rb(0) - temp184*temp184b3 + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp184b1 = distp(0, 1)*fun2b + distpb(0, 1) = (3.d0*rp2-dd1*rp1)*funb0 + (6.d0*r(0)-6.d0*(dd1*rp2& +& )+dd1**2*rp1)*fun2b + temp184b2 = distp(0, 1)*funb0 + rp2b = 3.d0*temp184b2 - 6.d0*dd1*temp184b1 + rp1b = dd1**2*temp184b1 - dd1*temp184b2 + rb(0) = rb(0) + 2*r(0)*rp2b + 3*r(0)**2*rp1b + 6.d0*temp184b1 + dd1b = (rp1*2*dd1-6.d0*rp2)*temp184b1 - rp1*temp184b2 + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + END IF + DO i=0,0,-1 + distpb(i, 1) = distpb(i, 1) + r(i)**3*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*3*r(i)**2*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO cb = 0.0_8 DO k=0,0,-1 - temp313 = r(k)**2 - temp313b7 = c*DEXP(-(dd1*temp313))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp313))*distpb(k, 1) - dd1b = dd1b - temp313*temp313b7 - rb(k) = rb(k) - dd1*2*r(k)*temp313b7 + temp184b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp184b0 + rb(k) = rb(k) - dd1*temp184b0 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 1.64592278064948967213d0*1.75d0*dd1**0.75D0*cb - ddb(indparp) = ddb(indparp) + dd1b - CASE (48) -! f single gaussian orbital -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) - c = dd1**2.25d0*1.47215808929909374563d0 -! endif + dd1b = dd1b + .03178848180059307346d0*4.5d0*dd1**3.5D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (1000:1099) +! +! 4s double zeta +! s gaussian r**(2*npower)*exp(-alpha*r**2) + npower = iopt - 1000 + indorbp = indorb + 1 + dd2 = dd(indpar+1) DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + distp(k, 1) = r(k)**(2*npower)*DEXP(-(dd2*r(k)**2)) END DO - DO i=0,0 - distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) -! lz=0 - distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) -! lz=+/-2 - distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) -! lz=+/-2 - distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) -! lz=+/-3 - distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) +! endif + IF (typec .NE. 1) THEN + rp1 = r(0)**2 + fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp188 = distp(0, 1)/rp1 + temp189b = 2.d0*temp188*fun2b + temp189b0 = -((npower*4.d0+1.d0)*temp189b) + temp188b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& +& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 + temp187 = distp(0, 1)/rp1 + temp188b0 = 2.d0*temp187*funb0 + dd2b = rp1*temp189b0 - rp1*temp188b0 + 2.d0*rp1**2*2*dd2*temp189b + temp187b = 2.d0*(npower-dd2*rp1)*funb0/rp1 + rp1b = dd2*temp189b0 - temp187*temp187b - temp188*temp188b - dd2*& +& temp188b0 + 2.d0*dd2**2*2*rp1*temp189b + distpb(0, 1) = temp187b + temp188b + rb(0) = rb(0) + 2*r(0)*rp1b + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO i=0,0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO -! lz=+/-3 - DO ic=1,7 + DO k=0,0,-1 + temp186 = r(k)**2 + temp185 = 2*npower + temp185b0 = r(k)**temp185*DEXP(-(dd2*temp186))*distpb(k, 1) + IF (r(k) .LE. 0.0 .AND. (temp185 .EQ. 0.0 .OR. temp185 .NE. INT(& +& temp185))) THEN + rb(k) = rb(k) - dd2*2*r(k)*temp185b0 + ELSE + rb(k) = rb(k) + DEXP(-(dd2*temp186))*temp185*r(k)**(temp185-1)*& +& distpb(k, 1) - dd2*2*r(k)*temp185b0 + END IF + dd2b = dd2b - temp186*temp185b0 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (144) +! 2p single exponential -r^3 e^{-z r} ! derivative of 130 + dd2 = dd(indpar+1) + DO k=0,0 + distp(k, 1) = -DEXP(-(dd2*r(k))) + END DO +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO ! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1) - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) + fun = distp(0, 1)*(3.d0-dd2*r(0))*r(0) +! fun= derivative of fun0 respect to r divided dy r + fun2 = distp(0, 1)*(dd2**2*r(0)**3-6*dd2*r(0)**2+6*r(0)) +! fun2= second derivative of fun0 respect to r ! indorbp=indorb - DO ic=1,7 + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - IF (ic .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) - ELSE IF (ic .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (ic .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE IF (ic .EQ. 4) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (ic .EQ. 5) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - ELSE IF (ic .EQ. 6) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - END IF + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=7,1,-1 - temp315b28 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 8.d0*temp315b28 - fun2b = fun2b + temp315b28 + DO ic=3,1,-1 + temp190b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp190b0 + fun2b = fun2b + temp190b0 zb(indorbp, indt+4) = 0.0_8 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 4) THEN - IF (branch .LT. 2) THEN - IF (branch .LT. 1) THEN - temp315b9 = cost1f*zb(indorbp, indt+3) - temp315b10 = -(cost1f*6.d0*zb(indorbp, indt+2)) - temp315b11 = -(cost1f*6.d0*zb(indorbp, indt+1)) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp315b10 + rmu(3, 0)& -& *rmu(1, 0)*temp315b11 + (9.d0*rmu(3, 0)**2-3.d0*r(0)**2)& -& *temp315b9 - rmub(3, 0) = rmub(3, 0) + fun0*9.d0*2*rmu(3, 0)*temp315b9 - rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp315b9 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp315b10 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp315b10 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp315b11 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp315b11 - ELSE - temp315b12 = cost2f*8.d0*zb(indorbp, indt+3) - temp315b13 = -(cost2f*2.d0*zb(indorbp, indt+2)) - fun0b = fun0b + rmu(1, 0)*rmu(2, 0)*temp315b13 + cost2f*(& -& 5.d0*rmu(3, 0)**2-r(0)**2-2.d0*rmu(1, 0)**2)*zb(indorbp& -& , indt+1) + rmu(1, 0)*rmu(3, 0)*temp315b12 - rmub(3, 0) = rmub(3, 0) + rmu(1, 0)*fun0*temp315b12 - rmub(1, 0) = rmub(1, 0) + fun0*rmu(3, 0)*temp315b12 - rmub(2, 0) = rmub(2, 0) + rmu(1, 0)*fun0*temp315b13 - rmub(1, 0) = rmub(1, 0) + fun0*rmu(2, 0)*temp315b13 - temp315b14 = cost2f*fun0*zb(indorbp, indt+1) - rmub(3, 0) = rmub(3, 0) + 5.d0*2*rmu(3, 0)*temp315b14 - rb(0) = rb(0) - 2*r(0)*temp315b14 - rmub(1, 0) = rmub(1, 0) - 2.d0*2*rmu(1, 0)*temp315b14 - END IF - ELSE IF (branch .LT. 3) THEN - temp315b15 = cost2f*8.d0*zb(indorbp, indt+3) - temp315b16 = -(cost2f*2.d0*zb(indorbp, indt+1)) - fun0b = fun0b + cost2f*(5.d0*rmu(3, 0)**2-r(0)**2-2.d0*rmu(2& -& , 0)**2)*zb(indorbp, indt+2) + rmu(2, 0)*rmu(1, 0)*& -& temp315b16 + rmu(2, 0)*rmu(3, 0)*temp315b15 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*fun0*temp315b15 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(3, 0)*temp315b15 - temp315b17 = cost2f*fun0*zb(indorbp, indt+2) - rmub(3, 0) = rmub(3, 0) + 5.d0*2*rmu(3, 0)*temp315b17 - rb(0) = rb(0) - 2*r(0)*temp315b17 - rmub(2, 0) = rmub(2, 0) - 2.d0*2*rmu(2, 0)*temp315b17 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp315b16 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp315b16 - ELSE - temp315b18 = cost3f*zb(indorbp, indt+3) - temp315b19 = -(cost3f*2.d0*zb(indorbp, indt+2)) - temp315b20 = cost3f*2.d0*zb(indorbp, indt+1) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp315b19 + rmu(3, 0)*& -& rmu(1, 0)*temp315b20 + (rmu(1, 0)**2-rmu(2, 0)**2)*& -& temp315b18 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp315b18 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp315b19 - fun0*2& -& *rmu(2, 0)*temp315b18 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp315b19 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp315b20 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp315b20 - END IF - ELSE IF (branch .LT. 6) THEN - IF (branch .LT. 5) THEN - temp315b21 = cost3f*2.d0*zb(indorbp, indt+3) - temp315b22 = cost3f*2.d0*zb(indorbp, indt+2) - temp315b23 = cost3f*2.d0*zb(indorbp, indt+1) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp315b22 + rmu(3, 0)*& -& rmu(2, 0)*temp315b23 + rmu(2, 0)*rmu(1, 0)*temp315b21 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp315b21 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp315b21 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp315b22 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp315b22 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp315b23 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp315b23 - ELSE - temp315b24 = -(cost4f*6.d0*zb(indorbp, indt+2)) - temp315b25 = cost4f*3.d0*zb(indorbp, indt+1) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp315b25 + rmu& -& (2, 0)*rmu(1, 0)*temp315b24 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp315b24 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp315b24 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp315b25 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp315b25 - END IF - ELSE - temp315b26 = cost4f*3.d0*zb(indorbp, indt+2) - temp315b27 = cost4f*6.d0*zb(indorbp, indt+1) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp315b27 + (rmu(1, 0)**2& -& -rmu(2, 0)**2)*temp315b26 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp315b26 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp315b26 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp315b27 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp315b27 - END IF DO i=3,1,-1 - temp315b8 = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp315b8 - funb = funb + rmu(i, 0)*temp315b8 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp190b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp190b + funb0 = funb0 + rmu(ic, 0)*temp190b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp315b7 = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp315b7 - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp315b7 - distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + distpb = 0.0_8 + temp189 = r(0)**3 + temp189b3 = distp(0, 1)*fun2b + temp189b4 = (3.d0-dd2*r(0))*funb0 + distpb(0, 1) = r(0)*temp189b4 + r(0)**3*fun0b + (dd2**2*temp189-6*& +& (dd2*r(0)**2)+6*r(0))*fun2b + temp189b5 = distp(0, 1)*r(0)*funb0 + dd2b = (temp189*2*dd2-6*r(0)**2)*temp189b3 - r(0)*temp189b5 + rb(0) = rb(0) + distp(0, 1)*temp189b4 - dd2*temp189b5 + distp(0, 1& +& )*3*r(0)**2*fun0b + (dd2**2*3*r(0)**2-6*dd2*2*r(0)+6)*temp189b3 ELSE distpb = 0.0_8 + dd2b = 0.0_8 END IF - DO ic=7,1,-1 - DO k=0,0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) - zb(indorbp, k) = 0.0_8 + DO ic=3,1,-1 + DO i=0,0,-1 + temp189b2 = r(i)**3*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp189b2 + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp189b2 + rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*3*r(i)**2*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=0,0,-1 - temp315b = cost4f*rmu(2, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 8) - 2*rmu(2, i)*temp315b - distpb(i, 8) = 0.0_8 - temp315b0 = cost4f*rmu(1, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& -& distpb(i, 7) + 2*rmu(1, i)*temp315b0 + 3.d0*2*rmu(1, i)*temp315b - rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp315b0 - distpb(i, 7) = 0.0_8 - temp315b1 = cost3f*2.d0*distpb(i, 6) - temp315b2 = rmu(2, i)*temp315b1 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp315b2 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp315b2 - rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp315b1 - distpb(i, 6) = 0.0_8 - temp315b3 = cost3f*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 5) - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp315b3 - distpb(i, 5) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 4) - 2*rmu(2, i)*temp315b3 - temp315b4 = cost2f*rmu(2, i)*distpb(i, 4) - rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp315b4 - distpb(i, 4) = 0.0_8 - temp315b5 = cost2f*rmu(1, i)*distpb(i, 3) - rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 3) - distpb(i, 3) = 0.0_8 - temp315b6 = cost1f*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - 2*r(i)*temp315b5 - 3.d0*2*r(i)*temp315b6 - 2*r(i)*& -& temp315b4 - rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& -& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp315b6 + 5.d0*2*rmu(3, i)*& -& temp315b5 - distpb(i, 2) = 0.0_8 - END DO - dd1b = 0.0_8 - cb = 0.0_8 DO k=0,0,-1 - temp314 = r(k)**2 - temp314b3 = c*DEXP(-(dd1*temp314))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp314))*distpb(k, 1) - dd1b = dd1b - temp314*temp314b3 - rb(k) = rb(k) - dd1*2*r(k)*temp314b3 + temp189b1 = -(DEXP(-(dd2*r(k)))*distpb(k, 1)) + dd2b = dd2b - r(k)*temp189b1 + rb(k) = rb(k) - dd2*temp189b1 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 1.47215808929909374563d0*2.25d0*dd1**1.25D0*cb - ddb(indparp) = ddb(indparp) + dd1b - CASE (49) -! derivative of 48 with respect to z -! f orbitals -! R(r)= c*exp(-z r^2)*(9/4/z-r^2) + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (70) +! f single Slater orbital +! R(r)= exp(-alpha r) +! normalized ! indorbp=indorb indparp = indpar + 1 dd1 = dd(indparp) ! if(iflagnorm.gt.2) then ! overall normalization -! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) - c = dd1**2.25d0*1.47215808929909374563d0 +! l = 3 +! \int d\omega Y*Y = 4 pi / (2 l + 1) +! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5 * 3**2 / 2**2 / dd1**9 +! c=1.d0/dsqrt(10.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(9.d0/2.d0)/3.d0 + c = dd1**4.5d0*0.084104417400672d0 ! endif DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + distp(k, 1) = c*DEXP(-(dd1*r(k))) END DO DO i=0,0 distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) @@ -10025,10 +9910,9 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd IF (typec .NE. 1) THEN CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) dd1 = dd(indparp) - fun0 = distp(0, 1)*(9.d0/4.d0/dd1-r(0)**2) - fun = distp(0, 1)*(2.d0*dd1*r(0)**2-13.d0/2.d0) - fun2 = distp(0, 1)*(-(4.d0*dd1**2*r(0)**4)+19.d0*dd1*r(0)**2-13.d0& -& /2.d0) + fun0 = distp(0, 1) + fun = -(dd1*distp(0, 1)/r(0)) + fun2 = dd1**2*distp(0, 1) ! indorbp=indorb DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -10091,15 +9975,15 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=7,1,-1 - temp321b23 = distp(0, 1+ic)*zb(indorbp, indt+4) + temp191b23 = distp(0, 1+ic)*zb(indorbp, indt+4) distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & & indt+4) - funb = funb + 8.d0*temp321b23 - fun2b = fun2b + temp321b23 + funb0 = funb0 + 8.d0*temp191b23 + fun2b = fun2b + temp191b23 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -10108,246 +9992,331 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd IF (branch .LT. 4) THEN IF (branch .LT. 3) THEN IF (.NOT.branch .LT. 2) THEN - temp321b2 = cost1f*zb(indorbp, indt+i) + temp191b2 = cost1f*zb(indorbp, indt+i) fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& -& temp321b2 +& temp191b2 rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& -& temp321b2 - rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp321b2 +& temp191b2 + rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp191b2 END IF - temp321b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) - temp321b1 = rmu(i, 0)*temp321b0 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp321b0 - fun0b = fun0b + rmu(3, 0)*temp321b1 - rmub(3, 0) = rmub(3, 0) + fun0*temp321b1 - GOTO 120 + temp191b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) + temp191b1 = rmu(i, 0)*temp191b0 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp191b0 + fun0b = fun0b + rmu(3, 0)*temp191b1 + rmub(3, 0) = rmub(3, 0) + fun0*temp191b1 + GOTO 110 ELSE - temp321b5 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp321b5 + temp191b5 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp191b5 rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp321b5 - rb(0) = rb(0) - fun0*2*r(0)*temp321b5 +& temp191b5 + rb(0) = rb(0) - fun0*2*r(0)*temp191b5 END IF ELSE IF (.NOT.branch .LT. 5) THEN - temp321b6 = cost2f*10.d0*zb(indorbp, indt+i) - temp321b7 = rmu(i, 0)*temp321b6 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp321b6 - fun0b = fun0b + rmu(1, 0)*temp321b7 - rmub(1, 0) = rmub(1, 0) + fun0*temp321b7 + temp191b6 = cost2f*10.d0*zb(indorbp, indt+i) + temp191b7 = rmu(i, 0)*temp191b6 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp191b6 + fun0b = fun0b + rmu(1, 0)*temp191b7 + rmub(1, 0) = rmub(1, 0) + fun0*temp191b7 END IF - temp321b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp321b4 = rmu(i, 0)*temp321b3 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp321b3 - fun0b = fun0b + rmu(1, 0)*temp321b4 - rmub(1, 0) = rmub(1, 0) + fun0*temp321b4 + temp191b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp191b4 = rmu(i, 0)*temp191b3 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp191b3 + fun0b = fun0b + rmu(1, 0)*temp191b4 + rmub(1, 0) = rmub(1, 0) + fun0*temp191b4 ELSE IF (branch .LT. 9) THEN IF (branch .LT. 8) THEN IF (branch .LT. 7) THEN - temp321b10 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp321b10 + temp191b10 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp191b10 rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp321b10 - rb(0) = rb(0) - fun0*2*r(0)*temp321b10 +& temp191b10 + rb(0) = rb(0) - fun0*2*r(0)*temp191b10 END IF ELSE - temp321b11 = cost2f*10.d0*zb(indorbp, indt+i) - temp321b12 = rmu(i, 0)*temp321b11 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp321b11 - fun0b = fun0b + rmu(2, 0)*temp321b12 - rmub(2, 0) = rmub(2, 0) + fun0*temp321b12 + temp191b11 = cost2f*10.d0*zb(indorbp, indt+i) + temp191b12 = rmu(i, 0)*temp191b11 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp191b11 + fun0b = fun0b + rmu(2, 0)*temp191b12 + rmub(2, 0) = rmub(2, 0) + fun0*temp191b12 END IF - temp321b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp321b9 = rmu(i, 0)*temp321b8 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp321b8 - fun0b = fun0b + rmu(2, 0)*temp321b9 - rmub(2, 0) = rmub(2, 0) + fun0*temp321b9 + temp191b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp191b9 = rmu(i, 0)*temp191b8 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp191b8 + fun0b = fun0b + rmu(2, 0)*temp191b9 + rmub(2, 0) = rmub(2, 0) + fun0*temp191b9 ELSE IF (branch .LT. 10) THEN - temp321b13 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp321b13 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp321b13 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp321b13 + temp191b13 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp191b13 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp191b13 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp191b13 ELSE - temp321b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp321b14 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp321b14 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp321b14 + temp191b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp191b14 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp191b14 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp191b14 END IF ELSE IF (branch .LT. 16) THEN IF (branch .LT. 14) THEN IF (branch .LT. 13) THEN IF (branch .LT. 12) THEN - temp321b15 = cost3f*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp321b15 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp321b15 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp321b15 + temp191b15 = cost3f*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp191b15 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp191b15 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp191b15 ELSE - temp321b16 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp321b16 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp321b16 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp321b16 + temp191b16 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp191b16 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp191b16 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp191b16 END IF ELSE - temp321b17 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp321b17 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp321b17 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp321b17 + temp191b17 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp191b17 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp191b17 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp191b17 END IF ELSE IF (branch .LT. 15) THEN - temp321b18 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp321b18 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp321b18 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp321b18 + temp191b18 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp191b18 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp191b18 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp191b18 ELSE - temp321b19 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp321b19 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp321b19 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp321b19 + temp191b19 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp191b19 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp191b19 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp191b19 END IF ELSE IF (branch .LT. 19) THEN IF (branch .LT. 18) THEN IF (.NOT.branch .LT. 17) THEN - temp321b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp321b20 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp321b20 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp321b20 + temp191b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp191b20 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp191b20 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp191b20 END IF ELSE - temp321b21 = cost4f*6.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp321b21 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp321b21 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp321b21 + temp191b21 = cost4f*6.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp191b21 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp191b21 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp191b21 END IF ELSE IF (.NOT.branch .LT. 20) THEN - temp321b22 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp321b22 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp321b22 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp321b22 + temp191b22 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp191b22 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp191b22 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp191b22 END IF - 120 temp321b = distp(0, 1+ic)*zb(indorbp, indt+i) + 110 temp191b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp321b - funb = funb + rmu(i, 0)*temp321b + rmub(i, 0) = rmub(i, 0) + fun*temp191b + funb0 = funb0 + rmu(i, 0)*temp191b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp320 = r(0)**4 - temp320b = distp(0, 1)*fun2b - temp319 = 4.d0*dd1 - temp318 = 9.d0/temp319 - distpb(0, 1) = distpb(0, 1) + (2.d0*(dd1*r(0)**2)-13.d0/2.d0)*funb& -& + (temp318-r(0)**2)*fun0b + (19.d0*(dd1*r(0)**2)-13.d0/2.d0-4.d0& -& *(dd1**2*temp320))*fun2b - temp320b0 = distp(0, 1)*2.d0*funb - dd1b = r(0)**2*temp320b0 - distp(0, 1)*temp318*4.d0*fun0b/temp319 & -& + (19.d0*r(0)**2-4.d0*temp320*2*dd1)*temp320b - rb(0) = rb(0) + dd1*2*r(0)*temp320b0 - distp(0, 1)*2*r(0)*fun0b + & -& (19.d0*dd1*2*r(0)-4.d0*dd1**2*4*r(0)**3)*temp320b + temp190b10 = -(distp(0, 1)*funb0/r(0)) + dd1b = temp190b10 + distp(0, 1)*2*dd1*fun2b + temp190 = dd1/r(0) + distpb(0, 1) = distpb(0, 1) + fun0b - temp190*funb0 + dd1**2*fun2b + rb(0) = rb(0) - temp190*temp190b10 CALL POPREAL8(adr8ibuf,adr8buf,dd1) ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 END IF - dd1b = 0.0_8 DO ic=7,1,-1 DO k=0,0,-1 - temp318b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) - temp317 = 4.d0*dd1 - temp316 = 9.d0/temp317 - temp316b7 = (temp316-r(k)**2)*zb(indorbp, k) - dd1b = dd1b - temp316*4.d0*temp318b/temp317 - rb(k) = rb(k) - 2*r(k)*temp318b - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp316b7 - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp316b7 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - temp316b = cost4f*rmu(2, i)*distpb(i, 8) + temp190b2 = cost4f*rmu(2, i)*distpb(i, 8) rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 8) - 2*rmu(2, i)*temp316b +& distpb(i, 8) - 2*rmu(2, i)*temp190b2 distpb(i, 8) = 0.0_8 - temp316b0 = cost4f*rmu(1, i)*distpb(i, 7) + temp190b3 = cost4f*rmu(1, i)*distpb(i, 7) rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& -& distpb(i, 7) + 2*rmu(1, i)*temp316b0 + 3.d0*2*rmu(1, i)*temp316b - rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp316b0 +& distpb(i, 7) + 2*rmu(1, i)*temp190b3 + 3.d0*2*rmu(1, i)*& +& temp190b2 + rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp190b3 distpb(i, 7) = 0.0_8 - temp316b1 = cost3f*2.d0*distpb(i, 6) - temp316b2 = rmu(2, i)*temp316b1 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp316b2 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp316b2 - rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp316b1 + temp190b4 = cost3f*2.d0*distpb(i, 6) + temp190b5 = rmu(2, i)*temp190b4 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp190b5 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp190b5 + rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp190b4 distpb(i, 6) = 0.0_8 - temp316b3 = cost3f*rmu(3, i)*distpb(i, 5) + temp190b6 = cost3f*rmu(3, i)*distpb(i, 5) rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& & distpb(i, 5) - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp316b3 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp190b6 distpb(i, 5) = 0.0_8 rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 4) - 2*rmu(2, i)*temp316b3 - temp316b4 = cost2f*rmu(2, i)*distpb(i, 4) - rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp316b4 +& distpb(i, 4) - 2*rmu(2, i)*temp190b6 + temp190b7 = cost2f*rmu(2, i)*distpb(i, 4) + rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp190b7 distpb(i, 4) = 0.0_8 - temp316b5 = cost2f*rmu(1, i)*distpb(i, 3) + temp190b8 = cost2f*rmu(1, i)*distpb(i, 3) rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& & distpb(i, 3) distpb(i, 3) = 0.0_8 - temp316b6 = cost1f*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - 2*r(i)*temp316b5 - 3.d0*2*r(i)*temp316b6 - 2*r(i)*& -& temp316b4 + temp190b9 = cost1f*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - 2*r(i)*temp190b8 - 3.d0*2*r(i)*temp190b9 - 2*r(i)*& +& temp190b7 rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& -& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp316b6 + 5.d0*2*rmu(3, i)*& -& temp316b5 +& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp190b9 + 5.d0*2*rmu(3, i)*& +& temp190b8 distpb(i, 2) = 0.0_8 END DO + dd1b = 0.0_8 cb = 0.0_8 DO k=0,0,-1 - temp315 = r(k)**2 - temp315b29 = c*DEXP(-(dd1*temp315))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp315))*distpb(k, 1) - dd1b = dd1b - temp315*temp315b29 - rb(k) = rb(k) - dd1*2*r(k)*temp315b29 + temp190b1 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp190b1 + rb(k) = rb(k) - dd1*temp190b1 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 1.47215808929909374563d0*2.25d0*dd1**1.25D0*cb + dd1b = dd1b + 0.084104417400672d0*4.5d0*dd1**3.5D0*cb ddb(indparp) = ddb(indparp) + dd1b - CASE (70) -! f single Slater orbital -! R(r)= exp(-alpha r) + CASE (100) +! 2s single gaussian +! exp(-dd2*r^2) + dd2 = dd(indpar+1) + indorbp = indorb + 1 + DO k=0,0 + distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) + END DO +! endif + IF (typec .NE. 1) THEN + fun = -(dd2*distp(0, 1)*2.d0) + distpb = 0.0_8 + temp191b25 = 2.d0**2*dd2*distp(0, 1)*zb(indorbp, indt+4) + temp191b26 = 2.d0*(2.d0*(dd2*r(0)**2)-3.d0)*zb(indorbp, indt+4) + dd2b = distp(0, 1)*temp191b26 + r(0)**2*temp191b25 + rb(0) = rb(0) + dd2*2*r(0)*temp191b25 + distpb(0, 1) = dd2*temp191b26 + zb(indorbp, indt+4) = 0.0_8 + funb0 = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + dd2b = dd2b - 2.d0*distp(0, 1)*funb0 + distpb(0, 1) = distpb(0, 1) - 2.d0*dd2*funb0 + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO i=0,0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + DO k=0,0,-1 + temp191b24 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp191b24 + rb(k) = rb(k) - dd2*2*r(k)*temp191b24 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (138) +! 2s with cusp condition +! ( -dd2*r^2*exp(-dd2*r)) ! with no cusp condition der of 137 + dd2 = dd(indpar+1) + indorbp = indorb + 1 + DO k=0,0 + distp(k, 1) = -(dd2*DEXP(-(dd2*r(k)))) + END DO +! endif + IF (typec .NE. 1) THEN + fun = (2.d0-dd2*r(0))*distp(0, 1) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp191b28 = distp(0, 1)*fun2b + temp191b29 = 2*dd2*r(0)*temp191b28 + dd2b = r(0)*temp191b29 - 4*r(0)*temp191b28 - distp(0, 1)*r(0)*& +& funb0 + rb(0) = rb(0) + dd2*temp191b29 - 4*dd2*temp191b28 - distp(0, 1)*& +& dd2*funb0 + distpb(0, 1) = (2.d0-dd2*r(0))*funb0 + ((dd2*r(0))**2-4*(dd2*r(0))& +& +2.d0)*fun2b + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO i=0,0,-1 + distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + DO k=0,0,-1 + temp191b27 = -(dd2*DEXP(-(dd2*r(k)))*distpb(k, 1)) + dd2b = dd2b - r(k)*temp191b27 - DEXP(-(dd2*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd2*temp191b27 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (56) +! g single Slater orbital derivative of 55 +! R(r)= (11.d0/2.0 1/dd1 - r) * exp(-alpha r) ! normalized ! indorbp=indorb indparp = indpar + 1 dd1 = dd(indparp) ! if(iflagnorm.gt.2) then ! overall normalization -! l = 3 +! l = 4 ! \int d\omega Y*Y = 4 pi / (2 l + 1) -! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5 * 3**2 / 2**2 / dd1**9 -! c=1.d0/dsqrt(10.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(9.d0/2.d0)/3.d0 - c = dd1**4.5d0*0.084104417400672d0 +! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5**2 * 3**4 / 2**3 / dd1**11 + c = dd1**5.5d0*.020104801169736915d0 +! c=1.d0/dsqrt(7.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(11.d0/2.d0)/3.d0/5.d0 ! endif DO k=0,0 distp(k, 1) = c*DEXP(-(dd1*r(k))) END DO DO i=0,0 - distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) + distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& +& 2+3.d0*r(i)**4) ! lz=0 - distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) + distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) ! lz=+/-1 - distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) + distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) ! lz=+/-1 - distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) + distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& +& 2-r(i)**2) ! lz=+/-2 - distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) + distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& +& (i)**2) ! lz=+/-2 - distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) + distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & +& i)**2) ! lz=+/-3 - distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) - END DO + distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& +& , i)**2) ! lz=+/-3 - DO ic=1,7 + distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& +& rmu(2, i)**4) +! lz=+/-4 + distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& +& , i)**2) + END DO +! lz=+/-4 + DO ic=1,9 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic @@ -10356,297 +10325,542 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd IF (typec .NE. 1) THEN CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) dd1 = dd(indparp) - fun0 = distp(0, 1) - fun = -(dd1*distp(0, 1)/r(0)) - fun2 = dd1**2*distp(0, 1) + fun0 = distp(0, 1)*(11.d0/2.d0/dd1-r(0)) + fun = distp(0, 1)*(dd1-13.d0/2.d0/r(0)) + fun2 = dd1*distp(0, 1)*(15.d0/2.d0-dd1*r(0)) ! indorbp=indorb - DO ic=1,7 + DO ic=1,9 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN - IF (i .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) END IF ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) END IF ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) END IF ELSE IF (ic .EQ. 4) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) END IF ELSE IF (ic .EQ. 6) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + END IF + ELSE IF (ic .EQ. 7) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,21) + END IF + ELSE IF (ic .EQ. 8) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,22) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,24) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,23) + END IF + ELSE IF (ic .EQ. 9) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,26) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,28) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,27) END IF - ELSE IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,25) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=7,1,-1 - temp322b23 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 8.d0*temp322b23 - fun2b = fun2b + temp322b23 + DO ic=9,1,-1 + temp197b57 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 10.d0*temp197b57 + fun2b = fun2b + temp197b57 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 11) THEN - IF (branch .LT. 6) THEN - IF (branch .LT. 4) THEN + IF (branch .LT. 15) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN - IF (.NOT.branch .LT. 2) THEN - temp322b2 = cost1f*zb(indorbp, indt+i) - fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& -& temp322b2 - rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& -& temp322b2 - rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp322b2 + IF (branch .LT. 2) THEN + temp197b2 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& +& 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& +& ) + rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& +& , 0)**2)*temp197b2 + rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp197b2 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& +& )*temp197b2 + ELSE + temp197b3 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& +& 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& +& ) + rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& +& , 0)**2)*temp197b3 + rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp197b3 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& +& )*temp197b3 END IF - temp322b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) - temp322b1 = rmu(i, 0)*temp322b0 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp322b0 - fun0b = fun0b + rmu(3, 0)*temp322b1 - rmub(3, 0) = rmub(3, 0) + fun0*temp322b1 - GOTO 130 + ELSE IF (branch .LT. 4) THEN + temp197b4 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& +& 3, 0)*r(0)**2))*zb(indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& +& r(0)**2)*temp197b4 + rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp197b4 ELSE - temp322b5 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp322b5 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp322b5 - rb(0) = rb(0) - fun0*2*r(0)*temp322b5 + temp197b5 = cost2g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& +& , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& +& (indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& +& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp197b5 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp197b5 + rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp197b5 END IF - ELSE IF (.NOT.branch .LT. 5) THEN - temp322b6 = cost2f*10.d0*zb(indorbp, indt+i) - temp322b7 = rmu(i, 0)*temp322b6 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp322b6 - fun0b = fun0b + rmu(1, 0)*temp322b7 - rmub(1, 0) = rmub(1, 0) + fun0*temp322b7 + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp197b6 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp197b7 = rmu(2, 0)*rmu(3, 0)*temp197b6 + temp197b8 = fun0*rmu(1, 0)*temp197b6 + fun0b = fun0b + rmu(1, 0)*temp197b7 + rmub(1, 0) = rmub(1, 0) + fun0*temp197b7 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp197b8 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp197b8 + ELSE + temp197b9 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp197b10 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& +& **2)*temp197b9 + temp197b11 = fun0*rmu(1, 0)*temp197b9 + fun0b = fun0b + rmu(1, 0)*temp197b10 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp197b11 + & +& fun0*temp197b10 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp197b11 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp197b11 + END IF + ELSE + temp197b12 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp197b13 = rmu(2, 0)*rmu(3, 0)*temp197b12 + temp197b14 = fun0*rmu(1, 0)*temp197b12 + fun0b = fun0b + rmu(1, 0)*temp197b13 + rmub(1, 0) = rmub(1, 0) + fun0*temp197b13 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp197b14 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp197b14 END IF - temp322b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp322b4 = rmu(i, 0)*temp322b3 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp322b3 - fun0b = fun0b + rmu(1, 0)*temp322b4 - rmub(1, 0) = rmub(1, 0) + fun0*temp322b4 - ELSE IF (branch .LT. 9) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 7) THEN - temp322b10 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp322b10 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp322b10 - rb(0) = rb(0) - fun0*2*r(0)*temp322b10 + ELSE IF (branch .LT. 12) THEN + IF (branch .LT. 10) THEN + IF (branch .LT. 9) THEN + temp197b15 = cost2g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& +& , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& +& (indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& +& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp197b15 + rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp197b15 + rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp197b15 + ELSE + temp197b16 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp197b17 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& +& **2)*temp197b16 + temp197b18 = fun0*rmu(2, 0)*temp197b16 + fun0b = fun0b + rmu(2, 0)*temp197b17 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp197b18 + & +& fun0*temp197b17 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp197b18 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp197b18 END IF + ELSE IF (branch .LT. 11) THEN + temp197b19 = -(cost3g*4.d0*zb(indorbp, indt+i)) + temp197b20 = fun0*temp197b19 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& +& **2))*temp197b19 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& +& **2)*temp197b20 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& +& temp197b20 ELSE - temp322b11 = cost2f*10.d0*zb(indorbp, indt+i) - temp322b12 = rmu(i, 0)*temp322b11 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp322b11 - fun0b = fun0b + rmu(2, 0)*temp322b12 - rmub(2, 0) = rmub(2, 0) + fun0*temp322b12 + temp197b21 = cost3g*4.d0*zb(indorbp, indt+i) + temp197b22 = fun0*temp197b21 + fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& +& **2))*temp197b21 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& +& **2)*temp197b22 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& +& temp197b22 + END IF + ELSE IF (branch .LT. 14) THEN + IF (branch .LT. 13) THEN + temp197b23 = cost3g*12.d0*zb(indorbp, indt+i) + temp197b24 = fun0*rmu(3, 0)*temp197b23 + temp197b25 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp197b23 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp197b24 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp197b24 + fun0b = fun0b + rmu(3, 0)*temp197b25 + rmub(3, 0) = rmub(3, 0) + fun0*temp197b25 + ELSE + temp197b26 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp197b27 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3& +& , 0)**2)*temp197b26 + temp197b28 = fun0*rmu(2, 0)*temp197b26 + fun0b = fun0b + rmu(2, 0)*temp197b27 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp197b28 + fun0*& +& temp197b27 + rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp197b28 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp197b28 END IF - temp322b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp322b9 = rmu(i, 0)*temp322b8 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp322b8 - fun0b = fun0b + rmu(2, 0)*temp322b9 - rmub(2, 0) = rmub(2, 0) + fun0*temp322b9 - ELSE IF (branch .LT. 10) THEN - temp322b13 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp322b13 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp322b13 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp322b13 ELSE - temp322b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp322b14 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp322b14 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp322b14 + temp197b29 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp197b30 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0& +& )**2)*temp197b29 + temp197b31 = fun0*rmu(1, 0)*temp197b29 + fun0b = fun0b + rmu(1, 0)*temp197b30 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp197b31 + fun0*& +& temp197b30 + rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp197b31 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp197b31 END IF - ELSE IF (branch .LT. 16) THEN - IF (branch .LT. 14) THEN - IF (branch .LT. 13) THEN - IF (branch .LT. 12) THEN - temp322b15 = cost3f*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp322b15 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp322b15 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp322b15 + ELSE IF (branch .LT. 22) THEN + IF (branch .LT. 19) THEN + IF (branch .LT. 17) THEN + IF (branch .LT. 16) THEN + temp197b32 = cost3g*24.d0*zb(indorbp, indt+i) + temp197b33 = rmu(2, 0)*rmu(3, 0)*temp197b32 + temp197b34 = fun0*rmu(1, 0)*temp197b32 + fun0b = fun0b + rmu(1, 0)*temp197b33 + rmub(1, 0) = rmub(1, 0) + fun0*temp197b33 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp197b34 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp197b34 ELSE - temp322b16 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp322b16 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp322b16 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp322b16 + temp197b35 = cost4g*3.d0*zb(indorbp, indt+i) + temp197b36 = fun0*rmu(3, 0)*temp197b35 + temp197b37 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp197b35 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp197b36 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp197b36 + fun0b = fun0b + rmu(3, 0)*temp197b37 + rmub(3, 0) = rmub(3, 0) + fun0*temp197b37 END IF + ELSE IF (branch .LT. 18) THEN + temp197b38 = -(cost4g*6.d0*zb(indorbp, indt+i)) + temp197b39 = rmu(2, 0)*rmu(3, 0)*temp197b38 + temp197b40 = fun0*rmu(1, 0)*temp197b38 + fun0b = fun0b + rmu(1, 0)*temp197b39 + rmub(1, 0) = rmub(1, 0) + fun0*temp197b39 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp197b40 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp197b40 + ELSE + temp197b41 = cost4g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& +& (2, 0)**2))*zb(indorbp, indt+i) + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& +& **2)*temp197b41 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp197b41 + END IF + ELSE IF (branch .LT. 21) THEN + IF (branch .LT. 20) THEN + temp197b42 = cost4g*6.d0*zb(indorbp, indt+i) + temp197b43 = rmu(2, 0)*rmu(3, 0)*temp197b42 + temp197b44 = fun0*rmu(1, 0)*temp197b42 + fun0b = fun0b + rmu(1, 0)*temp197b43 + rmub(1, 0) = rmub(1, 0) + fun0*temp197b43 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp197b44 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp197b44 ELSE - temp322b17 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp322b17 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp322b17 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp322b17 + temp197b45 = cost4g*3.d0*zb(indorbp, indt+i) + temp197b46 = fun0*rmu(3, 0)*temp197b45 + temp197b47 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp197b45 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp197b46 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp197b46 + fun0b = fun0b + rmu(3, 0)*temp197b47 + rmub(3, 0) = rmub(3, 0) + fun0*temp197b47 END IF - ELSE IF (branch .LT. 15) THEN - temp322b18 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp322b18 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp322b18 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp322b18 ELSE - temp322b19 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp322b19 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp322b19 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp322b19 + temp197b48 = cost4g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& +& 2, 0)**3)*zb(indorbp, indt+i) + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp197b48 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& +& 2)*temp197b48 END IF - ELSE IF (branch .LT. 19) THEN - IF (branch .LT. 18) THEN - IF (.NOT.branch .LT. 17) THEN - temp322b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp322b20 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp322b20 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp322b20 + ELSE IF (branch .LT. 26) THEN + IF (branch .LT. 24) THEN + IF (branch .LT. 23) THEN + temp197b49 = cost5g*4.d0*zb(indorbp, indt+i) + temp197b50 = fun0*temp197b49 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& +& **2))*temp197b49 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& +& **2)*temp197b50 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp197b50 END IF - ELSE - temp322b21 = cost4f*6.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp322b21 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp322b21 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp322b21 + ELSE IF (branch .LT. 25) THEN + temp197b51 = cost5g*4.d0*zb(indorbp, indt+i) + temp197b52 = fun0*temp197b51 + fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& +& ))*temp197b51 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& +& 2)*temp197b52 + rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp197b52 END IF - ELSE IF (.NOT.branch .LT. 20) THEN - temp322b22 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp322b22 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp322b22 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp322b22 + ELSE IF (branch .LT. 28) THEN + IF (branch .LT. 27) THEN + temp197b53 = cost5g*4.d0*zb(indorbp, indt+i) + temp197b54 = fun0*temp197b53 + fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& +& 3)*temp197b53 + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp197b54 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& +& 2)*temp197b54 + END IF + ELSE + temp197b55 = cost5g*4.d0*zb(indorbp, indt+i) + temp197b56 = fun0*temp197b55 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& +& *temp197b55 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& +& *temp197b56 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp197b56 END IF - 130 temp322b = distp(0, 1+ic)*zb(indorbp, indt+i) + temp197b1 = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp322b - funb = funb + rmu(i, 0)*temp322b + rmub(i, 0) = rmub(i, 0) + fun*temp197b1 + funb0 = funb0 + rmu(i, 0)*temp197b1 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp321b33 = -(distp(0, 1)*funb/r(0)) - dd1b = temp321b33 + distp(0, 1)*2*dd1*fun2b - temp321 = dd1/r(0) - distpb(0, 1) = distpb(0, 1) + fun0b - temp321*funb + dd1**2*fun2b - rb(0) = rb(0) - temp321*temp321b33 + temp197b = (15.d0/2.d0-dd1*r(0))*fun2b + temp197b0 = dd1*distp(0, 1)*fun2b + temp194 = 2.d0*dd1 + temp193 = 11.d0/temp194 + dd1b = distp(0, 1)*funb0 - distp(0, 1)*temp193*2.d0*fun0b/temp194 & +& - r(0)*temp197b0 + distp(0, 1)*temp197b + temp196 = 2.d0*r(0) + temp195 = 13.d0/temp196 + distpb(0, 1) = distpb(0, 1) + (dd1-temp195)*funb0 + (temp193-r(0))& +& *fun0b + dd1*temp197b + rb(0) = rb(0) + distp(0, 1)*temp195*2.d0*funb0/temp196 - distp(0, & +& 1)*fun0b - dd1*temp197b0 CALL POPREAL8(adr8ibuf,adr8buf,dd1) ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 END IF - DO ic=7,1,-1 + dd1b = 0.0_8 + DO ic=9,1,-1 DO k=0,0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + temp192 = 2.d0*dd1 + temp191 = 11.d0/temp192 + temp191b49 = (temp191-r(k))*zb(indorbp, k) + temp191b50 = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp191b49 + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp191b49 + dd1b = dd1b - temp191*2.d0*temp191b50/temp192 + rb(k) = rb(k) - temp191b50 zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - temp321b25 = cost4f*rmu(2, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 8) - 2*rmu(2, i)*temp321b25 + temp191b31 = cost5g*4.d0*distpb(i, 10) + temp191b32 = (rmu(1, i)**2-rmu(2, i)**2)*temp191b31 + temp191b33 = rmu(1, i)*rmu(2, i)*temp191b31 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp191b33 + rmu(2, i)*& +& temp191b32 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp191b32 - 2*rmu(2, i)*& +& temp191b33 + distpb(i, 10) = 0.0_8 + temp191b34 = cost5g*distpb(i, 9) + rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& +& 1, i))*temp191b34 + distpb(i, 9) = 0.0_8 + temp191b35 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) + temp191b36 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp191b35 - 2*rmu(2, i)*& +& temp191b36 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& +& temp191b34 + rmub(3, i) = rmub(3, i) + rmu(2, i)*temp191b35 distpb(i, 8) = 0.0_8 - temp321b26 = cost4f*rmu(1, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& -& distpb(i, 7) + 2*rmu(1, i)*temp321b26 + 3.d0*2*rmu(1, i)*& -& temp321b25 - rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp321b26 + temp191b37 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) + temp191b38 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp191b37 + 2*rmu(1, i)*& +& temp191b38 + 3.d0*2*rmu(1, i)*temp191b36 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp191b37 + rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp191b38 distpb(i, 7) = 0.0_8 - temp321b27 = cost3f*2.d0*distpb(i, 6) - temp321b28 = rmu(2, i)*temp321b27 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp321b28 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp321b28 - rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp321b27 + temp191b39 = cost3g*2.d0*distpb(i, 6) + temp191b40 = (7.d0*rmu(3, i)**2-r(i)**2)*temp191b39 + temp191b41 = rmu(1, i)*rmu(2, i)*temp191b39 + rmub(1, i) = rmub(1, i) + rmu(2, i)*temp191b40 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp191b40 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp191b41 distpb(i, 6) = 0.0_8 - temp321b29 = cost3f*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 5) - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp321b29 + temp191b42 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) + temp191b43 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) distpb(i, 5) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 4) - 2*rmu(2, i)*temp321b29 - temp321b30 = cost2f*rmu(2, i)*distpb(i, 4) - rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp321b30 + temp191b44 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) + temp191b45 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - temp321b31 = cost2f*rmu(1, i)*distpb(i, 3) - rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 3) + temp191b46 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) + temp191b47 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 - temp321b32 = cost1f*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - 2*r(i)*temp321b31 - 3.d0*2*r(i)*temp321b32 - 2*r(i& -& )*temp321b30 - rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& -& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp321b32 + 5.d0*2*rmu(3, i)*& -& temp321b31 + temp191b48 = cost1g*distpb(i, 2) + rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& +& temp191b48 - 3.d0*2*r(i)*temp191b47 - 2*r(i)*temp191b43 - 3.d0*2& +& *r(i)*temp191b45 - 2*r(i)*temp191b41 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp191b42 + rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp191b42 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp191b43 + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp191b44 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp191b45 + rmu(2, i)*& +& temp191b44 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp191b46 + rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& +& rmu(3, i))*temp191b48 + 7.d0*2*rmu(3, i)*temp191b47 + rmu(1, i)*& +& temp191b46 distpb(i, 2) = 0.0_8 END DO - dd1b = 0.0_8 cb = 0.0_8 DO k=0,0,-1 - temp321b24 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + temp191b30 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp321b24 - rb(k) = rb(k) - dd1*temp321b24 + dd1b = dd1b - r(k)*temp191b30 + rb(k) = rb(k) - dd1*temp191b30 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.084104417400672d0*4.5d0*dd1**3.5D0*cb + dd1b = dd1b + .020104801169736915d0*5.5d0*dd1**4.5D0*cb ddb(indparp) = ddb(indparp) + dd1b - CASE (71) -! f single Slater orbital derivative of 70 -! R(r)= (9.d0/2.0 1/dd1 - r) * exp(-alpha r) -! normalized + CASE (1) +! s orbital +! +! - angmom = 0 +! - type = Slater +! - normalized = yes +! - angtype = spherical +! - npar = 1 +! - multiplicity = 1 +! + dd1 = dd(indpar+1) + c = dd1*DSQRT(dd1)*0.56418958354775628695d0 + indorbp = indorb + 1 + DO k=0,0 + distp(k, 1) = c*DEXP(-(dd1*r(k))) + END DO + IF (typec .NE. 1) THEN + fun = -(dd1*distp(0, 1)) + distpb = 0.0_8 + temp199 = dd1/r(0) + temp199b = -(distp(0, 1)*2.d0*zb(indorbp, indt+4)/r(0)) + dd1b = temp199b + distp(0, 1)*2*dd1*zb(indorbp, indt+4) + rb(0) = rb(0) - temp199*temp199b + distpb(0, 1) = (dd1**2-2.d0*temp199)*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + funb0 = 0.0_8 + DO i=3,1,-1 + temp198 = fun/r(0) + temp198b0 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(i, 0) = rmub(i, 0) + temp198*zb(indorbp, indt+i) + funb0 = funb0 + temp198b0 + rb(0) = rb(0) - temp198*temp198b0 + zb(indorbp, indt+i) = 0.0_8 + END DO + dd1b = dd1b - distp(0, 1)*funb0 + distpb(0, 1) = distpb(0, 1) - dd1*funb0 + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + END IF + DO i=0,0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + cb = 0.0_8 + DO k=0,0,-1 + temp198b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp198b + rb(k) = rb(k) - dd1*temp198b + distpb(k, 1) = 0.0_8 + END DO + temp197 = DSQRT(dd1) + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + 0.56418958354775628695d0*temp197*cb + ELSE + dd1b = dd1b + (0.56418958354775628695d0*dd1/(2.D0*DSQRT(dd1))+& +& 0.56418958354775628695d0*temp197)*cb + END IF + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (49) +! f orbitals +! R(r)= c*exp(-z r^2)*(9/4/z-r^2) ! indorbp=indorb indparp = indpar + 1 dd1 = dd(indparp) ! if(iflagnorm.gt.2) then ! overall normalization -! l = 3 -! \int d\omega Y*Y = 4 pi / (2 l + 1) -! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5 * 3**2 / 2**2 / dd1**9 -! c=1.d0/dsqrt(10.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(9.d0/2.d0)/3.d0 - c = dd1**4.5d0*0.084104417400672d0 +! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) + c = dd1**2.25d0*1.47215808929909374563d0 ! endif DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO DO i=0,0 distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) @@ -10673,9 +10887,10 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd IF (typec .NE. 1) THEN CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) dd1 = dd(indparp) - fun0 = distp(0, 1)*(9.d0/2.d0/dd1-r(0)) - fun = distp(0, 1)*(dd1-11.d0/2.d0/r(0)) - fun2 = dd1*distp(0, 1)*(13.d0/2.d0-dd1*r(0)) + fun0 = distp(0, 1)*(9.d0/4.d0/dd1-r(0)**2) + fun = distp(0, 1)*(2.d0*dd1*r(0)**2-13.d0/2.d0) + fun2 = distp(0, 1)*(-(4.d0*dd1**2*r(0)**4)+19.d0*dd1*r(0)**2-13.d0& +& /2.d0) ! indorbp=indorb DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -10738,15 +10953,15 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=7,1,-1 - temp328b25 = distp(0, 1+ic)*zb(indorbp, indt+4) + temp206b23 = distp(0, 1+ic)*zb(indorbp, indt+4) distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & & indt+4) - funb = funb + 8.d0*temp328b25 - fun2b = fun2b + temp328b25 + funb0 = funb0 + 8.d0*temp206b23 + fun2b = fun2b + temp206b23 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -10755,142 +10970,142 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd IF (branch .LT. 4) THEN IF (branch .LT. 3) THEN IF (.NOT.branch .LT. 2) THEN - temp328b4 = cost1f*zb(indorbp, indt+i) + temp206b2 = cost1f*zb(indorbp, indt+i) fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& -& temp328b4 +& temp206b2 rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& -& temp328b4 - rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp328b4 +& temp206b2 + rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp206b2 END IF - temp328b2 = -(cost1f*6.d0*zb(indorbp, indt+i)) - temp328b3 = rmu(i, 0)*temp328b2 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp328b2 - fun0b = fun0b + rmu(3, 0)*temp328b3 - rmub(3, 0) = rmub(3, 0) + fun0*temp328b3 - GOTO 140 + temp206b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) + temp206b1 = rmu(i, 0)*temp206b0 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp206b0 + fun0b = fun0b + rmu(3, 0)*temp206b1 + rmub(3, 0) = rmub(3, 0) + fun0*temp206b1 + GOTO 120 ELSE - temp328b7 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp328b7 + temp206b5 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp206b5 rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp328b7 - rb(0) = rb(0) - fun0*2*r(0)*temp328b7 +& temp206b5 + rb(0) = rb(0) - fun0*2*r(0)*temp206b5 END IF ELSE IF (.NOT.branch .LT. 5) THEN - temp328b8 = cost2f*10.d0*zb(indorbp, indt+i) - temp328b9 = rmu(i, 0)*temp328b8 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp328b8 - fun0b = fun0b + rmu(1, 0)*temp328b9 - rmub(1, 0) = rmub(1, 0) + fun0*temp328b9 + temp206b6 = cost2f*10.d0*zb(indorbp, indt+i) + temp206b7 = rmu(i, 0)*temp206b6 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp206b6 + fun0b = fun0b + rmu(1, 0)*temp206b7 + rmub(1, 0) = rmub(1, 0) + fun0*temp206b7 END IF - temp328b5 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp328b6 = rmu(i, 0)*temp328b5 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp328b5 - fun0b = fun0b + rmu(1, 0)*temp328b6 - rmub(1, 0) = rmub(1, 0) + fun0*temp328b6 + temp206b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp206b4 = rmu(i, 0)*temp206b3 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp206b3 + fun0b = fun0b + rmu(1, 0)*temp206b4 + rmub(1, 0) = rmub(1, 0) + fun0*temp206b4 ELSE IF (branch .LT. 9) THEN IF (branch .LT. 8) THEN IF (branch .LT. 7) THEN - temp328b12 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp328b12 + temp206b10 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp206b10 rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp328b12 - rb(0) = rb(0) - fun0*2*r(0)*temp328b12 +& temp206b10 + rb(0) = rb(0) - fun0*2*r(0)*temp206b10 END IF ELSE - temp328b13 = cost2f*10.d0*zb(indorbp, indt+i) - temp328b14 = rmu(i, 0)*temp328b13 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp328b13 - fun0b = fun0b + rmu(2, 0)*temp328b14 - rmub(2, 0) = rmub(2, 0) + fun0*temp328b14 + temp206b11 = cost2f*10.d0*zb(indorbp, indt+i) + temp206b12 = rmu(i, 0)*temp206b11 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp206b11 + fun0b = fun0b + rmu(2, 0)*temp206b12 + rmub(2, 0) = rmub(2, 0) + fun0*temp206b12 END IF - temp328b10 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp328b11 = rmu(i, 0)*temp328b10 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp328b10 - fun0b = fun0b + rmu(2, 0)*temp328b11 - rmub(2, 0) = rmub(2, 0) + fun0*temp328b11 + temp206b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp206b9 = rmu(i, 0)*temp206b8 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp206b8 + fun0b = fun0b + rmu(2, 0)*temp206b9 + rmub(2, 0) = rmub(2, 0) + fun0*temp206b9 ELSE IF (branch .LT. 10) THEN - temp328b15 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp328b15 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp328b15 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp328b15 + temp206b13 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp206b13 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp206b13 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp206b13 ELSE - temp328b16 = -(cost3f*2.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp328b16 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp328b16 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp328b16 + temp206b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp206b14 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp206b14 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp206b14 END IF ELSE IF (branch .LT. 16) THEN IF (branch .LT. 14) THEN IF (branch .LT. 13) THEN IF (branch .LT. 12) THEN - temp328b17 = cost3f*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp328b17 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp328b17 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp328b17 + temp206b15 = cost3f*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp206b15 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp206b15 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp206b15 ELSE - temp328b18 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp328b18 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp328b18 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp328b18 + temp206b16 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp206b16 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp206b16 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp206b16 END IF ELSE - temp328b19 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp328b19 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp328b19 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp328b19 + temp206b17 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp206b17 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp206b17 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp206b17 END IF ELSE IF (branch .LT. 15) THEN - temp328b20 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp328b20 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp328b20 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp328b20 + temp206b18 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp206b18 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp206b18 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp206b18 ELSE - temp328b21 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp328b21 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp328b21 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp328b21 + temp206b19 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp206b19 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp206b19 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp206b19 END IF ELSE IF (branch .LT. 19) THEN IF (branch .LT. 18) THEN IF (.NOT.branch .LT. 17) THEN - temp328b22 = -(cost4f*6.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp328b22 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp328b22 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp328b22 + temp206b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp206b20 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp206b20 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp206b20 END IF ELSE - temp328b23 = cost4f*6.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp328b23 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp328b23 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp328b23 + temp206b21 = cost4f*6.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp206b21 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp206b21 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp206b21 END IF ELSE IF (.NOT.branch .LT. 20) THEN - temp328b24 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp328b24 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp328b24 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp328b24 + temp206b22 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp206b22 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp206b22 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp206b22 END IF - 140 temp328b1 = distp(0, 1+ic)*zb(indorbp, indt+i) + 120 temp206b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp328b1 - funb = funb + rmu(i, 0)*temp328b1 + rmub(i, 0) = rmub(i, 0) + fun*temp206b + funb0 = funb0 + rmu(i, 0)*temp206b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp328b = (13.d0/2.d0-dd1*r(0))*fun2b - temp328b0 = dd1*distp(0, 1)*fun2b - temp325 = 2.d0*dd1 - temp324 = 9.d0/temp325 - dd1b = distp(0, 1)*funb - distp(0, 1)*temp324*2.d0*fun0b/temp325 -& -& r(0)*temp328b0 + distp(0, 1)*temp328b - temp327 = 2.d0*r(0) - temp326 = 11.d0/temp327 - distpb(0, 1) = distpb(0, 1) + (dd1-temp326)*funb + (temp324-r(0))*& -& fun0b + dd1*temp328b - rb(0) = rb(0) + distp(0, 1)*temp326*2.d0*funb/temp327 - distp(0, 1& -& )*fun0b - dd1*temp328b0 + temp205 = r(0)**4 + temp205b = distp(0, 1)*fun2b + temp204 = 4.d0*dd1 + temp203 = 9.d0/temp204 + distpb(0, 1) = distpb(0, 1) + (2.d0*(dd1*r(0)**2)-13.d0/2.d0)*& +& funb0 + (temp203-r(0)**2)*fun0b + (19.d0*(dd1*r(0)**2)-13.d0/& +& 2.d0-4.d0*(dd1**2*temp205))*fun2b + temp205b0 = distp(0, 1)*2.d0*funb0 + dd1b = r(0)**2*temp205b0 - distp(0, 1)*temp203*4.d0*fun0b/temp204 & +& + (19.d0*r(0)**2-4.d0*temp205*2*dd1)*temp205b + rb(0) = rb(0) + dd1*2*r(0)*temp205b0 - distp(0, 1)*2*r(0)*fun0b + & +& (19.d0*dd1*2*r(0)-4.d0*dd1**2*4*r(0)**3)*temp205b CALL POPREAL8(adr8ibuf,adr8buf,dd1) ddb(indparp) = ddb(indparp) + dd1b ELSE @@ -10899,371 +11114,72 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd dd1b = 0.0_8 DO ic=7,1,-1 DO k=0,0,-1 - temp323 = 2.d0*dd1 - temp322 = 9.d0/temp323 - temp322b33 = (temp322-r(k))*zb(indorbp, k) - temp322b34 = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp322b33 - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp322b33 - dd1b = dd1b - temp322*2.d0*temp322b34/temp323 - rb(k) = rb(k) - temp322b34 + temp203b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) + temp202 = 4.d0*dd1 + temp201 = 9.d0/temp202 + temp201b7 = (temp201-r(k)**2)*zb(indorbp, k) + dd1b = dd1b - temp201*4.d0*temp203b/temp202 + rb(k) = rb(k) - 2*r(k)*temp203b + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp201b7 + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp201b7 zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - temp322b25 = cost4f*rmu(2, i)*distpb(i, 8) + temp201b = cost4f*rmu(2, i)*distpb(i, 8) rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 8) - 2*rmu(2, i)*temp322b25 +& distpb(i, 8) - 2*rmu(2, i)*temp201b distpb(i, 8) = 0.0_8 - temp322b26 = cost4f*rmu(1, i)*distpb(i, 7) + temp201b0 = cost4f*rmu(1, i)*distpb(i, 7) rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& -& distpb(i, 7) + 2*rmu(1, i)*temp322b26 + 3.d0*2*rmu(1, i)*& -& temp322b25 - rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp322b26 +& distpb(i, 7) + 2*rmu(1, i)*temp201b0 + 3.d0*2*rmu(1, i)*temp201b + rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp201b0 distpb(i, 7) = 0.0_8 - temp322b27 = cost3f*2.d0*distpb(i, 6) - temp322b28 = rmu(2, i)*temp322b27 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp322b28 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp322b28 - rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp322b27 + temp201b1 = cost3f*2.d0*distpb(i, 6) + temp201b2 = rmu(2, i)*temp201b1 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp201b2 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp201b2 + rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp201b1 distpb(i, 6) = 0.0_8 - temp322b29 = cost3f*rmu(3, i)*distpb(i, 5) + temp201b3 = cost3f*rmu(3, i)*distpb(i, 5) rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& & distpb(i, 5) - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp322b29 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp201b3 distpb(i, 5) = 0.0_8 rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 4) - 2*rmu(2, i)*temp322b29 - temp322b30 = cost2f*rmu(2, i)*distpb(i, 4) - rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp322b30 +& distpb(i, 4) - 2*rmu(2, i)*temp201b3 + temp201b4 = cost2f*rmu(2, i)*distpb(i, 4) + rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp201b4 distpb(i, 4) = 0.0_8 - temp322b31 = cost2f*rmu(1, i)*distpb(i, 3) + temp201b5 = cost2f*rmu(1, i)*distpb(i, 3) rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& & distpb(i, 3) distpb(i, 3) = 0.0_8 - temp322b32 = cost1f*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - 2*r(i)*temp322b31 - 3.d0*2*r(i)*temp322b32 - 2*r(i& -& )*temp322b30 + temp201b6 = cost1f*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - 2*r(i)*temp201b5 - 3.d0*2*r(i)*temp201b6 - 2*r(i)*& +& temp201b4 rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& -& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp322b32 + 5.d0*2*rmu(3, i)*& -& temp322b31 +& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp201b6 + 5.d0*2*rmu(3, i)*& +& temp201b5 distpb(i, 2) = 0.0_8 END DO cb = 0.0_8 DO k=0,0,-1 - temp322b24 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp322b24 - rb(k) = rb(k) - dd1*temp322b24 + temp200 = r(k)**2 + temp200b = c*DEXP(-(dd1*temp200))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp200))*distpb(k, 1) + dd1b = dd1b - temp200*temp200b + rb(k) = rb(k) - dd1*2*r(k)*temp200b distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.084104417400672d0*4.5d0*dd1**3.5D0*cb + dd1b = dd1b + 1.47215808929909374563d0*2.25d0*dd1**1.25D0*cb ddb(indparp) = ddb(indparp) + dd1b - CASE (38) -! 3s -derivative of 34 with respect to dd1 -! R(r)=r**2*exp(-z1*r) -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=1.d0/dsqrt(1.d0/4.d0/dd1**3+12.d0*dd1/(2.d0*dd1)**4+ & -! &3.d0*dd1**2/4.d0/dd1**5)/dsqrt(4.d0*pi) -! c=dd1*dsqrt(dd1)/dsqrt(7.d0*pi) - c = dd1*DSQRT(dd1)*0.21324361862292308211d0 -! endif - c0 = -(c*dd1) - c1 = 1.5d0*c/dd1 - DO i=0,0 - distp(i, 1) = DEXP(-(dd1*r(i))) - END DO - CALL PUSHREAL8(adr8ibuf,adr8buf,c1) - c1 = c1*dd1**2 - IF (typec .NE. 1) THEN - fun = (c0*(2.d0-dd1*r(0))-c1)*distp(0, 1) - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp331b = distp(0, 1)*fun2b - temp330 = (dd1*r(0))**2 - 4*(dd1*r(0)) + 2.d0 - temp330b0 = c0*temp331b - temp330b1 = 2*dd1*r(0)*temp330b0 - temp330b2 = distp(0, 1)*funb - c0b = (2.d0-dd1*r(0))*temp330b2 + temp330*temp331b - dd1b = c1*r(0)*temp331b - c0*r(0)*temp330b2 - 4*r(0)*temp330b0 + r& -& (0)*temp330b1 - rb(0) = rb(0) + c1*dd1*temp331b - c0*dd1*temp330b2 - 4*dd1*& -& temp330b0 + dd1*temp330b1 - c1b = (dd1*r(0)-1.d0)*temp331b - temp330b2 - distpb(0, 1) = (c0*(2.d0-dd1*r(0))-c1)*funb + (c0*temp330+c1*(dd1*& -& r(0)-1.d0))*fun2b - ELSE - distpb = 0.0_8 - c0b = 0.0_8 - c1b = 0.0_8 - dd1b = 0.0_8 - END IF - CALL POPREAL8(adr8ibuf,adr8buf,c1) - dd1b = dd1b + c1*2*dd1*c1b - c1b = dd1**2*c1b - DO i=0,0,-1 - temp330b = distp(i, 1)*zb(indorbp, i) - temp329 = dd1*r(i) + 1.d0 - c0b = c0b + r(i)**2*temp330b - rb(i) = rb(i) + (c1*dd1+c0*2*r(i))*temp330b - c1b = c1b + temp329*temp330b - dd1b = dd1b + c1*r(i)*temp330b - distpb(i, 1) = distpb(i, 1) + (c0*r(i)**2+c1*temp329)*zb(indorbp, & -& i) - zb(indorbp, i) = 0.0_8 - END DO - DO i=0,0,-1 - temp329b0 = DEXP(-(dd1*r(i)))*distpb(i, 1) - dd1b = dd1b - r(i)*temp329b0 - rb(i) = rb(i) - dd1*temp329b0 - distpb(i, 1) = 0.0_8 - END DO - temp329b = 1.5d0*c1b/dd1 - cb = temp329b - dd1*c0b - temp328 = DSQRT(dd1) - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + 0.21324361862292308211d0*temp328*cb - c*c0b - c*& -& temp329b/dd1 - ELSE - dd1b = dd1b + (0.21324361862292308211d0*dd1/(2.D0*DSQRT(dd1))+& -& 0.21324361862292308211d0*temp328)*cb - c*c0b - c*temp329b/dd1 - END IF - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (39) -! 4s single zeta derivative of 10 -! R(r)=r**3*exp(-z1*r) -! -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 -! c=dsqrt((2*dd1)**7/720.d0/pi)/2.d0 - c = dd1**3.5d0*0.11894160774351807429d0 -! c=-c -! endif - c0 = -c - c1 = 3.5d0*c/dd1 - DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k))) - END DO - IF (typec .NE. 1) THEN - rp1 = r(0)**3 - rp2 = r(0)**2 -! fun=(2.d0-dd1*r(0))*distp(0,1) -! fun2=(2.d0-4*dd1*r(0)+(dd1*r(0))**2)*distp(0,1) -! -!c the first derivative/r - fun = distp(0, 1)*(c0*(3.d0*r(0)-dd1*rp2)+c1*(2.d0-dd1*r(0))) -!c -!c the second derivative - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp333 = (dd1*r(0))**2 - 4*(dd1*r(0)) + 2.d0 - temp334 = 6.d0*r(0) - 6.d0*dd1*rp2 + dd1**2*rp1 - temp335b = distp(0, 1)*fun2b - temp334b = c0*temp335b - temp333b = c1*temp335b - temp333b0 = 2*dd1*r(0)*temp333b - temp332 = 3.d0*r(0) - dd1*rp2 - distpb(0, 1) = (c0*temp332+c1*(2.d0-dd1*r(0)))*funb + (c0*temp334+& -& c1*temp333)*fun2b - temp333b1 = distp(0, 1)*funb - c0b = temp332*temp333b1 + temp334*temp335b - temp332b0 = c0*temp333b1 - rp2b = -(dd1*temp332b0) - 6.d0*dd1*temp334b - rp1b = dd1**2*temp334b - rb(0) = rb(0) + 3.d0*temp332b0 - c1*dd1*temp333b1 + 3*r(0)**2*rp1b& -& + 2*r(0)*rp2b - 4*dd1*temp333b + dd1*temp333b0 + 6.d0*temp334b - dd1b = r(0)*temp333b0 - c1*r(0)*temp333b1 - 4*r(0)*temp333b - rp2*& -& temp332b0 + (rp1*2*dd1-6.d0*rp2)*temp334b - c1b = (2.d0-dd1*r(0))*temp333b1 + temp333*temp335b - ELSE - distpb = 0.0_8 - c0b = 0.0_8 - c1b = 0.0_8 - dd1b = 0.0_8 - END IF - DO i=0,0,-1 - temp332b = distp(i, 1)*zb(indorbp, i) - temp331 = r(i)**3 - c0b = c0b + temp331*temp332b - rb(i) = rb(i) + (c1*2*r(i)+c0*3*r(i)**2)*temp332b - c1b = c1b + r(i)**2*temp332b - distpb(i, 1) = distpb(i, 1) + (c0*temp331+c1*r(i)**2)*zb(indorbp, & -& i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=0,0,-1 - temp331b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp331b1 - rb(k) = rb(k) - dd1*temp331b1 - distpb(k, 1) = 0.0_8 - END DO - temp331b0 = 3.5d0*c1b/dd1 - cb = temp331b0 - c0b - dd1b = dd1b + 0.11894160774351807429d0*3.5d0*dd1**2.5D0*cb - c*& -& temp331b0/dd1 - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (40) -! -! 3p single zeta -! 3p without cusp condition derivative of 20 -! r e^{-z1 r } - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2.d0*dd1)**5/8.d0/pi)/2.d0 - c = dd1**2.5d0*0.5641895835477562d0 -! endif - c0 = -c - c1 = 2.5d0*c/dd1 -! - DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k))) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(k, 2)) - distp(k, 2) = r(k)*distp(k, 1) - END DO -! -! indorbp=indorb -! - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif -! -! - IF (typec .NE. 1) THEN - fun = (c0*(1.d0-dd1*r(0))-c1*dd1)*distp(0, 1) - fun2 = (c0*dd1*(dd1*r(0)-2.d0)+c1*dd1**2)*distp(0, 1) -! -! indorbp=indorb -! - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp337 = fun/r(0) - temp338b = rmu(ic, 0)*zb(indorbp, indt+4) - temp337b = 4.d0*temp338b/r(0) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp337+fun2)*zb(indorbp, indt& -& +4) - funb = funb + temp337b - rb(0) = rb(0) - temp337*temp337b - fun2b = fun2b + temp338b - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp336 = fun/r(0) - temp336b0 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(ic, 0) = rmub(ic, 0) + temp336*rmu(i, 0)*zb(indorbp, indt& -& +i) - rmub(i, 0) = rmub(i, 0) + temp336*rmu(ic, 0)*zb(indorbp, indt+& -& i) - funb = funb + temp336b0 - rb(0) = rb(0) - temp336*temp336b0 - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - distpb = 0.0_8 - temp336b = distp(0, 1)*fun2b - temp335 = dd1*r(0) - 2.d0 - temp335b3 = c0*dd1*temp336b - temp335b4 = distp(0, 1)*funb - c0b = (1.d0-dd1*r(0))*temp335b4 + distp(0, 2)*fun0b + temp335*dd1*& -& temp336b - dd1b = (-c1-c0*r(0))*temp335b4 + r(0)*temp335b3 + (c1*2*dd1+& -& temp335*c0)*temp336b - rb(0) = rb(0) + dd1*temp335b3 - c0*dd1*temp335b4 - c1b = distp(0, 1)*fun0b - dd1*temp335b4 + dd1**2*temp336b - distpb(0, 1) = (c0*(1.d0-dd1*r(0))-c1*dd1)*funb + (c0*dd1*temp335+& -& c1*dd1**2)*fun2b - distpb(0, 2) = distpb(0, 2) + c0*fun0b - distpb(0, 1) = distpb(0, 1) + c1*fun0b - ELSE - distpb = 0.0_8 - c0b = 0.0_8 - c1b = 0.0_8 - dd1b = 0.0_8 - END IF - DO ic=3,1,-1 - DO i=0,0,-1 - temp335b2 = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + (c0*distp(i, 2)+c1*distp(i, 1))*zb(& -& indorbp, i) - c0b = c0b + distp(i, 2)*temp335b2 - distpb(i, 2) = distpb(i, 2) + c0*temp335b2 - c1b = c1b + distp(i, 1)*temp335b2 - distpb(i, 1) = distpb(i, 1) + c1*temp335b2 - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO k=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(k, 2)) - rb(k) = rb(k) + distp(k, 1)*distpb(k, 2) - distpb(k, 1) = distpb(k, 1) + r(k)*distpb(k, 2) - distpb(k, 2) = 0.0_8 - temp335b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp335b1 - rb(k) = rb(k) - dd1*temp335b1 - distpb(k, 1) = 0.0_8 - END DO - temp335b0 = 2.5d0*c1b/dd1 - cb = temp335b0 - c0b - dd1b = dd1b + 0.5641895835477562d0*2.5d0*dd1**1.5D0*cb - c*temp335b0& -& /dd1 - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (41) -! 4p single zeta -!c 4p without cusp condition derivative of 22 -!c r^2 e^{-z1 r } - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2.d0*dd1)**7/240.d0/pi)/2.d0 - c = dd1**3.5d0*0.2060129077457011d0 -! endif - c0 = -c - c1 = 3.5d0*c/dd1 + CASE (141) +! 2p single exponential r^2 e^{-z r} ! parent of 121 + dd2 = dd(indpar+1) DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k))) - END DO - DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = r(i)**2*distp(i, 1) + distp(k, 1) = -DEXP(-(dd2*r(k))) END DO ! indorbp=indorb DO ic=1,3 @@ -11273,11 +11189,8 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN -! fun=(1.d0-dd1*r(0))*distp(0,1) -! fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) - fun = (c0*(2.d0-dd1*r(0))*r(0)+c1*(1.d0-dd1*r(0)))*distp(0, 1) - fun2 = (c0*((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))+c1*dd1*(dd1*r(0)-& -& 2.d0))*distp(0, 1) + fun = distp(0, 1)*(2.d0-dd2*r(0)) + fun2 = (2.d0-4.d0*dd2*r(0)+(dd2*r(0))**2)*distp(0, 1) ! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -11291,581 +11204,617 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp343 = fun/r(0) - temp344b = rmu(ic, 0)*zb(indorbp, indt+4) - temp343b = 4.d0*temp344b/r(0) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp343+fun2)*zb(indorbp, indt& -& +4) - funb = funb + temp343b - rb(0) = rb(0) - temp343*temp343b - fun2b = fun2b + temp344b + temp206b29 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp206b29 + fun2b = fun2b + temp206b29 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp342 = fun/r(0) - temp342b0 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(ic, 0) = rmub(ic, 0) + temp342*rmu(i, 0)*zb(indorbp, indt& -& +i) - rmub(i, 0) = rmub(i, 0) + temp342*rmu(ic, 0)*zb(indorbp, indt+& -& i) - funb = funb + temp342b0 - rb(0) = rb(0) - temp342*temp342b0 + temp206b28 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp206b28 + funb0 = funb0 + rmu(ic, 0)*temp206b28 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp342b = distp(0, 1)*fun2b - temp341 = (dd1*r(0))**2 - 4.d0*dd1*r(0) + 2.d0 - temp341b = c0*temp342b - temp341b0 = 2*dd1*r(0)*temp341b - temp340 = dd1*r(0) - 2.d0 - temp340b = c1*dd1*temp342b - temp340b0 = distp(0, 1)*funb - temp338 = -(dd1*r(0)) + 2.d0 - c0b = temp338*r(0)*temp340b0 + distp(0, 3)*fun0b + temp341*& -& temp342b - temp339 = c0*r(0) - dd1b = (-(c1*r(0))-temp339*r(0))*temp340b0 + r(0)*temp340b + & -& temp340*c1*temp342b - 4.d0*r(0)*temp341b + r(0)*temp341b0 - rb(0) = rb(0) + (temp338*c0-c1*dd1-temp339*dd1)*temp340b0 + distp(& -& 0, 1)*c1*fun0b + dd1*temp340b - 4.d0*dd1*temp341b + dd1*& -& temp341b0 - c1b = (1.d0-dd1*r(0))*temp340b0 + distp(0, 1)*r(0)*fun0b + temp340& -& *dd1*temp342b - distpb(0, 1) = (temp338*temp339+c1*(1.d0-dd1*r(0)))*funb + (c0*& -& temp341+c1*dd1*temp340)*fun2b - distpb(0, 3) = distpb(0, 3) + c0*fun0b - distpb(0, 1) = distpb(0, 1) + c1*r(0)*fun0b + temp206b26 = distp(0, 1)*fun2b + temp206b27 = 2*dd2*r(0)*temp206b26 + dd2b = r(0)*temp206b27 - 4.d0*r(0)*temp206b26 - distp(0, 1)*r(0)*& +& funb0 + rb(0) = rb(0) + distp(0, 1)*2*r(0)*fun0b - distp(0, 1)*dd2*funb0 -& +& 4.d0*dd2*temp206b26 + dd2*temp206b27 + distpb(0, 1) = (2.d0-dd2*r(0))*funb0 + r(0)**2*fun0b + ((dd2*r(0))& +& **2-4.d0*(dd2*r(0))+2.d0)*fun2b ELSE distpb = 0.0_8 - c0b = 0.0_8 - c1b = 0.0_8 - dd1b = 0.0_8 + dd2b = 0.0_8 END IF DO ic=3,1,-1 DO i=0,0,-1 - temp338b2 = rmu(ic, i)*zb(indorbp, i) - temp338b3 = distp(i, 1)*temp338b2 - rmub(ic, i) = rmub(ic, i) + (c0*distp(i, 3)+c1*r(i)*distp(i, 1))& -& *zb(indorbp, i) - c0b = c0b + distp(i, 3)*temp338b2 - distpb(i, 3) = distpb(i, 3) + c0*temp338b2 - c1b = c1b + r(i)*temp338b3 - rb(i) = rb(i) + c1*temp338b3 - distpb(i, 1) = distpb(i, 1) + c1*r(i)*temp338b2 - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO i=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*distpb(i, 3) - distpb(i, 1) = distpb(i, 1) + r(i)**2*distpb(i, 3) - distpb(i, 3) = 0.0_8 + temp206b25 = r(i)**2*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp206b25 + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp206b25 + rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*2*r(i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=0,0,-1 - temp338b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp338b1 - rb(k) = rb(k) - dd1*temp338b1 + temp206b24 = -(DEXP(-(dd2*r(k)))*distpb(k, 1)) + dd2b = dd2b - r(k)*temp206b24 + rb(k) = rb(k) - dd2*temp206b24 distpb(k, 1) = 0.0_8 END DO - temp338b0 = 3.5d0*c1b/dd1 - cb = temp338b0 - c0b - dd1b = dd1b + 0.2060129077457011d0*3.5d0*dd1**2.5D0*cb - c*temp338b0& -& /dd1 - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (42) -! 4d without cusp and one parmater derivative of 30 + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (26) +! der of 127 +! s orbital +! +! - angmom = 1 +! - type = Slater +! - normalized = yes +! - angtype = spherical +! - npar = 5 +! - multiplicity = 3 +! +! 2p with cusp conditions +! dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c= & -! & 1.d0/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) - c = dd1**3.5d0*0.26596152026762178d0 -! c= -! & 1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) -! endif - c0 = -c - c1 = 3.5d0*c/dd1 + dd2 = dd(indpar+2) + peff = dd(indpar+3) + dd3 = dd(indpar+4) + peff2 = dd(indpar+5) + c = 1.d0/2.d0/DSQRT(8.d0*pi*(1.d0/(2.d0*dd1)**5+2.d0*peff/(dd1+dd2)& +& **5+peff**2/(2.d0*dd2)**5+2.d0*peff2/(dd1+dd3)**5+peff2**2/(2.d0*& +& dd3)**5+2.d0*peff2*peff/(dd2+dd3)**5)) DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 2) = c*DEXP(-(dd2*r(k))) + distp(k, 3) = c*DEXP(-(dd3*r(k))) END DO DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = distp(i, 1)*(c0*r(i)+c1) CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) -! lz=0 - distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) -! lz=+/ - distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) -! lz=+/-2 - distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) -! lz=+/-1 - distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) -! lz=+/-1 - distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d + distp(i, 4) = distp(i, 1) + peff*distp(i, 2) + peff2*distp(i, 3) END DO -! indorbp=indorb - DO ic=1,5 + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 3) - fun = -(dd1*distp(0, 3)) + c0*distp(0, 1) - fun2 = dd1**2*distp(0, 3) - 2.d0*dd1*c0*distp(0, 1) -! indorbp=indorb - DO ic=1,5 + fun = (-(dd1*distp(0, 1))-dd2*peff*distp(0, 2)-dd3*peff2*distp(0, & +& 3))/r(0) + fun2 = dd1**2*distp(0, 1) + peff*dd2**2*distp(0, 2) + peff2*dd3**2& +& *distp(0, 3) + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 - fun0b = 0.0_8 + funb0 = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp345 = fun/r(0) - temp346b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp345b3 = 6.d0*temp346b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp345+fun2)*zb(& -& indorbp, indt+4) - funb = funb + temp345b3 - rb(0) = rb(0) - temp345*temp345b3 - fun2b = fun2b + temp346b + DO ic=3,1,-1 + temp220b6 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp220b6 + fun2b = fun2b + temp220b6 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp345b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp345b - fun0b = fun0b + rmu(i, 0)*temp345b - ELSE - temp345b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp345b0 - fun0b = fun0b + rmu(i, 0)*temp345b0 - END IF - ELSE IF (branch .LT. 4) THEN - temp345b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp345b1 - fun0b = fun0b + rmu(i, 0)*temp345b1 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp345b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp345b2 - fun0b = fun0b + rmu(i, 0)*temp345b2 - ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - temp344 = fun/r(0) - temp344b4 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp344*rmu(i, 0)*zb(& -& indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp344*distp(0, 3+ic)*zb(indorbp, & -& indt+i) - funb = funb + temp344b4 - rb(0) = rb(0) - temp344*temp344b4 + IF (.NOT.branch .LT. 2) distpb(0, 4) = distpb(0, 4) + zb(& +& indorbp, indt+i) + temp220b5 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp220b5 + funb0 = funb0 + rmu(ic, 0)*temp220b5 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp344b3 = -(2.d0*distp(0, 1)*fun2b) - dd1b = c0*temp344b3 - distp(0, 3)*funb + distp(0, 3)*2*dd1*fun2b - distpb(0, 3) = distpb(0, 3) + dd1**2*fun2b - c0b = distp(0, 1)*funb + dd1*temp344b3 - distpb(0, 1) = distpb(0, 1) + c0*funb - 2.d0*dd1*c0*fun2b - distpb(0, 3) = distpb(0, 3) + fun0b - dd1*funb + temp220b2 = dd2**2*fun2b + temp220b3 = dd3**2*fun2b + temp220b4 = funb0/r(0) + dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*temp220b4 + distpb(0, 1) = distpb(0, 1) + dd1**2*fun2b + dd2b = peff*distp(0, 2)*2*dd2*fun2b - distp(0, 2)*peff*temp220b4 + peffb = distp(0, 2)*temp220b2 - distp(0, 2)*dd2*temp220b4 + distpb(0, 2) = distpb(0, 2) + peff*temp220b2 + dd3b = peff2*distp(0, 3)*2*dd3*fun2b - distp(0, 3)*peff2*temp220b4 + peff2b = distp(0, 3)*temp220b3 - distp(0, 3)*dd3*temp220b4 + distpb(0, 3) = distpb(0, 3) + peff2*temp220b3 + distpb(0, 1) = distpb(0, 1) - dd1*temp220b4 + distpb(0, 2) = distpb(0, 2) - dd2*peff*temp220b4 + distpb(0, 3) = distpb(0, 3) - dd3*peff2*temp220b4 + rb(0) = rb(0) - (-(dd1*distp(0, 1))-dd2*peff*distp(0, 2)-dd3*peff2& +& *distp(0, 3))*temp220b4/r(0) ELSE distpb = 0.0_8 - c0b = 0.0_8 + peffb = 0.0_8 dd1b = 0.0_8 + dd2b = 0.0_8 + dd3b = 0.0_8 + peff2b = 0.0_8 END IF - DO ic=5,1,-1 + DO ic=3,1,-1 DO i=0,0,-1 - distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 4)*zb(indorbp, i) + distpb(i, 4) = distpb(i, 4) + rmu(ic, i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - c1b = 0.0_8 DO i=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) - distpb(i, 8) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) - distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + distpb(i, 1) = distpb(i, 1) + distpb(i, 4) + peffb = peffb + distp(i, 2)*distpb(i, 4) + distpb(i, 2) = distpb(i, 2) + peff*distpb(i, 4) + peff2b = peff2b + distp(i, 3)*distpb(i, 4) + distpb(i, 3) = distpb(i, 3) + peff2*distpb(i, 4) distpb(i, 4) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - temp344b2 = distp(i, 1)*distpb(i, 3) - distpb(i, 1) = distpb(i, 1) + (c0*r(i)+c1)*distpb(i, 3) - c0b = c0b + r(i)*temp344b2 - rb(i) = rb(i) + c0*temp344b2 - c1b = c1b + temp344b2 - distpb(i, 3) = 0.0_8 END DO + cb = 0.0_8 DO k=0,0,-1 - temp344b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp344b1 - rb(k) = rb(k) - dd1*temp344b1 + temp220b = c*DEXP(-(dd3*r(k)))*distpb(k, 3) + cb = cb + DEXP(-(dd3*r(k)))*distpb(k, 3) + dd3b = dd3b - r(k)*temp220b + distpb(k, 3) = 0.0_8 + temp220b0 = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) + distpb(k, 2) = 0.0_8 + temp220b1 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd2*temp220b0 - dd1*temp220b1 - dd3*temp220b + dd2b = dd2b - r(k)*temp220b0 + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp220b1 distpb(k, 1) = 0.0_8 END DO - temp344b0 = 3.5d0*c1b/dd1 - cb = temp344b0 - c0b - dd1b = dd1b + 0.26596152026762178d0*3.5d0*dd1**2.5D0*cb - c*& -& temp344b0/dd1 + temp219 = (dd2+dd3)**5 + temp206 = peff2*peff/temp219 + temp218 = 2.d0**5 + temp217 = temp218*dd3**5 + temp216 = peff2**2/temp217 + temp215 = (dd1+dd3)**5 + temp214 = 2.d0**5 + temp213 = temp214*dd2**5 + temp212 = peff**2/temp213 + temp211 = (dd1+dd2)**5 + temp210 = 2.d0**5 + temp209 = temp210*dd1**5 + temp208 = 8.d0*pi*(1.0/temp209+2.d0*peff/temp211+temp212+2.d0*peff2/& +& temp215+temp216+2.d0*temp206) + temp207 = DSQRT(temp208) + IF (temp208 .EQ. 0.0) THEN + temp207b = 0.0 + ELSE + temp207b = -(pi*8.d0*cb/(2.d0*temp207**2*2.D0*DSQRT(temp208))) + END IF + temp207b0 = 2.d0*temp207b/temp211 + temp207b1 = -(peff*5*(dd1+dd2)**4*temp207b0/temp211) + temp207b2 = 2.d0*temp207b/temp215 + temp207b3 = -(peff2*5*(dd1+dd3)**4*temp207b2/temp215) + temp206b30 = 2.d0*temp207b/temp219 + temp206b31 = -(temp206*5*(dd2+dd3)**4*temp206b30) + dd1b = dd1b + temp207b3 + temp207b1 - temp210*5*dd1**4*temp207b/& +& temp209**2 + peffb = peffb + peff2*temp206b30 + 2*peff*temp207b/temp213 + & +& temp207b0 + dd2b = dd2b + temp206b31 - temp212*temp214*5*dd2**4*temp207b/temp213& +& + temp207b1 + peff2b = peff2b + peff*temp206b30 + 2*peff2*temp207b/temp217 + & +& temp207b2 + dd3b = dd3b + temp206b31 - temp216*temp218*5*dd3**4*temp207b/temp217& +& + temp207b3 + ddb(indpar+5) = ddb(indpar+5) + peff2b + ddb(indpar+4) = ddb(indpar+4) + dd3b + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (43) -! 4d without cusp and one parmater derivative of 33 - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c= & -! & 1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) - c = dd1**4.5d0*0.0710812062076410d0 -! endif - c0 = -c - c1 = 4.5d0*c/dd1 + CASE (86) +! f single gaussian orbital +! R(r)= exp(-alpha r^2) +! normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) + dd2 = DSQRT(dd1) +! if(iflagnorm.gt.2) then +! overall normalization +! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0)*ratiocf + c = dd1**2.25d0*ratiocf +! endif DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k))) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) END DO DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = distp(i, 1)*(c0*r(i)**2+c1*r(i)) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) + distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) ! lz=0 - distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) -! lz=+/ - distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) -! lz=+/-2 - distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) + distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) ! lz=+/-1 - distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) + distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) ! lz=+/-1 - distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d + distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) +! lz=+/-2 + distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) +! lz=+/-2 + distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) +! lz=+/-3 + distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) END DO -! indorbp=indorb - DO ic=1,5 +! lz=+/-3 + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 3) - fun = -(dd1*distp(0, 3)) + distp(0, 1)*(2.d0*c0*r(0)+c1) - fun2 = dd1**2*distp(0, 3) + distp(0, 1)*(-(2.d0*dd1*(2.d0*c0*r(0)+& -& c1))+2.d0*c0) + fun0 = distp(0, 1) + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) +! the second derivative + fun2 = dd1*distp(0, 1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**& +& 2)/rp3**2 ! indorbp=indorb - DO ic=1,5 + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE + IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN + IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) END IF ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN + IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) END IF + ELSE IF (ic .EQ. 6) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + END IF + ELSE IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp348 = fun/r(0) - temp349b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp348b3 = 6.d0*temp349b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp348+fun2)*zb(& -& indorbp, indt+4) - funb = funb + temp348b3 - rb(0) = rb(0) - temp348*temp348b3 - fun2b = fun2b + temp349b + DO ic=7,1,-1 + temp224b23 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 8.d0*temp224b23 + fun2b = fun2b + temp224b23 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp348b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp348b - fun0b = fun0b + rmu(i, 0)*temp348b + IF (branch .LT. 11) THEN + IF (branch .LT. 6) THEN + IF (branch .LT. 4) THEN + IF (branch .LT. 3) THEN + IF (.NOT.branch .LT. 2) THEN + temp224b2 = cost1f*zb(indorbp, indt+i) + fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& +& temp224b2 + rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& +& temp224b2 + rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp224b2 + END IF + temp224b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) + temp224b1 = rmu(i, 0)*temp224b0 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp224b0 + fun0b = fun0b + rmu(3, 0)*temp224b1 + rmub(3, 0) = rmub(3, 0) + fun0*temp224b1 + GOTO 130 ELSE - temp348b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp348b0 - fun0b = fun0b + rmu(i, 0)*temp348b0 + temp224b5 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp224b5 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp224b5 + rb(0) = rb(0) - fun0*2*r(0)*temp224b5 END IF - ELSE IF (branch .LT. 4) THEN - temp348b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp348b1 - fun0b = fun0b + rmu(i, 0)*temp348b1 + ELSE IF (.NOT.branch .LT. 5) THEN + temp224b6 = cost2f*10.d0*zb(indorbp, indt+i) + temp224b7 = rmu(i, 0)*temp224b6 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp224b6 + fun0b = fun0b + rmu(1, 0)*temp224b7 + rmub(1, 0) = rmub(1, 0) + fun0*temp224b7 END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp348b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp348b2 - fun0b = fun0b + rmu(i, 0)*temp348b2 + temp224b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp224b4 = rmu(i, 0)*temp224b3 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp224b3 + fun0b = fun0b + rmu(1, 0)*temp224b4 + rmub(1, 0) = rmub(1, 0) + fun0*temp224b4 + ELSE IF (branch .LT. 9) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 7) THEN + temp224b10 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp224b10 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp224b10 + rb(0) = rb(0) - fun0*2*r(0)*temp224b10 + END IF ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + temp224b11 = cost2f*10.d0*zb(indorbp, indt+i) + temp224b12 = rmu(i, 0)*temp224b11 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp224b11 + fun0b = fun0b + rmu(2, 0)*temp224b12 + rmub(2, 0) = rmub(2, 0) + fun0*temp224b12 END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + temp224b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp224b9 = rmu(i, 0)*temp224b8 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp224b8 + fun0b = fun0b + rmu(2, 0)*temp224b9 + rmub(2, 0) = rmub(2, 0) + fun0*temp224b9 + ELSE IF (branch .LT. 10) THEN + temp224b13 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp224b13 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp224b13 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp224b13 + ELSE + temp224b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp224b14 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp224b14 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp224b14 END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 16) THEN + IF (branch .LT. 14) THEN + IF (branch .LT. 13) THEN + IF (branch .LT. 12) THEN + temp224b15 = cost3f*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp224b15 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp224b15 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp224b15 + ELSE + temp224b16 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp224b16 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp224b16 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp224b16 + END IF + ELSE + temp224b17 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp224b17 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp224b17 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp224b17 END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 15) THEN + temp224b18 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp224b18 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp224b18 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp224b18 + ELSE + temp224b19 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp224b19 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp224b19 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp224b19 END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 19) THEN + IF (branch .LT. 18) THEN + IF (.NOT.branch .LT. 17) THEN + temp224b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp224b20 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp224b20 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp224b20 + END IF + ELSE + temp224b21 = cost4f*6.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp224b21 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp224b21 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp224b21 END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + ELSE IF (.NOT.branch .LT. 20) THEN + temp224b22 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp224b22 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp224b22 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp224b22 END IF - temp347 = fun/r(0) - temp347b0 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp347*rmu(i, 0)*zb(& -& indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp347*distp(0, 3+ic)*zb(indorbp, & + 130 temp224b = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - funb = funb + temp347b0 - rb(0) = rb(0) - temp347*temp347b0 + rmub(i, 0) = rmub(i, 0) + fun*temp224b + funb0 = funb0 + rmu(i, 0)*temp224b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp346 = 2.d0*c0*r(0) + c1 - temp347b = -(distp(0, 1)*2.d0*fun2b) - temp346b3 = dd1*temp347b - dd1b = temp346*temp347b - distp(0, 3)*funb + distp(0, 3)*2*dd1*& -& fun2b - distpb(0, 3) = distpb(0, 3) + dd1**2*fun2b - distpb(0, 1) = distpb(0, 1) + (2.d0*(c0*r(0))+c1)*funb + (2.d0*c0-& -& 2.d0*(dd1*temp346))*fun2b - temp346b4 = distp(0, 1)*funb - c0b = 2.d0*r(0)*temp346b4 + 2.d0*r(0)*temp346b3 + distp(0, 1)*2.d0& -& *fun2b - rb(0) = rb(0) + 2.d0*c0*temp346b4 + 2.d0*c0*temp346b3 - c1b = temp346b4 + temp346b3 - distpb(0, 3) = distpb(0, 3) + fun0b - dd1*funb + temp223 = rp3**2 + temp222b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& +& temp223 + temp222 = dd1*distp(0, 1)/temp223 + temp222b0 = temp222*fun2b + rp1b = (2*rp1+4.d0*rp2+4.d0)*temp222b0 + temp221b8 = -(distp(0, 1)*(rp2+2.d0)*funb0/rp3) + dd1b = temp221b8 + r(0)**2*rp1b + distp(0, 1)*temp222b + temp221 = dd1/rp3 + distpb(0, 1) = distpb(0, 1) + fun0b - temp221*(rp2+2.d0)*funb0 + & +& dd1*temp222b + rp3b = -(temp221*temp221b8) - temp222*2*rp3*temp222b + rp2b = 2*(rp2+1.d0)*rp3b - temp221*distp(0, 1)*funb0 + (4.d0*rp1-& +& 2.d0)*temp222b0 + dd2b = r(0)*rp2b + rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b ELSE distpb = 0.0_8 - c0b = 0.0_8 - c1b = 0.0_8 dd1b = 0.0_8 + dd2b = 0.0_8 END IF - DO ic=5,1,-1 - DO i=0,0,-1 - distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=7,1,-1 + DO k=0,0,-1 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + temp221b0 = cost4f*rmu(2, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 8) - 2*rmu(2, i)*temp221b0 distpb(i, 8) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + temp221b1 = cost4f*rmu(1, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& +& distpb(i, 7) + 2*rmu(1, i)*temp221b1 + 3.d0*2*rmu(1, i)*& +& temp221b0 + rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp221b1 distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + temp221b2 = cost3f*2.d0*distpb(i, 6) + temp221b3 = rmu(2, i)*temp221b2 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp221b3 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp221b3 + rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp221b2 distpb(i, 6) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + temp221b4 = cost3f*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 5) + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp221b4 distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 4) - 2*rmu(2, i)*temp221b4 + temp221b5 = cost2f*rmu(2, i)*distpb(i, 4) + rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp221b5 distpb(i, 4) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - temp346b2 = distp(i, 1)*distpb(i, 3) - distpb(i, 1) = distpb(i, 1) + (c0*r(i)**2+c1*r(i))*distpb(i, 3) - c0b = c0b + r(i)**2*temp346b2 - rb(i) = rb(i) + (c1+c0*2*r(i))*temp346b2 - c1b = c1b + r(i)*temp346b2 + temp221b6 = cost2f*rmu(1, i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 3) distpb(i, 3) = 0.0_8 + temp221b7 = cost1f*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - 2*r(i)*temp221b6 - 3.d0*2*r(i)*temp221b7 - 2*r(i)*& +& temp221b5 + rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& +& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp221b7 + 5.d0*2*rmu(3, i)*& +& temp221b6 + distpb(i, 2) = 0.0_8 END DO + cb = 0.0_8 DO k=0,0,-1 - temp346b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp346b1 - rb(k) = rb(k) - dd1*temp346b1 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp220 = dd2*r(k) + 1.d0 + temp221b = costb/temp220 + temp220b7 = -(dd1*r(k)**2*temp221b/temp220) + dd1b = dd1b + r(k)**2*temp221b + rb(k) = rb(k) + dd2*temp220b7 + dd1*2*r(k)*temp221b + dd2b = dd2b + r(k)*temp220b7 END DO - temp346b0 = 4.5d0*c1b/dd1 - cb = temp346b0 - c0b - dd1b = dd1b + 0.0710812062076410d0*4.5d0*dd1**3.5D0*cb - c*temp346b0& -& /dd1 - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (44) -! derivative of 36 with respect zeta -! R(r)=x*exp(-z*r**2)*(5/4/z-r**2) - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0 - c = dd1**1.25d0*1.42541094070998d0 -! endif + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocf*2.25d0*dd1**1.25D0*cb + ELSE + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocf*2.25d0*dd1**1.25D0*& +& cb + END IF + ddb(indparp) = ddb(indparp) + dd1b + CASE (101) +! derivative of 48 with respect to z +! 2s without cusp condition +! dd1*( dd3 +exp(-dd2*r^2)) + dd2 = dd(indpar+1) + indorbp = indorb + 1 DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) + END DO +! endif + IF (typec .NE. 1) THEN + fun = -(dd2*distp(0, 1)*2.d0) + distpb = 0.0_8 + temp224b25 = 2.d0**2*dd2*distp(0, 1)*zb(indorbp, indt+4) + temp224b26 = 2.d0*(2.d0*(dd2*r(0)**2)-3.d0)*zb(indorbp, indt+4) + dd2b = distp(0, 1)*temp224b26 + r(0)**2*temp224b25 + rb(0) = rb(0) + dd2*2*r(0)*temp224b25 + distpb(0, 1) = dd2*temp224b26 + zb(indorbp, indt+4) = 0.0_8 + funb0 = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + dd2b = dd2b - 2.d0*distp(0, 1)*funb0 + distpb(0, 1) = distpb(0, 1) - 2.d0*dd2*funb0 + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + dd3b = 0.0_8 + DO i=0,0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + DO k=0,0,-1 + temp224b24 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp224b24 + rb(k) = rb(k) - dd2*2*r(k)*temp224b24 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (150) +! 2p single exponential r e^{-z r^2} + dd2 = dd(indpar+1) + DO k=0,0 + distp(k, 1) = DEXP(-(dd2*r(k)**2)) END DO ! indorbp=indorb -! DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then @@ -11873,9 +11822,10 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - fun = distp(0, 1)*(2.d0*dd1*r(0)**2-9.d0/2.d0) - fun2 = distp(0, 1)*(-(4.d0*dd1**2*r(0)**4)+15.d0*dd1*r(0)**2-9.d0/& -& 2.d0) + fun0 = distp(0, 1)*r(0) + cost = 2.d0*dd2*r(0)**2 + fun = distp(0, 1)*(1.d0-cost)/r(0) + fun2 = 2.d0*dd2*fun0*(cost-3.d0) ! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -11889,96 +11839,85 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp355b0 = rmu(ic, 0)*zb(indorbp, indt+4) + temp225b1 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp355b0 - fun2b = fun2b + temp355b0 + funb0 = funb0 + 4.d0*temp225b1 + fun2b = fun2b + temp225b1 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp355b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp355b - funb = funb + rmu(ic, 0)*temp355b + temp225b0 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp225b0 + funb0 = funb0 + rmu(ic, 0)*temp225b0 rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + temp225b = 2.d0*(cost-3.d0)*fun2b + temp224b29 = distp(0, 1)*funb0/r(0) + costb = 2.d0*dd2*fun0*fun2b - temp224b29 + dd2b = 2.d0*r(0)**2*costb + fun0*temp225b + fun0b = fun0b + dd2*temp225b distpb = 0.0_8 - temp354 = r(0)**4 - temp354b = distp(0, 1)*fun2b - temp353 = 4.d0*dd1 - temp352 = 5.d0/temp353 - distpb(0, 1) = (2.d0*(dd1*r(0)**2)-9.d0/2.d0)*funb + (temp352-r(0)& -& **2)*fun0b + (15.d0*(dd1*r(0)**2)-9.d0/2.d0-4.d0*(dd1**2*temp354& -& ))*fun2b - temp354b0 = distp(0, 1)*2.d0*funb - dd1b = r(0)**2*temp354b0 - distp(0, 1)*temp352*4.d0*fun0b/temp353 & -& + (15.d0*r(0)**2-4.d0*temp354*2*dd1)*temp354b - rb(0) = rb(0) + dd1*2*r(0)*temp354b0 - distp(0, 1)*2*r(0)*fun0b + & -& (15.d0*dd1*2*r(0)-4.d0*dd1**2*4*r(0)**3)*temp354b + temp224 = (-cost+1.d0)/r(0) + distpb(0, 1) = r(0)*fun0b + temp224*funb0 + rb(0) = rb(0) + 2.d0*dd2*2*r(0)*costb + distp(0, 1)*fun0b - & +& temp224*temp224b29 ELSE distpb = 0.0_8 - dd1b = 0.0_8 + dd2b = 0.0_8 END IF DO ic=3,1,-1 DO i=0,0,-1 - temp351 = 4.d0*dd1 - temp350 = 5.d0/temp351 - temp350b = (temp350-r(i)**2)*zb(indorbp, i) - temp350b0 = rmu(ic, i)*distp(i, 1)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp350b - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp350b - dd1b = dd1b - temp350*4.d0*temp350b0/temp351 - rb(i) = rb(i) - 2*r(i)*temp350b0 + temp224b28 = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*r(i)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + r(i)*temp224b28 + rb(i) = rb(i) + distp(i, 1)*temp224b28 zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - cb = 0.0_8 DO k=0,0,-1 - temp349 = r(k)**2 - temp349b0 = c*DEXP(-(dd1*temp349))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp349))*distpb(k, 1) - dd1b = dd1b - temp349*temp349b0 - rb(k) = rb(k) - dd1*2*r(k)*temp349b0 + temp224b27 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp224b27 + rb(k) = rb(k) - dd2*2*r(k)*temp224b27 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 1.42541094070998d0*1.25d0*dd1**0.25D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (45, 69) -! derivative of 37 with respect to z -! d orbitals -! R(r)= c*exp(-z r^2)*(7/4/z-r^2) + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (155) +! Jastrow single gaussian f orbital +! derivative of 154 with respect to z +! unnormalized f orbitals +! R(r)= -r^2*exp(-z r^2) ! indorbp=indorb indparp = indpar + 1 dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) - c = dd1**1.75d0*1.64592278064948967213d0 -! endif DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + distp(k, 1) = DEXP(-(dd1*r(k)**2)) END DO DO i=0,0 + distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) ! lz=0 - distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d -! lz=+/-2 - distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d -! lz=+/-2 - distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d + distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) ! lz=+/-1 - distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d + distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) ! lz=+/-1 - distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d + distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) +! lz=+/-2 + distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) +! lz=+/-2 + distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) +! lz=+/-3 + distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) END DO - DO ic=1,5 +! lz=+/-3 + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic @@ -11987,740 +11926,600 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd IF (typec .NE. 1) THEN CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) dd1 = dd(indparp) - fun0 = distp(0, 1)*(7.d0/4.d0/dd1-r(0)**2) - fun = distp(0, 1)*(2.d0*dd1*r(0)**2-11.d0/2.d0) - fun2 = distp(0, 1)*(-(4.d0*dd1**2*r(0)**4)+17.d0*dd1*r(0)**2-11.d0& -& /2.d0) + fun0 = -(r(0)**2*distp(0, 1)) + fun = 2.d0*(dd1*r(0)**2-1.d0)*distp(0, 1) + fun2 = -(2.d0*(2.d0*dd1**2*r(0)**4+1.d0-5.d0*dd1*r(0)**2)*distp(0& +& , 1)) ! indorbp=indorb - DO ic=1,5 + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE + IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN + IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) END IF ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN + IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) END IF + ELSE IF (ic .EQ. 6) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + END IF + ELSE IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp361b4 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & + DO ic=7,1,-1 + temp226b23 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & & indt+4) - funb = funb + 6.d0*temp361b4 - fun2b = fun2b + temp361b4 + funb0 = funb0 + 8.d0*temp226b23 + fun2b = fun2b + temp226b23 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp361b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp361b0 - fun0b = fun0b + rmu(i, 0)*temp361b0 + IF (branch .LT. 11) THEN + IF (branch .LT. 6) THEN + IF (branch .LT. 4) THEN + IF (branch .LT. 3) THEN + IF (.NOT.branch .LT. 2) THEN + temp226b2 = cost1f*zb(indorbp, indt+i) + fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& +& temp226b2 + rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& +& temp226b2 + rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp226b2 + END IF + temp226b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) + temp226b1 = rmu(i, 0)*temp226b0 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp226b0 + fun0b = fun0b + rmu(3, 0)*temp226b1 + rmub(3, 0) = rmub(3, 0) + fun0*temp226b1 + GOTO 140 ELSE - temp361b1 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp361b1 - fun0b = fun0b + rmu(i, 0)*temp361b1 + temp226b5 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp226b5 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp226b5 + rb(0) = rb(0) - fun0*2*r(0)*temp226b5 END IF - ELSE IF (branch .LT. 4) THEN - temp361b2 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp361b2 - fun0b = fun0b + rmu(i, 0)*temp361b2 + ELSE IF (.NOT.branch .LT. 5) THEN + temp226b6 = cost2f*10.d0*zb(indorbp, indt+i) + temp226b7 = rmu(i, 0)*temp226b6 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp226b6 + fun0b = fun0b + rmu(1, 0)*temp226b7 + rmub(1, 0) = rmub(1, 0) + fun0*temp226b7 END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp361b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp361b3 - fun0b = fun0b + rmu(i, 0)*temp361b3 + temp226b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp226b4 = rmu(i, 0)*temp226b3 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp226b3 + fun0b = fun0b + rmu(1, 0)*temp226b4 + rmub(1, 0) = rmub(1, 0) + fun0*temp226b4 + ELSE IF (branch .LT. 9) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 7) THEN + temp226b10 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp226b10 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp226b10 + rb(0) = rb(0) - fun0*2*r(0)*temp226b10 + END IF ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + temp226b11 = cost2f*10.d0*zb(indorbp, indt+i) + temp226b12 = rmu(i, 0)*temp226b11 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp226b11 + fun0b = fun0b + rmu(2, 0)*temp226b12 + rmub(2, 0) = rmub(2, 0) + fun0*temp226b12 END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + temp226b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp226b9 = rmu(i, 0)*temp226b8 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp226b8 + fun0b = fun0b + rmu(2, 0)*temp226b9 + rmub(2, 0) = rmub(2, 0) + fun0*temp226b9 + ELSE IF (branch .LT. 10) THEN + temp226b13 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp226b13 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp226b13 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp226b13 + ELSE + temp226b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp226b14 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp226b14 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp226b14 END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 16) THEN + IF (branch .LT. 14) THEN + IF (branch .LT. 13) THEN + IF (branch .LT. 12) THEN + temp226b15 = cost3f*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp226b15 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp226b15 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp226b15 + ELSE + temp226b16 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp226b16 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp226b16 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp226b16 + END IF + ELSE + temp226b17 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp226b17 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp226b17 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp226b17 END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 15) THEN + temp226b18 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp226b18 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp226b18 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp226b18 + ELSE + temp226b19 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp226b19 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp226b19 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp226b19 END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 19) THEN + IF (branch .LT. 18) THEN + IF (.NOT.branch .LT. 17) THEN + temp226b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp226b20 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp226b20 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp226b20 + END IF + ELSE + temp226b21 = cost4f*6.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp226b21 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp226b21 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp226b21 END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + ELSE IF (.NOT.branch .LT. 20) THEN + temp226b22 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp226b22 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp226b22 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp226b22 END IF - temp361b = distp(0, 1+ic)*zb(indorbp, indt+i) + 140 temp226b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp361b - funb = funb + rmu(i, 0)*temp361b + rmub(i, 0) = rmub(i, 0) + fun*temp226b + funb0 = funb0 + rmu(i, 0)*temp226b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp360 = r(0)**4 - temp360b = distp(0, 1)*fun2b - temp359 = 4.d0*dd1 - temp358 = 7.d0/temp359 - distpb(0, 1) = distpb(0, 1) + (2.d0*(dd1*r(0)**2)-11.d0/2.d0)*funb& -& + (temp358-r(0)**2)*fun0b + (17.d0*(dd1*r(0)**2)-11.d0/2.d0-4.d0& -& *(dd1**2*temp360))*fun2b - temp360b0 = distp(0, 1)*2.d0*funb - dd1b = r(0)**2*temp360b0 - distp(0, 1)*temp358*4.d0*fun0b/temp359 & -& + (17.d0*r(0)**2-4.d0*temp360*2*dd1)*temp360b - rb(0) = rb(0) + dd1*2*r(0)*temp360b0 - distp(0, 1)*2*r(0)*fun0b + & -& (17.d0*dd1*2*r(0)-4.d0*dd1**2*4*r(0)**3)*temp360b + temp225 = r(0)**4 + temp225b12 = -(2.d0*distp(0, 1)*fun2b) + temp225b13 = 2.d0*distp(0, 1)*funb0 + dd1b = r(0)**2*temp225b13 + (2.d0*temp225*2*dd1-5.d0*r(0)**2)*& +& temp225b12 + rb(0) = rb(0) + dd1*2*r(0)*temp225b13 - distp(0, 1)*2*r(0)*fun0b +& +& (2.d0*dd1**2*4*r(0)**3-5.d0*dd1*2*r(0))*temp225b12 + distpb(0, 1) = distpb(0, 1) + 2.d0*(dd1*r(0)**2-1.d0)*funb0 - r(0)& +& **2*fun0b - 2.d0*(2.d0*(dd1**2*temp225)-5.d0*(dd1*r(0)**2)+1.d0)& +& *fun2b CALL POPREAL8(adr8ibuf,adr8buf,dd1) ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 END IF - dd1b = 0.0_8 - DO ic=5,1,-1 + DO ic=7,1,-1 DO k=0,0,-1 - temp358b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) - temp357 = 4.d0*dd1 - temp356 = 7.d0/temp357 - temp356b = (temp356-r(k)**2)*zb(indorbp, k) - dd1b = dd1b - temp356*4.d0*temp358b/temp357 - rb(k) = rb(k) - 2*r(k)*temp358b - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp356b - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp356b + temp225b11 = -(r(k)**2*zb(indorbp, k)) + rb(k) = rb(k) - distp(k, 1)*distp(k, 1+ic)*2*r(k)*zb(indorbp, k) + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp225b11 + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp225b11 zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) + temp225b3 = cost4f*rmu(2, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 8) - 2*rmu(2, i)*temp225b3 + distpb(i, 8) = 0.0_8 + temp225b4 = cost4f*rmu(1, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& +& distpb(i, 7) + 2*rmu(1, i)*temp225b4 + 3.d0*2*rmu(1, i)*& +& temp225b3 + rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp225b4 + distpb(i, 7) = 0.0_8 + temp225b5 = cost3f*2.d0*distpb(i, 6) + temp225b6 = rmu(2, i)*temp225b5 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp225b6 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp225b6 + rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp225b5 distpb(i, 6) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) + temp225b7 = cost3f*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 5) + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp225b7 distpb(i, 5) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 4) - 2*rmu(2, i)*temp225b7 + temp225b8 = cost2f*rmu(2, i)*distpb(i, 4) + rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp225b8 distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) + temp225b9 = cost2f*rmu(1, i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 3) distpb(i, 3) = 0.0_8 - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) + temp225b10 = cost1f*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - 2*r(i)*temp225b9 - 3.d0*2*r(i)*temp225b10 - 2*r(i)& +& *temp225b8 + rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& +& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp225b10 + 5.d0*2*rmu(3, i)*& +& temp225b9 distpb(i, 2) = 0.0_8 END DO - cb = 0.0_8 + dd1b = 0.0_8 DO k=0,0,-1 - temp355 = r(k)**2 - temp355b1 = c*DEXP(-(dd1*temp355))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp355))*distpb(k, 1) - dd1b = dd1b - temp355*temp355b1 - rb(k) = rb(k) - dd1*2*r(k)*temp355b1 + temp225b2 = DEXP(-(dd1*r(k)**2))*distpb(k, 1) + dd1b = dd1b - r(k)**2*temp225b2 + rb(k) = rb(k) - dd1*2*r(k)*temp225b2 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 1.64592278064948967213d0*1.75d0*dd1**0.75D0*cb ddb(indparp) = ddb(indparp) + dd1b - CASE (46) -! derivative of 17 with respect to z -! R(r)=c*r**2*exp(-z*r**2)*(7/4/z-r**2) -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 + CASE (83) +! R(r)=x*exp(-z*r**2)*(5/4/z-r**2) dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then - c = 4.d0*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)/DSQRT(15.d0) -! endif + dd2 = DSQRT(dd1) + c = dd1**1.25d0*ratiocp DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) + END DO +! indorbp=indorb +! + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*dd2*r(i))/(1.d0+dd2*r(i))**2 + END DO END DO +! endif IF (typec .NE. 1) THEN - rp1 = r(0)**2 -! the first derivative / r - fun = distp(0, 1)*(7.d0-15.d0*dd1*rp1+4.d0*(dd1*rp1)**2)/2.d0/dd1 -! the second derivative - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*rp2)/rp3 + fun = 0.25d0*distp(0, 1)*(-18.d0-39.d0*rp2-20.d0*rp1+rp1*rp2+2.d0*& +& rp1**2)/rp3**2 + fun2 = 0.25d0*distp(0, 1)*(-18.d0-42.d0*rp2+30.d0*rp1+138.d0*rp1*& +& rp2+113.d0*rp1**2+30.d0*rp1**2*rp2-3.d0*rp1**3-2.d0*rp1**3*rp2)/& +& rp3**3 +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp233b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp233b0 + fun2b = fun2b + temp233b0 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp233b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp233b + funb0 = funb0 + rmu(ic, 0)*temp233b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp367 = 2.d0*dd1 - temp366 = distp(0, 1)/temp367 - temp367b = temp366*fun2b - temp367b0 = 50*2*dd1*rp1*temp367b - temp367b1 = -(8*3*dd1**2*rp1**2*temp367b) - temp366b = (50*(dd1*rp1)**2-59*(dd1*rp1)-8*(dd1*rp1)**3+7.d0)*& -& fun2b/temp367 - temp365 = 2.d0*dd1 - temp364 = distp(0, 1)/temp365 - temp365b = temp364*funb - temp364b = (4.d0*(dd1**2*rp1**2)-15.d0*(dd1*rp1)+7.d0)*funb/& -& temp365 - dd1b = (4.d0*rp1**2*2*dd1-15.d0*rp1)*temp365b - temp364*2.d0*& -& temp364b - temp366*2.d0*temp366b + rp1*temp367b1 - 59*rp1*& -& temp367b + rp1*temp367b0 - rp1b = (4.d0*dd1**2*2*rp1-15.d0*dd1)*temp365b + dd1*temp367b1 - 59& -& *dd1*temp367b + dd1*temp367b0 - distpb(0, 1) = temp364b + temp366b - rb(0) = rb(0) + 2*r(0)*rp1b + temp232 = rp3**3 + temp230 = distp(0, 1)/temp232 + temp231 = rp1**3 + temp231b = 0.25d0*temp230*fun2b + temp230b = 0.25d0*(30.d0*rp1-42.d0*rp2+138.d0*(rp1*rp2)+113.d0*rp1& +& **2+30.d0*(rp1**2*rp2)-3.d0*rp1**3-2.d0*(temp231*rp2)-18.d0)*& +& fun2b/temp232 + temp229 = rp3**2 + temp228 = distp(0, 1)/temp229 + temp229b = 0.25d0*temp228*funb0 + rp1b = (2.d0*2*rp1+rp2-20.d0)*temp229b + (30.d0*rp2*2*rp1-3.d0*3*& +& rp1**2-2.d0*rp2*3*rp1**2+113.d0*2*rp1+138.d0*rp2+30.d0)*temp231b + temp228b2 = 0.25d0*(rp1*rp2-20.d0*rp1-39.d0*rp2+2.d0*rp1**2-18.d0)& +& *funb0/temp229 + temp228b3 = distp(0, 1)*fun0b + costb = -(r(0)**2*temp228b3) + rp3b = -(temp228*2*rp3*temp228b2) - (0.5d0*rp2+1.d0)*costb/rp3**2 & +& - temp230*3*rp3**2*temp230b + rp2b = (rp1-39.d0)*temp229b + 2*(rp2+1.d0)*rp3b + 0.5d0*costb/rp3 & +& + (30.d0*rp1**2-2.d0*temp231+138.d0*rp1-42.d0)*temp231b + distpb(0, 1) = temp228b2 + (1.25d0/dd1-r(0)**2*cost)*fun0b + & +& temp230b + dd1b = r(0)**2*rp1b - 1.25d0*temp228b3/dd1**2 + rb(0) = rb(0) + dd2*rp2b + dd1*2*r(0)*rp1b - cost*2*r(0)*temp228b3 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = r(0)*rp2b ELSE distpb = 0.0_8 dd1b = 0.0_8 + dd2b = 0.0_8 END IF - DO i=0,0,-1 - temp363 = 4.d0*dd1 - temp362 = r(i)**2/temp363 - temp363b = distp(i, 1)*zb(indorbp, i) - temp362b = 7.d0*temp363b/temp363 - distpb(i, 1) = distpb(i, 1) + (7.d0*temp362-r(i)**4)*zb(indorbp, i& -& ) - rb(i) = rb(i) + 2*r(i)*temp362b - 4*r(i)**3*temp363b - dd1b = dd1b - temp362*4.d0*temp362b - zb(indorbp, i) = 0.0_8 + DO ic=3,1,-1 + DO i=0,0,-1 + temp228b = (1.25d0/dd1-r(i)**2*cost)*zb(indorbp, i) + temp228b0 = rmu(ic, i)*distp(i, 1)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp228b + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp228b + dd1b = dd1b - 1.25d0*temp228b0/dd1**2 + costb = -(r(i)**2*temp228b0) + temp227 = dd2*r(i) + 1.d0 + temp228b1 = costb/temp227**2 + temp227b0 = -((0.5d0*(dd2*r(i))+1.d0)*2*temp228b1/temp227) + rb(i) = rb(i) + 0.5d0*dd2*temp228b1 + dd2*temp227b0 - cost*2*r(i& +& )*temp228b0 + zb(indorbp, i) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = dd2b + r(i)*temp227b0 + 0.5d0*r(i)*temp228b1 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO cb = 0.0_8 DO k=0,0,-1 - temp361 = r(k)**2 - temp361b5 = c*DEXP(-(dd1*temp361))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp361))*distpb(k, 1) - dd1b = dd1b - temp361*temp361b5 - rb(k) = rb(k) - dd1*2*r(k)*temp361b5 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp226 = dd2*r(k) + 1.d0 + temp227b = costb/temp226 + temp226b24 = -(dd1*r(k)**2*temp227b/temp226) + dd1b = dd1b + r(k)**2*temp227b + rb(k) = rb(k) + dd2*temp226b24 + dd1*2*r(k)*temp227b + dd2b = dd2b + r(k)*temp226b24 END DO - IF (.NOT.(dd1 .LE. 0.0 .AND. (7.d0/4.d0 .EQ. 0.0 .OR. 7.d0/4.d0 .NE.& -& INT(7.d0/4.d0)))) dd1b = dd1b + (2.d0/pi)**(3.d0/4.d0)*7.d0*dd1& -& **(7.d0/4.d0-1)*cb/DSQRT(15.d0) + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocp*1.25d0*dd1**0.25D0*cb + ELSE + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocp*1.25d0*dd1**0.25D0*& +& cb + END IF ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (50) -! 5s single zeta derivative of 12 -! R(r)=(c0*r**4+c1*r**3)*exp(-z1*r) -! -! if(iocc(indshellp).eq.1) then + CASE (81) +! R(r)=c*exp(-z*r**2)*(3/4/z-r**2) +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then - c = DSQRT((2*dd1)**9/40320.d0/pi)/2.d0 -! endif - c0 = -c - c1 = 4.5d0*c/dd1 + dd2 = DSQRT(dd1) +! c=(2.d0*dd1/pi)**(3.d0/4.d0)*ratiocs + c = dd1**0.75d0*ratiocs DO k=0,0 - distp(k, 1) = r(k)*DEXP(-(dd1*r(k))) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) + END DO + DO i=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*dd2*r(i))/(1.d0+dd2*r(i))**2 END DO IF (typec .NE. 1) THEN - rp1 = r(0)*dd1 - rp2 = rp1*rp1 -!c the first derivative/r - fun = -(distp(0, 1)*(c0*r(0)*(rp1-4.d0)+c1*(rp1-3.d0))) -!c -!c the second derivative - funb = 2.d0*zb(indorbp, indt+4) +! the first derivative /r + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + fun = 0.25d0*distp(0, 1)*(-14.d0-29.d0*rp2-12.d0*rp1+3.d0*rp1*rp2+& +& 2.d0*rp1**2)/rp3**2 +! the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp371 = rp2 - 8.d0*rp1 + 12.d0 - temp370 = c0*r(0) - temp370b0 = distp(0, 1)*fun2b - distpb(0, 1) = (temp370*temp371+c1*(rp2-6*rp1+6.d0))*fun2b - (c0*r& -& (0)*(rp1-4.d0)+c1*(rp1-3.d0))*funb - temp370b1 = -(distp(0, 1)*funb) - c0b = (rp1-4.d0)*r(0)*temp370b1 + temp371*r(0)*temp370b0 - rp2b = (c1+temp370)*temp370b0 - rp1b = (c1+c0*r(0))*temp370b1 + 2*rp1*rp2b + ((-6)*c1-temp370*8.d0& -& )*temp370b0 - rb(0) = rb(0) + (rp1-4.d0)*c0*temp370b1 + dd1*rp1b + temp371*c0*& -& temp370b0 - c1b = (rp1-3.d0)*temp370b1 + (rp2-6*rp1+6.d0)*temp370b0 - dd1b = r(0)*rp1b + temp241 = rp3**3 + temp239 = distp(0, 1)/temp241 + temp240 = rp1**3 + temp240b = 0.25d0*temp239*fun2b + temp239b = 0.25d0*(34.d0*rp1-30.d0*rp2+118.d0*(rp1*rp2)+87.d0*rp1& +& **2+18.d0*(rp1**2*rp2)-5.d0*rp1**3-2.d0*(temp240*rp2)-14.d0)*& +& fun2b/temp241 + temp238 = rp3**2 + temp237 = distp(0, 1)/temp238 + temp238b = 0.25d0*temp237*funb0 + rp1b = (2.d0*2*rp1+3.d0*rp2-12.d0)*temp238b + (18.d0*rp2*2*rp1-& +& 5.d0*3*rp1**2-2.d0*rp2*3*rp1**2+87.d0*2*rp1+118.d0*rp2+34.d0)*& +& temp240b + temp237b = 0.25d0*(3.d0*(rp1*rp2)-12.d0*rp1-29.d0*rp2+2.d0*rp1**2-& +& 14.d0)*funb0/temp238 + rp3b = -(temp237*2*rp3*temp237b) - temp239*3*rp3**2*temp239b + rp2b = (3.d0*rp1-29.d0)*temp238b + 2*(rp2+1.d0)*rp3b + (18.d0*rp1& +& **2-2.d0*temp240+118.d0*rp1-30.d0)*temp240b + distpb(0, 1) = temp237b + temp239b + dd2b = r(0)*rp2b + rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b + dd1b = r(0)**2*rp1b ELSE distpb = 0.0_8 - c0b = 0.0_8 - c1b = 0.0_8 dd1b = 0.0_8 + dd2b = 0.0_8 END IF DO i=0,0,-1 - temp370b = distp(i, 1)*zb(indorbp, i) - temp369 = r(i)**3 - c0b = c0b + temp369*temp370b - rb(i) = rb(i) + (c1*2*r(i)+c0*3*r(i)**2)*temp370b - c1b = c1b + r(i)**2*temp370b - distpb(i, 1) = distpb(i, 1) + (c0*temp369+c1*r(i)**2)*zb(indorbp, & -& i) + temp236 = 4.d0*dd1 + temp235 = 3.d0/temp236 + temp235b = distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + (temp235-r(i)**2*cost)*zb(indorbp, i& +& ) + dd1b = dd1b - temp235*4.d0*temp235b/temp236 + costb = -(r(i)**2*temp235b) + temp234 = dd2*r(i) + 1.d0 + temp235b0 = costb/temp234**2 + temp234b0 = -((0.5d0*(dd2*r(i))+1.d0)*2*temp235b0/temp234) + rb(i) = rb(i) + 0.5d0*dd2*temp235b0 + dd2*temp234b0 - cost*2*r(i)*& +& temp235b zb(indorbp, i) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = dd2b + r(i)*temp234b0 + 0.5d0*r(i)*temp235b0 END DO + cb = 0.0_8 DO k=0,0,-1 - temp369b0 = r(k)*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1*temp369b0 - dd1b = dd1b - r(k)*temp369b0 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp233 = dd2*r(k) + 1.d0 + temp234b = costb/temp233 + temp233b1 = -(dd1*r(k)**2*temp234b/temp233) + dd1b = dd1b + r(k)**2*temp234b + rb(k) = rb(k) + dd2*temp233b1 + dd1*2*r(k)*temp234b + dd2b = dd2b + r(k)*temp233b1 END DO - temp369b = 4.5d0*c1b/dd1 - cb = temp369b - c0b - temp368 = 2**9 - IF (temp368*(dd1**9/(40320.d0*pi)) .EQ. 0.0) THEN - dd1b = dd1b - c*temp369b/dd1 + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocs*0.75d0*dd1**(-0.25D0)*cb ELSE - dd1b = dd1b + temp368*9*dd1**8*cb/(2.d0*2.D0*DSQRT(temp368*(dd1**9& -& /(40320.d0*pi)))*40320.d0*pi) - c*temp369b/dd1 + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocs*0.75d0*dd1**(& +& -0.25D0)*cb END IF ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (51) -! -! g single gaussian orbital -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0) - c = dd1**2.75d0*1.11284691281640568826d0 -! endif + CASE (130) +! 2p single exponential r^2 e^{-z r} ! parent of 121 + dd2 = dd(indpar+1) DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) - END DO - DO i=0,0 - distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& -& 2+3.d0*r(i)**4) -! lz=0 - distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& -& 2-r(i)**2) -! lz=+/-2 - distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& -& (i)**2) -! lz=+/-2 - distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & -& i)**2) -! lz=+/-3 - distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& -& , i)**2) -! lz=+/-3 - distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& -& rmu(2, i)**4) -! lz=+/-4 - distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& -& , i)**2) + distp(k, 1) = DEXP(-(dd2*r(k))) END DO -! lz=+/-4 - DO ic=1,9 +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO ! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1) - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) + fun = distp(0, 1)*(2.d0-dd2*r(0)) + fun2 = (2.d0-4.d0*dd2*r(0)+(dd2*r(0))**2)*distp(0, 1) ! indorbp=indorb - DO ic=1,9 + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - IF (ic .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) - ELSE IF (ic .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (ic .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE IF (ic .EQ. 4) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (ic .EQ. 5) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - ELSE IF (ic .EQ. 6) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE IF (ic .EQ. 7) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (ic .EQ. 8) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - ELSE IF (ic .EQ. 9) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - END IF + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=9,1,-1 - temp373b74 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 10.d0*temp373b74 - fun2b = fun2b + temp373b74 + DO ic=3,1,-1 + temp242b4 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp242b4 + fun2b = fun2b + temp242b4 zb(indorbp, indt+4) = 0.0_8 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - IF (branch .LT. 1) THEN - temp373b19 = cost1g*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-60.d0*& -& (rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+2) + cost1g& -& *(12.d0*(rmu(1, 0)*r(0)**2)-60.d0*(rmu(1, 0)*rmu(3, 0)& -& **2))*zb(indorbp, indt+1) + cost1g*(80.d0*rmu(3, 0)**3& -& -48.d0*(rmu(3, 0)*r(0)**2))*zb(indorbp, indt+3) - rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*r(& -& 0)**2)*temp373b19 - temp373b20 = cost1g*fun0*zb(indorbp, indt+2) - temp373b21 = cost1g*fun0*zb(indorbp, indt+1) - rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp373b20 + & -& 12.d0*rmu(1, 0)*2*r(0)*temp373b21 - 48.d0*rmu(3, 0)*2*& -& r(0)*temp373b19 - rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3, 0)& -& **2)*temp373b20 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0)*& -& temp373b20 - rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3, 0)& -& **2)*temp373b21 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0)*& -& temp373b21 - ELSE - temp373b22 = -(cost2g*3.d0*zb(indorbp, indt+3)) - temp373b23 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**& -& 2)*temp373b22 - temp373b24 = fun0*rmu(1, 0)*temp373b22 - temp373b25 = -(cost2g*6.d0*zb(indorbp, indt+2)) - temp373b26 = rmu(2, 0)*rmu(3, 0)*temp373b25 - fun0b = fun0b + rmu(1, 0)*temp373b26 + cost2g*(4.d0*rmu(& -& 3, 0)**3-3.d0*(rmu(2, 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)& -& **2*rmu(3, 0)))*zb(indorbp, indt+1) + rmu(1, 0)*& -& temp373b23 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp373b24 + fun0*& -& temp373b23 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp373b24 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp373b24 - temp373b27 = fun0*rmu(1, 0)*temp373b25 - rmub(1, 0) = rmub(1, 0) + fun0*temp373b26 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp373b27 - temp373b28 = cost2g*fun0*zb(indorbp, indt+1) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*rmu(& -& 2, 0)**2-9.d0*rmu(1, 0)**2)*temp373b28 + rmu(2, 0)*& -& temp373b27 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp373b28 - rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp373b28 - END IF - ELSE - temp373b29 = -(cost2g*3.d0*zb(indorbp, indt+3)) - temp373b30 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**2)& -& *temp373b29 - temp373b31 = fun0*rmu(2, 0)*temp373b29 - temp373b32 = -(cost2g*6.d0*zb(indorbp, indt+1)) - temp373b33 = rmu(2, 0)*rmu(3, 0)*temp373b32 - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2, 0)& -& **2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb(indorbp& -& , indt+2) + rmu(1, 0)*temp373b33 + rmu(2, 0)*temp373b30 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp373b31 + fun0*& -& temp373b30 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp373b31 - temp373b34 = cost2g*fun0*zb(indorbp, indt+2) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*rmu(2& -& , 0)**2-3.d0*rmu(1, 0)**2)*temp373b34 - 4.d0*2*rmu(3, 0)& -& *temp373b31 - rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp373b34 - rmub(1, 0) = rmub(1, 0) + fun0*temp373b33 - 3.d0*rmu(3, 0)& -& *2*rmu(1, 0)*temp373b34 - temp373b35 = fun0*rmu(1, 0)*temp373b32 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp373b35 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp373b35 - END IF - ELSE IF (branch .LT. 4) THEN - temp373b36 = cost3g*12.d0*zb(indorbp, indt+3) - temp373b37 = fun0*rmu(3, 0)*temp373b36 - temp373b38 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp373b36 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp373b37 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp373b37 - temp373b39 = cost3g*4.d0*zb(indorbp, indt+2) - temp373b40 = -(cost3g*4.d0*zb(indorbp, indt+1)) - fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)**2))& -& *temp373b39 + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)**2))& -& *temp373b40 + rmu(3, 0)*temp373b38 - rmub(3, 0) = rmub(3, 0) + fun0*temp373b38 - temp373b41 = fun0*temp373b39 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)**2)& -& *temp373b41 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& -& temp373b41 - temp373b42 = fun0*temp373b40 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)**2)& -& *temp373b42 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& -& temp373b42 - ELSE - temp373b43 = cost3g*24.d0*zb(indorbp, indt+3) - temp373b44 = rmu(2, 0)*rmu(3, 0)*temp373b43 - temp373b45 = fun0*rmu(1, 0)*temp373b43 - temp373b46 = -(cost3g*2.d0*zb(indorbp, indt+2)) - temp373b47 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0)& -& **2)*temp373b46 - temp373b48 = -(cost3g*2.d0*zb(indorbp, indt+1)) - temp373b49 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3, 0)& -& **2)*temp373b48 - fun0b = fun0b + rmu(1, 0)*temp373b47 + rmu(2, 0)*temp373b49 & -& + rmu(1, 0)*temp373b44 - rmub(1, 0) = rmub(1, 0) + fun0*temp373b44 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp373b45 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp373b45 - temp373b50 = fun0*rmu(1, 0)*temp373b46 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp373b50 + fun0*& -& temp373b47 - rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp373b50 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp373b50 - temp373b51 = fun0*rmu(2, 0)*temp373b48 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp373b51 + fun0*& -& temp373b49 - rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp373b51 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp373b51 - END IF - ELSE IF (branch .LT. 8) THEN - IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp373b52 = cost4g*fun0*zb(indorbp, indt+3) - temp373b53 = -(cost4g*6.d0*zb(indorbp, indt+2)) - temp373b54 = rmu(2, 0)*rmu(3, 0)*temp373b53 - temp373b55 = cost4g*3.d0*zb(indorbp, indt+1) - temp373b56 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp373b55 - fun0b = fun0b + rmu(1, 0)*temp373b54 + rmu(3, 0)*& -& temp373b56 + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2& -& , 0)**2))*zb(indorbp, indt+3) - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**& -& 2)*temp373b52 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp373b52 - temp373b57 = fun0*rmu(1, 0)*temp373b53 - rmub(1, 0) = rmub(1, 0) + fun0*temp373b54 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp373b57 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp373b57 - temp373b58 = fun0*rmu(3, 0)*temp373b55 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp373b58 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp373b58 - rmub(3, 0) = rmub(3, 0) + fun0*temp373b56 - ELSE - temp373b59 = cost4g*fun0*zb(indorbp, indt+3) - temp373b60 = cost4g*3.d0*zb(indorbp, indt+2) - temp373b61 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp373b60 - temp373b62 = cost4g*6.d0*zb(indorbp, indt+1) - temp373b63 = rmu(2, 0)*rmu(3, 0)*temp373b62 - fun0b = fun0b + rmu(3, 0)*temp373b61 + rmu(1, 0)*& -& temp373b63 + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2& -& , 0)**3)*zb(indorbp, indt+3) - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp373b59 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp373b59 - temp373b64 = fun0*rmu(3, 0)*temp373b60 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp373b64 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp373b64 - rmub(3, 0) = rmub(3, 0) + fun0*temp373b61 - temp373b65 = fun0*rmu(1, 0)*temp373b62 - rmub(1, 0) = rmub(1, 0) + fun0*temp373b63 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp373b65 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp373b65 - END IF - ELSE - temp373b66 = cost5g*4.d0*zb(indorbp, indt+2) - temp373b67 = fun0*temp373b66 - temp373b68 = cost5g*4.d0*zb(indorbp, indt+1) - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& -& *temp373b68 + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)))& -& *temp373b66 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**2)& -& *temp373b67 - temp373b69 = fun0*temp373b68 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& -& *temp373b69 - 3.d0*rmu(2, 0)*2*rmu(1, 0)*temp373b67 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp373b69 - END IF - ELSE IF (.NOT.branch .LT. 9) THEN - temp373b70 = cost5g*4.d0*zb(indorbp, indt+2) - temp373b71 = fun0*temp373b70 - temp373b72 = cost5g*4.d0*zb(indorbp, indt+1) - fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**3)*& -& temp373b72 + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))*& -& temp373b70 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)*& -& temp373b71 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp373b71 - temp373b73 = fun0*temp373b72 - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp373b73 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**2)*& -& temp373b73 - END IF DO i=3,1,-1 - temp373b18 = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp373b18 - funb = funb + rmu(i, 0)*temp373b18 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp242b3 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp242b3 + funb0 = funb0 + rmu(ic, 0)*temp242b3 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp373b17 = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp373b17 - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp373b17 - distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + distpb = 0.0_8 + temp242b1 = distp(0, 1)*fun2b + temp242b2 = 2*dd2*r(0)*temp242b1 + dd2b = r(0)*temp242b2 - 4.d0*r(0)*temp242b1 - distp(0, 1)*r(0)*& +& funb0 + rb(0) = rb(0) + distp(0, 1)*2*r(0)*fun0b - distp(0, 1)*dd2*funb0 -& +& 4.d0*dd2*temp242b1 + dd2*temp242b2 + distpb(0, 1) = (2.d0-dd2*r(0))*funb0 + r(0)**2*fun0b + ((dd2*r(0))& +& **2-4.d0*(dd2*r(0))+2.d0)*fun2b ELSE distpb = 0.0_8 + dd2b = 0.0_8 END IF - DO ic=9,1,-1 - DO k=0,0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) - zb(indorbp, k) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO i=0,0,-1 - temp373b = cost5g*4.d0*distpb(i, 10) - temp373b0 = (rmu(1, i)**2-rmu(2, i)**2)*temp373b - temp373b1 = rmu(1, i)*rmu(2, i)*temp373b - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp373b1 + rmu(2, i)*& -& temp373b0 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp373b0 - 2*rmu(2, i)*& -& temp373b1 - distpb(i, 10) = 0.0_8 - temp373b2 = cost5g*distpb(i, 9) - rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& -& 1, i))*temp373b2 - distpb(i, 9) = 0.0_8 - temp373b3 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) - temp373b4 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp373b3 - 2*rmu(2, i)*& -& temp373b4 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& -& temp373b2 - rmub(3, i) = rmub(3, i) + rmu(2, i)*temp373b3 - distpb(i, 8) = 0.0_8 - temp373b5 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) - temp373b6 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp373b5 + 2*rmu(1, i)*& -& temp373b6 + 3.d0*2*rmu(1, i)*temp373b4 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp373b5 - rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp373b6 - distpb(i, 7) = 0.0_8 - temp373b7 = cost3g*2.d0*distpb(i, 6) - temp373b8 = (7.d0*rmu(3, i)**2-r(i)**2)*temp373b7 - temp373b9 = rmu(1, i)*rmu(2, i)*temp373b7 - rmub(1, i) = rmub(1, i) + rmu(2, i)*temp373b8 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp373b8 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp373b9 - distpb(i, 6) = 0.0_8 - temp373b10 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) - temp373b11 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - temp373b12 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) - temp373b13 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - temp373b14 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) - temp373b15 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - temp373b16 = cost1g*distpb(i, 2) - rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& -& temp373b16 - 3.d0*2*r(i)*temp373b15 - 2*r(i)*temp373b11 - 3.d0*2& -& *r(i)*temp373b13 - 2*r(i)*temp373b9 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp373b10 - rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp373b10 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp373b11 - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp373b12 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp373b13 + rmu(2, i)*& -& temp373b12 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp373b14 - rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& -& rmu(3, i))*temp373b16 + 7.d0*2*rmu(3, i)*temp373b15 + rmu(1, i)*& -& temp373b14 - distpb(i, 2) = 0.0_8 + DO ic=3,1,-1 + DO i=0,0,-1 + temp242b0 = r(i)**2*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp242b0 + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp242b0 + rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*2*r(i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - dd1b = 0.0_8 - cb = 0.0_8 DO k=0,0,-1 - temp372 = r(k)**2 - temp372b = c*DEXP(-(dd1*temp372))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp372))*distpb(k, 1) - dd1b = dd1b - temp372*temp372b - rb(k) = rb(k) - dd1*2*r(k)*temp372b + temp242b = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp242b + rb(k) = rb(k) - dd2*temp242b distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 1.11284691281640568826d0*2.75d0*dd1**1.75D0*cb - ddb(indparp) = ddb(indparp) + dd1b - CASE (52) + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (89) ! g single gaussian orbital ! derivative of 51 ! R(r)= exp(-alpha r^2) @@ -12728,13 +12527,16 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd ! indorbp=indorb indparp = indpar + 1 dd1 = dd(indparp) -! if(iflagnorm.gt.2) then + dd2 = DSQRT(dd1) +! if(iflagnorm.gt.2) then ! overall normalization -! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0) - c = dd1**2.75d0*1.11284691281640568826d0 -! endif +! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0)*ratiocg + c = dd1**2.75d0*ratiocg +! endif DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) END DO DO i=0,0 distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& @@ -12769,15 +12571,24 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic + DO k=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 + END DO END DO ! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1)*(11.d0/4.d0/dd1-r(0)**2) - fun = distp(0, 1)*(2.d0*dd1*r(0)**2-15.d0/2.d0) - fun2 = distp(0, 1)*(-(4.d0*dd1**2*r(0)**4)+21.d0*dd1*r(0)**2-15.d0& -& /2.d0) + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*rp2)/rp3 + fun0 = distp(0, 1)*(11.d0/4.d0/dd1-r(0)**2*cost) + fun = 0.25d0*distp(0, 1)*(-30.d0-69.d0*rp2-44.d0*rp1-5.d0*rp1*rp2+& +& 2.d0*rp1**2)/rp3**2 + fun2 = 0.25d0*distp(0, 1)*(-30.d0-78.d0*rp2+18.d0*rp1+198.d0*rp1*& +& rp2+191.d0*rp1**2+66.d0*rp1**2*rp2+3.d0*rp1**3-2.d0*rp1**3*rp2)/& +& rp3**3 ! indorbp=indorb DO ic=1,9 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -12862,15 +12673,15 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=9,1,-1 - temp379b55 = distp(0, 1+ic)*zb(indorbp, indt+4) + temp253b55 = distp(0, 1+ic)*zb(indorbp, indt+4) distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& & , indt+4) - funb = funb + 10.d0*temp379b55 - fun2b = fun2b + temp379b55 + funb0 = funb0 + 10.d0*temp253b55 + fun2b = fun2b + temp253b55 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -12879,2046 +12690,1374 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN IF (branch .LT. 2) THEN - temp379b0 = cost1g*fun0*zb(indorbp, indt+i) + temp253b0 = cost1g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& & 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& & ) rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp379b0 - rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp379b0 +& , 0)**2)*temp253b0 + rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp253b0 rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& -& )*temp379b0 +& )*temp253b0 ELSE - temp379b1 = cost1g*fun0*zb(indorbp, indt+i) + temp253b1 = cost1g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& & 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& & ) rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp379b1 - rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp379b1 +& , 0)**2)*temp253b1 + rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp253b1 rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& -& )*temp379b1 +& )*temp253b1 END IF ELSE IF (branch .LT. 4) THEN - temp379b2 = cost1g*fun0*zb(indorbp, indt+i) + temp253b2 = cost1g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& & 3, 0)*r(0)**2))*zb(indorbp, indt+i) rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& -& r(0)**2)*temp379b2 - rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp379b2 +& r(0)**2)*temp253b2 + rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp253b2 ELSE - temp379b3 = cost2g*fun0*zb(indorbp, indt+i) + temp253b3 = cost2g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& & , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& & (indorbp, indt+i) rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& -& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp379b3 +& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp253b3 rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp379b3 +& temp253b3 rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp379b3 +& temp253b3 END IF ELSE IF (branch .LT. 7) THEN IF (branch .LT. 6) THEN - temp379b4 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp379b5 = rmu(2, 0)*rmu(3, 0)*temp379b4 - temp379b6 = fun0*rmu(1, 0)*temp379b4 - fun0b = fun0b + rmu(1, 0)*temp379b5 - rmub(1, 0) = rmub(1, 0) + fun0*temp379b5 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp379b6 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp379b6 + temp253b4 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp253b5 = rmu(2, 0)*rmu(3, 0)*temp253b4 + temp253b6 = fun0*rmu(1, 0)*temp253b4 + fun0b = fun0b + rmu(1, 0)*temp253b5 + rmub(1, 0) = rmub(1, 0) + fun0*temp253b5 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp253b6 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp253b6 ELSE - temp379b7 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp379b8 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& -& **2)*temp379b7 - temp379b9 = fun0*rmu(1, 0)*temp379b7 - fun0b = fun0b + rmu(1, 0)*temp379b8 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp379b9 + fun0& -& *temp379b8 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp379b9 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp379b9 + temp253b7 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp253b8 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& +& **2)*temp253b7 + temp253b9 = fun0*rmu(1, 0)*temp253b7 + fun0b = fun0b + rmu(1, 0)*temp253b8 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp253b9 + fun0& +& *temp253b8 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp253b9 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp253b9 END IF ELSE - temp379b10 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp379b11 = rmu(2, 0)*rmu(3, 0)*temp379b10 - temp379b12 = fun0*rmu(1, 0)*temp379b10 - fun0b = fun0b + rmu(1, 0)*temp379b11 - rmub(1, 0) = rmub(1, 0) + fun0*temp379b11 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp379b12 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp379b12 + temp253b10 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp253b11 = rmu(2, 0)*rmu(3, 0)*temp253b10 + temp253b12 = fun0*rmu(1, 0)*temp253b10 + fun0b = fun0b + rmu(1, 0)*temp253b11 + rmub(1, 0) = rmub(1, 0) + fun0*temp253b11 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp253b12 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp253b12 END IF ELSE IF (branch .LT. 12) THEN IF (branch .LT. 10) THEN IF (branch .LT. 9) THEN - temp379b13 = cost2g*fun0*zb(indorbp, indt+i) + temp253b13 = cost2g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& & , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& & (indorbp, indt+i) rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& -& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp379b13 +& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp253b13 rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp379b13 +& temp253b13 rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp379b13 +& temp253b13 ELSE - temp379b14 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp379b15 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& -& **2)*temp379b14 - temp379b16 = fun0*rmu(2, 0)*temp379b14 - fun0b = fun0b + rmu(2, 0)*temp379b15 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp379b16 + & -& fun0*temp379b15 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp379b16 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp379b16 + temp253b14 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp253b15 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& +& **2)*temp253b14 + temp253b16 = fun0*rmu(2, 0)*temp253b14 + fun0b = fun0b + rmu(2, 0)*temp253b15 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp253b16 + & +& fun0*temp253b15 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp253b16 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp253b16 END IF ELSE IF (branch .LT. 11) THEN - temp379b17 = -(cost3g*4.d0*zb(indorbp, indt+i)) - temp379b18 = fun0*temp379b17 + temp253b17 = -(cost3g*4.d0*zb(indorbp, indt+i)) + temp253b18 = fun0*temp253b17 fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& -& **2))*temp379b17 +& **2))*temp253b17 rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp379b18 +& **2)*temp253b18 rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& -& temp379b18 +& temp253b18 ELSE - temp379b19 = cost3g*4.d0*zb(indorbp, indt+i) - temp379b20 = fun0*temp379b19 + temp253b19 = cost3g*4.d0*zb(indorbp, indt+i) + temp253b20 = fun0*temp253b19 fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& -& **2))*temp379b19 +& **2))*temp253b19 rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp379b20 +& **2)*temp253b20 rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& -& temp379b20 +& temp253b20 END IF ELSE IF (branch .LT. 14) THEN IF (branch .LT. 13) THEN - temp379b21 = cost3g*12.d0*zb(indorbp, indt+i) - temp379b22 = fun0*rmu(3, 0)*temp379b21 - temp379b23 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp379b21 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp379b22 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp379b22 - fun0b = fun0b + rmu(3, 0)*temp379b23 - rmub(3, 0) = rmub(3, 0) + fun0*temp379b23 + temp253b21 = cost3g*12.d0*zb(indorbp, indt+i) + temp253b22 = fun0*rmu(3, 0)*temp253b21 + temp253b23 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp253b21 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp253b22 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp253b22 + fun0b = fun0b + rmu(3, 0)*temp253b23 + rmub(3, 0) = rmub(3, 0) + fun0*temp253b23 ELSE - temp379b24 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp379b25 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3& -& , 0)**2)*temp379b24 - temp379b26 = fun0*rmu(2, 0)*temp379b24 - fun0b = fun0b + rmu(2, 0)*temp379b25 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp379b26 + fun0*& -& temp379b25 - rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp379b26 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp379b26 + temp253b24 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp253b25 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3& +& , 0)**2)*temp253b24 + temp253b26 = fun0*rmu(2, 0)*temp253b24 + fun0b = fun0b + rmu(2, 0)*temp253b25 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp253b26 + fun0*& +& temp253b25 + rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp253b26 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp253b26 END IF ELSE - temp379b27 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp379b28 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0& -& )**2)*temp379b27 - temp379b29 = fun0*rmu(1, 0)*temp379b27 - fun0b = fun0b + rmu(1, 0)*temp379b28 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp379b29 + fun0*& -& temp379b28 - rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp379b29 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp379b29 + temp253b27 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp253b28 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0& +& )**2)*temp253b27 + temp253b29 = fun0*rmu(1, 0)*temp253b27 + fun0b = fun0b + rmu(1, 0)*temp253b28 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp253b29 + fun0*& +& temp253b28 + rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp253b29 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp253b29 END IF ELSE IF (branch .LT. 22) THEN IF (branch .LT. 19) THEN IF (branch .LT. 17) THEN IF (branch .LT. 16) THEN - temp379b30 = cost3g*24.d0*zb(indorbp, indt+i) - temp379b31 = rmu(2, 0)*rmu(3, 0)*temp379b30 - temp379b32 = fun0*rmu(1, 0)*temp379b30 - fun0b = fun0b + rmu(1, 0)*temp379b31 - rmub(1, 0) = rmub(1, 0) + fun0*temp379b31 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp379b32 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp379b32 + temp253b30 = cost3g*24.d0*zb(indorbp, indt+i) + temp253b31 = rmu(2, 0)*rmu(3, 0)*temp253b30 + temp253b32 = fun0*rmu(1, 0)*temp253b30 + fun0b = fun0b + rmu(1, 0)*temp253b31 + rmub(1, 0) = rmub(1, 0) + fun0*temp253b31 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp253b32 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp253b32 ELSE - temp379b33 = cost4g*3.d0*zb(indorbp, indt+i) - temp379b34 = fun0*rmu(3, 0)*temp379b33 - temp379b35 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp379b33 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp379b34 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp379b34 - fun0b = fun0b + rmu(3, 0)*temp379b35 - rmub(3, 0) = rmub(3, 0) + fun0*temp379b35 + temp253b33 = cost4g*3.d0*zb(indorbp, indt+i) + temp253b34 = fun0*rmu(3, 0)*temp253b33 + temp253b35 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp253b33 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp253b34 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp253b34 + fun0b = fun0b + rmu(3, 0)*temp253b35 + rmub(3, 0) = rmub(3, 0) + fun0*temp253b35 END IF ELSE IF (branch .LT. 18) THEN - temp379b36 = -(cost4g*6.d0*zb(indorbp, indt+i)) - temp379b37 = rmu(2, 0)*rmu(3, 0)*temp379b36 - temp379b38 = fun0*rmu(1, 0)*temp379b36 - fun0b = fun0b + rmu(1, 0)*temp379b37 - rmub(1, 0) = rmub(1, 0) + fun0*temp379b37 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp379b38 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp379b38 + temp253b36 = -(cost4g*6.d0*zb(indorbp, indt+i)) + temp253b37 = rmu(2, 0)*rmu(3, 0)*temp253b36 + temp253b38 = fun0*rmu(1, 0)*temp253b36 + fun0b = fun0b + rmu(1, 0)*temp253b37 + rmub(1, 0) = rmub(1, 0) + fun0*temp253b37 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp253b38 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp253b38 ELSE - temp379b39 = cost4g*fun0*zb(indorbp, indt+i) + temp253b39 = cost4g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& & (2, 0)**2))*zb(indorbp, indt+i) rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp379b39 +& **2)*temp253b39 rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp379b39 +& temp253b39 END IF ELSE IF (branch .LT. 21) THEN IF (branch .LT. 20) THEN - temp379b40 = cost4g*6.d0*zb(indorbp, indt+i) - temp379b41 = rmu(2, 0)*rmu(3, 0)*temp379b40 - temp379b42 = fun0*rmu(1, 0)*temp379b40 - fun0b = fun0b + rmu(1, 0)*temp379b41 - rmub(1, 0) = rmub(1, 0) + fun0*temp379b41 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp379b42 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp379b42 + temp253b40 = cost4g*6.d0*zb(indorbp, indt+i) + temp253b41 = rmu(2, 0)*rmu(3, 0)*temp253b40 + temp253b42 = fun0*rmu(1, 0)*temp253b40 + fun0b = fun0b + rmu(1, 0)*temp253b41 + rmub(1, 0) = rmub(1, 0) + fun0*temp253b41 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp253b42 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp253b42 ELSE - temp379b43 = cost4g*3.d0*zb(indorbp, indt+i) - temp379b44 = fun0*rmu(3, 0)*temp379b43 - temp379b45 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp379b43 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp379b44 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp379b44 - fun0b = fun0b + rmu(3, 0)*temp379b45 - rmub(3, 0) = rmub(3, 0) + fun0*temp379b45 + temp253b43 = cost4g*3.d0*zb(indorbp, indt+i) + temp253b44 = fun0*rmu(3, 0)*temp253b43 + temp253b45 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp253b43 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp253b44 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp253b44 + fun0b = fun0b + rmu(3, 0)*temp253b45 + rmub(3, 0) = rmub(3, 0) + fun0*temp253b45 END IF ELSE - temp379b46 = cost4g*fun0*zb(indorbp, indt+i) + temp253b46 = cost4g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& & 2, 0)**3)*zb(indorbp, indt+i) rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp379b46 +& temp253b46 rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp379b46 +& 2)*temp253b46 END IF ELSE IF (branch .LT. 26) THEN IF (branch .LT. 24) THEN IF (branch .LT. 23) THEN - temp379b47 = cost5g*4.d0*zb(indorbp, indt+i) - temp379b48 = fun0*temp379b47 + temp253b47 = cost5g*4.d0*zb(indorbp, indt+i) + temp253b48 = fun0*temp253b47 fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& -& **2))*temp379b47 +& **2))*temp253b47 rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp379b48 +& **2)*temp253b48 rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp379b48 +& temp253b48 END IF ELSE IF (branch .LT. 25) THEN - temp379b49 = cost5g*4.d0*zb(indorbp, indt+i) - temp379b50 = fun0*temp379b49 + temp253b49 = cost5g*4.d0*zb(indorbp, indt+i) + temp253b50 = fun0*temp253b49 fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& -& ))*temp379b49 +& ))*temp253b49 rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& -& 2)*temp379b50 +& 2)*temp253b50 rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp379b50 +& temp253b50 END IF ELSE IF (branch .LT. 28) THEN IF (branch .LT. 27) THEN - temp379b51 = cost5g*4.d0*zb(indorbp, indt+i) - temp379b52 = fun0*temp379b51 + temp253b51 = cost5g*4.d0*zb(indorbp, indt+i) + temp253b52 = fun0*temp253b51 fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& -& 3)*temp379b51 +& 3)*temp253b51 rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp379b52 +& temp253b52 rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp379b52 +& 2)*temp253b52 END IF ELSE - temp379b53 = cost5g*4.d0*zb(indorbp, indt+i) - temp379b54 = fun0*temp379b53 + temp253b53 = cost5g*4.d0*zb(indorbp, indt+i) + temp253b54 = fun0*temp253b53 fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& -& *temp379b53 +& *temp253b53 rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& -& *temp379b54 +& *temp253b54 rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp379b54 +& temp253b54 END IF - temp379b = distp(0, 1+ic)*zb(indorbp, indt+i) + temp253b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp379b - funb = funb + rmu(i, 0)*temp379b + rmub(i, 0) = rmub(i, 0) + fun*temp253b + funb0 = funb0 + rmu(i, 0)*temp253b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp378 = r(0)**4 - temp378b = distp(0, 1)*fun2b - temp377 = 4.d0*dd1 - temp376 = 11.d0/temp377 - distpb(0, 1) = distpb(0, 1) + (2.d0*(dd1*r(0)**2)-15.d0/2.d0)*funb& -& + (temp376-r(0)**2)*fun0b + (21.d0*(dd1*r(0)**2)-15.d0/2.d0-4.d0& -& *(dd1**2*temp378))*fun2b - temp378b0 = distp(0, 1)*2.d0*funb - dd1b = r(0)**2*temp378b0 - distp(0, 1)*temp376*4.d0*fun0b/temp377 & -& + (21.d0*r(0)**2-4.d0*temp378*2*dd1)*temp378b - rb(0) = rb(0) + dd1*2*r(0)*temp378b0 - distp(0, 1)*2*r(0)*fun0b + & -& (21.d0*dd1*2*r(0)-4.d0*dd1**2*4*r(0)**3)*temp378b - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + temp252 = rp3**3 + temp250 = distp(0, 1)/temp252 + temp251 = rp1**3 + temp251b = 0.25d0*temp250*fun2b + temp250b = 0.25d0*(18.d0*rp1-78.d0*rp2+198.d0*(rp1*rp2)+191.d0*rp1& +& **2+66.d0*(rp1**2*rp2)+3.d0*rp1**3-2.d0*(temp251*rp2)-30.d0)*& +& fun2b/temp252 + temp249 = rp3**2 + temp248 = distp(0, 1)/temp249 + temp249b = 0.25d0*temp248*funb0 + rp1b = (2.d0*2*rp1-5.d0*rp2-44.d0)*temp249b + (3.d0*3*rp1**2-2.d0*& +& rp2*3*rp1**2+66.d0*rp2*2*rp1+191.d0*2*rp1+198.d0*rp2+18.d0)*& +& temp251b + temp248b = 0.25d0*(2.d0*rp1**2-44.d0*rp1-69.d0*rp2-5.d0*(rp1*rp2)-& +& 30.d0)*funb0/temp249 + temp246b0 = distp(0, 1)*fun0b + costb = -(r(0)**2*temp246b0) + rp3b = -(temp248*2*rp3*temp248b) - (0.5d0*rp2+1.d0)*costb/rp3**2 -& +& temp250*3*rp3**2*temp250b + rp2b = ((-69.d0)-5.d0*rp1)*temp249b + 2*(rp2+1.d0)*rp3b + 0.5d0*& +& costb/rp3 + (66.d0*rp1**2-2.d0*temp251+198.d0*rp1-78.d0)*& +& temp251b + temp247 = 4.d0*dd1 + temp246 = 11.d0/temp247 + distpb(0, 1) = distpb(0, 1) + temp248b + (temp246-r(0)**2*cost)*& +& fun0b + temp250b + dd1b = r(0)**2*rp1b - temp246*4.d0*temp246b0/temp247 + rb(0) = rb(0) + dd2*rp2b + dd1*2*r(0)*rp1b - cost*2*r(0)*temp246b0 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = r(0)*rp2b ELSE distpb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 END IF - dd1b = 0.0_8 DO ic=9,1,-1 DO k=0,0,-1 - temp376b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) - temp375 = 4.d0*dd1 - temp374 = 11.d0/temp375 - temp374b17 = (temp374-r(k)**2)*zb(indorbp, k) - dd1b = dd1b - temp374*4.d0*temp376b/temp375 - rb(k) = rb(k) - 2*r(k)*temp376b - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp374b17 - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp374b17 + temp246b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) + temp245 = 4.d0*dd1 + temp244 = 11.d0/temp245 + temp244b = (temp244-r(k)**2*cost)*zb(indorbp, k) + dd1b = dd1b - temp244*4.d0*temp246b/temp245 + costb = -(r(k)**2*temp246b) + temp243 = dd2*r(k) + 1.d0 + temp244b0 = costb/temp243**2 + temp243b18 = -((0.5d0*(dd2*r(k))+1.d0)*2*temp244b0/temp243) + rb(k) = rb(k) + 0.5d0*dd2*temp244b0 + dd2*temp243b18 - cost*2*r(& +& k)*temp246b + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp244b + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp244b zb(indorbp, k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = dd2b + r(k)*temp243b18 + 0.5d0*r(k)*temp244b0 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - temp374b = cost5g*4.d0*distpb(i, 10) - temp374b0 = (rmu(1, i)**2-rmu(2, i)**2)*temp374b - temp374b1 = rmu(1, i)*rmu(2, i)*temp374b - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp374b1 + rmu(2, i)*& -& temp374b0 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp374b0 - 2*rmu(2, i)*& -& temp374b1 + temp243b0 = cost5g*4.d0*distpb(i, 10) + temp243b1 = (rmu(1, i)**2-rmu(2, i)**2)*temp243b0 + temp243b2 = rmu(1, i)*rmu(2, i)*temp243b0 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp243b2 + rmu(2, i)*& +& temp243b1 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp243b1 - 2*rmu(2, i)*& +& temp243b2 distpb(i, 10) = 0.0_8 - temp374b2 = cost5g*distpb(i, 9) + temp243b3 = cost5g*distpb(i, 9) rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& -& 1, i))*temp374b2 +& 1, i))*temp243b3 distpb(i, 9) = 0.0_8 - temp374b3 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) - temp374b4 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp374b3 - 2*rmu(2, i)*& -& temp374b4 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& -& temp374b2 - rmub(3, i) = rmub(3, i) + rmu(2, i)*temp374b3 + temp243b4 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) + temp243b5 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp243b4 - 2*rmu(2, i)*& +& temp243b5 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& +& temp243b3 + rmub(3, i) = rmub(3, i) + rmu(2, i)*temp243b4 distpb(i, 8) = 0.0_8 - temp374b5 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) - temp374b6 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp374b5 + 2*rmu(1, i)*& -& temp374b6 + 3.d0*2*rmu(1, i)*temp374b4 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp374b5 - rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp374b6 + temp243b6 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) + temp243b7 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp243b6 + 2*rmu(1, i)*& +& temp243b7 + 3.d0*2*rmu(1, i)*temp243b5 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp243b6 + rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp243b7 distpb(i, 7) = 0.0_8 - temp374b7 = cost3g*2.d0*distpb(i, 6) - temp374b8 = (7.d0*rmu(3, i)**2-r(i)**2)*temp374b7 - temp374b9 = rmu(1, i)*rmu(2, i)*temp374b7 - rmub(1, i) = rmub(1, i) + rmu(2, i)*temp374b8 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp374b8 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp374b9 + temp243b8 = cost3g*2.d0*distpb(i, 6) + temp243b9 = (7.d0*rmu(3, i)**2-r(i)**2)*temp243b8 + temp243b10 = rmu(1, i)*rmu(2, i)*temp243b8 + rmub(1, i) = rmub(1, i) + rmu(2, i)*temp243b9 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp243b9 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp243b10 distpb(i, 6) = 0.0_8 - temp374b10 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) - temp374b11 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) + temp243b11 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) + temp243b12 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) distpb(i, 5) = 0.0_8 - temp374b12 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) - temp374b13 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) + temp243b13 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) + temp243b14 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - temp374b14 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) - temp374b15 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) + temp243b15 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) + temp243b16 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 - temp374b16 = cost1g*distpb(i, 2) + temp243b17 = cost1g*distpb(i, 2) rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& -& temp374b16 - 3.d0*2*r(i)*temp374b15 - 2*r(i)*temp374b11 - 3.d0*2& -& *r(i)*temp374b13 - 2*r(i)*temp374b9 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp374b10 - rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp374b10 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp374b11 - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp374b12 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp374b13 + rmu(2, i)*& -& temp374b12 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp374b14 +& temp243b17 - 3.d0*2*r(i)*temp243b16 - 2*r(i)*temp243b12 - 3.d0*2& +& *r(i)*temp243b14 - 2*r(i)*temp243b10 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp243b11 + rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp243b11 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp243b12 + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp243b13 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp243b14 + rmu(2, i)*& +& temp243b13 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp243b15 rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& -& rmu(3, i))*temp374b16 + 7.d0*2*rmu(3, i)*temp374b15 + rmu(1, i)*& -& temp374b14 +& rmu(3, i))*temp243b17 + 7.d0*2*rmu(3, i)*temp243b16 + rmu(1, i)*& +& temp243b15 distpb(i, 2) = 0.0_8 END DO cb = 0.0_8 DO k=0,0,-1 - temp373 = r(k)**2 - temp373b75 = c*DEXP(-(dd1*temp373))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp373))*distpb(k, 1) - dd1b = dd1b - temp373*temp373b75 - rb(k) = rb(k) - dd1*2*r(k)*temp373b75 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp242 = dd2*r(k) + 1.d0 + temp243b = costb/temp242 + temp242b5 = -(dd1*r(k)**2*temp243b/temp242) + dd1b = dd1b + r(k)**2*temp243b + rb(k) = rb(k) + dd2*temp242b5 + dd1*2*r(k)*temp243b + dd2b = dd2b + r(k)*temp242b5 END DO - dd1b = dd1b + 1.11284691281640568826d0*2.75d0*dd1**1.75D0*cb + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocg*2.75d0*dd1**1.75D0*cb + ELSE + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocg*2.75d0*dd1**1.75D0*& +& cb + END IF ddb(indparp) = ddb(indparp) + dd1b - CASE (55) -! g single Slater orbital -! R(r)= exp(-alpha r) -! normalized + CASE (1100:1199) +! WARNING IN DFT it is assumed that UMRIGAR orbitals could be extended +! up to number 99, so i,h,... are possible extensions. +! 1s single Z NO CUSP! +! p gaussian r**(2*npower)*exp(-alpha*r**2) + npower = iopt - 1100 ! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) + dd2 = dd(indpar+1) + DO k=0,0 + distp(k, 1) = r(k)**(2*npower)*DEXP(-(dd2*r(k)**2)) + END DO + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN + rp1 = r(0)**2 + fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 + fun2 = (npower*(2.d0*npower-1.d0)-(1.d0+4.d0*npower)*dd2*rp1+2.d0*& +& (dd2*rp1)**2)*distp(0, 1)*2.d0/rp1 +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp257b2 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp257b2 + fun2b = fun2b + temp257b2 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp257b1 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp257b1 + funb0 = funb0 + rmu(ic, 0)*temp257b1 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + distpb = 0.0_8 + temp256 = distp(0, 1)/rp1 + temp257b = 2.d0*temp256*fun2b + temp257b0 = -((npower*4.d0+1.d0)*temp257b) + temp256b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& +& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 + temp255 = distp(0, 1)/rp1 + temp256b0 = 2.d0*temp255*funb0 + dd2b = rp1*temp257b0 - rp1*temp256b0 + 2.d0*rp1**2*2*dd2*temp257b + temp255b = 2.d0*(npower-dd2*rp1)*funb0/rp1 + rp1b = dd2*temp257b0 - temp255*temp255b - temp256*temp256b - dd2*& +& temp256b0 + 2.d0*dd2**2*2*rp1*temp257b + distpb(0, 1) = temp255b + fun0b + temp256b + rb(0) = rb(0) + 2*r(0)*rp1b + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=0,0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO k=0,0,-1 + temp254 = r(k)**2 + temp253 = 2*npower + temp253b56 = r(k)**temp253*DEXP(-(dd2*temp254))*distpb(k, 1) + IF (r(k) .LE. 0.0 .AND. (temp253 .EQ. 0.0 .OR. temp253 .NE. INT(& +& temp253))) THEN + rb(k) = rb(k) - dd2*2*r(k)*temp253b56 + ELSE + rb(k) = rb(k) + DEXP(-(dd2*temp254))*temp253*r(k)**(temp253-1)*& +& distpb(k, 1) - dd2*2*r(k)*temp253b56 + END IF + dd2b = dd2b - temp254*temp253b56 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (119) +! 2p single r_mu/(1+b r^2)^(3/2) parent of 103 + dd2 = dd(indpar+1) + DO k=0,0 + distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**2)**1.5d0 + END DO +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN + fun = -(3.d0*dd2*distp(0, 1)/(1.d0+dd2*r(0)**2)) + fun2 = 3.d0*dd2*(-1.d0+4.d0*dd2*r(0)**2)/(1.d0+dd2*r(0)**2)**3.5d0 +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp263b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp263b0 + fun2b = fun2b + temp263b0 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp263b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp263b + funb0 = funb0 + rmu(ic, 0)*temp263b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + temp260 = dd2*r(0)**2 + 1.d0 + temp262 = temp260**3.5d0 + temp261 = 4.d0*dd2*r(0)**2 - 1.d0 + temp261b = 3.d0*fun2b/temp262 + temp261b0 = dd2*4.d0*temp261b + temp260b = -(dd2*temp261*3.5d0*temp260**2.5D0*temp261b/temp262) + temp259 = dd2*r(0)**2 + 1.d0 + temp260b0 = -(3.d0*funb0/temp259) + temp259b = -(dd2*distp(0, 1)*temp260b0/temp259) + dd2b = distp(0, 1)*temp260b0 + r(0)**2*temp259b + r(0)**2*temp260b& +& + r(0)**2*temp261b0 + temp261*temp261b + rb(0) = rb(0) + dd2*2*r(0)*temp259b + dd2*2*r(0)*temp260b + dd2*2*& +& r(0)*temp261b0 + distpb = 0.0_8 + distpb(0, 1) = fun0b + dd2*temp260b0 + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=0,0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO k=0,0,-1 + temp257 = dd2*r(k)**2 + 1.d0 + temp258 = temp257**1.5d0 + temp257b3 = -(1.5d0*temp257**0.5D0*distpb(k, 1)/temp258**2) + dd2b = dd2b + r(k)**2*temp257b3 + rb(k) = rb(k) + dd2*2*r(k)*temp257b3 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (27) +! 2p without cusp condition + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd(indpar+3) + dd3 = dd(indpar+4) + peff2 = dd(indpar+5) ! if(iflagnorm.gt.2) then -! overall normalization -! l = 4 -! \int d\omega Y*Y = 4 pi / (2 l + 1) -! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5**2 * 3**4 / 2**3 / dd1**11 -! c=1.d0/dsqrt(7.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(11.d0/2.d0)/3.d0/5.d0 - c = dd1**5.5d0*.020104801169736915d0 + c = 1.d0/2.d0/DSQRT(240.d0*pi*(1.d0/(2.d0*dd1)**7+2.d0*peff/(dd1+dd2& +& )**7+peff**2/(2.d0*dd2)**7+2.d0*peff2/(dd1+dd3)**7+peff2**2/(2.d0*& +& dd3)**7+2.d0*peff2*peff/(dd2+dd3)**7)) ! endif DO k=0,0 distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 2) = c*DEXP(-(dd2*r(k))) + distp(k, 3) = c*DEXP(-(dd3*r(k))) END DO DO i=0,0 - distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& -& 2+3.d0*r(i)**4) -! lz=0 - distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& -& 2-r(i)**2) -! lz=+/-2 - distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& -& (i)**2) -! lz=+/-2 - distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & -& i)**2) -! lz=+/-3 - distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& -& , i)**2) -! lz=+/-3 - distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& -& rmu(2, i)**4) -! lz=+/-4 - distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& -& , i)**2) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) + distp(i, 4) = r(i)*(distp(i, 1)+peff*distp(i, 2)+peff2*distp(i, 3)& +& ) END DO -! lz=+/-4 - DO ic=1,9 +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO ! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1) - fun = -(dd1*distp(0, 1)/r(0)) - fun2 = dd1**2*distp(0, 1) + fun = (1.d0-dd1*r(0))*distp(0, 1) + peff*(1.d0-dd2*r(0))*distp(0, & +& 2) + peff2*(1.d0-dd3*r(0))*distp(0, 3) + fun2 = dd1*(dd1*r(0)-2.d0)*distp(0, 1) + peff*dd2*(dd2*r(0)-2.d0)*& +& distp(0, 2) + peff2*dd3*(dd3*r(0)-2.d0)*distp(0, 3) ! indorbp=indorb - DO ic=1,9 + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - END IF - ELSE IF (ic .EQ. 6) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - END IF - ELSE IF (ic .EQ. 7) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,21) - END IF - ELSE IF (ic .EQ. 8) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,22) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,24) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,23) - END IF - ELSE IF (ic .EQ. 9) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,26) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,28) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,27) - END IF + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,25) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=9,1,-1 - temp380b55 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 10.d0*temp380b55 - fun2b = fun2b + temp380b55 + DO ic=3,1,-1 + temp278 = fun/r(0) + temp279b = rmu(ic, 0)*zb(indorbp, indt+4) + temp278b = 4.d0*temp279b/r(0) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp278+fun2)*zb(indorbp, indt& +& +4) + funb0 = funb0 + temp278b + rb(0) = rb(0) - temp278*temp278b + fun2b = fun2b + temp279b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 15) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp380b0 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& -& 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& -& ) - rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp380b0 - rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp380b0 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& -& )*temp380b0 - ELSE - temp380b1 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& -& 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& -& ) - rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp380b1 - rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp380b1 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& -& )*temp380b1 - END IF - ELSE IF (branch .LT. 4) THEN - temp380b2 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& -& 3, 0)*r(0)**2))*zb(indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& -& r(0)**2)*temp380b2 - rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp380b2 - ELSE - temp380b3 = cost2g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& -& , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& -& (indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& -& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp380b3 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp380b3 - rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp380b3 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp380b4 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp380b5 = rmu(2, 0)*rmu(3, 0)*temp380b4 - temp380b6 = fun0*rmu(1, 0)*temp380b4 - fun0b = fun0b + rmu(1, 0)*temp380b5 - rmub(1, 0) = rmub(1, 0) + fun0*temp380b5 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp380b6 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp380b6 - ELSE - temp380b7 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp380b8 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& -& **2)*temp380b7 - temp380b9 = fun0*rmu(1, 0)*temp380b7 - fun0b = fun0b + rmu(1, 0)*temp380b8 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp380b9 + fun0& -& *temp380b8 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp380b9 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp380b9 - END IF - ELSE - temp380b10 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp380b11 = rmu(2, 0)*rmu(3, 0)*temp380b10 - temp380b12 = fun0*rmu(1, 0)*temp380b10 - fun0b = fun0b + rmu(1, 0)*temp380b11 - rmub(1, 0) = rmub(1, 0) + fun0*temp380b11 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp380b12 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp380b12 - END IF - ELSE IF (branch .LT. 12) THEN - IF (branch .LT. 10) THEN - IF (branch .LT. 9) THEN - temp380b13 = cost2g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& -& , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& -& (indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& -& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp380b13 - rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp380b13 - rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp380b13 - ELSE - temp380b14 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp380b15 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& -& **2)*temp380b14 - temp380b16 = fun0*rmu(2, 0)*temp380b14 - fun0b = fun0b + rmu(2, 0)*temp380b15 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp380b16 + & -& fun0*temp380b15 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp380b16 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp380b16 - END IF - ELSE IF (branch .LT. 11) THEN - temp380b17 = -(cost3g*4.d0*zb(indorbp, indt+i)) - temp380b18 = fun0*temp380b17 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& -& **2))*temp380b17 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp380b18 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& -& temp380b18 - ELSE - temp380b19 = cost3g*4.d0*zb(indorbp, indt+i) - temp380b20 = fun0*temp380b19 - fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& -& **2))*temp380b19 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp380b20 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& -& temp380b20 - END IF - ELSE IF (branch .LT. 14) THEN - IF (branch .LT. 13) THEN - temp380b21 = cost3g*12.d0*zb(indorbp, indt+i) - temp380b22 = fun0*rmu(3, 0)*temp380b21 - temp380b23 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp380b21 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp380b22 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp380b22 - fun0b = fun0b + rmu(3, 0)*temp380b23 - rmub(3, 0) = rmub(3, 0) + fun0*temp380b23 - ELSE - temp380b24 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp380b25 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3& -& , 0)**2)*temp380b24 - temp380b26 = fun0*rmu(2, 0)*temp380b24 - fun0b = fun0b + rmu(2, 0)*temp380b25 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp380b26 + fun0*& -& temp380b25 - rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp380b26 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp380b26 - END IF - ELSE - temp380b27 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp380b28 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0& -& )**2)*temp380b27 - temp380b29 = fun0*rmu(1, 0)*temp380b27 - fun0b = fun0b + rmu(1, 0)*temp380b28 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp380b29 + fun0*& -& temp380b28 - rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp380b29 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp380b29 - END IF - ELSE IF (branch .LT. 22) THEN - IF (branch .LT. 19) THEN - IF (branch .LT. 17) THEN - IF (branch .LT. 16) THEN - temp380b30 = cost3g*24.d0*zb(indorbp, indt+i) - temp380b31 = rmu(2, 0)*rmu(3, 0)*temp380b30 - temp380b32 = fun0*rmu(1, 0)*temp380b30 - fun0b = fun0b + rmu(1, 0)*temp380b31 - rmub(1, 0) = rmub(1, 0) + fun0*temp380b31 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp380b32 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp380b32 - ELSE - temp380b33 = cost4g*3.d0*zb(indorbp, indt+i) - temp380b34 = fun0*rmu(3, 0)*temp380b33 - temp380b35 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp380b33 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp380b34 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp380b34 - fun0b = fun0b + rmu(3, 0)*temp380b35 - rmub(3, 0) = rmub(3, 0) + fun0*temp380b35 - END IF - ELSE IF (branch .LT. 18) THEN - temp380b36 = -(cost4g*6.d0*zb(indorbp, indt+i)) - temp380b37 = rmu(2, 0)*rmu(3, 0)*temp380b36 - temp380b38 = fun0*rmu(1, 0)*temp380b36 - fun0b = fun0b + rmu(1, 0)*temp380b37 - rmub(1, 0) = rmub(1, 0) + fun0*temp380b37 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp380b38 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp380b38 - ELSE - temp380b39 = cost4g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& -& (2, 0)**2))*zb(indorbp, indt+i) - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp380b39 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp380b39 - END IF - ELSE IF (branch .LT. 21) THEN - IF (branch .LT. 20) THEN - temp380b40 = cost4g*6.d0*zb(indorbp, indt+i) - temp380b41 = rmu(2, 0)*rmu(3, 0)*temp380b40 - temp380b42 = fun0*rmu(1, 0)*temp380b40 - fun0b = fun0b + rmu(1, 0)*temp380b41 - rmub(1, 0) = rmub(1, 0) + fun0*temp380b41 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp380b42 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp380b42 - ELSE - temp380b43 = cost4g*3.d0*zb(indorbp, indt+i) - temp380b44 = fun0*rmu(3, 0)*temp380b43 - temp380b45 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp380b43 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp380b44 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp380b44 - fun0b = fun0b + rmu(3, 0)*temp380b45 - rmub(3, 0) = rmub(3, 0) + fun0*temp380b45 - END IF - ELSE - temp380b46 = cost4g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& -& 2, 0)**3)*zb(indorbp, indt+i) - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp380b46 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp380b46 - END IF - ELSE IF (branch .LT. 26) THEN - IF (branch .LT. 24) THEN - IF (branch .LT. 23) THEN - temp380b47 = cost5g*4.d0*zb(indorbp, indt+i) - temp380b48 = fun0*temp380b47 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& -& **2))*temp380b47 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp380b48 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp380b48 - END IF - ELSE IF (branch .LT. 25) THEN - temp380b49 = cost5g*4.d0*zb(indorbp, indt+i) - temp380b50 = fun0*temp380b49 - fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& -& ))*temp380b49 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& -& 2)*temp380b50 - rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp380b50 - END IF - ELSE IF (branch .LT. 28) THEN - IF (branch .LT. 27) THEN - temp380b51 = cost5g*4.d0*zb(indorbp, indt+i) - temp380b52 = fun0*temp380b51 - fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& -& 3)*temp380b51 - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp380b52 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp380b52 - END IF - ELSE - temp380b53 = cost5g*4.d0*zb(indorbp, indt+i) - temp380b54 = fun0*temp380b53 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& -& *temp380b53 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& -& *temp380b54 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp380b54 - END IF - temp380b = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp380b - funb = funb + rmu(i, 0)*temp380b + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp277 = fun/r(0) + temp277b13 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(ic, 0) = rmub(ic, 0) + temp277*rmu(i, 0)*zb(indorbp, indt& +& +i) + rmub(i, 0) = rmub(i, 0) + temp277*rmu(ic, 0)*zb(indorbp, indt+& +& i) + funb0 = funb0 + temp277b13 + rb(0) = rb(0) - temp277*temp277b13 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp379b75 = -(distp(0, 1)*funb/r(0)) - dd1b = temp379b75 + distp(0, 1)*2*dd1*fun2b - temp379 = dd1/r(0) - distpb(0, 1) = distpb(0, 1) + fun0b - temp379*funb + dd1**2*fun2b - rb(0) = rb(0) - temp379*temp379b75 - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + distpb = 0.0_8 + temp277b3 = dd1*distp(0, 1)*fun2b + temp277b4 = (dd1*r(0)-2.d0)*fun2b + temp277b5 = (dd2*r(0)-2.d0)*fun2b + temp277b6 = peff*dd2*distp(0, 2)*fun2b + temp277b7 = (dd3*r(0)-2.d0)*fun2b + temp277b8 = peff2*dd3*distp(0, 3)*fun2b + dd1b = distp(0, 1)*temp277b4 - distp(0, 1)*r(0)*funb0 + r(0)*& +& temp277b3 + temp277b9 = peff*distp(0, 2)*funb0 + temp277b10 = peff2*distp(0, 3)*funb0 + rb(0) = rb(0) + dd3*temp277b8 - dd2*temp277b9 - dd3*temp277b10 - & +& distp(0, 1)*dd1*funb0 + dd2*temp277b6 + dd1*temp277b3 + distpb(0, 1) = dd1*temp277b4 + temp277b11 = (1.d0-dd2*r(0))*funb0 + peffb = distp(0, 2)*temp277b11 + distp(0, 2)*dd2*temp277b5 + dd2b = r(0)*temp277b6 - r(0)*temp277b9 + distp(0, 2)*peff*& +& temp277b5 + distpb(0, 2) = peff*dd2*temp277b5 + temp277b12 = (1.d0-dd3*r(0))*funb0 + peff2b = distp(0, 3)*temp277b12 + distp(0, 3)*dd3*temp277b7 + dd3b = r(0)*temp277b8 - r(0)*temp277b10 + distp(0, 3)*peff2*& +& temp277b7 + distpb(0, 3) = peff2*dd3*temp277b7 + distpb(0, 1) = distpb(0, 1) + (1.d0-dd1*r(0))*funb0 + distpb(0, 2) = distpb(0, 2) + peff*temp277b11 + distpb(0, 3) = distpb(0, 3) + peff2*temp277b12 + distpb(0, 4) = distpb(0, 4) + fun0b ELSE distpb = 0.0_8 + peffb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 + dd3b = 0.0_8 + peff2b = 0.0_8 END IF - DO ic=9,1,-1 - DO k=0,0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) - zb(indorbp, k) = 0.0_8 + DO ic=3,1,-1 + DO i=0,0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 4)*zb(indorbp, i) + distpb(i, 4) = distpb(i, 4) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - temp379b57 = cost5g*4.d0*distpb(i, 10) - temp379b58 = (rmu(1, i)**2-rmu(2, i)**2)*temp379b57 - temp379b59 = rmu(1, i)*rmu(2, i)*temp379b57 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp379b59 + rmu(2, i)*& -& temp379b58 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp379b58 - 2*rmu(2, i)*& -& temp379b59 - distpb(i, 10) = 0.0_8 - temp379b60 = cost5g*distpb(i, 9) - rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& -& 1, i))*temp379b60 - distpb(i, 9) = 0.0_8 - temp379b61 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) - temp379b62 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp379b61 - 2*rmu(2, i)*& -& temp379b62 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& -& temp379b60 - rmub(3, i) = rmub(3, i) + rmu(2, i)*temp379b61 - distpb(i, 8) = 0.0_8 - temp379b63 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) - temp379b64 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp379b63 + 2*rmu(1, i)*& -& temp379b64 + 3.d0*2*rmu(1, i)*temp379b62 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp379b63 - rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp379b64 - distpb(i, 7) = 0.0_8 - temp379b65 = cost3g*2.d0*distpb(i, 6) - temp379b66 = (7.d0*rmu(3, i)**2-r(i)**2)*temp379b65 - temp379b67 = rmu(1, i)*rmu(2, i)*temp379b65 - rmub(1, i) = rmub(1, i) + rmu(2, i)*temp379b66 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp379b66 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp379b67 - distpb(i, 6) = 0.0_8 - temp379b68 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) - temp379b69 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - temp379b70 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) - temp379b71 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) + temp277b2 = r(i)*distpb(i, 4) + rb(i) = rb(i) + (distp(i, 1)+peff*distp(i, 2)+peff2*distp(i, 3))*& +& distpb(i, 4) + distpb(i, 1) = distpb(i, 1) + temp277b2 + peffb = peffb + distp(i, 2)*temp277b2 + distpb(i, 2) = distpb(i, 2) + peff*temp277b2 + peff2b = peff2b + distp(i, 3)*temp277b2 + distpb(i, 3) = distpb(i, 3) + peff2*temp277b2 distpb(i, 4) = 0.0_8 - temp379b72 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) - temp379b73 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - temp379b74 = cost1g*distpb(i, 2) - rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& -& temp379b74 - 3.d0*2*r(i)*temp379b73 - 2*r(i)*temp379b69 - 3.d0*2& -& *r(i)*temp379b71 - 2*r(i)*temp379b67 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp379b68 - rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp379b68 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp379b69 - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp379b70 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp379b71 + rmu(2, i)*& -& temp379b70 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp379b72 - rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& -& rmu(3, i))*temp379b74 + 7.d0*2*rmu(3, i)*temp379b73 + rmu(1, i)*& -& temp379b72 - distpb(i, 2) = 0.0_8 END DO - dd1b = 0.0_8 cb = 0.0_8 DO k=0,0,-1 - temp379b56 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + temp277b = c*DEXP(-(dd3*r(k)))*distpb(k, 3) + cb = cb + DEXP(-(dd3*r(k)))*distpb(k, 3) + dd3b = dd3b - r(k)*temp277b + distpb(k, 3) = 0.0_8 + temp277b0 = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) + distpb(k, 2) = 0.0_8 + temp277b1 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd2*temp277b0 - dd1*temp277b1 - dd3*temp277b + dd2b = dd2b - r(k)*temp277b0 cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp379b56 - rb(k) = rb(k) - dd1*temp379b56 + dd1b = dd1b - r(k)*temp277b1 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + .020104801169736915d0*5.5d0*dd1**4.5D0*cb - ddb(indparp) = ddb(indparp) + dd1b - CASE (56) -! g single Slater orbital derivative of 55 -! R(r)= (11.d0/2.0 1/dd1 - r) * exp(-alpha r) -! normalized + temp276 = (dd2+dd3)**7 + temp263 = peff2*peff/temp276 + temp275 = 2.d0**7 + temp274 = temp275*dd3**7 + temp273 = peff2**2/temp274 + temp272 = (dd1+dd3)**7 + temp271 = 2.d0**7 + temp270 = temp271*dd2**7 + temp269 = peff**2/temp270 + temp268 = (dd1+dd2)**7 + temp267 = 2.d0**7 + temp266 = temp267*dd1**7 + temp265 = 240.d0*pi*(1.0/temp266+2.d0*peff/temp268+temp269+2.d0*& +& peff2/temp272+temp273+2.d0*temp263) + temp264 = DSQRT(temp265) + IF (temp265 .EQ. 0.0) THEN + temp264b = 0.0 + ELSE + temp264b = -(pi*240.d0*cb/(2.d0*temp264**2*2.D0*DSQRT(temp265))) + END IF + temp264b0 = 2.d0*temp264b/temp268 + temp264b1 = -(peff*7*(dd1+dd2)**6*temp264b0/temp268) + temp264b2 = 2.d0*temp264b/temp272 + temp264b3 = -(peff2*7*(dd1+dd3)**6*temp264b2/temp272) + temp263b1 = 2.d0*temp264b/temp276 + temp263b2 = -(temp263*7*(dd2+dd3)**6*temp263b1) + dd1b = dd1b + temp264b3 + temp264b1 - temp267*7*dd1**6*temp264b/& +& temp266**2 + peffb = peffb + peff2*temp263b1 + 2*peff*temp264b/temp270 + & +& temp264b0 + dd2b = dd2b + temp263b2 - temp269*temp271*7*dd2**6*temp264b/temp270 & +& + temp264b1 + peff2b = peff2b + peff*temp263b1 + 2*peff2*temp264b/temp274 + & +& temp264b2 + dd3b = dd3b + temp263b2 - temp273*temp275*7*dd3**6*temp264b/temp274 & +& + temp264b3 + ddb(indpar+5) = ddb(indpar+5) + peff2b + ddb(indpar+4) = ddb(indpar+4) + dd3b + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (85) +! d orbitals +! R(r)= c*exp(-z r^2)*(7/4/z-r^2) ! indorbp=indorb indparp = indpar + 1 dd1 = dd(indparp) + dd2 = DSQRT(dd1) ! if(iflagnorm.gt.2) then ! overall normalization -! l = 4 -! \int d\omega Y*Y = 4 pi / (2 l + 1) -! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5**2 * 3**4 / 2**3 / dd1**11 - c = dd1**5.5d0*.020104801169736915d0 -! c=1.d0/dsqrt(7.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(11.d0/2.d0)/3.d0/5.d0 +! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)*ratiocd + c = dd1**1.75d0*ratiocd ! endif DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k))) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) END DO DO i=0,0 - distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& -& 2+3.d0*r(i)**4) ! lz=0 - distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& -& 2-r(i)**2) + distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d ! lz=+/-2 - distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& -& (i)**2) + distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d ! lz=+/-2 - distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & -& i)**2) -! lz=+/-3 - distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& -& , i)**2) -! lz=+/-3 - distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& -& rmu(2, i)**4) -! lz=+/-4 - distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& -& , i)**2) + distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d +! lz=+/-1 + distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d +! lz=+/-1 + distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d END DO -! lz=+/-4 - DO ic=1,9 + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic + DO k=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 + END DO END DO ! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1)*(11.d0/2.d0/dd1-r(0)) - fun = distp(0, 1)*(dd1-13.d0/2.d0/r(0)) - fun2 = dd1*distp(0, 1)*(15.d0/2.d0-dd1*r(0)) + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*rp2)/rp3 + fun0 = distp(0, 1)*(7.d0/4.d0/dd1-r(0)**2*cost) + fun = 0.25d0*distp(0, 1)*(-22.d0-49.d0*rp2-28.d0*rp1-rp1*rp2+2.d0*& +& rp1**2)/rp3**2 + fun2 = -(0.25d0*distp(0, 1)*(22.d0+54.d0*rp2-26.d0*rp1-158.d0*rp1*& +& rp2-139.d0*rp1**2-42.d0*rp1**2*rp2+rp1**3+2.d0*rp1**3*rp2)/rp3**& +& 3) ! indorbp=indorb - DO ic=1,9 + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN - IF (i .EQ. 1) THEN + IF (i .NE. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) END IF ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF ELSE IF (ic .EQ. 3) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) END IF ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE IF (i .EQ. 2) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - ELSE + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - END IF - ELSE IF (ic .EQ. 6) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - END IF - ELSE IF (ic .EQ. 7) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,21) - END IF - ELSE IF (ic .EQ. 8) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,22) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,24) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,23) - END IF - ELSE IF (ic .EQ. 9) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,26) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,28) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,27) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,25) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=9,1,-1 - temp386b57 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 10.d0*temp386b57 - fun2b = fun2b + temp386b57 + DO ic=5,1,-1 + temp290b4 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 6.d0*temp290b4 + fun2b = fun2b + temp290b4 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 15) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp386b2 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& -& 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& -& ) - rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp386b2 - rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp386b2 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& -& )*temp386b2 - ELSE - temp386b3 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& -& 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& -& ) - rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp386b3 - rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp386b3 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& -& )*temp386b3 - END IF - ELSE IF (branch .LT. 4) THEN - temp386b4 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& -& 3, 0)*r(0)**2))*zb(indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& -& r(0)**2)*temp386b4 - rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp386b4 - ELSE - temp386b5 = cost2g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& -& , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& -& (indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& -& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp386b5 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp386b5 - rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp386b5 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp386b6 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp386b7 = rmu(2, 0)*rmu(3, 0)*temp386b6 - temp386b8 = fun0*rmu(1, 0)*temp386b6 - fun0b = fun0b + rmu(1, 0)*temp386b7 - rmub(1, 0) = rmub(1, 0) + fun0*temp386b7 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp386b8 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp386b8 - ELSE - temp386b9 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp386b10 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& -& **2)*temp386b9 - temp386b11 = fun0*rmu(1, 0)*temp386b9 - fun0b = fun0b + rmu(1, 0)*temp386b10 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp386b11 + & -& fun0*temp386b10 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp386b11 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp386b11 - END IF - ELSE - temp386b12 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp386b13 = rmu(2, 0)*rmu(3, 0)*temp386b12 - temp386b14 = fun0*rmu(1, 0)*temp386b12 - fun0b = fun0b + rmu(1, 0)*temp386b13 - rmub(1, 0) = rmub(1, 0) + fun0*temp386b13 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp386b14 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp386b14 - END IF - ELSE IF (branch .LT. 12) THEN - IF (branch .LT. 10) THEN - IF (branch .LT. 9) THEN - temp386b15 = cost2g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& -& , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& -& (indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& -& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp386b15 - rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp386b15 - rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp386b15 - ELSE - temp386b16 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp386b17 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& -& **2)*temp386b16 - temp386b18 = fun0*rmu(2, 0)*temp386b16 - fun0b = fun0b + rmu(2, 0)*temp386b17 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp386b18 + & -& fun0*temp386b17 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp386b18 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp386b18 - END IF - ELSE IF (branch .LT. 11) THEN - temp386b19 = -(cost3g*4.d0*zb(indorbp, indt+i)) - temp386b20 = fun0*temp386b19 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& -& **2))*temp386b19 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp386b20 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& -& temp386b20 - ELSE - temp386b21 = cost3g*4.d0*zb(indorbp, indt+i) - temp386b22 = fun0*temp386b21 - fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& -& **2))*temp386b21 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp386b22 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& -& temp386b22 - END IF - ELSE IF (branch .LT. 14) THEN - IF (branch .LT. 13) THEN - temp386b23 = cost3g*12.d0*zb(indorbp, indt+i) - temp386b24 = fun0*rmu(3, 0)*temp386b23 - temp386b25 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp386b23 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp386b24 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp386b24 - fun0b = fun0b + rmu(3, 0)*temp386b25 - rmub(3, 0) = rmub(3, 0) + fun0*temp386b25 - ELSE - temp386b26 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp386b27 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3& -& , 0)**2)*temp386b26 - temp386b28 = fun0*rmu(2, 0)*temp386b26 - fun0b = fun0b + rmu(2, 0)*temp386b27 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp386b28 + fun0*& -& temp386b27 - rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp386b28 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp386b28 - END IF - ELSE - temp386b29 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp386b30 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0& -& )**2)*temp386b29 - temp386b31 = fun0*rmu(1, 0)*temp386b29 - fun0b = fun0b + rmu(1, 0)*temp386b30 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp386b31 + fun0*& -& temp386b30 - rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp386b31 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp386b31 - END IF - ELSE IF (branch .LT. 22) THEN - IF (branch .LT. 19) THEN - IF (branch .LT. 17) THEN - IF (branch .LT. 16) THEN - temp386b32 = cost3g*24.d0*zb(indorbp, indt+i) - temp386b33 = rmu(2, 0)*rmu(3, 0)*temp386b32 - temp386b34 = fun0*rmu(1, 0)*temp386b32 - fun0b = fun0b + rmu(1, 0)*temp386b33 - rmub(1, 0) = rmub(1, 0) + fun0*temp386b33 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp386b34 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp386b34 + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp290b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp290b0 + fun0b = fun0b + rmu(i, 0)*temp290b0 ELSE - temp386b35 = cost4g*3.d0*zb(indorbp, indt+i) - temp386b36 = fun0*rmu(3, 0)*temp386b35 - temp386b37 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp386b35 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp386b36 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp386b36 - fun0b = fun0b + rmu(3, 0)*temp386b37 - rmub(3, 0) = rmub(3, 0) + fun0*temp386b37 + temp290b1 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp290b1 + fun0b = fun0b + rmu(i, 0)*temp290b1 END IF - ELSE IF (branch .LT. 18) THEN - temp386b38 = -(cost4g*6.d0*zb(indorbp, indt+i)) - temp386b39 = rmu(2, 0)*rmu(3, 0)*temp386b38 - temp386b40 = fun0*rmu(1, 0)*temp386b38 - fun0b = fun0b + rmu(1, 0)*temp386b39 - rmub(1, 0) = rmub(1, 0) + fun0*temp386b39 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp386b40 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp386b40 - ELSE - temp386b41 = cost4g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& -& (2, 0)**2))*zb(indorbp, indt+i) - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp386b41 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp386b41 + ELSE IF (branch .LT. 4) THEN + temp290b2 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp290b2 + fun0b = fun0b + rmu(i, 0)*temp290b2 END IF - ELSE IF (branch .LT. 21) THEN - IF (branch .LT. 20) THEN - temp386b42 = cost4g*6.d0*zb(indorbp, indt+i) - temp386b43 = rmu(2, 0)*rmu(3, 0)*temp386b42 - temp386b44 = fun0*rmu(1, 0)*temp386b42 - fun0b = fun0b + rmu(1, 0)*temp386b43 - rmub(1, 0) = rmub(1, 0) + fun0*temp386b43 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp386b44 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp386b44 + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp290b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp290b3 + fun0b = fun0b + rmu(i, 0)*temp290b3 ELSE - temp386b45 = cost4g*3.d0*zb(indorbp, indt+i) - temp386b46 = fun0*rmu(3, 0)*temp386b45 - temp386b47 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp386b45 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp386b46 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp386b46 - fun0b = fun0b + rmu(3, 0)*temp386b47 - rmub(3, 0) = rmub(3, 0) + fun0*temp386b47 + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - ELSE - temp386b48 = cost4g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& -& 2, 0)**3)*zb(indorbp, indt+i) - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp386b48 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp386b48 + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 26) THEN - IF (branch .LT. 24) THEN - IF (branch .LT. 23) THEN - temp386b49 = cost5g*4.d0*zb(indorbp, indt+i) - temp386b50 = fun0*temp386b49 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& -& **2))*temp386b49 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp386b50 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp386b50 + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 25) THEN - temp386b51 = cost5g*4.d0*zb(indorbp, indt+i) - temp386b52 = fun0*temp386b51 - fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& -& ))*temp386b51 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& -& 2)*temp386b52 - rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp386b52 + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 28) THEN - IF (branch .LT. 27) THEN - temp386b53 = cost5g*4.d0*zb(indorbp, indt+i) - temp386b54 = fun0*temp386b53 - fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& -& 3)*temp386b53 - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp386b54 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp386b54 + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF ELSE - temp386b55 = cost5g*4.d0*zb(indorbp, indt+i) - temp386b56 = fun0*temp386b55 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& -& *temp386b55 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& -& *temp386b56 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp386b56 + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp386b1 = distp(0, 1+ic)*zb(indorbp, indt+i) + temp290b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp386b1 - funb = funb + rmu(i, 0)*temp386b1 + rmub(i, 0) = rmub(i, 0) + fun*temp290b + funb0 = funb0 + rmu(i, 0)*temp290b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp386b = (15.d0/2.d0-dd1*r(0))*fun2b - temp386b0 = dd1*distp(0, 1)*fun2b - temp383 = 2.d0*dd1 - temp382 = 11.d0/temp383 - dd1b = distp(0, 1)*funb - distp(0, 1)*temp382*2.d0*fun0b/temp383 -& -& r(0)*temp386b0 + distp(0, 1)*temp386b - temp385 = 2.d0*r(0) - temp384 = 13.d0/temp385 - distpb(0, 1) = distpb(0, 1) + (dd1-temp384)*funb + (temp382-r(0))*& -& fun0b + dd1*temp386b - rb(0) = rb(0) + distp(0, 1)*temp384*2.d0*funb/temp385 - distp(0, 1& -& )*fun0b - dd1*temp386b0 - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + temp289 = rp3**3 + temp287 = distp(0, 1)/temp289 + temp288 = rp1**3 + temp288b = -(0.25d0*temp287*fun2b) + temp287b = -(0.25d0*(54.d0*rp2-26.d0*rp1-158.d0*(rp1*rp2)-139.d0*& +& rp1**2+rp1**3-42.d0*(rp1**2*rp2)+2.d0*(temp288*rp2)+22.d0)*fun2b& +& /temp289) + temp286 = rp3**2 + temp285 = distp(0, 1)/temp286 + temp285b = 0.25d0*(2.d0*rp1**2-28.d0*rp1-49.d0*rp2-rp1*rp2-22.d0)*& +& funb0/temp286 + temp283b0 = distp(0, 1)*fun0b + costb = -(r(0)**2*temp283b0) + rp3b = -(temp285*2*rp3*temp285b) - (0.5d0*rp2+1.d0)*costb/rp3**2 -& +& temp287*3*rp3**2*temp287b + temp286b = 0.25d0*temp285*funb0 + rp2b = ((-49.d0)-rp1)*temp286b + 2*(rp2+1.d0)*rp3b + 0.5d0*costb/& +& rp3 + (2.d0*temp288-42.d0*rp1**2-158.d0*rp1+54.d0)*temp288b + rp1b = (2.d0*2*rp1-rp2-28.d0)*temp286b + (2.d0*rp2*3*rp1**2-42.d0*& +& rp2*2*rp1+3*rp1**2-139.d0*2*rp1-158.d0*rp2-26.d0)*temp288b + temp284 = 4.d0*dd1 + temp283 = 7.d0/temp284 + distpb(0, 1) = distpb(0, 1) + temp285b + (temp283-r(0)**2*cost)*& +& fun0b + temp287b + dd1b = r(0)**2*rp1b - temp283*4.d0*temp283b0/temp284 + rb(0) = rb(0) + dd2*rp2b + dd1*2*r(0)*rp1b - cost*2*r(0)*temp283b0 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = r(0)*rp2b ELSE distpb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 END IF - dd1b = 0.0_8 - DO ic=9,1,-1 + DO ic=5,1,-1 DO k=0,0,-1 - temp381 = 2.d0*dd1 - temp380 = 11.d0/temp381 - temp380b75 = (temp380-r(k))*zb(indorbp, k) - temp380b76 = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp380b75 - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp380b75 - dd1b = dd1b - temp380*2.d0*temp380b76/temp381 - rb(k) = rb(k) - temp380b76 + temp283b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) + temp282 = 4.d0*dd1 + temp281 = 7.d0/temp282 + temp281b = (temp281-r(k)**2*cost)*zb(indorbp, k) + dd1b = dd1b - temp281*4.d0*temp283b/temp282 + costb = -(r(k)**2*temp283b) + temp280 = dd2*r(k) + 1.d0 + temp281b0 = costb/temp280**2 + temp280b0 = -((0.5d0*(dd2*r(k))+1.d0)*2*temp281b0/temp280) + rb(k) = rb(k) + 0.5d0*dd2*temp281b0 + dd2*temp280b0 - cost*2*r(k& +& )*temp283b + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp281b + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp281b zb(indorbp, k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = dd2b + r(k)*temp280b0 + 0.5d0*r(k)*temp281b0 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - temp380b57 = cost5g*4.d0*distpb(i, 10) - temp380b58 = (rmu(1, i)**2-rmu(2, i)**2)*temp380b57 - temp380b59 = rmu(1, i)*rmu(2, i)*temp380b57 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp380b59 + rmu(2, i)*& -& temp380b58 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp380b58 - 2*rmu(2, i)*& -& temp380b59 - distpb(i, 10) = 0.0_8 - temp380b60 = cost5g*distpb(i, 9) - rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& -& 1, i))*temp380b60 - distpb(i, 9) = 0.0_8 - temp380b61 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) - temp380b62 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp380b61 - 2*rmu(2, i)*& -& temp380b62 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& -& temp380b60 - rmub(3, i) = rmub(3, i) + rmu(2, i)*temp380b61 - distpb(i, 8) = 0.0_8 - temp380b63 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) - temp380b64 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp380b63 + 2*rmu(1, i)*& -& temp380b64 + 3.d0*2*rmu(1, i)*temp380b62 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp380b63 - rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp380b64 - distpb(i, 7) = 0.0_8 - temp380b65 = cost3g*2.d0*distpb(i, 6) - temp380b66 = (7.d0*rmu(3, i)**2-r(i)**2)*temp380b65 - temp380b67 = rmu(1, i)*rmu(2, i)*temp380b65 - rmub(1, i) = rmub(1, i) + rmu(2, i)*temp380b66 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp380b66 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp380b67 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 - temp380b68 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) - temp380b69 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 - temp380b70 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) - temp380b71 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - temp380b72 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) - temp380b73 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 - temp380b74 = cost1g*distpb(i, 2) - rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& -& temp380b74 - 3.d0*2*r(i)*temp380b73 - 2*r(i)*temp380b69 - 3.d0*2& -& *r(i)*temp380b71 - 2*r(i)*temp380b67 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp380b68 - rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp380b68 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp380b69 - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp380b70 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp380b71 + rmu(2, i)*& -& temp380b70 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp380b72 - rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& -& rmu(3, i))*temp380b74 + 7.d0*2*rmu(3, i)*temp380b73 + rmu(1, i)*& -& temp380b72 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) distpb(i, 2) = 0.0_8 END DO cb = 0.0_8 DO k=0,0,-1 - temp380b56 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp380b56 - rb(k) = rb(k) - dd1*temp380b56 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp279 = dd2*r(k) + 1.d0 + temp280b = costb/temp279 + temp279b0 = -(dd1*r(k)**2*temp280b/temp279) + dd1b = dd1b + r(k)**2*temp280b + rb(k) = rb(k) + dd2*temp279b0 + dd1*2*r(k)*temp280b + dd2b = dd2b + r(k)*temp279b0 END DO - dd1b = dd1b + .020104801169736915d0*5.5d0*dd1**4.5D0*cb + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocd*1.75d0*dd1**0.75D0*cb + ELSE + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocd*1.75d0*dd1**0.75D0*& +& cb + END IF ddb(indparp) = ddb(indparp) + dd1b - CASE (72) -! h-orbitals -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization obtained by Mathematica - c = dd1**3.25d0*0.79296269381073167718d0 -! C= dd1^13/4 /Sqrt[Integrate[x^12 Exp[-2 x^2],{x,0,Infinity}]] -! endif + CASE (115) +! 2s double lorentian with constant parent of 102 +! (dd3+ r^2/(1+dd2*r)^3+dd4*r^3/(1+dd5*r)^4; + dd2 = dd(indpar+1) + dd4 = dd(indpar+3) + dd5 = dd(indpar+4) + indorbp = indorb + 1 DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) - END DO - DO i=0,0 - DO k=1,5 - CALL PUSHREAL8(adr8ibuf,adr8buf,zv(k)) - zv(k) = rmu(3, i)**k - CALL PUSHREAL8(adr8ibuf,adr8buf,yv(k)) - yv(k) = rmu(2, i)**k - CALL PUSHREAL8(adr8ibuf,adr8buf,xv(k)) - xv(k) = rmu(1, i)**k - END DO - CALL PUSHREAL8(adr8ibuf,adr8buf,r2) - r2 = xv(2) + yv(2) + zv(2) - CALL PUSHREAL8(adr8ibuf,adr8buf,r4) - r4 = r2*r2 -! lz=0 - distp(i, 2) = cost1h*(63.d0*zv(5)-70.d0*zv(3)*r2+15.d0*zv(1)*r4) - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = 21.d0*zv(4) - 14.d0*zv(2)*r2 + r4 -! lz=+/-1 - distp(i, 3) = cost2h*rmu(1, i)*cost -! lz=+/-1 - distp(i, 4) = cost2h*rmu(2, i)*cost - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = 3.d0*zv(3) - zv(1)*r2 -! lz=+/-2 - distp(i, 5) = cost3h*(xv(2)-yv(2))*cost -! lz=+/-2 - distp(i, 6) = 2.d0*cost3h*xv(1)*yv(1)*cost - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = 9.d0*zv(2) - r2 -! lz=+/-3 - distp(i, 7) = cost4h*(xv(3)-3.d0*xv(1)*yv(2))*cost -! lz=+/-3 - distp(i, 8) = -(cost4h*(yv(3)-3.d0*yv(1)*xv(2))*cost) -! lz=+/-4 - distp(i, 9) = cost5h*(xv(4)-6.d0*xv(2)*yv(2)+yv(4))*zv(1) -! lz=+/-4 - distp(i, 10) = cost5h*4.d0*(xv(3)*yv(1)-yv(3)*xv(1))*zv(1) -! lz=+/-5 - distp(i, 11) = cost6h*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4)) -! lz=+/-5 - distp(i, 12) = -(cost6h*(-(5.d0*xv(4)*yv(1))+10.d0*xv(2)*yv(3)-yv(& -& 5))) - END DO - DO ic=1,11 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic + distp(k, 1) = r(k)**2/(1.d0+dd2*r(k))**3 + distp(k, 2) = r(k)**3/(1.d0+dd5*r(k))**4 END DO +! write(6,*) ' function inside = ',z(indorbp,i) ! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1) - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) - DO k=1,5 - CALL PUSHREAL8(adr8ibuf,adr8buf,zv(k)) - zv(k) = rmu(3, 0)**k - CALL PUSHREAL8(adr8ibuf,adr8buf,yv(k)) - yv(k) = rmu(2, 0)**k - CALL PUSHREAL8(adr8ibuf,adr8buf,xv(k)) - xv(k) = rmu(1, 0)**k - END DO - CALL PUSHREAL8(adr8ibuf,adr8buf,r2) - r2 = xv(2) + yv(2) + zv(2) - CALL PUSHREAL8(adr8ibuf,adr8buf,r4) - r4 = r2*r2 -! indorbp=indorb - DO ic=1,11 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - IF (ic .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) - ELSE IF (ic .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (ic .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE IF (ic .EQ. 4) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (ic .EQ. 5) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - ELSE IF (ic .EQ. 6) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE IF (ic .EQ. 7) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (ic .EQ. 8) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - ELSE IF (ic .EQ. 9) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE IF (ic .EQ. 10) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (ic .EQ. 11) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - END IF + fun = (2.d0-dd2*r(0))/(1+dd2*r(0))**4 - dd4*r(0)*(-3.d0+dd5*r(0))/& +& (1.d0+dd5*r(0))**5 + fun2b = zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 END DO - distpb = 0.0_8 - zvb = 0.0_8 - xvb = 0.0_8 - funb = 0.0_8 - yvb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - r2b = 0.0_8 - r4b = 0.0_8 - DO ic=11,1,-1 - temp387b61 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (12.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 12.d0*temp387b61 - fun2b = fun2b + temp387b61 - zb(indorbp, indt+4) = 0.0_8 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 6) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - IF (branch .LT. 1) THEN - temp387b11 = cost1h*fun0*zb(indorbp, indt+3) - temp387b12 = cost1h*20.d0*zb(indorbp, indt+2) - temp387b13 = (3.d0*xv(2)+3.d0*yv(2)-4.d0*zv(2))*& -& temp387b12 - temp387b14 = cost1h*20.d0*zb(indorbp, indt+1) - temp387b15 = (3.d0*xv(2)+3.d0*yv(2)-4.d0*zv(2))*& -& temp387b14 - fun0b = fun0b + zv(1)*yv(1)*temp387b13 + zv(1)*xv(1)*& -& temp387b15 + cost1h*(175.d0*zv(4)-150.d0*(zv(2)*r2)+& -& 15.d0*r4)*zb(indorbp, indt+3) - zvb(4) = zvb(4) + 175.d0*temp387b11 - zvb(2) = zvb(2) - 150.d0*r2*temp387b11 - r2b = r2b - 150.d0*zv(2)*temp387b11 - r4b = r4b + 15.d0*temp387b11 - temp387b16 = fun0*yv(1)*zv(1)*temp387b12 - yvb(1) = yvb(1) + zv(1)*fun0*temp387b13 - zvb(1) = zvb(1) + fun0*yv(1)*temp387b13 - xvb(2) = xvb(2) + 3.d0*temp387b16 - temp387b17 = fun0*xv(1)*zv(1)*temp387b14 - yvb(2) = yvb(2) + 3.d0*temp387b17 + 3.d0*temp387b16 - zvb(2) = zvb(2) - 4.d0*temp387b16 - xvb(1) = xvb(1) + zv(1)*fun0*temp387b15 - zvb(1) = zvb(1) + fun0*xv(1)*temp387b15 - xvb(2) = xvb(2) + 3.d0*temp387b17 - zvb(2) = zvb(2) - 4.d0*temp387b17 - ELSE - temp387b18 = cost2h*fun0*zb(indorbp, indt+3) - temp387b19 = -(24.d0*zv(1)*temp387b18) - fun0b = fun0b + cost2h*(4.d0*(xv(3)*yv(1))+4.d0*(xv(1)*& -& yv(3))-24.d0*(xv(1)*yv(1)*zv(2)))*zb(indorbp, indt+2) & -& + cost2h*(5.d0*xv(4)+6.d0*(xv(2)*yv(2))+yv(4)+8.d0*zv(& -& 4)-12.d0*(yv(2)*zv(2))-36.d0*(xv(2)*zv(2)))*zb(indorbp& -& , indt+1) + cost2h*(32.d0*(zv(3)*xv(1))-24.d0*(xv(1)*& -& yv(2)*zv(1))-24.d0*(xv(3)*zv(1)))*zb(indorbp, indt+3) - zvb(3) = zvb(3) + 32.d0*xv(1)*temp387b18 - xvb(1) = xvb(1) + yv(2)*temp387b19 + 32.d0*zv(3)*& -& temp387b18 - yvb(2) = yvb(2) + xv(1)*temp387b19 - zvb(1) = zvb(1) + (-(24.d0*xv(3))-24.d0*xv(1)*yv(2))*& -& temp387b18 - temp387b20 = cost2h*fun0*zb(indorbp, indt+2) - xvb(3) = xvb(3) + 4.d0*yv(1)*temp387b20 - 24.d0*zv(1)*& -& temp387b18 - temp387b21 = -(24.d0*zv(2)*temp387b20) - yvb(1) = yvb(1) + xv(1)*temp387b21 + 4.d0*xv(3)*& -& temp387b20 - xvb(1) = xvb(1) + yv(1)*temp387b21 + 4.d0*yv(3)*& -& temp387b20 - yvb(3) = yvb(3) + 4.d0*xv(1)*temp387b20 - zvb(2) = zvb(2) - 24.d0*xv(1)*yv(1)*temp387b20 - temp387b22 = cost2h*fun0*zb(indorbp, indt+1) - xvb(4) = xvb(4) + 5.d0*temp387b22 - xvb(2) = xvb(2) + (6.d0*yv(2)-36.d0*zv(2))*temp387b22 - yvb(2) = yvb(2) + (6.d0*xv(2)-12.d0*zv(2))*temp387b22 - yvb(4) = yvb(4) + temp387b22 - zvb(4) = zvb(4) + 8.d0*temp387b22 - zvb(2) = zvb(2) + (-(36.d0*xv(2))-12.d0*yv(2))*& -& temp387b22 - END IF - ELSE - temp387b23 = cost2h*fun0*zb(indorbp, indt+3) - temp387b24 = -(24.d0*zv(1)*temp387b23) - fun0b = fun0b + cost2h*(5.d0*yv(4)+6.d0*(xv(2)*yv(2))+xv(4& -& )+8.d0*zv(4)-12.d0*(xv(2)*zv(2))-36.d0*(yv(2)*zv(2)))*zb& -& (indorbp, indt+2) - cost2h*(24.d0*(xv(1)*yv(1)*zv(2))-& -& 4.d0*(xv(1)*yv(3))-4.d0*(xv(3)*yv(1)))*zb(indorbp, indt+& -& 1) + cost2h*(32.d0*(zv(3)*yv(1))-24.d0*(yv(1)*xv(2)*zv(1& -& ))-24.d0*(yv(3)*zv(1)))*zb(indorbp, indt+3) - zvb(3) = zvb(3) + 32.d0*yv(1)*temp387b23 - yvb(1) = yvb(1) + xv(2)*temp387b24 + 32.d0*zv(3)*& -& temp387b23 - temp387b25 = cost2h*fun0*zb(indorbp, indt+2) - xvb(2) = xvb(2) + (6.d0*yv(2)-12.d0*zv(2))*temp387b25 + yv& -& (1)*temp387b24 - zvb(1) = zvb(1) + (-(24.d0*yv(3))-24.d0*yv(1)*xv(2))*& -& temp387b23 - yvb(3) = yvb(3) - 24.d0*zv(1)*temp387b23 - yvb(4) = yvb(4) + 5.d0*temp387b25 - yvb(2) = yvb(2) + (6.d0*xv(2)-36.d0*zv(2))*temp387b25 - xvb(4) = xvb(4) + temp387b25 - zvb(4) = zvb(4) + 8.d0*temp387b25 - temp387b26 = -(cost2h*fun0*zb(indorbp, indt+1)) - zvb(2) = zvb(2) + 24.d0*xv(1)*yv(1)*temp387b26 + (-(36.d0*& -& yv(2))-12.d0*xv(2))*temp387b25 - temp387b27 = 24.d0*zv(2)*temp387b26 - xvb(1) = xvb(1) + yv(1)*temp387b27 - 4.d0*yv(3)*temp387b26 - yvb(1) = yvb(1) + xv(1)*temp387b27 - 4.d0*xv(3)*temp387b26 - yvb(3) = yvb(3) - 4.d0*xv(1)*temp387b26 - xvb(3) = xvb(3) - 4.d0*yv(1)*temp387b26 - END IF - ELSE IF (branch .LT. 5) THEN - IF (branch .LT. 4) THEN - temp387b28 = cost3h*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost3h*(4.d0*(yv(3)*zv(1))-4.d0*(yv(1)*zv(& -& 3)))*zb(indorbp, indt+2) + cost3h*(4.d0*(xv(1)*zv(3))-& -& 4.d0*(xv(3)*zv(1)))*zb(indorbp, indt+1) + cost3h*(yv(4)-& -& xv(4)+6.d0*(xv(2)*zv(2))-6.d0*(yv(2)*zv(2)))*zb(indorbp& -& , indt+3) - yvb(4) = yvb(4) + temp387b28 - xvb(4) = xvb(4) - temp387b28 - xvb(2) = xvb(2) + 6.d0*zv(2)*temp387b28 - zvb(2) = zvb(2) + (6.d0*xv(2)-6.d0*yv(2))*temp387b28 - yvb(2) = yvb(2) - 6.d0*zv(2)*temp387b28 - temp387b29 = cost3h*fun0*zb(indorbp, indt+2) - yvb(3) = yvb(3) + 4.d0*zv(1)*temp387b29 - zvb(1) = zvb(1) + 4.d0*yv(3)*temp387b29 - yvb(1) = yvb(1) - 4.d0*zv(3)*temp387b29 - temp387b30 = cost3h*fun0*zb(indorbp, indt+1) - zvb(3) = zvb(3) + 4.d0*xv(1)*temp387b30 - 4.d0*yv(1)*& -& temp387b29 - xvb(1) = xvb(1) + 4.d0*zv(3)*temp387b30 - xvb(3) = xvb(3) - 4.d0*zv(1)*temp387b30 - zvb(1) = zvb(1) - 4.d0*xv(3)*temp387b30 - ELSE - temp387b31 = -(cost3h*fun0*zb(indorbp, indt+3)) - temp387b32 = -(12.d0*zv(2)*temp387b31) - fun0b = fun0b - cost3h*(2.d0*(xv(3)*zv(1))+6.d0*(xv(1)*yv(& -& 2)*zv(1))-4.d0*(xv(1)*zv(3)))*zb(indorbp, indt+2) - & -& cost3h*(6.d0*(xv(2)*yv(1)*zv(1))+2.d0*(yv(3)*zv(1))-4.d0& -& *(yv(1)*zv(3)))*zb(indorbp, indt+1) - cost3h*(2.d0*(xv(3& -& )*yv(1))+2.d0*(xv(1)*yv(3))-12.d0*(xv(1)*yv(1)*zv(2)))*& -& zb(indorbp, indt+3) - xvb(3) = xvb(3) + 2.d0*yv(1)*temp387b31 - yvb(1) = yvb(1) + xv(1)*temp387b32 + 2.d0*xv(3)*temp387b31 - xvb(1) = xvb(1) + yv(1)*temp387b32 + 2.d0*yv(3)*temp387b31 - yvb(3) = yvb(3) + 2.d0*xv(1)*temp387b31 - zvb(2) = zvb(2) - 12.d0*xv(1)*yv(1)*temp387b31 - temp387b33 = -(cost3h*fun0*zb(indorbp, indt+2)) - temp387b34 = 6.d0*zv(1)*temp387b33 - xvb(3) = xvb(3) + 2.d0*zv(1)*temp387b33 - zvb(1) = zvb(1) + (6.d0*xv(1)*yv(2)+2.d0*xv(3))*temp387b33 - xvb(1) = xvb(1) + yv(2)*temp387b34 - 4.d0*zv(3)*temp387b33 - yvb(2) = yvb(2) + xv(1)*temp387b34 - zvb(3) = zvb(3) - 4.d0*xv(1)*temp387b33 - temp387b35 = -(cost3h*fun0*zb(indorbp, indt+1)) - temp387b36 = 6.d0*zv(1)*temp387b35 - xvb(2) = xvb(2) + yv(1)*temp387b36 - yvb(1) = yvb(1) + xv(2)*temp387b36 - 4.d0*zv(3)*temp387b35 - zvb(1) = zvb(1) + (2.d0*yv(3)+6.d0*xv(2)*yv(1))*temp387b35 - yvb(3) = yvb(3) + 2.d0*zv(1)*temp387b35 - zvb(3) = zvb(3) - 4.d0*yv(1)*temp387b35 - END IF - ELSE - temp387b37 = cost4h*fun0*zb(indorbp, indt+3) - temp387b38 = -(48.d0*zv(1)*temp387b37) - fun0b = fun0b + cost4h*(4.d0*(xv(3)*yv(1))+12.d0*(xv(1)*yv(3& -& ))-48.d0*(xv(1)*yv(1)*zv(2)))*zb(indorbp, indt+2) + cost4h& -& *(6.d0*(xv(2)*yv(2))-5.d0*xv(4)+3.d0*yv(4)+24.d0*(xv(2)*zv& -& (2))-24.d0*(yv(2)*zv(2)))*zb(indorbp, indt+1) + cost4h*(& -& 16.d0*(xv(3)*zv(1))-48.d0*(xv(1)*yv(2)*zv(1)))*zb(indorbp& -& , indt+3) - xvb(3) = xvb(3) + 16.d0*zv(1)*temp387b37 - zvb(1) = zvb(1) + (16.d0*xv(3)-48.d0*xv(1)*yv(2))*temp387b37 - xvb(1) = xvb(1) + yv(2)*temp387b38 - yvb(2) = yvb(2) + xv(1)*temp387b38 - temp387b39 = cost4h*fun0*zb(indorbp, indt+2) - temp387b40 = -(48.d0*zv(2)*temp387b39) - xvb(3) = xvb(3) + 4.d0*yv(1)*temp387b39 - yvb(1) = yvb(1) + xv(1)*temp387b40 + 4.d0*xv(3)*temp387b39 - xvb(1) = xvb(1) + yv(1)*temp387b40 + 12.d0*yv(3)*temp387b39 - yvb(3) = yvb(3) + 12.d0*xv(1)*temp387b39 - temp387b41 = cost4h*fun0*zb(indorbp, indt+1) - zvb(2) = zvb(2) + (24.d0*xv(2)-24.d0*yv(2))*temp387b41 - & -& 48.d0*xv(1)*yv(1)*temp387b39 - xvb(2) = xvb(2) + (24.d0*zv(2)+6.d0*yv(2))*temp387b41 - yvb(2) = yvb(2) + (6.d0*xv(2)-24.d0*zv(2))*temp387b41 - xvb(4) = xvb(4) - 5.d0*temp387b41 - yvb(4) = yvb(4) + 3.d0*temp387b41 - END IF - ELSE IF (branch .LT. 9) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 7) THEN - temp387b42 = -(cost4h*fun0*zb(indorbp, indt+3)) - temp387b43 = -(48.d0*zv(1)*temp387b42) - fun0b = fun0b - cost4h*(3.d0*xv(4)+6.d0*(xv(2)*yv(2))-5.d0& -& *yv(4)+24.d0*(yv(2)*zv(2))-24.d0*(xv(2)*zv(2)))*zb(& -& indorbp, indt+2) - cost4h*(12.d0*(xv(3)*yv(1))+4.d0*(xv(& -& 1)*yv(3))-48.d0*(xv(1)*yv(1)*zv(2)))*zb(indorbp, indt+1)& -& - cost4h*(16.d0*(yv(3)*zv(1))-48.d0*(xv(2)*yv(1)*zv(1)))& -& *zb(indorbp, indt+3) - yvb(3) = yvb(3) + 16.d0*zv(1)*temp387b42 - zvb(1) = zvb(1) + (16.d0*yv(3)-48.d0*xv(2)*yv(1))*& -& temp387b42 - xvb(2) = xvb(2) + yv(1)*temp387b43 - yvb(1) = yvb(1) + xv(2)*temp387b43 - temp387b44 = -(cost4h*fun0*zb(indorbp, indt+2)) - xvb(4) = xvb(4) + 3.d0*temp387b44 - xvb(2) = xvb(2) + (6.d0*yv(2)-24.d0*zv(2))*temp387b44 - yvb(2) = yvb(2) + (24.d0*zv(2)+6.d0*xv(2))*temp387b44 - yvb(4) = yvb(4) - 5.d0*temp387b44 - temp387b45 = -(cost4h*fun0*zb(indorbp, indt+1)) - zvb(2) = zvb(2) + (24.d0*yv(2)-24.d0*xv(2))*temp387b44 - & -& 48.d0*xv(1)*yv(1)*temp387b45 - temp387b46 = -(48.d0*zv(2)*temp387b45) - xvb(3) = xvb(3) + 12.d0*yv(1)*temp387b45 - yvb(1) = yvb(1) + xv(1)*temp387b46 + 12.d0*xv(3)*& -& temp387b45 - xvb(1) = xvb(1) + yv(1)*temp387b46 + 4.d0*yv(3)*temp387b45 - yvb(3) = yvb(3) + 4.d0*xv(1)*temp387b45 - ELSE - temp387b47 = cost5h*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost5h*(4.d0*(yv(3)*zv(1))-12.d0*(xv(2)*yv& -& (1)*zv(1)))*zb(indorbp, indt+2) + cost5h*(4.d0*(xv(3)*zv& -& (1))-12.d0*(xv(1)*yv(2)*zv(1)))*zb(indorbp, indt+1) + & -& cost5h*(xv(4)-6.d0*(xv(2)*yv(2))+yv(4))*zb(indorbp, indt& -& +3) - xvb(4) = xvb(4) + temp387b47 - temp387b48 = cost5h*fun0*zb(indorbp, indt+2) - temp387b49 = -(12.d0*zv(1)*temp387b48) - xvb(2) = xvb(2) + yv(1)*temp387b49 - 6.d0*yv(2)*temp387b47 - yvb(2) = yvb(2) - 6.d0*xv(2)*temp387b47 - yvb(4) = yvb(4) + temp387b47 - yvb(3) = yvb(3) + 4.d0*zv(1)*temp387b48 - temp387b50 = cost5h*fun0*zb(indorbp, indt+1) - zvb(1) = zvb(1) + (4.d0*xv(3)-12.d0*xv(1)*yv(2))*& -& temp387b50 + (4.d0*yv(3)-12.d0*xv(2)*yv(1))*temp387b48 - yvb(1) = yvb(1) + xv(2)*temp387b49 - temp387b51 = -(12.d0*zv(1)*temp387b50) - xvb(3) = xvb(3) + 4.d0*zv(1)*temp387b50 - xvb(1) = xvb(1) + yv(2)*temp387b51 - yvb(2) = yvb(2) + xv(1)*temp387b51 - END IF + temp300 = (dd2*r(0)+1)**5 + temp300b = 2.d0*fun2b/temp300 + temp300b0 = 2*dd2*r(0)*temp300b + temp300b1 = -(((dd2*r(0))**2-4.d0*(dd2*r(0))+1.d0)*5*(dd2*r(0)+1)& +& **4*temp300b/temp300) + temp299 = (dd5*r(0)+1.d0)**6 + temp298 = dd4*r(0)/temp299 + temp299b = 2.d0*temp298*fun2b + temp299b0 = 2*dd5*r(0)*temp299b + temp298b = 2.d0*((dd5*r(0))**2-6.d0*(dd5*r(0))+3.d0)*fun2b/temp299 + temp298b0 = -(temp298*6*(dd5*r(0)+1.d0)**5*temp298b) + temp297 = (dd2*r(0)+1)**4 + temp297b = funb0/temp297 + temp297b0 = -((2.d0-dd2*r(0))*4*(dd2*r(0)+1)**3*temp297b/temp297) + dd2b = r(0)*temp297b0 - r(0)*temp297b + r(0)*temp300b1 - 4.d0*r(0)& +& *temp300b + r(0)*temp300b0 + temp296 = (dd5*r(0)+1.d0)**5 + temp296b = -(funb0/temp296) + temp295 = dd5*r(0) - 3.d0 + temp294 = dd4*r(0) + temp294b = -(temp294*temp295*5*(dd5*r(0)+1.d0)**4*temp296b/temp296& +& ) + rb(0) = rb(0) + dd2*temp297b0 - dd2*temp297b + (temp294*dd5+& +& temp295*dd4)*temp296b + dd5*temp294b + dd5*temp298b0 + dd4*& +& temp298b - 6.d0*dd5*temp299b + dd5*temp299b0 + dd2*temp300b1 - & +& 4.d0*dd2*temp300b + dd2*temp300b0 + dd5b = temp294*r(0)*temp296b + r(0)*temp294b + r(0)*temp298b0 - & +& 6.d0*r(0)*temp299b + r(0)*temp299b0 + dd4b = temp295*r(0)*temp296b + r(0)*temp298b + ELSE + dd2b = 0.0_8 + dd4b = 0.0_8 + dd5b = 0.0_8 + END IF + distpb = 0.0_8 + dd3b = 0.0_8 + DO i=0,0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) + dd4b = dd4b + distp(i, 2)*zb(indorbp, i) + distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + DO k=0,0,-1 + temp292 = dd5*r(k) + 1.d0 + temp293 = temp292**4 + temp292b = -(r(k)**3*4*temp292**3*distpb(k, 2)/temp293**2) + rb(k) = rb(k) + dd5*temp292b + 3*r(k)**2*distpb(k, 2)/temp293 + dd5b = dd5b + r(k)*temp292b + distpb(k, 2) = 0.0_8 + temp290 = dd2*r(k) + 1.d0 + temp291 = temp290**3 + temp290b5 = -(r(k)**2*3*temp290**2*distpb(k, 1)/temp291**2) + rb(k) = rb(k) + dd2*temp290b5 + 2*r(k)*distpb(k, 1)/temp291 + dd2b = dd2b + r(k)*temp290b5 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+4) = ddb(indpar+4) + dd5b + ddb(indpar+3) = ddb(indpar+3) + dd4b + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (22) +! 3p without cusp condition +! r e^{-z1 r } + dd1 = dd(indpar+1) +! c=dsqrt((2.d0*dd1)**7/240.d0/pi)/2.d0 + c = dd1**3.5d0*0.2060129077457011d0 +! + DO k=0,0 + distp(k, 1) = c*DEXP(-(dd1*r(k))) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(k, 2)) + distp(k, 2) = r(k)*distp(k, 1) + END DO +! +! indorbp=indorb +! + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif +! +! + IF (typec .NE. 1) THEN + fun = (1.d0-dd1*r(0))*distp(0, 1) + fun2 = dd1*(dd1*r(0)-2.d0)*distp(0, 1) +! +! indorbp=indorb +! + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - temp387b52 = -(cost5h*fun0*zb(indorbp, indt+3)) - fun0b = fun0b - cost5h*(12.d0*(xv(1)*yv(2)*zv(1))-4.d0*(xv(3& -& )*zv(1)))*zb(indorbp, indt+2) - cost5h*(4.d0*(yv(3)*zv(1))& -& -12.d0*(xv(2)*yv(1)*zv(1)))*zb(indorbp, indt+1) - cost5h*(& -& 4.d0*(xv(1)*yv(3))-4.d0*(xv(3)*yv(1)))*zb(indorbp, indt+3) - xvb(1) = xvb(1) + 4.d0*yv(3)*temp387b52 - yvb(3) = yvb(3) + 4.d0*xv(1)*temp387b52 - xvb(3) = xvb(3) - 4.d0*yv(1)*temp387b52 - yvb(1) = yvb(1) - 4.d0*xv(3)*temp387b52 - temp387b53 = -(cost5h*fun0*zb(indorbp, indt+2)) - temp387b54 = 12.d0*zv(1)*temp387b53 - xvb(1) = xvb(1) + yv(2)*temp387b54 - yvb(2) = yvb(2) + xv(1)*temp387b54 - temp387b55 = -(cost5h*fun0*zb(indorbp, indt+1)) - zvb(1) = zvb(1) + (4.d0*yv(3)-12.d0*xv(2)*yv(1))*temp387b55 & -& + (12.d0*xv(1)*yv(2)-4.d0*xv(3))*temp387b53 - xvb(3) = xvb(3) - 4.d0*zv(1)*temp387b53 - temp387b56 = -(12.d0*zv(1)*temp387b55) - yvb(3) = yvb(3) + 4.d0*zv(1)*temp387b55 - xvb(2) = xvb(2) + yv(1)*temp387b56 - yvb(1) = yvb(1) + xv(2)*temp387b56 - END IF - ELSE IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - temp387b57 = cost6h*fun0*zb(indorbp, indt+2) - fun0b = fun0b + cost6h*(5.d0*xv(4)-30.d0*(xv(2)*yv(2))+5.d0*& -& yv(4))*zb(indorbp, indt+1) + cost6h*(20.d0*(xv(1)*yv(3))-& -& 20.d0*(xv(3)*yv(1)))*zb(indorbp, indt+2) - xvb(1) = xvb(1) + 20.d0*yv(3)*temp387b57 - yvb(3) = yvb(3) + 20.d0*xv(1)*temp387b57 - xvb(3) = xvb(3) - 20.d0*yv(1)*temp387b57 - yvb(1) = yvb(1) - 20.d0*xv(3)*temp387b57 - temp387b58 = cost6h*fun0*zb(indorbp, indt+1) - xvb(4) = xvb(4) + 5.d0*temp387b58 - xvb(2) = xvb(2) - 30.d0*yv(2)*temp387b58 - yvb(2) = yvb(2) - 30.d0*xv(2)*temp387b58 - yvb(4) = yvb(4) + 5.d0*temp387b58 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF - ELSE - temp387b59 = -(cost6h*fun0*zb(indorbp, indt+2)) - fun0b = fun0b - cost6h*(20.d0*(xv(1)*yv(3))-20.d0*(xv(3)*yv(1)& -& ))*zb(indorbp, indt+1) - cost6h*(30.d0*(xv(2)*yv(2))-5.d0*xv& -& (4)-5.d0*yv(4))*zb(indorbp, indt+2) - xvb(2) = xvb(2) + 30.d0*yv(2)*temp387b59 - yvb(2) = yvb(2) + 30.d0*xv(2)*temp387b59 - xvb(4) = xvb(4) - 5.d0*temp387b59 - yvb(4) = yvb(4) - 5.d0*temp387b59 - temp387b60 = -(cost6h*fun0*zb(indorbp, indt+1)) - xvb(1) = xvb(1) + 20.d0*yv(3)*temp387b60 - yvb(3) = yvb(3) + 20.d0*xv(1)*temp387b60 - xvb(3) = xvb(3) - 20.d0*yv(1)*temp387b60 - yvb(1) = yvb(1) - 20.d0*xv(3)*temp387b60 - END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp302 = fun/r(0) + temp303b = rmu(ic, 0)*zb(indorbp, indt+4) + temp302b = 4.d0*temp303b/r(0) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp302+fun2)*zb(indorbp, indt& +& +4) + funb0 = funb0 + temp302b + rb(0) = rb(0) - temp302*temp302b + fun2b = fun2b + temp303b + zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - temp387b10 = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp387b10 - funb = funb + rmu(i, 0)*temp387b10 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp301 = fun/r(0) + temp301b2 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(ic, 0) = rmub(ic, 0) + temp301*rmu(i, 0)*zb(indorbp, indt& +& +i) + rmub(i, 0) = rmub(i, 0) + temp301*rmu(ic, 0)*zb(indorbp, indt+& +& i) + funb0 = funb0 + temp301b2 + rb(0) = rb(0) - temp301*temp301b2 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - CALL POPREAL8(adr8ibuf,adr8buf,r4) - r2b = r2b + 2*r2*r4b - CALL POPREAL8(adr8ibuf,adr8buf,r2) - xvb(2) = xvb(2) + r2b - yvb(2) = yvb(2) + r2b - zvb(2) = zvb(2) + r2b - DO k=5,1,-1 - CALL POPREAL8(adr8ibuf,adr8buf,xv(k)) - IF (.NOT.(rmu(1, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(1, 0) = rmub(1, 0) + k*rmu(1, 0)**(k-1)*xvb(k) - xvb(k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,yv(k)) - IF (.NOT.(rmu(2, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(2, 0) = rmub(2, 0) + k*rmu(2, 0)**(k-1)*yvb(k) - yvb(k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,zv(k)) - IF (.NOT.(rmu(3, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(3, 0) = rmub(3, 0) + k*rmu(3, 0)**(k-1)*zvb(k) - zvb(k) = 0.0_8 - END DO - temp387b9 = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp387b9 - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp387b9 - distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + distpb = 0.0_8 + temp301b0 = dd1*distp(0, 1)*fun2b + temp301b1 = (dd1*r(0)-2.d0)*fun2b + dd1b = distp(0, 1)*temp301b1 - distp(0, 1)*r(0)*funb0 + r(0)*& +& temp301b0 + rb(0) = rb(0) + dd1*temp301b0 - distp(0, 1)*dd1*funb0 + distpb(0, 1) = (1.d0-dd1*r(0))*funb0 + dd1*temp301b1 + distpb(0, 2) = distpb(0, 2) + fun0b ELSE distpb = 0.0_8 - zvb = 0.0_8 - xvb = 0.0_8 - yvb = 0.0_8 + dd1b = 0.0_8 END IF - DO ic=11,1,-1 - DO k=0,0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) - zb(indorbp, k) = 0.0_8 + DO ic=3,1,-1 + DO i=0,0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 2)*zb(indorbp, i) + distpb(i, 2) = distpb(i, 2) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=0,0,-1 - temp387b = -(cost6h*distpb(i, 12)) - xvb(2) = xvb(2) + 10.d0*yv(3)*temp387b - yvb(3) = yvb(3) + 10.d0*xv(2)*temp387b - xvb(4) = xvb(4) - 5.d0*yv(1)*temp387b - yvb(1) = yvb(1) - 5.d0*xv(4)*temp387b - yvb(5) = yvb(5) - temp387b - distpb(i, 12) = 0.0_8 - temp387b0 = cost6h*distpb(i, 11) - xvb(5) = xvb(5) + temp387b0 - xvb(3) = xvb(3) - 10.d0*yv(2)*temp387b0 - yvb(2) = yvb(2) - 10.d0*xv(3)*temp387b0 - xvb(1) = xvb(1) + 5.d0*yv(4)*temp387b0 - yvb(4) = yvb(4) + 5.d0*xv(1)*temp387b0 - distpb(i, 11) = 0.0_8 - temp387b1 = cost5h*4.d0*distpb(i, 10) - temp387b2 = zv(1)*temp387b1 - xvb(3) = xvb(3) + yv(1)*temp387b2 - yvb(1) = yvb(1) + xv(3)*temp387b2 - yvb(3) = yvb(3) - xv(1)*temp387b2 - xvb(1) = xvb(1) - yv(3)*temp387b2 - distpb(i, 10) = 0.0_8 - zvb(1) = zvb(1) + cost5h*(xv(4)-6.d0*(xv(2)*yv(2))+yv(4))*distpb(i& -& , 9) + (xv(3)*yv(1)-yv(3)*xv(1))*temp387b1 - temp387b3 = cost5h*zv(1)*distpb(i, 9) - xvb(4) = xvb(4) + temp387b3 - distpb(i, 9) = 0.0_8 - temp387b4 = -(cost4h*cost*distpb(i, 8)) - xvb(2) = xvb(2) - 3.d0*yv(1)*temp387b4 - 6.d0*yv(2)*temp387b3 - yvb(2) = yvb(2) - 6.d0*xv(2)*temp387b3 - yvb(4) = yvb(4) + temp387b3 - yvb(3) = yvb(3) + temp387b4 - yvb(1) = yvb(1) - 3.d0*xv(2)*temp387b4 - costb = -(cost4h*(yv(3)-3.d0*(yv(1)*xv(2)))*distpb(i, 8)) - distpb(i, 8) = 0.0_8 - temp387b5 = cost4h*cost*distpb(i, 7) - xvb(3) = xvb(3) + temp387b5 - costb = costb + cost4h*(xv(3)-3.d0*(xv(1)*yv(2)))*distpb(i, 7) - distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp387b6 = cost3h*2.d0*distpb(i, 6) - xvb(1) = xvb(1) + yv(1)*cost*temp387b6 - 3.d0*yv(2)*temp387b5 - yvb(2) = yvb(2) - 3.d0*xv(1)*temp387b5 - zvb(2) = zvb(2) + 9.d0*costb - r2b = -costb - distpb(i, 6) = 0.0_8 - temp387b7 = cost3h*distpb(i, 5) - costb = (xv(2)-yv(2))*temp387b7 + yv(1)*xv(1)*temp387b6 - yvb(1) = yvb(1) + xv(1)*cost*temp387b6 - xvb(2) = xvb(2) + cost*temp387b7 - yvb(2) = yvb(2) - cost*temp387b7 - distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - zvb(3) = zvb(3) + 3.d0*costb - zvb(1) = zvb(1) - r2*costb - r2b = r2b - zv(1)*costb - rmub(2, i) = rmub(2, i) + cost2h*cost*distpb(i, 4) - costb = cost2h*rmu(2, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2h*cost*distpb(i, 3) - costb = costb + cost2h*rmu(1, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - zvb(4) = zvb(4) + 21.d0*costb - zvb(2) = zvb(2) - 14.d0*r2*costb - temp387b8 = cost1h*distpb(i, 2) - r4b = 15.d0*zv(1)*temp387b8 + costb - r2b = r2b + 2*r2*r4b - 70.d0*zv(3)*temp387b8 - 14.d0*zv(2)*costb - zvb(5) = zvb(5) + 63.d0*temp387b8 - zvb(3) = zvb(3) - 70.d0*r2*temp387b8 - zvb(1) = zvb(1) + 15.d0*r4*temp387b8 - distpb(i, 2) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,r4) - CALL POPREAL8(adr8ibuf,adr8buf,r2) - xvb(2) = xvb(2) + r2b - yvb(2) = yvb(2) + r2b - zvb(2) = zvb(2) + r2b - DO k=5,1,-1 - CALL POPREAL8(adr8ibuf,adr8buf,xv(k)) - IF (.NOT.(rmu(1, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(1, i) = rmub(1, i) + k*rmu(1, i)**(k-1)*xvb(k) - xvb(k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,yv(k)) - IF (.NOT.(rmu(2, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(2, i) = rmub(2, i) + k*rmu(2, i)**(k-1)*yvb(k) - yvb(k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,zv(k)) - IF (.NOT.(rmu(3, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(3, i) = rmub(3, i) + k*rmu(3, i)**(k-1)*zvb(k) - zvb(k) = 0.0_8 + cb = 0.0_8 + DO k=0,0,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(k, 2)) + rb(k) = rb(k) + distp(k, 1)*distpb(k, 2) + distpb(k, 1) = distpb(k, 1) + r(k)*distpb(k, 2) + distpb(k, 2) = 0.0_8 + temp301b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp301b + rb(k) = rb(k) - dd1*temp301b + distpb(k, 1) = 0.0_8 + END DO + dd1b = dd1b + 0.2060129077457011d0*3.5d0*dd1**2.5D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (13) +! 3p double zeta +! R(r)=r**3*(exp(-z1*r)+z3*exp(-z2*r)) +! +! +! +! if(iocc(indshellp).eq.1) then +! + indorbp = indorb + 1 + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + dd3 = dd(indpar+3) +! if(iflagnorm.gt.2) then + c = 1.d0/2.d0/DSQRT(pi*40320.d0*(1.d0/(2.d0*dd1)**9+2.d0*dd3/(dd1+& +& dd2)**9+dd3**2/(2.d0*dd2)**9)) +! endif +! + DO k=0,0 + distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 2) = c*DEXP(-(dd2*r(k))) + END DO +! + IF (typec .NE. 1) THEN + rp1 = r(0)**3 + rp2 = r(0)**2 +! +!c the first derivative + fun = distp(0, 1)*(3.d0*rp2-dd1*rp1) + dd3*distp(0, 2)*(3.d0*rp2-& +& dd2*rp1) +!c +! the second derivative + temp312b = 2.d0*zb(indorbp, indt+4)/r(0) + funb0 = temp312b + rb(0) = rb(0) - fun*temp312b/r(0) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + temp311 = fun/r(0) + temp311b8 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(i, 0) = rmub(i, 0) + temp311*zb(indorbp, indt+i) + funb0 = funb0 + temp311b8 + rb(0) = rb(0) - temp311*temp311b8 + zb(indorbp, indt+i) = 0.0_8 END DO + distpb = 0.0_8 + temp311b2 = distp(0, 1)*fun2b + temp311b3 = (6.d0*r(0)-6.d0*(dd2*rp2)+dd2**2*rp1)*fun2b + temp311b4 = dd3*distp(0, 2)*fun2b + distpb(0, 1) = (6.d0*r(0)-6.d0*(dd1*rp2)+dd1**2*rp1)*fun2b + temp311b5 = distp(0, 1)*funb0 + temp311b6 = dd3*distp(0, 2)*funb0 + rp2b = 3.d0*temp311b5 + 3.d0*temp311b6 - 6.d0*dd2*temp311b4 - 6.d0& +& *dd1*temp311b2 + rp1b = dd2**2*temp311b4 - dd2*temp311b6 - dd1*temp311b5 + dd1**2*& +& temp311b2 + rb(0) = rb(0) + 2*r(0)*rp2b + 3*r(0)**2*rp1b + 6.d0*temp311b4 + & +& 6.d0*temp311b2 + dd1b = (rp1*2*dd1-6.d0*rp2)*temp311b2 - rp1*temp311b5 + temp311b7 = (3.d0*rp2-dd2*rp1)*funb0 + dd3b = distp(0, 2)*temp311b7 + distp(0, 2)*temp311b3 + distpb(0, 2) = dd3*temp311b3 + dd2b = (rp1*2*dd2-6.d0*rp2)*temp311b4 - rp1*temp311b6 + distpb(0, 1) = distpb(0, 1) + (3.d0*rp2-dd1*rp1)*funb0 + distpb(0, 2) = distpb(0, 2) + dd3*temp311b7 + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 + dd3b = 0.0_8 + END IF + DO i=0,0,-1 + temp311b1 = r(i)**3*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp311b1 + dd3b = dd3b + distp(i, 2)*temp311b1 + distpb(i, 2) = distpb(i, 2) + dd3*temp311b1 + rb(i) = rb(i) + (distp(i, 1)+dd3*distp(i, 2))*3*r(i)**2*zb(indorbp& +& , i) + zb(indorbp, i) = 0.0_8 END DO - dd1b = 0.0_8 cb = 0.0_8 DO k=0,0,-1 - temp386 = r(k)**2 - temp386b58 = c*DEXP(-(dd1*temp386))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp386))*distpb(k, 1) - dd1b = dd1b - temp386*temp386b58 - rb(k) = rb(k) - dd1*2*r(k)*temp386b58 + temp311b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp311b + distpb(k, 2) = 0.0_8 + temp311b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp311b0 - dd2*temp311b + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp311b0 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.79296269381073167718d0*3.25d0*dd1**2.25D0*cb - ddb(indparp) = ddb(indparp) + dd1b - CASE (73) -! 2s gaussian for pseudo -! I-orbitals -! indorbp=indorb + temp310 = 2.d0**9 + temp309 = temp310*dd2**9 + temp308 = dd3**2/temp309 + temp307 = (dd1+dd2)**9 + temp306 = 2.d0**9 + temp305 = temp306*dd1**9 + temp304 = 40320.d0*pi*(1.0/temp305+2.d0*dd3/temp307+temp308) + temp303 = DSQRT(temp304) + IF (temp304 .EQ. 0.0) THEN + temp303b0 = 0.0 + ELSE + temp303b0 = -(pi*40320.d0*cb/(2.d0*temp303**2*2.D0*DSQRT(temp304))& +& ) + END IF + temp303b1 = 2.d0*temp303b0/temp307 + temp303b2 = -(dd3*9*(dd1+dd2)**8*temp303b1/temp307) + dd1b = dd1b + temp303b2 - temp306*9*dd1**8*temp303b0/temp305**2 + dd3b = dd3b + 2*dd3*temp303b0/temp309 + temp303b1 + dd2b = dd2b + temp303b2 - temp308*temp310*9*dd2**8*temp303b0/temp309 + ddb(indpar+3) = ddb(indpar+3) + dd3b + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (37, 68) +! 1s single Z pseudo +! d orbital +! +! - angmom = 2 +! - type = Gaussian +! - normalized = yes +! - angtype = spherical +! - npar = 1 +! - multiplicity = 5 +! indparp = indpar + 1 dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization obtained by Mathematica - c = dd1**3.75d0*0.43985656185609913955d0 -! C= dd1^15/4 /Sqrt[Integrate[x^14 Exp[-2 x^2],{x,0,Infinity}]] -! endif + c = dd1**1.75d0*1.64592278064948967213d0 DO k=0,0 distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO DO i=0,0 - DO k=1,6 - CALL PUSHREAL8(adr8ibuf,adr8buf,zv(k)) - zv(k) = rmu(3, i)**k - CALL PUSHREAL8(adr8ibuf,adr8buf,yv(k)) - yv(k) = rmu(2, i)**k - CALL PUSHREAL8(adr8ibuf,adr8buf,xv(k)) - xv(k) = rmu(1, i)**k - END DO - CALL PUSHREAL8(adr8ibuf,adr8buf,r2) - r2 = xv(2) + yv(2) + zv(2) - CALL PUSHREAL8(adr8ibuf,adr8buf,r4) - r4 = r2*r2 - r6 = r2*r4 ! lz=0 - distp(i, 2) = cost1i*(231.d0*zv(6)-315.d0*zv(4)*r2+105.d0*zv(2)*r4& -& -5.d0*r6) - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = 33.d0*zv(5) - 30.d0*zv(3)*r2 + 5.d0*zv(1)*r4 -! lz=+/-1 - distp(i, 3) = cost2i*rmu(1, i)*cost -! lz=+/-1 - distp(i, 4) = cost2i*rmu(2, i)*cost - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = 33.d0*zv(4) - 18.d0*zv(2)*r2 + r4 + distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d ! lz=+/-2 - distp(i, 5) = cost3i*(xv(2)-yv(2))*cost + distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d ! lz=+/-2 - distp(i, 6) = 2.d0*cost3i*xv(1)*yv(1)*cost - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = 11.d0*zv(3) - 3.d0*zv(1)*r2 -! lz=+/-3 - distp(i, 7) = cost4i*(xv(3)-3.d0*xv(1)*yv(2))*cost -! lz=+/-3 - distp(i, 8) = -(cost4i*(yv(3)-3.d0*yv(1)*xv(2))*cost) - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = 11.d0*zv(2) - r2 -! lz=+/-4 - distp(i, 9) = cost5i*(xv(4)-6.d0*xv(2)*yv(2)+yv(4))*cost -! lz=+/-4 - distp(i, 10) = cost5i*4.d0*(xv(3)*yv(1)-yv(3)*xv(1))*cost -! lz=+/-5 - distp(i, 11) = cost6i*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4))*& -& zv(1) -! lz=+/-5 - distp(i, 12) = -(cost6i*(-(5.d0*xv(4)*yv(1))+10.d0*xv(2)*yv(3)-yv(& -& 5))*zv(1)) -! lz=+/-6 - distp(i, 13) = cost7i*(xv(6)-15.d0*xv(4)*yv(2)+15.d0*xv(2)*yv(4)-& -& yv(6)) -! lz=+/-6 - distp(i, 14) = -(cost7i*(-(6.d0*xv(5)*yv(1))+20.d0*xv(3)*yv(3)-& -& 6.d0*yv(5)*xv(1))) + distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d +! lz=+/-1 + distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d +! lz=+/-1 + distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d END DO - DO ic=1,13 + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif IF (typec .NE. 1) THEN CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) dd1 = dd(indparp) fun0 = distp(0, 1) fun = -(2.d0*dd1*distp(0, 1)) fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) - DO k=1,6 - CALL PUSHREAL8(adr8ibuf,adr8buf,zv(k)) - zv(k) = rmu(3, 0)**k - CALL PUSHREAL8(adr8ibuf,adr8buf,yv(k)) - yv(k) = rmu(2, 0)**k - CALL PUSHREAL8(adr8ibuf,adr8buf,xv(k)) - xv(k) = rmu(1, 0)**k - END DO -! indorbp=indorb - DO ic=1,13 + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic IF (ic .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) @@ -14929,538 +14068,81 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd ELSE IF (ic .EQ. 4) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) ELSE IF (ic .EQ. 5) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - ELSE IF (ic .EQ. 6) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE IF (ic .EQ. 7) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (ic .EQ. 8) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - ELSE IF (ic .EQ. 9) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE IF (ic .EQ. 10) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (ic .EQ. 11) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE IF (ic .EQ. 12) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE IF (ic .EQ. 13) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF END DO distpb = 0.0_8 - zvb = 0.0_8 - xvb = 0.0_8 - funb = 0.0_8 - yvb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=13,1,-1 - temp388b91 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (14.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 14.d0*temp388b91 - fun2b = fun2b + temp388b91 + DO ic=5,1,-1 + temp313b6 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 6.d0*temp313b6 + fun2b = fun2b + temp313b6 zb(indorbp, indt+4) = 0.0_8 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 7) THEN - IF (branch .LT. 4) THEN - IF (branch .LT. 2) THEN - IF (branch .LT. 1) THEN - temp388b13 = cost1i*fun0*zb(indorbp, indt+3) - temp388b14 = 360.d0*zv(1)*temp388b13 - fun0b = fun0b + cost1i*(360.d0*(xv(2)*yv(1)*zv(2))-60.d0& -& *(xv(2)*yv(3))-30.d0*yv(5)-30.d0*(xv(4)*yv(1))+360.d0*& -& (yv(3)*zv(2))-240.d0*(yv(1)*zv(4)))*zb(indorbp, indt+2& -& ) + cost1i*(360.d0*(xv(3)*zv(2))-60.d0*(xv(3)*yv(2))-& -& 30.d0*(xv(1)*yv(4))-30.d0*xv(5)+360.d0*(xv(1)*yv(2)*zv& -& (2))-240.d0*(xv(1)*zv(4)))*zb(indorbp, indt+1) + & -& cost1i*(180.d0*(xv(4)*zv(1))+360.d0*(xv(2)*yv(2)*zv(1)& -& )+180.d0*(yv(4)*zv(1))+96.d0*zv(5)-480.d0*(yv(2)*zv(3)& -& )-480.d0*(xv(2)*zv(3)))*zb(indorbp, indt+3) - xvb(4) = xvb(4) + 180.d0*zv(1)*temp388b13 - zvb(1) = zvb(1) + (180.d0*yv(4)+360.d0*xv(2)*yv(2)+& -& 180.d0*xv(4))*temp388b13 - temp388b15 = cost1i*fun0*zb(indorbp, indt+2) - temp388b16 = 360.d0*zv(2)*temp388b15 - xvb(2) = xvb(2) + yv(1)*temp388b16 - 60.d0*yv(3)*& -& temp388b15 - 480.d0*zv(3)*temp388b13 + yv(2)*& -& temp388b14 - yvb(2) = yvb(2) + xv(2)*temp388b14 - 480.d0*zv(3)*& -& temp388b13 - yvb(4) = yvb(4) + 180.d0*zv(1)*temp388b13 - zvb(5) = zvb(5) + 96.d0*temp388b13 - zvb(3) = zvb(3) + (-(480.d0*xv(2))-480.d0*yv(2))*& -& temp388b13 - yvb(1) = yvb(1) + (-(240.d0*zv(4))-30.d0*xv(4))*& -& temp388b15 + xv(2)*temp388b16 - zvb(2) = zvb(2) + (360.d0*yv(3)+360.d0*xv(2)*yv(1))*& -& temp388b15 - yvb(3) = yvb(3) + (360.d0*zv(2)-60.d0*xv(2))*temp388b15 - yvb(5) = yvb(5) - 30.d0*temp388b15 - xvb(4) = xvb(4) - 30.d0*yv(1)*temp388b15 - zvb(4) = zvb(4) - 240.d0*yv(1)*temp388b15 - temp388b17 = cost1i*fun0*zb(indorbp, indt+1) - temp388b18 = 360.d0*zv(2)*temp388b17 - xvb(3) = xvb(3) + (360.d0*zv(2)-60.d0*yv(2))*temp388b17 - zvb(2) = zvb(2) + (360.d0*xv(1)*yv(2)+360.d0*xv(3))*& -& temp388b17 - yvb(2) = yvb(2) + xv(1)*temp388b18 - 60.d0*xv(3)*& -& temp388b17 - xvb(1) = xvb(1) + yv(2)*temp388b18 + (-(240.d0*zv(4))-& -& 30.d0*yv(4))*temp388b17 - yvb(4) = yvb(4) - 30.d0*xv(1)*temp388b17 - xvb(5) = xvb(5) - 30.d0*temp388b17 - zvb(4) = zvb(4) - 240.d0*xv(1)*temp388b17 - ELSE - temp388b19 = cost2i*fun0*zb(indorbp, indt+3) - temp388b20 = -(60.d0*zv(2)*temp388b19) - fun0b = fun0b + cost2i*(20.d0*(xv(3)*yv(1)*zv(1))+20.d0*& -& (xv(1)*yv(3)*zv(1))-40.d0*(xv(1)*yv(1)*zv(3)))*zb(& -& indorbp, indt+2) + cost2i*(25.d0*(xv(4)*zv(1))+30.d0*(& -& xv(2)*yv(2)*zv(1))+5.d0*(yv(4)*zv(1))+8.d0*zv(5)-20.d0& -& *(yv(2)*zv(3))-60.d0*(xv(2)*zv(3)))*zb(indorbp, indt+1& -& ) + cost2i*(5.d0*xv(5)+10.d0*(xv(3)*yv(2))+5.d0*(yv(4)& -& *xv(1))+40.d0*(xv(1)*zv(4))-60.d0*(xv(1)*yv(2)*zv(2))-& -& 60.d0*(xv(3)*zv(2)))*zb(indorbp, indt+3) - xvb(5) = xvb(5) + 5.d0*temp388b19 - xvb(3) = xvb(3) + (10.d0*yv(2)-60.d0*zv(2))*temp388b19 - yvb(2) = yvb(2) + xv(1)*temp388b20 + 10.d0*xv(3)*& -& temp388b19 - yvb(4) = yvb(4) + 5.d0*xv(1)*temp388b19 - xvb(1) = xvb(1) + yv(2)*temp388b20 + (40.d0*zv(4)+5.d0*& -& yv(4))*temp388b19 - zvb(4) = zvb(4) + 40.d0*xv(1)*temp388b19 - zvb(2) = zvb(2) + (-(60.d0*xv(3))-60.d0*xv(1)*yv(2))*& -& temp388b19 - temp388b21 = cost2i*fun0*zb(indorbp, indt+2) - temp388b22 = 20.d0*zv(1)*temp388b21 - temp388b23 = 20.d0*zv(1)*temp388b21 - temp388b24 = -(40.d0*zv(3)*temp388b21) - xvb(3) = xvb(3) + yv(1)*temp388b22 - yvb(1) = yvb(1) + xv(1)*temp388b24 + xv(3)*temp388b22 - zvb(1) = zvb(1) + (20.d0*xv(1)*yv(3)+20.d0*xv(3)*yv(1))*& -& temp388b21 - xvb(1) = xvb(1) + yv(1)*temp388b24 + yv(3)*temp388b23 - yvb(3) = yvb(3) + xv(1)*temp388b23 - zvb(3) = zvb(3) - 40.d0*xv(1)*yv(1)*temp388b21 - temp388b25 = cost2i*fun0*zb(indorbp, indt+1) - temp388b26 = 30.d0*zv(1)*temp388b25 - xvb(4) = xvb(4) + 25.d0*zv(1)*temp388b25 - zvb(1) = zvb(1) + (5.d0*yv(4)+30.d0*xv(2)*yv(2)+25.d0*xv& -& (4))*temp388b25 - xvb(2) = xvb(2) + yv(2)*temp388b26 - 60.d0*zv(3)*& -& temp388b25 - yvb(2) = yvb(2) + xv(2)*temp388b26 - 20.d0*zv(3)*& -& temp388b25 - yvb(4) = yvb(4) + 5.d0*zv(1)*temp388b25 - zvb(5) = zvb(5) + 8.d0*temp388b25 - zvb(3) = zvb(3) + (-(60.d0*xv(2))-20.d0*yv(2))*& -& temp388b25 - END IF - ELSE IF (branch .LT. 3) THEN - temp388b27 = -(cost2i*fun0*zb(indorbp, indt+3)) - temp388b28 = 60.d0*zv(2)*temp388b27 - fun0b = fun0b - cost2i*(20.d0*(xv(2)*zv(3))-30.d0*(xv(2)*& -& yv(2)*zv(1))-25.d0*(yv(4)*zv(1))-5.d0*(xv(4)*zv(1))+& -& 60.d0*(yv(2)*zv(3))-8.d0*zv(5))*zb(indorbp, indt+2) - & -& cost2i*(40.d0*(xv(1)*yv(1)*zv(3))-20.d0*(xv(1)*yv(3)*zv(& -& 1))-20.d0*(xv(3)*yv(1)*zv(1)))*zb(indorbp, indt+1) - & -& cost2i*(60.d0*(xv(2)*yv(1)*zv(2))-10.d0*(xv(2)*yv(3))-& -& 5.d0*yv(5)-5.d0*(xv(4)*yv(1))+60.d0*(yv(3)*zv(2))-40.d0*& -& (yv(1)*zv(4)))*zb(indorbp, indt+3) - xvb(2) = xvb(2) + yv(1)*temp388b28 - 10.d0*yv(3)*& -& temp388b27 - yvb(1) = yvb(1) + (-(40.d0*zv(4))-5.d0*xv(4))*temp388b27 +& -& xv(2)*temp388b28 - zvb(2) = zvb(2) + (60.d0*yv(3)+60.d0*xv(2)*yv(1))*& -& temp388b27 - yvb(3) = yvb(3) + (60.d0*zv(2)-10.d0*xv(2))*temp388b27 - yvb(5) = yvb(5) - 5.d0*temp388b27 - xvb(4) = xvb(4) - 5.d0*yv(1)*temp388b27 - zvb(4) = zvb(4) - 40.d0*yv(1)*temp388b27 - temp388b29 = -(cost2i*fun0*zb(indorbp, indt+2)) - temp388b30 = -(30.d0*zv(1)*temp388b29) - xvb(2) = xvb(2) + yv(2)*temp388b30 + 20.d0*zv(3)*& -& temp388b29 - zvb(3) = zvb(3) + (60.d0*yv(2)+20.d0*xv(2))*temp388b29 - yvb(2) = yvb(2) + 60.d0*zv(3)*temp388b29 + xv(2)*& -& temp388b30 - zvb(1) = zvb(1) + (-(5.d0*xv(4))-25.d0*yv(4)-30.d0*xv(2)*& -& yv(2))*temp388b29 - yvb(4) = yvb(4) - 25.d0*zv(1)*temp388b29 - xvb(4) = xvb(4) - 5.d0*zv(1)*temp388b29 - zvb(5) = zvb(5) - 8.d0*temp388b29 - temp388b31 = -(cost2i*fun0*zb(indorbp, indt+1)) - temp388b32 = 40.d0*zv(3)*temp388b31 - temp388b33 = -(20.d0*zv(1)*temp388b31) - temp388b34 = -(20.d0*zv(1)*temp388b31) - xvb(1) = xvb(1) + yv(3)*temp388b33 + yv(1)*temp388b32 - yvb(1) = yvb(1) + xv(3)*temp388b34 + xv(1)*temp388b32 - zvb(3) = zvb(3) + 40.d0*xv(1)*yv(1)*temp388b31 - yvb(3) = yvb(3) + xv(1)*temp388b33 - zvb(1) = zvb(1) + (-(20.d0*xv(3)*yv(1))-20.d0*xv(1)*yv(3))& -& *temp388b31 - xvb(3) = xvb(3) + yv(1)*temp388b34 - ELSE - temp388b35 = cost3i*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost3i*(2.d0*(xv(4)*yv(1))-4.d0*(xv(2)*yv(& -& 3))-6.d0*yv(5)+64.d0*(yv(3)*zv(2))-32.d0*(yv(1)*zv(4)))*& -& zb(indorbp, indt+2) + cost3i*(6.d0*xv(5)+4.d0*(xv(3)*yv(& -& 2))-2.d0*(xv(1)*yv(4))+32.d0*(xv(1)*zv(4))-64.d0*(xv(3)*& -& zv(2)))*zb(indorbp, indt+1) + cost3i*(32.d0*(yv(4)*zv(1)& -& )-32.d0*(xv(4)*zv(1))+64.d0*(xv(2)*zv(3))-64.d0*(yv(2)*& -& zv(3)))*zb(indorbp, indt+3) - yvb(4) = yvb(4) + 32.d0*zv(1)*temp388b35 - zvb(1) = zvb(1) + (32.d0*yv(4)-32.d0*xv(4))*temp388b35 - xvb(4) = xvb(4) - 32.d0*zv(1)*temp388b35 - xvb(2) = xvb(2) + 64.d0*zv(3)*temp388b35 - zvb(3) = zvb(3) + (64.d0*xv(2)-64.d0*yv(2))*temp388b35 - yvb(2) = yvb(2) - 64.d0*zv(3)*temp388b35 - temp388b36 = cost3i*fun0*zb(indorbp, indt+2) - xvb(4) = xvb(4) + 2.d0*yv(1)*temp388b36 - yvb(1) = yvb(1) + (2.d0*xv(4)-32.d0*zv(4))*temp388b36 - xvb(2) = xvb(2) - 4.d0*yv(3)*temp388b36 - yvb(3) = yvb(3) + (64.d0*zv(2)-4.d0*xv(2))*temp388b36 - yvb(5) = yvb(5) - 6.d0*temp388b36 - zvb(2) = zvb(2) + 64.d0*yv(3)*temp388b36 - temp388b37 = cost3i*fun0*zb(indorbp, indt+1) - zvb(4) = zvb(4) + 32.d0*xv(1)*temp388b37 - 32.d0*yv(1)*& -& temp388b36 - xvb(5) = xvb(5) + 6.d0*temp388b37 - xvb(3) = xvb(3) + (4.d0*yv(2)-64.d0*zv(2))*temp388b37 - yvb(2) = yvb(2) + 4.d0*xv(3)*temp388b37 - xvb(1) = xvb(1) + (32.d0*zv(4)-2.d0*yv(4))*temp388b37 - yvb(4) = yvb(4) - 2.d0*xv(1)*temp388b37 - zvb(2) = zvb(2) - 64.d0*xv(3)*temp388b37 - END IF - ELSE IF (branch .LT. 6) THEN - IF (branch .LT. 5) THEN - temp388b38 = -(cost3i*fun0*zb(indorbp, indt+3)) - temp388b39 = 64.d0*zv(1)*temp388b38 - temp388b40 = 64.d0*zv(1)*temp388b38 - temp388b41 = -(128.d0*zv(3)*temp388b38) - fun0b = fun0b - cost3i*(32.d0*(xv(3)*zv(2))-12.d0*(xv(3)*& -& yv(2))-10.d0*(xv(1)*yv(4))-2.d0*xv(5)+96.d0*(xv(1)*yv(2)& -& *zv(2))-32.d0*(xv(1)*zv(4)))*zb(indorbp, indt+2) - & -& cost3i*(96.d0*(xv(2)*yv(1)*zv(2))-12.d0*(xv(2)*yv(3))-& -& 2.d0*yv(5)-10.d0*(xv(4)*yv(1))+32.d0*(yv(3)*zv(2))-32.d0& -& *(yv(1)*zv(4)))*zb(indorbp, indt+1) - cost3i*(64.d0*(xv(& -& 3)*yv(1)*zv(1))+64.d0*(xv(1)*yv(3)*zv(1))-128.d0*(xv(1)*& -& yv(1)*zv(3)))*zb(indorbp, indt+3) - xvb(3) = xvb(3) + yv(1)*temp388b39 - yvb(1) = yvb(1) + xv(1)*temp388b41 + xv(3)*temp388b39 - zvb(1) = zvb(1) + (64.d0*xv(1)*yv(3)+64.d0*xv(3)*yv(1))*& -& temp388b38 - xvb(1) = xvb(1) + yv(1)*temp388b41 + yv(3)*temp388b40 - yvb(3) = yvb(3) + xv(1)*temp388b40 - zvb(3) = zvb(3) - 128.d0*xv(1)*yv(1)*temp388b38 - temp388b42 = -(cost3i*fun0*zb(indorbp, indt+2)) - temp388b43 = 96.d0*zv(2)*temp388b42 - xvb(3) = xvb(3) + (32.d0*zv(2)-12.d0*yv(2))*temp388b42 - zvb(2) = zvb(2) + (96.d0*xv(1)*yv(2)+32.d0*xv(3))*& -& temp388b42 - yvb(2) = yvb(2) + xv(1)*temp388b43 - 12.d0*xv(3)*& -& temp388b42 - xvb(1) = xvb(1) + yv(2)*temp388b43 + (-(32.d0*zv(4))-10.d0& -& *yv(4))*temp388b42 - yvb(4) = yvb(4) - 10.d0*xv(1)*temp388b42 - xvb(5) = xvb(5) - 2.d0*temp388b42 - zvb(4) = zvb(4) - 32.d0*xv(1)*temp388b42 - temp388b44 = -(cost3i*fun0*zb(indorbp, indt+1)) - temp388b45 = 96.d0*zv(2)*temp388b44 - xvb(2) = xvb(2) + yv(1)*temp388b45 - 12.d0*yv(3)*& -& temp388b44 - yvb(1) = yvb(1) + (-(32.d0*zv(4))-10.d0*xv(4))*temp388b44 & -& + xv(2)*temp388b45 - zvb(2) = zvb(2) + (32.d0*yv(3)+96.d0*xv(2)*yv(1))*& -& temp388b44 - yvb(3) = yvb(3) + (32.d0*zv(2)-12.d0*xv(2))*temp388b44 - yvb(5) = yvb(5) - 2.d0*temp388b44 - xvb(4) = xvb(4) - 10.d0*yv(1)*temp388b44 - zvb(4) = zvb(4) - 32.d0*yv(1)*temp388b44 - ELSE - temp388b46 = cost4i*fun0*zb(indorbp, indt+3) - temp388b47 = -(72.d0*zv(2)*temp388b46) - fun0b = fun0b + cost4i*(12.d0*(xv(3)*yv(1)*zv(1))+36.d0*(& -& xv(1)*yv(3)*zv(1))-48.d0*(xv(1)*yv(1)*zv(3)))*zb(indorbp& -& , indt+2) + cost4i*(18.d0*(xv(2)*yv(2)*zv(1))-15.d0*(xv(& -& 4)*zv(1))+9.d0*(yv(4)*zv(1))+24.d0*(xv(2)*zv(3))-24.d0*(& -& yv(2)*zv(3)))*zb(indorbp, indt+1) + cost4i*(6.d0*(xv(3)*& -& yv(2))-3.d0*xv(5)+9.d0*(xv(1)*yv(4))+24.d0*(xv(3)*zv(2))& -& -72.d0*(xv(1)*yv(2)*zv(2)))*zb(indorbp, indt+3) - xvb(3) = xvb(3) + (24.d0*zv(2)+6.d0*yv(2))*temp388b46 - yvb(2) = yvb(2) + xv(1)*temp388b47 + 6.d0*xv(3)*temp388b46 - xvb(5) = xvb(5) - 3.d0*temp388b46 - xvb(1) = xvb(1) + yv(2)*temp388b47 + 9.d0*yv(4)*temp388b46 - yvb(4) = yvb(4) + 9.d0*xv(1)*temp388b46 - zvb(2) = zvb(2) + (24.d0*xv(3)-72.d0*xv(1)*yv(2))*& -& temp388b46 - temp388b48 = cost4i*fun0*zb(indorbp, indt+2) - temp388b49 = 12.d0*zv(1)*temp388b48 - temp388b50 = 36.d0*zv(1)*temp388b48 - temp388b51 = -(48.d0*zv(3)*temp388b48) - xvb(3) = xvb(3) + yv(1)*temp388b49 - yvb(1) = yvb(1) + xv(1)*temp388b51 + xv(3)*temp388b49 - zvb(1) = zvb(1) + (36.d0*xv(1)*yv(3)+12.d0*xv(3)*yv(1))*& -& temp388b48 - xvb(1) = xvb(1) + yv(1)*temp388b51 + yv(3)*temp388b50 - yvb(3) = yvb(3) + xv(1)*temp388b50 - zvb(3) = zvb(3) - 48.d0*xv(1)*yv(1)*temp388b48 - temp388b52 = cost4i*fun0*zb(indorbp, indt+1) - temp388b53 = 18.d0*zv(1)*temp388b52 - xvb(2) = xvb(2) + 24.d0*zv(3)*temp388b52 + yv(2)*& -& temp388b53 - yvb(2) = yvb(2) + xv(2)*temp388b53 - 24.d0*zv(3)*& -& temp388b52 - zvb(1) = zvb(1) + (9.d0*yv(4)-15.d0*xv(4)+18.d0*xv(2)*yv(2& -& ))*temp388b52 - xvb(4) = xvb(4) - 15.d0*zv(1)*temp388b52 - yvb(4) = yvb(4) + 9.d0*zv(1)*temp388b52 - zvb(3) = zvb(3) + (24.d0*xv(2)-24.d0*yv(2))*temp388b52 - END IF - ELSE - temp388b54 = -(cost4i*fun0*zb(indorbp, indt+3)) - temp388b55 = -(72.d0*zv(2)*temp388b54) - fun0b = fun0b - cost4i*(9.d0*(xv(4)*zv(1))+18.d0*(xv(2)*yv(2& -& )*zv(1))-15.d0*(yv(4)*zv(1))+24.d0*(yv(2)*zv(3))-24.d0*(xv& -& (2)*zv(3)))*zb(indorbp, indt+2) - cost4i*(36.d0*(xv(3)*yv(& -& 1)*zv(1))+12.d0*(xv(1)*yv(3)*zv(1))-48.d0*(xv(1)*yv(1)*zv(& -& 3)))*zb(indorbp, indt+1) - cost4i*(9.d0*(xv(4)*yv(1))+6.d0& -& *(xv(2)*yv(3))-3.d0*yv(5)+24.d0*(yv(3)*zv(2))-72.d0*(xv(2)& -& *yv(1)*zv(2)))*zb(indorbp, indt+3) - xvb(4) = xvb(4) + 9.d0*yv(1)*temp388b54 - yvb(1) = yvb(1) + xv(2)*temp388b55 + 9.d0*xv(4)*temp388b54 - xvb(2) = xvb(2) + yv(1)*temp388b55 + 6.d0*yv(3)*temp388b54 - yvb(3) = yvb(3) + (24.d0*zv(2)+6.d0*xv(2))*temp388b54 - yvb(5) = yvb(5) - 3.d0*temp388b54 - zvb(2) = zvb(2) + (24.d0*yv(3)-72.d0*xv(2)*yv(1))*temp388b54 - temp388b56 = -(cost4i*fun0*zb(indorbp, indt+2)) - temp388b57 = 18.d0*zv(1)*temp388b56 - xvb(4) = xvb(4) + 9.d0*zv(1)*temp388b56 - zvb(1) = zvb(1) + (18.d0*xv(2)*yv(2)-15.d0*yv(4)+9.d0*xv(4))& -& *temp388b56 - xvb(2) = xvb(2) + yv(2)*temp388b57 - 24.d0*zv(3)*temp388b56 - yvb(2) = yvb(2) + 24.d0*zv(3)*temp388b56 + xv(2)*temp388b57 - yvb(4) = yvb(4) - 15.d0*zv(1)*temp388b56 - zvb(3) = zvb(3) + (24.d0*yv(2)-24.d0*xv(2))*temp388b56 - temp388b58 = -(cost4i*fun0*zb(indorbp, indt+1)) - temp388b59 = 36.d0*zv(1)*temp388b58 - temp388b60 = 12.d0*zv(1)*temp388b58 - temp388b61 = -(48.d0*zv(3)*temp388b58) - xvb(3) = xvb(3) + yv(1)*temp388b59 - yvb(1) = yvb(1) + xv(1)*temp388b61 + xv(3)*temp388b59 - zvb(1) = zvb(1) + (12.d0*xv(1)*yv(3)+36.d0*xv(3)*yv(1))*& -& temp388b58 - xvb(1) = xvb(1) + yv(1)*temp388b61 + yv(3)*temp388b60 - yvb(3) = yvb(3) + xv(1)*temp388b60 - zvb(3) = zvb(3) - 48.d0*xv(1)*yv(1)*temp388b58 - END IF - ELSE IF (branch .LT. 11) THEN - IF (branch .LT. 9) THEN - IF (branch .LT. 8) THEN - temp388b62 = cost5i*fun0*zb(indorbp, indt+3) - temp388b63 = -(120.d0*zv(1)*temp388b62) - fun0b = fun0b + cost5i*(10.d0*(xv(4)*yv(1))+20.d0*(xv(2)*& -& yv(3))-6.d0*yv(5)+40.d0*(yv(3)*zv(2))-120.d0*(xv(2)*yv(1& -& )*zv(2)))*zb(indorbp, indt+2) + cost5i*(20.d0*(xv(3)*yv(& -& 2))-6.d0*xv(5)+10.d0*(xv(1)*yv(4))+40.d0*(xv(3)*zv(2))-& -& 120.d0*(xv(1)*yv(2)*zv(2)))*zb(indorbp, indt+1) + cost5i& -& *(20.d0*(xv(4)*zv(1))-120.d0*(xv(2)*yv(2)*zv(1))+20.d0*(& -& yv(4)*zv(1)))*zb(indorbp, indt+3) - xvb(4) = xvb(4) + 20.d0*zv(1)*temp388b62 - zvb(1) = zvb(1) + (20.d0*yv(4)-120.d0*xv(2)*yv(2)+20.d0*xv& -& (4))*temp388b62 - xvb(2) = xvb(2) + yv(2)*temp388b63 - yvb(2) = yvb(2) + xv(2)*temp388b63 - yvb(4) = yvb(4) + 20.d0*zv(1)*temp388b62 - temp388b64 = cost5i*fun0*zb(indorbp, indt+2) - temp388b65 = -(120.d0*zv(2)*temp388b64) - xvb(4) = xvb(4) + 10.d0*yv(1)*temp388b64 - yvb(1) = yvb(1) + xv(2)*temp388b65 + 10.d0*xv(4)*& -& temp388b64 - xvb(2) = xvb(2) + yv(1)*temp388b65 + 20.d0*yv(3)*& -& temp388b64 - yvb(3) = yvb(3) + (40.d0*zv(2)+20.d0*xv(2))*temp388b64 - yvb(5) = yvb(5) - 6.d0*temp388b64 - temp388b66 = cost5i*fun0*zb(indorbp, indt+1) - zvb(2) = zvb(2) + (40.d0*xv(3)-120.d0*xv(1)*yv(2))*& -& temp388b66 + (40.d0*yv(3)-120.d0*xv(2)*yv(1))*temp388b64 - temp388b67 = -(120.d0*zv(2)*temp388b66) - xvb(3) = xvb(3) + (40.d0*zv(2)+20.d0*yv(2))*temp388b66 - yvb(2) = yvb(2) + xv(1)*temp388b67 + 20.d0*xv(3)*& -& temp388b66 - xvb(5) = xvb(5) - 6.d0*temp388b66 - xvb(1) = xvb(1) + yv(2)*temp388b67 + 10.d0*yv(4)*& -& temp388b66 - yvb(4) = yvb(4) + 10.d0*xv(1)*temp388b66 + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + IF (branch .LT. 1) THEN + temp313b1 = cost1d*4.d0*zb(indorbp, indt+3) + rmub(3, 0) = rmub(3, 0) + fun0*temp313b1 + temp313b2 = -(cost1d*2.d0*zb(indorbp, indt+2)) + temp313b3 = -(cost1d*2.d0*zb(indorbp, indt+1)) + fun0b = fun0b + rmu(2, 0)*temp313b2 + rmu(1, 0)*temp313b3 & +& + rmu(3, 0)*temp313b1 + rmub(2, 0) = rmub(2, 0) + fun0*temp313b2 + rmub(1, 0) = rmub(1, 0) + fun0*temp313b3 ELSE - temp388b68 = -(cost5i*fun0*zb(indorbp, indt+3)) - temp388b69 = 80.d0*zv(1)*temp388b68 - temp388b70 = -(80.d0*zv(1)*temp388b68) - fun0b = fun0b - cost5i*(4.d0*xv(5)-20.d0*(xv(1)*yv(4))+& -& 120.d0*(xv(1)*yv(2)*zv(2))-40.d0*(xv(3)*zv(2)))*zb(& -& indorbp, indt+2) - cost5i*(20.d0*(xv(4)*yv(1))-4.d0*yv(5& -& )+40.d0*(yv(3)*zv(2))-120.d0*(xv(2)*yv(1)*zv(2)))*zb(& -& indorbp, indt+1) - cost5i*(80.d0*(xv(1)*yv(3)*zv(1))-& -& 80.d0*(xv(3)*yv(1)*zv(1)))*zb(indorbp, indt+3) - xvb(1) = xvb(1) + yv(3)*temp388b69 - yvb(3) = yvb(3) + xv(1)*temp388b69 - zvb(1) = zvb(1) + (80.d0*xv(1)*yv(3)-80.d0*xv(3)*yv(1))*& -& temp388b68 - xvb(3) = xvb(3) + yv(1)*temp388b70 - yvb(1) = yvb(1) + xv(3)*temp388b70 - temp388b71 = -(cost5i*fun0*zb(indorbp, indt+2)) - temp388b72 = 120.d0*zv(2)*temp388b71 - xvb(5) = xvb(5) + 4.d0*temp388b71 - xvb(1) = xvb(1) + yv(2)*temp388b72 - 20.d0*yv(4)*& -& temp388b71 - yvb(4) = yvb(4) - 20.d0*xv(1)*temp388b71 - yvb(2) = yvb(2) + xv(1)*temp388b72 - temp388b73 = -(cost5i*fun0*zb(indorbp, indt+1)) - zvb(2) = zvb(2) + (40.d0*yv(3)-120.d0*xv(2)*yv(1))*& -& temp388b73 + (120.d0*xv(1)*yv(2)-40.d0*xv(3))*temp388b71 - xvb(3) = xvb(3) - 40.d0*zv(2)*temp388b71 - temp388b74 = -(120.d0*zv(2)*temp388b73) - xvb(4) = xvb(4) + 20.d0*yv(1)*temp388b73 - yvb(1) = yvb(1) + xv(2)*temp388b74 + 20.d0*xv(4)*& -& temp388b73 - yvb(5) = yvb(5) - 4.d0*temp388b73 - yvb(3) = yvb(3) + 40.d0*zv(2)*temp388b73 - xvb(2) = xvb(2) + yv(1)*temp388b74 + temp313b4 = -(cost2d*2.d0*zb(indorbp, indt+2)) + rmub(2, 0) = rmub(2, 0) + fun0*temp313b4 + temp313b5 = cost2d*2.d0*zb(indorbp, indt+1) + fun0b = fun0b + rmu(1, 0)*temp313b5 + rmu(2, 0)*temp313b4 + rmub(1, 0) = rmub(1, 0) + fun0*temp313b5 END IF - ELSE IF (branch .LT. 10) THEN - temp388b75 = cost6i*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost6i*(20.d0*(xv(1)*yv(3)*zv(1))-20.d0*(xv(& -& 3)*yv(1)*zv(1)))*zb(indorbp, indt+2) + cost6i*(5.d0*(xv(4)& -& *zv(1))-30.d0*(xv(2)*yv(2)*zv(1))+5.d0*(yv(4)*zv(1)))*zb(& -& indorbp, indt+1) + cost6i*(xv(5)-10.d0*(xv(3)*yv(2))+5.d0*& -& (xv(1)*yv(4)))*zb(indorbp, indt+3) - xvb(5) = xvb(5) + temp388b75 - xvb(3) = xvb(3) - 10.d0*yv(2)*temp388b75 - yvb(2) = yvb(2) - 10.d0*xv(3)*temp388b75 - temp388b76 = cost6i*fun0*zb(indorbp, indt+2) - temp388b77 = 20.d0*zv(1)*temp388b76 - xvb(1) = xvb(1) + yv(3)*temp388b77 + 5.d0*yv(4)*temp388b75 - yvb(4) = yvb(4) + 5.d0*xv(1)*temp388b75 - temp388b78 = -(20.d0*zv(1)*temp388b76) - yvb(3) = yvb(3) + xv(1)*temp388b77 - temp388b79 = cost6i*fun0*zb(indorbp, indt+1) - zvb(1) = zvb(1) + (5.d0*yv(4)-30.d0*xv(2)*yv(2)+5.d0*xv(4))*& -& temp388b79 + (20.d0*xv(1)*yv(3)-20.d0*xv(3)*yv(1))*& -& temp388b76 - xvb(3) = xvb(3) + yv(1)*temp388b78 - yvb(1) = yvb(1) + xv(3)*temp388b78 - temp388b80 = -(30.d0*zv(1)*temp388b79) - xvb(4) = xvb(4) + 5.d0*zv(1)*temp388b79 - xvb(2) = xvb(2) + yv(2)*temp388b80 - yvb(2) = yvb(2) + xv(2)*temp388b80 - yvb(4) = yvb(4) + 5.d0*zv(1)*temp388b79 ELSE - temp388b81 = -(cost6i*fun0*zb(indorbp, indt+3)) - fun0b = fun0b - cost6i*(30.d0*(xv(2)*yv(2)*zv(1))-5.d0*(xv(4& -& )*zv(1))-5.d0*(yv(4)*zv(1)))*zb(indorbp, indt+2) - cost6i*& -& (20.d0*(xv(1)*yv(3)*zv(1))-20.d0*(xv(3)*yv(1)*zv(1)))*zb(& -& indorbp, indt+1) - cost6i*(10.d0*(xv(2)*yv(3))-5.d0*(xv(4)& -& *yv(1))-yv(5))*zb(indorbp, indt+3) - xvb(2) = xvb(2) + 10.d0*yv(3)*temp388b81 - yvb(3) = yvb(3) + 10.d0*xv(2)*temp388b81 - xvb(4) = xvb(4) - 5.d0*yv(1)*temp388b81 - yvb(1) = yvb(1) - 5.d0*xv(4)*temp388b81 - yvb(5) = yvb(5) - temp388b81 - temp388b82 = -(cost6i*fun0*zb(indorbp, indt+2)) - temp388b83 = 30.d0*zv(1)*temp388b82 - xvb(2) = xvb(2) + yv(2)*temp388b83 - yvb(2) = yvb(2) + xv(2)*temp388b83 - temp388b84 = -(cost6i*fun0*zb(indorbp, indt+1)) - zvb(1) = zvb(1) + (20.d0*xv(1)*yv(3)-20.d0*xv(3)*yv(1))*& -& temp388b84 + (30.d0*xv(2)*yv(2)-5.d0*xv(4)-5.d0*yv(4))*& -& temp388b82 - xvb(4) = xvb(4) - 5.d0*zv(1)*temp388b82 - yvb(4) = yvb(4) - 5.d0*zv(1)*temp388b82 - temp388b85 = 20.d0*zv(1)*temp388b84 - temp388b86 = -(20.d0*zv(1)*temp388b84) - xvb(1) = xvb(1) + yv(3)*temp388b85 - yvb(3) = yvb(3) + xv(1)*temp388b85 - xvb(3) = xvb(3) + yv(1)*temp388b86 - yvb(1) = yvb(1) + xv(3)*temp388b86 + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+2) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+1) + & +& cost3d*rmu(1, 0)*zb(indorbp, indt+2) + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+1) END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 12) THEN - temp388b87 = cost7i*fun0*zb(indorbp, indt+2) - fun0b = fun0b + cost7i*(6.d0*xv(5)-60.d0*(xv(3)*yv(2))+30.d0& -& *(xv(1)*yv(4)))*zb(indorbp, indt+1) + cost7i*(60.d0*(xv(2)& -& *yv(3))-30.d0*(xv(4)*yv(1))-6.d0*yv(5))*zb(indorbp, indt+2& -& ) - xvb(2) = xvb(2) + 60.d0*yv(3)*temp388b87 - yvb(3) = yvb(3) + 60.d0*xv(2)*temp388b87 - xvb(4) = xvb(4) - 30.d0*yv(1)*temp388b87 - yvb(1) = yvb(1) - 30.d0*xv(4)*temp388b87 - yvb(5) = yvb(5) - 6.d0*temp388b87 - temp388b88 = cost7i*fun0*zb(indorbp, indt+1) - xvb(5) = xvb(5) + 6.d0*temp388b88 - xvb(3) = xvb(3) - 60.d0*yv(2)*temp388b88 - yvb(2) = yvb(2) - 60.d0*xv(3)*temp388b88 - xvb(1) = xvb(1) + 30.d0*yv(4)*temp388b88 - yvb(4) = yvb(4) + 30.d0*xv(1)*temp388b88 + ELSE IF (branch .LT. 5) THEN + IF (branch .LT. 4) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+2) + & +& cost3d*rmu(2, 0)*zb(indorbp, indt+3) + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+2) END IF ELSE - temp388b89 = -(cost7i*fun0*zb(indorbp, indt+2)) - fun0b = fun0b - cost7i*(60.d0*(xv(2)*yv(3))-30.d0*(xv(4)*yv(1)& -& )-6.d0*yv(5))*zb(indorbp, indt+1) - cost7i*(60.d0*(xv(3)*yv(& -& 2))-6.d0*xv(5)-30.d0*(xv(1)*yv(4)))*zb(indorbp, indt+2) - xvb(3) = xvb(3) + 60.d0*yv(2)*temp388b89 - yvb(2) = yvb(2) + 60.d0*xv(3)*temp388b89 - xvb(5) = xvb(5) - 6.d0*temp388b89 - xvb(1) = xvb(1) - 30.d0*yv(4)*temp388b89 - yvb(4) = yvb(4) - 30.d0*xv(1)*temp388b89 - temp388b90 = -(cost7i*fun0*zb(indorbp, indt+1)) - xvb(2) = xvb(2) + 60.d0*yv(3)*temp388b90 - yvb(3) = yvb(3) + 60.d0*xv(2)*temp388b90 - xvb(4) = xvb(4) - 30.d0*yv(1)*temp388b90 - yvb(1) = yvb(1) - 30.d0*xv(4)*temp388b90 - yvb(5) = yvb(5) - 6.d0*temp388b90 - END IF - DO i=3,1,-1 - temp388b12 = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp388b12 - funb = funb + rmu(i, 0)*temp388b12 - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO k=6,1,-1 - CALL POPREAL8(adr8ibuf,adr8buf,xv(k)) - IF (.NOT.(rmu(1, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(1, 0) = rmub(1, 0) + k*rmu(1, 0)**(k-1)*xvb(k) - xvb(k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,yv(k)) - IF (.NOT.(rmu(2, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(2, 0) = rmub(2, 0) + k*rmu(2, 0)**(k-1)*yvb(k) - yvb(k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,zv(k)) - IF (.NOT.(rmu(3, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(3, 0) = rmub(3, 0) + k*rmu(3, 0)**(k-1)*zvb(k) - zvb(k) = 0.0_8 + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+1) + cost3d*& +& rmu(1, 0)*zb(indorbp, indt+3) + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+1) + END IF + DO i=3,1,-1 + temp313b0 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp313b0 + funb0 = funb0 + rmu(i, 0)*temp313b0 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp388b11 = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp388b11 - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp388b11 - distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb + temp313b = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp313b - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp313b + distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb0 CALL POPREAL8(adr8ibuf,adr8buf,dd1) ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - zvb = 0.0_8 - xvb = 0.0_8 - yvb = 0.0_8 END IF - DO ic=13,1,-1 + DO ic=5,1,-1 DO k=0,0,-1 distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) @@ -15469,191 +14151,171 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - temp388b = -(cost7i*distpb(i, 14)) - xvb(3) = xvb(3) + 20.d0*yv(3)*temp388b - yvb(3) = yvb(3) + 20.d0*xv(3)*temp388b - xvb(5) = xvb(5) - 6.d0*yv(1)*temp388b - yvb(1) = yvb(1) - 6.d0*xv(5)*temp388b - yvb(5) = yvb(5) - 6.d0*xv(1)*temp388b - xvb(1) = xvb(1) - 6.d0*yv(5)*temp388b - distpb(i, 14) = 0.0_8 - temp388b0 = cost7i*distpb(i, 13) - xvb(6) = xvb(6) + temp388b0 - xvb(4) = xvb(4) - 15.d0*yv(2)*temp388b0 - yvb(2) = yvb(2) - 15.d0*xv(4)*temp388b0 - distpb(i, 13) = 0.0_8 - temp388b1 = -(cost6i*zv(1)*distpb(i, 12)) - xvb(2) = xvb(2) + 10.d0*yv(3)*temp388b1 + 15.d0*yv(4)*temp388b0 - yvb(4) = yvb(4) + 15.d0*xv(2)*temp388b0 - yvb(6) = yvb(6) - temp388b0 - yvb(3) = yvb(3) + 10.d0*xv(2)*temp388b1 - xvb(4) = xvb(4) - 5.d0*yv(1)*temp388b1 - yvb(1) = yvb(1) - 5.d0*xv(4)*temp388b1 - yvb(5) = yvb(5) - temp388b1 - zvb(1) = zvb(1) - cost6i*(10.d0*(xv(2)*yv(3))-5.d0*(xv(4)*yv(1))-& -& yv(5))*distpb(i, 12) - distpb(i, 12) = 0.0_8 - temp388b2 = cost6i*zv(1)*distpb(i, 11) - xvb(5) = xvb(5) + temp388b2 - xvb(3) = xvb(3) - 10.d0*yv(2)*temp388b2 - yvb(2) = yvb(2) - 10.d0*xv(3)*temp388b2 - xvb(1) = xvb(1) + 5.d0*yv(4)*temp388b2 - yvb(4) = yvb(4) + 5.d0*xv(1)*temp388b2 - zvb(1) = zvb(1) + cost6i*(xv(5)-10.d0*(xv(3)*yv(2))+5.d0*(xv(1)*yv& -& (4)))*distpb(i, 11) - distpb(i, 11) = 0.0_8 - temp388b3 = cost5i*4.d0*distpb(i, 10) - temp388b4 = cost*temp388b3 - xvb(3) = xvb(3) + yv(1)*temp388b4 - yvb(1) = yvb(1) + xv(3)*temp388b4 - yvb(3) = yvb(3) - xv(1)*temp388b4 - xvb(1) = xvb(1) - yv(3)*temp388b4 - distpb(i, 10) = 0.0_8 - costb = cost5i*(xv(4)-6.d0*(xv(2)*yv(2))+yv(4))*distpb(i, 9) + (xv& -& (3)*yv(1)-yv(3)*xv(1))*temp388b3 - temp388b5 = cost5i*cost*distpb(i, 9) - xvb(4) = xvb(4) + temp388b5 - distpb(i, 9) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp388b6 = -(cost4i*cost*distpb(i, 8)) - xvb(2) = xvb(2) - 3.d0*yv(1)*temp388b6 - 6.d0*yv(2)*temp388b5 - yvb(2) = yvb(2) - 6.d0*xv(2)*temp388b5 - yvb(4) = yvb(4) + temp388b5 - zvb(2) = zvb(2) + 11.d0*costb - r2b = -costb - yvb(3) = yvb(3) + temp388b6 - yvb(1) = yvb(1) - 3.d0*xv(2)*temp388b6 - costb = -(cost4i*(yv(3)-3.d0*(yv(1)*xv(2)))*distpb(i, 8)) - distpb(i, 8) = 0.0_8 - temp388b7 = cost4i*cost*distpb(i, 7) - xvb(3) = xvb(3) + temp388b7 - costb = costb + cost4i*(xv(3)-3.d0*(xv(1)*yv(2)))*distpb(i, 7) - distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp388b8 = cost3i*2.d0*distpb(i, 6) - xvb(1) = xvb(1) + yv(1)*cost*temp388b8 - 3.d0*yv(2)*temp388b7 - yvb(2) = yvb(2) - 3.d0*xv(1)*temp388b7 - zvb(3) = zvb(3) + 11.d0*costb - zvb(1) = zvb(1) - 3.d0*r2*costb - r2b = r2b - 3.d0*zv(1)*costb + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 - temp388b9 = cost3i*distpb(i, 5) - costb = (xv(2)-yv(2))*temp388b9 + yv(1)*xv(1)*temp388b8 - yvb(1) = yvb(1) + xv(1)*cost*temp388b8 - xvb(2) = xvb(2) + cost*temp388b9 - yvb(2) = yvb(2) - cost*temp388b9 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - zvb(4) = zvb(4) + 33.d0*costb - zvb(2) = zvb(2) - 18.d0*r2*costb - r2b = r2b - 18.d0*zv(2)*costb - r4b = costb - rmub(2, i) = rmub(2, i) + cost2i*cost*distpb(i, 4) - costb = cost2i*rmu(2, i)*distpb(i, 4) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2i*cost*distpb(i, 3) - costb = costb + cost2i*rmu(1, i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - zvb(5) = zvb(5) + 33.d0*costb - zvb(3) = zvb(3) - 30.d0*r2*costb - temp388b10 = cost1i*distpb(i, 2) - r6b = -(5.d0*temp388b10) - r4b = r4b + 105.d0*zv(2)*temp388b10 + r2*r6b + 5.d0*zv(1)*costb - r2b = r2b + 2*r2*r4b - 315.d0*zv(4)*temp388b10 + r4*r6b - 30.d0*zv& -& (3)*costb - zvb(1) = zvb(1) + 5.d0*r4*costb - zvb(6) = zvb(6) + 231.d0*temp388b10 - zvb(4) = zvb(4) - 315.d0*r2*temp388b10 - zvb(2) = zvb(2) + r2b + 105.d0*r4*temp388b10 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) distpb(i, 2) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,r4) - CALL POPREAL8(adr8ibuf,adr8buf,r2) - xvb(2) = xvb(2) + r2b - yvb(2) = yvb(2) + r2b - DO k=6,1,-1 - CALL POPREAL8(adr8ibuf,adr8buf,xv(k)) - IF (.NOT.(rmu(1, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(1, i) = rmub(1, i) + k*rmu(1, i)**(k-1)*xvb(k) - xvb(k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,yv(k)) - IF (.NOT.(rmu(2, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(2, i) = rmub(2, i) + k*rmu(2, i)**(k-1)*yvb(k) - yvb(k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,zv(k)) - IF (.NOT.(rmu(3, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(3, i) = rmub(3, i) + k*rmu(3, i)**(k-1)*zvb(k) - zvb(k) = 0.0_8 - END DO END DO dd1b = 0.0_8 cb = 0.0_8 DO k=0,0,-1 - temp387 = r(k)**2 - temp387b62 = c*DEXP(-(dd1*temp387))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp387))*distpb(k, 1) - dd1b = dd1b - temp387*temp387b62 - rb(k) = rb(k) - dd1*2*r(k)*temp387b62 + temp312 = r(k)**2 + temp312b0 = c*DEXP(-(dd1*temp312))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp312))*distpb(k, 1) + dd1b = dd1b - temp312*temp312b0 + rb(k) = rb(k) - dd1*2*r(k)*temp312b0 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.43985656185609913955d0*3.75d0*dd1**2.75D0*cb + dd1b = dd1b + 1.64592278064948967213d0*1.75d0*dd1**0.75D0*cb ddb(indparp) = ddb(indparp) + dd1b - CASE (60) -! 2s gaussian for pseudo -! R(r)=r**3*exp(-z*r**2) single zeta -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=2.d0/pi**(3.d0/4.d0)*(2.d0*dd1)**(9.d0/4.d0)*dsqrt(2.d0/105.d0) - c = dd1**2.25d0*.55642345640820284397d0 + CASE (140) +! 2p single exponential -r e^{-z r} ! der of 121 + dd2 = dd(indpar+1) + DO k=0,0 + distp(k, 1) = -DEXP(-(dd2*r(k))) + END DO +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO ! endif + IF (typec .NE. 1) THEN + fun = distp(0, 1)*(1.d0-dd2*r(0))/r(0) + fun2 = dd2*(dd2*r(0)-2.d0)*distp(0, 1) +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp314b2 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp314b2 + fun2b = fun2b + temp314b2 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp314b1 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp314b1 + funb0 = funb0 + rmu(ic, 0)*temp314b1 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + distpb = 0.0_8 + temp314b = dd2*distp(0, 1)*fun2b + temp314b0 = (dd2*r(0)-2.d0)*fun2b + temp313 = distp(0, 1)/r(0) + dd2b = distp(0, 1)*temp314b0 - temp313*r(0)*funb0 + r(0)*temp314b + temp313b9 = (1.d0-dd2*r(0))*funb0/r(0) + rb(0) = rb(0) + distp(0, 1)*fun0b - temp313*dd2*funb0 - temp313*& +& temp313b9 + dd2*temp314b + distpb(0, 1) = temp313b9 + r(0)*fun0b + dd2*temp314b0 + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=0,0,-1 + temp313b8 = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*r(i)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + r(i)*temp313b8 + rb(i) = rb(i) + distp(i, 1)*temp313b8 + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO k=0,0,-1 + temp313b7 = -(DEXP(-(dd2*r(k)))*distpb(k, 1)) + dd2b = dd2b - r(k)*temp313b7 + rb(k) = rb(k) - dd2*temp313b7 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (2000:2099) +! s gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative of 1000 + npower = iopt + 1 - 2000 + indorbp = indorb + 1 + dd2 = dd(indpar+1) DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2))*r(k) + distp(k, 1) = -(r(k)**(2*npower)*DEXP(-(dd2*r(k)**2))) END DO +! endif IF (typec .NE. 1) THEN - rp1 = r(0)**2*dd1 -! the first derivative / r - fun = distp(0, 1)*(3.d0-2.d0*rp1) -! the second derivative - funb = 2.d0*zb(indorbp, indt+4) + rp1 = r(0)**2 + fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - distpb(0, 1) = (3.d0-2.d0*rp1)*funb + (4.d0*rp1**2-14.d0*rp1+6.d0)& -& *fun2b - rp1b = (distp(0, 1)*4.d0*2*rp1-distp(0, 1)*14.d0)*fun2b - distp(0& -& , 1)*2.d0*funb - rb(0) = rb(0) + dd1*2*r(0)*rp1b - dd1b = r(0)**2*rp1b + temp317 = distp(0, 1)/rp1 + temp318b = 2.d0*temp317*fun2b + temp318b0 = -((npower*4.d0+1.d0)*temp318b) + temp317b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& +& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 + temp316 = distp(0, 1)/rp1 + temp317b0 = 2.d0*temp316*funb0 + dd2b = rp1*temp318b0 - rp1*temp317b0 + 2.d0*rp1**2*2*dd2*temp318b + temp316b = 2.d0*(npower-dd2*rp1)*funb0/rp1 + rp1b = dd2*temp318b0 - temp316*temp316b - temp317*temp317b - dd2*& +& temp317b0 + 2.d0*dd2**2*2*rp1*temp318b + distpb(0, 1) = temp316b + temp317b + rb(0) = rb(0) + 2*r(0)*rp1b ELSE distpb = 0.0_8 - dd1b = 0.0_8 + dd2b = 0.0_8 END IF DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO - cb = 0.0_8 DO k=0,0,-1 - temp388 = r(k)**2 - temp388b92 = c*r(k)*DEXP(-(dd1*temp388))*distpb(k, 1) - temp388b93 = DEXP(-(dd1*temp388))*distpb(k, 1) - dd1b = dd1b - temp388*temp388b92 - rb(k) = rb(k) + c*temp388b93 - dd1*2*r(k)*temp388b92 - cb = cb + r(k)*temp388b93 + temp315 = r(k)**2 + temp314 = 2*npower + temp314b3 = -(r(k)**temp314*DEXP(-(dd2*temp315))*distpb(k, 1)) + IF (r(k) .LE. 0.0 .AND. (temp314 .EQ. 0.0 .OR. temp314 .NE. INT(& +& temp314))) THEN + rb(k) = rb(k) - dd2*2*r(k)*temp314b3 + ELSE + rb(k) = rb(k) - dd2*2*r(k)*temp314b3 - DEXP(-(dd2*temp315))*& +& temp314*r(k)**(temp314-1)*distpb(k, 1) + END IF + dd2b = dd2b - temp315*temp314b3 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + .55642345640820284397d0*2.25d0*dd1**1.25D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b + ddb(indpar+1) = ddb(indpar+1) + dd2b CASE (61) -! 3s -derivative of 60 with respect to dd1 ! R(r)=c (-r**5*exp(-z1*r**2)+c1 r**3 exp(-z1*r**2)) ! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 @@ -15672,27 +14334,27 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd fun = c1*distp(0, 1)*(3.d0-2.d0*rp2) + distp(0, 1)*rp1*(-5.d0+2.d0& & *rp2) ! the second derivative - funb = 2.d0*zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp390b0 = (4.d0*rp2**2-14.d0*rp2+6.d0)*fun2b - temp390b1 = c1*distp(0, 1)*fun2b - temp390b2 = (22.d0*rp2-4.d0*rp2**2-20.d0)*fun2b - temp390b3 = distp(0, 1)*rp1*fun2b - temp390b4 = (3.d0-2.d0*rp2)*funb - c1b = distp(0, 1)*temp390b4 + distp(0, 1)*temp390b0 - temp390b5 = (2.d0*rp2-5.d0)*funb - distpb(0, 1) = c1*temp390b4 + rp1*temp390b5 + rp1*temp390b2 + c1*& -& temp390b0 - rp2b = (distp(0, 1)*rp1*2.d0-c1*distp(0, 1)*2.d0)*funb + (22.d0-& -& 4.d0*2*rp2)*temp390b3 + (4.d0*2*rp2-14.d0)*temp390b1 - rp1b = distp(0, 1)*temp390b5 + dd1*rp2b + distp(0, 1)*temp390b2 + temp319b0 = (4.d0*rp2**2-14.d0*rp2+6.d0)*fun2b + temp319b1 = c1*distp(0, 1)*fun2b + temp319b2 = (22.d0*rp2-4.d0*rp2**2-20.d0)*fun2b + temp319b3 = distp(0, 1)*rp1*fun2b + temp319b4 = (3.d0-2.d0*rp2)*funb0 + c1b = distp(0, 1)*temp319b4 + distp(0, 1)*temp319b0 + temp319b5 = (2.d0*rp2-5.d0)*funb0 + distpb(0, 1) = c1*temp319b4 + rp1*temp319b5 + rp1*temp319b2 + c1*& +& temp319b0 + rp2b = (distp(0, 1)*rp1*2.d0-c1*distp(0, 1)*2.d0)*funb0 + (22.d0-& +& 4.d0*2*rp2)*temp319b3 + (4.d0*2*rp2-14.d0)*temp319b1 + rp1b = distp(0, 1)*temp319b5 + dd1*rp2b + distp(0, 1)*temp319b2 dd1b = rp1*rp2b rb(0) = rb(0) + 2*r(0)*rp1b ELSE @@ -15701,128 +14363,36 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd dd1b = 0.0_8 END IF DO i=0,0,-1 - temp390b = distp(i, 1)*zb(indorbp, i) - c1b = c1b + r(i)**2*temp390b - rb(i) = rb(i) + (c1*2*r(i)-4*r(i)**3)*temp390b + temp319b = distp(i, 1)*zb(indorbp, i) + c1b = c1b + r(i)**2*temp319b + rb(i) = rb(i) + (c1*2*r(i)-4*r(i)**3)*temp319b distpb(i, 1) = distpb(i, 1) + (c1*r(i)**2-r(i)**4)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO cb = 0.0_8 DO k=0,0,-1 - temp389 = r(k)**2 - temp389b = c*r(k)*DEXP(-(dd1*temp389))*distpb(k, 1) - temp389b0 = DEXP(-(dd1*temp389))*distpb(k, 1) - dd1b = dd1b - temp389*temp389b - rb(k) = rb(k) + c*temp389b0 - dd1*2*r(k)*temp389b - cb = cb + r(k)*temp389b0 + temp318 = r(k)**2 + temp318b1 = c*r(k)*DEXP(-(dd1*temp318))*distpb(k, 1) + temp318b2 = DEXP(-(dd1*temp318))*distpb(k, 1) + dd1b = dd1b - temp318*temp318b1 + rb(k) = rb(k) + c*temp318b2 - dd1*2*r(k)*temp318b1 + cb = cb + r(k)*temp318b2 distpb(k, 1) = 0.0_8 END DO dd1b = dd1b + .55642345640820284397d0*2.25d0*dd1**1.25D0*cb - 2.25d0& -& *c1b/dd1**2 - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (62) -! single gaussianx r p orbitals - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=2.d0/pi**0.75d0*(2.d0*dd1)**1.75d0/dsqrt(5.d0) - c = dd1**1.75d0*1.2749263037197753d0 -! endif - DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) - END DO -! indorbp=indorb -! - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun0 = distp(0, 1)*r(0) - cost = 2.d0*dd1*r(0)**2 - fun = distp(0, 1)*(1.d0-cost)/r(0) - fun2 = 2.d0*dd1*fun0*(cost-3.d0) -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp392b1 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp392b1 - fun2b = fun2b + temp392b1 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp392b0 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp392b0 - funb = funb + rmu(ic, 0)*temp392b0 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - temp392b = 2.d0*(cost-3.d0)*fun2b - temp391b0 = distp(0, 1)*funb/r(0) - costb = 2.d0*dd1*fun0*fun2b - temp391b0 - dd1b = 2.d0*r(0)**2*costb + fun0*temp392b - fun0b = fun0b + dd1*temp392b - distpb = 0.0_8 - temp391 = (-cost+1.d0)/r(0) - distpb(0, 1) = r(0)*fun0b + temp391*funb - rb(0) = rb(0) + 2.d0*dd1*2*r(0)*costb + distp(0, 1)*fun0b - & -& temp391*temp391b0 - ELSE - distpb = 0.0_8 - dd1b = 0.0_8 - END IF - DO ic=3,1,-1 - DO i=0,0,-1 - temp391b = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*r(i)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + r(i)*temp391b - rb(i) = rb(i) + distp(i, 1)*temp391b - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - cb = 0.0_8 - DO k=0,0,-1 - temp390 = r(k)**2 - temp390b6 = c*DEXP(-(dd1*temp390))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp390))*distpb(k, 1) - dd1b = dd1b - temp390*temp390b6 - rb(k) = rb(k) - dd1*2*r(k)*temp390b6 - distpb(k, 1) = 0.0_8 - END DO - dd1b = dd1b + 1.2749263037197753d0*1.75d0*dd1**0.75D0*cb +& *c1b/dd1**2 ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (63) -! derivative of 62 with respect zeta -! R(r)=c x*exp(-z*r**2)*r (c1 - r^2) + CASE (20) +! single gaussianx r p orbitals +! 2p single Z with no cusp condition dd1 = dd(indpar+1) ! if(iflagnorm.gt.2) then - c = dd1**1.75d0*1.2749263037197753d0 -! c=2.d0/pi**0.75d0*(2.d0*dd1)**1.75d0/dsqrt(5.d0) +! c=dsqrt((2.d0*dd1)**5/8.d0/pi)/2.d0 + c = dd1**2.5d0*0.5641895835477562d0 ! endif DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + distp(k, 1) = c*DEXP(-(dd1*r(k))) END DO - c1 = 1.75d0/dd1 ! indorbp=indorb ! DO ic=1,3 @@ -15832,14 +14402,8 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - rp1 = dd1*r(0)**2 - cost = 2.d0*rp1 - fun = distp(0, 1)*(c1*(1.d0-cost)/r(0)+(-3.d0+cost)*r(0)) -! My bug !!! -! fun2=distp(0,1)*(c1*2.d0*dd1*fun0*(cost-3.d0) -! &-2.d0*r(0)*(3.d0-7.d0*rp1+2.d0*rp1**2)) - fun2 = -(2.d0*distp(0, 1)*r(0)*(3.d0-7.d0*rp1+2.d0*rp1**2+c1*dd1*(& -& 3.d0-cost))) + fun = -(dd1*distp(0, 1)) + fun2 = dd1**2*distp(0, 1) ! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -15853,308 +14417,157 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp395b3 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp395b3 - fun2b = fun2b + temp395b3 + temp320 = fun/r(0) + temp321b = rmu(ic, 0)*zb(indorbp, indt+4) + temp320b = 4.d0*temp321b/r(0) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp320+fun2)*zb(indorbp, indt& +& +4) + funb0 = funb0 + temp320b + rb(0) = rb(0) - temp320*temp320b + fun2b = fun2b + temp321b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp395b2 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp395b2 - funb = funb + rmu(ic, 0)*temp395b2 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + temp319 = fun/r(0) + temp319b7 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(ic, 0) = rmub(ic, 0) + temp319*rmu(i, 0)*zb(indorbp, indt& +& +i) + rmub(i, 0) = rmub(i, 0) + temp319*rmu(ic, 0)*zb(indorbp, indt+& +& i) + funb0 = funb0 + temp319b7 + rb(0) = rb(0) - temp319*temp319b7 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp395b = -(2.d0*(2.d0*rp1**2-7.d0*rp1+c1*dd1*(3.d0-cost)+3.d0)*& -& fun2b) - temp395b0 = -(2.d0*distp(0, 1)*r(0)*fun2b) - temp394 = c1*(-cost+1.d0)/r(0) - temp394b1 = (c1-r(0)**2)*fun0b - distpb(0, 1) = (temp394+(cost-3.d0)*r(0))*funb + r(0)*temp394b1 + & -& r(0)*temp395b - temp395b1 = distp(0, 1)*funb - temp394b2 = temp395b1/r(0) - costb = r(0)*temp395b1 - c1*temp394b2 - c1*dd1*temp395b0 - rp1b = 2.d0*costb + (2.d0*2*rp1-7.d0)*temp395b0 - temp394b3 = distp(0, 1)*r(0)*fun0b - rb(0) = rb(0) + (cost-3.d0)*temp395b1 - temp394*temp394b2 + dd1*2*& -& r(0)*rp1b - 2*r(0)*temp394b3 + distp(0, 1)*temp394b1 + distp(0, & -& 1)*temp395b - c1b = (1.d0-cost)*temp394b2 + temp394b3 + (3.d0-cost)*dd1*& -& temp395b0 - dd1b = r(0)**2*rp1b + (3.d0-cost)*c1*temp395b0 + dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb0 + distpb(0, 1) = fun0b - dd1*funb0 + dd1**2*fun2b ELSE distpb = 0.0_8 - c1b = 0.0_8 dd1b = 0.0_8 END IF DO ic=3,1,-1 DO i=0,0,-1 - temp393 = c1 - r(i)**2 - temp394b = rmu(ic, i)*temp393*zb(indorbp, i) - temp394b0 = distp(i, 1)*r(i)*zb(indorbp, i) - temp393b = rmu(ic, i)*temp394b0 - distpb(i, 1) = distpb(i, 1) + r(i)*temp394b - rb(i) = rb(i) + distp(i, 1)*temp394b - 2*r(i)*temp393b - rmub(ic, i) = rmub(ic, i) + temp393*temp394b0 - c1b = c1b + temp393b + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - dd1b = dd1b - 1.75d0*c1b/dd1**2 cb = 0.0_8 DO k=0,0,-1 - temp392 = r(k)**2 - temp392b2 = c*DEXP(-(dd1*temp392))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp392))*distpb(k, 1) - dd1b = dd1b - temp392*temp392b2 - rb(k) = rb(k) - dd1*2*r(k)*temp392b2 + temp319b6 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp319b6 + rb(k) = rb(k) - dd1*temp319b6 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 1.2749263037197753d0*1.75d0*dd1**0.75D0*cb + dd1b = dd1b + 0.5641895835477562d0*2.5d0*dd1**1.5D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (64) -! d orbitals -! R(r)= r exp(-alpha r^2) -! each gaussian term is normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! c=8.d0/dsqrt(21.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) - c = dd1**2.25d0*1.24420067280413253d0 -! endif - DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) - END DO + CASE (38) +! 2p double zeta +! R(r)=r**2*exp(-z1*r) +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c=1.d0/dsqrt(1.d0/4.d0/dd1**3+12.d0*dd1/(2.d0*dd1)**4+& +! &3.d0*dd1**2/4.d0/dd1**5)/dsqrt(4.d0*pi) +! c=dd1*dsqrt(dd1)/dsqrt(7.d0*pi) + c = dd1*DSQRT(dd1)*0.21324361862292308211d0 +! endif + c0 = -(c*dd1) + c1 = 1.5d0*c/dd1 DO i=0,0 -! lz=0 - distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d -! lz=+/-2 - distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d -! lz=+/-2 - distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d -! lz=+/-1 - distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d -! lz=+/-1 - distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d - END DO - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic + distp(i, 1) = DEXP(-(dd1*r(i))) END DO -! endif + CALL PUSHREAL8(adr8ibuf,adr8buf,c1) + c1 = c1*dd1**2 IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - rp1 = 2.d0*dd1*r(0) - rp2 = rp1*r(0) - fun0 = distp(0, 1)*r(0) - fun = (1.d0-rp2)*distp(0, 1)/r(0) - fun2 = distp(0, 1)*rp1*(rp2-3.d0) -! indorbp=indorb - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - END IF - END DO + fun = (c0*(2.d0-dd1*r(0))-c1)*distp(0, 1) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=5,1,-1 - temp397b4 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 6.d0*temp397b4 - fun2b = fun2b + temp397b4 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp397b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp397b0 - fun0b = fun0b + rmu(i, 0)*temp397b0 - ELSE - temp397b1 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp397b1 - fun0b = fun0b + rmu(i, 0)*temp397b1 - END IF - ELSE IF (branch .LT. 4) THEN - temp397b2 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp397b2 - fun0b = fun0b + rmu(i, 0)*temp397b2 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp397b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp397b3 - fun0b = fun0b + rmu(i, 0)*temp397b3 - ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - temp397b = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp397b - funb = funb + rmu(i, 0)*temp397b - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - temp396 = (-rp2+1.d0)/r(0) - distpb(0, 1) = distpb(0, 1) + temp396*funb + r(0)*fun0b + rp1*(rp2& -& -3.d0)*fun2b - temp396b0 = distp(0, 1)*funb/r(0) - rp2b = distp(0, 1)*rp1*fun2b - temp396b0 - rp1b = r(0)*rp2b + distp(0, 1)*(rp2-3.d0)*fun2b - rb(0) = rb(0) + distp(0, 1)*fun0b + 2.d0*dd1*rp1b + rp1*rp2b - & -& temp396*temp396b0 - dd1b = 2.d0*r(0)*rp1b - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + temp324b = distp(0, 1)*fun2b + temp323 = (dd1*r(0))**2 - 4*(dd1*r(0)) + 2.d0 + temp323b0 = c0*temp324b + temp323b1 = 2*dd1*r(0)*temp323b0 + temp323b2 = distp(0, 1)*funb0 + c0b = (2.d0-dd1*r(0))*temp323b2 + temp323*temp324b + dd1b = c1*r(0)*temp324b - c0*r(0)*temp323b2 - 4*r(0)*temp323b0 + r& +& (0)*temp323b1 + rb(0) = rb(0) + c1*dd1*temp324b - c0*dd1*temp323b2 - 4*dd1*& +& temp323b0 + dd1*temp323b1 + c1b = (dd1*r(0)-1.d0)*temp324b - temp323b2 + distpb(0, 1) = (c0*(2.d0-dd1*r(0))-c1)*funb0 + (c0*temp323+c1*(dd1& +& *r(0)-1.d0))*fun2b ELSE distpb = 0.0_8 + c0b = 0.0_8 + c1b = 0.0_8 + dd1b = 0.0_8 END IF - DO ic=5,1,-1 - DO k=0,0,-1 - temp396b = distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1) = distpb(k, 1) + r(k)*temp396b - rb(k) = rb(k) + distp(k, 1)*temp396b - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*r(k)*zb(indorbp& -& , k) - zb(indorbp, k) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO + CALL POPREAL8(adr8ibuf,adr8buf,c1) + dd1b = dd1b + c1*2*dd1*c1b + c1b = dd1**2*c1b DO i=0,0,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) - distpb(i, 2) = 0.0_8 + temp323b = distp(i, 1)*zb(indorbp, i) + temp322 = dd1*r(i) + 1.d0 + c0b = c0b + r(i)**2*temp323b + rb(i) = rb(i) + (c1*dd1+c0*2*r(i))*temp323b + c1b = c1b + temp322*temp323b + dd1b = dd1b + c1*r(i)*temp323b + distpb(i, 1) = distpb(i, 1) + (c0*r(i)**2+c1*temp322)*zb(indorbp, & +& i) + zb(indorbp, i) = 0.0_8 END DO - dd1b = 0.0_8 - cb = 0.0_8 - DO k=0,0,-1 - temp395 = r(k)**2 - temp395b4 = c*DEXP(-(dd1*temp395))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp395))*distpb(k, 1) - dd1b = dd1b - temp395*temp395b4 - rb(k) = rb(k) - dd1*2*r(k)*temp395b4 - distpb(k, 1) = 0.0_8 + DO i=0,0,-1 + temp322b0 = DEXP(-(dd1*r(i)))*distpb(i, 1) + dd1b = dd1b - r(i)*temp322b0 + rb(i) = rb(i) - dd1*temp322b0 + distpb(i, 1) = 0.0_8 END DO - dd1b = dd1b + 1.24420067280413253d0*2.25d0*dd1**1.25D0*cb - ddb(indparp) = ddb(indparp) + dd1b - CASE (65) + temp322b = 1.5d0*c1b/dd1 + cb = temp322b - dd1*c0b + temp321 = DSQRT(dd1) + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + 0.21324361862292308211d0*temp321*cb - c*c0b - c*& +& temp322b/dd1 + ELSE + dd1b = dd1b + (0.21324361862292308211d0*dd1/(2.D0*DSQRT(dd1))+& +& 0.21324361862292308211d0*temp321)*cb - c*c0b - c*temp322b/dd1 + END IF + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (84) +! 4s single zeta derivative of 10 ! d orbitals -! R(r)= c0 r^3 exp(-alpha r^2)+ c1 r exp(-alpha r^2) +! R(r)= exp(-alpha r^2) ! each gaussian term is normalized ! indorbp=indorb indparp = indpar + 1 dd1 = dd(indparp) + dd2 = DSQRT(dd1) ! if(iflagnorm.gt.2) then -! overall normalization to be done -! c=8.d0/dsqrt(21.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) - c = dd1**2.25d0*1.24420067280413253d0 +! overall normalization +! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)*ratiocd + c = ratiocd*dd1**1.75d0 ! endif - c0 = -c - c1 = 2.25d0*c/dd1 DO k=0,0 - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) END DO DO i=0,0 ! lz=0 @@ -16175,14 +14588,14 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - rp1 = 2.d0*dd1*r(0) - rp2 = rp1*r(0) - fun0 = distp(0, 1)*(c1*r(0)+c0*r(0)**3) - fun = (c1*(1.d0-rp2)+c0*r(0)**2*(3.d0-rp2))*distp(0, 1)/r(0) - fun2 = distp(0, 1)*(c1*rp1*(rp2-3.d0)+c0*r(0)*(3.d0-3.5d0*rp2+& -& 0.5d0*rp2**2)) + fun0 = distp(0, 1) + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) +! the second derivative + fun2 = dd1*distp(0, 1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**& +& 2)/rp3**2 ! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -16233,15 +14646,15 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=5,1,-1 - temp404b4 = distp(0, 1+ic)*zb(indorbp, indt+4) + temp328b4 = distp(0, 1+ic)*zb(indorbp, indt+4) distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & & indt+4) - funb = funb + 6.d0*temp404b4 - fun2b = fun2b + temp404b4 + funb0 = funb0 + 6.d0*temp328b4 + fun2b = fun2b + temp328b4 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -16249,24 +14662,24 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN IF (branch .LT. 2) THEN - temp404b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp404b0 - fun0b = fun0b + rmu(i, 0)*temp404b0 + temp328b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp328b0 + fun0b = fun0b + rmu(i, 0)*temp328b0 ELSE - temp404b1 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp404b1 - fun0b = fun0b + rmu(i, 0)*temp404b1 + temp328b1 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp328b1 + fun0b = fun0b + rmu(i, 0)*temp328b1 END IF ELSE IF (branch .LT. 4) THEN - temp404b2 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp404b2 - fun0b = fun0b + rmu(i, 0)*temp404b2 + temp328b2 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp328b2 + fun0b = fun0b + rmu(i, 0)*temp328b2 END IF ELSE IF (branch .LT. 7) THEN IF (branch .LT. 6) THEN - temp404b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp404b3 - fun0b = fun0b + rmu(i, 0)*temp404b3 + temp328b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp328b3 + fun0b = fun0b + rmu(i, 0)*temp328b3 ELSE rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) @@ -16296,55 +14709,40 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp404b = distp(0, 1+ic)*zb(indorbp, indt+i) + temp328b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp404b - funb = funb + rmu(i, 0)*temp404b + rmub(i, 0) = rmub(i, 0) + fun*temp328b + funb0 = funb0 + rmu(i, 0)*temp328b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp403 = 0.5d0*rp2**2 - 3.5d0*rp2 + 3.d0 - temp402 = c0*r(0) - temp402b = distp(0, 1)*fun2b - temp401b = (c1*(1.d0-rp2)+r(0)**2*(c0*(3.d0-rp2)))*funb/r(0) - temp400 = r(0)**3 - distpb(0, 1) = distpb(0, 1) + temp401b + (c1*r(0)+c0*temp400)*& -& fun0b + (c1*rp1*(rp2-3.d0)+temp402*temp403)*fun2b - temp401 = distp(0, 1)/r(0) - temp402b0 = temp401*funb - temp400b = distp(0, 1)*fun0b - c1b = (1.d0-rp2)*temp402b0 + r(0)*temp400b + (rp2-3.d0)*rp1*& -& temp402b - temp402b1 = r(0)**2*temp402b0 - rp2b = (temp402*0.5d0*2*rp2-temp402*3.5d0+c1*rp1)*temp402b - c0*& -& temp402b1 - c1*temp402b0 - rp1b = r(0)*rp2b + (rp2-3.d0)*c1*temp402b - c0b = (3.d0-rp2)*temp402b1 + temp400*temp400b + temp403*r(0)*& -& temp402b - rb(0) = rb(0) + c0*(3.d0-rp2)*2*r(0)*temp402b0 - temp401*temp401b & -& + rp1*rp2b + 2.d0*dd1*rp1b + (c0*3*r(0)**2+c1)*temp400b + & -& temp403*c0*temp402b - dd1b = 2.d0*r(0)*rp1b - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + temp327 = rp3**2 + temp326b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& +& temp327 + temp326 = dd1*distp(0, 1)/temp327 + temp326b0 = temp326*fun2b + rp1b = (2*rp1+4.d0*rp2+4.d0)*temp326b0 + temp325b0 = -(distp(0, 1)*(rp2+2.d0)*funb0/rp3) + dd1b = temp325b0 + r(0)**2*rp1b + distp(0, 1)*temp326b + temp325 = dd1/rp3 + distpb(0, 1) = distpb(0, 1) + fun0b - temp325*(rp2+2.d0)*funb0 + & +& dd1*temp326b + rp3b = -(temp325*temp325b0) - temp326*2*rp3*temp326b + rp2b = 2*(rp2+1.d0)*rp3b - temp325*distp(0, 1)*funb0 + (4.d0*rp1-& +& 2.d0)*temp326b0 + dd2b = r(0)*rp2b + rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b ELSE distpb = 0.0_8 - c0b = 0.0_8 - c1b = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 END IF DO ic=5,1,-1 DO k=0,0,-1 - temp399 = r(k)**3 - temp398 = c0*distp(k, 1+ic) - temp398b = distp(k, 1)*zb(indorbp, k) - distpb(k, 1) = distpb(k, 1) + (temp398*temp399+c1*r(k))*zb(& -& indorbp, k) - c0b = c0b + temp399*distp(k, 1+ic)*temp398b - distpb(k, 1+ic) = distpb(k, 1+ic) + temp399*c0*temp398b - rb(k) = rb(k) + (c1+temp398*3*r(k)**2)*temp398b - c1b = c1b + r(k)*temp398b + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -16366,288 +14764,725 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) distpb(i, 2) = 0.0_8 END DO - dd1b = 0.0_8 cb = 0.0_8 DO k=0,0,-1 - temp397 = r(k)**2 - temp397b6 = c*DEXP(-(dd1*temp397))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp397))*distpb(k, 1) - dd1b = dd1b - temp397*temp397b6 - rb(k) = rb(k) - dd1*2*r(k)*temp397b6 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp324 = dd2*r(k) + 1.d0 + temp325b = costb/temp324 + temp324b0 = -(dd1*r(k)**2*temp325b/temp324) + dd1b = dd1b + r(k)**2*temp325b + rb(k) = rb(k) + dd2*temp324b0 + dd1*2*r(k)*temp325b + dd2b = dd2b + r(k)*temp324b0 END DO - temp397b5 = 2.25d0*c1b/dd1 - cb = cb + temp397b5 - c0b - dd1b = dd1b + 1.24420067280413253d0*2.25d0*dd1**1.25D0*cb - c*& -& temp397b5/dd1 - ddb(indparp) = ddb(indparp) + dd1b - CASE (100) -! ******************* END GAUSSIAN BASIS ************************ -! ** ** ** ** ** ** ** JASTROW ORBITALS ** ** ** ** ** ** ** ** * -! 2s single gaussian -! exp(-dd2*r^2) - dd2 = dd(indpar+1) - indorbp = indorb + 1 - DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) - END DO -! endif - IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)*2.d0) - distpb = 0.0_8 - temp404b6 = 2.d0**2*dd2*distp(0, 1)*zb(indorbp, indt+4) - temp404b7 = 2.d0*(2.d0*(dd2*r(0)**2)-3.d0)*zb(indorbp, indt+4) - dd2b = distp(0, 1)*temp404b7 + r(0)**2*temp404b6 - rb(0) = rb(0) + dd2*2*r(0)*temp404b6 - distpb(0, 1) = dd2*temp404b7 - zb(indorbp, indt+4) = 0.0_8 - funb = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - dd2b = dd2b - 2.d0*distp(0, 1)*funb - distpb(0, 1) = distpb(0, 1) - 2.d0*dd2*funb + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocd*1.75d0*dd1**0.75D0*cb ELSE - distpb = 0.0_8 - dd2b = 0.0_8 + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocd*1.75d0*dd1**0.75D0*& +& cb END IF - DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + ddb(indparp) = ddb(indparp) + dd1b + CASE (24) +! derivative of 37 with respect to z +!c 4p without cusp condition +!c r^2 e^{-z1 r } + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c=dsqrt((2.d0*dd1)**9/120960.d0/pi)/2.d0 + c = dd1**4.5d0*0.01835308852470193d0 +! endif + DO k=0,0 + distp(k, 1) = c*DEXP(-(dd1*r(k))) END DO - DO k=0,0,-1 - temp404b5 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp404b5 - rb(k) = rb(k) - dd2*2*r(k)*temp404b5 - distpb(k, 1) = 0.0_8 + DO i=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = r(i)**2*distp(i, 1) END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (101) -! 2s without cusp condition -! dd1*( dd3 +exp(-dd2*r^2)) - dd2 = dd(indpar+1) - indorbp = indorb + 1 - DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic END DO ! endif IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)*2.d0) - distpb = 0.0_8 - temp404b9 = 2.d0**2*dd2*distp(0, 1)*zb(indorbp, indt+4) - temp404b10 = 2.d0*(2.d0*(dd2*r(0)**2)-3.d0)*zb(indorbp, indt+4) - dd2b = distp(0, 1)*temp404b10 + r(0)**2*temp404b9 - rb(0) = rb(0) + dd2*2*r(0)*temp404b9 - distpb(0, 1) = dd2*temp404b10 - zb(indorbp, indt+4) = 0.0_8 - funb = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 + fun = (2.d0*r(0)-dd1*r(0)**2)*distp(0, 1) + fun2 = ((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))*distp(0, 1) +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp329 = fun/r(0) + temp330b = rmu(ic, 0)*zb(indorbp, indt+4) + temp329b = 4.d0*temp330b/r(0) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp329+fun2)*zb(indorbp, indt& +& +4) + funb0 = funb0 + temp329b + rb(0) = rb(0) - temp329*temp329b + fun2b = fun2b + temp330b + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp328 = fun/r(0) + temp328b9 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(ic, 0) = rmub(ic, 0) + temp328*rmu(i, 0)*zb(indorbp, indt& +& +i) + rmub(i, 0) = rmub(i, 0) + temp328*rmu(ic, 0)*zb(indorbp, indt+& +& i) + funb0 = funb0 + temp328b9 + rb(0) = rb(0) - temp328*temp328b9 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - dd2b = dd2b - 2.d0*distp(0, 1)*funb - distpb(0, 1) = distpb(0, 1) - 2.d0*dd2*funb + distpb = 0.0_8 + temp328b6 = distp(0, 1)*fun2b + temp328b7 = 2*dd1*r(0)*temp328b6 + temp328b8 = distp(0, 1)*funb0 + dd1b = r(0)*temp328b7 - 4.d0*r(0)*temp328b6 - r(0)**2*temp328b8 + rb(0) = rb(0) + (2.d0-dd1*2*r(0))*temp328b8 - 4.d0*dd1*temp328b6 +& +& dd1*temp328b7 + distpb(0, 1) = (2.d0*r(0)-dd1*r(0)**2)*funb0 + ((dd1*r(0))**2-4.d0& +& *(dd1*r(0))+2.d0)*fun2b + distpb(0, 3) = distpb(0, 3) + fun0b ELSE distpb = 0.0_8 - dd2b = 0.0_8 + dd1b = 0.0_8 END IF - dd3b = 0.0_8 + DO ic=3,1,-1 + DO i=0,0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*distpb(i, 3) + distpb(i, 1) = distpb(i, 1) + r(i)**2*distpb(i, 3) + distpb(i, 3) = 0.0_8 END DO + cb = 0.0_8 DO k=0,0,-1 - temp404b8 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp404b8 - rb(k) = rb(k) - dd2*2*r(k)*temp404b8 + temp328b5 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp328b5 + rb(k) = rb(k) - dd1*temp328b5 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (102) -! 2s double gaussian with constant -! (dd3+ exp (-dd2 r^2)+dd4*exp(-dd5*r^2)) - dd2 = dd(indpar+1) - dd4 = dd(indpar+3) - dd5 = dd(indpar+4) + dd1b = dd1b + 0.01835308852470193d0*4.5d0*dd1**3.5D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (5) +! 4p double zeta +! normalized +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 + dd1 = dd(indpar+1) DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) - distp(k, 2) = DEXP(-(dd5*r(k)*r(k))) + distp(k, 1) = DEXP(-(dd1*r(k))) END DO -! write(6,*) ' function inside = ',z(indorbp,i) -! endif +! if(iflagnorm.gt.2) then +! c=dd1**2.5d0/dsqrt(3.d0*pi) + c = dd1**2.5d0*0.32573500793527994772d0 IF (typec .NE. 1) THEN - fun = -(2.d0*(dd2*distp(0, 1)+dd5*dd4*distp(0, 2))) - fun2 = r(0)**2 - distpb = 0.0_8 - temp404b14 = 2.d0*zb(indorbp, indt+4) - temp404b15 = dd2*distp(0, 1)*2.d0*temp404b14 - temp404b16 = (2.d0*(dd2*fun2)-3.d0)*temp404b14 - temp404b17 = (2.d0*(dd5*fun2)-3.d0)*temp404b14 - temp404b18 = dd5*dd4*distp(0, 2)*2.d0*temp404b14 - dd2b = distp(0, 1)*temp404b16 + fun2*temp404b15 - fun2b = dd5*temp404b18 + dd2*temp404b15 - distpb(0, 1) = dd2*temp404b16 - dd5b = fun2*temp404b18 + distp(0, 2)*dd4*temp404b17 - dd4b = distp(0, 2)*dd5*temp404b17 - distpb(0, 2) = dd5*dd4*temp404b17 + fun = distp(0, 1)*(1.d0-dd1*r(0)) + fun2 = distp(0, 1)*(dd1**2*r(0)-2.d0*dd1) + temp331b = 2.d0*zb(indorbp, indt+4)/r(0) + cb = fun2*zb(indorbp, indt+4) + fun*temp331b + funb0 = c*temp331b + rb(0) = rb(0) - c*fun*temp331b/r(0) + fun2b = c*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 - funb = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + temp330 = rmu(i, 0)/r(0) + temp330b3 = c*fun*zb(indorbp, indt+i)/r(0) + cb = cb + temp330*fun*zb(indorbp, indt+i) + funb0 = funb0 + temp330*c*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp330b3 + rb(0) = rb(0) - temp330*temp330b3 zb(indorbp, indt+i) = 0.0_8 END DO - rb(0) = rb(0) + 2*r(0)*fun2b - temp404b13 = -(2.d0*funb) - dd2b = dd2b + distp(0, 1)*temp404b13 - distpb(0, 1) = distpb(0, 1) + dd2*temp404b13 - dd5b = dd5b + distp(0, 2)*dd4*temp404b13 - dd4b = dd4b + distp(0, 2)*dd5*temp404b13 - distpb(0, 2) = distpb(0, 2) + dd5*dd4*temp404b13 + distpb = 0.0_8 + temp330b2 = distp(0, 1)*fun2b + distpb(0, 1) = (1.d0-dd1*r(0))*funb0 + (dd1**2*r(0)-2.d0*dd1)*& +& fun2b + dd1b = (r(0)*2*dd1-2.d0)*temp330b2 - distp(0, 1)*r(0)*funb0 + rb(0) = rb(0) + dd1**2*temp330b2 - distp(0, 1)*dd1*funb0 ELSE distpb = 0.0_8 - dd2b = 0.0_8 - dd4b = 0.0_8 - dd5b = 0.0_8 + dd1b = 0.0_8 + cb = 0.0_8 END IF - dd3b = 0.0_8 DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) - dd4b = dd4b + distp(i, 2)*zb(indorbp, i) - distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) + temp330b1 = distp(i, 1)*zb(indorbp, i) + cb = cb + r(i)*temp330b1 + rb(i) = rb(i) + c*temp330b1 + distpb(i, 1) = distpb(i, 1) + c*r(i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO + dd1b = dd1b + 0.32573500793527994772d0*2.5d0*dd1**1.5D0*cb DO k=0,0,-1 - temp404b11 = DEXP(-(dd5*r(k)**2))*distpb(k, 2) - dd5b = dd5b - r(k)**2*temp404b11 - distpb(k, 2) = 0.0_8 - temp404b12 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - rb(k) = rb(k) - dd2*2*r(k)*temp404b12 - dd5*2*r(k)*temp404b11 - dd2b = dd2b - r(k)**2*temp404b12 + temp330b0 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp330b0 + rb(k) = rb(k) - dd1*temp330b0 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+4) = ddb(indpar+4) + dd5b - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (104) -! 2p double gaussian -! dd1 * x_mu (exp(-dd2 r^2)+dd3 * exp(-dd4*r^2)) - dd2 = dd(indpar+1) - dd3 = dd(indpar+2) - dd4 = dd(indpar+3) + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (88) +! 2s double Z NO CUSP +! g single gaussian orbital +! R(r)= exp(-alpha r^2) +! normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) + dd2 = DSQRT(dd1) +! if(iflagnorm.gt.2) then +! overall normalization +! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0)*ratiocg + c = dd1**2.75d0*ratiocg +! endif DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k)**2)) - distp(k, 2) = DEXP(-(dd4*r(k)**2)) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) + END DO + DO i=0,0 + distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& +& 2+3.d0*r(i)**4) +! lz=0 + distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& +& 2-r(i)**2) +! lz=+/-2 + distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& +& (i)**2) +! lz=+/-2 + distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & +& i)**2) +! lz=+/-3 + distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& +& , i)**2) +! lz=+/-3 + distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& +& rmu(2, i)**4) +! lz=+/-4 + distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& +& , i)**2) END DO -! indorbp=indorb - DO ic=1,3 +! lz=+/-4 + DO ic=1,9 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO ! endif IF (typec .NE. 1) THEN - fun = 2.d0*(-(dd2*distp(0, 1))-dd4*dd3*distp(0, 2)) - fun2 = 2.d0*(dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0, 1)+dd4*dd3*(-& -& 1.d0+2.d0*dd4*r(0)**2)*distp(0, 2)) + fun0 = distp(0, 1) + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) +! the second derivative + fun2 = dd1*distp(0, 1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**& +& 2)/rp3**2 ! indorbp=indorb - DO ic=1,3 + DO ic=1,9 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + IF (ic .EQ. 1) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + END IF + ELSE IF (ic .EQ. 6) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + END IF + ELSE IF (ic .EQ. 7) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,21) + END IF + ELSE IF (ic .EQ. 8) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,22) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,24) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,23) + END IF + ELSE IF (ic .EQ. 9) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,26) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,28) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,27) + END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,25) END IF END DO END DO - funb = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=3,1,-1 - temp404b29 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp404b29 - fun2b = fun2b + temp404b29 + DO ic=9,1,-1 + temp335b55 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 10.d0*temp335b55 + fun2b = fun2b + temp335b55 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp404b28 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp404b28 - funb = funb + rmu(ic, 0)*temp404b28 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + IF (branch .LT. 15) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp335b0 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& +& 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& +& ) + rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& +& , 0)**2)*temp335b0 + rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp335b0 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& +& )*temp335b0 + ELSE + temp335b1 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& +& 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& +& ) + rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& +& , 0)**2)*temp335b1 + rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp335b1 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& +& )*temp335b1 + END IF + ELSE IF (branch .LT. 4) THEN + temp335b2 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& +& 3, 0)*r(0)**2))*zb(indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& +& r(0)**2)*temp335b2 + rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp335b2 + ELSE + temp335b3 = cost2g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& +& , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& +& (indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& +& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp335b3 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp335b3 + rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp335b3 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp335b4 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp335b5 = rmu(2, 0)*rmu(3, 0)*temp335b4 + temp335b6 = fun0*rmu(1, 0)*temp335b4 + fun0b = fun0b + rmu(1, 0)*temp335b5 + rmub(1, 0) = rmub(1, 0) + fun0*temp335b5 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp335b6 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp335b6 + ELSE + temp335b7 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp335b8 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& +& **2)*temp335b7 + temp335b9 = fun0*rmu(1, 0)*temp335b7 + fun0b = fun0b + rmu(1, 0)*temp335b8 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp335b9 + fun0& +& *temp335b8 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp335b9 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp335b9 + END IF + ELSE + temp335b10 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp335b11 = rmu(2, 0)*rmu(3, 0)*temp335b10 + temp335b12 = fun0*rmu(1, 0)*temp335b10 + fun0b = fun0b + rmu(1, 0)*temp335b11 + rmub(1, 0) = rmub(1, 0) + fun0*temp335b11 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp335b12 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp335b12 + END IF + ELSE IF (branch .LT. 12) THEN + IF (branch .LT. 10) THEN + IF (branch .LT. 9) THEN + temp335b13 = cost2g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& +& , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& +& (indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& +& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp335b13 + rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp335b13 + rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp335b13 + ELSE + temp335b14 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp335b15 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& +& **2)*temp335b14 + temp335b16 = fun0*rmu(2, 0)*temp335b14 + fun0b = fun0b + rmu(2, 0)*temp335b15 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp335b16 + & +& fun0*temp335b15 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp335b16 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp335b16 + END IF + ELSE IF (branch .LT. 11) THEN + temp335b17 = -(cost3g*4.d0*zb(indorbp, indt+i)) + temp335b18 = fun0*temp335b17 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& +& **2))*temp335b17 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& +& **2)*temp335b18 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& +& temp335b18 + ELSE + temp335b19 = cost3g*4.d0*zb(indorbp, indt+i) + temp335b20 = fun0*temp335b19 + fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& +& **2))*temp335b19 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& +& **2)*temp335b20 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& +& temp335b20 + END IF + ELSE IF (branch .LT. 14) THEN + IF (branch .LT. 13) THEN + temp335b21 = cost3g*12.d0*zb(indorbp, indt+i) + temp335b22 = fun0*rmu(3, 0)*temp335b21 + temp335b23 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp335b21 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp335b22 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp335b22 + fun0b = fun0b + rmu(3, 0)*temp335b23 + rmub(3, 0) = rmub(3, 0) + fun0*temp335b23 + ELSE + temp335b24 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp335b25 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3& +& , 0)**2)*temp335b24 + temp335b26 = fun0*rmu(2, 0)*temp335b24 + fun0b = fun0b + rmu(2, 0)*temp335b25 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp335b26 + fun0*& +& temp335b25 + rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp335b26 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp335b26 + END IF + ELSE + temp335b27 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp335b28 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0& +& )**2)*temp335b27 + temp335b29 = fun0*rmu(1, 0)*temp335b27 + fun0b = fun0b + rmu(1, 0)*temp335b28 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp335b29 + fun0*& +& temp335b28 + rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp335b29 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp335b29 + END IF + ELSE IF (branch .LT. 22) THEN + IF (branch .LT. 19) THEN + IF (branch .LT. 17) THEN + IF (branch .LT. 16) THEN + temp335b30 = cost3g*24.d0*zb(indorbp, indt+i) + temp335b31 = rmu(2, 0)*rmu(3, 0)*temp335b30 + temp335b32 = fun0*rmu(1, 0)*temp335b30 + fun0b = fun0b + rmu(1, 0)*temp335b31 + rmub(1, 0) = rmub(1, 0) + fun0*temp335b31 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp335b32 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp335b32 + ELSE + temp335b33 = cost4g*3.d0*zb(indorbp, indt+i) + temp335b34 = fun0*rmu(3, 0)*temp335b33 + temp335b35 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp335b33 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp335b34 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp335b34 + fun0b = fun0b + rmu(3, 0)*temp335b35 + rmub(3, 0) = rmub(3, 0) + fun0*temp335b35 + END IF + ELSE IF (branch .LT. 18) THEN + temp335b36 = -(cost4g*6.d0*zb(indorbp, indt+i)) + temp335b37 = rmu(2, 0)*rmu(3, 0)*temp335b36 + temp335b38 = fun0*rmu(1, 0)*temp335b36 + fun0b = fun0b + rmu(1, 0)*temp335b37 + rmub(1, 0) = rmub(1, 0) + fun0*temp335b37 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp335b38 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp335b38 + ELSE + temp335b39 = cost4g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& +& (2, 0)**2))*zb(indorbp, indt+i) + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& +& **2)*temp335b39 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp335b39 + END IF + ELSE IF (branch .LT. 21) THEN + IF (branch .LT. 20) THEN + temp335b40 = cost4g*6.d0*zb(indorbp, indt+i) + temp335b41 = rmu(2, 0)*rmu(3, 0)*temp335b40 + temp335b42 = fun0*rmu(1, 0)*temp335b40 + fun0b = fun0b + rmu(1, 0)*temp335b41 + rmub(1, 0) = rmub(1, 0) + fun0*temp335b41 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp335b42 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp335b42 + ELSE + temp335b43 = cost4g*3.d0*zb(indorbp, indt+i) + temp335b44 = fun0*rmu(3, 0)*temp335b43 + temp335b45 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp335b43 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp335b44 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp335b44 + fun0b = fun0b + rmu(3, 0)*temp335b45 + rmub(3, 0) = rmub(3, 0) + fun0*temp335b45 + END IF + ELSE + temp335b46 = cost4g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& +& 2, 0)**3)*zb(indorbp, indt+i) + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp335b46 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& +& 2)*temp335b46 + END IF + ELSE IF (branch .LT. 26) THEN + IF (branch .LT. 24) THEN + IF (branch .LT. 23) THEN + temp335b47 = cost5g*4.d0*zb(indorbp, indt+i) + temp335b48 = fun0*temp335b47 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& +& **2))*temp335b47 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& +& **2)*temp335b48 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp335b48 + END IF + ELSE IF (branch .LT. 25) THEN + temp335b49 = cost5g*4.d0*zb(indorbp, indt+i) + temp335b50 = fun0*temp335b49 + fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& +& ))*temp335b49 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& +& 2)*temp335b50 + rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp335b50 + END IF + ELSE IF (branch .LT. 28) THEN + IF (branch .LT. 27) THEN + temp335b51 = cost5g*4.d0*zb(indorbp, indt+i) + temp335b52 = fun0*temp335b51 + fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& +& 3)*temp335b51 + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp335b52 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& +& 2)*temp335b52 + END IF + ELSE + temp335b53 = cost5g*4.d0*zb(indorbp, indt+i) + temp335b54 = fun0*temp335b53 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& +& *temp335b53 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& +& *temp335b54 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp335b54 + END IF + temp335b = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp335b + funb0 = funb0 + rmu(i, 0)*temp335b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp404b22 = 2.d0*fun2b - temp404b23 = dd2*distp(0, 1)*2.d0*temp404b22 - temp404b24 = (2.d0*(dd2*r(0)**2)-1.d0)*temp404b22 - temp404b25 = (2.d0*(dd4*r(0)**2)-1.d0)*temp404b22 - temp404b26 = dd4*dd3*distp(0, 2)*2.d0*temp404b22 - temp404b27 = 2.d0*funb - dd2b = distp(0, 1)*temp404b24 - distp(0, 1)*temp404b27 + r(0)**2*& -& temp404b23 - rb(0) = rb(0) + dd4*2*r(0)*temp404b26 + dd2*2*r(0)*temp404b23 - distpb(0, 1) = dd2*temp404b24 - dd4b = r(0)**2*temp404b26 - distp(0, 2)*dd3*temp404b27 + distp(0, & -& 2)*dd3*temp404b25 - dd3b = distp(0, 2)*fun0b - distp(0, 2)*dd4*temp404b27 + distp(0, 2& -& )*dd4*temp404b25 - distpb(0, 2) = dd4*dd3*temp404b25 - distpb(0, 1) = distpb(0, 1) - dd2*temp404b27 - distpb(0, 2) = distpb(0, 2) - dd4*dd3*temp404b27 - distpb(0, 1) = distpb(0, 1) + fun0b - distpb(0, 2) = distpb(0, 2) + dd3*fun0b + temp334 = rp3**2 + temp333b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& +& temp334 + temp333 = dd1*distp(0, 1)/temp334 + temp333b0 = temp333*fun2b + rp1b = (2*rp1+4.d0*rp2+4.d0)*temp333b0 + temp332b18 = -(distp(0, 1)*(rp2+2.d0)*funb0/rp3) + dd1b = temp332b18 + r(0)**2*rp1b + distp(0, 1)*temp333b + temp332 = dd1/rp3 + distpb(0, 1) = distpb(0, 1) + fun0b - temp332*(rp2+2.d0)*funb0 + & +& dd1*temp333b + rp3b = -(temp332*temp332b18) - temp333*2*rp3*temp333b + rp2b = 2*(rp2+1.d0)*rp3b - temp332*distp(0, 1)*funb0 + (4.d0*rp1-& +& 2.d0)*temp333b0 + dd2b = r(0)*rp2b + rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b ELSE distpb = 0.0_8 + dd1b = 0.0_8 dd2b = 0.0_8 - dd3b = 0.0_8 - dd4b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=0,0,-1 - temp404b21 = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& -& indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp404b21 - dd3b = dd3b + distp(i, 2)*temp404b21 - distpb(i, 2) = distpb(i, 2) + dd3*temp404b21 - zb(indorbp, i) = 0.0_8 + DO ic=9,1,-1 + DO k=0,0,-1 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + DO i=0,0,-1 + temp332b0 = cost5g*4.d0*distpb(i, 10) + temp332b1 = (rmu(1, i)**2-rmu(2, i)**2)*temp332b0 + temp332b2 = rmu(1, i)*rmu(2, i)*temp332b0 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp332b2 + rmu(2, i)*& +& temp332b1 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp332b1 - 2*rmu(2, i)*& +& temp332b2 + distpb(i, 10) = 0.0_8 + temp332b3 = cost5g*distpb(i, 9) + rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& +& 1, i))*temp332b3 + distpb(i, 9) = 0.0_8 + temp332b4 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) + temp332b5 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp332b4 - 2*rmu(2, i)*& +& temp332b5 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& +& temp332b3 + rmub(3, i) = rmub(3, i) + rmu(2, i)*temp332b4 + distpb(i, 8) = 0.0_8 + temp332b6 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) + temp332b7 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp332b6 + 2*rmu(1, i)*& +& temp332b7 + 3.d0*2*rmu(1, i)*temp332b5 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp332b6 + rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp332b7 + distpb(i, 7) = 0.0_8 + temp332b8 = cost3g*2.d0*distpb(i, 6) + temp332b9 = (7.d0*rmu(3, i)**2-r(i)**2)*temp332b8 + temp332b10 = rmu(1, i)*rmu(2, i)*temp332b8 + rmub(1, i) = rmub(1, i) + rmu(2, i)*temp332b9 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp332b9 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp332b10 + distpb(i, 6) = 0.0_8 + temp332b11 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) + temp332b12 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + temp332b13 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) + temp332b14 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + temp332b15 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) + temp332b16 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + temp332b17 = cost1g*distpb(i, 2) + rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& +& temp332b17 - 3.d0*2*r(i)*temp332b16 - 2*r(i)*temp332b12 - 3.d0*2& +& *r(i)*temp332b14 - 2*r(i)*temp332b10 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp332b11 + rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp332b11 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp332b12 + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp332b13 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp332b14 + rmu(2, i)*& +& temp332b13 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp332b15 + rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& +& rmu(3, i))*temp332b17 + 7.d0*2*rmu(3, i)*temp332b16 + rmu(1, i)*& +& temp332b15 + distpb(i, 2) = 0.0_8 + END DO + cb = 0.0_8 DO k=0,0,-1 - temp404b19 = DEXP(-(dd4*r(k)**2))*distpb(k, 2) - dd4b = dd4b - r(k)**2*temp404b19 - distpb(k, 2) = 0.0_8 - temp404b20 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - rb(k) = rb(k) - dd2*2*r(k)*temp404b20 - dd4*2*r(k)*temp404b19 - dd2b = dd2b - r(k)**2*temp404b20 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp331 = dd2*r(k) + 1.d0 + temp332b = costb/temp331 + temp331b0 = -(dd1*r(k)**2*temp332b/temp331) + dd1b = dd1b + r(k)**2*temp332b + rb(k) = rb(k) + dd2*temp331b0 + dd1*2*r(k)*temp332b + dd2b = dd2b + r(k)*temp331b0 END DO - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (103) -! 2p single gaussian + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocg*2.75d0*dd1**1.75D0*cb + ELSE + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocg*2.75d0*dd1**1.75D0*& +& cb + END IF + ddb(indparp) = ddb(indparp) + dd1b + CASE (2100:2199) +! p gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative 1100 + npower = iopt + 1 - 2100 +! indorbp=indorb dd2 = dd(indpar+1) DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k)**2)) + distp(k, 1) = -(r(k)**(2*npower)*DEXP(-(dd2*r(k)**2))) END DO -! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then @@ -16655,40 +15490,57 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)*2.d0) - fun2 = 2.d0*dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0, 1) -! indorbp=indorb + rp1 = r(0)**2 + fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 + fun2 = (npower*(2.d0*npower-1.d0)-(1.d0+4.d0*npower)*dd2*rp1+2.d0*& +& (dd2*rp1)**2)*distp(0, 1)*2.d0/rp1 +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp404b34 = rmu(ic, 0)*zb(indorbp, indt+4) + temp339b2 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp404b34 - fun2b = fun2b + temp404b34 + funb0 = funb0 + 4.d0*temp339b2 + fun2b = fun2b + temp339b2 zb(indorbp, indt+4) = 0.0_8 - fun0b = fun0b + zb(indorbp, indt+ic) DO i=3,1,-1 - temp404b33 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp404b33 - funb = funb + rmu(ic, 0)*temp404b33 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp339b1 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp339b1 + funb0 = funb0 + rmu(ic, 0)*temp339b1 rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp404b31 = 2.d0**2*dd2*distp(0, 1)*fun2b - temp404b32 = 2.d0*(2.d0*(dd2*r(0)**2)-1.d0)*fun2b - dd2b = distp(0, 1)*temp404b32 - 2.d0*distp(0, 1)*funb + r(0)**2*& -& temp404b31 - rb(0) = rb(0) + dd2*2*r(0)*temp404b31 - distpb(0, 1) = fun0b - 2.d0*dd2*funb + dd2*temp404b32 + temp338 = distp(0, 1)/rp1 + temp339b = 2.d0*temp338*fun2b + temp339b0 = -((npower*4.d0+1.d0)*temp339b) + temp338b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& +& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 + temp337 = distp(0, 1)/rp1 + temp338b0 = 2.d0*temp337*funb0 + dd2b = rp1*temp339b0 - rp1*temp338b0 + 2.d0*rp1**2*2*dd2*temp339b + temp337b = 2.d0*(npower-dd2*rp1)*funb0/rp1 + rp1b = dd2*temp339b0 - temp337*temp337b - temp338*temp338b - dd2*& +& temp338b0 + 2.d0*dd2**2*2*rp1*temp339b + distpb(0, 1) = temp337b + fun0b + temp338b + rb(0) = rb(0) + 2*r(0)*rp1b ELSE distpb = 0.0_8 dd2b = 0.0_8 @@ -16702,512 +15554,740 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=0,0,-1 - temp404b30 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp404b30 - rb(k) = rb(k) - dd2*2*r(k)*temp404b30 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (105) -! 2s double gaussian without constant -! (exp (-dd2 r^2)+dd4*exp(-dd5*r^2)) -! dd1=1.d0 - dd2 = dd(indpar+1) -! dd3=dd(indpar+2) -! dd4=dd(indpar+3) -! dd5=dd(indpar+4) - dd4 = dd(indpar+2) - dd5 = dd(indpar+3) - indorbp = indorb + 1 - DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) - distp(k, 2) = DEXP(-(dd5*r(k)*r(k))) - END DO -! write(6,*) ' function inside = ',z(indorbp,i) -! endif - IF (typec .NE. 1) THEN - fun = -(2.d0*(dd2*distp(0, 1)+dd5*dd4*distp(0, 2))) - fun2 = r(0)**2 - distpb = 0.0_8 - temp404b38 = 2.d0*zb(indorbp, indt+4) - temp404b39 = dd2*distp(0, 1)*2.d0*temp404b38 - temp404b40 = (2.d0*(dd2*fun2)-3.d0)*temp404b38 - temp404b41 = (2.d0*(dd5*fun2)-3.d0)*temp404b38 - temp404b42 = dd5*dd4*distp(0, 2)*2.d0*temp404b38 - dd2b = distp(0, 1)*temp404b40 + fun2*temp404b39 - fun2b = dd5*temp404b42 + dd2*temp404b39 - distpb(0, 1) = dd2*temp404b40 - dd5b = fun2*temp404b42 + distp(0, 2)*dd4*temp404b41 - dd4b = distp(0, 2)*dd5*temp404b41 - distpb(0, 2) = dd5*dd4*temp404b41 - zb(indorbp, indt+4) = 0.0_8 - funb = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - rb(0) = rb(0) + 2*r(0)*fun2b - temp404b37 = -(2.d0*funb) - dd2b = dd2b + distp(0, 1)*temp404b37 - distpb(0, 1) = distpb(0, 1) + dd2*temp404b37 - dd5b = dd5b + distp(0, 2)*dd4*temp404b37 - dd4b = dd4b + distp(0, 2)*dd5*temp404b37 - distpb(0, 2) = distpb(0, 2) + dd5*dd4*temp404b37 - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - dd4b = 0.0_8 - dd5b = 0.0_8 - END IF - DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd4b = dd4b + distp(i, 2)*zb(indorbp, i) - distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=0,0,-1 - temp404b35 = DEXP(-(dd5*r(k)**2))*distpb(k, 2) - dd5b = dd5b - r(k)**2*temp404b35 - distpb(k, 2) = 0.0_8 - temp404b36 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - rb(k) = rb(k) - dd2*2*r(k)*temp404b36 - dd5*2*r(k)*temp404b35 - dd2b = dd2b - r(k)**2*temp404b36 + temp336 = r(k)**2 + temp335 = 2*npower + temp335b56 = -(r(k)**temp335*DEXP(-(dd2*temp336))*distpb(k, 1)) + IF (r(k) .LE. 0.0 .AND. (temp335 .EQ. 0.0 .OR. temp335 .NE. INT(& +& temp335))) THEN + rb(k) = rb(k) - dd2*2*r(k)*temp335b56 + ELSE + rb(k) = rb(k) - dd2*2*r(k)*temp335b56 - DEXP(-(dd2*temp336))*& +& temp335*r(k)**(temp335-1)*distpb(k, 1) + END IF + dd2b = dd2b - temp336*temp335b56 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+3) = ddb(indpar+3) + dd5b - ddb(indpar+2) = ddb(indpar+2) + dd4b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (106) -! 2s without cusp condition -! dd1*( dd3 +1/(1+dd2*r^2)) - dd2 = dd(indpar+1) - indorbp = indorb + 1 + CASE (72) +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization obtained by Mathematica + c = dd1**3.25d0*0.79296269381073167718d0 +! C= dd1^13/4 /Sqrt[Integrate[x^12 Exp[-2 x^2],{x,0,Infinity}]] +! endif DO k=0,0 - distp(k, 1) = 1.d0/(1.d0+dd2*r(k)*r(k)) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO -! endif - IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)**2*2.d0) - fun2b = zb(indorbp, indt+4) - funb = 2.d0*zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 + DO i=0,0 + DO k=1,5 + CALL PUSHREAL8(adr8ibuf,adr8buf,zv(k)) + zv(k) = rmu(3, i)**k + CALL PUSHREAL8(adr8ibuf,adr8buf,yv(k)) + yv(k) = rmu(2, i)**k + CALL PUSHREAL8(adr8ibuf,adr8buf,xv(k)) + xv(k) = rmu(1, i)**k END DO - distpb = 0.0_8 - temp405b = (1.-3.d0*(dd2*r(0)**2))*fun2b - temp405b0 = -(fun*distp(0, 1)*3.d0*fun2b) - funb = funb + distp(0, 1)*temp405b - distpb(0, 1) = fun*temp405b - 2.d0*dd2*2*distp(0, 1)*funb - dd2b = r(0)**2*temp405b0 - 2.d0*distp(0, 1)**2*funb - rb(0) = rb(0) + dd2*2*r(0)*temp405b0 - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - dd3b = 0.0_8 - DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=0,0,-1 - temp404 = dd2*r(k)**2 + 1.d0 - temp404b43 = -(distpb(k, 1)/temp404**2) - dd2b = dd2b + r(k)**2*temp404b43 - rb(k) = rb(k) + dd2*2*r(k)*temp404b43 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (107) -! 2p single lorentian parent of 103 - dd2 = dd(indpar+1) - DO k=0,0 - distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**2) + CALL PUSHREAL8(adr8ibuf,adr8buf,r2) + r2 = xv(2) + yv(2) + zv(2) + CALL PUSHREAL8(adr8ibuf,adr8buf,r4) + r4 = r2*r2 +! lz=0 + distp(i, 2) = cost1h*(63.d0*zv(5)-70.d0*zv(3)*r2+15.d0*zv(1)*r4) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = 21.d0*zv(4) - 14.d0*zv(2)*r2 + r4 +! lz=+/-1 + distp(i, 3) = cost2h*rmu(1, i)*cost +! lz=+/-1 + distp(i, 4) = cost2h*rmu(2, i)*cost + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = 3.d0*zv(3) - zv(1)*r2 +! lz=+/-2 + distp(i, 5) = cost3h*(xv(2)-yv(2))*cost +! lz=+/-2 + distp(i, 6) = 2.d0*cost3h*xv(1)*yv(1)*cost + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = 9.d0*zv(2) - r2 +! lz=+/-3 + distp(i, 7) = cost4h*(xv(3)-3.d0*xv(1)*yv(2))*cost +! lz=+/-3 + distp(i, 8) = -(cost4h*(yv(3)-3.d0*yv(1)*xv(2))*cost) +! lz=+/-4 + distp(i, 9) = cost5h*(xv(4)-6.d0*xv(2)*yv(2)+yv(4))*zv(1) +! lz=+/-4 + distp(i, 10) = cost5h*4.d0*(xv(3)*yv(1)-yv(3)*xv(1))*zv(1) +! lz=+/-5 + distp(i, 11) = cost6h*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4)) +! lz=+/-5 + distp(i, 12) = -(cost6h*(-(5.d0*xv(4)*yv(1))+10.d0*xv(2)*yv(3)-yv(& +& 5))) END DO -! indorbp=indorb - DO ic=1,3 + DO ic=1,11 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO ! endif IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)**2*2.d0) - fun2 = fun*distp(0, 1)*(1.d0-3.d0*dd2*r(0)**2) + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1) + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) + DO k=1,5 + CALL PUSHREAL8(adr8ibuf,adr8buf,zv(k)) + zv(k) = rmu(3, 0)**k + CALL PUSHREAL8(adr8ibuf,adr8buf,yv(k)) + yv(k) = rmu(2, 0)**k + CALL PUSHREAL8(adr8ibuf,adr8buf,xv(k)) + xv(k) = rmu(1, 0)**k + END DO + CALL PUSHREAL8(adr8ibuf,adr8buf,r2) + r2 = xv(2) + yv(2) + zv(2) + CALL PUSHREAL8(adr8ibuf,adr8buf,r4) + r4 = r2*r2 ! indorbp=indorb - DO ic=1,3 + DO ic=1,11 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + IF (ic .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + ELSE IF (ic .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (ic .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE IF (ic .EQ. 4) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (ic .EQ. 5) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + ELSE IF (ic .EQ. 6) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE IF (ic .EQ. 7) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (ic .EQ. 8) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + ELSE IF (ic .EQ. 9) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE IF (ic .EQ. 10) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (ic .EQ. 11) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + END DO + distpb = 0.0_8 + zvb = 0.0_8 + xvb = 0.0_8 + funb0 = 0.0_8 + yvb = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + r2b = 0.0_8 + r4b = 0.0_8 + DO ic=11,1,-1 + temp340b61 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (12.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 12.d0*temp340b61 + fun2b = fun2b + temp340b61 + zb(indorbp, indt+4) = 0.0_8 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 6) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + IF (branch .LT. 1) THEN + temp340b11 = cost1h*fun0*zb(indorbp, indt+3) + temp340b12 = cost1h*20.d0*zb(indorbp, indt+2) + temp340b13 = (3.d0*xv(2)+3.d0*yv(2)-4.d0*zv(2))*& +& temp340b12 + temp340b14 = cost1h*20.d0*zb(indorbp, indt+1) + temp340b15 = (3.d0*xv(2)+3.d0*yv(2)-4.d0*zv(2))*& +& temp340b14 + fun0b = fun0b + zv(1)*yv(1)*temp340b13 + zv(1)*xv(1)*& +& temp340b15 + cost1h*(175.d0*zv(4)-150.d0*(zv(2)*r2)+& +& 15.d0*r4)*zb(indorbp, indt+3) + zvb(4) = zvb(4) + 175.d0*temp340b11 + zvb(2) = zvb(2) - 150.d0*r2*temp340b11 + r2b = r2b - 150.d0*zv(2)*temp340b11 + r4b = r4b + 15.d0*temp340b11 + temp340b16 = fun0*yv(1)*zv(1)*temp340b12 + yvb(1) = yvb(1) + zv(1)*fun0*temp340b13 + zvb(1) = zvb(1) + fun0*yv(1)*temp340b13 + xvb(2) = xvb(2) + 3.d0*temp340b16 + temp340b17 = fun0*xv(1)*zv(1)*temp340b14 + yvb(2) = yvb(2) + 3.d0*temp340b17 + 3.d0*temp340b16 + zvb(2) = zvb(2) - 4.d0*temp340b16 + xvb(1) = xvb(1) + zv(1)*fun0*temp340b15 + zvb(1) = zvb(1) + fun0*xv(1)*temp340b15 + xvb(2) = xvb(2) + 3.d0*temp340b17 + zvb(2) = zvb(2) - 4.d0*temp340b17 + ELSE + temp340b18 = cost2h*fun0*zb(indorbp, indt+3) + temp340b19 = -(24.d0*zv(1)*temp340b18) + fun0b = fun0b + cost2h*(4.d0*(xv(3)*yv(1))+4.d0*(xv(1)*& +& yv(3))-24.d0*(xv(1)*yv(1)*zv(2)))*zb(indorbp, indt+2) & +& + cost2h*(5.d0*xv(4)+6.d0*(xv(2)*yv(2))+yv(4)+8.d0*zv(& +& 4)-12.d0*(yv(2)*zv(2))-36.d0*(xv(2)*zv(2)))*zb(indorbp& +& , indt+1) + cost2h*(32.d0*(zv(3)*xv(1))-24.d0*(xv(1)*& +& yv(2)*zv(1))-24.d0*(xv(3)*zv(1)))*zb(indorbp, indt+3) + zvb(3) = zvb(3) + 32.d0*xv(1)*temp340b18 + xvb(1) = xvb(1) + yv(2)*temp340b19 + 32.d0*zv(3)*& +& temp340b18 + yvb(2) = yvb(2) + xv(1)*temp340b19 + zvb(1) = zvb(1) + (-(24.d0*xv(3))-24.d0*xv(1)*yv(2))*& +& temp340b18 + temp340b20 = cost2h*fun0*zb(indorbp, indt+2) + xvb(3) = xvb(3) + 4.d0*yv(1)*temp340b20 - 24.d0*zv(1)*& +& temp340b18 + temp340b21 = -(24.d0*zv(2)*temp340b20) + yvb(1) = yvb(1) + xv(1)*temp340b21 + 4.d0*xv(3)*& +& temp340b20 + xvb(1) = xvb(1) + yv(1)*temp340b21 + 4.d0*yv(3)*& +& temp340b20 + yvb(3) = yvb(3) + 4.d0*xv(1)*temp340b20 + zvb(2) = zvb(2) - 24.d0*xv(1)*yv(1)*temp340b20 + temp340b22 = cost2h*fun0*zb(indorbp, indt+1) + xvb(4) = xvb(4) + 5.d0*temp340b22 + xvb(2) = xvb(2) + (6.d0*yv(2)-36.d0*zv(2))*temp340b22 + yvb(2) = yvb(2) + (6.d0*xv(2)-12.d0*zv(2))*temp340b22 + yvb(4) = yvb(4) + temp340b22 + zvb(4) = zvb(4) + 8.d0*temp340b22 + zvb(2) = zvb(2) + (-(36.d0*xv(2))-12.d0*yv(2))*& +& temp340b22 + END IF + ELSE + temp340b23 = cost2h*fun0*zb(indorbp, indt+3) + temp340b24 = -(24.d0*zv(1)*temp340b23) + fun0b = fun0b + cost2h*(5.d0*yv(4)+6.d0*(xv(2)*yv(2))+xv(4& +& )+8.d0*zv(4)-12.d0*(xv(2)*zv(2))-36.d0*(yv(2)*zv(2)))*zb& +& (indorbp, indt+2) - cost2h*(24.d0*(xv(1)*yv(1)*zv(2))-& +& 4.d0*(xv(1)*yv(3))-4.d0*(xv(3)*yv(1)))*zb(indorbp, indt+& +& 1) + cost2h*(32.d0*(zv(3)*yv(1))-24.d0*(yv(1)*xv(2)*zv(1& +& ))-24.d0*(yv(3)*zv(1)))*zb(indorbp, indt+3) + zvb(3) = zvb(3) + 32.d0*yv(1)*temp340b23 + yvb(1) = yvb(1) + xv(2)*temp340b24 + 32.d0*zv(3)*& +& temp340b23 + temp340b25 = cost2h*fun0*zb(indorbp, indt+2) + xvb(2) = xvb(2) + (6.d0*yv(2)-12.d0*zv(2))*temp340b25 + yv& +& (1)*temp340b24 + zvb(1) = zvb(1) + (-(24.d0*yv(3))-24.d0*yv(1)*xv(2))*& +& temp340b23 + yvb(3) = yvb(3) - 24.d0*zv(1)*temp340b23 + yvb(4) = yvb(4) + 5.d0*temp340b25 + yvb(2) = yvb(2) + (6.d0*xv(2)-36.d0*zv(2))*temp340b25 + xvb(4) = xvb(4) + temp340b25 + zvb(4) = zvb(4) + 8.d0*temp340b25 + temp340b26 = -(cost2h*fun0*zb(indorbp, indt+1)) + zvb(2) = zvb(2) + 24.d0*xv(1)*yv(1)*temp340b26 + (-(36.d0*& +& yv(2))-12.d0*xv(2))*temp340b25 + temp340b27 = 24.d0*zv(2)*temp340b26 + xvb(1) = xvb(1) + yv(1)*temp340b27 - 4.d0*yv(3)*temp340b26 + yvb(1) = yvb(1) + xv(1)*temp340b27 - 4.d0*xv(3)*temp340b26 + yvb(3) = yvb(3) - 4.d0*xv(1)*temp340b26 + xvb(3) = xvb(3) - 4.d0*yv(1)*temp340b26 + END IF + ELSE IF (branch .LT. 5) THEN + IF (branch .LT. 4) THEN + temp340b28 = cost3h*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost3h*(4.d0*(yv(3)*zv(1))-4.d0*(yv(1)*zv(& +& 3)))*zb(indorbp, indt+2) + cost3h*(4.d0*(xv(1)*zv(3))-& +& 4.d0*(xv(3)*zv(1)))*zb(indorbp, indt+1) + cost3h*(yv(4)-& +& xv(4)+6.d0*(xv(2)*zv(2))-6.d0*(yv(2)*zv(2)))*zb(indorbp& +& , indt+3) + yvb(4) = yvb(4) + temp340b28 + xvb(4) = xvb(4) - temp340b28 + xvb(2) = xvb(2) + 6.d0*zv(2)*temp340b28 + zvb(2) = zvb(2) + (6.d0*xv(2)-6.d0*yv(2))*temp340b28 + yvb(2) = yvb(2) - 6.d0*zv(2)*temp340b28 + temp340b29 = cost3h*fun0*zb(indorbp, indt+2) + yvb(3) = yvb(3) + 4.d0*zv(1)*temp340b29 + zvb(1) = zvb(1) + 4.d0*yv(3)*temp340b29 + yvb(1) = yvb(1) - 4.d0*zv(3)*temp340b29 + temp340b30 = cost3h*fun0*zb(indorbp, indt+1) + zvb(3) = zvb(3) + 4.d0*xv(1)*temp340b30 - 4.d0*yv(1)*& +& temp340b29 + xvb(1) = xvb(1) + 4.d0*zv(3)*temp340b30 + xvb(3) = xvb(3) - 4.d0*zv(1)*temp340b30 + zvb(1) = zvb(1) - 4.d0*xv(3)*temp340b30 + ELSE + temp340b31 = -(cost3h*fun0*zb(indorbp, indt+3)) + temp340b32 = -(12.d0*zv(2)*temp340b31) + fun0b = fun0b - cost3h*(2.d0*(xv(3)*zv(1))+6.d0*(xv(1)*yv(& +& 2)*zv(1))-4.d0*(xv(1)*zv(3)))*zb(indorbp, indt+2) - & +& cost3h*(6.d0*(xv(2)*yv(1)*zv(1))+2.d0*(yv(3)*zv(1))-4.d0& +& *(yv(1)*zv(3)))*zb(indorbp, indt+1) - cost3h*(2.d0*(xv(3& +& )*yv(1))+2.d0*(xv(1)*yv(3))-12.d0*(xv(1)*yv(1)*zv(2)))*& +& zb(indorbp, indt+3) + xvb(3) = xvb(3) + 2.d0*yv(1)*temp340b31 + yvb(1) = yvb(1) + xv(1)*temp340b32 + 2.d0*xv(3)*temp340b31 + xvb(1) = xvb(1) + yv(1)*temp340b32 + 2.d0*yv(3)*temp340b31 + yvb(3) = yvb(3) + 2.d0*xv(1)*temp340b31 + zvb(2) = zvb(2) - 12.d0*xv(1)*yv(1)*temp340b31 + temp340b33 = -(cost3h*fun0*zb(indorbp, indt+2)) + temp340b34 = 6.d0*zv(1)*temp340b33 + xvb(3) = xvb(3) + 2.d0*zv(1)*temp340b33 + zvb(1) = zvb(1) + (6.d0*xv(1)*yv(2)+2.d0*xv(3))*temp340b33 + xvb(1) = xvb(1) + yv(2)*temp340b34 - 4.d0*zv(3)*temp340b33 + yvb(2) = yvb(2) + xv(1)*temp340b34 + zvb(3) = zvb(3) - 4.d0*xv(1)*temp340b33 + temp340b35 = -(cost3h*fun0*zb(indorbp, indt+1)) + temp340b36 = 6.d0*zv(1)*temp340b35 + xvb(2) = xvb(2) + yv(1)*temp340b36 + yvb(1) = yvb(1) + xv(2)*temp340b36 - 4.d0*zv(3)*temp340b35 + zvb(1) = zvb(1) + (2.d0*yv(3)+6.d0*xv(2)*yv(1))*temp340b35 + yvb(3) = yvb(3) + 2.d0*zv(1)*temp340b35 + zvb(3) = zvb(3) - 4.d0*yv(1)*temp340b35 + END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + temp340b37 = cost4h*fun0*zb(indorbp, indt+3) + temp340b38 = -(48.d0*zv(1)*temp340b37) + fun0b = fun0b + cost4h*(4.d0*(xv(3)*yv(1))+12.d0*(xv(1)*yv(3& +& ))-48.d0*(xv(1)*yv(1)*zv(2)))*zb(indorbp, indt+2) + cost4h& +& *(6.d0*(xv(2)*yv(2))-5.d0*xv(4)+3.d0*yv(4)+24.d0*(xv(2)*zv& +& (2))-24.d0*(yv(2)*zv(2)))*zb(indorbp, indt+1) + cost4h*(& +& 16.d0*(xv(3)*zv(1))-48.d0*(xv(1)*yv(2)*zv(1)))*zb(indorbp& +& , indt+3) + xvb(3) = xvb(3) + 16.d0*zv(1)*temp340b37 + zvb(1) = zvb(1) + (16.d0*xv(3)-48.d0*xv(1)*yv(2))*temp340b37 + xvb(1) = xvb(1) + yv(2)*temp340b38 + yvb(2) = yvb(2) + xv(1)*temp340b38 + temp340b39 = cost4h*fun0*zb(indorbp, indt+2) + temp340b40 = -(48.d0*zv(2)*temp340b39) + xvb(3) = xvb(3) + 4.d0*yv(1)*temp340b39 + yvb(1) = yvb(1) + xv(1)*temp340b40 + 4.d0*xv(3)*temp340b39 + xvb(1) = xvb(1) + yv(1)*temp340b40 + 12.d0*yv(3)*temp340b39 + yvb(3) = yvb(3) + 12.d0*xv(1)*temp340b39 + temp340b41 = cost4h*fun0*zb(indorbp, indt+1) + zvb(2) = zvb(2) + (24.d0*xv(2)-24.d0*yv(2))*temp340b41 - & +& 48.d0*xv(1)*yv(1)*temp340b39 + xvb(2) = xvb(2) + (24.d0*zv(2)+6.d0*yv(2))*temp340b41 + yvb(2) = yvb(2) + (6.d0*xv(2)-24.d0*zv(2))*temp340b41 + xvb(4) = xvb(4) - 5.d0*temp340b41 + yvb(4) = yvb(4) + 3.d0*temp340b41 END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp406b2 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp406b2 - fun2b = fun2b + temp406b2 - zb(indorbp, indt+4) = 0.0_8 + ELSE IF (branch .LT. 9) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 7) THEN + temp340b42 = -(cost4h*fun0*zb(indorbp, indt+3)) + temp340b43 = -(48.d0*zv(1)*temp340b42) + fun0b = fun0b - cost4h*(3.d0*xv(4)+6.d0*(xv(2)*yv(2))-5.d0& +& *yv(4)+24.d0*(yv(2)*zv(2))-24.d0*(xv(2)*zv(2)))*zb(& +& indorbp, indt+2) - cost4h*(12.d0*(xv(3)*yv(1))+4.d0*(xv(& +& 1)*yv(3))-48.d0*(xv(1)*yv(1)*zv(2)))*zb(indorbp, indt+1)& +& - cost4h*(16.d0*(yv(3)*zv(1))-48.d0*(xv(2)*yv(1)*zv(1)))& +& *zb(indorbp, indt+3) + yvb(3) = yvb(3) + 16.d0*zv(1)*temp340b42 + zvb(1) = zvb(1) + (16.d0*yv(3)-48.d0*xv(2)*yv(1))*& +& temp340b42 + xvb(2) = xvb(2) + yv(1)*temp340b43 + yvb(1) = yvb(1) + xv(2)*temp340b43 + temp340b44 = -(cost4h*fun0*zb(indorbp, indt+2)) + xvb(4) = xvb(4) + 3.d0*temp340b44 + xvb(2) = xvb(2) + (6.d0*yv(2)-24.d0*zv(2))*temp340b44 + yvb(2) = yvb(2) + (24.d0*zv(2)+6.d0*xv(2))*temp340b44 + yvb(4) = yvb(4) - 5.d0*temp340b44 + temp340b45 = -(cost4h*fun0*zb(indorbp, indt+1)) + zvb(2) = zvb(2) + (24.d0*yv(2)-24.d0*xv(2))*temp340b44 - & +& 48.d0*xv(1)*yv(1)*temp340b45 + temp340b46 = -(48.d0*zv(2)*temp340b45) + xvb(3) = xvb(3) + 12.d0*yv(1)*temp340b45 + yvb(1) = yvb(1) + xv(1)*temp340b46 + 12.d0*xv(3)*& +& temp340b45 + xvb(1) = xvb(1) + yv(1)*temp340b46 + 4.d0*yv(3)*temp340b45 + yvb(3) = yvb(3) + 4.d0*xv(1)*temp340b45 + ELSE + temp340b47 = cost5h*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost5h*(4.d0*(yv(3)*zv(1))-12.d0*(xv(2)*yv& +& (1)*zv(1)))*zb(indorbp, indt+2) + cost5h*(4.d0*(xv(3)*zv& +& (1))-12.d0*(xv(1)*yv(2)*zv(1)))*zb(indorbp, indt+1) + & +& cost5h*(xv(4)-6.d0*(xv(2)*yv(2))+yv(4))*zb(indorbp, indt& +& +3) + xvb(4) = xvb(4) + temp340b47 + temp340b48 = cost5h*fun0*zb(indorbp, indt+2) + temp340b49 = -(12.d0*zv(1)*temp340b48) + xvb(2) = xvb(2) + yv(1)*temp340b49 - 6.d0*yv(2)*temp340b47 + yvb(2) = yvb(2) - 6.d0*xv(2)*temp340b47 + yvb(4) = yvb(4) + temp340b47 + yvb(3) = yvb(3) + 4.d0*zv(1)*temp340b48 + temp340b50 = cost5h*fun0*zb(indorbp, indt+1) + zvb(1) = zvb(1) + (4.d0*xv(3)-12.d0*xv(1)*yv(2))*& +& temp340b50 + (4.d0*yv(3)-12.d0*xv(2)*yv(1))*temp340b48 + yvb(1) = yvb(1) + xv(2)*temp340b49 + temp340b51 = -(12.d0*zv(1)*temp340b50) + xvb(3) = xvb(3) + 4.d0*zv(1)*temp340b50 + xvb(1) = xvb(1) + yv(2)*temp340b51 + yvb(2) = yvb(2) + xv(1)*temp340b51 + END IF + ELSE + temp340b52 = -(cost5h*fun0*zb(indorbp, indt+3)) + fun0b = fun0b - cost5h*(12.d0*(xv(1)*yv(2)*zv(1))-4.d0*(xv(3& +& )*zv(1)))*zb(indorbp, indt+2) - cost5h*(4.d0*(yv(3)*zv(1))& +& -12.d0*(xv(2)*yv(1)*zv(1)))*zb(indorbp, indt+1) - cost5h*(& +& 4.d0*(xv(1)*yv(3))-4.d0*(xv(3)*yv(1)))*zb(indorbp, indt+3) + xvb(1) = xvb(1) + 4.d0*yv(3)*temp340b52 + yvb(3) = yvb(3) + 4.d0*xv(1)*temp340b52 + xvb(3) = xvb(3) - 4.d0*yv(1)*temp340b52 + yvb(1) = yvb(1) - 4.d0*xv(3)*temp340b52 + temp340b53 = -(cost5h*fun0*zb(indorbp, indt+2)) + temp340b54 = 12.d0*zv(1)*temp340b53 + xvb(1) = xvb(1) + yv(2)*temp340b54 + yvb(2) = yvb(2) + xv(1)*temp340b54 + temp340b55 = -(cost5h*fun0*zb(indorbp, indt+1)) + zvb(1) = zvb(1) + (4.d0*yv(3)-12.d0*xv(2)*yv(1))*temp340b55 & +& + (12.d0*xv(1)*yv(2)-4.d0*xv(3))*temp340b53 + xvb(3) = xvb(3) - 4.d0*zv(1)*temp340b53 + temp340b56 = -(12.d0*zv(1)*temp340b55) + yvb(3) = yvb(3) + 4.d0*zv(1)*temp340b55 + xvb(2) = xvb(2) + yv(1)*temp340b56 + yvb(1) = yvb(1) + xv(2)*temp340b56 + END IF + ELSE IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + temp340b57 = cost6h*fun0*zb(indorbp, indt+2) + fun0b = fun0b + cost6h*(5.d0*xv(4)-30.d0*(xv(2)*yv(2))+5.d0*& +& yv(4))*zb(indorbp, indt+1) + cost6h*(20.d0*(xv(1)*yv(3))-& +& 20.d0*(xv(3)*yv(1)))*zb(indorbp, indt+2) + xvb(1) = xvb(1) + 20.d0*yv(3)*temp340b57 + yvb(3) = yvb(3) + 20.d0*xv(1)*temp340b57 + xvb(3) = xvb(3) - 20.d0*yv(1)*temp340b57 + yvb(1) = yvb(1) - 20.d0*xv(3)*temp340b57 + temp340b58 = cost6h*fun0*zb(indorbp, indt+1) + xvb(4) = xvb(4) + 5.d0*temp340b58 + xvb(2) = xvb(2) - 30.d0*yv(2)*temp340b58 + yvb(2) = yvb(2) - 30.d0*xv(2)*temp340b58 + yvb(4) = yvb(4) + 5.d0*temp340b58 + END IF + ELSE + temp340b59 = -(cost6h*fun0*zb(indorbp, indt+2)) + fun0b = fun0b - cost6h*(20.d0*(xv(1)*yv(3))-20.d0*(xv(3)*yv(1)& +& ))*zb(indorbp, indt+1) - cost6h*(30.d0*(xv(2)*yv(2))-5.d0*xv& +& (4)-5.d0*yv(4))*zb(indorbp, indt+2) + xvb(2) = xvb(2) + 30.d0*yv(2)*temp340b59 + yvb(2) = yvb(2) + 30.d0*xv(2)*temp340b59 + xvb(4) = xvb(4) - 5.d0*temp340b59 + yvb(4) = yvb(4) - 5.d0*temp340b59 + temp340b60 = -(cost6h*fun0*zb(indorbp, indt+1)) + xvb(1) = xvb(1) + 20.d0*yv(3)*temp340b60 + yvb(3) = yvb(3) + 20.d0*xv(1)*temp340b60 + xvb(3) = xvb(3) - 20.d0*yv(1)*temp340b60 + yvb(1) = yvb(1) - 20.d0*xv(3)*temp340b60 + END IF DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp406b1 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp406b1 - funb = funb + rmu(ic, 0)*temp406b1 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + temp340b10 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp340b10 + funb0 = funb0 + rmu(i, 0)*temp340b10 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp406b = (1.d0-3.d0*(dd2*r(0)**2))*fun2b - temp406b0 = -(fun*distp(0, 1)*3.d0*fun2b) - funb = funb + distp(0, 1)*temp406b - distpb(0, 1) = fun0b - 2.d0*dd2*2*distp(0, 1)*funb + fun*temp406b - dd2b = r(0)**2*temp406b0 - 2.d0*distp(0, 1)**2*funb - rb(0) = rb(0) + dd2*2*r(0)*temp406b0 + CALL POPREAL8(adr8ibuf,adr8buf,r4) + r2b = r2b + 2*r2*r4b + CALL POPREAL8(adr8ibuf,adr8buf,r2) + xvb(2) = xvb(2) + r2b + yvb(2) = yvb(2) + r2b + zvb(2) = zvb(2) + r2b + DO k=5,1,-1 + CALL POPREAL8(adr8ibuf,adr8buf,xv(k)) + IF (.NOT.(rmu(1, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(1, 0) = rmub(1, 0) + k*rmu(1, 0)**(k-1)*xvb(k) + xvb(k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,yv(k)) + IF (.NOT.(rmu(2, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(2, 0) = rmub(2, 0) + k*rmu(2, 0)**(k-1)*yvb(k) + yvb(k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,zv(k)) + IF (.NOT.(rmu(3, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(3, 0) = rmub(3, 0) + k*rmu(3, 0)**(k-1)*zvb(k) + zvb(k) = 0.0_8 + END DO + temp340b9 = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp340b9 - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp340b9 + distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb0 + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd2b = 0.0_8 + zvb = 0.0_8 + xvb = 0.0_8 + yvb = 0.0_8 END IF - DO ic=3,1,-1 - DO i=0,0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=11,1,-1 + DO k=0,0,-1 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO k=0,0,-1 - temp405 = dd2*r(k)**2 + 1.d0 - temp405b1 = -(distpb(k, 1)/temp405**2) - dd2b = dd2b + r(k)**2*temp405b1 - rb(k) = rb(k) + dd2*2*r(k)*temp405b1 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (108) -! 2s double lorentian with constant parent of 102 -! (dd3+ L(dd2 r^2)+dd4*L(dd5*r^2)) ; L(x)=1/1+x^2 - dd2 = dd(indpar+1) - dd4 = dd(indpar+3) - dd5 = dd(indpar+4) - indorbp = indorb + 1 - DO k=0,0 - distp(k, 1) = 1.d0/(1.d0+dd2*r(k)*r(k)) - distp(k, 2) = 1.d0/(1.d0+dd5*r(k)*r(k)) - END DO -! write(6,*) ' function inside = ',z(indorbp,i) -! endif - IF (typec .NE. 1) THEN - fun = -(2.d0*(dd2*distp(0, 1)**2+dd5*dd4*distp(0, 2)**2)) - fun2b = zb(indorbp, indt+4) - funb = 2.d0*zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp409 = distp(0, 1)**3 - temp409b = 2.d0*(3.d0*(dd2*r(0)**2)-1.d0)*fun2b - temp409b0 = 2.d0*dd2*temp409*3.d0*fun2b - temp408 = distp(0, 2)**3 - temp408b = 2.d0*(3.d0*(dd5*r(0)**2)-1.d0)*fun2b - temp408b0 = 2.d0*dd5*dd4*temp408*3.d0*fun2b - temp408b1 = -(2.d0*funb) - dd2b = distp(0, 1)**2*temp408b1 + r(0)**2*temp409b0 + temp409*& -& temp409b - distpb(0, 1) = dd2*3*distp(0, 1)**2*temp409b - rb(0) = rb(0) + dd5*2*r(0)*temp408b0 + dd2*2*r(0)*temp409b0 - temp408b2 = distp(0, 2)**2*temp408b1 - dd5b = dd4*temp408b2 + r(0)**2*temp408b0 + temp408*dd4*temp408b - dd4b = dd5*temp408b2 + temp408*dd5*temp408b - distpb(0, 2) = dd5*dd4*3*distp(0, 2)**2*temp408b - distpb(0, 1) = distpb(0, 1) + dd2*2*distp(0, 1)*temp408b1 - distpb(0, 2) = distpb(0, 2) + dd5*dd4*2*distp(0, 2)*temp408b1 - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - dd4b = 0.0_8 - dd5b = 0.0_8 - END IF - dd3b = 0.0_8 DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) - dd4b = dd4b + distp(i, 2)*zb(indorbp, i) - distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + temp340b = -(cost6h*distpb(i, 12)) + xvb(2) = xvb(2) + 10.d0*yv(3)*temp340b + yvb(3) = yvb(3) + 10.d0*xv(2)*temp340b + xvb(4) = xvb(4) - 5.d0*yv(1)*temp340b + yvb(1) = yvb(1) - 5.d0*xv(4)*temp340b + yvb(5) = yvb(5) - temp340b + distpb(i, 12) = 0.0_8 + temp340b0 = cost6h*distpb(i, 11) + xvb(5) = xvb(5) + temp340b0 + xvb(3) = xvb(3) - 10.d0*yv(2)*temp340b0 + yvb(2) = yvb(2) - 10.d0*xv(3)*temp340b0 + xvb(1) = xvb(1) + 5.d0*yv(4)*temp340b0 + yvb(4) = yvb(4) + 5.d0*xv(1)*temp340b0 + distpb(i, 11) = 0.0_8 + temp340b1 = cost5h*4.d0*distpb(i, 10) + temp340b2 = zv(1)*temp340b1 + xvb(3) = xvb(3) + yv(1)*temp340b2 + yvb(1) = yvb(1) + xv(3)*temp340b2 + yvb(3) = yvb(3) - xv(1)*temp340b2 + xvb(1) = xvb(1) - yv(3)*temp340b2 + distpb(i, 10) = 0.0_8 + zvb(1) = zvb(1) + cost5h*(xv(4)-6.d0*(xv(2)*yv(2))+yv(4))*distpb(i& +& , 9) + (xv(3)*yv(1)-yv(3)*xv(1))*temp340b1 + temp340b3 = cost5h*zv(1)*distpb(i, 9) + xvb(4) = xvb(4) + temp340b3 + distpb(i, 9) = 0.0_8 + temp340b4 = -(cost4h*cost*distpb(i, 8)) + xvb(2) = xvb(2) - 3.d0*yv(1)*temp340b4 - 6.d0*yv(2)*temp340b3 + yvb(2) = yvb(2) - 6.d0*xv(2)*temp340b3 + yvb(4) = yvb(4) + temp340b3 + yvb(3) = yvb(3) + temp340b4 + yvb(1) = yvb(1) - 3.d0*xv(2)*temp340b4 + costb = -(cost4h*(yv(3)-3.d0*(yv(1)*xv(2)))*distpb(i, 8)) + distpb(i, 8) = 0.0_8 + temp340b5 = cost4h*cost*distpb(i, 7) + xvb(3) = xvb(3) + temp340b5 + costb = costb + cost4h*(xv(3)-3.d0*(xv(1)*yv(2)))*distpb(i, 7) + distpb(i, 7) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp340b6 = cost3h*2.d0*distpb(i, 6) + xvb(1) = xvb(1) + yv(1)*cost*temp340b6 - 3.d0*yv(2)*temp340b5 + yvb(2) = yvb(2) - 3.d0*xv(1)*temp340b5 + zvb(2) = zvb(2) + 9.d0*costb + r2b = -costb + distpb(i, 6) = 0.0_8 + temp340b7 = cost3h*distpb(i, 5) + costb = (xv(2)-yv(2))*temp340b7 + yv(1)*xv(1)*temp340b6 + yvb(1) = yvb(1) + xv(1)*cost*temp340b6 + xvb(2) = xvb(2) + cost*temp340b7 + yvb(2) = yvb(2) - cost*temp340b7 + distpb(i, 5) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + zvb(3) = zvb(3) + 3.d0*costb + zvb(1) = zvb(1) - r2*costb + r2b = r2b - zv(1)*costb + rmub(2, i) = rmub(2, i) + cost2h*cost*distpb(i, 4) + costb = cost2h*rmu(2, i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost2h*cost*distpb(i, 3) + costb = costb + cost2h*rmu(1, i)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + zvb(4) = zvb(4) + 21.d0*costb + zvb(2) = zvb(2) - 14.d0*r2*costb + temp340b8 = cost1h*distpb(i, 2) + r4b = 15.d0*zv(1)*temp340b8 + costb + r2b = r2b + 2*r2*r4b - 70.d0*zv(3)*temp340b8 - 14.d0*zv(2)*costb + zvb(5) = zvb(5) + 63.d0*temp340b8 + zvb(3) = zvb(3) - 70.d0*r2*temp340b8 + zvb(1) = zvb(1) + 15.d0*r4*temp340b8 + distpb(i, 2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,r4) + CALL POPREAL8(adr8ibuf,adr8buf,r2) + xvb(2) = xvb(2) + r2b + yvb(2) = yvb(2) + r2b + zvb(2) = zvb(2) + r2b + DO k=5,1,-1 + CALL POPREAL8(adr8ibuf,adr8buf,xv(k)) + IF (.NOT.(rmu(1, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(1, i) = rmub(1, i) + k*rmu(1, i)**(k-1)*xvb(k) + xvb(k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,yv(k)) + IF (.NOT.(rmu(2, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(2, i) = rmub(2, i) + k*rmu(2, i)**(k-1)*yvb(k) + yvb(k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,zv(k)) + IF (.NOT.(rmu(3, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(3, i) = rmub(3, i) + k*rmu(3, i)**(k-1)*zvb(k) + zvb(k) = 0.0_8 + END DO END DO + dd1b = 0.0_8 + cb = 0.0_8 DO k=0,0,-1 - temp407 = dd5*r(k)**2 + 1.d0 - temp407b = -(distpb(k, 2)/temp407**2) - dd5b = dd5b + r(k)**2*temp407b - distpb(k, 2) = 0.0_8 - temp406 = dd2*r(k)**2 + 1.d0 - temp406b3 = -(distpb(k, 1)/temp406**2) - rb(k) = rb(k) + dd2*2*r(k)*temp406b3 + dd5*2*r(k)*temp407b - dd2b = dd2b + r(k)**2*temp406b3 + temp339 = r(k)**2 + temp339b3 = c*DEXP(-(dd1*temp339))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp339))*distpb(k, 1) + dd1b = dd1b - temp339*temp339b3 + rb(k) = rb(k) - dd1*2*r(k)*temp339b3 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+4) = ddb(indpar+4) + dd5b - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (109) -! 2p double Lorentian -! dd1 * x_mu (L(dd2 r^2)+dd3 * L(dd4*r^2)) ; L(x)=1/(1+x^2) + dd1b = dd1b + 0.79296269381073167718d0*3.25d0*dd1**2.25D0*cb + ddb(indparp) = ddb(indparp) + dd1b + CASE (152) +! 2s gaussian for pseudo +! 2s with cusp condition +! ( r^3*exp(-dd2*r^2)) ! with no cusp condition dd2 = dd(indpar+1) - dd3 = dd(indpar+2) - dd4 = dd(indpar+3) + indorbp = indorb + 1 DO k=0,0 - distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**2) - distp(k, 2) = 1.d0/(1.d0+dd4*r(k)**2) - END DO -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic + distp(k, 1) = DEXP(-(dd2*r(k)**2))*r(k) END DO ! endif IF (typec .NE. 1) THEN - fun = 2.d0*(-(dd2*distp(0, 1)**2)-dd4*dd3*distp(0, 2)**2) -! fun2=2.d0*(dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0,1) -! 1+dd4*dd3*(-1.d0+2.d0*dd4*r(0)**2)*distp(0,2)) - fun2 = 2*dd2*distp(0, 1)**3*(-1.d0+3.d0*dd2*r(0)**2) + 2*dd3*dd4*& -& distp(0, 2)**3*(-1.d0+3.d0*dd4*r(0)**2) -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp414b0 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp414b0 - fun2b = fun2b + temp414b0 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp414b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp414b - funb = funb + rmu(ic, 0)*temp414b - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + rp1 = r(0)**2*dd2 + fun = (3.d0-2.d0*rp1)*distp(0, 1) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp413 = distp(0, 1)**3 - temp413b = 2*(3.d0*(dd2*r(0)**2)-1.d0)*fun2b - temp413b0 = 2*dd2*temp413*3.d0*fun2b - temp412 = distp(0, 2)**3 - temp412b0 = 2*(3.d0*(dd4*r(0)**2)-1.d0)*fun2b - temp412b1 = 2*dd3*dd4*temp412*3.d0*fun2b - temp412b2 = 2.d0*funb - dd2b = r(0)**2*temp413b0 - distp(0, 1)**2*temp412b2 + temp413*& -& temp413b - distpb(0, 1) = dd2*3*distp(0, 1)**2*temp413b - rb(0) = rb(0) + dd4*2*r(0)*temp412b1 + dd2*2*r(0)*temp413b0 - temp412b3 = -(distp(0, 2)**2*temp412b2) - dd3b = dd4*temp412b3 + distp(0, 2)*fun0b + temp412*dd4*temp412b0 - dd4b = dd3*temp412b3 + r(0)**2*temp412b1 + temp412*dd3*temp412b0 - distpb(0, 2) = dd3*dd4*3*distp(0, 2)**2*temp412b0 - distpb(0, 1) = distpb(0, 1) - dd2*2*distp(0, 1)*temp412b2 - distpb(0, 2) = distpb(0, 2) - dd4*dd3*2*distp(0, 2)*temp412b2 - distpb(0, 1) = distpb(0, 1) + fun0b - distpb(0, 2) = distpb(0, 2) + dd3*fun0b + rp1b = (distp(0, 1)*4.d0*2*rp1-distp(0, 1)*14.d0)*fun2b - distp(0& +& , 1)*2.d0*funb0 + distpb(0, 1) = (3.d0-2.d0*rp1)*funb0 + (4.d0*rp1**2-14.d0*rp1+6.d0& +& )*fun2b + rb(0) = rb(0) + dd2*2*r(0)*rp1b + dd2b = r(0)**2*rp1b ELSE distpb = 0.0_8 dd2b = 0.0_8 - dd3b = 0.0_8 - dd4b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=0,0,-1 - temp412b = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& -& indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp412b - dd3b = dd3b + distp(i, 2)*temp412b - distpb(i, 2) = distpb(i, 2) + dd3*temp412b - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + DO i=0,0,-1 + distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO DO k=0,0,-1 - temp411 = dd4*r(k)**2 + 1.d0 - temp411b = -(distpb(k, 2)/temp411**2) - dd4b = dd4b + r(k)**2*temp411b - distpb(k, 2) = 0.0_8 - temp410 = dd2*r(k)**2 + 1.d0 - temp410b = -(distpb(k, 1)/temp410**2) - rb(k) = rb(k) + dd2*2*r(k)*temp410b + dd4*2*r(k)*temp411b - dd2b = dd2b + r(k)**2*temp410b + temp340 = r(k)**2 + temp340b62 = r(k)*DEXP(-(dd2*temp340))*distpb(k, 1) + dd2b = dd2b - temp340*temp340b62 + rb(k) = rb(k) + DEXP(-(dd2*temp340))*distpb(k, 1) - dd2*2*r(k)*& +& temp340b62 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (110) -! 2s without cusp condition -! dd1*( dd3 +1/(1+dd2*r^3)) + CASE (126) +! 2s double exp with constant +! (dd3+ exp (-dd2 r)+dd4*exp(-dd5*r)) dd2 = dd(indpar+1) + dd4 = dd(indpar+3) + dd5 = dd(indpar+4) indorbp = indorb + 1 DO k=0,0 - distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**3) + distp(k, 1) = DEXP(-(dd2*r(k))) + distp(k, 2) = DEXP(-(dd5*r(k))) END DO +! write(6,*) ' function inside = ',z(indorbp,i) ! endif IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)**2*3.d0*r(0)) + fun = -((dd2*distp(0, 1)+dd5*dd4*distp(0, 2))/r(0)) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) - funb = 2.d0*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp415 = r(0)**3 - temp415b = (2.d0-4.d0*(dd2*temp415))*fun2b - temp415b0 = -(fun*distp(0, 1)*4.d0*fun2b) - funb = funb + distp(0, 1)*temp415b - distpb(0, 1) = fun*temp415b - 3.d0*dd2*r(0)*2*distp(0, 1)*funb - temp415b1 = -(3.d0*distp(0, 1)**2*funb) - dd2b = r(0)*temp415b1 + temp415*temp415b0 - rb(0) = rb(0) + dd2*temp415b1 + dd2*3*r(0)**2*temp415b0 + temp341b1 = dd5**2*fun2b + temp341b2 = -(funb0/r(0)) + dd2b = distp(0, 1)*temp341b2 + distp(0, 1)*2*dd2*fun2b + distpb(0, 1) = dd2**2*fun2b + dd5b = distp(0, 2)*dd4*temp341b2 + dd4*distp(0, 2)*2*dd5*fun2b + dd4b = distp(0, 2)*dd5*temp341b2 + distp(0, 2)*temp341b1 + distpb(0, 2) = dd4*temp341b1 + distpb(0, 1) = distpb(0, 1) + dd2*temp341b2 + distpb(0, 2) = distpb(0, 2) + dd5*dd4*temp341b2 + rb(0) = rb(0) - (dd2*distp(0, 1)+dd5*dd4*distp(0, 2))*temp341b2/r(& +& 0) ELSE distpb = 0.0_8 dd2b = 0.0_8 + dd4b = 0.0_8 + dd5b = 0.0_8 END IF dd3b = 0.0_8 DO i=0,0,-1 distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) dd3b = dd3b + zb(indorbp, i) + dd4b = dd4b + distp(i, 2)*zb(indorbp, i) + distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO DO k=0,0,-1 - temp414 = r(k)**3 - temp414b1 = -(distpb(k, 1)/(dd2*temp414+1.d0)**2) - dd2b = dd2b + temp414*temp414b1 - rb(k) = rb(k) + dd2*3*r(k)**2*temp414b1 + temp341b = DEXP(-(dd5*r(k)))*distpb(k, 2) + dd5b = dd5b - r(k)*temp341b + distpb(k, 2) = 0.0_8 + temp341b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd2*temp341b0 - dd5*temp341b + dd2b = dd2b - r(k)*temp341b0 distpb(k, 1) = 0.0_8 END DO + ddb(indpar+4) = ddb(indpar+4) + dd5b + ddb(indpar+3) = ddb(indpar+3) + dd4b ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (111) -! 2p single r_mu/(1+b r^3) parent of 103 + CASE (153) +! 2s with cusp condition +! (-r^5*exp(-dd2*r^2)) ! derivative of 152 dd2 = dd(indpar+1) + indorbp = indorb + 1 DO k=0,0 - distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**3) - END DO -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic + distp(k, 1) = DEXP(-(dd2*r(k)**2))*r(k)**3 END DO ! endif IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)**2*3.d0*r(0)) - fun2 = fun*distp(0, 1)*(2.d0-4.d0*dd2*r(0)**3) -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp418b0 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp418b0 - fun2b = fun2b + temp418b0 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp418b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp418b - funb = funb + rmu(ic, 0)*temp418b - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + rp1 = dd2*r(0)**2 + fun = (-5.d0+2.d0*rp1)*distp(0, 1) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp417 = r(0)**3 - temp417b = (2.d0-4.d0*(dd2*temp417))*fun2b - temp417b0 = -(fun*distp(0, 1)*4.d0*fun2b) - funb = funb + distp(0, 1)*temp417b - distpb(0, 1) = fun0b - 3.d0*dd2*r(0)*2*distp(0, 1)*funb + fun*& -& temp417b - temp417b1 = -(3.d0*distp(0, 1)**2*funb) - dd2b = r(0)*temp417b1 + temp417*temp417b0 - rb(0) = rb(0) + dd2*temp417b1 + dd2*3*r(0)**2*temp417b0 + rp1b = distp(0, 1)*2.d0*funb0 + (distp(0, 1)*22.d0-distp(0, 1)*& +& 4.d0*2*rp1)*fun2b + distpb(0, 1) = (2.d0*rp1-5.d0)*funb0 + (22.d0*rp1-4.d0*rp1**2-& +& 20.d0)*fun2b + dd2b = r(0)**2*rp1b + rb(0) = rb(0) + dd2*2*r(0)*rp1b ELSE distpb = 0.0_8 dd2b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=0,0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + DO i=0,0,-1 + distpb(i, 1) = distpb(i, 1) - r(i)**2*zb(indorbp, i) + rb(i) = rb(i) - distp(i, 1)*2*r(i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO DO k=0,0,-1 - temp416 = r(k)**3 - temp416b = -(distpb(k, 1)/(dd2*temp416+1.d0)**2) - dd2b = dd2b + temp416*temp416b - rb(k) = rb(k) + dd2*3*r(k)**2*temp416b + temp341 = r(k)**2 + temp341b3 = r(k)**3*DEXP(-(dd2*temp341))*distpb(k, 1) + dd2b = dd2b - temp341*temp341b3 + rb(k) = rb(k) + DEXP(-(dd2*temp341))*3*r(k)**2*distpb(k, 1) - dd2*& +& 2*r(k)*temp341b3 distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (112) -! 2p single r_mu/(1+b r)^3 parent of 103 + CASE (121) +! 2p single exponential dd2 = dd(indpar+1) DO k=0,0 - distp(k, 1) = 1.d0/(1.d0+dd2*r(k))**3 + distp(k, 1) = DEXP(-(dd2*r(k))) END DO ! indorbp=indorb DO ic=1,3 @@ -17217,8 +16297,8 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - fun = -(3.d0*dd2*distp(0, 1)/(r(0)*(1.d0+dd2*r(0)))) - fun2 = 12.d0*dd2**2/(1.+dd2*r(0))**5 + fun = -(dd2*distp(0, 1)/r(0)) + fun2 = dd2**2*distp(0, 1) ! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -17232,37 +16312,32 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp422b0 = rmu(ic, 0)*zb(indorbp, indt+4) + temp343b0 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp422b0 - fun2b = fun2b + temp422b0 + funb0 = funb0 + 4.d0*temp343b0 + fun2b = fun2b + temp343b0 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp422b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp422b - funb = funb + rmu(ic, 0)*temp422b + temp343b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp343b + funb0 = funb0 + rmu(ic, 0)*temp343b rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp421 = (dd2*r(0)+1.)**5 - temp421b = 12.d0*fun2b/temp421 - temp421b0 = -(dd2**2*5*(dd2*r(0)+1.)**4*temp421b/temp421) - temp420 = dd2*r(0) + 1.d0 - temp420b = -(3.d0*funb/(r(0)*temp420)) - temp420b0 = -(dd2*distp(0, 1)*temp420b/(r(0)*temp420)) - dd2b = distp(0, 1)*temp420b + r(0)**2*temp420b0 + r(0)*temp421b0 +& -& 2*dd2*temp421b - rb(0) = rb(0) + (r(0)*dd2+temp420)*temp420b0 + dd2*temp421b0 - distpb = 0.0_8 - distpb(0, 1) = fun0b + dd2*temp420b + distpb = 0.0_8 + temp342b0 = -(distp(0, 1)*funb0/r(0)) + dd2b = temp342b0 + distp(0, 1)*2*dd2*fun2b + temp342 = dd2/r(0) + distpb(0, 1) = fun0b - temp342*funb0 + dd2**2*fun2b + rb(0) = rb(0) - temp342*temp342b0 ELSE distpb = 0.0_8 dd2b = 0.0_8 @@ -17276,204 +16351,211 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=0,0,-1 - temp418 = dd2*r(k) + 1.d0 - temp419 = temp418**3 - temp418b1 = -(3*temp418**2*distpb(k, 1)/temp419**2) - dd2b = dd2b + r(k)*temp418b1 - rb(k) = rb(k) + dd2*temp418b1 + temp342b = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp342b + rb(k) = rb(k) - dd2*temp342b distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (113) -! 2s without cusp condition -! dd1*( dd3 +r^2/(1+dd2*r)^4) + CASE (149) +! derivative of 131 with respect z_1 +! - r^4 exp(-z_1 r^2) dd2 = dd(indpar+1) indorbp = indorb + 1 -! endif - IF (typec .NE. 1) THEN - fun = (2.d0-2.d0*dd2*r(0))/(1+dd2*r(0))**5 - fun2b = zb(indorbp, indt+4) - funb = 2.d0*zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - temp425 = (dd2*r(0)+1)**6 - temp425b = 2.d0*fun2b/temp425 - temp425b0 = -((3.d0*(dd2**2*r(0)**2)-6.d0*(dd2*r(0))+1.d0)*6*(dd2*& -& r(0)+1)**5*temp425b/temp425) - temp424 = (dd2*r(0)+1)**5 - temp424b = funb/temp424 - temp424b0 = -((2.d0-2.d0*(dd2*r(0)))*5*(dd2*r(0)+1)**4*temp424b/& -& temp424) - dd2b = r(0)*temp424b0 - 2.d0*r(0)*temp424b + r(0)*temp425b0 + (& -& 3.d0*r(0)**2*2*dd2-6.d0*r(0))*temp425b - rb(0) = rb(0) + dd2*temp424b0 - 2.d0*dd2*temp424b + dd2*temp425b0 & -& + (3.d0*dd2**2*2*r(0)-6.d0*dd2)*temp425b - ELSE - dd2b = 0.0_8 - END IF - distpb = 0.0_8 - dd3b = 0.0_8 - DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=0,0,-1 - temp422 = dd2*r(k) + 1.d0 - temp423 = temp422**4 - temp422b1 = -(r(k)**2*4*temp422**3*distpb(k, 1)/temp423**2) - rb(k) = rb(k) + dd2*temp422b1 + 2*r(k)*distpb(k, 1)/temp423 - dd2b = dd2b + r(k)*temp422b1 - distpb(k, 1) = 0.0_8 + DO k=0,0 + distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) END DO - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (114) -! 2s without cusp condition -! dd1*( dd3 +r^2/(1+dd2*r)^3) - dd2 = dd(indpar+1) - indorbp = indorb + 1 ! endif IF (typec .NE. 1) THEN - fun = (2.d0-dd2*r(0))/(1+dd2*r(0))**4 + fun0 = dd2*r(0)**2 + fun = -(2.d0*r(0)**2*distp(0, 1)*(2.d0-fun0)) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) - funb = 2.d0*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO - temp429 = (dd2*r(0)+1)**5 - temp429b = 2.d0*fun2b/temp429 - temp429b0 = 2*dd2*r(0)*temp429b - temp429b1 = -(((dd2*r(0))**2-4.d0*(dd2*r(0))+1.d0)*5*(dd2*r(0)+1)& -& **4*temp429b/temp429) - temp428 = (dd2*r(0)+1)**4 - temp428b = funb/temp428 - temp428b0 = -((2.d0-dd2*r(0))*4*(dd2*r(0)+1)**3*temp428b/temp428) - dd2b = r(0)*temp428b0 - r(0)*temp428b + r(0)*temp429b1 - 4.d0*r(0)& -& *temp429b + r(0)*temp429b0 - rb(0) = rb(0) + dd2*temp428b0 - dd2*temp428b + dd2*temp429b1 - & -& 4.d0*dd2*temp429b + dd2*temp429b0 + distpb = 0.0_8 + temp343b2 = -(2.d0*(2.d0*fun0**2-9.d0*fun0+6.d0)*fun2b) + temp343b3 = -(2.d0*r(0)**2*distp(0, 1)*fun2b) + temp343b4 = -(2.d0*r(0)**2*funb0) + fun0b = (2.d0*2*fun0-9.d0)*temp343b3 - distp(0, 1)*temp343b4 + rb(0) = rb(0) + dd2*2*r(0)*fun0b - 2.d0*distp(0, 1)*(2.d0-fun0)*2*& +& r(0)*funb0 + distp(0, 1)*2*r(0)*temp343b2 + distpb(0, 1) = (2.d0-fun0)*temp343b4 + r(0)**2*temp343b2 + dd2b = r(0)**2*fun0b ELSE + distpb = 0.0_8 dd2b = 0.0_8 END IF - distpb = 0.0_8 - dd3b = 0.0_8 DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) - r(i)**4*zb(indorbp, i) + rb(i) = rb(i) - distp(i, 1)*4*r(i)**3*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO DO k=0,0,-1 - temp426 = dd2*r(k) + 1.d0 - temp427 = temp426**3 - temp426b = -(r(k)**2*3*temp426**2*distpb(k, 1)/temp427**2) - rb(k) = rb(k) + dd2*temp426b + 2*r(k)*distpb(k, 1)/temp427 - dd2b = dd2b + r(k)*temp426b + temp343b1 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp343b1 + rb(k) = rb(k) - dd2*2*r(k)*temp343b1 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (115) -! 2s double lorentian with constant parent of 102 -! (dd3+ r^2/(1+dd2*r)^3+dd4*r^3/(1+dd5*r)^4; - dd2 = dd(indpar+1) - dd4 = dd(indpar+3) - dd5 = dd(indpar+4) - indorbp = indorb + 1 + CASE (147) +! 3d single gaussian + dd1 = dd(indpar+1) DO k=0,0 - distp(k, 1) = r(k)**2/(1.d0+dd2*r(k))**3 - distp(k, 2) = r(k)**3/(1.d0+dd5*r(k))**4 + distp(k, 1) = DEXP(-(dd1*r(k)**2)) END DO -! write(6,*) ' function inside = ',z(indorbp,i) -! endif + DO i=0,0 + distp(i, 3) = distp(i, 1) + distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d + distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d + distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d + END DO +! indorbp=indorb + DO ic=1,5 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif IF (typec .NE. 1) THEN - fun = (2.d0-dd2*r(0))/(1+dd2*r(0))**4 - dd4*r(0)*(-3.d0+dd5*r(0))/& -& (1.d0+dd5*r(0))**5 - fun2b = zb(indorbp, indt+4) - funb = 2.d0*zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 + fun0 = distp(0, 3) + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = ((2.d0*dd1*r(0))**2-2.d0*dd1)*distp(0, 1) +! indorbp=indorb + DO ic=1,5 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + IF (ic .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + ELSE IF (ic .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (ic .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE IF (ic .EQ. 4) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (ic .EQ. 5) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + END DO + distpb = 0.0_8 + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=5,1,-1 + temp344b5 = distp(0, 3+ic)*zb(indorbp, indt+4) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 6.d0*temp344b5 + fun2b = fun2b + temp344b5 + zb(indorbp, indt+4) = 0.0_8 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + IF (branch .LT. 1) THEN + temp344b0 = cost1d*4.d0*zb(indorbp, indt+3) + rmub(3, 0) = rmub(3, 0) + fun0*temp344b0 + temp344b1 = -(cost1d*2.d0*zb(indorbp, indt+2)) + temp344b2 = -(cost1d*2.d0*zb(indorbp, indt+1)) + fun0b = fun0b + rmu(2, 0)*temp344b1 + rmu(1, 0)*temp344b2 & +& + rmu(3, 0)*temp344b0 + rmub(2, 0) = rmub(2, 0) + fun0*temp344b1 + rmub(1, 0) = rmub(1, 0) + fun0*temp344b2 + ELSE + temp344b3 = -(cost2d*2.d0*zb(indorbp, indt+2)) + rmub(2, 0) = rmub(2, 0) + fun0*temp344b3 + temp344b4 = cost2d*2.d0*zb(indorbp, indt+1) + fun0b = fun0b + rmu(1, 0)*temp344b4 + rmu(2, 0)*temp344b3 + rmub(1, 0) = rmub(1, 0) + fun0*temp344b4 + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+2) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+1) + & +& cost3d*rmu(1, 0)*zb(indorbp, indt+2) + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+1) + END IF + ELSE IF (branch .LT. 5) THEN + IF (branch .LT. 4) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+2) + & +& cost3d*rmu(2, 0)*zb(indorbp, indt+3) + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+2) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+1) + cost3d*& +& rmu(1, 0)*zb(indorbp, indt+3) + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+1) + END IF + DO i=3,1,-1 + temp344b = distp(0, 3+ic)*zb(indorbp, indt+i) + distpb(0, 3+ic) = distpb(0, 3+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp344b + funb0 = funb0 + rmu(i, 0)*temp344b + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp440 = (dd2*r(0)+1)**5 - temp440b = 2.d0*fun2b/temp440 - temp440b0 = 2*dd2*r(0)*temp440b - temp440b1 = -(((dd2*r(0))**2-4.d0*(dd2*r(0))+1.d0)*5*(dd2*r(0)+1)& -& **4*temp440b/temp440) - temp439 = (dd5*r(0)+1.d0)**6 - temp438 = dd4*r(0)/temp439 - temp439b = 2.d0*temp438*fun2b - temp439b0 = 2*dd5*r(0)*temp439b - temp438b = 2.d0*((dd5*r(0))**2-6.d0*(dd5*r(0))+3.d0)*fun2b/temp439 - temp438b0 = -(temp438*6*(dd5*r(0)+1.d0)**5*temp438b) - temp437 = (dd2*r(0)+1)**4 - temp437b = funb/temp437 - temp437b0 = -((2.d0-dd2*r(0))*4*(dd2*r(0)+1)**3*temp437b/temp437) - dd2b = r(0)*temp437b0 - r(0)*temp437b + r(0)*temp440b1 - 4.d0*r(0)& -& *temp440b + r(0)*temp440b0 - temp436 = (dd5*r(0)+1.d0)**5 - temp436b = -(funb/temp436) - temp435 = dd5*r(0) - 3.d0 - temp434 = dd4*r(0) - temp434b = -(temp434*temp435*5*(dd5*r(0)+1.d0)**4*temp436b/temp436& -& ) - rb(0) = rb(0) + dd2*temp437b0 - dd2*temp437b + (temp434*dd5+& -& temp435*dd4)*temp436b + dd5*temp434b + dd5*temp438b0 + dd4*& -& temp438b - 6.d0*dd5*temp439b + dd5*temp439b0 + dd2*temp440b1 - & -& 4.d0*dd2*temp440b + dd2*temp440b0 - dd5b = temp434*r(0)*temp436b + r(0)*temp434b + r(0)*temp438b0 - & -& 6.d0*r(0)*temp439b + r(0)*temp439b0 - dd4b = temp435*r(0)*temp436b + r(0)*temp438b + temp343 = 2.d0*dd1*r(0) + temp343b6 = distp(0, 1)*2*temp343*2.d0*fun2b + dd1b = r(0)*temp343b6 - distp(0, 1)*2.d0*fun2b - 2.d0*distp(0, 1)*& +& funb0 + rb(0) = rb(0) + dd1*temp343b6 + distpb(0, 1) = distpb(0, 1) + (temp343**2-2.d0*dd1)*fun2b - 2.d0*& +& dd1*funb0 + distpb(0, 3) = distpb(0, 3) + fun0b ELSE - dd2b = 0.0_8 - dd4b = 0.0_8 - dd5b = 0.0_8 + distpb = 0.0_8 + dd1b = 0.0_8 END IF - distpb = 0.0_8 - dd3b = 0.0_8 + DO ic=5,1,-1 + DO i=0,0,-1 + distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) - dd4b = dd4b + distp(i, 2)*zb(indorbp, i) - distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + distpb(i, 8) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + distpb(i, 1) = distpb(i, 1) + distpb(i, 3) + distpb(i, 3) = 0.0_8 END DO DO k=0,0,-1 - temp432 = dd5*r(k) + 1.d0 - temp433 = temp432**4 - temp432b = -(r(k)**3*4*temp432**3*distpb(k, 2)/temp433**2) - rb(k) = rb(k) + dd5*temp432b + 3*r(k)**2*distpb(k, 2)/temp433 - dd5b = dd5b + r(k)*temp432b - distpb(k, 2) = 0.0_8 - temp430 = dd2*r(k) + 1.d0 - temp431 = temp430**3 - temp430b = -(r(k)**2*3*temp430**2*distpb(k, 1)/temp431**2) - rb(k) = rb(k) + dd2*temp430b + 2*r(k)*distpb(k, 1)/temp431 - dd2b = dd2b + r(k)*temp430b + temp343b5 = DEXP(-(dd1*r(k)**2))*distpb(k, 1) + dd1b = dd1b - r(k)**2*temp343b5 + rb(k) = rb(k) - dd1*2*r(k)*temp343b5 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+4) = ddb(indpar+4) + dd5b - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (116) -! 2p double Lorentian -! dd1 * x_mu (L^3(dd2 r)+dd3 r * L(dd4*r)^4) ; L(x)=1/(1+x) + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (134) +! 2p single exponential r^3 e^{-z r} ! dd2 = dd(indpar+1) - dd3 = dd(indpar+2) - dd4 = dd(indpar+3) DO k=0,0 - distp(k, 1) = 1.d0/(1.d0+dd2*r(k))**3 - distp(k, 2) = r(k)/(1.d0+dd4*r(k))**4 + distp(k, 1) = DEXP(-(dd2*r(k))) END DO ! indorbp=indorb DO ic=1,3 @@ -17483,14 +16565,10 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - fun = -(3.d0*dd2*distp(0, 1)/(r(0)*(1.d0+dd2*r(0)))) + dd3*distp(0& -& , 2)/r(0)**2*(1.d0-3*dd4*r(0))/(1.d0+dd4*r(0)) - fun2 = 12.d0*dd2**2/(1.+dd2*r(0))**5 + dd3*4.d0*dd4*(-2.d0+3.d0*& -& dd4*r(0))/(1.+dd4*r(0))**6 -! fun0=distp(0,1)+dd3*distp(0,2) -! fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) -! fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) -! 1+2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) + fun = distp(0, 1)*(3.d0-dd2*r(0))*r(0) +! fun= derivative of fun0 respect to r divided dy r + fun2 = distp(0, 1)*(dd2**2*r(0)**3-6*dd2*r(0)**2+6*r(0)) +! fun2= second derivative of fun0 respect to r ! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -17504,222 +16582,62 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp451b0 = rmu(ic, 0)*zb(indorbp, indt+4) + temp345b0 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp451b0 - fun2b = fun2b + temp451b0 + funb0 = funb0 + 4.d0*temp345b0 + fun2b = fun2b + temp345b0 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp451b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp451b - funb = funb + rmu(ic, 0)*temp451b + temp345b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp345b + funb0 = funb0 + rmu(ic, 0)*temp345b rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp450 = (dd2*r(0)+1.)**5 - temp450b = 12.d0*fun2b/temp450 - temp450b0 = -(dd2**2*5*(dd2*r(0)+1.)**4*temp450b/temp450) - temp449 = (dd4*r(0)+1.)**6 - temp448 = 3.d0*dd4*r(0) - 2.d0 - temp448b = 4.d0*fun2b/temp449 - temp448b0 = dd3*dd4*3.d0*temp448b - temp448b1 = -(dd3*dd4*temp448*6*(dd4*r(0)+1.)**5*temp448b/temp449) - temp445 = dd2*r(0) + 1.d0 - temp445b0 = -(3.d0*funb/(r(0)*temp445)) - temp445b1 = -(dd2*distp(0, 1)*temp445b0/(r(0)*temp445)) - dd2b = distp(0, 1)*temp445b0 + r(0)**2*temp445b1 + r(0)*temp450b0 & -& + 2*dd2*temp450b - temp446 = r(0)**2*(dd4*r(0)+1.d0) - temp448b2 = funb/temp446 - temp447 = (-3)*(dd4*r(0)) + 1.d0 - temp447b = -(dd3*distp(0, 2)*3*temp448b2) - temp446b = -(dd3*distp(0, 2)*temp447*temp448b2/temp446) - temp446b0 = r(0)**2*temp446b - rb(0) = rb(0) + dd4*temp447b + (dd4*r(0)+1.d0)*2*r(0)*temp446b + & -& dd4*temp446b0 + (r(0)*dd2+temp445)*temp445b1 + dd4*temp448b1 + & -& dd4*temp448b0 + dd2*temp450b0 - dd3b = temp447*distp(0, 2)*temp448b2 + distp(0, 2)*fun0b + temp448& -& *dd4*temp448b - dd4b = r(0)*temp447b + r(0)*temp446b0 + r(0)*temp448b1 + r(0)*& -& temp448b0 + temp448*dd3*temp448b - distpb = 0.0_8 - distpb(0, 2) = temp447*dd3*temp448b2 - distpb(0, 1) = fun0b + dd2*temp445b0 - distpb(0, 2) = distpb(0, 2) + dd3*fun0b + distpb = 0.0_8 + temp344 = r(0)**3 + temp344b8 = distp(0, 1)*fun2b + temp344b9 = (3.d0-dd2*r(0))*funb0 + distpb(0, 1) = r(0)*temp344b9 + r(0)**3*fun0b + (dd2**2*temp344-6*& +& (dd2*r(0)**2)+6*r(0))*fun2b + temp344b10 = distp(0, 1)*r(0)*funb0 + dd2b = (temp344*2*dd2-6*r(0)**2)*temp344b8 - r(0)*temp344b10 + rb(0) = rb(0) + distp(0, 1)*temp344b9 - dd2*temp344b10 + distp(0, & +& 1)*3*r(0)**2*fun0b + (dd2**2*3*r(0)**2-6*dd2*2*r(0)+6)*temp344b8 ELSE distpb = 0.0_8 dd2b = 0.0_8 - dd3b = 0.0_8 - dd4b = 0.0_8 END IF DO ic=3,1,-1 DO i=0,0,-1 - temp445b = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& -& indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp445b - dd3b = dd3b + distp(i, 2)*temp445b - distpb(i, 2) = distpb(i, 2) + dd3*temp445b + temp344b7 = r(i)**3*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp344b7 + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp344b7 + rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*3*r(i)**2*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=0,0,-1 - temp443 = dd4*r(k) + 1.d0 - temp444 = temp443**4 - temp443b = -(r(k)*4*temp443**3*distpb(k, 2)/temp444**2) - rb(k) = rb(k) + dd4*temp443b + distpb(k, 2)/temp444 - dd4b = dd4b + r(k)*temp443b - distpb(k, 2) = 0.0_8 - temp441 = dd2*r(k) + 1.d0 - temp442 = temp441**3 - temp441b = -(3*temp441**2*distpb(k, 1)/temp442**2) - dd2b = dd2b + r(k)*temp441b - rb(k) = rb(k) + dd2*temp441b + temp344b6 = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp344b6 + rb(k) = rb(k) - dd2*temp344b6 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (117) -! 2s double lorentian with constant parent of 102 -! (dd3+r^3/(1+dd5*r)^4; - dd5 = dd(indpar+2) - indorbp = indorb + 1 -! write(6,*) ' function inside = ',z(indorbp,i) -! endif - IF (typec .NE. 1) THEN - fun = -(r(0)*(-3.d0+dd5*r(0))/(1.d0+dd5*r(0))**5) - fun2b = zb(indorbp, indt+4) - funb = 2.d0*zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - temp455 = (dd5*r(0)+1.d0)**6 - temp454 = r(0)/temp455 - temp455b = 2.d0*temp454*fun2b - temp455b0 = 2*dd5*r(0)*temp455b - temp454b = 2.d0*((dd5*r(0))**2-6.d0*(dd5*r(0))+3.d0)*fun2b/temp455 - temp454b0 = -(temp454*6*(dd5*r(0)+1.d0)**5*temp454b) - temp453 = (dd5*r(0)+1.d0)**5 - temp453b = -(funb/temp453) - temp453b0 = -(r(0)*(dd5*r(0)-3.d0)*5*(dd5*r(0)+1.d0)**4*temp453b/& -& temp453) - dd5b = r(0)**2*temp453b + r(0)*temp453b0 + r(0)*temp454b0 - 6.d0*r& -& (0)*temp455b + r(0)*temp455b0 - rb(0) = rb(0) + (r(0)*dd5+dd5*r(0)-3.d0)*temp453b + dd5*temp453b0 & -& + dd5*temp454b0 + temp454b - 6.d0*dd5*temp455b + dd5*temp455b0 - ELSE - dd5b = 0.0_8 - END IF - distpb = 0.0_8 - dd3b = 0.0_8 - DO i=0,0,-1 - dd3b = dd3b + zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=0,0,-1 - temp451 = dd5*r(k) + 1.d0 - temp452 = temp451**4 - temp451b1 = -(r(k)**3*4*temp451**3*distpb(k, 1)/temp452**2) - rb(k) = rb(k) + dd5*temp451b1 + 3*r(k)**2*distpb(k, 1)/temp452 - dd5b = dd5b + r(k)*temp451b1 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+2) = ddb(indpar+2) + dd5b - ddb(indpar+1) = ddb(indpar+1) + dd3b - CASE (118) -! 2s double lorentian with constant parent of 102 -! (dd1+ 1/ (1 + Exp[ dd2 (r^2 - r_0^2) ] ) | dd3=r_0 -! Fermi distribution with r^2 - dd2 = dd(indpar+2) - dd3 = -(dd2*dd(indpar+3)**2) - indorbp = indorb + 1 - DO k=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,arg) - arg = dd2*r(k)**2 + dd3 - IF (arg .GT. 200) THEN - distp(k, 1) = DEXP(200.d0) - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - distp(k, 1) = DEXP(arg) - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF - END DO -! write(6,*) ' function inside = ',z(indorbp,i) -! endif - IF (typec .NE. 1) THEN - fun = -(2.d0*dd2*distp(0, 1)/(1.d0+distp(0, 1))**2) - fun2b = zb(indorbp, indt+4) - funb = 2.d0*zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp458 = (distp(0, 1)+1.d0)**3 - temp457 = -(2.d0*dd2*r(0)**2) - 1.d0 - temp456 = -(2.d0*dd2*r(0)**2) + 1.d0 - temp456b = -(2.d0*dd2*fun2b/temp458) - temp456b0 = -(distp(0, 1)**2*2.d0*temp456b) - temp456b1 = distp(0, 1)*2.d0*temp456b - temp456b2 = -(2.d0*(distp(0, 1)**2*temp456-distp(0, 1)*temp457)*& -& fun2b/temp458) - temp456b3 = -(2.d0*funb/(distp(0, 1)+1.d0)**2) - distpb(0, 1) = (dd2-dd2*distp(0, 1)*2/(distp(0, 1)+1.d0))*& -& temp456b3 - dd2*3*(distp(0, 1)+1.d0)**2*temp456b2/temp458 + (& -& temp456*2*distp(0, 1)-temp457)*temp456b - dd2b = distp(0, 1)*temp456b3 + temp456b2 + r(0)**2*temp456b1 + r(0& -& )**2*temp456b0 - rb(0) = rb(0) + dd2*2*r(0)*temp456b1 + dd2*2*r(0)*temp456b0 - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - dd1b = 0.0_8 - DO i=0,0,-1 - dd1b = dd1b + zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) - zb(indorbp, i)/(distp(i, 1)+1.d0)**2 - zb(indorbp, i) = 0.0_8 - END DO - dd3b = 0.0_8 - DO k=0,0,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 2) THEN - distpb(k, 1) = 0.0_8 - argb = 0.0_8 - ELSE - argb = DEXP(arg)*distpb(k, 1) - distpb(k, 1) = 0.0_8 - END IF - CALL POPREAL8(adr8ibuf,adr8buf,arg) - dd2b = dd2b + r(k)**2*argb - rb(k) = rb(k) + dd2*2*r(k)*argb - dd3b = dd3b + argb - END DO - dd2b = dd2b - dd(indpar+3)**2*dd3b - ddb(indpar+3) = ddb(indpar+3) - dd2*2*dd(indpar+3)*dd3b - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (119) -! 2p single r_mu/(1+b r^2)^(3/2) parent of 103 + CASE (146) +! 2p single exponential -r^2 e^{-z r^2} ! derivative of 103 dd2 = dd(indpar+1) DO k=0,0 - distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**2)**1.5d0 + distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) END DO ! indorbp=indorb DO ic=1,3 @@ -17729,8 +16647,9 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - fun = -(3.d0*dd2*distp(0, 1)/(1.d0+dd2*r(0)**2)) - fun2 = 3.d0*dd2*(-1.d0+4.d0*dd2*r(0)**2)/(1.d0+dd2*r(0)**2)**3.5d0 + rp2 = dd2*r(0)*r(0) + fun = distp(0, 1)*(-2.d0+2.d0*rp2) + fun2 = (-2.d0+10.d0*rp2-4.d0*rp2*rp2)*distp(0, 1) ! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -17744,71 +16663,71 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp465b0 = rmu(ic, 0)*zb(indorbp, indt+4) + temp345b4 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp465b0 - fun2b = fun2b + temp465b0 + funb0 = funb0 + 4.d0*temp345b4 + fun2b = fun2b + temp345b4 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp465b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp465b - funb = funb + rmu(ic, 0)*temp465b + temp345b3 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp345b3 + funb0 = funb0 + rmu(ic, 0)*temp345b3 rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp462 = dd2*r(0)**2 + 1.d0 - temp464 = temp462**3.5d0 - temp463 = 4.d0*dd2*r(0)**2 - 1.d0 - temp463b = 3.d0*fun2b/temp464 - temp463b0 = dd2*4.d0*temp463b - temp462b = -(dd2*temp463*3.5d0*temp462**2.5D0*temp463b/temp464) - temp461 = dd2*r(0)**2 + 1.d0 - temp462b0 = -(3.d0*funb/temp461) - temp461b = -(dd2*distp(0, 1)*temp462b0/temp461) - dd2b = distp(0, 1)*temp462b0 + r(0)**2*temp461b + r(0)**2*temp462b& -& + r(0)**2*temp463b0 + temp463*temp463b - rb(0) = rb(0) + dd2*2*r(0)*temp461b + dd2*2*r(0)*temp462b + dd2*2*& -& r(0)*temp463b0 - distpb = 0.0_8 - distpb(0, 1) = fun0b + dd2*temp462b0 + distpb = 0.0_8 + rp2b = distp(0, 1)*2.d0*funb0 + (distp(0, 1)*10.d0-distp(0, 1)*& +& 4.d0*2*rp2)*fun2b + distpb(0, 1) = (2.d0*rp2-2.d0)*funb0 - r(0)**2*fun0b + (10.d0*rp2-& +& 4.d0*rp2**2-2.d0)*fun2b + rb(0) = rb(0) + dd2*2*r(0)*rp2b - distp(0, 1)*2*r(0)*fun0b + dd2b = r(0)**2*rp2b ELSE distpb = 0.0_8 dd2b = 0.0_8 END IF DO ic=3,1,-1 DO i=0,0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + temp345b2 = -(r(i)**2*zb(indorbp, i)) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp345b2 + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp345b2 + rb(i) = rb(i) - rmu(ic, i)*distp(i, 1)*2*r(i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=0,0,-1 - temp459 = dd2*r(k)**2 + 1.d0 - temp460 = temp459**1.5d0 - temp459b = -(1.5d0*temp459**0.5D0*distpb(k, 1)/temp460**2) - dd2b = dd2b + r(k)**2*temp459b - rb(k) = rb(k) + dd2*2*r(k)*temp459b + temp345b1 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp345b1 + rb(k) = rb(k) - dd2*2*r(k)*temp345b1 distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (120) -! 2p double cubic -! dd1 * x_mu (L^3(dd2 r)+dd3 L(dd4*r)^3) ; L(x)=1/(1+x) - dd2 = dd(indpar+1) - dd3 = dd(indpar+2) - dd4 = dd(indpar+3) + CASE (25) +! 4p without cusp condition +! r^2 ( e^{-z2 r } + z1 e^{-z3 r } ) + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + dd3 = dd(indpar+3) +! if(iflagnorm.gt.2) then + c = 1.d0/2.d0/DSQRT(120960.d0*pi*(1.d0/(2.d0*dd1)**9+2.d0*dd3/(dd1+& +& dd2)**9+dd3**2/(2.d0*dd2)**9)) +! endif DO k=0,0 - distp(k, 1) = 1.d0/(1.d0+dd2*r(k))**3 - distp(k, 2) = 1.d0/(1.d0+dd4*r(k))**3 + distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 2) = c*DEXP(-(dd2*r(k))) + END DO + DO i=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = r(i)**2*(distp(i, 1)+dd3*distp(i, 2)) END DO ! indorbp=indorb DO ic=1,3 @@ -17818,18 +16737,14 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - fun = -(3.d0*dd2*distp(0, 1)/(r(0)*(1.d0+dd2*r(0)))) - 3.d0*dd4*& -& dd3*distp(0, 2)/(r(0)*(1.d0+dd4*r(0))) - fun2 = 12.d0*dd2**2/(1.+dd2*r(0))**5 + 12.d0*dd3*dd4**2/(1.+dd4*r(& -& 0))**5 -! fun0=distp(0,1)+dd3*distp(0,2) -! fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) -! fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) -! 1+2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) + fun = (2.d0*r(0)-dd1*r(0)**2)*distp(0, 1) + dd3*(2.d0*r(0)-dd2*r(0& +& )**2)*distp(0, 2) + fun2 = ((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))*distp(0, 1) + dd3*((dd2*& +& r(0))**2+2.d0-4.d0*dd2*r(0))*distp(0, 2) ! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -17839,213 +16754,471 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp473b0 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp473b0 - fun2b = fun2b + temp473b0 + temp354 = fun/r(0) + temp355b = rmu(ic, 0)*zb(indorbp, indt+4) + temp354b = 4.d0*temp355b/r(0) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp354+fun2)*zb(indorbp, indt& +& +4) + funb0 = funb0 + temp354b + rb(0) = rb(0) - temp354*temp354b + fun2b = fun2b + temp355b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp473b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp473b - funb = funb + rmu(ic, 0)*temp473b - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + temp353 = fun/r(0) + temp353b10 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(ic, 0) = rmub(ic, 0) + temp353*rmu(i, 0)*zb(indorbp, indt& +& +i) + rmub(i, 0) = rmub(i, 0) + temp353*rmu(ic, 0)*zb(indorbp, indt+& +& i) + funb0 = funb0 + temp353b10 + rb(0) = rb(0) - temp353*temp353b10 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp472 = (dd2*r(0)+1.)**5 - temp472b = 12.d0*fun2b/temp472 - temp472b0 = -(dd2**2*5*(dd2*r(0)+1.)**4*temp472b/temp472) - temp471 = (dd4*r(0)+1.)**5 - temp471b = 12.d0*fun2b/temp471 - temp471b0 = -(dd3*dd4**2*5*(dd4*r(0)+1.)**4*temp471b/temp471) - temp470 = dd2*r(0) + 1.d0 - temp470b = -(3.d0*funb/(r(0)*temp470)) - temp470b0 = -(dd2*distp(0, 1)*temp470b/(r(0)*temp470)) - dd2b = distp(0, 1)*temp470b + r(0)**2*temp470b0 + r(0)*temp472b0 +& -& 2*dd2*temp472b - temp469 = dd4*r(0) + 1.d0 - temp469b0 = -(3.d0*funb/(r(0)*temp469)) - temp469b1 = -(dd4*dd3*distp(0, 2)*temp469b0/(r(0)*temp469)) - rb(0) = rb(0) + (r(0)*dd2+temp470)*temp470b0 + (r(0)*dd4+temp469)*& -& temp469b1 + dd4*temp471b0 + dd2*temp472b0 - dd3b = distp(0, 2)*dd4*temp469b0 + distp(0, 2)*fun0b + dd4**2*& -& temp471b - dd4b = distp(0, 2)*dd3*temp469b0 + r(0)**2*temp469b1 + r(0)*& -& temp471b0 + dd3*2*dd4*temp471b - distpb = 0.0_8 - distpb(0, 1) = dd2*temp470b - distpb(0, 2) = dd4*dd3*temp469b0 - distpb(0, 1) = distpb(0, 1) + fun0b - distpb(0, 2) = distpb(0, 2) + dd3*fun0b + distpb = 0.0_8 + temp353b2 = distp(0, 1)*fun2b + temp353b3 = 2*dd1*r(0)*temp353b2 + temp353b4 = dd3*distp(0, 2)*fun2b + temp353b5 = 2*dd2*r(0)*temp353b4 + temp353b6 = ((dd2*r(0))**2-4.d0*(dd2*r(0))+2.d0)*fun2b + temp353b7 = distp(0, 1)*funb0 + dd1b = r(0)*temp353b3 - 4.d0*r(0)*temp353b2 - r(0)**2*temp353b7 + temp353b8 = dd3*distp(0, 2)*funb0 + rb(0) = rb(0) + (2.d0-dd1*2*r(0))*temp353b7 + (2.d0-dd2*2*r(0))*& +& temp353b8 - 4.d0*dd2*temp353b4 + dd2*temp353b5 - 4.d0*dd1*& +& temp353b2 + dd1*temp353b3 + distpb(0, 1) = ((dd1*r(0))**2-4.d0*(dd1*r(0))+2.d0)*fun2b + dd2b = r(0)*temp353b5 - 4.d0*r(0)*temp353b4 - r(0)**2*temp353b8 + temp353b9 = (2.d0*r(0)-dd2*r(0)**2)*funb0 + dd3b = distp(0, 2)*temp353b9 + distp(0, 2)*temp353b6 + distpb(0, 2) = dd3*temp353b6 + distpb(0, 1) = distpb(0, 1) + (2.d0*r(0)-dd1*r(0)**2)*funb0 + distpb(0, 2) = distpb(0, 2) + dd3*temp353b9 + distpb(0, 3) = distpb(0, 3) + fun0b ELSE distpb = 0.0_8 + dd1b = 0.0_8 dd2b = 0.0_8 dd3b = 0.0_8 - dd4b = 0.0_8 END IF DO ic=3,1,-1 DO i=0,0,-1 - temp469b = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& -& indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp469b - dd3b = dd3b + distp(i, 2)*temp469b - distpb(i, 2) = distpb(i, 2) + dd3*temp469b + rmub(ic, i) = rmub(ic, i) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + rmu(ic, i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + DO i=0,0,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + temp353b1 = r(i)**2*distpb(i, 3) + rb(i) = rb(i) + (distp(i, 1)+dd3*distp(i, 2))*2*r(i)*distpb(i, 3) + distpb(i, 1) = distpb(i, 1) + temp353b1 + dd3b = dd3b + distp(i, 2)*temp353b1 + distpb(i, 2) = distpb(i, 2) + dd3*temp353b1 + distpb(i, 3) = 0.0_8 + END DO + cb = 0.0_8 DO k=0,0,-1 - temp467 = dd4*r(k) + 1.d0 - temp468 = temp467**3 - temp467b = -(3*temp467**2*distpb(k, 2)/temp468**2) - dd4b = dd4b + r(k)*temp467b + temp353b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp353b distpb(k, 2) = 0.0_8 - temp465 = dd2*r(k) + 1.d0 - temp466 = temp465**3 - temp465b1 = -(3*temp465**2*distpb(k, 1)/temp466**2) - rb(k) = rb(k) + dd2*temp465b1 + dd4*temp467b - dd2b = dd2b + r(k)*temp465b1 + temp353b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp353b0 - dd2*temp353b + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp353b0 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (121) -! 2p single exponential - dd2 = dd(indpar+1) + temp352 = 2.d0**9 + temp351 = temp352*dd2**9 + temp350 = dd3**2/temp351 + temp349 = (dd1+dd2)**9 + temp348 = 2.d0**9 + temp347 = temp348*dd1**9 + temp346 = 120960.d0*pi*(1.0/temp347+2.d0*dd3/temp349+temp350) + temp345 = DSQRT(temp346) + IF (temp346 .EQ. 0.0) THEN + temp345b5 = 0.0 + ELSE + temp345b5 = -(pi*120960.d0*cb/(2.d0*temp345**2*2.D0*DSQRT(temp346)& +& )) + END IF + temp345b6 = 2.d0*temp345b5/temp349 + temp345b7 = -(dd3*9*(dd1+dd2)**8*temp345b6/temp349) + dd1b = dd1b + temp345b7 - temp348*9*dd1**8*temp345b5/temp347**2 + dd3b = dd3b + 2*dd3*temp345b5/temp351 + temp345b6 + dd2b = dd2b + temp345b7 - temp350*temp352*9*dd2**8*temp345b5/temp351 + ddb(indpar+3) = ddb(indpar+3) + dd3b + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (32) +! 2p triple zeta +! 3d without cusp condition triple Z + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd(indpar+3) + dd3 = dd(indpar+4) + peff2 = dd(indpar+5) +! if(iflagnorm.gt.2) then + c = 1/2.d0*DSQRT(5.d0/pi)/DSQRT(1/(2.d0*dd1)**7+2*peff/(dd1+dd2)**7+& +& peff**2/(2.d0*dd2)**7+2*peff2/(dd1+dd3)**7+peff2**2/(2.d0*dd3)**7+& +& 2*peff*peff2/(dd2+dd3)**7)/DSQRT(720.d0) +! endif DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k))) + distp(k, 1) = DEXP(-(dd1*r(k))) + distp(k, 2) = DEXP(-(dd2*r(k))) + distp(k, 3) = DEXP(-(dd3*r(k))) + END DO + DO i=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) + distp(i, 4) = c*(distp(i, 1)+peff*distp(i, 2)+peff2*distp(i, 3)) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) +!lz=0 + distp(i, 5) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) +!lz=+/-2 + distp(i, 6) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) +! lz=+/- 2 + distp(i, 7) = rmu(1, i)*rmu(2, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) +! lz=+/-1 + distp(i, 8) = rmu(2, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 9)) +! lz=+/-1 + distp(i, 9) = rmu(1, i)*rmu(3, i)*cost3d END DO ! indorbp=indorb - DO ic=1,3 + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO ! endif IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)/r(0)) - fun2 = dd2**2*distp(0, 1) + fun0 = distp(0, 4) + fun = c*(-(dd1*distp(0, 1))-peff*dd2*distp(0, 2)-peff2*dd3*distp(0& +& , 3)) + fun2 = c*(dd1**2*distp(0, 1)+peff*dd2**2*distp(0, 2)+peff2*dd3**2*& +& distp(0, 3)) ! indorbp=indorb - DO ic=1,3 + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + IF (ic .EQ. 1) THEN + IF (i .NE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO END DO - funb = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=3,1,-1 - temp474b0 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp474b0 - fun2b = fun2b + temp474b0 + DO ic=5,1,-1 + temp371 = fun/r(0) + temp372b = distp(0, 4+ic)*zb(indorbp, indt+4) + temp371b3 = 6.d0*temp372b/r(0) + distpb(0, 4+ic) = distpb(0, 4+ic) + (6.d0*temp371+fun2)*zb(& +& indorbp, indt+4) + funb0 = funb0 + temp371b3 + rb(0) = rb(0) - temp371*temp371b3 + fun2b = fun2b + temp372b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp474b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp474b - funb = funb + rmu(ic, 0)*temp474b - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp371b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp371b + fun0b = fun0b + rmu(i, 0)*temp371b + ELSE + temp371b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp371b0 + fun0b = fun0b + rmu(i, 0)*temp371b0 + END IF + ELSE IF (branch .LT. 4) THEN + temp371b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp371b1 + fun0b = fun0b + rmu(i, 0)*temp371b1 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp371b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp371b2 + fun0b = fun0b + rmu(i, 0)*temp371b2 + ELSE + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + temp370 = fun/r(0) + temp370b7 = distp(0, 4+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 4+ic) = distpb(0, 4+ic) + temp370*rmu(i, 0)*zb(& +& indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp370*distp(0, 4+ic)*zb(indorbp, & +& indt+i) + funb0 = funb0 + temp370b7 + rb(0) = rb(0) - temp370*temp370b7 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp473b2 = -(distp(0, 1)*funb/r(0)) - dd2b = temp473b2 + distp(0, 1)*2*dd2*fun2b - temp473 = dd2/r(0) - distpb(0, 1) = fun0b - temp473*funb + dd2**2*fun2b - rb(0) = rb(0) - temp473*temp473b2 + temp370b3 = c*fun2b + temp370b4 = dd2**2*temp370b3 + temp370b5 = dd3**2*temp370b3 + cb = (-(dd1*distp(0, 1))-peff*dd2*distp(0, 2)-peff2*dd3*distp(0, 3& +& ))*funb0 + (dd1**2*distp(0, 1)+dd2**2*(peff*distp(0, 2))+dd3**2*& +& (peff2*distp(0, 3)))*fun2b + temp370b6 = c*funb0 + dd1b = distp(0, 1)*2*dd1*temp370b3 - distp(0, 1)*temp370b6 + distpb(0, 1) = distpb(0, 1) + dd1**2*temp370b3 + dd2b = peff*distp(0, 2)*2*dd2*temp370b3 - distp(0, 2)*peff*& +& temp370b6 + peffb = distp(0, 2)*temp370b4 - distp(0, 2)*dd2*temp370b6 + distpb(0, 2) = distpb(0, 2) + peff*temp370b4 + dd3b = peff2*distp(0, 3)*2*dd3*temp370b3 - distp(0, 3)*peff2*& +& temp370b6 + peff2b = distp(0, 3)*temp370b5 - distp(0, 3)*dd3*temp370b6 + distpb(0, 3) = distpb(0, 3) + peff2*temp370b5 + distpb(0, 1) = distpb(0, 1) - dd1*temp370b6 + distpb(0, 2) = distpb(0, 2) - peff*dd2*temp370b6 + distpb(0, 3) = distpb(0, 3) - peff2*dd3*temp370b6 + distpb(0, 4) = distpb(0, 4) + fun0b ELSE distpb = 0.0_8 + peffb = 0.0_8 + dd1b = 0.0_8 dd2b = 0.0_8 + dd3b = 0.0_8 + peff2b = 0.0_8 + cb = 0.0_8 END IF - DO ic=3,1,-1 + DO ic=5,1,-1 DO i=0,0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + distpb(i, 4+ic) = distpb(i, 4+ic) + distp(i, 4)*zb(indorbp, i) + distpb(i, 4) = distpb(i, 4) + distp(i, 4+ic)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + DO i=0,0,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 9)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 9) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 9) + distpb(i, 9) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 8) + distpb(i, 8) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 7) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 5) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) + temp370b2 = c*distpb(i, 4) + cb = cb + (distp(i, 1)+peff*distp(i, 2)+peff2*distp(i, 3))*distpb(& +& i, 4) + distpb(i, 1) = distpb(i, 1) + temp370b2 + peffb = peffb + distp(i, 2)*temp370b2 + distpb(i, 2) = distpb(i, 2) + peff*temp370b2 + peff2b = peff2b + distp(i, 3)*temp370b2 + distpb(i, 3) = distpb(i, 3) + peff2*temp370b2 + distpb(i, 4) = 0.0_8 + END DO DO k=0,0,-1 - temp473b1 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp473b1 - rb(k) = rb(k) - dd2*temp473b1 + temp370b = DEXP(-(dd3*r(k)))*distpb(k, 3) + dd3b = dd3b - r(k)*temp370b + distpb(k, 3) = 0.0_8 + temp370b0 = DEXP(-(dd2*r(k)))*distpb(k, 2) + distpb(k, 2) = 0.0_8 + temp370b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd2*temp370b0 - dd1*temp370b1 - dd3*temp370b + dd2b = dd2b - r(k)*temp370b0 + dd1b = dd1b - r(k)*temp370b1 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (122) -! 2s with cusp condition -! dd1*( dd3 +exp(-dd2*r)*(1+dd2*r)) + temp369 = (dd2+dd3)**7 + temp355 = peff*peff2/temp369 + temp368 = 2.d0**7 + temp367 = temp368*dd3**7 + temp366 = peff2**2/temp367 + temp365 = (dd1+dd3)**7 + temp364 = 2.d0**7 + temp363 = temp364*dd2**7 + temp362 = peff**2/temp363 + temp361 = (dd1+dd2)**7 + temp360 = 2.d0**7 + temp359 = temp360*dd1**7 + temp356 = 1.0/temp359 + 2*(peff/temp361) + temp362 + 2*(peff2/& +& temp365) + temp366 + 2*temp355 + temp358 = DSQRT(temp356) + temp357 = 2.d0*DSQRT(720.d0) + IF (temp356 .EQ. 0.0) THEN + temp356b = 0.0 + ELSE + temp356b = -(DSQRT(5.d0/pi)*cb/(temp357*temp358**2*2.D0*DSQRT(& +& temp356))) + END IF + temp356b0 = 2*temp356b/temp361 + temp356b1 = -(peff*7*(dd1+dd2)**6*temp356b0/temp361) + temp356b2 = 2*temp356b/temp365 + temp356b3 = -(peff2*7*(dd1+dd3)**6*temp356b2/temp365) + temp355b0 = 2*temp356b/temp369 + temp355b1 = -(temp355*7*(dd2+dd3)**6*temp355b0) + dd1b = dd1b + temp356b3 + temp356b1 - temp360*7*dd1**6*temp356b/& +& temp359**2 + peffb = peffb + peff2*temp355b0 + 2*peff*temp356b/temp363 + & +& temp356b0 + dd2b = dd2b + temp355b1 - temp362*temp364*7*dd2**6*temp356b/temp363 & +& + temp356b1 + peff2b = peff2b + peff*temp355b0 + 2*peff2*temp356b/temp367 + & +& temp356b2 + dd3b = dd3b + temp355b1 - temp366*temp368*7*dd3**6*temp356b/temp367 & +& + temp356b3 + ddb(indpar+5) = ddb(indpar+5) + peff2b + ddb(indpar+4) = ddb(indpar+4) + dd3b + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (145) +! 2s without cusp condition !derivative 100 +! -(r^2*exp(-dd2*r^2)) dd2 = dd(indpar+1) indorbp = indorb + 1 DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k))) + distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) END DO ! endif IF (typec .NE. 1) THEN - fun = -(dd2**2*distp(0, 1)) - funb = 2.d0*zb(indorbp, indt+4) + fun0 = dd2*r(0)**2 + fun = -(2.d0*distp(0, 1)*(1.d0-fun0)) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO - funb = funb + (1.d0-dd2*r(0))*fun2b - dd2b = -(distp(0, 1)*2*dd2*funb) - fun*r(0)*fun2b - rb(0) = rb(0) - fun*dd2*fun2b distpb = 0.0_8 - distpb(0, 1) = -(dd2**2*funb) + temp372b1 = -(2.d0*distp(0, 1)*fun2b) + distpb(0, 1) = -(2.d0*(1.d0-fun0)*funb0) - 2.d0*(2.d0*fun0**2-5.d0& +& *fun0+1.d0)*fun2b + fun0b = 2.d0*distp(0, 1)*funb0 + (2.d0*2*fun0-5.d0)*temp372b1 + dd2b = r(0)**2*fun0b + rb(0) = rb(0) + dd2*2*r(0)*fun0b ELSE distpb = 0.0_8 dd2b = 0.0_8 END IF - dd3b = 0.0_8 DO i=0,0,-1 - temp474b2 = distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + (dd2*r(i)+1.d0)*zb(indorbp, i) - dd2b = dd2b + r(i)*temp474b2 - rb(i) = rb(i) + dd2*temp474b2 - dd3b = dd3b + zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) - r(i)**2*zb(indorbp, i) + rb(i) = rb(i) - distp(i, 1)*2*r(i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO DO k=0,0,-1 - temp474b1 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp474b1 - rb(k) = rb(k) - dd2*temp474b1 + temp372b0 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp372b0 + rb(k) = rb(k) - dd2*2*r(k)*temp372b0 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (123) -! 2p double exp -! dd1 * x_mu (exp(-dd2 r)+dd3 * exp(-dd4*r)) - dd2 = dd(indpar+1) - dd3 = dd(indpar+2) - dd4 = dd(indpar+3) + CASE (21) +! 2p without cusp condition + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd(indpar+3) + c = 0.5d0/DSQRT(8.d0*pi*(1.d0/(2.d0*dd1)**5+2.d0*peff/(dd1+dd2)**5+& +& peff**2/(2.d0*dd2)**5)) DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k))) - distp(k, 2) = DEXP(-(dd4*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 2) = c*DEXP(-(dd2*r(k))) + END DO + DO i=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = distp(i, 1) + peff*distp(i, 2) END DO ! indorbp=indorb DO ic=1,3 @@ -18055,12 +17228,12 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - fun = -((dd2*distp(0, 1)+dd3*dd4*distp(0, 2))/r(0)) - fun2 = dd2**2*distp(0, 1) + dd3*dd4**2*distp(0, 2) + fun = (-(dd1*distp(0, 1))-dd2*peff*distp(0, 2))/r(0) + fun2 = dd1**2*distp(0, 1) + peff*dd2**2*distp(0, 2) ! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -18070,115 +17243,134 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END IF END DO END DO - funb = 0.0_8 - fun0b = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp474b9 = rmu(ic, 0)*zb(indorbp, indt+4) + temp380b4 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp474b9 - fun2b = fun2b + temp474b9 + funb0 = funb0 + 4.d0*temp380b4 + fun2b = fun2b + temp380b4 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp474b8 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp474b8 - funb = funb + rmu(ic, 0)*temp474b8 + IF (.NOT.branch .LT. 2) distpb(0, 3) = distpb(0, 3) + zb(& +& indorbp, indt+i) + temp380b3 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp380b3 + funb0 = funb0 + rmu(ic, 0)*temp380b3 rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp474b6 = dd4**2*fun2b - temp474b7 = -(funb/r(0)) - dd2b = distp(0, 1)*temp474b7 + distp(0, 1)*2*dd2*fun2b - distpb(0, 1) = dd2**2*fun2b - dd4b = distp(0, 2)*dd3*temp474b7 + dd3*distp(0, 2)*2*dd4*fun2b - dd3b = distp(0, 2)*dd4*temp474b7 + distp(0, 2)*fun0b + distp(0, 2)& -& *temp474b6 - distpb(0, 2) = dd3*temp474b6 - distpb(0, 1) = distpb(0, 1) + dd2*temp474b7 - distpb(0, 2) = distpb(0, 2) + dd3*dd4*temp474b7 - rb(0) = rb(0) - (dd2*distp(0, 1)+dd3*dd4*distp(0, 2))*temp474b7/r(& -& 0) - distpb(0, 1) = distpb(0, 1) + fun0b - distpb(0, 2) = distpb(0, 2) + dd3*fun0b + temp380b1 = dd2**2*fun2b + temp380b2 = funb0/r(0) + dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*temp380b2 + distpb(0, 1) = distpb(0, 1) + dd1**2*fun2b + dd2b = peff*distp(0, 2)*2*dd2*fun2b - distp(0, 2)*peff*temp380b2 + peffb = distp(0, 2)*temp380b1 - distp(0, 2)*dd2*temp380b2 + distpb(0, 2) = distpb(0, 2) + peff*temp380b1 + distpb(0, 1) = distpb(0, 1) - dd1*temp380b2 + distpb(0, 2) = distpb(0, 2) - dd2*peff*temp380b2 + rb(0) = rb(0) - (-(dd1*distp(0, 1))-dd2*peff*distp(0, 2))*& +& temp380b2/r(0) ELSE distpb = 0.0_8 + peffb = 0.0_8 + dd1b = 0.0_8 dd2b = 0.0_8 - dd3b = 0.0_8 - dd4b = 0.0_8 END IF DO ic=3,1,-1 DO i=0,0,-1 - temp474b5 = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& -& indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp474b5 - dd3b = dd3b + distp(i, 2)*temp474b5 - distpb(i, 2) = distpb(i, 2) + dd3*temp474b5 + rmub(ic, i) = rmub(ic, i) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + rmu(ic, i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + DO i=0,0,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distpb(i, 1) = distpb(i, 1) + distpb(i, 3) + peffb = peffb + distp(i, 2)*distpb(i, 3) + distpb(i, 2) = distpb(i, 2) + peff*distpb(i, 3) + distpb(i, 3) = 0.0_8 + END DO + cb = 0.0_8 DO k=0,0,-1 - temp474b3 = DEXP(-(dd4*r(k)))*distpb(k, 2) - dd4b = dd4b - r(k)*temp474b3 + temp380b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp380b distpb(k, 2) = 0.0_8 - temp474b4 = DEXP(-(dd2*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd2*temp474b4 - dd4*temp474b3 - dd2b = dd2b - r(k)*temp474b4 + temp380b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp380b0 - dd2*temp380b + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp380b0 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (124) -! 2s double exp with constant and cusp cond. -! (dd3+ exp (-dd2 r)*(1+dd2*r)+dd4*exp(-dd5*r)*(1+dd5*r)) + temp379 = 2.d0**5 + temp378 = temp379*dd2**5 + temp377 = peff**2/temp378 + temp376 = (dd1+dd2)**5 + temp375 = 2.d0**5 + temp374 = temp375*dd1**5 + temp373 = 8.d0*pi*(1.0/temp374+2.d0*peff/temp376+temp377) + temp372 = DSQRT(temp373) + IF (temp373 .EQ. 0.0) THEN + temp372b2 = 0.0 + ELSE + temp372b2 = -(0.5d0*pi*8.d0*cb/(temp372**2*2.D0*DSQRT(temp373))) + END IF + temp372b3 = 2.d0*temp372b2/temp376 + temp372b4 = -(peff*5*(dd1+dd2)**4*temp372b3/temp376) + dd1b = dd1b + temp372b4 - temp375*5*dd1**4*temp372b2/temp374**2 + peffb = peffb + 2*peff*temp372b2/temp378 + temp372b3 + dd2b = dd2b + temp372b4 - temp377*temp379*5*dd2**4*temp372b2/temp378 + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (108) +! 3p single zeta +! 2s double lorentian with constant parent of 102 +! (dd3+ L(dd2 r^2)+dd4*L(dd5*r^2)) ; L(x)=1/1+x^2 dd2 = dd(indpar+1) dd4 = dd(indpar+3) dd5 = dd(indpar+4) indorbp = indorb + 1 DO k=0,0 - distp(k, 3) = DEXP(-(dd2*r(k))) - distp(k, 4) = DEXP(-(dd5*r(k))) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(k, 1)) - distp(k, 1) = distp(k, 3)*(1.d0+dd2*r(k)) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(k, 2)) - distp(k, 2) = distp(k, 4)*(1.d0+dd5*r(k)) + distp(k, 1) = 1.d0/(1.d0+dd2*r(k)*r(k)) + distp(k, 2) = 1.d0/(1.d0+dd5*r(k)*r(k)) END DO ! write(6,*) ' function inside = ',z(indorbp,i) ! endif IF (typec .NE. 1) THEN - fun = -(dd2**2*distp(0, 3)) - dd5**2*dd4*distp(0, 4) - funb = 2.d0*zb(indorbp, indt+4) + fun = -(2.d0*(dd2*distp(0, 1)**2+dd5*dd4*distp(0, 2)**2)) fun2b = zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp474b14 = -((1.d0-dd2*r(0))*fun2b) - temp474b15 = -(dd2**2*distp(0, 3)*fun2b) - temp474b16 = -((1.d0-dd5*r(0))*fun2b) - temp474b17 = dd5**2*temp474b16 - temp474b18 = -(dd5**2*dd4*distp(0, 4)*fun2b) - dd2b = distp(0, 3)*2*dd2*temp474b14 - r(0)*temp474b15 - distp(0, 3& -& )*2*dd2*funb - distpb(0, 3) = dd2**2*temp474b14 - rb(0) = rb(0) - dd5*temp474b18 - dd2*temp474b15 - dd5b = dd4*distp(0, 4)*2*dd5*temp474b16 - r(0)*temp474b18 - dd4*& -& distp(0, 4)*2*dd5*funb - temp474b19 = -(dd5**2*funb) - dd4b = distp(0, 4)*temp474b19 + distp(0, 4)*temp474b17 - distpb(0, 4) = dd4*temp474b17 - distpb(0, 3) = distpb(0, 3) - dd2**2*funb - distpb(0, 4) = distpb(0, 4) + dd4*temp474b19 + temp383 = distp(0, 1)**3 + temp383b = 2.d0*(3.d0*(dd2*r(0)**2)-1.d0)*fun2b + temp383b0 = 2.d0*dd2*temp383*3.d0*fun2b + temp382 = distp(0, 2)**3 + temp382b = 2.d0*(3.d0*(dd5*r(0)**2)-1.d0)*fun2b + temp382b0 = 2.d0*dd5*dd4*temp382*3.d0*fun2b + temp382b1 = -(2.d0*funb0) + dd2b = distp(0, 1)**2*temp382b1 + r(0)**2*temp383b0 + temp383*& +& temp383b + distpb(0, 1) = dd2*3*distp(0, 1)**2*temp383b + rb(0) = rb(0) + dd5*2*r(0)*temp382b0 + dd2*2*r(0)*temp383b0 + temp382b2 = distp(0, 2)**2*temp382b1 + dd5b = dd4*temp382b2 + r(0)**2*temp382b0 + temp382*dd4*temp382b + dd4b = dd5*temp382b2 + temp382*dd5*temp382b + distpb(0, 2) = dd5*dd4*3*distp(0, 2)**2*temp382b + distpb(0, 1) = distpb(0, 1) + dd2*2*distp(0, 1)*temp382b1 + distpb(0, 2) = distpb(0, 2) + dd5*dd4*2*distp(0, 2)*temp382b1 ELSE distpb = 0.0_8 dd2b = 0.0_8 @@ -18194,144 +17386,81 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd zb(indorbp, i) = 0.0_8 END DO DO k=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(k, 2)) - temp474b10 = distp(k, 4)*distpb(k, 2) - distpb(k, 4) = distpb(k, 4) + (dd5*r(k)+1.d0)*distpb(k, 2) + temp381 = dd5*r(k)**2 + 1.d0 + temp381b = -(distpb(k, 2)/temp381**2) + dd5b = dd5b + r(k)**2*temp381b distpb(k, 2) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(k, 1)) - temp474b11 = distp(k, 3)*distpb(k, 1) - distpb(k, 3) = distpb(k, 3) + (dd2*r(k)+1.d0)*distpb(k, 1) + temp380 = dd2*r(k)**2 + 1.d0 + temp380b5 = -(distpb(k, 1)/temp380**2) + rb(k) = rb(k) + dd2*2*r(k)*temp380b5 + dd5*2*r(k)*temp381b + dd2b = dd2b + r(k)**2*temp380b5 distpb(k, 1) = 0.0_8 - temp474b12 = DEXP(-(dd5*r(k)))*distpb(k, 4) - dd5b = dd5b + r(k)*temp474b10 - r(k)*temp474b12 - distpb(k, 4) = 0.0_8 - temp474b13 = DEXP(-(dd2*r(k)))*distpb(k, 3) - rb(k) = rb(k) + dd2*temp474b11 - dd2*temp474b13 - dd5*temp474b12 +& -& dd5*temp474b10 - dd2b = dd2b + r(k)*temp474b11 - r(k)*temp474b13 - distpb(k, 3) = 0.0_8 END DO ddb(indpar+4) = ddb(indpar+4) + dd5b ddb(indpar+3) = ddb(indpar+3) + dd4b ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (125) -! 2s with cusp condition -! dd1*( dd3 +exp(-dd2*r)) ! with no cusp condition - dd2 = dd(indpar+1) - indorbp = indorb + 1 - DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k))) - END DO -! endif - IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)/r(0)) - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp474b21 = -(distp(0, 1)*funb/r(0)) - dd2b = temp474b21 + distp(0, 1)*2*dd2*fun2b - temp474 = dd2/r(0) - distpb(0, 1) = dd2**2*fun2b - temp474*funb - rb(0) = rb(0) - temp474*temp474b21 - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - dd3b = 0.0_8 - DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=0,0,-1 - temp474b20 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp474b20 - rb(k) = rb(k) - dd2*temp474b20 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (126) -! 2s double exp with constant -! (dd3+ exp (-dd2 r)+dd4*exp(-dd5*r)) + CASE (131) +! 2s without cusp condition +! dd1*(r^2*exp(-dd2*r^2)) dd2 = dd(indpar+1) - dd4 = dd(indpar+3) - dd5 = dd(indpar+4) indorbp = indorb + 1 DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k))) - distp(k, 2) = DEXP(-(dd5*r(k))) + distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) END DO -! write(6,*) ' function inside = ',z(indorbp,i) ! endif IF (typec .NE. 1) THEN - fun = -((dd2*distp(0, 1)+dd5*dd4*distp(0, 2))/r(0)) - funb = 2.d0*zb(indorbp, indt+4) + fun0 = dd2*r(0)**2 + fun = 2.d0*distp(0, 1)*(1.d0-fun0) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp475b1 = dd5**2*fun2b - temp475b2 = -(funb/r(0)) - dd2b = distp(0, 1)*temp475b2 + distp(0, 1)*2*dd2*fun2b - distpb(0, 1) = dd2**2*fun2b - dd5b = distp(0, 2)*dd4*temp475b2 + dd4*distp(0, 2)*2*dd5*fun2b - dd4b = distp(0, 2)*dd5*temp475b2 + distp(0, 2)*temp475b1 - distpb(0, 2) = dd4*temp475b1 - distpb(0, 1) = distpb(0, 1) + dd2*temp475b2 - distpb(0, 2) = distpb(0, 2) + dd5*dd4*temp475b2 - rb(0) = rb(0) - (dd2*distp(0, 1)+dd5*dd4*distp(0, 2))*temp475b2/r(& -& 0) + temp384b0 = 2.d0*distp(0, 1)*fun2b + distpb(0, 1) = 2.d0*(1.d0-fun0)*funb0 + 2.d0*(2.d0*fun0**2-5.d0*& +& fun0+1.d0)*fun2b + fun0b = (2.d0*2*fun0-5.d0)*temp384b0 - 2.d0*distp(0, 1)*funb0 + dd2b = r(0)**2*fun0b + rb(0) = rb(0) + dd2*2*r(0)*fun0b ELSE distpb = 0.0_8 dd2b = 0.0_8 - dd4b = 0.0_8 - dd5b = 0.0_8 END IF - dd3b = 0.0_8 DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) - dd4b = dd4b + distp(i, 2)*zb(indorbp, i) - distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO DO k=0,0,-1 - temp475b = DEXP(-(dd5*r(k)))*distpb(k, 2) - dd5b = dd5b - r(k)*temp475b - distpb(k, 2) = 0.0_8 - temp475b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd2*temp475b0 - dd5*temp475b - dd2b = dd2b - r(k)*temp475b0 + temp384b = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp384b + rb(k) = rb(k) - dd2*2*r(k)*temp384b distpb(k, 1) = 0.0_8 END DO - ddb(indpar+4) = ddb(indpar+4) + dd5b - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (127) -! 3d without cusp and one parmater + CASE (133) +! 4d one parmater dd1 = dd(indpar+1) DO k=0,0 distp(k, 1) = DEXP(-(dd1*r(k))) END DO DO i=0,0 - distp(i, 3) = distp(i, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = distp(i, 1)*r(i) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d END DO ! indorbp=indorb @@ -18343,8 +17472,8 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd ! endif IF (typec .NE. 1) THEN fun0 = distp(0, 3) - fun = -(dd1*distp(0, 1)) - fun2 = dd1**2*distp(0, 1) + fun = (1.d0-dd1*r(0))*distp(0, 1) + fun2 = dd1*(dd1*r(0)-2.d0)*distp(0, 1) ! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -18395,18 +17524,18 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=5,1,-1 - temp476 = fun/r(0) - temp477b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp476b3 = 6.d0*temp477b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp476+fun2)*zb(& + temp385 = fun/r(0) + temp386b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp385b3 = 6.d0*temp386b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp385+fun2)*zb(& & indorbp, indt+4) - funb = funb + temp476b3 - rb(0) = rb(0) - temp476*temp476b3 - fun2b = fun2b + temp477b + funb0 = funb0 + temp385b3 + rb(0) = rb(0) - temp385*temp385b3 + fun2b = fun2b + temp386b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -18414,24 +17543,24 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN IF (branch .LT. 2) THEN - temp476b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp476b - fun0b = fun0b + rmu(i, 0)*temp476b + temp385b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp385b + fun0b = fun0b + rmu(i, 0)*temp385b ELSE - temp476b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp476b0 - fun0b = fun0b + rmu(i, 0)*temp476b0 + temp385b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp385b0 + fun0b = fun0b + rmu(i, 0)*temp385b0 END IF ELSE IF (branch .LT. 4) THEN - temp476b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp476b1 - fun0b = fun0b + rmu(i, 0)*temp476b1 + temp385b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp385b1 + fun0b = fun0b + rmu(i, 0)*temp385b1 END IF ELSE IF (branch .LT. 7) THEN IF (branch .LT. 6) THEN - temp476b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp476b2 - fun0b = fun0b + rmu(i, 0)*temp476b2 + temp385b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp385b2 + fun0b = fun0b + rmu(i, 0)*temp385b2 ELSE rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) @@ -18461,20 +17590,25 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp475 = fun/r(0) - temp475b4 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp475*rmu(i, 0)*zb(& + temp384 = fun/r(0) + temp384b4 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp384*rmu(i, 0)*zb(& & indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp475*distp(0, 3+ic)*zb(indorbp, & + rmub(i, 0) = rmub(i, 0) + temp384*distp(0, 3+ic)*zb(indorbp, & & indt+i) - funb = funb + temp475b4 - rb(0) = rb(0) - temp475*temp475b4 + funb0 = funb0 + temp384b4 + rb(0) = rb(0) - temp384*temp384b4 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb - distpb(0, 1) = distpb(0, 1) + dd1**2*fun2b - dd1*funb + temp384b2 = dd1*distp(0, 1)*fun2b + temp384b3 = (dd1*r(0)-2.d0)*fun2b + dd1b = distp(0, 1)*temp384b3 - distp(0, 1)*r(0)*funb0 + r(0)*& +& temp384b2 + rb(0) = rb(0) + dd1*temp384b2 - distp(0, 1)*dd1*funb0 + distpb(0, 1) = distpb(0, 1) + (1.d0-dd1*r(0))*funb0 + dd1*& +& temp384b3 distpb(0, 3) = distpb(0, 3) + fun0b ELSE distpb = 0.0_8 @@ -18489,79 +17623,340 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) distpb(i, 8) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) distpb(i, 7) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - distpb(i, 1) = distpb(i, 1) + distpb(i, 3) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distpb(i, 1) = distpb(i, 1) + r(i)*distpb(i, 3) + rb(i) = rb(i) + distp(i, 1)*distpb(i, 3) distpb(i, 3) = 0.0_8 END DO DO k=0,0,-1 - temp475b3 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp475b3 - rb(k) = rb(k) - dd1*temp475b3 + temp384b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp384b1 + rb(k) = rb(k) - dd1*temp384b1 distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (128) -! 2s with cusp condition -! ( r^2*exp(-dd2*r)) ! with no cusp condition - dd2 = dd(indpar+1) + CASE (66) +! derivative of 57 (orbital 1s STO regolarized for r->0) +! dR(r)/dz with R(r)= C(z) * P(z*r) * exp(-z*r) +! P(x) = (x+a)^n/(1+(x+a)^n) with a so that P(0)==dP(0)/dx +! C(z) = const * z^(3/2) normalization +! the following definitions are in module constants +! n -> costSTO1s_n = 4 +! a -> costSTO1s_a = 1.2263393530877080588 +! const(n) -> costSTO1s_c = 0.58542132302621750732 +! +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 - DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k))) + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! if(dd1.gt.0.) then + c = coststo1s_c*dd1**1.5d0 +! else +! c=1.d0 +! endif +! endif + DO i=0,0 + distp(i, 1) = c*DEXP(-(dd1*r(i))) + END DO + DO i=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = dd1*r(i) + coststo1s_a + CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) + rp4 = rp1**coststo1s_n + END DO + IF (typec .NE. 1) THEN + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = dd1*r(0) + coststo1s_a + rp2 = rp1**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) + rp4 = rp1**coststo1s_n + rp6 = rp4**2 +! the first derivative /r + fun = distp(0, 1)*(dd1*rp4*(-(2.d0*coststo1s_a*(coststo1s_n**2*(-& +& 1.d0+rp4)+coststo1s_n*(1.d0+2.d0*rp1)*(1.d0+rp4)-rp2*(1.d0+rp4)& +& **2))+rp1*(2*coststo1s_n**2*(-1+rp4)+coststo1s_n*(-3.d0+4.d0*rp1& +& )*(1.d0+rp4)-rp1*(-5.d0+2.d0*rp1)*(1.d0+rp4)**2)))/(2.d0*rp2*(& +& coststo1s_a-rp1)*(1.d0+rp4)**3) +! fun=+distp(0,1)*rp4/(1.d0+rp4)*(1.5d0/dd1 + r(0)* & +! &(-1.d0+(costSTO1s_n)/(rp1*(1.d0+rp4)))) & +! &*(dd1*(2.d0 + 5.d0/(-dd1*r(0)) + & +! &(4.d0*costSTO1s_n**2)/(rp2*(1.d0+rp4)**2) + & +! &(costSTO1s_n*((3.d0 - 2.d0*costSTO1s_n - 4.d0*rp1)*rp1& +! &+ 2.d0*costSTO1s_a*(1.d0+costSTO1s_n+2.d0*rp1)))/ & +! &(rp2*(dd1*r(0))*(1 + rp4))))/2.d0 +! the second derivative derivative + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp410 = (rp4+1)**4 + temp397 = 2.d0*rp1*rp2 + temp398 = temp397*temp410 + temp409 = distp(0, 1)*dd1*rp4 + temp399 = temp409/temp398 + temp409b = -(temp399*fun2b) + temp408 = coststo1s_n**3 + temp404 = 6.d0*rp2 - 8.d0*rp1 - 3.d0 + temp407 = (rp4+1.d0)**3 + temp406 = rp2*(2.d0*rp1-7.d0) + temp405 = temp406*temp407 - coststo1s_n*temp404*(rp4+1.d0)**2 - & +& coststo1s_n**2*(6.d0*rp1-1.d0)*(rp6-1.d0) - 2*temp408*(rp4*(rp4-& +& 4.d0)+1.d0) + temp405b = rp1*temp409b + temp404b = -(coststo1s_n*(rp4+1.d0)**2*temp405b) + temp404b0 = -(coststo1s_n**2*temp405b) + temp404b1 = -(temp408*2*temp405b) + temp403 = coststo1s_n**3 + temp402 = 3.d0*rp1*(rp1+1.d0) + 2.d0 + temp401 = (rp4+1.d0)**3 + temp400 = 3.d0*coststo1s_n**2 + temp400b = coststo1s_a*2.d0*temp409b + temp400b0 = coststo1s_n*(rp4+1.d0)**2*3.d0*temp400b + temp399b = -((rp1*temp405+coststo1s_a*2.d0*(temp400*((rp1+1.d0)*(& +& rp6-1.d0))-rp1*rp2*temp401+coststo1s_n*((rp4+1.d0)**2*temp402)+& +& temp403*(rp4*(rp4-4.d0)+1.d0)))*fun2b/temp398) + temp398b = -(temp399*temp399b) + temp397b = temp410*temp398b + temp396 = (rp4+1.d0)**3 + temp389 = 2.d0*rp2*(coststo1s_a-rp1) + temp390 = temp389*temp396 + temp395 = distp(0, 1)*dd1*rp4 + temp391 = temp395/temp390 + temp395b = temp391*funb0 + temp394 = (rp4+1.d0)**2 + temp393 = rp1*(2.d0*rp1-5.d0) + temp392 = 2*coststo1s_n**2*(rp4-1) + coststo1s_n*(4.d0*rp1-3.d0)*(& +& rp4+1.d0) - temp393*temp394 + temp392b = -(coststo1s_a*2.d0*temp395b) + temp391b = (rp1*temp392-coststo1s_a*2.d0*(coststo1s_n**2*(rp4-1.d0& +& )+coststo1s_n*((2.d0*rp1+1.d0)*(rp4+1.d0))-rp2*(rp4+1.d0)**2))*& +& funb0/temp390 + temp390b = -(temp391*temp391b) + temp389b0 = temp396*temp390b + rp2b = (coststo1s_a-rp1)*2.d0*temp389b0 - (rp4+1.d0)**2*temp392b +& +& 2.d0*rp1*temp397b - temp401*rp1*temp400b + 6.d0*temp404b + & +& temp407*(2.d0*rp1-7.d0)*temp405b + rp6b = temp400*(rp1+1.d0)*temp400b + (6.d0*rp1-1.d0)*temp404b0 + temp392b0 = rp1*temp395b + rp4b = (coststo1s_n*(4.d0*rp1-3.d0)-temp393*2*(rp4+1.d0)+2*& +& coststo1s_n**2)*temp392b0 + (coststo1s_n*(2.d0*rp1+1.d0)-rp2*2*(& +& rp4+1.d0)+coststo1s_n**2)*temp392b + distp(0, 1)*dd1*temp391b + & +& temp389*3*(rp4+1.d0)**2*temp390b + 2*rp4*rp6b + temp397*4*(rp4+1& +& )**3*temp398b + distp(0, 1)*dd1*temp399b + (temp403*rp4+temp403*& +& (rp4-4.d0)+coststo1s_n*temp402*2*(rp4+1.d0)-rp1*rp2*3*(rp4+1.d0)& +& **2)*temp400b + (2*rp4-4.d0)*temp404b1 + (temp406*3*(rp4+1.d0)**& +& 2-coststo1s_n*temp404*2*(rp4+1.d0))*temp405b + IF (rp1 .LE. 0.0 .AND. (coststo1s_n .EQ. 0.0 .OR. coststo1s_n .NE.& +& INT(coststo1s_n))) THEN + rp1b = temp392*temp395b + (coststo1s_n*(rp4+1.d0)*4.d0-temp394*(& +& 2.d0*rp1-5.d0)-temp394*rp1*2.d0)*temp392b0 + coststo1s_n*(rp4+& +& 1.d0)*2.d0*temp392b - 2.d0*rp2*temp389b0 + 2*rp1*rp2b + rp2*& +& 2.d0*temp397b + (2*rp1+1.d0)*temp400b0 + (temp400*(rp6-1.d0)-& +& temp401*rp2)*temp400b + (rp6-1.d0)*6.d0*temp404b0 - 8.d0*& +& temp404b + temp407*rp2*2.d0*temp405b + temp405*temp409b + ELSE + rp1b = temp392*temp395b + (coststo1s_n*(rp4+1.d0)*4.d0-temp394*(& +& 2.d0*rp1-5.d0)-temp394*rp1*2.d0)*temp392b0 + coststo1s_n*(rp4+& +& 1.d0)*2.d0*temp392b - 2.d0*rp2*temp389b0 + 2*rp1*rp2b + & +& coststo1s_n*rp1**(coststo1s_n-1)*rp4b + rp2*2.d0*temp397b + (2& +& *rp1+1.d0)*temp400b0 + (temp400*(rp6-1.d0)-temp401*rp2)*& +& temp400b + (rp6-1.d0)*6.d0*temp404b0 - 8.d0*temp404b + temp407& +& *rp2*2.d0*temp405b + temp405*temp409b + END IF + distpb(0, 1) = dd1*rp4*temp391b + dd1*rp4*temp399b + dd1b = distp(0, 1)*rp4*temp391b + r(0)*rp1b + distp(0, 1)*rp4*& +& temp399b + CALL POPREAL8(adr8ibuf,adr8buf,rp4) + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + rb(0) = rb(0) + dd1*rp1b + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + END IF + DO i=0,0,-1 + temp386 = rp4/(rp4+1.d0) + temp389b = distp(i, 1)*temp386*zb(indorbp, i) + temp387 = rp1*(rp4+1.d0) + temp388 = coststo1s_n/temp387 + temp387b = -(r(i)*temp388*temp389b/temp387) + temp387b0 = (1.5d0/dd1+r(i)*(temp388-1.d0))*zb(indorbp, i) + temp386b1 = distp(i, 1)*temp387b0/(rp4+1.d0) + rp4b = (1.0_8-temp386)*temp386b1 + rp1*temp387b + IF (rp1 .LE. 0.0 .AND. (coststo1s_n .EQ. 0.0 .OR. coststo1s_n .NE.& +& INT(coststo1s_n))) THEN + rp1b = (rp4+1.d0)*temp387b + ELSE + rp1b = coststo1s_n*rp1**(coststo1s_n-1)*rp4b + (rp4+1.d0)*& +& temp387b + END IF + dd1b = dd1b + r(i)*rp1b - 1.5d0*temp389b/dd1**2 + rb(i) = rb(i) + dd1*rp1b + (temp388-1.d0)*temp389b + distpb(i, 1) = distpb(i, 1) + temp386*temp387b0 + zb(indorbp, i) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,rp4) + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + END DO + cb = 0.0_8 + DO i=0,0,-1 + temp386b0 = c*DEXP(-(dd1*r(i)))*distpb(i, 1) + cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) + dd1b = dd1b - r(i)*temp386b0 + rb(i) = rb(i) - dd1*temp386b0 + distpb(i, 1) = 0.0_8 + END DO + dd1b = dd1b + coststo1s_c*1.5d0*dd1**0.5D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (57) +! orbital 1s (no cusp) - STO regolarized for r->0 +! R(r)= C(z) * P(z*r) * exp(-z*r) +! P(x) = (x+a)^n/(1+(x+a)^n) with a so that P(0)==dP(0)/dx +! C(z) = const * z^(3/2) normalization +! the following definitions are in module constants +! n -> costSTO1s_n = 4 +! a -> costSTO1s_a = 1.2263393530877080588 +! const(n) -> costSTO1s_c = 0.58542132302621750732 +! +! +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! if(dd1.gt.0.) then + c = coststo1s_c*dd1**1.5d0 +! else +! c=1.d0 +! endif +! endif + DO i=0,0 + distp(i, 1) = c*DEXP(-(dd1*r(i))) + END DO + DO i=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) + rp4 = (dd1*r(i)+coststo1s_a)**coststo1s_n END DO -! endif IF (typec .NE. 1) THEN - fun = (2.d0-dd2*r(0))*distp(0, 1) - funb = 2.d0*zb(indorbp, indt+4) + rp1 = dd1*r(0) + coststo1s_a + rp2 = rp1**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) + rp4 = rp1**coststo1s_n +! the first derivative /r +!fun=-z(indorbp,0)*((dd1**2*(-costSTO1s_n+rp1+rp1*rp4))/ & +! &(rp1*(-costSTO1s_a+rp1)*(1.d0+rp4))) + fun = -(distp(0, 1)*rp4*(dd1**2*(-coststo1s_n+rp1+rp1*rp4)/(rp1*(-& +& coststo1s_a+rp1)*(1.d0+rp4)**2))) +! the second derivative derivative + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp477b1 = distp(0, 1)*fun2b - temp477b2 = 2*dd2*r(0)*temp477b1 - dd2b = r(0)*temp477b2 - 4*r(0)*temp477b1 - distp(0, 1)*r(0)*funb - rb(0) = rb(0) + dd2*temp477b2 - 4*dd2*temp477b1 - distp(0, 1)*dd2*& -& funb - distpb(0, 1) = (2.d0-dd2*r(0))*funb + ((dd2*r(0))**2-4*(dd2*r(0))+& -& 2.d0)*fun2b + temp419 = (rp4+1.d0)**3 + temp416 = rp2*temp419 + temp417b = (rp2*(rp4+1.d0)**2-coststo1s_n*((2.d0*rp1+1.d0)*(rp4+& +& 1.d0))-coststo1s_n**2*(rp4-1.d0))*fun2b/temp416 + temp419b = dd1**2*temp417b + temp418 = distp(0, 1)*rp4*dd1**2 + temp417 = temp418/temp416 + temp416b = -(temp417*temp417b) + temp416b0 = temp417*fun2b + temp415 = (rp4+1.d0)**2 + temp412 = rp1*(rp1-coststo1s_a)*temp415 + temp415b = -(funb0/temp412) + temp413 = rp1 - coststo1s_n + rp1*rp4 + temp414b = temp413*temp415b + temp415b0 = dd1**2*temp414b + distpb(0, 1) = rp4*temp415b0 + rp4*temp419b + temp414 = distp(0, 1)*rp4*dd1**2 + temp413b = temp414*temp415b + temp412b = -(temp414*temp413*temp415b/temp412) + rp4b = distp(0, 1)*temp415b0 + rp1*temp413b + rp1*(rp1-coststo1s_a& +& )*2*(rp4+1.d0)*temp412b + (rp2*2*(rp4+1.d0)-coststo1s_n*(2.d0*& +& rp1+1.d0)-coststo1s_n**2)*temp416b0 + rp2*3*(rp4+1.d0)**2*& +& temp416b + distp(0, 1)*temp419b + rp2b = (rp4+1.d0)**2*temp416b0 + temp419*temp416b + IF (rp1 .LE. 0.0 .AND. (coststo1s_n .EQ. 0.0 .OR. coststo1s_n .NE.& +& INT(coststo1s_n))) THEN + rp1b = (rp4+1.0_8)*temp413b + (temp415*rp1+temp415*(rp1-& +& coststo1s_a))*temp412b + 2*rp1*rp2b - coststo1s_n*(rp4+1.d0)*& +& 2.d0*temp416b0 + ELSE + rp1b = (rp4+1.0_8)*temp413b + (temp415*rp1+temp415*(rp1-& +& coststo1s_a))*temp412b + 2*rp1*rp2b + coststo1s_n*rp1**(& +& coststo1s_n-1)*rp4b - coststo1s_n*(rp4+1.d0)*2.d0*temp416b0 + END IF + dd1b = distp(0, 1)*rp4*2*dd1*temp414b + r(0)*rp1b + distp(0, 1)*& +& rp4*2*dd1*temp417b + CALL POPREAL8(adr8ibuf,adr8buf,rp4) + rb(0) = rb(0) + dd1*rp1b ELSE distpb = 0.0_8 - dd2b = 0.0_8 + dd1b = 0.0_8 END IF DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) + temp411 = rp4/(rp4+1.d0) + temp411b0 = distp(i, 1)*zb(indorbp, i)/(rp4+1.d0) + distpb(i, 1) = distpb(i, 1) + temp411*zb(indorbp, i) + rp4b = (1.0_8-temp411)*temp411b0 zb(indorbp, i) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,rp4) + IF (coststo1s_a + dd1*r(i) .LE. 0.0 .AND. (coststo1s_n .EQ. 0.0 & +& .OR. coststo1s_n .NE. INT(coststo1s_n))) THEN + temp411b1 = 0.0 + ELSE + temp411b1 = coststo1s_n*(coststo1s_a+dd1*r(i))**(coststo1s_n-1)*& +& rp4b + END IF + dd1b = dd1b + r(i)*temp411b1 + rb(i) = rb(i) + dd1*temp411b1 END DO - DO k=0,0,-1 - temp477b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp477b0 - rb(k) = rb(k) - dd2*temp477b0 - distpb(k, 1) = 0.0_8 + cb = 0.0_8 + DO i=0,0,-1 + temp411b = c*DEXP(-(dd1*r(i)))*distpb(i, 1) + cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) + dd1b = dd1b - r(i)*temp411b + rb(i) = rb(i) - dd1*temp411b + distpb(i, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (129) -! 2p single exponential r e^{-z r} ! parent of 121 + dd1b = dd1b + coststo1s_c*1.5d0*dd1**0.5D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (123) +! 2p double exp +! dd1 * x_mu (exp(-dd2 r)+dd3 * exp(-dd4*r)) dd2 = dd(indpar+1) + dd3 = dd(indpar+2) + dd4 = dd(indpar+3) DO k=0,0 distp(k, 1) = DEXP(-(dd2*r(k))) + distp(k, 2) = DEXP(-(dd4*r(k))) END DO ! indorbp=indorb DO ic=1,3 @@ -18571,8 +17966,8 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - fun = distp(0, 1)*(1.d0-dd2*r(0))/r(0) - fun2 = dd2*(dd2*r(0)-2.d0)*distp(0, 1) + fun = -((dd2*distp(0, 1)+dd3*dd4*distp(0, 2))/r(0)) + fun2 = dd2**2*distp(0, 1) + dd3*dd4**2*distp(0, 2) ! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -18586,602 +17981,658 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp478b2 = rmu(ic, 0)*zb(indorbp, indt+4) + temp420b5 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp478b2 - fun2b = fun2b + temp478b2 + funb0 = funb0 + 4.d0*temp420b5 + fun2b = fun2b + temp420b5 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp478b1 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp478b1 - funb = funb + rmu(ic, 0)*temp478b1 + temp420b4 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp420b4 + funb0 = funb0 + rmu(ic, 0)*temp420b4 rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp478b = dd2*distp(0, 1)*fun2b - temp478b0 = (dd2*r(0)-2.d0)*fun2b - temp477 = distp(0, 1)/r(0) - dd2b = distp(0, 1)*temp478b0 - temp477*r(0)*funb + r(0)*temp478b - temp477b5 = (1.d0-dd2*r(0))*funb/r(0) - rb(0) = rb(0) + distp(0, 1)*fun0b - temp477*dd2*funb - temp477*& -& temp477b5 + dd2*temp478b - distpb(0, 1) = temp477b5 + r(0)*fun0b + dd2*temp478b0 + temp420b2 = dd4**2*fun2b + temp420b3 = -(funb0/r(0)) + dd2b = distp(0, 1)*temp420b3 + distp(0, 1)*2*dd2*fun2b + distpb(0, 1) = dd2**2*fun2b + dd4b = distp(0, 2)*dd3*temp420b3 + dd3*distp(0, 2)*2*dd4*fun2b + dd3b = distp(0, 2)*dd4*temp420b3 + distp(0, 2)*fun0b + distp(0, 2)& +& *temp420b2 + distpb(0, 2) = dd3*temp420b2 + distpb(0, 1) = distpb(0, 1) + dd2*temp420b3 + distpb(0, 2) = distpb(0, 2) + dd3*dd4*temp420b3 + rb(0) = rb(0) - (dd2*distp(0, 1)+dd3*dd4*distp(0, 2))*temp420b3/r(& +& 0) + distpb(0, 1) = distpb(0, 1) + fun0b + distpb(0, 2) = distpb(0, 2) + dd3*fun0b ELSE distpb = 0.0_8 dd2b = 0.0_8 + dd3b = 0.0_8 + dd4b = 0.0_8 END IF DO ic=3,1,-1 DO i=0,0,-1 - temp477b4 = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*r(i)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + r(i)*temp477b4 - rb(i) = rb(i) + distp(i, 1)*temp477b4 + temp420b1 = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& +& indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp420b1 + dd3b = dd3b + distp(i, 2)*temp420b1 + distpb(i, 2) = distpb(i, 2) + dd3*temp420b1 zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=0,0,-1 - temp477b3 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp477b3 - rb(k) = rb(k) - dd2*temp477b3 + temp420b = DEXP(-(dd4*r(k)))*distpb(k, 2) + dd4b = dd4b - r(k)*temp420b + distpb(k, 2) = 0.0_8 + temp420b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd2*temp420b0 - dd4*temp420b + dd2b = dd2b - r(k)*temp420b0 distpb(k, 1) = 0.0_8 END DO + ddb(indpar+3) = ddb(indpar+3) + dd4b + ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (130) -! 2p single exponential r^2 e^{-z r} ! parent of 121 - dd2 = dd(indpar+1) - DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k))) - END DO + CASE (87) +! f orbitals +! R(r)= c*exp(-z r^2)*(9/4/z-r^2) ! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun = distp(0, 1)*(2.d0-dd2*r(0)) - fun2 = (2.d0-4.d0*dd2*r(0)+(dd2*r(0))**2)*distp(0, 1) -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp478b8 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp478b8 - fun2b = fun2b + temp478b8 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp478b7 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp478b7 - funb = funb + rmu(ic, 0)*temp478b7 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - distpb = 0.0_8 - temp478b5 = distp(0, 1)*fun2b - temp478b6 = 2*dd2*r(0)*temp478b5 - dd2b = r(0)*temp478b6 - 4.d0*r(0)*temp478b5 - distp(0, 1)*r(0)*& -& funb - rb(0) = rb(0) + distp(0, 1)*2*r(0)*fun0b - distp(0, 1)*dd2*funb - & -& 4.d0*dd2*temp478b5 + dd2*temp478b6 - distpb(0, 1) = (2.d0-dd2*r(0))*funb + r(0)**2*fun0b + ((dd2*r(0))& -& **2-4.d0*(dd2*r(0))+2.d0)*fun2b - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - DO ic=3,1,-1 - DO i=0,0,-1 - temp478b4 = r(i)**2*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp478b4 - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp478b4 - rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*2*r(i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO k=0,0,-1 - temp478b3 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp478b3 - rb(k) = rb(k) - dd2*temp478b3 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (131) -! 2s without cusp condition -! dd1*(r^2*exp(-dd2*r^2)) - dd2 = dd(indpar+1) - indorbp = indorb + 1 - DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) - END DO -! endif - IF (typec .NE. 1) THEN - fun0 = dd2*r(0)**2 - fun = 2.d0*distp(0, 1)*(1.d0-fun0) - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp478b10 = 2.d0*distp(0, 1)*fun2b - distpb(0, 1) = 2.d0*(1.d0-fun0)*funb + 2.d0*(2.d0*fun0**2-5.d0*& -& fun0+1.d0)*fun2b - fun0b = (2.d0*2*fun0-5.d0)*temp478b10 - 2.d0*distp(0, 1)*funb - dd2b = r(0)**2*fun0b - rb(0) = rb(0) + dd2*2*r(0)*fun0b - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=0,0,-1 - temp478b9 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp478b9 - rb(k) = rb(k) - dd2*2*r(k)*temp478b9 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (132) -! 2s with cusp condition -! ( r^3*exp(-dd2*r)) ! with no cusp condition - dd2 = dd(indpar+1) - indorbp = indorb + 1 - DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k)))*r(k) - END DO -! endif - IF (typec .NE. 1) THEN - fun = (3.d0-dd2*r(0))*distp(0, 1) - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp478b12 = distp(0, 1)*fun2b - temp478b13 = 2*dd2*r(0)*temp478b12 - dd2b = r(0)*temp478b13 - 6*r(0)*temp478b12 - distp(0, 1)*r(0)*funb - rb(0) = rb(0) + dd2*temp478b13 - 6*dd2*temp478b12 - distp(0, 1)*& -& dd2*funb - distpb(0, 1) = (3.d0-dd2*r(0))*funb + ((dd2*r(0))**2-6*(dd2*r(0))+& -& 6.d0)*fun2b - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=0,0,-1 - temp478b11 = r(k)*DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp478b11 - rb(k) = rb(k) + DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2*temp478b11 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (133) -! 4d one parmater - dd1 = dd(indpar+1) + indparp = indpar + 1 + dd1 = dd(indparp) + dd2 = DSQRT(dd1) +! if(iflagnorm.gt.2) then +! overall normalization +! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0)*ratiocf + c = dd1**2.25d0*ratiocf +! endif DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k))) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) END DO DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = distp(i, 1)*r(i) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) - distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) - distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) - distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) - distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) - distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d + distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) +! lz=0 + distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) +! lz=+/-2 + distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) +! lz=+/-2 + distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) +! lz=+/-3 + distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) END DO -! indorbp=indorb - DO ic=1,5 +! lz=+/-3 + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic + DO k=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 + END DO END DO -! endif +! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 3) - fun = (1.d0-dd1*r(0))*distp(0, 1) - fun2 = dd1*(dd1*r(0)-2.d0)*distp(0, 1) + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*rp2)/rp3 + fun0 = distp(0, 1)*(9.d0/4.d0/dd1-r(0)**2*cost) + fun = 0.25d0*distp(0, 1)*(-26.d0-59.d0*rp2-36.d0*rp1-3.d0*rp1*rp2+& +& 2.d0*rp1**2)/rp3**2 + fun2 = 0.25d0*distp(0, 1)*(-26.d0-66.d0*rp2+22.d0*rp1+178.d0*rp1*& +& rp2+165.d0*rp1**2+54.d0*rp1**2*rp2+rp1**3-2.d0*rp1**3*rp2)/rp3**& +& 3 ! indorbp=indorb - DO ic=1,5 + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE + IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN + IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) END IF ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN + IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) END IF + ELSE IF (ic .EQ. 6) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + END IF + ELSE IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp479 = fun/r(0) - temp480b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp479b3 = 6.d0*temp480b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp479+fun2)*zb(& -& indorbp, indt+4) - funb = funb + temp479b3 - rb(0) = rb(0) - temp479*temp479b3 - fun2b = fun2b + temp480b + DO ic=7,1,-1 + temp431b23 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 8.d0*temp431b23 + fun2b = fun2b + temp431b23 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp479b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp479b - fun0b = fun0b + rmu(i, 0)*temp479b + IF (branch .LT. 11) THEN + IF (branch .LT. 6) THEN + IF (branch .LT. 4) THEN + IF (branch .LT. 3) THEN + IF (.NOT.branch .LT. 2) THEN + temp431b2 = cost1f*zb(indorbp, indt+i) + fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& +& temp431b2 + rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& +& temp431b2 + rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp431b2 + END IF + temp431b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) + temp431b1 = rmu(i, 0)*temp431b0 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp431b0 + fun0b = fun0b + rmu(3, 0)*temp431b1 + rmub(3, 0) = rmub(3, 0) + fun0*temp431b1 + GOTO 150 ELSE - temp479b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp479b0 - fun0b = fun0b + rmu(i, 0)*temp479b0 + temp431b5 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp431b5 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp431b5 + rb(0) = rb(0) - fun0*2*r(0)*temp431b5 END IF - ELSE IF (branch .LT. 4) THEN - temp479b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp479b1 - fun0b = fun0b + rmu(i, 0)*temp479b1 + ELSE IF (.NOT.branch .LT. 5) THEN + temp431b6 = cost2f*10.d0*zb(indorbp, indt+i) + temp431b7 = rmu(i, 0)*temp431b6 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp431b6 + fun0b = fun0b + rmu(1, 0)*temp431b7 + rmub(1, 0) = rmub(1, 0) + fun0*temp431b7 END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp479b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp479b2 - fun0b = fun0b + rmu(i, 0)*temp479b2 + temp431b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp431b4 = rmu(i, 0)*temp431b3 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp431b3 + fun0b = fun0b + rmu(1, 0)*temp431b4 + rmub(1, 0) = rmub(1, 0) + fun0*temp431b4 + ELSE IF (branch .LT. 9) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 7) THEN + temp431b10 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp431b10 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp431b10 + rb(0) = rb(0) - fun0*2*r(0)*temp431b10 + END IF ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + temp431b11 = cost2f*10.d0*zb(indorbp, indt+i) + temp431b12 = rmu(i, 0)*temp431b11 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp431b11 + fun0b = fun0b + rmu(2, 0)*temp431b12 + rmub(2, 0) = rmub(2, 0) + fun0*temp431b12 END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + temp431b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp431b9 = rmu(i, 0)*temp431b8 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp431b8 + fun0b = fun0b + rmu(2, 0)*temp431b9 + rmub(2, 0) = rmub(2, 0) + fun0*temp431b9 + ELSE IF (branch .LT. 10) THEN + temp431b13 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp431b13 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp431b13 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp431b13 + ELSE + temp431b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp431b14 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp431b14 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp431b14 END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 16) THEN + IF (branch .LT. 14) THEN + IF (branch .LT. 13) THEN + IF (branch .LT. 12) THEN + temp431b15 = cost3f*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp431b15 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp431b15 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp431b15 + ELSE + temp431b16 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp431b16 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp431b16 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp431b16 + END IF + ELSE + temp431b17 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp431b17 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp431b17 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp431b17 END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 15) THEN + temp431b18 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp431b18 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp431b18 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp431b18 + ELSE + temp431b19 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp431b19 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp431b19 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp431b19 END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 19) THEN + IF (branch .LT. 18) THEN + IF (.NOT.branch .LT. 17) THEN + temp431b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp431b20 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp431b20 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp431b20 + END IF + ELSE + temp431b21 = cost4f*6.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp431b21 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp431b21 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp431b21 END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + ELSE IF (.NOT.branch .LT. 20) THEN + temp431b22 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp431b22 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp431b22 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp431b22 END IF - temp478 = fun/r(0) - temp478b17 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp478*rmu(i, 0)*zb(& -& indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp478*distp(0, 3+ic)*zb(indorbp, & + 150 temp431b = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - funb = funb + temp478b17 - rb(0) = rb(0) - temp478*temp478b17 + rmub(i, 0) = rmub(i, 0) + fun*temp431b + funb0 = funb0 + rmu(i, 0)*temp431b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp478b15 = dd1*distp(0, 1)*fun2b - temp478b16 = (dd1*r(0)-2.d0)*fun2b - dd1b = distp(0, 1)*temp478b16 - distp(0, 1)*r(0)*funb + r(0)*& -& temp478b15 - rb(0) = rb(0) + dd1*temp478b15 - distp(0, 1)*dd1*funb - distpb(0, 1) = distpb(0, 1) + (1.d0-dd1*r(0))*funb + dd1*& -& temp478b16 - distpb(0, 3) = distpb(0, 3) + fun0b + temp430 = rp3**3 + temp428 = distp(0, 1)/temp430 + temp429 = rp1**3 + temp429b = 0.25d0*temp428*fun2b + temp428b = 0.25d0*(22.d0*rp1-66.d0*rp2+178.d0*(rp1*rp2)+165.d0*rp1& +& **2+54.d0*(rp1**2*rp2)+rp1**3-2.d0*(temp429*rp2)-26.d0)*fun2b/& +& temp430 + temp427 = rp3**2 + temp426 = distp(0, 1)/temp427 + temp427b = 0.25d0*temp426*funb0 + rp1b = (2.d0*2*rp1-3.d0*rp2-36.d0)*temp427b + (3*rp1**2-2.d0*rp2*3& +& *rp1**2+54.d0*rp2*2*rp1+165.d0*2*rp1+178.d0*rp2+22.d0)*temp429b + temp426b = 0.25d0*(2.d0*rp1**2-36.d0*rp1-59.d0*rp2-3.d0*(rp1*rp2)-& +& 26.d0)*funb0/temp427 + temp424b0 = distp(0, 1)*fun0b + costb = -(r(0)**2*temp424b0) + rp3b = -(temp426*2*rp3*temp426b) - (0.5d0*rp2+1.d0)*costb/rp3**2 -& +& temp428*3*rp3**2*temp428b + rp2b = ((-59.d0)-3.d0*rp1)*temp427b + 2*(rp2+1.d0)*rp3b + 0.5d0*& +& costb/rp3 + (54.d0*rp1**2-2.d0*temp429+178.d0*rp1-66.d0)*& +& temp429b + temp425 = 4.d0*dd1 + temp424 = 9.d0/temp425 + distpb(0, 1) = distpb(0, 1) + temp426b + (temp424-r(0)**2*cost)*& +& fun0b + temp428b + dd1b = r(0)**2*rp1b - temp424*4.d0*temp424b0/temp425 + rb(0) = rb(0) + dd2*rp2b + dd1*2*r(0)*rp1b - cost*2*r(0)*temp424b0 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = r(0)*rp2b ELSE distpb = 0.0_8 dd1b = 0.0_8 + dd2b = 0.0_8 END IF - DO ic=5,1,-1 - DO i=0,0,-1 - distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=7,1,-1 + DO k=0,0,-1 + temp424b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) + temp423 = 4.d0*dd1 + temp422 = 9.d0/temp423 + temp422b = (temp422-r(k)**2*cost)*zb(indorbp, k) + dd1b = dd1b - temp422*4.d0*temp424b/temp423 + costb = -(r(k)**2*temp424b) + temp421 = dd2*r(k) + 1.d0 + temp422b0 = costb/temp421**2 + temp421b8 = -((0.5d0*(dd2*r(k))+1.d0)*2*temp422b0/temp421) + rb(k) = rb(k) + 0.5d0*dd2*temp422b0 + dd2*temp421b8 - cost*2*r(k& +& )*temp424b + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp422b + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp422b + zb(indorbp, k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = dd2b + r(k)*temp421b8 + 0.5d0*r(k)*temp422b0 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + temp421b0 = cost4f*rmu(2, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 8) - 2*rmu(2, i)*temp421b0 distpb(i, 8) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + temp421b1 = cost4f*rmu(1, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& +& distpb(i, 7) + 2*rmu(1, i)*temp421b1 + 3.d0*2*rmu(1, i)*& +& temp421b0 + rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp421b1 distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + temp421b2 = cost3f*2.d0*distpb(i, 6) + temp421b3 = rmu(2, i)*temp421b2 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp421b3 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp421b3 + rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp421b2 distpb(i, 6) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + temp421b4 = cost3f*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 5) + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp421b4 distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 4) - 2*rmu(2, i)*temp421b4 + temp421b5 = cost2f*rmu(2, i)*distpb(i, 4) + rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp421b5 distpb(i, 4) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distpb(i, 1) = distpb(i, 1) + r(i)*distpb(i, 3) - rb(i) = rb(i) + distp(i, 1)*distpb(i, 3) + temp421b6 = cost2f*rmu(1, i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 3) distpb(i, 3) = 0.0_8 + temp421b7 = cost1f*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - 2*r(i)*temp421b6 - 3.d0*2*r(i)*temp421b7 - 2*r(i)*& +& temp421b5 + rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& +& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp421b7 + 5.d0*2*rmu(3, i)*& +& temp421b6 + distpb(i, 2) = 0.0_8 END DO + cb = 0.0_8 DO k=0,0,-1 - temp478b14 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp478b14 - rb(k) = rb(k) - dd1*temp478b14 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp420 = dd2*r(k) + 1.d0 + temp421b = costb/temp420 + temp420b6 = -(dd1*r(k)**2*temp421b/temp420) + dd1b = dd1b + r(k)**2*temp421b + rb(k) = rb(k) + dd2*temp420b6 + dd1*2*r(k)*temp421b + dd2b = dd2b + r(k)*temp420b6 END DO - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (134) -! 2p single exponential r^3 e^{-z r} ! - dd2 = dd(indpar+1) - DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k))) - END DO -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun = distp(0, 1)*(3.d0-dd2*r(0))*r(0) -! fun= derivative of fun0 respect to r divided dy r - fun2 = distp(0, 1)*(dd2**2*r(0)**3-6*dd2*r(0)**2+6*r(0)) -! fun2= second derivative of fun0 respect to r -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp481b0 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp481b0 - fun2b = fun2b + temp481b0 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp481b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp481b - funb = funb + rmu(ic, 0)*temp481b - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - distpb = 0.0_8 - temp480 = r(0)**3 - temp480b2 = distp(0, 1)*fun2b - temp480b3 = (3.d0-dd2*r(0))*funb - distpb(0, 1) = r(0)*temp480b3 + r(0)**3*fun0b + (dd2**2*temp480-6*& -& (dd2*r(0)**2)+6*r(0))*fun2b - temp480b4 = distp(0, 1)*r(0)*funb - dd2b = (temp480*2*dd2-6*r(0)**2)*temp480b2 - r(0)*temp480b4 - rb(0) = rb(0) + distp(0, 1)*temp480b3 - dd2*temp480b4 + distp(0, 1& -& )*3*r(0)**2*fun0b + (dd2**2*3*r(0)**2-6*dd2*2*r(0)+6)*temp480b2 + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocf*2.25d0*dd1**1.25D0*cb ELSE - distpb = 0.0_8 - dd2b = 0.0_8 + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocf*2.25d0*dd1**1.25D0*& +& cb END IF - DO ic=3,1,-1 - DO i=0,0,-1 - temp480b1 = r(i)**3*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp480b1 - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp480b1 - rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*3*r(i)**2*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO k=0,0,-1 - temp480b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp480b0 - rb(k) = rb(k) - dd2*temp480b0 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (135) -! 2p single exponential r^4 e^{-z r} ! - dd2 = dd(indpar+1) + ddb(indparp) = ddb(indparp) + dd1b + CASE (47) +! d orbitals cartesian !!! +! R(r)= exp(-alpha r^2) +! each gaussian term is normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization + c = dd1**1.75d0*1.64592278064948967213d0 +! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) +! endif DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO -! indorbp=indorb - DO ic=1,3 + DO i=0,0 + distp(i, 2) = rmu(1, i)**2 + distp(i, 3) = rmu(2, i)**2 + distp(i, 4) = rmu(3, i)**2 +! lz=+/-2 + distp(i, 5) = rmu(1, i)*rmu(2, i)*cost3d +! lz=+/-1 + distp(i, 6) = rmu(2, i)*rmu(3, i)*cost3d +! lz=+/-1 + distp(i, 7) = rmu(1, i)*rmu(3, i)*cost3d + END DO + DO ic=1,6 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO ! endif - IF (typec .NE. 1) THEN - fun = distp(0, 1)*(4.d0-dd2*r(0))*r(0)**2 - fun2 = distp(0, 1)*(12*r(0)**2-8*dd2*r(0)**3+dd2**2*r(0)**4) + IF (typec .NE. 1) THEN + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1) + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) ! indorbp=indorb - DO ic=1,3 + DO ic=1,6 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + IF (ic .LE. 3) THEN + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 6) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) END IF END DO +!endif for ic +!enddo for i + IF (ic .LE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF END DO - funb = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=3,1,-1 - temp483b0 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp483b0 - fun2b = fun2b + temp483b0 - zb(indorbp, indt+4) = 0.0_8 + DO ic=6,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 2) THEN + temp432b1 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 6.d0*temp432b1 + fun2b = fun2b + temp432b1 + distpb(0, 1) = distpb(0, 1) + 2.d0*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + ELSE + temp432b2 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 6.d0*temp432b2 + fun2b = fun2b + temp432b2 + zb(indorbp, indt+4) = 0.0_8 + END IF DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp483b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp483b - funb = funb + rmu(ic, 0)*temp483b - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + IF (branch .LT. 7) THEN + IF (branch .LT. 4) THEN + IF (branch .LT. 3) THEN + IF (.NOT.branch .LT. 2) THEN + rmub(i, 0) = rmub(i, 0) + 2.d0*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + 2.d0*rmu(i, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 6) THEN + IF (.NOT.branch .LT. 5) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 10) THEN + IF (branch .LT. 9) THEN + IF (.NOT.branch .LT. 8) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + END IF + ELSE IF (branch .LT. 12) THEN + IF (branch .LT. 11) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + temp432b0 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp432b0 + funb0 = funb0 + rmu(i, 0)*temp432b0 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp482 = r(0)**4 - temp481 = r(0)**3 - temp481b3 = distp(0, 1)*fun2b - temp481b4 = (4.d0-dd2*r(0))*funb - distpb(0, 1) = r(0)**2*temp481b4 + r(0)**4*fun0b + (12*r(0)**2-8*(& -& dd2*temp481)+dd2**2*temp482)*fun2b - temp481b5 = distp(0, 1)*r(0)**2*funb - rb(0) = rb(0) + distp(0, 1)*2*r(0)*temp481b4 - dd2*temp481b5 + & -& distp(0, 1)*4*r(0)**3*fun0b + (dd2**2*4*r(0)**3-8*dd2*3*r(0)**2+& -& 12*2*r(0))*temp481b3 - dd2b = (temp482*2*dd2-8*temp481)*temp481b3 - r(0)*temp481b5 + temp432b = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp432b - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp432b + distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb0 + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd2b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=0,0,-1 - temp481b2 = r(i)**4*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp481b2 - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp481b2 - rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*4*r(i)**3*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=6,1,-1 + DO k=0,0,-1 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + DO i=0,0,-1 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 6) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + rmub(3, i) = rmub(3, i) + 2*rmu(3, i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + rmub(2, i) = rmub(2, i) + 2*rmu(2, i)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*distpb(i, 2) + distpb(i, 2) = 0.0_8 + END DO + dd1b = 0.0_8 + cb = 0.0_8 DO k=0,0,-1 - temp481b1 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp481b1 - rb(k) = rb(k) - dd2*temp481b1 + temp431 = r(k)**2 + temp431b24 = c*DEXP(-(dd1*temp431))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp431))*distpb(k, 1) + dd1b = dd1b - temp431*temp431b24 + rb(k) = rb(k) - dd1*2*r(k)*temp431b24 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (136) -! 2p single exponential r^5 e^{-z r} ! + dd1b = dd1b + 1.64592278064948967213d0*1.75d0*dd1**0.75D0*cb + ddb(indparp) = ddb(indparp) + dd1b + CASE (104) +! 2p double gaussian +! dd1 * x_mu (exp(-dd2 r^2)+dd3 * exp(-dd4*r^2)) dd2 = dd(indpar+1) + dd3 = dd(indpar+2) + dd4 = dd(indpar+3) DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k))) + distp(k, 1) = DEXP(-(dd2*r(k)**2)) + distp(k, 2) = DEXP(-(dd4*r(k)**2)) END DO ! indorbp=indorb DO ic=1,3 @@ -19191,8 +18642,9 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - fun = distp(0, 1)*(5.d0-dd2*r(0))*r(0)**3 - fun2 = distp(0, 1)*(20*r(0)**3-10*dd2*r(0)**4+dd2**2*r(0)**5) + fun = 2.d0*(-(dd2*distp(0, 1))-dd4*dd3*distp(0, 2)) + fun2 = 2.d0*(dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0, 1)+dd4*dd3*(-& +& 1.d0+2.d0*dd4*r(0)**2)*distp(0, 2)) ! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -19206,175 +18658,304 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp485b0 = rmu(ic, 0)*zb(indorbp, indt+4) + temp432b13 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp485b0 - fun2b = fun2b + temp485b0 + funb0 = funb0 + 4.d0*temp432b13 + fun2b = fun2b + temp432b13 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp485b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp485b - funb = funb + rmu(ic, 0)*temp485b + temp432b12 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp432b12 + funb0 = funb0 + rmu(ic, 0)*temp432b12 rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp484 = r(0)**5 - temp483 = r(0)**4 - temp483b3 = distp(0, 1)*fun2b - temp483b4 = r(0)**3*funb - distpb(0, 1) = (5.d0-dd2*r(0))*temp483b4 + r(0)**5*fun0b + (20*r(0& -& )**3-10*(dd2*temp483)+dd2**2*temp484)*fun2b - rb(0) = rb(0) + distp(0, 1)*(5.d0-dd2*r(0))*3*r(0)**2*funb - distp& -& (0, 1)*dd2*temp483b4 + distp(0, 1)*5*r(0)**4*fun0b + (dd2**2*5*r& -& (0)**4-10*dd2*4*r(0)**3+20*3*r(0)**2)*temp483b3 - dd2b = (temp484*2*dd2-10*temp483)*temp483b3 - distp(0, 1)*r(0)*& -& temp483b4 + temp432b6 = 2.d0*fun2b + temp432b7 = dd2*distp(0, 1)*2.d0*temp432b6 + temp432b8 = (2.d0*(dd2*r(0)**2)-1.d0)*temp432b6 + temp432b9 = (2.d0*(dd4*r(0)**2)-1.d0)*temp432b6 + temp432b10 = dd4*dd3*distp(0, 2)*2.d0*temp432b6 + temp432b11 = 2.d0*funb0 + dd2b = distp(0, 1)*temp432b8 - distp(0, 1)*temp432b11 + r(0)**2*& +& temp432b7 + rb(0) = rb(0) + dd4*2*r(0)*temp432b10 + dd2*2*r(0)*temp432b7 + distpb(0, 1) = dd2*temp432b8 + dd4b = r(0)**2*temp432b10 - distp(0, 2)*dd3*temp432b11 + distp(0, & +& 2)*dd3*temp432b9 + dd3b = distp(0, 2)*fun0b - distp(0, 2)*dd4*temp432b11 + distp(0, 2& +& )*dd4*temp432b9 + distpb(0, 2) = dd4*dd3*temp432b9 + distpb(0, 1) = distpb(0, 1) - dd2*temp432b11 + distpb(0, 2) = distpb(0, 2) - dd4*dd3*temp432b11 + distpb(0, 1) = distpb(0, 1) + fun0b + distpb(0, 2) = distpb(0, 2) + dd3*fun0b ELSE distpb = 0.0_8 dd2b = 0.0_8 + dd3b = 0.0_8 + dd4b = 0.0_8 END IF DO ic=3,1,-1 DO i=0,0,-1 - temp483b2 = r(i)**5*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp483b2 - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp483b2 - rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*5*r(i)**4*zb(indorbp, i) + temp432b5 = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& +& indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp432b5 + dd3b = dd3b + distp(i, 2)*temp432b5 + distpb(i, 2) = distpb(i, 2) + dd3*temp432b5 zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=0,0,-1 - temp483b1 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp483b1 - rb(k) = rb(k) - dd2*temp483b1 + temp432b3 = DEXP(-(dd4*r(k)**2))*distpb(k, 2) + dd4b = dd4b - r(k)**2*temp432b3 + distpb(k, 2) = 0.0_8 + temp432b4 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + rb(k) = rb(k) - dd2*2*r(k)*temp432b4 - dd4*2*r(k)*temp432b3 + dd2b = dd2b - r(k)**2*temp432b4 distpb(k, 1) = 0.0_8 END DO + ddb(indpar+3) = ddb(indpar+3) + dd4b + ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (137) -! 2s with cusp condition -! dd1*(exp(-dd2*r)*(1+dd2*r)) - dd2 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=1.d0/dsqrt(1/4.d0/dd2**3+12*dd2/(2.d0*dd2)**4+ -! &3*dd2**2/4/dd2**5)/dsqrt(4.0*pi) + CASE (199) +! derivative of 200 LA COSTANTE + indorbp = indorb + 1 ! endif + IF (typec .NE. 1) THEN + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + zb(indorbp, indt+i) = 0.0_8 + END DO + END IF + DO i=0,0,-1 + zb(indorbp, i) = 0.0_8 + END DO + distpb = 0.0_8 + CASE (11) +! R(r)=r**2*(exp(-z1*r)+p*exp(-z2*r)) +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd(indpar+3) +! if(iflagnorm.gt.2) then + c = 1.d0/2.d0/DSQRT(pi*720.d0*(1.d0/(2.d0*dd1)**7+2.d0*peff/(dd1+dd2& +& )**7+peff**2/(2.d0*dd2)**7)) +! endif DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 2) = c*DEXP(-(dd2*r(k))) END DO -! endif IF (typec .NE. 1) THEN - fun = -(dd2**2*distp(0, 1)) - funb = 2.d0*zb(indorbp, indt+4) + rp1 = r(0)**2 +! the first derivative + fun = distp(0, 1)*(2.d0*r(0)-dd1*rp1) + peff*distp(0, 2)*(2.d0*r(0& +& )-dd2*rp1) +! +! the second derivative + temp441b = 2.d0*zb(indorbp, indt+4)/r(0) + funb0 = temp441b + rb(0) = rb(0) - fun*temp441b/r(0) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + temp440 = fun/r(0) + temp440b8 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(i, 0) = rmub(i, 0) + temp440*zb(indorbp, indt+i) + funb0 = funb0 + temp440b8 + rb(0) = rb(0) - temp440*temp440b8 zb(indorbp, indt+i) = 0.0_8 END DO - funb = funb + (1.d0-dd2*r(0))*fun2b - dd2b = -(distp(0, 1)*2*dd2*funb) - fun*r(0)*fun2b - rb(0) = rb(0) - fun*dd2*fun2b distpb = 0.0_8 - distpb(0, 1) = -(dd2**2*funb) + temp440b2 = distp(0, 1)*fun2b + temp440b3 = (dd2**2*rp1-4.d0*(dd2*r(0))+2.d0)*fun2b + temp440b4 = peff*distp(0, 2)*fun2b + distpb(0, 1) = (dd1**2*rp1-4.d0*(dd1*r(0))+2.d0)*fun2b + temp440b5 = distp(0, 1)*funb0 + dd1b = (rp1*2*dd1-4.d0*r(0))*temp440b2 - rp1*temp440b5 + temp440b6 = peff*distp(0, 2)*funb0 + rp1b = dd2**2*temp440b4 - dd2*temp440b6 - dd1*temp440b5 + dd1**2*& +& temp440b2 + rb(0) = rb(0) + 2.d0*temp440b5 + 2.d0*temp440b6 + 2*r(0)*rp1b - & +& 4.d0*dd2*temp440b4 - 4.d0*dd1*temp440b2 + temp440b7 = (2.d0*r(0)-dd2*rp1)*funb0 + peffb = distp(0, 2)*temp440b7 + distp(0, 2)*temp440b3 + distpb(0, 2) = peff*temp440b3 + dd2b = (rp1*2*dd2-4.d0*r(0))*temp440b4 - rp1*temp440b6 + distpb(0, 1) = distpb(0, 1) + (2.d0*r(0)-dd1*rp1)*funb0 + distpb(0, 2) = distpb(0, 2) + peff*temp440b7 ELSE distpb = 0.0_8 + peffb = 0.0_8 + dd1b = 0.0_8 dd2b = 0.0_8 END IF DO i=0,0,-1 - temp485b2 = distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + (dd2*r(i)+1.d0)*zb(indorbp, i) - dd2b = dd2b + r(i)*temp485b2 - rb(i) = rb(i) + dd2*temp485b2 + temp440b1 = r(i)**2*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp440b1 + peffb = peffb + distp(i, 2)*temp440b1 + distpb(i, 2) = distpb(i, 2) + peff*temp440b1 + rb(i) = rb(i) + (distp(i, 1)+peff*distp(i, 2))*2*r(i)*zb(indorbp, & +& i) zb(indorbp, i) = 0.0_8 END DO + cb = 0.0_8 DO k=0,0,-1 - temp485b1 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp485b1 - rb(k) = rb(k) - dd2*temp485b1 + temp440b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp440b + distpb(k, 2) = 0.0_8 + temp440b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp440b0 - dd2*temp440b + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp440b0 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (138) -! 2s with cusp condition -! ( -dd2*r^2*exp(-dd2*r)) ! with no cusp condition der of 137 - dd2 = dd(indpar+1) + temp439 = 2.d0**7 + temp438 = temp439*dd2**7 + temp437 = peff**2/temp438 + temp436 = (dd1+dd2)**7 + temp435 = 2.d0**7 + temp434 = temp435*dd1**7 + temp433 = 720.d0*pi*(1.0/temp434+2.d0*peff/temp436+temp437) + temp432 = DSQRT(temp433) + IF (temp433 .EQ. 0.0) THEN + temp432b14 = 0.0 + ELSE + temp432b14 = -(pi*720.d0*cb/(2.d0*temp432**2*2.D0*DSQRT(temp433))) + END IF + temp432b15 = 2.d0*temp432b14/temp436 + temp432b16 = -(peff*7*(dd1+dd2)**6*temp432b15/temp436) + dd1b = dd1b + temp432b16 - temp435*7*dd1**6*temp432b14/temp434**2 + peffb = peffb + 2*peff*temp432b14/temp438 + temp432b15 + dd2b = dd2b + temp432b16 - temp437*temp439*7*dd2**6*temp432b14/& +& temp438 + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (39) +! 4s single zeta +! R(r)=r**3*exp(-z1*r) +! +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 +! c=dsqrt((2*dd1)**7/720.d0/pi)/2.d0 + c = dd1**3.5d0*0.11894160774351807429d0 +! c=-c +! endif + c0 = -c + c1 = 3.5d0*c/dd1 DO k=0,0 - distp(k, 1) = -(dd2*DEXP(-(dd2*r(k)))) + distp(k, 1) = DEXP(-(dd1*r(k))) END DO -! endif IF (typec .NE. 1) THEN - fun = (2.d0-dd2*r(0))*distp(0, 1) - funb = 2.d0*zb(indorbp, indt+4) + rp1 = r(0)**3 + rp2 = r(0)**2 +! fun=(2.d0-dd1*r(0))*distp(0,1) +! fun2=(2.d0-4*dd1*r(0)+(dd1*r(0))**2)*distp(0,1) +! +!c the first derivative/r + fun = distp(0, 1)*(c0*(3.d0*r(0)-dd1*rp2)+c1*(2.d0-dd1*r(0))) +!c +!c the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp485b4 = distp(0, 1)*fun2b - temp485b5 = 2*dd2*r(0)*temp485b4 - dd2b = r(0)*temp485b5 - 4*r(0)*temp485b4 - distp(0, 1)*r(0)*funb - rb(0) = rb(0) + dd2*temp485b5 - 4*dd2*temp485b4 - distp(0, 1)*dd2*& -& funb - distpb(0, 1) = (2.d0-dd2*r(0))*funb + ((dd2*r(0))**2-4*(dd2*r(0))+& -& 2.d0)*fun2b + temp443 = (dd1*r(0))**2 - 4*(dd1*r(0)) + 2.d0 + temp444 = 6.d0*r(0) - 6.d0*dd1*rp2 + dd1**2*rp1 + temp445b = distp(0, 1)*fun2b + temp444b = c0*temp445b + temp443b = c1*temp445b + temp443b0 = 2*dd1*r(0)*temp443b + temp442 = 3.d0*r(0) - dd1*rp2 + distpb(0, 1) = (c0*temp442+c1*(2.d0-dd1*r(0)))*funb0 + (c0*temp444& +& +c1*temp443)*fun2b + temp443b1 = distp(0, 1)*funb0 + c0b = temp442*temp443b1 + temp444*temp445b + temp442b0 = c0*temp443b1 + rp2b = -(dd1*temp442b0) - 6.d0*dd1*temp444b + rp1b = dd1**2*temp444b + rb(0) = rb(0) + 3.d0*temp442b0 - c1*dd1*temp443b1 + 3*r(0)**2*rp1b& +& + 2*r(0)*rp2b - 4*dd1*temp443b + dd1*temp443b0 + 6.d0*temp444b + dd1b = r(0)*temp443b0 - c1*r(0)*temp443b1 - 4*r(0)*temp443b - rp2*& +& temp442b0 + (rp1*2*dd1-6.d0*rp2)*temp444b + c1b = (2.d0-dd1*r(0))*temp443b1 + temp443*temp445b ELSE distpb = 0.0_8 - dd2b = 0.0_8 + c0b = 0.0_8 + c1b = 0.0_8 + dd1b = 0.0_8 END IF DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) + temp442b = distp(i, 1)*zb(indorbp, i) + temp441 = r(i)**3 + c0b = c0b + temp441*temp442b + rb(i) = rb(i) + (c1*2*r(i)+c0*3*r(i)**2)*temp442b + c1b = c1b + r(i)**2*temp442b + distpb(i, 1) = distpb(i, 1) + (c0*temp441+c1*r(i)**2)*zb(indorbp, & +& i) zb(indorbp, i) = 0.0_8 END DO DO k=0,0,-1 - temp485b3 = -(dd2*DEXP(-(dd2*r(k)))*distpb(k, 1)) - dd2b = dd2b - r(k)*temp485b3 - DEXP(-(dd2*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd2*temp485b3 + temp441b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp441b1 + rb(k) = rb(k) - dd1*temp441b1 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (139) + temp441b0 = 3.5d0*c1b/dd1 + cb = temp441b0 - c0b + dd1b = dd1b + 0.11894160774351807429d0*3.5d0*dd1**2.5D0*cb - c*& +& temp441b0/dd1 + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (132) +! +! 3p single zeta ! 2s with cusp condition -! ( r^3*exp(-dd2*r)) ! der of 128 +! ( r^3*exp(-dd2*r)) ! with no cusp condition dd2 = dd(indpar+1) indorbp = indorb + 1 DO k=0,0 - distp(k, 1) = -(DEXP(-(dd2*r(k)))*r(k)) + distp(k, 1) = DEXP(-(dd2*r(k)))*r(k) END DO ! endif IF (typec .NE. 1) THEN fun = (3.d0-dd2*r(0))*distp(0, 1) - funb = 2.d0*zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp485b7 = distp(0, 1)*fun2b - temp485b8 = 2*dd2*r(0)*temp485b7 - dd2b = r(0)*temp485b8 - 6*r(0)*temp485b7 - distp(0, 1)*r(0)*funb - rb(0) = rb(0) + dd2*temp485b8 - 6*dd2*temp485b7 - distp(0, 1)*dd2*& -& funb - distpb(0, 1) = (3.d0-dd2*r(0))*funb + ((dd2*r(0))**2-6*(dd2*r(0))+& -& 6.d0)*fun2b + temp445b1 = distp(0, 1)*fun2b + temp445b2 = 2*dd2*r(0)*temp445b1 + dd2b = r(0)*temp445b2 - 6*r(0)*temp445b1 - distp(0, 1)*r(0)*funb0 + rb(0) = rb(0) + dd2*temp445b2 - 6*dd2*temp445b1 - distp(0, 1)*dd2*& +& funb0 + distpb(0, 1) = (3.d0-dd2*r(0))*funb0 + ((dd2*r(0))**2-6*(dd2*r(0))& +& +6.d0)*fun2b ELSE distpb = 0.0_8 dd2b = 0.0_8 @@ -19385,202 +18966,1033 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd zb(indorbp, i) = 0.0_8 END DO DO k=0,0,-1 - temp485b6 = -(r(k)*DEXP(-(dd2*r(k)))*distpb(k, 1)) - dd2b = dd2b - r(k)*temp485b6 - rb(k) = rb(k) - DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2*temp485b6 + temp445b0 = r(k)*DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp445b0 + rb(k) = rb(k) + DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2*temp445b0 distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (140) -! 2p single exponential -r e^{-z r} ! der of 121 - dd2 = dd(indpar+1) + CASE (30) +! 3d without cusp and one parmater + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c= & +! &1.d0/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) + c = dd1**3.5d0*0.26596152026762178d0 +! endif DO k=0,0 - distp(k, 1) = -DEXP(-(dd2*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k))) END DO -! indorbp=indorb - DO ic=1,3 + DO i=0,0 + distp(i, 3) = distp(i, 1) +! lz=0 + distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d +! lz=+/-2 + distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d +! lz=+/-2 + distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d +! lz=+/-1 + distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d +! lz=+/-1 + distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d + END DO +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = distp(0, 1)*(1.d0-dd2*r(0))/r(0) - fun2 = dd2*(dd2*r(0)-2.d0)*distp(0, 1) + fun0 = distp(0, 3) + fun = -(dd1*distp(0, 1)) + fun2 = dd1**2*distp(0, 1) ! indorbp=indorb - DO ic=1,3 + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + IF (ic .EQ. 1) THEN + IF (i .NE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO END DO - funb = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=3,1,-1 - temp486b2 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp486b2 - fun2b = fun2b + temp486b2 + DO ic=5,1,-1 + temp446 = fun/r(0) + temp447b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp446b3 = 6.d0*temp447b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp446+fun2)*zb(& +& indorbp, indt+4) + funb0 = funb0 + temp446b3 + rb(0) = rb(0) - temp446*temp446b3 + fun2b = fun2b + temp447b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp486b1 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp486b1 - funb = funb + rmu(ic, 0)*temp486b1 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp446b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp446b + fun0b = fun0b + rmu(i, 0)*temp446b + ELSE + temp446b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp446b0 + fun0b = fun0b + rmu(i, 0)*temp446b0 + END IF + ELSE IF (branch .LT. 4) THEN + temp446b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp446b1 + fun0b = fun0b + rmu(i, 0)*temp446b1 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp446b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp446b2 + fun0b = fun0b + rmu(i, 0)*temp446b2 + ELSE + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + temp445 = fun/r(0) + temp445b4 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp445*rmu(i, 0)*zb(& +& indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp445*distp(0, 3+ic)*zb(indorbp, & +& indt+i) + funb0 = funb0 + temp445b4 + rb(0) = rb(0) - temp445*temp445b4 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp486b = dd2*distp(0, 1)*fun2b - temp486b0 = (dd2*r(0)-2.d0)*fun2b - temp485 = distp(0, 1)/r(0) - dd2b = distp(0, 1)*temp486b0 - temp485*r(0)*funb + r(0)*temp486b - temp485b11 = (1.d0-dd2*r(0))*funb/r(0) - rb(0) = rb(0) + distp(0, 1)*fun0b - temp485*dd2*funb - temp485*& -& temp485b11 + dd2*temp486b - distpb(0, 1) = temp485b11 + r(0)*fun0b + dd2*temp486b0 + dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb0 + distpb(0, 1) = distpb(0, 1) + dd1**2*fun2b - dd1*funb0 + distpb(0, 3) = distpb(0, 3) + fun0b ELSE distpb = 0.0_8 - dd2b = 0.0_8 + dd1b = 0.0_8 END IF - DO ic=3,1,-1 + DO ic=5,1,-1 DO i=0,0,-1 - temp485b10 = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*r(i)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + r(i)*temp485b10 - rb(i) = rb(i) + distp(i, 1)*temp485b10 + distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + DO i=0,0,-1 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + distpb(i, 8) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + distpb(i, 1) = distpb(i, 1) + distpb(i, 3) + distpb(i, 3) = 0.0_8 + END DO + cb = 0.0_8 DO k=0,0,-1 - temp485b9 = -(DEXP(-(dd2*r(k)))*distpb(k, 1)) - dd2b = dd2b - r(k)*temp485b9 - rb(k) = rb(k) - dd2*temp485b9 + temp445b3 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp445b3 + rb(k) = rb(k) - dd1*temp445b3 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (141) -! 2p single exponential r^2 e^{-z r} ! parent of 121 - dd2 = dd(indpar+1) + dd1b = dd1b + 0.26596152026762178d0*3.5d0*dd1**2.5D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (73) +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization obtained by Mathematica + c = dd1**3.75d0*0.43985656185609913955d0 +! C= dd1^15/4 /Sqrt[Integrate[x^14 Exp[-2 x^2],{x,0,Infinity}]] +! endif DO k=0,0 - distp(k, 1) = -DEXP(-(dd2*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + END DO + DO i=0,0 + DO k=1,6 + CALL PUSHREAL8(adr8ibuf,adr8buf,zv(k)) + zv(k) = rmu(3, i)**k + CALL PUSHREAL8(adr8ibuf,adr8buf,yv(k)) + yv(k) = rmu(2, i)**k + CALL PUSHREAL8(adr8ibuf,adr8buf,xv(k)) + xv(k) = rmu(1, i)**k + END DO + CALL PUSHREAL8(adr8ibuf,adr8buf,r2) + r2 = xv(2) + yv(2) + zv(2) + CALL PUSHREAL8(adr8ibuf,adr8buf,r4) + r4 = r2*r2 + r6 = r2*r4 +! lz=0 + distp(i, 2) = cost1i*(231.d0*zv(6)-315.d0*zv(4)*r2+105.d0*zv(2)*r4& +& -5.d0*r6) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = 33.d0*zv(5) - 30.d0*zv(3)*r2 + 5.d0*zv(1)*r4 +! lz=+/-1 + distp(i, 3) = cost2i*rmu(1, i)*cost +! lz=+/-1 + distp(i, 4) = cost2i*rmu(2, i)*cost + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = 33.d0*zv(4) - 18.d0*zv(2)*r2 + r4 +! lz=+/-2 + distp(i, 5) = cost3i*(xv(2)-yv(2))*cost +! lz=+/-2 + distp(i, 6) = 2.d0*cost3i*xv(1)*yv(1)*cost + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = 11.d0*zv(3) - 3.d0*zv(1)*r2 +! lz=+/-3 + distp(i, 7) = cost4i*(xv(3)-3.d0*xv(1)*yv(2))*cost +! lz=+/-3 + distp(i, 8) = -(cost4i*(yv(3)-3.d0*yv(1)*xv(2))*cost) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = 11.d0*zv(2) - r2 +! lz=+/-4 + distp(i, 9) = cost5i*(xv(4)-6.d0*xv(2)*yv(2)+yv(4))*cost +! lz=+/-4 + distp(i, 10) = cost5i*4.d0*(xv(3)*yv(1)-yv(3)*xv(1))*cost +! lz=+/-5 + distp(i, 11) = cost6i*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4))*& +& zv(1) +! lz=+/-5 + distp(i, 12) = -(cost6i*(-(5.d0*xv(4)*yv(1))+10.d0*xv(2)*yv(3)-yv(& +& 5))*zv(1)) +! lz=+/-6 + distp(i, 13) = cost7i*(xv(6)-15.d0*xv(4)*yv(2)+15.d0*xv(2)*yv(4)-& +& yv(6)) +! lz=+/-6 + distp(i, 14) = -(cost7i*(-(6.d0*xv(5)*yv(1))+20.d0*xv(3)*yv(3)-& +& 6.d0*yv(5)*xv(1))) END DO -! indorbp=indorb - DO ic=1,3 + DO ic=1,13 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO ! endif IF (typec .NE. 1) THEN - fun = distp(0, 1)*(2.d0-dd2*r(0)) - fun2 = (2.d0-4.d0*dd2*r(0)+(dd2*r(0))**2)*distp(0, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1) + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) + DO k=1,6 + CALL PUSHREAL8(adr8ibuf,adr8buf,zv(k)) + zv(k) = rmu(3, 0)**k + CALL PUSHREAL8(adr8ibuf,adr8buf,yv(k)) + yv(k) = rmu(2, 0)**k + CALL PUSHREAL8(adr8ibuf,adr8buf,xv(k)) + xv(k) = rmu(1, 0)**k + END DO ! indorbp=indorb - DO ic=1,3 + DO ic=1,13 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO + IF (ic .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + ELSE IF (ic .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (ic .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE IF (ic .EQ. 4) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (ic .EQ. 5) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + ELSE IF (ic .EQ. 6) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE IF (ic .EQ. 7) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (ic .EQ. 8) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + ELSE IF (ic .EQ. 9) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE IF (ic .EQ. 10) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (ic .EQ. 11) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE IF (ic .EQ. 12) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE IF (ic .EQ. 13) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + END IF END DO - funb = 0.0_8 + distpb = 0.0_8 + zvb = 0.0_8 + xvb = 0.0_8 + funb0 = 0.0_8 + yvb = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=3,1,-1 - temp486b8 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp486b8 - fun2b = fun2b + temp486b8 + DO ic=13,1,-1 + temp448b91 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (14.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 14.d0*temp448b91 + fun2b = fun2b + temp448b91 zb(indorbp, indt+4) = 0.0_8 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 7) THEN + IF (branch .LT. 4) THEN + IF (branch .LT. 2) THEN + IF (branch .LT. 1) THEN + temp448b13 = cost1i*fun0*zb(indorbp, indt+3) + temp448b14 = 360.d0*zv(1)*temp448b13 + fun0b = fun0b + cost1i*(360.d0*(xv(2)*yv(1)*zv(2))-60.d0& +& *(xv(2)*yv(3))-30.d0*yv(5)-30.d0*(xv(4)*yv(1))+360.d0*& +& (yv(3)*zv(2))-240.d0*(yv(1)*zv(4)))*zb(indorbp, indt+2& +& ) + cost1i*(360.d0*(xv(3)*zv(2))-60.d0*(xv(3)*yv(2))-& +& 30.d0*(xv(1)*yv(4))-30.d0*xv(5)+360.d0*(xv(1)*yv(2)*zv& +& (2))-240.d0*(xv(1)*zv(4)))*zb(indorbp, indt+1) + & +& cost1i*(180.d0*(xv(4)*zv(1))+360.d0*(xv(2)*yv(2)*zv(1)& +& )+180.d0*(yv(4)*zv(1))+96.d0*zv(5)-480.d0*(yv(2)*zv(3)& +& )-480.d0*(xv(2)*zv(3)))*zb(indorbp, indt+3) + xvb(4) = xvb(4) + 180.d0*zv(1)*temp448b13 + zvb(1) = zvb(1) + (180.d0*yv(4)+360.d0*xv(2)*yv(2)+& +& 180.d0*xv(4))*temp448b13 + temp448b15 = cost1i*fun0*zb(indorbp, indt+2) + temp448b16 = 360.d0*zv(2)*temp448b15 + xvb(2) = xvb(2) + yv(1)*temp448b16 - 60.d0*yv(3)*& +& temp448b15 - 480.d0*zv(3)*temp448b13 + yv(2)*& +& temp448b14 + yvb(2) = yvb(2) + xv(2)*temp448b14 - 480.d0*zv(3)*& +& temp448b13 + yvb(4) = yvb(4) + 180.d0*zv(1)*temp448b13 + zvb(5) = zvb(5) + 96.d0*temp448b13 + zvb(3) = zvb(3) + (-(480.d0*xv(2))-480.d0*yv(2))*& +& temp448b13 + yvb(1) = yvb(1) + (-(240.d0*zv(4))-30.d0*xv(4))*& +& temp448b15 + xv(2)*temp448b16 + zvb(2) = zvb(2) + (360.d0*yv(3)+360.d0*xv(2)*yv(1))*& +& temp448b15 + yvb(3) = yvb(3) + (360.d0*zv(2)-60.d0*xv(2))*temp448b15 + yvb(5) = yvb(5) - 30.d0*temp448b15 + xvb(4) = xvb(4) - 30.d0*yv(1)*temp448b15 + zvb(4) = zvb(4) - 240.d0*yv(1)*temp448b15 + temp448b17 = cost1i*fun0*zb(indorbp, indt+1) + temp448b18 = 360.d0*zv(2)*temp448b17 + xvb(3) = xvb(3) + (360.d0*zv(2)-60.d0*yv(2))*temp448b17 + zvb(2) = zvb(2) + (360.d0*xv(1)*yv(2)+360.d0*xv(3))*& +& temp448b17 + yvb(2) = yvb(2) + xv(1)*temp448b18 - 60.d0*xv(3)*& +& temp448b17 + xvb(1) = xvb(1) + yv(2)*temp448b18 + (-(240.d0*zv(4))-& +& 30.d0*yv(4))*temp448b17 + yvb(4) = yvb(4) - 30.d0*xv(1)*temp448b17 + xvb(5) = xvb(5) - 30.d0*temp448b17 + zvb(4) = zvb(4) - 240.d0*xv(1)*temp448b17 + ELSE + temp448b19 = cost2i*fun0*zb(indorbp, indt+3) + temp448b20 = -(60.d0*zv(2)*temp448b19) + fun0b = fun0b + cost2i*(20.d0*(xv(3)*yv(1)*zv(1))+20.d0*& +& (xv(1)*yv(3)*zv(1))-40.d0*(xv(1)*yv(1)*zv(3)))*zb(& +& indorbp, indt+2) + cost2i*(25.d0*(xv(4)*zv(1))+30.d0*(& +& xv(2)*yv(2)*zv(1))+5.d0*(yv(4)*zv(1))+8.d0*zv(5)-20.d0& +& *(yv(2)*zv(3))-60.d0*(xv(2)*zv(3)))*zb(indorbp, indt+1& +& ) + cost2i*(5.d0*xv(5)+10.d0*(xv(3)*yv(2))+5.d0*(yv(4)& +& *xv(1))+40.d0*(xv(1)*zv(4))-60.d0*(xv(1)*yv(2)*zv(2))-& +& 60.d0*(xv(3)*zv(2)))*zb(indorbp, indt+3) + xvb(5) = xvb(5) + 5.d0*temp448b19 + xvb(3) = xvb(3) + (10.d0*yv(2)-60.d0*zv(2))*temp448b19 + yvb(2) = yvb(2) + xv(1)*temp448b20 + 10.d0*xv(3)*& +& temp448b19 + yvb(4) = yvb(4) + 5.d0*xv(1)*temp448b19 + xvb(1) = xvb(1) + yv(2)*temp448b20 + (40.d0*zv(4)+5.d0*& +& yv(4))*temp448b19 + zvb(4) = zvb(4) + 40.d0*xv(1)*temp448b19 + zvb(2) = zvb(2) + (-(60.d0*xv(3))-60.d0*xv(1)*yv(2))*& +& temp448b19 + temp448b21 = cost2i*fun0*zb(indorbp, indt+2) + temp448b22 = 20.d0*zv(1)*temp448b21 + temp448b23 = 20.d0*zv(1)*temp448b21 + temp448b24 = -(40.d0*zv(3)*temp448b21) + xvb(3) = xvb(3) + yv(1)*temp448b22 + yvb(1) = yvb(1) + xv(1)*temp448b24 + xv(3)*temp448b22 + zvb(1) = zvb(1) + (20.d0*xv(1)*yv(3)+20.d0*xv(3)*yv(1))*& +& temp448b21 + xvb(1) = xvb(1) + yv(1)*temp448b24 + yv(3)*temp448b23 + yvb(3) = yvb(3) + xv(1)*temp448b23 + zvb(3) = zvb(3) - 40.d0*xv(1)*yv(1)*temp448b21 + temp448b25 = cost2i*fun0*zb(indorbp, indt+1) + temp448b26 = 30.d0*zv(1)*temp448b25 + xvb(4) = xvb(4) + 25.d0*zv(1)*temp448b25 + zvb(1) = zvb(1) + (5.d0*yv(4)+30.d0*xv(2)*yv(2)+25.d0*xv& +& (4))*temp448b25 + xvb(2) = xvb(2) + yv(2)*temp448b26 - 60.d0*zv(3)*& +& temp448b25 + yvb(2) = yvb(2) + xv(2)*temp448b26 - 20.d0*zv(3)*& +& temp448b25 + yvb(4) = yvb(4) + 5.d0*zv(1)*temp448b25 + zvb(5) = zvb(5) + 8.d0*temp448b25 + zvb(3) = zvb(3) + (-(60.d0*xv(2))-20.d0*yv(2))*& +& temp448b25 + END IF + ELSE IF (branch .LT. 3) THEN + temp448b27 = -(cost2i*fun0*zb(indorbp, indt+3)) + temp448b28 = 60.d0*zv(2)*temp448b27 + fun0b = fun0b - cost2i*(20.d0*(xv(2)*zv(3))-30.d0*(xv(2)*& +& yv(2)*zv(1))-25.d0*(yv(4)*zv(1))-5.d0*(xv(4)*zv(1))+& +& 60.d0*(yv(2)*zv(3))-8.d0*zv(5))*zb(indorbp, indt+2) - & +& cost2i*(40.d0*(xv(1)*yv(1)*zv(3))-20.d0*(xv(1)*yv(3)*zv(& +& 1))-20.d0*(xv(3)*yv(1)*zv(1)))*zb(indorbp, indt+1) - & +& cost2i*(60.d0*(xv(2)*yv(1)*zv(2))-10.d0*(xv(2)*yv(3))-& +& 5.d0*yv(5)-5.d0*(xv(4)*yv(1))+60.d0*(yv(3)*zv(2))-40.d0*& +& (yv(1)*zv(4)))*zb(indorbp, indt+3) + xvb(2) = xvb(2) + yv(1)*temp448b28 - 10.d0*yv(3)*& +& temp448b27 + yvb(1) = yvb(1) + (-(40.d0*zv(4))-5.d0*xv(4))*temp448b27 +& +& xv(2)*temp448b28 + zvb(2) = zvb(2) + (60.d0*yv(3)+60.d0*xv(2)*yv(1))*& +& temp448b27 + yvb(3) = yvb(3) + (60.d0*zv(2)-10.d0*xv(2))*temp448b27 + yvb(5) = yvb(5) - 5.d0*temp448b27 + xvb(4) = xvb(4) - 5.d0*yv(1)*temp448b27 + zvb(4) = zvb(4) - 40.d0*yv(1)*temp448b27 + temp448b29 = -(cost2i*fun0*zb(indorbp, indt+2)) + temp448b30 = -(30.d0*zv(1)*temp448b29) + xvb(2) = xvb(2) + yv(2)*temp448b30 + 20.d0*zv(3)*& +& temp448b29 + zvb(3) = zvb(3) + (60.d0*yv(2)+20.d0*xv(2))*temp448b29 + yvb(2) = yvb(2) + 60.d0*zv(3)*temp448b29 + xv(2)*& +& temp448b30 + zvb(1) = zvb(1) + (-(5.d0*xv(4))-25.d0*yv(4)-30.d0*xv(2)*& +& yv(2))*temp448b29 + yvb(4) = yvb(4) - 25.d0*zv(1)*temp448b29 + xvb(4) = xvb(4) - 5.d0*zv(1)*temp448b29 + zvb(5) = zvb(5) - 8.d0*temp448b29 + temp448b31 = -(cost2i*fun0*zb(indorbp, indt+1)) + temp448b32 = 40.d0*zv(3)*temp448b31 + temp448b33 = -(20.d0*zv(1)*temp448b31) + temp448b34 = -(20.d0*zv(1)*temp448b31) + xvb(1) = xvb(1) + yv(3)*temp448b33 + yv(1)*temp448b32 + yvb(1) = yvb(1) + xv(3)*temp448b34 + xv(1)*temp448b32 + zvb(3) = zvb(3) + 40.d0*xv(1)*yv(1)*temp448b31 + yvb(3) = yvb(3) + xv(1)*temp448b33 + zvb(1) = zvb(1) + (-(20.d0*xv(3)*yv(1))-20.d0*xv(1)*yv(3))& +& *temp448b31 + xvb(3) = xvb(3) + yv(1)*temp448b34 + ELSE + temp448b35 = cost3i*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost3i*(2.d0*(xv(4)*yv(1))-4.d0*(xv(2)*yv(& +& 3))-6.d0*yv(5)+64.d0*(yv(3)*zv(2))-32.d0*(yv(1)*zv(4)))*& +& zb(indorbp, indt+2) + cost3i*(6.d0*xv(5)+4.d0*(xv(3)*yv(& +& 2))-2.d0*(xv(1)*yv(4))+32.d0*(xv(1)*zv(4))-64.d0*(xv(3)*& +& zv(2)))*zb(indorbp, indt+1) + cost3i*(32.d0*(yv(4)*zv(1)& +& )-32.d0*(xv(4)*zv(1))+64.d0*(xv(2)*zv(3))-64.d0*(yv(2)*& +& zv(3)))*zb(indorbp, indt+3) + yvb(4) = yvb(4) + 32.d0*zv(1)*temp448b35 + zvb(1) = zvb(1) + (32.d0*yv(4)-32.d0*xv(4))*temp448b35 + xvb(4) = xvb(4) - 32.d0*zv(1)*temp448b35 + xvb(2) = xvb(2) + 64.d0*zv(3)*temp448b35 + zvb(3) = zvb(3) + (64.d0*xv(2)-64.d0*yv(2))*temp448b35 + yvb(2) = yvb(2) - 64.d0*zv(3)*temp448b35 + temp448b36 = cost3i*fun0*zb(indorbp, indt+2) + xvb(4) = xvb(4) + 2.d0*yv(1)*temp448b36 + yvb(1) = yvb(1) + (2.d0*xv(4)-32.d0*zv(4))*temp448b36 + xvb(2) = xvb(2) - 4.d0*yv(3)*temp448b36 + yvb(3) = yvb(3) + (64.d0*zv(2)-4.d0*xv(2))*temp448b36 + yvb(5) = yvb(5) - 6.d0*temp448b36 + zvb(2) = zvb(2) + 64.d0*yv(3)*temp448b36 + temp448b37 = cost3i*fun0*zb(indorbp, indt+1) + zvb(4) = zvb(4) + 32.d0*xv(1)*temp448b37 - 32.d0*yv(1)*& +& temp448b36 + xvb(5) = xvb(5) + 6.d0*temp448b37 + xvb(3) = xvb(3) + (4.d0*yv(2)-64.d0*zv(2))*temp448b37 + yvb(2) = yvb(2) + 4.d0*xv(3)*temp448b37 + xvb(1) = xvb(1) + (32.d0*zv(4)-2.d0*yv(4))*temp448b37 + yvb(4) = yvb(4) - 2.d0*xv(1)*temp448b37 + zvb(2) = zvb(2) - 64.d0*xv(3)*temp448b37 + END IF + ELSE IF (branch .LT. 6) THEN + IF (branch .LT. 5) THEN + temp448b38 = -(cost3i*fun0*zb(indorbp, indt+3)) + temp448b39 = 64.d0*zv(1)*temp448b38 + temp448b40 = 64.d0*zv(1)*temp448b38 + temp448b41 = -(128.d0*zv(3)*temp448b38) + fun0b = fun0b - cost3i*(32.d0*(xv(3)*zv(2))-12.d0*(xv(3)*& +& yv(2))-10.d0*(xv(1)*yv(4))-2.d0*xv(5)+96.d0*(xv(1)*yv(2)& +& *zv(2))-32.d0*(xv(1)*zv(4)))*zb(indorbp, indt+2) - & +& cost3i*(96.d0*(xv(2)*yv(1)*zv(2))-12.d0*(xv(2)*yv(3))-& +& 2.d0*yv(5)-10.d0*(xv(4)*yv(1))+32.d0*(yv(3)*zv(2))-32.d0& +& *(yv(1)*zv(4)))*zb(indorbp, indt+1) - cost3i*(64.d0*(xv(& +& 3)*yv(1)*zv(1))+64.d0*(xv(1)*yv(3)*zv(1))-128.d0*(xv(1)*& +& yv(1)*zv(3)))*zb(indorbp, indt+3) + xvb(3) = xvb(3) + yv(1)*temp448b39 + yvb(1) = yvb(1) + xv(1)*temp448b41 + xv(3)*temp448b39 + zvb(1) = zvb(1) + (64.d0*xv(1)*yv(3)+64.d0*xv(3)*yv(1))*& +& temp448b38 + xvb(1) = xvb(1) + yv(1)*temp448b41 + yv(3)*temp448b40 + yvb(3) = yvb(3) + xv(1)*temp448b40 + zvb(3) = zvb(3) - 128.d0*xv(1)*yv(1)*temp448b38 + temp448b42 = -(cost3i*fun0*zb(indorbp, indt+2)) + temp448b43 = 96.d0*zv(2)*temp448b42 + xvb(3) = xvb(3) + (32.d0*zv(2)-12.d0*yv(2))*temp448b42 + zvb(2) = zvb(2) + (96.d0*xv(1)*yv(2)+32.d0*xv(3))*& +& temp448b42 + yvb(2) = yvb(2) + xv(1)*temp448b43 - 12.d0*xv(3)*& +& temp448b42 + xvb(1) = xvb(1) + yv(2)*temp448b43 + (-(32.d0*zv(4))-10.d0& +& *yv(4))*temp448b42 + yvb(4) = yvb(4) - 10.d0*xv(1)*temp448b42 + xvb(5) = xvb(5) - 2.d0*temp448b42 + zvb(4) = zvb(4) - 32.d0*xv(1)*temp448b42 + temp448b44 = -(cost3i*fun0*zb(indorbp, indt+1)) + temp448b45 = 96.d0*zv(2)*temp448b44 + xvb(2) = xvb(2) + yv(1)*temp448b45 - 12.d0*yv(3)*& +& temp448b44 + yvb(1) = yvb(1) + (-(32.d0*zv(4))-10.d0*xv(4))*temp448b44 & +& + xv(2)*temp448b45 + zvb(2) = zvb(2) + (32.d0*yv(3)+96.d0*xv(2)*yv(1))*& +& temp448b44 + yvb(3) = yvb(3) + (32.d0*zv(2)-12.d0*xv(2))*temp448b44 + yvb(5) = yvb(5) - 2.d0*temp448b44 + xvb(4) = xvb(4) - 10.d0*yv(1)*temp448b44 + zvb(4) = zvb(4) - 32.d0*yv(1)*temp448b44 + ELSE + temp448b46 = cost4i*fun0*zb(indorbp, indt+3) + temp448b47 = -(72.d0*zv(2)*temp448b46) + fun0b = fun0b + cost4i*(12.d0*(xv(3)*yv(1)*zv(1))+36.d0*(& +& xv(1)*yv(3)*zv(1))-48.d0*(xv(1)*yv(1)*zv(3)))*zb(indorbp& +& , indt+2) + cost4i*(18.d0*(xv(2)*yv(2)*zv(1))-15.d0*(xv(& +& 4)*zv(1))+9.d0*(yv(4)*zv(1))+24.d0*(xv(2)*zv(3))-24.d0*(& +& yv(2)*zv(3)))*zb(indorbp, indt+1) + cost4i*(6.d0*(xv(3)*& +& yv(2))-3.d0*xv(5)+9.d0*(xv(1)*yv(4))+24.d0*(xv(3)*zv(2))& +& -72.d0*(xv(1)*yv(2)*zv(2)))*zb(indorbp, indt+3) + xvb(3) = xvb(3) + (24.d0*zv(2)+6.d0*yv(2))*temp448b46 + yvb(2) = yvb(2) + xv(1)*temp448b47 + 6.d0*xv(3)*temp448b46 + xvb(5) = xvb(5) - 3.d0*temp448b46 + xvb(1) = xvb(1) + yv(2)*temp448b47 + 9.d0*yv(4)*temp448b46 + yvb(4) = yvb(4) + 9.d0*xv(1)*temp448b46 + zvb(2) = zvb(2) + (24.d0*xv(3)-72.d0*xv(1)*yv(2))*& +& temp448b46 + temp448b48 = cost4i*fun0*zb(indorbp, indt+2) + temp448b49 = 12.d0*zv(1)*temp448b48 + temp448b50 = 36.d0*zv(1)*temp448b48 + temp448b51 = -(48.d0*zv(3)*temp448b48) + xvb(3) = xvb(3) + yv(1)*temp448b49 + yvb(1) = yvb(1) + xv(1)*temp448b51 + xv(3)*temp448b49 + zvb(1) = zvb(1) + (36.d0*xv(1)*yv(3)+12.d0*xv(3)*yv(1))*& +& temp448b48 + xvb(1) = xvb(1) + yv(1)*temp448b51 + yv(3)*temp448b50 + yvb(3) = yvb(3) + xv(1)*temp448b50 + zvb(3) = zvb(3) - 48.d0*xv(1)*yv(1)*temp448b48 + temp448b52 = cost4i*fun0*zb(indorbp, indt+1) + temp448b53 = 18.d0*zv(1)*temp448b52 + xvb(2) = xvb(2) + 24.d0*zv(3)*temp448b52 + yv(2)*& +& temp448b53 + yvb(2) = yvb(2) + xv(2)*temp448b53 - 24.d0*zv(3)*& +& temp448b52 + zvb(1) = zvb(1) + (9.d0*yv(4)-15.d0*xv(4)+18.d0*xv(2)*yv(2& +& ))*temp448b52 + xvb(4) = xvb(4) - 15.d0*zv(1)*temp448b52 + yvb(4) = yvb(4) + 9.d0*zv(1)*temp448b52 + zvb(3) = zvb(3) + (24.d0*xv(2)-24.d0*yv(2))*temp448b52 + END IF + ELSE + temp448b54 = -(cost4i*fun0*zb(indorbp, indt+3)) + temp448b55 = -(72.d0*zv(2)*temp448b54) + fun0b = fun0b - cost4i*(9.d0*(xv(4)*zv(1))+18.d0*(xv(2)*yv(2& +& )*zv(1))-15.d0*(yv(4)*zv(1))+24.d0*(yv(2)*zv(3))-24.d0*(xv& +& (2)*zv(3)))*zb(indorbp, indt+2) - cost4i*(36.d0*(xv(3)*yv(& +& 1)*zv(1))+12.d0*(xv(1)*yv(3)*zv(1))-48.d0*(xv(1)*yv(1)*zv(& +& 3)))*zb(indorbp, indt+1) - cost4i*(9.d0*(xv(4)*yv(1))+6.d0& +& *(xv(2)*yv(3))-3.d0*yv(5)+24.d0*(yv(3)*zv(2))-72.d0*(xv(2)& +& *yv(1)*zv(2)))*zb(indorbp, indt+3) + xvb(4) = xvb(4) + 9.d0*yv(1)*temp448b54 + yvb(1) = yvb(1) + xv(2)*temp448b55 + 9.d0*xv(4)*temp448b54 + xvb(2) = xvb(2) + yv(1)*temp448b55 + 6.d0*yv(3)*temp448b54 + yvb(3) = yvb(3) + (24.d0*zv(2)+6.d0*xv(2))*temp448b54 + yvb(5) = yvb(5) - 3.d0*temp448b54 + zvb(2) = zvb(2) + (24.d0*yv(3)-72.d0*xv(2)*yv(1))*temp448b54 + temp448b56 = -(cost4i*fun0*zb(indorbp, indt+2)) + temp448b57 = 18.d0*zv(1)*temp448b56 + xvb(4) = xvb(4) + 9.d0*zv(1)*temp448b56 + zvb(1) = zvb(1) + (18.d0*xv(2)*yv(2)-15.d0*yv(4)+9.d0*xv(4))& +& *temp448b56 + xvb(2) = xvb(2) + yv(2)*temp448b57 - 24.d0*zv(3)*temp448b56 + yvb(2) = yvb(2) + 24.d0*zv(3)*temp448b56 + xv(2)*temp448b57 + yvb(4) = yvb(4) - 15.d0*zv(1)*temp448b56 + zvb(3) = zvb(3) + (24.d0*yv(2)-24.d0*xv(2))*temp448b56 + temp448b58 = -(cost4i*fun0*zb(indorbp, indt+1)) + temp448b59 = 36.d0*zv(1)*temp448b58 + temp448b60 = 12.d0*zv(1)*temp448b58 + temp448b61 = -(48.d0*zv(3)*temp448b58) + xvb(3) = xvb(3) + yv(1)*temp448b59 + yvb(1) = yvb(1) + xv(1)*temp448b61 + xv(3)*temp448b59 + zvb(1) = zvb(1) + (12.d0*xv(1)*yv(3)+36.d0*xv(3)*yv(1))*& +& temp448b58 + xvb(1) = xvb(1) + yv(1)*temp448b61 + yv(3)*temp448b60 + yvb(3) = yvb(3) + xv(1)*temp448b60 + zvb(3) = zvb(3) - 48.d0*xv(1)*yv(1)*temp448b58 + END IF + ELSE IF (branch .LT. 11) THEN + IF (branch .LT. 9) THEN + IF (branch .LT. 8) THEN + temp448b62 = cost5i*fun0*zb(indorbp, indt+3) + temp448b63 = -(120.d0*zv(1)*temp448b62) + fun0b = fun0b + cost5i*(10.d0*(xv(4)*yv(1))+20.d0*(xv(2)*& +& yv(3))-6.d0*yv(5)+40.d0*(yv(3)*zv(2))-120.d0*(xv(2)*yv(1& +& )*zv(2)))*zb(indorbp, indt+2) + cost5i*(20.d0*(xv(3)*yv(& +& 2))-6.d0*xv(5)+10.d0*(xv(1)*yv(4))+40.d0*(xv(3)*zv(2))-& +& 120.d0*(xv(1)*yv(2)*zv(2)))*zb(indorbp, indt+1) + cost5i& +& *(20.d0*(xv(4)*zv(1))-120.d0*(xv(2)*yv(2)*zv(1))+20.d0*(& +& yv(4)*zv(1)))*zb(indorbp, indt+3) + xvb(4) = xvb(4) + 20.d0*zv(1)*temp448b62 + zvb(1) = zvb(1) + (20.d0*yv(4)-120.d0*xv(2)*yv(2)+20.d0*xv& +& (4))*temp448b62 + xvb(2) = xvb(2) + yv(2)*temp448b63 + yvb(2) = yvb(2) + xv(2)*temp448b63 + yvb(4) = yvb(4) + 20.d0*zv(1)*temp448b62 + temp448b64 = cost5i*fun0*zb(indorbp, indt+2) + temp448b65 = -(120.d0*zv(2)*temp448b64) + xvb(4) = xvb(4) + 10.d0*yv(1)*temp448b64 + yvb(1) = yvb(1) + xv(2)*temp448b65 + 10.d0*xv(4)*& +& temp448b64 + xvb(2) = xvb(2) + yv(1)*temp448b65 + 20.d0*yv(3)*& +& temp448b64 + yvb(3) = yvb(3) + (40.d0*zv(2)+20.d0*xv(2))*temp448b64 + yvb(5) = yvb(5) - 6.d0*temp448b64 + temp448b66 = cost5i*fun0*zb(indorbp, indt+1) + zvb(2) = zvb(2) + (40.d0*xv(3)-120.d0*xv(1)*yv(2))*& +& temp448b66 + (40.d0*yv(3)-120.d0*xv(2)*yv(1))*temp448b64 + temp448b67 = -(120.d0*zv(2)*temp448b66) + xvb(3) = xvb(3) + (40.d0*zv(2)+20.d0*yv(2))*temp448b66 + yvb(2) = yvb(2) + xv(1)*temp448b67 + 20.d0*xv(3)*& +& temp448b66 + xvb(5) = xvb(5) - 6.d0*temp448b66 + xvb(1) = xvb(1) + yv(2)*temp448b67 + 10.d0*yv(4)*& +& temp448b66 + yvb(4) = yvb(4) + 10.d0*xv(1)*temp448b66 + ELSE + temp448b68 = -(cost5i*fun0*zb(indorbp, indt+3)) + temp448b69 = 80.d0*zv(1)*temp448b68 + temp448b70 = -(80.d0*zv(1)*temp448b68) + fun0b = fun0b - cost5i*(4.d0*xv(5)-20.d0*(xv(1)*yv(4))+& +& 120.d0*(xv(1)*yv(2)*zv(2))-40.d0*(xv(3)*zv(2)))*zb(& +& indorbp, indt+2) - cost5i*(20.d0*(xv(4)*yv(1))-4.d0*yv(5& +& )+40.d0*(yv(3)*zv(2))-120.d0*(xv(2)*yv(1)*zv(2)))*zb(& +& indorbp, indt+1) - cost5i*(80.d0*(xv(1)*yv(3)*zv(1))-& +& 80.d0*(xv(3)*yv(1)*zv(1)))*zb(indorbp, indt+3) + xvb(1) = xvb(1) + yv(3)*temp448b69 + yvb(3) = yvb(3) + xv(1)*temp448b69 + zvb(1) = zvb(1) + (80.d0*xv(1)*yv(3)-80.d0*xv(3)*yv(1))*& +& temp448b68 + xvb(3) = xvb(3) + yv(1)*temp448b70 + yvb(1) = yvb(1) + xv(3)*temp448b70 + temp448b71 = -(cost5i*fun0*zb(indorbp, indt+2)) + temp448b72 = 120.d0*zv(2)*temp448b71 + xvb(5) = xvb(5) + 4.d0*temp448b71 + xvb(1) = xvb(1) + yv(2)*temp448b72 - 20.d0*yv(4)*& +& temp448b71 + yvb(4) = yvb(4) - 20.d0*xv(1)*temp448b71 + yvb(2) = yvb(2) + xv(1)*temp448b72 + temp448b73 = -(cost5i*fun0*zb(indorbp, indt+1)) + zvb(2) = zvb(2) + (40.d0*yv(3)-120.d0*xv(2)*yv(1))*& +& temp448b73 + (120.d0*xv(1)*yv(2)-40.d0*xv(3))*temp448b71 + xvb(3) = xvb(3) - 40.d0*zv(2)*temp448b71 + temp448b74 = -(120.d0*zv(2)*temp448b73) + xvb(4) = xvb(4) + 20.d0*yv(1)*temp448b73 + yvb(1) = yvb(1) + xv(2)*temp448b74 + 20.d0*xv(4)*& +& temp448b73 + yvb(5) = yvb(5) - 4.d0*temp448b73 + yvb(3) = yvb(3) + 40.d0*zv(2)*temp448b73 + xvb(2) = xvb(2) + yv(1)*temp448b74 + END IF + ELSE IF (branch .LT. 10) THEN + temp448b75 = cost6i*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost6i*(20.d0*(xv(1)*yv(3)*zv(1))-20.d0*(xv(& +& 3)*yv(1)*zv(1)))*zb(indorbp, indt+2) + cost6i*(5.d0*(xv(4)& +& *zv(1))-30.d0*(xv(2)*yv(2)*zv(1))+5.d0*(yv(4)*zv(1)))*zb(& +& indorbp, indt+1) + cost6i*(xv(5)-10.d0*(xv(3)*yv(2))+5.d0*& +& (xv(1)*yv(4)))*zb(indorbp, indt+3) + xvb(5) = xvb(5) + temp448b75 + xvb(3) = xvb(3) - 10.d0*yv(2)*temp448b75 + yvb(2) = yvb(2) - 10.d0*xv(3)*temp448b75 + temp448b76 = cost6i*fun0*zb(indorbp, indt+2) + temp448b77 = 20.d0*zv(1)*temp448b76 + xvb(1) = xvb(1) + yv(3)*temp448b77 + 5.d0*yv(4)*temp448b75 + yvb(4) = yvb(4) + 5.d0*xv(1)*temp448b75 + temp448b78 = -(20.d0*zv(1)*temp448b76) + yvb(3) = yvb(3) + xv(1)*temp448b77 + temp448b79 = cost6i*fun0*zb(indorbp, indt+1) + zvb(1) = zvb(1) + (5.d0*yv(4)-30.d0*xv(2)*yv(2)+5.d0*xv(4))*& +& temp448b79 + (20.d0*xv(1)*yv(3)-20.d0*xv(3)*yv(1))*& +& temp448b76 + xvb(3) = xvb(3) + yv(1)*temp448b78 + yvb(1) = yvb(1) + xv(3)*temp448b78 + temp448b80 = -(30.d0*zv(1)*temp448b79) + xvb(4) = xvb(4) + 5.d0*zv(1)*temp448b79 + xvb(2) = xvb(2) + yv(2)*temp448b80 + yvb(2) = yvb(2) + xv(2)*temp448b80 + yvb(4) = yvb(4) + 5.d0*zv(1)*temp448b79 + ELSE + temp448b81 = -(cost6i*fun0*zb(indorbp, indt+3)) + fun0b = fun0b - cost6i*(30.d0*(xv(2)*yv(2)*zv(1))-5.d0*(xv(4& +& )*zv(1))-5.d0*(yv(4)*zv(1)))*zb(indorbp, indt+2) - cost6i*& +& (20.d0*(xv(1)*yv(3)*zv(1))-20.d0*(xv(3)*yv(1)*zv(1)))*zb(& +& indorbp, indt+1) - cost6i*(10.d0*(xv(2)*yv(3))-5.d0*(xv(4)& +& *yv(1))-yv(5))*zb(indorbp, indt+3) + xvb(2) = xvb(2) + 10.d0*yv(3)*temp448b81 + yvb(3) = yvb(3) + 10.d0*xv(2)*temp448b81 + xvb(4) = xvb(4) - 5.d0*yv(1)*temp448b81 + yvb(1) = yvb(1) - 5.d0*xv(4)*temp448b81 + yvb(5) = yvb(5) - temp448b81 + temp448b82 = -(cost6i*fun0*zb(indorbp, indt+2)) + temp448b83 = 30.d0*zv(1)*temp448b82 + xvb(2) = xvb(2) + yv(2)*temp448b83 + yvb(2) = yvb(2) + xv(2)*temp448b83 + temp448b84 = -(cost6i*fun0*zb(indorbp, indt+1)) + zvb(1) = zvb(1) + (20.d0*xv(1)*yv(3)-20.d0*xv(3)*yv(1))*& +& temp448b84 + (30.d0*xv(2)*yv(2)-5.d0*xv(4)-5.d0*yv(4))*& +& temp448b82 + xvb(4) = xvb(4) - 5.d0*zv(1)*temp448b82 + yvb(4) = yvb(4) - 5.d0*zv(1)*temp448b82 + temp448b85 = 20.d0*zv(1)*temp448b84 + temp448b86 = -(20.d0*zv(1)*temp448b84) + xvb(1) = xvb(1) + yv(3)*temp448b85 + yvb(3) = yvb(3) + xv(1)*temp448b85 + xvb(3) = xvb(3) + yv(1)*temp448b86 + yvb(1) = yvb(1) + xv(3)*temp448b86 + END IF + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 12) THEN + temp448b87 = cost7i*fun0*zb(indorbp, indt+2) + fun0b = fun0b + cost7i*(6.d0*xv(5)-60.d0*(xv(3)*yv(2))+30.d0& +& *(xv(1)*yv(4)))*zb(indorbp, indt+1) + cost7i*(60.d0*(xv(2)& +& *yv(3))-30.d0*(xv(4)*yv(1))-6.d0*yv(5))*zb(indorbp, indt+2& +& ) + xvb(2) = xvb(2) + 60.d0*yv(3)*temp448b87 + yvb(3) = yvb(3) + 60.d0*xv(2)*temp448b87 + xvb(4) = xvb(4) - 30.d0*yv(1)*temp448b87 + yvb(1) = yvb(1) - 30.d0*xv(4)*temp448b87 + yvb(5) = yvb(5) - 6.d0*temp448b87 + temp448b88 = cost7i*fun0*zb(indorbp, indt+1) + xvb(5) = xvb(5) + 6.d0*temp448b88 + xvb(3) = xvb(3) - 60.d0*yv(2)*temp448b88 + yvb(2) = yvb(2) - 60.d0*xv(3)*temp448b88 + xvb(1) = xvb(1) + 30.d0*yv(4)*temp448b88 + yvb(4) = yvb(4) + 30.d0*xv(1)*temp448b88 + END IF + ELSE + temp448b89 = -(cost7i*fun0*zb(indorbp, indt+2)) + fun0b = fun0b - cost7i*(60.d0*(xv(2)*yv(3))-30.d0*(xv(4)*yv(1)& +& )-6.d0*yv(5))*zb(indorbp, indt+1) - cost7i*(60.d0*(xv(3)*yv(& +& 2))-6.d0*xv(5)-30.d0*(xv(1)*yv(4)))*zb(indorbp, indt+2) + xvb(3) = xvb(3) + 60.d0*yv(2)*temp448b89 + yvb(2) = yvb(2) + 60.d0*xv(3)*temp448b89 + xvb(5) = xvb(5) - 6.d0*temp448b89 + xvb(1) = xvb(1) - 30.d0*yv(4)*temp448b89 + yvb(4) = yvb(4) - 30.d0*xv(1)*temp448b89 + temp448b90 = -(cost7i*fun0*zb(indorbp, indt+1)) + xvb(2) = xvb(2) + 60.d0*yv(3)*temp448b90 + yvb(3) = yvb(3) + 60.d0*xv(2)*temp448b90 + xvb(4) = xvb(4) - 30.d0*yv(1)*temp448b90 + yvb(1) = yvb(1) - 30.d0*xv(4)*temp448b90 + yvb(5) = yvb(5) - 6.d0*temp448b90 + END IF DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp486b7 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp486b7 - funb = funb + rmu(ic, 0)*temp486b7 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + temp448b12 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp448b12 + funb0 = funb0 + rmu(i, 0)*temp448b12 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp486b5 = distp(0, 1)*fun2b - temp486b6 = 2*dd2*r(0)*temp486b5 - dd2b = r(0)*temp486b6 - 4.d0*r(0)*temp486b5 - distp(0, 1)*r(0)*& -& funb - rb(0) = rb(0) + distp(0, 1)*2*r(0)*fun0b - distp(0, 1)*dd2*funb - & -& 4.d0*dd2*temp486b5 + dd2*temp486b6 - distpb(0, 1) = (2.d0-dd2*r(0))*funb + r(0)**2*fun0b + ((dd2*r(0))& -& **2-4.d0*(dd2*r(0))+2.d0)*fun2b + DO k=6,1,-1 + CALL POPREAL8(adr8ibuf,adr8buf,xv(k)) + IF (.NOT.(rmu(1, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(1, 0) = rmub(1, 0) + k*rmu(1, 0)**(k-1)*xvb(k) + xvb(k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,yv(k)) + IF (.NOT.(rmu(2, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(2, 0) = rmub(2, 0) + k*rmu(2, 0)**(k-1)*yvb(k) + yvb(k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,zv(k)) + IF (.NOT.(rmu(3, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(3, 0) = rmub(3, 0) + k*rmu(3, 0)**(k-1)*zvb(k) + zvb(k) = 0.0_8 + END DO + temp448b11 = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp448b11 - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp448b11 + distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb0 + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd2b = 0.0_8 + zvb = 0.0_8 + xvb = 0.0_8 + yvb = 0.0_8 END IF - DO ic=3,1,-1 - DO i=0,0,-1 - temp486b4 = r(i)**2*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp486b4 - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp486b4 - rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*2*r(i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=13,1,-1 + DO k=0,0,-1 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO i=0,0,-1 + temp448b = -(cost7i*distpb(i, 14)) + xvb(3) = xvb(3) + 20.d0*yv(3)*temp448b + yvb(3) = yvb(3) + 20.d0*xv(3)*temp448b + xvb(5) = xvb(5) - 6.d0*yv(1)*temp448b + yvb(1) = yvb(1) - 6.d0*xv(5)*temp448b + yvb(5) = yvb(5) - 6.d0*xv(1)*temp448b + xvb(1) = xvb(1) - 6.d0*yv(5)*temp448b + distpb(i, 14) = 0.0_8 + temp448b0 = cost7i*distpb(i, 13) + xvb(6) = xvb(6) + temp448b0 + xvb(4) = xvb(4) - 15.d0*yv(2)*temp448b0 + yvb(2) = yvb(2) - 15.d0*xv(4)*temp448b0 + distpb(i, 13) = 0.0_8 + temp448b1 = -(cost6i*zv(1)*distpb(i, 12)) + xvb(2) = xvb(2) + 10.d0*yv(3)*temp448b1 + 15.d0*yv(4)*temp448b0 + yvb(4) = yvb(4) + 15.d0*xv(2)*temp448b0 + yvb(6) = yvb(6) - temp448b0 + yvb(3) = yvb(3) + 10.d0*xv(2)*temp448b1 + xvb(4) = xvb(4) - 5.d0*yv(1)*temp448b1 + yvb(1) = yvb(1) - 5.d0*xv(4)*temp448b1 + yvb(5) = yvb(5) - temp448b1 + zvb(1) = zvb(1) - cost6i*(10.d0*(xv(2)*yv(3))-5.d0*(xv(4)*yv(1))-& +& yv(5))*distpb(i, 12) + distpb(i, 12) = 0.0_8 + temp448b2 = cost6i*zv(1)*distpb(i, 11) + xvb(5) = xvb(5) + temp448b2 + xvb(3) = xvb(3) - 10.d0*yv(2)*temp448b2 + yvb(2) = yvb(2) - 10.d0*xv(3)*temp448b2 + xvb(1) = xvb(1) + 5.d0*yv(4)*temp448b2 + yvb(4) = yvb(4) + 5.d0*xv(1)*temp448b2 + zvb(1) = zvb(1) + cost6i*(xv(5)-10.d0*(xv(3)*yv(2))+5.d0*(xv(1)*yv& +& (4)))*distpb(i, 11) + distpb(i, 11) = 0.0_8 + temp448b3 = cost5i*4.d0*distpb(i, 10) + temp448b4 = cost*temp448b3 + xvb(3) = xvb(3) + yv(1)*temp448b4 + yvb(1) = yvb(1) + xv(3)*temp448b4 + yvb(3) = yvb(3) - xv(1)*temp448b4 + xvb(1) = xvb(1) - yv(3)*temp448b4 + distpb(i, 10) = 0.0_8 + costb = cost5i*(xv(4)-6.d0*(xv(2)*yv(2))+yv(4))*distpb(i, 9) + (xv& +& (3)*yv(1)-yv(3)*xv(1))*temp448b3 + temp448b5 = cost5i*cost*distpb(i, 9) + xvb(4) = xvb(4) + temp448b5 + distpb(i, 9) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp448b6 = -(cost4i*cost*distpb(i, 8)) + xvb(2) = xvb(2) - 3.d0*yv(1)*temp448b6 - 6.d0*yv(2)*temp448b5 + yvb(2) = yvb(2) - 6.d0*xv(2)*temp448b5 + yvb(4) = yvb(4) + temp448b5 + zvb(2) = zvb(2) + 11.d0*costb + r2b = -costb + yvb(3) = yvb(3) + temp448b6 + yvb(1) = yvb(1) - 3.d0*xv(2)*temp448b6 + costb = -(cost4i*(yv(3)-3.d0*(yv(1)*xv(2)))*distpb(i, 8)) + distpb(i, 8) = 0.0_8 + temp448b7 = cost4i*cost*distpb(i, 7) + xvb(3) = xvb(3) + temp448b7 + costb = costb + cost4i*(xv(3)-3.d0*(xv(1)*yv(2)))*distpb(i, 7) + distpb(i, 7) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp448b8 = cost3i*2.d0*distpb(i, 6) + xvb(1) = xvb(1) + yv(1)*cost*temp448b8 - 3.d0*yv(2)*temp448b7 + yvb(2) = yvb(2) - 3.d0*xv(1)*temp448b7 + zvb(3) = zvb(3) + 11.d0*costb + zvb(1) = zvb(1) - 3.d0*r2*costb + r2b = r2b - 3.d0*zv(1)*costb + distpb(i, 6) = 0.0_8 + temp448b9 = cost3i*distpb(i, 5) + costb = (xv(2)-yv(2))*temp448b9 + yv(1)*xv(1)*temp448b8 + yvb(1) = yvb(1) + xv(1)*cost*temp448b8 + xvb(2) = xvb(2) + cost*temp448b9 + yvb(2) = yvb(2) - cost*temp448b9 + distpb(i, 5) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + zvb(4) = zvb(4) + 33.d0*costb + zvb(2) = zvb(2) - 18.d0*r2*costb + r2b = r2b - 18.d0*zv(2)*costb + r4b = costb + rmub(2, i) = rmub(2, i) + cost2i*cost*distpb(i, 4) + costb = cost2i*rmu(2, i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost2i*cost*distpb(i, 3) + costb = costb + cost2i*rmu(1, i)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + zvb(5) = zvb(5) + 33.d0*costb + zvb(3) = zvb(3) - 30.d0*r2*costb + temp448b10 = cost1i*distpb(i, 2) + r6b = -(5.d0*temp448b10) + r4b = r4b + 105.d0*zv(2)*temp448b10 + r2*r6b + 5.d0*zv(1)*costb + r2b = r2b + 2*r2*r4b - 315.d0*zv(4)*temp448b10 + r4*r6b - 30.d0*zv& +& (3)*costb + zvb(1) = zvb(1) + 5.d0*r4*costb + zvb(6) = zvb(6) + 231.d0*temp448b10 + zvb(4) = zvb(4) - 315.d0*r2*temp448b10 + zvb(2) = zvb(2) + r2b + 105.d0*r4*temp448b10 + distpb(i, 2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,r4) + CALL POPREAL8(adr8ibuf,adr8buf,r2) + xvb(2) = xvb(2) + r2b + yvb(2) = yvb(2) + r2b + DO k=6,1,-1 + CALL POPREAL8(adr8ibuf,adr8buf,xv(k)) + IF (.NOT.(rmu(1, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(1, i) = rmub(1, i) + k*rmu(1, i)**(k-1)*xvb(k) + xvb(k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,yv(k)) + IF (.NOT.(rmu(2, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(2, i) = rmub(2, i) + k*rmu(2, i)**(k-1)*yvb(k) + yvb(k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,zv(k)) + IF (.NOT.(rmu(3, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(3, i) = rmub(3, i) + k*rmu(3, i)**(k-1)*zvb(k) + zvb(k) = 0.0_8 END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + dd1b = 0.0_8 + cb = 0.0_8 DO k=0,0,-1 - temp486b3 = -(DEXP(-(dd2*r(k)))*distpb(k, 1)) - dd2b = dd2b - r(k)*temp486b3 - rb(k) = rb(k) - dd2*temp486b3 + temp447 = r(k)**2 + temp447b0 = c*DEXP(-(dd1*temp447))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp447))*distpb(k, 1) + dd1b = dd1b - temp447*temp447b0 + rb(k) = rb(k) - dd1*2*r(k)*temp447b0 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (142) -! der of 127 -! 4d one parmater - dd1 = dd(indpar+1) + dd1b = dd1b + 0.43985656185609913955d0*3.75d0*dd1**2.75D0*cb + ddb(indparp) = ddb(indparp) + dd1b + CASE (65) +! 2s gaussian for pseudo +! d orbitals +! R(r)= c0 r^3 exp(-alpha r^2)+ c1 r exp(-alpha r^2) +! each gaussian term is normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization to be done +! c=8.d0/dsqrt(21.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) + c = dd1**2.25d0*1.24420067280413253d0 +! endif + c0 = -c + c1 = 2.25d0*c/dd1 DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = distp(i, 1)*r(i) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) - distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) - distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) - distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) - distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) - distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d +! lz=0 + distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d +! lz=+/-2 + distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d +! lz=+/-2 + distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d +! lz=+/-1 + distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d +! lz=+/-1 + distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d END DO -! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun0 = -distp(0, 3) - fun = -((1.d0-dd1*r(0))*distp(0, 1)) - fun2 = -(dd1*(dd1*r(0)-2.d0)*distp(0, 1)) + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + rp1 = 2.d0*dd1*r(0) + rp2 = rp1*r(0) + fun0 = distp(0, 1)*(c1*r(0)+c0*r(0)**3) + fun = (c1*(1.d0-rp2)+c0*r(0)**2*(3.d0-rp2))*distp(0, 1)/r(0) + fun2 = distp(0, 1)*(c1*rp1*(rp2-3.d0)+c0*r(0)*(3.d0-3.5d0*rp2+& +& 0.5d0*rp2**2)) ! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -19631,18 +20043,15 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=5,1,-1 - temp487 = fun/r(0) - temp488b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp487b3 = 6.d0*temp488b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp487+fun2)*zb(& -& indorbp, indt+4) - funb = funb + temp487b3 - rb(0) = rb(0) - temp487*temp487b3 - fun2b = fun2b + temp488b + temp455b4 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 6.d0*temp455b4 + fun2b = fun2b + temp455b4 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -19650,24 +20059,24 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN IF (branch .LT. 2) THEN - temp487b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp487b - fun0b = fun0b + rmu(i, 0)*temp487b + temp455b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp455b0 + fun0b = fun0b + rmu(i, 0)*temp455b0 ELSE - temp487b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp487b0 - fun0b = fun0b + rmu(i, 0)*temp487b0 + temp455b1 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp455b1 + fun0b = fun0b + rmu(i, 0)*temp455b1 END IF ELSE IF (branch .LT. 4) THEN - temp487b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp487b1 - fun0b = fun0b + rmu(i, 0)*temp487b1 + temp455b2 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp455b2 + fun0b = fun0b + rmu(i, 0)*temp455b2 END IF ELSE IF (branch .LT. 7) THEN IF (branch .LT. 6) THEN - temp487b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp487b2 - fun0b = fun0b + rmu(i, 0)*temp487b2 + temp455b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp455b3 + fun0b = fun0b + rmu(i, 0)*temp455b3 ELSE rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) @@ -19697,283 +20106,209 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp486 = fun/r(0) - temp486b12 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp486*rmu(i, 0)*zb(& -& indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp486*distp(0, 3+ic)*zb(indorbp, & + temp455b = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - funb = funb + temp486b12 - rb(0) = rb(0) - temp486*temp486b12 + rmub(i, 0) = rmub(i, 0) + fun*temp455b + funb0 = funb0 + rmu(i, 0)*temp455b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp486b10 = -(dd1*distp(0, 1)*fun2b) - temp486b11 = -((dd1*r(0)-2.d0)*fun2b) - dd1b = distp(0, 1)*r(0)*funb + distp(0, 1)*temp486b11 + r(0)*& -& temp486b10 - rb(0) = rb(0) + distp(0, 1)*dd1*funb + dd1*temp486b10 - distpb(0, 1) = distpb(0, 1) + dd1*temp486b11 - (1.d0-dd1*r(0))*& -& funb - distpb(0, 3) = distpb(0, 3) - fun0b + temp454 = 0.5d0*rp2**2 - 3.5d0*rp2 + 3.d0 + temp453 = c0*r(0) + temp453b = distp(0, 1)*fun2b + temp452b = (c1*(1.d0-rp2)+r(0)**2*(c0*(3.d0-rp2)))*funb0/r(0) + temp451 = r(0)**3 + distpb(0, 1) = distpb(0, 1) + temp452b + (c1*r(0)+c0*temp451)*& +& fun0b + (c1*rp1*(rp2-3.d0)+temp453*temp454)*fun2b + temp452 = distp(0, 1)/r(0) + temp453b0 = temp452*funb0 + temp451b = distp(0, 1)*fun0b + c1b = (1.d0-rp2)*temp453b0 + r(0)*temp451b + (rp2-3.d0)*rp1*& +& temp453b + temp453b1 = r(0)**2*temp453b0 + rp2b = (temp453*0.5d0*2*rp2-temp453*3.5d0+c1*rp1)*temp453b - c0*& +& temp453b1 - c1*temp453b0 + rp1b = r(0)*rp2b + (rp2-3.d0)*c1*temp453b + c0b = (3.d0-rp2)*temp453b1 + temp451*temp451b + temp454*r(0)*& +& temp453b + rb(0) = rb(0) + c0*(3.d0-rp2)*2*r(0)*temp453b0 - temp452*temp452b & +& + rp1*rp2b + 2.d0*dd1*rp1b + (c0*3*r(0)**2+c1)*temp451b + & +& temp454*c0*temp453b + dd1b = 2.d0*r(0)*rp1b + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd1b = 0.0_8 + c0b = 0.0_8 + c1b = 0.0_8 END IF DO ic=5,1,-1 - DO i=0,0,-1 - distpb(i, 3+ic) = distpb(i, 3+ic) - distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) - distp(i, 3+ic)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO k=0,0,-1 + temp450 = r(k)**3 + temp449 = c0*distp(k, 1+ic) + temp449b = distp(k, 1)*zb(indorbp, k) + distpb(k, 1) = distpb(k, 1) + (temp449*temp450+c1*r(k))*zb(& +& indorbp, k) + c0b = c0b + temp450*distp(k, 1+ic)*temp449b + distpb(k, 1+ic) = distpb(k, 1+ic) + temp450*c0*temp449b + rb(k) = rb(k) + (c1+temp449*3*r(k)**2)*temp449b + c1b = c1b + r(k)*temp449b + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) - distpb(i, 8) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) - distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distpb(i, 1) = distpb(i, 1) + r(i)*distpb(i, 3) - rb(i) = rb(i) + distp(i, 1)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) + distpb(i, 2) = 0.0_8 END DO + dd1b = 0.0_8 + cb = 0.0_8 DO k=0,0,-1 - temp486b9 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp486b9 - rb(k) = rb(k) - dd1*temp486b9 + temp448 = r(k)**2 + temp448b93 = c*DEXP(-(dd1*temp448))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp448))*distpb(k, 1) + dd1b = dd1b - temp448*temp448b93 + rb(k) = rb(k) - dd1*2*r(k)*temp448b93 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (143) -! 4d one parmater der of 133 + temp448b92 = 2.25d0*c1b/dd1 + cb = cb + temp448b92 - c0b + dd1b = dd1b + 1.24420067280413253d0*2.25d0*dd1**1.25D0*cb - c*& +& temp448b92/dd1 + ddb(indparp) = ddb(indparp) + dd1b + CASE (82) +! ******************* END GAUSSIAN BASIS ************************ +! ** ** ** ** ** ** ** JASTROW ORBITALS ** ** ** ** ** ** ** ** * dd1 = dd(indpar+1) + dd2 = DSQRT(dd1) +! if(iflagnorm.gt.2) then +! ratiocp--> ratiocp*dsqrt(2.d0)*pi**(-0.75d0)*2**1.25 +! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0*ratiocp + c = dd1**1.25d0*ratiocp +! endif DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k))) - END DO - DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = distp(i, 1)*r(i)**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) - distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) - distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) - distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) - distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) - distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) END DO -! indorbp=indorb - DO ic=1,5 +! indorbp=indorb +! + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif IF (typec .NE. 1) THEN - fun0 = -distp(0, 3) - fun = -((-2.d0+dd1*r(0))*distp(0, 1)) - fun2 = ((dd1*r(0))**2-4.d0*r(0)*dd1+2.d0)*distp(0, 1) -! indorbp=indorb - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF +! fun=-2.d0*dd1*distp(0,1) +! fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) +! the second derivative + fun2 = dd1*distp(0, 1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**& +& 2)/rp3**2 +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp488b8 = distp(0, 3+ic)*zb(indorbp, indt+4) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 6.d0*temp488b8 - fun2b = fun2b + temp488b8 + DO ic=3,1,-1 + temp459b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp459b0 + fun2b = fun2b + temp459b0 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp488b4 = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp488b4 - fun0b = fun0b + rmu(i, 0)*temp488b4 - ELSE - temp488b5 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp488b5 - fun0b = fun0b + rmu(i, 0)*temp488b5 - END IF - ELSE IF (branch .LT. 4) THEN - temp488b6 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp488b6 - fun0b = fun0b + rmu(i, 0)*temp488b6 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp488b7 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp488b7 - fun0b = fun0b + rmu(i, 0)*temp488b7 - ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - temp488b3 = distp(0, 3+ic)*zb(indorbp, indt+i) - distpb(0, 3+ic) = distpb(0, 3+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp488b3 - funb = funb + rmu(i, 0)*temp488b3 + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp459b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp459b + funb0 = funb0 + rmu(ic, 0)*temp459b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp488b1 = distp(0, 1)*fun2b - temp488b2 = 2*dd1*r(0)*temp488b1 - dd1b = r(0)*temp488b2 - 4.d0*r(0)*temp488b1 - distp(0, 1)*r(0)*& -& funb - rb(0) = rb(0) + dd1*temp488b2 - 4.d0*dd1*temp488b1 - distp(0, 1)*& -& dd1*funb - distpb(0, 1) = distpb(0, 1) + ((dd1*r(0))**2-4.d0*(r(0)*dd1)+2.d0)& -& *fun2b - (dd1*r(0)-2.d0)*funb - distpb(0, 3) = distpb(0, 3) - fun0b + distpb = 0.0_8 + temp458 = rp3**2 + temp457b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& +& temp458 + temp457 = dd1*distp(0, 1)/temp458 + temp457b0 = temp457*fun2b + rp1b = (2*rp1+4.d0*rp2+4.d0)*temp457b0 + temp456b0 = -(distp(0, 1)*(rp2+2.d0)*funb0/rp3) + dd1b = temp456b0 + r(0)**2*rp1b + distp(0, 1)*temp457b + temp456 = dd1/rp3 + distpb(0, 1) = fun0b - temp456*(rp2+2.d0)*funb0 + dd1*temp457b + rp3b = -(temp456*temp456b0) - temp457*2*rp3*temp457b + rp2b = 2*(rp2+1.d0)*rp3b - temp456*distp(0, 1)*funb0 + (4.d0*rp1-& +& 2.d0)*temp457b0 + dd2b = r(0)*rp2b + rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b ELSE distpb = 0.0_8 dd1b = 0.0_8 + dd2b = 0.0_8 END IF - DO ic=5,1,-1 + DO ic=3,1,-1 DO i=0,0,-1 - distpb(i, 3+ic) = distpb(i, 3+ic) - distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) - distp(i, 3+ic)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) - distpb(i, 8) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) - distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distpb(i, 1) = distpb(i, 1) + r(i)**2*distpb(i, 3) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - END DO + cb = 0.0_8 DO k=0,0,-1 - temp488b0 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp488b0 - rb(k) = rb(k) - dd1*temp488b0 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp455 = dd2*r(k) + 1.d0 + temp456b = costb/temp455 + temp455b5 = -(dd1*r(k)**2*temp456b/temp455) + dd1b = dd1b + r(k)**2*temp456b + rb(k) = rb(k) + dd2*temp455b5 + dd1*2*r(k)*temp456b + dd2b = dd2b + r(k)*temp455b5 END DO + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocp*1.25d0*dd1**0.25D0*cb + ELSE + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocp*1.25d0*dd1**0.25D0*& +& cb + END IF ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (144) -! 2p single exponential -r^3 e^{-z r} ! derivative of 130 + CASE (111) +! 2p single r_mu/(1+b r^3) parent of 103 dd2 = dd(indpar+1) DO k=0,0 - distp(k, 1) = -DEXP(-(dd2*r(k))) + distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**3) END DO ! indorbp=indorb DO ic=1,3 @@ -19983,10 +20318,8 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - fun = distp(0, 1)*(3.d0-dd2*r(0))*r(0) -! fun= derivative of fun0 respect to r divided dy r - fun2 = distp(0, 1)*(dd2**2*r(0)**3-6*dd2*r(0)**2+6*r(0)) -! fun2= second derivative of fun0 respect to r + fun = -(dd2*distp(0, 1)**2*3.d0*r(0)) + fun2 = fun*distp(0, 1)*(2.d0-4.d0*dd2*r(0)**3) ! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -20000,108 +20333,67 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp489b0 = rmu(ic, 0)*zb(indorbp, indt+4) + temp461b0 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp489b0 - fun2b = fun2b + temp489b0 + funb0 = funb0 + 4.d0*temp461b0 + fun2b = fun2b + temp461b0 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp489b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp489b - funb = funb + rmu(ic, 0)*temp489b + temp461b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp461b + funb0 = funb0 + rmu(ic, 0)*temp461b rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp488 = r(0)**3 - temp488b11 = distp(0, 1)*fun2b - temp488b12 = (3.d0-dd2*r(0))*funb - distpb(0, 1) = r(0)*temp488b12 + r(0)**3*fun0b + (dd2**2*temp488-6& -& *(dd2*r(0)**2)+6*r(0))*fun2b - temp488b13 = distp(0, 1)*r(0)*funb - dd2b = (temp488*2*dd2-6*r(0)**2)*temp488b11 - r(0)*temp488b13 - rb(0) = rb(0) + distp(0, 1)*temp488b12 - dd2*temp488b13 + distp(0& -& , 1)*3*r(0)**2*fun0b + (dd2**2*3*r(0)**2-6*dd2*2*r(0)+6)*& -& temp488b11 + temp460 = r(0)**3 + temp460b = (2.d0-4.d0*(dd2*temp460))*fun2b + temp460b0 = -(fun*distp(0, 1)*4.d0*fun2b) + funb0 = funb0 + distp(0, 1)*temp460b + distpb(0, 1) = fun0b - 3.d0*dd2*r(0)*2*distp(0, 1)*funb0 + fun*& +& temp460b + temp460b1 = -(3.d0*distp(0, 1)**2*funb0) + dd2b = r(0)*temp460b1 + temp460*temp460b0 + rb(0) = rb(0) + dd2*temp460b1 + dd2*3*r(0)**2*temp460b0 ELSE distpb = 0.0_8 dd2b = 0.0_8 END IF DO ic=3,1,-1 DO i=0,0,-1 - temp488b10 = r(i)**3*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp488b10 - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp488b10 - rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*3*r(i)**2*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=0,0,-1 - temp488b9 = -(DEXP(-(dd2*r(k)))*distpb(k, 1)) - dd2b = dd2b - r(k)*temp488b9 - rb(k) = rb(k) - dd2*temp488b9 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (145) -! 2s without cusp condition !derivative 100 -! -(r^2*exp(-dd2*r^2)) - dd2 = dd(indpar+1) - indorbp = indorb + 1 - DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) - END DO -! endif - IF (typec .NE. 1) THEN - fun0 = dd2*r(0)**2 - fun = -(2.d0*distp(0, 1)*(1.d0-fun0)) - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp489b2 = -(2.d0*distp(0, 1)*fun2b) - distpb(0, 1) = -(2.d0*(1.d0-fun0)*funb) - 2.d0*(2.d0*fun0**2-5.d0*& -& fun0+1.d0)*fun2b - fun0b = 2.d0*distp(0, 1)*funb + (2.d0*2*fun0-5.d0)*temp489b2 - dd2b = r(0)**2*fun0b - rb(0) = rb(0) + dd2*2*r(0)*fun0b - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) - r(i)**2*zb(indorbp, i) - rb(i) = rb(i) - distp(i, 1)*2*r(i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=0,0,-1 - temp489b1 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp489b1 - rb(k) = rb(k) - dd2*2*r(k)*temp489b1 + temp459 = r(k)**3 + temp459b1 = -(distpb(k, 1)/(dd2*temp459+1.d0)**2) + dd2b = dd2b + temp459*temp459b1 + rb(k) = rb(k) + dd2*3*r(k)**2*temp459b1 distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (146) -! 2p single exponential -r^2 e^{-z r^2} ! derivative of 103 - dd2 = dd(indpar+1) + CASE (62) + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c=2.d0/pi**0.75d0*(2.d0*dd1)**1.75d0/dsqrt(5.d0) + c = dd1**1.75d0*1.2749263037197753d0 +! endif DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO ! indorbp=indorb +! DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then @@ -20109,9 +20401,10 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - rp2 = dd2*r(0)*r(0) - fun = distp(0, 1)*(-2.d0+2.d0*rp2) - fun2 = (-2.d0+10.d0*rp2-4.d0*rp2*rp2)*distp(0, 1) + fun0 = distp(0, 1)*r(0) + cost = 2.d0*dd1*r(0)**2 + fun = distp(0, 1)*(1.d0-cost)/r(0) + fun2 = 2.d0*dd1*fun0*(cost-3.d0) ! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -20125,66 +20418,94 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp489b6 = rmu(ic, 0)*zb(indorbp, indt+4) + temp463b1 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp489b6 - fun2b = fun2b + temp489b6 + funb0 = funb0 + 4.d0*temp463b1 + fun2b = fun2b + temp463b1 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp489b5 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp489b5 - funb = funb + rmu(ic, 0)*temp489b5 + temp463b0 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp463b0 + funb0 = funb0 + rmu(ic, 0)*temp463b0 rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + temp463b = 2.d0*(cost-3.d0)*fun2b + temp462b0 = distp(0, 1)*funb0/r(0) + costb = 2.d0*dd1*fun0*fun2b - temp462b0 + dd1b = 2.d0*r(0)**2*costb + fun0*temp463b + fun0b = fun0b + dd1*temp463b distpb = 0.0_8 - rp2b = distp(0, 1)*2.d0*funb + (distp(0, 1)*10.d0-distp(0, 1)*4.d0& -& *2*rp2)*fun2b - distpb(0, 1) = (2.d0*rp2-2.d0)*funb - r(0)**2*fun0b + (10.d0*rp2-& -& 4.d0*rp2**2-2.d0)*fun2b - rb(0) = rb(0) + dd2*2*r(0)*rp2b - distp(0, 1)*2*r(0)*fun0b - dd2b = r(0)**2*rp2b + temp462 = (-cost+1.d0)/r(0) + distpb(0, 1) = r(0)*fun0b + temp462*funb0 + rb(0) = rb(0) + 2.d0*dd1*2*r(0)*costb + distp(0, 1)*fun0b - & +& temp462*temp462b0 ELSE distpb = 0.0_8 - dd2b = 0.0_8 + dd1b = 0.0_8 END IF DO ic=3,1,-1 DO i=0,0,-1 - temp489b4 = -(r(i)**2*zb(indorbp, i)) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp489b4 - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp489b4 - rb(i) = rb(i) - rmu(ic, i)*distp(i, 1)*2*r(i)*zb(indorbp, i) + temp462b = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*r(i)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + r(i)*temp462b + rb(i) = rb(i) + distp(i, 1)*temp462b zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + cb = 0.0_8 DO k=0,0,-1 - temp489b3 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp489b3 - rb(k) = rb(k) - dd2*2*r(k)*temp489b3 + temp461 = r(k)**2 + temp461b1 = c*DEXP(-(dd1*temp461))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp461))*distpb(k, 1) + dd1b = dd1b - temp461*temp461b1 + rb(k) = rb(k) - dd1*2*r(k)*temp461b1 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (147) -! 3d single gaussian + dd1b = dd1b + 1.2749263037197753d0*1.75d0*dd1**0.75D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (42) +! derivative of 62 with respect zeta +! 4d without cusp and one parmater derivative of 30 dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c= & +! &1.d0/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) + c = dd1**3.5d0*0.26596152026762178d0 +! c= +! &1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) +! endif + c0 = -c + c1 = 3.5d0*c/dd1 DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k)**2)) + distp(k, 1) = DEXP(-(dd1*r(k))) END DO DO i=0,0 - distp(i, 3) = distp(i, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = distp(i, 1)*(c0*r(i)+c1) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) +! lz=0 distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) +! lz=+/ distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) +! lz=+/-2 distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) +! lz=+/-1 distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) +! lz=+/-1 distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d END DO ! indorbp=indorb @@ -20196,96 +20517,145 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd ! endif IF (typec .NE. 1) THEN fun0 = distp(0, 3) - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = ((2.d0*dd1*r(0))**2-2.d0*dd1)*distp(0, 1) + fun = -(dd1*distp(0, 3)) + c0*distp(0, 1) + fun2 = dd1**2*distp(0, 3) - 2.d0*dd1*c0*distp(0, 1) ! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - IF (ic .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) - ELSE IF (ic .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (ic .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE IF (ic .EQ. 4) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (ic .EQ. 5) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF + DO i=1,3 + IF (ic .EQ. 1) THEN + IF (i .NE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + END IF + END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=5,1,-1 - temp490b5 = distp(0, 3+ic)*zb(indorbp, indt+4) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 6.d0*temp490b5 - fun2b = fun2b + temp490b5 + temp464 = fun/r(0) + temp465b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp464b3 = 6.d0*temp465b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp464+fun2)*zb(& +& indorbp, indt+4) + funb0 = funb0 + temp464b3 + rb(0) = rb(0) - temp464*temp464b3 + fun2b = fun2b + temp465b zb(indorbp, indt+4) = 0.0_8 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - IF (branch .LT. 1) THEN - temp490b0 = cost1d*4.d0*zb(indorbp, indt+3) - rmub(3, 0) = rmub(3, 0) + fun0*temp490b0 - temp490b1 = -(cost1d*2.d0*zb(indorbp, indt+2)) - temp490b2 = -(cost1d*2.d0*zb(indorbp, indt+1)) - fun0b = fun0b + rmu(2, 0)*temp490b1 + rmu(1, 0)*temp490b2 & -& + rmu(3, 0)*temp490b0 - rmub(2, 0) = rmub(2, 0) + fun0*temp490b1 - rmub(1, 0) = rmub(1, 0) + fun0*temp490b2 - ELSE - temp490b3 = -(cost2d*2.d0*zb(indorbp, indt+2)) - rmub(2, 0) = rmub(2, 0) + fun0*temp490b3 - temp490b4 = cost2d*2.d0*zb(indorbp, indt+1) - fun0b = fun0b + rmu(1, 0)*temp490b4 + rmu(2, 0)*temp490b3 - rmub(1, 0) = rmub(1, 0) + fun0*temp490b4 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp464b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp464b + fun0b = fun0b + rmu(i, 0)*temp464b + ELSE + temp464b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp464b0 + fun0b = fun0b + rmu(i, 0)*temp464b0 + END IF + ELSE IF (branch .LT. 4) THEN + temp464b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp464b1 + fun0b = fun0b + rmu(i, 0)*temp464b1 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp464b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp464b2 + fun0b = fun0b + rmu(i, 0)*temp464b2 + ELSE + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+2) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+1) + & -& cost3d*rmu(1, 0)*zb(indorbp, indt+2) - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+1) - END IF - ELSE IF (branch .LT. 5) THEN - IF (branch .LT. 4) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+2) + & -& cost3d*rmu(2, 0)*zb(indorbp, indt+3) - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+2) + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+1) + cost3d*& -& rmu(1, 0)*zb(indorbp, indt+3) - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+1) - END IF - DO i=3,1,-1 - temp490b = distp(0, 3+ic)*zb(indorbp, indt+i) - distpb(0, 3+ic) = distpb(0, 3+ic) + rmu(i, 0)*fun*zb(indorbp, & + temp463 = fun/r(0) + temp463b6 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp463*rmu(i, 0)*zb(& +& indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp463*distp(0, 3+ic)*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp490b - funb = funb + rmu(i, 0)*temp490b + funb0 = funb0 + temp463b6 + rb(0) = rb(0) - temp463*temp463b6 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp489 = 2.d0*dd1*r(0) - temp489b8 = distp(0, 1)*2*temp489*2.d0*fun2b - dd1b = r(0)*temp489b8 - distp(0, 1)*2.d0*fun2b - 2.d0*distp(0, 1)*& -& funb - rb(0) = rb(0) + dd1*temp489b8 - distpb(0, 1) = distpb(0, 1) + (temp489**2-2.d0*dd1)*fun2b - 2.d0*& -& dd1*funb - distpb(0, 3) = distpb(0, 3) + fun0b + temp463b5 = -(2.d0*distp(0, 1)*fun2b) + dd1b = c0*temp463b5 - distp(0, 3)*funb0 + distp(0, 3)*2*dd1*fun2b + distpb(0, 3) = distpb(0, 3) + dd1**2*fun2b + c0b = distp(0, 1)*funb0 + dd1*temp463b5 + distpb(0, 1) = distpb(0, 1) + c0*funb0 - 2.d0*dd1*c0*fun2b + distpb(0, 3) = distpb(0, 3) + fun0b - dd1*funb0 ELSE distpb = 0.0_8 + c0b = 0.0_8 dd1b = 0.0_8 END IF DO ic=5,1,-1 @@ -20296,295 +20666,462 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + c1b = 0.0_8 DO i=0,0,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) distpb(i, 8) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) distpb(i, 7) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - distpb(i, 1) = distpb(i, 1) + distpb(i, 3) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + temp463b4 = distp(i, 1)*distpb(i, 3) + distpb(i, 1) = distpb(i, 1) + (c0*r(i)+c1)*distpb(i, 3) + c0b = c0b + r(i)*temp463b4 + rb(i) = rb(i) + c0*temp463b4 + c1b = c1b + temp463b4 distpb(i, 3) = 0.0_8 END DO DO k=0,0,-1 - temp489b7 = DEXP(-(dd1*r(k)**2))*distpb(k, 1) - dd1b = dd1b - r(k)**2*temp489b7 - rb(k) = rb(k) - dd1*2*r(k)*temp489b7 + temp463b3 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp463b3 + rb(k) = rb(k) - dd1*temp463b3 distpb(k, 1) = 0.0_8 END DO + temp463b2 = 3.5d0*c1b/dd1 + cb = temp463b2 - c0b + dd1b = dd1b + 0.26596152026762178d0*3.5d0*dd1**2.5D0*cb - c*& +& temp463b2/dd1 ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (148) -! derivative of 147 with respect to dd1 + CASE (4) +! normalized +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 dd1 = dd(indpar+1) + dd2 = dd(indpar+2) +! if(iflagnorm.gt.2) then + c = dd1**2.5d0/DSQRT(3.d0*pi*(1.d0+dd2**2/3.d0)) +! endif DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k)**2)) + distp(k, 1) = c*DEXP(-(dd1*r(k))) END DO - DO i=0,0 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = -(r(i)**2*distp(i, 1)) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) - distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) - distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) - distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) - distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) - distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d + IF (typec .NE. 1) THEN + fun = distp(0, 1)*(1.d0-dd1*r(0)) + funp = -(dd2*dd1*distp(0, 1)*rmu(3, 0)) + temp468b = zb(indorbp, indt+4)/r(0) + funb0 = 2.d0*temp468b + funpb = 4.d0*temp468b + rb(0) = rb(0) - (2.d0*fun+4.d0*funp)*temp468b/r(0) + fun2b = zb(indorbp, indt+4) + fun2pb = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + distpb = 0.0_8 + dd2b = distp(0, 1)*zb(indorbp, indt+3) + distpb(0, 1) = dd2*zb(indorbp, indt+3) + DO i=3,1,-1 + temp467b6 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) + temp467 = (fun+funp)/r(0) + funb0 = funb0 + temp467b6 + funpb = funpb + temp467b6 + rb(0) = rb(0) - temp467*temp467b6 + rmub(i, 0) = rmub(i, 0) + temp467*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + temp467b1 = dd2*distp(0, 1)*fun2pb + temp467b2 = dd1**2*rmu(3, 0)*fun2pb + temp467b3 = distp(0, 1)*fun2b + temp467b4 = -(distp(0, 1)*rmu(3, 0)*funpb) + dd1b = (r(0)*2*dd1-2.d0)*temp467b3 - distp(0, 1)*r(0)*funb0 + dd2*& +& temp467b4 + rmu(3, 0)*2*dd1*temp467b1 + temp467b5 = -(dd2*dd1*funpb) + rmub(3, 0) = rmub(3, 0) + distp(0, 1)*temp467b5 + dd1**2*temp467b1 + dd2b = dd2b + dd1*temp467b4 + distp(0, 1)*temp467b2 + distpb(0, 1) = distpb(0, 1) + (dd1**2*r(0)-2.d0*dd1)*fun2b + (1.d0& +& -dd1*r(0))*funb0 + rmu(3, 0)*temp467b5 + dd2*temp467b2 + rb(0) = rb(0) + dd1**2*temp467b3 - distp(0, 1)*dd1*funb0 + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 + END IF + DO i=0,0,-1 + temp467b0 = distp(i, 1)*zb(indorbp, i) + rb(i) = rb(i) + temp467b0 + dd2b = dd2b + rmu(3, i)*temp467b0 + rmub(3, i) = rmub(3, i) + dd2*temp467b0 + distpb(i, 1) = distpb(i, 1) + (r(i)+dd2*rmu(3, i))*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO -! indorbp=indorb - DO ic=1,5 + cb = 0.0_8 + DO k=0,0,-1 + temp467b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp467b + rb(k) = rb(k) - dd1*temp467b + distpb(k, 1) = 0.0_8 + END DO + temp466 = 3.d0*pi*(dd2**2/3.d0+1.d0) + temp465 = DSQRT(temp466) + dd1b = dd1b + 2.5d0*dd1**1.5D0*cb/temp465 + IF (.NOT.temp466 .EQ. 0.0) dd2b = dd2b - dd1**2.5d0*pi*2*dd2*cb/(& +& temp465**2*2.D0*DSQRT(temp466)) + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (137) +! 2s single Z NO CUSP +! 2s with cusp condition +! dd1*(exp(-dd2*r)*(1+dd2*r)) + dd2 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c=1.d0/dsqrt(1/4.d0/dd2**3+12*dd2/(2.d0*dd2)**4+ +! &3*dd2**2/4/dd2**5)/dsqrt(4.0*pi) +! endif + indorbp = indorb + 1 + DO k=0,0 + distp(k, 1) = DEXP(-(dd2*r(k))) + END DO +! endif + IF (typec .NE. 1) THEN + fun = -(dd2**2*distp(0, 1)) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + funb0 = funb0 + (1.d0-dd2*r(0))*fun2b + dd2b = -(distp(0, 1)*2*dd2*funb0) - fun*r(0)*fun2b + rb(0) = rb(0) - fun*dd2*fun2b + distpb = 0.0_8 + distpb(0, 1) = -(dd2**2*funb0) + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO i=0,0,-1 + temp468b1 = distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + (dd2*r(i)+1.d0)*zb(indorbp, i) + dd2b = dd2b + r(i)*temp468b1 + rb(i) = rb(i) + dd2*temp468b1 + zb(indorbp, i) = 0.0_8 + END DO + DO k=0,0,-1 + temp468b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp468b0 + rb(k) = rb(k) - dd2*temp468b0 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (8) +! s orbital +! +! - angmom = 0 +! - type = Gaussian +! - normalized = yes +! - angtype = spherical +! - npar = 2 +! - multiplicity = 1 +! +! = exp(-dd1*r) + (dd1-zeta) * r * exp(-dd2*r) +! +! 2s double Z WITH CUSP +! + indorbp = indorb + 1 + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd1 - zeta(1) + DO k=0,0 + distp(k, 1) = DEXP(-(dd1*r(k))) + distp(k, 2) = DEXP(-(dd2*r(k))) + END DO + c = 1.d0/DSQRT(1.d0/4.d0/dd1**3+12.d0*peff/(dd1+dd2)**4+3*peff**2/4/& +& dd2**5)/DSQRT(4.0*pi) + IF (typec .NE. 1) THEN + fun = -(dd1*distp(0, 1)) + peff*distp(0, 2)*(1.d0-dd2*r(0)) + fun2 = distp(0, 1)*dd1**2 + peff*distp(0, 2)*(dd2**2*r(0)-2.d0*dd2& +& ) + temp476 = fun/r(0) + temp476b = c*2.d0*zb(indorbp, indt+4)/r(0) + cb = (2.d0*temp476+fun2)*zb(indorbp, indt+4) + funb0 = temp476b + rb(0) = rb(0) - temp476*temp476b + fun2b = c*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + temp475 = rmu(i, 0)/r(0) + temp475b5 = fun*c*zb(indorbp, indt+i)/r(0) + funb0 = funb0 + temp475*c*zb(indorbp, indt+i) + cb = cb + temp475*fun*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp475b5 + rb(0) = rb(0) - temp475*temp475b5 + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp475b1 = (dd2**2*r(0)-2.d0*dd2)*fun2b + temp475b2 = peff*distp(0, 2)*fun2b + distpb(0, 1) = dd1**2*fun2b + dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb0 + temp475b3 = (1.d0-dd2*r(0))*funb0 + peffb = distp(0, 2)*temp475b3 + distp(0, 2)*temp475b1 + distpb(0, 2) = peff*temp475b3 + peff*temp475b1 + temp475b4 = peff*distp(0, 2)*funb0 + dd2b = (r(0)*2*dd2-2.d0)*temp475b2 - r(0)*temp475b4 + rb(0) = rb(0) + dd2**2*temp475b2 - dd2*temp475b4 + distpb(0, 1) = distpb(0, 1) - dd1*funb0 + ELSE + distpb = 0.0_8 + peffb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 + cb = 0.0_8 + END IF + DO i=0,0,-1 + temp475b = c*zb(indorbp, i) + temp475b0 = distp(i, 2)*temp475b + cb = cb + (distp(i, 1)+r(i)*peff*distp(i, 2))*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp475b + rb(i) = rb(i) + peff*temp475b0 + peffb = peffb + r(i)*temp475b0 + distpb(i, 2) = distpb(i, 2) + r(i)*peff*temp475b + zb(indorbp, i) = 0.0_8 + END DO + temp474 = 4*dd2**5 + temp468 = peff**2/temp474 + temp473 = (dd1+dd2)**4 + temp472 = 4.d0*dd1**3 + temp469 = 1.0/temp472 + 12.d0*peff/temp473 + 3*temp468 + temp471 = DSQRT(temp469) + temp470 = DSQRT(4.0*pi) + IF (temp469 .EQ. 0.0) THEN + temp469b = 0.0 + ELSE + temp469b = -(cb/(temp470*temp471**2*2.D0*DSQRT(temp469))) + END IF + temp469b0 = 12.d0*temp469b/temp473 + temp469b1 = -(peff*4*(dd1+dd2)**3*temp469b0/temp473) + temp468b4 = 3*temp469b/temp474 + dd1b = dd1b + temp469b1 - 4.d0*3*dd1**2*temp469b/temp472**2 + peffb = peffb + 2*peff*temp468b4 + temp469b0 + dd2b = dd2b + temp469b1 - temp468*4*5*dd2**4*temp468b4 + DO k=0,0,-1 + temp468b2 = DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp468b2 + distpb(k, 2) = 0.0_8 + temp468b3 = DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp468b3 - dd2*temp468b2 + dd1b = dd1b - r(k)*temp468b3 + distpb(k, 1) = 0.0_8 + END DO + dd1b = dd1b + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (109) +! 2p double Lorentian +! dd1 * x_mu (L(dd2 r^2)+dd3 * L(dd4*r^2)) ; L(x)=1/(1+x^2) + dd2 = dd(indpar+1) + dd3 = dd(indpar+2) + dd4 = dd(indpar+3) + DO k=0,0 + distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**2) + distp(k, 2) = 1.d0/(1.d0+dd4*r(k)**2) + END DO +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 3) - fun = 2.d0*(dd1*r(0)**2-1.d0)*r(0)*distp(0, 1) - fun2 = -(2.d0*(2.d0*dd1**2*r(0)**4+1.d0-5.d0*dd1*r(0)**2)*distp(0& -& , 1)) + fun = 2.d0*(-(dd2*distp(0, 1)**2)-dd4*dd3*distp(0, 2)**2) +! fun2=2.d0*(dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0,1) +! 1+dd4*dd3*(-1.d0+2.d0*dd4*r(0)**2)*distp(0,2)) + fun2 = 2*dd2*distp(0, 1)**3*(-1.d0+3.d0*dd2*r(0)**2) + 2*dd3*dd4*& +& distp(0, 2)**3*(-1.d0+3.d0*dd4*r(0)**2) ! indorbp=indorb - DO ic=1,5 + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp492 = fun/r(0) - temp493b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp492b3 = 6.d0*temp493b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp492+fun2)*zb(& -& indorbp, indt+4) - funb = funb + temp492b3 - rb(0) = rb(0) - temp492*temp492b3 - fun2b = fun2b + temp493b + DO ic=3,1,-1 + temp481b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp481b0 + fun2b = fun2b + temp481b0 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp492b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp492b - fun0b = fun0b + rmu(i, 0)*temp492b - ELSE - temp492b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp492b0 - fun0b = fun0b + rmu(i, 0)*temp492b0 - END IF - ELSE IF (branch .LT. 4) THEN - temp492b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp492b1 - fun0b = fun0b + rmu(i, 0)*temp492b1 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp492b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp492b2 - fun0b = fun0b + rmu(i, 0)*temp492b2 - ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - temp491 = fun/r(0) - temp491b = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp491*rmu(i, 0)*zb(& -& indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp491*distp(0, 3+ic)*zb(indorbp, & -& indt+i) - funb = funb + temp491b - rb(0) = rb(0) - temp491*temp491b + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp481b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp481b + funb0 = funb0 + rmu(ic, 0)*temp481b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp490 = r(0)**4 - temp490b7 = -(2.d0*distp(0, 1)*fun2b) - temp490b8 = 2.d0*r(0)*distp(0, 1)*funb - dd1b = r(0)**2*temp490b8 + (2.d0*temp490*2*dd1-5.d0*r(0)**2)*& -& temp490b7 - temp490b9 = 2.d0*(dd1*r(0)**2-1.d0)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp490b8 + distp(0, 1)*temp490b9 + (& -& 2.d0*dd1**2*4*r(0)**3-5.d0*dd1*2*r(0))*temp490b7 - distpb(0, 1) = distpb(0, 1) + r(0)*temp490b9 - 2.d0*(2.d0*(dd1**2*& -& temp490)-5.d0*(dd1*r(0)**2)+1.d0)*fun2b - distpb(0, 3) = distpb(0, 3) + fun0b + distpb = 0.0_8 + temp480 = distp(0, 1)**3 + temp480b = 2*(3.d0*(dd2*r(0)**2)-1.d0)*fun2b + temp480b0 = 2*dd2*temp480*3.d0*fun2b + temp479 = distp(0, 2)**3 + temp479b0 = 2*(3.d0*(dd4*r(0)**2)-1.d0)*fun2b + temp479b1 = 2*dd3*dd4*temp479*3.d0*fun2b + temp479b2 = 2.d0*funb0 + dd2b = r(0)**2*temp480b0 - distp(0, 1)**2*temp479b2 + temp480*& +& temp480b + distpb(0, 1) = dd2*3*distp(0, 1)**2*temp480b + rb(0) = rb(0) + dd4*2*r(0)*temp479b1 + dd2*2*r(0)*temp480b0 + temp479b3 = -(distp(0, 2)**2*temp479b2) + dd3b = dd4*temp479b3 + distp(0, 2)*fun0b + temp479*dd4*temp479b0 + dd4b = dd3*temp479b3 + r(0)**2*temp479b1 + temp479*dd3*temp479b0 + distpb(0, 2) = dd3*dd4*3*distp(0, 2)**2*temp479b0 + distpb(0, 1) = distpb(0, 1) - dd2*2*distp(0, 1)*temp479b2 + distpb(0, 2) = distpb(0, 2) - dd4*dd3*2*distp(0, 2)*temp479b2 + distpb(0, 1) = distpb(0, 1) + fun0b + distpb(0, 2) = distpb(0, 2) + dd3*fun0b ELSE distpb = 0.0_8 - dd1b = 0.0_8 + dd2b = 0.0_8 + dd3b = 0.0_8 + dd4b = 0.0_8 END IF - DO ic=5,1,-1 + DO ic=3,1,-1 DO i=0,0,-1 - distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) + temp479b = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& +& indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp479b + dd3b = dd3b + distp(i, 2)*temp479b + distpb(i, 2) = distpb(i, 2) + dd3*temp479b zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=0,0,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) - distpb(i, 8) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) - distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - rb(i) = rb(i) - distp(i, 1)*2*r(i)*distpb(i, 3) - distpb(i, 1) = distpb(i, 1) - r(i)**2*distpb(i, 3) - distpb(i, 3) = 0.0_8 - END DO DO k=0,0,-1 - temp490b6 = DEXP(-(dd1*r(k)**2))*distpb(k, 1) - dd1b = dd1b - r(k)**2*temp490b6 - rb(k) = rb(k) - dd1*2*r(k)*temp490b6 + temp478 = dd4*r(k)**2 + 1.d0 + temp478b = -(distpb(k, 2)/temp478**2) + dd4b = dd4b + r(k)**2*temp478b + distpb(k, 2) = 0.0_8 + temp477 = dd2*r(k)**2 + 1.d0 + temp477b = -(distpb(k, 1)/temp477**2) + rb(k) = rb(k) + dd2*2*r(k)*temp477b + dd4*2*r(k)*temp478b + dd2b = dd2b + r(k)**2*temp477b distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (149) -! derivative of 131 with respect z_1 -! - r^4 exp(-z_1 r^2) + ddb(indpar+3) = ddb(indpar+3) + dd4b + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (112) +! 2p single r_mu/(1+b r)^3 parent of 103 dd2 = dd(indpar+1) - indorbp = indorb + 1 DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) + distp(k, 1) = 1.d0/(1.d0+dd2*r(k))**3 + END DO +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic END DO ! endif IF (typec .NE. 1) THEN - fun0 = dd2*r(0)**2 - fun = -(2.d0*r(0)**2*distp(0, 1)*(2.d0-fun0)) - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 + fun = -(3.d0*dd2*distp(0, 1)/(r(0)*(1.d0+dd2*r(0)))) + fun2 = 12.d0*dd2**2/(1.+dd2*r(0))**5 +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO END DO - distpb = 0.0_8 - temp493b1 = -(2.d0*(2.d0*fun0**2-9.d0*fun0+6.d0)*fun2b) - temp493b2 = -(2.d0*r(0)**2*distp(0, 1)*fun2b) - temp493b3 = -(2.d0*r(0)**2*funb) - fun0b = (2.d0*2*fun0-9.d0)*temp493b2 - distp(0, 1)*temp493b3 - rb(0) = rb(0) + dd2*2*r(0)*fun0b - 2.d0*distp(0, 1)*(2.d0-fun0)*2*& -& r(0)*funb + distp(0, 1)*2*r(0)*temp493b1 - distpb(0, 1) = (2.d0-fun0)*temp493b3 + r(0)**2*temp493b1 - dd2b = r(0)**2*fun0b + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp485b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp485b0 + fun2b = fun2b + temp485b0 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp485b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp485b + funb0 = funb0 + rmu(ic, 0)*temp485b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + temp484 = (dd2*r(0)+1.)**5 + temp484b = 12.d0*fun2b/temp484 + temp484b0 = -(dd2**2*5*(dd2*r(0)+1.)**4*temp484b/temp484) + temp483 = dd2*r(0) + 1.d0 + temp483b = -(3.d0*funb0/(r(0)*temp483)) + temp483b0 = -(dd2*distp(0, 1)*temp483b/(r(0)*temp483)) + dd2b = distp(0, 1)*temp483b + r(0)**2*temp483b0 + r(0)*temp484b0 +& +& 2*dd2*temp484b + rb(0) = rb(0) + (r(0)*dd2+temp483)*temp483b0 + dd2*temp484b0 + distpb = 0.0_8 + distpb(0, 1) = fun0b + dd2*temp483b ELSE distpb = 0.0_8 dd2b = 0.0_8 END IF - DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) - r(i)**4*zb(indorbp, i) - rb(i) = rb(i) - distp(i, 1)*4*r(i)**3*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=3,1,-1 + DO i=0,0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=0,0,-1 - temp493b0 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp493b0 - rb(k) = rb(k) - dd2*2*r(k)*temp493b0 + temp481 = dd2*r(k) + 1.d0 + temp482 = temp481**3 + temp481b1 = -(3*temp481**2*distpb(k, 1)/temp482**2) + dd2b = dd2b + r(k)*temp481b1 + rb(k) = rb(k) + dd2*temp481b1 distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (150) -! 2p single exponential r e^{-z r^2} + CASE (151) +! 2p single exponential -r^3 e^{-z r^2} ! parent of 150 dd2 = dd(indpar+1) DO k=0,0 distp(k, 1) = DEXP(-(dd2*r(k)**2)) @@ -20597,10 +21134,9 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END DO ! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 1)*r(0) - cost = 2.d0*dd2*r(0)**2 - fun = distp(0, 1)*(1.d0-cost)/r(0) - fun2 = 2.d0*dd2*fun0*(cost-3.d0) + cost = dd2*r(0)**2 + fun = distp(0, 1)*(-3.d0+2.d0*cost)*r(0) + fun2 = -(2.d0*distp(0, 1)*r(0)*(3.d0-7.d0*cost+2.d0*cost**2)) ! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -20614,1516 +21150,2077 @@ SUBROUTINE makefun0_b (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,zb,dd,dd END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp494b1 = rmu(ic, 0)*zb(indorbp, indt+4) + temp485b7 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp494b1 - fun2b = fun2b + temp494b1 + funb0 = funb0 + 4.d0*temp485b7 + fun2b = fun2b + temp485b7 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp494b0 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp494b0 - funb = funb + rmu(ic, 0)*temp494b0 + temp485b6 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp485b6 + funb0 = funb0 + rmu(ic, 0)*temp485b6 rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp494b = 2.d0*(cost-3.d0)*fun2b - temp493b6 = distp(0, 1)*funb/r(0) - costb = 2.d0*dd2*fun0*fun2b - temp493b6 - dd2b = 2.d0*r(0)**2*costb + fun0*temp494b - fun0b = fun0b + dd2*temp494b distpb = 0.0_8 - temp493 = (-cost+1.d0)/r(0) - distpb(0, 1) = r(0)*fun0b + temp493*funb - rb(0) = rb(0) + 2.d0*dd2*2*r(0)*costb + distp(0, 1)*fun0b - & -& temp493*temp493b6 + temp485b3 = -(2.d0*(2.d0*cost**2-7.d0*cost+3.d0)*fun2b) + temp485b4 = -(2.d0*distp(0, 1)*r(0)*fun2b) + temp485b5 = (2.d0*cost-3.d0)*funb0 + distpb(0, 1) = r(0)*temp485b5 - r(0)**3*fun0b + r(0)*temp485b3 + costb = distp(0, 1)*r(0)*2.d0*funb0 + (2.d0*2*cost-7.d0)*temp485b4 + rb(0) = rb(0) + distp(0, 1)*temp485b5 - distp(0, 1)*3*r(0)**2*& +& fun0b + dd2*2*r(0)*costb + distp(0, 1)*temp485b3 + dd2b = r(0)**2*costb ELSE distpb = 0.0_8 dd2b = 0.0_8 END IF DO ic=3,1,-1 DO i=0,0,-1 - temp493b5 = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*r(i)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + r(i)*temp493b5 - rb(i) = rb(i) + distp(i, 1)*temp493b5 + temp485b2 = -(r(i)**3*zb(indorbp, i)) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp485b2 + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp485b2 + rb(i) = rb(i) - rmu(ic, i)*distp(i, 1)*3*r(i)**2*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=0,0,-1 - temp493b4 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp493b4 - rb(k) = rb(k) - dd2*2*r(k)*temp493b4 + temp485b1 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp485b1 + rb(k) = rb(k) - dd2*2*r(k)*temp485b1 distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (151) -! 2p single exponential -r^3 e^{-z r^2} ! parent of 150 - dd2 = dd(indpar+1) + CASE (127) +! 3d without cusp and one parmater + dd1 = dd(indpar+1) DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k)**2)) + distp(k, 1) = DEXP(-(dd1*r(k))) END DO -! indorbp=indorb - DO ic=1,3 + DO i=0,0 + distp(i, 3) = distp(i, 1) + distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d + distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d + distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d + END DO +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - cost = dd2*r(0)**2 - fun = distp(0, 1)*(-3.d0+2.d0*cost)*r(0) - fun2 = -(2.d0*distp(0, 1)*r(0)*(3.d0-7.d0*cost+2.d0*cost**2)) + fun0 = distp(0, 3) + fun = -(dd1*distp(0, 1)) + fun2 = dd1**2*distp(0, 1) ! indorbp=indorb - DO ic=1,3 + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + IF (ic .EQ. 1) THEN + IF (i .NE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO END DO - funb = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=3,1,-1 - temp494b8 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp494b8 - fun2b = fun2b + temp494b8 + DO ic=5,1,-1 + temp486 = fun/r(0) + temp487b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp486b3 = 6.d0*temp487b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp486+fun2)*zb(& +& indorbp, indt+4) + funb0 = funb0 + temp486b3 + rb(0) = rb(0) - temp486*temp486b3 + fun2b = fun2b + temp487b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp494b7 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp494b7 - funb = funb + rmu(ic, 0)*temp494b7 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp486b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp486b + fun0b = fun0b + rmu(i, 0)*temp486b + ELSE + temp486b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp486b0 + fun0b = fun0b + rmu(i, 0)*temp486b0 + END IF + ELSE IF (branch .LT. 4) THEN + temp486b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp486b1 + fun0b = fun0b + rmu(i, 0)*temp486b1 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp486b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp486b2 + fun0b = fun0b + rmu(i, 0)*temp486b2 + ELSE + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + temp485 = fun/r(0) + temp485b9 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp485*rmu(i, 0)*zb(& +& indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp485*distp(0, 3+ic)*zb(indorbp, & +& indt+i) + funb0 = funb0 + temp485b9 + rb(0) = rb(0) - temp485*temp485b9 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp494b4 = -(2.d0*(2.d0*cost**2-7.d0*cost+3.d0)*fun2b) - temp494b5 = -(2.d0*distp(0, 1)*r(0)*fun2b) - temp494b6 = (2.d0*cost-3.d0)*funb - distpb(0, 1) = r(0)*temp494b6 - r(0)**3*fun0b + r(0)*temp494b4 - costb = distp(0, 1)*r(0)*2.d0*funb + (2.d0*2*cost-7.d0)*temp494b5 - rb(0) = rb(0) + distp(0, 1)*temp494b6 - distp(0, 1)*3*r(0)**2*& -& fun0b + dd2*2*r(0)*costb + distp(0, 1)*temp494b4 - dd2b = r(0)**2*costb + dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb0 + distpb(0, 1) = distpb(0, 1) + dd1**2*fun2b - dd1*funb0 + distpb(0, 3) = distpb(0, 3) + fun0b ELSE distpb = 0.0_8 - dd2b = 0.0_8 + dd1b = 0.0_8 END IF - DO ic=3,1,-1 + DO ic=5,1,-1 DO i=0,0,-1 - temp494b3 = -(r(i)**3*zb(indorbp, i)) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp494b3 - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp494b3 - rb(i) = rb(i) - rmu(ic, i)*distp(i, 1)*3*r(i)**2*zb(indorbp, i) + distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO k=0,0,-1 - temp494b2 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp494b2 - rb(k) = rb(k) - dd2*2*r(k)*temp494b2 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (152) -! 2s with cusp condition -! ( r^3*exp(-dd2*r^2)) ! with no cusp condition - dd2 = dd(indpar+1) - indorbp = indorb + 1 - DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k)**2))*r(k) - END DO -! endif - IF (typec .NE. 1) THEN - rp1 = r(0)**2*dd2 - fun = (3.d0-2.d0*rp1)*distp(0, 1) - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - rp1b = (distp(0, 1)*4.d0*2*rp1-distp(0, 1)*14.d0)*fun2b - distp(0& -& , 1)*2.d0*funb - distpb(0, 1) = (3.d0-2.d0*rp1)*funb + (4.d0*rp1**2-14.d0*rp1+6.d0)& -& *fun2b - rb(0) = rb(0) + dd2*2*r(0)*rp1b - dd2b = r(0)**2*rp1b - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + distpb(i, 8) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + distpb(i, 1) = distpb(i, 1) + distpb(i, 3) + distpb(i, 3) = 0.0_8 END DO DO k=0,0,-1 - temp494 = r(k)**2 - temp494b9 = r(k)*DEXP(-(dd2*temp494))*distpb(k, 1) - dd2b = dd2b - temp494*temp494b9 - rb(k) = rb(k) + DEXP(-(dd2*temp494))*distpb(k, 1) - dd2*2*r(k)*& -& temp494b9 + temp485b8 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp485b8 + rb(k) = rb(k) - dd1*temp485b8 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (153) + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (139) ! 2s with cusp condition -! (-r^5*exp(-dd2*r^2)) ! derivative of 152 +! ( r^3*exp(-dd2*r)) ! der of 128 dd2 = dd(indpar+1) indorbp = indorb + 1 DO k=0,0 - distp(k, 1) = DEXP(-(dd2*r(k)**2))*r(k)**3 + distp(k, 1) = -(DEXP(-(dd2*r(k)))*r(k)) END DO ! endif IF (typec .NE. 1) THEN - rp1 = dd2*r(0)**2 - fun = (-5.d0+2.d0*rp1)*distp(0, 1) - funb = 2.d0*zb(indorbp, indt+4) + fun = (3.d0-dd2*r(0))*distp(0, 1) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - rp1b = distp(0, 1)*2.d0*funb + (distp(0, 1)*22.d0-distp(0, 1)*4.d0& -& *2*rp1)*fun2b - distpb(0, 1) = (2.d0*rp1-5.d0)*funb + (22.d0*rp1-4.d0*rp1**2-20.d0& -& )*fun2b - dd2b = r(0)**2*rp1b - rb(0) = rb(0) + dd2*2*r(0)*rp1b + temp487b1 = distp(0, 1)*fun2b + temp487b2 = 2*dd2*r(0)*temp487b1 + dd2b = r(0)*temp487b2 - 6*r(0)*temp487b1 - distp(0, 1)*r(0)*funb0 + rb(0) = rb(0) + dd2*temp487b2 - 6*dd2*temp487b1 - distp(0, 1)*dd2*& +& funb0 + distpb(0, 1) = (3.d0-dd2*r(0))*funb0 + ((dd2*r(0))**2-6*(dd2*r(0))& +& +6.d0)*fun2b ELSE distpb = 0.0_8 dd2b = 0.0_8 END IF DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) - r(i)**2*zb(indorbp, i) - rb(i) = rb(i) - distp(i, 1)*2*r(i)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO DO k=0,0,-1 - temp495 = r(k)**2 - temp495b = r(k)**3*DEXP(-(dd2*temp495))*distpb(k, 1) - dd2b = dd2b - temp495*temp495b - rb(k) = rb(k) + DEXP(-(dd2*temp495))*3*r(k)**2*distpb(k, 1) - dd2*& -& 2*r(k)*temp495b + temp487b0 = -(r(k)*DEXP(-(dd2*r(k)))*distpb(k, 1)) + dd2b = dd2b - r(k)*temp487b0 + rb(k) = rb(k) - DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2*temp487b0 distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (154) -! Jastrow single gaussian f orbital -! R(r)= exp(-alpha r^2) -! unnormalized + CASE (45, 69) +! d orbitals +! R(r)= c*exp(-z r^2)*(7/4/z-r^2) ! indorbp=indorb indparp = indpar + 1 dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization +! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) + c = dd1**1.75d0*1.64592278064948967213d0 +! endif DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k)**2)) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO DO i=0,0 - distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) ! lz=0 - distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) + distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d ! lz=+/-2 - distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) + distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d ! lz=+/-2 - distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) -! lz=+/-3 - distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) + distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d +! lz=+/-1 + distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d +! lz=+/-1 + distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d END DO -! lz=+/-3 - DO ic=1,7 + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO ! endif IF (typec .NE. 1) THEN -! dd1=dd(indparp) - fun0 = distp(0, 1) - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1)*(7.d0/4.d0/dd1-r(0)**2) + fun = distp(0, 1)*(2.d0*dd1*r(0)**2-11.d0/2.d0) + fun2 = distp(0, 1)*(-(4.d0*dd1**2*r(0)**4)+17.d0*dd1*r(0)**2-11.d0& +& /2.d0) ! indorbp=indorb - DO ic=1,7 + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - IF (ic .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) - ELSE IF (ic .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (ic .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE IF (ic .EQ. 4) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (ic .EQ. 5) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - ELSE IF (ic .EQ. 6) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - END IF + DO i=1,3 + IF (ic .EQ. 1) THEN + IF (i .NE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + END IF + END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=7,1,-1 - temp496b29 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & + DO ic=5,1,-1 + temp493b4 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & & indt+4) - funb = funb + 8.d0*temp496b29 - fun2b = fun2b + temp496b29 + funb0 = funb0 + 6.d0*temp493b4 + fun2b = fun2b + temp493b4 zb(indorbp, indt+4) = 0.0_8 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 4) THEN - IF (branch .LT. 2) THEN - IF (branch .LT. 1) THEN - temp496b10 = cost1f*zb(indorbp, indt+3) - temp496b11 = -(cost1f*6.d0*zb(indorbp, indt+2)) - temp496b12 = -(cost1f*6.d0*zb(indorbp, indt+1)) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp496b11 + rmu(3, 0)& -& *rmu(1, 0)*temp496b12 + (9.d0*rmu(3, 0)**2-3.d0*r(0)**2)& -& *temp496b10 - rmub(3, 0) = rmub(3, 0) + fun0*9.d0*2*rmu(3, 0)*temp496b10 - rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp496b10 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp496b11 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp496b11 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp496b12 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp496b12 - ELSE - temp496b13 = cost2f*8.d0*zb(indorbp, indt+3) - temp496b14 = -(cost2f*2.d0*zb(indorbp, indt+2)) - fun0b = fun0b + rmu(1, 0)*rmu(2, 0)*temp496b14 + cost2f*(& -& 5.d0*rmu(3, 0)**2-r(0)**2-2.d0*rmu(1, 0)**2)*zb(indorbp& -& , indt+1) + rmu(1, 0)*rmu(3, 0)*temp496b13 - rmub(3, 0) = rmub(3, 0) + rmu(1, 0)*fun0*temp496b13 - rmub(1, 0) = rmub(1, 0) + fun0*rmu(3, 0)*temp496b13 - rmub(2, 0) = rmub(2, 0) + rmu(1, 0)*fun0*temp496b14 - rmub(1, 0) = rmub(1, 0) + fun0*rmu(2, 0)*temp496b14 - temp496b15 = cost2f*fun0*zb(indorbp, indt+1) - rmub(3, 0) = rmub(3, 0) + 5.d0*2*rmu(3, 0)*temp496b15 - rb(0) = rb(0) - 2*r(0)*temp496b15 - rmub(1, 0) = rmub(1, 0) - 2.d0*2*rmu(1, 0)*temp496b15 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp493b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp493b0 + fun0b = fun0b + rmu(i, 0)*temp493b0 + ELSE + temp493b1 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp493b1 + fun0b = fun0b + rmu(i, 0)*temp493b1 + END IF + ELSE IF (branch .LT. 4) THEN + temp493b2 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp493b2 + fun0b = fun0b + rmu(i, 0)*temp493b2 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp493b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp493b3 + fun0b = fun0b + rmu(i, 0)*temp493b3 + ELSE + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 3) THEN - temp496b16 = cost2f*8.d0*zb(indorbp, indt+3) - temp496b17 = -(cost2f*2.d0*zb(indorbp, indt+1)) - fun0b = fun0b + cost2f*(5.d0*rmu(3, 0)**2-r(0)**2-2.d0*rmu(2& -& , 0)**2)*zb(indorbp, indt+2) + rmu(2, 0)*rmu(1, 0)*& -& temp496b17 + rmu(2, 0)*rmu(3, 0)*temp496b16 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*fun0*temp496b16 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(3, 0)*temp496b16 - temp496b18 = cost2f*fun0*zb(indorbp, indt+2) - rmub(3, 0) = rmub(3, 0) + 5.d0*2*rmu(3, 0)*temp496b18 - rb(0) = rb(0) - 2*r(0)*temp496b18 - rmub(2, 0) = rmub(2, 0) - 2.d0*2*rmu(2, 0)*temp496b18 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp496b17 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp496b17 - ELSE - temp496b19 = cost3f*zb(indorbp, indt+3) - temp496b20 = -(cost3f*2.d0*zb(indorbp, indt+2)) - temp496b21 = cost3f*2.d0*zb(indorbp, indt+1) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp496b20 + rmu(3, 0)*& -& rmu(1, 0)*temp496b21 + (rmu(1, 0)**2-rmu(2, 0)**2)*& -& temp496b19 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp496b19 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp496b20 - fun0*2& -& *rmu(2, 0)*temp496b19 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp496b20 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp496b21 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp496b21 - END IF - ELSE IF (branch .LT. 6) THEN - IF (branch .LT. 5) THEN - temp496b22 = cost3f*2.d0*zb(indorbp, indt+3) - temp496b23 = cost3f*2.d0*zb(indorbp, indt+2) - temp496b24 = cost3f*2.d0*zb(indorbp, indt+1) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp496b23 + rmu(3, 0)*& -& rmu(2, 0)*temp496b24 + rmu(2, 0)*rmu(1, 0)*temp496b22 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp496b22 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp496b22 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp496b23 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp496b23 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp496b24 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp496b24 ELSE - temp496b25 = -(cost4f*6.d0*zb(indorbp, indt+2)) - temp496b26 = cost4f*3.d0*zb(indorbp, indt+1) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp496b26 + rmu& -& (2, 0)*rmu(1, 0)*temp496b25 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp496b25 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp496b25 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp496b26 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp496b26 + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - ELSE - temp496b27 = cost4f*3.d0*zb(indorbp, indt+2) - temp496b28 = cost4f*6.d0*zb(indorbp, indt+1) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp496b28 + (rmu(1, 0)**2& -& -rmu(2, 0)**2)*temp496b27 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp496b27 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp496b27 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp496b28 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp496b28 - END IF - DO i=3,1,-1 - temp496b9 = distp(0, 1+ic)*zb(indorbp, indt+i) + temp493b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp496b9 - funb = funb + rmu(i, 0)*temp496b9 + rmub(i, 0) = rmub(i, 0) + fun*temp493b + funb0 = funb0 + rmu(i, 0)*temp493b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp496b8 = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp496b8 - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp496b8 - distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb + temp492 = r(0)**4 + temp492b = distp(0, 1)*fun2b + temp491 = 4.d0*dd1 + temp490 = 7.d0/temp491 + distpb(0, 1) = distpb(0, 1) + (2.d0*(dd1*r(0)**2)-11.d0/2.d0)*& +& funb0 + (temp490-r(0)**2)*fun0b + (17.d0*(dd1*r(0)**2)-11.d0/& +& 2.d0-4.d0*(dd1**2*temp492))*fun2b + temp492b0 = distp(0, 1)*2.d0*funb0 + dd1b = r(0)**2*temp492b0 - distp(0, 1)*temp490*4.d0*fun0b/temp491 & +& + (17.d0*r(0)**2-4.d0*temp492*2*dd1)*temp492b + rb(0) = rb(0) + dd1*2*r(0)*temp492b0 - distp(0, 1)*2*r(0)*fun0b + & +& (17.d0*dd1*2*r(0)-4.d0*dd1**2*4*r(0)**3)*temp492b + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd1b = 0.0_8 END IF - DO ic=7,1,-1 + dd1b = 0.0_8 + DO ic=5,1,-1 DO k=0,0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + temp490b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) + temp489 = 4.d0*dd1 + temp488 = 7.d0/temp489 + temp488b = (temp488-r(k)**2)*zb(indorbp, k) + dd1b = dd1b - temp488*4.d0*temp490b/temp489 + rb(k) = rb(k) - 2*r(k)*temp490b + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp488b + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp488b zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - temp496b0 = cost4f*rmu(2, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 8) - 2*rmu(2, i)*temp496b0 - distpb(i, 8) = 0.0_8 - temp496b1 = cost4f*rmu(1, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& -& distpb(i, 7) + 2*rmu(1, i)*temp496b1 + 3.d0*2*rmu(1, i)*& -& temp496b0 - rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp496b1 - distpb(i, 7) = 0.0_8 - temp496b2 = cost3f*2.d0*distpb(i, 6) - temp496b3 = rmu(2, i)*temp496b2 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp496b3 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp496b3 - rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp496b2 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 - temp496b4 = cost3f*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 5) - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp496b4 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 4) - 2*rmu(2, i)*temp496b4 - temp496b5 = cost2f*rmu(2, i)*distpb(i, 4) - rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp496b5 + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - temp496b6 = cost2f*rmu(1, i)*distpb(i, 3) - rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 - temp496b7 = cost1f*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - 2*r(i)*temp496b6 - 3.d0*2*r(i)*temp496b7 - 2*r(i)*& -& temp496b5 - rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& -& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp496b7 + 5.d0*2*rmu(3, i)*& -& temp496b6 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) distpb(i, 2) = 0.0_8 END DO + cb = 0.0_8 DO k=0,0,-1 - temp496b = DEXP(-(dd1*r(k)**2))*distpb(k, 1) - dd1b = dd1b - r(k)**2*temp496b - rb(k) = rb(k) - dd1*2*r(k)*temp496b + temp487 = r(k)**2 + temp487b3 = c*DEXP(-(dd1*temp487))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp487))*distpb(k, 1) + dd1b = dd1b - temp487*temp487b3 + rb(k) = rb(k) - dd1*2*r(k)*temp487b3 distpb(k, 1) = 0.0_8 END DO + dd1b = dd1b + 1.64592278064948967213d0*1.75d0*dd1**0.75D0*cb ddb(indparp) = ddb(indparp) + dd1b - CASE (155) -! Jastrow single gaussian f orbital -! derivative of 154 with respect to z -! unnormalized f orbitals -! R(r)= -r^2*exp(-z r^2) + CASE (1200:1299) +! derivative of 17 with respect to z +! d gaussian r**(2*npower)*exp(-alpha*r**2) + npower = iopt - 1200 ! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) + dd2 = dd(indpar+1) DO k=0,0 - distp(k, 1) = DEXP(-(dd1*r(k)**2)) + distp(k, 1) = r(k)**(2*npower)*DEXP(-(dd2*r(k)**2)) END DO DO i=0,0 - distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) -! lz=0 - distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) -! lz=+/-2 - distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) -! lz=+/-2 - distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) -! lz=+/-3 - distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) + distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d + distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d + distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d END DO -! lz=+/-3 - DO ic=1,7 + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO ! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = -(r(0)**2*distp(0, 1)) - fun = 2.d0*(dd1*r(0)**2-1.d0)*distp(0, 1) - fun2 = -(2.d0*(2.d0*dd1**2*r(0)**4+1.d0-5.d0*dd1*r(0)**2)*distp(0& -& , 1)) + rp1 = r(0)**2 + fun0 = distp(0, 1) + fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 + fun2 = (npower*(2.d0*npower-1.d0)-(1.d0+4.d0*npower)*dd2*rp1+2.d0*& +& (dd2*rp1)**2)*distp(0, 1)*2.d0/rp1 ! indorbp=indorb - DO ic=1,7 + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) ! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN - IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE + IF (i .NE. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) END IF ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 3) THEN + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 2) THEN + IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 3) THEN + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) END IF ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 1) THEN + IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF - ELSE IF (ic .EQ. 6) THEN - IF (i .EQ. 1) THEN + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) END IF - ELSE IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=7,1,-1 - temp497b23 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & + DO ic=5,1,-1 + temp497b6 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & & indt+4) - funb = funb + 8.d0*temp497b23 - fun2b = fun2b + temp497b23 + funb0 = funb0 + 6.d0*temp497b6 + fun2b = fun2b + temp497b6 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 11) THEN - IF (branch .LT. 6) THEN - IF (branch .LT. 4) THEN - IF (branch .LT. 3) THEN - IF (.NOT.branch .LT. 2) THEN - temp497b2 = cost1f*zb(indorbp, indt+i) - fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& -& temp497b2 - rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& -& temp497b2 - rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp497b2 - END IF - temp497b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) - temp497b1 = rmu(i, 0)*temp497b0 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp497b0 - fun0b = fun0b + rmu(3, 0)*temp497b1 - rmub(3, 0) = rmub(3, 0) + fun0*temp497b1 - GOTO 150 + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp497b2 = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp497b2 + fun0b = fun0b + rmu(i, 0)*temp497b2 ELSE - temp497b5 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp497b5 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp497b5 - rb(0) = rb(0) - fun0*2*r(0)*temp497b5 + temp497b3 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp497b3 + fun0b = fun0b + rmu(i, 0)*temp497b3 END IF - ELSE IF (.NOT.branch .LT. 5) THEN - temp497b6 = cost2f*10.d0*zb(indorbp, indt+i) - temp497b7 = rmu(i, 0)*temp497b6 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp497b6 - fun0b = fun0b + rmu(1, 0)*temp497b7 - rmub(1, 0) = rmub(1, 0) + fun0*temp497b7 + ELSE IF (branch .LT. 4) THEN + temp497b4 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp497b4 + fun0b = fun0b + rmu(i, 0)*temp497b4 END IF - temp497b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp497b4 = rmu(i, 0)*temp497b3 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp497b3 - fun0b = fun0b + rmu(1, 0)*temp497b4 - rmub(1, 0) = rmub(1, 0) + fun0*temp497b4 - ELSE IF (branch .LT. 9) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 7) THEN - temp497b10 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp497b10 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp497b10 - rb(0) = rb(0) - fun0*2*r(0)*temp497b10 - END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp497b5 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp497b5 + fun0b = fun0b + rmu(i, 0)*temp497b5 ELSE - temp497b11 = cost2f*10.d0*zb(indorbp, indt+i) - temp497b12 = rmu(i, 0)*temp497b11 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp497b11 - fun0b = fun0b + rmu(2, 0)*temp497b12 - rmub(2, 0) = rmub(2, 0) + fun0*temp497b12 + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - temp497b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp497b9 = rmu(i, 0)*temp497b8 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp497b8 - fun0b = fun0b + rmu(2, 0)*temp497b9 - rmub(2, 0) = rmub(2, 0) + fun0*temp497b9 - ELSE IF (branch .LT. 10) THEN - temp497b13 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp497b13 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp497b13 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp497b13 - ELSE - temp497b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp497b14 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp497b14 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp497b14 + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 16) THEN - IF (branch .LT. 14) THEN - IF (branch .LT. 13) THEN - IF (branch .LT. 12) THEN - temp497b15 = cost3f*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp497b15 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp497b15 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp497b15 - ELSE - temp497b16 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp497b16 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp497b16 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp497b16 - END IF - ELSE - temp497b17 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp497b17 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp497b17 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp497b17 + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 15) THEN - temp497b18 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp497b18 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp497b18 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp497b18 - ELSE - temp497b19 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp497b19 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp497b19 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp497b19 + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 19) THEN - IF (branch .LT. 18) THEN - IF (.NOT.branch .LT. 17) THEN - temp497b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp497b20 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp497b20 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp497b20 - END IF - ELSE - temp497b21 = cost4f*6.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp497b21 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp497b21 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp497b21 + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF - ELSE IF (.NOT.branch .LT. 20) THEN - temp497b22 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp497b22 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp497b22 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp497b22 + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - 150 temp497b = distp(0, 1+ic)*zb(indorbp, indt+i) + temp497b1 = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp497b - funb = funb + rmu(i, 0)*temp497b + rmub(i, 0) = rmub(i, 0) + fun*temp497b1 + funb0 = funb0 + rmu(i, 0)*temp497b1 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp496 = r(0)**4 - temp496b40 = -(2.d0*distp(0, 1)*fun2b) - temp496b41 = 2.d0*distp(0, 1)*funb - dd1b = r(0)**2*temp496b41 + (2.d0*temp496*2*dd1-5.d0*r(0)**2)*& -& temp496b40 - rb(0) = rb(0) + dd1*2*r(0)*temp496b41 - distp(0, 1)*2*r(0)*fun0b +& -& (2.d0*dd1**2*4*r(0)**3-5.d0*dd1*2*r(0))*temp496b40 - distpb(0, 1) = distpb(0, 1) + 2.d0*(dd1*r(0)**2-1.d0)*funb - r(0)& -& **2*fun0b - 2.d0*(2.d0*(dd1**2*temp496)-5.d0*(dd1*r(0)**2)+1.d0)& -& *fun2b - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + temp496 = distp(0, 1)/rp1 + temp497b = 2.d0*temp496*fun2b + temp497b0 = -((npower*4.d0+1.d0)*temp497b) + temp496b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& +& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 + temp495 = distp(0, 1)/rp1 + temp496b0 = 2.d0*temp495*funb0 + dd2b = rp1*temp497b0 - rp1*temp496b0 + 2.d0*rp1**2*2*dd2*temp497b + temp495b = 2.d0*(npower-dd2*rp1)*funb0/rp1 + rp1b = dd2*temp497b0 - temp495*temp495b - temp496*temp496b - dd2*& +& temp496b0 + 2.d0*dd2**2*2*rp1*temp497b + distpb(0, 1) = distpb(0, 1) + temp495b + fun0b + temp496b + rb(0) = rb(0) + 2*r(0)*rp1b ELSE distpb = 0.0_8 + dd2b = 0.0_8 END IF - DO ic=7,1,-1 - DO k=0,0,-1 - temp496b39 = -(r(k)**2*zb(indorbp, k)) - rb(k) = rb(k) - distp(k, 1)*distp(k, 1+ic)*2*r(k)*zb(indorbp, k) - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp496b39 - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp496b39 - zb(indorbp, k) = 0.0_8 + DO ic=5,1,-1 + DO i=0,0,-1 + distpb(i, 1+ic) = distpb(i, 1+ic) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + distp(i, 1+ic)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=0,0,-1 - temp496b31 = cost4f*rmu(2, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 8) - 2*rmu(2, i)*temp496b31 - distpb(i, 8) = 0.0_8 - temp496b32 = cost4f*rmu(1, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& -& distpb(i, 7) + 2*rmu(1, i)*temp496b32 + 3.d0*2*rmu(1, i)*& -& temp496b31 - rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp496b32 - distpb(i, 7) = 0.0_8 - temp496b33 = cost3f*2.d0*distpb(i, 6) - temp496b34 = rmu(2, i)*temp496b33 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp496b34 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp496b34 - rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp496b33 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 - temp496b35 = cost3f*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 5) - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp496b35 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 4) - 2*rmu(2, i)*temp496b35 - temp496b36 = cost2f*rmu(2, i)*distpb(i, 4) - rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp496b36 + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - temp496b37 = cost2f*rmu(1, i)*distpb(i, 3) - rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 - temp496b38 = cost1f*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - 2*r(i)*temp496b37 - 3.d0*2*r(i)*temp496b38 - 2*r(i& -& )*temp496b36 - rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& -& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp496b38 + 5.d0*2*rmu(3, i)*& -& temp496b37 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) distpb(i, 2) = 0.0_8 END DO - dd1b = 0.0_8 DO k=0,0,-1 - temp496b30 = DEXP(-(dd1*r(k)**2))*distpb(k, 1) - dd1b = dd1b - r(k)**2*temp496b30 - rb(k) = rb(k) - dd1*2*r(k)*temp496b30 + temp494 = r(k)**2 + temp493 = 2*npower + temp493b5 = r(k)**temp493*DEXP(-(dd2*temp494))*distpb(k, 1) + IF (r(k) .LE. 0.0 .AND. (temp493 .EQ. 0.0 .OR. temp493 .NE. INT(& +& temp493))) THEN + rb(k) = rb(k) - dd2*2*r(k)*temp493b5 + ELSE + rb(k) = rb(k) + DEXP(-(dd2*temp494))*temp493*r(k)**(temp493-1)*& +& distpb(k, 1) - dd2*2*r(k)*temp493b5 + END IF + dd2b = dd2b - temp494*temp493b5 distpb(k, 1) = 0.0_8 END DO - ddb(indparp) = ddb(indparp) + dd1b - CASE (199) -! derivative of 200 LA COSTANTE + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (90:99) +! cartesian orbitals +! +! - angmom := iopt - 90 +! - type = Gaussian +! - normalized = yes +! - angtype = cartesian +! - npar = 1 +! - multiplicity := (iopt - 90 + 2) * (iopt - 90 + 1) // 2 +! indorbp = indorb + 1 -! endif + dd1 = dd(indpar+1) + multiplicity = (iopt-90+2)*(iopt-90+1)/2 + powers(:, -2, :) = 0.0d0 + powers(:, -1, :) = 0.0d0 + powers(:, 0, :) = 1.0d0 + DO ii=1,iopt-90 + DO k=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,powers(1, ii, k)) + powers(1, ii, k) = powers(1, ii-1, k)*rmu(1, k) + CALL PUSHREAL8(adr8ibuf,adr8buf,powers(2, ii, k)) + powers(2, ii, k) = powers(2, ii-1, k)*rmu(2, k) + CALL PUSHREAL8(adr8ibuf,adr8buf,powers(3, ii, k)) + powers(3, ii, k) = powers(3, ii-1, k)*rmu(3, k) + END DO + END DO +! * 2.829 + c = 0.712705470354990_8*dd1**0.75_8 + IF (iopt - 90 .NE. 0) THEN + CALL PUSHREAL8(adr8ibuf,adr8buf,c) + c = c*(8_4*dd1)**((iopt-90)/2.0_8) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + END IF + DO k=0,0 + distp(k, 1) = DEXP(-(1.0_8*dd1*r(k)*r(k)))*c + END DO + DO k=0,0 + count = 0 + DO ii=iopt-90,0,-1 + ad_from = iopt - 90 - ii + DO jj=ad_from,0,-1 + kk = iopt - 90 - ii - jj + z(indorbp+count, k) = 1.0_8 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = 1.0_8 + DO i=ii+1,2*ii + rp1 = rp1*i + END DO + z(indorbp+count, k) = z(indorbp+count, k)/DSQRT(rp1) + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = 1.0_8 + DO i=jj+1,2*jj + rp1 = rp1*i + END DO + z(indorbp+count, k) = z(indorbp+count, k)/DSQRT(rp1) + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = 1.0_8 + DO i=kk+1,2*kk + rp1 = rp1*i + END DO + z(indorbp+count, k) = z(indorbp+count, k)/DSQRT(rp1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,count) + count = count + 1 + END DO + CALL PUSHINTEGER4(adi4ibuf,adi4buf,ad_from) + END DO + END DO +! We need to calculate it again for derivatives, it could not be done in previous loop because of case if 0 /= 0 IF (typec .NE. 1) THEN - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - zb(indorbp, indt+i) = 0.0_8 + count = 0 + DO ii=iopt-90,0,-1 + ad_from0 = iopt - 90 - ii + DO jj=ad_from0,0,-1 + kk = iopt - 90 - ii - jj + z(indorbp+count, indt+1) = 1.0_8 + z(indorbp+count, indt+2) = 1.0_8 + z(indorbp+count, indt+3) = 1.0_8 + z(indorbp+count, indt+4) = 1.0_8 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = 1.0_8 + DO i=ii+1,2*ii + rp1 = rp1*i + END DO + z(indorbp+count, indt+1) = z(indorbp+count, indt+1)/DSQRT(rp1) + z(indorbp+count, indt+2) = z(indorbp+count, indt+2)/DSQRT(rp1) + z(indorbp+count, indt+3) = z(indorbp+count, indt+3)/DSQRT(rp1) + z(indorbp+count, indt+4) = z(indorbp+count, indt+4)/DSQRT(rp1) + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = 1.0_8 + DO i=jj+1,2*jj + rp1 = rp1*i + END DO + z(indorbp+count, indt+1) = z(indorbp+count, indt+1)/DSQRT(rp1) + z(indorbp+count, indt+2) = z(indorbp+count, indt+2)/DSQRT(rp1) + z(indorbp+count, indt+3) = z(indorbp+count, indt+3)/DSQRT(rp1) + z(indorbp+count, indt+4) = z(indorbp+count, indt+4)/DSQRT(rp1) + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = 1.0_8 + DO i=kk+1,2*kk + rp1 = rp1*i + END DO + z(indorbp+count, indt+1) = z(indorbp+count, indt+1)/DSQRT(rp1) + z(indorbp+count, indt+2) = z(indorbp+count, indt+2)/DSQRT(rp1) + z(indorbp+count, indt+3) = z(indorbp+count, indt+3)/DSQRT(rp1) + z(indorbp+count, indt+4) = z(indorbp+count, indt+4)/DSQRT(rp1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,count) + count = count + 1 + END DO + CALL PUSHINTEGER4(adi4ibuf,adi4buf,ad_from0) END DO + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) END IF - DO i=0,0,-1 - zb(indorbp, i) = 0.0_8 - END DO - distpb = 0.0_8 - CASE (200) -! THE COSTANT - indorbp = indorb + 1 -! endif +! Initialize gradients and laplacians (radial part) IF (typec .NE. 1) THEN - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - zb(indorbp, indt+i) = 0.0_8 + tmp = -(2.0d0*dd1*rmu(1, 0)*distp(0, 1)) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(indt+1, 1)) + distp(indt+1, 1) = tmp + tmp0 = -(2.0d0*dd1*rmu(2, 0)*distp(0, 1)) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(indt+2, 1)) + distp(indt+2, 1) = tmp0 + tmp1 = -(2.0d0*dd1*rmu(3, 0)*distp(0, 1)) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(indt+3, 1)) + distp(indt+3, 1) = tmp1 + tmp2 = dd1*(4.0d0*dd1*(r(0)*r(0))-6.0d0)*distp(0, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(indt+4, 1)) + distp(indt+4, 1) = tmp2 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + END IF + DO k=0,0 + count = 0 + DO ii=iopt-90,0,-1 + ad_from1 = iopt - 90 - ii + DO jj=ad_from1,0,-1 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,kk) + kk = iopt - 90 - ii - jj + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, k)) + z(indorbp+count, k) = z(indorbp+count, k)*powers(1, ii, k) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, k)) + z(indorbp+count, k) = z(indorbp+count, k)*powers(2, jj, k) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, k)) + z(indorbp+count, k) = z(indorbp+count, k)*powers(3, kk, k) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,count) + count = count + 1 + END DO + CALL PUSHINTEGER4(adi4ibuf,adi4buf,ad_from1) END DO + END DO + IF (typec .NE. 1) THEN +! Solve ang_mom = 0, 1 separately + IF (iopt - 90 .EQ. 0) THEN + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+1)) + z(indorbp, indt+1) = distp(indt+1, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+2)) + z(indorbp, indt+2) = distp(indt+2, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+3)) + z(indorbp, indt+3) = distp(indt+3, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+4)) + z(indorbp, indt+4) = distp(indt+4, 1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (iopt - 90 .EQ. 1) THEN + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = DSQRT(2.0_8) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+1)) + z(indorbp, indt+1) = (distp(indt+1, 1)*rmu(1, 0)+distp(0, & +& 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+2)) + z(indorbp, indt+2) = distp(indt+2, 1)*rmu(1, 0)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+3)) + z(indorbp, indt+3) = distp(indt+3, 1)*rmu(1, 0)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+1)) + z(indorbp+1, indt+1) = distp(indt+1, 1)*rmu(2, 0)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+2)) + z(indorbp+1, indt+2) = (distp(indt+2, 1)*rmu(2, 0)+distp(0& +& , 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+3)) + z(indorbp+1, indt+3) = distp(indt+3, 1)*rmu(2, 0)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+1)) + z(indorbp+2, indt+1) = distp(indt+1, 1)*rmu(3, 0)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+2)) + z(indorbp+2, indt+2) = distp(indt+2, 1)*rmu(3, 0)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+3)) + z(indorbp+2, indt+3) = (distp(indt+3, 1)*rmu(3, 0)+distp(0& +& , 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+4)) + z(indorbp, indt+4) = (distp(indt+4, 1)*rmu(1, 0)+2.0d0*& +& distp(indt+1, 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+4)) + z(indorbp+1, indt+4) = (distp(indt+4, 1)*rmu(2, 0)+2.0d0*& +& distp(indt+2, 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+4)) + z(indorbp+2, indt+4) = (distp(indt+4, 1)*rmu(3, 0)+2.0d0*& +& distp(indt+3, 1))/rp1 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE IF (iopt - 90 .EQ. 2) THEN + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = 2.0_8 + rp2 = DSQRT(12.0_8) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+1)) + z(indorbp, indt+1) = (distp(indt+1, 1)*rmu(1, 0)*rmu(1, & +& 0)+2*rmu(1, 0)*distp(0, 1))/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+2)) + z(indorbp, indt+2) = distp(indt+2, 1)*rmu(1, 0)*rmu(1, & +& 0)/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+3)) + z(indorbp, indt+3) = distp(indt+3, 1)*rmu(1, 0)*rmu(1, & +& 0)/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+1)) + z(indorbp+1, indt+1) = (distp(indt+1, 1)*rmu(1, 0)*rmu(2, & +& 0)+rmu(2, 0)*distp(0, 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+2)) + z(indorbp+1, indt+2) = (distp(indt+2, 1)*rmu(1, 0)*rmu(2, & +& 0)+rmu(1, 0)*distp(0, 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+3)) + z(indorbp+1, indt+3) = distp(indt+3, 1)*rmu(1, 0)*rmu(2, & +& 0)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+1)) + z(indorbp+2, indt+1) = (distp(indt+1, 1)*rmu(1, 0)*rmu(3, & +& 0)+rmu(3, 0)*distp(0, 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+2)) + z(indorbp+2, indt+2) = distp(indt+2, 1)*rmu(1, 0)*rmu(3, & +& 0)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+3)) + z(indorbp+2, indt+3) = distp(indt+3, 1)*rmu(1, 0)*rmu(3, & +& 0) + rmu(1, 0)*distp(0, 1)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+3, indt+1)) + z(indorbp+3, indt+1) = distp(indt+1, 1)*rmu(2, 0)*rmu(2, & +& 0)/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+3, indt+2)) + z(indorbp+3, indt+2) = (distp(indt+2, 1)*rmu(2, 0)*rmu(2, & +& 0)+2*rmu(2, 0)*distp(0, 1))/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+3, indt+3)) + z(indorbp+3, indt+3) = distp(indt+3, 1)*rmu(2, 0)*rmu(2, & +& 0)/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+4, indt+1)) + z(indorbp+4, indt+1) = distp(indt+1, 1)*rmu(2, 0)*rmu(3, & +& 0)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+4, indt+2)) + z(indorbp+4, indt+2) = (distp(indt+2, 1)*rmu(2, 0)*rmu(3, & +& 0)+rmu(3, 0)*distp(0, 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+4, indt+3)) + z(indorbp+4, indt+3) = (distp(indt+3, 1)*rmu(2, 0)*rmu(3, & +& 0)+rmu(2, 0)*distp(0, 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+5, indt+1)) + z(indorbp+5, indt+1) = distp(indt+1, 1)*rmu(3, 0)*rmu(3, & +& 0)/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+5, indt+2)) + z(indorbp+5, indt+2) = distp(indt+2, 1)*rmu(3, 0)*rmu(3, & +& 0)/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+5, indt+3)) + z(indorbp+5, indt+3) = (distp(indt+3, 1)*rmu(3, 0)*rmu(3, & +& 0)+2*rmu(3, 0)*distp(0, 1))/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+4)) + z(indorbp, indt+4) = (1.0d0*distp(indt+4, 1)*rmu(1, 0)*rmu& +& (1, 0)+4.0d0*distp(indt+1, 1)*rmu(1, 0)+2.0d0*& +& distp(0, 1))/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+4)) + z(indorbp+1, indt+4) = (1.0d0*distp(indt+4, 1)*rmu(1, 0)*& +& rmu(2, 0)+2.0d0*distp(indt+2, 1)*rmu(1, 0)+2.0d0*& +& distp(indt+1, 1)*rmu(2, 0))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+4)) + z(indorbp+2, indt+4) = (1.0d0*distp(indt+4, 1)*rmu(1, 0)*& +& rmu(3, 0)+2.0d0*distp(indt+3, 1)*rmu(1, 0)+2.0d0*& +& distp(indt+1, 1)*rmu(3, 0))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+3, indt+4)) + z(indorbp+3, indt+4) = (1.0d0*distp(indt+4, 1)*rmu(2, 0)*& +& rmu(2, 0)+4.0d0*distp(indt+2, 1)*rmu(2, 0)+2.0d0*& +& distp(0, 1))/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+4, indt+4)) + z(indorbp+4, indt+4) = (1.0d0*distp(indt+4, 1)*rmu(2, 0)*& +& rmu(3, 0)+2.0d0*distp(indt+3, 1)*rmu(2, 0)+2.0d0*& +& distp(indt+2, 1)*rmu(3, 0))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+5, indt+4)) + z(indorbp+5, indt+4) = (1.0d0*distp(indt+4, 1)*rmu(3, 0)*& +& rmu(3, 0)+4.0d0*distp(indt+3, 1)*rmu(3, 0)+2.0d0*& +& distp(0, 1))/rp2 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE + count = 0 + DO ii=iopt-90,0,-1 + ad_from2 = iopt - 90 - ii + DO jj=ad_from2,0,-1 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,kk) + kk = iopt - 90 - ii - jj + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) +! First store polynomial part into respective places +! Then solve full laplacian using using lower derivatives +! Then do the same thing for gradients +! Then finally the values + z(indorbp+count, indt+1) = z(indorbp+count, indt+1)*powers(1& +& , ii-1, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + z(indorbp+count, indt+1) = z(indorbp+count, indt+1)*powers(2& +& , jj, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + z(indorbp+count, indt+1) = z(indorbp+count, indt+1)*powers(3& +& , kk, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + z(indorbp+count, indt+1) = z(indorbp+count, indt+1)*ii + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + z(indorbp+count, indt+2) = z(indorbp+count, indt+2)*powers(1& +& , ii, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + z(indorbp+count, indt+2) = z(indorbp+count, indt+2)*powers(2& +& , jj-1, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + z(indorbp+count, indt+2) = z(indorbp+count, indt+2)*powers(3& +& , kk, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + z(indorbp+count, indt+2) = z(indorbp+count, indt+2)*jj + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + z(indorbp+count, indt+3) = z(indorbp+count, indt+3)*powers(1& +& , ii, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + z(indorbp+count, indt+3) = z(indorbp+count, indt+3)*powers(2& +& , jj, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + z(indorbp+count, indt+3) = z(indorbp+count, indt+3)*powers(3& +& , kk-1, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + z(indorbp+count, indt+3) = z(indorbp+count, indt+3)*kk + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+4)) + z(indorbp+count, indt+4) = z(indorbp+count, indt+4)*(powers(& +& 1, ii-2, 0)*powers(2, jj, 0)*powers(3, kk, 0)*ii*(ii-1)+& +& powers(1, ii, 0)*powers(2, jj-2, 0)*powers(3, kk, 0)*jj*(& +& jj-1)+powers(1, ii, 0)*powers(2, jj, 0)*powers(3, kk-2, 0)& +& *kk*(kk-1)) +! All polynomial parts are now stored +! Now solve laplacian + tmp3 = z(indorbp+count, indt+4)*distp(0, 1) + 2.0_8*z(& +& indorbp+count, indt+1)*distp(indt+1, 1) + 2.0_8*z(indorbp+& +& count, indt+2)*distp(indt+2, 1) + 2.0_8*z(indorbp+count, & +& indt+3)*distp(indt+3, 1) + z(indorbp+count, 0)*distp& +& (indt+4, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+4)) + z(indorbp+count, indt+4) = tmp3 +! Now solve gradients + tmp4 = z(indorbp+count, indt+1)*distp(0, 1) + z(indorbp+& +& count, 0)*distp(indt+1, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + z(indorbp+count, indt+1) = tmp4 + tmp5 = z(indorbp+count, indt+2)*distp(0, 1) + z(indorbp+& +& count, 0)*distp(indt+2, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + z(indorbp+count, indt+2) = tmp5 + tmp6 = z(indorbp+count, indt+3)*distp(0, 1) + z(indorbp+& +& count, 0)*distp(indt+3, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + z(indorbp+count, indt+3) = tmp6 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,count) + count = count + 1 + END DO + CALL PUSHINTEGER4(adi4ibuf,adi4buf,ad_from2) + END DO + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) END IF - DO i=0,0,-1 - zb(indorbp, i) = 0.0_8 +! Multiply by radial part for values + DO ii=1,multiplicity + CALL PUSHINTEGER4(adi4ibuf,adi4buf,kk) END DO distpb = 0.0_8 - CASE (1000:1099) -! s gaussian r**(2*npower)*exp(-alpha*r**2) - npower = iopt - 1000 - indorbp = indorb + 1 - dd2 = dd(indpar+1) - DO k=0,0 - distp(k, 1) = r(k)**(2*npower)*DEXP(-(dd2*r(k)**2)) + DO ii=multiplicity,1,-1 + DO kk=0,0,-1 + distpb(kk, 1) = distpb(kk, 1) + z(indorbp+ii-1, kk)*zb(indorbp+& +& ii-1, kk) + zb(indorbp+ii-1, kk) = distp(kk, 1)*zb(indorbp+ii-1, kk) + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,kk) END DO -! endif - IF (typec .NE. 1) THEN - rp1 = r(0)**2 - fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + IF (branch .LT. 1) THEN + powersb = 0.0_8 + ELSE + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+4)) + distpb(indt+4, 1) = distpb(indt+4, 1) + zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+3)) + distpb(indt+3, 1) = distpb(indt+3, 1) + zb(indorbp, indt+3) + zb(indorbp, indt+3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+2)) + distpb(indt+2, 1) = distpb(indt+2, 1) + zb(indorbp, indt+2) + zb(indorbp, indt+2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+1)) + distpb(indt+1, 1) = distpb(indt+1, 1) + zb(indorbp, indt+1) + zb(indorbp, indt+1) = 0.0_8 + powersb = 0.0_8 + END IF + ELSE + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+4)) + temp499b4 = zb(indorbp+2, indt+4)/rp1 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(3, 0)*& +& temp499b4 + rmub(3, 0) = rmub(3, 0) + distp(indt+4, 1)*temp499b4 + distpb(indt+3, 1) = distpb(indt+3, 1) + 2.0d0*temp499b4 + zb(indorbp+2, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+4)) + temp499b5 = zb(indorbp+1, indt+4)/rp1 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(2, 0)*& +& temp499b5 + rmub(2, 0) = rmub(2, 0) + distp(indt+4, 1)*temp499b5 + distpb(indt+2, 1) = distpb(indt+2, 1) + 2.0d0*temp499b5 + zb(indorbp+1, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+4)) + temp499b6 = zb(indorbp, indt+4)/rp1 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(1, 0)*& +& temp499b6 + rmub(1, 0) = rmub(1, 0) + distp(indt+4, 1)*temp499b6 + distpb(indt+1, 1) = distpb(indt+1, 1) + 2.0d0*temp499b6 + zb(indorbp, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+3)) + temp499b7 = zb(indorbp+2, indt+3)/rp1 + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(3, 0)*& +& temp499b7 + zb(indorbp+2, indt+3) = 0.0_8 + rmub(3, 0) = rmub(3, 0) + distp(indt+2, 1)*zb(& +& indorbp+2, indt+2)/rp1 + distp(indt+3, 1)*temp499b7 + distpb(0, 1) = distpb(0, 1) + temp499b7 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+2)) + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(3, 0)*zb(& +& indorbp+2, indt+2)/rp1 + zb(indorbp+2, indt+2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+1)) + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(3, 0)*zb(& +& indorbp+2, indt+1)/rp1 + rmub(3, 0) = rmub(3, 0) + distp(indt+1, 1)*zb(& +& indorbp+2, indt+1)/rp1 + zb(indorbp+2, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+3)) + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(2, 0)*zb(& +& indorbp+1, indt+3)/rp1 + rmub(2, 0) = rmub(2, 0) + distp(indt+3, 1)*zb(& +& indorbp+1, indt+3)/rp1 + zb(indorbp+1, indt+3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+2)) + temp499b8 = zb(indorbp+1, indt+2)/rp1 + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(2, 0)*& +& temp499b8 + zb(indorbp+1, indt+2) = 0.0_8 + rmub(2, 0) = rmub(2, 0) + distp(indt+1, 1)*zb(& +& indorbp+1, indt+1)/rp1 + distp(indt+2, 1)*temp499b8 + distpb(0, 1) = distpb(0, 1) + temp499b8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+1)) + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(2, 0)*zb(& +& indorbp+1, indt+1)/rp1 + zb(indorbp+1, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+3)) + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(1, 0)*zb(& +& indorbp, indt+3)/rp1 + rmub(1, 0) = rmub(1, 0) + distp(indt+3, 1)*zb(& +& indorbp, indt+3)/rp1 + zb(indorbp, indt+3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+2)) + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(1, 0)*zb(& +& indorbp, indt+2)/rp1 + rmub(1, 0) = rmub(1, 0) + distp(indt+2, 1)*zb(& +& indorbp, indt+2)/rp1 + zb(indorbp, indt+2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+1)) + temp499b9 = zb(indorbp, indt+1)/rp1 + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(1, 0)*& +& temp499b9 + rmub(1, 0) = rmub(1, 0) + distp(indt+1, 1)*temp499b9 + distpb(0, 1) = distpb(0, 1) + temp499b9 + zb(indorbp, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + powersb = 0.0_8 + END IF + ELSE IF (branch .LT. 4) THEN + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+5, indt+4)) + temp499b10 = zb(indorbp+5, indt+4)/rp2 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(3, 0)**2*& +& temp499b10 + rmub(3, 0) = rmub(3, 0) + (4.0d0*distp(indt+3, 1)+& +& distp(indt+4, 1)*2*rmu(3, 0))*temp499b10 + distpb(indt+3, 1) = distpb(indt+3, 1) + 4.0d0*rmu(3, 0)*& +& temp499b10 + distpb(0, 1) = distpb(0, 1) + 2.0d0*temp499b10 + zb(indorbp+5, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+4, indt+4)) + temp499b11 = zb(indorbp+4, indt+4)/rp1 + temp499b12 = distp(indt+4, 1)*temp499b11 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(2, 0)*rmu(3, & +& 0)*temp499b11 + rmub(2, 0) = rmub(2, 0) + 2.0d0*distp(indt+3, 1)*& +& temp499b11 + rmu(3, 0)*temp499b12 + rmub(3, 0) = rmub(3, 0) + 2.0d0*distp(indt+2, 1)*& +& temp499b11 + rmu(2, 0)*temp499b12 + distpb(indt+3, 1) = distpb(indt+3, 1) + 2.0d0*rmu(2, 0)*& +& temp499b11 + distpb(indt+2, 1) = distpb(indt+2, 1) + 2.0d0*rmu(3, 0)*& +& temp499b11 + zb(indorbp+4, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+3, indt+4)) + temp499b13 = zb(indorbp+3, indt+4)/rp2 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(2, 0)**2*& +& temp499b13 + rmub(2, 0) = rmub(2, 0) + (4.0d0*distp(indt+2, 1)+& +& distp(indt+4, 1)*2*rmu(2, 0))*temp499b13 + distpb(indt+2, 1) = distpb(indt+2, 1) + 4.0d0*rmu(2, 0)*& +& temp499b13 + distpb(0, 1) = distpb(0, 1) + 2.0d0*temp499b13 + zb(indorbp+3, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+4)) + temp499b14 = zb(indorbp+2, indt+4)/rp1 + temp499b15 = distp(indt+4, 1)*temp499b14 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(1, 0)*rmu(3, & +& 0)*temp499b14 + rmub(1, 0) = rmub(1, 0) + 2.0d0*distp(indt+3, 1)*& +& temp499b14 + rmu(3, 0)*temp499b15 + rmub(3, 0) = rmub(3, 0) + 2.0d0*distp(indt+1, 1)*& +& temp499b14 + rmu(1, 0)*temp499b15 + distpb(indt+3, 1) = distpb(indt+3, 1) + 2.0d0*rmu(1, 0)*& +& temp499b14 + distpb(indt+1, 1) = distpb(indt+1, 1) + 2.0d0*rmu(3, 0)*& +& temp499b14 + zb(indorbp+2, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+4)) + temp499b16 = zb(indorbp+1, indt+4)/rp1 + temp499b17 = distp(indt+4, 1)*temp499b16 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(1, 0)*rmu(2, & +& 0)*temp499b16 + rmub(1, 0) = rmub(1, 0) + 2.0d0*distp(indt+2, 1)*& +& temp499b16 + rmu(2, 0)*temp499b17 + rmub(2, 0) = rmub(2, 0) + 2.0d0*distp(indt+1, 1)*& +& temp499b16 + rmu(1, 0)*temp499b17 + distpb(indt+2, 1) = distpb(indt+2, 1) + 2.0d0*rmu(1, 0)*& +& temp499b16 + distpb(indt+1, 1) = distpb(indt+1, 1) + 2.0d0*rmu(2, 0)*& +& temp499b16 + zb(indorbp+1, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+4)) + temp499b18 = zb(indorbp, indt+4)/rp2 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(1, 0)**2*& +& temp499b18 + rmub(1, 0) = rmub(1, 0) + (4.0d0*distp(indt+1, 1)+& +& distp(indt+4, 1)*2*rmu(1, 0))*temp499b18 + distpb(indt+1, 1) = distpb(indt+1, 1) + 4.0d0*rmu(1, 0)*& +& temp499b18 + distpb(0, 1) = distpb(0, 1) + 2.0d0*temp499b18 zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+5, indt+3)) + temp499b19 = zb(indorbp+5, indt+3)/rp2 + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(3, 0)**2*& +& temp499b19 + zb(indorbp+5, indt+3) = 0.0_8 + rmub(3, 0) = rmub(3, 0) + distp(indt+2, 1)*2*rmu(3, & +& 0)*zb(indorbp+5, indt+2)/rp2 + (2*distp(0, 1)+distp(indt+3& +& , 1)*2*rmu(3, 0))*temp499b19 + distpb(0, 1) = distpb(0, 1) + 2*rmu(3, 0)*temp499b19 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+5, indt+2)) + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(3, 0)**2*zb(& +& indorbp+5, indt+2)/rp2 + zb(indorbp+5, indt+2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+5, indt+1)) + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(3, 0)**2*zb(& +& indorbp+5, indt+1)/rp2 + rmub(3, 0) = rmub(3, 0) + distp(indt+1, 1)*2*rmu(3, & +& 0)*zb(indorbp+5, indt+1)/rp2 + zb(indorbp+5, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+4, indt+3)) + temp499b20 = zb(indorbp+4, indt+3)/rp1 + temp499b21 = distp(indt+3, 1)*temp499b20 + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(2, 0)*rmu(3, & +& 0)*temp499b20 + rmub(2, 0) = rmub(2, 0) + distp(0, 1)*temp499b20 + rmu& +& (3, 0)*temp499b21 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp499b21 + distpb(0, 1) = distpb(0, 1) + rmu(2, 0)*temp499b20 + zb(indorbp+4, indt+3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+4, indt+2)) + temp499b22 = zb(indorbp+4, indt+2)/rp1 + temp499b23 = distp(indt+2, 1)*temp499b22 + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(2, 0)*rmu(3, & +& 0)*temp499b22 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp499b23 + zb(indorbp+4, indt+2) = 0.0_8 + temp499b24 = rmu(2, 0)*zb(indorbp+4, indt+1)/rp1 + rmub(3, 0) = rmub(3, 0) + distp(indt+1, 1)*temp499b24 & +& + distp(0, 1)*temp499b22 + rmu(2, 0)*temp499b23 + distpb(0, 1) = distpb(0, 1) + rmu(3, 0)*temp499b22 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+4, indt+1)) + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(3, 0)*temp499b24 + rmub(2, 0) = rmub(2, 0) + distp(indt+1, 1)*rmu(3, & +& 0)*zb(indorbp+4, indt+1)/rp1 + zb(indorbp+4, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+3, indt+3)) + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(2, 0)**2*zb(& +& indorbp+3, indt+3)/rp2 + rmub(2, 0) = rmub(2, 0) + distp(indt+3, 1)*2*rmu(2, & +& 0)*zb(indorbp+3, indt+3)/rp2 + zb(indorbp+3, indt+3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+3, indt+2)) + temp499b25 = zb(indorbp+3, indt+2)/rp2 + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(2, 0)**2*& +& temp499b25 + zb(indorbp+3, indt+2) = 0.0_8 + rmub(2, 0) = rmub(2, 0) + distp(indt+1, 1)*2*rmu(2, & +& 0)*zb(indorbp+3, indt+1)/rp2 + (2*distp(0, 1)+distp(indt+2& +& , 1)*2*rmu(2, 0))*temp499b25 + distpb(0, 1) = distpb(0, 1) + 2*rmu(2, 0)*temp499b25 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+3, indt+1)) + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(2, 0)**2*zb(& +& indorbp+3, indt+1)/rp2 + zb(indorbp+3, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+3)) + temp499b26 = distp(indt+3, 1)*zb(indorbp+2, indt+3) + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(1, 0)*rmu(3, & +& 0)*zb(indorbp+2, indt+3) + rmub(1, 0) = rmub(1, 0) + distp(0, 1)*zb(indorbp+2, & +& indt+3)/rp1 + rmu(3, 0)*temp499b26 + distpb(0, 1) = distpb(0, 1) + rmu(1, 0)*zb(indorbp+2, indt+3& +& )/rp1 + zb(indorbp+2, indt+3) = 0.0_8 + temp499b27 = rmu(1, 0)*zb(indorbp+2, indt+2)/rp1 + rmub(3, 0) = rmub(3, 0) + distp(indt+2, 1)*temp499b27 & +& + rmu(1, 0)*temp499b26 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+2)) + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(3, 0)*temp499b27 + rmub(1, 0) = rmub(1, 0) + distp(indt+2, 1)*rmu(3, & +& 0)*zb(indorbp+2, indt+2)/rp1 + zb(indorbp+2, indt+2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+1)) + temp499b28 = zb(indorbp+2, indt+1)/rp1 + temp499b29 = distp(indt+1, 1)*temp499b28 + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(1, 0)*rmu(3, & +& 0)*temp499b28 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*temp499b29 + rmub(3, 0) = rmub(3, 0) + distp(0, 1)*temp499b28 + rmu& +& (1, 0)*temp499b29 + distpb(0, 1) = distpb(0, 1) + rmu(3, 0)*temp499b28 + zb(indorbp+2, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+3)) + temp499b30 = rmu(1, 0)*zb(indorbp+1, indt+3)/rp1 + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(2, 0)*temp499b30 + rmub(2, 0) = rmub(2, 0) + distp(indt+3, 1)*temp499b30 + rmub(1, 0) = rmub(1, 0) + distp(indt+3, 1)*rmu(2, & +& 0)*zb(indorbp+1, indt+3)/rp1 + zb(indorbp+1, indt+3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+2)) + temp499b31 = zb(indorbp+1, indt+2)/rp1 + temp499b32 = distp(indt+2, 1)*temp499b31 + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(1, 0)*rmu(2, & +& 0)*temp499b31 + rmub(1, 0) = rmub(1, 0) + distp(0, 1)*temp499b31 + rmu& +& (2, 0)*temp499b32 + rmub(2, 0) = rmub(2, 0) + rmu(1, 0)*temp499b32 + distpb(0, 1) = distpb(0, 1) + rmu(1, 0)*temp499b31 + zb(indorbp+1, indt+2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+1)) + temp499b33 = zb(indorbp+1, indt+1)/rp1 + temp499b34 = distp(indt+1, 1)*temp499b33 + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(1, 0)*rmu(2, & +& 0)*temp499b33 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*temp499b34 + rmub(2, 0) = rmub(2, 0) + distp(0, 1)*temp499b33 + rmu& +& (1, 0)*temp499b34 + distpb(0, 1) = distpb(0, 1) + rmu(2, 0)*temp499b33 + zb(indorbp+1, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+3)) + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(1, 0)**2*zb(& +& indorbp, indt+3)/rp2 + rmub(1, 0) = rmub(1, 0) + distp(indt+3, 1)*2*rmu(1, & +& 0)*zb(indorbp, indt+3)/rp2 + zb(indorbp, indt+3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+2)) + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(1, 0)**2*zb(& +& indorbp, indt+2)/rp2 + rmub(1, 0) = rmub(1, 0) + distp(indt+2, 1)*2*rmu(1, & +& 0)*zb(indorbp, indt+2)/rp2 + zb(indorbp, indt+2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+1)) + temp499b35 = zb(indorbp, indt+1)/rp2 + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(1, 0)**2*& +& temp499b35 + rmub(1, 0) = rmub(1, 0) + (2*distp(0, 1)+distp(indt+1& +& , 1)*2*rmu(1, 0))*temp499b35 + distpb(0, 1) = distpb(0, 1) + 2*rmu(1, 0)*temp499b35 + zb(indorbp, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + powersb = 0.0_8 + ELSE + powersb = 0.0_8 + DO ii=0,iopt-90,1 + CALL POPINTEGER4(adi4ibuf,adi4buf,ad_from2) + DO jj=0,ad_from2,1 + CALL POPINTEGER4(adi4ibuf,adi4buf,count) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + tmp6b = zb(indorbp+count, indt+3) + zb(indorbp+count, indt+3) = distp(0, 1)*tmp6b + distpb(0, 1) = distpb(0, 1) + z(indorbp+count, indt+3)*tmp6b + zb(indorbp+count, 0) = zb(indorbp+count, 0) + & +& distp(indt+3, 1)*tmp6b + distpb(indt+3, 1) = distpb(indt+3, 1) + z(indorbp+count, & +& 0)*tmp6b + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + tmp5b = zb(indorbp+count, indt+2) + zb(indorbp+count, indt+2) = distp(0, 1)*tmp5b + distpb(0, 1) = distpb(0, 1) + z(indorbp+count, indt+2)*tmp5b + zb(indorbp+count, 0) = zb(indorbp+count, 0) + & +& distp(indt+2, 1)*tmp5b + distpb(indt+2, 1) = distpb(indt+2, 1) + z(indorbp+count, & +& 0)*tmp5b + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + tmp4b = zb(indorbp+count, indt+1) + zb(indorbp+count, indt+1) = distp(0, 1)*tmp4b + distpb(0, 1) = distpb(0, 1) + z(indorbp+count, indt+1)*tmp4b + zb(indorbp+count, 0) = zb(indorbp+count, 0) + & +& distp(indt+1, 1)*tmp4b + distpb(indt+1, 1) = distpb(indt+1, 1) + z(indorbp+count, & +& 0)*tmp4b + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+4)) + tmp3b = zb(indorbp+count, indt+4) + zb(indorbp+count, indt+4) = distp(0, 1)*tmp3b + distpb(0, 1) = distpb(0, 1) + z(indorbp+count, indt+4)*tmp3b + zb(indorbp+count, indt+1) = zb(indorbp+count, indt+1) + 2.0_8*& +& distp(indt+1, 1)*tmp3b + distpb(indt+1, 1) = distpb(indt+1, 1) + 2.0_8*z(indorbp+count& +& , indt+1)*tmp3b + zb(indorbp+count, indt+2) = zb(indorbp+count, indt+2) + 2.0_8*& +& distp(indt+2, 1)*tmp3b + distpb(indt+2, 1) = distpb(indt+2, 1) + 2.0_8*z(indorbp+count& +& , indt+2)*tmp3b + zb(indorbp+count, indt+3) = zb(indorbp+count, indt+3) + 2.0_8*& +& distp(indt+3, 1)*tmp3b + distpb(indt+3, 1) = distpb(indt+3, 1) + 2.0_8*z(indorbp+count& +& , indt+3)*tmp3b + zb(indorbp+count, 0) = zb(indorbp+count, 0) + & +& distp(indt+4, 1)*tmp3b + distpb(indt+4, 1) = distpb(indt+4, 1) + z(indorbp+count, & +& 0)*tmp3b + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+4)) + temp502 = powers(3, kk-2, 0) + temp501 = powers(1, ii, 0)*powers(2, jj, 0) + temp499 = powers(1, ii, 0)*powers(3, kk, 0) + temp500 = powers(2, jj, 0)*powers(3, kk, 0) + temp501b = z(indorbp+count, indt+4)*zb(indorbp+count, indt+4) + temp501b0 = ii*(ii-1)*temp501b + temp500b = powers(1, ii-2, 0)*temp501b0 + temp500b0 = jj*(jj-1)*temp501b + temp499b36 = powers(2, jj-2, 0)*temp500b0 + temp499b37 = kk*(kk-1)*temp501b + powersb(1, ii-2, 0) = powersb(1, ii-2, 0) + temp500*temp501b0 + powersb(2, jj, 0) = powersb(2, jj, 0) + temp502*powers(1, ii, & +& 0)*temp499b37 + powers(3, kk, 0)*temp500b + powersb(3, kk, 0) = powersb(3, kk, 0) + powers(1, ii, 0)*& +& temp499b36 + powers(2, jj, 0)*temp500b + powersb(2, jj-2, 0) = powersb(2, jj-2, 0) + temp499*temp500b0 + powersb(1, ii, 0) = powersb(1, ii, 0) + temp502*powers(2, jj, & +& 0)*temp499b37 + powers(3, kk, 0)*temp499b36 + powersb(3, kk-2, 0) = powersb(3, kk-2, 0) + temp501*temp499b37 + zb(indorbp+count, indt+4) = (ii*(ii-1)*(powers(1, ii-2, 0)*& +& temp500)+jj*(jj-1)*(powers(2, jj-2, 0)*temp499)+kk*(kk-1)*(& +& temp501*temp502))*zb(indorbp+count, indt+4) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + zb(indorbp+count, indt+3) = kk*zb(indorbp+count, indt+3) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + powersb(3, kk-1, 0) = powersb(3, kk-1, 0) + z(indorbp+count, & +& indt+3)*zb(indorbp+count, indt+3) + zb(indorbp+count, indt+3) = powers(3, kk-1, 0)*zb(indorbp+& +& count, indt+3) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + powersb(2, jj, 0) = powersb(2, jj, 0) + z(indorbp+count, indt+& +& 3)*zb(indorbp+count, indt+3) + zb(indorbp+count, indt+3) = powers(2, jj, 0)*zb(indorbp+count& +& , indt+3) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + powersb(1, ii, 0) = powersb(1, ii, 0) + z(indorbp+count, indt+& +& 3)*zb(indorbp+count, indt+3) + zb(indorbp+count, indt+3) = powers(1, ii, 0)*zb(indorbp+count& +& , indt+3) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + zb(indorbp+count, indt+2) = jj*zb(indorbp+count, indt+2) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + powersb(3, kk, 0) = powersb(3, kk, 0) + z(indorbp+count, indt+& +& 2)*zb(indorbp+count, indt+2) + zb(indorbp+count, indt+2) = powers(3, kk, 0)*zb(indorbp+count& +& , indt+2) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + powersb(2, jj-1, 0) = powersb(2, jj-1, 0) + z(indorbp+count, & +& indt+2)*zb(indorbp+count, indt+2) + zb(indorbp+count, indt+2) = powers(2, jj-1, 0)*zb(indorbp+& +& count, indt+2) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + powersb(1, ii, 0) = powersb(1, ii, 0) + z(indorbp+count, indt+& +& 2)*zb(indorbp+count, indt+2) + zb(indorbp+count, indt+2) = powers(1, ii, 0)*zb(indorbp+count& +& , indt+2) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + zb(indorbp+count, indt+1) = ii*zb(indorbp+count, indt+1) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + powersb(3, kk, 0) = powersb(3, kk, 0) + z(indorbp+count, indt+& +& 1)*zb(indorbp+count, indt+1) + zb(indorbp+count, indt+1) = powers(3, kk, 0)*zb(indorbp+count& +& , indt+1) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + powersb(2, jj, 0) = powersb(2, jj, 0) + z(indorbp+count, indt+& +& 1)*zb(indorbp+count, indt+1) + zb(indorbp+count, indt+1) = powers(2, jj, 0)*zb(indorbp+count& +& , indt+1) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + powersb(1, ii-1, 0) = powersb(1, ii-1, 0) + z(indorbp+count, & +& indt+1)*zb(indorbp+count, indt+1) + zb(indorbp+count, indt+1) = powers(1, ii-1, 0)*zb(indorbp+& +& count, indt+1) + CALL POPINTEGER4(adi4ibuf,adi4buf,kk) + END DO END DO - distpb = 0.0_8 - temp500 = distp(0, 1)/rp1 - temp501b = 2.d0*temp500*fun2b - temp501b0 = -((npower*4.d0+1.d0)*temp501b) - temp500b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& -& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 - temp499 = distp(0, 1)/rp1 - temp500b0 = 2.d0*temp499*funb - dd2b = rp1*temp501b0 - rp1*temp500b0 + 2.d0*rp1**2*2*dd2*temp501b - temp499b = 2.d0*(npower-dd2*rp1)*funb/rp1 - rp1b = dd2*temp501b0 - temp499*temp499b - temp500*temp500b - dd2*& -& temp500b0 + 2.d0*dd2**2*2*rp1*temp501b - distpb(0, 1) = temp499b + temp500b - rb(0) = rb(0) + 2*r(0)*rp1b + END IF + DO k=0,0,-1 + DO ii=0,iopt-90,1 + CALL POPINTEGER4(adi4ibuf,adi4buf,ad_from1) + DO jj=0,ad_from1,1 + CALL POPINTEGER4(adi4ibuf,adi4buf,count) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, k)) + powersb(3, kk, k) = powersb(3, kk, k) + z(indorbp+count, k)*zb& +& (indorbp+count, k) + zb(indorbp+count, k) = powers(3, kk, k)*zb(indorbp+count, k) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, k)) + powersb(2, jj, k) = powersb(2, jj, k) + z(indorbp+count, k)*zb& +& (indorbp+count, k) + zb(indorbp+count, k) = powers(2, jj, k)*zb(indorbp+count, k) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, k)) + powersb(1, ii, k) = powersb(1, ii, k) + z(indorbp+count, k)*zb& +& (indorbp+count, k) + zb(indorbp+count, k) = powers(1, ii, k)*zb(indorbp+count, k) + CALL POPINTEGER4(adi4ibuf,adi4buf,kk) + END DO + END DO + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 1) THEN + dd1b = 0.0_8 ELSE - distpb = 0.0_8 - dd2b = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(indt+4, 1)) + tmp2b = distpb(indt+4, 1) + distpb(indt+4, 1) = 0.0_8 + temp499b = dd1*distp(0, 1)*4.0d0*tmp2b + temp499b0 = (4.0d0*(dd1*r(0)**2)-6.0d0)*tmp2b + dd1b = distp(0, 1)*temp499b0 + r(0)**2*temp499b + rb(0) = rb(0) + dd1*2*r(0)*temp499b + distpb(0, 1) = distpb(0, 1) + dd1*temp499b0 + CALL POPREAL8(adr8ibuf,adr8buf,distp(indt+3, 1)) + tmp1b = distpb(indt+3, 1) + distpb(indt+3, 1) = 0.0_8 + temp499b1 = -(2.0d0*distp(0, 1)*tmp1b) + distpb(0, 1) = distpb(0, 1) - 2.0d0*dd1*rmu(3, 0)*tmp1b + CALL POPREAL8(adr8ibuf,adr8buf,distp(indt+2, 1)) + tmp0b = distpb(indt+2, 1) + distpb(indt+2, 1) = 0.0_8 + temp499b2 = -(2.0d0*distp(0, 1)*tmp0b) + distpb(0, 1) = distpb(0, 1) - 2.0d0*dd1*rmu(2, 0)*tmp0b + CALL POPREAL8(adr8ibuf,adr8buf,distp(indt+1, 1)) + tmpb = distpb(indt+1, 1) + temp499b3 = -(2.0d0*distp(0, 1)*tmpb) + dd1b = dd1b + rmu(2, 0)*temp499b2 + rmu(1, 0)*temp499b3 + rmu(3, 0& +& )*temp499b1 + rmub(3, 0) = rmub(3, 0) + dd1*temp499b1 + rmub(2, 0) = rmub(2, 0) + dd1*temp499b2 + distpb(indt+1, 1) = 0.0_8 + rmub(1, 0) = rmub(1, 0) + dd1*temp499b3 + distpb(0, 1) = distpb(0, 1) - 2.0d0*dd1*rmu(1, 0)*tmpb END IF - DO i=0,0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 1) THEN + DO ii=0,iopt-90,1 + CALL POPINTEGER4(adi4ibuf,adi4buf,ad_from0) + DO jj=0,ad_from0,1 + CALL POPINTEGER4(adi4ibuf,adi4buf,count) + zb(indorbp+count, indt+4) = zb(indorbp+count, indt+4)/DSQRT(& +& rp1) + zb(indorbp+count, indt+3) = zb(indorbp+count, indt+3)/DSQRT(& +& rp1) + zb(indorbp+count, indt+2) = zb(indorbp+count, indt+2)/DSQRT(& +& rp1) + zb(indorbp+count, indt+1) = zb(indorbp+count, indt+1)/DSQRT(& +& rp1) + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + zb(indorbp+count, indt+4) = zb(indorbp+count, indt+4)/DSQRT(& +& rp1) + zb(indorbp+count, indt+3) = zb(indorbp+count, indt+3)/DSQRT(& +& rp1) + zb(indorbp+count, indt+2) = zb(indorbp+count, indt+2)/DSQRT(& +& rp1) + zb(indorbp+count, indt+1) = zb(indorbp+count, indt+1)/DSQRT(& +& rp1) + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + zb(indorbp+count, indt+4) = zb(indorbp+count, indt+4)/DSQRT(& +& rp1) + zb(indorbp+count, indt+3) = zb(indorbp+count, indt+3)/DSQRT(& +& rp1) + zb(indorbp+count, indt+2) = zb(indorbp+count, indt+2)/DSQRT(& +& rp1) + zb(indorbp+count, indt+1) = zb(indorbp+count, indt+1)/DSQRT(& +& rp1) + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + zb(indorbp+count, indt+4) = 0.0_8 + zb(indorbp+count, indt+3) = 0.0_8 + zb(indorbp+count, indt+2) = 0.0_8 + zb(indorbp+count, indt+1) = 0.0_8 + END DO + END DO + END IF + DO k=0,0,-1 + DO ii=0,iopt-90,1 + CALL POPINTEGER4(adi4ibuf,adi4buf,ad_from) + DO jj=0,ad_from,1 + CALL POPINTEGER4(adi4ibuf,adi4buf,count) + zb(indorbp+count, k) = zb(indorbp+count, k)/DSQRT(rp1) + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + zb(indorbp+count, k) = zb(indorbp+count, k)/DSQRT(rp1) + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + zb(indorbp+count, k) = zb(indorbp+count, k)/DSQRT(rp1) + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + zb(indorbp+count, k) = 0.0_8 + END DO + END DO END DO + cb = 0.0_8 DO k=0,0,-1 temp498 = r(k)**2 - temp497 = 2*npower - temp497b24 = r(k)**temp497*DEXP(-(dd2*temp498))*distpb(k, 1) - IF (r(k) .LE. 0.0 .AND. (temp497 .EQ. 0.0 .OR. temp497 .NE. INT(& -& temp497))) THEN - rb(k) = rb(k) - dd2*2*r(k)*temp497b24 - ELSE - rb(k) = rb(k) + DEXP(-(dd2*temp498))*temp497*r(k)**(temp497-1)*& -& distpb(k, 1) - dd2*2*r(k)*temp497b24 - END IF - dd2b = dd2b - temp498*temp497b24 + temp498b = c*DEXP(-(dd1*temp498))*distpb(k, 1) + dd1b = dd1b - temp498*temp498b + rb(k) = rb(k) - dd1*2*r(k)*temp498b + cb = cb + DEXP(-(dd1*temp498))*distpb(k, 1) distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (2000:2099) -! s gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative of 1000 - npower = iopt + 1 - 2000 - indorbp = indorb + 1 - dd2 = dd(indpar+1) - DO k=0,0 - distp(k, 1) = -(r(k)**(2*npower)*DEXP(-(dd2*r(k)**2))) + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 1) THEN + CALL POPREAL8(adr8ibuf,adr8buf,c) + temp497 = (iopt-90)/2.0_8 + IF (.NOT.(8_4*dd1 .LE. 0.0 .AND. (temp497 .EQ. 0.0 .OR. temp497 & +& .NE. INT(temp497)))) dd1b = dd1b + c*temp497*(8_4*dd1)**(& +& temp497-1)*8_4*cb + cb = (8_4*dd1)**temp497*cb + END IF + dd1b = dd1b + 0.712705470354990_8*0.75_8*dd1**(-0.242)*cb + DO ii=iopt-90,1,-1 + DO k=0,0,-1 + CALL POPREAL8(adr8ibuf,adr8buf,powers(3, ii, k)) + powersb(3, ii-1, k) = powersb(3, ii-1, k) + rmu(3, k)*powersb(3& +& , ii, k) + rmub(3, k) = rmub(3, k) + powers(3, ii-1, k)*powersb(3, ii, k) + powersb(3, ii, k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,powers(2, ii, k)) + powersb(2, ii-1, k) = powersb(2, ii-1, k) + rmu(2, k)*powersb(2& +& , ii, k) + rmub(2, k) = rmub(2, k) + powers(2, ii-1, k)*powersb(2, ii, k) + powersb(2, ii, k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,powers(1, ii, k)) + powersb(1, ii-1, k) = powersb(1, ii-1, k) + rmu(1, k)*powersb(1& +& , ii, k) + rmub(1, k) = rmub(1, k) + powers(1, ii-1, k)*powersb(1, ii, k) + powersb(1, ii, k) = 0.0_8 + END DO END DO -! endif + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (117) +! 2s double lorentian with constant parent of 102 +! (dd3+r^3/(1+dd5*r)^4; + dd5 = dd(indpar+2) + indorbp = indorb + 1 +! write(6,*) ' function inside = ',z(indorbp,i) +! endif IF (typec .NE. 1) THEN - rp1 = r(0)**2 - fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 - funb = 2.d0*zb(indorbp, indt+4) + fun = -(r(0)*(-3.d0+dd5*r(0))/(1.d0+dd5*r(0))**5) fun2b = zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO - distpb = 0.0_8 - temp504 = distp(0, 1)/rp1 - temp505b = 2.d0*temp504*fun2b - temp505b0 = -((npower*4.d0+1.d0)*temp505b) - temp504b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& -& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 - temp503 = distp(0, 1)/rp1 - temp504b0 = 2.d0*temp503*funb - dd2b = rp1*temp505b0 - rp1*temp504b0 + 2.d0*rp1**2*2*dd2*temp505b - temp503b = 2.d0*(npower-dd2*rp1)*funb/rp1 - rp1b = dd2*temp505b0 - temp503*temp503b - temp504*temp504b - dd2*& -& temp504b0 + 2.d0*dd2**2*2*rp1*temp505b - distpb(0, 1) = temp503b + temp504b - rb(0) = rb(0) + 2*r(0)*rp1b + temp507 = (dd5*r(0)+1.d0)**6 + temp506 = r(0)/temp507 + temp507b = 2.d0*temp506*fun2b + temp507b0 = 2*dd5*r(0)*temp507b + temp506b = 2.d0*((dd5*r(0))**2-6.d0*(dd5*r(0))+3.d0)*fun2b/temp507 + temp506b0 = -(temp506*6*(dd5*r(0)+1.d0)**5*temp506b) + temp505 = (dd5*r(0)+1.d0)**5 + temp505b = -(funb0/temp505) + temp505b0 = -(r(0)*(dd5*r(0)-3.d0)*5*(dd5*r(0)+1.d0)**4*temp505b/& +& temp505) + dd5b = r(0)**2*temp505b + r(0)*temp505b0 + r(0)*temp506b0 - 6.d0*r& +& (0)*temp507b + r(0)*temp507b0 + rb(0) = rb(0) + (r(0)*dd5+dd5*r(0)-3.d0)*temp505b + dd5*temp505b0 & +& + dd5*temp506b0 + temp506b - 6.d0*dd5*temp507b + dd5*temp507b0 ELSE - distpb = 0.0_8 - dd2b = 0.0_8 + dd5b = 0.0_8 END IF + distpb = 0.0_8 + dd3b = 0.0_8 DO i=0,0,-1 + dd3b = dd3b + zb(indorbp, i) distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO DO k=0,0,-1 - temp502 = r(k)**2 - temp501 = 2*npower - temp501b1 = -(r(k)**temp501*DEXP(-(dd2*temp502))*distpb(k, 1)) - IF (r(k) .LE. 0.0 .AND. (temp501 .EQ. 0.0 .OR. temp501 .NE. INT(& -& temp501))) THEN - rb(k) = rb(k) - dd2*2*r(k)*temp501b1 - ELSE - rb(k) = rb(k) - dd2*2*r(k)*temp501b1 - DEXP(-(dd2*temp502))*& -& temp501*r(k)**(temp501-1)*distpb(k, 1) - END IF - dd2b = dd2b - temp502*temp501b1 + temp503 = dd5*r(k) + 1.d0 + temp504 = temp503**4 + temp503b = -(r(k)**3*4*temp503**3*distpb(k, 1)/temp504**2) + rb(k) = rb(k) + dd5*temp503b + 3*r(k)**2*distpb(k, 1)/temp504 + dd5b = dd5b + r(k)*temp503b distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (1100:1199) -! p gaussian r**(2*npower)*exp(-alpha*r**2) - npower = iopt - 1100 -! indorbp=indorb - dd2 = dd(indpar+1) + ddb(indpar+2) = ddb(indpar+2) + dd5b + ddb(indpar+1) = ddb(indpar+1) + dd3b + CASE (50) +! R(r)=(c0*r**4+c1*r**3)*exp(-z1*r) +! +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then + c = DSQRT((2*dd1)**9/40320.d0/pi)/2.d0 +! endif + c0 = -c + c1 = 4.5d0*c/dd1 DO k=0,0 - distp(k, 1) = r(k)**(2*npower)*DEXP(-(dd2*r(k)**2)) - END DO - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic + distp(k, 1) = r(k)*DEXP(-(dd1*r(k))) END DO -! endif IF (typec .NE. 1) THEN - rp1 = r(0)**2 - fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 - fun2 = (npower*(2.d0*npower-1.d0)-(1.d0+4.d0*npower)*dd2*rp1+2.d0*& -& (dd2*rp1)**2)*distp(0, 1)*2.d0/rp1 -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp509b2 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp509b2 - fun2b = fun2b + temp509b2 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp509b1 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp509b1 - funb = funb + rmu(ic, 0)*temp509b1 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + rp1 = r(0)*dd1 + rp2 = rp1*rp1 +!c the first derivative/r + fun = -(distp(0, 1)*(c0*r(0)*(rp1-4.d0)+c1*(rp1-3.d0))) +!c +!c the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 END DO - distpb = 0.0_8 - temp508 = distp(0, 1)/rp1 - temp509b = 2.d0*temp508*fun2b - temp509b0 = -((npower*4.d0+1.d0)*temp509b) - temp508b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& -& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 - temp507 = distp(0, 1)/rp1 - temp508b0 = 2.d0*temp507*funb - dd2b = rp1*temp509b0 - rp1*temp508b0 + 2.d0*rp1**2*2*dd2*temp509b - temp507b = 2.d0*(npower-dd2*rp1)*funb/rp1 - rp1b = dd2*temp509b0 - temp507*temp507b - temp508*temp508b - dd2*& -& temp508b0 + 2.d0*dd2**2*2*rp1*temp509b - distpb(0, 1) = temp507b + fun0b + temp508b - rb(0) = rb(0) + 2*r(0)*rp1b + distpb = 0.0_8 + temp511 = rp2 - 8.d0*rp1 + 12.d0 + temp510 = c0*r(0) + temp510b0 = distp(0, 1)*fun2b + distpb(0, 1) = (temp510*temp511+c1*(rp2-6*rp1+6.d0))*fun2b - (c0*r& +& (0)*(rp1-4.d0)+c1*(rp1-3.d0))*funb0 + temp510b1 = -(distp(0, 1)*funb0) + c0b = (rp1-4.d0)*r(0)*temp510b1 + temp511*r(0)*temp510b0 + rp2b = (c1+temp510)*temp510b0 + rp1b = (c1+c0*r(0))*temp510b1 + 2*rp1*rp2b + ((-6)*c1-temp510*8.d0& +& )*temp510b0 + rb(0) = rb(0) + (rp1-4.d0)*c0*temp510b1 + dd1*rp1b + temp511*c0*& +& temp510b0 + c1b = (rp1-3.d0)*temp510b1 + (rp2-6*rp1+6.d0)*temp510b0 + dd1b = r(0)*rp1b ELSE distpb = 0.0_8 - dd2b = 0.0_8 + c0b = 0.0_8 + c1b = 0.0_8 + dd1b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=0,0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + DO i=0,0,-1 + temp510b = distp(i, 1)*zb(indorbp, i) + temp509 = r(i)**3 + c0b = c0b + temp509*temp510b + rb(i) = rb(i) + (c1*2*r(i)+c0*3*r(i)**2)*temp510b + c1b = c1b + r(i)**2*temp510b + distpb(i, 1) = distpb(i, 1) + (c0*temp509+c1*r(i)**2)*zb(indorbp, & +& i) + zb(indorbp, i) = 0.0_8 END DO DO k=0,0,-1 - temp506 = r(k)**2 - temp505 = 2*npower - temp505b1 = r(k)**temp505*DEXP(-(dd2*temp506))*distpb(k, 1) - IF (r(k) .LE. 0.0 .AND. (temp505 .EQ. 0.0 .OR. temp505 .NE. INT(& -& temp505))) THEN - rb(k) = rb(k) - dd2*2*r(k)*temp505b1 - ELSE - rb(k) = rb(k) + DEXP(-(dd2*temp506))*temp505*r(k)**(temp505-1)*& -& distpb(k, 1) - dd2*2*r(k)*temp505b1 - END IF - dd2b = dd2b - temp506*temp505b1 + temp509b0 = r(k)*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1*temp509b0 + dd1b = dd1b - r(k)*temp509b0 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (2100:2199) -! p gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative 1100 - npower = iopt + 1 - 2100 -! indorbp=indorb - dd2 = dd(indpar+1) - DO k=0,0 - distp(k, 1) = -(r(k)**(2*npower)*DEXP(-(dd2*r(k)**2))) - END DO - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO + temp509b = 4.5d0*c1b/dd1 + cb = temp509b - c0b + temp508 = 2**9 + IF (temp508*(dd1**9/(40320.d0*pi)) .EQ. 0.0) THEN + dd1b = dd1b - c*temp509b/dd1 + ELSE + dd1b = dd1b + temp508*9*dd1**8*cb/(2.d0*2.D0*DSQRT(temp508*(dd1**9& +& /(40320.d0*pi)))*40320.d0*pi) - c*temp509b/dd1 + END IF + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (3) +! +! +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd(indpar+3) +! if(iflagnorm.gt.2) then + c = 1.d0/2.d0/DSQRT(2.d0*pi*(1.d0/(2.d0*dd1)**3+2.d0*peff/(dd1+dd2)& +& **3+peff**2/(2.d0*dd2)**3)) + ad_from3 = indpar + 1 ! endif - IF (typec .NE. 1) THEN - rp1 = r(0)**2 - fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 - fun2 = (npower*(2.d0*npower-1.d0)-(1.d0+4.d0*npower)*dd2*rp1+2.d0*& -& (dd2*rp1)**2)*distp(0, 1)*2.d0/rp1 -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp513b2 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp513b2 - fun2b = fun2b + temp513b2 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp513b1 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp513b1 - funb = funb + rmu(ic, 0)*temp513b1 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + DO i=ad_from3,indpar+2 + DO k=0,0 + distp(k, i-indpar) = c*DEXP(-(dd(i)*r(k))) END DO + END DO + CALL PUSHINTEGER4(adi4ibuf,adi4buf,i - 1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,ad_from3) + IF (typec .NE. 1) THEN + fun = -(dd1*distp(0, 1)) - peff*dd2*distp(0, 2) distpb = 0.0_8 - temp512 = distp(0, 1)/rp1 - temp513b = 2.d0*temp512*fun2b - temp513b0 = -((npower*4.d0+1.d0)*temp513b) - temp512b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& -& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 - temp511 = distp(0, 1)/rp1 - temp512b0 = 2.d0*temp511*funb - dd2b = rp1*temp513b0 - rp1*temp512b0 + 2.d0*rp1**2*2*dd2*temp513b - temp511b = 2.d0*(npower-dd2*rp1)*funb/rp1 - rp1b = dd2*temp513b0 - temp511*temp511b - temp512*temp512b - dd2*& -& temp512b0 + 2.d0*dd2**2*2*rp1*temp513b - distpb(0, 1) = temp511b + fun0b + temp512b - rb(0) = rb(0) + 2*r(0)*rp1b + temp521 = dd1/r(0) + temp521b = -(distp(0, 1)*2.d0*zb(indorbp, indt+4)/r(0)) + temp521b0 = peff*distp(0, 2)*zb(indorbp, indt+4) + temp520 = dd2/r(0) + temp520b = -(2.d0*temp521b0/r(0)) + temp520b0 = (dd2**2-2.d0*temp520)*zb(indorbp, indt+4) + dd1b = temp521b + distp(0, 1)*2*dd1*zb(indorbp, indt+4) + rb(0) = rb(0) - temp520*temp520b - temp521*temp521b + distpb(0, 1) = (dd1**2-2.d0*temp521)*zb(indorbp, indt+4) + dd2b = temp520b + 2*dd2*temp521b0 + peffb = distp(0, 2)*temp520b0 + distpb(0, 2) = peff*temp520b0 + zb(indorbp, indt+4) = 0.0_8 + funb0 = 0.0_8 + DO i=3,1,-1 + temp519 = fun/r(0) + temp519b = rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(i, 0) = rmub(i, 0) + temp519*zb(indorbp, indt+i) + funb0 = funb0 + temp519b + rb(0) = rb(0) - temp519*temp519b + zb(indorbp, indt+i) = 0.0_8 + END DO + dd1b = dd1b - distp(0, 1)*funb0 + distpb(0, 1) = distpb(0, 1) - dd1*funb0 + peffb = peffb - distp(0, 2)*dd2*funb0 + dd2b = dd2b - distp(0, 2)*peff*funb0 + distpb(0, 2) = distpb(0, 2) - peff*dd2*funb0 ELSE distpb = 0.0_8 + peffb = 0.0_8 + dd1b = 0.0_8 dd2b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=0,0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + DO i=0,0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + peffb = peffb + distp(i, 2)*zb(indorbp, i) + distpb(i, 2) = distpb(i, 2) + peff*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO - DO k=0,0,-1 - temp510 = r(k)**2 - temp509 = 2*npower - temp509b3 = -(r(k)**temp509*DEXP(-(dd2*temp510))*distpb(k, 1)) - IF (r(k) .LE. 0.0 .AND. (temp509 .EQ. 0.0 .OR. temp509 .NE. INT(& -& temp509))) THEN - rb(k) = rb(k) - dd2*2*r(k)*temp509b3 - ELSE - rb(k) = rb(k) - dd2*2*r(k)*temp509b3 - DEXP(-(dd2*temp510))*& -& temp509*r(k)**(temp509-1)*distpb(k, 1) - END IF - dd2b = dd2b - temp510*temp509b3 - distpb(k, 1) = 0.0_8 + cb = 0.0_8 + CALL POPINTEGER4(adi4ibuf,adi4buf,ad_from3) + CALL POPINTEGER4(adi4ibuf,adi4buf,ad_to) + DO i=ad_to,ad_from3,-1 + DO k=0,0,-1 + temp518 = -(dd(i)*r(k)) + temp518b = c*DEXP(temp518)*distpb(k, i-indpar) + cb = cb + DEXP(temp518)*distpb(k, i-indpar) + ddb(i) = ddb(i) - r(k)*temp518b + rb(k) = rb(k) - dd(i)*temp518b + distpb(k, i-indpar) = 0.0_8 + END DO END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (1200:1299) -! d gaussian r**(2*npower)*exp(-alpha*r**2) - npower = iopt - 1200 -! indorbp=indorb + temp517 = 2.d0**3*dd2**3 + temp516 = peff**2/temp517 + temp515 = (dd1+dd2)**3 + temp514 = 2.d0**3*dd1**3 + temp513 = 2.d0*pi*(1.0/temp514+2.d0*peff/temp515+temp516) + temp512 = DSQRT(temp513) + IF (temp513 .EQ. 0.0) THEN + temp512b = 0.0 + ELSE + temp512b = -(pi*cb/(temp512**2*2.D0*DSQRT(temp513))) + END IF + temp512b0 = 2.d0*temp512b/temp515 + temp512b1 = -(peff*3*(dd1+dd2)**2*temp512b0/temp515) + dd1b = dd1b + temp512b1 - 2.d0**3*3*dd1**2*temp512b/temp514**2 + peffb = peffb + 2*peff*temp512b/temp517 + temp512b0 + dd2b = dd2b + temp512b1 - temp516*2.d0**3*3*dd2**2*temp512b/temp517 + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (124) +! 2s 2pz Hybryd single Z +! 2s double exp with constant and cusp cond. +! (dd3+ exp (-dd2 r)*(1+dd2*r)+dd4*exp(-dd5*r)*(1+dd5*r)) dd2 = dd(indpar+1) + dd4 = dd(indpar+3) + dd5 = dd(indpar+4) + indorbp = indorb + 1 DO k=0,0 - distp(k, 1) = r(k)**(2*npower)*DEXP(-(dd2*r(k)**2)) - END DO - DO i=0,0 - distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d - distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d - distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d - END DO - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - rp1 = r(0)**2 - fun0 = distp(0, 1) - fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 - fun2 = (npower*(2.d0*npower-1.d0)-(1.d0+4.d0*npower)*dd2*rp1+2.d0*& -& (dd2*rp1)**2)*distp(0, 1)*2.d0/rp1 -! indorbp=indorb - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - END IF - END DO - END DO - distpb = 0.0_8 - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=5,1,-1 - temp517b6 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 6.d0*temp517b6 - fun2b = fun2b + temp517b6 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp517b2 = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp517b2 - fun0b = fun0b + rmu(i, 0)*temp517b2 - ELSE - temp517b3 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp517b3 - fun0b = fun0b + rmu(i, 0)*temp517b3 - END IF - ELSE IF (branch .LT. 4) THEN - temp517b4 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp517b4 - fun0b = fun0b + rmu(i, 0)*temp517b4 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp517b5 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp517b5 - fun0b = fun0b + rmu(i, 0)*temp517b5 - ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - temp517b1 = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp517b1 - funb = funb + rmu(i, 0)*temp517b1 - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + distp(k, 3) = DEXP(-(dd2*r(k))) + distp(k, 4) = DEXP(-(dd5*r(k))) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(k, 1)) + distp(k, 1) = distp(k, 3)*(1.d0+dd2*r(k)) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(k, 2)) + distp(k, 2) = distp(k, 4)*(1.d0+dd5*r(k)) + END DO +! write(6,*) ' function inside = ',z(indorbp,i) +! endif + IF (typec .NE. 1) THEN + fun = -(dd2**2*distp(0, 3)) - dd5**2*dd4*distp(0, 4) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 END DO - temp516 = distp(0, 1)/rp1 - temp517b = 2.d0*temp516*fun2b - temp517b0 = -((npower*4.d0+1.d0)*temp517b) - temp516b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& -& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 - temp515 = distp(0, 1)/rp1 - temp516b0 = 2.d0*temp515*funb - dd2b = rp1*temp517b0 - rp1*temp516b0 + 2.d0*rp1**2*2*dd2*temp517b - temp515b = 2.d0*(npower-dd2*rp1)*funb/rp1 - rp1b = dd2*temp517b0 - temp515*temp515b - temp516*temp516b - dd2*& -& temp516b0 + 2.d0*dd2**2*2*rp1*temp517b - distpb(0, 1) = distpb(0, 1) + temp515b + fun0b + temp516b - rb(0) = rb(0) + 2*r(0)*rp1b + distpb = 0.0_8 + temp522b3 = -((1.d0-dd2*r(0))*fun2b) + temp522b4 = -(dd2**2*distp(0, 3)*fun2b) + temp522b5 = -((1.d0-dd5*r(0))*fun2b) + temp522b6 = dd5**2*temp522b5 + temp522b7 = -(dd5**2*dd4*distp(0, 4)*fun2b) + dd2b = distp(0, 3)*2*dd2*temp522b3 - r(0)*temp522b4 - distp(0, 3)*& +& 2*dd2*funb0 + distpb(0, 3) = dd2**2*temp522b3 + rb(0) = rb(0) - dd5*temp522b7 - dd2*temp522b4 + dd5b = dd4*distp(0, 4)*2*dd5*temp522b5 - r(0)*temp522b7 - dd4*& +& distp(0, 4)*2*dd5*funb0 + temp522b8 = -(dd5**2*funb0) + dd4b = distp(0, 4)*temp522b8 + distp(0, 4)*temp522b6 + distpb(0, 4) = dd4*temp522b6 + distpb(0, 3) = distpb(0, 3) - dd2**2*funb0 + distpb(0, 4) = distpb(0, 4) + dd4*temp522b8 ELSE distpb = 0.0_8 dd2b = 0.0_8 + dd4b = 0.0_8 + dd5b = 0.0_8 END IF - DO ic=5,1,-1 - DO i=0,0,-1 - distpb(i, 1+ic) = distpb(i, 1+ic) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + distp(i, 1+ic)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO + dd3b = 0.0_8 DO i=0,0,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) - distpb(i, 2) = 0.0_8 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) + dd4b = dd4b + distp(i, 2)*zb(indorbp, i) + distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO DO k=0,0,-1 - temp514 = r(k)**2 - temp513 = 2*npower - temp513b3 = r(k)**temp513*DEXP(-(dd2*temp514))*distpb(k, 1) - IF (r(k) .LE. 0.0 .AND. (temp513 .EQ. 0.0 .OR. temp513 .NE. INT(& -& temp513))) THEN - rb(k) = rb(k) - dd2*2*r(k)*temp513b3 - ELSE - rb(k) = rb(k) + DEXP(-(dd2*temp514))*temp513*r(k)**(temp513-1)*& -& distpb(k, 1) - dd2*2*r(k)*temp513b3 - END IF - dd2b = dd2b - temp514*temp513b3 + CALL POPREAL8(adr8ibuf,adr8buf,distp(k, 2)) + temp522b = distp(k, 4)*distpb(k, 2) + distpb(k, 4) = distpb(k, 4) + (dd5*r(k)+1.d0)*distpb(k, 2) + distpb(k, 2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(k, 1)) + temp522b0 = distp(k, 3)*distpb(k, 1) + distpb(k, 3) = distpb(k, 3) + (dd2*r(k)+1.d0)*distpb(k, 1) distpb(k, 1) = 0.0_8 + temp522b1 = DEXP(-(dd5*r(k)))*distpb(k, 4) + dd5b = dd5b + r(k)*temp522b - r(k)*temp522b1 + distpb(k, 4) = 0.0_8 + temp522b2 = DEXP(-(dd2*r(k)))*distpb(k, 3) + rb(k) = rb(k) + dd2*temp522b0 - dd2*temp522b2 - dd5*temp522b1 + & +& dd5*temp522b + dd2b = dd2b + r(k)*temp522b0 - r(k)*temp522b2 + distpb(k, 3) = 0.0_8 END DO + ddb(indpar+4) = ddb(indpar+4) + dd5b + ddb(indpar+3) = ddb(indpar+3) + dd4b + ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (2200:2299) -! d gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative 1200 - npower = iopt + 1 - 2200 -! indorbp=indorb - dd2 = dd(indpar+1) - DO k=0,0 - distp(k, 1) = -(r(k)**(2*npower)*DEXP(-(dd2*r(k)**2))) - END DO + CASE (28) +! R(r)=(Z*b*r)^4/(1+(Z*b*r)^4)*exp(-z*r) orbital 1s (no cusp) +! d -> b1s (defined in module constants) +! normadization: cost1s, depends on b1s +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! if(dd1.gt.0.) then + c = cost1s*dd1**1.5d0 +! else +! c=1.d0 +! endif +! endif DO i=0,0 - distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d - distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d - distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d + distp(i, 1) = c*DEXP(-(dd1*r(i))) END DO - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic + DO i=0,0 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) + rp4 = (dd1*b1s*r(i))**4 END DO -! endif IF (typec .NE. 1) THEN - rp1 = r(0)**2 - fun0 = distp(0, 1) - fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 - fun2 = (npower*(2.d0*npower-1.d0)-(1.d0+4.d0*npower)*dd2*rp1+2.d0*& -& (dd2*rp1)**2)*distp(0, 1)*2.d0/rp1 -! indorbp=indorb - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - END IF - END DO + rp1 = dd1*b1s*r(0) + rp2 = rp1**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) + rp4 = rp2**2 + rp5 = r(0)*dd1 + rp6 = (b1s*dd1)**2*rp2 +! the first derivative /r + fun = -(distp(0, 1)*rp6*(-4.d0+rp5+rp4*rp5)/(1.d0+rp4)**2) +! the second derivative derivative + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=5,1,-1 - temp521b6 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 6.d0*temp521b6 - fun2b = fun2b + temp521b6 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp521b2 = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp521b2 - fun0b = fun0b + rmu(i, 0)*temp521b2 - ELSE - temp521b3 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp521b3 - fun0b = fun0b + rmu(i, 0)*temp521b3 - END IF - ELSE IF (branch .LT. 4) THEN - temp521b4 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp521b4 - fun0b = fun0b + rmu(i, 0)*temp521b4 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp521b5 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp521b5 - fun0b = fun0b + rmu(i, 0)*temp521b5 - ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - temp521b1 = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp521b1 - funb = funb + rmu(i, 0)*temp521b1 - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - temp520 = distp(0, 1)/rp1 - temp521b = 2.d0*temp520*fun2b - temp521b0 = -((npower*4.d0+1.d0)*temp521b) - temp520b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& -& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 - temp519 = distp(0, 1)/rp1 - temp520b0 = 2.d0*temp519*funb - dd2b = rp1*temp521b0 - rp1*temp520b0 + 2.d0*rp1**2*2*dd2*temp521b - temp519b = 2.d0*(npower-dd2*rp1)*funb/rp1 - rp1b = dd2*temp521b0 - temp519*temp519b - temp520*temp520b - dd2*& -& temp520b0 + 2.d0*dd2**2*2*rp1*temp521b - distpb(0, 1) = distpb(0, 1) + temp519b + fun0b + temp520b - rb(0) = rb(0) + 2*r(0)*rp1b + temp526 = (rp4+1.d0)**3 + temp525 = distp(0, 1)*rp6/temp526 + temp526b = temp525*fun2b + temp526b0 = 2*rp4*rp5*temp526b + temp525b = (rp5**2-8*rp5-20*rp4+2*(rp4*rp5**2)-8*(rp4*rp5)+(rp4*& +& rp5)**2+12.d0)*fun2b/temp526 + temp524 = (rp4+1.d0)**2 + temp523 = distp(0, 1)*rp6/temp524 + temp523b = -(temp523*funb0) + rp5b = (rp4+1.0_8)*temp523b + rp4*temp526b0 + (2**2*rp4*rp5-8*rp4+& +& 2*rp5-8)*temp526b + temp523b0 = -((rp5+rp4*rp5-4.d0)*funb0/temp524) + rp4b = rp5*temp523b - temp523*2*(rp4+1.d0)*temp523b0 - temp525*3*(& +& rp4+1.d0)**2*temp525b + rp5*temp526b0 + (2*rp5**2-8*rp5-20)*& +& temp526b + distpb(0, 1) = rp6*temp523b0 + rp6*temp525b + rp6b = distp(0, 1)*temp523b0 + distp(0, 1)*temp525b + temp523b1 = b1s**2*rp6b + rp2b = 2*rp2*rp4b + dd1**2*temp523b1 + rp1b = 2*rp1*rp2b + dd1b = r(0)*rp5b + b1s*r(0)*rp1b + rp2*2*dd1*temp523b1 + rb(0) = rb(0) + b1s*dd1*rp1b + dd1*rp5b + CALL POPREAL8(adr8ibuf,adr8buf,rp4) ELSE distpb = 0.0_8 - dd2b = 0.0_8 + dd1b = 0.0_8 END IF - DO ic=5,1,-1 - DO i=0,0,-1 - distpb(i, 1+ic) = distpb(i, 1+ic) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + distp(i, 1+ic)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO DO i=0,0,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) - distpb(i, 2) = 0.0_8 + temp522 = rp4/(rp4+1.d0) + temp522b10 = distp(i, 1)*zb(indorbp, i)/(rp4+1.d0) + distpb(i, 1) = distpb(i, 1) + temp522*zb(indorbp, i) + rp4b = (1.0_8-temp522)*temp522b10 + zb(indorbp, i) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,rp4) + temp522b11 = 4*b1s**4*dd1**3*r(i)**3*rp4b + dd1b = dd1b + r(i)*temp522b11 + rb(i) = rb(i) + dd1*temp522b11 END DO - DO k=0,0,-1 - temp518 = r(k)**2 - temp517 = 2*npower - temp517b7 = -(r(k)**temp517*DEXP(-(dd2*temp518))*distpb(k, 1)) - IF (r(k) .LE. 0.0 .AND. (temp517 .EQ. 0.0 .OR. temp517 .NE. INT(& -& temp517))) THEN - rb(k) = rb(k) - dd2*2*r(k)*temp517b7 - ELSE - rb(k) = rb(k) - dd2*2*r(k)*temp517b7 - DEXP(-(dd2*temp518))*& -& temp517*r(k)**(temp517-1)*distpb(k, 1) - END IF - dd2b = dd2b - temp518*temp517b7 - distpb(k, 1) = 0.0_8 + cb = 0.0_8 + DO i=0,0,-1 + temp522b9 = c*DEXP(-(dd1*r(i)))*distpb(i, 1) + cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) + dd1b = dd1b - r(i)*temp522b9 + rb(i) = rb(i) - dd1*temp522b9 + distpb(i, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b + dd1b = dd1b + cost1s*1.5d0*dd1**0.5D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b CASE DEFAULT distpb = 0.0_8 END SELECT diff --git a/src/c_adjoint_backward/makefun0_bump_b.f90 b/src/c_adjoint_backward/makefun0_bump_b.f90 index ed337f0..ff474ff 100644 --- a/src/c_adjoint_backward/makefun0_bump_b.f90 +++ b/src/c_adjoint_backward/makefun0_bump_b.f90 @@ -1,4 +1,3 @@ -!TL off !########################################################### @@ -7,7 +6,8 @@ !# # !########################################################### - ! Generated by TAPENADE (INRIA, Tropics team) + !TL off +! Generated by TAPENADE (INRIA, Tropics team) ! Tapenade 3.3 (r3163) - 09/25/2009 09:03 ! ! Differentiation of makefun_bump in reverse (adjoint) mode: diff --git a/src/c_adjoint_backward/makefun0_pbc_b.f90 b/src/c_adjoint_backward/makefun0_pbc_b.f90 index d863313..c416047 100644 --- a/src/c_adjoint_backward/makefun0_pbc_b.f90 +++ b/src/c_adjoint_backward/makefun0_pbc_b.f90 @@ -1,4 +1,3 @@ -!TL off !########################################################### @@ -7,7 +6,8 @@ !# # !########################################################### - ! Generated by TAPENADE (INRIA, Tropics team) + !TL off +! Generated by TAPENADE (INRIA, Tropics team) ! Tapenade 3.3 (r3163) - 09/25/2009 09:03 ! ! Differentiation of makefun_pbc in reverse (adjoint) mode: diff --git a/src/c_adjoint_backward/makefun_b.f90 b/src/c_adjoint_backward/makefun_b.f90 index 809bb7d..5c28df2 100644 --- a/src/c_adjoint_backward/makefun_b.f90 +++ b/src/c_adjoint_backward/makefun_b.f90 @@ -1,10 +1,10 @@ -!TL off ! Generated by TAPENADE (INRIA, Tropics team) ! Tapenade 3.3 (r3163) - 09/25/2009 09:03 ! ! Differentiation of makefun in reverse (adjoint) mode: ! gradient, with respect to input variables: dd r z rmu distp ! of linear combination of output variables: dd r z rmu +!TL off SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & & indorb, indshell, nelskip, z, zb, dd, ddb, zeta, r, rb, rmu, rmub, & & distp, distpb, iflagnorm_unused, cr) @@ -16,2469 +16,2549 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & ! --- INTEGER :: iopt, indt, i, k, nelskip, indpar, indorbp, indorb, & & indshell, indshellp, ic, indtmin, i0, iflagnorm_unused, indparp, indtm& -& , npower, typec -! up to i +& , npower, typec, ii, jj, kk +! up to i REAL*8 :: z(nelskip, i0:*), dd(*), zeta(*), rmu(3, 0:indtm), r(0:indtm& & ), distp(0:indtm, 20), peff, fun, fun0, fun2, rp1, rp2, rp3, rp4, rp5& -& , rp6, rp7, rp8, dd1, dd2, dd3, dd4, dd5, c, cr, funp, fun2p, peff2, & -& arg, c0, c1, cost, zv(6), yv(6), xv(6), r2, r4, r6 +& , rp6, rp7, rp8, dd1, dd2, dd3, dd4, dd5, c, cr, funp, fun2p, funb, & +& peff2, arg, c0, c1, cost, zv(6), yv(6), xv(6), r2, r4, r6 REAL*8 :: zb(nelskip, i0:*), ddb(*), rmub(3, 0:indtm), rb(0:indtm), & -& distpb(0:indtm, 20), peffb, funb, fun0b, fun2b, rp1b, rp2b, rp3b, rp4b& -& , rp5b, rp6b, rp8b, dd1b, dd2b, dd3b, dd4b, dd5b, cb, funpb, fun2pb, & -& peff2b, argb, c0b, c1b, costb, zvb(6), yvb(6), xvb(6), r2b, r4b, r6b +& distpb(0:indtm, 20), peffb, funb0, fun0b, fun2b, rp1b, rp2b, rp3b, & +& rp4b, rp5b, rp6b, rp8b, dd1b, dd2b, dd3b, dd4b, dd5b, cb, funpb, & +& fun2pb, funbb, peff2b, argb, c0b, c1b, costb, zvb(6), yvb(6), xvb(6), & +& r2b, r4b, r6b + INTEGER :: count, multiplicity + INTEGER, PARAMETER :: max_power=20 + REAL*8 :: powers(3, -2:max_power, 0:indtm) + REAL*8 :: powersb(3, -2:max_power, 0:indtm) + REAL*8 :: tmp + REAL*8 :: tmp0 + REAL*8 :: tmp1 + REAL*8 :: tmp2 + REAL*8 :: tmp3 + REAL*8 :: tmp4 + REAL*8 :: tmp5 + REAL*8 :: tmp6 INTEGER :: branch INTEGER :: ad_from + INTEGER :: ad_from0 + INTEGER :: ad_from1 + INTEGER :: ad_from2 + INTEGER :: ad_from3 INTEGER :: ad_to - REAL*8 :: temp3 - DOUBLE PRECISION :: temp29 - REAL*8 :: temp42b3 - REAL*8 :: temp57b7 - REAL*8 :: temp57b18 - REAL*8 :: temp68b43 + DOUBLE PRECISION :: temp3 + DOUBLE PRECISION :: temp8b56 + REAL*8 :: temp29 + REAL*8 :: temp25b2 + REAL*8 :: temp131b11 + REAL*8 :: temp131b48 + REAL*8 :: temp135b26 REAL*8 :: temp153b + REAL*8 :: temp155b0 + REAL*8 :: temp172b1 + REAL*8 :: temp197b55 REAL*8 :: temp234b + REAL*8 :: temp253b1 + REAL*8 :: temp253b52 REAL*8 :: temp296 - REAL*8 :: temp315b + REAL*8 :: temp317b0 + REAL*8 :: temp332b18 + REAL*8 :: temp335b24 + REAL*8 :: temp340b37 REAL*8 :: temp340 - REAL*8 :: temp373b22 - REAL*8 :: temp373b59 - DOUBLE PRECISION :: temp377 - REAL*8 :: temp379b71 - REAL*8 :: temp386b28 - REAL*8 :: temp388b2 - REAL*8 :: temp388b62 - REAL*8 :: temp404b27 - REAL*8 :: temp415b1 + REAL*8 :: temp377 REAL*8 :: temp421 + REAL*8 :: temp432b2 + REAL*8 :: temp448b74 REAL*8 :: temp458 REAL*8 :: temp486b3 - REAL*8 :: temp496b35 REAL*8 :: temp502 - REAL*8 :: temp513b2 REAL*8 :: temp2 + REAL*8 :: temp8b55 REAL*8 :: temp28 + REAL*8 :: temp25b1 REAL*8 :: temp42b2 - REAL*8 :: temp57b6 - REAL*8 :: temp57b17 - REAL*8 :: temp68b42 + REAL*8 :: temp131b10 + REAL*8 :: temp131b47 + REAL*8 :: temp135b25 + REAL*8 :: temp172b0 + REAL*8 :: temp197b54 + REAL*8 :: temp198b REAL*8 :: temp242b - DOUBLE PRECISION :: temp295 - REAL*8 :: temp373b21 - REAL*8 :: temp373b58 - DOUBLE PRECISION :: temp376 - REAL*8 :: temp379b70 - REAL*8 :: temp386b27 - REAL*8 :: temp388b1 - REAL*8 :: temp388b61 - REAL*8 :: temp404b - REAL*8 :: temp404b26 + REAL*8 :: temp253b0 + REAL*8 :: temp253b51 + REAL*8 :: temp279b + REAL*8 :: temp295 + REAL*8 :: temp323b + REAL*8 :: temp332b17 + REAL*8 :: temp335b23 + REAL*8 :: temp340b36 + REAL*8 :: temp344b9 + REAL*8 :: temp376 + DOUBLE PRECISION :: temp404b REAL*8 :: temp415b0 REAL*8 :: temp420 - DOUBLE PRECISION :: temp457 - REAL*8 :: temp469b1 + REAL*8 :: temp432b1 + REAL*8 :: temp448b73 + REAL*8 :: temp457 + DOUBLE PRECISION :: temp469b1 REAL*8 :: temp486b2 - REAL*8 :: temp496b34 - INTEGER :: temp501 - REAL*8 :: temp513b1 + REAL*8 :: temp501 REAL*8 :: temp1 - REAL*8 :: temp25b0 + REAL*8 :: temp8b54 REAL*8 :: temp27 + REAL*8 :: temp25b0 REAL*8 :: temp42b1 - REAL*8 :: temp57b5 - REAL*8 :: temp57b16 - REAL*8 :: temp68b41 - REAL*8 :: temp79b1 - REAL*8 :: temp150b3 - DOUBLE PRECISION :: temp250b - DOUBLE PRECISION :: temp294 + REAL*8 :: temp131b46 + REAL*8 :: temp135b24 + REAL*8 :: temp197b53 + REAL*8 :: temp250b + REAL*8 :: temp253b50 + REAL*8 :: temp287b + REAL*8 :: temp294 REAL*8 :: temp331b - REAL*8 :: temp373b20 - REAL*8 :: temp373b57 + REAL*8 :: temp332b16 + REAL*8 :: temp335b22 + REAL*8 :: temp340b35 + REAL*8 :: temp344b8 DOUBLE PRECISION :: temp375 - REAL*8 :: temp386b26 - REAL*8 :: temp388b0 - REAL*8 :: temp388b60 - REAL*8 :: temp404b25 REAL*8 :: temp412b - DOUBLE PRECISION :: temp456 - REAL*8 :: temp469b0 + REAL*8 :: temp432b0 + REAL*8 :: temp448b72 + REAL*8 :: temp449b + REAL*8 :: temp456 + DOUBLE PRECISION :: temp469b0 REAL*8 :: temp486b1 - REAL*8 :: temp496b33 REAL*8 :: temp500 - REAL*8 :: temp513b0 + REAL*8 :: tmp4b REAL*8 :: temp0 - REAL*8 :: temp13b - REAL*8 :: temp26 - REAL*8 :: temp42b0 - REAL*8 :: temp57b4 - REAL*8 :: temp57b15 - REAL*8 :: temp68b40 - REAL*8 :: temp79b0 - REAL*8 :: temp91b6 - REAL*8 :: temp150b2 + REAL*8 :: temp8b53 + DOUBLE PRECISION :: temp26 + DOUBLE PRECISION :: temp42b0 + DOUBLE PRECISION :: temp116b0 + REAL*8 :: temp131b45 + REAL*8 :: temp133b1 + REAL*8 :: temp135b23 + REAL*8 :: temp197b52 REAL*8 :: temp293 - REAL*8 :: temp312b2 - REAL*8 :: temp373b56 + REAL*8 :: temp332b15 + REAL*8 :: temp335b21 + REAL*8 :: temp340b34 + REAL*8 :: temp344b7 DOUBLE PRECISION :: temp374 - REAL*8 :: temp376b - REAL*8 :: temp386b25 - REAL*8 :: temp404b24 REAL*8 :: temp420b + REAL*8 :: temp448b71 REAL*8 :: temp455 - REAL*8 :: temp481b5 + REAL*8 :: temp457b REAL*8 :: temp486b0 - REAL*8 :: temp488b13 - REAL*8 :: temp496b9 - REAL*8 :: temp496b32 REAL*8 :: temp501b REAL*8 :: temp7b + REAL*8 :: temp8b52 REAL*8 :: temp21b - REAL*8 :: temp25 - REAL*8 :: temp57b3 - REAL*8 :: temp57b14 + DOUBLE PRECISION :: temp25 REAL*8 :: temp58b - REAL*8 :: temp91b5 - REAL*8 :: temp150b1 + REAL*8 :: temp131b44 + REAL*8 :: temp133b0 + REAL*8 :: temp135b22 + REAL*8 :: temp191b39 + REAL*8 :: temp197b51 + REAL*8 :: temp224b9 + REAL*8 :: temp225b13 REAL*8 :: temp292 - REAL*8 :: temp312b1 - REAL*8 :: temp373b55 - REAL*8 :: temp373 - REAL*8 :: temp386b24 - REAL*8 :: temp404b23 - REAL*8 :: temp454 + REAL*8 :: temp332b14 + REAL*8 :: temp335b20 + REAL*8 :: temp340b33 + REAL*8 :: temp344b6 + DOUBLE PRECISION :: temp373 + REAL*8 :: temp384b + REAL*8 :: temp448b70 + DOUBLE PRECISION :: temp454 REAL*8 :: temp465b - REAL*8 :: temp481b4 - REAL*8 :: temp488b12 - REAL*8 :: temp496b8 - REAL*8 :: temp496b31 + REAL*8 :: temp464b3 + REAL*8 :: temp8b51 REAL*8 :: temp24 - REAL*8 :: temp57b2 - REAL*8 :: temp57b13 + REAL*8 :: temp50b29 REAL*8 :: temp66b - REAL*8 :: temp91b4 - REAL*8 :: temp150b0 - DOUBLE PRECISION :: temp291 + REAL*8 :: temp74b3 + REAL*8 :: temp118b11 + REAL*8 :: temp131b43 + REAL*8 :: temp135b21 + REAL*8 :: temp191b38 + REAL*8 :: temp197b9 + REAL*8 :: temp197b50 + REAL*8 :: temp224b8 + REAL*8 :: temp225b12 + REAL*8 :: temp291 REAL*8 :: temp312b0 - REAL*8 :: temp322b9 - REAL*8 :: temp349b0 - REAL*8 :: temp372 - REAL*8 :: temp373b54 - REAL*8 :: temp386b23 + REAL*8 :: temp332b13 + REAL*8 :: temp335b56 + REAL*8 :: temp340b32 + REAL*8 :: temp344b5 + REAL*8 :: temp344b10 + DOUBLE PRECISION :: temp372 REAL*8 :: temp392b - REAL*8 :: temp404b22 REAL*8 :: temp453 - REAL*8 :: temp473b - REAL*8 :: temp481b3 - REAL*8 :: temp488b11 - REAL*8 :: temp496b7 - REAL*8 :: temp496b30 + REAL*8 :: temp464b2 INTRINSIC DEXP + REAL*8 :: temp8b50 REAL*8 :: temp23 - REAL*8 :: temp57b1 - REAL*8 :: temp57b12 - REAL*8 :: temp57b49 - REAL*8 :: temp91b3 - REAL*8 :: temp109b5 - REAL*8 :: temp111b - REAL*8 :: temp119 + REAL*8 :: temp50b28 + REAL*8 :: temp74b + REAL*8 :: temp74b2 + DOUBLE PRECISION :: temp119 + REAL*8 :: temp118b10 + REAL*8 :: temp131b42 + REAL*8 :: temp135b20 REAL*8 :: temp148b + REAL*8 :: temp191b37 + REAL*8 :: temp197b8 + REAL*8 :: temp224b7 + REAL*8 :: temp225b11 REAL*8 :: temp229b - REAL*8 :: temp280b5 - DOUBLE PRECISION :: temp290 - REAL*8 :: temp322b8 + REAL*8 :: temp290 + REAL*8 :: temp332b12 + REAL*8 :: temp335b55 + REAL*8 :: temp340b31 REAL*8 :: temp344b4 - REAL*8 :: temp361b5 REAL*8 :: temp371 - REAL*8 :: temp373b53 - REAL*8 :: temp386b22 - REAL*8 :: temp388b93 - REAL*8 :: temp404b21 + REAL*8 :: temp447b0 REAL*8 :: temp452 + REAL*8 :: temp464b1 REAL*8 :: temp481b - REAL*8 :: temp481b2 - REAL*8 :: temp488b10 DOUBLE PRECISION :: temp489 - REAL*8 :: temp496b6 - REAL*8 :: temp22 - REAL*8 :: temp18b3 + REAL*8 :: temp20b0 + DOUBLE PRECISION :: temp22 + REAL*8 :: temp50b27 REAL*8 :: temp57b0 - REAL*8 :: temp57b11 - REAL*8 :: temp57b48 DOUBLE PRECISION :: temp59 - REAL*8 :: temp91b2 - REAL*8 :: temp109b4 - REAL*8 :: temp111b1 - REAL*8 :: temp118 - REAL*8 :: temp156b + REAL*8 :: temp74b1 + REAL*8 :: temp82b + DOUBLE PRECISION :: temp83b12 + DOUBLE PRECISION :: temp118 + REAL*8 :: temp131b41 + REAL*8 :: temp131b78 + REAL*8 :: temp148b1 + DOUBLE PRECISION :: temp156b + REAL*8 :: temp191b36 + REAL*8 :: temp197b7 + REAL*8 :: temp200b + REAL*8 :: temp224b6 + REAL*8 :: temp225b10 + REAL*8 :: temp226b19 REAL*8 :: temp237b - REAL*8 :: temp280b4 REAL*8 :: temp318b - REAL*8 :: temp322b7 + REAL*8 :: temp332b11 + REAL*8 :: temp335b54 + REAL*8 :: temp340b30 REAL*8 :: temp344b3 - REAL*8 :: temp361b4 REAL*8 :: temp370 - REAL*8 :: temp373b52 - REAL*8 :: temp386b21 - REAL*8 :: temp386b58 - REAL*8 :: temp388b92 - REAL*8 :: temp404b20 - REAL*8 :: temp408b2 + REAL*8 :: temp383b0 REAL*8 :: temp451 - REAL*8 :: temp474b9 + REAL*8 :: temp464b0 REAL*8 :: temp481b1 - REAL*8 :: temp488 - REAL*8 :: temp496b5 + DOUBLE PRECISION :: temp488 REAL*8 :: temp21 - REAL*8 :: temp18b2 - REAL*8 :: temp57b10 - REAL*8 :: temp57b47 - REAL*8 :: temp58 - REAL*8 :: temp91b1 - REAL*8 :: temp109b3 - REAL*8 :: temp111b0 + REAL*8 :: temp50b26 + DOUBLE PRECISION :: temp58 + REAL*8 :: temp74b0 + DOUBLE PRECISION :: temp83b11 REAL*8 :: temp117 + REAL*8 :: temp131b40 + REAL*8 :: temp131b77 REAL*8 :: temp148b0 REAL*8 :: temp164b - REAL*8 :: temp245b - REAL*8 :: temp280b3 - REAL*8 :: temp322b6 + REAL*8 :: temp191b35 + REAL*8 :: temp197b6 + REAL*8 :: temp224b5 + REAL*8 :: temp226b18 + REAL*8 :: temp263b2 + REAL*8 :: temp326b + REAL*8 :: temp332b10 + REAL*8 :: temp335b53 REAL*8 :: temp344b2 - REAL*8 :: temp361b3 - REAL*8 :: temp373b51 - REAL*8 :: temp386b20 - REAL*8 :: temp386b57 - REAL*8 :: temp387b29 - REAL*8 :: temp388b91 - REAL*8 :: temp407b - REAL*8 :: temp408b1 REAL*8 :: temp450 - REAL*8 :: temp474b8 REAL*8 :: temp479b3 REAL*8 :: temp481b0 REAL*8 :: temp487 - REAL*8 :: temp496b4 - REAL*8 :: temp18b1 REAL*8 :: temp20 - REAL*8 :: temp57b46 + REAL*8 :: temp50b25 REAL*8 :: temp57 - REAL*8 :: temp58b18 - REAL*8 :: temp91b0 - REAL*8 :: temp109b2 - REAL*8 :: temp116 - REAL*8 :: temp202b8 + DOUBLE PRECISION :: temp83b10 + DOUBLE PRECISION :: temp116 + REAL*8 :: temp124b29 + REAL*8 :: temp131b76 + REAL*8 :: temp172b + REAL*8 :: temp191b34 + REAL*8 :: temp197b5 + REAL*8 :: temp207b3 + REAL*8 :: temp224b4 + REAL*8 :: temp226b17 REAL*8 :: temp246b0 - REAL*8 :: temp280b2 - REAL*8 :: temp322b5 - DOUBLE PRECISION :: temp334b + REAL*8 :: temp253b + REAL*8 :: temp263b1 + REAL*8 :: temp335b52 REAL*8 :: temp344b1 - REAL*8 :: temp361b2 - REAL*8 :: temp373b50 - REAL*8 :: temp386b56 - REAL*8 :: temp387b28 - REAL*8 :: temp388b90 - REAL*8 :: temp408b0 REAL*8 :: temp415b - REAL*8 :: temp474b7 + REAL*8 :: temp420b6 REAL*8 :: temp479b2 REAL*8 :: temp486 - REAL*8 :: temp496b3 REAL*8 :: temp16b - REAL*8 :: temp18b0 + REAL*8 :: temp49b26 + REAL*8 :: temp50b24 REAL*8 :: temp56 - REAL*8 :: temp57b45 - REAL*8 :: temp58b17 - REAL*8 :: temp109b1 - DOUBLE PRECISION :: temp115 - REAL*8 :: temp202b7 - REAL*8 :: temp280b1 + REAL*8 :: temp115 + REAL*8 :: temp124b28 + REAL*8 :: temp131b75 + REAL*8 :: temp180b + REAL*8 :: temp191b33 + REAL*8 :: temp197b4 + REAL*8 :: temp207b2 + REAL*8 :: temp224b3 + REAL*8 :: temp226b16 + REAL*8 :: temp261b + REAL*8 :: temp263b0 REAL*8 :: temp298b - REAL*8 :: temp322b4 + REAL*8 :: temp335b51 REAL*8 :: temp342b REAL*8 :: temp344b0 - REAL*8 :: temp361b1 - REAL*8 :: temp379b - REAL*8 :: temp386b55 - REAL*8 :: temp387b27 - REAL*8 :: temp425b0 - REAL*8 :: temp474b6 + REAL*8 :: temp420b5 REAL*8 :: temp479b1 REAL*8 :: temp485 - REAL*8 :: temp496b2 - REAL*8 :: temp504b + REAL*8 :: temp506b0 + REAL*8 :: temp523b1 REAL*8 :: temp24b - REAL*8 :: temp55 - REAL*8 :: temp57b44 - REAL*8 :: temp58b16 - REAL*8 :: temp109b0 - DOUBLE PRECISION :: temp114 - REAL*8 :: temp202b6 + REAL*8 :: temp49b25 + REAL*8 :: temp50b23 + DOUBLE PRECISION :: temp55 + REAL*8 :: temp114 + REAL*8 :: temp124b27 + REAL*8 :: temp131b74 + REAL*8 :: temp191b32 + REAL*8 :: temp197b3 + REAL*8 :: temp207b1 + REAL*8 :: temp224b2 + REAL*8 :: temp226b15 REAL*8 :: temp280b0 - REAL*8 :: temp321b19 - REAL*8 :: temp322b3 - REAL*8 :: temp350b - REAL*8 :: temp361b0 - REAL*8 :: temp386b54 + REAL*8 :: temp335b50 REAL*8 :: temp387b - REAL*8 :: temp387b26 - REAL*8 :: temp474b5 + REAL*8 :: temp420b4 + REAL*8 :: temp431b + DOUBLE PRECISION :: temp442b0 + REAL*8 :: temp468b REAL*8 :: temp479b0 REAL*8 :: temp484 - REAL*8 :: temp496b1 REAL*8 :: temp512b + REAL*8 :: temp523b0 + REAL*8 :: tempb9 + REAL*8 :: temp32b + REAL*8 :: temp49b24 + REAL*8 :: temp50b22 REAL*8 :: temp54 - REAL*8 :: temp57b43 - REAL*8 :: temp58b15 + REAL*8 :: temp50b59 REAL*8 :: temp69b + REAL*8 :: temp106b DOUBLE PRECISION :: temp113 - REAL*8 :: temp202b5 - REAL*8 :: temp321b18 - REAL*8 :: temp322b2 - REAL*8 :: temp386b53 - REAL*8 :: temp387b25 + REAL*8 :: temp124b26 + REAL*8 :: temp131b73 + REAL*8 :: temp143b1 + REAL*8 :: temp191b31 + REAL*8 :: temp197b2 + REAL*8 :: temp207b0 + REAL*8 :: temp224b1 + REAL*8 :: temp226b14 + REAL*8 :: temp340b62 REAL*8 :: temp395b - REAL*8 :: temp474b4 + REAL*8 :: temp420b3 REAL*8 :: temp476b REAL*8 :: temp483 - REAL*8 :: temp489b8 REAL*8 :: temp496b0 REAL*8 :: temp520b - REAL*8 :: temp4b0 - REAL*8 :: temp40b + REAL*8 :: tempb8 + REAL*8 :: temp49b23 + REAL*8 :: temp50b21 REAL*8 :: temp53 - REAL*8 :: temp57b42 - REAL*8 :: temp58b14 + REAL*8 :: temp50b58 REAL*8 :: temp77b DOUBLE PRECISION :: temp112 + REAL*8 :: temp114b + REAL*8 :: temp124b25 + REAL*8 :: temp131b72 + REAL*8 :: temp143b0 REAL*8 :: temp149 - REAL*8 :: temp202b4 - REAL*8 :: temp315b9 - REAL*8 :: temp321b17 - REAL*8 :: temp322b1 - REAL*8 :: temp386b52 - REAL*8 :: temp387b24 - REAL*8 :: temp474b3 + REAL*8 :: temp191b30 + REAL*8 :: temp197b1 + REAL*8 :: temp224b0 + REAL*8 :: temp226b13 + REAL*8 :: temp340b61 + REAL*8 :: temp420b2 + REAL*8 :: temp431b24 REAL*8 :: temp482 - REAL*8 :: temp489b7 - REAL*8 :: temp52 - REAL*8 :: temp57b41 - REAL*8 :: temp58b13 - REAL*8 :: temp85b - DOUBLE PRECISION :: temp89 - REAL*8 :: temp99b7 - REAL*8 :: temp111 + REAL*8 :: temp484b + REAL*8 :: tempb7 + REAL*8 :: temp49b22 + REAL*8 :: temp50b20 + DOUBLE PRECISION :: temp52 + REAL*8 :: temp50b57 + REAL*8 :: temp89 + DOUBLE PRECISION :: temp111 + REAL*8 :: temp124b24 + REAL*8 :: temp131b71 REAL*8 :: temp148 - REAL*8 :: temp202b3 + REAL*8 :: temp197b0 REAL*8 :: temp203b - DOUBLE PRECISION :: temp229 - REAL*8 :: temp241b0 - REAL*8 :: temp315b8 - REAL*8 :: temp321b16 + REAL*8 :: temp226b12 + REAL*8 :: temp229 REAL*8 :: temp322b0 - REAL*8 :: temp380b39 - REAL*8 :: temp386b51 - REAL*8 :: temp387b23 - REAL*8 :: temp474b2 + REAL*8 :: temp332b9 + REAL*8 :: temp340b60 + REAL*8 :: temp420b1 + REAL*8 :: temp431b23 REAL*8 :: temp481 - REAL*8 :: temp489b6 REAL*8 :: temp492b - REAL*8 :: temp501b1 - REAL*8 :: temp13b0 - REAL*8 :: temp51 - REAL*8 :: temp57b40 - REAL*8 :: temp58b12 - REAL*8 :: temp88 + REAL*8 :: tempb6 + REAL*8 :: temp49b21 + DOUBLE PRECISION :: temp51 + REAL*8 :: temp50b56 + DOUBLE PRECISION :: temp88 REAL*8 :: temp93b - REAL*8 :: temp99b6 - REAL*8 :: temp110 + DOUBLE PRECISION :: temp110 + REAL*8 :: temp124b23 REAL*8 :: temp130b + REAL*8 :: temp131b70 REAL*8 :: temp147 - REAL*8 :: temp202b2 + REAL*8 :: temp226b11 REAL*8 :: temp228 - REAL*8 :: temp300b3 - REAL*8 :: temp309 - REAL*8 :: temp315b7 - REAL*8 :: temp321b15 + REAL*8 :: temp248b + REAL*8 :: temp290b5 + DOUBLE PRECISION :: temp309 REAL*8 :: temp329b - REAL*8 :: temp380b38 - REAL*8 :: temp386b9 - REAL*8 :: temp386b50 - REAL*8 :: temp387b22 - REAL*8 :: temp387b59 + REAL*8 :: temp332b8 REAL*8 :: temp420b0 - REAL*8 :: temp474b1 + REAL*8 :: temp431b22 + REAL*8 :: temp457b0 REAL*8 :: temp480 - REAL*8 :: temp489b5 REAL*8 :: temp501b0 - REAL*8 :: temp50 - REAL*8 :: temp58b11 - REAL*8 :: temp87 - REAL*8 :: temp99b5 + REAL*8 :: tempb5 + REAL*8 :: temp49b20 + REAL*8 :: temp50b55 + DOUBLE PRECISION :: temp50 + DOUBLE PRECISION :: temp87 + REAL*8 :: temp124b22 REAL*8 :: temp146 - REAL*8 :: temp175b - REAL*8 :: temp202b1 + REAL*8 :: temp226b10 REAL*8 :: temp227 + REAL*8 :: temp256b + REAL*8 :: temp290b4 REAL*8 :: temp300b - REAL*8 :: temp300b2 REAL*8 :: temp308 - REAL*8 :: temp315b6 - REAL*8 :: temp321b14 + REAL*8 :: temp332b7 REAL*8 :: temp337b - REAL*8 :: temp379b39 - REAL*8 :: temp380b37 - REAL*8 :: temp386b8 - REAL*8 :: temp387b21 - REAL*8 :: temp387b58 - REAL*8 :: temp418b - REAL*8 :: temp474b0 - REAL*8 :: temp489b4 + REAL*8 :: temp431b21 + REAL*8 :: tempb4 REAL*8 :: temp19b - REAL*8 :: temp58b10 - REAL*8 :: temp86 - REAL*8 :: temp99b4 - DOUBLE PRECISION :: temp145 - REAL*8 :: temp202b0 + REAL*8 :: temp50b54 + DOUBLE PRECISION :: temp86 + REAL*8 :: temp124b21 + REAL*8 :: temp131b9 + REAL*8 :: temp145 + REAL*8 :: temp183b REAL*8 :: temp226 - DOUBLE PRECISION :: temp264b - DOUBLE PRECISION :: temp273b2 + REAL*8 :: temp253b19 + REAL*8 :: temp264b + REAL*8 :: temp277b13 + REAL*8 :: temp290b3 REAL*8 :: temp300b1 REAL*8 :: temp307 - REAL*8 :: temp315b5 - REAL*8 :: temp321b13 + REAL*8 :: temp332b6 REAL*8 :: temp345b - REAL*8 :: temp379b38 - REAL*8 :: temp380b36 - REAL*8 :: temp386b7 - REAL*8 :: temp387b20 - REAL*8 :: temp387b57 - REAL*8 :: temp388b29 - REAL*8 :: temp418b1 + REAL*8 :: temp371b3 REAL*8 :: temp426b - REAL*8 :: temp489b3 + REAL*8 :: temp431b20 REAL*8 :: temp507b - REAL*8 :: temp27b - REAL*8 :: temp85 - REAL*8 :: temp99b3 + REAL*8 :: tempb3 + REAL*8 :: temp50b53 + DOUBLE PRECISION :: temp85 + REAL*8 :: temp124b20 + REAL*8 :: temp131b8 REAL*8 :: temp144 + REAL*8 :: temp191b + REAL*8 :: temp206b29 REAL*8 :: temp225 - REAL*8 :: temp272b - DOUBLE PRECISION :: temp273b1 + REAL*8 :: temp253b18 + REAL*8 :: temp256b0 + REAL*8 :: temp277b12 + REAL*8 :: temp290b2 REAL*8 :: temp300b0 DOUBLE PRECISION :: temp306 - REAL*8 :: temp315b4 - REAL*8 :: temp321b12 - REAL*8 :: temp379b37 - REAL*8 :: temp380b35 - REAL*8 :: temp386b6 - REAL*8 :: temp387b56 - REAL*8 :: temp388b28 - REAL*8 :: temp418b0 - REAL*8 :: temp434b - REAL*8 :: temp489b2 - REAL*8 :: temp515b - REAL*8 :: temp28b0 - REAL*8 :: temp35b + REAL*8 :: temp332b5 + REAL*8 :: temp353b + REAL*8 :: temp371b2 + REAL*8 :: temp467b6 + REAL*8 :: tempb2 + REAL*8 :: temp45b1 + REAL*8 :: temp50b52 DOUBLE PRECISION :: temp84 - REAL*8 :: temp99b2 REAL*8 :: temp109b + REAL*8 :: temp131b7 REAL*8 :: temp143 - REAL*8 :: temp224 - DOUBLE PRECISION :: temp273b0 + REAL*8 :: temp206b28 + DOUBLE PRECISION :: temp224 + REAL*8 :: temp253b17 + REAL*8 :: temp277b11 REAL*8 :: temp280b + REAL*8 :: temp290b1 DOUBLE PRECISION :: temp305 - REAL*8 :: temp315b3 - REAL*8 :: temp321b11 - REAL*8 :: temp354b0 - REAL*8 :: temp361b - REAL*8 :: temp379b36 - REAL*8 :: temp380b34 - REAL*8 :: temp386b5 - REAL*8 :: temp387b55 - REAL*8 :: temp388b27 - REAL*8 :: temp398b + REAL*8 :: temp332b4 + REAL*8 :: temp371b1 + DOUBLE PRECISION :: temp398b + REAL*8 :: temp442b + REAL*8 :: temp448b39 + REAL*8 :: temp467b5 REAL*8 :: temp479b - REAL*8 :: temp489b1 - REAL*8 :: temp516b0 + REAL*8 :: temp523b + REAL*8 :: tempb1 REAL*8 :: temp43b - REAL*8 :: temp83 - REAL*8 :: temp99b1 - DOUBLE PRECISION :: temp142 - DOUBLE PRECISION :: temp179 + REAL*8 :: temp45b0 + REAL*8 :: temp50b51 + DOUBLE PRECISION :: temp83 + REAL*8 :: temp117b + REAL*8 :: temp131b6 + REAL*8 :: temp136b1 + REAL*8 :: temp142 + REAL*8 :: temp179 + REAL*8 :: temp197b19 + REAL*8 :: temp206b27 REAL*8 :: temp223 + REAL*8 :: temp253b16 + REAL*8 :: temp277b10 + REAL*8 :: temp290b0 DOUBLE PRECISION :: temp304 - REAL*8 :: temp315b2 - REAL*8 :: temp321b10 - REAL*8 :: temp322b19 - REAL*8 :: temp379b35 - REAL*8 :: temp380b33 - REAL*8 :: temp386b4 - REAL*8 :: temp387b54 - REAL*8 :: temp388b26 - REAL*8 :: temp450b - REAL*8 :: temp478b17 + REAL*8 :: temp332b3 + REAL*8 :: temp371b0 + REAL*8 :: temp448b38 + REAL*8 :: temp467b4 REAL*8 :: temp487b - REAL*8 :: temp489b0 + REAL*8 :: temp499b9 + REAL*8 :: tempb0 REAL*8 :: temp0b - REAL*8 :: temp51b - REAL*8 :: temp82 - REAL*8 :: temp88b + REAL*8 :: temp8b19 + REAL*8 :: temp50b50 + DOUBLE PRECISION :: temp82 REAL*8 :: temp99b0 + REAL*8 :: temp125b + REAL*8 :: temp131b5 + REAL*8 :: temp136b0 REAL*8 :: temp141 - DOUBLE PRECISION :: temp178 + REAL*8 :: temp178 + REAL*8 :: temp197b18 + REAL*8 :: temp206b + REAL*8 :: temp206b26 REAL*8 :: temp222 + REAL*8 :: temp253b15 REAL*8 :: temp259 DOUBLE PRECISION :: temp303 - REAL*8 :: temp315b1 - REAL*8 :: temp322b18 - REAL*8 :: temp379b34 - REAL*8 :: temp380b32 - REAL*8 :: temp380b69 - REAL*8 :: temp386b3 - REAL*8 :: temp387b53 - REAL*8 :: temp388b25 - REAL*8 :: temp478b16 + REAL*8 :: temp332b2 + REAL*8 :: temp448b37 + REAL*8 :: temp467b3 REAL*8 :: temp495b - REAL*8 :: temp77b3 - DOUBLE PRECISION :: temp81 + REAL*8 :: temp499b8 + REAL*8 :: temp8b18 + REAL*8 :: temp81 + REAL*8 :: temp96b + REAL*8 :: temp131b4 + REAL*8 :: temp133b REAL*8 :: temp140 REAL*8 :: temp153b0 REAL*8 :: temp177 + REAL*8 :: temp197b17 + REAL*8 :: temp206b25 REAL*8 :: temp221 - DOUBLE PRECISION :: temp258 + REAL*8 :: temp234b0 + REAL*8 :: temp253b14 + REAL*8 :: temp258 REAL*8 :: temp302 - REAL*8 :: temp315b0 - REAL*8 :: temp322b17 + REAL*8 :: temp332b1 REAL*8 :: temp339 - REAL*8 :: temp379b33 - REAL*8 :: temp380b31 - REAL*8 :: temp380b68 - REAL*8 :: temp386b2 - REAL*8 :: temp387b52 - REAL*8 :: temp388b24 - REAL*8 :: temp478b15 - REAL*8 :: temp23b1 - REAL*8 :: temp38b5 - REAL*8 :: temp77b2 + REAL*8 :: temp448b36 + REAL*8 :: temp467b2 + REAL*8 :: temp499b7 + REAL*8 :: temp8b17 DOUBLE PRECISION :: temp80 + REAL*8 :: temp131b3 + REAL*8 :: temp141b + REAL*8 :: temp170b0 REAL*8 :: temp176 REAL*8 :: temp178b + REAL*8 :: temp197b16 + REAL*8 :: temp206b24 REAL*8 :: temp220 REAL*8 :: temp222b - DOUBLE PRECISION :: temp257 + REAL*8 :: temp253b13 + REAL*8 :: temp257 REAL*8 :: temp259b - DOUBLE PRECISION :: temp301 - DOUBLE PRECISION :: temp303b - REAL*8 :: temp322b16 - DOUBLE PRECISION :: temp332b0 - DOUBLE PRECISION :: temp338 - REAL*8 :: temp369b0 - REAL*8 :: temp379b9 - REAL*8 :: temp379b32 - REAL*8 :: temp379b69 - REAL*8 :: temp380b30 - REAL*8 :: temp380b67 + REAL*8 :: temp301 + REAL*8 :: temp303b + REAL*8 :: temp332b0 + REAL*8 :: temp338 REAL*8 :: temp386b1 - REAL*8 :: temp387b51 - REAL*8 :: temp388b23 - REAL*8 :: temp413b0 REAL*8 :: temp419 - REAL*8 :: temp478b14 + REAL*8 :: temp448b35 + REAL*8 :: temp467b1 + REAL*8 :: temp499b6 + REAL*8 :: temp8b16 REAL*8 :: temp23b0 - REAL*8 :: temp38b4 - REAL*8 :: temp77b1 + REAL*8 :: temp131b2 + REAL*8 :: temp155b39 REAL*8 :: temp175 - REAL*8 :: temp186b + REAL*8 :: temp197b15 + REAL*8 :: temp206b23 REAL*8 :: temp230b + REAL*8 :: temp253b12 + REAL*8 :: temp253b49 REAL*8 :: temp256 REAL*8 :: temp300 REAL*8 :: temp311b - REAL*8 :: temp322b15 REAL*8 :: temp337 - REAL*8 :: temp348b - REAL*8 :: temp373b19 - REAL*8 :: temp379b8 - REAL*8 :: temp379b31 - REAL*8 :: temp379b68 - REAL*8 :: temp380b66 REAL*8 :: temp386b0 - REAL*8 :: temp387b50 - REAL*8 :: temp388b22 - REAL*8 :: temp388b59 REAL*8 :: temp418 REAL*8 :: temp429b - REAL*8 :: temp478b13 - REAL*8 :: temp509b3 - REAL*8 :: temp38b3 - REAL*8 :: temp40b0 - REAL*8 :: temp68b39 - REAL*8 :: temp77b0 + REAL*8 :: temp445b4 + REAL*8 :: temp448b34 + REAL*8 :: temp467b0 + REAL*8 :: tmpb + REAL*8 :: temp499b5 + REAL*8 :: tempb11 + REAL*8 :: temp8b15 + REAL*8 :: temp50b9 + REAL*8 :: temp114b0 + REAL*8 :: temp124b9 + REAL*8 :: temp131b1 + REAL*8 :: temp155b38 + REAL*8 :: temp168b1 REAL*8 :: temp174 + REAL*8 :: temp197b14 + REAL*8 :: temp206b22 + REAL*8 :: temp253b11 + REAL*8 :: temp253b48 REAL*8 :: temp255 - DOUBLE PRECISION :: temp283b3 - REAL*8 :: temp322b14 REAL*8 :: temp336 - REAL*8 :: temp356b - REAL*8 :: temp373b18 - REAL*8 :: temp379b7 - REAL*8 :: temp379b30 - REAL*8 :: temp379b67 - REAL*8 :: temp380b65 - REAL*8 :: temp388b21 - REAL*8 :: temp388b58 + DOUBLE PRECISION :: temp356b REAL*8 :: temp400b REAL*8 :: temp417 - REAL*8 :: temp437b - REAL*8 :: temp478b12 - REAL*8 :: temp494b9 - REAL*8 :: temp509b2 - REAL*8 :: temp38b - REAL*8 :: temp38b2 - REAL*8 :: temp68b38 - REAL*8 :: temp129b3 - DOUBLE PRECISION :: temp173 + REAL*8 :: temp440b8 + REAL*8 :: temp445b3 + REAL*8 :: temp448b33 + REAL*8 :: temp484b0 + REAL*8 :: temp499b4 + REAL*8 :: temp499b37 + REAL*8 :: temp518b + REAL*8 :: tempb10 + REAL*8 :: temp8b14 + REAL*8 :: temp50b8 + REAL*8 :: temp124b8 + REAL*8 :: temp131b0 + REAL*8 :: temp155b37 + REAL*8 :: temp168b0 + REAL*8 :: temp173 + REAL*8 :: temp197b13 + REAL*8 :: temp206b21 + REAL*8 :: temp253b10 + REAL*8 :: temp253b47 REAL*8 :: temp254 - DOUBLE PRECISION :: temp249b0 - DOUBLE PRECISION :: temp283b - DOUBLE PRECISION :: temp283b2 - REAL*8 :: temp322b13 - REAL*8 :: temp335 - REAL*8 :: temp364b - REAL*8 :: temp373b17 - REAL*8 :: temp379b6 - REAL*8 :: temp379b66 - REAL*8 :: temp380b64 - REAL*8 :: temp388b20 - REAL*8 :: temp388b57 + REAL*8 :: temp283b + REAL*8 :: temp335b19 + INTEGER :: temp335 REAL*8 :: temp416 + REAL*8 :: temp440b7 REAL*8 :: temp445b - REAL*8 :: temp478b11 - REAL*8 :: temp494b8 - REAL*8 :: temp509b1 - REAL*8 :: temp38b1 - REAL*8 :: temp46b - REAL*8 :: temp68b37 - REAL*8 :: temp129b2 - DOUBLE PRECISION :: temp172 - REAL*8 :: temp253 - DOUBLE PRECISION :: temp283b1 - REAL*8 :: temp322b12 - DOUBLE PRECISION :: temp334 - REAL*8 :: temp347b0 + REAL*8 :: temp445b2 + REAL*8 :: temp448b32 + REAL*8 :: temp448b69 + REAL*8 :: tmp0b + REAL*8 :: temp499b3 + REAL*8 :: temp499b36 + REAL*8 :: temp522b11 + REAL*8 :: temp526b + REAL*8 :: temp8b13 + REAL*8 :: temp50b7 + REAL*8 :: temp124b7 + REAL*8 :: temp155b36 + REAL*8 :: temp172 + REAL*8 :: temp185b0 + REAL*8 :: temp197b12 + REAL*8 :: temp197b49 + REAL*8 :: temp206b20 + REAL*8 :: temp253b46 + INTEGER :: temp253 + REAL*8 :: temp334 + REAL*8 :: temp335b18 REAL*8 :: temp372b - REAL*8 :: temp373b16 - REAL*8 :: temp379b5 - REAL*8 :: temp379b65 - REAL*8 :: temp380b63 - REAL*8 :: temp388b56 REAL*8 :: temp415 - REAL*8 :: temp428b0 + REAL*8 :: temp440b6 REAL*8 :: temp445b1 + REAL*8 :: temp448b31 + REAL*8 :: temp448b68 REAL*8 :: temp453b - REAL*8 :: temp478b10 - REAL*8 :: temp494b7 - REAL*8 :: temp496b29 + REAL*8 :: temp499b2 + REAL*8 :: temp499b35 REAL*8 :: temp509b0 - REAL*8 :: temp521b6 + REAL*8 :: temp522b10 REAL*8 :: temp3b - REAL*8 :: temp38b0 - REAL*8 :: temp54b - REAL*8 :: temp68b36 - REAL*8 :: temp128b - REAL*8 :: temp129b1 + REAL*8 :: temp8b12 + REAL*8 :: temp8b49 + REAL*8 :: temp50b6 + REAL*8 :: temp124b6 + REAL*8 :: temp135b19 + REAL*8 :: temp155b35 REAL*8 :: temp171 - DOUBLE PRECISION :: temp252 + REAL*8 :: temp197b11 + REAL*8 :: temp197b48 + REAL*8 :: temp252 + REAL*8 :: temp253b45 REAL*8 :: temp289 - DOUBLE PRECISION :: temp283b0 - REAL*8 :: temp322b11 + REAL*8 :: temp283b0 REAL*8 :: temp333 - REAL*8 :: temp373b15 - REAL*8 :: temp374b9 - REAL*8 :: temp379b4 - REAL*8 :: temp379b64 + REAL*8 :: temp335b17 REAL*8 :: temp380b - REAL*8 :: temp380b62 - REAL*8 :: temp388b55 - REAL*8 :: temp406b3 REAL*8 :: temp414 + REAL*8 :: temp440b5 REAL*8 :: temp445b0 + REAL*8 :: temp448b30 + REAL*8 :: temp448b67 REAL*8 :: temp461b - REAL*8 :: temp477b5 - REAL*8 :: temp494b6 - REAL*8 :: temp496b28 - REAL*8 :: temp521b5 - REAL*8 :: temp55b0 - REAL*8 :: temp68b35 + REAL*8 :: temp498b + REAL*8 :: temp499b1 + REAL*8 :: temp499b34 + REAL*8 :: temp526b0 + REAL*8 :: temp8b11 + REAL*8 :: temp8b48 + REAL*8 :: temp16b3 + REAL*8 :: temp50b5 REAL*8 :: temp99b + REAL*8 :: temp124b5 REAL*8 :: temp129b0 + REAL*8 :: temp135b18 + REAL*8 :: temp136b + REAL*8 :: temp155b34 REAL*8 :: temp170 - REAL*8 :: temp217b + REAL*8 :: temp180b3 + REAL*8 :: temp197b10 + REAL*8 :: temp197b47 REAL*8 :: temp251 + REAL*8 :: temp253b44 REAL*8 :: temp288 - REAL*8 :: temp298b3 - REAL*8 :: temp322b10 - DOUBLE PRECISION :: temp332 + REAL*8 :: temp332 + REAL*8 :: temp335b16 + REAL*8 :: temp340b29 REAL*8 :: temp369 - REAL*8 :: temp373b14 - REAL*8 :: temp374b8 - REAL*8 :: temp379b3 - REAL*8 :: temp379b63 - REAL*8 :: temp380b61 - REAL*8 :: temp388b54 - REAL*8 :: temp404b19 - REAL*8 :: temp406b2 REAL*8 :: temp413 - REAL*8 :: temp462b0 - REAL*8 :: temp477b4 - REAL*8 :: temp494b5 - REAL*8 :: temp496b27 - REAL*8 :: temp521b4 - REAL*8 :: temp68b34 + REAL*8 :: temp440b4 + REAL*8 :: temp448b66 + DOUBLE PRECISION :: temp462b0 + REAL*8 :: temp499b0 + REAL*8 :: temp499b33 + REAL*8 :: temp7b0 + REAL*8 :: temp8b10 + REAL*8 :: temp8b47 + REAL*8 :: temp16b2 + REAL*8 :: temp50b4 REAL*8 :: temp70b + REAL*8 :: temp124b4 + REAL*8 :: temp131b39 + REAL*8 :: temp135b17 REAL*8 :: temp144b - REAL*8 :: temp146b0 + REAL*8 :: temp155b33 + REAL*8 :: temp180b2 + REAL*8 :: temp197b46 REAL*8 :: temp225b REAL*8 :: temp227b0 - DOUBLE PRECISION :: temp250 - DOUBLE PRECISION :: temp287 - REAL*8 :: temp298b2 + REAL*8 :: temp250 + REAL*8 :: temp253b43 + REAL*8 :: temp287 REAL*8 :: temp331 - INTEGER :: temp368 - REAL*8 :: temp373b13 - REAL*8 :: temp374b7 - REAL*8 :: temp379b2 - REAL*8 :: temp379b62 - REAL*8 :: temp380b60 - REAL*8 :: temp386b19 - REAL*8 :: temp388b53 - REAL*8 :: temp404b18 - REAL*8 :: temp406b1 + REAL*8 :: temp335b15 + REAL*8 :: temp340b28 + DOUBLE PRECISION :: temp368 REAL*8 :: temp412 + REAL*8 :: temp440b3 + REAL*8 :: temp448b65 REAL*8 :: temp449 - REAL*8 :: temp477b3 - REAL*8 :: temp494b4 - REAL*8 :: temp496b26 - REAL*8 :: temp521b3 + REAL*8 :: temp499b32 + REAL*8 :: temp8b46 REAL*8 :: temp16b1 REAL*8 :: temp19 - REAL*8 :: temp68b33 + REAL*8 :: temp50b3 + REAL*8 :: temp124b3 + REAL*8 :: temp131b38 + REAL*8 :: temp135b16 + REAL*8 :: temp155b32 + REAL*8 :: temp180b1 REAL*8 :: temp189b - DOUBLE PRECISION :: temp286 - REAL*8 :: temp298b1 + REAL*8 :: temp197b45 + REAL*8 :: temp233b + REAL*8 :: temp244b0 + REAL*8 :: temp253b42 + REAL*8 :: temp286 REAL*8 :: temp314b + REAL*8 :: temp325b0 REAL*8 :: temp330 + REAL*8 :: temp335b9 + REAL*8 :: temp335b14 + REAL*8 :: temp340b27 DOUBLE PRECISION :: temp367 - REAL*8 :: temp373b12 - REAL*8 :: temp373b49 - REAL*8 :: temp374b6 - REAL*8 :: temp379b1 - REAL*8 :: temp379b61 - REAL*8 :: temp386b18 - REAL*8 :: temp388b52 - REAL*8 :: temp388b89 - REAL*8 :: temp404b17 - REAL*8 :: temp406b0 REAL*8 :: temp411 - DOUBLE PRECISION :: temp448 - REAL*8 :: temp477b2 - REAL*8 :: temp494b3 - REAL*8 :: temp496b25 - REAL*8 :: temp521b2 + REAL*8 :: temp440b2 + REAL*8 :: temp448b64 + REAL*8 :: temp448 + REAL*8 :: temp499b31 + REAL*8 :: temp8b45 REAL*8 :: temp16b0 REAL*8 :: temp18 - REAL*8 :: temp68b32 - REAL*8 :: temp139b6 - REAL*8 :: temp241b - DOUBLE PRECISION :: temp285 + REAL*8 :: temp50b2 + REAL*8 :: temp107b1 + REAL*8 :: temp124b2 + REAL*8 :: temp131b37 + REAL*8 :: temp135b15 + REAL*8 :: temp155b31 + REAL*8 :: temp180b0 + REAL*8 :: temp190b9 + REAL*8 :: temp197b + REAL*8 :: temp197b44 + REAL*8 :: temp253b41 + REAL*8 :: temp261b0 + REAL*8 :: temp278b + REAL*8 :: temp285 REAL*8 :: temp298b0 REAL*8 :: temp322b + REAL*8 :: temp335b8 + REAL*8 :: temp335b13 + REAL*8 :: temp340b26 REAL*8 :: temp342b0 REAL*8 :: temp366 - REAL*8 :: temp373b11 - REAL*8 :: temp373b48 - REAL*8 :: temp374b5 - REAL*8 :: temp379b0 - REAL*8 :: temp379b60 - REAL*8 :: temp386b17 - REAL*8 :: temp388b51 - REAL*8 :: temp388b88 - REAL*8 :: temp404b16 REAL*8 :: temp410 REAL*8 :: temp440b1 - DOUBLE PRECISION :: temp447 - REAL*8 :: temp477b1 - REAL*8 :: temp494b2 - REAL*8 :: temp496b24 - REAL*8 :: temp504b0 - REAL*8 :: temp521b1 + REAL*8 :: temp447 + REAL*8 :: temp448b63 + REAL*8 :: temp455b5 + REAL*8 :: temp499b30 + REAL*8 :: temp8b44 REAL*8 :: temp17 - REAL*8 :: temp68b31 - REAL*8 :: temp139b5 - REAL*8 :: temp178b2 + REAL*8 :: temp50b1 + REAL*8 :: temp107b0 + REAL*8 :: temp124b1 + REAL*8 :: temp131b36 + REAL*8 :: temp135b14 + REAL*8 :: temp155b30 + REAL*8 :: temp190b8 + REAL*8 :: temp197b43 + REAL*8 :: temp253b40 DOUBLE PRECISION :: temp284 + REAL*8 :: temp286b + REAL*8 :: temp303b2 REAL*8 :: temp330b - DOUBLE PRECISION :: temp365 - REAL*8 :: temp367b - REAL*8 :: temp373b10 - REAL*8 :: temp373b47 - REAL*8 :: temp374b4 - REAL*8 :: temp386b16 - REAL*8 :: temp388b50 - REAL*8 :: temp388b87 - DOUBLE PRECISION :: temp396b0 - REAL*8 :: temp404b15 + REAL*8 :: temp335b7 + REAL*8 :: temp335b12 + REAL*8 :: temp335b49 + REAL*8 :: temp340b25 + REAL*8 :: temp365 REAL*8 :: temp411b REAL*8 :: temp440b0 REAL*8 :: temp446 REAL*8 :: temp448b - REAL*8 :: temp477b0 - REAL*8 :: temp494b1 - REAL*8 :: temp496b23 + REAL*8 :: temp448b62 + REAL*8 :: temp455b4 + REAL*8 :: tmp3b REAL*8 :: temp521b0 - REAL*8 :: temp12b + REAL*8 :: temp8b43 REAL*8 :: temp16 - REAL*8 :: temp43b8 REAL*8 :: temp49b - REAL*8 :: temp68b30 - REAL*8 :: temp87b0 - REAL*8 :: temp139b4 - REAL*8 :: temp178b1 - REAL*8 :: temp216b13 + REAL*8 :: temp50b0 + REAL*8 :: temp124b0 + REAL*8 :: temp131b35 + REAL*8 :: temp135b13 + REAL*8 :: temp190b7 + REAL*8 :: temp197b42 + REAL*8 :: temp205b0 DOUBLE PRECISION :: temp283 - DOUBLE PRECISION :: temp303b1 - REAL*8 :: temp364 - REAL*8 :: temp373b46 - REAL*8 :: temp374b3 - REAL*8 :: temp386b15 - REAL*8 :: temp388b86 - REAL*8 :: temp404b14 + REAL*8 :: temp294b + REAL*8 :: temp303b1 + REAL*8 :: temp335b6 + REAL*8 :: temp335b11 + REAL*8 :: temp335b48 + REAL*8 :: temp340b24 + DOUBLE PRECISION :: temp364 REAL*8 :: temp445 + REAL*8 :: temp448b61 + REAL*8 :: temp455b3 REAL*8 :: temp456b - REAL*8 :: temp494b0 - REAL*8 :: temp496b22 REAL*8 :: temp500b + REAL*8 :: temp526 + REAL*8 :: temp2b0 + REAL*8 :: temp8b42 REAL*8 :: temp15 REAL*8 :: temp20b - REAL*8 :: temp43b7 REAL*8 :: temp57b - REAL*8 :: temp139b3 - REAL*8 :: temp178b0 - REAL*8 :: temp216b12 + REAL*8 :: temp131b34 + REAL*8 :: temp135b12 + REAL*8 :: temp141b0 + REAL*8 :: temp190b6 + REAL*8 :: temp191b29 + REAL*8 :: temp197b41 REAL*8 :: temp222b0 - REAL*8 :: temp282 - DOUBLE PRECISION :: temp303b0 + DOUBLE PRECISION :: temp282 + REAL*8 :: temp303b0 + REAL*8 :: temp313b9 + REAL*8 :: temp335b5 + REAL*8 :: temp335b10 + REAL*8 :: temp335b47 + REAL*8 :: temp340b23 DOUBLE PRECISION :: temp363 - REAL*8 :: temp373b45 - REAL*8 :: temp374b2 - REAL*8 :: temp374b17 - REAL*8 :: temp386b14 - REAL*8 :: temp388b85 - REAL*8 :: temp404b13 - REAL*8 :: temp444 - REAL*8 :: temp496b21 - REAL*8 :: temp14 - REAL*8 :: temp43b6 - REAL*8 :: temp65b + REAL*8 :: temp383b + DOUBLE PRECISION :: temp444 + REAL*8 :: temp448b60 + REAL*8 :: temp455b2 + REAL*8 :: temp464b + REAL*8 :: temp525 + REAL*8 :: temp8b41 + DOUBLE PRECISION :: temp14 + REAL*8 :: temp50b19 + REAL*8 :: temp102b + REAL*8 :: temp131b33 + REAL*8 :: temp135b11 REAL*8 :: temp139b - REAL*8 :: temp139b2 - REAL*8 :: temp216b11 - REAL*8 :: temp281 - REAL*8 :: temp320b0 + REAL*8 :: temp190b5 + REAL*8 :: temp191b28 + REAL*8 :: temp197b40 + DOUBLE PRECISION :: temp281 + REAL*8 :: temp313b8 REAL*8 :: temp335b4 + REAL*8 :: temp335b46 + REAL*8 :: temp340b22 + REAL*8 :: temp340b59 REAL*8 :: temp362 - REAL*8 :: temp373b44 - REAL*8 :: temp374b1 - REAL*8 :: temp374b16 - REAL*8 :: temp386b13 - REAL*8 :: temp388b84 - REAL*8 :: temp391b REAL*8 :: temp399 - REAL*8 :: temp404b12 - REAL*8 :: temp438b0 + REAL*8 :: temp391b REAL*8 :: temp443 - REAL*8 :: temp472b - REAL*8 :: temp496b20 + REAL*8 :: temp448b9 + REAL*8 :: temp455b1 + REAL*8 :: temp524 + REAL*8 :: temp8b40 REAL*8 :: temp13 - REAL*8 :: temp43b5 - REAL*8 :: temp53b24 - REAL*8 :: temp57b39 - REAL*8 :: temp58b9 + REAL*8 :: temp48b0 + REAL*8 :: temp50b18 + REAL*8 :: temp73b REAL*8 :: temp109 REAL*8 :: temp110b - REAL*8 :: temp139b1 - REAL*8 :: temp147b - REAL*8 :: temp156b2 - REAL*8 :: temp216b10 + REAL*8 :: temp117b5 + REAL*8 :: temp131b32 + REAL*8 :: temp131b69 + REAL*8 :: temp135b10 + REAL*8 :: temp190b4 + REAL*8 :: temp191b27 REAL*8 :: temp228b REAL*8 :: temp280 - REAL*8 :: temp309b REAL*8 :: temp313b7 - REAL*8 :: temp315b29 + REAL*8 :: temp318b2 REAL*8 :: temp335b3 + REAL*8 :: temp335b45 + REAL*8 :: temp340b21 + REAL*8 :: temp340b58 REAL*8 :: temp361 - REAL*8 :: temp373b43 - REAL*8 :: temp374b0 - REAL*8 :: temp374b15 - REAL*8 :: temp386b12 - REAL*8 :: temp386b49 - REAL*8 :: temp388b83 - REAL*8 :: temp398 - REAL*8 :: temp404b11 - REAL*8 :: temp442 + DOUBLE PRECISION :: temp398 + DOUBLE PRECISION :: temp442 + REAL*8 :: temp448b8 REAL*8 :: temp455b0 REAL*8 :: temp479 REAL*8 :: temp480b + REAL*8 :: temp523 REAL*8 :: temp12 - REAL*8 :: temp43b4 + REAL*8 :: temp49b19 REAL*8 :: temp49 - REAL*8 :: temp53b23 - REAL*8 :: temp57b38 - REAL*8 :: temp58b8 - REAL*8 :: temp108 + REAL*8 :: temp50b17 + REAL*8 :: temp82b1 + REAL*8 :: temp81b + DOUBLE PRECISION :: temp108 + REAL*8 :: temp117b4 + REAL*8 :: temp131b31 + REAL*8 :: temp131b68 REAL*8 :: temp139b0 REAL*8 :: temp155b - REAL*8 :: temp156b1 - REAL*8 :: temp237b1 + DOUBLE PRECISION :: temp156b1 + REAL*8 :: temp190b3 + REAL*8 :: temp191b26 REAL*8 :: temp313b6 - REAL*8 :: temp315b28 + REAL*8 :: temp317b + REAL*8 :: temp318b1 REAL*8 :: temp335b2 - REAL*8 :: temp360 - REAL*8 :: temp373b42 - REAL*8 :: temp374b14 - REAL*8 :: temp386b11 - REAL*8 :: temp386b48 - REAL*8 :: temp388b82 - DOUBLE PRECISION :: temp391b0 - REAL*8 :: temp397 - REAL*8 :: temp404b10 + REAL*8 :: temp335b44 + REAL*8 :: temp340b20 + REAL*8 :: temp340b57 + DOUBLE PRECISION :: temp360 + DOUBLE PRECISION :: temp397 REAL*8 :: temp441 - REAL*8 :: temp472b0 + REAL*8 :: temp448b7 REAL*8 :: temp478 - REAL*8 :: temp11 - REAL*8 :: temp43b3 + REAL*8 :: temp522 + DOUBLE PRECISION :: temp11 REAL*8 :: temp48 - REAL*8 :: temp53b22 - REAL*8 :: temp57b37 - REAL*8 :: temp58b7 + REAL*8 :: temp49b18 + REAL*8 :: temp50b16 + REAL*8 :: temp82b0 REAL*8 :: temp107 - REAL*8 :: temp156b0 - REAL*8 :: temp237b0 + REAL*8 :: temp117b3 + REAL*8 :: temp131b30 + REAL*8 :: temp131b67 + DOUBLE PRECISION :: temp156b0 + REAL*8 :: temp163b + REAL*8 :: temp190b2 + REAL*8 :: temp191b25 + REAL*8 :: temp244b + REAL*8 :: temp243b18 REAL*8 :: temp313b5 - REAL*8 :: temp315b27 + REAL*8 :: temp318b0 + REAL*8 :: temp325b REAL*8 :: temp328b9 REAL*8 :: temp335b1 - REAL*8 :: temp373b41 - REAL*8 :: temp374b13 - REAL*8 :: temp386b10 - REAL*8 :: temp386b47 - REAL*8 :: temp387b19 - REAL*8 :: temp388b81 - DOUBLE PRECISION :: temp396 - REAL*8 :: temp406b + REAL*8 :: temp335b43 + REAL*8 :: temp340b56 + REAL*8 :: temp396 + REAL*8 :: temp431b19 REAL*8 :: temp440 + REAL*8 :: temp448b6 + REAL*8 :: temp448b93 REAL*8 :: temp477 REAL*8 :: temp487b3 - REAL*8 :: temp10 - REAL*8 :: temp43b2 - DOUBLE PRECISION :: temp47 - REAL*8 :: temp53b21 - REAL*8 :: temp57b36 - REAL*8 :: temp58b6 - REAL*8 :: temp106 - REAL*8 :: temp252b + REAL*8 :: temp521 + DOUBLE PRECISION :: temp10 + REAL*8 :: temp47 + REAL*8 :: temp49b17 + REAL*8 :: temp50b15 + DOUBLE PRECISION :: temp106 + REAL*8 :: temp117b2 + REAL*8 :: temp124b19 + REAL*8 :: temp131b66 + REAL*8 :: temp134b3 + REAL*8 :: temp171b + REAL*8 :: temp190b1 + REAL*8 :: temp191b24 + REAL*8 :: temp243b17 REAL*8 :: temp313b4 - REAL*8 :: temp315b26 REAL*8 :: temp328b8 REAL*8 :: temp333b REAL*8 :: temp335b0 - REAL*8 :: temp373b40 - REAL*8 :: temp374b12 - REAL*8 :: temp386b46 - REAL*8 :: temp387b18 - REAL*8 :: temp388b80 + REAL*8 :: temp335b42 + REAL*8 :: temp340b55 REAL*8 :: temp395 + REAL*8 :: temp416b0 REAL*8 :: temp414b + REAL*8 :: temp431b18 + REAL*8 :: temp448b5 + REAL*8 :: temp448b92 REAL*8 :: temp476 REAL*8 :: temp487b2 + REAL*8 :: tmp6b REAL*8 :: temp520 - REAL*8 :: temp43b1 - DOUBLE PRECISION :: temp46 - REAL*8 :: temp53b20 - REAL*8 :: temp57b35 - REAL*8 :: temp58b5 + REAL*8 :: temp15b + REAL*8 :: temp46 + REAL*8 :: temp49b16 + REAL*8 :: temp50b14 DOUBLE PRECISION :: temp105 - REAL*8 :: temp186b10 + REAL*8 :: temp117b1 + REAL*8 :: temp124b18 + REAL*8 :: temp131b65 + REAL*8 :: temp134b2 + REAL*8 :: temp190b0 + REAL*8 :: temp191b23 + REAL*8 :: temp243b16 REAL*8 :: temp260b - REAL*8 :: temp271b0 REAL*8 :: temp297b REAL*8 :: temp313b3 - REAL*8 :: temp315b25 REAL*8 :: temp328b7 + REAL*8 :: temp335b41 + REAL*8 :: temp340b54 REAL*8 :: temp341b - REAL*8 :: temp374b11 - REAL*8 :: temp378b - REAL*8 :: temp386b45 - REAL*8 :: temp387b17 - REAL*8 :: temp389b0 REAL*8 :: temp394 + DOUBLE PRECISION :: temp389b0 REAL*8 :: temp422b + REAL*8 :: temp431b17 + REAL*8 :: temp448b4 + REAL*8 :: temp448b91 REAL*8 :: temp459b REAL*8 :: temp475 REAL*8 :: temp487b1 - REAL*8 :: temp497b24 REAL*8 :: temp503b - REAL*8 :: temp9b REAL*8 :: temp23b REAL*8 :: temp43b0 - DOUBLE PRECISION :: temp45 - REAL*8 :: temp53b9 - REAL*8 :: temp57b34 - REAL*8 :: temp58b4 - DOUBLE PRECISION :: temp104 + INTEGER :: temp45 + REAL*8 :: temp49b15 + REAL*8 :: temp50b13 + REAL*8 :: temp104 + REAL*8 :: temp117b0 + REAL*8 :: temp124b17 + REAL*8 :: temp131b64 + REAL*8 :: temp134b1 + REAL*8 :: temp151b2 + REAL*8 :: temp191b22 + REAL*8 :: temp243b15 REAL*8 :: temp313b2 - REAL*8 :: temp315b24 REAL*8 :: temp328b6 - REAL*8 :: temp373b75 - REAL*8 :: temp374b10 + REAL*8 :: temp330b3 + REAL*8 :: temp335b40 + REAL*8 :: temp340b53 + REAL*8 :: temp345b7 + REAL*8 :: temp384b4 REAL*8 :: temp386b - REAL*8 :: temp386b44 - REAL*8 :: temp387b16 REAL*8 :: temp393 - REAL*8 :: temp404b43 - REAL*8 :: temp430b - REAL*8 :: temp450b0 + REAL*8 :: temp431b16 + REAL*8 :: temp448b3 + REAL*8 :: temp448b90 REAL*8 :: temp467b REAL*8 :: temp474 REAL*8 :: temp487b0 - REAL*8 :: temp497b9 - REAL*8 :: temp497b23 - REAL*8 :: temp511b REAL*8 :: temp31b - DOUBLE PRECISION :: temp44 - REAL*8 :: temp53b8 - REAL*8 :: temp57b33 - REAL*8 :: temp58b3 + REAL*8 :: temp44 + REAL*8 :: temp49b14 + REAL*8 :: temp50b12 + REAL*8 :: temp50b49 REAL*8 :: temp68b - DOUBLE PRECISION :: temp103 - REAL*8 :: temp188b1 + REAL*8 :: temp92b5 + REAL*8 :: temp103 + REAL*8 :: temp124b16 + REAL*8 :: temp131b63 + REAL*8 :: temp134b0 + REAL*8 :: temp151b1 + REAL*8 :: temp191b21 + REAL*8 :: temp225b9 + REAL*8 :: temp243b14 REAL*8 :: temp313b1 - REAL*8 :: temp315b23 REAL*8 :: temp328b5 REAL*8 :: temp330b2 - REAL*8 :: temp373b74 - REAL*8 :: temp386b43 - REAL*8 :: temp387b15 - REAL*8 :: temp392 - REAL*8 :: temp394b - REAL*8 :: temp404b42 + REAL*8 :: temp340b52 + REAL*8 :: temp345b6 + REAL*8 :: temp384b3 + DOUBLE PRECISION :: temp392 + REAL*8 :: temp431b15 REAL*8 :: temp448b2 REAL*8 :: temp473 REAL*8 :: temp475b - REAL*8 :: temp497b8 - REAL*8 :: temp497b22 REAL*8 :: temp43 - REAL*8 :: temp53b7 - REAL*8 :: temp57b32 - REAL*8 :: temp58b2 - DOUBLE PRECISION :: temp102 + REAL*8 :: temp49b13 + REAL*8 :: temp50b11 + REAL*8 :: temp50b48 + REAL*8 :: temp76b + REAL*8 :: temp92b4 + REAL*8 :: temp102 + REAL*8 :: temp124b15 + REAL*8 :: temp131b62 REAL*8 :: temp139 + REAL*8 :: temp151b0 REAL*8 :: temp188b0 + REAL*8 :: temp191b20 + REAL*8 :: temp225b8 + REAL*8 :: temp243b13 REAL*8 :: temp313b0 - REAL*8 :: temp315b22 REAL*8 :: temp328b4 REAL*8 :: temp330b1 - REAL*8 :: temp367b1 - REAL*8 :: temp373b73 - REAL*8 :: temp386b42 - REAL*8 :: temp387b14 - DOUBLE PRECISION :: temp391 - REAL*8 :: temp404b9 - REAL*8 :: temp404b41 + REAL*8 :: temp340b51 + REAL*8 :: temp345b5 + REAL*8 :: temp384b2 + REAL*8 :: temp391 + REAL*8 :: temp411b1 + REAL*8 :: temp431b14 REAL*8 :: temp448b1 - REAL*8 :: temp472 + DOUBLE PRECISION :: temp472 REAL*8 :: temp483b - REAL*8 :: temp497b7 - REAL*8 :: temp497b21 - REAL*8 :: temp42 - REAL*8 :: temp53b6 - REAL*8 :: temp57b31 + DOUBLE PRECISION :: temp42 + REAL*8 :: temp49b12 + REAL*8 :: temp50b10 + REAL*8 :: temp50b47 REAL*8 :: temp58b1 - DOUBLE PRECISION :: temp79 + REAL*8 :: temp79 REAL*8 :: temp92b3 DOUBLE PRECISION :: temp101 + REAL*8 :: temp124b14 + REAL*8 :: temp131b61 REAL*8 :: temp138 - REAL*8 :: temp202b REAL*8 :: temp219 + REAL*8 :: temp225b7 REAL*8 :: temp239b - REAL*8 :: temp315b21 + REAL*8 :: temp243b12 REAL*8 :: temp328b3 REAL*8 :: temp330b0 - REAL*8 :: temp367b0 - REAL*8 :: temp373b72 - REAL*8 :: temp380b29 - REAL*8 :: temp386b41 - REAL*8 :: temp387b13 - REAL*8 :: temp390 - REAL*8 :: temp404b8 - REAL*8 :: temp404b40 + REAL*8 :: temp340b9 + REAL*8 :: temp340b50 + REAL*8 :: temp345b4 + REAL*8 :: temp384b1 + DOUBLE PRECISION :: temp390 + REAL*8 :: temp411b0 + REAL*8 :: temp431b13 REAL*8 :: temp448b0 - REAL*8 :: temp465b1 - REAL*8 :: temp471 - REAL*8 :: temp491b + DOUBLE PRECISION :: temp471 REAL*8 :: temp497b6 - REAL*8 :: temp497b20 REAL*8 :: temp41 - REAL*8 :: temp53b5 - REAL*8 :: temp57b30 + REAL*8 :: temp49b11 + REAL*8 :: temp50b46 REAL*8 :: temp58b0 - REAL*8 :: temp68b9 - REAL*8 :: temp78 + REAL*8 :: temp75b1 + DOUBLE PRECISION :: temp78 REAL*8 :: temp92b REAL*8 :: temp92b2 - DOUBLE PRECISION :: temp100 - DOUBLE PRECISION :: temp112b1 + REAL*8 :: temp100 + REAL*8 :: temp124b13 + REAL*8 :: temp131b60 DOUBLE PRECISION :: temp137 - REAL*8 :: temp149b1 REAL*8 :: temp166b - REAL*8 :: temp166b2 - REAL*8 :: temp218 - REAL*8 :: temp247b - REAL*8 :: temp315b20 + REAL*8 :: temp183b3 + DOUBLE PRECISION :: temp218 + REAL*8 :: temp225b6 + REAL*8 :: temp243b11 + REAL*8 :: temp264b3 REAL*8 :: temp328b REAL*8 :: temp328b2 + REAL*8 :: temp340b8 REAL*8 :: temp345b3 - REAL*8 :: temp373b71 - REAL*8 :: temp380b28 - REAL*8 :: temp386b40 - REAL*8 :: temp387b12 - REAL*8 :: temp387b49 - REAL*8 :: temp404b7 + REAL*8 :: temp384b0 REAL*8 :: temp409b - REAL*8 :: temp465b0 - REAL*8 :: temp470 + REAL*8 :: temp421b8 + REAL*8 :: temp431b12 + DOUBLE PRECISION :: temp470 REAL*8 :: temp497b5 REAL*8 :: temp40 - REAL*8 :: temp53b4 - REAL*8 :: temp68b8 + REAL*8 :: temp49b10 + REAL*8 :: temp50b45 + REAL*8 :: temp75b0 REAL*8 :: temp77 REAL*8 :: temp92b1 - DOUBLE PRECISION :: temp112b0 - DOUBLE PRECISION :: temp136 + REAL*8 :: temp124b12 + REAL*8 :: temp136 REAL*8 :: temp149b0 - REAL*8 :: temp166b1 REAL*8 :: temp174b - REAL*8 :: temp217 + REAL*8 :: temp183b2 + DOUBLE PRECISION :: temp217 + REAL*8 :: temp225b5 + REAL*8 :: temp243b10 REAL*8 :: temp255b - REAL*8 :: temp281b3 + REAL*8 :: temp264b2 REAL*8 :: temp328b1 - REAL*8 :: temp328b25 - REAL*8 :: temp336b + REAL*8 :: temp340b7 REAL*8 :: temp345b2 - REAL*8 :: temp373b70 - REAL*8 :: temp379b29 - REAL*8 :: temp380b27 - REAL*8 :: temp387b11 - REAL*8 :: temp387b48 - REAL*8 :: temp404b6 REAL*8 :: temp417b + REAL*8 :: temp421b7 + REAL*8 :: temp431b11 REAL*8 :: temp497b4 - REAL*8 :: temp18b - REAL*8 :: temp53b3 - REAL*8 :: temp68b7 - DOUBLE PRECISION :: temp76 + REAL*8 :: temp31b7 + REAL*8 :: temp50b44 + REAL*8 :: temp76 REAL*8 :: temp92b0 - REAL*8 :: temp135 - REAL*8 :: temp166b0 + REAL*8 :: temp124b11 + DOUBLE PRECISION :: temp135 + REAL*8 :: temp182b + REAL*8 :: temp183b1 REAL*8 :: temp216 - REAL*8 :: temp247b0 + REAL*8 :: temp225b4 + REAL*8 :: temp242b5 + REAL*8 :: temp263b REAL*8 :: temp264b1 - REAL*8 :: temp281b2 REAL*8 :: temp328b0 - REAL*8 :: temp328b24 + REAL*8 :: temp340b6 REAL*8 :: temp344b REAL*8 :: temp345b1 - REAL*8 :: temp379b28 - REAL*8 :: temp380b26 - REAL*8 :: temp387b10 - REAL*8 :: temp387b47 - REAL*8 :: temp388b19 - REAL*8 :: temp404b5 - REAL*8 :: temp409b0 - REAL*8 :: temp425b + REAL*8 :: temp421b6 + REAL*8 :: temp431b10 REAL*8 :: temp497b3 - REAL*8 :: temp42b24 - REAL*8 :: temp53b2 - REAL*8 :: temp68b6 + REAL*8 :: temp506b + REAL*8 :: temp19b0 + REAL*8 :: temp31b6 + REAL*8 :: temp50b43 REAL*8 :: temp75 + REAL*8 :: temp124b10 REAL*8 :: temp134 + REAL*8 :: temp183b0 + REAL*8 :: temp190b + REAL*8 :: temp206b19 REAL*8 :: temp215 + REAL*8 :: temp225b3 + REAL*8 :: temp242b4 REAL*8 :: temp264b0 - REAL*8 :: temp271b - REAL*8 :: temp281b1 - REAL*8 :: temp328b23 + REAL*8 :: temp340b5 REAL*8 :: temp345b0 - REAL*8 :: temp379b27 - REAL*8 :: temp380b25 - REAL*8 :: temp387b46 - REAL*8 :: temp388b18 REAL*8 :: temp389b - REAL*8 :: temp404b4 + REAL*8 :: temp421b5 + REAL*8 :: temp443b1 REAL*8 :: temp497b2 + REAL*8 :: temp507b0 + REAL*8 :: temp31b5 REAL*8 :: temp34b - REAL*8 :: temp42b23 - REAL*8 :: temp53b1 - REAL*8 :: temp68b5 + REAL*8 :: temp50b42 REAL*8 :: temp74 - DOUBLE PRECISION :: temp133 + REAL*8 :: temp133 + REAL*8 :: temp206b18 DOUBLE PRECISION :: temp214 + REAL*8 :: temp220b7 + REAL*8 :: temp225b2 + REAL*8 :: temp242b3 REAL*8 :: temp281b0 - REAL*8 :: temp328b22 - REAL*8 :: temp360b - REAL*8 :: temp379b26 - REAL*8 :: temp380b24 - REAL*8 :: temp387b45 - REAL*8 :: temp388b17 - REAL*8 :: temp397b - REAL*8 :: temp404b3 + REAL*8 :: temp340b4 + DOUBLE PRECISION :: temp397b + REAL*8 :: temp421b4 REAL*8 :: temp441b + REAL*8 :: temp443b0 + REAL*8 :: temp448b29 + REAL*8 :: temp460b1 + REAL*8 :: temp475b5 REAL*8 :: temp478b REAL*8 :: temp497b1 + REAL*8 :: temp522b + REAL*8 :: temp31b4 REAL*8 :: temp42b - REAL*8 :: temp42b22 - REAL*8 :: temp53b0 - REAL*8 :: temp68b4 - DOUBLE PRECISION :: temp73 + REAL*8 :: temp50b41 + REAL*8 :: temp73 REAL*8 :: temp79b - DOUBLE PRECISION :: temp132 - DOUBLE PRECISION :: temp169 + REAL*8 :: temp116b + REAL*8 :: temp132 + REAL*8 :: temp169 + REAL*8 :: temp191b50 + REAL*8 :: temp206b17 DOUBLE PRECISION :: temp213 - REAL*8 :: temp328b21 - REAL*8 :: temp379b25 - REAL*8 :: temp380b23 - REAL*8 :: temp387b44 - REAL*8 :: temp388b16 - REAL*8 :: temp404b2 + REAL*8 :: temp220b6 + REAL*8 :: temp225b1 + REAL*8 :: temp242b2 + REAL*8 :: temp323b2 + REAL*8 :: temp340b3 + REAL*8 :: temp421b3 + REAL*8 :: temp432b16 + REAL*8 :: temp448b28 + REAL*8 :: temp460b0 REAL*8 :: temp475b4 REAL*8 :: temp486b REAL*8 :: temp497b0 - REAL*8 :: temp517b7 - REAL*8 :: temp5b0 - REAL*8 :: temp42b21 + REAL*8 :: temp31b3 REAL*8 :: temp50b - REAL*8 :: temp68b3 - DOUBLE PRECISION :: temp72 - REAL*8 :: temp87b - DOUBLE PRECISION :: temp131 - DOUBLE PRECISION :: temp168 + REAL*8 :: temp50b40 + REAL*8 :: temp70b0 + REAL*8 :: temp72 + REAL*8 :: temp124b + REAL*8 :: temp131 + REAL*8 :: temp168 + REAL*8 :: temp205b + REAL*8 :: temp206b16 REAL*8 :: temp212 - DOUBLE PRECISION :: temp249 - REAL*8 :: temp328b20 - REAL*8 :: temp379b24 - REAL*8 :: temp380b22 - REAL*8 :: temp380b59 - REAL*8 :: temp387b43 - REAL*8 :: temp388b15 - REAL*8 :: temp394b3 + REAL*8 :: temp220b5 + REAL*8 :: temp225b0 + REAL*8 :: temp242b1 + REAL*8 :: temp249 + REAL*8 :: temp323b1 + REAL*8 :: temp340b2 REAL*8 :: temp404b1 + REAL*8 :: temp421b2 + REAL*8 :: temp432b15 + REAL*8 :: temp448b27 REAL*8 :: temp475b3 - REAL*8 :: temp494b - REAL*8 :: temp517b6 REAL*8 :: tempb - REAL*8 :: temp42b20 - REAL*8 :: temp68b2 - DOUBLE PRECISION :: temp71 - DOUBLE PRECISION :: temp130 - DOUBLE PRECISION :: temp167 - REAL*8 :: temp176b4 + REAL*8 :: temp31b2 + REAL*8 :: temp71 + REAL*8 :: temp95b + REAL*8 :: temp130 + REAL*8 :: temp132b + REAL*8 :: temp167 + REAL*8 :: temp169b + REAL*8 :: temp198b0 + REAL*8 :: temp206b15 REAL*8 :: temp211 - REAL*8 :: temp203b3 + REAL*8 :: temp220b4 REAL*8 :: temp242b0 - DOUBLE PRECISION :: temp248 + REAL*8 :: temp248 + REAL*8 :: temp279b0 + REAL*8 :: temp323b0 REAL*8 :: temp329 - REAL*8 :: temp379b23 - REAL*8 :: temp380b21 - REAL*8 :: temp380b58 - REAL*8 :: temp387b42 - REAL*8 :: temp388b14 - REAL*8 :: temp394b2 + REAL*8 :: temp340b1 REAL*8 :: temp404b0 + REAL*8 :: temp421b1 + REAL*8 :: temp432b14 + REAL*8 :: temp448b26 REAL*8 :: temp475b2 - REAL*8 :: temp492b3 - REAL*8 :: temp517b5 - REAL*8 :: temp14b0 - REAL*8 :: temp68b1 + REAL*8 :: temp31b1 REAL*8 :: temp70 + REAL*8 :: temp137b6 REAL*8 :: temp140b - DOUBLE PRECISION :: temp166 - REAL*8 :: temp176b3 + REAL*8 :: temp166 REAL*8 :: temp177b + REAL*8 :: temp206b14 DOUBLE PRECISION :: temp210 - REAL*8 :: temp203b2 + REAL*8 :: temp220b3 REAL*8 :: temp221b - REAL*8 :: temp247 - DOUBLE PRECISION :: temp258b + DOUBLE PRECISION :: temp247 + REAL*8 :: temp257b3 REAL*8 :: temp302b - REAL*8 :: temp316b7 - DOUBLE PRECISION :: temp328 - REAL*8 :: temp338b3 + REAL*8 :: temp328 + REAL*8 :: temp339b REAL*8 :: temp340b0 - REAL*8 :: temp379b22 - REAL*8 :: temp379b59 - REAL*8 :: temp380b20 - REAL*8 :: temp380b57 - REAL*8 :: temp387b9 - REAL*8 :: temp387b41 - REAL*8 :: temp388b13 - REAL*8 :: temp394b1 REAL*8 :: temp409 REAL*8 :: temp421b0 + REAL*8 :: temp431b9 + REAL*8 :: temp432b13 + REAL*8 :: temp448b25 REAL*8 :: temp475b1 - REAL*8 :: temp492b2 - REAL*8 :: temp517b4 + REAL*8 :: temp499b29 REAL*8 :: temp31b0 REAL*8 :: temp68b0 + REAL*8 :: temp137b5 + REAL*8 :: temp155b29 REAL*8 :: temp165 - REAL*8 :: temp176b2 - REAL*8 :: temp203b1 - REAL*8 :: temp246 - REAL*8 :: temp310b - REAL*8 :: temp316b6 - REAL*8 :: temp321b33 - DOUBLE PRECISION :: temp327 - REAL*8 :: temp338b2 - REAL*8 :: temp347b - REAL*8 :: temp379b21 - REAL*8 :: temp379b58 - REAL*8 :: temp380b56 - REAL*8 :: temp387b8 - REAL*8 :: temp387b40 - REAL*8 :: temp388b12 - REAL*8 :: temp388b49 - REAL*8 :: temp394b0 - REAL*8 :: temp408 + REAL*8 :: temp185b + REAL*8 :: temp206b13 + REAL*8 :: temp220b2 + DOUBLE PRECISION :: temp246 + REAL*8 :: temp253b39 + REAL*8 :: temp257b2 + REAL*8 :: temp301b2 + REAL*8 :: temp327 + REAL*8 :: temp372b4 + DOUBLE PRECISION :: temp408 REAL*8 :: temp428b + REAL*8 :: temp431b8 + REAL*8 :: temp432b12 + REAL*8 :: temp448b24 REAL*8 :: temp475b0 REAL*8 :: temp485b9 - REAL*8 :: temp492b1 + REAL*8 :: temp499b28 REAL*8 :: temp509b - REAL*8 :: temp517b3 - REAL*8 :: temp29b - REAL*8 :: temp68b29 - DOUBLE PRECISION :: temp100b4 + REAL*8 :: temp137b4 + REAL*8 :: temp155b28 REAL*8 :: temp164 - REAL*8 :: temp176b1 - REAL*8 :: temp203b0 - REAL*8 :: temp245 - REAL*8 :: temp316b5 - REAL*8 :: temp321b32 - DOUBLE PRECISION :: temp326 - REAL*8 :: temp338b1 + REAL*8 :: temp206b12 + REAL*8 :: temp220b1 + DOUBLE PRECISION :: temp245 + REAL*8 :: temp253b38 + REAL*8 :: temp257b1 + REAL*8 :: temp301b1 + REAL*8 :: temp326 REAL*8 :: temp355b - REAL*8 :: temp379b20 - REAL*8 :: temp379b57 - REAL*8 :: temp380b55 - REAL*8 :: temp387b7 - REAL*8 :: temp388b11 - REAL*8 :: temp388b48 + REAL*8 :: temp372b3 REAL*8 :: temp407 - REAL*8 :: temp436b + REAL*8 :: temp431b7 + REAL*8 :: temp432b11 + REAL*8 :: temp448b23 REAL*8 :: temp485b8 REAL*8 :: temp492b0 - REAL*8 :: temp517b - REAL*8 :: temp517b2 + REAL*8 :: temp499b27 REAL*8 :: temp0b0 - REAL*8 :: temp68b28 - DOUBLE PRECISION :: temp100b3 - DOUBLE PRECISION :: temp163 + REAL*8 :: temp37b + REAL*8 :: temp137b3 + REAL*8 :: temp155b27 + REAL*8 :: temp163 REAL*8 :: temp176b0 - REAL*8 :: temp186b9 - REAL*8 :: temp244 - REAL*8 :: temp282b - REAL*8 :: temp316b4 - REAL*8 :: temp321b31 - DOUBLE PRECISION :: temp325 + REAL*8 :: temp206b11 + REAL*8 :: temp220b0 + DOUBLE PRECISION :: temp244 + REAL*8 :: temp253b37 + REAL*8 :: temp257b0 + REAL*8 :: temp301b0 + REAL*8 :: temp325 REAL*8 :: temp338b0 REAL*8 :: temp355b1 - REAL*8 :: temp363b - REAL*8 :: temp379b56 - REAL*8 :: temp380b54 - REAL*8 :: temp387b6 - REAL*8 :: temp388b10 - REAL*8 :: temp388b47 + REAL*8 :: temp372b2 REAL*8 :: temp406 + REAL*8 :: temp431b6 + REAL*8 :: temp432b10 + DOUBLE PRECISION :: temp444b + REAL*8 :: temp448b22 + REAL*8 :: temp448b59 REAL*8 :: temp485b7 - REAL*8 :: temp517b1 - REAL*8 :: temp29b0 - REAL*8 :: temp68b27 - DOUBLE PRECISION :: temp100b2 - REAL*8 :: temp119b - DOUBLE PRECISION :: temp162 - REAL*8 :: temp186b8 - DOUBLE PRECISION :: temp199 - REAL*8 :: temp218b2 + REAL*8 :: temp499b26 + REAL*8 :: temp525b + REAL*8 :: temp45b + REAL*8 :: temp137b2 + REAL*8 :: temp155b26 + REAL*8 :: temp162 + REAL*8 :: temp197b39 + REAL*8 :: temp199 + REAL*8 :: temp206b10 + DOUBLE PRECISION :: temp224b29 REAL*8 :: temp243 - REAL*8 :: temp316b3 - REAL*8 :: temp321b30 - DOUBLE PRECISION :: temp324 + REAL*8 :: temp253b36 + REAL*8 :: temp290b + REAL*8 :: temp311b8 + REAL*8 :: temp324 REAL*8 :: temp355b0 - REAL*8 :: temp379b55 - REAL*8 :: temp380b53 - REAL*8 :: temp387b5 - REAL*8 :: temp388b46 + REAL*8 :: temp371b + REAL*8 :: temp372b1 REAL*8 :: temp405 + REAL*8 :: temp431b5 + REAL*8 :: temp448b21 + REAL*8 :: temp448b58 + REAL*8 :: temp452b + REAL*8 :: temp453b1 REAL*8 :: temp485b6 - REAL*8 :: temp489b - REAL*8 :: temp496b19 - REAL*8 :: temp517b0 - REAL*8 :: temp39b8 - REAL*8 :: temp46b0 - REAL*8 :: temp53b - REAL*8 :: temp68b26 - REAL*8 :: temp100b1 + REAL*8 :: temp499b25 + REAL*8 :: temp2b + REAL*8 :: temp8b39 + REAL*8 :: temp127b + REAL*8 :: temp137b1 + REAL*8 :: temp155b25 REAL*8 :: temp161 - REAL*8 :: temp186b7 + REAL*8 :: temp197b38 REAL*8 :: temp198 - REAL*8 :: temp218b1 + REAL*8 :: temp224b28 REAL*8 :: temp242 - DOUBLE PRECISION :: temp279 - REAL*8 :: temp316b2 - DOUBLE PRECISION :: temp323 - REAL*8 :: temp379b54 - REAL*8 :: temp380b52 - REAL*8 :: temp387b4 - REAL*8 :: temp388b45 - REAL*8 :: temp404 + REAL*8 :: temp253b35 + REAL*8 :: temp279 + REAL*8 :: temp311b7 + REAL*8 :: temp323 + REAL*8 :: temp372b0 + DOUBLE PRECISION :: temp404 + REAL*8 :: temp431b4 + REAL*8 :: temp448b20 + REAL*8 :: temp448b57 REAL*8 :: temp453b0 - REAL*8 :: temp474b21 + REAL*8 :: temp460b + REAL*8 :: temp468b4 REAL*8 :: temp485b5 - REAL*8 :: temp496b18 REAL*8 :: temp497b - REAL*8 :: temp39b7 - REAL*8 :: temp61b - REAL*8 :: temp68b25 - REAL*8 :: temp100b0 + REAL*8 :: temp499b24 + REAL*8 :: temp8b9 + REAL*8 :: temp8b38 + REAL*8 :: temp24b3 + REAL*8 :: temp135b + REAL*8 :: temp137b0 + REAL*8 :: temp154b1 + REAL*8 :: temp155b24 REAL*8 :: temp160 - REAL*8 :: temp186b6 - REAL*8 :: temp197 - REAL*8 :: temp216b - REAL*8 :: temp218b0 - REAL*8 :: temp235b1 + REAL*8 :: temp197b37 + DOUBLE PRECISION :: temp197 + REAL*8 :: temp224b27 REAL*8 :: temp241 + REAL*8 :: temp253b34 REAL*8 :: temp278 - REAL*8 :: temp316b1 - DOUBLE PRECISION :: temp322 + REAL*8 :: temp311b6 + REAL*8 :: temp322 + REAL*8 :: temp340b19 DOUBLE PRECISION :: temp359 - REAL*8 :: temp379b53 - REAL*8 :: temp380b51 - REAL*8 :: temp387b3 - REAL*8 :: temp388b44 DOUBLE PRECISION :: temp403 - REAL*8 :: temp470b0 - REAL*8 :: temp474b20 + REAL*8 :: temp431b3 + REAL*8 :: temp448b56 + REAL*8 :: temp468b3 REAL*8 :: temp485b4 - REAL*8 :: temp496b17 - REAL*8 :: temp39b6 - REAL*8 :: temp68b24 + REAL*8 :: temp499b23 + REAL*8 :: temp8b8 + REAL*8 :: temp8b37 + REAL*8 :: temp24b2 + REAL*8 :: temp95b4 + REAL*8 :: temp131b29 + REAL*8 :: temp143b REAL*8 :: temp154b0 - REAL*8 :: temp186b5 + REAL*8 :: temp155b23 DOUBLE PRECISION :: temp196 + REAL*8 :: temp197b36 REAL*8 :: temp224b + REAL*8 :: temp224b26 REAL*8 :: temp235b0 REAL*8 :: temp240 + REAL*8 :: temp253b33 REAL*8 :: temp277 - REAL*8 :: temp316b0 - REAL*8 :: temp321 - REAL*8 :: temp333b1 + REAL*8 :: temp311b5 + DOUBLE PRECISION :: temp321 + REAL*8 :: temp340b18 DOUBLE PRECISION :: temp358 - REAL*8 :: temp379b52 - REAL*8 :: temp380b50 - REAL*8 :: temp387b2 - REAL*8 :: temp388b43 - REAL*8 :: temp402 - REAL*8 :: temp414b1 - REAL*8 :: temp439 + DOUBLE PRECISION :: temp402 + REAL*8 :: temp431b2 + DOUBLE PRECISION :: temp439 + REAL*8 :: temp448b55 + REAL*8 :: temp468b2 REAL*8 :: temp485b3 - REAL*8 :: temp496b16 - REAL*8 :: temp39b5 - REAL*8 :: temp68b23 + REAL*8 :: temp499b22 + REAL*8 :: temp8b7 + REAL*8 :: temp8b36 + REAL*8 :: temp24b1 + REAL*8 :: temp95b3 + REAL*8 :: temp131b28 + REAL*8 :: temp132b3 REAL*8 :: temp151b - REAL*8 :: temp164b8 - REAL*8 :: temp186b4 + REAL*8 :: temp155b22 + REAL*8 :: temp171b0 REAL*8 :: temp188b DOUBLE PRECISION :: temp195 - REAL*8 :: temp232b - REAL*8 :: temp269b - DOUBLE PRECISION :: temp252b0 - DOUBLE PRECISION :: temp276 + REAL*8 :: temp197b35 + REAL*8 :: temp224b25 + REAL*8 :: temp253b32 + REAL*8 :: temp276 + REAL*8 :: temp311b4 REAL*8 :: temp313b REAL*8 :: temp320 REAL*8 :: temp333b0 + REAL*8 :: temp340b17 DOUBLE PRECISION :: temp357 - REAL*8 :: temp373b39 - REAL*8 :: temp379b51 - REAL*8 :: temp387b1 - REAL*8 :: temp388b42 - REAL*8 :: temp388b79 REAL*8 :: temp401 - REAL*8 :: temp414b0 - REAL*8 :: temp438 + REAL*8 :: temp431b1 + DOUBLE PRECISION :: temp438 + REAL*8 :: temp448b54 + REAL*8 :: temp463b6 + REAL*8 :: temp468b1 REAL*8 :: temp485b2 - REAL*8 :: temp496b15 + REAL*8 :: temp499b21 + REAL*8 :: temp512b1 REAL*8 :: temp519 + REAL*8 :: temp8b6 + REAL*8 :: temp8b35 REAL*8 :: temp24b0 - REAL*8 :: temp39b4 - REAL*8 :: temp53b19 - REAL*8 :: temp68b22 - REAL*8 :: temp164b7 - REAL*8 :: temp186b3 - REAL*8 :: temp194 + REAL*8 :: temp73b6 + REAL*8 :: temp95b2 + REAL*8 :: temp115b1 + REAL*8 :: temp131b27 + REAL*8 :: temp132b2 + REAL*8 :: temp155b21 + DOUBLE PRECISION :: temp194 + REAL*8 :: temp197b34 + REAL*8 :: temp224b24 REAL*8 :: temp240b + REAL*8 :: temp253b31 DOUBLE PRECISION :: temp275 + REAL*8 :: temp277b + REAL*8 :: temp311b3 REAL*8 :: temp321b - REAL*8 :: temp322b34 - REAL*8 :: temp348b3 - REAL*8 :: temp350b0 + REAL*8 :: temp340b16 DOUBLE PRECISION :: temp356 - REAL*8 :: temp358b - REAL*8 :: temp373b38 - REAL*8 :: temp379b50 REAL*8 :: temp387b0 - REAL*8 :: temp388b41 - REAL*8 :: temp388b78 - REAL*8 :: temp400 - REAL*8 :: temp402b + DOUBLE PRECISION :: temp400 + REAL*8 :: temp431b0 REAL*8 :: temp437 - REAL*8 :: temp439b - REAL*8 :: temp478b9 + REAL*8 :: temp448b53 + REAL*8 :: temp463b5 + REAL*8 :: temp468b0 REAL*8 :: temp485b1 - REAL*8 :: temp496b14 + REAL*8 :: temp499b20 REAL*8 :: temp512b0 REAL*8 :: temp518 - REAL*8 :: temp39b3 - REAL*8 :: temp53b18 - REAL*8 :: temp68b21 - REAL*8 :: temp78b0 - REAL*8 :: temp164b6 - REAL*8 :: temp186b2 - REAL*8 :: temp193 + REAL*8 :: temp522b9 + REAL*8 :: temp8b5 + REAL*8 :: temp8b34 + REAL*8 :: temp73b5 + REAL*8 :: temp95b1 + REAL*8 :: temp115b0 + REAL*8 :: temp131b26 + REAL*8 :: temp132b1 + REAL*8 :: temp155b20 + REAL*8 :: temp181b7 + DOUBLE PRECISION :: temp193 + REAL*8 :: temp197b33 + REAL*8 :: temp206b9 + REAL*8 :: temp224b23 + REAL*8 :: temp253b30 DOUBLE PRECISION :: temp274 - REAL*8 :: temp309b5 - REAL*8 :: temp322b33 - REAL*8 :: temp348b2 + REAL*8 :: temp285b + REAL*8 :: temp311b2 + REAL*8 :: temp335b39 + REAL*8 :: temp340b15 REAL*8 :: temp355 - REAL*8 :: temp366b - REAL*8 :: temp373b37 - REAL*8 :: temp388b40 - REAL*8 :: temp388b77 - REAL*8 :: temp410b REAL*8 :: temp436 REAL*8 :: temp447b - REAL*8 :: temp478b8 + REAL*8 :: temp446b3 + REAL*8 :: temp448b52 + REAL*8 :: temp448b89 + REAL*8 :: temp463b4 REAL*8 :: temp485b0 - REAL*8 :: temp496b13 - INTEGER :: temp517 - REAL*8 :: temp39b2 + REAL*8 :: tmp2b + DOUBLE PRECISION :: temp517 + REAL*8 :: temp522b8 + REAL*8 :: temp3b9 + REAL*8 :: temp8b4 + REAL*8 :: temp8b33 REAL*8 :: temp48b - REAL*8 :: temp53b17 - REAL*8 :: temp68b20 - REAL*8 :: temp164b5 - REAL*8 :: temp186b1 + REAL*8 :: temp56b3 + REAL*8 :: temp73b4 + REAL*8 :: temp95b0 + REAL*8 :: temp131b25 + REAL*8 :: temp132b0 + REAL*8 :: temp169b0 + REAL*8 :: temp181b6 DOUBLE PRECISION :: temp192 - DOUBLE PRECISION :: temp273 - REAL*8 :: temp309b4 - REAL*8 :: temp322b32 - REAL*8 :: temp348b1 + REAL*8 :: temp197b32 + REAL*8 :: temp206b8 + REAL*8 :: temp224b22 + REAL*8 :: temp273 + REAL*8 :: temp311b1 + REAL*8 :: temp335b38 + REAL*8 :: temp340b14 + REAL*8 :: temp343b6 REAL*8 :: temp354 - REAL*8 :: temp373b36 - REAL*8 :: temp374b - REAL*8 :: temp388b76 - REAL*8 :: temp429b1 - REAL*8 :: temp435 + DOUBLE PRECISION :: temp435 + REAL*8 :: temp446b2 + REAL*8 :: temp448b51 + REAL*8 :: temp448b88 REAL*8 :: temp455b - REAL*8 :: temp478b7 - REAL*8 :: temp480b4 - REAL*8 :: temp496b12 + REAL*8 :: temp463b3 REAL*8 :: temp516 + REAL*8 :: temp522b7 + REAL*8 :: temp3b8 REAL*8 :: temp5b - REAL*8 :: temp39b1 - REAL*8 :: temp53b16 + REAL*8 :: temp8b3 + REAL*8 :: temp8b32 + REAL*8 :: temp56b + REAL*8 :: temp56b2 + REAL*8 :: temp73b3 + REAL*8 :: temp131b24 REAL*8 :: temp164b4 - REAL*8 :: temp186b0 + REAL*8 :: temp181b5 + REAL*8 :: temp190b10 + REAL*8 :: temp191b19 DOUBLE PRECISION :: temp191 + REAL*8 :: temp197b31 + REAL*8 :: temp206b7 + REAL*8 :: temp224b21 + REAL*8 :: temp228b3 REAL*8 :: temp272 - REAL*8 :: temp309b3 - REAL*8 :: temp321b9 - REAL*8 :: temp322b31 - REAL*8 :: temp348b0 - DOUBLE PRECISION :: temp353 - REAL*8 :: temp373b35 - REAL*8 :: temp388b75 - REAL*8 :: temp397b6 - REAL*8 :: temp429b0 - REAL*8 :: temp434 + REAL*8 :: temp277b9 + REAL*8 :: temp311b0 + REAL*8 :: temp335b37 + REAL*8 :: temp340b13 + REAL*8 :: temp343b5 + REAL*8 :: temp353 + REAL*8 :: temp382b + REAL*8 :: temp382b2 + DOUBLE PRECISION :: temp434 + REAL*8 :: temp446b1 + REAL*8 :: temp448b50 + REAL*8 :: temp448b87 REAL*8 :: temp463b - REAL*8 :: temp478b6 - REAL*8 :: temp480b3 - REAL*8 :: temp496b11 + REAL*8 :: temp463b2 REAL*8 :: temp515 - REAL*8 :: temp39b0 - REAL*8 :: temp53b15 - REAL*8 :: temp64b - REAL*8 :: temp68b55 - REAL*8 :: temp138b + REAL*8 :: temp522b6 + REAL*8 :: temp3b7 + REAL*8 :: temp8b2 + REAL*8 :: temp8b31 + REAL*8 :: temp34b5 + REAL*8 :: temp49b9 + REAL*8 :: temp56b1 + REAL*8 :: temp73b2 + REAL*8 :: temp101b + REAL*8 :: temp131b23 REAL*8 :: temp164b3 - DOUBLE PRECISION :: temp190 - REAL*8 :: temp219b - REAL*8 :: temp271 - REAL*8 :: temp309b2 - REAL*8 :: temp321b8 - REAL*8 :: temp322b30 + REAL*8 :: temp181b4 + REAL*8 :: temp190 + REAL*8 :: temp191b18 + REAL*8 :: temp197b30 + REAL*8 :: temp206b6 + REAL*8 :: temp224b20 + REAL*8 :: temp228b2 + DOUBLE PRECISION :: temp271 + REAL*8 :: temp277b8 + REAL*8 :: temp335b36 + REAL*8 :: temp340b12 + REAL*8 :: temp340b49 + REAL*8 :: temp343b4 DOUBLE PRECISION :: temp352 - REAL*8 :: temp373b34 - REAL*8 :: temp388b74 - REAL*8 :: temp389 - REAL*8 :: temp390b - REAL*8 :: temp397b5 - REAL*8 :: temp404b39 - REAL*8 :: temp433 + REAL*8 :: temp382b1 + DOUBLE PRECISION :: temp389 + DOUBLE PRECISION :: temp390b + DOUBLE PRECISION :: temp433 REAL*8 :: temp446b0 - REAL*8 :: temp471b - REAL*8 :: temp478b5 - REAL*8 :: temp480b2 - REAL*8 :: temp496b10 - REAL*8 :: temp497b19 - REAL*8 :: temp514 - REAL*8 :: temp53b14 - REAL*8 :: temp57b29 - REAL*8 :: temp68b54 + REAL*8 :: temp448b86 + REAL*8 :: temp463b1 + DOUBLE PRECISION :: temp514 + REAL*8 :: temp522b5 + REAL*8 :: temp3b6 + REAL*8 :: temp8b1 + REAL*8 :: temp8b30 + REAL*8 :: temp34b4 + REAL*8 :: temp49b8 + REAL*8 :: temp56b0 + REAL*8 :: temp72b + REAL*8 :: temp73b1 + REAL*8 :: temp131b22 + REAL*8 :: temp131b59 REAL*8 :: temp146b REAL*8 :: temp164b2 + REAL*8 :: temp181b3 + REAL*8 :: temp191b17 + REAL*8 :: temp206b5 REAL*8 :: temp227b - REAL*8 :: temp270 - REAL*8 :: temp309b1 - REAL*8 :: temp315b19 - REAL*8 :: temp321b7 + REAL*8 :: temp228b1 + DOUBLE PRECISION :: temp270 + REAL*8 :: temp277b7 + REAL*8 :: temp335b35 + REAL*8 :: temp340b11 + REAL*8 :: temp340b48 + REAL*8 :: temp343b3 DOUBLE PRECISION :: temp351 - REAL*8 :: temp373b33 - REAL*8 :: temp386b39 - REAL*8 :: temp388b73 - REAL*8 :: temp388 - REAL*8 :: temp397b4 - REAL*8 :: temp404b38 - REAL*8 :: temp432 + REAL*8 :: temp382b0 + DOUBLE PRECISION :: temp388 + DOUBLE PRECISION :: temp432 + REAL*8 :: temp448b85 REAL*8 :: temp463b0 - REAL*8 :: temp469 - REAL*8 :: temp478b4 - REAL*8 :: temp480b1 - REAL*8 :: temp497b18 - INTEGER :: temp513 - REAL*8 :: temp39 - REAL*8 :: temp53b13 - REAL*8 :: temp57b28 - REAL*8 :: temp68b53 - REAL*8 :: temp147b0 + DOUBLE PRECISION :: temp469 + DOUBLE PRECISION :: temp513 + REAL*8 :: temp522b4 + REAL*8 :: temp3b5 + REAL*8 :: temp8b0 + REAL*8 :: temp34b3 + DOUBLE PRECISION :: temp39 + REAL*8 :: temp49b7 + REAL*8 :: temp66b8 + REAL*8 :: temp73b0 + REAL*8 :: temp80b + REAL*8 :: temp83b9 + REAL*8 :: temp110b0 + REAL*8 :: temp131b21 + REAL*8 :: temp131b58 REAL*8 :: temp154b REAL*8 :: temp164b1 + REAL*8 :: temp181b2 + REAL*8 :: temp191b16 + REAL*8 :: temp206b4 + REAL*8 :: temp228b0 REAL*8 :: temp235b - REAL*8 :: temp309b0 - REAL*8 :: temp315b18 + REAL*8 :: temp277b6 REAL*8 :: temp316b - REAL*8 :: temp321b6 - DOUBLE PRECISION :: temp350 - REAL*8 :: temp373b32 - REAL*8 :: temp373b69 - REAL*8 :: temp386b38 + REAL*8 :: temp335b34 + REAL*8 :: temp340b10 + REAL*8 :: temp340b47 + REAL*8 :: temp343b2 + REAL*8 :: temp350 REAL*8 :: temp387 - REAL*8 :: temp388b72 - REAL*8 :: temp397b3 - REAL*8 :: temp404b37 REAL*8 :: temp431 + REAL*8 :: temp448b84 REAL*8 :: temp468 - REAL*8 :: temp478b3 REAL*8 :: temp480b0 - REAL*8 :: temp490b9 - REAL*8 :: temp497b17 - REAL*8 :: temp512 + DOUBLE PRECISION :: temp512 + REAL*8 :: temp522b3 + REAL*8 :: temp3b4 + REAL*8 :: temp34b2 REAL*8 :: temp38 - REAL*8 :: temp53b12 - REAL*8 :: temp57b27 - REAL*8 :: temp68b52 + REAL*8 :: temp49b6 + REAL*8 :: temp66b7 + REAL*8 :: temp83b8 + REAL*8 :: temp131b20 + REAL*8 :: temp131b57 + REAL*8 :: temp162b REAL*8 :: temp164b0 + REAL*8 :: temp181b1 + REAL*8 :: temp191b15 + REAL*8 :: temp199b + REAL*8 :: temp206b3 REAL*8 :: temp243b - REAL*8 :: temp299b1 - REAL*8 :: temp315b17 - REAL*8 :: temp321b5 - REAL*8 :: temp373b31 - REAL*8 :: temp373b68 - REAL*8 :: temp386b37 + REAL*8 :: temp277b5 + REAL*8 :: temp324b + REAL*8 :: temp326b0 + REAL*8 :: temp335b33 + REAL*8 :: temp340b46 + REAL*8 :: temp343b1 REAL*8 :: temp386 - REAL*8 :: temp388b71 - REAL*8 :: temp397b2 - REAL*8 :: temp404b36 REAL*8 :: temp405b REAL*8 :: temp430 + REAL*8 :: temp448b83 REAL*8 :: temp467 - REAL*8 :: temp478b2 - REAL*8 :: temp490b8 - REAL*8 :: temp497b16 - REAL*8 :: temp505b1 REAL*8 :: temp511 + REAL*8 :: temp522b2 + REAL*8 :: temp3b3 REAL*8 :: temp17b0 + REAL*8 :: temp34b1 REAL*8 :: temp37 - REAL*8 :: temp53b11 - REAL*8 :: temp57b26 - REAL*8 :: temp68b51 - REAL*8 :: temp174b8 + REAL*8 :: temp49b5 + REAL*8 :: temp66b6 + REAL*8 :: temp83b7 + REAL*8 :: temp131b56 + REAL*8 :: temp170b + REAL*8 :: temp181b0 + REAL*8 :: temp191b9 + REAL*8 :: temp191b14 + REAL*8 :: temp201b7 + REAL*8 :: temp206b2 REAL*8 :: temp251b + REAL*8 :: temp277b4 + REAL*8 :: temp288b REAL*8 :: temp299b0 - REAL*8 :: temp315b16 - REAL*8 :: temp321b4 + REAL*8 :: temp319b7 REAL*8 :: temp332b - REAL*8 :: temp369b - REAL*8 :: temp373b30 - REAL*8 :: temp373b67 - DOUBLE PRECISION :: temp385 - REAL*8 :: temp386b36 - REAL*8 :: temp388b70 - REAL*8 :: temp397b1 - REAL*8 :: temp404b35 + REAL*8 :: temp335b32 + REAL*8 :: temp340b45 + REAL*8 :: temp343b0 + REAL*8 :: temp353b9 + REAL*8 :: temp385 REAL*8 :: temp413b REAL*8 :: temp424b0 - REAL*8 :: temp466 - REAL*8 :: temp478b1 - REAL*8 :: temp490b7 - REAL*8 :: temp497b15 + REAL*8 :: temp441b1 + REAL*8 :: temp448b82 + DOUBLE PRECISION :: temp466 + REAL*8 :: tmp5b REAL*8 :: temp505b0 REAL*8 :: temp510 - REAL*8 :: temp14b + REAL*8 :: temp522b1 + REAL*8 :: temp3b2 + REAL*8 :: temp34b0 REAL*8 :: temp36 - REAL*8 :: temp53b10 - REAL*8 :: temp57b25 - REAL*8 :: temp68b50 - REAL*8 :: temp174b7 - REAL*8 :: temp315b15 - REAL*8 :: temp321b3 + REAL*8 :: temp49b4 + REAL*8 :: temp66b5 + REAL*8 :: temp83b6 + REAL*8 :: temp118b9 + REAL*8 :: temp125b1 + REAL*8 :: temp131b55 + REAL*8 :: temp191b8 + REAL*8 :: temp191b13 + REAL*8 :: temp201b6 + REAL*8 :: temp206b1 + REAL*8 :: temp277b3 + REAL*8 :: temp296b + REAL*8 :: temp319b6 + REAL*8 :: temp335b31 REAL*8 :: temp340b - REAL*8 :: temp360b0 - REAL*8 :: temp373b66 - DOUBLE PRECISION :: temp384 - REAL*8 :: temp386b35 - REAL*8 :: temp397b0 - REAL*8 :: temp404b34 + REAL*8 :: temp340b44 + REAL*8 :: temp353b8 + REAL*8 :: temp384 REAL*8 :: temp421b - REAL*8 :: temp465 - REAL*8 :: temp478b0 - REAL*8 :: temp488b9 - REAL*8 :: temp490b6 - REAL*8 :: temp497b14 + REAL*8 :: temp441b0 + REAL*8 :: temp448b81 + DOUBLE PRECISION :: temp465 + REAL*8 :: temp522b0 + REAL*8 :: temp3b1 REAL*8 :: temp8b - REAL*8 :: temp35 - REAL*8 :: temp54b18 - REAL*8 :: temp57b24 - REAL*8 :: temp59b - REAL*8 :: temp88b0 - REAL*8 :: temp174b6 - REAL*8 :: temp216b9 - REAL*8 :: temp223b1 - REAL*8 :: temp315b14 - REAL*8 :: temp321b2 - REAL*8 :: temp373b65 - DOUBLE PRECISION :: temp383 - REAL*8 :: temp386b34 - REAL*8 :: temp404b33 - REAL*8 :: temp456b3 + REAL*8 :: temp22b + DOUBLE PRECISION :: temp35 + REAL*8 :: temp49b3 + REAL*8 :: temp66b4 + REAL*8 :: temp83b5 + REAL*8 :: temp118b8 + REAL*8 :: temp125b0 + REAL*8 :: temp131b54 + REAL*8 :: temp135b9 + REAL*8 :: temp191b7 + REAL*8 :: temp191b12 + REAL*8 :: temp191b49 + REAL*8 :: temp201b5 + REAL*8 :: temp206b0 + REAL*8 :: temp277b2 + REAL*8 :: temp319b5 + REAL*8 :: temp335b30 + REAL*8 :: temp340b43 + REAL*8 :: temp353b7 + REAL*8 :: temp383 + REAL*8 :: temp385b + REAL*8 :: temp448b80 REAL*8 :: temp464 - REAL*8 :: temp488b8 - REAL*8 :: temp490b5 - REAL*8 :: temp496b41 - REAL*8 :: temp497b13 - REAL*8 :: temp34 - REAL*8 :: temp54b17 - REAL*8 :: temp57b23 - REAL*8 :: temp120b4 - REAL*8 :: temp174b5 - REAL*8 :: temp216b8 - REAL*8 :: temp223b0 - REAL*8 :: temp315b13 - REAL*8 :: temp321b1 - REAL*8 :: temp328b19 - REAL*8 :: temp373b64 - DOUBLE PRECISION :: temp382 - REAL*8 :: temp386b33 - REAL*8 :: temp393b - REAL*8 :: temp402b1 - REAL*8 :: temp404b32 - REAL*8 :: temp456b2 - DOUBLE PRECISION :: temp463 - REAL*8 :: temp474b - REAL*8 :: temp488b7 - REAL*8 :: temp490b4 - REAL*8 :: temp496b40 - REAL*8 :: temp497b12 - REAL*8 :: temp27b5 + REAL*8 :: temp510b + REAL*8 :: temp3b0 + DOUBLE PRECISION :: temp34 + REAL*8 :: temp49b2 + REAL*8 :: temp50b39 + REAL*8 :: temp66b3 + REAL*8 :: temp67b + REAL*8 :: temp83b4 + REAL*8 :: temp104b + REAL*8 :: temp118b7 + REAL*8 :: temp131b53 + REAL*8 :: temp135b8 + REAL*8 :: temp191b6 + REAL*8 :: temp191b11 + REAL*8 :: temp191b48 + REAL*8 :: temp201b4 + REAL*8 :: temp277b1 + REAL*8 :: temp319b4 + REAL*8 :: temp340b42 + REAL*8 :: temp353b6 + REAL*8 :: temp370b7 + REAL*8 :: temp382 + REAL*8 :: temp463 REAL*8 :: temp33 - REAL*8 :: temp42b19 - REAL*8 :: temp54b16 - REAL*8 :: temp57b22 - DOUBLE PRECISION :: temp112b - REAL*8 :: temp120b3 + REAL*8 :: temp49b1 + REAL*8 :: temp50b38 + REAL*8 :: temp66b2 + REAL*8 :: temp75b + REAL*8 :: temp83b3 + REAL*8 :: temp118b6 REAL*8 :: temp129 + REAL*8 :: temp131b52 + REAL*8 :: temp135b7 + REAL*8 :: temp135b30 REAL*8 :: temp149b - REAL*8 :: temp174b4 - REAL*8 :: temp216b7 - REAL*8 :: temp315b12 - REAL*8 :: temp321b0 - REAL*8 :: temp328b18 - REAL*8 :: temp373b63 - DOUBLE PRECISION :: temp381 - REAL*8 :: temp386b32 - REAL*8 :: temp392b2 - REAL*8 :: temp402b0 - REAL*8 :: temp404b31 - REAL*8 :: temp439b0 - REAL*8 :: temp456b1 - REAL*8 :: temp462 - REAL*8 :: temp473b2 - REAL*8 :: temp488b6 - REAL*8 :: temp490b3 - REAL*8 :: temp497b11 + REAL*8 :: temp191b5 + REAL*8 :: temp191b10 + REAL*8 :: temp191b47 + REAL*8 :: temp201b3 + REAL*8 :: temp277b0 + REAL*8 :: temp319b3 + REAL*8 :: temp340b41 + REAL*8 :: temp353b5 + REAL*8 :: temp353b10 + REAL*8 :: temp370b6 + REAL*8 :: temp381 + DOUBLE PRECISION :: temp462 REAL*8 :: temp499 - REAL*8 :: temp27b4 - DOUBLE PRECISION :: temp32 - REAL*8 :: temp42b18 - REAL*8 :: temp54b15 - REAL*8 :: temp57b21 + REAL*8 :: temp32 + REAL*8 :: temp44b5 + REAL*8 :: temp49b0 + REAL*8 :: temp50b37 + REAL*8 :: temp66b1 REAL*8 :: temp69 + REAL*8 :: temp83b + REAL*8 :: temp83b2 REAL*8 :: temp118b5 - REAL*8 :: temp120b - REAL*8 :: temp120b2 - REAL*8 :: temp128 - REAL*8 :: temp174b3 + DOUBLE PRECISION :: temp128 + REAL*8 :: temp131b51 + REAL*8 :: temp135b6 + REAL*8 :: temp191b4 + REAL*8 :: temp191b46 + REAL*8 :: temp201b + REAL*8 :: temp201b2 DOUBLE PRECISION :: temp209 - REAL*8 :: temp216b6 REAL*8 :: temp238b - REAL*8 :: temp315b11 - REAL*8 :: temp328b17 - REAL*8 :: temp373b62 - REAL*8 :: temp380b19 - DOUBLE PRECISION :: temp380 - REAL*8 :: temp386b31 - REAL*8 :: temp392b1 - REAL*8 :: temp404b30 + REAL*8 :: temp319b + REAL*8 :: temp319b2 + REAL*8 :: temp340b40 + REAL*8 :: temp353b4 + REAL*8 :: temp370b5 + REAL*8 :: temp380 REAL*8 :: temp456b0 REAL*8 :: temp461 - REAL*8 :: temp473b1 - REAL*8 :: temp488b5 REAL*8 :: temp490b - REAL*8 :: temp490b2 - REAL*8 :: temp497b10 REAL*8 :: temp498 REAL*8 :: temp500b0 - REAL*8 :: temp27b3 - DOUBLE PRECISION :: temp31 - REAL*8 :: temp42b17 - REAL*8 :: temp54b14 - REAL*8 :: temp57b20 - DOUBLE PRECISION :: temp68 - REAL*8 :: temp91b + REAL*8 :: temp31 + REAL*8 :: temp44b4 + REAL*8 :: temp50b36 + REAL*8 :: temp66b0 + REAL*8 :: temp68 + REAL*8 :: temp83b1 REAL*8 :: temp118b4 - REAL*8 :: temp120b1 DOUBLE PRECISION :: temp127 - REAL*8 :: temp165b - REAL*8 :: temp174b2 - REAL*8 :: temp208 - REAL*8 :: temp216b5 + REAL*8 :: temp131b50 + REAL*8 :: temp135b5 + REAL*8 :: temp191b3 + REAL*8 :: temp191b45 + REAL*8 :: temp201b1 + DOUBLE PRECISION :: temp208 REAL*8 :: temp246b - REAL*8 :: temp272b3 - REAL*8 :: temp315b10 - REAL*8 :: temp328b16 - REAL*8 :: temp373b61 - REAL*8 :: temp380b18 - REAL*8 :: temp386b30 - REAL*8 :: temp387b39 - REAL*8 :: temp392b0 - REAL*8 :: temp408b + REAL*8 :: temp319b1 + REAL*8 :: temp353b3 + REAL*8 :: temp370b4 + DOUBLE PRECISION :: temp392b0 REAL*8 :: temp460 - REAL*8 :: temp473b0 - REAL*8 :: temp488b4 - REAL*8 :: temp490b1 - INTEGER :: temp497 - REAL*8 :: temp27b2 - DOUBLE PRECISION :: temp30 - REAL*8 :: temp42b16 - REAL*8 :: temp54b13 - REAL*8 :: temp57b56 + REAL(8) :: temp497 + REAL*8 :: temp3b17 + REAL*8 :: temp22b7 + REAL*8 :: temp30 + REAL*8 :: temp44b3 + REAL*8 :: temp50b35 REAL*8 :: temp67 + REAL*8 :: temp83b0 REAL*8 :: temp118b3 - REAL*8 :: temp120b0 - DOUBLE PRECISION :: temp126 + REAL*8 :: temp126 + REAL*8 :: temp135b4 REAL*8 :: temp174b1 - REAL*8 :: temp207 - REAL*8 :: temp216b4 - REAL*8 :: temp272b2 - REAL*8 :: temp328b15 + REAL*8 :: temp189b5 + REAL*8 :: temp191b2 + REAL*8 :: temp191b44 + REAL*8 :: temp201b0 + DOUBLE PRECISION :: temp207 + REAL*8 :: temp319b0 REAL*8 :: temp335b - REAL*8 :: temp373b60 - REAL*8 :: temp379b19 - REAL*8 :: temp380b17 - REAL*8 :: temp387b38 + REAL*8 :: temp353b2 + REAL*8 :: temp370b3 REAL*8 :: temp416b - REAL*8 :: temp417b1 - REAL*8 :: temp485b11 - REAL*8 :: temp488b3 - REAL*8 :: temp490b0 REAL*8 :: temp496 + REAL*8 :: temp3b16 REAL*8 :: temp17b - REAL*8 :: temp27b1 - REAL*8 :: temp42b15 - REAL*8 :: temp54b12 - REAL*8 :: temp57b55 + DOUBLE PRECISION :: temp22b6 + REAL*8 :: temp44b2 + REAL*8 :: temp50b34 REAL*8 :: temp66 REAL*8 :: temp118b2 REAL*8 :: temp125 + REAL*8 :: temp135b3 REAL*8 :: temp174b0 - DOUBLE PRECISION :: temp206 - REAL*8 :: temp216b3 - REAL*8 :: temp272b1 + REAL*8 :: temp181b + REAL*8 :: temp189b4 + REAL*8 :: temp191b1 + REAL*8 :: temp191b43 + REAL*8 :: temp206 REAL*8 :: temp299b - REAL*8 :: temp328b14 - REAL*8 :: temp336b0 REAL*8 :: temp343b - REAL*8 :: temp379b18 - REAL*8 :: temp380b16 - REAL*8 :: temp387b37 - REAL*8 :: temp417b0 + REAL*8 :: temp353b1 + REAL*8 :: temp370b2 REAL*8 :: temp424b - REAL*8 :: temp485b10 - REAL*8 :: temp488b2 REAL*8 :: temp495 REAL*8 :: temp505b + REAL*8 :: temp3b15 + REAL*8 :: temp22b5 REAL*8 :: temp25b - REAL*8 :: temp27b0 - REAL*8 :: temp42b14 - REAL*8 :: temp54b11 - REAL*8 :: temp57b54 - REAL*8 :: temp65 + REAL*8 :: temp44b1 + REAL*8 :: temp50b33 + DOUBLE PRECISION :: temp65 REAL*8 :: temp118b1 REAL*8 :: temp124 + REAL*8 :: temp135b2 REAL*8 :: temp189b3 - DOUBLE PRECISION :: temp205 - REAL*8 :: temp216b2 - REAL*8 :: temp272b0 + REAL*8 :: temp191b0 + REAL*8 :: temp191b42 + REAL*8 :: temp205 REAL*8 :: temp314b3 - REAL*8 :: temp321b29 - REAL*8 :: temp328b13 + REAL*8 :: temp353b0 REAL*8 :: temp370b1 - REAL*8 :: temp379b17 - REAL*8 :: temp380b15 - REAL*8 :: temp387b36 - REAL*8 :: temp388b REAL*8 :: temp432b - REAL*8 :: temp451b1 - REAL*8 :: temp469b - REAL*8 :: temp488b1 + DOUBLE PRECISION :: temp469b REAL*8 :: temp494 - REAL*8 :: temp513b - REAL*8 :: temp33b - REAL*8 :: temp42b13 + REAL*8 :: temp3b14 + REAL*8 :: temp22b4 REAL*8 :: temp44b0 - REAL*8 :: temp54b9 - REAL*8 :: temp54b10 - REAL*8 :: temp57b53 - REAL*8 :: temp64 + REAL*8 :: temp50b32 + DOUBLE PRECISION :: temp64 + REAL*8 :: temp107b REAL*8 :: temp118b0 DOUBLE PRECISION :: temp123 + REAL*8 :: temp135b1 REAL*8 :: temp189b2 + REAL*8 :: temp191b41 DOUBLE PRECISION :: temp204 - REAL*8 :: temp216b1 + REAL*8 :: temp226b24 REAL*8 :: temp314b2 - REAL*8 :: temp321b28 - REAL*8 :: temp328b12 REAL*8 :: temp370b0 - REAL*8 :: temp379b16 - REAL*8 :: temp380b9 - REAL*8 :: temp380b14 - REAL*8 :: temp387b35 - REAL*8 :: temp396b - REAL*8 :: temp412b3 REAL*8 :: temp440b - REAL*8 :: temp451b0 + REAL*8 :: temp448b19 REAL*8 :: temp477b - REAL*8 :: temp488b0 - DOUBLE PRECISION :: temp493 + INTEGER :: temp493 REAL*8 :: temp521b - REAL*8 :: temp42b12 - REAL*8 :: temp54b8 - REAL*8 :: temp57b52 + REAL*8 :: temp3b13 + REAL*8 :: temp22b3 + REAL*8 :: temp41b + REAL*8 :: temp50b31 REAL*8 :: temp63 - REAL*8 :: temp61b0 REAL*8 :: temp78b + REAL*8 :: temp115b DOUBLE PRECISION :: temp122 - REAL*8 :: temp128b8 + REAL*8 :: temp135b0 DOUBLE PRECISION :: temp159 REAL*8 :: temp189b1 + REAL*8 :: temp191b40 DOUBLE PRECISION :: temp203 - REAL*8 :: temp216b0 + REAL*8 :: temp226b9 + REAL*8 :: temp226b23 + REAL*8 :: temp233b1 REAL*8 :: temp314b1 - REAL*8 :: temp321b27 - REAL*8 :: temp328b11 - REAL*8 :: temp379b15 - REAL*8 :: temp380b8 - REAL*8 :: temp380b13 - REAL*8 :: temp387b34 - REAL*8 :: temp412b2 - REAL*8 :: temp474b19 - REAL*8 :: temp483b4 + REAL*8 :: temp385b3 + REAL*8 :: temp448b18 REAL*8 :: temp485b REAL*8 :: temp492 - REAL*8 :: temp42b11 - REAL*8 :: temp54b7 - REAL*8 :: temp57b51 - DOUBLE PRECISION :: temp62 - REAL*8 :: temp86b + REAL*8 :: temp3b12 + REAL*8 :: temp22b2 + REAL*8 :: temp50b30 + REAL*8 :: temp62 REAL*8 :: temp99 DOUBLE PRECISION :: temp121 - REAL*8 :: temp128b7 DOUBLE PRECISION :: temp158 REAL*8 :: temp189b0 - REAL*8 :: temp202 + DOUBLE PRECISION :: temp202 + REAL*8 :: temp226b8 + REAL*8 :: temp226b22 + REAL*8 :: temp233b0 REAL*8 :: temp239 + REAL*8 :: temp243b9 REAL*8 :: temp314b0 - REAL*8 :: temp321b26 - REAL*8 :: temp328b10 - REAL*8 :: temp331b1 - REAL*8 :: temp379b14 - REAL*8 :: temp380b7 - REAL*8 :: temp380b12 - REAL*8 :: temp380b49 - REAL*8 :: temp387b33 - REAL*8 :: temp412b1 - REAL*8 :: temp474b18 - REAL*8 :: temp483b3 - REAL*8 :: temp491 + REAL*8 :: temp385b2 + REAL*8 :: temp448b17 + DOUBLE PRECISION :: temp491 REAL*8 :: temp493b - REAL*8 :: temp42b10 - REAL*8 :: temp54b6 - REAL*8 :: temp57b50 + REAL*8 :: temp3b11 + REAL*8 :: temp22b1 DOUBLE PRECISION :: temp61 + REAL*8 :: temp94b REAL*8 :: temp98 DOUBLE PRECISION :: temp120 - REAL*8 :: temp128b6 + REAL*8 :: temp131b DOUBLE PRECISION :: temp157 - REAL*8 :: temp201 + REAL*8 :: temp168b + DOUBLE PRECISION :: temp201 + REAL*8 :: temp226b7 + REAL*8 :: temp226b21 REAL*8 :: temp238 + REAL*8 :: temp243b8 REAL*8 :: temp249b - DOUBLE PRECISION :: temp319 - REAL*8 :: temp321b25 + REAL*8 :: temp319 REAL*8 :: temp331b0 - REAL*8 :: temp346b4 - REAL*8 :: temp379b13 - REAL*8 :: temp380b6 - REAL*8 :: temp380b11 - REAL*8 :: temp380b48 - REAL*8 :: temp387b32 - REAL*8 :: temp412b0 - REAL*8 :: temp474b17 - REAL*8 :: temp483b2 - REAL*8 :: temp490 - REAL*8 :: temp54b5 + REAL*8 :: temp385b1 + REAL*8 :: temp448b16 + DOUBLE PRECISION :: temp490 + REAL*8 :: temp510b1 + REAL*8 :: temp3b10 + REAL*8 :: temp22b0 DOUBLE PRECISION :: temp60 - REAL*8 :: temp59b0 REAL*8 :: temp97 - REAL*8 :: temp93b2 - REAL*8 :: temp128b5 - REAL*8 :: temp130b2 + REAL*8 :: temp124b32 DOUBLE PRECISION :: temp156 REAL*8 :: temp176b - DOUBLE PRECISION :: temp200 + REAL*8 :: temp184b3 + REAL*8 :: temp200 + REAL*8 :: temp220b + REAL*8 :: temp226b6 + REAL*8 :: temp226b20 REAL*8 :: temp237 - DOUBLE PRECISION :: temp257b + REAL*8 :: temp243b7 + REAL*8 :: temp257b REAL*8 :: temp301b - DOUBLE PRECISION :: temp318 - REAL*8 :: temp321b24 + REAL*8 :: temp318 REAL*8 :: temp338b - DOUBLE PRECISION :: temp346b3 - REAL*8 :: temp379b12 - REAL*8 :: temp379b49 REAL*8 :: temp380b5 - REAL*8 :: temp380b10 - REAL*8 :: temp380b47 - REAL*8 :: temp387b31 - REAL*8 :: temp474b16 - REAL*8 :: temp483b1 - REAL*8 :: temp54b4 + REAL*8 :: temp385b0 + REAL*8 :: temp419b + REAL*8 :: temp448b15 + REAL*8 :: temp499b19 + REAL*8 :: temp510b0 REAL*8 :: temp96 - REAL*8 :: temp93b1 - REAL*8 :: temp128b4 - REAL*8 :: temp130b1 + REAL*8 :: temp124b31 + REAL*8 :: temp155b19 REAL*8 :: temp155 + REAL*8 :: temp184b + REAL*8 :: temp184b2 + REAL*8 :: temp226b5 DOUBLE PRECISION :: temp236 - REAL*8 :: temp265b - REAL*8 :: temp297b7 - DOUBLE PRECISION :: temp317 - REAL*8 :: temp321b23 - REAL*8 :: temp346b - REAL*8 :: temp346b2 - REAL*8 :: temp379b11 - REAL*8 :: temp379b48 + REAL*8 :: temp243b6 + REAL*8 :: temp253b29 + REAL*8 :: temp317 REAL*8 :: temp380b4 - REAL*8 :: temp380b46 - REAL*8 :: temp387b30 - REAL*8 :: temp388b39 - REAL*8 :: temp474b15 + REAL*8 :: temp427b + REAL*8 :: temp448b14 REAL*8 :: temp483b0 - REAL*8 :: temp486b12 - REAL*8 :: temp508b - REAL*8 :: temp28b - REAL*8 :: temp54b3 - REAL*8 :: temp68b19 + REAL*8 :: temp499b18 REAL*8 :: temp95 - REAL*8 :: temp93b0 - REAL*8 :: temp128b3 - REAL*8 :: temp130b0 + REAL*8 :: temp124b30 REAL*8 :: temp154 - REAL*8 :: temp235 - REAL*8 :: temp273b - REAL*8 :: temp297b6 - DOUBLE PRECISION :: temp316 - REAL*8 :: temp321b22 - REAL*8 :: temp329b0 - REAL*8 :: temp346b1 + REAL*8 :: temp155b18 + REAL*8 :: temp162b5 + REAL*8 :: temp184b1 + REAL*8 :: temp226b4 + DOUBLE PRECISION :: temp235 + REAL*8 :: temp243b5 + REAL*8 :: temp253b28 + REAL*8 :: temp316 REAL*8 :: temp354b - REAL*8 :: temp379b10 - REAL*8 :: temp379b47 REAL*8 :: temp380b3 - REAL*8 :: temp380b45 - REAL*8 :: temp388b38 - REAL*8 :: temp474b14 - REAL*8 :: temp486b11 - REAL*8 :: temp516b - REAL*8 :: temp36b - REAL*8 :: temp54b2 - REAL*8 :: temp68b18 - DOUBLE PRECISION :: temp94 - REAL*8 :: temp128b2 + REAL*8 :: temp448b13 + REAL*8 :: temp499b17 + REAL*8 :: temp15b5 + REAL*8 :: temp94 REAL*8 :: temp153 - DOUBLE PRECISION :: temp234 + REAL*8 :: temp155b17 + REAL*8 :: temp162b4 + REAL*8 :: temp184b0 + REAL*8 :: temp221b8 + REAL*8 :: temp226b3 + REAL*8 :: temp234 + REAL*8 :: temp243b4 + REAL*8 :: temp253b27 REAL*8 :: temp281b - REAL*8 :: temp282b1 - REAL*8 :: temp297b5 REAL*8 :: temp315 - REAL*8 :: temp321b21 - REAL*8 :: temp346b0 - REAL*8 :: temp362b - REAL*8 :: temp379b46 REAL*8 :: temp380b2 - REAL*8 :: temp380b44 - REAL*8 :: temp388b37 + REAL*8 :: temp399b REAL*8 :: temp443b - REAL*8 :: temp474b13 - REAL*8 :: temp486b10 - REAL*8 :: temp508b0 + REAL*8 :: temp448b12 + REAL*8 :: temp448b49 + REAL*8 :: temp499b16 + REAL*8 :: temp15b4 + REAL*8 :: temp37b0 REAL*8 :: temp44b - REAL*8 :: temp54b1 - REAL*8 :: temp68b17 - REAL*8 :: temp71b2 - DOUBLE PRECISION :: temp93 + REAL*8 :: temp93 REAL*8 :: temp118b - REAL*8 :: temp128b1 - REAL*8 :: temp145b2 - DOUBLE PRECISION :: temp152 - DOUBLE PRECISION :: temp189 - DOUBLE PRECISION :: temp233 - REAL*8 :: temp282b0 - REAL*8 :: temp297b4 - REAL*8 :: temp314 - REAL*8 :: temp321b20 - REAL*8 :: temp322b29 + REAL*8 :: temp152 + REAL*8 :: temp155b16 + REAL*8 :: temp162b3 + REAL*8 :: temp189 + REAL*8 :: temp197b29 + REAL*8 :: temp221b7 + REAL*8 :: temp224b19 + REAL*8 :: temp226b2 + REAL*8 :: temp233 + REAL*8 :: temp243b3 + REAL*8 :: temp253b26 + INTEGER :: temp314 REAL*8 :: temp370b - REAL*8 :: temp373b9 - REAL*8 :: temp379b45 REAL*8 :: temp380b1 - REAL*8 :: temp380b43 - REAL*8 :: temp388b36 + REAL*8 :: temp448b11 + REAL*8 :: temp448b48 REAL*8 :: temp451b - REAL*8 :: temp474b12 + REAL*8 :: temp461b1 REAL*8 :: temp488b - DOUBLE PRECISION :: temp493b6 + REAL*8 :: temp499b15 REAL*8 :: temp1b - REAL*8 :: temp54b0 - REAL*8 :: temp68b16 - REAL*8 :: temp71b1 + REAL*8 :: temp8b29 + REAL*8 :: temp15b3 REAL*8 :: temp92 - REAL*8 :: temp128b0 - REAL*8 :: temp145b1 + REAL*8 :: temp126b DOUBLE PRECISION :: temp151 + REAL*8 :: temp155b15 + REAL*8 :: temp162b2 REAL*8 :: temp188 + REAL*8 :: temp197b28 + REAL*8 :: temp207b + REAL*8 :: temp221b6 + REAL*8 :: temp224b18 + REAL*8 :: temp226b1 REAL*8 :: temp232 + REAL*8 :: temp243b2 + REAL*8 :: temp253b25 REAL*8 :: temp269 - REAL*8 :: temp297b3 REAL*8 :: temp313 - REAL*8 :: temp322b28 - REAL*8 :: temp373b8 - REAL*8 :: temp379b44 + REAL*8 :: temp341b3 REAL*8 :: temp380b0 - REAL*8 :: temp380b42 - REAL*8 :: temp388b35 - REAL*8 :: temp395b4 - REAL*8 :: temp474b11 + REAL*8 :: temp448b10 + REAL*8 :: temp448b47 + REAL*8 :: temp461b0 REAL*8 :: temp493b5 REAL*8 :: temp496b + REAL*8 :: temp499b14 INTRINSIC DSQRT REAL*8 :: temp - REAL*8 :: temp68b15 - REAL*8 :: temp71b0 + REAL*8 :: temp8b28 + REAL*8 :: temp15b2 + REAL*8 :: temp32b3 REAL*8 :: temp91 - REAL*8 :: temp138b8 - DOUBLE PRECISION :: temp145b0 - REAL*8 :: temp150 + REAL*8 :: temp97b + REAL*8 :: temp134b + DOUBLE PRECISION :: temp150 + REAL*8 :: temp155b9 + REAL*8 :: temp155b14 + REAL*8 :: temp162b1 REAL*8 :: temp187 + REAL*8 :: temp197b27 + REAL*8 :: temp221b5 + REAL*8 :: temp224b17 + REAL*8 :: temp226b0 REAL*8 :: temp231 - DOUBLE PRECISION :: temp268 - REAL*8 :: temp297b2 + REAL*8 :: temp243b1 + REAL*8 :: temp253b24 + REAL*8 :: temp268 REAL*8 :: temp312 - REAL*8 :: temp322b27 + REAL*8 :: temp341b2 REAL*8 :: temp349 - REAL*8 :: temp373b7 - REAL*8 :: temp379b43 - REAL*8 :: temp380b41 - REAL*8 :: temp387b62 - REAL*8 :: temp388b34 - REAL*8 :: temp395b3 - REAL*8 :: temp405b1 - REAL*8 :: temp474b10 - REAL*8 :: temp476b3 + REAL*8 :: temp448b46 REAL*8 :: temp493b4 - REAL*8 :: temp68b14 - DOUBLE PRECISION :: temp90 - REAL*8 :: temp138b7 + REAL*8 :: temp499b13 + REAL*8 :: temp8b27 + REAL*8 :: temp15b1 + REAL*8 :: temp32b2 + REAL*8 :: temp90 + REAL*8 :: temp131b19 + REAL*8 :: temp142b + REAL*8 :: temp155b8 + REAL*8 :: temp155b13 + REAL*8 :: temp162b0 + REAL*8 :: temp179b REAL*8 :: temp186 - REAL*8 :: temp223b + REAL*8 :: temp197b26 + REAL*8 :: temp221b4 + REAL*8 :: temp224b16 REAL*8 :: temp230 - REAL*8 :: temp267 - REAL*8 :: temp297b1 + REAL*8 :: temp243b0 + REAL*8 :: temp253b9 + REAL*8 :: temp253b23 + DOUBLE PRECISION :: temp267 REAL*8 :: temp311 - REAL*8 :: temp322b26 - REAL*8 :: temp348 - REAL*8 :: temp373b6 - REAL*8 :: temp379b42 - REAL*8 :: temp380b40 - REAL*8 :: temp387b61 - REAL*8 :: temp388b33 - REAL*8 :: temp395b2 - REAL*8 :: temp405b0 - REAL*8 :: temp422b1 + REAL*8 :: temp324b0 + REAL*8 :: temp341b1 + DOUBLE PRECISION :: temp348 REAL*8 :: temp429 - REAL*8 :: temp476b2 + REAL*8 :: temp448b45 + REAL*8 :: temp459b1 REAL*8 :: temp493b3 - REAL*8 :: temp68b13 - REAL*8 :: temp138b6 + REAL*8 :: temp499b12 + REAL*8 :: temp8b26 + REAL*8 :: temp15b0 + REAL*8 :: temp32b1 + REAL*8 :: temp131b18 REAL*8 :: temp150b - DOUBLE PRECISION :: temp185 + REAL*8 :: temp155b7 + REAL*8 :: temp155b12 + INTEGER :: temp185 REAL*8 :: temp187b - REAL*8 :: temp266 + REAL*8 :: temp197b25 + REAL*8 :: temp221b3 + REAL*8 :: temp224b15 + REAL*8 :: temp231b + REAL*8 :: temp253b8 + REAL*8 :: temp253b22 REAL*8 :: temp260b0 + DOUBLE PRECISION :: temp266 REAL*8 :: temp297b0 - REAL*8 :: temp302b3 - REAL*8 :: temp310 + DOUBLE PRECISION :: temp310 REAL*8 :: temp312b - REAL*8 :: temp322b25 + REAL*8 :: temp339b3 REAL*8 :: temp341b0 - REAL*8 :: temp347 - REAL*8 :: temp349b - REAL*8 :: temp373b5 - REAL*8 :: temp373b29 - REAL*8 :: temp378b0 - REAL*8 :: temp379b41 - REAL*8 :: temp380b76 - REAL*8 :: temp387b60 - REAL*8 :: temp388b9 - REAL*8 :: temp388b32 - REAL*8 :: temp388b69 - REAL*8 :: temp390b6 - REAL*8 :: temp395b1 + DOUBLE PRECISION :: temp347 REAL*8 :: temp422b0 REAL*8 :: temp428 - REAL*8 :: temp476b1 + REAL*8 :: temp432b9 + REAL*8 :: temp448b44 + REAL*8 :: temp459b0 REAL*8 :: temp493b2 - INTEGER :: temp509 - REAL*8 :: temp9 - REAL*8 :: temp42b9 - REAL*8 :: temp68b12 - REAL*8 :: temp68b49 + REAL*8 :: temp499b11 + REAL*8 :: temp509 + REAL*8 :: temp8b25 + DOUBLE PRECISION :: temp9 + REAL*8 :: temp32b0 REAL*8 :: temp69b0 - REAL*8 :: temp138b5 - DOUBLE PRECISION :: temp184 - REAL*8 :: temp265 - REAL*8 :: temp302b2 + REAL*8 :: temp131b17 + REAL*8 :: temp155b6 + REAL*8 :: temp155b11 + REAL*8 :: temp184 + REAL*8 :: temp197b24 + REAL*8 :: temp221b2 + REAL*8 :: temp224b14 + REAL*8 :: temp253b7 + REAL*8 :: temp253b21 + DOUBLE PRECISION :: temp265 REAL*8 :: temp320b - REAL*8 :: temp322b24 + REAL*8 :: temp339b2 DOUBLE PRECISION :: temp346 - REAL*8 :: temp373b4 - REAL*8 :: temp373b28 - REAL*8 :: temp379b40 - REAL*8 :: temp380b75 - REAL*8 :: temp388b8 - REAL*8 :: temp388b31 - REAL*8 :: temp388b68 - REAL*8 :: temp390b5 - REAL*8 :: temp395b0 - REAL*8 :: temp401b + DOUBLE PRECISION :: temp356b3 REAL*8 :: temp427 - REAL*8 :: temp438b - REAL*8 :: temp476b0 - REAL*8 :: temp486b9 + REAL*8 :: temp432b8 + REAL*8 :: temp448b43 REAL*8 :: temp493b1 - REAL*8 :: temp508 - REAL*8 :: temp520b0 + REAL*8 :: temp499b10 + INTEGER :: temp508 REAL*8 :: temp519b - REAL*8 :: temp8 - REAL*8 :: temp39b - REAL*8 :: temp42b8 - REAL*8 :: temp68b11 - REAL*8 :: temp68b48 - REAL*8 :: temp138b4 - REAL*8 :: temp140b1 + REAL*8 :: temp520b0 + REAL*8 :: temp8b24 + DOUBLE PRECISION :: temp8 + REAL*8 :: temp131b16 + REAL*8 :: temp155b5 + REAL*8 :: temp155b10 + REAL*8 :: temp177b1 REAL*8 :: temp183 + REAL*8 :: temp197b23 + REAL*8 :: temp206b31 + REAL*8 :: temp221b1 + REAL*8 :: temp224b13 + REAL*8 :: temp253b6 + REAL*8 :: temp253b20 DOUBLE PRECISION :: temp264 - REAL*8 :: temp302b1 - REAL*8 :: temp322b23 - REAL*8 :: temp345 - REAL*8 :: temp365b - REAL*8 :: temp373b3 - REAL*8 :: temp373b27 - REAL*8 :: temp380b74 - REAL*8 :: temp388b7 - REAL*8 :: temp388b30 - REAL*8 :: temp388b67 - REAL*8 :: temp390b4 + REAL*8 :: temp335b29 + REAL*8 :: temp339b1 + DOUBLE PRECISION :: temp345 + DOUBLE PRECISION :: temp356b2 REAL*8 :: temp426 + REAL*8 :: temp432b7 REAL*8 :: temp446b - REAL*8 :: temp486b8 + REAL*8 :: temp448b42 + REAL*8 :: temp448b79 REAL*8 :: temp493b0 + REAL*8 :: tmp1b REAL*8 :: temp507 - REAL*8 :: temp1b0 REAL*8 :: temp7 - REAL*8 :: temp10b - REAL*8 :: temp42b7 - REAL*8 :: temp68b10 - REAL*8 :: temp68b47 - REAL*8 :: temp138b3 + REAL*8 :: temp8b23 + REAL*8 :: temp47b + REAL*8 :: temp131b15 REAL*8 :: temp140b0 + REAL*8 :: temp155b4 + REAL*8 :: temp172b5 + REAL*8 :: temp177b0 REAL*8 :: temp182 - DOUBLE PRECISION :: temp263 - REAL*8 :: temp302b0 - REAL*8 :: temp322b22 + REAL*8 :: temp197b22 + REAL*8 :: temp206b30 + REAL*8 :: temp221b0 + REAL*8 :: temp224b12 + REAL*8 :: temp253b5 + REAL*8 :: temp253b56 + REAL*8 :: temp263 + REAL*8 :: temp292b + REAL*8 :: temp335b28 + REAL*8 :: temp339b0 REAL*8 :: temp344 - REAL*8 :: temp373b - REAL*8 :: temp373b2 - REAL*8 :: temp373b26 - REAL*8 :: temp379b75 - REAL*8 :: temp380b73 - REAL*8 :: temp388b6 - REAL*8 :: temp388b66 - REAL*8 :: temp390b3 - REAL*8 :: temp425 - REAL*8 :: temp454b - REAL*8 :: temp486b7 - REAL*8 :: temp496b39 + DOUBLE PRECISION :: temp356b1 + DOUBLE PRECISION :: temp425 + REAL*8 :: temp432b6 + REAL*8 :: temp448b41 + REAL*8 :: temp448b78 REAL*8 :: temp506 - REAL*8 :: temp4b DOUBLE PRECISION :: temp6 - REAL*8 :: temp42b6 - REAL*8 :: temp55b - REAL*8 :: temp68b46 + REAL*8 :: temp8b22 REAL*8 :: temp129b - REAL*8 :: temp138b2 - DOUBLE PRECISION :: temp181 - DOUBLE PRECISION :: temp262 + REAL*8 :: temp131b14 + REAL*8 :: temp135b29 + REAL*8 :: temp155b3 + REAL*8 :: temp172b4 + REAL*8 :: temp181 + REAL*8 :: temp197b21 + REAL*8 :: temp224b11 + REAL*8 :: temp253b4 + REAL*8 :: temp253b55 + REAL*8 :: temp262 REAL*8 :: temp299 - REAL*8 :: temp322b21 - REAL*8 :: temp343 - REAL*8 :: temp373b1 - REAL*8 :: temp373b25 - REAL*8 :: temp379b74 - REAL*8 :: temp380b72 - REAL*8 :: temp388b5 - REAL*8 :: temp388b65 - REAL*8 :: temp390b2 - REAL*8 :: temp424 - REAL*8 :: temp437b0 + REAL*8 :: temp335b27 + DOUBLE PRECISION :: temp343 + DOUBLE PRECISION :: temp356b0 + REAL*8 :: temp381b + REAL*8 :: temp400b0 + DOUBLE PRECISION :: temp424 + REAL*8 :: temp432b5 + REAL*8 :: temp448b40 + REAL*8 :: temp448b77 REAL*8 :: temp462b - REAL*8 :: temp486b6 - REAL*8 :: temp496b38 REAL*8 :: temp499b - INTEGER :: temp505 + REAL*8 :: temp505 DOUBLE PRECISION :: temp5 - REAL*8 :: temp42b5 - REAL*8 :: temp57b9 - REAL*8 :: temp63b - REAL*8 :: temp68b45 + REAL*8 :: temp8b21 + DOUBLE PRECISION :: temp8b58 REAL*8 :: temp100b - REAL*8 :: temp138b1 - DOUBLE PRECISION :: temp180 - REAL*8 :: temp218b - REAL*8 :: temp219b1 - REAL*8 :: temp261 + REAL*8 :: temp131b13 + REAL*8 :: temp135b28 + REAL*8 :: temp137b + REAL*8 :: temp155b2 + REAL*8 :: temp172b3 + REAL*8 :: temp180 + REAL*8 :: temp197b20 + REAL*8 :: temp197b57 + REAL*8 :: temp224b10 + REAL*8 :: temp253b3 + REAL*8 :: temp253b54 + DOUBLE PRECISION :: temp261 REAL*8 :: temp298 - REAL*8 :: temp322b20 + REAL*8 :: temp335b26 + REAL*8 :: temp340b39 REAL*8 :: temp342 - REAL*8 :: temp373b0 - REAL*8 :: temp373b24 - REAL*8 :: temp379b73 - REAL*8 :: temp379 - REAL*8 :: temp380b71 - REAL*8 :: temp388b4 - REAL*8 :: temp388b64 - REAL*8 :: temp390b1 - REAL*8 :: temp404b29 - REAL*8 :: temp423 - REAL*8 :: temp454b0 - REAL*8 :: temp470b - REAL*8 :: temp486b5 - REAL*8 :: temp496b37 + DOUBLE PRECISION :: temp379 + DOUBLE PRECISION :: temp423 + REAL*8 :: temp432b4 + REAL*8 :: temp448b76 REAL*8 :: temp504 - REAL*8 :: temp4 - REAL*8 :: temp42b4 - REAL*8 :: temp57b8 - REAL*8 :: temp57b19 - REAL*8 :: temp68b44 - REAL*8 :: temp71b - REAL*8 :: temp138b0 - REAL*8 :: temp145b - REAL*8 :: temp219b0 - DOUBLE PRECISION :: temp260 + DOUBLE PRECISION :: temp4 + REAL*8 :: temp8b20 + DOUBLE PRECISION :: temp8b57 + REAL*8 :: temp131b12 + REAL*8 :: temp131b49 + REAL*8 :: temp135b27 + REAL*8 :: temp155b1 + REAL*8 :: temp172b2 + REAL*8 :: temp197b56 + REAL*8 :: temp226b + REAL*8 :: temp253b2 + REAL*8 :: temp253b53 + REAL*8 :: temp260 REAL*8 :: temp297 + REAL*8 :: temp335b25 + REAL*8 :: temp340b38 REAL*8 :: temp341 - REAL*8 :: temp373b23 - REAL*8 :: temp378 - REAL*8 :: temp379b72 - REAL*8 :: temp380b70 - REAL*8 :: temp386b29 - REAL*8 :: temp388b3 - REAL*8 :: temp388b63 - REAL*8 :: temp390b0 - REAL*8 :: temp404b28 - REAL*8 :: temp422 + DOUBLE PRECISION :: temp378 + DOUBLE PRECISION :: temp422 + REAL*8 :: temp432b3 + REAL*8 :: temp448b75 REAL*8 :: temp459 - REAL*8 :: temp471b0 - REAL*8 :: temp486b4 - REAL*8 :: temp496b36 REAL*8 :: temp503 - REAL*8 :: temp513b3 -! -! indorb are the number of orbitals occupied before calling -! this subroutine -! -! indpar is the number of variational parameters used -! before calling this subroutine -! -! indshell is the index of the last occupied orbital -! in the shell, characterized by occupation number iocc(indshell) -! -! z(i,indt+4) contains the laplacian of the orbital i -! z(i,indt+mu) contains the gradient of the orbital i (mu=1,2,3) -! In the following given a radial part of the orbital f(r) -! fun=1/r d f(r)/d r -! fun2= d^2 f(r)/dr^2 +! +! indorb are the number of orbitals occupied before calling +! this subroutine +! +! indpar is the number of variational parameters used +! before calling this subroutine +! +! indshell is the index of the last occupied orbital +! in the shell, characterized by occupation number iocc(indshell) +! +! z(i,indt+4) contains the laplacian of the orbital i +! z(i,indt+mu) contains the gradient of the orbital i (mu=1,2,3) +! In the following given a radial part of the orbital f(r) +! fun=1/r d f(r)/d r +!print *,"minicode/src/c_adjoint_forward/makefun.f90" +!print *,'makefun: iopt=',iopt +!print *,'makefun: i=',i0,' a=',indtmin,' b=',indtm +!print *,'makefun: indpar=',indpar,' indorb=',indorb,' indshell=',indshell +!print *,'makefun: nelskip=',nelskip @@ -2487,215 +2567,112 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & adr8ibuf=1 SELECT CASE (iopt) - CASE (80) -! Cyrus basis -! R(r)=exp(-z*r**2) single zeta -! if(iocc(indshellp).eq.1) then + CASE (105) +! 2s double gaussian without constant +! (exp (-dd2 r^2)+dd4*exp(-dd5*r^2)) +! dd1=1.d0 + dd2 = dd(indpar+1) +! dd3=dd(indpar+2) +! dd4=dd(indpar+3) +! dd5=dd(indpar+4) + dd4 = dd(indpar+2) + dd5 = dd(indpar+3) indorbp = indorb + 1 - dd1 = dd(indpar+1) - dd2 = DSQRT(dd1) -! if(iflagnorm.gt.2) then -! c=(2.d0*dd1/pi)**(3.d0/4.d0)*ratiocs -! ratiocs--> ratiocs*(2/pi)**3/4 - c = dd1**0.75d0*ratiocs -! endif DO k=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) + distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) + distp(k, 2) = DEXP(-(dd5*r(k)*r(k))) END DO +! write(6,*) ' function inside = ',z(indorbp,i) +! endif IF (typec .NE. 1) THEN -! the first derivative /r - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) -! the second derivative - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp2 = rp3**2 - temp1b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& -& temp2 - temp1 = dd1*distp(0, 1)/temp2 - temp1b0 = temp1*fun2b - rp1b = (2*rp1+4.d0*rp2+4.d0)*temp1b0 - temp0b0 = -(distp(0, 1)*(rp2+2.d0)*funb/rp3) - dd1b = temp0b0 + r(0)**2*rp1b + distp(0, 1)*temp1b - temp0 = dd1/rp3 - distpb(0, 1) = dd1*temp1b - temp0*(rp2+2.d0)*funb - rp3b = -(temp0*temp0b0) - temp1*2*rp3*temp1b - rp2b = 2*(rp2+1.d0)*rp3b - temp0*distp(0, 1)*funb + (4.d0*rp1-2.d0& -& )*temp1b0 - dd2b = r(0)*rp2b - rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b - ELSE + fun = -(2.d0*(dd2*distp(0, 1)+dd5*dd4*distp(0, 2))) + fun2 = r(0)**2 distpb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 - END IF - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - cb = 0.0_8 - DO k=indtm,indtmin,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) - distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp = dd2*r(k) + 1.d0 - temp0b = costb/temp - tempb = -(dd1*r(k)**2*temp0b/temp) - dd1b = dd1b + r(k)**2*temp0b - rb(k) = rb(k) + dd2*tempb + dd1*2*r(k)*temp0b - dd2b = dd2b + r(k)*tempb - END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocs*0.75d0*dd1**(-0.25D0)*cb - ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocs*0.75d0*dd1**(& -& -0.25D0)*cb - END IF - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (81) -! derivative of bump gaussian -! R(r)=c*exp(-z*r**2)*(3/4/z-r**2) -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) - dd2 = DSQRT(dd1) -! c=(2.d0*dd1/pi)**(3.d0/4.d0)*ratiocs - c = dd1**0.75d0*ratiocs - DO k=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) - END DO - DO i=i0,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*dd2*r(i))/(1.d0+dd2*r(i))**2 - END DO - IF (typec .NE. 1) THEN -! the first derivative /r - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - fun = 0.25d0*distp(0, 1)*(-14.d0-29.d0*rp2-12.d0*rp1+3.d0*rp1*rp2+& -& 2.d0*rp1**2)/rp3**2 -! the second derivative - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) + tempb2 = 2.d0*zb(indorbp, indt+4) + tempb3 = dd2*distp(0, 1)*2.d0*tempb2 + tempb4 = (2.d0*(dd2*fun2)-3.d0)*tempb2 + tempb5 = (2.d0*(dd5*fun2)-3.d0)*tempb2 + tempb6 = dd5*dd4*distp(0, 2)*2.d0*tempb2 + dd2b = distp(0, 1)*tempb4 + fun2*tempb3 + fun2b = dd5*tempb6 + dd2*tempb3 + distpb(0, 1) = dd2*tempb4 + dd5b = fun2*tempb6 + distp(0, 2)*dd4*tempb5 + dd4b = distp(0, 2)*dd5*tempb5 + distpb(0, 2) = dd5*dd4*tempb5 zb(indorbp, indt+4) = 0.0_8 + funb0 = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO - distpb = 0.0_8 - temp11 = rp3**3 - temp9 = distp(0, 1)/temp11 - temp10 = rp1**3 - temp10b = 0.25d0*temp9*fun2b - temp9b = 0.25d0*(34.d0*rp1-30.d0*rp2+118.d0*(rp1*rp2)+87.d0*rp1**2& -& +18.d0*(rp1**2*rp2)-5.d0*rp1**3-2.d0*(temp10*rp2)-14.d0)*fun2b/& -& temp11 - temp8 = rp3**2 - temp7 = distp(0, 1)/temp8 - temp8b = 0.25d0*temp7*funb - rp1b = (2.d0*2*rp1+3.d0*rp2-12.d0)*temp8b + (18.d0*rp2*2*rp1-5.d0*& -& 3*rp1**2-2.d0*rp2*3*rp1**2+87.d0*2*rp1+118.d0*rp2+34.d0)*temp10b - temp7b = 0.25d0*(3.d0*(rp1*rp2)-12.d0*rp1-29.d0*rp2+2.d0*rp1**2-& -& 14.d0)*funb/temp8 - rp3b = -(temp7*2*rp3*temp7b) - temp9*3*rp3**2*temp9b - rp2b = (3.d0*rp1-29.d0)*temp8b + 2*(rp2+1.d0)*rp3b + (18.d0*rp1**2& -& -2.d0*temp10+118.d0*rp1-30.d0)*temp10b - distpb(0, 1) = temp7b + temp9b - dd2b = r(0)*rp2b - rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b - dd1b = r(0)**2*rp1b + rb(0) = rb(0) + 2*r(0)*fun2b + tempb1 = -(2.d0*funb0) + dd2b = dd2b + distp(0, 1)*tempb1 + distpb(0, 1) = distpb(0, 1) + dd2*tempb1 + dd5b = dd5b + distp(0, 2)*dd4*tempb1 + dd4b = dd4b + distp(0, 2)*dd5*tempb1 + distpb(0, 2) = distpb(0, 2) + dd5*dd4*tempb1 ELSE distpb = 0.0_8 - dd1b = 0.0_8 dd2b = 0.0_8 + dd4b = 0.0_8 + dd5b = 0.0_8 END IF DO i=indtm,i0,-1 - temp6 = 4.d0*dd1 - temp5 = 3.d0/temp6 - temp5b = distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + (temp5-r(i)**2*cost)*zb(indorbp, i) - dd1b = dd1b - temp5*4.d0*temp5b/temp6 - costb = -(r(i)**2*temp5b) - temp4 = dd2*r(i) + 1.d0 - temp5b0 = costb/temp4**2 - temp4b0 = -((0.5d0*(dd2*r(i))+1.d0)*2*temp5b0/temp4) - rb(i) = rb(i) + 0.5d0*dd2*temp5b0 + dd2*temp4b0 - cost*2*r(i)*& -& temp5b + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd4b = dd4b + distp(i, 2)*zb(indorbp, i) + distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) zb(indorbp, i) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = dd2b + r(i)*temp4b0 + 0.5d0*r(i)*temp5b0 END DO - cb = 0.0_8 DO k=indtm,indtmin,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) + tempb = DEXP(-(dd5*r(k)**2))*distpb(k, 2) + dd5b = dd5b - r(k)**2*tempb + distpb(k, 2) = 0.0_8 + tempb0 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + rb(k) = rb(k) - dd2*2*r(k)*tempb0 - dd5*2*r(k)*tempb + dd2b = dd2b - r(k)**2*tempb0 distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp3 = dd2*r(k) + 1.d0 - temp4b = costb/temp3 - temp3b = -(dd1*r(k)**2*temp4b/temp3) - dd1b = dd1b + r(k)**2*temp4b - rb(k) = rb(k) + dd2*temp3b + dd1*2*r(k)*temp4b - dd2b = dd2b + r(k)*temp3b END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocs*0.75d0*dd1**(-0.25D0)*cb - ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocs*0.75d0*dd1**(& -& -0.25D0)*cb - END IF - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (82) + ddb(indpar+3) = ddb(indpar+3) + dd5b + ddb(indpar+2) = ddb(indpar+2) + dd4b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (40) +! 3p without cusp condition derivative of 20 +! r e^{-z1 r } dd1 = dd(indpar+1) - dd2 = DSQRT(dd1) -! if(iflagnorm.gt.2) then -! ratiocp--> ratiocp*dsqrt(2.d0)*pi**(-0.75d0)*2**1.25 -! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0*ratiocp - c = dd1**1.25d0*ratiocp -! endif +! if(iflagnorm.gt.2) then +! c=dsqrt((2.d0*dd1)**5/8.d0/pi)/2.d0 + c = dd1**2.5d0*0.5641895835477562d0 +! endif + c0 = -c + c1 = 2.5d0*c/dd1 +! DO k=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) + distp(k, 1) = DEXP(-(dd1*r(k))) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(k, 2)) + distp(k, 2) = r(k)*distp(k, 1) END DO -! indorbp=indorb -! +! +! indorbp=indorb +! DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif +! +! IF (typec .NE. 1) THEN -! fun=-2.d0*dd1*distp(0,1) -! fun2=fun*(1.d0-2.d0*dd1*r(0)**2) - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) -! the second derivative - fun2 = dd1*distp(0, 1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**& -& 2)/rp3**2 -! indorbp=indorb + fun = (c0*(1.d0-dd1*r(0))-c1*dd1)*distp(0, 1) + fun2 = (c0*dd1*(dd1*r(0)-2.d0)+c1*dd1**2)*distp(0, 1) +! +! indorbp=indorb +! DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -2705,505 +2682,646 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp16b0 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp16b0 - fun2b = fun2b + temp16b0 + temp1 = fun/r(0) + temp2b = rmu(ic, 0)*zb(indorbp, indt+4) + temp1b = 4.d0*temp2b/r(0) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp1+fun2)*zb(indorbp, indt+4& +& ) + funb0 = funb0 + temp1b + rb(0) = rb(0) - temp1*temp1b + fun2b = fun2b + temp2b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp16b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp16b - funb = funb + rmu(ic, 0)*temp16b - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + temp0 = fun/r(0) + temp0b0 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(ic, 0) = rmub(ic, 0) + temp0*rmu(i, 0)*zb(indorbp, indt+i& +& ) + rmub(i, 0) = rmub(i, 0) + temp0*rmu(ic, 0)*zb(indorbp, indt+i) + funb0 = funb0 + temp0b0 + rb(0) = rb(0) - temp0*temp0b0 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp15 = rp3**2 - temp14b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& -& temp15 - temp14 = dd1*distp(0, 1)/temp15 - temp14b0 = temp14*fun2b - rp1b = (2*rp1+4.d0*rp2+4.d0)*temp14b0 - temp13b0 = -(distp(0, 1)*(rp2+2.d0)*funb/rp3) - dd1b = temp13b0 + r(0)**2*rp1b + distp(0, 1)*temp14b - temp13 = dd1/rp3 - distpb(0, 1) = fun0b - temp13*(rp2+2.d0)*funb + dd1*temp14b - rp3b = -(temp13*temp13b0) - temp14*2*rp3*temp14b - rp2b = 2*(rp2+1.d0)*rp3b - temp13*distp(0, 1)*funb + (4.d0*rp1-& -& 2.d0)*temp14b0 - dd2b = r(0)*rp2b - rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b + temp0b = distp(0, 1)*fun2b + temp = dd1*r(0) - 2.d0 + tempb10 = c0*dd1*temp0b + tempb11 = distp(0, 1)*funb0 + c0b = (1.d0-dd1*r(0))*tempb11 + distp(0, 2)*fun0b + temp*dd1*& +& temp0b + dd1b = (-c1-c0*r(0))*tempb11 + r(0)*tempb10 + (c1*2*dd1+temp*c0)*& +& temp0b + rb(0) = rb(0) + dd1*tempb10 - c0*dd1*tempb11 + c1b = distp(0, 1)*fun0b - dd1*tempb11 + dd1**2*temp0b + distpb(0, 1) = (c0*(1.d0-dd1*r(0))-c1*dd1)*funb0 + (c0*dd1*temp+c1& +& *dd1**2)*fun2b + distpb(0, 2) = distpb(0, 2) + c0*fun0b + distpb(0, 1) = distpb(0, 1) + c1*fun0b ELSE distpb = 0.0_8 + c0b = 0.0_8 + c1b = 0.0_8 dd1b = 0.0_8 - dd2b = 0.0_8 END IF DO ic=3,1,-1 DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + tempb9 = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + (c0*distp(i, 2)+c1*distp(i, 1))*zb(& +& indorbp, i) + c0b = c0b + distp(i, 2)*tempb9 + distpb(i, 2) = distpb(i, 2) + c0*tempb9 + c1b = c1b + distp(i, 1)*tempb9 + distpb(i, 1) = distpb(i, 1) + c1*tempb9 zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - cb = 0.0_8 DO k=indtm,indtmin,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) + CALL POPREAL8(adr8ibuf,adr8buf,distp(k, 2)) + rb(k) = rb(k) + distp(k, 1)*distpb(k, 2) + distpb(k, 1) = distpb(k, 1) + r(k)*distpb(k, 2) + distpb(k, 2) = 0.0_8 + tempb8 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*tempb8 + rb(k) = rb(k) - dd1*tempb8 distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp12 = dd2*r(k) + 1.d0 - temp13b = costb/temp12 - temp12b = -(dd1*r(k)**2*temp13b/temp12) - dd1b = dd1b + r(k)**2*temp13b - rb(k) = rb(k) + dd2*temp12b + dd1*2*r(k)*temp13b - dd2b = dd2b + r(k)*temp12b END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocp*1.25d0*dd1**0.25D0*cb - ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocp*1.25d0*dd1**0.25D0*& -& cb - END IF + tempb7 = 2.5d0*c1b/dd1 + cb = tempb7 - c0b + dd1b = dd1b + 0.5641895835477562d0*2.5d0*dd1**1.5D0*cb - c*tempb7/& +& dd1 ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (83) -! derivative of 36 -! R(r)=x*exp(-z*r**2)*(5/4/z-r**2) - dd1 = dd(indpar+1) - dd2 = DSQRT(dd1) -! if(iflagnorm.gt.2) then -! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0*ratiocp - c = dd1**1.25d0*ratiocp -! endif + CASE (52) +! 4p single zeta +! g single gaussian orbital +! derivative of 51 +! R(r)= exp(-alpha r^2) +! normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization +! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0) + c = dd1**2.75d0*1.11284691281640568826d0 +! endif DO k=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO -! indorbp=indorb -! - DO ic=1,3 + DO i=indtmin,indtm + distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& +& 2+3.d0*r(i)**4) +! lz=0 + distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& +& 2-r(i)**2) +! lz=+/-2 + distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& +& (i)**2) +! lz=+/-2 + distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & +& i)**2) +! lz=+/-3 + distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& +& , i)**2) +! lz=+/-3 + distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& +& rmu(2, i)**4) +! lz=+/-4 + distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& +& , i)**2) + END DO +! lz=+/-4 + DO ic=1,9 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - DO i=i0,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*dd2*r(i))/(1.d0+dd2*r(i))**2 - END DO END DO -! endif +! endif IF (typec .NE. 1) THEN - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*rp2)/rp3 - fun = 0.25d0*distp(0, 1)*(-18.d0-39.d0*rp2-20.d0*rp1+rp1*rp2+2.d0*& -& rp1**2)/rp3**2 - fun2 = 0.25d0*distp(0, 1)*(-18.d0-42.d0*rp2+30.d0*rp1+138.d0*rp1*& -& rp2+113.d0*rp1**2+30.d0*rp1**2*rp2-3.d0*rp1**3-2.d0*rp1**3*rp2)/& -& rp3**3 -! indorbp=indorb - DO ic=1,3 + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1)*(11.d0/4.d0/dd1-r(0)**2) + fun = distp(0, 1)*(2.d0*dd1*r(0)**2-15.d0/2.d0) + fun2 = distp(0, 1)*(-(4.d0*dd1**2*r(0)**4)+21.d0*dd1*r(0)**2-15.d0& +& /2.d0) +! indorbp=indorb + DO ic=1,9 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp23b0 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp23b0 - fun2b = fun2b + temp23b0 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp23b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp23b - funb = funb + rmu(ic, 0)*temp23b - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - distpb = 0.0_8 - temp22 = rp3**3 - temp20 = distp(0, 1)/temp22 - temp21 = rp1**3 - temp21b = 0.25d0*temp20*fun2b - temp20b = 0.25d0*(30.d0*rp1-42.d0*rp2+138.d0*(rp1*rp2)+113.d0*rp1& -& **2+30.d0*(rp1**2*rp2)-3.d0*rp1**3-2.d0*(temp21*rp2)-18.d0)*& -& fun2b/temp22 - temp19 = rp3**2 - temp18 = distp(0, 1)/temp19 - temp19b = 0.25d0*temp18*funb - rp1b = (2.d0*2*rp1+rp2-20.d0)*temp19b + (30.d0*rp2*2*rp1-3.d0*3*& -& rp1**2-2.d0*rp2*3*rp1**2+113.d0*2*rp1+138.d0*rp2+30.d0)*temp21b - temp18b2 = 0.25d0*(rp1*rp2-20.d0*rp1-39.d0*rp2+2.d0*rp1**2-18.d0)*& -& funb/temp19 - temp18b3 = distp(0, 1)*fun0b - costb = -(r(0)**2*temp18b3) - rp3b = -(temp18*2*rp3*temp18b2) - (0.5d0*rp2+1.d0)*costb/rp3**2 - & -& temp20*3*rp3**2*temp20b - rp2b = (rp1-39.d0)*temp19b + 2*(rp2+1.d0)*rp3b + 0.5d0*costb/rp3 +& -& (30.d0*rp1**2-2.d0*temp21+138.d0*rp1-42.d0)*temp21b - distpb(0, 1) = temp18b2 + (1.25d0/dd1-r(0)**2*cost)*fun0b + & -& temp20b - dd1b = r(0)**2*rp1b - 1.25d0*temp18b3/dd1**2 - rb(0) = rb(0) + dd2*rp2b + dd1*2*r(0)*rp1b - cost*2*r(0)*temp18b3 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = r(0)*rp2b - ELSE - distpb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 - END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - temp18b = (1.25d0/dd1-r(i)**2*cost)*zb(indorbp, i) - temp18b0 = rmu(ic, i)*distp(i, 1)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp18b - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp18b - dd1b = dd1b - 1.25d0*temp18b0/dd1**2 - costb = -(r(i)**2*temp18b0) - temp17 = dd2*r(i) + 1.d0 - temp18b1 = costb/temp17**2 - temp17b0 = -((0.5d0*(dd2*r(i))+1.d0)*2*temp18b1/temp17) - rb(i) = rb(i) + 0.5d0*dd2*temp18b1 + dd2*temp17b0 - cost*2*r(i)*& -& temp18b0 - zb(indorbp, i) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = dd2b + r(i)*temp17b0 + 0.5d0*r(i)*temp18b1 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - cb = 0.0_8 - DO k=indtm,indtmin,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) - distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp16 = dd2*r(k) + 1.d0 - temp17b = costb/temp16 - temp16b1 = -(dd1*r(k)**2*temp17b/temp16) - dd1b = dd1b + r(k)**2*temp17b - rb(k) = rb(k) + dd2*temp16b1 + dd1*2*r(k)*temp17b - dd2b = dd2b + r(k)*temp16b1 - END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocp*1.25d0*dd1**0.25D0*cb - ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocp*1.25d0*dd1**0.25D0*& -& cb - END IF - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (84) -! d orbitals -! R(r)= exp(-alpha r^2) -! each gaussian term is normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) - dd2 = DSQRT(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)*ratiocd - c = ratiocd*dd1**1.75d0 -! endif - DO k=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) - END DO - DO i=indtmin,indtm -! lz=0 - distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d -! lz=+/-2 - distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d -! lz=+/-2 - distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d -! lz=+/-1 - distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d -! lz=+/-1 - distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d - END DO - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun0 = distp(0, 1) - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) -! the second derivative - fun2 = dd1*distp(0, 1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**& -& 2)/rp3**2 -! indorbp=indorb - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN + IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) END IF ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) END IF ELSE IF (ic .EQ. 3) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) END IF ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + END IF + ELSE IF (ic .EQ. 6) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + END IF + ELSE IF (ic .EQ. 7) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,21) + END IF + ELSE IF (ic .EQ. 8) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,22) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,24) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,23) + END IF + ELSE IF (ic .EQ. 9) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,26) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,28) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,27) END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,25) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp27b4 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 6.d0*temp27b4 - fun2b = fun2b + temp27b4 + DO ic=9,1,-1 + temp8b55 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 10.d0*temp8b55 + fun2b = fun2b + temp8b55 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp27b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp27b0 - fun0b = fun0b + rmu(i, 0)*temp27b0 + IF (branch .LT. 15) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp8b0 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& +& 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& +& ) + rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& +& , 0)**2)*temp8b0 + rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp8b0 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& +& )*temp8b0 + ELSE + temp8b1 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& +& 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& +& ) + rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& +& , 0)**2)*temp8b1 + rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp8b1 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& +& )*temp8b1 + END IF + ELSE IF (branch .LT. 4) THEN + temp8b2 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& +& 3, 0)*r(0)**2))*zb(indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& +& r(0)**2)*temp8b2 + rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp8b2 + ELSE + temp8b3 = cost2g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& +& , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& +& (indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& +& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp8b3 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp8b3 + rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp8b3 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp8b4 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp8b5 = rmu(2, 0)*rmu(3, 0)*temp8b4 + temp8b6 = fun0*rmu(1, 0)*temp8b4 + fun0b = fun0b + rmu(1, 0)*temp8b5 + rmub(1, 0) = rmub(1, 0) + fun0*temp8b5 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp8b6 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp8b6 ELSE - temp27b1 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp27b1 - fun0b = fun0b + rmu(i, 0)*temp27b1 + temp8b7 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp8b8 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**2& +& )*temp8b7 + temp8b9 = fun0*rmu(1, 0)*temp8b7 + fun0b = fun0b + rmu(1, 0)*temp8b8 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp8b9 + fun0*& +& temp8b8 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp8b9 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp8b9 END IF - ELSE IF (branch .LT. 4) THEN - temp27b2 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp27b2 - fun0b = fun0b + rmu(i, 0)*temp27b2 + ELSE + temp8b10 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp8b11 = rmu(2, 0)*rmu(3, 0)*temp8b10 + temp8b12 = fun0*rmu(1, 0)*temp8b10 + fun0b = fun0b + rmu(1, 0)*temp8b11 + rmub(1, 0) = rmub(1, 0) + fun0*temp8b11 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp8b12 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp8b12 END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp27b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp27b3 - fun0b = fun0b + rmu(i, 0)*temp27b3 + ELSE IF (branch .LT. 12) THEN + IF (branch .LT. 10) THEN + IF (branch .LT. 9) THEN + temp8b13 = cost2g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& +& , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& +& (indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& +& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp8b13 + rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp8b13 + rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp8b13 + ELSE + temp8b14 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp8b15 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**& +& 2)*temp8b14 + temp8b16 = fun0*rmu(2, 0)*temp8b14 + fun0b = fun0b + rmu(2, 0)*temp8b15 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp8b16 + fun0*& +& temp8b15 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp8b16 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp8b16 + END IF + ELSE IF (branch .LT. 11) THEN + temp8b17 = -(cost3g*4.d0*zb(indorbp, indt+i)) + temp8b18 = fun0*temp8b17 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& +& **2))*temp8b17 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& +& **2)*temp8b18 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& +& temp8b18 ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + temp8b19 = cost3g*4.d0*zb(indorbp, indt+i) + temp8b20 = fun0*temp8b19 + fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& +& **2))*temp8b19 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& +& **2)*temp8b20 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& +& temp8b20 END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 14) THEN + IF (branch .LT. 13) THEN + temp8b21 = cost3g*12.d0*zb(indorbp, indt+i) + temp8b22 = fun0*rmu(3, 0)*temp8b21 + temp8b23 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp8b21 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp8b22 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp8b22 + fun0b = fun0b + rmu(3, 0)*temp8b23 + rmub(3, 0) = rmub(3, 0) + fun0*temp8b23 + ELSE + temp8b24 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp8b25 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3, 0& +& )**2)*temp8b24 + temp8b26 = fun0*rmu(2, 0)*temp8b24 + fun0b = fun0b + rmu(2, 0)*temp8b25 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp8b26 + fun0*& +& temp8b25 + rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp8b26 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp8b26 + END IF + ELSE + temp8b27 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp8b28 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0)& +& **2)*temp8b27 + temp8b29 = fun0*rmu(1, 0)*temp8b27 + fun0b = fun0b + rmu(1, 0)*temp8b28 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp8b29 + fun0*& +& temp8b28 + rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp8b29 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp8b29 END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 22) THEN + IF (branch .LT. 19) THEN + IF (branch .LT. 17) THEN + IF (branch .LT. 16) THEN + temp8b30 = cost3g*24.d0*zb(indorbp, indt+i) + temp8b31 = rmu(2, 0)*rmu(3, 0)*temp8b30 + temp8b32 = fun0*rmu(1, 0)*temp8b30 + fun0b = fun0b + rmu(1, 0)*temp8b31 + rmub(1, 0) = rmub(1, 0) + fun0*temp8b31 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp8b32 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp8b32 + ELSE + temp8b33 = cost4g*3.d0*zb(indorbp, indt+i) + temp8b34 = fun0*rmu(3, 0)*temp8b33 + temp8b35 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp8b33 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp8b34 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp8b34 + fun0b = fun0b + rmu(3, 0)*temp8b35 + rmub(3, 0) = rmub(3, 0) + fun0*temp8b35 + END IF + ELSE IF (branch .LT. 18) THEN + temp8b36 = -(cost4g*6.d0*zb(indorbp, indt+i)) + temp8b37 = rmu(2, 0)*rmu(3, 0)*temp8b36 + temp8b38 = fun0*rmu(1, 0)*temp8b36 + fun0b = fun0b + rmu(1, 0)*temp8b37 + rmub(1, 0) = rmub(1, 0) + fun0*temp8b37 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp8b38 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp8b38 + ELSE + temp8b39 = cost4g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& +& (2, 0)**2))*zb(indorbp, indt+i) + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& +& **2)*temp8b39 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp8b39 END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 21) THEN + IF (branch .LT. 20) THEN + temp8b40 = cost4g*6.d0*zb(indorbp, indt+i) + temp8b41 = rmu(2, 0)*rmu(3, 0)*temp8b40 + temp8b42 = fun0*rmu(1, 0)*temp8b40 + fun0b = fun0b + rmu(1, 0)*temp8b41 + rmub(1, 0) = rmub(1, 0) + fun0*temp8b41 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp8b42 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp8b42 + ELSE + temp8b43 = cost4g*3.d0*zb(indorbp, indt+i) + temp8b44 = fun0*rmu(3, 0)*temp8b43 + temp8b45 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp8b43 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp8b44 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp8b44 + fun0b = fun0b + rmu(3, 0)*temp8b45 + rmub(3, 0) = rmub(3, 0) + fun0*temp8b45 + END IF + ELSE + temp8b46 = cost4g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& +& 2, 0)**3)*zb(indorbp, indt+i) + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp8b46 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& +& 2)*temp8b46 END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 26) THEN + IF (branch .LT. 24) THEN + IF (branch .LT. 23) THEN + temp8b47 = cost5g*4.d0*zb(indorbp, indt+i) + temp8b48 = fun0*temp8b47 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& +& **2))*temp8b47 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& +& **2)*temp8b48 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp8b48 + END IF + ELSE IF (branch .LT. 25) THEN + temp8b49 = cost5g*4.d0*zb(indorbp, indt+i) + temp8b50 = fun0*temp8b49 + fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& +& ))*temp8b49 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& +& 2)*temp8b50 + rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp8b50 + END IF + ELSE IF (branch .LT. 28) THEN + IF (branch .LT. 27) THEN + temp8b51 = cost5g*4.d0*zb(indorbp, indt+i) + temp8b52 = fun0*temp8b51 + fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& +& 3)*temp8b51 + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp8b52 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& +& 2)*temp8b52 END IF ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + temp8b53 = cost5g*4.d0*zb(indorbp, indt+i) + temp8b54 = fun0*temp8b53 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& +& *temp8b53 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& +& *temp8b54 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp8b54 END IF - temp27b = distp(0, 1+ic)*zb(indorbp, indt+i) + temp8b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp27b - funb = funb + rmu(i, 0)*temp27b + rmub(i, 0) = rmub(i, 0) + fun*temp8b + funb0 = funb0 + rmu(i, 0)*temp8b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp26 = rp3**2 - temp25b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& -& temp26 - temp25 = dd1*distp(0, 1)/temp26 - temp25b0 = temp25*fun2b - rp1b = (2*rp1+4.d0*rp2+4.d0)*temp25b0 - temp24b0 = -(distp(0, 1)*(rp2+2.d0)*funb/rp3) - dd1b = temp24b0 + r(0)**2*rp1b + distp(0, 1)*temp25b - temp24 = dd1/rp3 - distpb(0, 1) = distpb(0, 1) + fun0b - temp24*(rp2+2.d0)*funb + dd1& -& *temp25b - rp3b = -(temp24*temp24b0) - temp25*2*rp3*temp25b - rp2b = 2*(rp2+1.d0)*rp3b - temp24*distp(0, 1)*funb + (4.d0*rp1-& -& 2.d0)*temp25b0 - dd2b = r(0)*rp2b - rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b - ELSE + temp7 = r(0)**4 + temp7b = distp(0, 1)*fun2b + temp6 = 4.d0*dd1 + temp5 = 11.d0/temp6 + distpb(0, 1) = distpb(0, 1) + (2.d0*(dd1*r(0)**2)-15.d0/2.d0)*& +& funb0 + (temp5-r(0)**2)*fun0b + (21.d0*(dd1*r(0)**2)-15.d0/2.d0-& +& 4.d0*(dd1**2*temp7))*fun2b + temp7b0 = distp(0, 1)*2.d0*funb0 + dd1b = r(0)**2*temp7b0 - distp(0, 1)*temp5*4.d0*fun0b/temp6 + (& +& 21.d0*r(0)**2-4.d0*temp7*2*dd1)*temp7b + rb(0) = rb(0) + dd1*2*r(0)*temp7b0 - distp(0, 1)*2*r(0)*fun0b + (& +& 21.d0*dd1*2*r(0)-4.d0*dd1**2*4*r(0)**3)*temp7b + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b + ELSE distpb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 END IF - DO ic=5,1,-1 + dd1b = 0.0_8 + DO ic=9,1,-1 DO k=indtm,i0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + temp5b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) + temp4 = 4.d0*dd1 + temp3 = 11.d0/temp4 + temp3b17 = (temp3-r(k)**2)*zb(indorbp, k) + dd1b = dd1b - temp3*4.d0*temp5b/temp4 + rb(k) = rb(k) - 2*r(k)*temp5b + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp3b17 + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp3b17 zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) + temp3b = cost5g*4.d0*distpb(i, 10) + temp3b0 = (rmu(1, i)**2-rmu(2, i)**2)*temp3b + temp3b1 = rmu(1, i)*rmu(2, i)*temp3b + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp3b1 + rmu(2, i)*temp3b0 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp3b0 - 2*rmu(2, i)*temp3b1 + distpb(i, 10) = 0.0_8 + temp3b2 = cost5g*distpb(i, 9) + rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& +& 1, i))*temp3b2 + distpb(i, 9) = 0.0_8 + temp3b3 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) + temp3b4 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp3b3 - 2*rmu(2, i)*temp3b4 & +& + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*temp3b2 + rmub(3, i) = rmub(3, i) + rmu(2, i)*temp3b3 + distpb(i, 8) = 0.0_8 + temp3b5 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) + temp3b6 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp3b5 + 2*rmu(1, i)*temp3b6 & +& + 3.d0*2*rmu(1, i)*temp3b4 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp3b5 + rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp3b6 + distpb(i, 7) = 0.0_8 + temp3b7 = cost3g*2.d0*distpb(i, 6) + temp3b8 = (7.d0*rmu(3, i)**2-r(i)**2)*temp3b7 + temp3b9 = rmu(1, i)*rmu(2, i)*temp3b7 + rmub(1, i) = rmub(1, i) + rmu(2, i)*temp3b8 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp3b8 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp3b9 distpb(i, 6) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) + temp3b10 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) + temp3b11 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) distpb(i, 5) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) + temp3b12 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) + temp3b13 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) + temp3b14 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) + temp3b15 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) + temp3b16 = cost1g*distpb(i, 2) + rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& +& temp3b16 - 3.d0*2*r(i)*temp3b15 - 2*r(i)*temp3b11 - 3.d0*2*r(i)*& +& temp3b13 - 2*r(i)*temp3b9 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp3b10 + rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp3b10 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp3b11 + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp3b12 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp3b13 + rmu(2, i)*& +& temp3b12 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp3b14 + rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& +& rmu(3, i))*temp3b16 + 7.d0*2*rmu(3, i)*temp3b15 + rmu(1, i)*& +& temp3b14 distpb(i, 2) = 0.0_8 END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) + temp2 = r(k)**2 + temp2b0 = c*DEXP(-(dd1*temp2))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp2))*distpb(k, 1) + dd1b = dd1b - temp2*temp2b0 + rb(k) = rb(k) - dd1*2*r(k)*temp2b0 distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp23 = dd2*r(k) + 1.d0 - temp24b = costb/temp23 - temp23b1 = -(dd1*r(k)**2*temp24b/temp23) - dd1b = dd1b + r(k)**2*temp24b - rb(k) = rb(k) + dd2*temp23b1 + dd1*2*r(k)*temp24b - dd2b = dd2b + r(k)*temp23b1 END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocd*1.75d0*dd1**0.75D0*cb - ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocd*1.75d0*dd1**0.75D0*& -& cb - END IF + dd1b = dd1b + 1.11284691281640568826d0*2.75d0*dd1**1.75D0*cb ddb(indparp) = ddb(indparp) + dd1b - CASE (85) -! derivative of 37 with respect to z -! d orbitals -! R(r)= c*exp(-z r^2)*(7/4/z-r^2) -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) - dd2 = DSQRT(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)*ratiocd - c = dd1**1.75d0*ratiocd -! endif + CASE (31) +! 3d without cusp condition double Z + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd(indpar+3) +! if(iflagnorm.gt.2) then + c = 1/2.d0*DSQRT(5.d0/pi)/DSQRT(1/dd1**7/128.d0+2*peff/(dd1+dd2)**7+& +& peff**2/dd2**7/128.d0)/DSQRT(720.d0) +! endif DO k=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) + distp(k, 1) = DEXP(-(dd1*r(k))) + distp(k, 2) = DEXP(-(dd2*r(k))) END DO DO i=indtmin,indtm -! lz=0 - distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d -! lz=+/-2 - distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d -! lz=+/-2 - distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d -! lz=+/-1 - distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d -! lz=+/-1 - distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = c*(distp(i, 1)+peff*distp(i, 2)) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) +!lz=0 + distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) +!lz=+/-2 + distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) +! lz=+/- 2 + distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) +! lz=+/-1 + distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) +! lz=+/-1 + distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d END DO +! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - DO k=i0,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 - END DO END DO -! endif +! endif IF (typec .NE. 1) THEN - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*rp2)/rp3 - fun0 = distp(0, 1)*(7.d0/4.d0/dd1-r(0)**2*cost) - fun = 0.25d0*distp(0, 1)*(-22.d0-49.d0*rp2-28.d0*rp1-rp1*rp2+2.d0*& -& rp1**2)/rp3**2 - fun2 = -(0.25d0*distp(0, 1)*(22.d0+54.d0*rp2-26.d0*rp1-158.d0*rp1*& -& rp2-139.d0*rp1**2-42.d0*rp1**2*rp2+rp1**3+2.d0*rp1**3*rp2)/rp3**& -& 3) -! indorbp=indorb + fun0 = distp(0, 3) + fun = c*(-(dd1*distp(0, 1))-peff*dd2*distp(0, 2)) + fun2 = c*(dd1**2*distp(0, 1)+peff*dd2**2*distp(0, 2)) +! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN @@ -3250,15 +3368,18 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=5,1,-1 - temp38b4 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 6.d0*temp38b4 - fun2b = fun2b + temp38b4 + temp16 = fun/r(0) + temp17b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp16b3 = 6.d0*temp17b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp16+fun2)*zb(& +& indorbp, indt+4) + funb0 = funb0 + temp16b3 + rb(0) = rb(0) - temp16*temp16b3 + fun2b = fun2b + temp17b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -3266,24 +3387,24 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN IF (branch .LT. 2) THEN - temp38b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp38b0 - fun0b = fun0b + rmu(i, 0)*temp38b0 + temp16b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp16b + fun0b = fun0b + rmu(i, 0)*temp16b ELSE - temp38b1 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp38b1 - fun0b = fun0b + rmu(i, 0)*temp38b1 + temp16b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp16b0 + fun0b = fun0b + rmu(i, 0)*temp16b0 END IF ELSE IF (branch .LT. 4) THEN - temp38b2 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp38b2 - fun0b = fun0b + rmu(i, 0)*temp38b2 + temp16b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp16b1 + fun0b = fun0b + rmu(i, 0)*temp16b1 END IF ELSE IF (branch .LT. 7) THEN IF (branch .LT. 6) THEN - temp38b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp38b3 - fun0b = fun0b + rmu(i, 0)*temp38b3 + temp16b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp16b2 + fun0b = fun0b + rmu(i, 0)*temp16b2 ELSE rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) @@ -3313,1978 +3434,1730 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp38b = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & + temp15 = fun/r(0) + temp15b5 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp15*rmu(i, 0)*zb(& +& indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp15*distp(0, 3+ic)*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp38b - funb = funb + rmu(i, 0)*temp38b + funb0 = funb0 + temp15b5 + rb(0) = rb(0) - temp15*temp15b5 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp37 = rp3**3 - temp35 = distp(0, 1)/temp37 - temp36 = rp1**3 - temp36b = -(0.25d0*temp35*fun2b) - temp35b = -(0.25d0*(54.d0*rp2-26.d0*rp1-158.d0*(rp1*rp2)-139.d0*& -& rp1**2+rp1**3-42.d0*(rp1**2*rp2)+2.d0*(temp36*rp2)+22.d0)*fun2b/& -& temp37) - temp34 = rp3**2 - temp33 = distp(0, 1)/temp34 - temp33b = 0.25d0*(2.d0*rp1**2-28.d0*rp1-49.d0*rp2-rp1*rp2-22.d0)*& -& funb/temp34 - temp31b0 = distp(0, 1)*fun0b - costb = -(r(0)**2*temp31b0) - rp3b = -(temp33*2*rp3*temp33b) - (0.5d0*rp2+1.d0)*costb/rp3**2 - & -& temp35*3*rp3**2*temp35b - temp34b = 0.25d0*temp33*funb - rp2b = ((-49.d0)-rp1)*temp34b + 2*(rp2+1.d0)*rp3b + 0.5d0*costb/& -& rp3 + (2.d0*temp36-42.d0*rp1**2-158.d0*rp1+54.d0)*temp36b - rp1b = (2.d0*2*rp1-rp2-28.d0)*temp34b + (2.d0*rp2*3*rp1**2-42.d0*& -& rp2*2*rp1+3*rp1**2-139.d0*2*rp1-158.d0*rp2-26.d0)*temp36b - temp32 = 4.d0*dd1 - temp31 = 7.d0/temp32 - distpb(0, 1) = distpb(0, 1) + temp33b + (temp31-r(0)**2*cost)*& -& fun0b + temp35b - dd1b = r(0)**2*rp1b - temp31*4.d0*temp31b0/temp32 - rb(0) = rb(0) + dd2*rp2b + dd1*2*r(0)*rp1b - cost*2*r(0)*temp31b0 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = r(0)*rp2b + temp15b2 = c*fun2b + temp15b3 = dd2**2*temp15b2 + cb = (-(dd1*distp(0, 1))-peff*dd2*distp(0, 2))*funb0 + (dd1**2*& +& distp(0, 1)+dd2**2*(peff*distp(0, 2)))*fun2b + temp15b4 = c*funb0 + dd1b = distp(0, 1)*2*dd1*temp15b2 - distp(0, 1)*temp15b4 + distpb(0, 1) = distpb(0, 1) + dd1**2*temp15b2 + dd2b = peff*distp(0, 2)*2*dd2*temp15b2 - distp(0, 2)*peff*temp15b4 + peffb = distp(0, 2)*temp15b3 - distp(0, 2)*dd2*temp15b4 + distpb(0, 2) = distpb(0, 2) + peff*temp15b3 + distpb(0, 1) = distpb(0, 1) - dd1*temp15b4 + distpb(0, 2) = distpb(0, 2) - peff*dd2*temp15b4 + distpb(0, 3) = distpb(0, 3) + fun0b ELSE distpb = 0.0_8 + peffb = 0.0_8 dd1b = 0.0_8 dd2b = 0.0_8 + cb = 0.0_8 END IF DO ic=5,1,-1 - DO k=indtm,i0,-1 - temp31b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) - temp30 = 4.d0*dd1 - temp29 = 7.d0/temp30 - temp29b = (temp29-r(k)**2*cost)*zb(indorbp, k) - dd1b = dd1b - temp29*4.d0*temp31b/temp30 - costb = -(r(k)**2*temp31b) - temp28 = dd2*r(k) + 1.d0 - temp29b0 = costb/temp28**2 - temp28b0 = -((0.5d0*(dd2*r(k))+1.d0)*2*temp29b0/temp28) - rb(k) = rb(k) + 0.5d0*dd2*temp29b0 + dd2*temp28b0 - cost*2*r(k)*& -& temp31b - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp29b - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp29b - zb(indorbp, k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = dd2b + r(k)*temp28b0 + 0.5d0*r(k)*temp29b0 + DO i=indtm,i0,-1 + distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + distpb(i, 8) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + temp15b1 = c*distpb(i, 3) + cb = cb + (distp(i, 1)+peff*distp(i, 2))*distpb(i, 3) + distpb(i, 1) = distpb(i, 1) + temp15b1 + peffb = peffb + distp(i, 2)*temp15b1 + distpb(i, 2) = distpb(i, 2) + peff*temp15b1 distpb(i, 3) = 0.0_8 - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) - distpb(i, 2) = 0.0_8 END DO - cb = 0.0_8 DO k=indtm,indtmin,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) + temp15b = DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp15b + distpb(k, 2) = 0.0_8 + temp15b0 = DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp15b0 - dd2*temp15b + dd1b = dd1b - r(k)*temp15b0 distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp27 = dd2*r(k) + 1.d0 - temp28b = costb/temp27 - temp27b5 = -(dd1*r(k)**2*temp28b/temp27) - dd1b = dd1b + r(k)**2*temp28b - rb(k) = rb(k) + dd2*temp27b5 + dd1*2*r(k)*temp28b - dd2b = dd2b + r(k)*temp27b5 END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocd*1.75d0*dd1**0.75D0*cb + temp14 = 128.d0*dd2**7 + temp13 = peff**2/temp14 + temp12 = (dd1+dd2)**7 + temp11 = 128.d0*dd1**7 + temp8 = 1.0/temp11 + 2*(peff/temp12) + temp13 + temp10 = DSQRT(temp8) + temp9 = 2.d0*DSQRT(720.d0) + IF (temp8 .EQ. 0.0) THEN + temp8b56 = 0.0 ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocd*1.75d0*dd1**0.75D0*& -& cb + temp8b56 = -(DSQRT(5.d0/pi)*cb/(temp9*temp10**2*2.D0*DSQRT(temp8))& +& ) END IF - ddb(indparp) = ddb(indparp) + dd1b - CASE (86) -! f single gaussian orbital -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) - dd2 = DSQRT(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0)*ratiocf - c = dd1**2.25d0*ratiocf -! endif - DO k=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) + temp8b57 = 2*temp8b56/temp12 + temp8b58 = -(peff*7*(dd1+dd2)**6*temp8b57/temp12) + dd1b = dd1b + temp8b58 - 128.d0*7*dd1**6*temp8b56/temp11**2 + peffb = peffb + 2*peff*temp8b56/temp14 + temp8b57 + dd2b = dd2b + temp8b58 - temp13*128.d0*7*dd2**6*temp8b56/temp14 + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (113) +! 2s without cusp condition +! dd1*( dd3 +r^2/(1+dd2*r)^4) + dd2 = dd(indpar+1) + indorbp = indorb + 1 +! endif + IF (typec .NE. 1) THEN + fun = (2.d0-2.d0*dd2*r(0))/(1+dd2*r(0))**5 + fun2b = zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + temp20 = (dd2*r(0)+1)**6 + temp20b = 2.d0*fun2b/temp20 + temp20b0 = -((3.d0*(dd2**2*r(0)**2)-6.d0*(dd2*r(0))+1.d0)*6*(dd2*r& +& (0)+1)**5*temp20b/temp20) + temp19 = (dd2*r(0)+1)**5 + temp19b = funb0/temp19 + temp19b0 = -((2.d0-2.d0*(dd2*r(0)))*5*(dd2*r(0)+1)**4*temp19b/& +& temp19) + dd2b = r(0)*temp19b0 - 2.d0*r(0)*temp19b + r(0)*temp20b0 + (3.d0*r& +& (0)**2*2*dd2-6.d0*r(0))*temp20b + rb(0) = rb(0) + dd2*temp19b0 - 2.d0*dd2*temp19b + dd2*temp20b0 + (& +& 3.d0*dd2**2*2*r(0)-6.d0*dd2)*temp20b + ELSE + dd2b = 0.0_8 + END IF + distpb = 0.0_8 + dd3b = 0.0_8 + DO i=indtm,i0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO - DO i=indtmin,indtm - distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) -! lz=0 - distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) -! lz=+/-2 - distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) -! lz=+/-2 - distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) -! lz=+/-3 - distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) + DO k=indtm,indtmin,-1 + temp17 = dd2*r(k) + 1.d0 + temp18 = temp17**4 + temp17b0 = -(r(k)**2*4*temp17**3*distpb(k, 1)/temp18**2) + rb(k) = rb(k) + dd2*temp17b0 + 2*r(k)*distpb(k, 1)/temp18 + dd2b = dd2b + r(k)*temp17b0 + distpb(k, 1) = 0.0_8 END DO -! lz=+/-3 - DO ic=1,7 + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (10000:11000) + distpb = 0.0_8 + CASE (107) +! Reserved for dummy orbitals +! 2p single lorentian parent of 103 + dd2 = dd(indpar+1) + DO k=indtmin,indtm + distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**2) + END DO +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 1) - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) -! the second derivative - fun2 = dd1*distp(0, 1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**& -& 2)/rp3**2 -! indorbp=indorb - DO ic=1,7 + fun = -(dd2*distp(0, 1)**2*2.d0) + fun2 = fun*distp(0, 1)*(1.d0-3.d0*dd2*r(0)**2) +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF - ELSE IF (ic .EQ. 6) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) - END IF - ELSE IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=7,1,-1 - temp42b23 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 8.d0*temp42b23 - fun2b = fun2b + temp42b23 + DO ic=3,1,-1 + temp22b2 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp22b2 + fun2b = fun2b + temp22b2 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 11) THEN - IF (branch .LT. 6) THEN - IF (branch .LT. 4) THEN - IF (branch .LT. 3) THEN - IF (.NOT.branch .LT. 2) THEN - temp42b2 = cost1f*zb(indorbp, indt+i) - fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& -& temp42b2 - rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& -& temp42b2 - rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp42b2 - END IF - temp42b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) - temp42b1 = rmu(i, 0)*temp42b0 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp42b0 - fun0b = fun0b + rmu(3, 0)*temp42b1 - rmub(3, 0) = rmub(3, 0) + fun0*temp42b1 - GOTO 100 - ELSE - temp42b5 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp42b5 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp42b5 - rb(0) = rb(0) - fun0*2*r(0)*temp42b5 - END IF - ELSE IF (.NOT.branch .LT. 5) THEN - temp42b6 = cost2f*10.d0*zb(indorbp, indt+i) - temp42b7 = rmu(i, 0)*temp42b6 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp42b6 - fun0b = fun0b + rmu(1, 0)*temp42b7 - rmub(1, 0) = rmub(1, 0) + fun0*temp42b7 - END IF - temp42b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp42b4 = rmu(i, 0)*temp42b3 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp42b3 - fun0b = fun0b + rmu(1, 0)*temp42b4 - rmub(1, 0) = rmub(1, 0) + fun0*temp42b4 - ELSE IF (branch .LT. 9) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 7) THEN - temp42b10 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp42b10 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp42b10 - rb(0) = rb(0) - fun0*2*r(0)*temp42b10 - END IF - ELSE - temp42b11 = cost2f*10.d0*zb(indorbp, indt+i) - temp42b12 = rmu(i, 0)*temp42b11 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp42b11 - fun0b = fun0b + rmu(2, 0)*temp42b12 - rmub(2, 0) = rmub(2, 0) + fun0*temp42b12 - END IF - temp42b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp42b9 = rmu(i, 0)*temp42b8 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp42b8 - fun0b = fun0b + rmu(2, 0)*temp42b9 - rmub(2, 0) = rmub(2, 0) + fun0*temp42b9 - ELSE IF (branch .LT. 10) THEN - temp42b13 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp42b13 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp42b13 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp42b13 - ELSE - temp42b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp42b14 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp42b14 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp42b14 - END IF - ELSE IF (branch .LT. 16) THEN - IF (branch .LT. 14) THEN - IF (branch .LT. 13) THEN - IF (branch .LT. 12) THEN - temp42b15 = cost3f*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp42b15 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp42b15 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp42b15 - ELSE - temp42b16 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp42b16 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp42b16 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp42b16 - END IF - ELSE - temp42b17 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp42b17 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp42b17 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp42b17 - END IF - ELSE IF (branch .LT. 15) THEN - temp42b18 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp42b18 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp42b18 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp42b18 - ELSE - temp42b19 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp42b19 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp42b19 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp42b19 - END IF - ELSE IF (branch .LT. 19) THEN - IF (branch .LT. 18) THEN - IF (.NOT.branch .LT. 17) THEN - temp42b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp42b20 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp42b20 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp42b20 - END IF - ELSE - temp42b21 = cost4f*6.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp42b21 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp42b21 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp42b21 - END IF - ELSE IF (.NOT.branch .LT. 20) THEN - temp42b22 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp42b22 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp42b22 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp42b22 - END IF - 100 temp42b = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp42b - funb = funb + rmu(i, 0)*temp42b + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp22b1 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp22b1 + funb0 = funb0 + rmu(ic, 0)*temp22b1 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp41 = rp3**2 - temp40b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& -& temp41 - temp40 = dd1*distp(0, 1)/temp41 - temp40b0 = temp40*fun2b - rp1b = (2*rp1+4.d0*rp2+4.d0)*temp40b0 - temp39b8 = -(distp(0, 1)*(rp2+2.d0)*funb/rp3) - dd1b = temp39b8 + r(0)**2*rp1b + distp(0, 1)*temp40b - temp39 = dd1/rp3 - distpb(0, 1) = distpb(0, 1) + fun0b - temp39*(rp2+2.d0)*funb + dd1& -& *temp40b - rp3b = -(temp39*temp39b8) - temp40*2*rp3*temp40b - rp2b = 2*(rp2+1.d0)*rp3b - temp39*distp(0, 1)*funb + (4.d0*rp1-& -& 2.d0)*temp40b0 - dd2b = r(0)*rp2b - rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b + distpb = 0.0_8 + temp22b = (1.d0-3.d0*(dd2*r(0)**2))*fun2b + temp22b0 = -(fun*distp(0, 1)*3.d0*fun2b) + funb0 = funb0 + distp(0, 1)*temp22b + distpb(0, 1) = fun0b - 2.d0*dd2*2*distp(0, 1)*funb0 + fun*temp22b + dd2b = r(0)**2*temp22b0 - 2.d0*distp(0, 1)**2*funb0 + rb(0) = rb(0) + dd2*2*r(0)*temp22b0 ELSE distpb = 0.0_8 - dd1b = 0.0_8 dd2b = 0.0_8 END IF - DO ic=7,1,-1 - DO k=indtm,i0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) - zb(indorbp, k) = 0.0_8 + DO ic=3,1,-1 + DO i=indtm,i0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=indtm,indtmin,-1 - temp39b0 = cost4f*rmu(2, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 8) - 2*rmu(2, i)*temp39b0 - distpb(i, 8) = 0.0_8 - temp39b1 = cost4f*rmu(1, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& -& distpb(i, 7) + 2*rmu(1, i)*temp39b1 + 3.d0*2*rmu(1, i)*temp39b0 - rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp39b1 - distpb(i, 7) = 0.0_8 - temp39b2 = cost3f*2.d0*distpb(i, 6) - temp39b3 = rmu(2, i)*temp39b2 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp39b3 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp39b3 - rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp39b2 - distpb(i, 6) = 0.0_8 - temp39b4 = cost3f*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 5) - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp39b4 - distpb(i, 5) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 4) - 2*rmu(2, i)*temp39b4 - temp39b5 = cost2f*rmu(2, i)*distpb(i, 4) - rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp39b5 - distpb(i, 4) = 0.0_8 - temp39b6 = cost2f*rmu(1, i)*distpb(i, 3) - rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 3) - distpb(i, 3) = 0.0_8 - temp39b7 = cost1f*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - 2*r(i)*temp39b6 - 3.d0*2*r(i)*temp39b7 - 2*r(i)*& -& temp39b5 - rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& -& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp39b7 + 5.d0*2*rmu(3, i)*& -& temp39b6 - distpb(i, 2) = 0.0_8 - END DO - cb = 0.0_8 DO k=indtm,indtmin,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) + temp21 = dd2*r(k)**2 + 1.d0 + temp21b = -(distpb(k, 1)/temp21**2) + dd2b = dd2b + r(k)**2*temp21b + rb(k) = rb(k) + dd2*2*r(k)*temp21b distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp38 = dd2*r(k) + 1.d0 - temp39b = costb/temp38 - temp38b5 = -(dd1*r(k)**2*temp39b/temp38) - dd1b = dd1b + r(k)**2*temp39b - rb(k) = rb(k) + dd2*temp38b5 + dd1*2*r(k)*temp39b - dd2b = dd2b + r(k)*temp38b5 END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocf*2.25d0*dd1**1.25D0*cb - ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocf*2.25d0*dd1**1.25D0*& -& cb - END IF - ddb(indparp) = ddb(indparp) + dd1b - CASE (87) -! derivative of 48 with respect to z -! f orbitals -! R(r)= c*exp(-z r^2)*(9/4/z-r^2) -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) - dd2 = DSQRT(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0)*ratiocf - c = dd1**2.25d0*ratiocf -! endif + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (43) +! 4d without cusp and one parmater derivative of 33 + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c= & +! &1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) + c = dd1**4.5d0*0.0710812062076410d0 +! endif + c0 = -c + c1 = 4.5d0*c/dd1 DO k=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) + distp(k, 1) = DEXP(-(dd1*r(k))) END DO DO i=indtmin,indtm - distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) -! lz=0 - distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) -! lz=+/-2 - distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) -! lz=+/-2 - distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) -! lz=+/-3 - distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = distp(i, 1)*(c0*r(i)**2+c1*r(i)) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) +! lz=0 + distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) +! lz=+/ + distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) +! lz=+/-2 + distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) +! lz=+/-1 + distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) +! lz=+/-1 + distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d END DO -! lz=+/-3 - DO ic=1,7 +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - DO k=i0,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 - END DO END DO -! endif +! endif IF (typec .NE. 1) THEN - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*rp2)/rp3 - fun0 = distp(0, 1)*(9.d0/4.d0/dd1-r(0)**2*cost) - fun = 0.25d0*distp(0, 1)*(-26.d0-59.d0*rp2-36.d0*rp1-3.d0*rp1*rp2+& -& 2.d0*rp1**2)/rp3**2 - fun2 = 0.25d0*distp(0, 1)*(-26.d0-66.d0*rp2+22.d0*rp1+178.d0*rp1*& -& rp2+165.d0*rp1**2+54.d0*rp1**2*rp2+rp1**3-2.d0*rp1**3*rp2)/rp3**& -& 3 -! indorbp=indorb - DO ic=1,7 + fun0 = distp(0, 3) + fun = -(dd1*distp(0, 3)) + distp(0, 1)*(2.d0*c0*r(0)+c1) + fun2 = dd1**2*distp(0, 3) + distp(0, 1)*(-(2.d0*dd1*(2.d0*c0*r(0)+& +& c1))+2.d0*c0) +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN - IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE + IF (i .NE. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) END IF ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 3) THEN + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 2) THEN + IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 3) THEN + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) END IF ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 1) THEN + IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF - ELSE IF (ic .EQ. 6) THEN - IF (i .EQ. 1) THEN + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) END IF - ELSE IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=7,1,-1 - temp53b23 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 8.d0*temp53b23 - fun2b = fun2b + temp53b23 + DO ic=5,1,-1 + temp24 = fun/r(0) + temp25b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp24b3 = 6.d0*temp25b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp24+fun2)*zb(& +& indorbp, indt+4) + funb0 = funb0 + temp24b3 + rb(0) = rb(0) - temp24*temp24b3 + fun2b = fun2b + temp25b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 11) THEN - IF (branch .LT. 6) THEN - IF (branch .LT. 4) THEN - IF (branch .LT. 3) THEN - IF (.NOT.branch .LT. 2) THEN - temp53b2 = cost1f*zb(indorbp, indt+i) - fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& -& temp53b2 - rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& -& temp53b2 - rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp53b2 - END IF - temp53b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) - temp53b1 = rmu(i, 0)*temp53b0 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp53b0 - fun0b = fun0b + rmu(3, 0)*temp53b1 - rmub(3, 0) = rmub(3, 0) + fun0*temp53b1 - GOTO 110 + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp24b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp24b + fun0b = fun0b + rmu(i, 0)*temp24b ELSE - temp53b5 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp53b5 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp53b5 - rb(0) = rb(0) - fun0*2*r(0)*temp53b5 + temp24b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp24b0 + fun0b = fun0b + rmu(i, 0)*temp24b0 END IF - ELSE IF (.NOT.branch .LT. 5) THEN - temp53b6 = cost2f*10.d0*zb(indorbp, indt+i) - temp53b7 = rmu(i, 0)*temp53b6 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp53b6 - fun0b = fun0b + rmu(1, 0)*temp53b7 - rmub(1, 0) = rmub(1, 0) + fun0*temp53b7 + ELSE IF (branch .LT. 4) THEN + temp24b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp24b1 + fun0b = fun0b + rmu(i, 0)*temp24b1 END IF - temp53b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp53b4 = rmu(i, 0)*temp53b3 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp53b3 - fun0b = fun0b + rmu(1, 0)*temp53b4 - rmub(1, 0) = rmub(1, 0) + fun0*temp53b4 - ELSE IF (branch .LT. 9) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 7) THEN - temp53b10 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp53b10 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp53b10 - rb(0) = rb(0) - fun0*2*r(0)*temp53b10 - END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp24b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp24b2 + fun0b = fun0b + rmu(i, 0)*temp24b2 ELSE - temp53b11 = cost2f*10.d0*zb(indorbp, indt+i) - temp53b12 = rmu(i, 0)*temp53b11 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp53b11 - fun0b = fun0b + rmu(2, 0)*temp53b12 - rmub(2, 0) = rmub(2, 0) + fun0*temp53b12 + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - temp53b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp53b9 = rmu(i, 0)*temp53b8 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp53b8 - fun0b = fun0b + rmu(2, 0)*temp53b9 - rmub(2, 0) = rmub(2, 0) + fun0*temp53b9 - ELSE IF (branch .LT. 10) THEN - temp53b13 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp53b13 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp53b13 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp53b13 - ELSE - temp53b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp53b14 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp53b14 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp53b14 + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 16) THEN - IF (branch .LT. 14) THEN - IF (branch .LT. 13) THEN - IF (branch .LT. 12) THEN - temp53b15 = cost3f*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp53b15 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp53b15 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp53b15 - ELSE - temp53b16 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp53b16 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp53b16 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp53b16 - END IF - ELSE - temp53b17 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp53b17 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp53b17 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp53b17 + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 15) THEN - temp53b18 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp53b18 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp53b18 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp53b18 - ELSE - temp53b19 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp53b19 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp53b19 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp53b19 + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 19) THEN - IF (branch .LT. 18) THEN - IF (.NOT.branch .LT. 17) THEN - temp53b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp53b20 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp53b20 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp53b20 - END IF - ELSE - temp53b21 = cost4f*6.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp53b21 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp53b21 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp53b21 + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF - ELSE IF (.NOT.branch .LT. 20) THEN - temp53b22 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp53b22 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp53b22 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp53b22 + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - 110 temp53b = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & + temp23 = fun/r(0) + temp23b0 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp23*rmu(i, 0)*zb(& +& indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp23*distp(0, 3+ic)*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp53b - funb = funb + rmu(i, 0)*temp53b + funb0 = funb0 + temp23b0 + rb(0) = rb(0) - temp23*temp23b0 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp52 = rp3**3 - temp50 = distp(0, 1)/temp52 - temp51 = rp1**3 - temp51b = 0.25d0*temp50*fun2b - temp50b = 0.25d0*(22.d0*rp1-66.d0*rp2+178.d0*(rp1*rp2)+165.d0*rp1& -& **2+54.d0*(rp1**2*rp2)+rp1**3-2.d0*(temp51*rp2)-26.d0)*fun2b/& -& temp52 - temp49 = rp3**2 - temp48 = distp(0, 1)/temp49 - temp49b = 0.25d0*temp48*funb - rp1b = (2.d0*2*rp1-3.d0*rp2-36.d0)*temp49b + (3*rp1**2-2.d0*rp2*3*& -& rp1**2+54.d0*rp2*2*rp1+165.d0*2*rp1+178.d0*rp2+22.d0)*temp51b - temp48b = 0.25d0*(2.d0*rp1**2-36.d0*rp1-59.d0*rp2-3.d0*(rp1*rp2)-& -& 26.d0)*funb/temp49 - temp46b0 = distp(0, 1)*fun0b - costb = -(r(0)**2*temp46b0) - rp3b = -(temp48*2*rp3*temp48b) - (0.5d0*rp2+1.d0)*costb/rp3**2 - & -& temp50*3*rp3**2*temp50b - rp2b = ((-59.d0)-3.d0*rp1)*temp49b + 2*(rp2+1.d0)*rp3b + 0.5d0*& -& costb/rp3 + (54.d0*rp1**2-2.d0*temp51+178.d0*rp1-66.d0)*temp51b - temp47 = 4.d0*dd1 - temp46 = 9.d0/temp47 - distpb(0, 1) = distpb(0, 1) + temp48b + (temp46-r(0)**2*cost)*& -& fun0b + temp50b - dd1b = r(0)**2*rp1b - temp46*4.d0*temp46b0/temp47 - rb(0) = rb(0) + dd2*rp2b + dd1*2*r(0)*rp1b - cost*2*r(0)*temp46b0 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = r(0)*rp2b + temp22 = 2.d0*c0*r(0) + c1 + temp23b = -(distp(0, 1)*2.d0*fun2b) + temp22b6 = dd1*temp23b + dd1b = temp22*temp23b - distp(0, 3)*funb0 + distp(0, 3)*2*dd1*& +& fun2b + distpb(0, 3) = distpb(0, 3) + dd1**2*fun2b + distpb(0, 1) = distpb(0, 1) + (2.d0*(c0*r(0))+c1)*funb0 + (2.d0*c0& +& -2.d0*(dd1*temp22))*fun2b + temp22b7 = distp(0, 1)*funb0 + c0b = 2.d0*r(0)*temp22b7 + 2.d0*r(0)*temp22b6 + distp(0, 1)*2.d0*& +& fun2b + rb(0) = rb(0) + 2.d0*c0*temp22b7 + 2.d0*c0*temp22b6 + c1b = temp22b7 + temp22b6 + distpb(0, 3) = distpb(0, 3) + fun0b - dd1*funb0 ELSE distpb = 0.0_8 + c0b = 0.0_8 + c1b = 0.0_8 dd1b = 0.0_8 - dd2b = 0.0_8 END IF - DO ic=7,1,-1 - DO k=indtm,i0,-1 - temp46b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) - temp45 = 4.d0*dd1 - temp44 = 9.d0/temp45 - temp44b = (temp44-r(k)**2*cost)*zb(indorbp, k) - dd1b = dd1b - temp44*4.d0*temp46b/temp45 - costb = -(r(k)**2*temp46b) - temp43 = dd2*r(k) + 1.d0 - temp44b0 = costb/temp43**2 - temp43b8 = -((0.5d0*(dd2*r(k))+1.d0)*2*temp44b0/temp43) - rb(k) = rb(k) + 0.5d0*dd2*temp44b0 + dd2*temp43b8 - cost*2*r(k)*& -& temp46b - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp44b - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp44b - zb(indorbp, k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = dd2b + r(k)*temp43b8 + 0.5d0*r(k)*temp44b0 + DO ic=5,1,-1 + DO i=indtm,i0,-1 + distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 - temp43b0 = cost4f*rmu(2, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 8) - 2*rmu(2, i)*temp43b0 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) distpb(i, 8) = 0.0_8 - temp43b1 = cost4f*rmu(1, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& -& distpb(i, 7) + 2*rmu(1, i)*temp43b1 + 3.d0*2*rmu(1, i)*temp43b0 - rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp43b1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) distpb(i, 7) = 0.0_8 - temp43b2 = cost3f*2.d0*distpb(i, 6) - temp43b3 = rmu(2, i)*temp43b2 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp43b3 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp43b3 - rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp43b2 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 - temp43b4 = cost3f*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 5) - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp43b4 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 4) - 2*rmu(2, i)*temp43b4 - temp43b5 = cost2f*rmu(2, i)*distpb(i, 4) - rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp43b5 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - temp43b6 = cost2f*rmu(1, i)*distpb(i, 3) - rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 3) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + temp22b5 = distp(i, 1)*distpb(i, 3) + distpb(i, 1) = distpb(i, 1) + (c0*r(i)**2+c1*r(i))*distpb(i, 3) + c0b = c0b + r(i)**2*temp22b5 + rb(i) = rb(i) + (c1+c0*2*r(i))*temp22b5 + c1b = c1b + r(i)*temp22b5 distpb(i, 3) = 0.0_8 - temp43b7 = cost1f*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - 2*r(i)*temp43b6 - 3.d0*2*r(i)*temp43b7 - 2*r(i)*& -& temp43b5 - rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& -& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp43b7 + 5.d0*2*rmu(3, i)*& -& temp43b6 - distpb(i, 2) = 0.0_8 + END DO + DO k=indtm,indtmin,-1 + temp22b4 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp22b4 + rb(k) = rb(k) - dd1*temp22b4 + distpb(k, 1) = 0.0_8 + END DO + temp22b3 = 4.5d0*c1b/dd1 + cb = temp22b3 - c0b + dd1b = dd1b + 0.0710812062076410d0*4.5d0*dd1**3.5D0*cb - c*temp22b3/& +& dd1 + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (6) +! derivative of 36 with respect zeta +! normalized +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd(indpar+3) +! if(iflagnorm.gt.2) then +! c= WRONG +! &0.5*dsqrt((1.d0/dd1**5/32.d0+2.d0*peff/(dd1+dd2)**5 +! &+peff**2/dd2**5/32.d0)/(24.d0*pi)) + c = 1.d0/DSQRT(3.d0*pi*(1.d0/dd1**5+64.d0*peff/(dd1+dd2)**5+peff**2/& +& dd2**5)) +! endif + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 2) = c*DEXP(-(dd2*r(k))) + END DO + IF (typec .NE. 1) THEN + fun = distp(0, 1)*(1.d0-dd1*r(0)) + peff*distp(0, 2)*(1.d0-dd2*r(0& +& )) + temp32b = 2.d0*zb(indorbp, indt+4)/r(0) + funb0 = temp32b + rb(0) = rb(0) - fun*temp32b/r(0) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + temp31 = fun/r(0) + temp31b7 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(i, 0) = rmub(i, 0) + temp31*zb(indorbp, indt+i) + funb0 = funb0 + temp31b7 + rb(0) = rb(0) - temp31*temp31b7 + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp31b2 = distp(0, 1)*fun2b + temp31b3 = (dd2**2*r(0)-2.d0*dd2)*fun2b + temp31b4 = peff*distp(0, 2)*fun2b + distpb(0, 1) = (dd1**2*r(0)-2.d0*dd1)*fun2b + dd1b = (r(0)*2*dd1-2.d0)*temp31b2 - distp(0, 1)*r(0)*funb0 + temp31b5 = peff*distp(0, 2)*funb0 + rb(0) = rb(0) + dd2**2*temp31b4 - dd2*temp31b5 - distp(0, 1)*dd1*& +& funb0 + dd1**2*temp31b2 + temp31b6 = (1.d0-dd2*r(0))*funb0 + peffb = distp(0, 2)*temp31b6 + distp(0, 2)*temp31b3 + distpb(0, 2) = peff*temp31b3 + dd2b = (r(0)*2*dd2-2.d0)*temp31b4 - r(0)*temp31b5 + distpb(0, 1) = distpb(0, 1) + (1.d0-dd1*r(0))*funb0 + distpb(0, 2) = distpb(0, 2) + peff*temp31b6 + ELSE + distpb = 0.0_8 + peffb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 + END IF + DO i=indtm,i0,-1 + temp31b1 = r(i)*zb(indorbp, i) + rb(i) = rb(i) + (distp(i, 1)+distp(i, 2)*peff)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp31b1 + distpb(i, 2) = distpb(i, 2) + peff*temp31b1 + peffb = peffb + distp(i, 2)*temp31b1 + zb(indorbp, i) = 0.0_8 END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) + temp31b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp31b + distpb(k, 2) = 0.0_8 + temp31b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp31b0 - dd2*temp31b + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp31b0 distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp42 = dd2*r(k) + 1.d0 - temp43b = costb/temp42 - temp42b24 = -(dd1*r(k)**2*temp43b/temp42) - dd1b = dd1b + r(k)**2*temp43b - rb(k) = rb(k) + dd2*temp42b24 + dd1*2*r(k)*temp43b - dd2b = dd2b + r(k)*temp42b24 END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocf*2.25d0*dd1**1.25D0*cb + temp30 = dd2**5 + temp29 = peff**2/temp30 + temp28 = (dd1+dd2)**5 + temp27 = dd1**5 + temp26 = 3.d0*pi*(1.0/temp27+64.d0*peff/temp28+temp29) + temp25 = DSQRT(temp26) + IF (temp26 .EQ. 0.0) THEN + temp25b0 = 0.0 ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocf*2.25d0*dd1**1.25D0*& -& cb + temp25b0 = -(pi*3.d0*cb/(temp25**2*2.D0*DSQRT(temp26))) END IF - ddb(indparp) = ddb(indparp) + dd1b - CASE (88) -! g single gaussian orbital -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) - dd2 = DSQRT(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0)*ratiocg - c = dd1**2.75d0*ratiocg -! endif + temp25b1 = 64.d0*temp25b0/temp28 + temp25b2 = -(peff*5*(dd1+dd2)**4*temp25b1/temp28) + dd1b = dd1b + temp25b2 - 5*dd1**4*temp25b0/temp27**2 + peffb = peffb + 2*peff*temp25b0/temp30 + temp25b1 + dd2b = dd2b + temp25b2 - temp29*5*dd2**4*temp25b0/temp30 + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (136) +! 2s double Z NO CUSP +! 2p single exponential r^5 e^{-z r} ! + dd2 = dd(indpar+1) DO k=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) - END DO - DO i=indtmin,indtm - distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& -& 2+3.d0*r(i)**4) -! lz=0 - distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& -& 2-r(i)**2) -! lz=+/-2 - distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& -& (i)**2) -! lz=+/-2 - distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & -& i)**2) -! lz=+/-3 - distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& -& , i)**2) -! lz=+/-3 - distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& -& rmu(2, i)**4) -! lz=+/-4 - distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& -& , i)**2) + distp(k, 1) = DEXP(-(dd2*r(k))) END DO -! lz=+/-4 - DO ic=1,9 +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 1) - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) -! the second derivative - fun2 = dd1*distp(0, 1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**& -& 2)/rp3**2 -! indorbp=indorb - DO ic=1,9 + fun = distp(0, 1)*(5.d0-dd2*r(0))*r(0)**3 + fun2 = distp(0, 1)*(20*r(0)**3-10*dd2*r(0)**4+dd2**2*r(0)**5) +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - END IF - ELSE IF (ic .EQ. 6) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - END IF - ELSE IF (ic .EQ. 7) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,21) - END IF - ELSE IF (ic .EQ. 8) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,22) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,24) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,23) - END IF - ELSE IF (ic .EQ. 9) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,26) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,28) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,27) - END IF + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,25) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=9,1,-1 - temp57b55 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 10.d0*temp57b55 - fun2b = fun2b + temp57b55 + DO ic=3,1,-1 + temp34b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp34b0 + fun2b = fun2b + temp34b0 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 15) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp57b0 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& -& 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& -& ) - rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp57b0 - rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp57b0 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& -& )*temp57b0 - ELSE - temp57b1 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& -& 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& -& ) - rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp57b1 - rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp57b1 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& -& )*temp57b1 - END IF - ELSE IF (branch .LT. 4) THEN - temp57b2 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& -& 3, 0)*r(0)**2))*zb(indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& -& r(0)**2)*temp57b2 - rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp57b2 - ELSE - temp57b3 = cost2g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& -& , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& -& (indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& -& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp57b3 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp57b3 - rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp57b3 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp57b4 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp57b5 = rmu(2, 0)*rmu(3, 0)*temp57b4 - temp57b6 = fun0*rmu(1, 0)*temp57b4 - fun0b = fun0b + rmu(1, 0)*temp57b5 - rmub(1, 0) = rmub(1, 0) + fun0*temp57b5 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp57b6 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp57b6 - ELSE - temp57b7 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp57b8 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**& -& 2)*temp57b7 - temp57b9 = fun0*rmu(1, 0)*temp57b7 - fun0b = fun0b + rmu(1, 0)*temp57b8 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp57b9 + fun0*& -& temp57b8 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp57b9 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp57b9 - END IF - ELSE - temp57b10 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp57b11 = rmu(2, 0)*rmu(3, 0)*temp57b10 - temp57b12 = fun0*rmu(1, 0)*temp57b10 - fun0b = fun0b + rmu(1, 0)*temp57b11 - rmub(1, 0) = rmub(1, 0) + fun0*temp57b11 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp57b12 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp57b12 - END IF - ELSE IF (branch .LT. 12) THEN - IF (branch .LT. 10) THEN - IF (branch .LT. 9) THEN - temp57b13 = cost2g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& -& , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& -& (indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& -& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp57b13 - rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp57b13 - rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp57b13 - ELSE - temp57b14 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp57b15 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& -& **2)*temp57b14 - temp57b16 = fun0*rmu(2, 0)*temp57b14 - fun0b = fun0b + rmu(2, 0)*temp57b15 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp57b16 + fun0& -& *temp57b15 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp57b16 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp57b16 - END IF - ELSE IF (branch .LT. 11) THEN - temp57b17 = -(cost3g*4.d0*zb(indorbp, indt+i)) - temp57b18 = fun0*temp57b17 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& -& **2))*temp57b17 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp57b18 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& -& temp57b18 - ELSE - temp57b19 = cost3g*4.d0*zb(indorbp, indt+i) - temp57b20 = fun0*temp57b19 - fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& -& **2))*temp57b19 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp57b20 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& -& temp57b20 - END IF - ELSE IF (branch .LT. 14) THEN - IF (branch .LT. 13) THEN - temp57b21 = cost3g*12.d0*zb(indorbp, indt+i) - temp57b22 = fun0*rmu(3, 0)*temp57b21 - temp57b23 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp57b21 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp57b22 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp57b22 - fun0b = fun0b + rmu(3, 0)*temp57b23 - rmub(3, 0) = rmub(3, 0) + fun0*temp57b23 - ELSE - temp57b24 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp57b25 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3, & -& 0)**2)*temp57b24 - temp57b26 = fun0*rmu(2, 0)*temp57b24 - fun0b = fun0b + rmu(2, 0)*temp57b25 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp57b26 + fun0*& -& temp57b25 - rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp57b26 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp57b26 - END IF - ELSE - temp57b27 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp57b28 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0)& -& **2)*temp57b27 - temp57b29 = fun0*rmu(1, 0)*temp57b27 - fun0b = fun0b + rmu(1, 0)*temp57b28 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp57b29 + fun0*& -& temp57b28 - rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp57b29 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp57b29 - END IF - ELSE IF (branch .LT. 22) THEN - IF (branch .LT. 19) THEN - IF (branch .LT. 17) THEN - IF (branch .LT. 16) THEN - temp57b30 = cost3g*24.d0*zb(indorbp, indt+i) - temp57b31 = rmu(2, 0)*rmu(3, 0)*temp57b30 - temp57b32 = fun0*rmu(1, 0)*temp57b30 - fun0b = fun0b + rmu(1, 0)*temp57b31 - rmub(1, 0) = rmub(1, 0) + fun0*temp57b31 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp57b32 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp57b32 - ELSE - temp57b33 = cost4g*3.d0*zb(indorbp, indt+i) - temp57b34 = fun0*rmu(3, 0)*temp57b33 - temp57b35 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp57b33 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp57b34 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp57b34 - fun0b = fun0b + rmu(3, 0)*temp57b35 - rmub(3, 0) = rmub(3, 0) + fun0*temp57b35 - END IF - ELSE IF (branch .LT. 18) THEN - temp57b36 = -(cost4g*6.d0*zb(indorbp, indt+i)) - temp57b37 = rmu(2, 0)*rmu(3, 0)*temp57b36 - temp57b38 = fun0*rmu(1, 0)*temp57b36 - fun0b = fun0b + rmu(1, 0)*temp57b37 - rmub(1, 0) = rmub(1, 0) + fun0*temp57b37 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp57b38 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp57b38 - ELSE - temp57b39 = cost4g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& -& (2, 0)**2))*zb(indorbp, indt+i) - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp57b39 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp57b39 - END IF - ELSE IF (branch .LT. 21) THEN - IF (branch .LT. 20) THEN - temp57b40 = cost4g*6.d0*zb(indorbp, indt+i) - temp57b41 = rmu(2, 0)*rmu(3, 0)*temp57b40 - temp57b42 = fun0*rmu(1, 0)*temp57b40 - fun0b = fun0b + rmu(1, 0)*temp57b41 - rmub(1, 0) = rmub(1, 0) + fun0*temp57b41 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp57b42 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp57b42 - ELSE - temp57b43 = cost4g*3.d0*zb(indorbp, indt+i) - temp57b44 = fun0*rmu(3, 0)*temp57b43 - temp57b45 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp57b43 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp57b44 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp57b44 - fun0b = fun0b + rmu(3, 0)*temp57b45 - rmub(3, 0) = rmub(3, 0) + fun0*temp57b45 - END IF - ELSE - temp57b46 = cost4g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& -& 2, 0)**3)*zb(indorbp, indt+i) - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp57b46 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp57b46 - END IF - ELSE IF (branch .LT. 26) THEN - IF (branch .LT. 24) THEN - IF (branch .LT. 23) THEN - temp57b47 = cost5g*4.d0*zb(indorbp, indt+i) - temp57b48 = fun0*temp57b47 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& -& **2))*temp57b47 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp57b48 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp57b48 - END IF - ELSE IF (branch .LT. 25) THEN - temp57b49 = cost5g*4.d0*zb(indorbp, indt+i) - temp57b50 = fun0*temp57b49 - fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& -& ))*temp57b49 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& -& 2)*temp57b50 - rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp57b50 - END IF - ELSE IF (branch .LT. 28) THEN - IF (branch .LT. 27) THEN - temp57b51 = cost5g*4.d0*zb(indorbp, indt+i) - temp57b52 = fun0*temp57b51 - fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& -& 3)*temp57b51 - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp57b52 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp57b52 - END IF - ELSE - temp57b53 = cost5g*4.d0*zb(indorbp, indt+i) - temp57b54 = fun0*temp57b53 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& -& *temp57b53 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& -& *temp57b54 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp57b54 - END IF - temp57b = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp57b - funb = funb + rmu(i, 0)*temp57b + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp34b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp34b + funb0 = funb0 + rmu(ic, 0)*temp34b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp56 = rp3**2 - temp55b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& -& temp56 - temp55 = dd1*distp(0, 1)/temp56 - temp55b0 = temp55*fun2b - rp1b = (2*rp1+4.d0*rp2+4.d0)*temp55b0 - temp54b18 = -(distp(0, 1)*(rp2+2.d0)*funb/rp3) - dd1b = temp54b18 + r(0)**2*rp1b + distp(0, 1)*temp55b - temp54 = dd1/rp3 - distpb(0, 1) = distpb(0, 1) + fun0b - temp54*(rp2+2.d0)*funb + dd1& -& *temp55b - rp3b = -(temp54*temp54b18) - temp55*2*rp3*temp55b - rp2b = 2*(rp2+1.d0)*rp3b - temp54*distp(0, 1)*funb + (4.d0*rp1-& -& 2.d0)*temp55b0 - dd2b = r(0)*rp2b - rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b + distpb = 0.0_8 + temp33 = r(0)**5 + temp32 = r(0)**4 + temp32b2 = distp(0, 1)*fun2b + temp32b3 = r(0)**3*funb0 + distpb(0, 1) = (5.d0-dd2*r(0))*temp32b3 + r(0)**5*fun0b + (20*r(0)& +& **3-10*(dd2*temp32)+dd2**2*temp33)*fun2b + rb(0) = rb(0) + distp(0, 1)*(5.d0-dd2*r(0))*3*r(0)**2*funb0 - & +& distp(0, 1)*dd2*temp32b3 + distp(0, 1)*5*r(0)**4*fun0b + (dd2**2& +& *5*r(0)**4-10*dd2*4*r(0)**3+20*3*r(0)**2)*temp32b2 + dd2b = (temp33*2*dd2-10*temp32)*temp32b2 - distp(0, 1)*r(0)*& +& temp32b3 ELSE distpb = 0.0_8 - dd1b = 0.0_8 dd2b = 0.0_8 END IF - DO ic=9,1,-1 - DO k=indtm,i0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) - zb(indorbp, k) = 0.0_8 + DO ic=3,1,-1 + DO i=indtm,i0,-1 + temp32b1 = r(i)**5*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp32b1 + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp32b1 + rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*5*r(i)**4*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=indtm,indtmin,-1 - temp54b0 = cost5g*4.d0*distpb(i, 10) - temp54b1 = (rmu(1, i)**2-rmu(2, i)**2)*temp54b0 - temp54b2 = rmu(1, i)*rmu(2, i)*temp54b0 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp54b2 + rmu(2, i)*& -& temp54b1 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp54b1 - 2*rmu(2, i)*& -& temp54b2 - distpb(i, 10) = 0.0_8 - temp54b3 = cost5g*distpb(i, 9) - rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& -& 1, i))*temp54b3 - distpb(i, 9) = 0.0_8 - temp54b4 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) - temp54b5 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp54b4 - 2*rmu(2, i)*& -& temp54b5 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& -& temp54b3 - rmub(3, i) = rmub(3, i) + rmu(2, i)*temp54b4 - distpb(i, 8) = 0.0_8 - temp54b6 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) - temp54b7 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp54b6 + 2*rmu(1, i)*& -& temp54b7 + 3.d0*2*rmu(1, i)*temp54b5 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp54b6 - rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp54b7 - distpb(i, 7) = 0.0_8 - temp54b8 = cost3g*2.d0*distpb(i, 6) - temp54b9 = (7.d0*rmu(3, i)**2-r(i)**2)*temp54b8 - temp54b10 = rmu(1, i)*rmu(2, i)*temp54b8 - rmub(1, i) = rmub(1, i) + rmu(2, i)*temp54b9 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp54b9 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp54b10 - distpb(i, 6) = 0.0_8 - temp54b11 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) - temp54b12 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - temp54b13 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) - temp54b14 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - temp54b15 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) - temp54b16 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - temp54b17 = cost1g*distpb(i, 2) - rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& -& temp54b17 - 3.d0*2*r(i)*temp54b16 - 2*r(i)*temp54b12 - 3.d0*2*r(& -& i)*temp54b14 - 2*r(i)*temp54b10 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp54b11 - rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp54b11 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp54b12 - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp54b13 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp54b14 + rmu(2, i)*& -& temp54b13 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp54b15 - rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& -& rmu(3, i))*temp54b17 + 7.d0*2*rmu(3, i)*temp54b16 + rmu(1, i)*& -& temp54b15 - distpb(i, 2) = 0.0_8 - END DO - cb = 0.0_8 DO k=indtm,indtmin,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) + temp32b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp32b0 + rb(k) = rb(k) - dd2*temp32b0 distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp53 = dd2*r(k) + 1.d0 - temp54b = costb/temp53 - temp53b24 = -(dd1*r(k)**2*temp54b/temp53) - dd1b = dd1b + r(k)**2*temp54b - rb(k) = rb(k) + dd2*temp53b24 + dd1*2*r(k)*temp54b - dd2b = dd2b + r(k)*temp53b24 END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocg*2.75d0*dd1**1.75D0*cb - ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocg*2.75d0*dd1**1.75D0*& -& cb + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (200) +! THE COSTANT + indorbp = indorb + 1 +! endif + IF (typec .NE. 1) THEN + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + zb(indorbp, indt+i) = 0.0_8 + END DO END IF - ddb(indparp) = ddb(indparp) + dd1b - CASE (89) -! g single gaussian orbital -! derivative of 51 -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) - dd2 = DSQRT(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0)*ratiocg - c = dd1**2.75d0*ratiocg -! endif - DO k=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k, 1) = c*DEXP(-cost) + DO i=indtm,i0,-1 + zb(indorbp, i) = 0.0_8 END DO - DO i=indtmin,indtm - distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& -& 2+3.d0*r(i)**4) -! lz=0 - distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& -& 2-r(i)**2) -! lz=+/-2 - distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& -& (i)**2) -! lz=+/-2 - distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & -& i)**2) -! lz=+/-3 - distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& -& , i)**2) -! lz=+/-3 - distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& -& rmu(2, i)**4) -! lz=+/-4 - distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& -& , i)**2) + distpb = 0.0_8 + CASE (118) +! 2s double lorentian with constant parent of 102 +! (dd1+ 1/ (1 + Exp[ dd2 (r^2 - r_0^2) ] ) | dd3=r_0 +! Fermi distribution with r^2 + dd2 = dd(indpar+2) + dd3 = -(dd2*dd(indpar+3)**2) + indorbp = indorb + 1 + DO k=indtmin,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,arg) + arg = dd2*r(k)**2 + dd3 + IF (arg .GT. 200) THEN + distp(k, 1) = DEXP(200.d0) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + distp(k, 1) = DEXP(arg) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF END DO -! lz=+/-4 - DO ic=1,9 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO k=i0,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 +! write(6,*) ' function inside = ',z(indorbp,i) +! endif + IF (typec .NE. 1) THEN + fun = -(2.d0*dd2*distp(0, 1)/(1.d0+distp(0, 1))**2) + fun2b = zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 END DO + distpb = 0.0_8 + temp36 = (distp(0, 1)+1.d0)**3 + temp35 = -(2.d0*dd2*r(0)**2) - 1.d0 + temp34 = -(2.d0*dd2*r(0)**2) + 1.d0 + temp34b1 = -(2.d0*dd2*fun2b/temp36) + temp34b2 = -(distp(0, 1)**2*2.d0*temp34b1) + temp34b3 = distp(0, 1)*2.d0*temp34b1 + temp34b4 = -(2.d0*(distp(0, 1)**2*temp34-distp(0, 1)*temp35)*fun2b& +& /temp36) + temp34b5 = -(2.d0*funb0/(distp(0, 1)+1.d0)**2) + distpb(0, 1) = (dd2-dd2*distp(0, 1)*2/(distp(0, 1)+1.d0))*temp34b5& +& - dd2*3*(distp(0, 1)+1.d0)**2*temp34b4/temp36 + (temp34*2*distp(& +& 0, 1)-temp35)*temp34b1 + dd2b = distp(0, 1)*temp34b5 + temp34b4 + r(0)**2*temp34b3 + r(0)**& +& 2*temp34b2 + rb(0) = rb(0) + dd2*2*r(0)*temp34b3 + dd2*2*r(0)*temp34b2 + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + dd1b = 0.0_8 + DO i=indtm,i0,-1 + dd1b = dd1b + zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) - zb(indorbp, i)/(distp(i, 1)+1.d0)**2 + zb(indorbp, i) = 0.0_8 + END DO + dd3b = 0.0_8 + DO k=indtm,indtmin,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 2) THEN + distpb(k, 1) = 0.0_8 + argb = 0.0_8 + ELSE + argb = DEXP(arg)*distpb(k, 1) + distpb(k, 1) = 0.0_8 + END IF + CALL POPREAL8(adr8ibuf,adr8buf,arg) + dd2b = dd2b + r(k)**2*argb + rb(k) = rb(k) + dd2*2*r(k)*argb + dd3b = dd3b + argb + END DO + dd2b = dd2b - dd(indpar+3)**2*dd3b + ddb(indpar+3) = ddb(indpar+3) - dd2*2*dd(indpar+3)*dd3b + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (15) +! (r**2 + dd2*(1 + dd1*r))*exp(-dd1*r) ! normalized +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + c = DSQRT(2.d0*dd1**7/pi/(45.d0+42.d0*dd1**2*dd2+14.d0*dd1**4*dd2**2& +& )) + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k))) END DO -! endif IF (typec .NE. 1) THEN - rp1 = dd1*r(0)**2 - rp2 = dd2*r(0) - rp3 = (1.d0+rp2)**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = (1.d0+0.5d0*rp2)/rp3 - fun0 = distp(0, 1)*(11.d0/4.d0/dd1-r(0)**2*cost) - fun = 0.25d0*distp(0, 1)*(-30.d0-69.d0*rp2-44.d0*rp1-5.d0*rp1*rp2+& -& 2.d0*rp1**2)/rp3**2 - fun2 = 0.25d0*distp(0, 1)*(-30.d0-78.d0*rp2+18.d0*rp1+198.d0*rp1*& -& rp2+191.d0*rp1**2+66.d0*rp1**2*rp2+3.d0*rp1**3-2.d0*rp1**3*rp2)/& -& rp3**3 -! indorbp=indorb - DO ic=1,9 + fun = distp(0, 1)*r(0)*(2.d0-dd1**2*dd2-dd1*r(0)) + temp44b = 2.d0*zb(indorbp, indt+4)/r(0) + funb0 = temp44b + rb(0) = rb(0) - fun*temp44b/r(0) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + temp43 = fun/r(0) + temp43b0 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(i, 0) = rmub(i, 0) + temp43*zb(indorbp, indt+i) + funb0 = funb0 + temp43b0 + rb(0) = rb(0) - temp43*temp43b0 + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp42 = -(dd1*r(0)) - dd1**2*dd2 + 3.d0 + temp43b = distp(0, 1)*fun2b + temp42b0 = (1.d0-dd1*r(0))*temp43b + temp42b1 = (2.d0-dd1*r(0)-dd1**2*dd2)*funb0 + distpb(0, 1) = r(0)*temp42b1 + ((1.d0-dd1*r(0))*temp42-1.d0)*fun2b + temp42b2 = distp(0, 1)*r(0)*funb0 + dd1b = (-(dd2*2*dd1)-r(0))*temp42b2 + (-(dd2*2*dd1)-r(0))*temp42b0& +& - temp42*r(0)*temp43b + rb(0) = rb(0) + distp(0, 1)*temp42b1 - dd1*temp42b2 - dd1*temp42b0& +& - temp42*dd1*temp43b + dd2b = -(dd1**2*temp42b2) - dd1**2*temp42b0 + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 + END IF + DO i=indtm,i0,-1 + temp42b = distp(i, 1)*zb(indorbp, i) + temp41 = dd1*r(i) + 1.d0 + rb(i) = rb(i) + (dd2*dd1+2*r(i))*temp42b + dd2b = dd2b + temp41*temp42b + dd1b = dd1b + dd2*r(i)*temp42b + distpb(i, 1) = distpb(i, 1) + (r(i)**2+dd2*temp41)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + cb = 0.0_8 + DO k=indtm,indtmin,-1 + temp41b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp41b + rb(k) = rb(k) - dd1*temp41b + distpb(k, 1) = 0.0_8 + END DO + temp40 = dd1**4 + temp39 = pi*(42.d0*dd1**2*dd2+14.d0*temp40*dd2**2+45.d0) + temp38 = dd1**7 + temp37 = temp38/temp39 + IF (2.d0*temp37 .EQ. 0.0) THEN + temp37b = 0.0 + ELSE + temp37b = 2.d0*cb/(2.D0*DSQRT(2.d0*temp37)*temp39) + END IF + temp37b0 = -(temp37*pi*temp37b) + dd1b = dd1b + (14.d0*dd2**2*4*dd1**3+42.d0*dd2*2*dd1)*temp37b0 + 7*& +& dd1**6*temp37b + dd2b = dd2b + (14.d0*temp40*2*dd2+42.d0*dd1**2)*temp37b0 + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (122) +! 2s gaussian for pseudo +! 2s with cusp condition +! dd1*( dd3 +exp(-dd2*r)*(1+dd2*r)) + dd2 = dd(indpar+1) + indorbp = indorb + 1 + DO k=indtmin,indtm + distp(k, 1) = DEXP(-(dd2*r(k))) + END DO +! endif + IF (typec .NE. 1) THEN + fun = -(dd2**2*distp(0, 1)) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + funb0 = funb0 + (1.d0-dd2*r(0))*fun2b + dd2b = -(distp(0, 1)*2*dd2*funb0) - fun*r(0)*fun2b + rb(0) = rb(0) - fun*dd2*fun2b + distpb = 0.0_8 + distpb(0, 1) = -(dd2**2*funb0) + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + dd3b = 0.0_8 + DO i=indtm,i0,-1 + temp44b1 = distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + (dd2*r(i)+1.d0)*zb(indorbp, i) + dd2b = dd2b + r(i)*temp44b1 + rb(i) = rb(i) + dd2*temp44b1 + dd3b = dd3b + zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + DO k=indtm,indtmin,-1 + temp44b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp44b0 + rb(k) = rb(k) - dd2*temp44b0 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (128) +! 2s with cusp condition +! ( r^2*exp(-dd2*r)) ! with no cusp condition + dd2 = dd(indpar+1) + indorbp = indorb + 1 + DO k=indtmin,indtm + distp(k, 1) = DEXP(-(dd2*r(k))) + END DO +! endif + IF (typec .NE. 1) THEN + fun = (2.d0-dd2*r(0))*distp(0, 1) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp44b3 = distp(0, 1)*fun2b + temp44b4 = 2*dd2*r(0)*temp44b3 + dd2b = r(0)*temp44b4 - 4*r(0)*temp44b3 - distp(0, 1)*r(0)*funb0 + rb(0) = rb(0) + dd2*temp44b4 - 4*dd2*temp44b3 - distp(0, 1)*dd2*& +& funb0 + distpb(0, 1) = (2.d0-dd2*r(0))*funb0 + ((dd2*r(0))**2-4*(dd2*r(0))& +& +2.d0)*fun2b + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO i=indtm,i0,-1 + distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + DO k=indtm,indtmin,-1 + temp44b2 = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp44b2 + rb(k) = rb(k) - dd2*temp44b2 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (16) +! s orbital +! +! - angmom = 0 +! - type = Gaussian +! - normalized = yes +! - angtype = spherical +! - npar = 1 +! - multiplicity = 1 +! +! = N * R +! +! where N is the normalization constant +! N = (2*alpha/pi)**(3/4) +! +! and R is the radial part +! R = exp(-alpha*r**2) +! + indorbp = indorb + 1 + dd1 = dd(indpar+1) + IF (dd1 .NE. 0.) THEN + c = 0.71270547035499016d0*dd1**0.75d0 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + c = 1.d0 + END IF + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + END DO + IF (typec .NE. 1) THEN +! the first derivative /r + fun = -(2.d0*dd1*distp(0, 1)) +! the second derivative + fun2 = fun*(1.d0-2.d0*dd1*r(0)*r(0)) + IF (typec .EQ. 2) THEN +! Backflow + funb = (fun2-fun)/(r(0)*r(0)) + funbb = rmu(3, 0)*rmu(2, 0)*zb(indorbp, indt+10) + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*funb*zb(indorbp, indt+10) + rmub(3, 0) = rmub(3, 0) + funb*rmu(2, 0)*zb(indorbp, indt+10) + zb(indorbp, indt+10) = 0.0_8 + funbb = funbb + rmu(3, 0)*rmu(1, 0)*zb(indorbp, indt+9) + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*funb*zb(indorbp, indt+9) + rmub(3, 0) = rmub(3, 0) + funb*rmu(1, 0)*zb(indorbp, indt+9) + zb(indorbp, indt+9) = 0.0_8 + funbb = funbb + rmu(2, 0)*rmu(1, 0)*zb(indorbp, indt+8) + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*funb*zb(indorbp, indt+8) + rmub(2, 0) = rmub(2, 0) + funb*rmu(1, 0)*zb(indorbp, indt+8) + zb(indorbp, indt+8) = 0.0_8 + funbb = funbb + rmu(3, 0)**2*zb(indorbp, indt+7) + rmub(3, 0) = rmub(3, 0) + funb*2*rmu(3, 0)*zb(indorbp, indt+7) + funb0 = zb(indorbp, indt+7) + zb(indorbp, indt+7) = 0.0_8 + funbb = funbb + rmu(2, 0)**2*zb(indorbp, indt+6) + rmub(2, 0) = rmub(2, 0) + funb*2*rmu(2, 0)*zb(indorbp, indt+6) + funb0 = funb0 + zb(indorbp, indt+6) + zb(indorbp, indt+6) = 0.0_8 + funbb = funbb + rmu(1, 0)**2*zb(indorbp, indt+5) + rmub(1, 0) = rmub(1, 0) + funb*2*rmu(1, 0)*zb(indorbp, indt+5) + temp45b0 = funbb/r(0)**2 + funb0 = funb0 + zb(indorbp, indt+5) - temp45b0 + zb(indorbp, indt+5) = 0.0_8 + fun2b = temp45b0 + rb(0) = rb(0) - (fun2-fun)*2*temp45b0/r(0) + ELSE + funb0 = 0.0_8 + fun2b = 0.0_8 + END IF + funb0 = funb0 + 2.d0*zb(indorbp, indt+4) + fun2b = fun2b + zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + temp45b = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp45b - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp45b + distpb = 0.0_8 + distpb(0, 1) = -(2.d0*dd1*funb0) + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + END IF + DO i=indtm,i0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + cb = 0.0_8 + DO k=indtm,indtmin,-1 + temp44 = r(k)**2 + temp44b5 = c*DEXP(-(dd1*temp44))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp44))*distpb(k, 1) + dd1b = dd1b - temp44*temp44b5 + rb(k) = rb(k) - dd1*2*r(k)*temp44b5 + distpb(k, 1) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 1) dd1b = dd1b + 0.71270547035499016d0*0.75d0*& +& dd1**(-0.25D0)*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (2200:2299) +! d gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative 1200 + npower = iopt + 1 - 2200 +! indorbp=indorb + dd2 = dd(indpar+1) + DO k=indtmin,indtm + distp(k, 1) = -(r(k)**(2*npower)*DEXP(-(dd2*r(k)**2))) + END DO + DO i=indtmin,indtm + distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d + distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d + distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d + END DO + DO ic=1,5 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN + rp1 = r(0)**2 + fun0 = distp(0, 1) + fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 + fun2 = (npower*(2.d0*npower-1.d0)-(1.d0+4.d0*npower)*dd2*rp1+2.d0*& +& (dd2*rp1)**2)*distp(0, 1)*2.d0/rp1 +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN - IF (i .EQ. 1) THEN + IF (i .NE. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) END IF ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF ELSE IF (ic .EQ. 3) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) END IF ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE IF (i .EQ. 2) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - ELSE + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - END IF - ELSE IF (ic .EQ. 6) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - END IF - ELSE IF (ic .EQ. 7) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,21) - END IF - ELSE IF (ic .EQ. 8) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,22) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,24) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,23) - END IF - ELSE IF (ic .EQ. 9) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,26) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,28) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,27) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,25) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=9,1,-1 - temp68b55 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 10.d0*temp68b55 - fun2b = fun2b + temp68b55 + DO ic=5,1,-1 + temp49b6 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 6.d0*temp49b6 + fun2b = fun2b + temp49b6 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 15) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp68b0 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& -& 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& -& ) - rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp68b0 - rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp68b0 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& -& )*temp68b0 - ELSE - temp68b1 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& -& 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& -& ) - rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp68b1 - rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp68b1 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& -& )*temp68b1 - END IF - ELSE IF (branch .LT. 4) THEN - temp68b2 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& -& 3, 0)*r(0)**2))*zb(indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& -& r(0)**2)*temp68b2 - rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp68b2 - ELSE - temp68b3 = cost2g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& -& , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& -& (indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& -& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp68b3 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp68b3 - rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp68b3 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp68b4 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp68b5 = rmu(2, 0)*rmu(3, 0)*temp68b4 - temp68b6 = fun0*rmu(1, 0)*temp68b4 - fun0b = fun0b + rmu(1, 0)*temp68b5 - rmub(1, 0) = rmub(1, 0) + fun0*temp68b5 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp68b6 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp68b6 + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp49b2 = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp49b2 + fun0b = fun0b + rmu(i, 0)*temp49b2 ELSE - temp68b7 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp68b8 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**& -& 2)*temp68b7 - temp68b9 = fun0*rmu(1, 0)*temp68b7 - fun0b = fun0b + rmu(1, 0)*temp68b8 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp68b9 + fun0*& -& temp68b8 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp68b9 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp68b9 + temp49b3 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp49b3 + fun0b = fun0b + rmu(i, 0)*temp49b3 END IF - ELSE - temp68b10 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp68b11 = rmu(2, 0)*rmu(3, 0)*temp68b10 - temp68b12 = fun0*rmu(1, 0)*temp68b10 - fun0b = fun0b + rmu(1, 0)*temp68b11 - rmub(1, 0) = rmub(1, 0) + fun0*temp68b11 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp68b12 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp68b12 + ELSE IF (branch .LT. 4) THEN + temp49b4 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp49b4 + fun0b = fun0b + rmu(i, 0)*temp49b4 END IF - ELSE IF (branch .LT. 12) THEN - IF (branch .LT. 10) THEN - IF (branch .LT. 9) THEN - temp68b13 = cost2g*fun0*zb(indorbp, indt+i) + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp49b5 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp49b5 + fun0b = fun0b + rmu(i, 0)*temp49b5 + ELSE + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + temp49b1 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp49b1 + funb0 = funb0 + rmu(i, 0)*temp49b1 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + temp48 = distp(0, 1)/rp1 + temp49b = 2.d0*temp48*fun2b + temp49b0 = -((npower*4.d0+1.d0)*temp49b) + temp48b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& +& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 + temp47 = distp(0, 1)/rp1 + temp48b0 = 2.d0*temp47*funb0 + dd2b = rp1*temp49b0 - rp1*temp48b0 + 2.d0*rp1**2*2*dd2*temp49b + temp47b = 2.d0*(npower-dd2*rp1)*funb0/rp1 + rp1b = dd2*temp49b0 - temp47*temp47b - temp48*temp48b - dd2*& +& temp48b0 + 2.d0*dd2**2*2*rp1*temp49b + distpb(0, 1) = distpb(0, 1) + temp47b + fun0b + temp48b + rb(0) = rb(0) + 2*r(0)*rp1b + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO ic=5,1,-1 + DO i=indtm,i0,-1 + distpb(i, 1+ic) = distpb(i, 1+ic) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + distp(i, 1+ic)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO i=indtm,indtmin,-1 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) + distpb(i, 2) = 0.0_8 + END DO + DO k=indtm,indtmin,-1 + temp46 = r(k)**2 + temp45 = 2*npower + temp45b1 = -(r(k)**temp45*DEXP(-(dd2*temp46))*distpb(k, 1)) + IF (r(k) .LE. 0.0 .AND. (temp45 .EQ. 0.0 .OR. temp45 .NE. INT(& +& temp45))) THEN + rb(k) = rb(k) - dd2*2*r(k)*temp45b1 + ELSE + rb(k) = rb(k) - dd2*2*r(k)*temp45b1 - DEXP(-(dd2*temp46))*temp45& +& *r(k)**(temp45-1)*distpb(k, 1) + END IF + dd2b = dd2b - temp46*temp45b1 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (55) +! g single Slater orbital +! R(r)= exp(-alpha r) +! normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization +! l = 4 +! \int d\omega Y*Y = 4 pi / (2 l + 1) +! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5**2 * 3**4 / 2**3 / dd1**11 +! c=1.d0/dsqrt(7.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(11.d0/2.d0)/3.d0/5.d0 + c = dd1**5.5d0*.020104801169736915d0 +! endif + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k))) + END DO + DO i=indtmin,indtm + distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& +& 2+3.d0*r(i)**4) +! lz=0 + distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& +& 2-r(i)**2) +! lz=+/-2 + distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& +& (i)**2) +! lz=+/-2 + distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & +& i)**2) +! lz=+/-3 + distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& +& , i)**2) +! lz=+/-3 + distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& +& rmu(2, i)**4) +! lz=+/-4 + distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& +& , i)**2) + END DO +! lz=+/-4 + DO ic=1,9 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1) + fun = -(dd1*distp(0, 1)/r(0)) + fun2 = dd1**2*distp(0, 1) +! indorbp=indorb + DO ic=1,9 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (ic .EQ. 1) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + END IF + ELSE IF (ic .EQ. 6) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + END IF + ELSE IF (ic .EQ. 7) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,21) + END IF + ELSE IF (ic .EQ. 8) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,22) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,24) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,23) + END IF + ELSE IF (ic .EQ. 9) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,26) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,28) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,27) + END IF + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,25) + END IF + END DO + END DO + distpb = 0.0_8 + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=9,1,-1 + temp50b55 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 10.d0*temp50b55 + fun2b = fun2b + temp50b55 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 15) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp50b0 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& +& 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& +& ) + rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& +& , 0)**2)*temp50b0 + rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp50b0 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& +& )*temp50b0 + ELSE + temp50b1 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& +& 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& +& ) + rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& +& , 0)**2)*temp50b1 + rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp50b1 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& +& )*temp50b1 + END IF + ELSE IF (branch .LT. 4) THEN + temp50b2 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& +& 3, 0)*r(0)**2))*zb(indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& +& r(0)**2)*temp50b2 + rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp50b2 + ELSE + temp50b3 = cost2g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& +& , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& +& (indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& +& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp50b3 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp50b3 + rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp50b3 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp50b4 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp50b5 = rmu(2, 0)*rmu(3, 0)*temp50b4 + temp50b6 = fun0*rmu(1, 0)*temp50b4 + fun0b = fun0b + rmu(1, 0)*temp50b5 + rmub(1, 0) = rmub(1, 0) + fun0*temp50b5 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp50b6 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp50b6 + ELSE + temp50b7 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp50b8 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**& +& 2)*temp50b7 + temp50b9 = fun0*rmu(1, 0)*temp50b7 + fun0b = fun0b + rmu(1, 0)*temp50b8 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp50b9 + fun0*& +& temp50b8 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp50b9 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp50b9 + END IF + ELSE + temp50b10 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp50b11 = rmu(2, 0)*rmu(3, 0)*temp50b10 + temp50b12 = fun0*rmu(1, 0)*temp50b10 + fun0b = fun0b + rmu(1, 0)*temp50b11 + rmub(1, 0) = rmub(1, 0) + fun0*temp50b11 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp50b12 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp50b12 + END IF + ELSE IF (branch .LT. 12) THEN + IF (branch .LT. 10) THEN + IF (branch .LT. 9) THEN + temp50b13 = cost2g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& & , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& & (indorbp, indt+i) rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& -& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp68b13 +& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp50b13 rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp68b13 +& temp50b13 rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp68b13 +& temp50b13 ELSE - temp68b14 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp68b15 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& -& **2)*temp68b14 - temp68b16 = fun0*rmu(2, 0)*temp68b14 - fun0b = fun0b + rmu(2, 0)*temp68b15 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp68b16 + fun0& -& *temp68b15 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp68b16 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp68b16 + temp50b14 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp50b15 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& +& **2)*temp50b14 + temp50b16 = fun0*rmu(2, 0)*temp50b14 + fun0b = fun0b + rmu(2, 0)*temp50b15 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp50b16 + fun0& +& *temp50b15 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp50b16 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp50b16 END IF ELSE IF (branch .LT. 11) THEN - temp68b17 = -(cost3g*4.d0*zb(indorbp, indt+i)) - temp68b18 = fun0*temp68b17 + temp50b17 = -(cost3g*4.d0*zb(indorbp, indt+i)) + temp50b18 = fun0*temp50b17 fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& -& **2))*temp68b17 +& **2))*temp50b17 rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp68b18 +& **2)*temp50b18 rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& -& temp68b18 +& temp50b18 ELSE - temp68b19 = cost3g*4.d0*zb(indorbp, indt+i) - temp68b20 = fun0*temp68b19 + temp50b19 = cost3g*4.d0*zb(indorbp, indt+i) + temp50b20 = fun0*temp50b19 fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& -& **2))*temp68b19 +& **2))*temp50b19 rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp68b20 +& **2)*temp50b20 rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& -& temp68b20 +& temp50b20 END IF ELSE IF (branch .LT. 14) THEN IF (branch .LT. 13) THEN - temp68b21 = cost3g*12.d0*zb(indorbp, indt+i) - temp68b22 = fun0*rmu(3, 0)*temp68b21 - temp68b23 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp68b21 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp68b22 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp68b22 - fun0b = fun0b + rmu(3, 0)*temp68b23 - rmub(3, 0) = rmub(3, 0) + fun0*temp68b23 + temp50b21 = cost3g*12.d0*zb(indorbp, indt+i) + temp50b22 = fun0*rmu(3, 0)*temp50b21 + temp50b23 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp50b21 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp50b22 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp50b22 + fun0b = fun0b + rmu(3, 0)*temp50b23 + rmub(3, 0) = rmub(3, 0) + fun0*temp50b23 ELSE - temp68b24 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp68b25 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3, & -& 0)**2)*temp68b24 - temp68b26 = fun0*rmu(2, 0)*temp68b24 - fun0b = fun0b + rmu(2, 0)*temp68b25 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp68b26 + fun0*& -& temp68b25 - rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp68b26 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp68b26 + temp50b24 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp50b25 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3, & +& 0)**2)*temp50b24 + temp50b26 = fun0*rmu(2, 0)*temp50b24 + fun0b = fun0b + rmu(2, 0)*temp50b25 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp50b26 + fun0*& +& temp50b25 + rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp50b26 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp50b26 END IF ELSE - temp68b27 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp68b28 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0)& -& **2)*temp68b27 - temp68b29 = fun0*rmu(1, 0)*temp68b27 - fun0b = fun0b + rmu(1, 0)*temp68b28 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp68b29 + fun0*& -& temp68b28 - rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp68b29 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp68b29 + temp50b27 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp50b28 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0)& +& **2)*temp50b27 + temp50b29 = fun0*rmu(1, 0)*temp50b27 + fun0b = fun0b + rmu(1, 0)*temp50b28 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp50b29 + fun0*& +& temp50b28 + rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp50b29 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp50b29 END IF ELSE IF (branch .LT. 22) THEN IF (branch .LT. 19) THEN IF (branch .LT. 17) THEN IF (branch .LT. 16) THEN - temp68b30 = cost3g*24.d0*zb(indorbp, indt+i) - temp68b31 = rmu(2, 0)*rmu(3, 0)*temp68b30 - temp68b32 = fun0*rmu(1, 0)*temp68b30 - fun0b = fun0b + rmu(1, 0)*temp68b31 - rmub(1, 0) = rmub(1, 0) + fun0*temp68b31 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp68b32 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp68b32 + temp50b30 = cost3g*24.d0*zb(indorbp, indt+i) + temp50b31 = rmu(2, 0)*rmu(3, 0)*temp50b30 + temp50b32 = fun0*rmu(1, 0)*temp50b30 + fun0b = fun0b + rmu(1, 0)*temp50b31 + rmub(1, 0) = rmub(1, 0) + fun0*temp50b31 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp50b32 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp50b32 ELSE - temp68b33 = cost4g*3.d0*zb(indorbp, indt+i) - temp68b34 = fun0*rmu(3, 0)*temp68b33 - temp68b35 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp68b33 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp68b34 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp68b34 - fun0b = fun0b + rmu(3, 0)*temp68b35 - rmub(3, 0) = rmub(3, 0) + fun0*temp68b35 + temp50b33 = cost4g*3.d0*zb(indorbp, indt+i) + temp50b34 = fun0*rmu(3, 0)*temp50b33 + temp50b35 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp50b33 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp50b34 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp50b34 + fun0b = fun0b + rmu(3, 0)*temp50b35 + rmub(3, 0) = rmub(3, 0) + fun0*temp50b35 END IF ELSE IF (branch .LT. 18) THEN - temp68b36 = -(cost4g*6.d0*zb(indorbp, indt+i)) - temp68b37 = rmu(2, 0)*rmu(3, 0)*temp68b36 - temp68b38 = fun0*rmu(1, 0)*temp68b36 - fun0b = fun0b + rmu(1, 0)*temp68b37 - rmub(1, 0) = rmub(1, 0) + fun0*temp68b37 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp68b38 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp68b38 + temp50b36 = -(cost4g*6.d0*zb(indorbp, indt+i)) + temp50b37 = rmu(2, 0)*rmu(3, 0)*temp50b36 + temp50b38 = fun0*rmu(1, 0)*temp50b36 + fun0b = fun0b + rmu(1, 0)*temp50b37 + rmub(1, 0) = rmub(1, 0) + fun0*temp50b37 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp50b38 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp50b38 ELSE - temp68b39 = cost4g*fun0*zb(indorbp, indt+i) + temp50b39 = cost4g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& & (2, 0)**2))*zb(indorbp, indt+i) rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp68b39 +& **2)*temp50b39 rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp68b39 +& temp50b39 END IF ELSE IF (branch .LT. 21) THEN IF (branch .LT. 20) THEN - temp68b40 = cost4g*6.d0*zb(indorbp, indt+i) - temp68b41 = rmu(2, 0)*rmu(3, 0)*temp68b40 - temp68b42 = fun0*rmu(1, 0)*temp68b40 - fun0b = fun0b + rmu(1, 0)*temp68b41 - rmub(1, 0) = rmub(1, 0) + fun0*temp68b41 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp68b42 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp68b42 + temp50b40 = cost4g*6.d0*zb(indorbp, indt+i) + temp50b41 = rmu(2, 0)*rmu(3, 0)*temp50b40 + temp50b42 = fun0*rmu(1, 0)*temp50b40 + fun0b = fun0b + rmu(1, 0)*temp50b41 + rmub(1, 0) = rmub(1, 0) + fun0*temp50b41 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp50b42 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp50b42 ELSE - temp68b43 = cost4g*3.d0*zb(indorbp, indt+i) - temp68b44 = fun0*rmu(3, 0)*temp68b43 - temp68b45 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp68b43 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp68b44 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp68b44 - fun0b = fun0b + rmu(3, 0)*temp68b45 - rmub(3, 0) = rmub(3, 0) + fun0*temp68b45 + temp50b43 = cost4g*3.d0*zb(indorbp, indt+i) + temp50b44 = fun0*rmu(3, 0)*temp50b43 + temp50b45 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp50b43 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp50b44 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp50b44 + fun0b = fun0b + rmu(3, 0)*temp50b45 + rmub(3, 0) = rmub(3, 0) + fun0*temp50b45 END IF ELSE - temp68b46 = cost4g*fun0*zb(indorbp, indt+i) + temp50b46 = cost4g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& & 2, 0)**3)*zb(indorbp, indt+i) rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp68b46 +& temp50b46 rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp68b46 +& 2)*temp50b46 END IF ELSE IF (branch .LT. 26) THEN IF (branch .LT. 24) THEN IF (branch .LT. 23) THEN - temp68b47 = cost5g*4.d0*zb(indorbp, indt+i) - temp68b48 = fun0*temp68b47 + temp50b47 = cost5g*4.d0*zb(indorbp, indt+i) + temp50b48 = fun0*temp50b47 fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& -& **2))*temp68b47 +& **2))*temp50b47 rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp68b48 +& **2)*temp50b48 rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp68b48 +& temp50b48 END IF ELSE IF (branch .LT. 25) THEN - temp68b49 = cost5g*4.d0*zb(indorbp, indt+i) - temp68b50 = fun0*temp68b49 + temp50b49 = cost5g*4.d0*zb(indorbp, indt+i) + temp50b50 = fun0*temp50b49 fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& -& ))*temp68b49 +& ))*temp50b49 rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& -& 2)*temp68b50 +& 2)*temp50b50 rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp68b50 +& temp50b50 END IF ELSE IF (branch .LT. 28) THEN IF (branch .LT. 27) THEN - temp68b51 = cost5g*4.d0*zb(indorbp, indt+i) - temp68b52 = fun0*temp68b51 + temp50b51 = cost5g*4.d0*zb(indorbp, indt+i) + temp50b52 = fun0*temp50b51 fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& -& 3)*temp68b51 +& 3)*temp50b51 rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp68b52 +& temp50b52 rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp68b52 +& 2)*temp50b52 END IF ELSE - temp68b53 = cost5g*4.d0*zb(indorbp, indt+i) - temp68b54 = fun0*temp68b53 + temp50b53 = cost5g*4.d0*zb(indorbp, indt+i) + temp50b54 = fun0*temp50b53 fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& -& *temp68b53 +& *temp50b53 rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& -& *temp68b54 +& *temp50b54 rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp68b54 +& temp50b54 END IF - temp68b = distp(0, 1+ic)*zb(indorbp, indt+i) + temp50b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp68b - funb = funb + rmu(i, 0)*temp68b + rmub(i, 0) = rmub(i, 0) + fun*temp50b + funb0 = funb0 + rmu(i, 0)*temp50b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp67 = rp3**3 - temp65 = distp(0, 1)/temp67 - temp66 = rp1**3 - temp66b = 0.25d0*temp65*fun2b - temp65b = 0.25d0*(18.d0*rp1-78.d0*rp2+198.d0*(rp1*rp2)+191.d0*rp1& -& **2+66.d0*(rp1**2*rp2)+3.d0*rp1**3-2.d0*(temp66*rp2)-30.d0)*& -& fun2b/temp67 - temp64 = rp3**2 - temp63 = distp(0, 1)/temp64 - temp64b = 0.25d0*temp63*funb - rp1b = (2.d0*2*rp1-5.d0*rp2-44.d0)*temp64b + (3.d0*3*rp1**2-2.d0*& -& rp2*3*rp1**2+66.d0*rp2*2*rp1+191.d0*2*rp1+198.d0*rp2+18.d0)*& -& temp66b - temp63b = 0.25d0*(2.d0*rp1**2-44.d0*rp1-69.d0*rp2-5.d0*(rp1*rp2)-& -& 30.d0)*funb/temp64 - temp61b0 = distp(0, 1)*fun0b - costb = -(r(0)**2*temp61b0) - rp3b = -(temp63*2*rp3*temp63b) - (0.5d0*rp2+1.d0)*costb/rp3**2 - & -& temp65*3*rp3**2*temp65b - rp2b = ((-69.d0)-5.d0*rp1)*temp64b + 2*(rp2+1.d0)*rp3b + 0.5d0*& -& costb/rp3 + (66.d0*rp1**2-2.d0*temp66+198.d0*rp1-78.d0)*temp66b - temp62 = 4.d0*dd1 - temp61 = 11.d0/temp62 - distpb(0, 1) = distpb(0, 1) + temp63b + (temp61-r(0)**2*cost)*& -& fun0b + temp65b - dd1b = r(0)**2*rp1b - temp61*4.d0*temp61b0/temp62 - rb(0) = rb(0) + dd2*rp2b + dd1*2*r(0)*rp1b - cost*2*r(0)*temp61b0 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = r(0)*rp2b + temp49b26 = -(distp(0, 1)*funb0/r(0)) + dd1b = temp49b26 + distp(0, 1)*2*dd1*fun2b + temp49 = dd1/r(0) + distpb(0, 1) = distpb(0, 1) + fun0b - temp49*funb0 + dd1**2*fun2b + rb(0) = rb(0) - temp49*temp49b26 + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 END IF DO ic=9,1,-1 DO k=indtm,i0,-1 - temp61b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) - temp60 = 4.d0*dd1 - temp59 = 11.d0/temp60 - temp59b = (temp59-r(k)**2*cost)*zb(indorbp, k) - dd1b = dd1b - temp59*4.d0*temp61b/temp60 - costb = -(r(k)**2*temp61b) - temp58 = dd2*r(k) + 1.d0 - temp59b0 = costb/temp58**2 - temp58b18 = -((0.5d0*(dd2*r(k))+1.d0)*2*temp59b0/temp58) - rb(k) = rb(k) + 0.5d0*dd2*temp59b0 + dd2*temp58b18 - cost*2*r(k)& -& *temp61b - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp59b - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp59b - zb(indorbp, k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - dd2b = dd2b + r(k)*temp58b18 + 0.5d0*r(k)*temp59b0 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 - temp58b0 = cost5g*4.d0*distpb(i, 10) - temp58b1 = (rmu(1, i)**2-rmu(2, i)**2)*temp58b0 - temp58b2 = rmu(1, i)*rmu(2, i)*temp58b0 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp58b2 + rmu(2, i)*& -& temp58b1 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp58b1 - 2*rmu(2, i)*& -& temp58b2 + temp49b8 = cost5g*4.d0*distpb(i, 10) + temp49b9 = (rmu(1, i)**2-rmu(2, i)**2)*temp49b8 + temp49b10 = rmu(1, i)*rmu(2, i)*temp49b8 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp49b10 + rmu(2, i)*& +& temp49b9 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp49b9 - 2*rmu(2, i)*& +& temp49b10 distpb(i, 10) = 0.0_8 - temp58b3 = cost5g*distpb(i, 9) + temp49b11 = cost5g*distpb(i, 9) rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& -& 1, i))*temp58b3 +& 1, i))*temp49b11 distpb(i, 9) = 0.0_8 - temp58b4 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) - temp58b5 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp58b4 - 2*rmu(2, i)*& -& temp58b5 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& -& temp58b3 - rmub(3, i) = rmub(3, i) + rmu(2, i)*temp58b4 + temp49b12 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) + temp49b13 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp49b12 - 2*rmu(2, i)*& +& temp49b13 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& +& temp49b11 + rmub(3, i) = rmub(3, i) + rmu(2, i)*temp49b12 distpb(i, 8) = 0.0_8 - temp58b6 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) - temp58b7 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp58b6 + 2*rmu(1, i)*& -& temp58b7 + 3.d0*2*rmu(1, i)*temp58b5 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp58b6 - rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp58b7 + temp49b14 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) + temp49b15 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp49b14 + 2*rmu(1, i)*& +& temp49b15 + 3.d0*2*rmu(1, i)*temp49b13 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp49b14 + rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp49b15 distpb(i, 7) = 0.0_8 - temp58b8 = cost3g*2.d0*distpb(i, 6) - temp58b9 = (7.d0*rmu(3, i)**2-r(i)**2)*temp58b8 - temp58b10 = rmu(1, i)*rmu(2, i)*temp58b8 - rmub(1, i) = rmub(1, i) + rmu(2, i)*temp58b9 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp58b9 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp58b10 + temp49b16 = cost3g*2.d0*distpb(i, 6) + temp49b17 = (7.d0*rmu(3, i)**2-r(i)**2)*temp49b16 + temp49b18 = rmu(1, i)*rmu(2, i)*temp49b16 + rmub(1, i) = rmub(1, i) + rmu(2, i)*temp49b17 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp49b17 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp49b18 distpb(i, 6) = 0.0_8 - temp58b11 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) - temp58b12 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) + temp49b19 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) + temp49b20 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) distpb(i, 5) = 0.0_8 - temp58b13 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) - temp58b14 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) + temp49b21 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) + temp49b22 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - temp58b15 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) - temp58b16 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) + temp49b23 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) + temp49b24 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 - temp58b17 = cost1g*distpb(i, 2) + temp49b25 = cost1g*distpb(i, 2) rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& -& temp58b17 - 3.d0*2*r(i)*temp58b16 - 2*r(i)*temp58b12 - 3.d0*2*r(& -& i)*temp58b14 - 2*r(i)*temp58b10 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp58b11 - rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp58b11 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp58b12 - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp58b13 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp58b14 + rmu(2, i)*& -& temp58b13 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp58b15 +& temp49b25 - 3.d0*2*r(i)*temp49b24 - 2*r(i)*temp49b20 - 3.d0*2*r(& +& i)*temp49b22 - 2*r(i)*temp49b18 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp49b19 + rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp49b19 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp49b20 + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp49b21 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp49b22 + rmu(2, i)*& +& temp49b21 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp49b23 rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& -& rmu(3, i))*temp58b17 + 7.d0*2*rmu(3, i)*temp58b16 + rmu(1, i)*& -& temp58b15 +& rmu(3, i))*temp49b25 + 7.d0*2*rmu(3, i)*temp49b24 + rmu(1, i)*& +& temp49b23 distpb(i, 2) = 0.0_8 END DO + dd1b = 0.0_8 cb = 0.0_8 DO k=indtm,indtmin,-1 - cb = cb + DEXP(-cost)*distpb(k, 1) - costb = -(c*DEXP(-cost)*distpb(k, 1)) - distpb(k, 1) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp57 = dd2*r(k) + 1.d0 - temp58b = costb/temp57 - temp57b56 = -(dd1*r(k)**2*temp58b/temp57) - dd1b = dd1b + r(k)**2*temp58b - rb(k) = rb(k) + dd2*temp57b56 + dd1*2*r(k)*temp58b - dd2b = dd2b + r(k)*temp57b56 - END DO - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + ratiocg*2.75d0*dd1**1.75D0*cb - ELSE - dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocg*2.75d0*dd1**1.75D0*& -& cb - END IF - ddb(indparp) = ddb(indparp) + dd1b - CASE (1) -! WARNING IN DFT it is assumed that UMRIGAR orbitals could be extended -! up to number 99, so i,h,... are possible extensions. -! 1s single Z NO CUSP! -! if(iocc(indshellp).eq.1) then - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dd1*dsqrt(dd1)/dsqrt(pi) - c = dd1*DSQRT(dd1)*0.56418958354775628695d0 -! endif - indorbp = indorb + 1 - DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) - END DO - IF (typec .NE. 1) THEN - fun = -(dd1*distp(0, 1)) - distpb = 0.0_8 - temp70 = dd1/r(0) - temp70b = -(distp(0, 1)*2.d0*zb(indorbp, indt+4)/r(0)) - dd1b = temp70b + distp(0, 1)*2*dd1*zb(indorbp, indt+4) - rb(0) = rb(0) - temp70*temp70b - distpb(0, 1) = (dd1**2-2.d0*temp70)*zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - funb = 0.0_8 - DO i=3,1,-1 - temp69 = fun/r(0) - temp69b0 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(i, 0) = rmub(i, 0) + temp69*zb(indorbp, indt+i) - funb = funb + temp69b0 - rb(0) = rb(0) - temp69*temp69b0 - zb(indorbp, indt+i) = 0.0_8 - END DO - dd1b = dd1b - distp(0, 1)*funb - distpb(0, 1) = distpb(0, 1) - dd1*funb - ELSE - distpb = 0.0_8 - dd1b = 0.0_8 - END IF - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - cb = 0.0_8 - DO k=indtm,indtmin,-1 - temp69b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + temp49b7 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp69b - rb(k) = rb(k) - dd1*temp69b + dd1b = dd1b - r(k)*temp49b7 + rb(k) = rb(k) - dd1*temp49b7 distpb(k, 1) = 0.0_8 END DO - temp68 = DSQRT(dd1) - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + 0.56418958354775628695d0*temp68*cb - ELSE - dd1b = dd1b + (0.56418958354775628695d0*dd1/(2.D0*DSQRT(dd1))+& -& 0.56418958354775628695d0*temp68)*cb - END IF - ddb(indpar+1) = ddb(indpar+1) + dd1b + dd1b = dd1b + .020104801169736915d0*5.5d0*dd1**4.5D0*cb + ddb(indparp) = ddb(indparp) + dd1b CASE (2) -! 1s double Z with cusp cond -! -! if(iocc(indshellp).eq.1) then +! +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) dd2 = dd(indpar+2) peff = (zeta(1)-dd1)/(dd2-zeta(1)) -! if(iflagnorm.gt.2) then +! if(iflagnorm.gt.2) then c = 1.d0/2.d0/DSQRT(2.d0*pi*(1.d0/(2.d0*dd1)**3+2.d0*peff/(dd1+dd2)& & **3+peff**2/(2.d0*dd2)**3)) -! endif +! endif DO k=indtmin,indtm distp(k, 1) = c*DEXP(-(dd1*r(k))) distp(k, 2) = c*DEXP(-(dd2*r(k))) @@ -5292,33 +5165,33 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & IF (typec .NE. 1) THEN fun = (-(dd1*distp(0, 1))-dd2*distp(0, 2)*peff)/r(0) distpb = 0.0_8 - temp78 = dd1/r(0) - temp78b = -(distp(0, 1)*2.d0*zb(indorbp, indt+4)/r(0)) - temp78b0 = peff*distp(0, 2)*zb(indorbp, indt+4) - temp77 = dd2/r(0) - temp77b2 = -(2.d0*temp78b0/r(0)) - temp77b3 = (dd2**2-2.d0*temp77)*zb(indorbp, indt+4) - dd1b = temp78b + distp(0, 1)*2*dd1*zb(indorbp, indt+4) - rb(0) = rb(0) - temp77*temp77b2 - temp78*temp78b - distpb(0, 1) = (dd1**2-2.d0*temp78)*zb(indorbp, indt+4) - dd2b = temp77b2 + 2*dd2*temp78b0 - peffb = distp(0, 2)*temp77b3 - distpb(0, 2) = peff*temp77b3 + temp57 = dd1/r(0) + temp57b = -(distp(0, 1)*2.d0*zb(indorbp, indt+4)/r(0)) + temp57b0 = peff*distp(0, 2)*zb(indorbp, indt+4) + temp56 = dd2/r(0) + temp56b2 = -(2.d0*temp57b0/r(0)) + temp56b3 = (dd2**2-2.d0*temp56)*zb(indorbp, indt+4) + dd1b = temp57b + distp(0, 1)*2*dd1*zb(indorbp, indt+4) + rb(0) = rb(0) - temp56*temp56b2 - temp57*temp57b + distpb(0, 1) = (dd1**2-2.d0*temp57)*zb(indorbp, indt+4) + dd2b = temp56b2 + 2*dd2*temp57b0 + peffb = distp(0, 2)*temp56b3 + distpb(0, 2) = peff*temp56b3 zb(indorbp, indt+4) = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO - temp77b1 = funb/r(0) - dd1b = dd1b - distp(0, 1)*temp77b1 - distpb(0, 1) = distpb(0, 1) - dd1*temp77b1 - distpb(0, 2) = distpb(0, 2) - dd2*peff*temp77b1 - dd2b = dd2b - distp(0, 2)*peff*temp77b1 - peffb = peffb - distp(0, 2)*dd2*temp77b1 + temp56b1 = funb0/r(0) + dd1b = dd1b - distp(0, 1)*temp56b1 + distpb(0, 1) = distpb(0, 1) - dd1*temp56b1 + distpb(0, 2) = distpb(0, 2) - dd2*peff*temp56b1 + dd2b = dd2b - distp(0, 2)*peff*temp56b1 + peffb = peffb - distp(0, 2)*dd2*temp56b1 rb(0) = rb(0) - (-(dd1*distp(0, 1))-distp(0, 2)*(dd2*peff))*& -& temp77b1/r(0) +& temp56b1/r(0) ELSE distpb = 0.0_8 peffb = 0.0_8 @@ -5333,3643 +5206,4291 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - temp77b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + temp56b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp77b + dd2b = dd2b - r(k)*temp56b distpb(k, 2) = 0.0_8 - temp77b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp77b0 - dd2*temp77b + temp56b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp56b0 - dd2*temp56b cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp77b0 + dd1b = dd1b - r(k)*temp56b0 distpb(k, 1) = 0.0_8 END DO - temp76 = 2.d0**3*dd2**3 - temp75 = peff**2/temp76 - temp74 = (dd1+dd2)**3 - temp73 = 2.d0**3*dd1**3 - temp72 = 2.d0*pi*(1.0/temp73+2.d0*peff/temp74+temp75) - temp71 = DSQRT(temp72) - IF (temp72 .EQ. 0.0) THEN - temp71b = 0.0 + temp55 = 2.d0**3*dd2**3 + temp54 = peff**2/temp55 + temp53 = (dd1+dd2)**3 + temp52 = 2.d0**3*dd1**3 + temp51 = 2.d0*pi*(1.0/temp52+2.d0*peff/temp53+temp54) + temp50 = DSQRT(temp51) + IF (temp51 .EQ. 0.0) THEN + temp50b56 = 0.0 ELSE - temp71b = -(pi*cb/(temp71**2*2.D0*DSQRT(temp72))) + temp50b56 = -(pi*cb/(temp50**2*2.D0*DSQRT(temp51))) END IF - temp71b0 = 2.d0*temp71b/temp74 - temp71b1 = -(peff*3*(dd1+dd2)**2*temp71b0/temp74) - peffb = peffb + 2*peff*temp71b/temp76 + temp71b0 - temp71b2 = peffb/(dd2-zeta(1)) - dd1b = dd1b + temp71b1 - temp71b2 - 2.d0**3*3*dd1**2*temp71b/temp73& -& **2 - dd2b = dd2b + temp71b1 - temp75*2.d0**3*3*dd2**2*temp71b/temp76 - (& -& zeta(1)-dd1)*temp71b2/(dd2-zeta(1)) + temp50b57 = 2.d0*temp50b56/temp53 + temp50b58 = -(peff*3*(dd1+dd2)**2*temp50b57/temp53) + peffb = peffb + 2*peff*temp50b56/temp55 + temp50b57 + temp50b59 = peffb/(dd2-zeta(1)) + dd1b = dd1b + temp50b58 - temp50b59 - 2.d0**3*3*dd1**2*temp50b56/& +& temp52**2 + dd2b = dd2b + temp50b58 - temp54*2.d0**3*3*dd2**2*temp50b56/temp55 -& +& (zeta(1)-dd1)*temp50b59/(dd2-zeta(1)) ddb(indpar+2) = ddb(indpar+2) + dd2b ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (3) -! 1s double Z NO CUSP -! -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 + CASE (23) +! 1s double Z NO CUSP +! 3p without cusp condition +! r ( e^{-z2 r } + z1 e^{-z3 r } ) dd1 = dd(indpar+1) dd2 = dd(indpar+2) - peff = dd(indpar+3) -! if(iflagnorm.gt.2) then - c = 1.d0/2.d0/DSQRT(2.d0*pi*(1.d0/(2.d0*dd1)**3+2.d0*peff/(dd1+dd2)& -& **3+peff**2/(2.d0*dd2)**3)) - ad_from = indpar + 1 -! endif - DO i=ad_from,indpar+2 - DO k=indtmin,indtm - distp(k, i-indpar) = c*DEXP(-(dd(i)*r(k))) - END DO + dd3 = dd(indpar+3) +! if(iflagnorm.gt.2) then + c = 1.d0/2.d0/DSQRT(240.d0*pi*(1.d0/(2.d0*dd1)**7+2.d0*dd3/(dd1+dd2)& +& **7+dd3**2/(2.d0*dd2)**7)) +! endif +! + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 2) = c*DEXP(-(dd2*r(k))) END DO - CALL PUSHINTEGER4(adi4ibuf,adi4buf,i - 1) - CALL PUSHINTEGER4(adi4ibuf,adi4buf,ad_from) +! + DO i=indtmin,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = r(i)*(distp(i, 1)+dd3*distp(i, 2)) + END DO +! +! indorbp=indorb +! + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif +! +! IF (typec .NE. 1) THEN - fun = -(dd1*distp(0, 1)) - peff*dd2*distp(0, 2) - distpb = 0.0_8 - temp88 = dd1/r(0) - temp88b = -(distp(0, 1)*2.d0*zb(indorbp, indt+4)/r(0)) - temp88b0 = peff*distp(0, 2)*zb(indorbp, indt+4) - temp87 = dd2/r(0) - temp87b = -(2.d0*temp88b0/r(0)) - temp87b0 = (dd2**2-2.d0*temp87)*zb(indorbp, indt+4) - dd1b = temp88b + distp(0, 1)*2*dd1*zb(indorbp, indt+4) - rb(0) = rb(0) - temp87*temp87b - temp88*temp88b - distpb(0, 1) = (dd1**2-2.d0*temp88)*zb(indorbp, indt+4) - dd2b = temp87b + 2*dd2*temp88b0 - peffb = distp(0, 2)*temp87b0 - distpb(0, 2) = peff*temp87b0 - zb(indorbp, indt+4) = 0.0_8 - funb = 0.0_8 - DO i=3,1,-1 - temp86 = fun/r(0) - temp86b = rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(i, 0) = rmub(i, 0) + temp86*zb(indorbp, indt+i) - funb = funb + temp86b - rb(0) = rb(0) - temp86*temp86b - zb(indorbp, indt+i) = 0.0_8 + fun = (1.d0-dd1*r(0))*distp(0, 1) + dd3*(1.d0-dd2*r(0))*distp(0, 2& +& ) + fun2 = dd1*(dd1*r(0)-2.d0)*distp(0, 1) + dd3*dd2*(dd2*r(0)-2.d0)*& +& distp(0, 2) +! +! indorbp=indorb +! + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp67 = fun/r(0) + temp68b = rmu(ic, 0)*zb(indorbp, indt+4) + temp67b = 4.d0*temp68b/r(0) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp67+fun2)*zb(indorbp, indt+& +& 4) + funb0 = funb0 + temp67b + rb(0) = rb(0) - temp67*temp67b + fun2b = fun2b + temp68b + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp66 = fun/r(0) + temp66b8 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(ic, 0) = rmub(ic, 0) + temp66*rmu(i, 0)*zb(indorbp, indt+& +& i) + rmub(i, 0) = rmub(i, 0) + temp66*rmu(ic, 0)*zb(indorbp, indt+i& +& ) + funb0 = funb0 + temp66b8 + rb(0) = rb(0) - temp66*temp66b8 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - dd1b = dd1b - distp(0, 1)*funb - distpb(0, 1) = distpb(0, 1) - dd1*funb - peffb = peffb - distp(0, 2)*dd2*funb - dd2b = dd2b - distp(0, 2)*peff*funb - distpb(0, 2) = distpb(0, 2) - peff*dd2*funb + distpb = 0.0_8 + temp66b2 = dd1*distp(0, 1)*fun2b + temp66b3 = (dd1*r(0)-2.d0)*fun2b + temp66b4 = (dd2*r(0)-2.d0)*fun2b + temp66b5 = dd3*dd2*distp(0, 2)*fun2b + dd1b = distp(0, 1)*temp66b3 - distp(0, 1)*r(0)*funb0 + r(0)*& +& temp66b2 + temp66b6 = dd3*distp(0, 2)*funb0 + rb(0) = rb(0) + dd2*temp66b5 - dd2*temp66b6 - distp(0, 1)*dd1*& +& funb0 + dd1*temp66b2 + distpb(0, 1) = dd1*temp66b3 + temp66b7 = (1.d0-dd2*r(0))*funb0 + dd3b = distp(0, 2)*temp66b7 + distp(0, 2)*dd2*temp66b4 + dd2b = r(0)*temp66b5 - r(0)*temp66b6 + distp(0, 2)*dd3*temp66b4 + distpb(0, 2) = dd3*dd2*temp66b4 + distpb(0, 1) = distpb(0, 1) + (1.d0-dd1*r(0))*funb0 + distpb(0, 2) = distpb(0, 2) + dd3*temp66b7 + distpb(0, 3) = distpb(0, 3) + fun0b ELSE distpb = 0.0_8 - peffb = 0.0_8 dd1b = 0.0_8 dd2b = 0.0_8 + dd3b = 0.0_8 END IF - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - peffb = peffb + distp(i, 2)*zb(indorbp, i) - distpb(i, 2) = distpb(i, 2) + peff*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=3,1,-1 + DO i=indtm,i0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO i=indtm,indtmin,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + temp66b1 = r(i)*distpb(i, 3) + rb(i) = rb(i) + (distp(i, 1)+dd3*distp(i, 2))*distpb(i, 3) + distpb(i, 1) = distpb(i, 1) + temp66b1 + dd3b = dd3b + distp(i, 2)*temp66b1 + distpb(i, 2) = distpb(i, 2) + dd3*temp66b1 + distpb(i, 3) = 0.0_8 END DO cb = 0.0_8 - CALL POPINTEGER4(adi4ibuf,adi4buf,ad_from) - CALL POPINTEGER4(adi4ibuf,adi4buf,ad_to) - DO i=ad_to,ad_from,-1 - DO k=indtm,indtmin,-1 - temp85 = -(dd(i)*r(k)) - temp85b = c*DEXP(temp85)*distpb(k, i-indpar) - cb = cb + DEXP(temp85)*distpb(k, i-indpar) - ddb(i) = ddb(i) - r(k)*temp85b - rb(k) = rb(k) - dd(i)*temp85b - distpb(k, i-indpar) = 0.0_8 - END DO + DO k=indtm,indtmin,-1 + temp66b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp66b + distpb(k, 2) = 0.0_8 + temp66b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp66b0 - dd2*temp66b + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp66b0 + distpb(k, 1) = 0.0_8 END DO - temp84 = 2.d0**3*dd2**3 - temp83 = peff**2/temp84 - temp82 = (dd1+dd2)**3 - temp81 = 2.d0**3*dd1**3 - temp80 = 2.d0*pi*(1.0/temp81+2.d0*peff/temp82+temp83) - temp79 = DSQRT(temp80) - IF (temp80 .EQ. 0.0) THEN - temp79b = 0.0 + temp65 = 2.d0**7 + temp64 = temp65*dd2**7 + temp63 = dd3**2/temp64 + temp62 = (dd1+dd2)**7 + temp61 = 2.d0**7 + temp60 = temp61*dd1**7 + temp59 = 240.d0*pi*(1.0/temp60+2.d0*dd3/temp62+temp63) + temp58 = DSQRT(temp59) + IF (temp59 .EQ. 0.0) THEN + temp58b = 0.0 ELSE - temp79b = -(pi*cb/(temp79**2*2.D0*DSQRT(temp80))) + temp58b = -(pi*240.d0*cb/(2.d0*temp58**2*2.D0*DSQRT(temp59))) END IF - temp79b0 = 2.d0*temp79b/temp82 - temp79b1 = -(peff*3*(dd1+dd2)**2*temp79b0/temp82) - dd1b = dd1b + temp79b1 - 2.d0**3*3*dd1**2*temp79b/temp81**2 - peffb = peffb + 2*peff*temp79b/temp84 + temp79b0 - dd2b = dd2b + temp79b1 - temp83*2.d0**3*3*dd2**2*temp79b/temp84 - ddb(indpar+3) = ddb(indpar+3) + peffb + temp58b0 = 2.d0*temp58b/temp62 + temp58b1 = -(dd3*7*(dd1+dd2)**6*temp58b0/temp62) + dd1b = dd1b + temp58b1 - temp61*7*dd1**6*temp58b/temp60**2 + dd3b = dd3b + 2*dd3*temp58b/temp64 + temp58b0 + dd2b = dd2b + temp58b1 - temp63*temp65*7*dd2**6*temp58b/temp64 + ddb(indpar+3) = ddb(indpar+3) + dd3b ddb(indpar+2) = ddb(indpar+2) + dd2b ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (4) -! 2s 2pz Hybryd single Z -! normalized -! if(iocc(indshellp).eq.1) then + CASE (80) +! 4p single zeta +! R(r)=exp(-z*r**2) single zeta indorbp = indorb + 1 dd1 = dd(indpar+1) - dd2 = dd(indpar+2) -! if(iflagnorm.gt.2) then - c = dd1**2.5d0/DSQRT(3.d0*pi*(1.d0+dd2**2/3.d0)) -! endif + dd2 = DSQRT(dd1) +! if(iflagnorm.gt.2) then +! c=(2.d0*dd1/pi)**(3.d0/4.d0)*ratiocs +! ratiocs--> ratiocs*(2/pi)**3/4 + c = dd1**0.75d0*ratiocs +! endif DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) END DO IF (typec .NE. 1) THEN - fun = distp(0, 1)*(1.d0-dd1*r(0)) - funp = -(dd2*dd1*distp(0, 1)*rmu(3, 0)) - temp92b = zb(indorbp, indt+4)/r(0) - funb = 2.d0*temp92b - funpb = 4.d0*temp92b - rb(0) = rb(0) - (2.d0*fun+4.d0*funp)*temp92b/r(0) +! the first derivative /r + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) +! the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) - fun2pb = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 - distpb = 0.0_8 - dd2b = distp(0, 1)*zb(indorbp, indt+3) - distpb(0, 1) = dd2*zb(indorbp, indt+3) DO i=3,1,-1 - temp91b6 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) - temp91 = (fun+funp)/r(0) - funb = funb + temp91b6 - funpb = funpb + temp91b6 - rb(0) = rb(0) - temp91*temp91b6 - rmub(i, 0) = rmub(i, 0) + temp91*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO - temp91b1 = dd2*distp(0, 1)*fun2pb - temp91b2 = dd1**2*rmu(3, 0)*fun2pb - temp91b3 = distp(0, 1)*fun2b - temp91b4 = -(distp(0, 1)*rmu(3, 0)*funpb) - dd1b = (r(0)*2*dd1-2.d0)*temp91b3 - distp(0, 1)*r(0)*funb + dd2*& -& temp91b4 + rmu(3, 0)*2*dd1*temp91b1 - temp91b5 = -(dd2*dd1*funpb) - rmub(3, 0) = rmub(3, 0) + distp(0, 1)*temp91b5 + dd1**2*temp91b1 - dd2b = dd2b + dd1*temp91b4 + distp(0, 1)*temp91b2 - distpb(0, 1) = distpb(0, 1) + (dd1**2*r(0)-2.d0*dd1)*fun2b + (1.d0& -& -dd1*r(0))*funb + rmu(3, 0)*temp91b5 + dd2*temp91b2 - rb(0) = rb(0) + dd1**2*temp91b3 - distp(0, 1)*dd1*funb + distpb = 0.0_8 + temp71 = rp3**2 + temp70b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& +& temp71 + temp70 = dd1*distp(0, 1)/temp71 + temp70b0 = temp70*fun2b + rp1b = (2*rp1+4.d0*rp2+4.d0)*temp70b0 + temp69b0 = -(distp(0, 1)*(rp2+2.d0)*funb0/rp3) + dd1b = temp69b0 + r(0)**2*rp1b + distp(0, 1)*temp70b + temp69 = dd1/rp3 + distpb(0, 1) = dd1*temp70b - temp69*(rp2+2.d0)*funb0 + rp3b = -(temp69*temp69b0) - temp70*2*rp3*temp70b + rp2b = 2*(rp2+1.d0)*rp3b - temp69*distp(0, 1)*funb0 + (4.d0*rp1-& +& 2.d0)*temp70b0 + dd2b = r(0)*rp2b + rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b ELSE distpb = 0.0_8 dd1b = 0.0_8 dd2b = 0.0_8 END IF DO i=indtm,i0,-1 - temp91b0 = distp(i, 1)*zb(indorbp, i) - rb(i) = rb(i) + temp91b0 - dd2b = dd2b + rmu(3, i)*temp91b0 - rmub(3, i) = rmub(3, i) + dd2*temp91b0 - distpb(i, 1) = distpb(i, 1) + (r(i)+dd2*rmu(3, i))*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - temp91b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp91b - rb(k) = rb(k) - dd1*temp91b + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp68 = dd2*r(k) + 1.d0 + temp69b = costb/temp68 + temp68b0 = -(dd1*r(k)**2*temp69b/temp68) + dd1b = dd1b + r(k)**2*temp69b + rb(k) = rb(k) + dd2*temp68b0 + dd1*2*r(k)*temp69b + dd2b = dd2b + r(k)*temp68b0 END DO - temp90 = 3.d0*pi*(dd2**2/3.d0+1.d0) - temp89 = DSQRT(temp90) - dd1b = dd1b + 2.5d0*dd1**1.5D0*cb/temp89 - IF (.NOT.temp90 .EQ. 0.0) dd2b = dd2b - dd1**2.5d0*pi*2*dd2*cb/(& -& temp89**2*2.D0*DSQRT(temp90)) - ddb(indpar+2) = ddb(indpar+2) + dd2b + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocs*0.75d0*dd1**(-0.25D0)*cb + ELSE + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocs*0.75d0*dd1**(& +& -0.25D0)*cb + END IF ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (5) -! 2s single Z NO CUSP -! normalized -! if(iocc(indshellp).eq.1) then + CASE (17) +! 2s gaussian for pseudo +! R(r)=r**2*exp(-z*r**2) single zeta +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c=4.d0*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)/dsqrt(15.d0) + c = .73607904464954686606d0*dd1**1.75d0 +! endif DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO -! if(iflagnorm.gt.2) then -! c=dd1**2.5d0/dsqrt(3.d0*pi) - c = dd1**2.5d0*0.32573500793527994772d0 IF (typec .NE. 1) THEN - fun = distp(0, 1)*(1.d0-dd1*r(0)) - fun2 = distp(0, 1)*(dd1**2*r(0)-2.d0*dd1) - temp93b = 2.d0*zb(indorbp, indt+4)/r(0) - cb = fun2*zb(indorbp, indt+4) + fun*temp93b - funb = c*temp93b - rb(0) = rb(0) - c*fun*temp93b/r(0) - fun2b = c*zb(indorbp, indt+4) + rp1 = r(0)**2 +! the first derivative / r + fun = 2.d0*distp(0, 1)*(1.d0-dd1*rp1) +! the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - temp92 = rmu(i, 0)/r(0) - temp92b3 = c*fun*zb(indorbp, indt+i)/r(0) - cb = cb + temp92*fun*zb(indorbp, indt+i) - funb = funb + temp92*c*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp92b3 - rb(0) = rb(0) - temp92*temp92b3 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp92b2 = distp(0, 1)*fun2b - distpb(0, 1) = (1.d0-dd1*r(0))*funb + (dd1**2*r(0)-2.d0*dd1)*fun2b - dd1b = (r(0)*2*dd1-2.d0)*temp92b2 - distp(0, 1)*r(0)*funb - rb(0) = rb(0) + dd1**2*temp92b2 - distp(0, 1)*dd1*funb + temp73b = 2.d0*distp(0, 1)*fun2b + distpb(0, 1) = 2.d0*(1.d0-dd1*rp1)*funb0 + 2.d0*(2.d0*(dd1**2*rp1& +& **2)-5.d0*(dd1*rp1)+1.d0)*fun2b + temp73b0 = 2.d0*distp(0, 1)*funb0 + dd1b = (2.d0*rp1**2*2*dd1-5.d0*rp1)*temp73b - rp1*temp73b0 + rp1b = (2.d0*dd1**2*2*rp1-5.d0*dd1)*temp73b - dd1*temp73b0 + rb(0) = rb(0) + 2*r(0)*rp1b ELSE distpb = 0.0_8 dd1b = 0.0_8 - cb = 0.0_8 END IF DO i=indtm,i0,-1 - temp92b1 = distp(i, 1)*zb(indorbp, i) - cb = cb + r(i)*temp92b1 - rb(i) = rb(i) + c*temp92b1 - distpb(i, 1) = distpb(i, 1) + c*r(i)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO - dd1b = dd1b + 0.32573500793527994772d0*2.5d0*dd1**1.5D0*cb + cb = 0.0_8 DO k=indtm,indtmin,-1 - temp92b0 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp92b0 - rb(k) = rb(k) - dd1*temp92b0 + temp72 = r(k)**2 + temp72b = c*DEXP(-(dd1*temp72))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp72))*distpb(k, 1) + dd1b = dd1b - temp72*temp72b + rb(k) = rb(k) - dd1*2*r(k)*temp72b distpb(k, 1) = 0.0_8 END DO + dd1b = dd1b + .73607904464954686606d0*1.75d0*dd1**0.75D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (6) -! 2s double Z NO CUSP -! normalized -! if(iocc(indshellp).eq.1) then + CASE (10) +! 2s gaussian for pseudo +! s orbital +! +! - angmom = 0 +! - type = Slater +! - normalized = yes +! - angtype = spherical +! - npar = 1 +! - multiplicity = 1 +! +! = N * R +! +! 3s single zeta +! and R is the radial part +! R(r) = r**2*exp(-z1*r) +! indorbp = indorb + 1 dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) -! if(iflagnorm.gt.2) then -! c= WRONG -! &0.5*dsqrt((1.d0/dd1**5/32.d0+2.d0*peff/(dd1+dd2)**5 -! &+peff**2/dd2**5/32.d0)/(24.d0*pi)) - c = 1.d0/DSQRT(3.d0*pi*(1.d0/dd1**5+64.d0*peff/(dd1+dd2)**5+peff**2/& -& dd2**5)) -! endif + c = dd1**3.5d0*0.11894160774351807429d0 DO k=indtmin,indtm distp(k, 1) = c*DEXP(-(dd1*r(k))) - distp(k, 2) = c*DEXP(-(dd2*r(k))) END DO IF (typec .NE. 1) THEN - fun = distp(0, 1)*(1.d0-dd1*r(0)) + peff*distp(0, 2)*(1.d0-dd2*r(0& -& )) - temp100b = 2.d0*zb(indorbp, indt+4)/r(0) - funb = temp100b - rb(0) = rb(0) - fun*temp100b/r(0) + fun = (2.d0-dd1*r(0))*distp(0, 1) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - temp99 = fun/r(0) - temp99b7 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(i, 0) = rmub(i, 0) + temp99*zb(indorbp, indt+i) - funb = funb + temp99b7 - rb(0) = rb(0) - temp99*temp99b7 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp99b2 = distp(0, 1)*fun2b - temp99b3 = (dd2**2*r(0)-2.d0*dd2)*fun2b - temp99b4 = peff*distp(0, 2)*fun2b - distpb(0, 1) = (dd1**2*r(0)-2.d0*dd1)*fun2b - dd1b = (r(0)*2*dd1-2.d0)*temp99b2 - distp(0, 1)*r(0)*funb - temp99b5 = peff*distp(0, 2)*funb - rb(0) = rb(0) + dd2**2*temp99b4 - dd2*temp99b5 - distp(0, 1)*dd1*& -& funb + dd1**2*temp99b2 - temp99b6 = (1.d0-dd2*r(0))*funb - peffb = distp(0, 2)*temp99b6 + distp(0, 2)*temp99b3 - distpb(0, 2) = peff*temp99b3 - dd2b = (r(0)*2*dd2-2.d0)*temp99b4 - r(0)*temp99b5 - distpb(0, 1) = distpb(0, 1) + (1.d0-dd1*r(0))*funb - distpb(0, 2) = distpb(0, 2) + peff*temp99b6 + temp73b2 = distp(0, 1)*fun2b + temp73b3 = 2*dd1*r(0)*temp73b2 + dd1b = r(0)*temp73b3 - 4*r(0)*temp73b2 - distp(0, 1)*r(0)*funb0 + rb(0) = rb(0) + dd1*temp73b3 - 4*dd1*temp73b2 - distp(0, 1)*dd1*& +& funb0 + distpb(0, 1) = (2.d0-dd1*r(0))*funb0 + ((dd1*r(0))**2-4*(dd1*r(0))& +& +2.d0)*fun2b ELSE distpb = 0.0_8 - peffb = 0.0_8 dd1b = 0.0_8 - dd2b = 0.0_8 END IF DO i=indtm,i0,-1 - temp99b1 = r(i)*zb(indorbp, i) - rb(i) = rb(i) + (distp(i, 1)+distp(i, 2)*peff)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp99b1 - distpb(i, 2) = distpb(i, 2) + peff*temp99b1 - peffb = peffb + distp(i, 2)*temp99b1 + distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - temp99b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp99b - distpb(k, 2) = 0.0_8 - temp99b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp99b0 - dd2*temp99b + temp73b1 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp99b0 + dd1b = dd1b - r(k)*temp73b1 + rb(k) = rb(k) - dd1*temp73b1 distpb(k, 1) = 0.0_8 END DO - temp98 = dd2**5 - temp97 = peff**2/temp98 - temp96 = (dd1+dd2)**5 - temp95 = dd1**5 - temp94 = 3.d0*pi*(1.0/temp95+64.d0*peff/temp96+temp97) - temp93 = DSQRT(temp94) - IF (temp94 .EQ. 0.0) THEN - temp93b0 = 0.0 - ELSE - temp93b0 = -(pi*3.d0*cb/(temp93**2*2.D0*DSQRT(temp94))) - END IF - temp93b1 = 64.d0*temp93b0/temp96 - temp93b2 = -(peff*5*(dd1+dd2)**4*temp93b1/temp96) - dd1b = dd1b + temp93b2 - 5*dd1**4*temp93b0/temp95**2 - peffb = peffb + 2*peff*temp93b0/temp98 + temp93b1 - dd2b = dd2b + temp93b2 - temp97*5*dd2**4*temp93b0/temp98 - ddb(indpar+3) = ddb(indpar+3) + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b + dd1b = dd1b + 0.11894160774351807429d0*3.5d0*dd1**2.5D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (7) -! 2s double Z NO CUSP -! normalized IS WRONG!!! -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) + CASE (129) +! 2p single exponential r e^{-z r} ! parent of 121 + dd2 = dd(indpar+1) DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k))) - distp(k, 2) = DEXP(-(dd2*r(k))) + distp(k, 1) = DEXP(-(dd2*r(k))) END DO -! if(iflagnorm.gt.2) then - c = 1/DSQRT(1/(3.d0/4.d0/dd1**5+peff**2/dd2**3/4+12*peff/(dd1+dd2)**& -& 4))*1.d0/DSQRT(4.0*pi) +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif IF (typec .NE. 1) THEN - fun = -(dd1*distp(0, 1)) + peff*distp(0, 2)*(1.d0-dd2*r(0)) - fun2 = distp(0, 1)*dd1**2 + peff*distp(0, 2)*(dd2**2*r(0)-2.d0*dd2& -& ) - temp110 = fun/r(0) - temp110b = c*2.d0*zb(indorbp, indt+4)/r(0) - cb = (2.d0*temp110+fun2)*zb(indorbp, indt+4) - funb = temp110b - rb(0) = rb(0) - temp110*temp110b - fun2b = c*zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - temp109 = rmu(i, 0)/r(0) - temp109b5 = fun*c*zb(indorbp, indt+i)/r(0) - funb = funb + temp109*c*zb(indorbp, indt+i) - cb = cb + temp109*fun*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp109b5 - rb(0) = rb(0) - temp109*temp109b5 - zb(indorbp, indt+i) = 0.0_8 + fun = distp(0, 1)*(1.d0-dd2*r(0))/r(0) + fun2 = dd2*(dd2*r(0)-2.d0)*distp(0, 1) +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp74b2 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp74b2 + fun2b = fun2b + temp74b2 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp74b1 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp74b1 + funb0 = funb0 + rmu(ic, 0)*temp74b1 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp109b1 = (dd2**2*r(0)-2.d0*dd2)*fun2b - temp109b2 = peff*distp(0, 2)*fun2b - distpb(0, 1) = dd1**2*fun2b - dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb - temp109b3 = (1.d0-dd2*r(0))*funb - peffb = distp(0, 2)*temp109b3 + distp(0, 2)*temp109b1 - distpb(0, 2) = peff*temp109b3 + peff*temp109b1 - temp109b4 = peff*distp(0, 2)*funb - dd2b = (r(0)*2*dd2-2.d0)*temp109b2 - r(0)*temp109b4 - rb(0) = rb(0) + dd2**2*temp109b2 - dd2*temp109b4 - distpb(0, 1) = distpb(0, 1) - dd1*funb + temp74b = dd2*distp(0, 1)*fun2b + temp74b0 = (dd2*r(0)-2.d0)*fun2b + temp73 = distp(0, 1)/r(0) + dd2b = distp(0, 1)*temp74b0 - temp73*r(0)*funb0 + r(0)*temp74b + temp73b6 = (1.d0-dd2*r(0))*funb0/r(0) + rb(0) = rb(0) + distp(0, 1)*fun0b - temp73*dd2*funb0 - temp73*& +& temp73b6 + dd2*temp74b + distpb(0, 1) = temp73b6 + r(0)*fun0b + dd2*temp74b0 ELSE distpb = 0.0_8 - peffb = 0.0_8 - dd1b = 0.0_8 dd2b = 0.0_8 - cb = 0.0_8 END IF - DO i=indtm,i0,-1 - temp109b = c*zb(indorbp, i) - temp109b0 = distp(i, 2)*temp109b - cb = cb + (distp(i, 1)+r(i)*peff*distp(i, 2))*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp109b - rb(i) = rb(i) + peff*temp109b0 - peffb = peffb + r(i)*temp109b0 - distpb(i, 2) = distpb(i, 2) + r(i)*peff*temp109b - zb(indorbp, i) = 0.0_8 + DO ic=3,1,-1 + DO i=indtm,i0,-1 + temp73b5 = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*r(i)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + r(i)*temp73b5 + rb(i) = rb(i) + distp(i, 1)*temp73b5 + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp108 = (dd1+dd2)**4 - temp107 = 4*dd2**3 - temp106 = peff**2/temp107 - temp105 = 4.d0*dd1**5 - temp100 = 3.d0/temp105 + temp106 + 12*(peff/temp108) - temp104 = 1.0/temp100 - temp103 = DSQRT(temp104) - temp102 = DSQRT(4.0*pi) - temp101 = temp102*temp103 - IF (temp104 .EQ. 0.0) THEN - temp100b2 = 0.0 - ELSE - temp100b2 = temp102*temp104*cb/(temp101**2*2.D0*DSQRT(temp104)*& -& temp100) - END IF - temp100b3 = 12*temp100b2/temp108 - temp100b4 = -(peff*4*(dd1+dd2)**3*temp100b3/temp108) - dd1b = dd1b + temp100b4 - 3.d0*4.d0*5*dd1**4*temp100b2/temp105**2 - peffb = peffb + temp100b3 + 2*peff*temp100b2/temp107 - dd2b = dd2b + temp100b4 - temp106*4*3*dd2**2*temp100b2/temp107 DO k=indtm,indtmin,-1 - temp100b0 = DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp100b0 - distpb(k, 2) = 0.0_8 - temp100b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp100b1 - dd2*temp100b0 - dd1b = dd1b - r(k)*temp100b1 + temp73b4 = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp73b4 + rb(k) = rb(k) - dd2*temp73b4 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+3) = ddb(indpar+3) + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (8) -! 2s double Z WITH CUSP -! normalized -! exp(-dd1*r) + (dd1-zeta) * r * exp(-dd2*r) -! if(iocc(indshellp).eq.1) then + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (110) +! 2s without cusp condition +! dd1*( dd3 +1/(1+dd2*r^3)) + dd2 = dd(indpar+1) indorbp = indorb + 1 - dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd1 - zeta(1) DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k))) - distp(k, 2) = DEXP(-(dd2*r(k))) + distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**3) END DO -! if(iflagnorm.gt.2) then - c = 1.d0/DSQRT(1/4.d0/dd1**3+12*peff/(dd1+dd2)**4+3*peff**2/4/dd2**5& -& )/DSQRT(4.0*pi) +! endif IF (typec .NE. 1) THEN - fun = -(dd1*distp(0, 1)) + peff*distp(0, 2)*(1.d0-dd2*r(0)) - fun2 = distp(0, 1)*dd1**2 + peff*distp(0, 2)*(dd2**2*r(0)-2.d0*dd2& -& ) - temp119 = fun/r(0) - temp119b = c*2.d0*zb(indorbp, indt+4)/r(0) - cb = (2.d0*temp119+fun2)*zb(indorbp, indt+4) - funb = temp119b - rb(0) = rb(0) - temp119*temp119b - fun2b = c*zb(indorbp, indt+4) + fun = -(dd2*distp(0, 1)**2*3.d0*r(0)) + fun2b = zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - temp118 = rmu(i, 0)/r(0) - temp118b5 = fun*c*zb(indorbp, indt+i)/r(0) - funb = funb + temp118*c*zb(indorbp, indt+i) - cb = cb + temp118*fun*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp118b5 - rb(0) = rb(0) - temp118*temp118b5 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp118b1 = (dd2**2*r(0)-2.d0*dd2)*fun2b - temp118b2 = peff*distp(0, 2)*fun2b - distpb(0, 1) = dd1**2*fun2b - dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb - temp118b3 = (1.d0-dd2*r(0))*funb - peffb = distp(0, 2)*temp118b3 + distp(0, 2)*temp118b1 - distpb(0, 2) = peff*temp118b3 + peff*temp118b1 - temp118b4 = peff*distp(0, 2)*funb - dd2b = (r(0)*2*dd2-2.d0)*temp118b2 - r(0)*temp118b4 - rb(0) = rb(0) + dd2**2*temp118b2 - dd2*temp118b4 - distpb(0, 1) = distpb(0, 1) - dd1*funb + temp75 = r(0)**3 + temp75b = (2.d0-4.d0*(dd2*temp75))*fun2b + temp75b0 = -(fun*distp(0, 1)*4.d0*fun2b) + funb0 = funb0 + distp(0, 1)*temp75b + distpb(0, 1) = fun*temp75b - 3.d0*dd2*r(0)*2*distp(0, 1)*funb0 + temp75b1 = -(3.d0*distp(0, 1)**2*funb0) + dd2b = r(0)*temp75b1 + temp75*temp75b0 + rb(0) = rb(0) + dd2*temp75b1 + dd2*3*r(0)**2*temp75b0 ELSE distpb = 0.0_8 - peffb = 0.0_8 - dd1b = 0.0_8 dd2b = 0.0_8 - cb = 0.0_8 END IF + dd3b = 0.0_8 DO i=indtm,i0,-1 - temp118b = c*zb(indorbp, i) - temp118b0 = distp(i, 2)*temp118b - cb = cb + (distp(i, 1)+r(i)*peff*distp(i, 2))*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp118b - rb(i) = rb(i) + peff*temp118b0 - peffb = peffb + r(i)*temp118b0 - distpb(i, 2) = distpb(i, 2) + r(i)*peff*temp118b + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO - temp117 = 4*dd2**5 - temp111 = peff**2/temp117 - temp116 = (dd1+dd2)**4 - temp115 = 4.d0*dd1**3 - temp112 = 1.0/temp115 + 12*(peff/temp116) + 3*temp111 - temp114 = DSQRT(temp112) - temp113 = DSQRT(4.0*pi) - IF (temp112 .EQ. 0.0) THEN - temp112b = 0.0 - ELSE - temp112b = -(cb/(temp113*temp114**2*2.D0*DSQRT(temp112))) - END IF - temp112b0 = 12*temp112b/temp116 - temp112b1 = -(peff*4*(dd1+dd2)**3*temp112b0/temp116) - temp111b1 = 3*temp112b/temp117 - dd1b = dd1b + temp112b1 - 4.d0*3*dd1**2*temp112b/temp115**2 - peffb = peffb + 2*peff*temp111b1 + temp112b0 - dd2b = dd2b + temp112b1 - temp111*4*5*dd2**4*temp111b1 DO k=indtm,indtmin,-1 - temp111b = DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp111b - distpb(k, 2) = 0.0_8 - temp111b0 = DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp111b0 - dd2*temp111b - dd1b = dd1b - r(k)*temp111b0 + temp74 = r(k)**3 + temp74b3 = -(distpb(k, 1)/(dd2*temp74+1.d0)**2) + dd2b = dd2b + temp74*temp74b3 + rb(k) = rb(k) + dd2*3*r(k)**2*temp74b3 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (10) -! 3s single zeta -! R(r)=r**2*exp(-z1*r) -! if(iocc(indshellp).eq.1) then + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (46) +! R(r)=c*r**2*exp(-z*r**2)*(7/4/z-r**2) +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2*dd1)**7/720.d0/pi)/2.d0 - c = dd1**3.5d0*0.11894160774351807429d0 -! endif +! if(iflagnorm.gt.2) then + c = 4.d0*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)/DSQRT(15.d0) +! endif DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO IF (typec .NE. 1) THEN - fun = (2.d0-dd1*r(0))*distp(0, 1) - funb = 2.d0*zb(indorbp, indt+4) + rp1 = r(0)**2 +! the first derivative / r + fun = distp(0, 1)*(7.d0-15.d0*dd1*rp1+4.d0*(dd1*rp1)**2)/2.d0/dd1 +! the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp120b0 = distp(0, 1)*fun2b - temp120b1 = 2*dd1*r(0)*temp120b0 - dd1b = r(0)*temp120b1 - 4*r(0)*temp120b0 - distp(0, 1)*r(0)*funb - rb(0) = rb(0) + dd1*temp120b1 - 4*dd1*temp120b0 - distp(0, 1)*dd1*& -& funb - distpb(0, 1) = (2.d0-dd1*r(0))*funb + ((dd1*r(0))**2-4*(dd1*r(0))+& -& 2.d0)*fun2b + temp82 = 2.d0*dd1 + temp81 = distp(0, 1)/temp82 + temp82b = temp81*fun2b + temp82b0 = 50*2*dd1*rp1*temp82b + temp82b1 = -(8*3*dd1**2*rp1**2*temp82b) + temp81b = (50*(dd1*rp1)**2-59*(dd1*rp1)-8*(dd1*rp1)**3+7.d0)*fun2b& +& /temp82 + temp80 = 2.d0*dd1 + temp79 = distp(0, 1)/temp80 + temp80b = temp79*funb0 + temp79b = (4.d0*(dd1**2*rp1**2)-15.d0*(dd1*rp1)+7.d0)*funb0/temp80 + dd1b = (4.d0*rp1**2*2*dd1-15.d0*rp1)*temp80b - temp79*2.d0*temp79b& +& - temp81*2.d0*temp81b + rp1*temp82b1 - 59*rp1*temp82b + rp1*& +& temp82b0 + rp1b = (4.d0*dd1**2*2*rp1-15.d0*dd1)*temp80b + dd1*temp82b1 - 59*& +& dd1*temp82b + dd1*temp82b0 + distpb(0, 1) = temp79b + temp81b + rb(0) = rb(0) + 2*r(0)*rp1b ELSE distpb = 0.0_8 dd1b = 0.0_8 END IF DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) + temp78 = 4.d0*dd1 + temp77 = r(i)**2/temp78 + temp78b = distp(i, 1)*zb(indorbp, i) + temp77b = 7.d0*temp78b/temp78 + distpb(i, 1) = distpb(i, 1) + (7.d0*temp77-r(i)**4)*zb(indorbp, i) + rb(i) = rb(i) + 2*r(i)*temp77b - 4*r(i)**3*temp78b + dd1b = dd1b - temp77*4.d0*temp77b zb(indorbp, i) = 0.0_8 END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - temp120b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp120b - rb(k) = rb(k) - dd1*temp120b + temp76 = r(k)**2 + temp76b = c*DEXP(-(dd1*temp76))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp76))*distpb(k, 1) + dd1b = dd1b - temp76*temp76b + rb(k) = rb(k) - dd1*2*r(k)*temp76b distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.11894160774351807429d0*3.5d0*dd1**2.5D0*cb + IF (.NOT.(dd1 .LE. 0.0 .AND. (7.d0/4.d0 .EQ. 0.0 .OR. 7.d0/4.d0 .NE.& +& INT(7.d0/4.d0)))) dd1b = dd1b + (2.d0/pi)**(3.d0/4.d0)*7.d0*dd1& +& **(7.d0/4.d0-1)*cb/DSQRT(15.d0) ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (11) -! 3s double zeta -! R(r)=r**2*(exp(-z1*r)+p*exp(-z2*r)) -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 + CASE (143) +! 5s single zeta derivative of 12 +! 4d one parmater der of 133 dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) -! if(iflagnorm.gt.2) then - c = 1.d0/2.d0/DSQRT(pi*720.d0*(1.d0/(2.d0*dd1)**7+2.d0*peff/(dd1+dd2& -& )**7+peff**2/(2.d0*dd2)**7)) -! endif DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) - distp(k, 2) = c*DEXP(-(dd2*r(k))) + distp(k, 1) = DEXP(-(dd1*r(k))) + END DO + DO i=indtmin,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = distp(i, 1)*r(i)**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) + distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) + distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) + distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) + distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) + distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d + END DO +! indorbp=indorb + DO ic=1,5 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic END DO +! endif IF (typec .NE. 1) THEN - rp1 = r(0)**2 -! the first derivative - fun = distp(0, 1)*(2.d0*r(0)-dd1*rp1) + peff*distp(0, 2)*(2.d0*r(0& -& )-dd2*rp1) -! -! the second derivative - temp129b = 2.d0*zb(indorbp, indt+4)/r(0) - funb = temp129b - rb(0) = rb(0) - fun*temp129b/r(0) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - temp128 = fun/r(0) - temp128b8 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(i, 0) = rmub(i, 0) + temp128*zb(indorbp, indt+i) - funb = funb + temp128b8 - rb(0) = rb(0) - temp128*temp128b8 - zb(indorbp, indt+i) = 0.0_8 + fun0 = -distp(0, 3) + fun = -((-2.d0+dd1*r(0))*distp(0, 1)) + fun2 = ((dd1*r(0))**2-4.d0*r(0)*dd1+2.d0)*distp(0, 1) +! indorbp=indorb + DO ic=1,5 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (ic .EQ. 1) THEN + IF (i .NE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + END IF + END DO END DO distpb = 0.0_8 - temp128b2 = distp(0, 1)*fun2b - temp128b3 = (dd2**2*rp1-4.d0*(dd2*r(0))+2.d0)*fun2b - temp128b4 = peff*distp(0, 2)*fun2b - distpb(0, 1) = (dd1**2*rp1-4.d0*(dd1*r(0))+2.d0)*fun2b - temp128b5 = distp(0, 1)*funb - dd1b = (rp1*2*dd1-4.d0*r(0))*temp128b2 - rp1*temp128b5 - temp128b6 = peff*distp(0, 2)*funb - rp1b = dd2**2*temp128b4 - dd2*temp128b6 - dd1*temp128b5 + dd1**2*& -& temp128b2 - rb(0) = rb(0) + 2.d0*temp128b5 + 2.d0*temp128b6 + 2*r(0)*rp1b - & -& 4.d0*dd2*temp128b4 - 4.d0*dd1*temp128b2 - temp128b7 = (2.d0*r(0)-dd2*rp1)*funb - peffb = distp(0, 2)*temp128b7 + distp(0, 2)*temp128b3 - distpb(0, 2) = peff*temp128b3 - dd2b = (rp1*2*dd2-4.d0*r(0))*temp128b4 - rp1*temp128b6 - distpb(0, 1) = distpb(0, 1) + (2.d0*r(0)-dd1*rp1)*funb - distpb(0, 2) = distpb(0, 2) + peff*temp128b7 + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=5,1,-1 + temp83b7 = distp(0, 3+ic)*zb(indorbp, indt+4) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 6.d0*temp83b7 + fun2b = fun2b + temp83b7 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp83b3 = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp83b3 + fun0b = fun0b + rmu(i, 0)*temp83b3 + ELSE + temp83b4 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp83b4 + fun0b = fun0b + rmu(i, 0)*temp83b4 + END IF + ELSE IF (branch .LT. 4) THEN + temp83b5 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp83b5 + fun0b = fun0b + rmu(i, 0)*temp83b5 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp83b6 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp83b6 + fun0b = fun0b + rmu(i, 0)*temp83b6 + ELSE + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + temp83b2 = distp(0, 3+ic)*zb(indorbp, indt+i) + distpb(0, 3+ic) = distpb(0, 3+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp83b2 + funb0 = funb0 + rmu(i, 0)*temp83b2 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + temp83b0 = distp(0, 1)*fun2b + temp83b1 = 2*dd1*r(0)*temp83b0 + dd1b = r(0)*temp83b1 - 4.d0*r(0)*temp83b0 - distp(0, 1)*r(0)*funb0 + rb(0) = rb(0) + dd1*temp83b1 - 4.d0*dd1*temp83b0 - distp(0, 1)*dd1& +& *funb0 + distpb(0, 1) = distpb(0, 1) + ((dd1*r(0))**2-4.d0*(r(0)*dd1)+2.d0)& +& *fun2b - (dd1*r(0)-2.d0)*funb0 + distpb(0, 3) = distpb(0, 3) - fun0b ELSE distpb = 0.0_8 - peffb = 0.0_8 dd1b = 0.0_8 - dd2b = 0.0_8 END IF - DO i=indtm,i0,-1 - temp128b1 = r(i)**2*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp128b1 - peffb = peffb + distp(i, 2)*temp128b1 - distpb(i, 2) = distpb(i, 2) + peff*temp128b1 - rb(i) = rb(i) + (distp(i, 1)+peff*distp(i, 2))*2*r(i)*zb(indorbp, & -& i) - zb(indorbp, i) = 0.0_8 + DO ic=5,1,-1 + DO i=indtm,i0,-1 + distpb(i, 3+ic) = distpb(i, 3+ic) - distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) - distp(i, 3+ic)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - cb = 0.0_8 - DO k=indtm,indtmin,-1 - temp128b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp128b - distpb(k, 2) = 0.0_8 - temp128b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp128b0 - dd2*temp128b - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp128b0 + DO i=indtm,indtmin,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + distpb(i, 8) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distpb(i, 1) = distpb(i, 1) + r(i)**2*distpb(i, 3) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + END DO + DO k=indtm,indtmin,-1 + temp83b = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp83b + rb(k) = rb(k) - dd1*temp83b distpb(k, 1) = 0.0_8 END DO - temp127 = 2.d0**7 - temp126 = temp127*dd2**7 - temp125 = peff**2/temp126 - temp124 = (dd1+dd2)**7 - temp123 = 2.d0**7 - temp122 = temp123*dd1**7 - temp121 = 720.d0*pi*(1.0/temp122+2.d0*peff/temp124+temp125) - temp120 = DSQRT(temp121) - IF (temp121 .EQ. 0.0) THEN - temp120b2 = 0.0 - ELSE - temp120b2 = -(pi*720.d0*cb/(2.d0*temp120**2*2.D0*DSQRT(temp121))) - END IF - temp120b3 = 2.d0*temp120b2/temp124 - temp120b4 = -(peff*7*(dd1+dd2)**6*temp120b3/temp124) - dd1b = dd1b + temp120b4 - temp123*7*dd1**6*temp120b2/temp122**2 - peffb = peffb + 2*peff*temp120b2/temp126 + temp120b3 - dd2b = dd2b + temp120b4 - temp125*temp127*7*dd2**6*temp120b2/temp126 - ddb(indpar+3) = ddb(indpar+3) + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (12) -! 4s single zeta -! R(r)=r**3*exp(-z1*r) -! -! if(iocc(indshellp).eq.1) then + CASE (7) +! normalized IS WRONG!!! +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 - c = dd1**4.5d0*.03178848180059307346d0 -! endif + dd2 = dd(indpar+2) + peff = dd(indpar+3) DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 1) = DEXP(-(dd1*r(k))) + distp(k, 2) = DEXP(-(dd2*r(k))) END DO +! if(iflagnorm.gt.2) then + c = 1/DSQRT(1/(3.d0/4.d0/dd1**5+peff**2/dd2**3/4+12*peff/(dd1+dd2)**& +& 4))*1.d0/DSQRT(4.0*pi) IF (typec .NE. 1) THEN - rp1 = r(0)**3 - rp2 = r(0)**2 -! -!c the first derivative - fun = distp(0, 1)*(3.d0*rp2-dd1*rp1) -!c -!c the second derivative - temp130b = 2.d0*zb(indorbp, indt+4)/r(0) - funb = temp130b - rb(0) = rb(0) - fun*temp130b/r(0) - fun2b = zb(indorbp, indt+4) + fun = -(dd1*distp(0, 1)) + peff*distp(0, 2)*(1.d0-dd2*r(0)) + fun2 = distp(0, 1)*dd1**2 + peff*distp(0, 2)*(dd2**2*r(0)-2.d0*dd2& +& ) + temp93 = fun/r(0) + temp93b = c*2.d0*zb(indorbp, indt+4)/r(0) + cb = (2.d0*temp93+fun2)*zb(indorbp, indt+4) + funb0 = temp93b + rb(0) = rb(0) - temp93*temp93b + fun2b = c*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - temp129 = fun/r(0) - temp129b3 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(i, 0) = rmub(i, 0) + temp129*zb(indorbp, indt+i) - funb = funb + temp129b3 - rb(0) = rb(0) - temp129*temp129b3 + temp92 = rmu(i, 0)/r(0) + temp92b5 = fun*c*zb(indorbp, indt+i)/r(0) + funb0 = funb0 + temp92*c*zb(indorbp, indt+i) + cb = cb + temp92*fun*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp92b5 + rb(0) = rb(0) - temp92*temp92b5 zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp129b1 = distp(0, 1)*fun2b - distpb(0, 1) = (3.d0*rp2-dd1*rp1)*funb + (6.d0*r(0)-6.d0*(dd1*rp2)& -& +dd1**2*rp1)*fun2b - temp129b2 = distp(0, 1)*funb - rp2b = 3.d0*temp129b2 - 6.d0*dd1*temp129b1 - rp1b = dd1**2*temp129b1 - dd1*temp129b2 - rb(0) = rb(0) + 2*r(0)*rp2b + 3*r(0)**2*rp1b + 6.d0*temp129b1 - dd1b = (rp1*2*dd1-6.d0*rp2)*temp129b1 - rp1*temp129b2 + temp92b1 = (dd2**2*r(0)-2.d0*dd2)*fun2b + temp92b2 = peff*distp(0, 2)*fun2b + distpb(0, 1) = dd1**2*fun2b + dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb0 + temp92b3 = (1.d0-dd2*r(0))*funb0 + peffb = distp(0, 2)*temp92b3 + distp(0, 2)*temp92b1 + distpb(0, 2) = peff*temp92b3 + peff*temp92b1 + temp92b4 = peff*distp(0, 2)*funb0 + dd2b = (r(0)*2*dd2-2.d0)*temp92b2 - r(0)*temp92b4 + rb(0) = rb(0) + dd2**2*temp92b2 - dd2*temp92b4 + distpb(0, 1) = distpb(0, 1) - dd1*funb0 ELSE distpb = 0.0_8 + peffb = 0.0_8 dd1b = 0.0_8 + dd2b = 0.0_8 + cb = 0.0_8 END IF DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**3*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*3*r(i)**2*zb(indorbp, i) + temp92b = c*zb(indorbp, i) + temp92b0 = distp(i, 2)*temp92b + cb = cb + (distp(i, 1)+r(i)*peff*distp(i, 2))*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp92b + rb(i) = rb(i) + peff*temp92b0 + peffb = peffb + r(i)*temp92b0 + distpb(i, 2) = distpb(i, 2) + r(i)*peff*temp92b zb(indorbp, i) = 0.0_8 END DO - cb = 0.0_8 + temp91 = (dd1+dd2)**4 + temp90 = 4*dd2**3 + temp89 = peff**2/temp90 + temp88 = 4.d0*dd1**5 + temp83 = 3.d0/temp88 + temp89 + 12*(peff/temp91) + temp87 = 1.0/temp83 + temp86 = DSQRT(temp87) + temp85 = DSQRT(4.0*pi) + temp84 = temp85*temp86 + IF (temp87 .EQ. 0.0) THEN + temp83b10 = 0.0 + ELSE + temp83b10 = temp85*temp87*cb/(temp84**2*2.D0*DSQRT(temp87)*temp83) + END IF + temp83b11 = 12*temp83b10/temp91 + temp83b12 = -(peff*4*(dd1+dd2)**3*temp83b11/temp91) + dd1b = dd1b + temp83b12 - 3.d0*4.d0*5*dd1**4*temp83b10/temp88**2 + peffb = peffb + temp83b11 + 2*peff*temp83b10/temp90 + dd2b = dd2b + temp83b12 - temp89*4*3*dd2**2*temp83b10/temp90 DO k=indtm,indtmin,-1 - temp129b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp129b0 - rb(k) = rb(k) - dd1*temp129b0 + temp83b8 = DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp83b8 + distpb(k, 2) = 0.0_8 + temp83b9 = DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp83b9 - dd2*temp83b8 + dd1b = dd1b - r(k)*temp83b9 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + .03178848180059307346d0*4.5d0*dd1**3.5D0*cb + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (13) -! -! 4s double zeta -! R(r)=r**3*(exp(-z1*r)+z3*exp(-z2*r)) -! -! -! -! if(iocc(indshellp).eq.1) then -! - indorbp = indorb + 1 + CASE (36) +! 2s double Z WITH CUSP +! p orbital +! +! - angmom = 1 +! - type = Gaussian +! - normalized = yes +! - angtype = spherical +! - npar = 1 +! - multiplicity = 3 +! dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - dd3 = dd(indpar+3) -! if(iflagnorm.gt.2) then - c = 1.d0/2.d0/DSQRT(pi*40320.d0*(1.d0/(2.d0*dd1)**9+2.d0*dd3/(dd1+& -& dd2)**9+dd3**2/(2.d0*dd2)**9)) -! endif -! + c = dd1**1.25d0*1.42541094070998d0 DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) - distp(k, 2) = c*DEXP(-(dd2*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + END DO + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) + indorbp = indorb + ic END DO -! IF (typec .NE. 1) THEN - rp1 = r(0)**3 - rp2 = r(0)**2 -! -!c the first derivative - fun = distp(0, 1)*(3.d0*rp2-dd1*rp1) + dd3*distp(0, 2)*(3.d0*rp2-& -& dd2*rp1) -!c -! the second derivative - temp139b = 2.d0*zb(indorbp, indt+4)/r(0) - funb = temp139b - rb(0) = rb(0) - fun*temp139b/r(0) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - temp138 = fun/r(0) - temp138b8 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(i, 0) = rmub(i, 0) + temp138*zb(indorbp, indt+i) - funb = funb + temp138b8 - rb(0) = rb(0) - temp138*temp138b8 - zb(indorbp, indt+i) = 0.0_8 + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) + indorbp = indorb + ic END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp95b1 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp95b1 + fun2b = fun2b + temp95b1 + zb(indorbp, indt+4) = 0.0_8 + fun0b = fun0b + zb(indorbp, indt+ic) + DO i=3,1,-1 + temp95b0 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp95b0 + funb0 = funb0 + rmu(ic, 0)*temp95b0 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + temp95b = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp95b - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp95b distpb = 0.0_8 - temp138b2 = distp(0, 1)*fun2b - temp138b3 = (6.d0*r(0)-6.d0*(dd2*rp2)+dd2**2*rp1)*fun2b - temp138b4 = dd3*distp(0, 2)*fun2b - distpb(0, 1) = (6.d0*r(0)-6.d0*(dd1*rp2)+dd1**2*rp1)*fun2b - temp138b5 = distp(0, 1)*funb - temp138b6 = dd3*distp(0, 2)*funb - rp2b = 3.d0*temp138b5 + 3.d0*temp138b6 - 6.d0*dd2*temp138b4 - 6.d0& -& *dd1*temp138b2 - rp1b = dd2**2*temp138b4 - dd2*temp138b6 - dd1*temp138b5 + dd1**2*& -& temp138b2 - rb(0) = rb(0) + 2*r(0)*rp2b + 3*r(0)**2*rp1b + 6.d0*temp138b4 + & -& 6.d0*temp138b2 - dd1b = (rp1*2*dd1-6.d0*rp2)*temp138b2 - rp1*temp138b5 - temp138b7 = (3.d0*rp2-dd2*rp1)*funb - dd3b = distp(0, 2)*temp138b7 + distp(0, 2)*temp138b3 - distpb(0, 2) = dd3*temp138b3 - dd2b = (rp1*2*dd2-6.d0*rp2)*temp138b4 - rp1*temp138b6 - distpb(0, 1) = distpb(0, 1) + (3.d0*rp2-dd1*rp1)*funb - distpb(0, 2) = distpb(0, 2) + dd3*temp138b7 + distpb(0, 1) = fun0b - 2.d0*dd1*funb0 ELSE distpb = 0.0_8 dd1b = 0.0_8 - dd2b = 0.0_8 - dd3b = 0.0_8 END IF - DO i=indtm,i0,-1 - temp138b1 = r(i)**3*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp138b1 - dd3b = dd3b + distp(i, 2)*temp138b1 - distpb(i, 2) = distpb(i, 2) + dd3*temp138b1 - rb(i) = rb(i) + (distp(i, 1)+dd3*distp(i, 2))*3*r(i)**2*zb(indorbp& -& , i) - zb(indorbp, i) = 0.0_8 + DO ic=3,1,-1 + DO i=indtm,i0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - temp138b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp138b - distpb(k, 2) = 0.0_8 - temp138b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp138b0 - dd2*temp138b - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp138b0 + temp94 = r(k)**2 + temp94b = c*DEXP(-(dd1*temp94))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp94))*distpb(k, 1) + dd1b = dd1b - temp94*temp94b + rb(k) = rb(k) - dd1*2*r(k)*temp94b distpb(k, 1) = 0.0_8 END DO - temp137 = 2.d0**9 - temp136 = temp137*dd2**9 - temp135 = dd3**2/temp136 - temp134 = (dd1+dd2)**9 - temp133 = 2.d0**9 - temp132 = temp133*dd1**9 - temp131 = 40320.d0*pi*(1.0/temp132+2.d0*dd3/temp134+temp135) - temp130 = DSQRT(temp131) - IF (temp131 .EQ. 0.0) THEN - temp130b0 = 0.0 - ELSE - temp130b0 = -(pi*40320.d0*cb/(2.d0*temp130**2*2.D0*DSQRT(temp131))& -& ) - END IF - temp130b1 = 2.d0*temp130b0/temp134 - temp130b2 = -(dd3*9*(dd1+dd2)**8*temp130b1/temp134) - dd1b = dd1b + temp130b2 - temp133*9*dd1**8*temp130b0/temp132**2 - dd3b = dd3b + 2*dd3*temp130b0/temp136 + temp130b1 - dd2b = dd2b + temp130b2 - temp135*temp137*9*dd2**8*temp130b0/temp136 - ddb(indpar+3) = ddb(indpar+3) + dd3b - ddb(indpar+2) = ddb(indpar+2) + dd2b + dd1b = dd1b + 1.42541094070998d0*1.25d0*dd1**0.25D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (14) -! 1s single Z pseudo -! (1.d0 + dd1 r) * exp(-dd1 * r) ! normalized -! if(iocc(indshellp).eq.1) then + CASE (29) +! derivative of (28) +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k))) +! if(iflagnorm.gt.2) then +! if(dd1.gt.0.) then + c = cost1s*dd1**1.5d0 +! else +! c=1.d0 +! endif +! endif +! if(dd1.gt.0.) then + c1 = 1.5d0/dd1 +! else +! c1=0.d0 +! endif + DO i=indtmin,indtm + distp(i, 1) = c*DEXP(-(dd1*r(i))) + END DO + DO i=i0,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) +! rp1=(b1s*r(i))**4*dd1**3 +! rp4=rp1*dd1 +! rp5=dd1*r(i) +! z(indorbp,i)=distp(i,1)* & +! &(c1*rp4/(1+rp4)-rp1*(-4+rp5+rp4*rp5)/(1+rp4)**2) + rp4 = (b1s*dd1*r(i))**4 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp5) + rp5 = dd1*r(i) END DO -! if(iflagnorm.gt.2) then -! c=dsqrt(dd1**3.d0/7.d0/pi) - c = dd1**1.5d0*0.213243618622923d0 IF (typec .NE. 1) THEN - fun = -(distp(0, 1)*dd1**2*r(0)) - fun2 = -(distp(0, 1)*dd1**2*(1.d0-dd1*r(0))) - temp140b = 2.d0*zb(indorbp, indt+4)/r(0) - cb = fun2*zb(indorbp, indt+4) + fun*temp140b - funb = c*temp140b - rb(0) = rb(0) - c*fun*temp140b/r(0) - fun2b = c*zb(indorbp, indt+4) + rp1 = dd1*b1s*r(0) + rp2 = rp1**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) + rp4 = rp2**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp5) + rp5 = rp4*rp1 + rp8 = rp4*rp4 + fun = distp(0, 1)*(dd1*rp2*(4*b1s**2*(11-5*rp4)+2*(rp1+rp5)**2-b1s& +& *rp1*(21+26*rp4+5*rp8)))/(2.*(1+rp4)**3) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - temp139 = rmu(i, 0)/r(0) - temp139b6 = c*fun*zb(indorbp, indt+i)/r(0) - cb = cb + temp139*fun*zb(indorbp, indt+i) - funb = funb + temp139*c*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp139b6 - rb(0) = rb(0) - temp139*temp139b6 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp139b3 = -((1.d0-dd1*r(0))*fun2b) - temp139b4 = -(distp(0, 1)*dd1**2*fun2b) - temp139b5 = -(dd1**2*funb) - distpb(0, 1) = r(0)*temp139b5 + dd1**2*temp139b3 - dd1b = distp(0, 1)*2*dd1*temp139b3 - r(0)*temp139b4 - distp(0, 1)*& -& r(0)*2*dd1*funb - rb(0) = rb(0) + distp(0, 1)*temp139b5 - dd1*temp139b4 + temp108 = 2.*b1s*(rp4+1)**4 + temp107 = distp(0, 1)*dd1*rp2 + temp104 = temp107/temp108 + temp107b = temp104*fun2b + temp107b0 = b1s*(7*rp4+31)*2*(rp1+rp5)*temp107b + temp107b1 = -(2*3*(rp1+rp5)**2*temp107b) + temp106 = 64*b1s**2 + temp106b = temp106*temp107b + temp105 = 4*b1s**3 + temp104b = (b1s*((7*rp4+31)*(rp1+rp5)**2)-2*(rp1+rp5)**3+temp106*(& +& rp1*(rp8-rp4-2))+temp105*(25*rp8-134*rp4+33))*fun2b/temp108 + temp103 = 2.*(rp4+1)**3 + temp102 = distp(0, 1)*dd1*rp2 + temp99 = temp102/temp103 + temp102b = temp99*funb0 + temp101b = 2**2*(rp1+rp5)*temp102b + rp5b = temp101b + temp107b1 + temp107b0 + temp100b = -(b1s*temp102b) + rp8b = rp1*5*temp100b + temp105*25*temp107b + rp1*temp106b + temp101 = 4*b1s**2 + temp100 = 26*rp4 + 5*rp8 + 21 + temp99b0 = (temp101*(11-5*rp4)+2*(rp1+rp5)**2-b1s*(rp1*temp100))*& +& funb0/temp103 + rp4b = rp1*26*temp100b - temp101*5*temp102b - temp99*2.*3*(rp4+1)& +& **2*temp99b0 + rp1*rp5b + 2*rp4*rp8b - temp104*2.*b1s*4*(rp4+1)& +& **3*temp104b - rp1*temp106b + (7*(b1s*(rp1+rp5)**2)-134*temp105)& +& *temp107b + rp2b = distp(0, 1)*dd1*temp99b0 + 2*rp2*rp4b + distp(0, 1)*dd1*& +& temp104b + rp1b = temp101b + temp100*temp100b + 2*rp1*rp2b + rp4*rp5b + (rp8-& +& rp4-2)*temp106b + temp107b1 + temp107b0 + distpb(0, 1) = dd1*rp2*temp99b0 + dd1*rp2*temp104b + dd1b = distp(0, 1)*rp2*temp99b0 + b1s*r(0)*rp1b + distp(0, 1)*rp2*& +& temp104b + CALL POPREAL8(adr8ibuf,adr8buf,rp5) + CALL POPREAL8(adr8ibuf,adr8buf,rp4) + rb(0) = rb(0) + b1s*dd1*rp1b ELSE distpb = 0.0_8 dd1b = 0.0_8 - cb = 0.0_8 END IF + c1b = 0.0_8 DO i=indtm,i0,-1 - temp139b1 = c*distp(i, 1)*zb(indorbp, i) - temp139b2 = (dd1*r(i)+1.d0)*zb(indorbp, i) - dd1b = dd1b + r(i)*temp139b1 - rb(i) = rb(i) + dd1*temp139b1 - cb = cb + distp(i, 1)*temp139b2 - distpb(i, 1) = distpb(i, 1) + c*temp139b2 + temp95 = rp4/(rp4+1) + temp99b = distp(i, 1)*temp95*zb(indorbp, i) + temp96 = dd1*(rp4+1) + temp97b = -(temp99b/temp96) + temp98 = rp5 + rp4*rp5 - 4 + temp97 = temp98/temp96 + temp96b = -(temp97*temp97b) + temp95b3 = (c1-temp97)*distp(i, 1)*zb(indorbp, i)/(rp4+1) + c1b = c1b + temp99b + rp5b = (rp4+1.0_8)*temp97b + rp4b = (1.0_8-temp95)*temp95b3 + dd1*temp96b + rp5*temp97b + temp95b4 = 4*b1s**4*dd1**3*r(i)**3*rp4b + dd1b = dd1b + r(i)*rp5b + r(i)*temp95b4 + (rp4+1)*temp96b + distpb(i, 1) = distpb(i, 1) + (c1-temp97)*temp95*zb(indorbp, i) zb(indorbp, i) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,rp5) + rb(i) = rb(i) + dd1*temp95b4 + dd1*rp5b + CALL POPREAL8(adr8ibuf,adr8buf,rp4) END DO - dd1b = dd1b + 0.213243618622923d0*1.5d0*dd1**0.5D0*cb - DO k=indtm,indtmin,-1 - temp139b0 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp139b0 - rb(k) = rb(k) - dd1*temp139b0 - distpb(k, 1) = 0.0_8 + cb = 0.0_8 + DO i=indtm,indtmin,-1 + temp95b2 = c*DEXP(-(dd1*r(i)))*distpb(i, 1) + cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) + dd1b = dd1b - r(i)*temp95b2 + rb(i) = rb(i) - dd1*temp95b2 + distpb(i, 1) = 0.0_8 END DO + dd1b = dd1b + cost1s*1.5d0*dd1**0.5D0*cb - 1.5d0*c1b/dd1**2 ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (15) -! 1s single Z pseudo -! (r**2 + dd2*(1 + dd1*r))*exp(-dd1*r) ! normalized -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 + CASE (44) +! R(r)=x*exp(-z*r**2)*(5/4/z-r**2) dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - c = DSQRT(2.d0*dd1**7/pi/(45.d0+42.d0*dd1**2*dd2+14.d0*dd1**4*dd2**2& -& )) +! if(iflagnorm.gt.2) then +! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0 + c = dd1**1.25d0*1.42541094070998d0 +! endif DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO +! indorbp=indorb +! + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif IF (typec .NE. 1) THEN - fun = distp(0, 1)*r(0)*(2.d0-dd1**2*dd2-dd1*r(0)) - temp147b = 2.d0*zb(indorbp, indt+4)/r(0) - funb = temp147b - rb(0) = rb(0) - fun*temp147b/r(0) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - temp146 = fun/r(0) - temp146b0 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(i, 0) = rmub(i, 0) + temp146*zb(indorbp, indt+i) - funb = funb + temp146b0 - rb(0) = rb(0) - temp146*temp146b0 - zb(indorbp, indt+i) = 0.0_8 + fun = distp(0, 1)*(2.d0*dd1*r(0)**2-9.d0/2.d0) + fun2 = distp(0, 1)*(-(4.d0*dd1**2*r(0)**4)+15.d0*dd1*r(0)**2-9.d0/& +& 2.d0) +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp115b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp115b0 + fun2b = fun2b + temp115b0 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp115b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp115b + funb0 = funb0 + rmu(ic, 0)*temp115b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp145 = -(dd1*r(0)) - dd1**2*dd2 + 3.d0 - temp146b = distp(0, 1)*fun2b - temp145b0 = (1.d0-dd1*r(0))*temp146b - temp145b1 = (2.d0-dd1*r(0)-dd1**2*dd2)*funb - distpb(0, 1) = r(0)*temp145b1 + ((1.d0-dd1*r(0))*temp145-1.d0)*& -& fun2b - temp145b2 = distp(0, 1)*r(0)*funb - dd1b = (-(dd2*2*dd1)-r(0))*temp145b2 + (-(dd2*2*dd1)-r(0))*& -& temp145b0 - temp145*r(0)*temp146b - rb(0) = rb(0) + distp(0, 1)*temp145b1 - dd1*temp145b2 - dd1*& -& temp145b0 - temp145*dd1*temp146b - dd2b = -(dd1**2*temp145b2) - dd1**2*temp145b0 + temp114 = r(0)**4 + temp114b = distp(0, 1)*fun2b + temp113 = 4.d0*dd1 + temp112 = 5.d0/temp113 + distpb(0, 1) = (2.d0*(dd1*r(0)**2)-9.d0/2.d0)*funb0 + (temp112-r(0& +& )**2)*fun0b + (15.d0*(dd1*r(0)**2)-9.d0/2.d0-4.d0*(dd1**2*& +& temp114))*fun2b + temp114b0 = distp(0, 1)*2.d0*funb0 + dd1b = r(0)**2*temp114b0 - distp(0, 1)*temp112*4.d0*fun0b/temp113 & +& + (15.d0*r(0)**2-4.d0*temp114*2*dd1)*temp114b + rb(0) = rb(0) + dd1*2*r(0)*temp114b0 - distp(0, 1)*2*r(0)*fun0b + & +& (15.d0*dd1*2*r(0)-4.d0*dd1**2*4*r(0)**3)*temp114b ELSE distpb = 0.0_8 dd1b = 0.0_8 - dd2b = 0.0_8 END IF - DO i=indtm,i0,-1 - temp145b = distp(i, 1)*zb(indorbp, i) - temp144 = dd1*r(i) + 1.d0 - rb(i) = rb(i) + (dd2*dd1+2*r(i))*temp145b - dd2b = dd2b + temp144*temp145b - dd1b = dd1b + dd2*r(i)*temp145b - distpb(i, 1) = distpb(i, 1) + (r(i)**2+dd2*temp144)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=3,1,-1 + DO i=indtm,i0,-1 + temp111 = 4.d0*dd1 + temp110 = 5.d0/temp111 + temp110b = (temp110-r(i)**2)*zb(indorbp, i) + temp110b0 = rmu(ic, i)*distp(i, 1)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp110b + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp110b + dd1b = dd1b - temp110*4.d0*temp110b0/temp111 + rb(i) = rb(i) - 2*r(i)*temp110b0 + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - temp144b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp144b - rb(k) = rb(k) - dd1*temp144b + temp109 = r(k)**2 + temp109b = c*DEXP(-(dd1*temp109))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp109))*distpb(k, 1) + dd1b = dd1b - temp109*temp109b + rb(k) = rb(k) - dd1*2*r(k)*temp109b distpb(k, 1) = 0.0_8 END DO - temp143 = dd1**4 - temp142 = pi*(42.d0*dd1**2*dd2+14.d0*temp143*dd2**2+45.d0) - temp141 = dd1**7 - temp140 = temp141/temp142 - IF (2.d0*temp140 .EQ. 0.0) THEN - temp140b0 = 0.0 - ELSE - temp140b0 = 2.d0*cb/(2.D0*DSQRT(2.d0*temp140)*temp142) - END IF - temp140b1 = -(temp140*pi*temp140b0) - dd1b = dd1b + (14.d0*dd2**2*4*dd1**3+42.d0*dd2*2*dd1)*temp140b1 + 7*& -& dd1**6*temp140b0 - dd2b = dd2b + (14.d0*temp143*2*dd2+42.d0*dd1**2)*temp140b1 - ddb(indpar+2) = ddb(indpar+2) + dd2b + dd1b = dd1b + 1.42541094070998d0*1.25d0*dd1**0.25D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (16) -! 2s gaussian for pseudo -! R(r)=exp(-z*r**2) single zeta -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then - IF (dd1 .NE. 0.) THEN - c = 0.71270547035499016d0*dd1**0.75d0 -! c=(2.d0*dd1/pi)**(3.d0/4.d0) - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) -! ! the constant - c = 1.d0 - END IF -! endif + CASE (64) +! derivative of 37 with respect to z +! d orbitals +! R(r)= r exp(-alpha r^2) +! each gaussian term is normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! c=8.d0/dsqrt(21.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) + c = dd1**2.25d0*1.24420067280413253d0 +! endif DO k=indtmin,indtm distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO - IF (typec .NE. 1) THEN -! the first derivative /r - fun = -(2.d0*dd1*distp(0, 1)) -! the second derivative - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - temp148b = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp148b - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp148b - distpb = 0.0_8 - distpb(0, 1) = -(2.d0*dd1*funb) - ELSE - distpb = 0.0_8 - dd1b = 0.0_8 - END IF - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - cb = 0.0_8 - DO k=indtm,indtmin,-1 - temp147 = r(k)**2 - temp147b0 = c*DEXP(-(dd1*temp147))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp147))*distpb(k, 1) - dd1b = dd1b - temp147*temp147b0 - rb(k) = rb(k) - dd1*2*r(k)*temp147b0 - distpb(k, 1) = 0.0_8 + DO i=indtmin,indtm +! lz=0 + distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d +! lz=+/-2 + distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d +! lz=+/-2 + distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d +! lz=+/-1 + distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d +! lz=+/-1 + distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 1) dd1b = dd1b + 0.71270547035499016d0*0.75d0*& -& dd1**(-0.25D0)*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (17) -! 2s gaussian for pseudo -! R(r)=r**2*exp(-z*r**2) single zeta -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=4.d0*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)/dsqrt(15.d0) - c = .73607904464954686606d0*dd1**1.75d0 -! endif - DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + DO ic=1,5 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic END DO +! endif IF (typec .NE. 1) THEN - rp1 = r(0)**2 -! the first derivative / r - fun = 2.d0*distp(0, 1)*(1.d0-dd1*rp1) -! the second derivative - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + rp1 = 2.d0*dd1*r(0) + rp2 = rp1*r(0) + fun0 = distp(0, 1)*r(0) + fun = (1.d0-rp2)*distp(0, 1)/r(0) + fun2 = distp(0, 1)*rp1*(rp2-3.d0) +! indorbp=indorb + DO ic=1,5 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (ic .EQ. 1) THEN + IF (i .NE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + END IF + END DO END DO distpb = 0.0_8 - temp149b = 2.d0*distp(0, 1)*fun2b - distpb(0, 1) = 2.d0*(1.d0-dd1*rp1)*funb + 2.d0*(2.d0*(dd1**2*rp1**& -& 2)-5.d0*(dd1*rp1)+1.d0)*fun2b - temp149b0 = 2.d0*distp(0, 1)*funb - dd1b = (2.d0*rp1**2*2*dd1-5.d0*rp1)*temp149b - rp1*temp149b0 - rp1b = (2.d0*dd1**2*2*rp1-5.d0*dd1)*temp149b - dd1*temp149b0 - rb(0) = rb(0) + 2*r(0)*rp1b - ELSE - distpb = 0.0_8 - dd1b = 0.0_8 - END IF - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - cb = 0.0_8 - DO k=indtm,indtmin,-1 - temp148 = r(k)**2 - temp148b0 = c*DEXP(-(dd1*temp148))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp148))*distpb(k, 1) - dd1b = dd1b - temp148*temp148b0 - rb(k) = rb(k) - dd1*2*r(k)*temp148b0 - distpb(k, 1) = 0.0_8 - END DO - dd1b = dd1b + .73607904464954686606d0*1.75d0*dd1**0.75D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (18) -! 2s gaussian for pseudo -! R(r)=r**4*exp(-z*r**2) single zeta -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=(2.d0*dd1**11/pi)**(1.d0/4.d0)*(512.d0/945.d0/pi) - c = dd1**2.75d0*0.1540487967684377d0 -! endif - DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) - END DO - IF (typec .NE. 1) THEN - rp1 = r(0)**2 -! the first derivative - fun = distp(0, 1)*rp1*(4.d0-2.d0*dd1*rp1) -! the second derivative - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=5,1,-1 + temp117b4 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 6.d0*temp117b4 + fun2b = fun2b + temp117b4 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp117b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp117b0 + fun0b = fun0b + rmu(i, 0)*temp117b0 + ELSE + temp117b1 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp117b1 + fun0b = fun0b + rmu(i, 0)*temp117b1 + END IF + ELSE IF (branch .LT. 4) THEN + temp117b2 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp117b2 + fun0b = fun0b + rmu(i, 0)*temp117b2 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp117b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp117b3 + fun0b = fun0b + rmu(i, 0)*temp117b3 + ELSE + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + temp117b = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp117b + funb0 = funb0 + rmu(i, 0)*temp117b + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp150b = (4.d0*(dd1**2*rp1**2)-18.d0*(dd1*rp1)+12.d0)*fun2b - temp150b0 = distp(0, 1)*rp1*fun2b - temp150b1 = (4.d0-2.d0*(dd1*rp1))*funb - distpb(0, 1) = rp1*temp150b1 + rp1*temp150b - temp150b2 = -(distp(0, 1)*rp1*2.d0*funb) - rp1b = distp(0, 1)*temp150b1 + dd1*temp150b2 + (4.d0*dd1**2*2*rp1-& -& 18.d0*dd1)*temp150b0 + distp(0, 1)*temp150b - dd1b = rp1*temp150b2 + (4.d0*rp1**2*2*dd1-18.d0*rp1)*temp150b0 - rb(0) = rb(0) + 2*r(0)*rp1b + temp116 = (-rp2+1.d0)/r(0) + distpb(0, 1) = distpb(0, 1) + temp116*funb0 + r(0)*fun0b + rp1*(& +& rp2-3.d0)*fun2b + temp116b0 = distp(0, 1)*funb0/r(0) + rp2b = distp(0, 1)*rp1*fun2b - temp116b0 + rp1b = r(0)*rp2b + distp(0, 1)*(rp2-3.d0)*fun2b + rb(0) = rb(0) + distp(0, 1)*fun0b + 2.d0*dd1*rp1b + rp1*rp2b - & +& temp116*temp116b0 + dd1b = 2.d0*r(0)*rp1b + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd1b = 0.0_8 END IF - DO i=indtm,i0,-1 - rb(i) = rb(i) + distp(i, 1)*4*r(i)**3*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + r(i)**4*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=5,1,-1 + DO k=indtm,i0,-1 + temp116b = distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1) = distpb(k, 1) + r(k)*temp116b + rb(k) = rb(k) + distp(k, 1)*temp116b + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*r(k)*zb(indorbp& +& , k) + zb(indorbp, k) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO i=indtm,indtmin,-1 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) + distpb(i, 2) = 0.0_8 END DO + dd1b = 0.0_8 cb = 0.0_8 DO k=indtm,indtmin,-1 - temp149 = r(k)**2 - temp149b1 = c*DEXP(-(dd1*temp149))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp149))*distpb(k, 1) - dd1b = dd1b - temp149*temp149b1 - rb(k) = rb(k) - dd1*2*r(k)*temp149b1 + temp115 = r(k)**2 + temp115b1 = c*DEXP(-(dd1*temp115))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp115))*distpb(k, 1) + dd1b = dd1b - temp115*temp115b1 + rb(k) = rb(k) - dd1*2*r(k)*temp115b1 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.1540487967684377d0*2.75d0*dd1**1.75D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (19) -! derivative of 16 with respect to z -! R(r)=c*exp(-z*r**2)*(3/4/z-r**2) -! if(iocc(indshellp).eq.1) then + dd1b = dd1b + 1.24420067280413253d0*2.25d0*dd1**1.25D0*cb + ddb(indparp) = ddb(indparp) + dd1b + CASE (106) +! 2s without cusp condition +! dd1*( dd3 +1/(1+dd2*r^2)) + dd2 = dd(indpar+1) indorbp = indorb + 1 - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! if(dd1.ne.0.) then -! c=(2.d0*dd1/pi)**(3.d0/4.d0) - c = 0.71270547035499016d0*dd1**0.75d0 -! else -! c=1.d0 -! endif -! endif DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + distp(k, 1) = 1.d0/(1.d0+dd2*r(k)*r(k)) END DO +! endif IF (typec .NE. 1) THEN -! the first derivative /r - fun = distp(0, 1)*(2.d0*dd1*r(0)**2-7.d0/2.d0) -! the second derivative - funb = 2.d0*zb(indorbp, indt+4) + fun = -(dd2*distp(0, 1)**2*2.d0) fun2b = zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp153 = r(0)**4 - temp153b = distp(0, 1)*fun2b - distpb(0, 1) = (2.d0*(dd1*r(0)**2)-7.d0/2.d0)*funb + (13.d0*(dd1*r& -& (0)**2)-7.d0/2.d0-4.d0*(dd1**2*temp153))*fun2b - temp153b0 = distp(0, 1)*2.d0*funb - dd1b = r(0)**2*temp153b0 + (13.d0*r(0)**2-4.d0*temp153*2*dd1)*& -& temp153b - rb(0) = rb(0) + dd1*2*r(0)*temp153b0 + (13.d0*dd1*2*r(0)-4.d0*dd1& -& **2*4*r(0)**3)*temp153b + temp118b = (1.-3.d0*(dd2*r(0)**2))*fun2b + temp118b0 = -(fun*distp(0, 1)*3.d0*fun2b) + funb0 = funb0 + distp(0, 1)*temp118b + distpb(0, 1) = fun*temp118b - 2.d0*dd2*2*distp(0, 1)*funb0 + dd2b = r(0)**2*temp118b0 - 2.d0*distp(0, 1)**2*funb0 + rb(0) = rb(0) + dd2*2*r(0)*temp118b0 ELSE distpb = 0.0_8 - dd1b = 0.0_8 + dd2b = 0.0_8 END IF + dd3b = 0.0_8 DO i=indtm,i0,-1 - temp152 = 4.d0*dd1 - temp151 = 3.d0/temp152 - temp151b = distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + (temp151-r(i)**2)*zb(indorbp, i) - dd1b = dd1b - temp151*4.d0*temp151b/temp152 - rb(i) = rb(i) - 2*r(i)*temp151b + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO - cb = 0.0_8 DO k=indtm,indtmin,-1 - temp150 = r(k)**2 - temp150b3 = c*DEXP(-(dd1*temp150))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp150))*distpb(k, 1) - dd1b = dd1b - temp150*temp150b3 - rb(k) = rb(k) - dd1*2*r(k)*temp150b3 + temp117 = dd2*r(k)**2 + 1.d0 + temp117b5 = -(distpb(k, 1)/temp117**2) + dd2b = dd2b + r(k)**2*temp117b5 + rb(k) = rb(k) + dd2*2*r(k)*temp117b5 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.71270547035499016d0*0.75d0*dd1**(-0.25D0)*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (20) -! 2p single zeta -! 2p single Z with no cusp condition - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2.d0*dd1)**5/8.d0/pi)/2.d0 - c = dd1**2.5d0*0.5641895835477562d0 -! endif + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (71) +! f single Slater orbital derivative of 70 +! R(r)= (9.d0/2.0 1/dd1 - r) * exp(-alpha r) +! normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization +! l = 3 +! \int d\omega Y*Y = 4 pi / (2 l + 1) +! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5 * 3**2 / 2**2 / dd1**9 +! c=1.d0/dsqrt(10.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(9.d0/2.d0)/3.d0 + c = dd1**4.5d0*0.084104417400672d0 +! endif DO k=indtmin,indtm distp(k, 1) = c*DEXP(-(dd1*r(k))) END DO -! indorbp=indorb -! - DO ic=1,3 + DO i=indtmin,indtm + distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) +! lz=0 + distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) +! lz=+/-2 + distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) +! lz=+/-2 + distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) +! lz=+/-3 + distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) + END DO +! lz=+/-3 + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = -(dd1*distp(0, 1)) - fun2 = dd1**2*distp(0, 1) -! indorbp=indorb - DO ic=1,3 + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1)*(9.d0/2.d0/dd1-r(0)) + fun = distp(0, 1)*(dd1-11.d0/2.d0/r(0)) + fun2 = dd1*distp(0, 1)*(13.d0/2.d0-dd1*r(0)) +! indorbp=indorb + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + IF (ic .EQ. 1) THEN + IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF + ELSE IF (ic .EQ. 6) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + END IF + ELSE IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) END IF END DO END DO - funb = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=3,1,-1 - temp155 = fun/r(0) - temp156b = rmu(ic, 0)*zb(indorbp, indt+4) - temp155b = 4.d0*temp156b/r(0) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp155+fun2)*zb(indorbp, indt& -& +4) - funb = funb + temp155b - rb(0) = rb(0) - temp155*temp155b - fun2b = fun2b + temp156b + DO ic=7,1,-1 + temp124b25 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 8.d0*temp124b25 + fun2b = fun2b + temp124b25 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp154 = fun/r(0) - temp154b0 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(ic, 0) = rmub(ic, 0) + temp154*rmu(i, 0)*zb(indorbp, indt& -& +i) - rmub(i, 0) = rmub(i, 0) + temp154*rmu(ic, 0)*zb(indorbp, indt+& -& i) - funb = funb + temp154b0 - rb(0) = rb(0) - temp154*temp154b0 + IF (branch .LT. 11) THEN + IF (branch .LT. 6) THEN + IF (branch .LT. 4) THEN + IF (branch .LT. 3) THEN + IF (.NOT.branch .LT. 2) THEN + temp124b4 = cost1f*zb(indorbp, indt+i) + fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& +& temp124b4 + rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& +& temp124b4 + rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp124b4 + END IF + temp124b2 = -(cost1f*6.d0*zb(indorbp, indt+i)) + temp124b3 = rmu(i, 0)*temp124b2 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp124b2 + fun0b = fun0b + rmu(3, 0)*temp124b3 + rmub(3, 0) = rmub(3, 0) + fun0*temp124b3 + GOTO 100 + ELSE + temp124b7 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp124b7 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp124b7 + rb(0) = rb(0) - fun0*2*r(0)*temp124b7 + END IF + ELSE IF (.NOT.branch .LT. 5) THEN + temp124b8 = cost2f*10.d0*zb(indorbp, indt+i) + temp124b9 = rmu(i, 0)*temp124b8 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp124b8 + fun0b = fun0b + rmu(1, 0)*temp124b9 + rmub(1, 0) = rmub(1, 0) + fun0*temp124b9 + END IF + temp124b5 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp124b6 = rmu(i, 0)*temp124b5 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp124b5 + fun0b = fun0b + rmu(1, 0)*temp124b6 + rmub(1, 0) = rmub(1, 0) + fun0*temp124b6 + ELSE IF (branch .LT. 9) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 7) THEN + temp124b12 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp124b12 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp124b12 + rb(0) = rb(0) - fun0*2*r(0)*temp124b12 + END IF + ELSE + temp124b13 = cost2f*10.d0*zb(indorbp, indt+i) + temp124b14 = rmu(i, 0)*temp124b13 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp124b13 + fun0b = fun0b + rmu(2, 0)*temp124b14 + rmub(2, 0) = rmub(2, 0) + fun0*temp124b14 + END IF + temp124b10 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp124b11 = rmu(i, 0)*temp124b10 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp124b10 + fun0b = fun0b + rmu(2, 0)*temp124b11 + rmub(2, 0) = rmub(2, 0) + fun0*temp124b11 + ELSE IF (branch .LT. 10) THEN + temp124b15 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp124b15 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp124b15 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp124b15 + ELSE + temp124b16 = -(cost3f*2.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp124b16 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp124b16 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp124b16 + END IF + ELSE IF (branch .LT. 16) THEN + IF (branch .LT. 14) THEN + IF (branch .LT. 13) THEN + IF (branch .LT. 12) THEN + temp124b17 = cost3f*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp124b17 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp124b17 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp124b17 + ELSE + temp124b18 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp124b18 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp124b18 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp124b18 + END IF + ELSE + temp124b19 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp124b19 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp124b19 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp124b19 + END IF + ELSE IF (branch .LT. 15) THEN + temp124b20 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp124b20 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp124b20 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp124b20 + ELSE + temp124b21 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp124b21 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp124b21 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp124b21 + END IF + ELSE IF (branch .LT. 19) THEN + IF (branch .LT. 18) THEN + IF (.NOT.branch .LT. 17) THEN + temp124b22 = -(cost4f*6.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp124b22 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp124b22 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp124b22 + END IF + ELSE + temp124b23 = cost4f*6.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp124b23 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp124b23 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp124b23 + END IF + ELSE IF (.NOT.branch .LT. 20) THEN + temp124b24 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp124b24 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp124b24 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp124b24 + END IF + 100 temp124b1 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp124b1 + funb0 = funb0 + rmu(i, 0)*temp124b1 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb - distpb(0, 1) = fun0b - dd1*funb + dd1**2*fun2b + temp124b = (13.d0/2.d0-dd1*r(0))*fun2b + temp124b0 = dd1*distp(0, 1)*fun2b + temp121 = 2.d0*dd1 + temp120 = 9.d0/temp121 + dd1b = distp(0, 1)*funb0 - distp(0, 1)*temp120*2.d0*fun0b/temp121 & +& - r(0)*temp124b0 + distp(0, 1)*temp124b + temp123 = 2.d0*r(0) + temp122 = 11.d0/temp123 + distpb(0, 1) = distpb(0, 1) + (dd1-temp122)*funb0 + (temp120-r(0))& +& *fun0b + dd1*temp124b + rb(0) = rb(0) + distp(0, 1)*temp122*2.d0*funb0/temp123 - distp(0, & +& 1)*fun0b - dd1*temp124b0 + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd1b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + dd1b = 0.0_8 + DO ic=7,1,-1 + DO k=indtm,i0,-1 + temp119 = 2.d0*dd1 + temp118 = 9.d0/temp119 + temp118b10 = (temp118-r(k))*zb(indorbp, k) + temp118b11 = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp118b10 + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp118b10 + dd1b = dd1b - temp118*2.d0*temp118b11/temp119 + rb(k) = rb(k) - temp118b11 + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + DO i=indtm,indtmin,-1 + temp118b2 = cost4f*rmu(2, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 8) - 2*rmu(2, i)*temp118b2 + distpb(i, 8) = 0.0_8 + temp118b3 = cost4f*rmu(1, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& +& distpb(i, 7) + 2*rmu(1, i)*temp118b3 + 3.d0*2*rmu(1, i)*& +& temp118b2 + rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp118b3 + distpb(i, 7) = 0.0_8 + temp118b4 = cost3f*2.d0*distpb(i, 6) + temp118b5 = rmu(2, i)*temp118b4 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp118b5 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp118b5 + rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp118b4 + distpb(i, 6) = 0.0_8 + temp118b6 = cost3f*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 5) + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp118b6 + distpb(i, 5) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 4) - 2*rmu(2, i)*temp118b6 + temp118b7 = cost2f*rmu(2, i)*distpb(i, 4) + rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp118b7 + distpb(i, 4) = 0.0_8 + temp118b8 = cost2f*rmu(1, i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 3) + distpb(i, 3) = 0.0_8 + temp118b9 = cost1f*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - 2*r(i)*temp118b8 - 3.d0*2*r(i)*temp118b9 - 2*r(i)*& +& temp118b7 + rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& +& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp118b9 + 5.d0*2*rmu(3, i)*& +& temp118b8 + distpb(i, 2) = 0.0_8 + END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - temp154b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + temp118b1 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp154b - rb(k) = rb(k) - dd1*temp154b + dd1b = dd1b - r(k)*temp118b1 + rb(k) = rb(k) - dd1*temp118b1 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.5641895835477562d0*2.5d0*dd1**1.5D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (21) -! 2p double zeta -! 2p without cusp condition + dd1b = dd1b + 0.084104417400672d0*4.5d0*dd1**3.5D0*cb + ddb(indparp) = ddb(indparp) + dd1b + CASE (14) +! 3s -derivative of 34 with respect to dd1 +! (1.d0 + dd1 r) * exp(-dd1 * r) ! normalized +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) - c = 0.5d0/DSQRT(8.d0*pi*(1.d0/(2.d0*dd1)**5+2.d0*peff/(dd1+dd2)**5+& -& peff**2/(2.d0*dd2)**5)) DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) - distp(k, 2) = c*DEXP(-(dd2*r(k))) - END DO - DO i=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = distp(i, 1) + peff*distp(i, 2) - END DO -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic + distp(k, 1) = DEXP(-(dd1*r(k))) END DO -! endif +! if(iflagnorm.gt.2) then +! c=dsqrt(dd1**3.d0/7.d0/pi) + c = dd1**1.5d0*0.213243618622923d0 IF (typec .NE. 1) THEN - fun = (-(dd1*distp(0, 1))-dd2*peff*distp(0, 2))/r(0) - fun2 = dd1**2*distp(0, 1) + peff*dd2**2*distp(0, 2) -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO + fun = -(distp(0, 1)*dd1**2*r(0)) + fun2 = -(distp(0, 1)*dd1**2*(1.d0-dd1*r(0))) + temp125b = 2.d0*zb(indorbp, indt+4)/r(0) + cb = fun2*zb(indorbp, indt+4) + fun*temp125b + funb0 = c*temp125b + rb(0) = rb(0) - c*fun*temp125b/r(0) + fun2b = c*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + temp124 = rmu(i, 0)/r(0) + temp124b32 = c*fun*zb(indorbp, indt+i)/r(0) + cb = cb + temp124*fun*zb(indorbp, indt+i) + funb0 = funb0 + temp124*c*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp124b32 + rb(0) = rb(0) - temp124*temp124b32 + zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - funb = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp164b4 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp164b4 - fun2b = fun2b + temp164b4 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) distpb(0, 3) = distpb(0, 3) + zb(& -& indorbp, indt+i) - temp164b3 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp164b3 - funb = funb + rmu(ic, 0)*temp164b3 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - temp164b1 = dd2**2*fun2b - temp164b2 = funb/r(0) - dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*temp164b2 - distpb(0, 1) = distpb(0, 1) + dd1**2*fun2b - dd2b = peff*distp(0, 2)*2*dd2*fun2b - distp(0, 2)*peff*temp164b2 - peffb = distp(0, 2)*temp164b1 - distp(0, 2)*dd2*temp164b2 - distpb(0, 2) = distpb(0, 2) + peff*temp164b1 - distpb(0, 1) = distpb(0, 1) - dd1*temp164b2 - distpb(0, 2) = distpb(0, 2) - dd2*peff*temp164b2 - rb(0) = rb(0) - (-(dd1*distp(0, 1))-dd2*peff*distp(0, 2))*& -& temp164b2/r(0) + temp124b29 = -((1.d0-dd1*r(0))*fun2b) + temp124b30 = -(distp(0, 1)*dd1**2*fun2b) + temp124b31 = -(dd1**2*funb0) + distpb(0, 1) = r(0)*temp124b31 + dd1**2*temp124b29 + dd1b = distp(0, 1)*2*dd1*temp124b29 - r(0)*temp124b30 - distp(0, 1& +& )*r(0)*2*dd1*funb0 + rb(0) = rb(0) + distp(0, 1)*temp124b31 - dd1*temp124b30 ELSE distpb = 0.0_8 - peffb = 0.0_8 dd1b = 0.0_8 - dd2b = 0.0_8 + cb = 0.0_8 END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO i=indtm,indtmin,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distpb(i, 1) = distpb(i, 1) + distpb(i, 3) - peffb = peffb + distp(i, 2)*distpb(i, 3) - distpb(i, 2) = distpb(i, 2) + peff*distpb(i, 3) - distpb(i, 3) = 0.0_8 + DO i=indtm,i0,-1 + temp124b27 = c*distp(i, 1)*zb(indorbp, i) + temp124b28 = (dd1*r(i)+1.d0)*zb(indorbp, i) + dd1b = dd1b + r(i)*temp124b27 + rb(i) = rb(i) + dd1*temp124b27 + cb = cb + distp(i, 1)*temp124b28 + distpb(i, 1) = distpb(i, 1) + c*temp124b28 + zb(indorbp, i) = 0.0_8 END DO - cb = 0.0_8 + dd1b = dd1b + 0.213243618622923d0*1.5d0*dd1**0.5D0*cb DO k=indtm,indtmin,-1 - temp164b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp164b - distpb(k, 2) = 0.0_8 - temp164b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp164b0 - dd2*temp164b - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp164b0 + temp124b26 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp124b26 + rb(k) = rb(k) - dd1*temp124b26 distpb(k, 1) = 0.0_8 END DO - temp163 = 2.d0**5 - temp162 = temp163*dd2**5 - temp161 = peff**2/temp162 - temp160 = (dd1+dd2)**5 - temp159 = 2.d0**5 - temp158 = temp159*dd1**5 - temp157 = 8.d0*pi*(1.0/temp158+2.d0*peff/temp160+temp161) - temp156 = DSQRT(temp157) - IF (temp157 .EQ. 0.0) THEN - temp156b0 = 0.0 - ELSE - temp156b0 = -(0.5d0*pi*8.d0*cb/(temp156**2*2.D0*DSQRT(temp157))) - END IF - temp156b1 = 2.d0*temp156b0/temp160 - temp156b2 = -(peff*5*(dd1+dd2)**4*temp156b1/temp160) - dd1b = dd1b + temp156b2 - temp159*5*dd1**4*temp156b0/temp158**2 - peffb = peffb + 2*peff*temp156b0/temp162 + temp156b1 - dd2b = dd2b + temp156b2 - temp161*temp163*5*dd2**4*temp156b0/temp162 - ddb(indpar+3) = ddb(indpar+3) + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (22) -! 3p single zeta -! 3p without cusp condition -! r e^{-z1 r } + CASE (60) +! 1s single Z pseudo +! R(r)=r**3*exp(-z*r**2) single zeta +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 dd1 = dd(indpar+1) -! c=dsqrt((2.d0*dd1)**7/240.d0/pi)/2.d0 - c = dd1**3.5d0*0.2060129077457011d0 -! +! if(iflagnorm.gt.2) then +! c=2.d0/pi**(3.d0/4.d0)*(2.d0*dd1)**(9.d0/4.d0)*dsqrt(2.d0/105.d0) + c = dd1**2.25d0*.55642345640820284397d0 +! endif DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(k, 2)) - distp(k, 2) = r(k)*distp(k, 1) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2))*r(k) END DO -! -! indorbp=indorb -! - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif -! -! IF (typec .NE. 1) THEN - fun = (1.d0-dd1*r(0))*distp(0, 1) - fun2 = dd1*(dd1*r(0)-2.d0)*distp(0, 1) -! -! indorbp=indorb -! - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp165 = fun/r(0) - temp166b = rmu(ic, 0)*zb(indorbp, indt+4) - temp165b = 4.d0*temp166b/r(0) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp165+fun2)*zb(indorbp, indt& -& +4) - funb = funb + temp165b - rb(0) = rb(0) - temp165*temp165b - fun2b = fun2b + temp166b - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp164 = fun/r(0) - temp164b8 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(ic, 0) = rmub(ic, 0) + temp164*rmu(i, 0)*zb(indorbp, indt& -& +i) - rmub(i, 0) = rmub(i, 0) + temp164*rmu(ic, 0)*zb(indorbp, indt+& -& i) - funb = funb + temp164b8 - rb(0) = rb(0) - temp164*temp164b8 - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + rp1 = r(0)**2*dd1 +! the first derivative / r + fun = distp(0, 1)*(3.d0-2.d0*rp1) +! the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp164b6 = dd1*distp(0, 1)*fun2b - temp164b7 = (dd1*r(0)-2.d0)*fun2b - dd1b = distp(0, 1)*temp164b7 - distp(0, 1)*r(0)*funb + r(0)*& -& temp164b6 - rb(0) = rb(0) + dd1*temp164b6 - distp(0, 1)*dd1*funb - distpb(0, 1) = (1.d0-dd1*r(0))*funb + dd1*temp164b7 - distpb(0, 2) = distpb(0, 2) + fun0b + distpb(0, 1) = (3.d0-2.d0*rp1)*funb0 + (4.d0*rp1**2-14.d0*rp1+6.d0& +& )*fun2b + rp1b = (distp(0, 1)*4.d0*2*rp1-distp(0, 1)*14.d0)*fun2b - distp(0& +& , 1)*2.d0*funb0 + rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd1b = r(0)**2*rp1b ELSE distpb = 0.0_8 dd1b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 2)*zb(indorbp, i) - distpb(i, 2) = distpb(i, 2) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + DO i=indtm,i0,-1 + distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(k, 2)) - rb(k) = rb(k) + distp(k, 1)*distpb(k, 2) - distpb(k, 1) = distpb(k, 1) + r(k)*distpb(k, 2) - distpb(k, 2) = 0.0_8 - temp164b5 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp164b5 - rb(k) = rb(k) - dd1*temp164b5 + temp125 = r(k)**2 + temp125b0 = c*r(k)*DEXP(-(dd1*temp125))*distpb(k, 1) + temp125b1 = DEXP(-(dd1*temp125))*distpb(k, 1) + dd1b = dd1b - temp125*temp125b0 + rb(k) = rb(k) + c*temp125b1 - dd1*2*r(k)*temp125b0 + cb = cb + r(k)*temp125b1 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.2060129077457011d0*3.5d0*dd1**2.5D0*cb + dd1b = dd1b + .55642345640820284397d0*2.25d0*dd1**1.25D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (23) -! 3p double zeta -! 3p without cusp condition -! r ( e^{-z2 r } + z1 e^{-z3 r } ) + CASE (19) +! 3s -derivative of 60 with respect to dd1 +! R(r)=c*exp(-z*r**2)*(3/4/z-r**2) +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - dd3 = dd(indpar+3) -! if(iflagnorm.gt.2) then - c = 1.d0/2.d0/DSQRT(240.d0*pi*(1.d0/(2.d0*dd1)**7+2.d0*dd3/(dd1+dd2)& -& **7+dd3**2/(2.d0*dd2)**7)) -! endif -! +! if(iflagnorm.gt.2) then +! if(dd1.ne.0.) then +! c=(2.d0*dd1/pi)**(3.d0/4.d0) + c = 0.71270547035499016d0*dd1**0.75d0 +! else +! c=1.d0 +! endif +! endif DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) - distp(k, 2) = c*DEXP(-(dd2*r(k))) - END DO -! - DO i=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = r(i)*(distp(i, 1)+dd3*distp(i, 2)) - END DO -! -! indorbp=indorb -! - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO -! endif -! -! IF (typec .NE. 1) THEN - fun = (1.d0-dd1*r(0))*distp(0, 1) + dd3*(1.d0-dd2*r(0))*distp(0, 2& -& ) - fun2 = dd1*(dd1*r(0)-2.d0)*distp(0, 1) + dd3*dd2*(dd2*r(0)-2.d0)*& -& distp(0, 2) -! -! indorbp=indorb -! - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp175 = fun/r(0) - temp176b = rmu(ic, 0)*zb(indorbp, indt+4) - temp175b = 4.d0*temp176b/r(0) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp175+fun2)*zb(indorbp, indt& -& +4) - funb = funb + temp175b - rb(0) = rb(0) - temp175*temp175b - fun2b = fun2b + temp176b - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp174 = fun/r(0) - temp174b8 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(ic, 0) = rmub(ic, 0) + temp174*rmu(i, 0)*zb(indorbp, indt& -& +i) - rmub(i, 0) = rmub(i, 0) + temp174*rmu(ic, 0)*zb(indorbp, indt+& -& i) - funb = funb + temp174b8 - rb(0) = rb(0) - temp174*temp174b8 - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) +! the first derivative /r + fun = distp(0, 1)*(2.d0*dd1*r(0)**2-7.d0/2.d0) +! the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp174b2 = dd1*distp(0, 1)*fun2b - temp174b3 = (dd1*r(0)-2.d0)*fun2b - temp174b4 = (dd2*r(0)-2.d0)*fun2b - temp174b5 = dd3*dd2*distp(0, 2)*fun2b - dd1b = distp(0, 1)*temp174b3 - distp(0, 1)*r(0)*funb + r(0)*& -& temp174b2 - temp174b6 = dd3*distp(0, 2)*funb - rb(0) = rb(0) + dd2*temp174b5 - dd2*temp174b6 - distp(0, 1)*dd1*& -& funb + dd1*temp174b2 - distpb(0, 1) = dd1*temp174b3 - temp174b7 = (1.d0-dd2*r(0))*funb - dd3b = distp(0, 2)*temp174b7 + distp(0, 2)*dd2*temp174b4 - dd2b = r(0)*temp174b5 - r(0)*temp174b6 + distp(0, 2)*dd3*temp174b4 - distpb(0, 2) = dd3*dd2*temp174b4 - distpb(0, 1) = distpb(0, 1) + (1.d0-dd1*r(0))*funb - distpb(0, 2) = distpb(0, 2) + dd3*temp174b7 - distpb(0, 3) = distpb(0, 3) + fun0b + temp129 = r(0)**4 + temp129b = distp(0, 1)*fun2b + distpb(0, 1) = (2.d0*(dd1*r(0)**2)-7.d0/2.d0)*funb0 + (13.d0*(dd1*& +& r(0)**2)-7.d0/2.d0-4.d0*(dd1**2*temp129))*fun2b + temp129b0 = distp(0, 1)*2.d0*funb0 + dd1b = r(0)**2*temp129b0 + (13.d0*r(0)**2-4.d0*temp129*2*dd1)*& +& temp129b + rb(0) = rb(0) + dd1*2*r(0)*temp129b0 + (13.d0*dd1*2*r(0)-4.d0*dd1& +& **2*4*r(0)**3)*temp129b ELSE distpb = 0.0_8 dd1b = 0.0_8 - dd2b = 0.0_8 - dd3b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO i=indtm,indtmin,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - temp174b1 = r(i)*distpb(i, 3) - rb(i) = rb(i) + (distp(i, 1)+dd3*distp(i, 2))*distpb(i, 3) - distpb(i, 1) = distpb(i, 1) + temp174b1 - dd3b = dd3b + distp(i, 2)*temp174b1 - distpb(i, 2) = distpb(i, 2) + dd3*temp174b1 - distpb(i, 3) = 0.0_8 + DO i=indtm,i0,-1 + temp128 = 4.d0*dd1 + temp127 = 3.d0/temp128 + temp127b = distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + (temp127-r(i)**2)*zb(indorbp, i) + dd1b = dd1b - temp127*4.d0*temp127b/temp128 + rb(i) = rb(i) - 2*r(i)*temp127b + zb(indorbp, i) = 0.0_8 END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - temp174b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp174b - distpb(k, 2) = 0.0_8 - temp174b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp174b0 - dd2*temp174b - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp174b0 + temp126 = r(k)**2 + temp126b = c*DEXP(-(dd1*temp126))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp126))*distpb(k, 1) + dd1b = dd1b - temp126*temp126b + rb(k) = rb(k) - dd1*2*r(k)*temp126b distpb(k, 1) = 0.0_8 END DO - temp173 = 2.d0**7 - temp172 = temp173*dd2**7 - temp171 = dd3**2/temp172 - temp170 = (dd1+dd2)**7 - temp169 = 2.d0**7 - temp168 = temp169*dd1**7 - temp167 = 240.d0*pi*(1.0/temp168+2.d0*dd3/temp170+temp171) - temp166 = DSQRT(temp167) - IF (temp167 .EQ. 0.0) THEN - temp166b0 = 0.0 - ELSE - temp166b0 = -(pi*240.d0*cb/(2.d0*temp166**2*2.D0*DSQRT(temp167))) - END IF - temp166b1 = 2.d0*temp166b0/temp170 - temp166b2 = -(dd3*7*(dd1+dd2)**6*temp166b1/temp170) - dd1b = dd1b + temp166b2 - temp169*7*dd1**6*temp166b0/temp168**2 - dd3b = dd3b + 2*dd3*temp166b0/temp172 + temp166b1 - dd2b = dd2b + temp166b2 - temp171*temp173*7*dd2**6*temp166b0/temp172 - ddb(indpar+3) = ddb(indpar+3) + dd3b - ddb(indpar+2) = ddb(indpar+2) + dd2b + dd1b = dd1b + 0.71270547035499016d0*0.75d0*dd1**(-0.25D0)*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (24) -! 4p single zeta -!c 4p without cusp condition -!c r^2 e^{-z1 r } - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2.d0*dd1)**9/120960.d0/pi)/2.d0 - c = dd1**4.5d0*0.01835308852470193d0 -! endif + CASE (51) +! 2p single zeta +! g single gaussian orbital +! R(r)= exp(-alpha r^2) +! normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization +! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0) + c = dd1**2.75d0*1.11284691281640568826d0 +! endif DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO DO i=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = r(i)**2*distp(i, 1) + distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& +& 2+3.d0*r(i)**4) +! lz=0 + distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& +& 2-r(i)**2) +! lz=+/-2 + distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& +& (i)**2) +! lz=+/-2 + distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & +& i)**2) +! lz=+/-3 + distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& +& , i)**2) +! lz=+/-3 + distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& +& rmu(2, i)**4) +! lz=+/-4 + distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& +& , i)**2) END DO -! indorbp=indorb - DO ic=1,3 +! lz=+/-4 + DO ic=1,9 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = (2.d0*r(0)-dd1*r(0)**2)*distp(0, 1) - fun2 = ((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))*distp(0, 1) -! indorbp=indorb - DO ic=1,3 + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1) + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) +! indorbp=indorb + DO ic=1,9 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO + IF (ic .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + ELSE IF (ic .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (ic .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE IF (ic .EQ. 4) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (ic .EQ. 5) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + ELSE IF (ic .EQ. 6) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE IF (ic .EQ. 7) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (ic .EQ. 8) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + ELSE IF (ic .EQ. 9) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + END IF END DO - funb = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=3,1,-1 - temp177 = fun/r(0) - temp178b = rmu(ic, 0)*zb(indorbp, indt+4) - temp177b = 4.d0*temp178b/r(0) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp177+fun2)*zb(indorbp, indt& -& +4) - funb = funb + temp177b - rb(0) = rb(0) - temp177*temp177b - fun2b = fun2b + temp178b + DO ic=9,1,-1 + temp131b74 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 10.d0*temp131b74 + fun2b = fun2b + temp131b74 zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp176 = fun/r(0) - temp176b4 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(ic, 0) = rmub(ic, 0) + temp176*rmu(i, 0)*zb(indorbp, indt& -& +i) - rmub(i, 0) = rmub(i, 0) + temp176*rmu(ic, 0)*zb(indorbp, indt+& -& i) - funb = funb + temp176b4 - rb(0) = rb(0) - temp176*temp176b4 - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - distpb = 0.0_8 - temp176b1 = distp(0, 1)*fun2b - temp176b2 = 2*dd1*r(0)*temp176b1 - temp176b3 = distp(0, 1)*funb - dd1b = r(0)*temp176b2 - 4.d0*r(0)*temp176b1 - r(0)**2*temp176b3 - rb(0) = rb(0) + (2.d0-dd1*2*r(0))*temp176b3 - 4.d0*dd1*temp176b1 +& -& dd1*temp176b2 - distpb(0, 1) = (2.d0*r(0)-dd1*r(0)**2)*funb + ((dd1*r(0))**2-4.d0*& -& (dd1*r(0))+2.d0)*fun2b - distpb(0, 3) = distpb(0, 3) + fun0b - ELSE - distpb = 0.0_8 - dd1b = 0.0_8 - END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO i=indtm,indtmin,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*distpb(i, 3) - distpb(i, 1) = distpb(i, 1) + r(i)**2*distpb(i, 3) - distpb(i, 3) = 0.0_8 - END DO - cb = 0.0_8 - DO k=indtm,indtmin,-1 - temp176b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp176b0 - rb(k) = rb(k) - dd1*temp176b0 - distpb(k, 1) = 0.0_8 - END DO - dd1b = dd1b + 0.01835308852470193d0*4.5d0*dd1**3.5D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (25) -! 4p double zeta -! 4p without cusp condition -! r^2 ( e^{-z2 r } + z1 e^{-z3 r } ) - dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - dd3 = dd(indpar+3) -! if(iflagnorm.gt.2) then - c = 1.d0/2.d0/DSQRT(120960.d0*pi*(1.d0/(2.d0*dd1)**9+2.d0*dd3/(dd1+& -& dd2)**9+dd3**2/(2.d0*dd2)**9)) -! endif - DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) - distp(k, 2) = c*DEXP(-(dd2*r(k))) - END DO - DO i=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = r(i)**2*(distp(i, 1)+dd3*distp(i, 2)) - END DO -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun = (2.d0*r(0)-dd1*r(0)**2)*distp(0, 1) + dd3*(2.d0*r(0)-dd2*r(0& -& )**2)*distp(0, 2) - fun2 = ((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))*distp(0, 1) + dd3*((dd2*& -& r(0))**2+2.d0-4.d0*dd2*r(0))*distp(0, 2) -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + IF (branch .LT. 1) THEN + temp131b19 = cost1g*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-60.d0*& +& (rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+2) + cost1g& +& *(12.d0*(rmu(1, 0)*r(0)**2)-60.d0*(rmu(1, 0)*rmu(3, 0)& +& **2))*zb(indorbp, indt+1) + cost1g*(80.d0*rmu(3, 0)**3& +& -48.d0*(rmu(3, 0)*r(0)**2))*zb(indorbp, indt+3) + rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*r(& +& 0)**2)*temp131b19 + temp131b20 = cost1g*fun0*zb(indorbp, indt+2) + temp131b21 = cost1g*fun0*zb(indorbp, indt+1) + rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp131b20 + & +& 12.d0*rmu(1, 0)*2*r(0)*temp131b21 - 48.d0*rmu(3, 0)*2*& +& r(0)*temp131b19 + rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3, 0)& +& **2)*temp131b20 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0)*& +& temp131b20 + rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3, 0)& +& **2)*temp131b21 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0)*& +& temp131b21 + ELSE + temp131b22 = -(cost2g*3.d0*zb(indorbp, indt+3)) + temp131b23 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**& +& 2)*temp131b22 + temp131b24 = fun0*rmu(1, 0)*temp131b22 + temp131b25 = -(cost2g*6.d0*zb(indorbp, indt+2)) + temp131b26 = rmu(2, 0)*rmu(3, 0)*temp131b25 + fun0b = fun0b + rmu(1, 0)*temp131b26 + cost2g*(4.d0*rmu(& +& 3, 0)**3-3.d0*(rmu(2, 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)& +& **2*rmu(3, 0)))*zb(indorbp, indt+1) + rmu(1, 0)*& +& temp131b23 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp131b24 + fun0*& +& temp131b23 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp131b24 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp131b24 + temp131b27 = fun0*rmu(1, 0)*temp131b25 + rmub(1, 0) = rmub(1, 0) + fun0*temp131b26 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp131b27 + temp131b28 = cost2g*fun0*zb(indorbp, indt+1) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*rmu(& +& 2, 0)**2-9.d0*rmu(1, 0)**2)*temp131b28 + rmu(2, 0)*& +& temp131b27 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp131b28 + rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp131b28 + END IF + ELSE + temp131b29 = -(cost2g*3.d0*zb(indorbp, indt+3)) + temp131b30 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**2)& +& *temp131b29 + temp131b31 = fun0*rmu(2, 0)*temp131b29 + temp131b32 = -(cost2g*6.d0*zb(indorbp, indt+1)) + temp131b33 = rmu(2, 0)*rmu(3, 0)*temp131b32 + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2, 0)& +& **2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb(indorbp& +& , indt+2) + rmu(1, 0)*temp131b33 + rmu(2, 0)*temp131b30 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp131b31 + fun0*& +& temp131b30 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp131b31 + temp131b34 = cost2g*fun0*zb(indorbp, indt+2) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*rmu(2& +& , 0)**2-3.d0*rmu(1, 0)**2)*temp131b34 - 4.d0*2*rmu(3, 0)& +& *temp131b31 + rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp131b34 + rmub(1, 0) = rmub(1, 0) + fun0*temp131b33 - 3.d0*rmu(3, 0)& +& *2*rmu(1, 0)*temp131b34 + temp131b35 = fun0*rmu(1, 0)*temp131b32 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp131b35 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp131b35 + END IF + ELSE IF (branch .LT. 4) THEN + temp131b36 = cost3g*12.d0*zb(indorbp, indt+3) + temp131b37 = fun0*rmu(3, 0)*temp131b36 + temp131b38 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp131b36 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp131b37 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp131b37 + temp131b39 = cost3g*4.d0*zb(indorbp, indt+2) + temp131b40 = -(cost3g*4.d0*zb(indorbp, indt+1)) + fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)**2))& +& *temp131b39 + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)**2))& +& *temp131b40 + rmu(3, 0)*temp131b38 + rmub(3, 0) = rmub(3, 0) + fun0*temp131b38 + temp131b41 = fun0*temp131b39 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)**2)& +& *temp131b41 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& +& temp131b41 + temp131b42 = fun0*temp131b40 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)**2)& +& *temp131b42 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& +& temp131b42 ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + temp131b43 = cost3g*24.d0*zb(indorbp, indt+3) + temp131b44 = rmu(2, 0)*rmu(3, 0)*temp131b43 + temp131b45 = fun0*rmu(1, 0)*temp131b43 + temp131b46 = -(cost3g*2.d0*zb(indorbp, indt+2)) + temp131b47 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0)& +& **2)*temp131b46 + temp131b48 = -(cost3g*2.d0*zb(indorbp, indt+1)) + temp131b49 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3, 0)& +& **2)*temp131b48 + fun0b = fun0b + rmu(1, 0)*temp131b47 + rmu(2, 0)*temp131b49 & +& + rmu(1, 0)*temp131b44 + rmub(1, 0) = rmub(1, 0) + fun0*temp131b44 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp131b45 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp131b45 + temp131b50 = fun0*rmu(1, 0)*temp131b46 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp131b50 + fun0*& +& temp131b47 + rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp131b50 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp131b50 + temp131b51 = fun0*rmu(2, 0)*temp131b48 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp131b51 + fun0*& +& temp131b49 + rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp131b51 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp131b51 END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp187 = fun/r(0) - temp188b = rmu(ic, 0)*zb(indorbp, indt+4) - temp187b = 4.d0*temp188b/r(0) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp187+fun2)*zb(indorbp, indt& -& +4) - funb = funb + temp187b - rb(0) = rb(0) - temp187*temp187b - fun2b = fun2b + temp188b - zb(indorbp, indt+4) = 0.0_8 + ELSE IF (branch .LT. 8) THEN + IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp131b52 = cost4g*fun0*zb(indorbp, indt+3) + temp131b53 = -(cost4g*6.d0*zb(indorbp, indt+2)) + temp131b54 = rmu(2, 0)*rmu(3, 0)*temp131b53 + temp131b55 = cost4g*3.d0*zb(indorbp, indt+1) + temp131b56 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp131b55 + fun0b = fun0b + rmu(1, 0)*temp131b54 + rmu(3, 0)*& +& temp131b56 + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2& +& , 0)**2))*zb(indorbp, indt+3) + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**& +& 2)*temp131b52 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp131b52 + temp131b57 = fun0*rmu(1, 0)*temp131b53 + rmub(1, 0) = rmub(1, 0) + fun0*temp131b54 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp131b57 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp131b57 + temp131b58 = fun0*rmu(3, 0)*temp131b55 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp131b58 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp131b58 + rmub(3, 0) = rmub(3, 0) + fun0*temp131b56 + ELSE + temp131b59 = cost4g*fun0*zb(indorbp, indt+3) + temp131b60 = cost4g*3.d0*zb(indorbp, indt+2) + temp131b61 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp131b60 + temp131b62 = cost4g*6.d0*zb(indorbp, indt+1) + temp131b63 = rmu(2, 0)*rmu(3, 0)*temp131b62 + fun0b = fun0b + rmu(3, 0)*temp131b61 + rmu(1, 0)*& +& temp131b63 + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2& +& , 0)**3)*zb(indorbp, indt+3) + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp131b59 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& +& 2)*temp131b59 + temp131b64 = fun0*rmu(3, 0)*temp131b60 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp131b64 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp131b64 + rmub(3, 0) = rmub(3, 0) + fun0*temp131b61 + temp131b65 = fun0*rmu(1, 0)*temp131b62 + rmub(1, 0) = rmub(1, 0) + fun0*temp131b63 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp131b65 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp131b65 + END IF + ELSE + temp131b66 = cost5g*4.d0*zb(indorbp, indt+2) + temp131b67 = fun0*temp131b66 + temp131b68 = cost5g*4.d0*zb(indorbp, indt+1) + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& +& *temp131b68 + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)))& +& *temp131b66 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**2)& +& *temp131b67 + temp131b69 = fun0*temp131b68 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& +& *temp131b69 - 3.d0*rmu(2, 0)*2*rmu(1, 0)*temp131b67 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp131b69 + END IF + ELSE IF (.NOT.branch .LT. 9) THEN + temp131b70 = cost5g*4.d0*zb(indorbp, indt+2) + temp131b71 = fun0*temp131b70 + temp131b72 = cost5g*4.d0*zb(indorbp, indt+1) + fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**3)*& +& temp131b72 + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))*& +& temp131b70 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)*& +& temp131b71 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp131b71 + temp131b73 = fun0*temp131b72 + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp131b73 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**2)*& +& temp131b73 + END IF DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp186 = fun/r(0) - temp186b10 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(ic, 0) = rmub(ic, 0) + temp186*rmu(i, 0)*zb(indorbp, indt& -& +i) - rmub(i, 0) = rmub(i, 0) + temp186*rmu(ic, 0)*zb(indorbp, indt+& -& i) - funb = funb + temp186b10 - rb(0) = rb(0) - temp186*temp186b10 + temp131b18 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp131b18 + funb0 = funb0 + rmu(i, 0)*temp131b18 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp186b2 = distp(0, 1)*fun2b - temp186b3 = 2*dd1*r(0)*temp186b2 - temp186b4 = dd3*distp(0, 2)*fun2b - temp186b5 = 2*dd2*r(0)*temp186b4 - temp186b6 = ((dd2*r(0))**2-4.d0*(dd2*r(0))+2.d0)*fun2b - temp186b7 = distp(0, 1)*funb - dd1b = r(0)*temp186b3 - 4.d0*r(0)*temp186b2 - r(0)**2*temp186b7 - temp186b8 = dd3*distp(0, 2)*funb - rb(0) = rb(0) + (2.d0-dd1*2*r(0))*temp186b7 + (2.d0-dd2*2*r(0))*& -& temp186b8 - 4.d0*dd2*temp186b4 + dd2*temp186b5 - 4.d0*dd1*& -& temp186b2 + dd1*temp186b3 - distpb(0, 1) = ((dd1*r(0))**2-4.d0*(dd1*r(0))+2.d0)*fun2b - dd2b = r(0)*temp186b5 - 4.d0*r(0)*temp186b4 - r(0)**2*temp186b8 - temp186b9 = (2.d0*r(0)-dd2*r(0)**2)*funb - dd3b = distp(0, 2)*temp186b9 + distp(0, 2)*temp186b6 - distpb(0, 2) = dd3*temp186b6 - distpb(0, 1) = distpb(0, 1) + (2.d0*r(0)-dd1*r(0)**2)*funb - distpb(0, 2) = distpb(0, 2) + dd3*temp186b9 - distpb(0, 3) = distpb(0, 3) + fun0b + temp131b17 = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp131b17 - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp131b17 + distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb0 + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 - dd3b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=9,1,-1 + DO k=indtm,i0,-1 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - temp186b1 = r(i)**2*distpb(i, 3) - rb(i) = rb(i) + (distp(i, 1)+dd3*distp(i, 2))*2*r(i)*distpb(i, 3) - distpb(i, 1) = distpb(i, 1) + temp186b1 - dd3b = dd3b + distp(i, 2)*temp186b1 - distpb(i, 2) = distpb(i, 2) + dd3*temp186b1 + temp131b = cost5g*4.d0*distpb(i, 10) + temp131b0 = (rmu(1, i)**2-rmu(2, i)**2)*temp131b + temp131b1 = rmu(1, i)*rmu(2, i)*temp131b + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp131b1 + rmu(2, i)*& +& temp131b0 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp131b0 - 2*rmu(2, i)*& +& temp131b1 + distpb(i, 10) = 0.0_8 + temp131b2 = cost5g*distpb(i, 9) + rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& +& 1, i))*temp131b2 + distpb(i, 9) = 0.0_8 + temp131b3 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) + temp131b4 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp131b3 - 2*rmu(2, i)*& +& temp131b4 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& +& temp131b2 + rmub(3, i) = rmub(3, i) + rmu(2, i)*temp131b3 + distpb(i, 8) = 0.0_8 + temp131b5 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) + temp131b6 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp131b5 + 2*rmu(1, i)*& +& temp131b6 + 3.d0*2*rmu(1, i)*temp131b4 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp131b5 + rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp131b6 + distpb(i, 7) = 0.0_8 + temp131b7 = cost3g*2.d0*distpb(i, 6) + temp131b8 = (7.d0*rmu(3, i)**2-r(i)**2)*temp131b7 + temp131b9 = rmu(1, i)*rmu(2, i)*temp131b7 + rmub(1, i) = rmub(1, i) + rmu(2, i)*temp131b8 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp131b8 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp131b9 + distpb(i, 6) = 0.0_8 + temp131b10 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) + temp131b11 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + temp131b12 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) + temp131b13 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + temp131b14 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) + temp131b15 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 + temp131b16 = cost1g*distpb(i, 2) + rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& +& temp131b16 - 3.d0*2*r(i)*temp131b15 - 2*r(i)*temp131b11 - 3.d0*2& +& *r(i)*temp131b13 - 2*r(i)*temp131b9 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp131b10 + rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp131b10 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp131b11 + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp131b12 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp131b13 + rmu(2, i)*& +& temp131b12 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp131b14 + rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& +& rmu(3, i))*temp131b16 + 7.d0*2*rmu(3, i)*temp131b15 + rmu(1, i)*& +& temp131b14 + distpb(i, 2) = 0.0_8 END DO + dd1b = 0.0_8 cb = 0.0_8 DO k=indtm,indtmin,-1 - temp186b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp186b - distpb(k, 2) = 0.0_8 - temp186b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp186b0 - dd2*temp186b - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp186b0 + temp130 = r(k)**2 + temp130b = c*DEXP(-(dd1*temp130))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp130))*distpb(k, 1) + dd1b = dd1b - temp130*temp130b + rb(k) = rb(k) - dd1*2*r(k)*temp130b distpb(k, 1) = 0.0_8 END DO - temp185 = 2.d0**9 - temp184 = temp185*dd2**9 - temp183 = dd3**2/temp184 - temp182 = (dd1+dd2)**9 - temp181 = 2.d0**9 - temp180 = temp181*dd1**9 - temp179 = 120960.d0*pi*(1.0/temp180+2.d0*dd3/temp182+temp183) - temp178 = DSQRT(temp179) - IF (temp179 .EQ. 0.0) THEN - temp178b0 = 0.0 - ELSE - temp178b0 = -(pi*120960.d0*cb/(2.d0*temp178**2*2.D0*DSQRT(temp179)& -& )) - END IF - temp178b1 = 2.d0*temp178b0/temp182 - temp178b2 = -(dd3*9*(dd1+dd2)**8*temp178b1/temp182) - dd1b = dd1b + temp178b2 - temp181*9*dd1**8*temp178b0/temp180**2 - dd3b = dd3b + 2*dd3*temp178b0/temp184 + temp178b1 - dd2b = dd2b + temp178b2 - temp183*temp185*9*dd2**8*temp178b0/temp184 - ddb(indpar+3) = ddb(indpar+3) + dd3b - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (26) -! 2p triple zeta -! 2p without cusp condition + dd1b = dd1b + 1.11284691281640568826d0*2.75d0*dd1**1.75D0*cb + ddb(indparp) = ddb(indparp) + dd1b + CASE (142) +! 4d one parmater dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) - dd3 = dd(indpar+4) - peff2 = dd(indpar+5) -! if(iflagnorm.gt.2) then - c = 1.d0/2.d0/DSQRT(8.d0*pi*(1.d0/(2.d0*dd1)**5+2.d0*peff/(dd1+dd2)& -& **5+peff**2/(2.d0*dd2)**5+2.d0*peff2/(dd1+dd3)**5+peff2**2/(2.d0*& -& dd3)**5+2.d0*peff2*peff/(dd2+dd3)**5)) -! endif DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) - distp(k, 2) = c*DEXP(-(dd2*r(k))) - distp(k, 3) = c*DEXP(-(dd3*r(k))) + distp(k, 1) = DEXP(-(dd1*r(k))) END DO DO i=indtmin,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = distp(i, 1)*r(i) CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) - distp(i, 4) = distp(i, 1) + peff*distp(i, 2) + peff2*distp(i, 3) + distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) + distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) + distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) + distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) + distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d END DO -! indorbp=indorb - DO ic=1,3 +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = (-(dd1*distp(0, 1))-dd2*peff*distp(0, 2)-dd3*peff2*distp(0, & -& 3))/r(0) - fun2 = dd1**2*distp(0, 1) + peff*dd2**2*distp(0, 2) + peff2*dd3**2& -& *distp(0, 3) -! indorbp=indorb - DO ic=1,3 + fun0 = -distp(0, 3) + fun = -((1.d0-dd1*r(0))*distp(0, 1)) + fun2 = -(dd1*(dd1*r(0)-2.d0)*distp(0, 1)) +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + IF (ic .EQ. 1) THEN + IF (i .NE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 + fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=3,1,-1 - temp202b6 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp202b6 - fun2b = fun2b + temp202b6 + DO ic=5,1,-1 + temp132 = fun/r(0) + temp133b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp132b3 = 6.d0*temp133b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp132+fun2)*zb(& +& indorbp, indt+4) + funb0 = funb0 + temp132b3 + rb(0) = rb(0) - temp132*temp132b3 + fun2b = fun2b + temp133b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) distpb(0, 4) = distpb(0, 4) + zb(& -& indorbp, indt+i) - temp202b5 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp202b5 - funb = funb + rmu(ic, 0)*temp202b5 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - temp202b2 = dd2**2*fun2b - temp202b3 = dd3**2*fun2b - temp202b4 = funb/r(0) - dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*temp202b4 - distpb(0, 1) = distpb(0, 1) + dd1**2*fun2b - dd2b = peff*distp(0, 2)*2*dd2*fun2b - distp(0, 2)*peff*temp202b4 - peffb = distp(0, 2)*temp202b2 - distp(0, 2)*dd2*temp202b4 - distpb(0, 2) = distpb(0, 2) + peff*temp202b2 - dd3b = peff2*distp(0, 3)*2*dd3*fun2b - distp(0, 3)*peff2*temp202b4 - peff2b = distp(0, 3)*temp202b3 - distp(0, 3)*dd3*temp202b4 - distpb(0, 3) = distpb(0, 3) + peff2*temp202b3 - distpb(0, 1) = distpb(0, 1) - dd1*temp202b4 - distpb(0, 2) = distpb(0, 2) - dd2*peff*temp202b4 - distpb(0, 3) = distpb(0, 3) - dd3*peff2*temp202b4 - rb(0) = rb(0) - (-(dd1*distp(0, 1))-dd2*peff*distp(0, 2)-dd3*peff2& -& *distp(0, 3))*temp202b4/r(0) - ELSE - distpb = 0.0_8 - peffb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 - dd3b = 0.0_8 - peff2b = 0.0_8 - END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 4)*zb(indorbp, i) - distpb(i, 4) = distpb(i, 4) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO i=indtm,indtmin,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - distpb(i, 1) = distpb(i, 1) + distpb(i, 4) - peffb = peffb + distp(i, 2)*distpb(i, 4) - distpb(i, 2) = distpb(i, 2) + peff*distpb(i, 4) - peff2b = peff2b + distp(i, 3)*distpb(i, 4) - distpb(i, 3) = distpb(i, 3) + peff2*distpb(i, 4) + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp132b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp132b + fun0b = fun0b + rmu(i, 0)*temp132b + ELSE + temp132b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp132b0 + fun0b = fun0b + rmu(i, 0)*temp132b0 + END IF + ELSE IF (branch .LT. 4) THEN + temp132b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp132b1 + fun0b = fun0b + rmu(i, 0)*temp132b1 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp132b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp132b2 + fun0b = fun0b + rmu(i, 0)*temp132b2 + ELSE + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + temp131 = fun/r(0) + temp131b78 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp131*rmu(i, 0)*zb(& +& indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp131*distp(0, 3+ic)*zb(indorbp, & +& indt+i) + funb0 = funb0 + temp131b78 + rb(0) = rb(0) - temp131*temp131b78 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + temp131b76 = -(dd1*distp(0, 1)*fun2b) + temp131b77 = -((dd1*r(0)-2.d0)*fun2b) + dd1b = distp(0, 1)*r(0)*funb0 + distp(0, 1)*temp131b77 + r(0)*& +& temp131b76 + rb(0) = rb(0) + distp(0, 1)*dd1*funb0 + dd1*temp131b76 + distpb(0, 1) = distpb(0, 1) + dd1*temp131b77 - (1.d0-dd1*r(0))*& +& funb0 + distpb(0, 3) = distpb(0, 3) - fun0b + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + END IF + DO ic=5,1,-1 + DO i=indtm,i0,-1 + distpb(i, 3+ic) = distpb(i, 3+ic) - distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) - distp(i, 3+ic)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO i=indtm,indtmin,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + distpb(i, 8) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) distpb(i, 4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distpb(i, 1) = distpb(i, 1) + r(i)*distpb(i, 3) + rb(i) = rb(i) + distp(i, 1)*distpb(i, 3) + distpb(i, 3) = 0.0_8 END DO - cb = 0.0_8 DO k=indtm,indtmin,-1 - temp202b = c*DEXP(-(dd3*r(k)))*distpb(k, 3) - cb = cb + DEXP(-(dd3*r(k)))*distpb(k, 3) - dd3b = dd3b - r(k)*temp202b - distpb(k, 3) = 0.0_8 - temp202b0 = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - distpb(k, 2) = 0.0_8 - temp202b1 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd2*temp202b0 - dd1*temp202b1 - dd3*temp202b - dd2b = dd2b - r(k)*temp202b0 - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp202b1 + temp131b75 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp131b75 + rb(k) = rb(k) - dd1*temp131b75 distpb(k, 1) = 0.0_8 END DO - temp201 = (dd2+dd3)**5 - temp188 = peff2*peff/temp201 - temp200 = 2.d0**5 - temp199 = temp200*dd3**5 - temp198 = peff2**2/temp199 - temp197 = (dd1+dd3)**5 - temp196 = 2.d0**5 - temp195 = temp196*dd2**5 - temp194 = peff**2/temp195 - temp193 = (dd1+dd2)**5 - temp192 = 2.d0**5 - temp191 = temp192*dd1**5 - temp190 = 8.d0*pi*(1.0/temp191+2.d0*peff/temp193+temp194+2.d0*peff2/& -& temp197+temp198+2.d0*temp188) - temp189 = DSQRT(temp190) - IF (temp190 .EQ. 0.0) THEN - temp189b = 0.0 - ELSE - temp189b = -(pi*8.d0*cb/(2.d0*temp189**2*2.D0*DSQRT(temp190))) - END IF - temp189b0 = 2.d0*temp189b/temp193 - temp189b1 = -(peff*5*(dd1+dd2)**4*temp189b0/temp193) - temp189b2 = 2.d0*temp189b/temp197 - temp189b3 = -(peff2*5*(dd1+dd3)**4*temp189b2/temp197) - temp188b0 = 2.d0*temp189b/temp201 - temp188b1 = -(temp188*5*(dd2+dd3)**4*temp188b0) - dd1b = dd1b + temp189b3 + temp189b1 - temp192*5*dd1**4*temp189b/& -& temp191**2 - peffb = peffb + peff2*temp188b0 + 2*peff*temp189b/temp195 + & -& temp189b0 - dd2b = dd2b + temp188b1 - temp194*temp196*5*dd2**4*temp189b/temp195 & -& + temp189b1 - peff2b = peff2b + peff*temp188b0 + 2*peff2*temp189b/temp199 + & -& temp189b2 - dd3b = dd3b + temp188b1 - temp198*temp200*5*dd3**4*temp189b/temp199 & -& + temp189b3 - ddb(indpar+5) = ddb(indpar+5) + peff2b - ddb(indpar+4) = ddb(indpar+4) + dd3b - ddb(indpar+3) = ddb(indpar+3) + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (27) -! 3p triple zeta -! 2p without cusp condition + CASE (33) +! 4d without cusp and one parmater dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) - dd3 = dd(indpar+4) - peff2 = dd(indpar+5) -! if(iflagnorm.gt.2) then - c = 1.d0/2.d0/DSQRT(240.d0*pi*(1.d0/(2.d0*dd1)**7+2.d0*peff/(dd1+dd2& -& )**7+peff**2/(2.d0*dd2)**7+2.d0*peff2/(dd1+dd3)**7+peff2**2/(2.d0*& -& dd3)**7+2.d0*peff2*peff/(dd2+dd3)**7)) -! endif +! if(iflagnorm.gt.2) then +! c= +! &1/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) +! c= & +! &1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) + c = dd1**4.5d0*0.0710812062076410d0 +! endif DO k=indtmin,indtm distp(k, 1) = c*DEXP(-(dd1*r(k))) - distp(k, 2) = c*DEXP(-(dd2*r(k))) - distp(k, 3) = c*DEXP(-(dd3*r(k))) END DO DO i=indtmin,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = distp(i, 1)*r(i) CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) - distp(i, 4) = r(i)*(distp(i, 1)+peff*distp(i, 2)+peff2*distp(i, 3)& -& ) +! lz=0 + distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) +! lz=+/ + distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) +! lz=+/-2 + distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) +! lz=+/-1 + distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) +! lz=+/-1 + distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d END DO -! indorbp=indorb - DO ic=1,3 +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = (1.d0-dd1*r(0))*distp(0, 1) + peff*(1.d0-dd2*r(0))*distp(0, & -& 2) + peff2*(1.d0-dd3*r(0))*distp(0, 3) - fun2 = dd1*(dd1*r(0)-2.d0)*distp(0, 1) + peff*dd2*(dd2*r(0)-2.d0)*& -& distp(0, 2) + peff2*dd3*(dd3*r(0)-2.d0)*distp(0, 3) -! indorbp=indorb - DO ic=1,3 + fun0 = distp(0, 3) + fun = -(dd1*distp(0, 3)) + distp(0, 1) + fun2 = dd1**2*distp(0, 3) - 2.d0*dd1*distp(0, 1) +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + IF (ic .EQ. 1) THEN + IF (i .NE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO END DO - funb = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=3,1,-1 - temp217 = fun/r(0) - temp218b = rmu(ic, 0)*zb(indorbp, indt+4) - temp217b = 4.d0*temp218b/r(0) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp217+fun2)*zb(indorbp, indt& -& +4) - funb = funb + temp217b - rb(0) = rb(0) - temp217*temp217b - fun2b = fun2b + temp218b + DO ic=5,1,-1 + temp134 = fun/r(0) + temp135b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp134b3 = 6.d0*temp135b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp134+fun2)*zb(& +& indorbp, indt+4) + funb0 = funb0 + temp134b3 + rb(0) = rb(0) - temp134*temp134b3 + fun2b = fun2b + temp135b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp216 = fun/r(0) - temp216b13 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(ic, 0) = rmub(ic, 0) + temp216*rmu(i, 0)*zb(indorbp, indt& -& +i) - rmub(i, 0) = rmub(i, 0) + temp216*rmu(ic, 0)*zb(indorbp, indt+& -& i) - funb = funb + temp216b13 - rb(0) = rb(0) - temp216*temp216b13 + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp134b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp134b + fun0b = fun0b + rmu(i, 0)*temp134b + ELSE + temp134b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp134b0 + fun0b = fun0b + rmu(i, 0)*temp134b0 + END IF + ELSE IF (branch .LT. 4) THEN + temp134b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp134b1 + fun0b = fun0b + rmu(i, 0)*temp134b1 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp134b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp134b2 + fun0b = fun0b + rmu(i, 0)*temp134b2 + ELSE + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + temp133 = fun/r(0) + temp133b1 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp133*rmu(i, 0)*zb(& +& indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp133*distp(0, 3+ic)*zb(indorbp, & +& indt+i) + funb0 = funb0 + temp133b1 + rb(0) = rb(0) - temp133*temp133b1 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp216b3 = dd1*distp(0, 1)*fun2b - temp216b4 = (dd1*r(0)-2.d0)*fun2b - temp216b5 = (dd2*r(0)-2.d0)*fun2b - temp216b6 = peff*dd2*distp(0, 2)*fun2b - temp216b7 = (dd3*r(0)-2.d0)*fun2b - temp216b8 = peff2*dd3*distp(0, 3)*fun2b - dd1b = distp(0, 1)*temp216b4 - distp(0, 1)*r(0)*funb + r(0)*& -& temp216b3 - temp216b9 = peff*distp(0, 2)*funb - temp216b10 = peff2*distp(0, 3)*funb - rb(0) = rb(0) + dd3*temp216b8 - dd2*temp216b9 - dd3*temp216b10 - & -& distp(0, 1)*dd1*funb + dd2*temp216b6 + dd1*temp216b3 - distpb(0, 1) = dd1*temp216b4 - temp216b11 = (1.d0-dd2*r(0))*funb - peffb = distp(0, 2)*temp216b11 + distp(0, 2)*dd2*temp216b5 - dd2b = r(0)*temp216b6 - r(0)*temp216b9 + distp(0, 2)*peff*& -& temp216b5 - distpb(0, 2) = peff*dd2*temp216b5 - temp216b12 = (1.d0-dd3*r(0))*funb - peff2b = distp(0, 3)*temp216b12 + distp(0, 3)*dd3*temp216b7 - dd3b = r(0)*temp216b8 - r(0)*temp216b10 + distp(0, 3)*peff2*& -& temp216b7 - distpb(0, 3) = peff2*dd3*temp216b7 - distpb(0, 1) = distpb(0, 1) + (1.d0-dd1*r(0))*funb - distpb(0, 2) = distpb(0, 2) + peff*temp216b11 - distpb(0, 3) = distpb(0, 3) + peff2*temp216b12 - distpb(0, 4) = distpb(0, 4) + fun0b + dd1b = (distp(0, 3)*2*dd1-2.d0*distp(0, 1))*fun2b - distp(0, 3)*& +& funb0 + distpb(0, 3) = distpb(0, 3) + dd1**2*fun2b + distpb(0, 1) = distpb(0, 1) + funb0 - 2.d0*dd1*fun2b + distpb(0, 3) = distpb(0, 3) + fun0b - dd1*funb0 ELSE distpb = 0.0_8 - peffb = 0.0_8 dd1b = 0.0_8 - dd2b = 0.0_8 - dd3b = 0.0_8 - peff2b = 0.0_8 END IF - DO ic=3,1,-1 + DO ic=5,1,-1 DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 4)*zb(indorbp, i) - distpb(i, 4) = distpb(i, 4) + rmu(ic, i)*zb(indorbp, i) + distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + distpb(i, 8) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - temp216b2 = r(i)*distpb(i, 4) - rb(i) = rb(i) + (distp(i, 1)+peff*distp(i, 2)+peff2*distp(i, 3))*& -& distpb(i, 4) - distpb(i, 1) = distpb(i, 1) + temp216b2 - peffb = peffb + distp(i, 2)*temp216b2 - distpb(i, 2) = distpb(i, 2) + peff*temp216b2 - peff2b = peff2b + distp(i, 3)*temp216b2 - distpb(i, 3) = distpb(i, 3) + peff2*temp216b2 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) distpb(i, 4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distpb(i, 1) = distpb(i, 1) + r(i)*distpb(i, 3) + rb(i) = rb(i) + distp(i, 1)*distpb(i, 3) + distpb(i, 3) = 0.0_8 END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - temp216b = c*DEXP(-(dd3*r(k)))*distpb(k, 3) - cb = cb + DEXP(-(dd3*r(k)))*distpb(k, 3) - dd3b = dd3b - r(k)*temp216b - distpb(k, 3) = 0.0_8 - temp216b0 = c*DEXP(-(dd2*r(k)))*distpb(k, 2) - cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) - distpb(k, 2) = 0.0_8 - temp216b1 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd2*temp216b0 - dd1*temp216b1 - dd3*temp216b - dd2b = dd2b - r(k)*temp216b0 + temp133b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp216b1 + dd1b = dd1b - r(k)*temp133b0 + rb(k) = rb(k) - dd1*temp133b0 distpb(k, 1) = 0.0_8 END DO - temp215 = (dd2+dd3)**7 - temp202 = peff2*peff/temp215 - temp214 = 2.d0**7 - temp213 = temp214*dd3**7 - temp212 = peff2**2/temp213 - temp211 = (dd1+dd3)**7 - temp210 = 2.d0**7 - temp209 = temp210*dd2**7 - temp208 = peff**2/temp209 - temp207 = (dd1+dd2)**7 - temp206 = 2.d0**7 - temp205 = temp206*dd1**7 - temp204 = 240.d0*pi*(1.0/temp205+2.d0*peff/temp207+temp208+2.d0*& -& peff2/temp211+temp212+2.d0*temp202) - temp203 = DSQRT(temp204) - IF (temp204 .EQ. 0.0) THEN - temp203b = 0.0 - ELSE - temp203b = -(pi*240.d0*cb/(2.d0*temp203**2*2.D0*DSQRT(temp204))) - END IF - temp203b0 = 2.d0*temp203b/temp207 - temp203b1 = -(peff*7*(dd1+dd2)**6*temp203b0/temp207) - temp203b2 = 2.d0*temp203b/temp211 - temp203b3 = -(peff2*7*(dd1+dd3)**6*temp203b2/temp211) - temp202b7 = 2.d0*temp203b/temp215 - temp202b8 = -(temp202*7*(dd2+dd3)**6*temp202b7) - dd1b = dd1b + temp203b3 + temp203b1 - temp206*7*dd1**6*temp203b/& -& temp205**2 - peffb = peffb + peff2*temp202b7 + 2*peff*temp203b/temp209 + & -& temp203b0 - dd2b = dd2b + temp202b8 - temp208*temp210*7*dd2**6*temp203b/temp209 & -& + temp203b1 - peff2b = peff2b + peff*temp202b7 + 2*peff2*temp203b/temp213 + & -& temp203b2 - dd3b = dd3b + temp202b8 - temp212*temp214*7*dd3**6*temp203b/temp213 & -& + temp203b3 - ddb(indpar+5) = ddb(indpar+5) + peff2b - ddb(indpar+4) = ddb(indpar+4) + dd3b - ddb(indpar+3) = ddb(indpar+3) + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b + dd1b = dd1b + 0.0710812062076410d0*4.5d0*dd1**3.5D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (28) -! R(r)=(Z*b*r)^4/(1+(Z*b*r)^4)*exp(-z*r) orbital 1s (no cusp) -! d -> b1s (defined in module constants) -! normadization: cost1s, depends on b1s -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! if(dd1.gt.0.) then - c = cost1s*dd1**1.5d0 -! else -! c=1.d0 -! endif -! endif + CASE (154) +! 2s single Z WITH CUSP zero +! Jastrow single gaussian f orbital +! R(r)= exp(-alpha r^2) +! unnormalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) + DO k=indtmin,indtm + distp(k, 1) = DEXP(-(dd1*r(k)**2)) + END DO DO i=indtmin,indtm - distp(i, 1) = c*DEXP(-(dd1*r(i))) + distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) +! lz=0 + distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) +! lz=+/-2 + distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) +! lz=+/-2 + distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) +! lz=+/-3 + distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) END DO - DO i=i0,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) - rp4 = (dd1*b1s*r(i))**4 +! lz=+/-3 + DO ic=1,7 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic END DO +! endif IF (typec .NE. 1) THEN - rp1 = dd1*b1s*r(0) - rp2 = rp1**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) - rp4 = rp2**2 - rp5 = r(0)*dd1 - rp6 = (b1s*dd1)**2*rp2 -! the first derivative /r - fun = -(distp(0, 1)*rp6*(-4.d0+rp5+rp4*rp5)/(1.d0+rp4)**2) -! the second derivative derivative - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 +! dd1=dd(indparp) + fun0 = distp(0, 1) + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) +! indorbp=indorb + DO ic=1,7 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + IF (ic .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + ELSE IF (ic .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (ic .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE IF (ic .EQ. 4) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (ic .EQ. 5) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + ELSE IF (ic .EQ. 6) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + END IF END DO distpb = 0.0_8 - temp222 = (rp4+1.d0)**3 - temp221 = distp(0, 1)*rp6/temp222 - temp222b = temp221*fun2b - temp222b0 = 2*rp4*rp5*temp222b - temp221b = (rp5**2-8*rp5-20*rp4+2*(rp4*rp5**2)-8*(rp4*rp5)+(rp4*& -& rp5)**2+12.d0)*fun2b/temp222 - temp220 = (rp4+1.d0)**2 - temp219 = distp(0, 1)*rp6/temp220 - temp219b = -(temp219*funb) - rp5b = (rp4+1.0_8)*temp219b + rp4*temp222b0 + (2**2*rp4*rp5-8*rp4+& -& 2*rp5-8)*temp222b - temp219b0 = -((rp5+rp4*rp5-4.d0)*funb/temp220) - rp4b = rp5*temp219b - temp219*2*(rp4+1.d0)*temp219b0 - temp221*3*(& -& rp4+1.d0)**2*temp221b + rp5*temp222b0 + (2*rp5**2-8*rp5-20)*& -& temp222b - distpb(0, 1) = rp6*temp219b0 + rp6*temp221b - rp6b = distp(0, 1)*temp219b0 + distp(0, 1)*temp221b - temp219b1 = b1s**2*rp6b - rp2b = 2*rp2*rp4b + dd1**2*temp219b1 - rp1b = 2*rp1*rp2b - dd1b = r(0)*rp5b + b1s*r(0)*rp1b + rp2*2*dd1*temp219b1 - rb(0) = rb(0) + b1s*dd1*rp1b + dd1*rp5b - CALL POPREAL8(adr8ibuf,adr8buf,rp4) + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=7,1,-1 + temp135b30 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 8.d0*temp135b30 + fun2b = fun2b + temp135b30 + zb(indorbp, indt+4) = 0.0_8 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 4) THEN + IF (branch .LT. 2) THEN + IF (branch .LT. 1) THEN + temp135b11 = cost1f*zb(indorbp, indt+3) + temp135b12 = -(cost1f*6.d0*zb(indorbp, indt+2)) + temp135b13 = -(cost1f*6.d0*zb(indorbp, indt+1)) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp135b12 + rmu(3, 0)& +& *rmu(1, 0)*temp135b13 + (9.d0*rmu(3, 0)**2-3.d0*r(0)**2)& +& *temp135b11 + rmub(3, 0) = rmub(3, 0) + fun0*9.d0*2*rmu(3, 0)*temp135b11 + rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp135b11 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp135b12 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp135b12 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp135b13 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp135b13 + ELSE + temp135b14 = cost2f*8.d0*zb(indorbp, indt+3) + temp135b15 = -(cost2f*2.d0*zb(indorbp, indt+2)) + fun0b = fun0b + rmu(1, 0)*rmu(2, 0)*temp135b15 + cost2f*(& +& 5.d0*rmu(3, 0)**2-r(0)**2-2.d0*rmu(1, 0)**2)*zb(indorbp& +& , indt+1) + rmu(1, 0)*rmu(3, 0)*temp135b14 + rmub(3, 0) = rmub(3, 0) + rmu(1, 0)*fun0*temp135b14 + rmub(1, 0) = rmub(1, 0) + fun0*rmu(3, 0)*temp135b14 + rmub(2, 0) = rmub(2, 0) + rmu(1, 0)*fun0*temp135b15 + rmub(1, 0) = rmub(1, 0) + fun0*rmu(2, 0)*temp135b15 + temp135b16 = cost2f*fun0*zb(indorbp, indt+1) + rmub(3, 0) = rmub(3, 0) + 5.d0*2*rmu(3, 0)*temp135b16 + rb(0) = rb(0) - 2*r(0)*temp135b16 + rmub(1, 0) = rmub(1, 0) - 2.d0*2*rmu(1, 0)*temp135b16 + END IF + ELSE IF (branch .LT. 3) THEN + temp135b17 = cost2f*8.d0*zb(indorbp, indt+3) + temp135b18 = -(cost2f*2.d0*zb(indorbp, indt+1)) + fun0b = fun0b + cost2f*(5.d0*rmu(3, 0)**2-r(0)**2-2.d0*rmu(2& +& , 0)**2)*zb(indorbp, indt+2) + rmu(2, 0)*rmu(1, 0)*& +& temp135b18 + rmu(2, 0)*rmu(3, 0)*temp135b17 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*fun0*temp135b17 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(3, 0)*temp135b17 + temp135b19 = cost2f*fun0*zb(indorbp, indt+2) + rmub(3, 0) = rmub(3, 0) + 5.d0*2*rmu(3, 0)*temp135b19 + rb(0) = rb(0) - 2*r(0)*temp135b19 + rmub(2, 0) = rmub(2, 0) - 2.d0*2*rmu(2, 0)*temp135b19 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp135b18 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp135b18 + ELSE + temp135b20 = cost3f*zb(indorbp, indt+3) + temp135b21 = -(cost3f*2.d0*zb(indorbp, indt+2)) + temp135b22 = cost3f*2.d0*zb(indorbp, indt+1) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp135b21 + rmu(3, 0)*& +& rmu(1, 0)*temp135b22 + (rmu(1, 0)**2-rmu(2, 0)**2)*& +& temp135b20 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp135b20 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp135b21 - fun0*2& +& *rmu(2, 0)*temp135b20 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp135b21 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp135b22 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp135b22 + END IF + ELSE IF (branch .LT. 6) THEN + IF (branch .LT. 5) THEN + temp135b23 = cost3f*2.d0*zb(indorbp, indt+3) + temp135b24 = cost3f*2.d0*zb(indorbp, indt+2) + temp135b25 = cost3f*2.d0*zb(indorbp, indt+1) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp135b24 + rmu(3, 0)*& +& rmu(2, 0)*temp135b25 + rmu(2, 0)*rmu(1, 0)*temp135b23 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp135b23 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp135b23 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp135b24 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp135b24 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp135b25 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp135b25 + ELSE + temp135b26 = -(cost4f*6.d0*zb(indorbp, indt+2)) + temp135b27 = cost4f*3.d0*zb(indorbp, indt+1) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp135b27 + rmu& +& (2, 0)*rmu(1, 0)*temp135b26 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp135b26 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp135b26 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp135b27 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp135b27 + END IF + ELSE + temp135b28 = cost4f*3.d0*zb(indorbp, indt+2) + temp135b29 = cost4f*6.d0*zb(indorbp, indt+1) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp135b29 + (rmu(1, 0)**2& +& -rmu(2, 0)**2)*temp135b28 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp135b28 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp135b28 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp135b29 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp135b29 + END IF + DO i=3,1,-1 + temp135b10 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp135b10 + funb0 = funb0 + rmu(i, 0)*temp135b10 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + temp135b9 = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp135b9 - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp135b9 + distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb0 ELSE distpb = 0.0_8 dd1b = 0.0_8 END IF - DO i=indtm,i0,-1 - temp218 = rp4/(rp4+1.d0) - temp218b1 = distp(i, 1)*zb(indorbp, i)/(rp4+1.d0) - distpb(i, 1) = distpb(i, 1) + temp218*zb(indorbp, i) - rp4b = (1.0_8-temp218)*temp218b1 - zb(indorbp, i) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,rp4) - temp218b2 = 4*b1s**4*dd1**3*r(i)**3*rp4b - dd1b = dd1b + r(i)*temp218b2 - rb(i) = rb(i) + dd1*temp218b2 + DO ic=7,1,-1 + DO k=indtm,i0,-1 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - cb = 0.0_8 DO i=indtm,indtmin,-1 - temp218b0 = c*DEXP(-(dd1*r(i)))*distpb(i, 1) - cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) - dd1b = dd1b - r(i)*temp218b0 - rb(i) = rb(i) - dd1*temp218b0 - distpb(i, 1) = 0.0_8 + temp135b1 = cost4f*rmu(2, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 8) - 2*rmu(2, i)*temp135b1 + distpb(i, 8) = 0.0_8 + temp135b2 = cost4f*rmu(1, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& +& distpb(i, 7) + 2*rmu(1, i)*temp135b2 + 3.d0*2*rmu(1, i)*& +& temp135b1 + rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp135b2 + distpb(i, 7) = 0.0_8 + temp135b3 = cost3f*2.d0*distpb(i, 6) + temp135b4 = rmu(2, i)*temp135b3 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp135b4 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp135b4 + rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp135b3 + distpb(i, 6) = 0.0_8 + temp135b5 = cost3f*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 5) + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp135b5 + distpb(i, 5) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 4) - 2*rmu(2, i)*temp135b5 + temp135b6 = cost2f*rmu(2, i)*distpb(i, 4) + rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp135b6 + distpb(i, 4) = 0.0_8 + temp135b7 = cost2f*rmu(1, i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 3) + distpb(i, 3) = 0.0_8 + temp135b8 = cost1f*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - 2*r(i)*temp135b7 - 3.d0*2*r(i)*temp135b8 - 2*r(i)*& +& temp135b6 + rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& +& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp135b8 + 5.d0*2*rmu(3, i)*& +& temp135b7 + distpb(i, 2) = 0.0_8 END DO - dd1b = dd1b + cost1s*1.5d0*dd1**0.5D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (29) -! derivative of (28) -! if(iocc(indshellp).eq.1) then + DO k=indtm,indtmin,-1 + temp135b0 = DEXP(-(dd1*r(k)**2))*distpb(k, 1) + dd1b = dd1b - r(k)**2*temp135b0 + rb(k) = rb(k) - dd1*2*r(k)*temp135b0 + distpb(k, 1) = 0.0_8 + END DO + ddb(indparp) = ddb(indparp) + dd1b + CASE (34) +! normalized +! exp(-dd1*r) + dd1*r*exp(-dd1*r) +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! if(dd1.gt.0.) then - c = cost1s*dd1**1.5d0 -! else -! c=1.d0 -! endif -! endif -! if(dd1.gt.0.) then - c1 = 1.5d0/dd1 -! else -! c1=0.d0 -! endif +! peff=dd1 +! if(iflagnorm.gt.2) then +! c=1.d0/dsqrt(1.d0/4.d0/dd1**3+12.d0*dd1/(2.d0*dd1)**4+& +! &3.d0*dd1**2/4.d0/dd1**5)/dsqrt(4.d0*pi) +! c=dd1*dsqrt(dd1)/dsqrt(7.d0*pi) + c = dd1*DSQRT(dd1)*.2132436186229231d0 +! endif DO i=indtmin,indtm distp(i, 1) = c*DEXP(-(dd1*r(i))) END DO - DO i=i0,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) -! rp1=(b1s*r(i))**4*dd1**3 -! rp4=rp1*dd1 -! rp5=dd1*r(i) -! z(indorbp,i)=distp(i,1)*& -! &(c1*rp4/(1+rp4)-rp1*(-4+rp5+rp4*rp5)/(1+rp4)**2) - rp4 = (b1s*dd1*r(i))**4 - CALL PUSHREAL8(adr8ibuf,adr8buf,rp5) - rp5 = dd1*r(i) - END DO IF (typec .NE. 1) THEN - rp1 = dd1*b1s*r(0) - rp2 = rp1**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) - rp4 = rp2**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,rp5) - rp5 = rp4*rp1 - rp8 = rp4*rp4 - fun = distp(0, 1)*(dd1*rp2*(4*b1s**2*(11-5*rp4)+2*(rp1+rp5)**2-b1s& -& *rp1*(21+26*rp4+5*rp8)))/(2.*(1+rp4)**3) - funb = 2.d0*zb(indorbp, indt+4) + fun = -(dd1**2*distp(0, 1)) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO + funb0 = funb0 + (1.d0-dd1*r(0))*fun2b + dd1b = -(distp(0, 1)*2*dd1*funb0) - fun*r(0)*fun2b + rb(0) = rb(0) - fun*dd1*fun2b distpb = 0.0_8 - temp236 = 2.*b1s*(rp4+1)**4 - temp235 = distp(0, 1)*dd1*rp2 - temp232 = temp235/temp236 - temp235b = temp232*fun2b - temp235b0 = b1s*(7*rp4+31)*2*(rp1+rp5)*temp235b - temp235b1 = -(2*3*(rp1+rp5)**2*temp235b) - temp234 = 64*b1s**2 - temp234b = temp234*temp235b - temp233 = 4*b1s**3 - temp232b = (b1s*((7*rp4+31)*(rp1+rp5)**2)-2*(rp1+rp5)**3+temp234*(& -& rp1*(rp8-rp4-2))+temp233*(25*rp8-134*rp4+33))*fun2b/temp236 - temp231 = 2.*(rp4+1)**3 - temp230 = distp(0, 1)*dd1*rp2 - temp227 = temp230/temp231 - temp230b = temp227*funb - temp229b = 2**2*(rp1+rp5)*temp230b - rp5b = temp229b + temp235b1 + temp235b0 - temp228b = -(b1s*temp230b) - rp8b = rp1*5*temp228b + temp233*25*temp235b + rp1*temp234b - temp229 = 4*b1s**2 - temp228 = 26*rp4 + 5*rp8 + 21 - temp227b0 = (temp229*(11-5*rp4)+2*(rp1+rp5)**2-b1s*(rp1*temp228))*& -& funb/temp231 - rp4b = rp1*26*temp228b - temp229*5*temp230b - temp227*2.*3*(rp4+1)& -& **2*temp227b0 + rp1*rp5b + 2*rp4*rp8b - temp232*2.*b1s*4*(rp4+1)& -& **3*temp232b - rp1*temp234b + (7*(b1s*(rp1+rp5)**2)-134*temp233)& -& *temp235b - rp2b = distp(0, 1)*dd1*temp227b0 + 2*rp2*rp4b + distp(0, 1)*dd1*& -& temp232b - rp1b = temp229b + temp228*temp228b + 2*rp1*rp2b + rp4*rp5b + (rp8-& -& rp4-2)*temp234b + temp235b1 + temp235b0 - distpb(0, 1) = dd1*rp2*temp227b0 + dd1*rp2*temp232b - dd1b = distp(0, 1)*rp2*temp227b0 + b1s*r(0)*rp1b + distp(0, 1)*rp2& -& *temp232b - CALL POPREAL8(adr8ibuf,adr8buf,rp5) - CALL POPREAL8(adr8ibuf,adr8buf,rp4) - rb(0) = rb(0) + b1s*dd1*rp1b + distpb(0, 1) = -(dd1**2*funb0) ELSE distpb = 0.0_8 dd1b = 0.0_8 END IF - c1b = 0.0_8 DO i=indtm,i0,-1 - temp223 = rp4/(rp4+1) - temp227b = distp(i, 1)*temp223*zb(indorbp, i) - temp224 = dd1*(rp4+1) - temp225b = -(temp227b/temp224) - temp226 = rp5 + rp4*rp5 - 4 - temp225 = temp226/temp224 - temp224b = -(temp225*temp225b) - temp223b0 = (c1-temp225)*distp(i, 1)*zb(indorbp, i)/(rp4+1) - c1b = c1b + temp227b - rp5b = (rp4+1.0_8)*temp225b - rp4b = (1.0_8-temp223)*temp223b0 + dd1*temp224b + rp5*temp225b - temp223b1 = 4*b1s**4*dd1**3*r(i)**3*rp4b - dd1b = dd1b + r(i)*rp5b + r(i)*temp223b1 + (rp4+1)*temp224b - distpb(i, 1) = distpb(i, 1) + (c1-temp225)*temp223*zb(indorbp, i) + temp136b0 = distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + (r(i)*dd1+1.d0)*zb(indorbp, i) + rb(i) = rb(i) + dd1*temp136b0 + dd1b = dd1b + r(i)*temp136b0 zb(indorbp, i) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,rp5) - rb(i) = rb(i) + dd1*temp223b1 + dd1*rp5b - CALL POPREAL8(adr8ibuf,adr8buf,rp4) END DO cb = 0.0_8 DO i=indtm,indtmin,-1 - temp223b = c*DEXP(-(dd1*r(i)))*distpb(i, 1) + temp136b = c*DEXP(-(dd1*r(i)))*distpb(i, 1) cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) - dd1b = dd1b - r(i)*temp223b - rb(i) = rb(i) - dd1*temp223b + dd1b = dd1b - r(i)*temp136b + rb(i) = rb(i) - dd1*temp136b distpb(i, 1) = 0.0_8 END DO - dd1b = dd1b + cost1s*1.5d0*dd1**0.5D0*cb - 1.5d0*c1b/dd1**2 + temp135 = DSQRT(dd1) + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + .2132436186229231d0*temp135*cb + ELSE + dd1b = dd1b + (.2132436186229231d0*dd1/(2.D0*DSQRT(dd1))+& +& .2132436186229231d0*temp135)*cb + END IF ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (57) -! orbital 1s (no cusp) - STO regolarized for r->0 -! R(r)= C(z) * P(z*r) * exp(-z*r) -! P(x) = (x+a)^n/(1+(x+a)^n) with a so that P(0)==dP(0)/dx -! C(z) = const * z^(3/2) normalization -! the following definitions are in module constants -! n -> costSTO1s_n = 4 -! a -> costSTO1s_a = 1.2263393530877080588 -! const(n) -> costSTO1s_c = 0.58542132302621750732 -! -! -! if(iocc(indshellp).eq.1) then + CASE (18) +! 2s single Z WITH CUSP +! R(r)=r**4*exp(-z*r**2) single zeta +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! if(dd1.gt.0.) then - c = coststo1s_c*dd1**1.5d0 -! else -! c=1.d0 -! endif -! endif - DO i=indtmin,indtm - distp(i, 1) = c*DEXP(-(dd1*r(i))) - END DO - DO i=i0,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) - rp4 = (dd1*r(i)+coststo1s_a)**coststo1s_n +! if(iflagnorm.gt.2) then +! c=(2.d0*dd1**11/pi)**(1.d0/4.d0)*(512.d0/945.d0/pi) + c = dd1**2.75d0*0.1540487967684377d0 +! endif + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO IF (typec .NE. 1) THEN - rp1 = dd1*r(0) + coststo1s_a - rp2 = rp1**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) - rp4 = rp1**coststo1s_n -! the first derivative /r -!fun=-z(indorbp,0)*((dd1**2*(-costSTO1s_n+rp1+rp1*rp4))/& -! &(rp1*(-costSTO1s_a+rp1)*(1.d0+rp4))) - fun = -(distp(0, 1)*rp4*(dd1**2*(-coststo1s_n+rp1+rp1*rp4)/(rp1*(-& -& coststo1s_a+rp1)*(1.d0+rp4)**2))) -! the second derivative derivative - funb = 2.d0*zb(indorbp, indt+4) + rp1 = r(0)**2 +! the first derivative + fun = distp(0, 1)*rp1*(4.d0-2.d0*dd1*rp1) +! the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp245 = (rp4+1.d0)**3 - temp242 = rp2*temp245 - temp243b = (rp2*(rp4+1.d0)**2-coststo1s_n*((2.d0*rp1+1.d0)*(rp4+& -& 1.d0))-coststo1s_n**2*(rp4-1.d0))*fun2b/temp242 - temp245b = dd1**2*temp243b - temp244 = distp(0, 1)*rp4*dd1**2 - temp243 = temp244/temp242 - temp242b = -(temp243*temp243b) - temp242b0 = temp243*fun2b - temp241 = (rp4+1.d0)**2 - temp238 = rp1*(rp1-coststo1s_a)*temp241 - temp241b = -(funb/temp238) - temp239 = rp1 - coststo1s_n + rp1*rp4 - temp240b = temp239*temp241b - temp241b0 = dd1**2*temp240b - distpb(0, 1) = rp4*temp241b0 + rp4*temp245b - temp240 = distp(0, 1)*rp4*dd1**2 - temp239b = temp240*temp241b - temp238b = -(temp240*temp239*temp241b/temp238) - rp4b = distp(0, 1)*temp241b0 + rp1*temp239b + rp1*(rp1-coststo1s_a& -& )*2*(rp4+1.d0)*temp238b + (rp2*2*(rp4+1.d0)-coststo1s_n*(2.d0*& -& rp1+1.d0)-coststo1s_n**2)*temp242b0 + rp2*3*(rp4+1.d0)**2*& -& temp242b + distp(0, 1)*temp245b - rp2b = (rp4+1.d0)**2*temp242b0 + temp245*temp242b - IF (rp1 .LE. 0.0 .AND. (coststo1s_n .EQ. 0.0 .OR. coststo1s_n .NE.& -& INT(coststo1s_n))) THEN - rp1b = (rp4+1.0_8)*temp239b + (temp241*rp1+temp241*(rp1-& -& coststo1s_a))*temp238b + 2*rp1*rp2b - coststo1s_n*(rp4+1.d0)*& -& 2.d0*temp242b0 - ELSE - rp1b = (rp4+1.0_8)*temp239b + (temp241*rp1+temp241*(rp1-& -& coststo1s_a))*temp238b + 2*rp1*rp2b + coststo1s_n*rp1**(& -& coststo1s_n-1)*rp4b - coststo1s_n*(rp4+1.d0)*2.d0*temp242b0 - END IF - dd1b = distp(0, 1)*rp4*2*dd1*temp240b + r(0)*rp1b + distp(0, 1)*& -& rp4*2*dd1*temp243b - CALL POPREAL8(adr8ibuf,adr8buf,rp4) - rb(0) = rb(0) + dd1*rp1b + temp137b = (4.d0*(dd1**2*rp1**2)-18.d0*(dd1*rp1)+12.d0)*fun2b + temp137b0 = distp(0, 1)*rp1*fun2b + temp137b1 = (4.d0-2.d0*(dd1*rp1))*funb0 + distpb(0, 1) = rp1*temp137b1 + rp1*temp137b + temp137b2 = -(distp(0, 1)*rp1*2.d0*funb0) + rp1b = distp(0, 1)*temp137b1 + dd1*temp137b2 + (4.d0*dd1**2*2*rp1-& +& 18.d0*dd1)*temp137b0 + distp(0, 1)*temp137b + dd1b = rp1*temp137b2 + (4.d0*rp1**2*2*dd1-18.d0*rp1)*temp137b0 + rb(0) = rb(0) + 2*r(0)*rp1b ELSE distpb = 0.0_8 dd1b = 0.0_8 END IF DO i=indtm,i0,-1 - temp237 = rp4/(rp4+1.d0) - temp237b0 = distp(i, 1)*zb(indorbp, i)/(rp4+1.d0) - distpb(i, 1) = distpb(i, 1) + temp237*zb(indorbp, i) - rp4b = (1.0_8-temp237)*temp237b0 + rb(i) = rb(i) + distp(i, 1)*4*r(i)**3*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + r(i)**4*zb(indorbp, i) zb(indorbp, i) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,rp4) - IF (coststo1s_a + dd1*r(i) .LE. 0.0 .AND. (coststo1s_n .EQ. 0.0 & -& .OR. coststo1s_n .NE. INT(coststo1s_n))) THEN - temp237b1 = 0.0 - ELSE - temp237b1 = coststo1s_n*(coststo1s_a+dd1*r(i))**(coststo1s_n-1)*& -& rp4b - END IF - dd1b = dd1b + r(i)*temp237b1 - rb(i) = rb(i) + dd1*temp237b1 END DO cb = 0.0_8 - DO i=indtm,indtmin,-1 - temp237b = c*DEXP(-(dd1*r(i)))*distpb(i, 1) - cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) - dd1b = dd1b - r(i)*temp237b - rb(i) = rb(i) - dd1*temp237b - distpb(i, 1) = 0.0_8 + DO k=indtm,indtmin,-1 + temp136 = r(k)**2 + temp136b1 = c*DEXP(-(dd1*temp136))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp136))*distpb(k, 1) + dd1b = dd1b - temp136*temp136b1 + rb(k) = rb(k) - dd1*2*r(k)*temp136b1 + distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + coststo1s_c*1.5d0*dd1**0.5D0*cb + dd1b = dd1b + 0.1540487967684377d0*2.75d0*dd1**1.75D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (66) -! derivative of 57 (orbital 1s STO regolarized for r->0) -! dR(r)/dz with R(r)= C(z) * P(z*r) * exp(-z*r) -! P(x) = (x+a)^n/(1+(x+a)^n) with a so that P(0)==dP(0)/dx -! C(z) = const * z^(3/2) normalization -! the following definitions are in module constants -! n -> costSTO1s_n = 4 -! a -> costSTO1s_a = 1.2263393530877080588 -! const(n) -> costSTO1s_c = 0.58542132302621750732 -! -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 + CASE (41) +! derivative of 16 with respect to z +!c 4p without cusp condition derivative of 22 +!c r^2 e^{-z1 r } dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! if(dd1.gt.0.) then - c = coststo1s_c*dd1**1.5d0 -! else -! c=1.d0 -! endif -! endif +! if(iflagnorm.gt.2) then +! c=dsqrt((2.d0*dd1)**7/240.d0/pi)/2.d0 + c = dd1**3.5d0*0.2060129077457011d0 +! endif + c0 = -c + c1 = 3.5d0*c/dd1 + DO k=indtmin,indtm + distp(k, 1) = DEXP(-(dd1*r(k))) + END DO DO i=indtmin,indtm - distp(i, 1) = c*DEXP(-(dd1*r(i))) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = r(i)**2*distp(i, 1) END DO - DO i=i0,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) - rp1 = dd1*r(i) + coststo1s_a - CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) - rp4 = rp1**coststo1s_n +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic END DO +! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) - rp1 = dd1*r(0) + coststo1s_a - rp2 = rp1**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) - rp4 = rp1**coststo1s_n - rp6 = rp4**2 -! the first derivative /r - fun = distp(0, 1)*(dd1*rp4*(-(2.d0*coststo1s_a*(coststo1s_n**2*(-& -& 1.d0+rp4)+coststo1s_n*(1.d0+2.d0*rp1)*(1.d0+rp4)-rp2*(1.d0+rp4)& -& **2))+rp1*(2*coststo1s_n**2*(-1+rp4)+coststo1s_n*(-3.d0+4.d0*rp1& -& )*(1.d0+rp4)-rp1*(-5.d0+2.d0*rp1)*(1.d0+rp4)**2)))/(2.d0*rp2*(& -& coststo1s_a-rp1)*(1.d0+rp4)**3) -! fun=+distp(0,1)*rp4/(1.d0+rp4)*(1.5d0/dd1 + r(0)* & -! &(-1.d0+(costSTO1s_n)/(rp1*(1.d0+rp4)))) & -! & *(dd1*(2.d0 + 5.d0/(-dd1*r(0)) + & -! &(4.d0*costSTO1s_n**2)/(rp2*(1.d0+rp4)**2) + & -! &(costSTO1s_n*((3.d0 - 2.d0*costSTO1s_n - 4.d0*rp1)*rp1& -! & + 2.d0*costSTO1s_a*(1.d0+costSTO1s_n+2.d0*rp1)))/ & -! &(rp2*(dd1*r(0))*(1 + rp4))))/2.d0 -! the second derivative derivative - funb = 2.d0*zb(indorbp, indt+4) +! fun=(1.d0-dd1*r(0))*distp(0,1) +! fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) + fun = (c0*(2.d0-dd1*r(0))*r(0)+c1*(1.d0-dd1*r(0)))*distp(0, 1) + fun2 = (c0*((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))+c1*dd1*(dd1*r(0)-& +& 2.d0))*distp(0, 1) +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp142 = fun/r(0) + temp143b = rmu(ic, 0)*zb(indorbp, indt+4) + temp142b = 4.d0*temp143b/r(0) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp142+fun2)*zb(indorbp, indt& +& +4) + funb0 = funb0 + temp142b + rb(0) = rb(0) - temp142*temp142b + fun2b = fun2b + temp143b + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp141 = fun/r(0) + temp141b0 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(ic, 0) = rmub(ic, 0) + temp141*rmu(i, 0)*zb(indorbp, indt& +& +i) + rmub(i, 0) = rmub(i, 0) + temp141*rmu(ic, 0)*zb(indorbp, indt+& +& i) + funb0 = funb0 + temp141b0 + rb(0) = rb(0) - temp141*temp141b0 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + distpb = 0.0_8 + temp141b = distp(0, 1)*fun2b + temp140 = (dd1*r(0))**2 - 4.d0*dd1*r(0) + 2.d0 + temp140b = c0*temp141b + temp140b0 = 2*dd1*r(0)*temp140b + temp139 = dd1*r(0) - 2.d0 + temp139b = c1*dd1*temp141b + temp139b0 = distp(0, 1)*funb0 + temp137 = -(dd1*r(0)) + 2.d0 + c0b = temp137*r(0)*temp139b0 + distp(0, 3)*fun0b + temp140*& +& temp141b + temp138 = c0*r(0) + dd1b = (-(c1*r(0))-temp138*r(0))*temp139b0 + r(0)*temp139b + & +& temp139*c1*temp141b - 4.d0*r(0)*temp140b + r(0)*temp140b0 + rb(0) = rb(0) + (temp137*c0-c1*dd1-temp138*dd1)*temp139b0 + distp(& +& 0, 1)*c1*fun0b + dd1*temp139b - 4.d0*dd1*temp140b + dd1*& +& temp140b0 + c1b = (1.d0-dd1*r(0))*temp139b0 + distp(0, 1)*r(0)*fun0b + temp139& +& *dd1*temp141b + distpb(0, 1) = (temp137*temp138+c1*(1.d0-dd1*r(0)))*funb0 + (c0*& +& temp140+c1*dd1*temp139)*fun2b + distpb(0, 3) = distpb(0, 3) + c0*fun0b + distpb(0, 1) = distpb(0, 1) + c1*r(0)*fun0b + ELSE + distpb = 0.0_8 + c0b = 0.0_8 + c1b = 0.0_8 + dd1b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=indtm,i0,-1 + temp137b5 = rmu(ic, i)*zb(indorbp, i) + temp137b6 = distp(i, 1)*temp137b5 + rmub(ic, i) = rmub(ic, i) + (c0*distp(i, 3)+c1*r(i)*distp(i, 1))& +& *zb(indorbp, i) + c0b = c0b + distp(i, 3)*temp137b5 + distpb(i, 3) = distpb(i, 3) + c0*temp137b5 + c1b = c1b + r(i)*temp137b6 + rb(i) = rb(i) + c1*temp137b6 + distpb(i, 1) = distpb(i, 1) + c1*r(i)*temp137b5 + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO i=indtm,indtmin,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*distpb(i, 3) + distpb(i, 1) = distpb(i, 1) + r(i)**2*distpb(i, 3) + distpb(i, 3) = 0.0_8 + END DO + DO k=indtm,indtmin,-1 + temp137b4 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp137b4 + rb(k) = rb(k) - dd1*temp137b4 + distpb(k, 1) = 0.0_8 + END DO + temp137b3 = 3.5d0*c1b/dd1 + cb = temp137b3 - c0b + dd1b = dd1b + 0.2060129077457011d0*3.5d0*dd1**2.5D0*cb - c*temp137b3& +& /dd1 + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (125) +! 2s with cusp condition +! dd1*( dd3 +exp(-dd2*r)) ! with no cusp condition + dd2 = dd(indpar+1) + indorbp = indorb + 1 + DO k=indtmin,indtm + distp(k, 1) = DEXP(-(dd2*r(k))) + END DO +! endif + IF (typec .NE. 1) THEN + fun = -(dd2*distp(0, 1)/r(0)) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp270 = (rp4+1)**4 - temp257 = 2.d0*rp1*rp2 - temp258 = temp257*temp270 - temp269 = distp(0, 1)*dd1*rp4 - temp259 = temp269/temp258 - temp269b = -(temp259*fun2b) - temp268 = coststo1s_n**3 - temp264 = 6.d0*rp2 - 8.d0*rp1 - 3.d0 - temp267 = (rp4+1.d0)**3 - temp266 = rp2*(2.d0*rp1-7.d0) - temp265 = temp266*temp267 - coststo1s_n*temp264*(rp4+1.d0)**2 - & -& coststo1s_n**2*(6.d0*rp1-1.d0)*(rp6-1.d0) - 2*temp268*(rp4*(rp4-& -& 4.d0)+1.d0) - temp265b = rp1*temp269b - temp264b = -(coststo1s_n*(rp4+1.d0)**2*temp265b) - temp264b0 = -(coststo1s_n**2*temp265b) - temp264b1 = -(temp268*2*temp265b) - temp263 = coststo1s_n**3 - temp262 = 3.d0*rp1*(rp1+1.d0) + 2.d0 - temp261 = (rp4+1.d0)**3 - temp260 = 3.d0*coststo1s_n**2 - temp260b = coststo1s_a*2.d0*temp269b - temp260b0 = coststo1s_n*(rp4+1.d0)**2*3.d0*temp260b - temp259b = -((rp1*temp265+coststo1s_a*2.d0*(temp260*((rp1+1.d0)*(& -& rp6-1.d0))-rp1*rp2*temp261+coststo1s_n*((rp4+1.d0)**2*temp262)+& -& temp263*(rp4*(rp4-4.d0)+1.d0)))*fun2b/temp258) - temp258b = -(temp259*temp259b) - temp257b = temp270*temp258b - temp256 = (rp4+1.d0)**3 - temp249 = 2.d0*rp2*(coststo1s_a-rp1) - temp250 = temp249*temp256 - temp255 = distp(0, 1)*dd1*rp4 - temp251 = temp255/temp250 - temp255b = temp251*funb - temp254 = (rp4+1.d0)**2 - temp253 = rp1*(2.d0*rp1-5.d0) - temp252 = 2*coststo1s_n**2*(rp4-1) + coststo1s_n*(4.d0*rp1-3.d0)*(& -& rp4+1.d0) - temp253*temp254 - temp252b = -(coststo1s_a*2.d0*temp255b) - temp251b = (rp1*temp252-coststo1s_a*2.d0*(coststo1s_n**2*(rp4-1.d0& -& )+coststo1s_n*((2.d0*rp1+1.d0)*(rp4+1.d0))-rp2*(rp4+1.d0)**2))*& -& funb/temp250 - temp250b = -(temp251*temp251b) - temp249b0 = temp256*temp250b - rp2b = (coststo1s_a-rp1)*2.d0*temp249b0 - (rp4+1.d0)**2*temp252b +& -& 2.d0*rp1*temp257b - temp261*rp1*temp260b + 6.d0*temp264b + & -& temp267*(2.d0*rp1-7.d0)*temp265b - rp6b = temp260*(rp1+1.d0)*temp260b + (6.d0*rp1-1.d0)*temp264b0 - temp252b0 = rp1*temp255b - rp4b = (coststo1s_n*(4.d0*rp1-3.d0)-temp253*2*(rp4+1.d0)+2*& -& coststo1s_n**2)*temp252b0 + (coststo1s_n*(2.d0*rp1+1.d0)-rp2*2*(& -& rp4+1.d0)+coststo1s_n**2)*temp252b + distp(0, 1)*dd1*temp251b + & -& temp249*3*(rp4+1.d0)**2*temp250b + 2*rp4*rp6b + temp257*4*(rp4+1& -& )**3*temp258b + distp(0, 1)*dd1*temp259b + (temp263*rp4+temp263*& -& (rp4-4.d0)+coststo1s_n*temp262*2*(rp4+1.d0)-rp1*rp2*3*(rp4+1.d0)& -& **2)*temp260b + (2*rp4-4.d0)*temp264b1 + (temp266*3*(rp4+1.d0)**& -& 2-coststo1s_n*temp264*2*(rp4+1.d0))*temp265b - IF (rp1 .LE. 0.0 .AND. (coststo1s_n .EQ. 0.0 .OR. coststo1s_n .NE.& -& INT(coststo1s_n))) THEN - rp1b = temp252*temp255b + (coststo1s_n*(rp4+1.d0)*4.d0-temp254*(& -& 2.d0*rp1-5.d0)-temp254*rp1*2.d0)*temp252b0 + coststo1s_n*(rp4+& -& 1.d0)*2.d0*temp252b - 2.d0*rp2*temp249b0 + 2*rp1*rp2b + rp2*& -& 2.d0*temp257b + (2*rp1+1.d0)*temp260b0 + (temp260*(rp6-1.d0)-& -& temp261*rp2)*temp260b + (rp6-1.d0)*6.d0*temp264b0 - 8.d0*& -& temp264b + temp267*rp2*2.d0*temp265b + temp265*temp269b - ELSE - rp1b = temp252*temp255b + (coststo1s_n*(rp4+1.d0)*4.d0-temp254*(& -& 2.d0*rp1-5.d0)-temp254*rp1*2.d0)*temp252b0 + coststo1s_n*(rp4+& -& 1.d0)*2.d0*temp252b - 2.d0*rp2*temp249b0 + 2*rp1*rp2b + & -& coststo1s_n*rp1**(coststo1s_n-1)*rp4b + rp2*2.d0*temp257b + (2& -& *rp1+1.d0)*temp260b0 + (temp260*(rp6-1.d0)-temp261*rp2)*& -& temp260b + (rp6-1.d0)*6.d0*temp264b0 - 8.d0*temp264b + temp267& -& *rp2*2.d0*temp265b + temp265*temp269b - END IF - distpb(0, 1) = dd1*rp4*temp251b + dd1*rp4*temp259b - dd1b = distp(0, 1)*rp4*temp251b + r(0)*rp1b + distp(0, 1)*rp4*& -& temp259b - CALL POPREAL8(adr8ibuf,adr8buf,rp4) - CALL POPREAL8(adr8ibuf,adr8buf,rp1) - rb(0) = rb(0) + dd1*rp1b + temp143b1 = -(distp(0, 1)*funb0/r(0)) + dd2b = temp143b1 + distp(0, 1)*2*dd2*fun2b + temp143 = dd2/r(0) + distpb(0, 1) = dd2**2*fun2b - temp143*funb0 + rb(0) = rb(0) - temp143*temp143b1 ELSE distpb = 0.0_8 - dd1b = 0.0_8 + dd2b = 0.0_8 END IF + dd3b = 0.0_8 DO i=indtm,i0,-1 - temp246 = rp4/(rp4+1.d0) - temp249b = distp(i, 1)*temp246*zb(indorbp, i) - temp247 = rp1*(rp4+1.d0) - temp248 = coststo1s_n/temp247 - temp247b = -(r(i)*temp248*temp249b/temp247) - temp247b0 = (1.5d0/dd1+r(i)*(temp248-1.d0))*zb(indorbp, i) - temp246b0 = distp(i, 1)*temp247b0/(rp4+1.d0) - rp4b = (1.0_8-temp246)*temp246b0 + rp1*temp247b - IF (rp1 .LE. 0.0 .AND. (coststo1s_n .EQ. 0.0 .OR. coststo1s_n .NE.& -& INT(coststo1s_n))) THEN - rp1b = (rp4+1.d0)*temp247b - ELSE - rp1b = coststo1s_n*rp1**(coststo1s_n-1)*rp4b + (rp4+1.d0)*& -& temp247b - END IF - dd1b = dd1b + r(i)*rp1b - 1.5d0*temp249b/dd1**2 - rb(i) = rb(i) + dd1*rp1b + (temp248-1.d0)*temp249b - distpb(i, 1) = distpb(i, 1) + temp246*temp247b0 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) zb(indorbp, i) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,rp4) - CALL POPREAL8(adr8ibuf,adr8buf,rp1) END DO - cb = 0.0_8 - DO i=indtm,indtmin,-1 - temp246b = c*DEXP(-(dd1*r(i)))*distpb(i, 1) - cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) - dd1b = dd1b - r(i)*temp246b - rb(i) = rb(i) - dd1*temp246b - distpb(i, 1) = 0.0_8 + DO k=indtm,indtmin,-1 + temp143b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp143b0 + rb(k) = rb(k) - dd2*temp143b0 + distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + coststo1s_c*1.5d0*dd1**0.5D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (30) -! 3d without cusp and one parmater - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c= & -! & 1.d0/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) - c = dd1**3.5d0*0.26596152026762178d0 -! endif + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (116) +! 2p double Lorentian +! dd1 * x_mu (L^3(dd2 r)+dd3 r * L(dd4*r)^4) ; L(x)=1/(1+x) + dd2 = dd(indpar+1) + dd3 = dd(indpar+2) + dd4 = dd(indpar+3) DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) - END DO - DO i=indtmin,indtm - distp(i, 3) = distp(i, 1) -! lz=0 - distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d -! lz=+/-2 - distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d -! lz=+/-2 - distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d -! lz=+/-1 - distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d -! lz=+/-1 - distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d + distp(k, 1) = 1.d0/(1.d0+dd2*r(k))**3 + distp(k, 2) = r(k)/(1.d0+dd4*r(k))**4 END DO -! indorbp=indorb - DO ic=1,5 +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 3) - fun = -(dd1*distp(0, 1)) - fun2 = dd1**2*distp(0, 1) -! indorbp=indorb - DO ic=1,5 + fun = -(3.d0*dd2*distp(0, 1)/(r(0)*(1.d0+dd2*r(0)))) + dd3*distp(0& +& , 2)/r(0)**2*(1.d0-3*dd4*r(0))/(1.d0+dd4*r(0)) + fun2 = 12.d0*dd2**2/(1.+dd2*r(0))**5 + dd3*4.d0*dd4*(-2.d0+3.d0*& +& dd4*r(0))/(1.+dd4*r(0))**6 +! fun0=distp(0,1)+dd3*distp(0,2) +! fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) +! fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) +! 1+2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp272 = fun/r(0) - temp273b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp272b3 = 6.d0*temp273b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp272+fun2)*zb(& -& indorbp, indt+4) - funb = funb + temp272b3 - rb(0) = rb(0) - temp272*temp272b3 - fun2b = fun2b + temp273b + DO ic=3,1,-1 + temp154b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp154b0 + fun2b = fun2b + temp154b0 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp272b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp272b - fun0b = fun0b + rmu(i, 0)*temp272b - ELSE - temp272b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp272b0 - fun0b = fun0b + rmu(i, 0)*temp272b0 - END IF - ELSE IF (branch .LT. 4) THEN - temp272b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp272b1 - fun0b = fun0b + rmu(i, 0)*temp272b1 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp272b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp272b2 - fun0b = fun0b + rmu(i, 0)*temp272b2 - ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - temp271 = fun/r(0) - temp271b0 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp271*rmu(i, 0)*zb(& -& indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp271*distp(0, 3+ic)*zb(indorbp, & -& indt+i) - funb = funb + temp271b0 - rb(0) = rb(0) - temp271*temp271b0 + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp154b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp154b + funb0 = funb0 + rmu(ic, 0)*temp154b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb - distpb(0, 1) = distpb(0, 1) + dd1**2*fun2b - dd1*funb - distpb(0, 3) = distpb(0, 3) + fun0b + temp153 = (dd2*r(0)+1.)**5 + temp153b = 12.d0*fun2b/temp153 + temp153b0 = -(dd2**2*5*(dd2*r(0)+1.)**4*temp153b/temp153) + temp152 = (dd4*r(0)+1.)**6 + temp151 = 3.d0*dd4*r(0) - 2.d0 + temp151b = 4.d0*fun2b/temp152 + temp151b0 = dd3*dd4*3.d0*temp151b + temp151b1 = -(dd3*dd4*temp151*6*(dd4*r(0)+1.)**5*temp151b/temp152) + temp148 = dd2*r(0) + 1.d0 + temp148b0 = -(3.d0*funb0/(r(0)*temp148)) + temp148b1 = -(dd2*distp(0, 1)*temp148b0/(r(0)*temp148)) + dd2b = distp(0, 1)*temp148b0 + r(0)**2*temp148b1 + r(0)*temp153b0 & +& + 2*dd2*temp153b + temp149 = r(0)**2*(dd4*r(0)+1.d0) + temp151b2 = funb0/temp149 + temp150 = (-3)*(dd4*r(0)) + 1.d0 + temp150b = -(dd3*distp(0, 2)*3*temp151b2) + temp149b = -(dd3*distp(0, 2)*temp150*temp151b2/temp149) + temp149b0 = r(0)**2*temp149b + rb(0) = rb(0) + dd4*temp150b + (dd4*r(0)+1.d0)*2*r(0)*temp149b + & +& dd4*temp149b0 + (r(0)*dd2+temp148)*temp148b1 + dd4*temp151b1 + & +& dd4*temp151b0 + dd2*temp153b0 + dd3b = temp150*distp(0, 2)*temp151b2 + distp(0, 2)*fun0b + temp151& +& *dd4*temp151b + dd4b = r(0)*temp150b + r(0)*temp149b0 + r(0)*temp151b1 + r(0)*& +& temp151b0 + temp151*dd3*temp151b + distpb = 0.0_8 + distpb(0, 2) = temp150*dd3*temp151b2 + distpb(0, 1) = fun0b + dd2*temp148b0 + distpb(0, 2) = distpb(0, 2) + dd3*fun0b ELSE distpb = 0.0_8 - dd1b = 0.0_8 + dd2b = 0.0_8 + dd3b = 0.0_8 + dd4b = 0.0_8 END IF - DO ic=5,1,-1 + DO ic=3,1,-1 DO i=indtm,i0,-1 - distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) + temp148b = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& +& indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp148b + dd3b = dd3b + distp(i, 2)*temp148b + distpb(i, 2) = distpb(i, 2) + dd3*temp148b zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=indtm,indtmin,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) - distpb(i, 8) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) - distpb(i, 7) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - distpb(i, 1) = distpb(i, 1) + distpb(i, 3) - distpb(i, 3) = 0.0_8 - END DO - cb = 0.0_8 DO k=indtm,indtmin,-1 - temp271b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp271b - rb(k) = rb(k) - dd1*temp271b + temp146 = dd4*r(k) + 1.d0 + temp147 = temp146**4 + temp146b = -(r(k)*4*temp146**3*distpb(k, 2)/temp147**2) + rb(k) = rb(k) + dd4*temp146b + distpb(k, 2)/temp147 + dd4b = dd4b + r(k)*temp146b + distpb(k, 2) = 0.0_8 + temp144 = dd2*r(k) + 1.d0 + temp145 = temp144**3 + temp144b = -(3*temp144**2*distpb(k, 1)/temp145**2) + dd2b = dd2b + r(k)*temp144b + rb(k) = rb(k) + dd2*temp144b distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.26596152026762178d0*3.5d0*dd1**2.5D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (31) -! 3d without cusp condition double Z - dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) -! if(iflagnorm.gt.2) then - c = 1/2.d0*DSQRT(5.d0/pi)/DSQRT(1/dd1**7/128.d0+2*peff/(dd1+dd2)**7+& -& peff**2/dd2**7/128.d0)/DSQRT(720.d0) -! endif + ddb(indpar+3) = ddb(indpar+3) + dd4b + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (48) +! f orbital +! +! - angmom = 3 +! - type = Gaussian +! - normalized = yes +! - angtype = spherical +! - npar = 1 +! - multiplicity = 7 +! + indparp = indpar + 1 + dd1 = dd(indparp) + c = dd1**2.25d0*1.47215808929909374563d0 DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k))) - distp(k, 2) = DEXP(-(dd2*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO DO i=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = c*(distp(i, 1)+peff*distp(i, 2)) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) -!lz=0 - distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) -!lz=+/-2 - distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) -! lz=+/- 2 - distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) -! lz=+/-1 - distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) -! lz=+/-1 - distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d + distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) +! lz=0 + distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) +! lz=+/-2 + distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) +! lz=+/-2 + distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) +! lz=+/-3 + distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) END DO -! indorbp=indorb - DO ic=1,5 +! lz=+/-3 + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 3) - fun = c*(-(dd1*distp(0, 1))-peff*dd2*distp(0, 2)) - fun2 = c*(dd1**2*distp(0, 1)+peff*dd2**2*distp(0, 2)) -! indorbp=indorb - DO ic=1,5 + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1) + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - END IF - END DO + IF (ic .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + ELSE IF (ic .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (ic .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE IF (ic .EQ. 4) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (ic .EQ. 5) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + ELSE IF (ic .EQ. 6) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + END IF END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp281 = fun/r(0) - temp282b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp281b3 = 6.d0*temp282b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp281+fun2)*zb(& -& indorbp, indt+4) - funb = funb + temp281b3 - rb(0) = rb(0) - temp281*temp281b3 - fun2b = fun2b + temp282b + DO ic=7,1,-1 + temp155b28 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 8.d0*temp155b28 + fun2b = fun2b + temp155b28 zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp281b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp281b - fun0b = fun0b + rmu(i, 0)*temp281b - ELSE - temp281b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp281b0 - fun0b = fun0b + rmu(i, 0)*temp281b0 - END IF - ELSE IF (branch .LT. 4) THEN - temp281b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp281b1 - fun0b = fun0b + rmu(i, 0)*temp281b1 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp281b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp281b2 - fun0b = fun0b + rmu(i, 0)*temp281b2 - ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 4) THEN + IF (branch .LT. 2) THEN + IF (branch .LT. 1) THEN + temp155b9 = cost1f*zb(indorbp, indt+3) + temp155b10 = -(cost1f*6.d0*zb(indorbp, indt+2)) + temp155b11 = -(cost1f*6.d0*zb(indorbp, indt+1)) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp155b10 + rmu(3, 0)& +& *rmu(1, 0)*temp155b11 + (9.d0*rmu(3, 0)**2-3.d0*r(0)**2)& +& *temp155b9 + rmub(3, 0) = rmub(3, 0) + fun0*9.d0*2*rmu(3, 0)*temp155b9 + rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp155b9 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp155b10 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp155b10 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp155b11 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp155b11 + ELSE + temp155b12 = cost2f*8.d0*zb(indorbp, indt+3) + temp155b13 = -(cost2f*2.d0*zb(indorbp, indt+2)) + fun0b = fun0b + rmu(1, 0)*rmu(2, 0)*temp155b13 + cost2f*(& +& 5.d0*rmu(3, 0)**2-r(0)**2-2.d0*rmu(1, 0)**2)*zb(indorbp& +& , indt+1) + rmu(1, 0)*rmu(3, 0)*temp155b12 + rmub(3, 0) = rmub(3, 0) + rmu(1, 0)*fun0*temp155b12 + rmub(1, 0) = rmub(1, 0) + fun0*rmu(3, 0)*temp155b12 + rmub(2, 0) = rmub(2, 0) + rmu(1, 0)*fun0*temp155b13 + rmub(1, 0) = rmub(1, 0) + fun0*rmu(2, 0)*temp155b13 + temp155b14 = cost2f*fun0*zb(indorbp, indt+1) + rmub(3, 0) = rmub(3, 0) + 5.d0*2*rmu(3, 0)*temp155b14 + rb(0) = rb(0) - 2*r(0)*temp155b14 + rmub(1, 0) = rmub(1, 0) - 2.d0*2*rmu(1, 0)*temp155b14 END IF + ELSE IF (branch .LT. 3) THEN + temp155b15 = cost2f*8.d0*zb(indorbp, indt+3) + temp155b16 = -(cost2f*2.d0*zb(indorbp, indt+1)) + fun0b = fun0b + cost2f*(5.d0*rmu(3, 0)**2-r(0)**2-2.d0*rmu(2& +& , 0)**2)*zb(indorbp, indt+2) + rmu(2, 0)*rmu(1, 0)*& +& temp155b16 + rmu(2, 0)*rmu(3, 0)*temp155b15 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*fun0*temp155b15 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(3, 0)*temp155b15 + temp155b17 = cost2f*fun0*zb(indorbp, indt+2) + rmub(3, 0) = rmub(3, 0) + 5.d0*2*rmu(3, 0)*temp155b17 + rb(0) = rb(0) - 2*r(0)*temp155b17 + rmub(2, 0) = rmub(2, 0) - 2.d0*2*rmu(2, 0)*temp155b17 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp155b16 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp155b16 ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + temp155b18 = cost3f*zb(indorbp, indt+3) + temp155b19 = -(cost3f*2.d0*zb(indorbp, indt+2)) + temp155b20 = cost3f*2.d0*zb(indorbp, indt+1) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp155b19 + rmu(3, 0)*& +& rmu(1, 0)*temp155b20 + (rmu(1, 0)**2-rmu(2, 0)**2)*& +& temp155b18 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp155b18 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp155b19 - fun0*2& +& *rmu(2, 0)*temp155b18 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp155b19 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp155b20 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp155b20 END IF - temp280 = fun/r(0) - temp280b5 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp280*rmu(i, 0)*zb(& -& indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp280*distp(0, 3+ic)*zb(indorbp, & + ELSE IF (branch .LT. 6) THEN + IF (branch .LT. 5) THEN + temp155b21 = cost3f*2.d0*zb(indorbp, indt+3) + temp155b22 = cost3f*2.d0*zb(indorbp, indt+2) + temp155b23 = cost3f*2.d0*zb(indorbp, indt+1) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp155b22 + rmu(3, 0)*& +& rmu(2, 0)*temp155b23 + rmu(2, 0)*rmu(1, 0)*temp155b21 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp155b21 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp155b21 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp155b22 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp155b22 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp155b23 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp155b23 + ELSE + temp155b24 = -(cost4f*6.d0*zb(indorbp, indt+2)) + temp155b25 = cost4f*3.d0*zb(indorbp, indt+1) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp155b25 + rmu& +& (2, 0)*rmu(1, 0)*temp155b24 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp155b24 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp155b24 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp155b25 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp155b25 + END IF + ELSE + temp155b26 = cost4f*3.d0*zb(indorbp, indt+2) + temp155b27 = cost4f*6.d0*zb(indorbp, indt+1) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp155b27 + (rmu(1, 0)**2& +& -rmu(2, 0)**2)*temp155b26 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp155b26 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp155b26 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp155b27 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp155b27 + END IF + DO i=3,1,-1 + temp155b8 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - funb = funb + temp280b5 - rb(0) = rb(0) - temp280*temp280b5 + rmub(i, 0) = rmub(i, 0) + fun*temp155b8 + funb0 = funb0 + rmu(i, 0)*temp155b8 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp280b2 = c*fun2b - temp280b3 = dd2**2*temp280b2 - cb = (-(dd1*distp(0, 1))-peff*dd2*distp(0, 2))*funb + (dd1**2*& -& distp(0, 1)+dd2**2*(peff*distp(0, 2)))*fun2b - temp280b4 = c*funb - dd1b = distp(0, 1)*2*dd1*temp280b2 - distp(0, 1)*temp280b4 - distpb(0, 1) = distpb(0, 1) + dd1**2*temp280b2 - dd2b = peff*distp(0, 2)*2*dd2*temp280b2 - distp(0, 2)*peff*& -& temp280b4 - peffb = distp(0, 2)*temp280b3 - distp(0, 2)*dd2*temp280b4 - distpb(0, 2) = distpb(0, 2) + peff*temp280b3 - distpb(0, 1) = distpb(0, 1) - dd1*temp280b4 - distpb(0, 2) = distpb(0, 2) - peff*dd2*temp280b4 - distpb(0, 3) = distpb(0, 3) + fun0b + temp155b7 = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp155b7 - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp155b7 + distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb0 + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - peffb = 0.0_8 - dd1b = 0.0_8 - dd2b = 0.0_8 - cb = 0.0_8 END IF - DO ic=5,1,-1 - DO i=indtm,i0,-1 - distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=7,1,-1 + DO k=indtm,i0,-1 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + temp155b = cost4f*rmu(2, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 8) - 2*rmu(2, i)*temp155b distpb(i, 8) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + temp155b0 = cost4f*rmu(1, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& +& distpb(i, 7) + 2*rmu(1, i)*temp155b0 + 3.d0*2*rmu(1, i)*temp155b + rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp155b0 distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + temp155b1 = cost3f*2.d0*distpb(i, 6) + temp155b2 = rmu(2, i)*temp155b1 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp155b2 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp155b2 + rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp155b1 distpb(i, 6) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + temp155b3 = cost3f*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 5) + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp155b3 distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 4) - 2*rmu(2, i)*temp155b3 + temp155b4 = cost2f*rmu(2, i)*distpb(i, 4) + rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp155b4 distpb(i, 4) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - temp280b1 = c*distpb(i, 3) - cb = cb + (distp(i, 1)+peff*distp(i, 2))*distpb(i, 3) - distpb(i, 1) = distpb(i, 1) + temp280b1 - peffb = peffb + distp(i, 2)*temp280b1 - distpb(i, 2) = distpb(i, 2) + peff*temp280b1 + temp155b5 = cost2f*rmu(1, i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 3) distpb(i, 3) = 0.0_8 + temp155b6 = cost1f*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - 2*r(i)*temp155b5 - 3.d0*2*r(i)*temp155b6 - 2*r(i)*& +& temp155b4 + rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& +& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp155b6 + 5.d0*2*rmu(3, i)*& +& temp155b5 + distpb(i, 2) = 0.0_8 END DO + dd1b = 0.0_8 + cb = 0.0_8 DO k=indtm,indtmin,-1 - temp280b = DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp280b - distpb(k, 2) = 0.0_8 - temp280b0 = DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp280b0 - dd2*temp280b - dd1b = dd1b - r(k)*temp280b0 + temp154 = r(k)**2 + temp154b1 = c*DEXP(-(dd1*temp154))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp154))*distpb(k, 1) + dd1b = dd1b - temp154*temp154b1 + rb(k) = rb(k) - dd1*2*r(k)*temp154b1 distpb(k, 1) = 0.0_8 END DO - temp279 = 128.d0*dd2**7 - temp278 = peff**2/temp279 - temp277 = (dd1+dd2)**7 - temp276 = 128.d0*dd1**7 - temp273 = 1.0/temp276 + 2*(peff/temp277) + temp278 - temp275 = DSQRT(temp273) - temp274 = 2.d0*DSQRT(720.d0) - IF (temp273 .EQ. 0.0) THEN - temp273b0 = 0.0 - ELSE - temp273b0 = -(DSQRT(5.d0/pi)*cb/(temp274*temp275**2*2.D0*DSQRT(& -& temp273))) - END IF - temp273b1 = 2*temp273b0/temp277 - temp273b2 = -(peff*7*(dd1+dd2)**6*temp273b1/temp277) - dd1b = dd1b + temp273b2 - 128.d0*7*dd1**6*temp273b0/temp276**2 - peffb = peffb + 2*peff*temp273b0/temp279 + temp273b1 - dd2b = dd2b + temp273b2 - temp278*128.d0*7*dd2**6*temp273b0/temp279 - ddb(indpar+3) = ddb(indpar+3) + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (32) -! 3d without cusp condition triple Z - dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd(indpar+3) - dd3 = dd(indpar+4) - peff2 = dd(indpar+5) -! if(iflagnorm.gt.2) then - c = 1/2.d0*DSQRT(5.d0/pi)/DSQRT(1/(2.d0*dd1)**7+2*peff/(dd1+dd2)**7+& -& peff**2/(2.d0*dd2)**7+2*peff2/(dd1+dd3)**7+peff2**2/(2.d0*dd3)**7+& -& 2*peff*peff2/(dd2+dd3)**7)/DSQRT(720.d0) -! endif + dd1b = dd1b + 1.47215808929909374563d0*2.25d0*dd1**1.25D0*cb + ddb(indparp) = ddb(indparp) + dd1b + CASE (102) +! 2s double gaussian with constant +! (dd3+ exp (-dd2 r^2)+dd4*exp(-dd5*r^2)) + dd2 = dd(indpar+1) + dd4 = dd(indpar+3) + dd5 = dd(indpar+4) + indorbp = indorb + 1 DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k))) - distp(k, 2) = DEXP(-(dd2*r(k))) - distp(k, 3) = DEXP(-(dd3*r(k))) + distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) + distp(k, 2) = DEXP(-(dd5*r(k)*r(k))) END DO - DO i=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) - distp(i, 4) = c*(distp(i, 1)+peff*distp(i, 2)+peff2*distp(i, 3)) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) -!lz=0 - distp(i, 5) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) -!lz=+/-2 - distp(i, 6) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) -! lz=+/- 2 - distp(i, 7) = rmu(1, i)*rmu(2, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) -! lz=+/-1 - distp(i, 8) = rmu(2, i)*rmu(3, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 9)) -! lz=+/-1 - distp(i, 9) = rmu(1, i)*rmu(3, i)*cost3d +! write(6,*) ' function inside = ',z(indorbp,i) +! endif + IF (typec .NE. 1) THEN + fun = -(2.d0*(dd2*distp(0, 1)+dd5*dd4*distp(0, 2))) + fun2 = r(0)**2 + distpb = 0.0_8 + temp155b32 = 2.d0*zb(indorbp, indt+4) + temp155b33 = dd2*distp(0, 1)*2.d0*temp155b32 + temp155b34 = (2.d0*(dd2*fun2)-3.d0)*temp155b32 + temp155b35 = (2.d0*(dd5*fun2)-3.d0)*temp155b32 + temp155b36 = dd5*dd4*distp(0, 2)*2.d0*temp155b32 + dd2b = distp(0, 1)*temp155b34 + fun2*temp155b33 + fun2b = dd5*temp155b36 + dd2*temp155b33 + distpb(0, 1) = dd2*temp155b34 + dd5b = fun2*temp155b36 + distp(0, 2)*dd4*temp155b35 + dd4b = distp(0, 2)*dd5*temp155b35 + distpb(0, 2) = dd5*dd4*temp155b35 + zb(indorbp, indt+4) = 0.0_8 + funb0 = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + rb(0) = rb(0) + 2*r(0)*fun2b + temp155b31 = -(2.d0*funb0) + dd2b = dd2b + distp(0, 1)*temp155b31 + distpb(0, 1) = distpb(0, 1) + dd2*temp155b31 + dd5b = dd5b + distp(0, 2)*dd4*temp155b31 + dd4b = dd4b + distp(0, 2)*dd5*temp155b31 + distpb(0, 2) = distpb(0, 2) + dd5*dd4*temp155b31 + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + dd4b = 0.0_8 + dd5b = 0.0_8 + END IF + dd3b = 0.0_8 + DO i=indtm,i0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) + dd4b = dd4b + distp(i, 2)*zb(indorbp, i) + distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO -! indorbp=indorb - DO ic=1,5 + DO k=indtm,indtmin,-1 + temp155b29 = DEXP(-(dd5*r(k)**2))*distpb(k, 2) + dd5b = dd5b - r(k)**2*temp155b29 + distpb(k, 2) = 0.0_8 + temp155b30 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + rb(k) = rb(k) - dd2*2*r(k)*temp155b30 - dd5*2*r(k)*temp155b29 + dd2b = dd2b - r(k)**2*temp155b30 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+4) = ddb(indpar+4) + dd5b + ddb(indpar+3) = ddb(indpar+3) + dd4b + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (35) +! normalized +! exp(-dd1*r) + dd1* r * exp(-dd2*r) +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd1 + DO k=indtmin,indtm + distp(k, 1) = DEXP(-(dd1*r(k))) + distp(k, 2) = DEXP(-(dd2*r(k))) + END DO +! if(iflagnorm.gt.2) then + c = 1.d0/DSQRT(1/4.d0/dd1**3+12*peff/(dd1+dd2)**4+3*peff**2/4/dd2**5& +& )/DSQRT(4.0*pi) + IF (typec .NE. 1) THEN + fun = -(dd1*distp(0, 1)) + peff*distp(0, 2)*(1.d0-dd2*r(0)) + fun2 = distp(0, 1)*dd1**2 + peff*distp(0, 2)*(dd2**2*r(0)-2.d0*dd2& +& ) + temp163 = fun/r(0) + temp163b = c*2.d0*zb(indorbp, indt+4)/r(0) + cb = (2.d0*temp163+fun2)*zb(indorbp, indt+4) + funb0 = temp163b + rb(0) = rb(0) - temp163*temp163b + fun2b = c*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + temp162 = rmu(i, 0)/r(0) + temp162b5 = fun*c*zb(indorbp, indt+i)/r(0) + funb0 = funb0 + temp162*c*zb(indorbp, indt+i) + cb = cb + temp162*fun*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp162b5 + rb(0) = rb(0) - temp162*temp162b5 + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp162b1 = (dd2**2*r(0)-2.d0*dd2)*fun2b + temp162b2 = peff*distp(0, 2)*fun2b + distpb(0, 1) = dd1**2*fun2b + dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb0 + temp162b3 = (1.d0-dd2*r(0))*funb0 + peffb = distp(0, 2)*temp162b3 + distp(0, 2)*temp162b1 + distpb(0, 2) = peff*temp162b3 + peff*temp162b1 + temp162b4 = peff*distp(0, 2)*funb0 + dd2b = (r(0)*2*dd2-2.d0)*temp162b2 - r(0)*temp162b4 + rb(0) = rb(0) + dd2**2*temp162b2 - dd2*temp162b4 + distpb(0, 1) = distpb(0, 1) - dd1*funb0 + ELSE + distpb = 0.0_8 + peffb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 + cb = 0.0_8 + END IF + DO i=indtm,i0,-1 + temp162b = c*zb(indorbp, i) + temp162b0 = distp(i, 2)*temp162b + cb = cb + (distp(i, 1)+r(i)*peff*distp(i, 2))*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp162b + rb(i) = rb(i) + peff*temp162b0 + peffb = peffb + r(i)*temp162b0 + distpb(i, 2) = distpb(i, 2) + r(i)*peff*temp162b + zb(indorbp, i) = 0.0_8 + END DO + temp161 = 4*dd2**5 + temp155 = peff**2/temp161 + temp160 = (dd1+dd2)**4 + temp159 = 4.d0*dd1**3 + temp156 = 1.0/temp159 + 12*(peff/temp160) + 3*temp155 + temp158 = DSQRT(temp156) + temp157 = DSQRT(4.0*pi) + IF (temp156 .EQ. 0.0) THEN + temp156b = 0.0 + ELSE + temp156b = -(cb/(temp157*temp158**2*2.D0*DSQRT(temp156))) + END IF + temp156b0 = 12*temp156b/temp160 + temp156b1 = -(peff*4*(dd1+dd2)**3*temp156b0/temp160) + temp155b39 = 3*temp156b/temp161 + dd1b = dd1b + temp156b1 - 4.d0*3*dd1**2*temp156b/temp159**2 + peffb = peffb + 2*peff*temp155b39 + temp156b0 + dd2b = dd2b + temp156b1 - temp155*4*5*dd2**4*temp155b39 + DO k=indtm,indtmin,-1 + temp155b37 = DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp155b37 + distpb(k, 2) = 0.0_8 + temp155b38 = DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp155b38 - dd2*temp155b37 + dd1b = dd1b - r(k)*temp155b38 + distpb(k, 1) = 0.0_8 + END DO + dd1b = dd1b + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (103) +! single gaussian p orbitals +! 2p single gaussian + dd2 = dd(indpar+1) + DO k=indtmin,indtm + distp(k, 1) = DEXP(-(dd2*r(k)**2)) + END DO +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 4) - fun = c*(-(dd1*distp(0, 1))-peff*dd2*distp(0, 2)-peff2*dd3*distp(0& -& , 3)) - fun2 = c*(dd1**2*distp(0, 1)+peff*dd2**2*distp(0, 2)+peff2*dd3**2*& -& distp(0, 3)) -! indorbp=indorb - DO ic=1,5 + fun = -(dd2*distp(0, 1)*2.d0) + fun2 = 2.d0*dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0, 1) +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - END IF - END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp298 = fun/r(0) - temp299b = distp(0, 4+ic)*zb(indorbp, indt+4) - temp298b3 = 6.d0*temp299b/r(0) - distpb(0, 4+ic) = distpb(0, 4+ic) + (6.d0*temp298+fun2)*zb(& -& indorbp, indt+4) - funb = funb + temp298b3 - rb(0) = rb(0) - temp298*temp298b3 - fun2b = fun2b + temp299b + DO ic=3,1,-1 + temp164b3 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp164b3 + fun2b = fun2b + temp164b3 zb(indorbp, indt+4) = 0.0_8 + fun0b = fun0b + zb(indorbp, indt+ic) DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp298b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp298b - fun0b = fun0b + rmu(i, 0)*temp298b - ELSE - temp298b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp298b0 - fun0b = fun0b + rmu(i, 0)*temp298b0 - END IF - ELSE IF (branch .LT. 4) THEN - temp298b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp298b1 - fun0b = fun0b + rmu(i, 0)*temp298b1 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp298b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp298b2 - fun0b = fun0b + rmu(i, 0)*temp298b2 - ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - temp297 = fun/r(0) - temp297b7 = distp(0, 4+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 4+ic) = distpb(0, 4+ic) + temp297*rmu(i, 0)*zb(& -& indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp297*distp(0, 4+ic)*zb(indorbp, & -& indt+i) - funb = funb + temp297b7 - rb(0) = rb(0) - temp297*temp297b7 + temp164b2 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp164b2 + funb0 = funb0 + rmu(ic, 0)*temp164b2 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp297b3 = c*fun2b - temp297b4 = dd2**2*temp297b3 - temp297b5 = dd3**2*temp297b3 - cb = (-(dd1*distp(0, 1))-peff*dd2*distp(0, 2)-peff2*dd3*distp(0, 3& -& ))*funb + (dd1**2*distp(0, 1)+dd2**2*(peff*distp(0, 2))+dd3**2*(& -& peff2*distp(0, 3)))*fun2b - temp297b6 = c*funb - dd1b = distp(0, 1)*2*dd1*temp297b3 - distp(0, 1)*temp297b6 - distpb(0, 1) = distpb(0, 1) + dd1**2*temp297b3 - dd2b = peff*distp(0, 2)*2*dd2*temp297b3 - distp(0, 2)*peff*& -& temp297b6 - peffb = distp(0, 2)*temp297b4 - distp(0, 2)*dd2*temp297b6 - distpb(0, 2) = distpb(0, 2) + peff*temp297b4 - dd3b = peff2*distp(0, 3)*2*dd3*temp297b3 - distp(0, 3)*peff2*& -& temp297b6 - peff2b = distp(0, 3)*temp297b5 - distp(0, 3)*dd3*temp297b6 - distpb(0, 3) = distpb(0, 3) + peff2*temp297b5 - distpb(0, 1) = distpb(0, 1) - dd1*temp297b6 - distpb(0, 2) = distpb(0, 2) - peff*dd2*temp297b6 - distpb(0, 3) = distpb(0, 3) - peff2*dd3*temp297b6 - distpb(0, 4) = distpb(0, 4) + fun0b + distpb = 0.0_8 + temp164b0 = 2.d0**2*dd2*distp(0, 1)*fun2b + temp164b1 = 2.d0*(2.d0*(dd2*r(0)**2)-1.d0)*fun2b + dd2b = distp(0, 1)*temp164b1 - 2.d0*distp(0, 1)*funb0 + r(0)**2*& +& temp164b0 + rb(0) = rb(0) + dd2*2*r(0)*temp164b0 + distpb(0, 1) = fun0b - 2.d0*dd2*funb0 + dd2*temp164b1 ELSE distpb = 0.0_8 - peffb = 0.0_8 - dd1b = 0.0_8 dd2b = 0.0_8 - dd3b = 0.0_8 - peff2b = 0.0_8 - cb = 0.0_8 END IF - DO ic=5,1,-1 + DO ic=3,1,-1 DO i=indtm,i0,-1 - distpb(i, 4+ic) = distpb(i, 4+ic) + distp(i, 4)*zb(indorbp, i) - distpb(i, 4) = distpb(i, 4) + distp(i, 4+ic)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=indtm,indtmin,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 9)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 9) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 9) - distpb(i, 9) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 8) - distpb(i, 8) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 7) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 7) - distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 5) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - temp297b2 = c*distpb(i, 4) - cb = cb + (distp(i, 1)+peff*distp(i, 2)+peff2*distp(i, 3))*distpb(& -& i, 4) - distpb(i, 1) = distpb(i, 1) + temp297b2 - peffb = peffb + distp(i, 2)*temp297b2 - distpb(i, 2) = distpb(i, 2) + peff*temp297b2 - peff2b = peff2b + distp(i, 3)*temp297b2 - distpb(i, 3) = distpb(i, 3) + peff2*temp297b2 - distpb(i, 4) = 0.0_8 - END DO DO k=indtm,indtmin,-1 - temp297b = DEXP(-(dd3*r(k)))*distpb(k, 3) - dd3b = dd3b - r(k)*temp297b - distpb(k, 3) = 0.0_8 - temp297b0 = DEXP(-(dd2*r(k)))*distpb(k, 2) - distpb(k, 2) = 0.0_8 - temp297b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd2*temp297b0 - dd1*temp297b1 - dd3*temp297b - dd2b = dd2b - r(k)*temp297b0 - dd1b = dd1b - r(k)*temp297b1 + temp164b = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp164b + rb(k) = rb(k) - dd2*2*r(k)*temp164b distpb(k, 1) = 0.0_8 END DO - temp296 = (dd2+dd3)**7 - temp282 = peff*peff2/temp296 - temp295 = 2.d0**7 - temp294 = temp295*dd3**7 - temp293 = peff2**2/temp294 - temp292 = (dd1+dd3)**7 - temp291 = 2.d0**7 - temp290 = temp291*dd2**7 - temp289 = peff**2/temp290 - temp288 = (dd1+dd2)**7 - temp287 = 2.d0**7 - temp286 = temp287*dd1**7 - temp283 = 1.0/temp286 + 2*(peff/temp288) + temp289 + 2*(peff2/& -& temp292) + temp293 + 2*temp282 - temp285 = DSQRT(temp283) - temp284 = 2.d0*DSQRT(720.d0) - IF (temp283 .EQ. 0.0) THEN - temp283b = 0.0 - ELSE - temp283b = -(DSQRT(5.d0/pi)*cb/(temp284*temp285**2*2.D0*DSQRT(& -& temp283))) - END IF - temp283b0 = 2*temp283b/temp288 - temp283b1 = -(peff*7*(dd1+dd2)**6*temp283b0/temp288) - temp283b2 = 2*temp283b/temp292 - temp283b3 = -(peff2*7*(dd1+dd3)**6*temp283b2/temp292) - temp282b0 = 2*temp283b/temp296 - temp282b1 = -(temp282*7*(dd2+dd3)**6*temp282b0) - dd1b = dd1b + temp283b3 + temp283b1 - temp287*7*dd1**6*temp283b/& -& temp286**2 - peffb = peffb + peff2*temp282b0 + 2*peff*temp283b/temp290 + & -& temp283b0 - dd2b = dd2b + temp282b1 - temp289*temp291*7*dd2**6*temp283b/temp290 & -& + temp283b1 - peff2b = peff2b + peff*temp282b0 + 2*peff2*temp283b/temp294 + & -& temp283b2 - dd3b = dd3b + temp282b1 - temp293*temp295*7*dd3**6*temp283b/temp294 & -& + temp283b3 - ddb(indpar+5) = ddb(indpar+5) + peff2b - ddb(indpar+4) = ddb(indpar+4) + dd3b - ddb(indpar+3) = ddb(indpar+3) + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (33) -! 4d without cusp and one parmater - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c= -! & 1/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) -! c= & -! & 1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) - c = dd1**4.5d0*0.0710812062076410d0 -! endif + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (120) +! 2p double cubic +! dd1 * x_mu (L^3(dd2 r)+dd3 L(dd4*r)^3) ; L(x)=1/(1+x) + dd2 = dd(indpar+1) + dd3 = dd(indpar+2) + dd4 = dd(indpar+3) DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) - END DO + distp(k, 1) = 1.d0/(1.d0+dd2*r(k))**3 + distp(k, 2) = 1.d0/(1.d0+dd4*r(k))**3 + END DO +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN + fun = -(3.d0*dd2*distp(0, 1)/(r(0)*(1.d0+dd2*r(0)))) - 3.d0*dd4*& +& dd3*distp(0, 2)/(r(0)*(1.d0+dd4*r(0))) + fun2 = 12.d0*dd2**2/(1.+dd2*r(0))**5 + 12.d0*dd3*dd4**2/(1.+dd4*r(& +& 0))**5 +! fun0=distp(0,1)+dd3*distp(0,2) +! fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) +! fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) +! 1+2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp172b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp172b0 + fun2b = fun2b + temp172b0 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp172b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp172b + funb0 = funb0 + rmu(ic, 0)*temp172b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + temp171 = (dd2*r(0)+1.)**5 + temp171b = 12.d0*fun2b/temp171 + temp171b0 = -(dd2**2*5*(dd2*r(0)+1.)**4*temp171b/temp171) + temp170 = (dd4*r(0)+1.)**5 + temp170b = 12.d0*fun2b/temp170 + temp170b0 = -(dd3*dd4**2*5*(dd4*r(0)+1.)**4*temp170b/temp170) + temp169 = dd2*r(0) + 1.d0 + temp169b = -(3.d0*funb0/(r(0)*temp169)) + temp169b0 = -(dd2*distp(0, 1)*temp169b/(r(0)*temp169)) + dd2b = distp(0, 1)*temp169b + r(0)**2*temp169b0 + r(0)*temp171b0 +& +& 2*dd2*temp171b + temp168 = dd4*r(0) + 1.d0 + temp168b0 = -(3.d0*funb0/(r(0)*temp168)) + temp168b1 = -(dd4*dd3*distp(0, 2)*temp168b0/(r(0)*temp168)) + rb(0) = rb(0) + (r(0)*dd2+temp169)*temp169b0 + (r(0)*dd4+temp168)*& +& temp168b1 + dd4*temp170b0 + dd2*temp171b0 + dd3b = distp(0, 2)*dd4*temp168b0 + distp(0, 2)*fun0b + dd4**2*& +& temp170b + dd4b = distp(0, 2)*dd3*temp168b0 + r(0)**2*temp168b1 + r(0)*& +& temp170b0 + dd3*2*dd4*temp170b + distpb = 0.0_8 + distpb(0, 1) = dd2*temp169b + distpb(0, 2) = dd4*dd3*temp168b0 + distpb(0, 1) = distpb(0, 1) + fun0b + distpb(0, 2) = distpb(0, 2) + dd3*fun0b + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + dd3b = 0.0_8 + dd4b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=indtm,i0,-1 + temp168b = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& +& indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp168b + dd3b = dd3b + distp(i, 2)*temp168b + distpb(i, 2) = distpb(i, 2) + dd3*temp168b + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO k=indtm,indtmin,-1 + temp166 = dd4*r(k) + 1.d0 + temp167 = temp166**3 + temp166b = -(3*temp166**2*distpb(k, 2)/temp167**2) + dd4b = dd4b + r(k)*temp166b + distpb(k, 2) = 0.0_8 + temp164 = dd2*r(k) + 1.d0 + temp165 = temp164**3 + temp164b4 = -(3*temp164**2*distpb(k, 1)/temp165**2) + rb(k) = rb(k) + dd2*temp164b4 + dd4*temp166b + dd2b = dd2b + r(k)*temp164b4 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+3) = ddb(indpar+3) + dd4b + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (135) +! 2p single exponential r^4 e^{-z r} ! + dd2 = dd(indpar+1) + DO k=indtmin,indtm + distp(k, 1) = DEXP(-(dd2*r(k))) + END DO +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN + fun = distp(0, 1)*(4.d0-dd2*r(0))*r(0)**2 + fun2 = distp(0, 1)*(12*r(0)**2-8*dd2*r(0)**3+dd2**2*r(0)**4) +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp174b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp174b0 + fun2b = fun2b + temp174b0 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp174b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp174b + funb0 = funb0 + rmu(ic, 0)*temp174b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + distpb = 0.0_8 + temp173 = r(0)**4 + temp172 = r(0)**3 + temp172b3 = distp(0, 1)*fun2b + temp172b4 = (4.d0-dd2*r(0))*funb0 + distpb(0, 1) = r(0)**2*temp172b4 + r(0)**4*fun0b + (12*r(0)**2-8*(& +& dd2*temp172)+dd2**2*temp173)*fun2b + temp172b5 = distp(0, 1)*r(0)**2*funb0 + rb(0) = rb(0) + distp(0, 1)*2*r(0)*temp172b4 - dd2*temp172b5 + & +& distp(0, 1)*4*r(0)**3*fun0b + (dd2**2*4*r(0)**3-8*dd2*3*r(0)**2+& +& 12*2*r(0))*temp172b3 + dd2b = (temp173*2*dd2-8*temp172)*temp172b3 - r(0)*temp172b5 + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=indtm,i0,-1 + temp172b2 = r(i)**4*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp172b2 + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp172b2 + rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*4*r(i)**3*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO k=indtm,indtmin,-1 + temp172b1 = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp172b1 + rb(k) = rb(k) - dd2*temp172b1 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (114) +! 2s without cusp condition +! dd1*( dd3 +r^2/(1+dd2*r)^3) + dd2 = dd(indpar+1) + indorbp = indorb + 1 +! endif + IF (typec .NE. 1) THEN + fun = (2.d0-dd2*r(0))/(1+dd2*r(0))**4 + fun2b = zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + temp177 = (dd2*r(0)+1)**5 + temp177b = 2.d0*fun2b/temp177 + temp177b0 = 2*dd2*r(0)*temp177b + temp177b1 = -(((dd2*r(0))**2-4.d0*(dd2*r(0))+1.d0)*5*(dd2*r(0)+1)& +& **4*temp177b/temp177) + temp176 = (dd2*r(0)+1)**4 + temp176b = funb0/temp176 + temp176b0 = -((2.d0-dd2*r(0))*4*(dd2*r(0)+1)**3*temp176b/temp176) + dd2b = r(0)*temp176b0 - r(0)*temp176b + r(0)*temp177b1 - 4.d0*r(0)& +& *temp177b + r(0)*temp177b0 + rb(0) = rb(0) + dd2*temp176b0 - dd2*temp176b + dd2*temp177b1 - & +& 4.d0*dd2*temp177b + dd2*temp177b0 + ELSE + dd2b = 0.0_8 + END IF + distpb = 0.0_8 + dd3b = 0.0_8 + DO i=indtm,i0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + DO k=indtm,indtmin,-1 + temp174 = dd2*r(k) + 1.d0 + temp175 = temp174**3 + temp174b1 = -(r(k)**2*3*temp174**2*distpb(k, 1)/temp175**2) + rb(k) = rb(k) + dd2*temp174b1 + 2*r(k)*distpb(k, 1)/temp175 + dd2b = dd2b + r(k)*temp174b1 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (63) +! R(r)=c x*exp(-z*r**2)*r (c1 - r^2) + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then + c = dd1**1.75d0*1.2749263037197753d0 +! c=2.d0/pi**0.75d0*(2.d0*dd1)**1.75d0/dsqrt(5.d0) +! endif + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + END DO + c1 = 1.75d0/dd1 +! indorbp=indorb +! + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN + rp1 = dd1*r(0)**2 + cost = 2.d0*rp1 + fun = distp(0, 1)*(c1*(1.d0-cost)/r(0)+(-3.d0+cost)*r(0)) +! My bug !!! +! fun2=distp(0,1)*(c1*2.d0*dd1*fun0*(cost-3.d0) +! &-2.d0*r(0)*(3.d0-7.d0*rp1+2.d0*rp1**2)) + fun2 = -(2.d0*distp(0, 1)*r(0)*(3.d0-7.d0*rp1+2.d0*rp1**2+c1*dd1*(& +& 3.d0-cost))) +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp181b3 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp181b3 + fun2b = fun2b + temp181b3 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp181b2 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp181b2 + funb0 = funb0 + rmu(ic, 0)*temp181b2 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + distpb = 0.0_8 + temp181b = -(2.d0*(2.d0*rp1**2-7.d0*rp1+c1*dd1*(3.d0-cost)+3.d0)*& +& fun2b) + temp181b0 = -(2.d0*distp(0, 1)*r(0)*fun2b) + temp180 = c1*(-cost+1.d0)/r(0) + temp180b1 = (c1-r(0)**2)*fun0b + distpb(0, 1) = (temp180+(cost-3.d0)*r(0))*funb0 + r(0)*temp180b1 +& +& r(0)*temp181b + temp181b1 = distp(0, 1)*funb0 + temp180b2 = temp181b1/r(0) + costb = r(0)*temp181b1 - c1*temp180b2 - c1*dd1*temp181b0 + rp1b = 2.d0*costb + (2.d0*2*rp1-7.d0)*temp181b0 + temp180b3 = distp(0, 1)*r(0)*fun0b + rb(0) = rb(0) + (cost-3.d0)*temp181b1 - temp180*temp180b2 + dd1*2*& +& r(0)*rp1b - 2*r(0)*temp180b3 + distp(0, 1)*temp180b1 + distp(0, & +& 1)*temp181b + c1b = (1.d0-cost)*temp180b2 + temp180b3 + (3.d0-cost)*dd1*& +& temp181b0 + dd1b = r(0)**2*rp1b + (3.d0-cost)*c1*temp181b0 + ELSE + distpb = 0.0_8 + c1b = 0.0_8 + dd1b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=indtm,i0,-1 + temp179 = c1 - r(i)**2 + temp180b = rmu(ic, i)*temp179*zb(indorbp, i) + temp180b0 = distp(i, 1)*r(i)*zb(indorbp, i) + temp179b = rmu(ic, i)*temp180b0 + distpb(i, 1) = distpb(i, 1) + r(i)*temp180b + rb(i) = rb(i) + distp(i, 1)*temp180b - 2*r(i)*temp179b + rmub(ic, i) = rmub(ic, i) + temp179*temp180b0 + c1b = c1b + temp179b + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + dd1b = dd1b - 1.75d0*c1b/dd1**2 + cb = 0.0_8 + DO k=indtm,indtmin,-1 + temp178 = r(k)**2 + temp178b = c*DEXP(-(dd1*temp178))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp178))*distpb(k, 1) + dd1b = dd1b - temp178*temp178b + rb(k) = rb(k) - dd1*2*r(k)*temp178b + distpb(k, 1) = 0.0_8 + END DO + dd1b = dd1b + 1.2749263037197753d0*1.75d0*dd1**0.75D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (148) +! derivative of 147 with respect to dd1 + dd1 = dd(indpar+1) + DO k=indtmin,indtm + distp(k, 1) = DEXP(-(dd1*r(k)**2)) + END DO DO i=indtmin,indtm CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = distp(i, 1)*r(i) + distp(i, 3) = -(r(i)**2*distp(i, 1)) CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) -! lz=0 distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) -! lz=+/ distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) -! lz=+/-2 distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) -! lz=+/-1 distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) -! lz=+/-1 distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d END DO -! indorbp=indorb +! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN fun0 = distp(0, 3) - fun = -(dd1*distp(0, 3)) + distp(0, 1) - fun2 = dd1**2*distp(0, 3) - 2.d0*dd1*distp(0, 1) -! indorbp=indorb + fun = 2.d0*(dd1*r(0)**2-1.d0)*r(0)*distp(0, 1) + fun2 = -(2.d0*(2.d0*dd1**2*r(0)**4+1.d0-5.d0*dd1*r(0)**2)*distp(0& +& , 1)) +! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN @@ -9016,18 +9537,18 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=5,1,-1 - temp300 = fun/r(0) - temp301b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp300b3 = 6.d0*temp301b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp300+fun2)*zb(& + temp183 = fun/r(0) + temp184b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp183b3 = 6.d0*temp184b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp183+fun2)*zb(& & indorbp, indt+4) - funb = funb + temp300b3 - rb(0) = rb(0) - temp300*temp300b3 - fun2b = fun2b + temp301b + funb0 = funb0 + temp183b3 + rb(0) = rb(0) - temp183*temp183b3 + fun2b = fun2b + temp184b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -9035,24 +9556,24 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN IF (branch .LT. 2) THEN - temp300b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp300b - fun0b = fun0b + rmu(i, 0)*temp300b + temp183b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp183b + fun0b = fun0b + rmu(i, 0)*temp183b ELSE - temp300b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp300b0 - fun0b = fun0b + rmu(i, 0)*temp300b0 + temp183b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp183b0 + fun0b = fun0b + rmu(i, 0)*temp183b0 END IF ELSE IF (branch .LT. 4) THEN - temp300b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp300b1 - fun0b = fun0b + rmu(i, 0)*temp300b1 + temp183b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp183b1 + fun0b = fun0b + rmu(i, 0)*temp183b1 END IF ELSE IF (branch .LT. 7) THEN IF (branch .LT. 6) THEN - temp300b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp300b2 - fun0b = fun0b + rmu(i, 0)*temp300b2 + temp183b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp183b2 + fun0b = fun0b + rmu(i, 0)*temp183b2 ELSE rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) @@ -9082,23 +9603,29 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp299 = fun/r(0) - temp299b1 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp299*rmu(i, 0)*zb(& + temp182 = fun/r(0) + temp182b = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp182*rmu(i, 0)*zb(& & indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp299*distp(0, 3+ic)*zb(indorbp, & + rmub(i, 0) = rmub(i, 0) + temp182*distp(0, 3+ic)*zb(indorbp, & & indt+i) - funb = funb + temp299b1 - rb(0) = rb(0) - temp299*temp299b1 + funb0 = funb0 + temp182b + rb(0) = rb(0) - temp182*temp182b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - dd1b = (distp(0, 3)*2*dd1-2.d0*distp(0, 1))*fun2b - distp(0, 3)*& -& funb - distpb(0, 3) = distpb(0, 3) + dd1**2*fun2b - distpb(0, 1) = distpb(0, 1) + funb - 2.d0*dd1*fun2b - distpb(0, 3) = distpb(0, 3) + fun0b - dd1*funb + temp181 = r(0)**4 + temp181b5 = -(2.d0*distp(0, 1)*fun2b) + temp181b6 = 2.d0*r(0)*distp(0, 1)*funb0 + dd1b = r(0)**2*temp181b6 + (2.d0*temp181*2*dd1-5.d0*r(0)**2)*& +& temp181b5 + temp181b7 = 2.d0*(dd1*r(0)**2-1.d0)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp181b6 + distp(0, 1)*temp181b7 + (& +& 2.d0*dd1**2*4*r(0)**3-5.d0*dd1*2*r(0))*temp181b5 + distpb(0, 1) = distpb(0, 1) + r(0)*temp181b7 - 2.d0*(2.d0*(dd1**2*& +& temp181)-5.d0*(dd1*r(0)**2)+1.d0)*fun2b + distpb(0, 3) = distpb(0, 3) + fun0b ELSE distpb = 0.0_8 dd1b = 0.0_8 @@ -9133,472 +9660,287 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) distpb(i, 4) = 0.0_8 CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distpb(i, 1) = distpb(i, 1) + r(i)*distpb(i, 3) - rb(i) = rb(i) + distp(i, 1)*distpb(i, 3) + rb(i) = rb(i) - distp(i, 1)*2*r(i)*distpb(i, 3) + distpb(i, 1) = distpb(i, 1) - r(i)**2*distpb(i, 3) distpb(i, 3) = 0.0_8 END DO - cb = 0.0_8 DO k=indtm,indtmin,-1 - temp299b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp299b0 - rb(k) = rb(k) - dd1*temp299b0 + temp181b4 = DEXP(-(dd1*r(k)**2))*distpb(k, 1) + dd1b = dd1b - r(k)**2*temp181b4 + rb(k) = rb(k) - dd1*2*r(k)*temp181b4 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.0710812062076410d0*4.5d0*dd1**3.5D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (34) -! 2s single Z WITH CUSP zero -! normalized -! exp(-dd1*r) + dd1*r*exp(-dd1*r) -! if(iocc(indshellp).eq.1) then + CASE (12) +! R(r)=r**3*exp(-z1*r) +! +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) -! peff=dd1 -! if(iflagnorm.gt.2) then -! c=1.d0/dsqrt(1.d0/4.d0/dd1**3+12.d0*dd1/(2.d0*dd1)**4+ & -! &3.d0*dd1**2/4.d0/dd1**5)/dsqrt(4.d0*pi) -! c=dd1*dsqrt(dd1)/dsqrt(7.d0*pi) - c = dd1*DSQRT(dd1)*.2132436186229231d0 -! endif - DO i=indtmin,indtm - distp(i, 1) = c*DEXP(-(dd1*r(i))) +! if(iflagnorm.gt.2) then +! c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 + c = dd1**4.5d0*.03178848180059307346d0 +! endif + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k))) END DO IF (typec .NE. 1) THEN - fun = -(dd1**2*distp(0, 1)) - funb = 2.d0*zb(indorbp, indt+4) + rp1 = r(0)**3 + rp2 = r(0)**2 +! +!c the first derivative + fun = distp(0, 1)*(3.d0*rp2-dd1*rp1) +!c +!c the second derivative + temp185b = 2.d0*zb(indorbp, indt+4)/r(0) + funb0 = temp185b + rb(0) = rb(0) - fun*temp185b/r(0) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + temp184 = fun/r(0) + temp184b3 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(i, 0) = rmub(i, 0) + temp184*zb(indorbp, indt+i) + funb0 = funb0 + temp184b3 + rb(0) = rb(0) - temp184*temp184b3 zb(indorbp, indt+i) = 0.0_8 END DO - funb = funb + (1.d0-dd1*r(0))*fun2b - dd1b = -(distp(0, 1)*2*dd1*funb) - fun*r(0)*fun2b - rb(0) = rb(0) - fun*dd1*fun2b distpb = 0.0_8 - distpb(0, 1) = -(dd1**2*funb) + temp184b1 = distp(0, 1)*fun2b + distpb(0, 1) = (3.d0*rp2-dd1*rp1)*funb0 + (6.d0*r(0)-6.d0*(dd1*rp2& +& )+dd1**2*rp1)*fun2b + temp184b2 = distp(0, 1)*funb0 + rp2b = 3.d0*temp184b2 - 6.d0*dd1*temp184b1 + rp1b = dd1**2*temp184b1 - dd1*temp184b2 + rb(0) = rb(0) + 2*r(0)*rp2b + 3*r(0)**2*rp1b + 6.d0*temp184b1 + dd1b = (rp1*2*dd1-6.d0*rp2)*temp184b1 - rp1*temp184b2 ELSE distpb = 0.0_8 dd1b = 0.0_8 END IF DO i=indtm,i0,-1 - temp302b0 = distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + (r(i)*dd1+1.d0)*zb(indorbp, i) - rb(i) = rb(i) + dd1*temp302b0 - dd1b = dd1b + r(i)*temp302b0 + distpb(i, 1) = distpb(i, 1) + r(i)**3*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*3*r(i)**2*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO cb = 0.0_8 - DO i=indtm,indtmin,-1 - temp302b = c*DEXP(-(dd1*r(i)))*distpb(i, 1) - cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) - dd1b = dd1b - r(i)*temp302b - rb(i) = rb(i) - dd1*temp302b - distpb(i, 1) = 0.0_8 + DO k=indtm,indtmin,-1 + temp184b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp184b0 + rb(k) = rb(k) - dd1*temp184b0 + distpb(k, 1) = 0.0_8 END DO - temp301 = DSQRT(dd1) - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + .2132436186229231d0*temp301*cb - ELSE - dd1b = dd1b + (.2132436186229231d0*dd1/(2.D0*DSQRT(dd1))+& -& .2132436186229231d0*temp301)*cb - END IF + dd1b = dd1b + .03178848180059307346d0*4.5d0*dd1**3.5D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (35) -! 2s single Z WITH CUSP -! normalized -! exp(-dd1*r) + dd1* r * exp(-dd2*r) -! if(iocc(indshellp).eq.1) then + CASE (1000:1099) +! +! 4s double zeta +! s gaussian r**(2*npower)*exp(-alpha*r**2) + npower = iopt - 1000 indorbp = indorb + 1 - dd1 = dd(indpar+1) - dd2 = dd(indpar+2) - peff = dd1 + dd2 = dd(indpar+1) DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k))) - distp(k, 2) = DEXP(-(dd2*r(k))) + distp(k, 1) = r(k)**(2*npower)*DEXP(-(dd2*r(k)**2)) END DO -! if(iflagnorm.gt.2) then - c = 1.d0/DSQRT(1/4.d0/dd1**3+12*peff/(dd1+dd2)**4+3*peff**2/4/dd2**5& -& )/DSQRT(4.0*pi) +! endif IF (typec .NE. 1) THEN - fun = -(dd1*distp(0, 1)) + peff*distp(0, 2)*(1.d0-dd2*r(0)) - fun2 = distp(0, 1)*dd1**2 + peff*distp(0, 2)*(dd2**2*r(0)-2.d0*dd2& -& ) - temp310 = fun/r(0) - temp310b = c*2.d0*zb(indorbp, indt+4)/r(0) - cb = (2.d0*temp310+fun2)*zb(indorbp, indt+4) - funb = temp310b - rb(0) = rb(0) - temp310*temp310b - fun2b = c*zb(indorbp, indt+4) + rp1 = r(0)**2 + fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - temp309 = rmu(i, 0)/r(0) - temp309b5 = fun*c*zb(indorbp, indt+i)/r(0) - funb = funb + temp309*c*zb(indorbp, indt+i) - cb = cb + temp309*fun*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp309b5 - rb(0) = rb(0) - temp309*temp309b5 + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp309b1 = (dd2**2*r(0)-2.d0*dd2)*fun2b - temp309b2 = peff*distp(0, 2)*fun2b - distpb(0, 1) = dd1**2*fun2b - dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb - temp309b3 = (1.d0-dd2*r(0))*funb - peffb = distp(0, 2)*temp309b3 + distp(0, 2)*temp309b1 - distpb(0, 2) = peff*temp309b3 + peff*temp309b1 - temp309b4 = peff*distp(0, 2)*funb - dd2b = (r(0)*2*dd2-2.d0)*temp309b2 - r(0)*temp309b4 - rb(0) = rb(0) + dd2**2*temp309b2 - dd2*temp309b4 - distpb(0, 1) = distpb(0, 1) - dd1*funb + temp188 = distp(0, 1)/rp1 + temp189b = 2.d0*temp188*fun2b + temp189b0 = -((npower*4.d0+1.d0)*temp189b) + temp188b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& +& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 + temp187 = distp(0, 1)/rp1 + temp188b0 = 2.d0*temp187*funb0 + dd2b = rp1*temp189b0 - rp1*temp188b0 + 2.d0*rp1**2*2*dd2*temp189b + temp187b = 2.d0*(npower-dd2*rp1)*funb0/rp1 + rp1b = dd2*temp189b0 - temp187*temp187b - temp188*temp188b - dd2*& +& temp188b0 + 2.d0*dd2**2*2*rp1*temp189b + distpb(0, 1) = temp187b + temp188b + rb(0) = rb(0) + 2*r(0)*rp1b ELSE distpb = 0.0_8 - peffb = 0.0_8 - dd1b = 0.0_8 dd2b = 0.0_8 - cb = 0.0_8 END IF DO i=indtm,i0,-1 - temp309b = c*zb(indorbp, i) - temp309b0 = distp(i, 2)*temp309b - cb = cb + (distp(i, 1)+r(i)*peff*distp(i, 2))*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp309b - rb(i) = rb(i) + peff*temp309b0 - peffb = peffb + r(i)*temp309b0 - distpb(i, 2) = distpb(i, 2) + r(i)*peff*temp309b + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO - temp308 = 4*dd2**5 - temp302 = peff**2/temp308 - temp307 = (dd1+dd2)**4 - temp306 = 4.d0*dd1**3 - temp303 = 1.0/temp306 + 12*(peff/temp307) + 3*temp302 - temp305 = DSQRT(temp303) - temp304 = DSQRT(4.0*pi) - IF (temp303 .EQ. 0.0) THEN - temp303b = 0.0 - ELSE - temp303b = -(cb/(temp304*temp305**2*2.D0*DSQRT(temp303))) - END IF - temp303b0 = 12*temp303b/temp307 - temp303b1 = -(peff*4*(dd1+dd2)**3*temp303b0/temp307) - temp302b3 = 3*temp303b/temp308 - dd1b = dd1b + temp303b1 - 4.d0*3*dd1**2*temp303b/temp306**2 - peffb = peffb + 2*peff*temp302b3 + temp303b0 - dd2b = dd2b + temp303b1 - temp302*4*5*dd2**4*temp302b3 DO k=indtm,indtmin,-1 - temp302b1 = DEXP(-(dd2*r(k)))*distpb(k, 2) - dd2b = dd2b - r(k)*temp302b1 - distpb(k, 2) = 0.0_8 - temp302b2 = DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd1*temp302b2 - dd2*temp302b1 - dd1b = dd1b - r(k)*temp302b2 + temp186 = r(k)**2 + temp185 = 2*npower + temp185b0 = r(k)**temp185*DEXP(-(dd2*temp186))*distpb(k, 1) + IF (r(k) .LE. 0.0 .AND. (temp185 .EQ. 0.0 .OR. temp185 .NE. INT(& +& temp185))) THEN + rb(k) = rb(k) - dd2*2*r(k)*temp185b0 + ELSE + rb(k) = rb(k) + DEXP(-(dd2*temp186))*temp185*r(k)**(temp185-1)*& +& distpb(k, 1) - dd2*2*r(k)*temp185b0 + END IF + dd2b = dd2b - temp186*temp185b0 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + peffb - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (36) -! single gaussian p orbitals - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0 - c = dd1**1.25d0*1.42541094070998d0 -! endif + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (144) +! 2p single exponential -r^3 e^{-z r} ! derivative of 130 + dd2 = dd(indpar+1) DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + distp(k, 1) = -DEXP(-(dd2*r(k))) END DO -! indorbp=indorb -! +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) -! indorbp=indorb + fun = distp(0, 1)*(3.d0-dd2*r(0))*r(0) +! fun= derivative of fun0 respect to r divided dy r + fun2 = distp(0, 1)*(dd2**2*r(0)**3-6*dd2*r(0)**2+6*r(0)) +! fun2= second derivative of fun0 respect to r +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp312b1 = rmu(ic, 0)*zb(indorbp, indt+4) + temp190b0 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp312b1 - fun2b = fun2b + temp312b1 + funb0 = funb0 + 4.d0*temp190b0 + fun2b = fun2b + temp190b0 zb(indorbp, indt+4) = 0.0_8 - fun0b = fun0b + zb(indorbp, indt+ic) DO i=3,1,-1 - temp312b0 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp312b0 - funb = funb + rmu(ic, 0)*temp312b0 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp190b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp190b + funb0 = funb0 + rmu(ic, 0)*temp190b rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp312b = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp312b - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp312b distpb = 0.0_8 - distpb(0, 1) = fun0b - 2.d0*dd1*funb + temp189 = r(0)**3 + temp189b3 = distp(0, 1)*fun2b + temp189b4 = (3.d0-dd2*r(0))*funb0 + distpb(0, 1) = r(0)*temp189b4 + r(0)**3*fun0b + (dd2**2*temp189-6*& +& (dd2*r(0)**2)+6*r(0))*fun2b + temp189b5 = distp(0, 1)*r(0)*funb0 + dd2b = (temp189*2*dd2-6*r(0)**2)*temp189b3 - r(0)*temp189b5 + rb(0) = rb(0) + distp(0, 1)*temp189b4 - dd2*temp189b5 + distp(0, 1& +& )*3*r(0)**2*fun0b + (dd2**2*3*r(0)**2-6*dd2*2*r(0)+6)*temp189b3 ELSE distpb = 0.0_8 - dd1b = 0.0_8 + dd2b = 0.0_8 END IF DO ic=3,1,-1 DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + temp189b2 = r(i)**3*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp189b2 + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp189b2 + rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*3*r(i)**2*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - cb = 0.0_8 - DO k=indtm,indtmin,-1 - temp311 = r(k)**2 - temp311b = c*DEXP(-(dd1*temp311))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp311))*distpb(k, 1) - dd1b = dd1b - temp311*temp311b - rb(k) = rb(k) - dd1*2*r(k)*temp311b - distpb(k, 1) = 0.0_8 - END DO - dd1b = dd1b + 1.42541094070998d0*1.25d0*dd1**0.25D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (37, 68) -! d orbitals -! R(r)= exp(-alpha r^2) -! each gaussian term is normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) - c = dd1**1.75d0*1.64592278064948967213d0 -! endif - DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) - END DO - DO i=indtmin,indtm -! lz=0 - distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d -! lz=+/-2 - distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d -! lz=+/-2 - distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d -! lz=+/-1 - distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d -! lz=+/-1 - distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d - END DO - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1) - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) -! indorbp=indorb - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - IF (ic .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) - ELSE IF (ic .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (ic .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE IF (ic .EQ. 4) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (ic .EQ. 5) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - END DO - distpb = 0.0_8 - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=5,1,-1 - temp313b6 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 6.d0*temp313b6 - fun2b = fun2b + temp313b6 - zb(indorbp, indt+4) = 0.0_8 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - IF (branch .LT. 1) THEN - temp313b1 = cost1d*4.d0*zb(indorbp, indt+3) - rmub(3, 0) = rmub(3, 0) + fun0*temp313b1 - temp313b2 = -(cost1d*2.d0*zb(indorbp, indt+2)) - temp313b3 = -(cost1d*2.d0*zb(indorbp, indt+1)) - fun0b = fun0b + rmu(2, 0)*temp313b2 + rmu(1, 0)*temp313b3 & -& + rmu(3, 0)*temp313b1 - rmub(2, 0) = rmub(2, 0) + fun0*temp313b2 - rmub(1, 0) = rmub(1, 0) + fun0*temp313b3 - ELSE - temp313b4 = -(cost2d*2.d0*zb(indorbp, indt+2)) - rmub(2, 0) = rmub(2, 0) + fun0*temp313b4 - temp313b5 = cost2d*2.d0*zb(indorbp, indt+1) - fun0b = fun0b + rmu(1, 0)*temp313b5 + rmu(2, 0)*temp313b4 - rmub(1, 0) = rmub(1, 0) + fun0*temp313b5 - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+2) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+1) + & -& cost3d*rmu(1, 0)*zb(indorbp, indt+2) - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+1) - END IF - ELSE IF (branch .LT. 5) THEN - IF (branch .LT. 4) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+2) + & -& cost3d*rmu(2, 0)*zb(indorbp, indt+3) - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+2) - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+1) + cost3d*& -& rmu(1, 0)*zb(indorbp, indt+3) - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+1) - END IF - DO i=3,1,-1 - temp313b0 = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp313b0 - funb = funb + rmu(i, 0)*temp313b0 - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - temp313b = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp313b - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp313b - distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b - ELSE - distpb = 0.0_8 - END IF - DO ic=5,1,-1 - DO k=indtm,i0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) - zb(indorbp, k) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO i=indtm,indtmin,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) - distpb(i, 2) = 0.0_8 - END DO - dd1b = 0.0_8 - cb = 0.0_8 DO k=indtm,indtmin,-1 - temp312 = r(k)**2 - temp312b2 = c*DEXP(-(dd1*temp312))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp312))*distpb(k, 1) - dd1b = dd1b - temp312*temp312b2 - rb(k) = rb(k) - dd1*2*r(k)*temp312b2 + temp189b1 = -(DEXP(-(dd2*r(k)))*distpb(k, 1)) + dd2b = dd2b - r(k)*temp189b1 + rb(k) = rb(k) - dd2*temp189b1 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 1.64592278064948967213d0*1.75d0*dd1**0.75D0*cb - ddb(indparp) = ddb(indparp) + dd1b - CASE (47) -! d orbitals cartesian !!! -! R(r)= exp(-alpha r^2) -! each gaussian term is normalized -! indorbp=indorb + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (70) +! f single Slater orbital +! R(r)= exp(-alpha r) +! normalized +! indorbp=indorb indparp = indpar + 1 dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization - c = dd1**1.75d0*1.64592278064948967213d0 -! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) -! endif +! if(iflagnorm.gt.2) then +! overall normalization +! l = 3 +! \int d\omega Y*Y = 4 pi / (2 l + 1) +! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5 * 3**2 / 2**2 / dd1**9 +! c=1.d0/dsqrt(10.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(9.d0/2.d0)/3.d0 + c = dd1**4.5d0*0.084104417400672d0 +! endif DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + distp(k, 1) = c*DEXP(-(dd1*r(k))) END DO DO i=indtmin,indtm - distp(i, 2) = rmu(1, i)**2 - distp(i, 3) = rmu(2, i)**2 - distp(i, 4) = rmu(3, i)**2 -! lz=+/-2 - distp(i, 5) = rmu(1, i)*rmu(2, i)*cost3d -! lz=+/-1 - distp(i, 6) = rmu(2, i)*rmu(3, i)*cost3d -! lz=+/-1 - distp(i, 7) = rmu(1, i)*rmu(3, i)*cost3d + distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) +! lz=0 + distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) +! lz=+/-2 + distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) +! lz=+/-2 + distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) +! lz=+/-3 + distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) END DO - DO ic=1,6 +! lz=+/-3 + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) dd1 = dd(indparp) fun0 = distp(0, 1) - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) -! indorbp=indorb - DO ic=1,6 + fun = -(dd1*distp(0, 1)/r(0)) + fun2 = dd1**2*distp(0, 1) +! indorbp=indorb + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (ic .LE. 3) THEN - IF (i .EQ. ic) THEN + IF (ic .EQ. 1) THEN + IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF - ELSE IF (ic .EQ. 4) THEN + ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF - ELSE IF (ic .EQ. 5) THEN + ELSE IF (ic .EQ. 3) THEN IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) ELSE IF (i .EQ. 3) THEN @@ -9606,328 +9948,186 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) END IF - ELSE IF (ic .EQ. 6) THEN + ELSE IF (ic .EQ. 4) THEN IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF + ELSE IF (ic .EQ. 6) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + END IF + ELSE IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) END IF END DO -!endif for ic -!enddo for i - IF (ic .LE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=6,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 2) THEN - temp314b1 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 6.d0*temp314b1 - fun2b = fun2b + temp314b1 - distpb(0, 1) = distpb(0, 1) + 2.d0*zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - ELSE - temp314b2 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 6.d0*temp314b2 - fun2b = fun2b + temp314b2 - zb(indorbp, indt+4) = 0.0_8 - END IF + DO ic=7,1,-1 + temp191b23 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 8.d0*temp191b23 + fun2b = fun2b + temp191b23 + zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 7) THEN - IF (branch .LT. 4) THEN - IF (branch .LT. 3) THEN - IF (.NOT.branch .LT. 2) THEN - rmub(i, 0) = rmub(i, 0) + 2.d0*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + 2.d0*rmu(i, 0)*zb(indorbp, indt+i) + IF (branch .LT. 11) THEN + IF (branch .LT. 6) THEN + IF (branch .LT. 4) THEN + IF (branch .LT. 3) THEN + IF (.NOT.branch .LT. 2) THEN + temp191b2 = cost1f*zb(indorbp, indt+i) + fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& +& temp191b2 + rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& +& temp191b2 + rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp191b2 + END IF + temp191b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) + temp191b1 = rmu(i, 0)*temp191b0 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp191b0 + fun0b = fun0b + rmu(3, 0)*temp191b1 + rmub(3, 0) = rmub(3, 0) + fun0*temp191b1 + GOTO 110 + ELSE + temp191b5 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp191b5 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp191b5 + rb(0) = rb(0) - fun0*2*r(0)*temp191b5 END IF - ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + ELSE IF (.NOT.branch .LT. 5) THEN + temp191b6 = cost2f*10.d0*zb(indorbp, indt+i) + temp191b7 = rmu(i, 0)*temp191b6 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp191b6 + fun0b = fun0b + rmu(1, 0)*temp191b7 + rmub(1, 0) = rmub(1, 0) + fun0*temp191b7 END IF - ELSE IF (branch .LT. 6) THEN - IF (.NOT.branch .LT. 5) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + temp191b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp191b4 = rmu(i, 0)*temp191b3 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp191b3 + fun0b = fun0b + rmu(1, 0)*temp191b4 + rmub(1, 0) = rmub(1, 0) + fun0*temp191b4 + ELSE IF (branch .LT. 9) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 7) THEN + temp191b10 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp191b10 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp191b10 + rb(0) = rb(0) - fun0*2*r(0)*temp191b10 + END IF + ELSE + temp191b11 = cost2f*10.d0*zb(indorbp, indt+i) + temp191b12 = rmu(i, 0)*temp191b11 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp191b11 + fun0b = fun0b + rmu(2, 0)*temp191b12 + rmub(2, 0) = rmub(2, 0) + fun0*temp191b12 END IF + temp191b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp191b9 = rmu(i, 0)*temp191b8 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp191b8 + fun0b = fun0b + rmu(2, 0)*temp191b9 + rmub(2, 0) = rmub(2, 0) + fun0*temp191b9 + ELSE IF (branch .LT. 10) THEN + temp191b13 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp191b13 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp191b13 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp191b13 ELSE - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + temp191b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp191b14 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp191b14 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp191b14 END IF - ELSE IF (branch .LT. 10) THEN - IF (branch .LT. 9) THEN - IF (.NOT.branch .LT. 8) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 16) THEN + IF (branch .LT. 14) THEN + IF (branch .LT. 13) THEN + IF (branch .LT. 12) THEN + temp191b15 = cost3f*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp191b15 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp191b15 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp191b15 + ELSE + temp191b16 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp191b16 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp191b16 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp191b16 + END IF + ELSE + temp191b17 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp191b17 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp191b17 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp191b17 END IF + ELSE IF (branch .LT. 15) THEN + temp191b18 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp191b18 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp191b18 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp191b18 + ELSE + temp191b19 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp191b19 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp191b19 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp191b19 END IF - ELSE IF (branch .LT. 12) THEN - IF (branch .LT. 11) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - temp314b0 = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp314b0 - funb = funb + rmu(i, 0)*temp314b0 - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - temp314b = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp314b - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp314b - distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b - ELSE - distpb = 0.0_8 - END IF - DO ic=6,1,-1 - DO k=indtm,i0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) - zb(indorbp, k) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO i=indtm,indtmin,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 7) - distpb(i, 7) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 6) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - rmub(3, i) = rmub(3, i) + 2*rmu(3, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - rmub(2, i) = rmub(2, i) + 2*rmu(2, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*distpb(i, 2) - distpb(i, 2) = 0.0_8 - END DO - dd1b = 0.0_8 - cb = 0.0_8 - DO k=indtm,indtmin,-1 - temp313 = r(k)**2 - temp313b7 = c*DEXP(-(dd1*temp313))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp313))*distpb(k, 1) - dd1b = dd1b - temp313*temp313b7 - rb(k) = rb(k) - dd1*2*r(k)*temp313b7 - distpb(k, 1) = 0.0_8 - END DO - dd1b = dd1b + 1.64592278064948967213d0*1.75d0*dd1**0.75D0*cb - ddb(indparp) = ddb(indparp) + dd1b - CASE (48) -! f single gaussian orbital -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) - c = dd1**2.25d0*1.47215808929909374563d0 -! endif - DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) - END DO - DO i=indtmin,indtm - distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) -! lz=0 - distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) -! lz=+/-2 - distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) -! lz=+/-2 - distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) -! lz=+/-3 - distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) - END DO -! lz=+/-3 - DO ic=1,7 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1) - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) -! indorbp=indorb - DO ic=1,7 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - IF (ic .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) - ELSE IF (ic .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (ic .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE IF (ic .EQ. 4) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (ic .EQ. 5) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - ELSE IF (ic .EQ. 6) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - END IF - END DO - distpb = 0.0_8 - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=7,1,-1 - temp315b28 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 8.d0*temp315b28 - fun2b = fun2b + temp315b28 - zb(indorbp, indt+4) = 0.0_8 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 4) THEN - IF (branch .LT. 2) THEN - IF (branch .LT. 1) THEN - temp315b9 = cost1f*zb(indorbp, indt+3) - temp315b10 = -(cost1f*6.d0*zb(indorbp, indt+2)) - temp315b11 = -(cost1f*6.d0*zb(indorbp, indt+1)) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp315b10 + rmu(3, 0)& -& *rmu(1, 0)*temp315b11 + (9.d0*rmu(3, 0)**2-3.d0*r(0)**2)& -& *temp315b9 - rmub(3, 0) = rmub(3, 0) + fun0*9.d0*2*rmu(3, 0)*temp315b9 - rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp315b9 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp315b10 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp315b10 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp315b11 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp315b11 + ELSE IF (branch .LT. 19) THEN + IF (branch .LT. 18) THEN + IF (.NOT.branch .LT. 17) THEN + temp191b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp191b20 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp191b20 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp191b20 + END IF ELSE - temp315b12 = cost2f*8.d0*zb(indorbp, indt+3) - temp315b13 = -(cost2f*2.d0*zb(indorbp, indt+2)) - fun0b = fun0b + rmu(1, 0)*rmu(2, 0)*temp315b13 + cost2f*(& -& 5.d0*rmu(3, 0)**2-r(0)**2-2.d0*rmu(1, 0)**2)*zb(indorbp& -& , indt+1) + rmu(1, 0)*rmu(3, 0)*temp315b12 - rmub(3, 0) = rmub(3, 0) + rmu(1, 0)*fun0*temp315b12 - rmub(1, 0) = rmub(1, 0) + fun0*rmu(3, 0)*temp315b12 - rmub(2, 0) = rmub(2, 0) + rmu(1, 0)*fun0*temp315b13 - rmub(1, 0) = rmub(1, 0) + fun0*rmu(2, 0)*temp315b13 - temp315b14 = cost2f*fun0*zb(indorbp, indt+1) - rmub(3, 0) = rmub(3, 0) + 5.d0*2*rmu(3, 0)*temp315b14 - rb(0) = rb(0) - 2*r(0)*temp315b14 - rmub(1, 0) = rmub(1, 0) - 2.d0*2*rmu(1, 0)*temp315b14 + temp191b21 = cost4f*6.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp191b21 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp191b21 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp191b21 END IF - ELSE IF (branch .LT. 3) THEN - temp315b15 = cost2f*8.d0*zb(indorbp, indt+3) - temp315b16 = -(cost2f*2.d0*zb(indorbp, indt+1)) - fun0b = fun0b + cost2f*(5.d0*rmu(3, 0)**2-r(0)**2-2.d0*rmu(2& -& , 0)**2)*zb(indorbp, indt+2) + rmu(2, 0)*rmu(1, 0)*& -& temp315b16 + rmu(2, 0)*rmu(3, 0)*temp315b15 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*fun0*temp315b15 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(3, 0)*temp315b15 - temp315b17 = cost2f*fun0*zb(indorbp, indt+2) - rmub(3, 0) = rmub(3, 0) + 5.d0*2*rmu(3, 0)*temp315b17 - rb(0) = rb(0) - 2*r(0)*temp315b17 - rmub(2, 0) = rmub(2, 0) - 2.d0*2*rmu(2, 0)*temp315b17 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp315b16 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp315b16 - ELSE - temp315b18 = cost3f*zb(indorbp, indt+3) - temp315b19 = -(cost3f*2.d0*zb(indorbp, indt+2)) - temp315b20 = cost3f*2.d0*zb(indorbp, indt+1) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp315b19 + rmu(3, 0)*& -& rmu(1, 0)*temp315b20 + (rmu(1, 0)**2-rmu(2, 0)**2)*& -& temp315b18 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp315b18 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp315b19 - fun0*2& -& *rmu(2, 0)*temp315b18 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp315b19 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp315b20 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp315b20 - END IF - ELSE IF (branch .LT. 6) THEN - IF (branch .LT. 5) THEN - temp315b21 = cost3f*2.d0*zb(indorbp, indt+3) - temp315b22 = cost3f*2.d0*zb(indorbp, indt+2) - temp315b23 = cost3f*2.d0*zb(indorbp, indt+1) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp315b22 + rmu(3, 0)*& -& rmu(2, 0)*temp315b23 + rmu(2, 0)*rmu(1, 0)*temp315b21 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp315b21 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp315b21 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp315b22 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp315b22 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp315b23 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp315b23 - ELSE - temp315b24 = -(cost4f*6.d0*zb(indorbp, indt+2)) - temp315b25 = cost4f*3.d0*zb(indorbp, indt+1) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp315b25 + rmu& -& (2, 0)*rmu(1, 0)*temp315b24 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp315b24 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp315b24 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp315b25 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp315b25 + ELSE IF (.NOT.branch .LT. 20) THEN + temp191b22 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp191b22 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp191b22 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp191b22 END IF - ELSE - temp315b26 = cost4f*3.d0*zb(indorbp, indt+2) - temp315b27 = cost4f*6.d0*zb(indorbp, indt+1) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp315b27 + (rmu(1, 0)**2& -& -rmu(2, 0)**2)*temp315b26 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp315b26 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp315b26 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp315b27 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp315b27 - END IF - DO i=3,1,-1 - temp315b8 = distp(0, 1+ic)*zb(indorbp, indt+i) + 110 temp191b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp315b8 - funb = funb + rmu(i, 0)*temp315b8 + rmub(i, 0) = rmub(i, 0) + fun*temp191b + funb0 = funb0 + rmu(i, 0)*temp191b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp315b7 = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp315b7 - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp315b7 - distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb + temp190b10 = -(distp(0, 1)*funb0/r(0)) + dd1b = temp190b10 + distp(0, 1)*2*dd1*fun2b + temp190 = dd1/r(0) + distpb(0, 1) = distpb(0, 1) + fun0b - temp190*funb0 + dd1**2*fun2b + rb(0) = rb(0) - temp190*temp190b10 CALL POPREAL8(adr8ibuf,adr8buf,dd1) ddb(indparp) = ddb(indparp) + dd1b ELSE @@ -9942,433 +10142,766 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 - temp315b = cost4f*rmu(2, i)*distpb(i, 8) + temp190b2 = cost4f*rmu(2, i)*distpb(i, 8) rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 8) - 2*rmu(2, i)*temp315b +& distpb(i, 8) - 2*rmu(2, i)*temp190b2 distpb(i, 8) = 0.0_8 - temp315b0 = cost4f*rmu(1, i)*distpb(i, 7) + temp190b3 = cost4f*rmu(1, i)*distpb(i, 7) rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& -& distpb(i, 7) + 2*rmu(1, i)*temp315b0 + 3.d0*2*rmu(1, i)*temp315b - rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp315b0 +& distpb(i, 7) + 2*rmu(1, i)*temp190b3 + 3.d0*2*rmu(1, i)*& +& temp190b2 + rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp190b3 distpb(i, 7) = 0.0_8 - temp315b1 = cost3f*2.d0*distpb(i, 6) - temp315b2 = rmu(2, i)*temp315b1 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp315b2 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp315b2 - rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp315b1 + temp190b4 = cost3f*2.d0*distpb(i, 6) + temp190b5 = rmu(2, i)*temp190b4 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp190b5 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp190b5 + rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp190b4 distpb(i, 6) = 0.0_8 - temp315b3 = cost3f*rmu(3, i)*distpb(i, 5) + temp190b6 = cost3f*rmu(3, i)*distpb(i, 5) rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& & distpb(i, 5) - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp315b3 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp190b6 distpb(i, 5) = 0.0_8 rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 4) - 2*rmu(2, i)*temp315b3 - temp315b4 = cost2f*rmu(2, i)*distpb(i, 4) - rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp315b4 +& distpb(i, 4) - 2*rmu(2, i)*temp190b6 + temp190b7 = cost2f*rmu(2, i)*distpb(i, 4) + rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp190b7 distpb(i, 4) = 0.0_8 - temp315b5 = cost2f*rmu(1, i)*distpb(i, 3) + temp190b8 = cost2f*rmu(1, i)*distpb(i, 3) rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& & distpb(i, 3) distpb(i, 3) = 0.0_8 - temp315b6 = cost1f*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - 2*r(i)*temp315b5 - 3.d0*2*r(i)*temp315b6 - 2*r(i)*& -& temp315b4 + temp190b9 = cost1f*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - 2*r(i)*temp190b8 - 3.d0*2*r(i)*temp190b9 - 2*r(i)*& +& temp190b7 rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& -& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp315b6 + 5.d0*2*rmu(3, i)*& -& temp315b5 +& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp190b9 + 5.d0*2*rmu(3, i)*& +& temp190b8 distpb(i, 2) = 0.0_8 END DO dd1b = 0.0_8 cb = 0.0_8 DO k=indtm,indtmin,-1 - temp314 = r(k)**2 - temp314b3 = c*DEXP(-(dd1*temp314))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp314))*distpb(k, 1) - dd1b = dd1b - temp314*temp314b3 - rb(k) = rb(k) - dd1*2*r(k)*temp314b3 + temp190b1 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp190b1 + rb(k) = rb(k) - dd1*temp190b1 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 1.47215808929909374563d0*2.25d0*dd1**1.25D0*cb + dd1b = dd1b + 0.084104417400672d0*4.5d0*dd1**3.5D0*cb ddb(indparp) = ddb(indparp) + dd1b - CASE (49) -! derivative of 48 with respect to z -! f orbitals -! R(r)= c*exp(-z r^2)*(9/4/z-r^2) -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) - c = dd1**2.25d0*1.47215808929909374563d0 -! endif + CASE (100) +! 2s single gaussian +! exp(-dd2*r^2) + dd2 = dd(indpar+1) + indorbp = indorb + 1 DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) - END DO - DO i=indtmin,indtm - distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) -! lz=0 - distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) -! lz=+/-2 - distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) -! lz=+/-2 - distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) -! lz=+/-3 - distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) - END DO -! lz=+/-3 - DO ic=1,7 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic + distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) END DO -! endif +! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1)*(9.d0/4.d0/dd1-r(0)**2) - fun = distp(0, 1)*(2.d0*dd1*r(0)**2-13.d0/2.d0) - fun2 = distp(0, 1)*(-(4.d0*dd1**2*r(0)**4)+19.d0*dd1*r(0)**2-13.d0& -& /2.d0) -! indorbp=indorb - DO ic=1,7 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 + fun = -(dd2*distp(0, 1)*2.d0) + distpb = 0.0_8 + temp191b25 = 2.d0**2*dd2*distp(0, 1)*zb(indorbp, indt+4) + temp191b26 = 2.d0*(2.d0*(dd2*r(0)**2)-3.d0)*zb(indorbp, indt+4) + dd2b = distp(0, 1)*temp191b26 + r(0)**2*temp191b25 + rb(0) = rb(0) + dd2*2*r(0)*temp191b25 + distpb(0, 1) = dd2*temp191b26 + zb(indorbp, indt+4) = 0.0_8 + funb0 = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + dd2b = dd2b - 2.d0*distp(0, 1)*funb0 + distpb(0, 1) = distpb(0, 1) - 2.d0*dd2*funb0 + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO i=indtm,i0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + DO k=indtm,indtmin,-1 + temp191b24 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp191b24 + rb(k) = rb(k) - dd2*2*r(k)*temp191b24 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (138) +! 2s with cusp condition +! ( -dd2*r^2*exp(-dd2*r)) ! with no cusp condition der of 137 + dd2 = dd(indpar+1) + indorbp = indorb + 1 + DO k=indtmin,indtm + distp(k, 1) = -(dd2*DEXP(-(dd2*r(k)))) + END DO +! endif + IF (typec .NE. 1) THEN + fun = (2.d0-dd2*r(0))*distp(0, 1) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp191b28 = distp(0, 1)*fun2b + temp191b29 = 2*dd2*r(0)*temp191b28 + dd2b = r(0)*temp191b29 - 4*r(0)*temp191b28 - distp(0, 1)*r(0)*& +& funb0 + rb(0) = rb(0) + dd2*temp191b29 - 4*dd2*temp191b28 - distp(0, 1)*& +& dd2*funb0 + distpb(0, 1) = (2.d0-dd2*r(0))*funb0 + ((dd2*r(0))**2-4*(dd2*r(0))& +& +2.d0)*fun2b + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO i=indtm,i0,-1 + distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + DO k=indtm,indtmin,-1 + temp191b27 = -(dd2*DEXP(-(dd2*r(k)))*distpb(k, 1)) + dd2b = dd2b - r(k)*temp191b27 - DEXP(-(dd2*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd2*temp191b27 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (56) +! g single Slater orbital derivative of 55 +! R(r)= (11.d0/2.0 1/dd1 - r) * exp(-alpha r) +! normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization +! l = 4 +! \int d\omega Y*Y = 4 pi / (2 l + 1) +! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5**2 * 3**4 / 2**3 / dd1**11 + c = dd1**5.5d0*.020104801169736915d0 +! c=1.d0/dsqrt(7.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(11.d0/2.d0)/3.d0/5.d0 +! endif + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k))) + END DO + DO i=indtmin,indtm + distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& +& 2+3.d0*r(i)**4) +! lz=0 + distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& +& 2-r(i)**2) +! lz=+/-2 + distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& +& (i)**2) +! lz=+/-2 + distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & +& i)**2) +! lz=+/-3 + distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& +& , i)**2) +! lz=+/-3 + distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& +& rmu(2, i)**4) +! lz=+/-4 + distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& +& , i)**2) + END DO +! lz=+/-4 + DO ic=1,9 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1)*(11.d0/2.d0/dd1-r(0)) + fun = distp(0, 1)*(dd1-13.d0/2.d0/r(0)) + fun2 = dd1*distp(0, 1)*(15.d0/2.d0-dd1*r(0)) +! indorbp=indorb + DO ic=1,9 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 IF (ic .EQ. 1) THEN - IF (i .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) END IF ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) END IF ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) END IF ELSE IF (ic .EQ. 4) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) END IF ELSE IF (ic .EQ. 6) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + END IF + ELSE IF (ic .EQ. 7) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,21) + END IF + ELSE IF (ic .EQ. 8) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,22) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,24) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,23) + END IF + ELSE IF (ic .EQ. 9) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,26) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,28) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,27) END IF - ELSE IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,25) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=7,1,-1 - temp321b23 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 8.d0*temp321b23 - fun2b = fun2b + temp321b23 + DO ic=9,1,-1 + temp197b57 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 10.d0*temp197b57 + fun2b = fun2b + temp197b57 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 11) THEN - IF (branch .LT. 6) THEN - IF (branch .LT. 4) THEN + IF (branch .LT. 15) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN - IF (.NOT.branch .LT. 2) THEN - temp321b2 = cost1f*zb(indorbp, indt+i) - fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& -& temp321b2 - rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& -& temp321b2 - rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp321b2 + IF (branch .LT. 2) THEN + temp197b2 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& +& 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& +& ) + rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& +& , 0)**2)*temp197b2 + rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp197b2 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& +& )*temp197b2 + ELSE + temp197b3 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& +& 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& +& ) + rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& +& , 0)**2)*temp197b3 + rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp197b3 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& +& )*temp197b3 END IF - temp321b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) - temp321b1 = rmu(i, 0)*temp321b0 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp321b0 - fun0b = fun0b + rmu(3, 0)*temp321b1 - rmub(3, 0) = rmub(3, 0) + fun0*temp321b1 - GOTO 120 + ELSE IF (branch .LT. 4) THEN + temp197b4 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& +& 3, 0)*r(0)**2))*zb(indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& +& r(0)**2)*temp197b4 + rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp197b4 ELSE - temp321b5 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp321b5 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp321b5 - rb(0) = rb(0) - fun0*2*r(0)*temp321b5 + temp197b5 = cost2g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& +& , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& +& (indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& +& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp197b5 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp197b5 + rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp197b5 END IF - ELSE IF (.NOT.branch .LT. 5) THEN - temp321b6 = cost2f*10.d0*zb(indorbp, indt+i) - temp321b7 = rmu(i, 0)*temp321b6 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp321b6 - fun0b = fun0b + rmu(1, 0)*temp321b7 - rmub(1, 0) = rmub(1, 0) + fun0*temp321b7 + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp197b6 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp197b7 = rmu(2, 0)*rmu(3, 0)*temp197b6 + temp197b8 = fun0*rmu(1, 0)*temp197b6 + fun0b = fun0b + rmu(1, 0)*temp197b7 + rmub(1, 0) = rmub(1, 0) + fun0*temp197b7 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp197b8 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp197b8 + ELSE + temp197b9 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp197b10 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& +& **2)*temp197b9 + temp197b11 = fun0*rmu(1, 0)*temp197b9 + fun0b = fun0b + rmu(1, 0)*temp197b10 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp197b11 + & +& fun0*temp197b10 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp197b11 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp197b11 + END IF + ELSE + temp197b12 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp197b13 = rmu(2, 0)*rmu(3, 0)*temp197b12 + temp197b14 = fun0*rmu(1, 0)*temp197b12 + fun0b = fun0b + rmu(1, 0)*temp197b13 + rmub(1, 0) = rmub(1, 0) + fun0*temp197b13 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp197b14 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp197b14 END IF - temp321b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp321b4 = rmu(i, 0)*temp321b3 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp321b3 - fun0b = fun0b + rmu(1, 0)*temp321b4 - rmub(1, 0) = rmub(1, 0) + fun0*temp321b4 - ELSE IF (branch .LT. 9) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 7) THEN - temp321b10 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp321b10 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp321b10 - rb(0) = rb(0) - fun0*2*r(0)*temp321b10 + ELSE IF (branch .LT. 12) THEN + IF (branch .LT. 10) THEN + IF (branch .LT. 9) THEN + temp197b15 = cost2g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& +& , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& +& (indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& +& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp197b15 + rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp197b15 + rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp197b15 + ELSE + temp197b16 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp197b17 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& +& **2)*temp197b16 + temp197b18 = fun0*rmu(2, 0)*temp197b16 + fun0b = fun0b + rmu(2, 0)*temp197b17 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp197b18 + & +& fun0*temp197b17 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp197b18 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp197b18 END IF + ELSE IF (branch .LT. 11) THEN + temp197b19 = -(cost3g*4.d0*zb(indorbp, indt+i)) + temp197b20 = fun0*temp197b19 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& +& **2))*temp197b19 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& +& **2)*temp197b20 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& +& temp197b20 ELSE - temp321b11 = cost2f*10.d0*zb(indorbp, indt+i) - temp321b12 = rmu(i, 0)*temp321b11 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp321b11 - fun0b = fun0b + rmu(2, 0)*temp321b12 - rmub(2, 0) = rmub(2, 0) + fun0*temp321b12 + temp197b21 = cost3g*4.d0*zb(indorbp, indt+i) + temp197b22 = fun0*temp197b21 + fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& +& **2))*temp197b21 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& +& **2)*temp197b22 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& +& temp197b22 + END IF + ELSE IF (branch .LT. 14) THEN + IF (branch .LT. 13) THEN + temp197b23 = cost3g*12.d0*zb(indorbp, indt+i) + temp197b24 = fun0*rmu(3, 0)*temp197b23 + temp197b25 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp197b23 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp197b24 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp197b24 + fun0b = fun0b + rmu(3, 0)*temp197b25 + rmub(3, 0) = rmub(3, 0) + fun0*temp197b25 + ELSE + temp197b26 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp197b27 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3& +& , 0)**2)*temp197b26 + temp197b28 = fun0*rmu(2, 0)*temp197b26 + fun0b = fun0b + rmu(2, 0)*temp197b27 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp197b28 + fun0*& +& temp197b27 + rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp197b28 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp197b28 END IF - temp321b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp321b9 = rmu(i, 0)*temp321b8 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp321b8 - fun0b = fun0b + rmu(2, 0)*temp321b9 - rmub(2, 0) = rmub(2, 0) + fun0*temp321b9 - ELSE IF (branch .LT. 10) THEN - temp321b13 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp321b13 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp321b13 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp321b13 ELSE - temp321b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp321b14 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp321b14 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp321b14 + temp197b29 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp197b30 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0& +& )**2)*temp197b29 + temp197b31 = fun0*rmu(1, 0)*temp197b29 + fun0b = fun0b + rmu(1, 0)*temp197b30 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp197b31 + fun0*& +& temp197b30 + rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp197b31 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp197b31 END IF - ELSE IF (branch .LT. 16) THEN - IF (branch .LT. 14) THEN - IF (branch .LT. 13) THEN - IF (branch .LT. 12) THEN - temp321b15 = cost3f*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp321b15 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp321b15 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp321b15 + ELSE IF (branch .LT. 22) THEN + IF (branch .LT. 19) THEN + IF (branch .LT. 17) THEN + IF (branch .LT. 16) THEN + temp197b32 = cost3g*24.d0*zb(indorbp, indt+i) + temp197b33 = rmu(2, 0)*rmu(3, 0)*temp197b32 + temp197b34 = fun0*rmu(1, 0)*temp197b32 + fun0b = fun0b + rmu(1, 0)*temp197b33 + rmub(1, 0) = rmub(1, 0) + fun0*temp197b33 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp197b34 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp197b34 ELSE - temp321b16 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp321b16 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp321b16 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp321b16 + temp197b35 = cost4g*3.d0*zb(indorbp, indt+i) + temp197b36 = fun0*rmu(3, 0)*temp197b35 + temp197b37 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp197b35 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp197b36 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp197b36 + fun0b = fun0b + rmu(3, 0)*temp197b37 + rmub(3, 0) = rmub(3, 0) + fun0*temp197b37 END IF + ELSE IF (branch .LT. 18) THEN + temp197b38 = -(cost4g*6.d0*zb(indorbp, indt+i)) + temp197b39 = rmu(2, 0)*rmu(3, 0)*temp197b38 + temp197b40 = fun0*rmu(1, 0)*temp197b38 + fun0b = fun0b + rmu(1, 0)*temp197b39 + rmub(1, 0) = rmub(1, 0) + fun0*temp197b39 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp197b40 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp197b40 ELSE - temp321b17 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp321b17 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp321b17 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp321b17 + temp197b41 = cost4g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& +& (2, 0)**2))*zb(indorbp, indt+i) + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& +& **2)*temp197b41 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp197b41 END IF - ELSE IF (branch .LT. 15) THEN - temp321b18 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp321b18 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp321b18 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp321b18 - ELSE - temp321b19 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp321b19 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp321b19 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp321b19 - END IF - ELSE IF (branch .LT. 19) THEN - IF (branch .LT. 18) THEN - IF (.NOT.branch .LT. 17) THEN - temp321b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp321b20 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp321b20 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp321b20 + ELSE IF (branch .LT. 21) THEN + IF (branch .LT. 20) THEN + temp197b42 = cost4g*6.d0*zb(indorbp, indt+i) + temp197b43 = rmu(2, 0)*rmu(3, 0)*temp197b42 + temp197b44 = fun0*rmu(1, 0)*temp197b42 + fun0b = fun0b + rmu(1, 0)*temp197b43 + rmub(1, 0) = rmub(1, 0) + fun0*temp197b43 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp197b44 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp197b44 + ELSE + temp197b45 = cost4g*3.d0*zb(indorbp, indt+i) + temp197b46 = fun0*rmu(3, 0)*temp197b45 + temp197b47 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp197b45 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp197b46 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp197b46 + fun0b = fun0b + rmu(3, 0)*temp197b47 + rmub(3, 0) = rmub(3, 0) + fun0*temp197b47 END IF ELSE - temp321b21 = cost4f*6.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp321b21 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp321b21 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp321b21 + temp197b48 = cost4g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& +& 2, 0)**3)*zb(indorbp, indt+i) + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp197b48 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& +& 2)*temp197b48 END IF - ELSE IF (.NOT.branch .LT. 20) THEN - temp321b22 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp321b22 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp321b22 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp321b22 + ELSE IF (branch .LT. 26) THEN + IF (branch .LT. 24) THEN + IF (branch .LT. 23) THEN + temp197b49 = cost5g*4.d0*zb(indorbp, indt+i) + temp197b50 = fun0*temp197b49 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& +& **2))*temp197b49 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& +& **2)*temp197b50 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp197b50 + END IF + ELSE IF (branch .LT. 25) THEN + temp197b51 = cost5g*4.d0*zb(indorbp, indt+i) + temp197b52 = fun0*temp197b51 + fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& +& ))*temp197b51 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& +& 2)*temp197b52 + rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp197b52 + END IF + ELSE IF (branch .LT. 28) THEN + IF (branch .LT. 27) THEN + temp197b53 = cost5g*4.d0*zb(indorbp, indt+i) + temp197b54 = fun0*temp197b53 + fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& +& 3)*temp197b53 + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp197b54 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& +& 2)*temp197b54 + END IF + ELSE + temp197b55 = cost5g*4.d0*zb(indorbp, indt+i) + temp197b56 = fun0*temp197b55 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& +& *temp197b55 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& +& *temp197b56 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp197b56 END IF - 120 temp321b = distp(0, 1+ic)*zb(indorbp, indt+i) + temp197b1 = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp321b - funb = funb + rmu(i, 0)*temp321b + rmub(i, 0) = rmub(i, 0) + fun*temp197b1 + funb0 = funb0 + rmu(i, 0)*temp197b1 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp320 = r(0)**4 - temp320b = distp(0, 1)*fun2b - temp319 = 4.d0*dd1 - temp318 = 9.d0/temp319 - distpb(0, 1) = distpb(0, 1) + (2.d0*(dd1*r(0)**2)-13.d0/2.d0)*funb& -& + (temp318-r(0)**2)*fun0b + (19.d0*(dd1*r(0)**2)-13.d0/2.d0-4.d0& -& *(dd1**2*temp320))*fun2b - temp320b0 = distp(0, 1)*2.d0*funb - dd1b = r(0)**2*temp320b0 - distp(0, 1)*temp318*4.d0*fun0b/temp319 & -& + (19.d0*r(0)**2-4.d0*temp320*2*dd1)*temp320b - rb(0) = rb(0) + dd1*2*r(0)*temp320b0 - distp(0, 1)*2*r(0)*fun0b + & -& (19.d0*dd1*2*r(0)-4.d0*dd1**2*4*r(0)**3)*temp320b + temp197b = (15.d0/2.d0-dd1*r(0))*fun2b + temp197b0 = dd1*distp(0, 1)*fun2b + temp194 = 2.d0*dd1 + temp193 = 11.d0/temp194 + dd1b = distp(0, 1)*funb0 - distp(0, 1)*temp193*2.d0*fun0b/temp194 & +& - r(0)*temp197b0 + distp(0, 1)*temp197b + temp196 = 2.d0*r(0) + temp195 = 13.d0/temp196 + distpb(0, 1) = distpb(0, 1) + (dd1-temp195)*funb0 + (temp193-r(0))& +& *fun0b + dd1*temp197b + rb(0) = rb(0) + distp(0, 1)*temp195*2.d0*funb0/temp196 - distp(0, & +& 1)*fun0b - dd1*temp197b0 CALL POPREAL8(adr8ibuf,adr8buf,dd1) ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 END IF dd1b = 0.0_8 - DO ic=7,1,-1 + DO ic=9,1,-1 DO k=indtm,i0,-1 - temp318b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) - temp317 = 4.d0*dd1 - temp316 = 9.d0/temp317 - temp316b7 = (temp316-r(k)**2)*zb(indorbp, k) - dd1b = dd1b - temp316*4.d0*temp318b/temp317 - rb(k) = rb(k) - 2*r(k)*temp318b - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp316b7 - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp316b7 + temp192 = 2.d0*dd1 + temp191 = 11.d0/temp192 + temp191b49 = (temp191-r(k))*zb(indorbp, k) + temp191b50 = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp191b49 + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp191b49 + dd1b = dd1b - temp191*2.d0*temp191b50/temp192 + rb(k) = rb(k) - temp191b50 zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 - temp316b = cost4f*rmu(2, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 8) - 2*rmu(2, i)*temp316b + temp191b31 = cost5g*4.d0*distpb(i, 10) + temp191b32 = (rmu(1, i)**2-rmu(2, i)**2)*temp191b31 + temp191b33 = rmu(1, i)*rmu(2, i)*temp191b31 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp191b33 + rmu(2, i)*& +& temp191b32 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp191b32 - 2*rmu(2, i)*& +& temp191b33 + distpb(i, 10) = 0.0_8 + temp191b34 = cost5g*distpb(i, 9) + rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& +& 1, i))*temp191b34 + distpb(i, 9) = 0.0_8 + temp191b35 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) + temp191b36 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp191b35 - 2*rmu(2, i)*& +& temp191b36 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& +& temp191b34 + rmub(3, i) = rmub(3, i) + rmu(2, i)*temp191b35 distpb(i, 8) = 0.0_8 - temp316b0 = cost4f*rmu(1, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& -& distpb(i, 7) + 2*rmu(1, i)*temp316b0 + 3.d0*2*rmu(1, i)*temp316b - rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp316b0 + temp191b37 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) + temp191b38 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp191b37 + 2*rmu(1, i)*& +& temp191b38 + 3.d0*2*rmu(1, i)*temp191b36 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp191b37 + rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp191b38 distpb(i, 7) = 0.0_8 - temp316b1 = cost3f*2.d0*distpb(i, 6) - temp316b2 = rmu(2, i)*temp316b1 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp316b2 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp316b2 - rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp316b1 + temp191b39 = cost3g*2.d0*distpb(i, 6) + temp191b40 = (7.d0*rmu(3, i)**2-r(i)**2)*temp191b39 + temp191b41 = rmu(1, i)*rmu(2, i)*temp191b39 + rmub(1, i) = rmub(1, i) + rmu(2, i)*temp191b40 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp191b40 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp191b41 distpb(i, 6) = 0.0_8 - temp316b3 = cost3f*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 5) - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp316b3 + temp191b42 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) + temp191b43 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) distpb(i, 5) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 4) - 2*rmu(2, i)*temp316b3 - temp316b4 = cost2f*rmu(2, i)*distpb(i, 4) - rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp316b4 + temp191b44 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) + temp191b45 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - temp316b5 = cost2f*rmu(1, i)*distpb(i, 3) - rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 3) + temp191b46 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) + temp191b47 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 - temp316b6 = cost1f*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - 2*r(i)*temp316b5 - 3.d0*2*r(i)*temp316b6 - 2*r(i)*& -& temp316b4 - rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& -& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp316b6 + 5.d0*2*rmu(3, i)*& -& temp316b5 + temp191b48 = cost1g*distpb(i, 2) + rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& +& temp191b48 - 3.d0*2*r(i)*temp191b47 - 2*r(i)*temp191b43 - 3.d0*2& +& *r(i)*temp191b45 - 2*r(i)*temp191b41 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp191b42 + rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp191b42 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp191b43 + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp191b44 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp191b45 + rmu(2, i)*& +& temp191b44 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp191b46 + rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& +& rmu(3, i))*temp191b48 + 7.d0*2*rmu(3, i)*temp191b47 + rmu(1, i)*& +& temp191b46 distpb(i, 2) = 0.0_8 END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - temp315 = r(k)**2 - temp315b29 = c*DEXP(-(dd1*temp315))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp315))*distpb(k, 1) - dd1b = dd1b - temp315*temp315b29 - rb(k) = rb(k) - dd1*2*r(k)*temp315b29 + temp191b30 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp191b30 + rb(k) = rb(k) - dd1*temp191b30 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 1.47215808929909374563d0*2.25d0*dd1**1.25D0*cb + dd1b = dd1b + .020104801169736915d0*5.5d0*dd1**4.5D0*cb ddb(indparp) = ddb(indparp) + dd1b - CASE (70) -! f single Slater orbital -! R(r)= exp(-alpha r) -! normalized -! indorbp=indorb + CASE (1) +! s orbital +! +! - angmom = 0 +! - type = Slater +! - normalized = yes +! - angtype = spherical +! - npar = 1 +! - multiplicity = 1 +! + dd1 = dd(indpar+1) + c = dd1*DSQRT(dd1)*0.56418958354775628695d0 + indorbp = indorb + 1 + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k))) + END DO + IF (typec .NE. 1) THEN + fun = -(dd1*distp(0, 1)) + distpb = 0.0_8 + temp199 = dd1/r(0) + temp199b = -(distp(0, 1)*2.d0*zb(indorbp, indt+4)/r(0)) + dd1b = temp199b + distp(0, 1)*2*dd1*zb(indorbp, indt+4) + rb(0) = rb(0) - temp199*temp199b + distpb(0, 1) = (dd1**2-2.d0*temp199)*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + funb0 = 0.0_8 + DO i=3,1,-1 + temp198 = fun/r(0) + temp198b0 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(i, 0) = rmub(i, 0) + temp198*zb(indorbp, indt+i) + funb0 = funb0 + temp198b0 + rb(0) = rb(0) - temp198*temp198b0 + zb(indorbp, indt+i) = 0.0_8 + END DO + dd1b = dd1b - distp(0, 1)*funb0 + distpb(0, 1) = distpb(0, 1) - dd1*funb0 + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + END IF + DO i=indtm,i0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + cb = 0.0_8 + DO k=indtm,indtmin,-1 + temp198b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp198b + rb(k) = rb(k) - dd1*temp198b + distpb(k, 1) = 0.0_8 + END DO + temp197 = DSQRT(dd1) + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + 0.56418958354775628695d0*temp197*cb + ELSE + dd1b = dd1b + (0.56418958354775628695d0*dd1/(2.D0*DSQRT(dd1))+& +& 0.56418958354775628695d0*temp197)*cb + END IF + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (49) +! f orbitals +! R(r)= c*exp(-z r^2)*(9/4/z-r^2) +! indorbp=indorb indparp = indpar + 1 dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! l = 3 -! \int d\omega Y*Y = 4 pi / (2 l + 1) -! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5 * 3**2 / 2**2 / dd1**9 -! c=1.d0/dsqrt(10.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(9.d0/2.d0)/3.d0 - c = dd1**4.5d0*0.084104417400672d0 -! endif +! if(iflagnorm.gt.2) then +! overall normalization +! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) + c = dd1**2.25d0*1.47215808929909374563d0 +! endif DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO DO i=indtmin,indtm distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) -! lz=0 +! lz=0 distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 +! lz=+/-1 distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 +! lz=+/-1 distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) -! lz=+/-2 +! lz=+/-2 distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) -! lz=+/-2 +! lz=+/-2 distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) -! lz=+/-3 +! lz=+/-3 distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) END DO -! lz=+/-3 +! lz=+/-3 DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) dd1 = dd(indparp) - fun0 = distp(0, 1) - fun = -(dd1*distp(0, 1)/r(0)) - fun2 = dd1**2*distp(0, 1) -! indorbp=indorb + fun0 = distp(0, 1)*(9.d0/4.d0/dd1-r(0)**2) + fun = distp(0, 1)*(2.d0*dd1*r(0)**2-13.d0/2.d0) + fun2 = distp(0, 1)*(-(4.d0*dd1**2*r(0)**4)+19.d0*dd1*r(0)**2-13.d0& +& /2.d0) +! indorbp=indorb DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN @@ -10427,15 +10960,15 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=7,1,-1 - temp322b23 = distp(0, 1+ic)*zb(indorbp, indt+4) + temp206b23 = distp(0, 1+ic)*zb(indorbp, indt+4) distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & & indt+4) - funb = funb + 8.d0*temp322b23 - fun2b = fun2b + temp322b23 + funb0 = funb0 + 8.d0*temp206b23 + fun2b = fun2b + temp206b23 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -10444,729 +10977,331 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & IF (branch .LT. 4) THEN IF (branch .LT. 3) THEN IF (.NOT.branch .LT. 2) THEN - temp322b2 = cost1f*zb(indorbp, indt+i) + temp206b2 = cost1f*zb(indorbp, indt+i) fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& -& temp322b2 +& temp206b2 rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& -& temp322b2 - rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp322b2 +& temp206b2 + rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp206b2 END IF - temp322b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) - temp322b1 = rmu(i, 0)*temp322b0 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp322b0 - fun0b = fun0b + rmu(3, 0)*temp322b1 - rmub(3, 0) = rmub(3, 0) + fun0*temp322b1 - GOTO 130 + temp206b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) + temp206b1 = rmu(i, 0)*temp206b0 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp206b0 + fun0b = fun0b + rmu(3, 0)*temp206b1 + rmub(3, 0) = rmub(3, 0) + fun0*temp206b1 + GOTO 120 ELSE - temp322b5 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp322b5 + temp206b5 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp206b5 rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp322b5 - rb(0) = rb(0) - fun0*2*r(0)*temp322b5 +& temp206b5 + rb(0) = rb(0) - fun0*2*r(0)*temp206b5 END IF ELSE IF (.NOT.branch .LT. 5) THEN - temp322b6 = cost2f*10.d0*zb(indorbp, indt+i) - temp322b7 = rmu(i, 0)*temp322b6 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp322b6 - fun0b = fun0b + rmu(1, 0)*temp322b7 - rmub(1, 0) = rmub(1, 0) + fun0*temp322b7 + temp206b6 = cost2f*10.d0*zb(indorbp, indt+i) + temp206b7 = rmu(i, 0)*temp206b6 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp206b6 + fun0b = fun0b + rmu(1, 0)*temp206b7 + rmub(1, 0) = rmub(1, 0) + fun0*temp206b7 END IF - temp322b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp322b4 = rmu(i, 0)*temp322b3 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp322b3 - fun0b = fun0b + rmu(1, 0)*temp322b4 - rmub(1, 0) = rmub(1, 0) + fun0*temp322b4 + temp206b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp206b4 = rmu(i, 0)*temp206b3 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp206b3 + fun0b = fun0b + rmu(1, 0)*temp206b4 + rmub(1, 0) = rmub(1, 0) + fun0*temp206b4 ELSE IF (branch .LT. 9) THEN IF (branch .LT. 8) THEN IF (branch .LT. 7) THEN - temp322b10 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp322b10 + temp206b10 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp206b10 rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp322b10 - rb(0) = rb(0) - fun0*2*r(0)*temp322b10 +& temp206b10 + rb(0) = rb(0) - fun0*2*r(0)*temp206b10 END IF ELSE - temp322b11 = cost2f*10.d0*zb(indorbp, indt+i) - temp322b12 = rmu(i, 0)*temp322b11 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp322b11 - fun0b = fun0b + rmu(2, 0)*temp322b12 - rmub(2, 0) = rmub(2, 0) + fun0*temp322b12 + temp206b11 = cost2f*10.d0*zb(indorbp, indt+i) + temp206b12 = rmu(i, 0)*temp206b11 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp206b11 + fun0b = fun0b + rmu(2, 0)*temp206b12 + rmub(2, 0) = rmub(2, 0) + fun0*temp206b12 END IF - temp322b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp322b9 = rmu(i, 0)*temp322b8 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp322b8 - fun0b = fun0b + rmu(2, 0)*temp322b9 - rmub(2, 0) = rmub(2, 0) + fun0*temp322b9 + temp206b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp206b9 = rmu(i, 0)*temp206b8 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp206b8 + fun0b = fun0b + rmu(2, 0)*temp206b9 + rmub(2, 0) = rmub(2, 0) + fun0*temp206b9 ELSE IF (branch .LT. 10) THEN - temp322b13 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp322b13 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp322b13 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp322b13 + temp206b13 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp206b13 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp206b13 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp206b13 ELSE - temp322b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp322b14 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp322b14 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp322b14 + temp206b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp206b14 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp206b14 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp206b14 END IF ELSE IF (branch .LT. 16) THEN IF (branch .LT. 14) THEN IF (branch .LT. 13) THEN IF (branch .LT. 12) THEN - temp322b15 = cost3f*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp322b15 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp322b15 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp322b15 + temp206b15 = cost3f*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp206b15 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp206b15 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp206b15 ELSE - temp322b16 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp322b16 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp322b16 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp322b16 + temp206b16 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp206b16 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp206b16 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp206b16 END IF ELSE - temp322b17 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp322b17 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp322b17 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp322b17 + temp206b17 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp206b17 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp206b17 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp206b17 END IF ELSE IF (branch .LT. 15) THEN - temp322b18 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp322b18 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp322b18 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp322b18 + temp206b18 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp206b18 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp206b18 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp206b18 ELSE - temp322b19 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp322b19 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp322b19 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp322b19 + temp206b19 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp206b19 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp206b19 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp206b19 END IF ELSE IF (branch .LT. 19) THEN IF (branch .LT. 18) THEN IF (.NOT.branch .LT. 17) THEN - temp322b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp322b20 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp322b20 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp322b20 + temp206b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp206b20 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp206b20 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp206b20 END IF ELSE - temp322b21 = cost4f*6.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp322b21 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp322b21 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp322b21 + temp206b21 = cost4f*6.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp206b21 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp206b21 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp206b21 END IF ELSE IF (.NOT.branch .LT. 20) THEN - temp322b22 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp322b22 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp322b22 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp322b22 + temp206b22 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp206b22 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp206b22 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp206b22 END IF - 130 temp322b = distp(0, 1+ic)*zb(indorbp, indt+i) + 120 temp206b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp322b - funb = funb + rmu(i, 0)*temp322b + rmub(i, 0) = rmub(i, 0) + fun*temp206b + funb0 = funb0 + rmu(i, 0)*temp206b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp321b33 = -(distp(0, 1)*funb/r(0)) - dd1b = temp321b33 + distp(0, 1)*2*dd1*fun2b - temp321 = dd1/r(0) - distpb(0, 1) = distpb(0, 1) + fun0b - temp321*funb + dd1**2*fun2b - rb(0) = rb(0) - temp321*temp321b33 + temp205 = r(0)**4 + temp205b = distp(0, 1)*fun2b + temp204 = 4.d0*dd1 + temp203 = 9.d0/temp204 + distpb(0, 1) = distpb(0, 1) + (2.d0*(dd1*r(0)**2)-13.d0/2.d0)*& +& funb0 + (temp203-r(0)**2)*fun0b + (19.d0*(dd1*r(0)**2)-13.d0/& +& 2.d0-4.d0*(dd1**2*temp205))*fun2b + temp205b0 = distp(0, 1)*2.d0*funb0 + dd1b = r(0)**2*temp205b0 - distp(0, 1)*temp203*4.d0*fun0b/temp204 & +& + (19.d0*r(0)**2-4.d0*temp205*2*dd1)*temp205b + rb(0) = rb(0) + dd1*2*r(0)*temp205b0 - distp(0, 1)*2*r(0)*fun0b + & +& (19.d0*dd1*2*r(0)-4.d0*dd1**2*4*r(0)**3)*temp205b CALL POPREAL8(adr8ibuf,adr8buf,dd1) ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 END IF + dd1b = 0.0_8 DO ic=7,1,-1 DO k=indtm,i0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + temp203b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) + temp202 = 4.d0*dd1 + temp201 = 9.d0/temp202 + temp201b7 = (temp201-r(k)**2)*zb(indorbp, k) + dd1b = dd1b - temp201*4.d0*temp203b/temp202 + rb(k) = rb(k) - 2*r(k)*temp203b + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp201b7 + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp201b7 zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 - temp321b25 = cost4f*rmu(2, i)*distpb(i, 8) + temp201b = cost4f*rmu(2, i)*distpb(i, 8) rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 8) - 2*rmu(2, i)*temp321b25 +& distpb(i, 8) - 2*rmu(2, i)*temp201b distpb(i, 8) = 0.0_8 - temp321b26 = cost4f*rmu(1, i)*distpb(i, 7) + temp201b0 = cost4f*rmu(1, i)*distpb(i, 7) rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& -& distpb(i, 7) + 2*rmu(1, i)*temp321b26 + 3.d0*2*rmu(1, i)*& -& temp321b25 - rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp321b26 +& distpb(i, 7) + 2*rmu(1, i)*temp201b0 + 3.d0*2*rmu(1, i)*temp201b + rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp201b0 distpb(i, 7) = 0.0_8 - temp321b27 = cost3f*2.d0*distpb(i, 6) - temp321b28 = rmu(2, i)*temp321b27 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp321b28 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp321b28 - rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp321b27 + temp201b1 = cost3f*2.d0*distpb(i, 6) + temp201b2 = rmu(2, i)*temp201b1 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp201b2 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp201b2 + rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp201b1 distpb(i, 6) = 0.0_8 - temp321b29 = cost3f*rmu(3, i)*distpb(i, 5) + temp201b3 = cost3f*rmu(3, i)*distpb(i, 5) rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& & distpb(i, 5) - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp321b29 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp201b3 distpb(i, 5) = 0.0_8 rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 4) - 2*rmu(2, i)*temp321b29 - temp321b30 = cost2f*rmu(2, i)*distpb(i, 4) - rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp321b30 +& distpb(i, 4) - 2*rmu(2, i)*temp201b3 + temp201b4 = cost2f*rmu(2, i)*distpb(i, 4) + rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp201b4 distpb(i, 4) = 0.0_8 - temp321b31 = cost2f*rmu(1, i)*distpb(i, 3) + temp201b5 = cost2f*rmu(1, i)*distpb(i, 3) rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& & distpb(i, 3) distpb(i, 3) = 0.0_8 - temp321b32 = cost1f*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - 2*r(i)*temp321b31 - 3.d0*2*r(i)*temp321b32 - 2*r(i& -& )*temp321b30 + temp201b6 = cost1f*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - 2*r(i)*temp201b5 - 3.d0*2*r(i)*temp201b6 - 2*r(i)*& +& temp201b4 rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& -& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp321b32 + 5.d0*2*rmu(3, i)*& -& temp321b31 +& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp201b6 + 5.d0*2*rmu(3, i)*& +& temp201b5 distpb(i, 2) = 0.0_8 END DO - dd1b = 0.0_8 cb = 0.0_8 DO k=indtm,indtmin,-1 - temp321b24 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp321b24 - rb(k) = rb(k) - dd1*temp321b24 + temp200 = r(k)**2 + temp200b = c*DEXP(-(dd1*temp200))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp200))*distpb(k, 1) + dd1b = dd1b - temp200*temp200b + rb(k) = rb(k) - dd1*2*r(k)*temp200b distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.084104417400672d0*4.5d0*dd1**3.5D0*cb + dd1b = dd1b + 1.47215808929909374563d0*2.25d0*dd1**1.25D0*cb ddb(indparp) = ddb(indparp) + dd1b - CASE (71) -! f single Slater orbital derivative of 70 -! R(r)= (9.d0/2.0 1/dd1 - r) * exp(-alpha r) -! normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! l = 3 -! \int d\omega Y*Y = 4 pi / (2 l + 1) -! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5 * 3**2 / 2**2 / dd1**9 -! c=1.d0/dsqrt(10.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(9.d0/2.d0)/3.d0 - c = dd1**4.5d0*0.084104417400672d0 -! endif + CASE (141) +! 2p single exponential r^2 e^{-z r} ! parent of 121 + dd2 = dd(indpar+1) DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) - END DO - DO i=indtmin,indtm - distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) -! lz=0 - distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) -! lz=+/-2 - distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) -! lz=+/-2 - distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) -! lz=+/-3 - distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) + distp(k, 1) = -DEXP(-(dd2*r(k))) END DO -! lz=+/-3 - DO ic=1,7 +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1)*(9.d0/2.d0/dd1-r(0)) - fun = distp(0, 1)*(dd1-11.d0/2.d0/r(0)) - fun2 = dd1*distp(0, 1)*(13.d0/2.d0-dd1*r(0)) -! indorbp=indorb - DO ic=1,7 + fun = distp(0, 1)*(2.d0-dd2*r(0)) + fun2 = (2.d0-4.d0*dd2*r(0)+(dd2*r(0))**2)*distp(0, 1) +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF - ELSE IF (ic .EQ. 6) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) - END IF - ELSE IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=7,1,-1 - temp328b25 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 8.d0*temp328b25 - fun2b = fun2b + temp328b25 + DO ic=3,1,-1 + temp206b29 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp206b29 + fun2b = fun2b + temp206b29 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 11) THEN - IF (branch .LT. 6) THEN - IF (branch .LT. 4) THEN - IF (branch .LT. 3) THEN - IF (.NOT.branch .LT. 2) THEN - temp328b4 = cost1f*zb(indorbp, indt+i) - fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& -& temp328b4 - rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& -& temp328b4 - rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp328b4 - END IF - temp328b2 = -(cost1f*6.d0*zb(indorbp, indt+i)) - temp328b3 = rmu(i, 0)*temp328b2 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp328b2 - fun0b = fun0b + rmu(3, 0)*temp328b3 - rmub(3, 0) = rmub(3, 0) + fun0*temp328b3 - GOTO 140 - ELSE - temp328b7 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp328b7 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp328b7 - rb(0) = rb(0) - fun0*2*r(0)*temp328b7 - END IF - ELSE IF (.NOT.branch .LT. 5) THEN - temp328b8 = cost2f*10.d0*zb(indorbp, indt+i) - temp328b9 = rmu(i, 0)*temp328b8 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp328b8 - fun0b = fun0b + rmu(1, 0)*temp328b9 - rmub(1, 0) = rmub(1, 0) + fun0*temp328b9 - END IF - temp328b5 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp328b6 = rmu(i, 0)*temp328b5 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp328b5 - fun0b = fun0b + rmu(1, 0)*temp328b6 - rmub(1, 0) = rmub(1, 0) + fun0*temp328b6 - ELSE IF (branch .LT. 9) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 7) THEN - temp328b12 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp328b12 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp328b12 - rb(0) = rb(0) - fun0*2*r(0)*temp328b12 - END IF - ELSE - temp328b13 = cost2f*10.d0*zb(indorbp, indt+i) - temp328b14 = rmu(i, 0)*temp328b13 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp328b13 - fun0b = fun0b + rmu(2, 0)*temp328b14 - rmub(2, 0) = rmub(2, 0) + fun0*temp328b14 - END IF - temp328b10 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp328b11 = rmu(i, 0)*temp328b10 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp328b10 - fun0b = fun0b + rmu(2, 0)*temp328b11 - rmub(2, 0) = rmub(2, 0) + fun0*temp328b11 - ELSE IF (branch .LT. 10) THEN - temp328b15 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp328b15 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp328b15 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp328b15 - ELSE - temp328b16 = -(cost3f*2.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp328b16 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp328b16 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp328b16 - END IF - ELSE IF (branch .LT. 16) THEN - IF (branch .LT. 14) THEN - IF (branch .LT. 13) THEN - IF (branch .LT. 12) THEN - temp328b17 = cost3f*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp328b17 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp328b17 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp328b17 - ELSE - temp328b18 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp328b18 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp328b18 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp328b18 - END IF - ELSE - temp328b19 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp328b19 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp328b19 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp328b19 - END IF - ELSE IF (branch .LT. 15) THEN - temp328b20 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp328b20 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp328b20 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp328b20 - ELSE - temp328b21 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp328b21 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp328b21 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp328b21 - END IF - ELSE IF (branch .LT. 19) THEN - IF (branch .LT. 18) THEN - IF (.NOT.branch .LT. 17) THEN - temp328b22 = -(cost4f*6.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp328b22 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp328b22 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp328b22 - END IF - ELSE - temp328b23 = cost4f*6.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp328b23 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp328b23 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp328b23 - END IF - ELSE IF (.NOT.branch .LT. 20) THEN - temp328b24 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp328b24 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp328b24 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp328b24 - END IF - 140 temp328b1 = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp328b1 - funb = funb + rmu(i, 0)*temp328b1 + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp206b28 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp206b28 + funb0 = funb0 + rmu(ic, 0)*temp206b28 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp328b = (13.d0/2.d0-dd1*r(0))*fun2b - temp328b0 = dd1*distp(0, 1)*fun2b - temp325 = 2.d0*dd1 - temp324 = 9.d0/temp325 - dd1b = distp(0, 1)*funb - distp(0, 1)*temp324*2.d0*fun0b/temp325 -& -& r(0)*temp328b0 + distp(0, 1)*temp328b - temp327 = 2.d0*r(0) - temp326 = 11.d0/temp327 - distpb(0, 1) = distpb(0, 1) + (dd1-temp326)*funb + (temp324-r(0))*& -& fun0b + dd1*temp328b - rb(0) = rb(0) + distp(0, 1)*temp326*2.d0*funb/temp327 - distp(0, 1& -& )*fun0b - dd1*temp328b0 - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + distpb = 0.0_8 + temp206b26 = distp(0, 1)*fun2b + temp206b27 = 2*dd2*r(0)*temp206b26 + dd2b = r(0)*temp206b27 - 4.d0*r(0)*temp206b26 - distp(0, 1)*r(0)*& +& funb0 + rb(0) = rb(0) + distp(0, 1)*2*r(0)*fun0b - distp(0, 1)*dd2*funb0 -& +& 4.d0*dd2*temp206b26 + dd2*temp206b27 + distpb(0, 1) = (2.d0-dd2*r(0))*funb0 + r(0)**2*fun0b + ((dd2*r(0))& +& **2-4.d0*(dd2*r(0))+2.d0)*fun2b ELSE distpb = 0.0_8 + dd2b = 0.0_8 END IF - dd1b = 0.0_8 - DO ic=7,1,-1 - DO k=indtm,i0,-1 - temp323 = 2.d0*dd1 - temp322 = 9.d0/temp323 - temp322b33 = (temp322-r(k))*zb(indorbp, k) - temp322b34 = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp322b33 - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp322b33 - dd1b = dd1b - temp322*2.d0*temp322b34/temp323 - rb(k) = rb(k) - temp322b34 - zb(indorbp, k) = 0.0_8 + DO ic=3,1,-1 + DO i=indtm,i0,-1 + temp206b25 = r(i)**2*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp206b25 + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp206b25 + rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*2*r(i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=indtm,indtmin,-1 - temp322b25 = cost4f*rmu(2, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 8) - 2*rmu(2, i)*temp322b25 - distpb(i, 8) = 0.0_8 - temp322b26 = cost4f*rmu(1, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& -& distpb(i, 7) + 2*rmu(1, i)*temp322b26 + 3.d0*2*rmu(1, i)*& -& temp322b25 - rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp322b26 - distpb(i, 7) = 0.0_8 - temp322b27 = cost3f*2.d0*distpb(i, 6) - temp322b28 = rmu(2, i)*temp322b27 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp322b28 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp322b28 - rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp322b27 - distpb(i, 6) = 0.0_8 - temp322b29 = cost3f*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 5) - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp322b29 - distpb(i, 5) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 4) - 2*rmu(2, i)*temp322b29 - temp322b30 = cost2f*rmu(2, i)*distpb(i, 4) - rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp322b30 - distpb(i, 4) = 0.0_8 - temp322b31 = cost2f*rmu(1, i)*distpb(i, 3) - rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 3) - distpb(i, 3) = 0.0_8 - temp322b32 = cost1f*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - 2*r(i)*temp322b31 - 3.d0*2*r(i)*temp322b32 - 2*r(i& -& )*temp322b30 - rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& -& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp322b32 + 5.d0*2*rmu(3, i)*& -& temp322b31 - distpb(i, 2) = 0.0_8 - END DO - cb = 0.0_8 DO k=indtm,indtmin,-1 - temp322b24 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp322b24 - rb(k) = rb(k) - dd1*temp322b24 + temp206b24 = -(DEXP(-(dd2*r(k)))*distpb(k, 1)) + dd2b = dd2b - r(k)*temp206b24 + rb(k) = rb(k) - dd2*temp206b24 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.084104417400672d0*4.5d0*dd1**3.5D0*cb - ddb(indparp) = ddb(indparp) + dd1b - CASE (38) -! 3s -derivative of 34 with respect to dd1 -! R(r)=r**2*exp(-z1*r) -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=1.d0/dsqrt(1.d0/4.d0/dd1**3+12.d0*dd1/(2.d0*dd1)**4+ & -! &3.d0*dd1**2/4.d0/dd1**5)/dsqrt(4.d0*pi) -! c=dd1*dsqrt(dd1)/dsqrt(7.d0*pi) - c = dd1*DSQRT(dd1)*0.21324361862292308211d0 -! endif - c0 = -(c*dd1) - c1 = 1.5d0*c/dd1 - DO i=indtmin,indtm - distp(i, 1) = DEXP(-(dd1*r(i))) - END DO - CALL PUSHREAL8(adr8ibuf,adr8buf,c1) - c1 = c1*dd1**2 - IF (typec .NE. 1) THEN - fun = (c0*(2.d0-dd1*r(0))-c1)*distp(0, 1) - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp331b = distp(0, 1)*fun2b - temp330 = (dd1*r(0))**2 - 4*(dd1*r(0)) + 2.d0 - temp330b0 = c0*temp331b - temp330b1 = 2*dd1*r(0)*temp330b0 - temp330b2 = distp(0, 1)*funb - c0b = (2.d0-dd1*r(0))*temp330b2 + temp330*temp331b - dd1b = c1*r(0)*temp331b - c0*r(0)*temp330b2 - 4*r(0)*temp330b0 + r& -& (0)*temp330b1 - rb(0) = rb(0) + c1*dd1*temp331b - c0*dd1*temp330b2 - 4*dd1*& -& temp330b0 + dd1*temp330b1 - c1b = (dd1*r(0)-1.d0)*temp331b - temp330b2 - distpb(0, 1) = (c0*(2.d0-dd1*r(0))-c1)*funb + (c0*temp330+c1*(dd1*& -& r(0)-1.d0))*fun2b - ELSE - distpb = 0.0_8 - c0b = 0.0_8 - c1b = 0.0_8 - dd1b = 0.0_8 - END IF - CALL POPREAL8(adr8ibuf,adr8buf,c1) - dd1b = dd1b + c1*2*dd1*c1b - c1b = dd1**2*c1b - DO i=indtm,i0,-1 - temp330b = distp(i, 1)*zb(indorbp, i) - temp329 = dd1*r(i) + 1.d0 - c0b = c0b + r(i)**2*temp330b - rb(i) = rb(i) + (c1*dd1+c0*2*r(i))*temp330b - c1b = c1b + temp329*temp330b - dd1b = dd1b + c1*r(i)*temp330b - distpb(i, 1) = distpb(i, 1) + (c0*r(i)**2+c1*temp329)*zb(indorbp, & -& i) - zb(indorbp, i) = 0.0_8 - END DO - DO i=indtm,indtmin,-1 - temp329b0 = DEXP(-(dd1*r(i)))*distpb(i, 1) - dd1b = dd1b - r(i)*temp329b0 - rb(i) = rb(i) - dd1*temp329b0 - distpb(i, 1) = 0.0_8 - END DO - temp329b = 1.5d0*c1b/dd1 - cb = temp329b - dd1*c0b - temp328 = DSQRT(dd1) - IF (dd1 .EQ. 0.0) THEN - dd1b = dd1b + 0.21324361862292308211d0*temp328*cb - c*c0b - c*& -& temp329b/dd1 - ELSE - dd1b = dd1b + (0.21324361862292308211d0*dd1/(2.D0*DSQRT(dd1))+& -& 0.21324361862292308211d0*temp328)*cb - c*c0b - c*temp329b/dd1 - END IF - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (39) -! 4s single zeta derivative of 10 -! R(r)=r**3*exp(-z1*r) -! -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (26) +! der of 127 +! s orbital +! +! - angmom = 1 +! - type = Slater +! - normalized = yes +! - angtype = spherical +! - npar = 5 +! - multiplicity = 3 +! +! 2p with cusp conditions +! dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 -! c=dsqrt((2*dd1)**7/720.d0/pi)/2.d0 - c = dd1**3.5d0*0.11894160774351807429d0 -! c=-c -! endif - c0 = -c - c1 = 3.5d0*c/dd1 + dd2 = dd(indpar+2) + peff = dd(indpar+3) + dd3 = dd(indpar+4) + peff2 = dd(indpar+5) + c = 1.d0/2.d0/DSQRT(8.d0*pi*(1.d0/(2.d0*dd1)**5+2.d0*peff/(dd1+dd2)& +& **5+peff**2/(2.d0*dd2)**5+2.d0*peff2/(dd1+dd3)**5+peff2**2/(2.d0*& +& dd3)**5+2.d0*peff2*peff/(dd2+dd3)**5)) DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k))) - END DO - IF (typec .NE. 1) THEN - rp1 = r(0)**3 - rp2 = r(0)**2 -! fun=(2.d0-dd1*r(0))*distp(0,1) -! fun2=(2.d0-4*dd1*r(0)+(dd1*r(0))**2)*distp(0,1) -! -!c the first derivative/r - fun = distp(0, 1)*(c0*(3.d0*r(0)-dd1*rp2)+c1*(2.d0-dd1*r(0))) -!c -!c the second derivative - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp333 = (dd1*r(0))**2 - 4*(dd1*r(0)) + 2.d0 - temp334 = 6.d0*r(0) - 6.d0*dd1*rp2 + dd1**2*rp1 - temp335b = distp(0, 1)*fun2b - temp334b = c0*temp335b - temp333b = c1*temp335b - temp333b0 = 2*dd1*r(0)*temp333b - temp332 = 3.d0*r(0) - dd1*rp2 - distpb(0, 1) = (c0*temp332+c1*(2.d0-dd1*r(0)))*funb + (c0*temp334+& -& c1*temp333)*fun2b - temp333b1 = distp(0, 1)*funb - c0b = temp332*temp333b1 + temp334*temp335b - temp332b0 = c0*temp333b1 - rp2b = -(dd1*temp332b0) - 6.d0*dd1*temp334b - rp1b = dd1**2*temp334b - rb(0) = rb(0) + 3.d0*temp332b0 - c1*dd1*temp333b1 + 3*r(0)**2*rp1b& -& + 2*r(0)*rp2b - 4*dd1*temp333b + dd1*temp333b0 + 6.d0*temp334b - dd1b = r(0)*temp333b0 - c1*r(0)*temp333b1 - 4*r(0)*temp333b - rp2*& -& temp332b0 + (rp1*2*dd1-6.d0*rp2)*temp334b - c1b = (2.d0-dd1*r(0))*temp333b1 + temp333*temp335b - ELSE - distpb = 0.0_8 - c0b = 0.0_8 - c1b = 0.0_8 - dd1b = 0.0_8 - END IF - DO i=indtm,i0,-1 - temp332b = distp(i, 1)*zb(indorbp, i) - temp331 = r(i)**3 - c0b = c0b + temp331*temp332b - rb(i) = rb(i) + (c1*2*r(i)+c0*3*r(i)**2)*temp332b - c1b = c1b + r(i)**2*temp332b - distpb(i, 1) = distpb(i, 1) + (c0*temp331+c1*r(i)**2)*zb(indorbp, & -& i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=indtm,indtmin,-1 - temp331b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp331b1 - rb(k) = rb(k) - dd1*temp331b1 - distpb(k, 1) = 0.0_8 + distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 2) = c*DEXP(-(dd2*r(k))) + distp(k, 3) = c*DEXP(-(dd3*r(k))) END DO - temp331b0 = 3.5d0*c1b/dd1 - cb = temp331b0 - c0b - dd1b = dd1b + 0.11894160774351807429d0*3.5d0*dd1**2.5D0*cb - c*& -& temp331b0/dd1 - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (40) -! -! 3p single zeta -! 3p without cusp condition derivative of 20 -! r e^{-z1 r } - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2.d0*dd1)**5/8.d0/pi)/2.d0 - c = dd1**2.5d0*0.5641895835477562d0 -! endif - c0 = -c - c1 = 2.5d0*c/dd1 -! - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k))) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(k, 2)) - distp(k, 2) = r(k)*distp(k, 1) + DO i=indtmin,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) + distp(i, 4) = distp(i, 1) + peff*distp(i, 2) + peff2*distp(i, 3) END DO -! -! indorbp=indorb -! DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif -! -! IF (typec .NE. 1) THEN - fun = (c0*(1.d0-dd1*r(0))-c1*dd1)*distp(0, 1) - fun2 = (c0*dd1*(dd1*r(0)-2.d0)+c1*dd1**2)*distp(0, 1) -! -! indorbp=indorb -! + fun = (-(dd1*distp(0, 1))-dd2*peff*distp(0, 2)-dd3*peff2*distp(0, & +& 3))/r(0) + fun2 = dd1**2*distp(0, 1) + peff*dd2**2*distp(0, 2) + peff2*dd3**2& +& *distp(0, 3) DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -11176,716 +11311,532 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END IF END DO END DO - funb = 0.0_8 - fun0b = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp337 = fun/r(0) - temp338b = rmu(ic, 0)*zb(indorbp, indt+4) - temp337b = 4.d0*temp338b/r(0) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp337+fun2)*zb(indorbp, indt& -& +4) - funb = funb + temp337b - rb(0) = rb(0) - temp337*temp337b - fun2b = fun2b + temp338b + temp220b6 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp220b6 + fun2b = fun2b + temp220b6 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp336 = fun/r(0) - temp336b0 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(ic, 0) = rmub(ic, 0) + temp336*rmu(i, 0)*zb(indorbp, indt& -& +i) - rmub(i, 0) = rmub(i, 0) + temp336*rmu(ic, 0)*zb(indorbp, indt+& -& i) - funb = funb + temp336b0 - rb(0) = rb(0) - temp336*temp336b0 + IF (.NOT.branch .LT. 2) distpb(0, 4) = distpb(0, 4) + zb(& +& indorbp, indt+i) + temp220b5 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp220b5 + funb0 = funb0 + rmu(ic, 0)*temp220b5 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp336b = distp(0, 1)*fun2b - temp335 = dd1*r(0) - 2.d0 - temp335b3 = c0*dd1*temp336b - temp335b4 = distp(0, 1)*funb - c0b = (1.d0-dd1*r(0))*temp335b4 + distp(0, 2)*fun0b + temp335*dd1*& -& temp336b - dd1b = (-c1-c0*r(0))*temp335b4 + r(0)*temp335b3 + (c1*2*dd1+& -& temp335*c0)*temp336b - rb(0) = rb(0) + dd1*temp335b3 - c0*dd1*temp335b4 - c1b = distp(0, 1)*fun0b - dd1*temp335b4 + dd1**2*temp336b - distpb(0, 1) = (c0*(1.d0-dd1*r(0))-c1*dd1)*funb + (c0*dd1*temp335+& -& c1*dd1**2)*fun2b - distpb(0, 2) = distpb(0, 2) + c0*fun0b - distpb(0, 1) = distpb(0, 1) + c1*fun0b + temp220b2 = dd2**2*fun2b + temp220b3 = dd3**2*fun2b + temp220b4 = funb0/r(0) + dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*temp220b4 + distpb(0, 1) = distpb(0, 1) + dd1**2*fun2b + dd2b = peff*distp(0, 2)*2*dd2*fun2b - distp(0, 2)*peff*temp220b4 + peffb = distp(0, 2)*temp220b2 - distp(0, 2)*dd2*temp220b4 + distpb(0, 2) = distpb(0, 2) + peff*temp220b2 + dd3b = peff2*distp(0, 3)*2*dd3*fun2b - distp(0, 3)*peff2*temp220b4 + peff2b = distp(0, 3)*temp220b3 - distp(0, 3)*dd3*temp220b4 + distpb(0, 3) = distpb(0, 3) + peff2*temp220b3 + distpb(0, 1) = distpb(0, 1) - dd1*temp220b4 + distpb(0, 2) = distpb(0, 2) - dd2*peff*temp220b4 + distpb(0, 3) = distpb(0, 3) - dd3*peff2*temp220b4 + rb(0) = rb(0) - (-(dd1*distp(0, 1))-dd2*peff*distp(0, 2)-dd3*peff2& +& *distp(0, 3))*temp220b4/r(0) ELSE distpb = 0.0_8 - c0b = 0.0_8 - c1b = 0.0_8 + peffb = 0.0_8 dd1b = 0.0_8 + dd2b = 0.0_8 + dd3b = 0.0_8 + peff2b = 0.0_8 END IF DO ic=3,1,-1 DO i=indtm,i0,-1 - temp335b2 = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + (c0*distp(i, 2)+c1*distp(i, 1))*zb(& -& indorbp, i) - c0b = c0b + distp(i, 2)*temp335b2 - distpb(i, 2) = distpb(i, 2) + c0*temp335b2 - c1b = c1b + distp(i, 1)*temp335b2 - distpb(i, 1) = distpb(i, 1) + c1*temp335b2 + rmub(ic, i) = rmub(ic, i) + distp(i, 4)*zb(indorbp, i) + distpb(i, 4) = distpb(i, 4) + rmu(ic, i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + DO i=indtm,indtmin,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) + distpb(i, 1) = distpb(i, 1) + distpb(i, 4) + peffb = peffb + distp(i, 2)*distpb(i, 4) + distpb(i, 2) = distpb(i, 2) + peff*distpb(i, 4) + peff2b = peff2b + distp(i, 3)*distpb(i, 4) + distpb(i, 3) = distpb(i, 3) + peff2*distpb(i, 4) + distpb(i, 4) = 0.0_8 + END DO + cb = 0.0_8 DO k=indtm,indtmin,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(k, 2)) - rb(k) = rb(k) + distp(k, 1)*distpb(k, 2) - distpb(k, 1) = distpb(k, 1) + r(k)*distpb(k, 2) + temp220b = c*DEXP(-(dd3*r(k)))*distpb(k, 3) + cb = cb + DEXP(-(dd3*r(k)))*distpb(k, 3) + dd3b = dd3b - r(k)*temp220b + distpb(k, 3) = 0.0_8 + temp220b0 = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) distpb(k, 2) = 0.0_8 - temp335b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp335b1 - rb(k) = rb(k) - dd1*temp335b1 + temp220b1 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd2*temp220b0 - dd1*temp220b1 - dd3*temp220b + dd2b = dd2b - r(k)*temp220b0 + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp220b1 distpb(k, 1) = 0.0_8 END DO - temp335b0 = 2.5d0*c1b/dd1 - cb = temp335b0 - c0b - dd1b = dd1b + 0.5641895835477562d0*2.5d0*dd1**1.5D0*cb - c*temp335b0& -& /dd1 + temp219 = (dd2+dd3)**5 + temp206 = peff2*peff/temp219 + temp218 = 2.d0**5 + temp217 = temp218*dd3**5 + temp216 = peff2**2/temp217 + temp215 = (dd1+dd3)**5 + temp214 = 2.d0**5 + temp213 = temp214*dd2**5 + temp212 = peff**2/temp213 + temp211 = (dd1+dd2)**5 + temp210 = 2.d0**5 + temp209 = temp210*dd1**5 + temp208 = 8.d0*pi*(1.0/temp209+2.d0*peff/temp211+temp212+2.d0*peff2/& +& temp215+temp216+2.d0*temp206) + temp207 = DSQRT(temp208) + IF (temp208 .EQ. 0.0) THEN + temp207b = 0.0 + ELSE + temp207b = -(pi*8.d0*cb/(2.d0*temp207**2*2.D0*DSQRT(temp208))) + END IF + temp207b0 = 2.d0*temp207b/temp211 + temp207b1 = -(peff*5*(dd1+dd2)**4*temp207b0/temp211) + temp207b2 = 2.d0*temp207b/temp215 + temp207b3 = -(peff2*5*(dd1+dd3)**4*temp207b2/temp215) + temp206b30 = 2.d0*temp207b/temp219 + temp206b31 = -(temp206*5*(dd2+dd3)**4*temp206b30) + dd1b = dd1b + temp207b3 + temp207b1 - temp210*5*dd1**4*temp207b/& +& temp209**2 + peffb = peffb + peff2*temp206b30 + 2*peff*temp207b/temp213 + & +& temp207b0 + dd2b = dd2b + temp206b31 - temp212*temp214*5*dd2**4*temp207b/temp213& +& + temp207b1 + peff2b = peff2b + peff*temp206b30 + 2*peff2*temp207b/temp217 + & +& temp207b2 + dd3b = dd3b + temp206b31 - temp216*temp218*5*dd3**4*temp207b/temp217& +& + temp207b3 + ddb(indpar+5) = ddb(indpar+5) + peff2b + ddb(indpar+4) = ddb(indpar+4) + dd3b + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (41) -! 4p single zeta -!c 4p without cusp condition derivative of 22 -!c r^2 e^{-z1 r } - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2.d0*dd1)**7/240.d0/pi)/2.d0 - c = dd1**3.5d0*0.2060129077457011d0 -! endif - c0 = -c - c1 = 3.5d0*c/dd1 + CASE (86) +! f single gaussian orbital +! R(r)= exp(-alpha r^2) +! normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) + dd2 = DSQRT(dd1) +! if(iflagnorm.gt.2) then +! overall normalization +! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0)*ratiocf + c = dd1**2.25d0*ratiocf +! endif DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k))) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) END DO DO i=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = r(i)**2*distp(i, 1) + distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) +! lz=0 + distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) +! lz=+/-2 + distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) +! lz=+/-2 + distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) +! lz=+/-3 + distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) END DO -! indorbp=indorb - DO ic=1,3 +! lz=+/-3 + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN -! fun=(1.d0-dd1*r(0))*distp(0,1) -! fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) - fun = (c0*(2.d0-dd1*r(0))*r(0)+c1*(1.d0-dd1*r(0)))*distp(0, 1) - fun2 = (c0*((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))+c1*dd1*(dd1*r(0)-& -& 2.d0))*distp(0, 1) -! indorbp=indorb - DO ic=1,3 + fun0 = distp(0, 1) + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) +! the second derivative + fun2 = dd1*distp(0, 1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**& +& 2)/rp3**2 +! indorbp=indorb + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp343 = fun/r(0) - temp344b = rmu(ic, 0)*zb(indorbp, indt+4) - temp343b = 4.d0*temp344b/r(0) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp343+fun2)*zb(indorbp, indt& -& +4) - funb = funb + temp343b - rb(0) = rb(0) - temp343*temp343b - fun2b = fun2b + temp344b - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp342 = fun/r(0) - temp342b0 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - rmub(ic, 0) = rmub(ic, 0) + temp342*rmu(i, 0)*zb(indorbp, indt& -& +i) - rmub(i, 0) = rmub(i, 0) + temp342*rmu(ic, 0)*zb(indorbp, indt+& -& i) - funb = funb + temp342b0 - rb(0) = rb(0) - temp342*temp342b0 - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - distpb = 0.0_8 - temp342b = distp(0, 1)*fun2b - temp341 = (dd1*r(0))**2 - 4.d0*dd1*r(0) + 2.d0 - temp341b = c0*temp342b - temp341b0 = 2*dd1*r(0)*temp341b - temp340 = dd1*r(0) - 2.d0 - temp340b = c1*dd1*temp342b - temp340b0 = distp(0, 1)*funb - temp338 = -(dd1*r(0)) + 2.d0 - c0b = temp338*r(0)*temp340b0 + distp(0, 3)*fun0b + temp341*& -& temp342b - temp339 = c0*r(0) - dd1b = (-(c1*r(0))-temp339*r(0))*temp340b0 + r(0)*temp340b + & -& temp340*c1*temp342b - 4.d0*r(0)*temp341b + r(0)*temp341b0 - rb(0) = rb(0) + (temp338*c0-c1*dd1-temp339*dd1)*temp340b0 + distp(& -& 0, 1)*c1*fun0b + dd1*temp340b - 4.d0*dd1*temp341b + dd1*& -& temp341b0 - c1b = (1.d0-dd1*r(0))*temp340b0 + distp(0, 1)*r(0)*fun0b + temp340& -& *dd1*temp342b - distpb(0, 1) = (temp338*temp339+c1*(1.d0-dd1*r(0)))*funb + (c0*& -& temp341+c1*dd1*temp340)*fun2b - distpb(0, 3) = distpb(0, 3) + c0*fun0b - distpb(0, 1) = distpb(0, 1) + c1*r(0)*fun0b - ELSE - distpb = 0.0_8 - c0b = 0.0_8 - c1b = 0.0_8 - dd1b = 0.0_8 - END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - temp338b2 = rmu(ic, i)*zb(indorbp, i) - temp338b3 = distp(i, 1)*temp338b2 - rmub(ic, i) = rmub(ic, i) + (c0*distp(i, 3)+c1*r(i)*distp(i, 1))& -& *zb(indorbp, i) - c0b = c0b + distp(i, 3)*temp338b2 - distpb(i, 3) = distpb(i, 3) + c0*temp338b2 - c1b = c1b + r(i)*temp338b3 - rb(i) = rb(i) + c1*temp338b3 - distpb(i, 1) = distpb(i, 1) + c1*r(i)*temp338b2 - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO i=indtm,indtmin,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*distpb(i, 3) - distpb(i, 1) = distpb(i, 1) + r(i)**2*distpb(i, 3) - distpb(i, 3) = 0.0_8 - END DO - DO k=indtm,indtmin,-1 - temp338b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp338b1 - rb(k) = rb(k) - dd1*temp338b1 - distpb(k, 1) = 0.0_8 - END DO - temp338b0 = 3.5d0*c1b/dd1 - cb = temp338b0 - c0b - dd1b = dd1b + 0.2060129077457011d0*3.5d0*dd1**2.5D0*cb - c*temp338b0& -& /dd1 - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (42) -! 4d without cusp and one parmater derivative of 30 - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c= & -! & 1.d0/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) - c = dd1**3.5d0*0.26596152026762178d0 -! c= -! & 1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) -! endif - c0 = -c - c1 = 3.5d0*c/dd1 - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k))) - END DO - DO i=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = distp(i, 1)*(c0*r(i)+c1) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) -! lz=0 - distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) -! lz=+/ - distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) -! lz=+/-2 - distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) -! lz=+/-1 - distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) -! lz=+/-1 - distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d - END DO -! indorbp=indorb - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun0 = distp(0, 3) - fun = -(dd1*distp(0, 3)) + c0*distp(0, 1) - fun2 = dd1**2*distp(0, 3) - 2.d0*dd1*c0*distp(0, 1) -! indorbp=indorb - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE + IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN + IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) END IF ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN + IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) END IF + ELSE IF (ic .EQ. 6) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + END IF + ELSE IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp345 = fun/r(0) - temp346b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp345b3 = 6.d0*temp346b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp345+fun2)*zb(& -& indorbp, indt+4) - funb = funb + temp345b3 - rb(0) = rb(0) - temp345*temp345b3 - fun2b = fun2b + temp346b + DO ic=7,1,-1 + temp224b23 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 8.d0*temp224b23 + fun2b = fun2b + temp224b23 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp345b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp345b - fun0b = fun0b + rmu(i, 0)*temp345b + IF (branch .LT. 11) THEN + IF (branch .LT. 6) THEN + IF (branch .LT. 4) THEN + IF (branch .LT. 3) THEN + IF (.NOT.branch .LT. 2) THEN + temp224b2 = cost1f*zb(indorbp, indt+i) + fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& +& temp224b2 + rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& +& temp224b2 + rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp224b2 + END IF + temp224b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) + temp224b1 = rmu(i, 0)*temp224b0 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp224b0 + fun0b = fun0b + rmu(3, 0)*temp224b1 + rmub(3, 0) = rmub(3, 0) + fun0*temp224b1 + GOTO 130 ELSE - temp345b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp345b0 - fun0b = fun0b + rmu(i, 0)*temp345b0 + temp224b5 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp224b5 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp224b5 + rb(0) = rb(0) - fun0*2*r(0)*temp224b5 END IF - ELSE IF (branch .LT. 4) THEN - temp345b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp345b1 - fun0b = fun0b + rmu(i, 0)*temp345b1 + ELSE IF (.NOT.branch .LT. 5) THEN + temp224b6 = cost2f*10.d0*zb(indorbp, indt+i) + temp224b7 = rmu(i, 0)*temp224b6 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp224b6 + fun0b = fun0b + rmu(1, 0)*temp224b7 + rmub(1, 0) = rmub(1, 0) + fun0*temp224b7 END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp345b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp345b2 - fun0b = fun0b + rmu(i, 0)*temp345b2 + temp224b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp224b4 = rmu(i, 0)*temp224b3 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp224b3 + fun0b = fun0b + rmu(1, 0)*temp224b4 + rmub(1, 0) = rmub(1, 0) + fun0*temp224b4 + ELSE IF (branch .LT. 9) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 7) THEN + temp224b10 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp224b10 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp224b10 + rb(0) = rb(0) - fun0*2*r(0)*temp224b10 + END IF ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + temp224b11 = cost2f*10.d0*zb(indorbp, indt+i) + temp224b12 = rmu(i, 0)*temp224b11 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp224b11 + fun0b = fun0b + rmu(2, 0)*temp224b12 + rmub(2, 0) = rmub(2, 0) + fun0*temp224b12 END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + temp224b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp224b9 = rmu(i, 0)*temp224b8 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp224b8 + fun0b = fun0b + rmu(2, 0)*temp224b9 + rmub(2, 0) = rmub(2, 0) + fun0*temp224b9 + ELSE IF (branch .LT. 10) THEN + temp224b13 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp224b13 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp224b13 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp224b13 + ELSE + temp224b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp224b14 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp224b14 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp224b14 END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 16) THEN + IF (branch .LT. 14) THEN + IF (branch .LT. 13) THEN + IF (branch .LT. 12) THEN + temp224b15 = cost3f*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp224b15 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp224b15 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp224b15 + ELSE + temp224b16 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp224b16 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp224b16 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp224b16 + END IF + ELSE + temp224b17 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp224b17 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp224b17 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp224b17 END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 15) THEN + temp224b18 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp224b18 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp224b18 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp224b18 + ELSE + temp224b19 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp224b19 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp224b19 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp224b19 END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 19) THEN + IF (branch .LT. 18) THEN + IF (.NOT.branch .LT. 17) THEN + temp224b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp224b20 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp224b20 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp224b20 + END IF + ELSE + temp224b21 = cost4f*6.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp224b21 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp224b21 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp224b21 END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + ELSE IF (.NOT.branch .LT. 20) THEN + temp224b22 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp224b22 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp224b22 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp224b22 END IF - temp344 = fun/r(0) - temp344b4 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp344*rmu(i, 0)*zb(& -& indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp344*distp(0, 3+ic)*zb(indorbp, & + 130 temp224b = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - funb = funb + temp344b4 - rb(0) = rb(0) - temp344*temp344b4 + rmub(i, 0) = rmub(i, 0) + fun*temp224b + funb0 = funb0 + rmu(i, 0)*temp224b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp344b3 = -(2.d0*distp(0, 1)*fun2b) - dd1b = c0*temp344b3 - distp(0, 3)*funb + distp(0, 3)*2*dd1*fun2b - distpb(0, 3) = distpb(0, 3) + dd1**2*fun2b - c0b = distp(0, 1)*funb + dd1*temp344b3 - distpb(0, 1) = distpb(0, 1) + c0*funb - 2.d0*dd1*c0*fun2b - distpb(0, 3) = distpb(0, 3) + fun0b - dd1*funb + temp223 = rp3**2 + temp222b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& +& temp223 + temp222 = dd1*distp(0, 1)/temp223 + temp222b0 = temp222*fun2b + rp1b = (2*rp1+4.d0*rp2+4.d0)*temp222b0 + temp221b8 = -(distp(0, 1)*(rp2+2.d0)*funb0/rp3) + dd1b = temp221b8 + r(0)**2*rp1b + distp(0, 1)*temp222b + temp221 = dd1/rp3 + distpb(0, 1) = distpb(0, 1) + fun0b - temp221*(rp2+2.d0)*funb0 + & +& dd1*temp222b + rp3b = -(temp221*temp221b8) - temp222*2*rp3*temp222b + rp2b = 2*(rp2+1.d0)*rp3b - temp221*distp(0, 1)*funb0 + (4.d0*rp1-& +& 2.d0)*temp222b0 + dd2b = r(0)*rp2b + rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b ELSE distpb = 0.0_8 - c0b = 0.0_8 dd1b = 0.0_8 + dd2b = 0.0_8 END IF - DO ic=5,1,-1 - DO i=indtm,i0,-1 - distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=7,1,-1 + DO k=indtm,i0,-1 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - c1b = 0.0_8 DO i=indtm,indtmin,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + temp221b0 = cost4f*rmu(2, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 8) - 2*rmu(2, i)*temp221b0 distpb(i, 8) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + temp221b1 = cost4f*rmu(1, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& +& distpb(i, 7) + 2*rmu(1, i)*temp221b1 + 3.d0*2*rmu(1, i)*& +& temp221b0 + rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp221b1 distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + temp221b2 = cost3f*2.d0*distpb(i, 6) + temp221b3 = rmu(2, i)*temp221b2 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp221b3 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp221b3 + rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp221b2 distpb(i, 6) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + temp221b4 = cost3f*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 5) + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp221b4 distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 4) - 2*rmu(2, i)*temp221b4 + temp221b5 = cost2f*rmu(2, i)*distpb(i, 4) + rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp221b5 distpb(i, 4) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - temp344b2 = distp(i, 1)*distpb(i, 3) - distpb(i, 1) = distpb(i, 1) + (c0*r(i)+c1)*distpb(i, 3) - c0b = c0b + r(i)*temp344b2 - rb(i) = rb(i) + c0*temp344b2 - c1b = c1b + temp344b2 + temp221b6 = cost2f*rmu(1, i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 3) distpb(i, 3) = 0.0_8 + temp221b7 = cost1f*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - 2*r(i)*temp221b6 - 3.d0*2*r(i)*temp221b7 - 2*r(i)*& +& temp221b5 + rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& +& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp221b7 + 5.d0*2*rmu(3, i)*& +& temp221b6 + distpb(i, 2) = 0.0_8 END DO + cb = 0.0_8 DO k=indtm,indtmin,-1 - temp344b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp344b1 - rb(k) = rb(k) - dd1*temp344b1 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp220 = dd2*r(k) + 1.d0 + temp221b = costb/temp220 + temp220b7 = -(dd1*r(k)**2*temp221b/temp220) + dd1b = dd1b + r(k)**2*temp221b + rb(k) = rb(k) + dd2*temp220b7 + dd1*2*r(k)*temp221b + dd2b = dd2b + r(k)*temp220b7 END DO - temp344b0 = 3.5d0*c1b/dd1 - cb = temp344b0 - c0b - dd1b = dd1b + 0.26596152026762178d0*3.5d0*dd1**2.5D0*cb - c*& -& temp344b0/dd1 - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (43) -! 4d without cusp and one parmater derivative of 33 - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c= & -! & 1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) - c = dd1**4.5d0*0.0710812062076410d0 -! endif - c0 = -c - c1 = 4.5d0*c/dd1 + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocf*2.25d0*dd1**1.25D0*cb + ELSE + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocf*2.25d0*dd1**1.25D0*& +& cb + END IF + ddb(indparp) = ddb(indparp) + dd1b + CASE (101) +! derivative of 48 with respect to z +! 2s without cusp condition +! dd1*( dd3 +exp(-dd2*r^2)) + dd2 = dd(indpar+1) + indorbp = indorb + 1 DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k))) - END DO - DO i=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = distp(i, 1)*(c0*r(i)**2+c1*r(i)) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) -! lz=0 - distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) -! lz=+/ - distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) -! lz=+/-2 - distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) -! lz=+/-1 - distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) -! lz=+/-1 - distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d - END DO -! indorbp=indorb - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic + distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) END DO -! endif +! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 3) - fun = -(dd1*distp(0, 3)) + distp(0, 1)*(2.d0*c0*r(0)+c1) - fun2 = dd1**2*distp(0, 3) + distp(0, 1)*(-(2.d0*dd1*(2.d0*c0*r(0)+& -& c1))+2.d0*c0) -! indorbp=indorb - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - END IF - END DO - END DO + fun = -(dd2*distp(0, 1)*2.d0) distpb = 0.0_8 - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=5,1,-1 - temp348 = fun/r(0) - temp349b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp348b3 = 6.d0*temp349b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp348+fun2)*zb(& -& indorbp, indt+4) - funb = funb + temp348b3 - rb(0) = rb(0) - temp348*temp348b3 - fun2b = fun2b + temp349b - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp348b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp348b - fun0b = fun0b + rmu(i, 0)*temp348b - ELSE - temp348b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp348b0 - fun0b = fun0b + rmu(i, 0)*temp348b0 - END IF - ELSE IF (branch .LT. 4) THEN - temp348b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp348b1 - fun0b = fun0b + rmu(i, 0)*temp348b1 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp348b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp348b2 - fun0b = fun0b + rmu(i, 0)*temp348b2 - ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - temp347 = fun/r(0) - temp347b0 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp347*rmu(i, 0)*zb(& -& indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp347*distp(0, 3+ic)*zb(indorbp, & -& indt+i) - funb = funb + temp347b0 - rb(0) = rb(0) - temp347*temp347b0 - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + temp224b25 = 2.d0**2*dd2*distp(0, 1)*zb(indorbp, indt+4) + temp224b26 = 2.d0*(2.d0*(dd2*r(0)**2)-3.d0)*zb(indorbp, indt+4) + dd2b = distp(0, 1)*temp224b26 + r(0)**2*temp224b25 + rb(0) = rb(0) + dd2*2*r(0)*temp224b25 + distpb(0, 1) = dd2*temp224b26 + zb(indorbp, indt+4) = 0.0_8 + funb0 = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 END DO - temp346 = 2.d0*c0*r(0) + c1 - temp347b = -(distp(0, 1)*2.d0*fun2b) - temp346b3 = dd1*temp347b - dd1b = temp346*temp347b - distp(0, 3)*funb + distp(0, 3)*2*dd1*& -& fun2b - distpb(0, 3) = distpb(0, 3) + dd1**2*fun2b - distpb(0, 1) = distpb(0, 1) + (2.d0*(c0*r(0))+c1)*funb + (2.d0*c0-& -& 2.d0*(dd1*temp346))*fun2b - temp346b4 = distp(0, 1)*funb - c0b = 2.d0*r(0)*temp346b4 + 2.d0*r(0)*temp346b3 + distp(0, 1)*2.d0& -& *fun2b - rb(0) = rb(0) + 2.d0*c0*temp346b4 + 2.d0*c0*temp346b3 - c1b = temp346b4 + temp346b3 - distpb(0, 3) = distpb(0, 3) + fun0b - dd1*funb + dd2b = dd2b - 2.d0*distp(0, 1)*funb0 + distpb(0, 1) = distpb(0, 1) - 2.d0*dd2*funb0 ELSE distpb = 0.0_8 - c0b = 0.0_8 - c1b = 0.0_8 - dd1b = 0.0_8 + dd2b = 0.0_8 END IF - DO ic=5,1,-1 - DO i=indtm,i0,-1 - distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO i=indtm,indtmin,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) - distpb(i, 8) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) - distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - temp346b2 = distp(i, 1)*distpb(i, 3) - distpb(i, 1) = distpb(i, 1) + (c0*r(i)**2+c1*r(i))*distpb(i, 3) - c0b = c0b + r(i)**2*temp346b2 - rb(i) = rb(i) + (c1+c0*2*r(i))*temp346b2 - c1b = c1b + r(i)*temp346b2 - distpb(i, 3) = 0.0_8 + dd3b = 0.0_8 + DO i=indtm,i0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO DO k=indtm,indtmin,-1 - temp346b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp346b1 - rb(k) = rb(k) - dd1*temp346b1 + temp224b24 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp224b24 + rb(k) = rb(k) - dd2*2*r(k)*temp224b24 distpb(k, 1) = 0.0_8 END DO - temp346b0 = 4.5d0*c1b/dd1 - cb = temp346b0 - c0b - dd1b = dd1b + 0.0710812062076410d0*4.5d0*dd1**3.5D0*cb - c*temp346b0& -& /dd1 - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (44) -! derivative of 36 with respect zeta -! R(r)=x*exp(-z*r**2)*(5/4/z-r**2) - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0 - c = dd1**1.25d0*1.42541094070998d0 -! endif + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (150) +! 2p single exponential r e^{-z r^2} + dd2 = dd(indpar+1) DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + distp(k, 1) = DEXP(-(dd2*r(k)**2)) END DO -! indorbp=indorb -! +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = distp(0, 1)*(2.d0*dd1*r(0)**2-9.d0/2.d0) - fun2 = distp(0, 1)*(-(4.d0*dd1**2*r(0)**4)+15.d0*dd1*r(0)**2-9.d0/& -& 2.d0) -! indorbp=indorb + fun0 = distp(0, 1)*r(0) + cost = 2.d0*dd2*r(0)**2 + fun = distp(0, 1)*(1.d0-cost)/r(0) + fun2 = 2.d0*dd2*fun0*(cost-3.d0) +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -11895,869 +11846,721 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp355b0 = rmu(ic, 0)*zb(indorbp, indt+4) + temp225b1 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp355b0 - fun2b = fun2b + temp355b0 + funb0 = funb0 + 4.d0*temp225b1 + fun2b = fun2b + temp225b1 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp355b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp355b - funb = funb + rmu(ic, 0)*temp355b + temp225b0 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp225b0 + funb0 = funb0 + rmu(ic, 0)*temp225b0 rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + temp225b = 2.d0*(cost-3.d0)*fun2b + temp224b29 = distp(0, 1)*funb0/r(0) + costb = 2.d0*dd2*fun0*fun2b - temp224b29 + dd2b = 2.d0*r(0)**2*costb + fun0*temp225b + fun0b = fun0b + dd2*temp225b distpb = 0.0_8 - temp354 = r(0)**4 - temp354b = distp(0, 1)*fun2b - temp353 = 4.d0*dd1 - temp352 = 5.d0/temp353 - distpb(0, 1) = (2.d0*(dd1*r(0)**2)-9.d0/2.d0)*funb + (temp352-r(0)& -& **2)*fun0b + (15.d0*(dd1*r(0)**2)-9.d0/2.d0-4.d0*(dd1**2*temp354& -& ))*fun2b - temp354b0 = distp(0, 1)*2.d0*funb - dd1b = r(0)**2*temp354b0 - distp(0, 1)*temp352*4.d0*fun0b/temp353 & -& + (15.d0*r(0)**2-4.d0*temp354*2*dd1)*temp354b - rb(0) = rb(0) + dd1*2*r(0)*temp354b0 - distp(0, 1)*2*r(0)*fun0b + & -& (15.d0*dd1*2*r(0)-4.d0*dd1**2*4*r(0)**3)*temp354b + temp224 = (-cost+1.d0)/r(0) + distpb(0, 1) = r(0)*fun0b + temp224*funb0 + rb(0) = rb(0) + 2.d0*dd2*2*r(0)*costb + distp(0, 1)*fun0b - & +& temp224*temp224b29 ELSE distpb = 0.0_8 - dd1b = 0.0_8 + dd2b = 0.0_8 END IF DO ic=3,1,-1 DO i=indtm,i0,-1 - temp351 = 4.d0*dd1 - temp350 = 5.d0/temp351 - temp350b = (temp350-r(i)**2)*zb(indorbp, i) - temp350b0 = rmu(ic, i)*distp(i, 1)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp350b - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp350b - dd1b = dd1b - temp350*4.d0*temp350b0/temp351 - rb(i) = rb(i) - 2*r(i)*temp350b0 + temp224b28 = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*r(i)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + r(i)*temp224b28 + rb(i) = rb(i) + distp(i, 1)*temp224b28 zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - cb = 0.0_8 DO k=indtm,indtmin,-1 - temp349 = r(k)**2 - temp349b0 = c*DEXP(-(dd1*temp349))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp349))*distpb(k, 1) - dd1b = dd1b - temp349*temp349b0 - rb(k) = rb(k) - dd1*2*r(k)*temp349b0 + temp224b27 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp224b27 + rb(k) = rb(k) - dd2*2*r(k)*temp224b27 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 1.42541094070998d0*1.25d0*dd1**0.25D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (45, 69) -! derivative of 37 with respect to z -! d orbitals -! R(r)= c*exp(-z r^2)*(7/4/z-r^2) -! indorbp=indorb + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (155) +! Jastrow single gaussian f orbital +! derivative of 154 with respect to z +! unnormalized f orbitals +! R(r)= -r^2*exp(-z r^2) +! indorbp=indorb indparp = indpar + 1 dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) - c = dd1**1.75d0*1.64592278064948967213d0 -! endif DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + distp(k, 1) = DEXP(-(dd1*r(k)**2)) END DO DO i=indtmin,indtm -! lz=0 - distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d -! lz=+/-2 - distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d -! lz=+/-2 - distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d -! lz=+/-1 - distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d -! lz=+/-1 - distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d + distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) +! lz=0 + distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) +! lz=+/-2 + distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) +! lz=+/-2 + distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) +! lz=+/-3 + distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) END DO - DO ic=1,5 +! lz=+/-3 + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) dd1 = dd(indparp) - fun0 = distp(0, 1)*(7.d0/4.d0/dd1-r(0)**2) - fun = distp(0, 1)*(2.d0*dd1*r(0)**2-11.d0/2.d0) - fun2 = distp(0, 1)*(-(4.d0*dd1**2*r(0)**4)+17.d0*dd1*r(0)**2-11.d0& -& /2.d0) -! indorbp=indorb - DO ic=1,5 + fun0 = -(r(0)**2*distp(0, 1)) + fun = 2.d0*(dd1*r(0)**2-1.d0)*distp(0, 1) + fun2 = -(2.d0*(2.d0*dd1**2*r(0)**4+1.d0-5.d0*dd1*r(0)**2)*distp(0& +& , 1)) +! indorbp=indorb + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE + IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN + IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) END IF ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN + IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) END IF + ELSE IF (ic .EQ. 6) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + END IF + ELSE IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp361b4 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & + DO ic=7,1,-1 + temp226b23 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & & indt+4) - funb = funb + 6.d0*temp361b4 - fun2b = fun2b + temp361b4 + funb0 = funb0 + 8.d0*temp226b23 + fun2b = fun2b + temp226b23 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp361b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp361b0 - fun0b = fun0b + rmu(i, 0)*temp361b0 + IF (branch .LT. 11) THEN + IF (branch .LT. 6) THEN + IF (branch .LT. 4) THEN + IF (branch .LT. 3) THEN + IF (.NOT.branch .LT. 2) THEN + temp226b2 = cost1f*zb(indorbp, indt+i) + fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& +& temp226b2 + rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& +& temp226b2 + rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp226b2 + END IF + temp226b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) + temp226b1 = rmu(i, 0)*temp226b0 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp226b0 + fun0b = fun0b + rmu(3, 0)*temp226b1 + rmub(3, 0) = rmub(3, 0) + fun0*temp226b1 + GOTO 140 ELSE - temp361b1 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp361b1 - fun0b = fun0b + rmu(i, 0)*temp361b1 + temp226b5 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp226b5 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp226b5 + rb(0) = rb(0) - fun0*2*r(0)*temp226b5 END IF - ELSE IF (branch .LT. 4) THEN - temp361b2 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp361b2 - fun0b = fun0b + rmu(i, 0)*temp361b2 + ELSE IF (.NOT.branch .LT. 5) THEN + temp226b6 = cost2f*10.d0*zb(indorbp, indt+i) + temp226b7 = rmu(i, 0)*temp226b6 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp226b6 + fun0b = fun0b + rmu(1, 0)*temp226b7 + rmub(1, 0) = rmub(1, 0) + fun0*temp226b7 END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp361b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp361b3 - fun0b = fun0b + rmu(i, 0)*temp361b3 + temp226b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp226b4 = rmu(i, 0)*temp226b3 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp226b3 + fun0b = fun0b + rmu(1, 0)*temp226b4 + rmub(1, 0) = rmub(1, 0) + fun0*temp226b4 + ELSE IF (branch .LT. 9) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 7) THEN + temp226b10 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp226b10 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp226b10 + rb(0) = rb(0) - fun0*2*r(0)*temp226b10 + END IF ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + temp226b11 = cost2f*10.d0*zb(indorbp, indt+i) + temp226b12 = rmu(i, 0)*temp226b11 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp226b11 + fun0b = fun0b + rmu(2, 0)*temp226b12 + rmub(2, 0) = rmub(2, 0) + fun0*temp226b12 END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + temp226b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp226b9 = rmu(i, 0)*temp226b8 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp226b8 + fun0b = fun0b + rmu(2, 0)*temp226b9 + rmub(2, 0) = rmub(2, 0) + fun0*temp226b9 + ELSE IF (branch .LT. 10) THEN + temp226b13 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp226b13 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp226b13 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp226b13 + ELSE + temp226b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp226b14 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp226b14 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp226b14 END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 16) THEN + IF (branch .LT. 14) THEN + IF (branch .LT. 13) THEN + IF (branch .LT. 12) THEN + temp226b15 = cost3f*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp226b15 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp226b15 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp226b15 + ELSE + temp226b16 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp226b16 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp226b16 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp226b16 + END IF + ELSE + temp226b17 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp226b17 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp226b17 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp226b17 END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 15) THEN + temp226b18 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp226b18 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp226b18 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp226b18 + ELSE + temp226b19 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp226b19 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp226b19 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp226b19 END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 19) THEN + IF (branch .LT. 18) THEN + IF (.NOT.branch .LT. 17) THEN + temp226b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp226b20 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp226b20 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp226b20 + END IF + ELSE + temp226b21 = cost4f*6.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp226b21 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp226b21 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp226b21 END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + ELSE IF (.NOT.branch .LT. 20) THEN + temp226b22 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp226b22 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp226b22 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp226b22 END IF - temp361b = distp(0, 1+ic)*zb(indorbp, indt+i) + 140 temp226b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp361b - funb = funb + rmu(i, 0)*temp361b + rmub(i, 0) = rmub(i, 0) + fun*temp226b + funb0 = funb0 + rmu(i, 0)*temp226b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp360 = r(0)**4 - temp360b = distp(0, 1)*fun2b - temp359 = 4.d0*dd1 - temp358 = 7.d0/temp359 - distpb(0, 1) = distpb(0, 1) + (2.d0*(dd1*r(0)**2)-11.d0/2.d0)*funb& -& + (temp358-r(0)**2)*fun0b + (17.d0*(dd1*r(0)**2)-11.d0/2.d0-4.d0& -& *(dd1**2*temp360))*fun2b - temp360b0 = distp(0, 1)*2.d0*funb - dd1b = r(0)**2*temp360b0 - distp(0, 1)*temp358*4.d0*fun0b/temp359 & -& + (17.d0*r(0)**2-4.d0*temp360*2*dd1)*temp360b - rb(0) = rb(0) + dd1*2*r(0)*temp360b0 - distp(0, 1)*2*r(0)*fun0b + & -& (17.d0*dd1*2*r(0)-4.d0*dd1**2*4*r(0)**3)*temp360b + temp225 = r(0)**4 + temp225b12 = -(2.d0*distp(0, 1)*fun2b) + temp225b13 = 2.d0*distp(0, 1)*funb0 + dd1b = r(0)**2*temp225b13 + (2.d0*temp225*2*dd1-5.d0*r(0)**2)*& +& temp225b12 + rb(0) = rb(0) + dd1*2*r(0)*temp225b13 - distp(0, 1)*2*r(0)*fun0b +& +& (2.d0*dd1**2*4*r(0)**3-5.d0*dd1*2*r(0))*temp225b12 + distpb(0, 1) = distpb(0, 1) + 2.d0*(dd1*r(0)**2-1.d0)*funb0 - r(0)& +& **2*fun0b - 2.d0*(2.d0*(dd1**2*temp225)-5.d0*(dd1*r(0)**2)+1.d0)& +& *fun2b CALL POPREAL8(adr8ibuf,adr8buf,dd1) ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 END IF - dd1b = 0.0_8 - DO ic=5,1,-1 + DO ic=7,1,-1 DO k=indtm,i0,-1 - temp358b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) - temp357 = 4.d0*dd1 - temp356 = 7.d0/temp357 - temp356b = (temp356-r(k)**2)*zb(indorbp, k) - dd1b = dd1b - temp356*4.d0*temp358b/temp357 - rb(k) = rb(k) - 2*r(k)*temp358b - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp356b - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp356b + temp225b11 = -(r(k)**2*zb(indorbp, k)) + rb(k) = rb(k) - distp(k, 1)*distp(k, 1+ic)*2*r(k)*zb(indorbp, k) + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp225b11 + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp225b11 zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) + temp225b3 = cost4f*rmu(2, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 8) - 2*rmu(2, i)*temp225b3 + distpb(i, 8) = 0.0_8 + temp225b4 = cost4f*rmu(1, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& +& distpb(i, 7) + 2*rmu(1, i)*temp225b4 + 3.d0*2*rmu(1, i)*& +& temp225b3 + rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp225b4 + distpb(i, 7) = 0.0_8 + temp225b5 = cost3f*2.d0*distpb(i, 6) + temp225b6 = rmu(2, i)*temp225b5 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp225b6 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp225b6 + rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp225b5 distpb(i, 6) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) + temp225b7 = cost3f*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 5) + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp225b7 distpb(i, 5) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 4) - 2*rmu(2, i)*temp225b7 + temp225b8 = cost2f*rmu(2, i)*distpb(i, 4) + rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp225b8 distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) + temp225b9 = cost2f*rmu(1, i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 3) distpb(i, 3) = 0.0_8 - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) + temp225b10 = cost1f*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - 2*r(i)*temp225b9 - 3.d0*2*r(i)*temp225b10 - 2*r(i)& +& *temp225b8 + rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& +& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp225b10 + 5.d0*2*rmu(3, i)*& +& temp225b9 distpb(i, 2) = 0.0_8 END DO - cb = 0.0_8 + dd1b = 0.0_8 DO k=indtm,indtmin,-1 - temp355 = r(k)**2 - temp355b1 = c*DEXP(-(dd1*temp355))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp355))*distpb(k, 1) - dd1b = dd1b - temp355*temp355b1 - rb(k) = rb(k) - dd1*2*r(k)*temp355b1 + temp225b2 = DEXP(-(dd1*r(k)**2))*distpb(k, 1) + dd1b = dd1b - r(k)**2*temp225b2 + rb(k) = rb(k) - dd1*2*r(k)*temp225b2 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 1.64592278064948967213d0*1.75d0*dd1**0.75D0*cb ddb(indparp) = ddb(indparp) + dd1b - CASE (46) -! derivative of 17 with respect to z -! R(r)=c*r**2*exp(-z*r**2)*(7/4/z-r**2) -! if(iocc(indshellp).eq.1) then - indorbp = indorb + 1 + CASE (83) +! R(r)=x*exp(-z*r**2)*(5/4/z-r**2) dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then - c = 4.d0*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)/DSQRT(15.d0) -! endif + dd2 = DSQRT(dd1) + c = dd1**1.25d0*ratiocp DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) + END DO +! indorbp=indorb +! + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=i0,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*dd2*r(i))/(1.d0+dd2*r(i))**2 + END DO END DO +! endif IF (typec .NE. 1) THEN - rp1 = r(0)**2 -! the first derivative / r - fun = distp(0, 1)*(7.d0-15.d0*dd1*rp1+4.d0*(dd1*rp1)**2)/2.d0/dd1 -! the second derivative - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*rp2)/rp3 + fun = 0.25d0*distp(0, 1)*(-18.d0-39.d0*rp2-20.d0*rp1+rp1*rp2+2.d0*& +& rp1**2)/rp3**2 + fun2 = 0.25d0*distp(0, 1)*(-18.d0-42.d0*rp2+30.d0*rp1+138.d0*rp1*& +& rp2+113.d0*rp1**2+30.d0*rp1**2*rp2-3.d0*rp1**3-2.d0*rp1**3*rp2)/& +& rp3**3 +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp233b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp233b0 + fun2b = fun2b + temp233b0 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp233b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp233b + funb0 = funb0 + rmu(ic, 0)*temp233b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp367 = 2.d0*dd1 - temp366 = distp(0, 1)/temp367 - temp367b = temp366*fun2b - temp367b0 = 50*2*dd1*rp1*temp367b - temp367b1 = -(8*3*dd1**2*rp1**2*temp367b) - temp366b = (50*(dd1*rp1)**2-59*(dd1*rp1)-8*(dd1*rp1)**3+7.d0)*& -& fun2b/temp367 - temp365 = 2.d0*dd1 - temp364 = distp(0, 1)/temp365 - temp365b = temp364*funb - temp364b = (4.d0*(dd1**2*rp1**2)-15.d0*(dd1*rp1)+7.d0)*funb/& -& temp365 - dd1b = (4.d0*rp1**2*2*dd1-15.d0*rp1)*temp365b - temp364*2.d0*& -& temp364b - temp366*2.d0*temp366b + rp1*temp367b1 - 59*rp1*& -& temp367b + rp1*temp367b0 - rp1b = (4.d0*dd1**2*2*rp1-15.d0*dd1)*temp365b + dd1*temp367b1 - 59& -& *dd1*temp367b + dd1*temp367b0 - distpb(0, 1) = temp364b + temp366b - rb(0) = rb(0) + 2*r(0)*rp1b + temp232 = rp3**3 + temp230 = distp(0, 1)/temp232 + temp231 = rp1**3 + temp231b = 0.25d0*temp230*fun2b + temp230b = 0.25d0*(30.d0*rp1-42.d0*rp2+138.d0*(rp1*rp2)+113.d0*rp1& +& **2+30.d0*(rp1**2*rp2)-3.d0*rp1**3-2.d0*(temp231*rp2)-18.d0)*& +& fun2b/temp232 + temp229 = rp3**2 + temp228 = distp(0, 1)/temp229 + temp229b = 0.25d0*temp228*funb0 + rp1b = (2.d0*2*rp1+rp2-20.d0)*temp229b + (30.d0*rp2*2*rp1-3.d0*3*& +& rp1**2-2.d0*rp2*3*rp1**2+113.d0*2*rp1+138.d0*rp2+30.d0)*temp231b + temp228b2 = 0.25d0*(rp1*rp2-20.d0*rp1-39.d0*rp2+2.d0*rp1**2-18.d0)& +& *funb0/temp229 + temp228b3 = distp(0, 1)*fun0b + costb = -(r(0)**2*temp228b3) + rp3b = -(temp228*2*rp3*temp228b2) - (0.5d0*rp2+1.d0)*costb/rp3**2 & +& - temp230*3*rp3**2*temp230b + rp2b = (rp1-39.d0)*temp229b + 2*(rp2+1.d0)*rp3b + 0.5d0*costb/rp3 & +& + (30.d0*rp1**2-2.d0*temp231+138.d0*rp1-42.d0)*temp231b + distpb(0, 1) = temp228b2 + (1.25d0/dd1-r(0)**2*cost)*fun0b + & +& temp230b + dd1b = r(0)**2*rp1b - 1.25d0*temp228b3/dd1**2 + rb(0) = rb(0) + dd2*rp2b + dd1*2*r(0)*rp1b - cost*2*r(0)*temp228b3 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = r(0)*rp2b ELSE distpb = 0.0_8 dd1b = 0.0_8 + dd2b = 0.0_8 END IF - DO i=indtm,i0,-1 - temp363 = 4.d0*dd1 - temp362 = r(i)**2/temp363 - temp363b = distp(i, 1)*zb(indorbp, i) - temp362b = 7.d0*temp363b/temp363 - distpb(i, 1) = distpb(i, 1) + (7.d0*temp362-r(i)**4)*zb(indorbp, i& -& ) - rb(i) = rb(i) + 2*r(i)*temp362b - 4*r(i)**3*temp363b - dd1b = dd1b - temp362*4.d0*temp362b - zb(indorbp, i) = 0.0_8 + DO ic=3,1,-1 + DO i=indtm,i0,-1 + temp228b = (1.25d0/dd1-r(i)**2*cost)*zb(indorbp, i) + temp228b0 = rmu(ic, i)*distp(i, 1)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp228b + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp228b + dd1b = dd1b - 1.25d0*temp228b0/dd1**2 + costb = -(r(i)**2*temp228b0) + temp227 = dd2*r(i) + 1.d0 + temp228b1 = costb/temp227**2 + temp227b0 = -((0.5d0*(dd2*r(i))+1.d0)*2*temp228b1/temp227) + rb(i) = rb(i) + 0.5d0*dd2*temp228b1 + dd2*temp227b0 - cost*2*r(i& +& )*temp228b0 + zb(indorbp, i) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = dd2b + r(i)*temp227b0 + 0.5d0*r(i)*temp228b1 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - temp361 = r(k)**2 - temp361b5 = c*DEXP(-(dd1*temp361))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp361))*distpb(k, 1) - dd1b = dd1b - temp361*temp361b5 - rb(k) = rb(k) - dd1*2*r(k)*temp361b5 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp226 = dd2*r(k) + 1.d0 + temp227b = costb/temp226 + temp226b24 = -(dd1*r(k)**2*temp227b/temp226) + dd1b = dd1b + r(k)**2*temp227b + rb(k) = rb(k) + dd2*temp226b24 + dd1*2*r(k)*temp227b + dd2b = dd2b + r(k)*temp226b24 END DO - IF (.NOT.(dd1 .LE. 0.0 .AND. (7.d0/4.d0 .EQ. 0.0 .OR. 7.d0/4.d0 .NE.& -& INT(7.d0/4.d0)))) dd1b = dd1b + (2.d0/pi)**(3.d0/4.d0)*7.d0*dd1& -& **(7.d0/4.d0-1)*cb/DSQRT(15.d0) + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocp*1.25d0*dd1**0.25D0*cb + ELSE + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocp*1.25d0*dd1**0.25D0*& +& cb + END IF ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (50) -! 5s single zeta derivative of 12 -! R(r)=(c0*r**4+c1*r**3)*exp(-z1*r) -! -! if(iocc(indshellp).eq.1) then + CASE (81) +! R(r)=c*exp(-z*r**2)*(3/4/z-r**2) +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then - c = DSQRT((2*dd1)**9/40320.d0/pi)/2.d0 -! endif - c0 = -c - c1 = 4.5d0*c/dd1 + dd2 = DSQRT(dd1) +! c=(2.d0*dd1/pi)**(3.d0/4.d0)*ratiocs + c = dd1**0.75d0*ratiocs DO k=indtmin,indtm - distp(k, 1) = r(k)*DEXP(-(dd1*r(k))) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) + END DO + DO i=i0,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*dd2*r(i))/(1.d0+dd2*r(i))**2 END DO IF (typec .NE. 1) THEN - rp1 = r(0)*dd1 - rp2 = rp1*rp1 -!c the first derivative/r - fun = -(distp(0, 1)*(c0*r(0)*(rp1-4.d0)+c1*(rp1-3.d0))) -!c -!c the second derivative - funb = 2.d0*zb(indorbp, indt+4) +! the first derivative /r + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + fun = 0.25d0*distp(0, 1)*(-14.d0-29.d0*rp2-12.d0*rp1+3.d0*rp1*rp2+& +& 2.d0*rp1**2)/rp3**2 +! the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp371 = rp2 - 8.d0*rp1 + 12.d0 - temp370 = c0*r(0) - temp370b0 = distp(0, 1)*fun2b - distpb(0, 1) = (temp370*temp371+c1*(rp2-6*rp1+6.d0))*fun2b - (c0*r& -& (0)*(rp1-4.d0)+c1*(rp1-3.d0))*funb - temp370b1 = -(distp(0, 1)*funb) - c0b = (rp1-4.d0)*r(0)*temp370b1 + temp371*r(0)*temp370b0 - rp2b = (c1+temp370)*temp370b0 - rp1b = (c1+c0*r(0))*temp370b1 + 2*rp1*rp2b + ((-6)*c1-temp370*8.d0& -& )*temp370b0 - rb(0) = rb(0) + (rp1-4.d0)*c0*temp370b1 + dd1*rp1b + temp371*c0*& -& temp370b0 - c1b = (rp1-3.d0)*temp370b1 + (rp2-6*rp1+6.d0)*temp370b0 - dd1b = r(0)*rp1b + temp241 = rp3**3 + temp239 = distp(0, 1)/temp241 + temp240 = rp1**3 + temp240b = 0.25d0*temp239*fun2b + temp239b = 0.25d0*(34.d0*rp1-30.d0*rp2+118.d0*(rp1*rp2)+87.d0*rp1& +& **2+18.d0*(rp1**2*rp2)-5.d0*rp1**3-2.d0*(temp240*rp2)-14.d0)*& +& fun2b/temp241 + temp238 = rp3**2 + temp237 = distp(0, 1)/temp238 + temp238b = 0.25d0*temp237*funb0 + rp1b = (2.d0*2*rp1+3.d0*rp2-12.d0)*temp238b + (18.d0*rp2*2*rp1-& +& 5.d0*3*rp1**2-2.d0*rp2*3*rp1**2+87.d0*2*rp1+118.d0*rp2+34.d0)*& +& temp240b + temp237b = 0.25d0*(3.d0*(rp1*rp2)-12.d0*rp1-29.d0*rp2+2.d0*rp1**2-& +& 14.d0)*funb0/temp238 + rp3b = -(temp237*2*rp3*temp237b) - temp239*3*rp3**2*temp239b + rp2b = (3.d0*rp1-29.d0)*temp238b + 2*(rp2+1.d0)*rp3b + (18.d0*rp1& +& **2-2.d0*temp240+118.d0*rp1-30.d0)*temp240b + distpb(0, 1) = temp237b + temp239b + dd2b = r(0)*rp2b + rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b + dd1b = r(0)**2*rp1b ELSE distpb = 0.0_8 - c0b = 0.0_8 - c1b = 0.0_8 dd1b = 0.0_8 + dd2b = 0.0_8 END IF DO i=indtm,i0,-1 - temp370b = distp(i, 1)*zb(indorbp, i) - temp369 = r(i)**3 - c0b = c0b + temp369*temp370b - rb(i) = rb(i) + (c1*2*r(i)+c0*3*r(i)**2)*temp370b - c1b = c1b + r(i)**2*temp370b - distpb(i, 1) = distpb(i, 1) + (c0*temp369+c1*r(i)**2)*zb(indorbp, & -& i) + temp236 = 4.d0*dd1 + temp235 = 3.d0/temp236 + temp235b = distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + (temp235-r(i)**2*cost)*zb(indorbp, i& +& ) + dd1b = dd1b - temp235*4.d0*temp235b/temp236 + costb = -(r(i)**2*temp235b) + temp234 = dd2*r(i) + 1.d0 + temp235b0 = costb/temp234**2 + temp234b0 = -((0.5d0*(dd2*r(i))+1.d0)*2*temp235b0/temp234) + rb(i) = rb(i) + 0.5d0*dd2*temp235b0 + dd2*temp234b0 - cost*2*r(i)*& +& temp235b zb(indorbp, i) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = dd2b + r(i)*temp234b0 + 0.5d0*r(i)*temp235b0 END DO + cb = 0.0_8 DO k=indtm,indtmin,-1 - temp369b0 = r(k)*DEXP(-(dd1*r(k)))*distpb(k, 1) - rb(k) = rb(k) + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1*temp369b0 - dd1b = dd1b - r(k)*temp369b0 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp233 = dd2*r(k) + 1.d0 + temp234b = costb/temp233 + temp233b1 = -(dd1*r(k)**2*temp234b/temp233) + dd1b = dd1b + r(k)**2*temp234b + rb(k) = rb(k) + dd2*temp233b1 + dd1*2*r(k)*temp234b + dd2b = dd2b + r(k)*temp233b1 END DO - temp369b = 4.5d0*c1b/dd1 - cb = temp369b - c0b - temp368 = 2**9 - IF (temp368*(dd1**9/(40320.d0*pi)) .EQ. 0.0) THEN - dd1b = dd1b - c*temp369b/dd1 + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocs*0.75d0*dd1**(-0.25D0)*cb ELSE - dd1b = dd1b + temp368*9*dd1**8*cb/(2.d0*2.D0*DSQRT(temp368*(dd1**9& -& /(40320.d0*pi)))*40320.d0*pi) - c*temp369b/dd1 + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocs*0.75d0*dd1**(& +& -0.25D0)*cb END IF ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (51) -! -! g single gaussian orbital -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0) - c = dd1**2.75d0*1.11284691281640568826d0 -! endif + CASE (130) +! 2p single exponential r^2 e^{-z r} ! parent of 121 + dd2 = dd(indpar+1) DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) - END DO - DO i=indtmin,indtm - distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& -& 2+3.d0*r(i)**4) -! lz=0 - distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& -& 2-r(i)**2) -! lz=+/-2 - distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& -& (i)**2) -! lz=+/-2 - distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & -& i)**2) -! lz=+/-3 - distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& -& , i)**2) -! lz=+/-3 - distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& -& rmu(2, i)**4) -! lz=+/-4 - distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& -& , i)**2) + distp(k, 1) = DEXP(-(dd2*r(k))) END DO -! lz=+/-4 - DO ic=1,9 +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1) - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) -! indorbp=indorb - DO ic=1,9 + fun = distp(0, 1)*(2.d0-dd2*r(0)) + fun2 = (2.d0-4.d0*dd2*r(0)+(dd2*r(0))**2)*distp(0, 1) +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - IF (ic .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) - ELSE IF (ic .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (ic .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE IF (ic .EQ. 4) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (ic .EQ. 5) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - ELSE IF (ic .EQ. 6) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE IF (ic .EQ. 7) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (ic .EQ. 8) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - ELSE IF (ic .EQ. 9) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - END IF + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=9,1,-1 - temp373b74 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 10.d0*temp373b74 - fun2b = fun2b + temp373b74 + DO ic=3,1,-1 + temp242b4 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp242b4 + fun2b = fun2b + temp242b4 zb(indorbp, indt+4) = 0.0_8 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - IF (branch .LT. 1) THEN - temp373b19 = cost1g*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-60.d0*& -& (rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+2) + cost1g& -& *(12.d0*(rmu(1, 0)*r(0)**2)-60.d0*(rmu(1, 0)*rmu(3, 0)& -& **2))*zb(indorbp, indt+1) + cost1g*(80.d0*rmu(3, 0)**3& -& -48.d0*(rmu(3, 0)*r(0)**2))*zb(indorbp, indt+3) - rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*r(& -& 0)**2)*temp373b19 - temp373b20 = cost1g*fun0*zb(indorbp, indt+2) - temp373b21 = cost1g*fun0*zb(indorbp, indt+1) - rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp373b20 + & -& 12.d0*rmu(1, 0)*2*r(0)*temp373b21 - 48.d0*rmu(3, 0)*2*& -& r(0)*temp373b19 - rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3, 0)& -& **2)*temp373b20 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0)*& -& temp373b20 - rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3, 0)& -& **2)*temp373b21 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0)*& -& temp373b21 - ELSE - temp373b22 = -(cost2g*3.d0*zb(indorbp, indt+3)) - temp373b23 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**& -& 2)*temp373b22 - temp373b24 = fun0*rmu(1, 0)*temp373b22 - temp373b25 = -(cost2g*6.d0*zb(indorbp, indt+2)) - temp373b26 = rmu(2, 0)*rmu(3, 0)*temp373b25 - fun0b = fun0b + rmu(1, 0)*temp373b26 + cost2g*(4.d0*rmu(& -& 3, 0)**3-3.d0*(rmu(2, 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)& -& **2*rmu(3, 0)))*zb(indorbp, indt+1) + rmu(1, 0)*& -& temp373b23 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp373b24 + fun0*& -& temp373b23 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp373b24 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp373b24 - temp373b27 = fun0*rmu(1, 0)*temp373b25 - rmub(1, 0) = rmub(1, 0) + fun0*temp373b26 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp373b27 - temp373b28 = cost2g*fun0*zb(indorbp, indt+1) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*rmu(& -& 2, 0)**2-9.d0*rmu(1, 0)**2)*temp373b28 + rmu(2, 0)*& -& temp373b27 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp373b28 - rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp373b28 - END IF - ELSE - temp373b29 = -(cost2g*3.d0*zb(indorbp, indt+3)) - temp373b30 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)**2)& -& *temp373b29 - temp373b31 = fun0*rmu(2, 0)*temp373b29 - temp373b32 = -(cost2g*6.d0*zb(indorbp, indt+1)) - temp373b33 = rmu(2, 0)*rmu(3, 0)*temp373b32 - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2, 0)& -& **2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb(indorbp& -& , indt+2) + rmu(1, 0)*temp373b33 + rmu(2, 0)*temp373b30 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp373b31 + fun0*& -& temp373b30 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp373b31 - temp373b34 = cost2g*fun0*zb(indorbp, indt+2) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*rmu(2& -& , 0)**2-3.d0*rmu(1, 0)**2)*temp373b34 - 4.d0*2*rmu(3, 0)& -& *temp373b31 - rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp373b34 - rmub(1, 0) = rmub(1, 0) + fun0*temp373b33 - 3.d0*rmu(3, 0)& -& *2*rmu(1, 0)*temp373b34 - temp373b35 = fun0*rmu(1, 0)*temp373b32 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp373b35 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp373b35 - END IF - ELSE IF (branch .LT. 4) THEN - temp373b36 = cost3g*12.d0*zb(indorbp, indt+3) - temp373b37 = fun0*rmu(3, 0)*temp373b36 - temp373b38 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp373b36 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp373b37 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp373b37 - temp373b39 = cost3g*4.d0*zb(indorbp, indt+2) - temp373b40 = -(cost3g*4.d0*zb(indorbp, indt+1)) - fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)**2))& -& *temp373b39 + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)**2))& -& *temp373b40 + rmu(3, 0)*temp373b38 - rmub(3, 0) = rmub(3, 0) + fun0*temp373b38 - temp373b41 = fun0*temp373b39 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)**2)& -& *temp373b41 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& -& temp373b41 - temp373b42 = fun0*temp373b40 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)**2)& -& *temp373b42 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& -& temp373b42 - ELSE - temp373b43 = cost3g*24.d0*zb(indorbp, indt+3) - temp373b44 = rmu(2, 0)*rmu(3, 0)*temp373b43 - temp373b45 = fun0*rmu(1, 0)*temp373b43 - temp373b46 = -(cost3g*2.d0*zb(indorbp, indt+2)) - temp373b47 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0)& -& **2)*temp373b46 - temp373b48 = -(cost3g*2.d0*zb(indorbp, indt+1)) - temp373b49 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3, 0)& -& **2)*temp373b48 - fun0b = fun0b + rmu(1, 0)*temp373b47 + rmu(2, 0)*temp373b49 & -& + rmu(1, 0)*temp373b44 - rmub(1, 0) = rmub(1, 0) + fun0*temp373b44 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp373b45 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp373b45 - temp373b50 = fun0*rmu(1, 0)*temp373b46 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp373b50 + fun0*& -& temp373b47 - rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp373b50 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp373b50 - temp373b51 = fun0*rmu(2, 0)*temp373b48 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp373b51 + fun0*& -& temp373b49 - rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp373b51 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp373b51 - END IF - ELSE IF (branch .LT. 8) THEN - IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp373b52 = cost4g*fun0*zb(indorbp, indt+3) - temp373b53 = -(cost4g*6.d0*zb(indorbp, indt+2)) - temp373b54 = rmu(2, 0)*rmu(3, 0)*temp373b53 - temp373b55 = cost4g*3.d0*zb(indorbp, indt+1) - temp373b56 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp373b55 - fun0b = fun0b + rmu(1, 0)*temp373b54 + rmu(3, 0)*& -& temp373b56 + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2& -& , 0)**2))*zb(indorbp, indt+3) - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**& -& 2)*temp373b52 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp373b52 - temp373b57 = fun0*rmu(1, 0)*temp373b53 - rmub(1, 0) = rmub(1, 0) + fun0*temp373b54 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp373b57 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp373b57 - temp373b58 = fun0*rmu(3, 0)*temp373b55 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp373b58 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp373b58 - rmub(3, 0) = rmub(3, 0) + fun0*temp373b56 - ELSE - temp373b59 = cost4g*fun0*zb(indorbp, indt+3) - temp373b60 = cost4g*3.d0*zb(indorbp, indt+2) - temp373b61 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp373b60 - temp373b62 = cost4g*6.d0*zb(indorbp, indt+1) - temp373b63 = rmu(2, 0)*rmu(3, 0)*temp373b62 - fun0b = fun0b + rmu(3, 0)*temp373b61 + rmu(1, 0)*& -& temp373b63 + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2& -& , 0)**3)*zb(indorbp, indt+3) - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp373b59 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp373b59 - temp373b64 = fun0*rmu(3, 0)*temp373b60 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp373b64 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp373b64 - rmub(3, 0) = rmub(3, 0) + fun0*temp373b61 - temp373b65 = fun0*rmu(1, 0)*temp373b62 - rmub(1, 0) = rmub(1, 0) + fun0*temp373b63 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp373b65 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp373b65 - END IF - ELSE - temp373b66 = cost5g*4.d0*zb(indorbp, indt+2) - temp373b67 = fun0*temp373b66 - temp373b68 = cost5g*4.d0*zb(indorbp, indt+1) - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& -& *temp373b68 + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)))& -& *temp373b66 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**2)& -& *temp373b67 - temp373b69 = fun0*temp373b68 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& -& *temp373b69 - 3.d0*rmu(2, 0)*2*rmu(1, 0)*temp373b67 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp373b69 - END IF - ELSE IF (.NOT.branch .LT. 9) THEN - temp373b70 = cost5g*4.d0*zb(indorbp, indt+2) - temp373b71 = fun0*temp373b70 - temp373b72 = cost5g*4.d0*zb(indorbp, indt+1) - fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**3)*& -& temp373b72 + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))*& -& temp373b70 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)*& -& temp373b71 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp373b71 - temp373b73 = fun0*temp373b72 - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp373b73 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**2)*& -& temp373b73 - END IF DO i=3,1,-1 - temp373b18 = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp373b18 - funb = funb + rmu(i, 0)*temp373b18 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp242b3 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp242b3 + funb0 = funb0 + rmu(ic, 0)*temp242b3 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp373b17 = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp373b17 - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp373b17 - distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + distpb = 0.0_8 + temp242b1 = distp(0, 1)*fun2b + temp242b2 = 2*dd2*r(0)*temp242b1 + dd2b = r(0)*temp242b2 - 4.d0*r(0)*temp242b1 - distp(0, 1)*r(0)*& +& funb0 + rb(0) = rb(0) + distp(0, 1)*2*r(0)*fun0b - distp(0, 1)*dd2*funb0 -& +& 4.d0*dd2*temp242b1 + dd2*temp242b2 + distpb(0, 1) = (2.d0-dd2*r(0))*funb0 + r(0)**2*fun0b + ((dd2*r(0))& +& **2-4.d0*(dd2*r(0))+2.d0)*fun2b ELSE distpb = 0.0_8 + dd2b = 0.0_8 END IF - DO ic=9,1,-1 - DO k=indtm,i0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) - zb(indorbp, k) = 0.0_8 + DO ic=3,1,-1 + DO i=indtm,i0,-1 + temp242b0 = r(i)**2*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp242b0 + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp242b0 + rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*2*r(i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=indtm,indtmin,-1 - temp373b = cost5g*4.d0*distpb(i, 10) - temp373b0 = (rmu(1, i)**2-rmu(2, i)**2)*temp373b - temp373b1 = rmu(1, i)*rmu(2, i)*temp373b - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp373b1 + rmu(2, i)*& -& temp373b0 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp373b0 - 2*rmu(2, i)*& -& temp373b1 - distpb(i, 10) = 0.0_8 - temp373b2 = cost5g*distpb(i, 9) - rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& -& 1, i))*temp373b2 - distpb(i, 9) = 0.0_8 - temp373b3 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) - temp373b4 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp373b3 - 2*rmu(2, i)*& -& temp373b4 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& -& temp373b2 - rmub(3, i) = rmub(3, i) + rmu(2, i)*temp373b3 - distpb(i, 8) = 0.0_8 - temp373b5 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) - temp373b6 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp373b5 + 2*rmu(1, i)*& -& temp373b6 + 3.d0*2*rmu(1, i)*temp373b4 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp373b5 - rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp373b6 - distpb(i, 7) = 0.0_8 - temp373b7 = cost3g*2.d0*distpb(i, 6) - temp373b8 = (7.d0*rmu(3, i)**2-r(i)**2)*temp373b7 - temp373b9 = rmu(1, i)*rmu(2, i)*temp373b7 - rmub(1, i) = rmub(1, i) + rmu(2, i)*temp373b8 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp373b8 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp373b9 - distpb(i, 6) = 0.0_8 - temp373b10 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) - temp373b11 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - temp373b12 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) - temp373b13 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - temp373b14 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) - temp373b15 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - temp373b16 = cost1g*distpb(i, 2) - rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& -& temp373b16 - 3.d0*2*r(i)*temp373b15 - 2*r(i)*temp373b11 - 3.d0*2& -& *r(i)*temp373b13 - 2*r(i)*temp373b9 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp373b10 - rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp373b10 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp373b11 - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp373b12 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp373b13 + rmu(2, i)*& -& temp373b12 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp373b14 - rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& -& rmu(3, i))*temp373b16 + 7.d0*2*rmu(3, i)*temp373b15 + rmu(1, i)*& -& temp373b14 - distpb(i, 2) = 0.0_8 - END DO - dd1b = 0.0_8 - cb = 0.0_8 DO k=indtm,indtmin,-1 - temp372 = r(k)**2 - temp372b = c*DEXP(-(dd1*temp372))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp372))*distpb(k, 1) - dd1b = dd1b - temp372*temp372b - rb(k) = rb(k) - dd1*2*r(k)*temp372b + temp242b = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp242b + rb(k) = rb(k) - dd2*temp242b distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 1.11284691281640568826d0*2.75d0*dd1**1.75D0*cb - ddb(indparp) = ddb(indparp) + dd1b - CASE (52) -! g single gaussian orbital + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (89) +! g single gaussian orbital ! derivative of 51 -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb +! R(r)= exp(-alpha r^2) +! normalized +! indorbp=indorb indparp = indpar + 1 dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0) - c = dd1**2.75d0*1.11284691281640568826d0 -! endif + dd2 = DSQRT(dd1) +! if(iflagnorm.gt.2) then +! overall normalization +! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0)*ratiocg + c = dd1**2.75d0*ratiocg +! endif DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) END DO DO i=indtmin,indtm distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& & 2+3.d0*r(i)**4) -! lz=0 +! lz=0 distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& & (i)**2) -! lz=+/-1 +! lz=+/-1 distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& & (i)**2) -! lz=+/-1 +! lz=+/-1 distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& & 2-r(i)**2) -! lz=+/-2 +! lz=+/-2 distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& & (i)**2) -! lz=+/-2 +! lz=+/-2 distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & & i)**2) ! lz=+/-3 @@ -12773,21 +12576,30 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & ! lz=+/-4 DO ic=1,9 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic + DO k=i0,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 + END DO END DO -! endif +! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1)*(11.d0/4.d0/dd1-r(0)**2) - fun = distp(0, 1)*(2.d0*dd1*r(0)**2-15.d0/2.d0) - fun2 = distp(0, 1)*(-(4.d0*dd1**2*r(0)**4)+21.d0*dd1*r(0)**2-15.d0& -& /2.d0) -! indorbp=indorb + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*rp2)/rp3 + fun0 = distp(0, 1)*(11.d0/4.d0/dd1-r(0)**2*cost) + fun = 0.25d0*distp(0, 1)*(-30.d0-69.d0*rp2-44.d0*rp1-5.d0*rp1*rp2+& +& 2.d0*rp1**2)/rp3**2 + fun2 = 0.25d0*distp(0, 1)*(-30.d0-78.d0*rp2+18.d0*rp1+198.d0*rp1*& +& rp2+191.d0*rp1**2+66.d0*rp1**2*rp2+3.d0*rp1**3-2.d0*rp1**3*rp2)/& +& rp3**3 +! indorbp=indorb DO ic=1,9 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN @@ -12868,15 +12680,15 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=9,1,-1 - temp379b55 = distp(0, 1+ic)*zb(indorbp, indt+4) + temp253b55 = distp(0, 1+ic)*zb(indorbp, indt+4) distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& & , indt+4) - funb = funb + 10.d0*temp379b55 - fun2b = fun2b + temp379b55 + funb0 = funb0 + 10.d0*temp253b55 + fun2b = fun2b + temp253b55 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -12885,1475 +12697,1374 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN IF (branch .LT. 2) THEN - temp379b0 = cost1g*fun0*zb(indorbp, indt+i) + temp253b0 = cost1g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& & 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& & ) rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp379b0 - rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp379b0 +& , 0)**2)*temp253b0 + rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp253b0 rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& -& )*temp379b0 +& )*temp253b0 ELSE - temp379b1 = cost1g*fun0*zb(indorbp, indt+i) + temp253b1 = cost1g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& & 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& & ) rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp379b1 - rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp379b1 +& , 0)**2)*temp253b1 + rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp253b1 rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& -& )*temp379b1 +& )*temp253b1 END IF ELSE IF (branch .LT. 4) THEN - temp379b2 = cost1g*fun0*zb(indorbp, indt+i) + temp253b2 = cost1g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& & 3, 0)*r(0)**2))*zb(indorbp, indt+i) rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& -& r(0)**2)*temp379b2 - rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp379b2 +& r(0)**2)*temp253b2 + rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp253b2 ELSE - temp379b3 = cost2g*fun0*zb(indorbp, indt+i) + temp253b3 = cost2g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& & , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& & (indorbp, indt+i) rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& -& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp379b3 +& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp253b3 rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp379b3 +& temp253b3 rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp379b3 +& temp253b3 END IF ELSE IF (branch .LT. 7) THEN IF (branch .LT. 6) THEN - temp379b4 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp379b5 = rmu(2, 0)*rmu(3, 0)*temp379b4 - temp379b6 = fun0*rmu(1, 0)*temp379b4 - fun0b = fun0b + rmu(1, 0)*temp379b5 - rmub(1, 0) = rmub(1, 0) + fun0*temp379b5 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp379b6 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp379b6 + temp253b4 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp253b5 = rmu(2, 0)*rmu(3, 0)*temp253b4 + temp253b6 = fun0*rmu(1, 0)*temp253b4 + fun0b = fun0b + rmu(1, 0)*temp253b5 + rmub(1, 0) = rmub(1, 0) + fun0*temp253b5 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp253b6 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp253b6 ELSE - temp379b7 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp379b8 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& -& **2)*temp379b7 - temp379b9 = fun0*rmu(1, 0)*temp379b7 - fun0b = fun0b + rmu(1, 0)*temp379b8 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp379b9 + fun0& -& *temp379b8 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp379b9 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp379b9 + temp253b7 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp253b8 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& +& **2)*temp253b7 + temp253b9 = fun0*rmu(1, 0)*temp253b7 + fun0b = fun0b + rmu(1, 0)*temp253b8 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp253b9 + fun0& +& *temp253b8 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp253b9 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp253b9 END IF ELSE - temp379b10 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp379b11 = rmu(2, 0)*rmu(3, 0)*temp379b10 - temp379b12 = fun0*rmu(1, 0)*temp379b10 - fun0b = fun0b + rmu(1, 0)*temp379b11 - rmub(1, 0) = rmub(1, 0) + fun0*temp379b11 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp379b12 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp379b12 + temp253b10 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp253b11 = rmu(2, 0)*rmu(3, 0)*temp253b10 + temp253b12 = fun0*rmu(1, 0)*temp253b10 + fun0b = fun0b + rmu(1, 0)*temp253b11 + rmub(1, 0) = rmub(1, 0) + fun0*temp253b11 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp253b12 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp253b12 END IF ELSE IF (branch .LT. 12) THEN IF (branch .LT. 10) THEN IF (branch .LT. 9) THEN - temp379b13 = cost2g*fun0*zb(indorbp, indt+i) + temp253b13 = cost2g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& & , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& & (indorbp, indt+i) rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& -& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp379b13 +& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp253b13 rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp379b13 +& temp253b13 rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp379b13 +& temp253b13 ELSE - temp379b14 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp379b15 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& -& **2)*temp379b14 - temp379b16 = fun0*rmu(2, 0)*temp379b14 - fun0b = fun0b + rmu(2, 0)*temp379b15 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp379b16 + & -& fun0*temp379b15 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp379b16 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp379b16 + temp253b14 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp253b15 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& +& **2)*temp253b14 + temp253b16 = fun0*rmu(2, 0)*temp253b14 + fun0b = fun0b + rmu(2, 0)*temp253b15 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp253b16 + & +& fun0*temp253b15 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp253b16 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp253b16 END IF ELSE IF (branch .LT. 11) THEN - temp379b17 = -(cost3g*4.d0*zb(indorbp, indt+i)) - temp379b18 = fun0*temp379b17 + temp253b17 = -(cost3g*4.d0*zb(indorbp, indt+i)) + temp253b18 = fun0*temp253b17 fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& -& **2))*temp379b17 +& **2))*temp253b17 rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp379b18 +& **2)*temp253b18 rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& -& temp379b18 +& temp253b18 ELSE - temp379b19 = cost3g*4.d0*zb(indorbp, indt+i) - temp379b20 = fun0*temp379b19 + temp253b19 = cost3g*4.d0*zb(indorbp, indt+i) + temp253b20 = fun0*temp253b19 fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& -& **2))*temp379b19 +& **2))*temp253b19 rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp379b20 +& **2)*temp253b20 rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& -& temp379b20 +& temp253b20 END IF ELSE IF (branch .LT. 14) THEN IF (branch .LT. 13) THEN - temp379b21 = cost3g*12.d0*zb(indorbp, indt+i) - temp379b22 = fun0*rmu(3, 0)*temp379b21 - temp379b23 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp379b21 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp379b22 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp379b22 - fun0b = fun0b + rmu(3, 0)*temp379b23 - rmub(3, 0) = rmub(3, 0) + fun0*temp379b23 + temp253b21 = cost3g*12.d0*zb(indorbp, indt+i) + temp253b22 = fun0*rmu(3, 0)*temp253b21 + temp253b23 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp253b21 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp253b22 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp253b22 + fun0b = fun0b + rmu(3, 0)*temp253b23 + rmub(3, 0) = rmub(3, 0) + fun0*temp253b23 ELSE - temp379b24 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp379b25 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3& -& , 0)**2)*temp379b24 - temp379b26 = fun0*rmu(2, 0)*temp379b24 - fun0b = fun0b + rmu(2, 0)*temp379b25 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp379b26 + fun0*& -& temp379b25 - rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp379b26 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp379b26 + temp253b24 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp253b25 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3& +& , 0)**2)*temp253b24 + temp253b26 = fun0*rmu(2, 0)*temp253b24 + fun0b = fun0b + rmu(2, 0)*temp253b25 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp253b26 + fun0*& +& temp253b25 + rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp253b26 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp253b26 END IF ELSE - temp379b27 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp379b28 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0& -& )**2)*temp379b27 - temp379b29 = fun0*rmu(1, 0)*temp379b27 - fun0b = fun0b + rmu(1, 0)*temp379b28 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp379b29 + fun0*& -& temp379b28 - rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp379b29 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp379b29 + temp253b27 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp253b28 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0& +& )**2)*temp253b27 + temp253b29 = fun0*rmu(1, 0)*temp253b27 + fun0b = fun0b + rmu(1, 0)*temp253b28 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp253b29 + fun0*& +& temp253b28 + rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp253b29 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp253b29 END IF ELSE IF (branch .LT. 22) THEN IF (branch .LT. 19) THEN IF (branch .LT. 17) THEN IF (branch .LT. 16) THEN - temp379b30 = cost3g*24.d0*zb(indorbp, indt+i) - temp379b31 = rmu(2, 0)*rmu(3, 0)*temp379b30 - temp379b32 = fun0*rmu(1, 0)*temp379b30 - fun0b = fun0b + rmu(1, 0)*temp379b31 - rmub(1, 0) = rmub(1, 0) + fun0*temp379b31 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp379b32 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp379b32 + temp253b30 = cost3g*24.d0*zb(indorbp, indt+i) + temp253b31 = rmu(2, 0)*rmu(3, 0)*temp253b30 + temp253b32 = fun0*rmu(1, 0)*temp253b30 + fun0b = fun0b + rmu(1, 0)*temp253b31 + rmub(1, 0) = rmub(1, 0) + fun0*temp253b31 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp253b32 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp253b32 ELSE - temp379b33 = cost4g*3.d0*zb(indorbp, indt+i) - temp379b34 = fun0*rmu(3, 0)*temp379b33 - temp379b35 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp379b33 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp379b34 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp379b34 - fun0b = fun0b + rmu(3, 0)*temp379b35 - rmub(3, 0) = rmub(3, 0) + fun0*temp379b35 + temp253b33 = cost4g*3.d0*zb(indorbp, indt+i) + temp253b34 = fun0*rmu(3, 0)*temp253b33 + temp253b35 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp253b33 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp253b34 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp253b34 + fun0b = fun0b + rmu(3, 0)*temp253b35 + rmub(3, 0) = rmub(3, 0) + fun0*temp253b35 END IF ELSE IF (branch .LT. 18) THEN - temp379b36 = -(cost4g*6.d0*zb(indorbp, indt+i)) - temp379b37 = rmu(2, 0)*rmu(3, 0)*temp379b36 - temp379b38 = fun0*rmu(1, 0)*temp379b36 - fun0b = fun0b + rmu(1, 0)*temp379b37 - rmub(1, 0) = rmub(1, 0) + fun0*temp379b37 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp379b38 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp379b38 + temp253b36 = -(cost4g*6.d0*zb(indorbp, indt+i)) + temp253b37 = rmu(2, 0)*rmu(3, 0)*temp253b36 + temp253b38 = fun0*rmu(1, 0)*temp253b36 + fun0b = fun0b + rmu(1, 0)*temp253b37 + rmub(1, 0) = rmub(1, 0) + fun0*temp253b37 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp253b38 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp253b38 ELSE - temp379b39 = cost4g*fun0*zb(indorbp, indt+i) + temp253b39 = cost4g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& & (2, 0)**2))*zb(indorbp, indt+i) rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp379b39 +& **2)*temp253b39 rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp379b39 +& temp253b39 END IF ELSE IF (branch .LT. 21) THEN IF (branch .LT. 20) THEN - temp379b40 = cost4g*6.d0*zb(indorbp, indt+i) - temp379b41 = rmu(2, 0)*rmu(3, 0)*temp379b40 - temp379b42 = fun0*rmu(1, 0)*temp379b40 - fun0b = fun0b + rmu(1, 0)*temp379b41 - rmub(1, 0) = rmub(1, 0) + fun0*temp379b41 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp379b42 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp379b42 + temp253b40 = cost4g*6.d0*zb(indorbp, indt+i) + temp253b41 = rmu(2, 0)*rmu(3, 0)*temp253b40 + temp253b42 = fun0*rmu(1, 0)*temp253b40 + fun0b = fun0b + rmu(1, 0)*temp253b41 + rmub(1, 0) = rmub(1, 0) + fun0*temp253b41 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp253b42 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp253b42 ELSE - temp379b43 = cost4g*3.d0*zb(indorbp, indt+i) - temp379b44 = fun0*rmu(3, 0)*temp379b43 - temp379b45 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp379b43 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp379b44 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp379b44 - fun0b = fun0b + rmu(3, 0)*temp379b45 - rmub(3, 0) = rmub(3, 0) + fun0*temp379b45 + temp253b43 = cost4g*3.d0*zb(indorbp, indt+i) + temp253b44 = fun0*rmu(3, 0)*temp253b43 + temp253b45 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp253b43 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp253b44 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp253b44 + fun0b = fun0b + rmu(3, 0)*temp253b45 + rmub(3, 0) = rmub(3, 0) + fun0*temp253b45 END IF ELSE - temp379b46 = cost4g*fun0*zb(indorbp, indt+i) + temp253b46 = cost4g*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& & 2, 0)**3)*zb(indorbp, indt+i) rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp379b46 +& temp253b46 rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp379b46 +& 2)*temp253b46 END IF ELSE IF (branch .LT. 26) THEN IF (branch .LT. 24) THEN IF (branch .LT. 23) THEN - temp379b47 = cost5g*4.d0*zb(indorbp, indt+i) - temp379b48 = fun0*temp379b47 + temp253b47 = cost5g*4.d0*zb(indorbp, indt+i) + temp253b48 = fun0*temp253b47 fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& -& **2))*temp379b47 +& **2))*temp253b47 rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp379b48 +& **2)*temp253b48 rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp379b48 +& temp253b48 END IF ELSE IF (branch .LT. 25) THEN - temp379b49 = cost5g*4.d0*zb(indorbp, indt+i) - temp379b50 = fun0*temp379b49 + temp253b49 = cost5g*4.d0*zb(indorbp, indt+i) + temp253b50 = fun0*temp253b49 fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& -& ))*temp379b49 +& ))*temp253b49 rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& -& 2)*temp379b50 +& 2)*temp253b50 rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp379b50 +& temp253b50 END IF ELSE IF (branch .LT. 28) THEN IF (branch .LT. 27) THEN - temp379b51 = cost5g*4.d0*zb(indorbp, indt+i) - temp379b52 = fun0*temp379b51 + temp253b51 = cost5g*4.d0*zb(indorbp, indt+i) + temp253b52 = fun0*temp253b51 fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& -& 3)*temp379b51 +& 3)*temp253b51 rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp379b52 +& temp253b52 rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp379b52 +& 2)*temp253b52 END IF ELSE - temp379b53 = cost5g*4.d0*zb(indorbp, indt+i) - temp379b54 = fun0*temp379b53 + temp253b53 = cost5g*4.d0*zb(indorbp, indt+i) + temp253b54 = fun0*temp253b53 fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& -& *temp379b53 +& *temp253b53 rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& -& *temp379b54 +& *temp253b54 rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp379b54 +& temp253b54 END IF - temp379b = distp(0, 1+ic)*zb(indorbp, indt+i) + temp253b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp379b - funb = funb + rmu(i, 0)*temp379b + rmub(i, 0) = rmub(i, 0) + fun*temp253b + funb0 = funb0 + rmu(i, 0)*temp253b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp378 = r(0)**4 - temp378b = distp(0, 1)*fun2b - temp377 = 4.d0*dd1 - temp376 = 11.d0/temp377 - distpb(0, 1) = distpb(0, 1) + (2.d0*(dd1*r(0)**2)-15.d0/2.d0)*funb& -& + (temp376-r(0)**2)*fun0b + (21.d0*(dd1*r(0)**2)-15.d0/2.d0-4.d0& -& *(dd1**2*temp378))*fun2b - temp378b0 = distp(0, 1)*2.d0*funb - dd1b = r(0)**2*temp378b0 - distp(0, 1)*temp376*4.d0*fun0b/temp377 & -& + (21.d0*r(0)**2-4.d0*temp378*2*dd1)*temp378b - rb(0) = rb(0) + dd1*2*r(0)*temp378b0 - distp(0, 1)*2*r(0)*fun0b + & -& (21.d0*dd1*2*r(0)-4.d0*dd1**2*4*r(0)**3)*temp378b - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + temp252 = rp3**3 + temp250 = distp(0, 1)/temp252 + temp251 = rp1**3 + temp251b = 0.25d0*temp250*fun2b + temp250b = 0.25d0*(18.d0*rp1-78.d0*rp2+198.d0*(rp1*rp2)+191.d0*rp1& +& **2+66.d0*(rp1**2*rp2)+3.d0*rp1**3-2.d0*(temp251*rp2)-30.d0)*& +& fun2b/temp252 + temp249 = rp3**2 + temp248 = distp(0, 1)/temp249 + temp249b = 0.25d0*temp248*funb0 + rp1b = (2.d0*2*rp1-5.d0*rp2-44.d0)*temp249b + (3.d0*3*rp1**2-2.d0*& +& rp2*3*rp1**2+66.d0*rp2*2*rp1+191.d0*2*rp1+198.d0*rp2+18.d0)*& +& temp251b + temp248b = 0.25d0*(2.d0*rp1**2-44.d0*rp1-69.d0*rp2-5.d0*(rp1*rp2)-& +& 30.d0)*funb0/temp249 + temp246b0 = distp(0, 1)*fun0b + costb = -(r(0)**2*temp246b0) + rp3b = -(temp248*2*rp3*temp248b) - (0.5d0*rp2+1.d0)*costb/rp3**2 -& +& temp250*3*rp3**2*temp250b + rp2b = ((-69.d0)-5.d0*rp1)*temp249b + 2*(rp2+1.d0)*rp3b + 0.5d0*& +& costb/rp3 + (66.d0*rp1**2-2.d0*temp251+198.d0*rp1-78.d0)*& +& temp251b + temp247 = 4.d0*dd1 + temp246 = 11.d0/temp247 + distpb(0, 1) = distpb(0, 1) + temp248b + (temp246-r(0)**2*cost)*& +& fun0b + temp250b + dd1b = r(0)**2*rp1b - temp246*4.d0*temp246b0/temp247 + rb(0) = rb(0) + dd2*rp2b + dd1*2*r(0)*rp1b - cost*2*r(0)*temp246b0 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = r(0)*rp2b ELSE distpb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 END IF - dd1b = 0.0_8 DO ic=9,1,-1 DO k=indtm,i0,-1 - temp376b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) - temp375 = 4.d0*dd1 - temp374 = 11.d0/temp375 - temp374b17 = (temp374-r(k)**2)*zb(indorbp, k) - dd1b = dd1b - temp374*4.d0*temp376b/temp375 - rb(k) = rb(k) - 2*r(k)*temp376b - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp374b17 - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp374b17 + temp246b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) + temp245 = 4.d0*dd1 + temp244 = 11.d0/temp245 + temp244b = (temp244-r(k)**2*cost)*zb(indorbp, k) + dd1b = dd1b - temp244*4.d0*temp246b/temp245 + costb = -(r(k)**2*temp246b) + temp243 = dd2*r(k) + 1.d0 + temp244b0 = costb/temp243**2 + temp243b18 = -((0.5d0*(dd2*r(k))+1.d0)*2*temp244b0/temp243) + rb(k) = rb(k) + 0.5d0*dd2*temp244b0 + dd2*temp243b18 - cost*2*r(& +& k)*temp246b + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp244b + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp244b zb(indorbp, k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = dd2b + r(k)*temp243b18 + 0.5d0*r(k)*temp244b0 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 - temp374b = cost5g*4.d0*distpb(i, 10) - temp374b0 = (rmu(1, i)**2-rmu(2, i)**2)*temp374b - temp374b1 = rmu(1, i)*rmu(2, i)*temp374b - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp374b1 + rmu(2, i)*& -& temp374b0 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp374b0 - 2*rmu(2, i)*& -& temp374b1 + temp243b0 = cost5g*4.d0*distpb(i, 10) + temp243b1 = (rmu(1, i)**2-rmu(2, i)**2)*temp243b0 + temp243b2 = rmu(1, i)*rmu(2, i)*temp243b0 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp243b2 + rmu(2, i)*& +& temp243b1 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp243b1 - 2*rmu(2, i)*& +& temp243b2 distpb(i, 10) = 0.0_8 - temp374b2 = cost5g*distpb(i, 9) + temp243b3 = cost5g*distpb(i, 9) rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& -& 1, i))*temp374b2 +& 1, i))*temp243b3 distpb(i, 9) = 0.0_8 - temp374b3 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) - temp374b4 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp374b3 - 2*rmu(2, i)*& -& temp374b4 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& -& temp374b2 - rmub(3, i) = rmub(3, i) + rmu(2, i)*temp374b3 + temp243b4 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) + temp243b5 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp243b4 - 2*rmu(2, i)*& +& temp243b5 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& +& temp243b3 + rmub(3, i) = rmub(3, i) + rmu(2, i)*temp243b4 distpb(i, 8) = 0.0_8 - temp374b5 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) - temp374b6 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp374b5 + 2*rmu(1, i)*& -& temp374b6 + 3.d0*2*rmu(1, i)*temp374b4 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp374b5 - rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp374b6 + temp243b6 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) + temp243b7 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp243b6 + 2*rmu(1, i)*& +& temp243b7 + 3.d0*2*rmu(1, i)*temp243b5 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp243b6 + rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp243b7 distpb(i, 7) = 0.0_8 - temp374b7 = cost3g*2.d0*distpb(i, 6) - temp374b8 = (7.d0*rmu(3, i)**2-r(i)**2)*temp374b7 - temp374b9 = rmu(1, i)*rmu(2, i)*temp374b7 - rmub(1, i) = rmub(1, i) + rmu(2, i)*temp374b8 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp374b8 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp374b9 + temp243b8 = cost3g*2.d0*distpb(i, 6) + temp243b9 = (7.d0*rmu(3, i)**2-r(i)**2)*temp243b8 + temp243b10 = rmu(1, i)*rmu(2, i)*temp243b8 + rmub(1, i) = rmub(1, i) + rmu(2, i)*temp243b9 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp243b9 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp243b10 distpb(i, 6) = 0.0_8 - temp374b10 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) - temp374b11 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) + temp243b11 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) + temp243b12 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) distpb(i, 5) = 0.0_8 - temp374b12 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) - temp374b13 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) + temp243b13 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) + temp243b14 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - temp374b14 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) - temp374b15 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) + temp243b15 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) + temp243b16 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 - temp374b16 = cost1g*distpb(i, 2) + temp243b17 = cost1g*distpb(i, 2) rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& -& temp374b16 - 3.d0*2*r(i)*temp374b15 - 2*r(i)*temp374b11 - 3.d0*2& -& *r(i)*temp374b13 - 2*r(i)*temp374b9 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp374b10 - rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp374b10 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp374b11 - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp374b12 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp374b13 + rmu(2, i)*& -& temp374b12 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp374b14 +& temp243b17 - 3.d0*2*r(i)*temp243b16 - 2*r(i)*temp243b12 - 3.d0*2& +& *r(i)*temp243b14 - 2*r(i)*temp243b10 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp243b11 + rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp243b11 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp243b12 + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp243b13 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp243b14 + rmu(2, i)*& +& temp243b13 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp243b15 rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& -& rmu(3, i))*temp374b16 + 7.d0*2*rmu(3, i)*temp374b15 + rmu(1, i)*& -& temp374b14 +& rmu(3, i))*temp243b17 + 7.d0*2*rmu(3, i)*temp243b16 + rmu(1, i)*& +& temp243b15 distpb(i, 2) = 0.0_8 END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - temp373 = r(k)**2 - temp373b75 = c*DEXP(-(dd1*temp373))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp373))*distpb(k, 1) - dd1b = dd1b - temp373*temp373b75 - rb(k) = rb(k) - dd1*2*r(k)*temp373b75 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp242 = dd2*r(k) + 1.d0 + temp243b = costb/temp242 + temp242b5 = -(dd1*r(k)**2*temp243b/temp242) + dd1b = dd1b + r(k)**2*temp243b + rb(k) = rb(k) + dd2*temp242b5 + dd1*2*r(k)*temp243b + dd2b = dd2b + r(k)*temp242b5 END DO - dd1b = dd1b + 1.11284691281640568826d0*2.75d0*dd1**1.75D0*cb + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocg*2.75d0*dd1**1.75D0*cb + ELSE + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocg*2.75d0*dd1**1.75D0*& +& cb + END IF ddb(indparp) = ddb(indparp) + dd1b - CASE (55) -! g single Slater orbital -! R(r)= exp(-alpha r) -! normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! l = 4 -! \int d\omega Y*Y = 4 pi / (2 l + 1) -! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5**2 * 3**4 / 2**3 / dd1**11 -! c=1.d0/dsqrt(7.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(11.d0/2.d0)/3.d0/5.d0 - c = dd1**5.5d0*.020104801169736915d0 -! endif + CASE (1100:1199) +! WARNING IN DFT it is assumed that UMRIGAR orbitals could be extended +! up to number 99, so i,h,... are possible extensions. +! 1s single Z NO CUSP! +! p gaussian r**(2*npower)*exp(-alpha*r**2) + npower = iopt - 1100 +! indorbp=indorb + dd2 = dd(indpar+1) DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) - END DO - DO i=indtmin,indtm - distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& -& 2+3.d0*r(i)**4) -! lz=0 - distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& -& 2-r(i)**2) -! lz=+/-2 - distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& -& (i)**2) -! lz=+/-2 - distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & -& i)**2) -! lz=+/-3 - distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& -& , i)**2) -! lz=+/-3 - distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& -& rmu(2, i)**4) -! lz=+/-4 - distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& -& , i)**2) + distp(k, 1) = r(k)**(2*npower)*DEXP(-(dd2*r(k)**2)) END DO -! lz=+/-4 - DO ic=1,9 + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1) - fun = -(dd1*distp(0, 1)/r(0)) - fun2 = dd1**2*distp(0, 1) -! indorbp=indorb - DO ic=1,9 + rp1 = r(0)**2 + fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 + fun2 = (npower*(2.d0*npower-1.d0)-(1.d0+4.d0*npower)*dd2*rp1+2.d0*& +& (dd2*rp1)**2)*distp(0, 1)*2.d0/rp1 +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - END IF - ELSE IF (ic .EQ. 6) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - END IF - ELSE IF (ic .EQ. 7) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,21) - END IF - ELSE IF (ic .EQ. 8) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,22) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,24) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,23) - END IF - ELSE IF (ic .EQ. 9) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,26) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,28) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,27) - END IF + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,25) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=9,1,-1 - temp380b55 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 10.d0*temp380b55 - fun2b = fun2b + temp380b55 + DO ic=3,1,-1 + temp257b2 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp257b2 + fun2b = fun2b + temp257b2 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 15) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp380b0 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& -& 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& -& ) - rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp380b0 - rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp380b0 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& -& )*temp380b0 - ELSE - temp380b1 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& -& 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& -& ) - rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp380b1 - rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp380b1 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& -& )*temp380b1 - END IF - ELSE IF (branch .LT. 4) THEN - temp380b2 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& -& 3, 0)*r(0)**2))*zb(indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& -& r(0)**2)*temp380b2 - rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp380b2 - ELSE - temp380b3 = cost2g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& -& , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& -& (indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& -& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp380b3 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp380b3 - rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp380b3 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp380b4 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp380b5 = rmu(2, 0)*rmu(3, 0)*temp380b4 - temp380b6 = fun0*rmu(1, 0)*temp380b4 - fun0b = fun0b + rmu(1, 0)*temp380b5 - rmub(1, 0) = rmub(1, 0) + fun0*temp380b5 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp380b6 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp380b6 - ELSE - temp380b7 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp380b8 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& -& **2)*temp380b7 - temp380b9 = fun0*rmu(1, 0)*temp380b7 - fun0b = fun0b + rmu(1, 0)*temp380b8 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp380b9 + fun0& -& *temp380b8 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp380b9 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp380b9 - END IF - ELSE - temp380b10 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp380b11 = rmu(2, 0)*rmu(3, 0)*temp380b10 - temp380b12 = fun0*rmu(1, 0)*temp380b10 - fun0b = fun0b + rmu(1, 0)*temp380b11 - rmub(1, 0) = rmub(1, 0) + fun0*temp380b11 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp380b12 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp380b12 - END IF - ELSE IF (branch .LT. 12) THEN - IF (branch .LT. 10) THEN - IF (branch .LT. 9) THEN - temp380b13 = cost2g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& -& , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& -& (indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& -& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp380b13 - rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp380b13 - rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp380b13 - ELSE - temp380b14 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp380b15 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& -& **2)*temp380b14 - temp380b16 = fun0*rmu(2, 0)*temp380b14 - fun0b = fun0b + rmu(2, 0)*temp380b15 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp380b16 + & -& fun0*temp380b15 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp380b16 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp380b16 - END IF - ELSE IF (branch .LT. 11) THEN - temp380b17 = -(cost3g*4.d0*zb(indorbp, indt+i)) - temp380b18 = fun0*temp380b17 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& -& **2))*temp380b17 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp380b18 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& -& temp380b18 - ELSE - temp380b19 = cost3g*4.d0*zb(indorbp, indt+i) - temp380b20 = fun0*temp380b19 - fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& -& **2))*temp380b19 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp380b20 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& -& temp380b20 - END IF - ELSE IF (branch .LT. 14) THEN - IF (branch .LT. 13) THEN - temp380b21 = cost3g*12.d0*zb(indorbp, indt+i) - temp380b22 = fun0*rmu(3, 0)*temp380b21 - temp380b23 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp380b21 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp380b22 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp380b22 - fun0b = fun0b + rmu(3, 0)*temp380b23 - rmub(3, 0) = rmub(3, 0) + fun0*temp380b23 - ELSE - temp380b24 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp380b25 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3& -& , 0)**2)*temp380b24 - temp380b26 = fun0*rmu(2, 0)*temp380b24 - fun0b = fun0b + rmu(2, 0)*temp380b25 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp380b26 + fun0*& -& temp380b25 - rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp380b26 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp380b26 - END IF - ELSE - temp380b27 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp380b28 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0& -& )**2)*temp380b27 - temp380b29 = fun0*rmu(1, 0)*temp380b27 - fun0b = fun0b + rmu(1, 0)*temp380b28 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp380b29 + fun0*& -& temp380b28 - rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp380b29 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp380b29 - END IF - ELSE IF (branch .LT. 22) THEN - IF (branch .LT. 19) THEN - IF (branch .LT. 17) THEN - IF (branch .LT. 16) THEN - temp380b30 = cost3g*24.d0*zb(indorbp, indt+i) - temp380b31 = rmu(2, 0)*rmu(3, 0)*temp380b30 - temp380b32 = fun0*rmu(1, 0)*temp380b30 - fun0b = fun0b + rmu(1, 0)*temp380b31 - rmub(1, 0) = rmub(1, 0) + fun0*temp380b31 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp380b32 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp380b32 - ELSE - temp380b33 = cost4g*3.d0*zb(indorbp, indt+i) - temp380b34 = fun0*rmu(3, 0)*temp380b33 - temp380b35 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp380b33 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp380b34 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp380b34 - fun0b = fun0b + rmu(3, 0)*temp380b35 - rmub(3, 0) = rmub(3, 0) + fun0*temp380b35 - END IF - ELSE IF (branch .LT. 18) THEN - temp380b36 = -(cost4g*6.d0*zb(indorbp, indt+i)) - temp380b37 = rmu(2, 0)*rmu(3, 0)*temp380b36 - temp380b38 = fun0*rmu(1, 0)*temp380b36 - fun0b = fun0b + rmu(1, 0)*temp380b37 - rmub(1, 0) = rmub(1, 0) + fun0*temp380b37 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp380b38 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp380b38 - ELSE - temp380b39 = cost4g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& -& (2, 0)**2))*zb(indorbp, indt+i) - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp380b39 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp380b39 - END IF - ELSE IF (branch .LT. 21) THEN - IF (branch .LT. 20) THEN - temp380b40 = cost4g*6.d0*zb(indorbp, indt+i) - temp380b41 = rmu(2, 0)*rmu(3, 0)*temp380b40 - temp380b42 = fun0*rmu(1, 0)*temp380b40 - fun0b = fun0b + rmu(1, 0)*temp380b41 - rmub(1, 0) = rmub(1, 0) + fun0*temp380b41 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp380b42 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp380b42 - ELSE - temp380b43 = cost4g*3.d0*zb(indorbp, indt+i) - temp380b44 = fun0*rmu(3, 0)*temp380b43 - temp380b45 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp380b43 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp380b44 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp380b44 - fun0b = fun0b + rmu(3, 0)*temp380b45 - rmub(3, 0) = rmub(3, 0) + fun0*temp380b45 - END IF - ELSE - temp380b46 = cost4g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& -& 2, 0)**3)*zb(indorbp, indt+i) - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp380b46 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp380b46 - END IF - ELSE IF (branch .LT. 26) THEN - IF (branch .LT. 24) THEN - IF (branch .LT. 23) THEN - temp380b47 = cost5g*4.d0*zb(indorbp, indt+i) - temp380b48 = fun0*temp380b47 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& -& **2))*temp380b47 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp380b48 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp380b48 - END IF - ELSE IF (branch .LT. 25) THEN - temp380b49 = cost5g*4.d0*zb(indorbp, indt+i) - temp380b50 = fun0*temp380b49 - fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& -& ))*temp380b49 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& -& 2)*temp380b50 - rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp380b50 - END IF - ELSE IF (branch .LT. 28) THEN - IF (branch .LT. 27) THEN - temp380b51 = cost5g*4.d0*zb(indorbp, indt+i) - temp380b52 = fun0*temp380b51 - fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& -& 3)*temp380b51 - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp380b52 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp380b52 - END IF - ELSE - temp380b53 = cost5g*4.d0*zb(indorbp, indt+i) - temp380b54 = fun0*temp380b53 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& -& *temp380b53 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& -& *temp380b54 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp380b54 - END IF - temp380b = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp380b - funb = funb + rmu(i, 0)*temp380b + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp257b1 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp257b1 + funb0 = funb0 + rmu(ic, 0)*temp257b1 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp379b75 = -(distp(0, 1)*funb/r(0)) - dd1b = temp379b75 + distp(0, 1)*2*dd1*fun2b - temp379 = dd1/r(0) - distpb(0, 1) = distpb(0, 1) + fun0b - temp379*funb + dd1**2*fun2b - rb(0) = rb(0) - temp379*temp379b75 - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + distpb = 0.0_8 + temp256 = distp(0, 1)/rp1 + temp257b = 2.d0*temp256*fun2b + temp257b0 = -((npower*4.d0+1.d0)*temp257b) + temp256b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& +& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 + temp255 = distp(0, 1)/rp1 + temp256b0 = 2.d0*temp255*funb0 + dd2b = rp1*temp257b0 - rp1*temp256b0 + 2.d0*rp1**2*2*dd2*temp257b + temp255b = 2.d0*(npower-dd2*rp1)*funb0/rp1 + rp1b = dd2*temp257b0 - temp255*temp255b - temp256*temp256b - dd2*& +& temp256b0 + 2.d0*dd2**2*2*rp1*temp257b + distpb(0, 1) = temp255b + fun0b + temp256b + rb(0) = rb(0) + 2*r(0)*rp1b ELSE distpb = 0.0_8 + dd2b = 0.0_8 END IF - DO ic=9,1,-1 - DO k=indtm,i0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) - zb(indorbp, k) = 0.0_8 + DO ic=3,1,-1 + DO i=indtm,i0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=indtm,indtmin,-1 - temp379b57 = cost5g*4.d0*distpb(i, 10) - temp379b58 = (rmu(1, i)**2-rmu(2, i)**2)*temp379b57 - temp379b59 = rmu(1, i)*rmu(2, i)*temp379b57 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp379b59 + rmu(2, i)*& -& temp379b58 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp379b58 - 2*rmu(2, i)*& -& temp379b59 - distpb(i, 10) = 0.0_8 - temp379b60 = cost5g*distpb(i, 9) - rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& -& 1, i))*temp379b60 - distpb(i, 9) = 0.0_8 - temp379b61 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) - temp379b62 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp379b61 - 2*rmu(2, i)*& -& temp379b62 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& -& temp379b60 - rmub(3, i) = rmub(3, i) + rmu(2, i)*temp379b61 - distpb(i, 8) = 0.0_8 - temp379b63 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) - temp379b64 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp379b63 + 2*rmu(1, i)*& -& temp379b64 + 3.d0*2*rmu(1, i)*temp379b62 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp379b63 - rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp379b64 - distpb(i, 7) = 0.0_8 - temp379b65 = cost3g*2.d0*distpb(i, 6) - temp379b66 = (7.d0*rmu(3, i)**2-r(i)**2)*temp379b65 - temp379b67 = rmu(1, i)*rmu(2, i)*temp379b65 - rmub(1, i) = rmub(1, i) + rmu(2, i)*temp379b66 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp379b66 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp379b67 - distpb(i, 6) = 0.0_8 - temp379b68 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) - temp379b69 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - temp379b70 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) - temp379b71 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - temp379b72 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) - temp379b73 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - temp379b74 = cost1g*distpb(i, 2) - rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& -& temp379b74 - 3.d0*2*r(i)*temp379b73 - 2*r(i)*temp379b69 - 3.d0*2& -& *r(i)*temp379b71 - 2*r(i)*temp379b67 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp379b68 - rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp379b68 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp379b69 - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp379b70 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp379b71 + rmu(2, i)*& -& temp379b70 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp379b72 - rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& -& rmu(3, i))*temp379b74 + 7.d0*2*rmu(3, i)*temp379b73 + rmu(1, i)*& -& temp379b72 - distpb(i, 2) = 0.0_8 - END DO - dd1b = 0.0_8 - cb = 0.0_8 DO k=indtm,indtmin,-1 - temp379b56 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp379b56 - rb(k) = rb(k) - dd1*temp379b56 + temp254 = r(k)**2 + temp253 = 2*npower + temp253b56 = r(k)**temp253*DEXP(-(dd2*temp254))*distpb(k, 1) + IF (r(k) .LE. 0.0 .AND. (temp253 .EQ. 0.0 .OR. temp253 .NE. INT(& +& temp253))) THEN + rb(k) = rb(k) - dd2*2*r(k)*temp253b56 + ELSE + rb(k) = rb(k) + DEXP(-(dd2*temp254))*temp253*r(k)**(temp253-1)*& +& distpb(k, 1) - dd2*2*r(k)*temp253b56 + END IF + dd2b = dd2b - temp254*temp253b56 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + .020104801169736915d0*5.5d0*dd1**4.5D0*cb - ddb(indparp) = ddb(indparp) + dd1b - CASE (56) -! g single Slater orbital derivative of 55 -! R(r)= (11.d0/2.0 1/dd1 - r) * exp(-alpha r) -! normalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! l = 4 -! \int d\omega Y*Y = 4 pi / (2 l + 1) -! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5**2 * 3**4 / 2**3 / dd1**11 - c = dd1**5.5d0*.020104801169736915d0 -! c=1.d0/dsqrt(7.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(11.d0/2.d0)/3.d0/5.d0 -! endif + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (119) +! 2p single r_mu/(1+b r^2)^(3/2) parent of 103 + dd2 = dd(indpar+1) DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k))) - END DO - DO i=indtmin,indtm - distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& -& 2+3.d0*r(i)**4) -! lz=0 - distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& -& (i)**2) -! lz=+/-1 - distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& -& 2-r(i)**2) -! lz=+/-2 - distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& -& (i)**2) -! lz=+/-2 - distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & -& i)**2) -! lz=+/-3 - distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& -& , i)**2) -! lz=+/-3 - distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& -& rmu(2, i)**4) -! lz=+/-4 - distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& -& , i)**2) + distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**2)**1.5d0 END DO -! lz=+/-4 - DO ic=1,9 +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1)*(11.d0/2.d0/dd1-r(0)) - fun = distp(0, 1)*(dd1-13.d0/2.d0/r(0)) - fun2 = dd1*distp(0, 1)*(15.d0/2.d0-dd1*r(0)) -! indorbp=indorb - DO ic=1,9 + fun = -(3.d0*dd2*distp(0, 1)/(1.d0+dd2*r(0)**2)) + fun2 = 3.d0*dd2*(-1.d0+4.d0*dd2*r(0)**2)/(1.d0+dd2*r(0)**2)**3.5d0 +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - ELSE IF (i .EQ. 2) THEN + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp263b0 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp263b0 + fun2b = fun2b + temp263b0 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp263b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp263b + funb0 = funb0 + rmu(ic, 0)*temp263b + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + temp260 = dd2*r(0)**2 + 1.d0 + temp262 = temp260**3.5d0 + temp261 = 4.d0*dd2*r(0)**2 - 1.d0 + temp261b = 3.d0*fun2b/temp262 + temp261b0 = dd2*4.d0*temp261b + temp260b = -(dd2*temp261*3.5d0*temp260**2.5D0*temp261b/temp262) + temp259 = dd2*r(0)**2 + 1.d0 + temp260b0 = -(3.d0*funb0/temp259) + temp259b = -(dd2*distp(0, 1)*temp260b0/temp259) + dd2b = distp(0, 1)*temp260b0 + r(0)**2*temp259b + r(0)**2*temp260b& +& + r(0)**2*temp261b0 + temp261*temp261b + rb(0) = rb(0) + dd2*2*r(0)*temp259b + dd2*2*r(0)*temp260b + dd2*2*& +& r(0)*temp261b0 + distpb = 0.0_8 + distpb(0, 1) = fun0b + dd2*temp260b0 + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=indtm,i0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO k=indtm,indtmin,-1 + temp257 = dd2*r(k)**2 + 1.d0 + temp258 = temp257**1.5d0 + temp257b3 = -(1.5d0*temp257**0.5D0*distpb(k, 1)/temp258**2) + dd2b = dd2b + r(k)**2*temp257b3 + rb(k) = rb(k) + dd2*2*r(k)*temp257b3 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (27) +! 2p without cusp condition + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd(indpar+3) + dd3 = dd(indpar+4) + peff2 = dd(indpar+5) +! if(iflagnorm.gt.2) then + c = 1.d0/2.d0/DSQRT(240.d0*pi*(1.d0/(2.d0*dd1)**7+2.d0*peff/(dd1+dd2& +& )**7+peff**2/(2.d0*dd2)**7+2.d0*peff2/(dd1+dd3)**7+peff2**2/(2.d0*& +& dd3)**7+2.d0*peff2*peff/(dd2+dd3)**7)) +! endif + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 2) = c*DEXP(-(dd2*r(k))) + distp(k, 3) = c*DEXP(-(dd3*r(k))) + END DO + DO i=indtmin,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) + distp(i, 4) = r(i)*(distp(i, 1)+peff*distp(i, 2)+peff2*distp(i, 3)& +& ) + END DO +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN + fun = (1.d0-dd1*r(0))*distp(0, 1) + peff*(1.d0-dd2*r(0))*distp(0, & +& 2) + peff2*(1.d0-dd3*r(0))*distp(0, 3) + fun2 = dd1*(dd1*r(0)-2.d0)*distp(0, 1) + peff*dd2*(dd2*r(0)-2.d0)*& +& distp(0, 2) + peff2*dd3*(dd3*r(0)-2.d0)*distp(0, 3) +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp278 = fun/r(0) + temp279b = rmu(ic, 0)*zb(indorbp, indt+4) + temp278b = 4.d0*temp279b/r(0) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp278+fun2)*zb(indorbp, indt& +& +4) + funb0 = funb0 + temp278b + rb(0) = rb(0) - temp278*temp278b + fun2b = fun2b + temp279b + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp277 = fun/r(0) + temp277b13 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(ic, 0) = rmub(ic, 0) + temp277*rmu(i, 0)*zb(indorbp, indt& +& +i) + rmub(i, 0) = rmub(i, 0) + temp277*rmu(ic, 0)*zb(indorbp, indt+& +& i) + funb0 = funb0 + temp277b13 + rb(0) = rb(0) - temp277*temp277b13 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + distpb = 0.0_8 + temp277b3 = dd1*distp(0, 1)*fun2b + temp277b4 = (dd1*r(0)-2.d0)*fun2b + temp277b5 = (dd2*r(0)-2.d0)*fun2b + temp277b6 = peff*dd2*distp(0, 2)*fun2b + temp277b7 = (dd3*r(0)-2.d0)*fun2b + temp277b8 = peff2*dd3*distp(0, 3)*fun2b + dd1b = distp(0, 1)*temp277b4 - distp(0, 1)*r(0)*funb0 + r(0)*& +& temp277b3 + temp277b9 = peff*distp(0, 2)*funb0 + temp277b10 = peff2*distp(0, 3)*funb0 + rb(0) = rb(0) + dd3*temp277b8 - dd2*temp277b9 - dd3*temp277b10 - & +& distp(0, 1)*dd1*funb0 + dd2*temp277b6 + dd1*temp277b3 + distpb(0, 1) = dd1*temp277b4 + temp277b11 = (1.d0-dd2*r(0))*funb0 + peffb = distp(0, 2)*temp277b11 + distp(0, 2)*dd2*temp277b5 + dd2b = r(0)*temp277b6 - r(0)*temp277b9 + distp(0, 2)*peff*& +& temp277b5 + distpb(0, 2) = peff*dd2*temp277b5 + temp277b12 = (1.d0-dd3*r(0))*funb0 + peff2b = distp(0, 3)*temp277b12 + distp(0, 3)*dd3*temp277b7 + dd3b = r(0)*temp277b8 - r(0)*temp277b10 + distp(0, 3)*peff2*& +& temp277b7 + distpb(0, 3) = peff2*dd3*temp277b7 + distpb(0, 1) = distpb(0, 1) + (1.d0-dd1*r(0))*funb0 + distpb(0, 2) = distpb(0, 2) + peff*temp277b11 + distpb(0, 3) = distpb(0, 3) + peff2*temp277b12 + distpb(0, 4) = distpb(0, 4) + fun0b + ELSE + distpb = 0.0_8 + peffb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 + dd3b = 0.0_8 + peff2b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=indtm,i0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 4)*zb(indorbp, i) + distpb(i, 4) = distpb(i, 4) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO i=indtm,indtmin,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) + temp277b2 = r(i)*distpb(i, 4) + rb(i) = rb(i) + (distp(i, 1)+peff*distp(i, 2)+peff2*distp(i, 3))*& +& distpb(i, 4) + distpb(i, 1) = distpb(i, 1) + temp277b2 + peffb = peffb + distp(i, 2)*temp277b2 + distpb(i, 2) = distpb(i, 2) + peff*temp277b2 + peff2b = peff2b + distp(i, 3)*temp277b2 + distpb(i, 3) = distpb(i, 3) + peff2*temp277b2 + distpb(i, 4) = 0.0_8 + END DO + cb = 0.0_8 + DO k=indtm,indtmin,-1 + temp277b = c*DEXP(-(dd3*r(k)))*distpb(k, 3) + cb = cb + DEXP(-(dd3*r(k)))*distpb(k, 3) + dd3b = dd3b - r(k)*temp277b + distpb(k, 3) = 0.0_8 + temp277b0 = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) + distpb(k, 2) = 0.0_8 + temp277b1 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd2*temp277b0 - dd1*temp277b1 - dd3*temp277b + dd2b = dd2b - r(k)*temp277b0 + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp277b1 + distpb(k, 1) = 0.0_8 + END DO + temp276 = (dd2+dd3)**7 + temp263 = peff2*peff/temp276 + temp275 = 2.d0**7 + temp274 = temp275*dd3**7 + temp273 = peff2**2/temp274 + temp272 = (dd1+dd3)**7 + temp271 = 2.d0**7 + temp270 = temp271*dd2**7 + temp269 = peff**2/temp270 + temp268 = (dd1+dd2)**7 + temp267 = 2.d0**7 + temp266 = temp267*dd1**7 + temp265 = 240.d0*pi*(1.0/temp266+2.d0*peff/temp268+temp269+2.d0*& +& peff2/temp272+temp273+2.d0*temp263) + temp264 = DSQRT(temp265) + IF (temp265 .EQ. 0.0) THEN + temp264b = 0.0 + ELSE + temp264b = -(pi*240.d0*cb/(2.d0*temp264**2*2.D0*DSQRT(temp265))) + END IF + temp264b0 = 2.d0*temp264b/temp268 + temp264b1 = -(peff*7*(dd1+dd2)**6*temp264b0/temp268) + temp264b2 = 2.d0*temp264b/temp272 + temp264b3 = -(peff2*7*(dd1+dd3)**6*temp264b2/temp272) + temp263b1 = 2.d0*temp264b/temp276 + temp263b2 = -(temp263*7*(dd2+dd3)**6*temp263b1) + dd1b = dd1b + temp264b3 + temp264b1 - temp267*7*dd1**6*temp264b/& +& temp266**2 + peffb = peffb + peff2*temp263b1 + 2*peff*temp264b/temp270 + & +& temp264b0 + dd2b = dd2b + temp263b2 - temp269*temp271*7*dd2**6*temp264b/temp270 & +& + temp264b1 + peff2b = peff2b + peff*temp263b1 + 2*peff2*temp264b/temp274 + & +& temp264b2 + dd3b = dd3b + temp263b2 - temp273*temp275*7*dd3**6*temp264b/temp274 & +& + temp264b3 + ddb(indpar+5) = ddb(indpar+5) + peff2b + ddb(indpar+4) = ddb(indpar+4) + dd3b + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (85) +! d orbitals +! R(r)= c*exp(-z r^2)*(7/4/z-r^2) +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) + dd2 = DSQRT(dd1) +! if(iflagnorm.gt.2) then +! overall normalization +! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)*ratiocd + c = dd1**1.75d0*ratiocd +! endif + DO k=indtmin,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) + END DO + DO i=indtmin,indtm +! lz=0 + distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d +! lz=+/-2 + distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d +! lz=+/-2 + distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d +! lz=+/-1 + distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d +! lz=+/-1 + distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d + END DO + DO ic=1,5 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO k=i0,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 + END DO + END DO +! endif + IF (typec .NE. 1) THEN + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*rp2)/rp3 + fun0 = distp(0, 1)*(7.d0/4.d0/dd1-r(0)**2*cost) + fun = 0.25d0*distp(0, 1)*(-22.d0-49.d0*rp2-28.d0*rp1-rp1*rp2+2.d0*& +& rp1**2)/rp3**2 + fun2 = -(0.25d0*distp(0, 1)*(22.d0+54.d0*rp2-26.d0*rp1-158.d0*rp1*& +& rp2-139.d0*rp1**2-42.d0*rp1**2*rp2+rp1**3+2.d0*rp1**3*rp2)/rp3**& +& 3) +! indorbp=indorb + DO ic=1,5 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (ic .EQ. 1) THEN + IF (i .NE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF ELSE IF (ic .EQ. 3) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) END IF ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE IF (i .EQ. 2) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - ELSE + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - END IF - ELSE IF (ic .EQ. 6) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - END IF - ELSE IF (ic .EQ. 7) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,21) - END IF - ELSE IF (ic .EQ. 8) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,22) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,24) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,23) - END IF - ELSE IF (ic .EQ. 9) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,26) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,28) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,27) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,25) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=9,1,-1 - temp386b57 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 10.d0*temp386b57 - fun2b = fun2b + temp386b57 + DO ic=5,1,-1 + temp290b4 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 6.d0*temp290b4 + fun2b = fun2b + temp290b4 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 15) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp386b2 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& -& 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& -& ) - rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp386b2 - rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp386b2 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& -& )*temp386b2 - ELSE - temp386b3 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& -& 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& -& ) - rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& -& , 0)**2)*temp386b3 - rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp386b3 - rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& -& )*temp386b3 - END IF - ELSE IF (branch .LT. 4) THEN - temp386b4 = cost1g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& -& 3, 0)*r(0)**2))*zb(indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& -& r(0)**2)*temp386b4 - rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp386b4 - ELSE - temp386b5 = cost2g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& -& , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& -& (indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& -& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp386b5 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp386b5 - rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp386b5 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp386b6 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp386b7 = rmu(2, 0)*rmu(3, 0)*temp386b6 - temp386b8 = fun0*rmu(1, 0)*temp386b6 - fun0b = fun0b + rmu(1, 0)*temp386b7 - rmub(1, 0) = rmub(1, 0) + fun0*temp386b7 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp386b8 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp386b8 - ELSE - temp386b9 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp386b10 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& -& **2)*temp386b9 - temp386b11 = fun0*rmu(1, 0)*temp386b9 - fun0b = fun0b + rmu(1, 0)*temp386b10 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp386b11 + & -& fun0*temp386b10 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp386b11 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp386b11 - END IF - ELSE - temp386b12 = -(cost2g*6.d0*zb(indorbp, indt+i)) - temp386b13 = rmu(2, 0)*rmu(3, 0)*temp386b12 - temp386b14 = fun0*rmu(1, 0)*temp386b12 - fun0b = fun0b + rmu(1, 0)*temp386b13 - rmub(1, 0) = rmub(1, 0) + fun0*temp386b13 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp386b14 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp386b14 - END IF - ELSE IF (branch .LT. 12) THEN - IF (branch .LT. 10) THEN - IF (branch .LT. 9) THEN - temp386b15 = cost2g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& -& , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& -& (indorbp, indt+i) - rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& -& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp386b15 - rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& -& temp386b15 - rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& -& temp386b15 - ELSE - temp386b16 = -(cost2g*3.d0*zb(indorbp, indt+i)) - temp386b17 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& -& **2)*temp386b16 - temp386b18 = fun0*rmu(2, 0)*temp386b16 - fun0b = fun0b + rmu(2, 0)*temp386b17 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp386b18 + & -& fun0*temp386b17 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp386b18 - rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp386b18 - END IF - ELSE IF (branch .LT. 11) THEN - temp386b19 = -(cost3g*4.d0*zb(indorbp, indt+i)) - temp386b20 = fun0*temp386b19 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& -& **2))*temp386b19 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp386b20 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& -& temp386b20 - ELSE - temp386b21 = cost3g*4.d0*zb(indorbp, indt+i) - temp386b22 = fun0*temp386b21 - fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& -& **2))*temp386b21 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& -& **2)*temp386b22 - rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& -& temp386b22 - END IF - ELSE IF (branch .LT. 14) THEN - IF (branch .LT. 13) THEN - temp386b23 = cost3g*12.d0*zb(indorbp, indt+i) - temp386b24 = fun0*rmu(3, 0)*temp386b23 - temp386b25 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp386b23 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp386b24 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp386b24 - fun0b = fun0b + rmu(3, 0)*temp386b25 - rmub(3, 0) = rmub(3, 0) + fun0*temp386b25 - ELSE - temp386b26 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp386b27 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3& -& , 0)**2)*temp386b26 - temp386b28 = fun0*rmu(2, 0)*temp386b26 - fun0b = fun0b + rmu(2, 0)*temp386b27 - rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp386b28 + fun0*& -& temp386b27 - rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp386b28 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp386b28 - END IF - ELSE - temp386b29 = -(cost3g*2.d0*zb(indorbp, indt+i)) - temp386b30 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0& -& )**2)*temp386b29 - temp386b31 = fun0*rmu(1, 0)*temp386b29 - fun0b = fun0b + rmu(1, 0)*temp386b30 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp386b31 + fun0*& -& temp386b30 - rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp386b31 - rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp386b31 - END IF - ELSE IF (branch .LT. 22) THEN - IF (branch .LT. 19) THEN - IF (branch .LT. 17) THEN - IF (branch .LT. 16) THEN - temp386b32 = cost3g*24.d0*zb(indorbp, indt+i) - temp386b33 = rmu(2, 0)*rmu(3, 0)*temp386b32 - temp386b34 = fun0*rmu(1, 0)*temp386b32 - fun0b = fun0b + rmu(1, 0)*temp386b33 - rmub(1, 0) = rmub(1, 0) + fun0*temp386b33 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp386b34 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp386b34 + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp290b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp290b0 + fun0b = fun0b + rmu(i, 0)*temp290b0 ELSE - temp386b35 = cost4g*3.d0*zb(indorbp, indt+i) - temp386b36 = fun0*rmu(3, 0)*temp386b35 - temp386b37 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp386b35 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp386b36 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp386b36 - fun0b = fun0b + rmu(3, 0)*temp386b37 - rmub(3, 0) = rmub(3, 0) + fun0*temp386b37 + temp290b1 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp290b1 + fun0b = fun0b + rmu(i, 0)*temp290b1 END IF - ELSE IF (branch .LT. 18) THEN - temp386b38 = -(cost4g*6.d0*zb(indorbp, indt+i)) - temp386b39 = rmu(2, 0)*rmu(3, 0)*temp386b38 - temp386b40 = fun0*rmu(1, 0)*temp386b38 - fun0b = fun0b + rmu(1, 0)*temp386b39 - rmub(1, 0) = rmub(1, 0) + fun0*temp386b39 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp386b40 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp386b40 - ELSE - temp386b41 = cost4g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& -& (2, 0)**2))*zb(indorbp, indt+i) - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp386b41 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp386b41 + ELSE IF (branch .LT. 4) THEN + temp290b2 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp290b2 + fun0b = fun0b + rmu(i, 0)*temp290b2 END IF - ELSE IF (branch .LT. 21) THEN - IF (branch .LT. 20) THEN - temp386b42 = cost4g*6.d0*zb(indorbp, indt+i) - temp386b43 = rmu(2, 0)*rmu(3, 0)*temp386b42 - temp386b44 = fun0*rmu(1, 0)*temp386b42 - fun0b = fun0b + rmu(1, 0)*temp386b43 - rmub(1, 0) = rmub(1, 0) + fun0*temp386b43 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp386b44 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp386b44 + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp290b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp290b3 + fun0b = fun0b + rmu(i, 0)*temp290b3 ELSE - temp386b45 = cost4g*3.d0*zb(indorbp, indt+i) - temp386b46 = fun0*rmu(3, 0)*temp386b45 - temp386b47 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp386b45 - rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp386b46 - rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp386b46 - fun0b = fun0b + rmu(3, 0)*temp386b47 - rmub(3, 0) = rmub(3, 0) + fun0*temp386b47 + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - ELSE - temp386b48 = cost4g*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& -& 2, 0)**3)*zb(indorbp, indt+i) - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp386b48 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp386b48 + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 26) THEN - IF (branch .LT. 24) THEN - IF (branch .LT. 23) THEN - temp386b49 = cost5g*4.d0*zb(indorbp, indt+i) - temp386b50 = fun0*temp386b49 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& -& **2))*temp386b49 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& -& **2)*temp386b50 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp386b50 + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 25) THEN - temp386b51 = cost5g*4.d0*zb(indorbp, indt+i) - temp386b52 = fun0*temp386b51 - fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& -& ))*temp386b51 - rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& -& 2)*temp386b52 - rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp386b52 + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 28) THEN - IF (branch .LT. 27) THEN - temp386b53 = cost5g*4.d0*zb(indorbp, indt+i) - temp386b54 = fun0*temp386b53 - fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& -& 3)*temp386b53 - rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& -& temp386b54 - rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& -& 2)*temp386b54 + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF ELSE - temp386b55 = cost5g*4.d0*zb(indorbp, indt+i) - temp386b56 = fun0*temp386b55 - fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& -& *temp386b55 - rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& -& *temp386b56 - rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& -& temp386b56 + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp386b1 = distp(0, 1+ic)*zb(indorbp, indt+i) + temp290b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp386b1 - funb = funb + rmu(i, 0)*temp386b1 + rmub(i, 0) = rmub(i, 0) + fun*temp290b + funb0 = funb0 + rmu(i, 0)*temp290b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp386b = (15.d0/2.d0-dd1*r(0))*fun2b - temp386b0 = dd1*distp(0, 1)*fun2b - temp383 = 2.d0*dd1 - temp382 = 11.d0/temp383 - dd1b = distp(0, 1)*funb - distp(0, 1)*temp382*2.d0*fun0b/temp383 -& -& r(0)*temp386b0 + distp(0, 1)*temp386b - temp385 = 2.d0*r(0) - temp384 = 13.d0/temp385 - distpb(0, 1) = distpb(0, 1) + (dd1-temp384)*funb + (temp382-r(0))*& -& fun0b + dd1*temp386b - rb(0) = rb(0) + distp(0, 1)*temp384*2.d0*funb/temp385 - distp(0, 1& -& )*fun0b - dd1*temp386b0 - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + temp289 = rp3**3 + temp287 = distp(0, 1)/temp289 + temp288 = rp1**3 + temp288b = -(0.25d0*temp287*fun2b) + temp287b = -(0.25d0*(54.d0*rp2-26.d0*rp1-158.d0*(rp1*rp2)-139.d0*& +& rp1**2+rp1**3-42.d0*(rp1**2*rp2)+2.d0*(temp288*rp2)+22.d0)*fun2b& +& /temp289) + temp286 = rp3**2 + temp285 = distp(0, 1)/temp286 + temp285b = 0.25d0*(2.d0*rp1**2-28.d0*rp1-49.d0*rp2-rp1*rp2-22.d0)*& +& funb0/temp286 + temp283b0 = distp(0, 1)*fun0b + costb = -(r(0)**2*temp283b0) + rp3b = -(temp285*2*rp3*temp285b) - (0.5d0*rp2+1.d0)*costb/rp3**2 -& +& temp287*3*rp3**2*temp287b + temp286b = 0.25d0*temp285*funb0 + rp2b = ((-49.d0)-rp1)*temp286b + 2*(rp2+1.d0)*rp3b + 0.5d0*costb/& +& rp3 + (2.d0*temp288-42.d0*rp1**2-158.d0*rp1+54.d0)*temp288b + rp1b = (2.d0*2*rp1-rp2-28.d0)*temp286b + (2.d0*rp2*3*rp1**2-42.d0*& +& rp2*2*rp1+3*rp1**2-139.d0*2*rp1-158.d0*rp2-26.d0)*temp288b + temp284 = 4.d0*dd1 + temp283 = 7.d0/temp284 + distpb(0, 1) = distpb(0, 1) + temp285b + (temp283-r(0)**2*cost)*& +& fun0b + temp287b + dd1b = r(0)**2*rp1b - temp283*4.d0*temp283b0/temp284 + rb(0) = rb(0) + dd2*rp2b + dd1*2*r(0)*rp1b - cost*2*r(0)*temp283b0 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = r(0)*rp2b ELSE distpb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 END IF - dd1b = 0.0_8 - DO ic=9,1,-1 + DO ic=5,1,-1 DO k=indtm,i0,-1 - temp381 = 2.d0*dd1 - temp380 = 11.d0/temp381 - temp380b75 = (temp380-r(k))*zb(indorbp, k) - temp380b76 = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp380b75 - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp380b75 - dd1b = dd1b - temp380*2.d0*temp380b76/temp381 - rb(k) = rb(k) - temp380b76 + temp283b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) + temp282 = 4.d0*dd1 + temp281 = 7.d0/temp282 + temp281b = (temp281-r(k)**2*cost)*zb(indorbp, k) + dd1b = dd1b - temp281*4.d0*temp283b/temp282 + costb = -(r(k)**2*temp283b) + temp280 = dd2*r(k) + 1.d0 + temp281b0 = costb/temp280**2 + temp280b0 = -((0.5d0*(dd2*r(k))+1.d0)*2*temp281b0/temp280) + rb(k) = rb(k) + 0.5d0*dd2*temp281b0 + dd2*temp280b0 - cost*2*r(k& +& )*temp283b + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp281b + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp281b zb(indorbp, k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = dd2b + r(k)*temp280b0 + 0.5d0*r(k)*temp281b0 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 - temp380b57 = cost5g*4.d0*distpb(i, 10) - temp380b58 = (rmu(1, i)**2-rmu(2, i)**2)*temp380b57 - temp380b59 = rmu(1, i)*rmu(2, i)*temp380b57 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp380b59 + rmu(2, i)*& -& temp380b58 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp380b58 - 2*rmu(2, i)*& -& temp380b59 - distpb(i, 10) = 0.0_8 - temp380b60 = cost5g*distpb(i, 9) - rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& -& 1, i))*temp380b60 - distpb(i, 9) = 0.0_8 - temp380b61 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) - temp380b62 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp380b61 - 2*rmu(2, i)*& -& temp380b62 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& -& temp380b60 - rmub(3, i) = rmub(3, i) + rmu(2, i)*temp380b61 - distpb(i, 8) = 0.0_8 - temp380b63 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) - temp380b64 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp380b63 + 2*rmu(1, i)*& -& temp380b64 + 3.d0*2*rmu(1, i)*temp380b62 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp380b63 - rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp380b64 - distpb(i, 7) = 0.0_8 - temp380b65 = cost3g*2.d0*distpb(i, 6) - temp380b66 = (7.d0*rmu(3, i)**2-r(i)**2)*temp380b65 - temp380b67 = rmu(1, i)*rmu(2, i)*temp380b65 - rmub(1, i) = rmub(1, i) + rmu(2, i)*temp380b66 - rmub(2, i) = rmub(2, i) + rmu(1, i)*temp380b66 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp380b67 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 - temp380b68 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) - temp380b69 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 - temp380b70 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) - temp380b71 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - temp380b72 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) - temp380b73 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 - temp380b74 = cost1g*distpb(i, 2) - rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& -& temp380b74 - 3.d0*2*r(i)*temp380b73 - 2*r(i)*temp380b69 - 3.d0*2& -& *r(i)*temp380b71 - 2*r(i)*temp380b67 - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp380b68 - rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp380b68 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp380b69 - rmub(2, i) = rmub(2, i) + rmu(3, i)*temp380b70 - rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp380b71 + rmu(2, i)*& -& temp380b70 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp380b72 - rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& -& rmu(3, i))*temp380b74 + 7.d0*2*rmu(3, i)*temp380b73 + rmu(1, i)*& -& temp380b72 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) distpb(i, 2) = 0.0_8 END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - temp380b56 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) - cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp380b56 - rb(k) = rb(k) - dd1*temp380b56 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp279 = dd2*r(k) + 1.d0 + temp280b = costb/temp279 + temp279b0 = -(dd1*r(k)**2*temp280b/temp279) + dd1b = dd1b + r(k)**2*temp280b + rb(k) = rb(k) + dd2*temp279b0 + dd1*2*r(k)*temp280b + dd2b = dd2b + r(k)*temp279b0 END DO - dd1b = dd1b + .020104801169736915d0*5.5d0*dd1**4.5D0*cb + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocd*1.75d0*dd1**0.75D0*cb + ELSE + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocd*1.75d0*dd1**0.75D0*& +& cb + END IF ddb(indparp) = ddb(indparp) + dd1b - CASE (72) -! h-orbitals -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization obtained by Mathematica - c = dd1**3.25d0*0.79296269381073167718d0 -! C= dd1^13/4 /Sqrt[Integrate[x^12 Exp[-2 x^2],{x,0,Infinity}]] -! endif + CASE (115) +! 2s double lorentian with constant parent of 102 +! (dd3+ r^2/(1+dd2*r)^3+dd4*r^3/(1+dd5*r)^4; + dd2 = dd(indpar+1) + dd4 = dd(indpar+3) + dd5 = dd(indpar+4) + indorbp = indorb + 1 DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + distp(k, 1) = r(k)**2/(1.d0+dd2*r(k))**3 + distp(k, 2) = r(k)**3/(1.d0+dd5*r(k))**4 END DO - DO i=indtmin,indtm - DO k=1,5 - CALL PUSHREAL8(adr8ibuf,adr8buf,zv(k)) - zv(k) = rmu(3, i)**k - CALL PUSHREAL8(adr8ibuf,adr8buf,yv(k)) - yv(k) = rmu(2, i)**k - CALL PUSHREAL8(adr8ibuf,adr8buf,xv(k)) - xv(k) = rmu(1, i)**k +! write(6,*) ' function inside = ',z(indorbp,i) +! endif + IF (typec .NE. 1) THEN + fun = (2.d0-dd2*r(0))/(1+dd2*r(0))**4 - dd4*r(0)*(-3.d0+dd5*r(0))/& +& (1.d0+dd5*r(0))**5 + fun2b = zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 END DO - CALL PUSHREAL8(adr8ibuf,adr8buf,r2) - r2 = xv(2) + yv(2) + zv(2) - CALL PUSHREAL8(adr8ibuf,adr8buf,r4) - r4 = r2*r2 -! lz=0 - distp(i, 2) = cost1h*(63.d0*zv(5)-70.d0*zv(3)*r2+15.d0*zv(1)*r4) - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = 21.d0*zv(4) - 14.d0*zv(2)*r2 + r4 -! lz=+/-1 - distp(i, 3) = cost2h*rmu(1, i)*cost -! lz=+/-1 - distp(i, 4) = cost2h*rmu(2, i)*cost - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = 3.d0*zv(3) - zv(1)*r2 -! lz=+/-2 - distp(i, 5) = cost3h*(xv(2)-yv(2))*cost -! lz=+/-2 - distp(i, 6) = 2.d0*cost3h*xv(1)*yv(1)*cost - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = 9.d0*zv(2) - r2 -! lz=+/-3 - distp(i, 7) = cost4h*(xv(3)-3.d0*xv(1)*yv(2))*cost -! lz=+/-3 - distp(i, 8) = -(cost4h*(yv(3)-3.d0*yv(1)*xv(2))*cost) -! lz=+/-4 - distp(i, 9) = cost5h*(xv(4)-6.d0*xv(2)*yv(2)+yv(4))*zv(1) -! lz=+/-4 - distp(i, 10) = cost5h*4.d0*(xv(3)*yv(1)-yv(3)*xv(1))*zv(1) -! lz=+/-5 - distp(i, 11) = cost6h*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4)) -! lz=+/-5 - distp(i, 12) = -(cost6h*(-(5.d0*xv(4)*yv(1))+10.d0*xv(2)*yv(3)-yv(& -& 5))) + temp300 = (dd2*r(0)+1)**5 + temp300b = 2.d0*fun2b/temp300 + temp300b0 = 2*dd2*r(0)*temp300b + temp300b1 = -(((dd2*r(0))**2-4.d0*(dd2*r(0))+1.d0)*5*(dd2*r(0)+1)& +& **4*temp300b/temp300) + temp299 = (dd5*r(0)+1.d0)**6 + temp298 = dd4*r(0)/temp299 + temp299b = 2.d0*temp298*fun2b + temp299b0 = 2*dd5*r(0)*temp299b + temp298b = 2.d0*((dd5*r(0))**2-6.d0*(dd5*r(0))+3.d0)*fun2b/temp299 + temp298b0 = -(temp298*6*(dd5*r(0)+1.d0)**5*temp298b) + temp297 = (dd2*r(0)+1)**4 + temp297b = funb0/temp297 + temp297b0 = -((2.d0-dd2*r(0))*4*(dd2*r(0)+1)**3*temp297b/temp297) + dd2b = r(0)*temp297b0 - r(0)*temp297b + r(0)*temp300b1 - 4.d0*r(0)& +& *temp300b + r(0)*temp300b0 + temp296 = (dd5*r(0)+1.d0)**5 + temp296b = -(funb0/temp296) + temp295 = dd5*r(0) - 3.d0 + temp294 = dd4*r(0) + temp294b = -(temp294*temp295*5*(dd5*r(0)+1.d0)**4*temp296b/temp296& +& ) + rb(0) = rb(0) + dd2*temp297b0 - dd2*temp297b + (temp294*dd5+& +& temp295*dd4)*temp296b + dd5*temp294b + dd5*temp298b0 + dd4*& +& temp298b - 6.d0*dd5*temp299b + dd5*temp299b0 + dd2*temp300b1 - & +& 4.d0*dd2*temp300b + dd2*temp300b0 + dd5b = temp294*r(0)*temp296b + r(0)*temp294b + r(0)*temp298b0 - & +& 6.d0*r(0)*temp299b + r(0)*temp299b0 + dd4b = temp295*r(0)*temp296b + r(0)*temp298b + ELSE + dd2b = 0.0_8 + dd4b = 0.0_8 + dd5b = 0.0_8 + END IF + distpb = 0.0_8 + dd3b = 0.0_8 + DO i=indtm,i0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) + dd4b = dd4b + distp(i, 2)*zb(indorbp, i) + distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO - DO ic=1,11 + DO k=indtm,indtmin,-1 + temp292 = dd5*r(k) + 1.d0 + temp293 = temp292**4 + temp292b = -(r(k)**3*4*temp292**3*distpb(k, 2)/temp293**2) + rb(k) = rb(k) + dd5*temp292b + 3*r(k)**2*distpb(k, 2)/temp293 + dd5b = dd5b + r(k)*temp292b + distpb(k, 2) = 0.0_8 + temp290 = dd2*r(k) + 1.d0 + temp291 = temp290**3 + temp290b5 = -(r(k)**2*3*temp290**2*distpb(k, 1)/temp291**2) + rb(k) = rb(k) + dd2*temp290b5 + 2*r(k)*distpb(k, 1)/temp291 + dd2b = dd2b + r(k)*temp290b5 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+4) = ddb(indpar+4) + dd5b + ddb(indpar+3) = ddb(indpar+3) + dd4b + ddb(indpar+2) = ddb(indpar+2) + dd3b + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (22) +! 3p without cusp condition +! r e^{-z1 r } + dd1 = dd(indpar+1) +! c=dsqrt((2.d0*dd1)**7/240.d0/pi)/2.d0 + c = dd1**3.5d0*0.2060129077457011d0 +! + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k))) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(k, 2)) + distp(k, 2) = r(k)*distp(k, 1) + END DO +! +! indorbp=indorb +! + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif +! +! IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1) - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) - DO k=1,5 - CALL PUSHREAL8(adr8ibuf,adr8buf,zv(k)) - zv(k) = rmu(3, 0)**k - CALL PUSHREAL8(adr8ibuf,adr8buf,yv(k)) - yv(k) = rmu(2, 0)**k - CALL PUSHREAL8(adr8ibuf,adr8buf,xv(k)) - xv(k) = rmu(1, 0)**k - END DO - CALL PUSHREAL8(adr8ibuf,adr8buf,r2) - r2 = xv(2) + yv(2) + zv(2) - CALL PUSHREAL8(adr8ibuf,adr8buf,r4) - r4 = r2*r2 -! indorbp=indorb - DO ic=1,11 + fun = (1.d0-dd1*r(0))*distp(0, 1) + fun2 = dd1*(dd1*r(0)-2.d0)*distp(0, 1) +! +! indorbp=indorb +! + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp302 = fun/r(0) + temp303b = rmu(ic, 0)*zb(indorbp, indt+4) + temp302b = 4.d0*temp303b/r(0) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp302+fun2)*zb(indorbp, indt& +& +4) + funb0 = funb0 + temp302b + rb(0) = rb(0) - temp302*temp302b + fun2b = fun2b + temp303b + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp301 = fun/r(0) + temp301b2 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(ic, 0) = rmub(ic, 0) + temp301*rmu(i, 0)*zb(indorbp, indt& +& +i) + rmub(i, 0) = rmub(i, 0) + temp301*rmu(ic, 0)*zb(indorbp, indt+& +& i) + funb0 = funb0 + temp301b2 + rb(0) = rb(0) - temp301*temp301b2 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + distpb = 0.0_8 + temp301b0 = dd1*distp(0, 1)*fun2b + temp301b1 = (dd1*r(0)-2.d0)*fun2b + dd1b = distp(0, 1)*temp301b1 - distp(0, 1)*r(0)*funb0 + r(0)*& +& temp301b0 + rb(0) = rb(0) + dd1*temp301b0 - distp(0, 1)*dd1*funb0 + distpb(0, 1) = (1.d0-dd1*r(0))*funb0 + dd1*temp301b1 + distpb(0, 2) = distpb(0, 2) + fun0b + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=indtm,i0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 2)*zb(indorbp, i) + distpb(i, 2) = distpb(i, 2) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + cb = 0.0_8 + DO k=indtm,indtmin,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(k, 2)) + rb(k) = rb(k) + distp(k, 1)*distpb(k, 2) + distpb(k, 1) = distpb(k, 1) + r(k)*distpb(k, 2) + distpb(k, 2) = 0.0_8 + temp301b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp301b + rb(k) = rb(k) - dd1*temp301b + distpb(k, 1) = 0.0_8 + END DO + dd1b = dd1b + 0.2060129077457011d0*3.5d0*dd1**2.5D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (13) +! 3p double zeta +! R(r)=r**3*(exp(-z1*r)+z3*exp(-z2*r)) +! +! +! +! if(iocc(indshellp).eq.1) then +! + indorbp = indorb + 1 + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + dd3 = dd(indpar+3) +! if(iflagnorm.gt.2) then + c = 1.d0/2.d0/DSQRT(pi*40320.d0*(1.d0/(2.d0*dd1)**9+2.d0*dd3/(dd1+& +& dd2)**9+dd3**2/(2.d0*dd2)**9)) +! endif +! + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 2) = c*DEXP(-(dd2*r(k))) + END DO +! + IF (typec .NE. 1) THEN + rp1 = r(0)**3 + rp2 = r(0)**2 +! +!c the first derivative + fun = distp(0, 1)*(3.d0*rp2-dd1*rp1) + dd3*distp(0, 2)*(3.d0*rp2-& +& dd2*rp1) +!c +! the second derivative + temp312b = 2.d0*zb(indorbp, indt+4)/r(0) + funb0 = temp312b + rb(0) = rb(0) - fun*temp312b/r(0) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + temp311 = fun/r(0) + temp311b8 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(i, 0) = rmub(i, 0) + temp311*zb(indorbp, indt+i) + funb0 = funb0 + temp311b8 + rb(0) = rb(0) - temp311*temp311b8 + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp311b2 = distp(0, 1)*fun2b + temp311b3 = (6.d0*r(0)-6.d0*(dd2*rp2)+dd2**2*rp1)*fun2b + temp311b4 = dd3*distp(0, 2)*fun2b + distpb(0, 1) = (6.d0*r(0)-6.d0*(dd1*rp2)+dd1**2*rp1)*fun2b + temp311b5 = distp(0, 1)*funb0 + temp311b6 = dd3*distp(0, 2)*funb0 + rp2b = 3.d0*temp311b5 + 3.d0*temp311b6 - 6.d0*dd2*temp311b4 - 6.d0& +& *dd1*temp311b2 + rp1b = dd2**2*temp311b4 - dd2*temp311b6 - dd1*temp311b5 + dd1**2*& +& temp311b2 + rb(0) = rb(0) + 2*r(0)*rp2b + 3*r(0)**2*rp1b + 6.d0*temp311b4 + & +& 6.d0*temp311b2 + dd1b = (rp1*2*dd1-6.d0*rp2)*temp311b2 - rp1*temp311b5 + temp311b7 = (3.d0*rp2-dd2*rp1)*funb0 + dd3b = distp(0, 2)*temp311b7 + distp(0, 2)*temp311b3 + distpb(0, 2) = dd3*temp311b3 + dd2b = (rp1*2*dd2-6.d0*rp2)*temp311b4 - rp1*temp311b6 + distpb(0, 1) = distpb(0, 1) + (3.d0*rp2-dd1*rp1)*funb0 + distpb(0, 2) = distpb(0, 2) + dd3*temp311b7 + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 + dd3b = 0.0_8 + END IF + DO i=indtm,i0,-1 + temp311b1 = r(i)**3*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp311b1 + dd3b = dd3b + distp(i, 2)*temp311b1 + distpb(i, 2) = distpb(i, 2) + dd3*temp311b1 + rb(i) = rb(i) + (distp(i, 1)+dd3*distp(i, 2))*3*r(i)**2*zb(indorbp& +& , i) + zb(indorbp, i) = 0.0_8 + END DO + cb = 0.0_8 + DO k=indtm,indtmin,-1 + temp311b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp311b + distpb(k, 2) = 0.0_8 + temp311b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp311b0 - dd2*temp311b + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp311b0 + distpb(k, 1) = 0.0_8 + END DO + temp310 = 2.d0**9 + temp309 = temp310*dd2**9 + temp308 = dd3**2/temp309 + temp307 = (dd1+dd2)**9 + temp306 = 2.d0**9 + temp305 = temp306*dd1**9 + temp304 = 40320.d0*pi*(1.0/temp305+2.d0*dd3/temp307+temp308) + temp303 = DSQRT(temp304) + IF (temp304 .EQ. 0.0) THEN + temp303b0 = 0.0 + ELSE + temp303b0 = -(pi*40320.d0*cb/(2.d0*temp303**2*2.D0*DSQRT(temp304))& +& ) + END IF + temp303b1 = 2.d0*temp303b0/temp307 + temp303b2 = -(dd3*9*(dd1+dd2)**8*temp303b1/temp307) + dd1b = dd1b + temp303b2 - temp306*9*dd1**8*temp303b0/temp305**2 + dd3b = dd3b + 2*dd3*temp303b0/temp309 + temp303b1 + dd2b = dd2b + temp303b2 - temp308*temp310*9*dd2**8*temp303b0/temp309 + ddb(indpar+3) = ddb(indpar+3) + dd3b + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (37, 68) +! 1s single Z pseudo +! d orbital +! +! - angmom = 2 +! - type = Gaussian +! - normalized = yes +! - angtype = spherical +! - npar = 1 +! - multiplicity = 5 +! + indparp = indpar + 1 + dd1 = dd(indparp) + c = dd1**1.75d0*1.64592278064948967213d0 + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + END DO + DO i=indtmin,indtm +! lz=0 + distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d +! lz=+/-2 + distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d +! lz=+/-2 + distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d +! lz=+/-1 + distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d +! lz=+/-1 + distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d + END DO + DO ic=1,5 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) + indorbp = indorb + ic + END DO + IF (typec .NE. 1) THEN + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1) + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic IF (ic .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) @@ -14364,364 +14075,81 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & ELSE IF (ic .EQ. 4) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) ELSE IF (ic .EQ. 5) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - ELSE IF (ic .EQ. 6) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE IF (ic .EQ. 7) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (ic .EQ. 8) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - ELSE IF (ic .EQ. 9) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE IF (ic .EQ. 10) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (ic .EQ. 11) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF END DO distpb = 0.0_8 - zvb = 0.0_8 - xvb = 0.0_8 - funb = 0.0_8 - yvb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - r2b = 0.0_8 - r4b = 0.0_8 - DO ic=11,1,-1 - temp387b61 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (12.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 12.d0*temp387b61 - fun2b = fun2b + temp387b61 + DO ic=5,1,-1 + temp313b6 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 6.d0*temp313b6 + fun2b = fun2b + temp313b6 zb(indorbp, indt+4) = 0.0_8 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 6) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - IF (branch .LT. 1) THEN - temp387b11 = cost1h*fun0*zb(indorbp, indt+3) - temp387b12 = cost1h*20.d0*zb(indorbp, indt+2) - temp387b13 = (3.d0*xv(2)+3.d0*yv(2)-4.d0*zv(2))*& -& temp387b12 - temp387b14 = cost1h*20.d0*zb(indorbp, indt+1) - temp387b15 = (3.d0*xv(2)+3.d0*yv(2)-4.d0*zv(2))*& -& temp387b14 - fun0b = fun0b + zv(1)*yv(1)*temp387b13 + zv(1)*xv(1)*& -& temp387b15 + cost1h*(175.d0*zv(4)-150.d0*(zv(2)*r2)+& -& 15.d0*r4)*zb(indorbp, indt+3) - zvb(4) = zvb(4) + 175.d0*temp387b11 - zvb(2) = zvb(2) - 150.d0*r2*temp387b11 - r2b = r2b - 150.d0*zv(2)*temp387b11 - r4b = r4b + 15.d0*temp387b11 - temp387b16 = fun0*yv(1)*zv(1)*temp387b12 - yvb(1) = yvb(1) + zv(1)*fun0*temp387b13 - zvb(1) = zvb(1) + fun0*yv(1)*temp387b13 - xvb(2) = xvb(2) + 3.d0*temp387b16 - temp387b17 = fun0*xv(1)*zv(1)*temp387b14 - yvb(2) = yvb(2) + 3.d0*temp387b17 + 3.d0*temp387b16 - zvb(2) = zvb(2) - 4.d0*temp387b16 - xvb(1) = xvb(1) + zv(1)*fun0*temp387b15 - zvb(1) = zvb(1) + fun0*xv(1)*temp387b15 - xvb(2) = xvb(2) + 3.d0*temp387b17 - zvb(2) = zvb(2) - 4.d0*temp387b17 - ELSE - temp387b18 = cost2h*fun0*zb(indorbp, indt+3) - temp387b19 = -(24.d0*zv(1)*temp387b18) - fun0b = fun0b + cost2h*(4.d0*(xv(3)*yv(1))+4.d0*(xv(1)*& -& yv(3))-24.d0*(xv(1)*yv(1)*zv(2)))*zb(indorbp, indt+2) & -& + cost2h*(5.d0*xv(4)+6.d0*(xv(2)*yv(2))+yv(4)+8.d0*zv(& -& 4)-12.d0*(yv(2)*zv(2))-36.d0*(xv(2)*zv(2)))*zb(indorbp& -& , indt+1) + cost2h*(32.d0*(zv(3)*xv(1))-24.d0*(xv(1)*& -& yv(2)*zv(1))-24.d0*(xv(3)*zv(1)))*zb(indorbp, indt+3) - zvb(3) = zvb(3) + 32.d0*xv(1)*temp387b18 - xvb(1) = xvb(1) + yv(2)*temp387b19 + 32.d0*zv(3)*& -& temp387b18 - yvb(2) = yvb(2) + xv(1)*temp387b19 - zvb(1) = zvb(1) + (-(24.d0*xv(3))-24.d0*xv(1)*yv(2))*& -& temp387b18 - temp387b20 = cost2h*fun0*zb(indorbp, indt+2) - xvb(3) = xvb(3) + 4.d0*yv(1)*temp387b20 - 24.d0*zv(1)*& -& temp387b18 - temp387b21 = -(24.d0*zv(2)*temp387b20) - yvb(1) = yvb(1) + xv(1)*temp387b21 + 4.d0*xv(3)*& -& temp387b20 - xvb(1) = xvb(1) + yv(1)*temp387b21 + 4.d0*yv(3)*& -& temp387b20 - yvb(3) = yvb(3) + 4.d0*xv(1)*temp387b20 - zvb(2) = zvb(2) - 24.d0*xv(1)*yv(1)*temp387b20 - temp387b22 = cost2h*fun0*zb(indorbp, indt+1) - xvb(4) = xvb(4) + 5.d0*temp387b22 - xvb(2) = xvb(2) + (6.d0*yv(2)-36.d0*zv(2))*temp387b22 - yvb(2) = yvb(2) + (6.d0*xv(2)-12.d0*zv(2))*temp387b22 - yvb(4) = yvb(4) + temp387b22 - zvb(4) = zvb(4) + 8.d0*temp387b22 - zvb(2) = zvb(2) + (-(36.d0*xv(2))-12.d0*yv(2))*& -& temp387b22 - END IF - ELSE - temp387b23 = cost2h*fun0*zb(indorbp, indt+3) - temp387b24 = -(24.d0*zv(1)*temp387b23) - fun0b = fun0b + cost2h*(5.d0*yv(4)+6.d0*(xv(2)*yv(2))+xv(4& -& )+8.d0*zv(4)-12.d0*(xv(2)*zv(2))-36.d0*(yv(2)*zv(2)))*zb& -& (indorbp, indt+2) - cost2h*(24.d0*(xv(1)*yv(1)*zv(2))-& -& 4.d0*(xv(1)*yv(3))-4.d0*(xv(3)*yv(1)))*zb(indorbp, indt+& -& 1) + cost2h*(32.d0*(zv(3)*yv(1))-24.d0*(yv(1)*xv(2)*zv(1& -& ))-24.d0*(yv(3)*zv(1)))*zb(indorbp, indt+3) - zvb(3) = zvb(3) + 32.d0*yv(1)*temp387b23 - yvb(1) = yvb(1) + xv(2)*temp387b24 + 32.d0*zv(3)*& -& temp387b23 - temp387b25 = cost2h*fun0*zb(indorbp, indt+2) - xvb(2) = xvb(2) + (6.d0*yv(2)-12.d0*zv(2))*temp387b25 + yv& -& (1)*temp387b24 - zvb(1) = zvb(1) + (-(24.d0*yv(3))-24.d0*yv(1)*xv(2))*& -& temp387b23 - yvb(3) = yvb(3) - 24.d0*zv(1)*temp387b23 - yvb(4) = yvb(4) + 5.d0*temp387b25 - yvb(2) = yvb(2) + (6.d0*xv(2)-36.d0*zv(2))*temp387b25 - xvb(4) = xvb(4) + temp387b25 - zvb(4) = zvb(4) + 8.d0*temp387b25 - temp387b26 = -(cost2h*fun0*zb(indorbp, indt+1)) - zvb(2) = zvb(2) + 24.d0*xv(1)*yv(1)*temp387b26 + (-(36.d0*& -& yv(2))-12.d0*xv(2))*temp387b25 - temp387b27 = 24.d0*zv(2)*temp387b26 - xvb(1) = xvb(1) + yv(1)*temp387b27 - 4.d0*yv(3)*temp387b26 - yvb(1) = yvb(1) + xv(1)*temp387b27 - 4.d0*xv(3)*temp387b26 - yvb(3) = yvb(3) - 4.d0*xv(1)*temp387b26 - xvb(3) = xvb(3) - 4.d0*yv(1)*temp387b26 - END IF - ELSE IF (branch .LT. 5) THEN - IF (branch .LT. 4) THEN - temp387b28 = cost3h*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost3h*(4.d0*(yv(3)*zv(1))-4.d0*(yv(1)*zv(& -& 3)))*zb(indorbp, indt+2) + cost3h*(4.d0*(xv(1)*zv(3))-& -& 4.d0*(xv(3)*zv(1)))*zb(indorbp, indt+1) + cost3h*(yv(4)-& -& xv(4)+6.d0*(xv(2)*zv(2))-6.d0*(yv(2)*zv(2)))*zb(indorbp& -& , indt+3) - yvb(4) = yvb(4) + temp387b28 - xvb(4) = xvb(4) - temp387b28 - xvb(2) = xvb(2) + 6.d0*zv(2)*temp387b28 - zvb(2) = zvb(2) + (6.d0*xv(2)-6.d0*yv(2))*temp387b28 - yvb(2) = yvb(2) - 6.d0*zv(2)*temp387b28 - temp387b29 = cost3h*fun0*zb(indorbp, indt+2) - yvb(3) = yvb(3) + 4.d0*zv(1)*temp387b29 - zvb(1) = zvb(1) + 4.d0*yv(3)*temp387b29 - yvb(1) = yvb(1) - 4.d0*zv(3)*temp387b29 - temp387b30 = cost3h*fun0*zb(indorbp, indt+1) - zvb(3) = zvb(3) + 4.d0*xv(1)*temp387b30 - 4.d0*yv(1)*& -& temp387b29 - xvb(1) = xvb(1) + 4.d0*zv(3)*temp387b30 - xvb(3) = xvb(3) - 4.d0*zv(1)*temp387b30 - zvb(1) = zvb(1) - 4.d0*xv(3)*temp387b30 - ELSE - temp387b31 = -(cost3h*fun0*zb(indorbp, indt+3)) - temp387b32 = -(12.d0*zv(2)*temp387b31) - fun0b = fun0b - cost3h*(2.d0*(xv(3)*zv(1))+6.d0*(xv(1)*yv(& -& 2)*zv(1))-4.d0*(xv(1)*zv(3)))*zb(indorbp, indt+2) - & -& cost3h*(6.d0*(xv(2)*yv(1)*zv(1))+2.d0*(yv(3)*zv(1))-4.d0& -& *(yv(1)*zv(3)))*zb(indorbp, indt+1) - cost3h*(2.d0*(xv(3& -& )*yv(1))+2.d0*(xv(1)*yv(3))-12.d0*(xv(1)*yv(1)*zv(2)))*& -& zb(indorbp, indt+3) - xvb(3) = xvb(3) + 2.d0*yv(1)*temp387b31 - yvb(1) = yvb(1) + xv(1)*temp387b32 + 2.d0*xv(3)*temp387b31 - xvb(1) = xvb(1) + yv(1)*temp387b32 + 2.d0*yv(3)*temp387b31 - yvb(3) = yvb(3) + 2.d0*xv(1)*temp387b31 - zvb(2) = zvb(2) - 12.d0*xv(1)*yv(1)*temp387b31 - temp387b33 = -(cost3h*fun0*zb(indorbp, indt+2)) - temp387b34 = 6.d0*zv(1)*temp387b33 - xvb(3) = xvb(3) + 2.d0*zv(1)*temp387b33 - zvb(1) = zvb(1) + (6.d0*xv(1)*yv(2)+2.d0*xv(3))*temp387b33 - xvb(1) = xvb(1) + yv(2)*temp387b34 - 4.d0*zv(3)*temp387b33 - yvb(2) = yvb(2) + xv(1)*temp387b34 - zvb(3) = zvb(3) - 4.d0*xv(1)*temp387b33 - temp387b35 = -(cost3h*fun0*zb(indorbp, indt+1)) - temp387b36 = 6.d0*zv(1)*temp387b35 - xvb(2) = xvb(2) + yv(1)*temp387b36 - yvb(1) = yvb(1) + xv(2)*temp387b36 - 4.d0*zv(3)*temp387b35 - zvb(1) = zvb(1) + (2.d0*yv(3)+6.d0*xv(2)*yv(1))*temp387b35 - yvb(3) = yvb(3) + 2.d0*zv(1)*temp387b35 - zvb(3) = zvb(3) - 4.d0*yv(1)*temp387b35 - END IF - ELSE - temp387b37 = cost4h*fun0*zb(indorbp, indt+3) - temp387b38 = -(48.d0*zv(1)*temp387b37) - fun0b = fun0b + cost4h*(4.d0*(xv(3)*yv(1))+12.d0*(xv(1)*yv(3& -& ))-48.d0*(xv(1)*yv(1)*zv(2)))*zb(indorbp, indt+2) + cost4h& -& *(6.d0*(xv(2)*yv(2))-5.d0*xv(4)+3.d0*yv(4)+24.d0*(xv(2)*zv& -& (2))-24.d0*(yv(2)*zv(2)))*zb(indorbp, indt+1) + cost4h*(& -& 16.d0*(xv(3)*zv(1))-48.d0*(xv(1)*yv(2)*zv(1)))*zb(indorbp& -& , indt+3) - xvb(3) = xvb(3) + 16.d0*zv(1)*temp387b37 - zvb(1) = zvb(1) + (16.d0*xv(3)-48.d0*xv(1)*yv(2))*temp387b37 - xvb(1) = xvb(1) + yv(2)*temp387b38 - yvb(2) = yvb(2) + xv(1)*temp387b38 - temp387b39 = cost4h*fun0*zb(indorbp, indt+2) - temp387b40 = -(48.d0*zv(2)*temp387b39) - xvb(3) = xvb(3) + 4.d0*yv(1)*temp387b39 - yvb(1) = yvb(1) + xv(1)*temp387b40 + 4.d0*xv(3)*temp387b39 - xvb(1) = xvb(1) + yv(1)*temp387b40 + 12.d0*yv(3)*temp387b39 - yvb(3) = yvb(3) + 12.d0*xv(1)*temp387b39 - temp387b41 = cost4h*fun0*zb(indorbp, indt+1) - zvb(2) = zvb(2) + (24.d0*xv(2)-24.d0*yv(2))*temp387b41 - & -& 48.d0*xv(1)*yv(1)*temp387b39 - xvb(2) = xvb(2) + (24.d0*zv(2)+6.d0*yv(2))*temp387b41 - yvb(2) = yvb(2) + (6.d0*xv(2)-24.d0*zv(2))*temp387b41 - xvb(4) = xvb(4) - 5.d0*temp387b41 - yvb(4) = yvb(4) + 3.d0*temp387b41 - END IF - ELSE IF (branch .LT. 9) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 7) THEN - temp387b42 = -(cost4h*fun0*zb(indorbp, indt+3)) - temp387b43 = -(48.d0*zv(1)*temp387b42) - fun0b = fun0b - cost4h*(3.d0*xv(4)+6.d0*(xv(2)*yv(2))-5.d0& -& *yv(4)+24.d0*(yv(2)*zv(2))-24.d0*(xv(2)*zv(2)))*zb(& -& indorbp, indt+2) - cost4h*(12.d0*(xv(3)*yv(1))+4.d0*(xv(& -& 1)*yv(3))-48.d0*(xv(1)*yv(1)*zv(2)))*zb(indorbp, indt+1)& -& - cost4h*(16.d0*(yv(3)*zv(1))-48.d0*(xv(2)*yv(1)*zv(1)))& -& *zb(indorbp, indt+3) - yvb(3) = yvb(3) + 16.d0*zv(1)*temp387b42 - zvb(1) = zvb(1) + (16.d0*yv(3)-48.d0*xv(2)*yv(1))*& -& temp387b42 - xvb(2) = xvb(2) + yv(1)*temp387b43 - yvb(1) = yvb(1) + xv(2)*temp387b43 - temp387b44 = -(cost4h*fun0*zb(indorbp, indt+2)) - xvb(4) = xvb(4) + 3.d0*temp387b44 - xvb(2) = xvb(2) + (6.d0*yv(2)-24.d0*zv(2))*temp387b44 - yvb(2) = yvb(2) + (24.d0*zv(2)+6.d0*xv(2))*temp387b44 - yvb(4) = yvb(4) - 5.d0*temp387b44 - temp387b45 = -(cost4h*fun0*zb(indorbp, indt+1)) - zvb(2) = zvb(2) + (24.d0*yv(2)-24.d0*xv(2))*temp387b44 - & -& 48.d0*xv(1)*yv(1)*temp387b45 - temp387b46 = -(48.d0*zv(2)*temp387b45) - xvb(3) = xvb(3) + 12.d0*yv(1)*temp387b45 - yvb(1) = yvb(1) + xv(1)*temp387b46 + 12.d0*xv(3)*& -& temp387b45 - xvb(1) = xvb(1) + yv(1)*temp387b46 + 4.d0*yv(3)*temp387b45 - yvb(3) = yvb(3) + 4.d0*xv(1)*temp387b45 + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + IF (branch .LT. 1) THEN + temp313b1 = cost1d*4.d0*zb(indorbp, indt+3) + rmub(3, 0) = rmub(3, 0) + fun0*temp313b1 + temp313b2 = -(cost1d*2.d0*zb(indorbp, indt+2)) + temp313b3 = -(cost1d*2.d0*zb(indorbp, indt+1)) + fun0b = fun0b + rmu(2, 0)*temp313b2 + rmu(1, 0)*temp313b3 & +& + rmu(3, 0)*temp313b1 + rmub(2, 0) = rmub(2, 0) + fun0*temp313b2 + rmub(1, 0) = rmub(1, 0) + fun0*temp313b3 ELSE - temp387b47 = cost5h*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost5h*(4.d0*(yv(3)*zv(1))-12.d0*(xv(2)*yv& -& (1)*zv(1)))*zb(indorbp, indt+2) + cost5h*(4.d0*(xv(3)*zv& -& (1))-12.d0*(xv(1)*yv(2)*zv(1)))*zb(indorbp, indt+1) + & -& cost5h*(xv(4)-6.d0*(xv(2)*yv(2))+yv(4))*zb(indorbp, indt& -& +3) - xvb(4) = xvb(4) + temp387b47 - temp387b48 = cost5h*fun0*zb(indorbp, indt+2) - temp387b49 = -(12.d0*zv(1)*temp387b48) - xvb(2) = xvb(2) + yv(1)*temp387b49 - 6.d0*yv(2)*temp387b47 - yvb(2) = yvb(2) - 6.d0*xv(2)*temp387b47 - yvb(4) = yvb(4) + temp387b47 - yvb(3) = yvb(3) + 4.d0*zv(1)*temp387b48 - temp387b50 = cost5h*fun0*zb(indorbp, indt+1) - zvb(1) = zvb(1) + (4.d0*xv(3)-12.d0*xv(1)*yv(2))*& -& temp387b50 + (4.d0*yv(3)-12.d0*xv(2)*yv(1))*temp387b48 - yvb(1) = yvb(1) + xv(2)*temp387b49 - temp387b51 = -(12.d0*zv(1)*temp387b50) - xvb(3) = xvb(3) + 4.d0*zv(1)*temp387b50 - xvb(1) = xvb(1) + yv(2)*temp387b51 - yvb(2) = yvb(2) + xv(1)*temp387b51 + temp313b4 = -(cost2d*2.d0*zb(indorbp, indt+2)) + rmub(2, 0) = rmub(2, 0) + fun0*temp313b4 + temp313b5 = cost2d*2.d0*zb(indorbp, indt+1) + fun0b = fun0b + rmu(1, 0)*temp313b5 + rmu(2, 0)*temp313b4 + rmub(1, 0) = rmub(1, 0) + fun0*temp313b5 END IF ELSE - temp387b52 = -(cost5h*fun0*zb(indorbp, indt+3)) - fun0b = fun0b - cost5h*(12.d0*(xv(1)*yv(2)*zv(1))-4.d0*(xv(3& -& )*zv(1)))*zb(indorbp, indt+2) - cost5h*(4.d0*(yv(3)*zv(1))& -& -12.d0*(xv(2)*yv(1)*zv(1)))*zb(indorbp, indt+1) - cost5h*(& -& 4.d0*(xv(1)*yv(3))-4.d0*(xv(3)*yv(1)))*zb(indorbp, indt+3) - xvb(1) = xvb(1) + 4.d0*yv(3)*temp387b52 - yvb(3) = yvb(3) + 4.d0*xv(1)*temp387b52 - xvb(3) = xvb(3) - 4.d0*yv(1)*temp387b52 - yvb(1) = yvb(1) - 4.d0*xv(3)*temp387b52 - temp387b53 = -(cost5h*fun0*zb(indorbp, indt+2)) - temp387b54 = 12.d0*zv(1)*temp387b53 - xvb(1) = xvb(1) + yv(2)*temp387b54 - yvb(2) = yvb(2) + xv(1)*temp387b54 - temp387b55 = -(cost5h*fun0*zb(indorbp, indt+1)) - zvb(1) = zvb(1) + (4.d0*yv(3)-12.d0*xv(2)*yv(1))*temp387b55 & -& + (12.d0*xv(1)*yv(2)-4.d0*xv(3))*temp387b53 - xvb(3) = xvb(3) - 4.d0*zv(1)*temp387b53 - temp387b56 = -(12.d0*zv(1)*temp387b55) - yvb(3) = yvb(3) + 4.d0*zv(1)*temp387b55 - xvb(2) = xvb(2) + yv(1)*temp387b56 - yvb(1) = yvb(1) + xv(2)*temp387b56 + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+2) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+1) + & +& cost3d*rmu(1, 0)*zb(indorbp, indt+2) + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+1) END IF - ELSE IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - temp387b57 = cost6h*fun0*zb(indorbp, indt+2) - fun0b = fun0b + cost6h*(5.d0*xv(4)-30.d0*(xv(2)*yv(2))+5.d0*& -& yv(4))*zb(indorbp, indt+1) + cost6h*(20.d0*(xv(1)*yv(3))-& -& 20.d0*(xv(3)*yv(1)))*zb(indorbp, indt+2) - xvb(1) = xvb(1) + 20.d0*yv(3)*temp387b57 - yvb(3) = yvb(3) + 20.d0*xv(1)*temp387b57 - xvb(3) = xvb(3) - 20.d0*yv(1)*temp387b57 - yvb(1) = yvb(1) - 20.d0*xv(3)*temp387b57 - temp387b58 = cost6h*fun0*zb(indorbp, indt+1) - xvb(4) = xvb(4) + 5.d0*temp387b58 - xvb(2) = xvb(2) - 30.d0*yv(2)*temp387b58 - yvb(2) = yvb(2) - 30.d0*xv(2)*temp387b58 - yvb(4) = yvb(4) + 5.d0*temp387b58 + ELSE IF (branch .LT. 5) THEN + IF (branch .LT. 4) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+2) + & +& cost3d*rmu(2, 0)*zb(indorbp, indt+3) + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+2) END IF ELSE - temp387b59 = -(cost6h*fun0*zb(indorbp, indt+2)) - fun0b = fun0b - cost6h*(20.d0*(xv(1)*yv(3))-20.d0*(xv(3)*yv(1)& -& ))*zb(indorbp, indt+1) - cost6h*(30.d0*(xv(2)*yv(2))-5.d0*xv& -& (4)-5.d0*yv(4))*zb(indorbp, indt+2) - xvb(2) = xvb(2) + 30.d0*yv(2)*temp387b59 - yvb(2) = yvb(2) + 30.d0*xv(2)*temp387b59 - xvb(4) = xvb(4) - 5.d0*temp387b59 - yvb(4) = yvb(4) - 5.d0*temp387b59 - temp387b60 = -(cost6h*fun0*zb(indorbp, indt+1)) - xvb(1) = xvb(1) + 20.d0*yv(3)*temp387b60 - yvb(3) = yvb(3) + 20.d0*xv(1)*temp387b60 - xvb(3) = xvb(3) - 20.d0*yv(1)*temp387b60 - yvb(1) = yvb(1) - 20.d0*xv(3)*temp387b60 + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+1) + cost3d*& +& rmu(1, 0)*zb(indorbp, indt+3) + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+1) END IF DO i=3,1,-1 - temp387b10 = distp(0, 1+ic)*zb(indorbp, indt+i) + temp313b0 = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp387b10 - funb = funb + rmu(i, 0)*temp387b10 + rmub(i, 0) = rmub(i, 0) + fun*temp313b0 + funb0 = funb0 + rmu(i, 0)*temp313b0 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - CALL POPREAL8(adr8ibuf,adr8buf,r4) - r2b = r2b + 2*r2*r4b - CALL POPREAL8(adr8ibuf,adr8buf,r2) - xvb(2) = xvb(2) + r2b - yvb(2) = yvb(2) + r2b - zvb(2) = zvb(2) + r2b - DO k=5,1,-1 - CALL POPREAL8(adr8ibuf,adr8buf,xv(k)) - IF (.NOT.(rmu(1, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(1, 0) = rmub(1, 0) + k*rmu(1, 0)**(k-1)*xvb(k) - xvb(k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,yv(k)) - IF (.NOT.(rmu(2, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(2, 0) = rmub(2, 0) + k*rmu(2, 0)**(k-1)*yvb(k) - yvb(k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,zv(k)) - IF (.NOT.(rmu(3, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(3, 0) = rmub(3, 0) + k*rmu(3, 0)**(k-1)*zvb(k) - zvb(k) = 0.0_8 - END DO - temp387b9 = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp387b9 - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp387b9 - distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb + temp313b = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp313b - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp313b + distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb0 CALL POPREAL8(adr8ibuf,adr8buf,dd1) ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - zvb = 0.0_8 - xvb = 0.0_8 - yvb = 0.0_8 END IF - DO ic=11,1,-1 + DO ic=5,1,-1 DO k=indtm,i0,-1 distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) @@ -14730,944 +14158,179 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 - temp387b = -(cost6h*distpb(i, 12)) - xvb(2) = xvb(2) + 10.d0*yv(3)*temp387b - yvb(3) = yvb(3) + 10.d0*xv(2)*temp387b - xvb(4) = xvb(4) - 5.d0*yv(1)*temp387b - yvb(1) = yvb(1) - 5.d0*xv(4)*temp387b - yvb(5) = yvb(5) - temp387b - distpb(i, 12) = 0.0_8 - temp387b0 = cost6h*distpb(i, 11) - xvb(5) = xvb(5) + temp387b0 - xvb(3) = xvb(3) - 10.d0*yv(2)*temp387b0 - yvb(2) = yvb(2) - 10.d0*xv(3)*temp387b0 - xvb(1) = xvb(1) + 5.d0*yv(4)*temp387b0 - yvb(4) = yvb(4) + 5.d0*xv(1)*temp387b0 - distpb(i, 11) = 0.0_8 - temp387b1 = cost5h*4.d0*distpb(i, 10) - temp387b2 = zv(1)*temp387b1 - xvb(3) = xvb(3) + yv(1)*temp387b2 - yvb(1) = yvb(1) + xv(3)*temp387b2 - yvb(3) = yvb(3) - xv(1)*temp387b2 - xvb(1) = xvb(1) - yv(3)*temp387b2 - distpb(i, 10) = 0.0_8 - zvb(1) = zvb(1) + cost5h*(xv(4)-6.d0*(xv(2)*yv(2))+yv(4))*distpb(i& -& , 9) + (xv(3)*yv(1)-yv(3)*xv(1))*temp387b1 - temp387b3 = cost5h*zv(1)*distpb(i, 9) - xvb(4) = xvb(4) + temp387b3 - distpb(i, 9) = 0.0_8 - temp387b4 = -(cost4h*cost*distpb(i, 8)) - xvb(2) = xvb(2) - 3.d0*yv(1)*temp387b4 - 6.d0*yv(2)*temp387b3 - yvb(2) = yvb(2) - 6.d0*xv(2)*temp387b3 - yvb(4) = yvb(4) + temp387b3 - yvb(3) = yvb(3) + temp387b4 - yvb(1) = yvb(1) - 3.d0*xv(2)*temp387b4 - costb = -(cost4h*(yv(3)-3.d0*(yv(1)*xv(2)))*distpb(i, 8)) - distpb(i, 8) = 0.0_8 - temp387b5 = cost4h*cost*distpb(i, 7) - xvb(3) = xvb(3) + temp387b5 - costb = costb + cost4h*(xv(3)-3.d0*(xv(1)*yv(2)))*distpb(i, 7) - distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp387b6 = cost3h*2.d0*distpb(i, 6) - xvb(1) = xvb(1) + yv(1)*cost*temp387b6 - 3.d0*yv(2)*temp387b5 - yvb(2) = yvb(2) - 3.d0*xv(1)*temp387b5 - zvb(2) = zvb(2) + 9.d0*costb - r2b = -costb + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 - temp387b7 = cost3h*distpb(i, 5) - costb = (xv(2)-yv(2))*temp387b7 + yv(1)*xv(1)*temp387b6 - yvb(1) = yvb(1) + xv(1)*cost*temp387b6 - xvb(2) = xvb(2) + cost*temp387b7 - yvb(2) = yvb(2) - cost*temp387b7 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - zvb(3) = zvb(3) + 3.d0*costb - zvb(1) = zvb(1) - r2*costb - r2b = r2b - zv(1)*costb - rmub(2, i) = rmub(2, i) + cost2h*cost*distpb(i, 4) - costb = cost2h*rmu(2, i)*distpb(i, 4) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2h*cost*distpb(i, 3) - costb = costb + cost2h*rmu(1, i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - zvb(4) = zvb(4) + 21.d0*costb - zvb(2) = zvb(2) - 14.d0*r2*costb - temp387b8 = cost1h*distpb(i, 2) - r4b = 15.d0*zv(1)*temp387b8 + costb - r2b = r2b + 2*r2*r4b - 70.d0*zv(3)*temp387b8 - 14.d0*zv(2)*costb - zvb(5) = zvb(5) + 63.d0*temp387b8 - zvb(3) = zvb(3) - 70.d0*r2*temp387b8 - zvb(1) = zvb(1) + 15.d0*r4*temp387b8 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) distpb(i, 2) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,r4) - CALL POPREAL8(adr8ibuf,adr8buf,r2) - xvb(2) = xvb(2) + r2b - yvb(2) = yvb(2) + r2b - zvb(2) = zvb(2) + r2b - DO k=5,1,-1 - CALL POPREAL8(adr8ibuf,adr8buf,xv(k)) - IF (.NOT.(rmu(1, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(1, i) = rmub(1, i) + k*rmu(1, i)**(k-1)*xvb(k) - xvb(k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,yv(k)) - IF (.NOT.(rmu(2, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(2, i) = rmub(2, i) + k*rmu(2, i)**(k-1)*yvb(k) - yvb(k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,zv(k)) - IF (.NOT.(rmu(3, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(3, i) = rmub(3, i) + k*rmu(3, i)**(k-1)*zvb(k) - zvb(k) = 0.0_8 - END DO END DO dd1b = 0.0_8 cb = 0.0_8 DO k=indtm,indtmin,-1 - temp386 = r(k)**2 - temp386b58 = c*DEXP(-(dd1*temp386))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp386))*distpb(k, 1) - dd1b = dd1b - temp386*temp386b58 - rb(k) = rb(k) - dd1*2*r(k)*temp386b58 + temp312 = r(k)**2 + temp312b0 = c*DEXP(-(dd1*temp312))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp312))*distpb(k, 1) + dd1b = dd1b - temp312*temp312b0 + rb(k) = rb(k) - dd1*2*r(k)*temp312b0 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.79296269381073167718d0*3.25d0*dd1**2.25D0*cb + dd1b = dd1b + 1.64592278064948967213d0*1.75d0*dd1**0.75D0*cb ddb(indparp) = ddb(indparp) + dd1b - CASE (73) -! 2s gaussian for pseudo -! I-orbitals -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization obtained by Mathematica - c = dd1**3.75d0*0.43985656185609913955d0 -! C= dd1^15/4 /Sqrt[Integrate[x^14 Exp[-2 x^2],{x,0,Infinity}]] -! endif + CASE (140) +! 2p single exponential -r e^{-z r} ! der of 121 + dd2 = dd(indpar+1) DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) - END DO - DO i=indtmin,indtm - DO k=1,6 - CALL PUSHREAL8(adr8ibuf,adr8buf,zv(k)) - zv(k) = rmu(3, i)**k - CALL PUSHREAL8(adr8ibuf,adr8buf,yv(k)) - yv(k) = rmu(2, i)**k - CALL PUSHREAL8(adr8ibuf,adr8buf,xv(k)) - xv(k) = rmu(1, i)**k - END DO - CALL PUSHREAL8(adr8ibuf,adr8buf,r2) - r2 = xv(2) + yv(2) + zv(2) - CALL PUSHREAL8(adr8ibuf,adr8buf,r4) - r4 = r2*r2 - r6 = r2*r4 -! lz=0 - distp(i, 2) = cost1i*(231.d0*zv(6)-315.d0*zv(4)*r2+105.d0*zv(2)*r4& -& -5.d0*r6) - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = 33.d0*zv(5) - 30.d0*zv(3)*r2 + 5.d0*zv(1)*r4 -! lz=+/-1 - distp(i, 3) = cost2i*rmu(1, i)*cost -! lz=+/-1 - distp(i, 4) = cost2i*rmu(2, i)*cost - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = 33.d0*zv(4) - 18.d0*zv(2)*r2 + r4 -! lz=+/-2 - distp(i, 5) = cost3i*(xv(2)-yv(2))*cost -! lz=+/-2 - distp(i, 6) = 2.d0*cost3i*xv(1)*yv(1)*cost - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = 11.d0*zv(3) - 3.d0*zv(1)*r2 -! lz=+/-3 - distp(i, 7) = cost4i*(xv(3)-3.d0*xv(1)*yv(2))*cost -! lz=+/-3 - distp(i, 8) = -(cost4i*(yv(3)-3.d0*yv(1)*xv(2))*cost) - CALL PUSHREAL8(adr8ibuf,adr8buf,cost) - cost = 11.d0*zv(2) - r2 -! lz=+/-4 - distp(i, 9) = cost5i*(xv(4)-6.d0*xv(2)*yv(2)+yv(4))*cost -! lz=+/-4 - distp(i, 10) = cost5i*4.d0*(xv(3)*yv(1)-yv(3)*xv(1))*cost -! lz=+/-5 - distp(i, 11) = cost6i*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4))*& -& zv(1) -! lz=+/-5 - distp(i, 12) = -(cost6i*(-(5.d0*xv(4)*yv(1))+10.d0*xv(2)*yv(3)-yv(& -& 5))*zv(1)) -! lz=+/-6 - distp(i, 13) = cost7i*(xv(6)-15.d0*xv(4)*yv(2)+15.d0*xv(2)*yv(4)-& -& yv(6)) -! lz=+/-6 - distp(i, 14) = -(cost7i*(-(6.d0*xv(5)*yv(1))+20.d0*xv(3)*yv(3)-& -& 6.d0*yv(5)*xv(1))) + distp(k, 1) = -DEXP(-(dd2*r(k))) END DO - DO ic=1,13 +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = distp(0, 1) - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) - DO k=1,6 - CALL PUSHREAL8(adr8ibuf,adr8buf,zv(k)) - zv(k) = rmu(3, 0)**k - CALL PUSHREAL8(adr8ibuf,adr8buf,yv(k)) - yv(k) = rmu(2, 0)**k - CALL PUSHREAL8(adr8ibuf,adr8buf,xv(k)) - xv(k) = rmu(1, 0)**k - END DO -! indorbp=indorb - DO ic=1,13 + fun = distp(0, 1)*(1.d0-dd2*r(0))/r(0) + fun2 = dd2*(dd2*r(0)-2.d0)*distp(0, 1) +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - IF (ic .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) - ELSE IF (ic .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (ic .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE IF (ic .EQ. 4) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (ic .EQ. 5) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - ELSE IF (ic .EQ. 6) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE IF (ic .EQ. 7) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (ic .EQ. 8) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - ELSE IF (ic .EQ. 9) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE IF (ic .EQ. 10) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (ic .EQ. 11) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE IF (ic .EQ. 12) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE IF (ic .EQ. 13) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - END IF + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO END DO - distpb = 0.0_8 - zvb = 0.0_8 - xvb = 0.0_8 - funb = 0.0_8 - yvb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=13,1,-1 - temp388b91 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (14.d0*fun+fun2)*zb(indorbp& -& , indt+4) - funb = funb + 14.d0*temp388b91 - fun2b = fun2b + temp388b91 - zb(indorbp, indt+4) = 0.0_8 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 7) THEN - IF (branch .LT. 4) THEN - IF (branch .LT. 2) THEN - IF (branch .LT. 1) THEN - temp388b13 = cost1i*fun0*zb(indorbp, indt+3) - temp388b14 = 360.d0*zv(1)*temp388b13 - fun0b = fun0b + cost1i*(360.d0*(xv(2)*yv(1)*zv(2))-60.d0& -& *(xv(2)*yv(3))-30.d0*yv(5)-30.d0*(xv(4)*yv(1))+360.d0*& -& (yv(3)*zv(2))-240.d0*(yv(1)*zv(4)))*zb(indorbp, indt+2& -& ) + cost1i*(360.d0*(xv(3)*zv(2))-60.d0*(xv(3)*yv(2))-& -& 30.d0*(xv(1)*yv(4))-30.d0*xv(5)+360.d0*(xv(1)*yv(2)*zv& -& (2))-240.d0*(xv(1)*zv(4)))*zb(indorbp, indt+1) + & -& cost1i*(180.d0*(xv(4)*zv(1))+360.d0*(xv(2)*yv(2)*zv(1)& -& )+180.d0*(yv(4)*zv(1))+96.d0*zv(5)-480.d0*(yv(2)*zv(3)& -& )-480.d0*(xv(2)*zv(3)))*zb(indorbp, indt+3) - xvb(4) = xvb(4) + 180.d0*zv(1)*temp388b13 - zvb(1) = zvb(1) + (180.d0*yv(4)+360.d0*xv(2)*yv(2)+& -& 180.d0*xv(4))*temp388b13 - temp388b15 = cost1i*fun0*zb(indorbp, indt+2) - temp388b16 = 360.d0*zv(2)*temp388b15 - xvb(2) = xvb(2) + yv(1)*temp388b16 - 60.d0*yv(3)*& -& temp388b15 - 480.d0*zv(3)*temp388b13 + yv(2)*& -& temp388b14 - yvb(2) = yvb(2) + xv(2)*temp388b14 - 480.d0*zv(3)*& -& temp388b13 - yvb(4) = yvb(4) + 180.d0*zv(1)*temp388b13 - zvb(5) = zvb(5) + 96.d0*temp388b13 - zvb(3) = zvb(3) + (-(480.d0*xv(2))-480.d0*yv(2))*& -& temp388b13 - yvb(1) = yvb(1) + (-(240.d0*zv(4))-30.d0*xv(4))*& -& temp388b15 + xv(2)*temp388b16 - zvb(2) = zvb(2) + (360.d0*yv(3)+360.d0*xv(2)*yv(1))*& -& temp388b15 - yvb(3) = yvb(3) + (360.d0*zv(2)-60.d0*xv(2))*temp388b15 - yvb(5) = yvb(5) - 30.d0*temp388b15 - xvb(4) = xvb(4) - 30.d0*yv(1)*temp388b15 - zvb(4) = zvb(4) - 240.d0*yv(1)*temp388b15 - temp388b17 = cost1i*fun0*zb(indorbp, indt+1) - temp388b18 = 360.d0*zv(2)*temp388b17 - xvb(3) = xvb(3) + (360.d0*zv(2)-60.d0*yv(2))*temp388b17 - zvb(2) = zvb(2) + (360.d0*xv(1)*yv(2)+360.d0*xv(3))*& -& temp388b17 - yvb(2) = yvb(2) + xv(1)*temp388b18 - 60.d0*xv(3)*& -& temp388b17 - xvb(1) = xvb(1) + yv(2)*temp388b18 + (-(240.d0*zv(4))-& -& 30.d0*yv(4))*temp388b17 - yvb(4) = yvb(4) - 30.d0*xv(1)*temp388b17 - xvb(5) = xvb(5) - 30.d0*temp388b17 - zvb(4) = zvb(4) - 240.d0*xv(1)*temp388b17 - ELSE - temp388b19 = cost2i*fun0*zb(indorbp, indt+3) - temp388b20 = -(60.d0*zv(2)*temp388b19) - fun0b = fun0b + cost2i*(20.d0*(xv(3)*yv(1)*zv(1))+20.d0*& -& (xv(1)*yv(3)*zv(1))-40.d0*(xv(1)*yv(1)*zv(3)))*zb(& -& indorbp, indt+2) + cost2i*(25.d0*(xv(4)*zv(1))+30.d0*(& -& xv(2)*yv(2)*zv(1))+5.d0*(yv(4)*zv(1))+8.d0*zv(5)-20.d0& -& *(yv(2)*zv(3))-60.d0*(xv(2)*zv(3)))*zb(indorbp, indt+1& -& ) + cost2i*(5.d0*xv(5)+10.d0*(xv(3)*yv(2))+5.d0*(yv(4)& -& *xv(1))+40.d0*(xv(1)*zv(4))-60.d0*(xv(1)*yv(2)*zv(2))-& -& 60.d0*(xv(3)*zv(2)))*zb(indorbp, indt+3) - xvb(5) = xvb(5) + 5.d0*temp388b19 - xvb(3) = xvb(3) + (10.d0*yv(2)-60.d0*zv(2))*temp388b19 - yvb(2) = yvb(2) + xv(1)*temp388b20 + 10.d0*xv(3)*& -& temp388b19 - yvb(4) = yvb(4) + 5.d0*xv(1)*temp388b19 - xvb(1) = xvb(1) + yv(2)*temp388b20 + (40.d0*zv(4)+5.d0*& -& yv(4))*temp388b19 - zvb(4) = zvb(4) + 40.d0*xv(1)*temp388b19 - zvb(2) = zvb(2) + (-(60.d0*xv(3))-60.d0*xv(1)*yv(2))*& -& temp388b19 - temp388b21 = cost2i*fun0*zb(indorbp, indt+2) - temp388b22 = 20.d0*zv(1)*temp388b21 - temp388b23 = 20.d0*zv(1)*temp388b21 - temp388b24 = -(40.d0*zv(3)*temp388b21) - xvb(3) = xvb(3) + yv(1)*temp388b22 - yvb(1) = yvb(1) + xv(1)*temp388b24 + xv(3)*temp388b22 - zvb(1) = zvb(1) + (20.d0*xv(1)*yv(3)+20.d0*xv(3)*yv(1))*& -& temp388b21 - xvb(1) = xvb(1) + yv(1)*temp388b24 + yv(3)*temp388b23 - yvb(3) = yvb(3) + xv(1)*temp388b23 - zvb(3) = zvb(3) - 40.d0*xv(1)*yv(1)*temp388b21 - temp388b25 = cost2i*fun0*zb(indorbp, indt+1) - temp388b26 = 30.d0*zv(1)*temp388b25 - xvb(4) = xvb(4) + 25.d0*zv(1)*temp388b25 - zvb(1) = zvb(1) + (5.d0*yv(4)+30.d0*xv(2)*yv(2)+25.d0*xv& -& (4))*temp388b25 - xvb(2) = xvb(2) + yv(2)*temp388b26 - 60.d0*zv(3)*& -& temp388b25 - yvb(2) = yvb(2) + xv(2)*temp388b26 - 20.d0*zv(3)*& -& temp388b25 - yvb(4) = yvb(4) + 5.d0*zv(1)*temp388b25 - zvb(5) = zvb(5) + 8.d0*temp388b25 - zvb(3) = zvb(3) + (-(60.d0*xv(2))-20.d0*yv(2))*& -& temp388b25 - END IF - ELSE IF (branch .LT. 3) THEN - temp388b27 = -(cost2i*fun0*zb(indorbp, indt+3)) - temp388b28 = 60.d0*zv(2)*temp388b27 - fun0b = fun0b - cost2i*(20.d0*(xv(2)*zv(3))-30.d0*(xv(2)*& -& yv(2)*zv(1))-25.d0*(yv(4)*zv(1))-5.d0*(xv(4)*zv(1))+& -& 60.d0*(yv(2)*zv(3))-8.d0*zv(5))*zb(indorbp, indt+2) - & -& cost2i*(40.d0*(xv(1)*yv(1)*zv(3))-20.d0*(xv(1)*yv(3)*zv(& -& 1))-20.d0*(xv(3)*yv(1)*zv(1)))*zb(indorbp, indt+1) - & -& cost2i*(60.d0*(xv(2)*yv(1)*zv(2))-10.d0*(xv(2)*yv(3))-& -& 5.d0*yv(5)-5.d0*(xv(4)*yv(1))+60.d0*(yv(3)*zv(2))-40.d0*& -& (yv(1)*zv(4)))*zb(indorbp, indt+3) - xvb(2) = xvb(2) + yv(1)*temp388b28 - 10.d0*yv(3)*& -& temp388b27 - yvb(1) = yvb(1) + (-(40.d0*zv(4))-5.d0*xv(4))*temp388b27 +& -& xv(2)*temp388b28 - zvb(2) = zvb(2) + (60.d0*yv(3)+60.d0*xv(2)*yv(1))*& -& temp388b27 - yvb(3) = yvb(3) + (60.d0*zv(2)-10.d0*xv(2))*temp388b27 - yvb(5) = yvb(5) - 5.d0*temp388b27 - xvb(4) = xvb(4) - 5.d0*yv(1)*temp388b27 - zvb(4) = zvb(4) - 40.d0*yv(1)*temp388b27 - temp388b29 = -(cost2i*fun0*zb(indorbp, indt+2)) - temp388b30 = -(30.d0*zv(1)*temp388b29) - xvb(2) = xvb(2) + yv(2)*temp388b30 + 20.d0*zv(3)*& -& temp388b29 - zvb(3) = zvb(3) + (60.d0*yv(2)+20.d0*xv(2))*temp388b29 - yvb(2) = yvb(2) + 60.d0*zv(3)*temp388b29 + xv(2)*& -& temp388b30 - zvb(1) = zvb(1) + (-(5.d0*xv(4))-25.d0*yv(4)-30.d0*xv(2)*& -& yv(2))*temp388b29 - yvb(4) = yvb(4) - 25.d0*zv(1)*temp388b29 - xvb(4) = xvb(4) - 5.d0*zv(1)*temp388b29 - zvb(5) = zvb(5) - 8.d0*temp388b29 - temp388b31 = -(cost2i*fun0*zb(indorbp, indt+1)) - temp388b32 = 40.d0*zv(3)*temp388b31 - temp388b33 = -(20.d0*zv(1)*temp388b31) - temp388b34 = -(20.d0*zv(1)*temp388b31) - xvb(1) = xvb(1) + yv(3)*temp388b33 + yv(1)*temp388b32 - yvb(1) = yvb(1) + xv(3)*temp388b34 + xv(1)*temp388b32 - zvb(3) = zvb(3) + 40.d0*xv(1)*yv(1)*temp388b31 - yvb(3) = yvb(3) + xv(1)*temp388b33 - zvb(1) = zvb(1) + (-(20.d0*xv(3)*yv(1))-20.d0*xv(1)*yv(3))& -& *temp388b31 - xvb(3) = xvb(3) + yv(1)*temp388b34 - ELSE - temp388b35 = cost3i*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost3i*(2.d0*(xv(4)*yv(1))-4.d0*(xv(2)*yv(& -& 3))-6.d0*yv(5)+64.d0*(yv(3)*zv(2))-32.d0*(yv(1)*zv(4)))*& -& zb(indorbp, indt+2) + cost3i*(6.d0*xv(5)+4.d0*(xv(3)*yv(& -& 2))-2.d0*(xv(1)*yv(4))+32.d0*(xv(1)*zv(4))-64.d0*(xv(3)*& -& zv(2)))*zb(indorbp, indt+1) + cost3i*(32.d0*(yv(4)*zv(1)& -& )-32.d0*(xv(4)*zv(1))+64.d0*(xv(2)*zv(3))-64.d0*(yv(2)*& -& zv(3)))*zb(indorbp, indt+3) - yvb(4) = yvb(4) + 32.d0*zv(1)*temp388b35 - zvb(1) = zvb(1) + (32.d0*yv(4)-32.d0*xv(4))*temp388b35 - xvb(4) = xvb(4) - 32.d0*zv(1)*temp388b35 - xvb(2) = xvb(2) + 64.d0*zv(3)*temp388b35 - zvb(3) = zvb(3) + (64.d0*xv(2)-64.d0*yv(2))*temp388b35 - yvb(2) = yvb(2) - 64.d0*zv(3)*temp388b35 - temp388b36 = cost3i*fun0*zb(indorbp, indt+2) - xvb(4) = xvb(4) + 2.d0*yv(1)*temp388b36 - yvb(1) = yvb(1) + (2.d0*xv(4)-32.d0*zv(4))*temp388b36 - xvb(2) = xvb(2) - 4.d0*yv(3)*temp388b36 - yvb(3) = yvb(3) + (64.d0*zv(2)-4.d0*xv(2))*temp388b36 - yvb(5) = yvb(5) - 6.d0*temp388b36 - zvb(2) = zvb(2) + 64.d0*yv(3)*temp388b36 - temp388b37 = cost3i*fun0*zb(indorbp, indt+1) - zvb(4) = zvb(4) + 32.d0*xv(1)*temp388b37 - 32.d0*yv(1)*& -& temp388b36 - xvb(5) = xvb(5) + 6.d0*temp388b37 - xvb(3) = xvb(3) + (4.d0*yv(2)-64.d0*zv(2))*temp388b37 - yvb(2) = yvb(2) + 4.d0*xv(3)*temp388b37 - xvb(1) = xvb(1) + (32.d0*zv(4)-2.d0*yv(4))*temp388b37 - yvb(4) = yvb(4) - 2.d0*xv(1)*temp388b37 - zvb(2) = zvb(2) - 64.d0*xv(3)*temp388b37 - END IF - ELSE IF (branch .LT. 6) THEN - IF (branch .LT. 5) THEN - temp388b38 = -(cost3i*fun0*zb(indorbp, indt+3)) - temp388b39 = 64.d0*zv(1)*temp388b38 - temp388b40 = 64.d0*zv(1)*temp388b38 - temp388b41 = -(128.d0*zv(3)*temp388b38) - fun0b = fun0b - cost3i*(32.d0*(xv(3)*zv(2))-12.d0*(xv(3)*& -& yv(2))-10.d0*(xv(1)*yv(4))-2.d0*xv(5)+96.d0*(xv(1)*yv(2)& -& *zv(2))-32.d0*(xv(1)*zv(4)))*zb(indorbp, indt+2) - & -& cost3i*(96.d0*(xv(2)*yv(1)*zv(2))-12.d0*(xv(2)*yv(3))-& -& 2.d0*yv(5)-10.d0*(xv(4)*yv(1))+32.d0*(yv(3)*zv(2))-32.d0& -& *(yv(1)*zv(4)))*zb(indorbp, indt+1) - cost3i*(64.d0*(xv(& -& 3)*yv(1)*zv(1))+64.d0*(xv(1)*yv(3)*zv(1))-128.d0*(xv(1)*& -& yv(1)*zv(3)))*zb(indorbp, indt+3) - xvb(3) = xvb(3) + yv(1)*temp388b39 - yvb(1) = yvb(1) + xv(1)*temp388b41 + xv(3)*temp388b39 - zvb(1) = zvb(1) + (64.d0*xv(1)*yv(3)+64.d0*xv(3)*yv(1))*& -& temp388b38 - xvb(1) = xvb(1) + yv(1)*temp388b41 + yv(3)*temp388b40 - yvb(3) = yvb(3) + xv(1)*temp388b40 - zvb(3) = zvb(3) - 128.d0*xv(1)*yv(1)*temp388b38 - temp388b42 = -(cost3i*fun0*zb(indorbp, indt+2)) - temp388b43 = 96.d0*zv(2)*temp388b42 - xvb(3) = xvb(3) + (32.d0*zv(2)-12.d0*yv(2))*temp388b42 - zvb(2) = zvb(2) + (96.d0*xv(1)*yv(2)+32.d0*xv(3))*& -& temp388b42 - yvb(2) = yvb(2) + xv(1)*temp388b43 - 12.d0*xv(3)*& -& temp388b42 - xvb(1) = xvb(1) + yv(2)*temp388b43 + (-(32.d0*zv(4))-10.d0& -& *yv(4))*temp388b42 - yvb(4) = yvb(4) - 10.d0*xv(1)*temp388b42 - xvb(5) = xvb(5) - 2.d0*temp388b42 - zvb(4) = zvb(4) - 32.d0*xv(1)*temp388b42 - temp388b44 = -(cost3i*fun0*zb(indorbp, indt+1)) - temp388b45 = 96.d0*zv(2)*temp388b44 - xvb(2) = xvb(2) + yv(1)*temp388b45 - 12.d0*yv(3)*& -& temp388b44 - yvb(1) = yvb(1) + (-(32.d0*zv(4))-10.d0*xv(4))*temp388b44 & -& + xv(2)*temp388b45 - zvb(2) = zvb(2) + (32.d0*yv(3)+96.d0*xv(2)*yv(1))*& -& temp388b44 - yvb(3) = yvb(3) + (32.d0*zv(2)-12.d0*xv(2))*temp388b44 - yvb(5) = yvb(5) - 2.d0*temp388b44 - xvb(4) = xvb(4) - 10.d0*yv(1)*temp388b44 - zvb(4) = zvb(4) - 32.d0*yv(1)*temp388b44 - ELSE - temp388b46 = cost4i*fun0*zb(indorbp, indt+3) - temp388b47 = -(72.d0*zv(2)*temp388b46) - fun0b = fun0b + cost4i*(12.d0*(xv(3)*yv(1)*zv(1))+36.d0*(& -& xv(1)*yv(3)*zv(1))-48.d0*(xv(1)*yv(1)*zv(3)))*zb(indorbp& -& , indt+2) + cost4i*(18.d0*(xv(2)*yv(2)*zv(1))-15.d0*(xv(& -& 4)*zv(1))+9.d0*(yv(4)*zv(1))+24.d0*(xv(2)*zv(3))-24.d0*(& -& yv(2)*zv(3)))*zb(indorbp, indt+1) + cost4i*(6.d0*(xv(3)*& -& yv(2))-3.d0*xv(5)+9.d0*(xv(1)*yv(4))+24.d0*(xv(3)*zv(2))& -& -72.d0*(xv(1)*yv(2)*zv(2)))*zb(indorbp, indt+3) - xvb(3) = xvb(3) + (24.d0*zv(2)+6.d0*yv(2))*temp388b46 - yvb(2) = yvb(2) + xv(1)*temp388b47 + 6.d0*xv(3)*temp388b46 - xvb(5) = xvb(5) - 3.d0*temp388b46 - xvb(1) = xvb(1) + yv(2)*temp388b47 + 9.d0*yv(4)*temp388b46 - yvb(4) = yvb(4) + 9.d0*xv(1)*temp388b46 - zvb(2) = zvb(2) + (24.d0*xv(3)-72.d0*xv(1)*yv(2))*& -& temp388b46 - temp388b48 = cost4i*fun0*zb(indorbp, indt+2) - temp388b49 = 12.d0*zv(1)*temp388b48 - temp388b50 = 36.d0*zv(1)*temp388b48 - temp388b51 = -(48.d0*zv(3)*temp388b48) - xvb(3) = xvb(3) + yv(1)*temp388b49 - yvb(1) = yvb(1) + xv(1)*temp388b51 + xv(3)*temp388b49 - zvb(1) = zvb(1) + (36.d0*xv(1)*yv(3)+12.d0*xv(3)*yv(1))*& -& temp388b48 - xvb(1) = xvb(1) + yv(1)*temp388b51 + yv(3)*temp388b50 - yvb(3) = yvb(3) + xv(1)*temp388b50 - zvb(3) = zvb(3) - 48.d0*xv(1)*yv(1)*temp388b48 - temp388b52 = cost4i*fun0*zb(indorbp, indt+1) - temp388b53 = 18.d0*zv(1)*temp388b52 - xvb(2) = xvb(2) + 24.d0*zv(3)*temp388b52 + yv(2)*& -& temp388b53 - yvb(2) = yvb(2) + xv(2)*temp388b53 - 24.d0*zv(3)*& -& temp388b52 - zvb(1) = zvb(1) + (9.d0*yv(4)-15.d0*xv(4)+18.d0*xv(2)*yv(2& -& ))*temp388b52 - xvb(4) = xvb(4) - 15.d0*zv(1)*temp388b52 - yvb(4) = yvb(4) + 9.d0*zv(1)*temp388b52 - zvb(3) = zvb(3) + (24.d0*xv(2)-24.d0*yv(2))*temp388b52 - END IF - ELSE - temp388b54 = -(cost4i*fun0*zb(indorbp, indt+3)) - temp388b55 = -(72.d0*zv(2)*temp388b54) - fun0b = fun0b - cost4i*(9.d0*(xv(4)*zv(1))+18.d0*(xv(2)*yv(2& -& )*zv(1))-15.d0*(yv(4)*zv(1))+24.d0*(yv(2)*zv(3))-24.d0*(xv& -& (2)*zv(3)))*zb(indorbp, indt+2) - cost4i*(36.d0*(xv(3)*yv(& -& 1)*zv(1))+12.d0*(xv(1)*yv(3)*zv(1))-48.d0*(xv(1)*yv(1)*zv(& -& 3)))*zb(indorbp, indt+1) - cost4i*(9.d0*(xv(4)*yv(1))+6.d0& -& *(xv(2)*yv(3))-3.d0*yv(5)+24.d0*(yv(3)*zv(2))-72.d0*(xv(2)& -& *yv(1)*zv(2)))*zb(indorbp, indt+3) - xvb(4) = xvb(4) + 9.d0*yv(1)*temp388b54 - yvb(1) = yvb(1) + xv(2)*temp388b55 + 9.d0*xv(4)*temp388b54 - xvb(2) = xvb(2) + yv(1)*temp388b55 + 6.d0*yv(3)*temp388b54 - yvb(3) = yvb(3) + (24.d0*zv(2)+6.d0*xv(2))*temp388b54 - yvb(5) = yvb(5) - 3.d0*temp388b54 - zvb(2) = zvb(2) + (24.d0*yv(3)-72.d0*xv(2)*yv(1))*temp388b54 - temp388b56 = -(cost4i*fun0*zb(indorbp, indt+2)) - temp388b57 = 18.d0*zv(1)*temp388b56 - xvb(4) = xvb(4) + 9.d0*zv(1)*temp388b56 - zvb(1) = zvb(1) + (18.d0*xv(2)*yv(2)-15.d0*yv(4)+9.d0*xv(4))& -& *temp388b56 - xvb(2) = xvb(2) + yv(2)*temp388b57 - 24.d0*zv(3)*temp388b56 - yvb(2) = yvb(2) + 24.d0*zv(3)*temp388b56 + xv(2)*temp388b57 - yvb(4) = yvb(4) - 15.d0*zv(1)*temp388b56 - zvb(3) = zvb(3) + (24.d0*yv(2)-24.d0*xv(2))*temp388b56 - temp388b58 = -(cost4i*fun0*zb(indorbp, indt+1)) - temp388b59 = 36.d0*zv(1)*temp388b58 - temp388b60 = 12.d0*zv(1)*temp388b58 - temp388b61 = -(48.d0*zv(3)*temp388b58) - xvb(3) = xvb(3) + yv(1)*temp388b59 - yvb(1) = yvb(1) + xv(1)*temp388b61 + xv(3)*temp388b59 - zvb(1) = zvb(1) + (12.d0*xv(1)*yv(3)+36.d0*xv(3)*yv(1))*& -& temp388b58 - xvb(1) = xvb(1) + yv(1)*temp388b61 + yv(3)*temp388b60 - yvb(3) = yvb(3) + xv(1)*temp388b60 - zvb(3) = zvb(3) - 48.d0*xv(1)*yv(1)*temp388b58 - END IF - ELSE IF (branch .LT. 11) THEN - IF (branch .LT. 9) THEN - IF (branch .LT. 8) THEN - temp388b62 = cost5i*fun0*zb(indorbp, indt+3) - temp388b63 = -(120.d0*zv(1)*temp388b62) - fun0b = fun0b + cost5i*(10.d0*(xv(4)*yv(1))+20.d0*(xv(2)*& -& yv(3))-6.d0*yv(5)+40.d0*(yv(3)*zv(2))-120.d0*(xv(2)*yv(1& -& )*zv(2)))*zb(indorbp, indt+2) + cost5i*(20.d0*(xv(3)*yv(& -& 2))-6.d0*xv(5)+10.d0*(xv(1)*yv(4))+40.d0*(xv(3)*zv(2))-& -& 120.d0*(xv(1)*yv(2)*zv(2)))*zb(indorbp, indt+1) + cost5i& -& *(20.d0*(xv(4)*zv(1))-120.d0*(xv(2)*yv(2)*zv(1))+20.d0*(& -& yv(4)*zv(1)))*zb(indorbp, indt+3) - xvb(4) = xvb(4) + 20.d0*zv(1)*temp388b62 - zvb(1) = zvb(1) + (20.d0*yv(4)-120.d0*xv(2)*yv(2)+20.d0*xv& -& (4))*temp388b62 - xvb(2) = xvb(2) + yv(2)*temp388b63 - yvb(2) = yvb(2) + xv(2)*temp388b63 - yvb(4) = yvb(4) + 20.d0*zv(1)*temp388b62 - temp388b64 = cost5i*fun0*zb(indorbp, indt+2) - temp388b65 = -(120.d0*zv(2)*temp388b64) - xvb(4) = xvb(4) + 10.d0*yv(1)*temp388b64 - yvb(1) = yvb(1) + xv(2)*temp388b65 + 10.d0*xv(4)*& -& temp388b64 - xvb(2) = xvb(2) + yv(1)*temp388b65 + 20.d0*yv(3)*& -& temp388b64 - yvb(3) = yvb(3) + (40.d0*zv(2)+20.d0*xv(2))*temp388b64 - yvb(5) = yvb(5) - 6.d0*temp388b64 - temp388b66 = cost5i*fun0*zb(indorbp, indt+1) - zvb(2) = zvb(2) + (40.d0*xv(3)-120.d0*xv(1)*yv(2))*& -& temp388b66 + (40.d0*yv(3)-120.d0*xv(2)*yv(1))*temp388b64 - temp388b67 = -(120.d0*zv(2)*temp388b66) - xvb(3) = xvb(3) + (40.d0*zv(2)+20.d0*yv(2))*temp388b66 - yvb(2) = yvb(2) + xv(1)*temp388b67 + 20.d0*xv(3)*& -& temp388b66 - xvb(5) = xvb(5) - 6.d0*temp388b66 - xvb(1) = xvb(1) + yv(2)*temp388b67 + 10.d0*yv(4)*& -& temp388b66 - yvb(4) = yvb(4) + 10.d0*xv(1)*temp388b66 - ELSE - temp388b68 = -(cost5i*fun0*zb(indorbp, indt+3)) - temp388b69 = 80.d0*zv(1)*temp388b68 - temp388b70 = -(80.d0*zv(1)*temp388b68) - fun0b = fun0b - cost5i*(4.d0*xv(5)-20.d0*(xv(1)*yv(4))+& -& 120.d0*(xv(1)*yv(2)*zv(2))-40.d0*(xv(3)*zv(2)))*zb(& -& indorbp, indt+2) - cost5i*(20.d0*(xv(4)*yv(1))-4.d0*yv(5& -& )+40.d0*(yv(3)*zv(2))-120.d0*(xv(2)*yv(1)*zv(2)))*zb(& -& indorbp, indt+1) - cost5i*(80.d0*(xv(1)*yv(3)*zv(1))-& -& 80.d0*(xv(3)*yv(1)*zv(1)))*zb(indorbp, indt+3) - xvb(1) = xvb(1) + yv(3)*temp388b69 - yvb(3) = yvb(3) + xv(1)*temp388b69 - zvb(1) = zvb(1) + (80.d0*xv(1)*yv(3)-80.d0*xv(3)*yv(1))*& -& temp388b68 - xvb(3) = xvb(3) + yv(1)*temp388b70 - yvb(1) = yvb(1) + xv(3)*temp388b70 - temp388b71 = -(cost5i*fun0*zb(indorbp, indt+2)) - temp388b72 = 120.d0*zv(2)*temp388b71 - xvb(5) = xvb(5) + 4.d0*temp388b71 - xvb(1) = xvb(1) + yv(2)*temp388b72 - 20.d0*yv(4)*& -& temp388b71 - yvb(4) = yvb(4) - 20.d0*xv(1)*temp388b71 - yvb(2) = yvb(2) + xv(1)*temp388b72 - temp388b73 = -(cost5i*fun0*zb(indorbp, indt+1)) - zvb(2) = zvb(2) + (40.d0*yv(3)-120.d0*xv(2)*yv(1))*& -& temp388b73 + (120.d0*xv(1)*yv(2)-40.d0*xv(3))*temp388b71 - xvb(3) = xvb(3) - 40.d0*zv(2)*temp388b71 - temp388b74 = -(120.d0*zv(2)*temp388b73) - xvb(4) = xvb(4) + 20.d0*yv(1)*temp388b73 - yvb(1) = yvb(1) + xv(2)*temp388b74 + 20.d0*xv(4)*& -& temp388b73 - yvb(5) = yvb(5) - 4.d0*temp388b73 - yvb(3) = yvb(3) + 40.d0*zv(2)*temp388b73 - xvb(2) = xvb(2) + yv(1)*temp388b74 - END IF - ELSE IF (branch .LT. 10) THEN - temp388b75 = cost6i*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost6i*(20.d0*(xv(1)*yv(3)*zv(1))-20.d0*(xv(& -& 3)*yv(1)*zv(1)))*zb(indorbp, indt+2) + cost6i*(5.d0*(xv(4)& -& *zv(1))-30.d0*(xv(2)*yv(2)*zv(1))+5.d0*(yv(4)*zv(1)))*zb(& -& indorbp, indt+1) + cost6i*(xv(5)-10.d0*(xv(3)*yv(2))+5.d0*& -& (xv(1)*yv(4)))*zb(indorbp, indt+3) - xvb(5) = xvb(5) + temp388b75 - xvb(3) = xvb(3) - 10.d0*yv(2)*temp388b75 - yvb(2) = yvb(2) - 10.d0*xv(3)*temp388b75 - temp388b76 = cost6i*fun0*zb(indorbp, indt+2) - temp388b77 = 20.d0*zv(1)*temp388b76 - xvb(1) = xvb(1) + yv(3)*temp388b77 + 5.d0*yv(4)*temp388b75 - yvb(4) = yvb(4) + 5.d0*xv(1)*temp388b75 - temp388b78 = -(20.d0*zv(1)*temp388b76) - yvb(3) = yvb(3) + xv(1)*temp388b77 - temp388b79 = cost6i*fun0*zb(indorbp, indt+1) - zvb(1) = zvb(1) + (5.d0*yv(4)-30.d0*xv(2)*yv(2)+5.d0*xv(4))*& -& temp388b79 + (20.d0*xv(1)*yv(3)-20.d0*xv(3)*yv(1))*& -& temp388b76 - xvb(3) = xvb(3) + yv(1)*temp388b78 - yvb(1) = yvb(1) + xv(3)*temp388b78 - temp388b80 = -(30.d0*zv(1)*temp388b79) - xvb(4) = xvb(4) + 5.d0*zv(1)*temp388b79 - xvb(2) = xvb(2) + yv(2)*temp388b80 - yvb(2) = yvb(2) + xv(2)*temp388b80 - yvb(4) = yvb(4) + 5.d0*zv(1)*temp388b79 - ELSE - temp388b81 = -(cost6i*fun0*zb(indorbp, indt+3)) - fun0b = fun0b - cost6i*(30.d0*(xv(2)*yv(2)*zv(1))-5.d0*(xv(4& -& )*zv(1))-5.d0*(yv(4)*zv(1)))*zb(indorbp, indt+2) - cost6i*& -& (20.d0*(xv(1)*yv(3)*zv(1))-20.d0*(xv(3)*yv(1)*zv(1)))*zb(& -& indorbp, indt+1) - cost6i*(10.d0*(xv(2)*yv(3))-5.d0*(xv(4)& -& *yv(1))-yv(5))*zb(indorbp, indt+3) - xvb(2) = xvb(2) + 10.d0*yv(3)*temp388b81 - yvb(3) = yvb(3) + 10.d0*xv(2)*temp388b81 - xvb(4) = xvb(4) - 5.d0*yv(1)*temp388b81 - yvb(1) = yvb(1) - 5.d0*xv(4)*temp388b81 - yvb(5) = yvb(5) - temp388b81 - temp388b82 = -(cost6i*fun0*zb(indorbp, indt+2)) - temp388b83 = 30.d0*zv(1)*temp388b82 - xvb(2) = xvb(2) + yv(2)*temp388b83 - yvb(2) = yvb(2) + xv(2)*temp388b83 - temp388b84 = -(cost6i*fun0*zb(indorbp, indt+1)) - zvb(1) = zvb(1) + (20.d0*xv(1)*yv(3)-20.d0*xv(3)*yv(1))*& -& temp388b84 + (30.d0*xv(2)*yv(2)-5.d0*xv(4)-5.d0*yv(4))*& -& temp388b82 - xvb(4) = xvb(4) - 5.d0*zv(1)*temp388b82 - yvb(4) = yvb(4) - 5.d0*zv(1)*temp388b82 - temp388b85 = 20.d0*zv(1)*temp388b84 - temp388b86 = -(20.d0*zv(1)*temp388b84) - xvb(1) = xvb(1) + yv(3)*temp388b85 - yvb(3) = yvb(3) + xv(1)*temp388b85 - xvb(3) = xvb(3) + yv(1)*temp388b86 - yvb(1) = yvb(1) + xv(3)*temp388b86 - END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 12) THEN - temp388b87 = cost7i*fun0*zb(indorbp, indt+2) - fun0b = fun0b + cost7i*(6.d0*xv(5)-60.d0*(xv(3)*yv(2))+30.d0& -& *(xv(1)*yv(4)))*zb(indorbp, indt+1) + cost7i*(60.d0*(xv(2)& -& *yv(3))-30.d0*(xv(4)*yv(1))-6.d0*yv(5))*zb(indorbp, indt+2& -& ) - xvb(2) = xvb(2) + 60.d0*yv(3)*temp388b87 - yvb(3) = yvb(3) + 60.d0*xv(2)*temp388b87 - xvb(4) = xvb(4) - 30.d0*yv(1)*temp388b87 - yvb(1) = yvb(1) - 30.d0*xv(4)*temp388b87 - yvb(5) = yvb(5) - 6.d0*temp388b87 - temp388b88 = cost7i*fun0*zb(indorbp, indt+1) - xvb(5) = xvb(5) + 6.d0*temp388b88 - xvb(3) = xvb(3) - 60.d0*yv(2)*temp388b88 - yvb(2) = yvb(2) - 60.d0*xv(3)*temp388b88 - xvb(1) = xvb(1) + 30.d0*yv(4)*temp388b88 - yvb(4) = yvb(4) + 30.d0*xv(1)*temp388b88 - END IF - ELSE - temp388b89 = -(cost7i*fun0*zb(indorbp, indt+2)) - fun0b = fun0b - cost7i*(60.d0*(xv(2)*yv(3))-30.d0*(xv(4)*yv(1)& -& )-6.d0*yv(5))*zb(indorbp, indt+1) - cost7i*(60.d0*(xv(3)*yv(& -& 2))-6.d0*xv(5)-30.d0*(xv(1)*yv(4)))*zb(indorbp, indt+2) - xvb(3) = xvb(3) + 60.d0*yv(2)*temp388b89 - yvb(2) = yvb(2) + 60.d0*xv(3)*temp388b89 - xvb(5) = xvb(5) - 6.d0*temp388b89 - xvb(1) = xvb(1) - 30.d0*yv(4)*temp388b89 - yvb(4) = yvb(4) - 30.d0*xv(1)*temp388b89 - temp388b90 = -(cost7i*fun0*zb(indorbp, indt+1)) - xvb(2) = xvb(2) + 60.d0*yv(3)*temp388b90 - yvb(3) = yvb(3) + 60.d0*xv(2)*temp388b90 - xvb(4) = xvb(4) - 30.d0*yv(1)*temp388b90 - yvb(1) = yvb(1) - 30.d0*xv(4)*temp388b90 - yvb(5) = yvb(5) - 6.d0*temp388b90 - END IF + DO ic=3,1,-1 + temp314b2 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp314b2 + fun2b = fun2b + temp314b2 + zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - temp388b12 = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp388b12 - funb = funb + rmu(i, 0)*temp388b12 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp314b1 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp314b1 + funb0 = funb0 + rmu(ic, 0)*temp314b1 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO k=6,1,-1 - CALL POPREAL8(adr8ibuf,adr8buf,xv(k)) - IF (.NOT.(rmu(1, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(1, 0) = rmub(1, 0) + k*rmu(1, 0)**(k-1)*xvb(k) - xvb(k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,yv(k)) - IF (.NOT.(rmu(2, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(2, 0) = rmub(2, 0) + k*rmu(2, 0)**(k-1)*yvb(k) - yvb(k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,zv(k)) - IF (.NOT.(rmu(3, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(3, 0) = rmub(3, 0) + k*rmu(3, 0)**(k-1)*zvb(k) - zvb(k) = 0.0_8 - END DO - temp388b11 = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp388b11 - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp388b11 - distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + distpb = 0.0_8 + temp314b = dd2*distp(0, 1)*fun2b + temp314b0 = (dd2*r(0)-2.d0)*fun2b + temp313 = distp(0, 1)/r(0) + dd2b = distp(0, 1)*temp314b0 - temp313*r(0)*funb0 + r(0)*temp314b + temp313b9 = (1.d0-dd2*r(0))*funb0/r(0) + rb(0) = rb(0) + distp(0, 1)*fun0b - temp313*dd2*funb0 - temp313*& +& temp313b9 + dd2*temp314b + distpb(0, 1) = temp313b9 + r(0)*fun0b + dd2*temp314b0 ELSE distpb = 0.0_8 - zvb = 0.0_8 - xvb = 0.0_8 - yvb = 0.0_8 + dd2b = 0.0_8 END IF - DO ic=13,1,-1 - DO k=indtm,i0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) - zb(indorbp, k) = 0.0_8 + DO ic=3,1,-1 + DO i=indtm,i0,-1 + temp313b8 = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*r(i)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + r(i)*temp313b8 + rb(i) = rb(i) + distp(i, 1)*temp313b8 + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=indtm,indtmin,-1 - temp388b = -(cost7i*distpb(i, 14)) - xvb(3) = xvb(3) + 20.d0*yv(3)*temp388b - yvb(3) = yvb(3) + 20.d0*xv(3)*temp388b - xvb(5) = xvb(5) - 6.d0*yv(1)*temp388b - yvb(1) = yvb(1) - 6.d0*xv(5)*temp388b - yvb(5) = yvb(5) - 6.d0*xv(1)*temp388b - xvb(1) = xvb(1) - 6.d0*yv(5)*temp388b - distpb(i, 14) = 0.0_8 - temp388b0 = cost7i*distpb(i, 13) - xvb(6) = xvb(6) + temp388b0 - xvb(4) = xvb(4) - 15.d0*yv(2)*temp388b0 - yvb(2) = yvb(2) - 15.d0*xv(4)*temp388b0 - distpb(i, 13) = 0.0_8 - temp388b1 = -(cost6i*zv(1)*distpb(i, 12)) - xvb(2) = xvb(2) + 10.d0*yv(3)*temp388b1 + 15.d0*yv(4)*temp388b0 - yvb(4) = yvb(4) + 15.d0*xv(2)*temp388b0 - yvb(6) = yvb(6) - temp388b0 - yvb(3) = yvb(3) + 10.d0*xv(2)*temp388b1 - xvb(4) = xvb(4) - 5.d0*yv(1)*temp388b1 - yvb(1) = yvb(1) - 5.d0*xv(4)*temp388b1 - yvb(5) = yvb(5) - temp388b1 - zvb(1) = zvb(1) - cost6i*(10.d0*(xv(2)*yv(3))-5.d0*(xv(4)*yv(1))-& -& yv(5))*distpb(i, 12) - distpb(i, 12) = 0.0_8 - temp388b2 = cost6i*zv(1)*distpb(i, 11) - xvb(5) = xvb(5) + temp388b2 - xvb(3) = xvb(3) - 10.d0*yv(2)*temp388b2 - yvb(2) = yvb(2) - 10.d0*xv(3)*temp388b2 - xvb(1) = xvb(1) + 5.d0*yv(4)*temp388b2 - yvb(4) = yvb(4) + 5.d0*xv(1)*temp388b2 - zvb(1) = zvb(1) + cost6i*(xv(5)-10.d0*(xv(3)*yv(2))+5.d0*(xv(1)*yv& -& (4)))*distpb(i, 11) - distpb(i, 11) = 0.0_8 - temp388b3 = cost5i*4.d0*distpb(i, 10) - temp388b4 = cost*temp388b3 - xvb(3) = xvb(3) + yv(1)*temp388b4 - yvb(1) = yvb(1) + xv(3)*temp388b4 - yvb(3) = yvb(3) - xv(1)*temp388b4 - xvb(1) = xvb(1) - yv(3)*temp388b4 - distpb(i, 10) = 0.0_8 - costb = cost5i*(xv(4)-6.d0*(xv(2)*yv(2))+yv(4))*distpb(i, 9) + (xv& -& (3)*yv(1)-yv(3)*xv(1))*temp388b3 - temp388b5 = cost5i*cost*distpb(i, 9) - xvb(4) = xvb(4) + temp388b5 - distpb(i, 9) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp388b6 = -(cost4i*cost*distpb(i, 8)) - xvb(2) = xvb(2) - 3.d0*yv(1)*temp388b6 - 6.d0*yv(2)*temp388b5 - yvb(2) = yvb(2) - 6.d0*xv(2)*temp388b5 - yvb(4) = yvb(4) + temp388b5 - zvb(2) = zvb(2) + 11.d0*costb - r2b = -costb - yvb(3) = yvb(3) + temp388b6 - yvb(1) = yvb(1) - 3.d0*xv(2)*temp388b6 - costb = -(cost4i*(yv(3)-3.d0*(yv(1)*xv(2)))*distpb(i, 8)) - distpb(i, 8) = 0.0_8 - temp388b7 = cost4i*cost*distpb(i, 7) - xvb(3) = xvb(3) + temp388b7 - costb = costb + cost4i*(xv(3)-3.d0*(xv(1)*yv(2)))*distpb(i, 7) - distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - temp388b8 = cost3i*2.d0*distpb(i, 6) - xvb(1) = xvb(1) + yv(1)*cost*temp388b8 - 3.d0*yv(2)*temp388b7 - yvb(2) = yvb(2) - 3.d0*xv(1)*temp388b7 - zvb(3) = zvb(3) + 11.d0*costb - zvb(1) = zvb(1) - 3.d0*r2*costb - r2b = r2b - 3.d0*zv(1)*costb - distpb(i, 6) = 0.0_8 - temp388b9 = cost3i*distpb(i, 5) - costb = (xv(2)-yv(2))*temp388b9 + yv(1)*xv(1)*temp388b8 - yvb(1) = yvb(1) + xv(1)*cost*temp388b8 - xvb(2) = xvb(2) + cost*temp388b9 - yvb(2) = yvb(2) - cost*temp388b9 - distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - zvb(4) = zvb(4) + 33.d0*costb - zvb(2) = zvb(2) - 18.d0*r2*costb - r2b = r2b - 18.d0*zv(2)*costb - r4b = costb - rmub(2, i) = rmub(2, i) + cost2i*cost*distpb(i, 4) - costb = cost2i*rmu(2, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2i*cost*distpb(i, 3) - costb = costb + cost2i*rmu(1, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,cost) - zvb(5) = zvb(5) + 33.d0*costb - zvb(3) = zvb(3) - 30.d0*r2*costb - temp388b10 = cost1i*distpb(i, 2) - r6b = -(5.d0*temp388b10) - r4b = r4b + 105.d0*zv(2)*temp388b10 + r2*r6b + 5.d0*zv(1)*costb - r2b = r2b + 2*r2*r4b - 315.d0*zv(4)*temp388b10 + r4*r6b - 30.d0*zv& -& (3)*costb - zvb(1) = zvb(1) + 5.d0*r4*costb - zvb(6) = zvb(6) + 231.d0*temp388b10 - zvb(4) = zvb(4) - 315.d0*r2*temp388b10 - zvb(2) = zvb(2) + r2b + 105.d0*r4*temp388b10 - distpb(i, 2) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,r4) - CALL POPREAL8(adr8ibuf,adr8buf,r2) - xvb(2) = xvb(2) + r2b - yvb(2) = yvb(2) + r2b - DO k=6,1,-1 - CALL POPREAL8(adr8ibuf,adr8buf,xv(k)) - IF (.NOT.(rmu(1, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(1, i) = rmub(1, i) + k*rmu(1, i)**(k-1)*xvb(k) - xvb(k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,yv(k)) - IF (.NOT.(rmu(2, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(2, i) = rmub(2, i) + k*rmu(2, i)**(k-1)*yvb(k) - yvb(k) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,zv(k)) - IF (.NOT.(rmu(3, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& -& )))) rmub(3, i) = rmub(3, i) + k*rmu(3, i)**(k-1)*zvb(k) - zvb(k) = 0.0_8 - END DO - END DO - dd1b = 0.0_8 - cb = 0.0_8 DO k=indtm,indtmin,-1 - temp387 = r(k)**2 - temp387b62 = c*DEXP(-(dd1*temp387))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp387))*distpb(k, 1) - dd1b = dd1b - temp387*temp387b62 - rb(k) = rb(k) - dd1*2*r(k)*temp387b62 + temp313b7 = -(DEXP(-(dd2*r(k)))*distpb(k, 1)) + dd2b = dd2b - r(k)*temp313b7 + rb(k) = rb(k) - dd2*temp313b7 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 0.43985656185609913955d0*3.75d0*dd1**2.75D0*cb - ddb(indparp) = ddb(indparp) + dd1b - CASE (60) -! 2s gaussian for pseudo -! R(r)=r**3*exp(-z*r**2) single zeta -! if(iocc(indshellp).eq.1) then + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (2000:2099) +! s gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative of 1000 + npower = iopt + 1 - 2000 indorbp = indorb + 1 - dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=2.d0/pi**(3.d0/4.d0)*(2.d0*dd1)**(9.d0/4.d0)*dsqrt(2.d0/105.d0) - c = dd1**2.25d0*.55642345640820284397d0 -! endif + dd2 = dd(indpar+1) DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2))*r(k) + distp(k, 1) = -(r(k)**(2*npower)*DEXP(-(dd2*r(k)**2))) END DO +! endif IF (typec .NE. 1) THEN - rp1 = r(0)**2*dd1 -! the first derivative / r - fun = distp(0, 1)*(3.d0-2.d0*rp1) -! the second derivative - funb = 2.d0*zb(indorbp, indt+4) + rp1 = r(0)**2 + fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - distpb(0, 1) = (3.d0-2.d0*rp1)*funb + (4.d0*rp1**2-14.d0*rp1+6.d0)& -& *fun2b - rp1b = (distp(0, 1)*4.d0*2*rp1-distp(0, 1)*14.d0)*fun2b - distp(0& -& , 1)*2.d0*funb - rb(0) = rb(0) + dd1*2*r(0)*rp1b - dd1b = r(0)**2*rp1b + temp317 = distp(0, 1)/rp1 + temp318b = 2.d0*temp317*fun2b + temp318b0 = -((npower*4.d0+1.d0)*temp318b) + temp317b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& +& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 + temp316 = distp(0, 1)/rp1 + temp317b0 = 2.d0*temp316*funb0 + dd2b = rp1*temp318b0 - rp1*temp317b0 + 2.d0*rp1**2*2*dd2*temp318b + temp316b = 2.d0*(npower-dd2*rp1)*funb0/rp1 + rp1b = dd2*temp318b0 - temp316*temp316b - temp317*temp317b - dd2*& +& temp317b0 + 2.d0*dd2**2*2*rp1*temp318b + distpb(0, 1) = temp316b + temp317b + rb(0) = rb(0) + 2*r(0)*rp1b ELSE distpb = 0.0_8 - dd1b = 0.0_8 + dd2b = 0.0_8 END IF DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO - cb = 0.0_8 DO k=indtm,indtmin,-1 - temp388 = r(k)**2 - temp388b92 = c*r(k)*DEXP(-(dd1*temp388))*distpb(k, 1) - temp388b93 = DEXP(-(dd1*temp388))*distpb(k, 1) - dd1b = dd1b - temp388*temp388b92 - rb(k) = rb(k) + c*temp388b93 - dd1*2*r(k)*temp388b92 - cb = cb + r(k)*temp388b93 + temp315 = r(k)**2 + temp314 = 2*npower + temp314b3 = -(r(k)**temp314*DEXP(-(dd2*temp315))*distpb(k, 1)) + IF (r(k) .LE. 0.0 .AND. (temp314 .EQ. 0.0 .OR. temp314 .NE. INT(& +& temp314))) THEN + rb(k) = rb(k) - dd2*2*r(k)*temp314b3 + ELSE + rb(k) = rb(k) - dd2*2*r(k)*temp314b3 - DEXP(-(dd2*temp315))*& +& temp314*r(k)**(temp314-1)*distpb(k, 1) + END IF + dd2b = dd2b - temp315*temp314b3 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + .55642345640820284397d0*2.25d0*dd1**1.25D0*cb - ddb(indpar+1) = ddb(indpar+1) + dd1b + ddb(indpar+1) = ddb(indpar+1) + dd2b CASE (61) -! 3s -derivative of 60 with respect to dd1 -! R(r)=c (-r**5*exp(-z1*r**2)+c1 r**3 exp(-z1*r**2)) -! if(iocc(indshellp).eq.1) then +! R(r)=c (-r**5*exp(-z1*r**2)+c1 r**3 exp(-z1*r**2)) +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=2.d0/pi**(3.d0/4.d0)*(2.d0*dd1)**(9.d0/4.d0)*dsqrt(2.d0/105.d0) +! if(iflagnorm.gt.2) then +! c=2.d0/pi**(3.d0/4.d0)*(2.d0*dd1)**(9.d0/4.d0)*dsqrt(2.d0/105.d0) c = dd1**2.25d0*.55642345640820284397d0 -! endif +! endif c1 = 2.25d0/dd1 DO k=indtmin,indtm distp(k, 1) = c*DEXP(-(dd1*r(k)**2))*r(k) @@ -15677,28 +14340,28 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & rp2 = rp1*dd1 fun = c1*distp(0, 1)*(3.d0-2.d0*rp2) + distp(0, 1)*rp1*(-5.d0+2.d0& & *rp2) -! the second derivative - funb = 2.d0*zb(indorbp, indt+4) +! the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp390b0 = (4.d0*rp2**2-14.d0*rp2+6.d0)*fun2b - temp390b1 = c1*distp(0, 1)*fun2b - temp390b2 = (22.d0*rp2-4.d0*rp2**2-20.d0)*fun2b - temp390b3 = distp(0, 1)*rp1*fun2b - temp390b4 = (3.d0-2.d0*rp2)*funb - c1b = distp(0, 1)*temp390b4 + distp(0, 1)*temp390b0 - temp390b5 = (2.d0*rp2-5.d0)*funb - distpb(0, 1) = c1*temp390b4 + rp1*temp390b5 + rp1*temp390b2 + c1*& -& temp390b0 - rp2b = (distp(0, 1)*rp1*2.d0-c1*distp(0, 1)*2.d0)*funb + (22.d0-& -& 4.d0*2*rp2)*temp390b3 + (4.d0*2*rp2-14.d0)*temp390b1 - rp1b = distp(0, 1)*temp390b5 + dd1*rp2b + distp(0, 1)*temp390b2 + temp319b0 = (4.d0*rp2**2-14.d0*rp2+6.d0)*fun2b + temp319b1 = c1*distp(0, 1)*fun2b + temp319b2 = (22.d0*rp2-4.d0*rp2**2-20.d0)*fun2b + temp319b3 = distp(0, 1)*rp1*fun2b + temp319b4 = (3.d0-2.d0*rp2)*funb0 + c1b = distp(0, 1)*temp319b4 + distp(0, 1)*temp319b0 + temp319b5 = (2.d0*rp2-5.d0)*funb0 + distpb(0, 1) = c1*temp319b4 + rp1*temp319b5 + rp1*temp319b2 + c1*& +& temp319b0 + rp2b = (distp(0, 1)*rp1*2.d0-c1*distp(0, 1)*2.d0)*funb0 + (22.d0-& +& 4.d0*2*rp2)*temp319b3 + (4.d0*2*rp2-14.d0)*temp319b1 + rp1b = distp(0, 1)*temp319b5 + dd1*rp2b + distp(0, 1)*temp319b2 dd1b = rp1*rp2b rb(0) = rb(0) + 2*r(0)*rp1b ELSE @@ -15707,52 +14370,51 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & dd1b = 0.0_8 END IF DO i=indtm,i0,-1 - temp390b = distp(i, 1)*zb(indorbp, i) - c1b = c1b + r(i)**2*temp390b - rb(i) = rb(i) + (c1*2*r(i)-4*r(i)**3)*temp390b + temp319b = distp(i, 1)*zb(indorbp, i) + c1b = c1b + r(i)**2*temp319b + rb(i) = rb(i) + (c1*2*r(i)-4*r(i)**3)*temp319b distpb(i, 1) = distpb(i, 1) + (c1*r(i)**2-r(i)**4)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - temp389 = r(k)**2 - temp389b = c*r(k)*DEXP(-(dd1*temp389))*distpb(k, 1) - temp389b0 = DEXP(-(dd1*temp389))*distpb(k, 1) - dd1b = dd1b - temp389*temp389b - rb(k) = rb(k) + c*temp389b0 - dd1*2*r(k)*temp389b - cb = cb + r(k)*temp389b0 + temp318 = r(k)**2 + temp318b1 = c*r(k)*DEXP(-(dd1*temp318))*distpb(k, 1) + temp318b2 = DEXP(-(dd1*temp318))*distpb(k, 1) + dd1b = dd1b - temp318*temp318b1 + rb(k) = rb(k) + c*temp318b2 - dd1*2*r(k)*temp318b1 + cb = cb + r(k)*temp318b2 distpb(k, 1) = 0.0_8 END DO dd1b = dd1b + .55642345640820284397d0*2.25d0*dd1**1.25D0*cb - 2.25d0& & *c1b/dd1**2 ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (62) -! single gaussianx r p orbitals + CASE (20) +! single gaussianx r p orbitals +! 2p single Z with no cusp condition dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=2.d0/pi**0.75d0*(2.d0*dd1)**1.75d0/dsqrt(5.d0) - c = dd1**1.75d0*1.2749263037197753d0 -! endif +! if(iflagnorm.gt.2) then +! c=dsqrt((2.d0*dd1)**5/8.d0/pi)/2.d0 + c = dd1**2.5d0*0.5641895835477562d0 +! endif DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + distp(k, 1) = c*DEXP(-(dd1*r(k))) END DO -! indorbp=indorb -! +! indorbp=indorb +! DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 1)*r(0) - cost = 2.d0*dd1*r(0)**2 - fun = distp(0, 1)*(1.d0-cost)/r(0) - fun2 = 2.d0*dd1*fun0*(cost-3.d0) -! indorbp=indorb + fun = -(dd1*distp(0, 1)) + fun2 = dd1**2*distp(0, 1) +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -15762,217 +14424,189 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp392b1 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp392b1 - fun2b = fun2b + temp392b1 + temp320 = fun/r(0) + temp321b = rmu(ic, 0)*zb(indorbp, indt+4) + temp320b = 4.d0*temp321b/r(0) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp320+fun2)*zb(indorbp, indt& +& +4) + funb0 = funb0 + temp320b + rb(0) = rb(0) - temp320*temp320b + fun2b = fun2b + temp321b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp392b0 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp392b0 - funb = funb + rmu(ic, 0)*temp392b0 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + temp319 = fun/r(0) + temp319b7 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(ic, 0) = rmub(ic, 0) + temp319*rmu(i, 0)*zb(indorbp, indt& +& +i) + rmub(i, 0) = rmub(i, 0) + temp319*rmu(ic, 0)*zb(indorbp, indt+& +& i) + funb0 = funb0 + temp319b7 + rb(0) = rb(0) - temp319*temp319b7 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp392b = 2.d0*(cost-3.d0)*fun2b - temp391b0 = distp(0, 1)*funb/r(0) - costb = 2.d0*dd1*fun0*fun2b - temp391b0 - dd1b = 2.d0*r(0)**2*costb + fun0*temp392b - fun0b = fun0b + dd1*temp392b distpb = 0.0_8 - temp391 = (-cost+1.d0)/r(0) - distpb(0, 1) = r(0)*fun0b + temp391*funb - rb(0) = rb(0) + 2.d0*dd1*2*r(0)*costb + distp(0, 1)*fun0b - & -& temp391*temp391b0 + dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb0 + distpb(0, 1) = fun0b - dd1*funb0 + dd1**2*fun2b ELSE distpb = 0.0_8 dd1b = 0.0_8 END IF DO ic=3,1,-1 DO i=indtm,i0,-1 - temp391b = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*r(i)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + r(i)*temp391b - rb(i) = rb(i) + distp(i, 1)*temp391b + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO cb = 0.0_8 DO k=indtm,indtmin,-1 - temp390 = r(k)**2 - temp390b6 = c*DEXP(-(dd1*temp390))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp390))*distpb(k, 1) - dd1b = dd1b - temp390*temp390b6 - rb(k) = rb(k) - dd1*2*r(k)*temp390b6 + temp319b6 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp319b6 + rb(k) = rb(k) - dd1*temp319b6 distpb(k, 1) = 0.0_8 END DO - dd1b = dd1b + 1.2749263037197753d0*1.75d0*dd1**0.75D0*cb + dd1b = dd1b + 0.5641895835477562d0*2.5d0*dd1**1.5D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (63) -! derivative of 62 with respect zeta -! R(r)=c x*exp(-z*r**2)*r (c1 - r^2) + CASE (38) +! 2p double zeta +! R(r)=r**2*exp(-z1*r) +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 dd1 = dd(indpar+1) -! if(iflagnorm.gt.2) then - c = dd1**1.75d0*1.2749263037197753d0 -! c=2.d0/pi**0.75d0*(2.d0*dd1)**1.75d0/dsqrt(5.d0) -! endif - DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) - END DO - c1 = 1.75d0/dd1 -! indorbp=indorb -! - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic +! if(iflagnorm.gt.2) then +! c=1.d0/dsqrt(1.d0/4.d0/dd1**3+12.d0*dd1/(2.d0*dd1)**4+& +! &3.d0*dd1**2/4.d0/dd1**5)/dsqrt(4.d0*pi) +! c=dd1*dsqrt(dd1)/dsqrt(7.d0*pi) + c = dd1*DSQRT(dd1)*0.21324361862292308211d0 +! endif + c0 = -(c*dd1) + c1 = 1.5d0*c/dd1 + DO i=indtmin,indtm + distp(i, 1) = DEXP(-(dd1*r(i))) END DO -! endif + CALL PUSHREAL8(adr8ibuf,adr8buf,c1) + c1 = c1*dd1**2 IF (typec .NE. 1) THEN - rp1 = dd1*r(0)**2 - cost = 2.d0*rp1 - fun = distp(0, 1)*(c1*(1.d0-cost)/r(0)+(-3.d0+cost)*r(0)) -! My bug !!! -! fun2=distp(0,1)*(c1*2.d0*dd1*fun0*(cost-3.d0) -! &-2.d0*r(0)*(3.d0-7.d0*rp1+2.d0*rp1**2)) - fun2 = -(2.d0*distp(0, 1)*r(0)*(3.d0-7.d0*rp1+2.d0*rp1**2+c1*dd1*(& -& 3.d0-cost))) -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp395b3 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp395b3 - fun2b = fun2b + temp395b3 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp395b2 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp395b2 - funb = funb + rmu(ic, 0)*temp395b2 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + fun = (c0*(2.d0-dd1*r(0))-c1)*distp(0, 1) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp395b = -(2.d0*(2.d0*rp1**2-7.d0*rp1+c1*dd1*(3.d0-cost)+3.d0)*& -& fun2b) - temp395b0 = -(2.d0*distp(0, 1)*r(0)*fun2b) - temp394 = c1*(-cost+1.d0)/r(0) - temp394b1 = (c1-r(0)**2)*fun0b - distpb(0, 1) = (temp394+(cost-3.d0)*r(0))*funb + r(0)*temp394b1 + & -& r(0)*temp395b - temp395b1 = distp(0, 1)*funb - temp394b2 = temp395b1/r(0) - costb = r(0)*temp395b1 - c1*temp394b2 - c1*dd1*temp395b0 - rp1b = 2.d0*costb + (2.d0*2*rp1-7.d0)*temp395b0 - temp394b3 = distp(0, 1)*r(0)*fun0b - rb(0) = rb(0) + (cost-3.d0)*temp395b1 - temp394*temp394b2 + dd1*2*& -& r(0)*rp1b - 2*r(0)*temp394b3 + distp(0, 1)*temp394b1 + distp(0, & -& 1)*temp395b - c1b = (1.d0-cost)*temp394b2 + temp394b3 + (3.d0-cost)*dd1*& -& temp395b0 - dd1b = r(0)**2*rp1b + (3.d0-cost)*c1*temp395b0 + temp324b = distp(0, 1)*fun2b + temp323 = (dd1*r(0))**2 - 4*(dd1*r(0)) + 2.d0 + temp323b0 = c0*temp324b + temp323b1 = 2*dd1*r(0)*temp323b0 + temp323b2 = distp(0, 1)*funb0 + c0b = (2.d0-dd1*r(0))*temp323b2 + temp323*temp324b + dd1b = c1*r(0)*temp324b - c0*r(0)*temp323b2 - 4*r(0)*temp323b0 + r& +& (0)*temp323b1 + rb(0) = rb(0) + c1*dd1*temp324b - c0*dd1*temp323b2 - 4*dd1*& +& temp323b0 + dd1*temp323b1 + c1b = (dd1*r(0)-1.d0)*temp324b - temp323b2 + distpb(0, 1) = (c0*(2.d0-dd1*r(0))-c1)*funb0 + (c0*temp323+c1*(dd1& +& *r(0)-1.d0))*fun2b ELSE distpb = 0.0_8 + c0b = 0.0_8 c1b = 0.0_8 dd1b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - temp393 = c1 - r(i)**2 - temp394b = rmu(ic, i)*temp393*zb(indorbp, i) - temp394b0 = distp(i, 1)*r(i)*zb(indorbp, i) - temp393b = rmu(ic, i)*temp394b0 - distpb(i, 1) = distpb(i, 1) + r(i)*temp394b - rb(i) = rb(i) + distp(i, 1)*temp394b - 2*r(i)*temp393b - rmub(ic, i) = rmub(ic, i) + temp393*temp394b0 - c1b = c1b + temp393b - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + CALL POPREAL8(adr8ibuf,adr8buf,c1) + dd1b = dd1b + c1*2*dd1*c1b + c1b = dd1**2*c1b + DO i=indtm,i0,-1 + temp323b = distp(i, 1)*zb(indorbp, i) + temp322 = dd1*r(i) + 1.d0 + c0b = c0b + r(i)**2*temp323b + rb(i) = rb(i) + (c1*dd1+c0*2*r(i))*temp323b + c1b = c1b + temp322*temp323b + dd1b = dd1b + c1*r(i)*temp323b + distpb(i, 1) = distpb(i, 1) + (c0*r(i)**2+c1*temp322)*zb(indorbp, & +& i) + zb(indorbp, i) = 0.0_8 END DO - dd1b = dd1b - 1.75d0*c1b/dd1**2 - cb = 0.0_8 - DO k=indtm,indtmin,-1 - temp392 = r(k)**2 - temp392b2 = c*DEXP(-(dd1*temp392))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp392))*distpb(k, 1) - dd1b = dd1b - temp392*temp392b2 - rb(k) = rb(k) - dd1*2*r(k)*temp392b2 - distpb(k, 1) = 0.0_8 + DO i=indtm,indtmin,-1 + temp322b0 = DEXP(-(dd1*r(i)))*distpb(i, 1) + dd1b = dd1b - r(i)*temp322b0 + rb(i) = rb(i) - dd1*temp322b0 + distpb(i, 1) = 0.0_8 END DO - dd1b = dd1b + 1.2749263037197753d0*1.75d0*dd1**0.75D0*cb + temp322b = 1.5d0*c1b/dd1 + cb = temp322b - dd1*c0b + temp321 = DSQRT(dd1) + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + 0.21324361862292308211d0*temp321*cb - c*c0b - c*& +& temp322b/dd1 + ELSE + dd1b = dd1b + (0.21324361862292308211d0*dd1/(2.D0*DSQRT(dd1))+& +& 0.21324361862292308211d0*temp321)*cb - c*c0b - c*temp322b/dd1 + END IF ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (64) -! d orbitals -! R(r)= r exp(-alpha r^2) -! each gaussian term is normalized -! indorbp=indorb + CASE (84) +! 4s single zeta derivative of 10 +! d orbitals +! R(r)= exp(-alpha r^2) +! each gaussian term is normalized +! indorbp=indorb indparp = indpar + 1 dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! c=8.d0/dsqrt(21.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) - c = dd1**2.25d0*1.24420067280413253d0 -! endif + dd2 = DSQRT(dd1) +! if(iflagnorm.gt.2) then +! overall normalization +! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)*ratiocd + c = ratiocd*dd1**1.75d0 +! endif DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) END DO DO i=indtmin,indtm -! lz=0 +! lz=0 distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d -! lz=+/-2 +! lz=+/-2 distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d -! lz=+/-2 +! lz=+/-2 distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d -! lz=+/-1 +! lz=+/-1 distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d -! lz=+/-1 +! lz=+/-1 distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d END DO DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - rp1 = 2.d0*dd1*r(0) - rp2 = rp1*r(0) - fun0 = distp(0, 1)*r(0) - fun = (1.d0-rp2)*distp(0, 1)/r(0) - fun2 = distp(0, 1)*rp1*(rp2-3.d0) -! indorbp=indorb + fun0 = distp(0, 1) + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) +! the second derivative + fun2 = dd1*distp(0, 1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**& +& 2)/rp3**2 +! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN @@ -16019,15 +14653,15 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=5,1,-1 - temp397b4 = distp(0, 1+ic)*zb(indorbp, indt+4) + temp328b4 = distp(0, 1+ic)*zb(indorbp, indt+4) distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & & indt+4) - funb = funb + 6.d0*temp397b4 - fun2b = fun2b + temp397b4 + funb0 = funb0 + 6.d0*temp328b4 + fun2b = fun2b + temp328b4 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -16035,24 +14669,24 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN IF (branch .LT. 2) THEN - temp397b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp397b0 - fun0b = fun0b + rmu(i, 0)*temp397b0 + temp328b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp328b0 + fun0b = fun0b + rmu(i, 0)*temp328b0 ELSE - temp397b1 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp397b1 - fun0b = fun0b + rmu(i, 0)*temp397b1 + temp328b1 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp328b1 + fun0b = fun0b + rmu(i, 0)*temp328b1 END IF ELSE IF (branch .LT. 4) THEN - temp397b2 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp397b2 - fun0b = fun0b + rmu(i, 0)*temp397b2 + temp328b2 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp328b2 + fun0b = fun0b + rmu(i, 0)*temp328b2 END IF ELSE IF (branch .LT. 7) THEN IF (branch .LT. 6) THEN - temp397b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp397b3 - fun0b = fun0b + rmu(i, 0)*temp397b3 + temp328b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp328b3 + fun0b = fun0b + rmu(i, 0)*temp328b3 ELSE rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) @@ -16082,36 +14716,40 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp397b = distp(0, 1+ic)*zb(indorbp, indt+i) + temp328b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp397b - funb = funb + rmu(i, 0)*temp397b + rmub(i, 0) = rmub(i, 0) + fun*temp328b + funb0 = funb0 + rmu(i, 0)*temp328b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp396 = (-rp2+1.d0)/r(0) - distpb(0, 1) = distpb(0, 1) + temp396*funb + r(0)*fun0b + rp1*(rp2& -& -3.d0)*fun2b - temp396b0 = distp(0, 1)*funb/r(0) - rp2b = distp(0, 1)*rp1*fun2b - temp396b0 - rp1b = r(0)*rp2b + distp(0, 1)*(rp2-3.d0)*fun2b - rb(0) = rb(0) + distp(0, 1)*fun0b + 2.d0*dd1*rp1b + rp1*rp2b - & -& temp396*temp396b0 - dd1b = 2.d0*r(0)*rp1b - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + temp327 = rp3**2 + temp326b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& +& temp327 + temp326 = dd1*distp(0, 1)/temp327 + temp326b0 = temp326*fun2b + rp1b = (2*rp1+4.d0*rp2+4.d0)*temp326b0 + temp325b0 = -(distp(0, 1)*(rp2+2.d0)*funb0/rp3) + dd1b = temp325b0 + r(0)**2*rp1b + distp(0, 1)*temp326b + temp325 = dd1/rp3 + distpb(0, 1) = distpb(0, 1) + fun0b - temp325*(rp2+2.d0)*funb0 + & +& dd1*temp326b + rp3b = -(temp325*temp325b0) - temp326*2*rp3*temp326b + rp2b = 2*(rp2+1.d0)*rp3b - temp325*distp(0, 1)*funb0 + (4.d0*rp1-& +& 2.d0)*temp326b0 + dd2b = r(0)*rp2b + rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b ELSE distpb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 END IF DO ic=5,1,-1 DO k=indtm,i0,-1 - temp396b = distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1) = distpb(k, 1) + r(k)*temp396b - rb(k) = rb(k) + distp(k, 1)*temp396b - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*r(k)*zb(indorbp& -& , k) + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) @@ -16133,441 +14771,740 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) distpb(i, 2) = 0.0_8 END DO - dd1b = 0.0_8 cb = 0.0_8 DO k=indtm,indtmin,-1 - temp395 = r(k)**2 - temp395b4 = c*DEXP(-(dd1*temp395))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp395))*distpb(k, 1) - dd1b = dd1b - temp395*temp395b4 - rb(k) = rb(k) - dd1*2*r(k)*temp395b4 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp324 = dd2*r(k) + 1.d0 + temp325b = costb/temp324 + temp324b0 = -(dd1*r(k)**2*temp325b/temp324) + dd1b = dd1b + r(k)**2*temp325b + rb(k) = rb(k) + dd2*temp324b0 + dd1*2*r(k)*temp325b + dd2b = dd2b + r(k)*temp324b0 END DO - dd1b = dd1b + 1.24420067280413253d0*2.25d0*dd1**1.25D0*cb + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocd*1.75d0*dd1**0.75D0*cb + ELSE + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocd*1.75d0*dd1**0.75D0*& +& cb + END IF ddb(indparp) = ddb(indparp) + dd1b - CASE (65) -! d orbitals -! R(r)= c0 r^3 exp(-alpha r^2)+ c1 r exp(-alpha r^2) -! each gaussian term is normalized -! indorbp=indorb + CASE (24) +! derivative of 37 with respect to z +!c 4p without cusp condition +!c r^2 e^{-z1 r } + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c=dsqrt((2.d0*dd1)**9/120960.d0/pi)/2.d0 + c = dd1**4.5d0*0.01835308852470193d0 +! endif + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k))) + END DO + DO i=indtmin,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = r(i)**2*distp(i, 1) + END DO +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN + fun = (2.d0*r(0)-dd1*r(0)**2)*distp(0, 1) + fun2 = ((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))*distp(0, 1) +! indorbp=indorb + DO ic=1,3 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO + END DO + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=3,1,-1 + temp329 = fun/r(0) + temp330b = rmu(ic, 0)*zb(indorbp, indt+4) + temp329b = 4.d0*temp330b/r(0) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp329+fun2)*zb(indorbp, indt& +& +4) + funb0 = funb0 + temp329b + rb(0) = rb(0) - temp329*temp329b + fun2b = fun2b + temp330b + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp328 = fun/r(0) + temp328b9 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(ic, 0) = rmub(ic, 0) + temp328*rmu(i, 0)*zb(indorbp, indt& +& +i) + rmub(i, 0) = rmub(i, 0) + temp328*rmu(ic, 0)*zb(indorbp, indt+& +& i) + funb0 = funb0 + temp328b9 + rb(0) = rb(0) - temp328*temp328b9 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + distpb = 0.0_8 + temp328b6 = distp(0, 1)*fun2b + temp328b7 = 2*dd1*r(0)*temp328b6 + temp328b8 = distp(0, 1)*funb0 + dd1b = r(0)*temp328b7 - 4.d0*r(0)*temp328b6 - r(0)**2*temp328b8 + rb(0) = rb(0) + (2.d0-dd1*2*r(0))*temp328b8 - 4.d0*dd1*temp328b6 +& +& dd1*temp328b7 + distpb(0, 1) = (2.d0*r(0)-dd1*r(0)**2)*funb0 + ((dd1*r(0))**2-4.d0& +& *(dd1*r(0))+2.d0)*fun2b + distpb(0, 3) = distpb(0, 3) + fun0b + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=indtm,i0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO i=indtm,indtmin,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*distpb(i, 3) + distpb(i, 1) = distpb(i, 1) + r(i)**2*distpb(i, 3) + distpb(i, 3) = 0.0_8 + END DO + cb = 0.0_8 + DO k=indtm,indtmin,-1 + temp328b5 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp328b5 + rb(k) = rb(k) - dd1*temp328b5 + distpb(k, 1) = 0.0_8 + END DO + dd1b = dd1b + 0.01835308852470193d0*4.5d0*dd1**3.5D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (5) +! 4p double zeta +! normalized +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) + DO k=indtmin,indtm + distp(k, 1) = DEXP(-(dd1*r(k))) + END DO +! if(iflagnorm.gt.2) then +! c=dd1**2.5d0/dsqrt(3.d0*pi) + c = dd1**2.5d0*0.32573500793527994772d0 + IF (typec .NE. 1) THEN + fun = distp(0, 1)*(1.d0-dd1*r(0)) + fun2 = distp(0, 1)*(dd1**2*r(0)-2.d0*dd1) + temp331b = 2.d0*zb(indorbp, indt+4)/r(0) + cb = fun2*zb(indorbp, indt+4) + fun*temp331b + funb0 = c*temp331b + rb(0) = rb(0) - c*fun*temp331b/r(0) + fun2b = c*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + temp330 = rmu(i, 0)/r(0) + temp330b3 = c*fun*zb(indorbp, indt+i)/r(0) + cb = cb + temp330*fun*zb(indorbp, indt+i) + funb0 = funb0 + temp330*c*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp330b3 + rb(0) = rb(0) - temp330*temp330b3 + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp330b2 = distp(0, 1)*fun2b + distpb(0, 1) = (1.d0-dd1*r(0))*funb0 + (dd1**2*r(0)-2.d0*dd1)*& +& fun2b + dd1b = (r(0)*2*dd1-2.d0)*temp330b2 - distp(0, 1)*r(0)*funb0 + rb(0) = rb(0) + dd1**2*temp330b2 - distp(0, 1)*dd1*funb0 + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + cb = 0.0_8 + END IF + DO i=indtm,i0,-1 + temp330b1 = distp(i, 1)*zb(indorbp, i) + cb = cb + r(i)*temp330b1 + rb(i) = rb(i) + c*temp330b1 + distpb(i, 1) = distpb(i, 1) + c*r(i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + dd1b = dd1b + 0.32573500793527994772d0*2.5d0*dd1**1.5D0*cb + DO k=indtm,indtmin,-1 + temp330b0 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp330b0 + rb(k) = rb(k) - dd1*temp330b0 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (88) +! 2s double Z NO CUSP +! g single gaussian orbital +! R(r)= exp(-alpha r^2) +! normalized +! indorbp=indorb indparp = indpar + 1 dd1 = dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization to be done -! c=8.d0/dsqrt(21.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) - c = dd1**2.25d0*1.24420067280413253d0 -! endif - c0 = -c - c1 = 2.25d0*c/dd1 + dd2 = DSQRT(dd1) +! if(iflagnorm.gt.2) then +! overall normalization +! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0)*ratiocg + c = dd1**2.75d0*ratiocg +! endif DO k=indtmin,indtm - distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) END DO DO i=indtmin,indtm -! lz=0 - distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d -! lz=+/-2 - distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d -! lz=+/-2 - distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d -! lz=+/-1 - distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d -! lz=+/-1 - distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d + distp(i, 2) = cost1g*(35.d0*rmu(3, i)**4-30.d0*rmu(3, i)**2*r(i)**& +& 2+3.d0*r(i)**4) +! lz=0 + distp(i, 3) = cost2g*rmu(1, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 4) = cost2g*rmu(2, i)*rmu(3, i)*(7.d0*rmu(3, i)**2-3.d0*r& +& (i)**2) +! lz=+/-1 + distp(i, 5) = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*(7.d0*rmu(3, i)**& +& 2-r(i)**2) +! lz=+/-2 + distp(i, 6) = cost3g*2.d0*rmu(1, i)*rmu(2, i)*(7.d0*rmu(3, i)**2-r& +& (i)**2) +! lz=+/-2 + distp(i, 7) = cost4g*rmu(1, i)*rmu(3, i)*(rmu(1, i)**2-3.0*rmu(2, & +& i)**2) +! lz=+/-3 + distp(i, 8) = cost4g*rmu(2, i)*rmu(3, i)*(3.d0*rmu(1, i)**2-rmu(2& +& , i)**2) +! lz=+/-3 + distp(i, 9) = cost5g*(rmu(1, i)**4-6.d0*rmu(1, i)**2*rmu(2, i)**2+& +& rmu(2, i)**4) +! lz=+/-4 + distp(i, 10) = cost5g*4.d0*rmu(1, i)*rmu(2, i)*(rmu(1, i)**2-rmu(2& +& , i)**2) END DO - DO ic=1,5 +! lz=+/-4 + DO ic=1,9 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - rp1 = 2.d0*dd1*r(0) - rp2 = rp1*r(0) - fun0 = distp(0, 1)*(c1*r(0)+c0*r(0)**3) - fun = (c1*(1.d0-rp2)+c0*r(0)**2*(3.d0-rp2))*distp(0, 1)/r(0) - fun2 = distp(0, 1)*(c1*rp1*(rp2-3.d0)+c0*r(0)*(3.d0-3.5d0*rp2+& -& 0.5d0*rp2**2)) -! indorbp=indorb - DO ic=1,5 + fun0 = distp(0, 1) + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) +! the second derivative + fun2 = dd1*distp(0, 1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**& +& 2)/rp3**2 +! indorbp=indorb + DO ic=1,9 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN + IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) END IF ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) END IF ELSE IF (ic .EQ. 3) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) END IF ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + END IF + ELSE IF (ic .EQ. 6) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + END IF + ELSE IF (ic .EQ. 7) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,21) + END IF + ELSE IF (ic .EQ. 8) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,22) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,24) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,23) + END IF + ELSE IF (ic .EQ. 9) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,26) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,28) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,27) END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,25) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=5,1,-1 - temp404b4 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 6.d0*temp404b4 - fun2b = fun2b + temp404b4 + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=9,1,-1 + temp335b55 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (10.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 10.d0*temp335b55 + fun2b = fun2b + temp335b55 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp404b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp404b0 - fun0b = fun0b + rmu(i, 0)*temp404b0 + IF (branch .LT. 15) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp335b0 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(12.d0*(rmu(1, 0)*r(0)**2)-& +& 60.d0*(rmu(1, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& +& ) + rmub(1, 0) = rmub(1, 0) + (12.d0*r(0)**2-60.d0*rmu(3& +& , 0)**2)*temp335b0 + rb(0) = rb(0) + 12.d0*rmu(1, 0)*2*r(0)*temp335b0 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(1, 0)*2*rmu(3, 0& +& )*temp335b0 + ELSE + temp335b1 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(12.d0*(rmu(2, 0)*r(0)**2)-& +& 60.d0*(rmu(2, 0)*rmu(3, 0)**2))*zb(indorbp, indt+i& +& ) + rmub(2, 0) = rmub(2, 0) + (12.d0*r(0)**2-60.d0*rmu(3& +& , 0)**2)*temp335b1 + rb(0) = rb(0) + 12.d0*rmu(2, 0)*2*r(0)*temp335b1 + rmub(3, 0) = rmub(3, 0) - 60.d0*rmu(2, 0)*2*rmu(3, 0& +& )*temp335b1 + END IF + ELSE IF (branch .LT. 4) THEN + temp335b2 = cost1g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost1g*(80.d0*rmu(3, 0)**3-48.d0*(rmu(& +& 3, 0)*r(0)**2))*zb(indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (80.d0*3*rmu(3, 0)**2-48.d0*& +& r(0)**2)*temp335b2 + rb(0) = rb(0) - 48.d0*rmu(3, 0)*2*r(0)*temp335b2 + ELSE + temp335b3 = cost2g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-3.d0*(rmu(2& +& , 0)**2*rmu(3, 0))-9.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& +& (indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-3.d0*& +& rmu(2, 0)**2-9.d0*rmu(1, 0)**2)*temp335b3 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp335b3 + rmub(1, 0) = rmub(1, 0) - 9.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp335b3 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp335b4 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp335b5 = rmu(2, 0)*rmu(3, 0)*temp335b4 + temp335b6 = fun0*rmu(1, 0)*temp335b4 + fun0b = fun0b + rmu(1, 0)*temp335b5 + rmub(1, 0) = rmub(1, 0) + fun0*temp335b5 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp335b6 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp335b6 ELSE - temp404b1 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp404b1 - fun0b = fun0b + rmu(i, 0)*temp404b1 + temp335b7 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp335b8 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& +& **2)*temp335b7 + temp335b9 = fun0*rmu(1, 0)*temp335b7 + fun0b = fun0b + rmu(1, 0)*temp335b8 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp335b9 + fun0& +& *temp335b8 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp335b9 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp335b9 END IF - ELSE IF (branch .LT. 4) THEN - temp404b2 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp404b2 - fun0b = fun0b + rmu(i, 0)*temp404b2 + ELSE + temp335b10 = -(cost2g*6.d0*zb(indorbp, indt+i)) + temp335b11 = rmu(2, 0)*rmu(3, 0)*temp335b10 + temp335b12 = fun0*rmu(1, 0)*temp335b10 + fun0b = fun0b + rmu(1, 0)*temp335b11 + rmub(1, 0) = rmub(1, 0) + fun0*temp335b11 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp335b12 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp335b12 END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp404b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp404b3 - fun0b = fun0b + rmu(i, 0)*temp404b3 + ELSE IF (branch .LT. 12) THEN + IF (branch .LT. 10) THEN + IF (branch .LT. 9) THEN + temp335b13 = cost2g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost2g*(4.d0*rmu(3, 0)**3-9.d0*(rmu(2& +& , 0)**2*rmu(3, 0))-3.d0*(rmu(1, 0)**2*rmu(3, 0)))*zb& +& (indorbp, indt+i) + rmub(3, 0) = rmub(3, 0) + (4.d0*3*rmu(3, 0)**2-9.d0*& +& rmu(2, 0)**2-3.d0*rmu(1, 0)**2)*temp335b13 + rmub(2, 0) = rmub(2, 0) - 9.d0*rmu(3, 0)*2*rmu(2, 0)*& +& temp335b13 + rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(3, 0)*2*rmu(1, 0)*& +& temp335b13 + ELSE + temp335b14 = -(cost2g*3.d0*zb(indorbp, indt+i)) + temp335b15 = (rmu(1, 0)**2+rmu(2, 0)**2-4.d0*rmu(3, 0)& +& **2)*temp335b14 + temp335b16 = fun0*rmu(2, 0)*temp335b14 + fun0b = fun0b + rmu(2, 0)*temp335b15 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp335b16 + & +& fun0*temp335b15 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp335b16 + rmub(3, 0) = rmub(3, 0) - 4.d0*2*rmu(3, 0)*temp335b16 + END IF + ELSE IF (branch .LT. 11) THEN + temp335b17 = -(cost3g*4.d0*zb(indorbp, indt+i)) + temp335b18 = fun0*temp335b17 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(3, 0)& +& **2))*temp335b17 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(3, 0)& +& **2)*temp335b18 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(1, 0)*2*rmu(3, 0)*& +& temp335b18 ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + temp335b19 = cost3g*4.d0*zb(indorbp, indt+i) + temp335b20 = fun0*temp335b19 + fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(2, 0)*rmu(3, 0)& +& **2))*temp335b19 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(3, 0)& +& **2)*temp335b20 + rmub(3, 0) = rmub(3, 0) - 3.d0*rmu(2, 0)*2*rmu(3, 0)*& +& temp335b20 END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 14) THEN + IF (branch .LT. 13) THEN + temp335b21 = cost3g*12.d0*zb(indorbp, indt+i) + temp335b22 = fun0*rmu(3, 0)*temp335b21 + temp335b23 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp335b21 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp335b22 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp335b22 + fun0b = fun0b + rmu(3, 0)*temp335b23 + rmub(3, 0) = rmub(3, 0) + fun0*temp335b23 + ELSE + temp335b24 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp335b25 = (3.d0*rmu(1, 0)**2+rmu(2, 0)**2-6.d0*rmu(3& +& , 0)**2)*temp335b24 + temp335b26 = fun0*rmu(2, 0)*temp335b24 + fun0b = fun0b + rmu(2, 0)*temp335b25 + rmub(2, 0) = rmub(2, 0) + 2*rmu(2, 0)*temp335b26 + fun0*& +& temp335b25 + rmub(1, 0) = rmub(1, 0) + 3.d0*2*rmu(1, 0)*temp335b26 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp335b26 + END IF + ELSE + temp335b27 = -(cost3g*2.d0*zb(indorbp, indt+i)) + temp335b28 = (rmu(1, 0)**2+3.d0*rmu(2, 0)**2-6.d0*rmu(3, 0& +& )**2)*temp335b27 + temp335b29 = fun0*rmu(1, 0)*temp335b27 + fun0b = fun0b + rmu(1, 0)*temp335b28 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp335b29 + fun0*& +& temp335b28 + rmub(2, 0) = rmub(2, 0) + 3.d0*2*rmu(2, 0)*temp335b29 + rmub(3, 0) = rmub(3, 0) - 6.d0*2*rmu(3, 0)*temp335b29 END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 22) THEN + IF (branch .LT. 19) THEN + IF (branch .LT. 17) THEN + IF (branch .LT. 16) THEN + temp335b30 = cost3g*24.d0*zb(indorbp, indt+i) + temp335b31 = rmu(2, 0)*rmu(3, 0)*temp335b30 + temp335b32 = fun0*rmu(1, 0)*temp335b30 + fun0b = fun0b + rmu(1, 0)*temp335b31 + rmub(1, 0) = rmub(1, 0) + fun0*temp335b31 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp335b32 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp335b32 + ELSE + temp335b33 = cost4g*3.d0*zb(indorbp, indt+i) + temp335b34 = fun0*rmu(3, 0)*temp335b33 + temp335b35 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp335b33 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp335b34 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp335b34 + fun0b = fun0b + rmu(3, 0)*temp335b35 + rmub(3, 0) = rmub(3, 0) + fun0*temp335b35 + END IF + ELSE IF (branch .LT. 18) THEN + temp335b36 = -(cost4g*6.d0*zb(indorbp, indt+i)) + temp335b37 = rmu(2, 0)*rmu(3, 0)*temp335b36 + temp335b38 = fun0*rmu(1, 0)*temp335b36 + fun0b = fun0b + rmu(1, 0)*temp335b37 + rmub(1, 0) = rmub(1, 0) + fun0*temp335b37 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp335b38 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp335b38 + ELSE + temp335b39 = cost4g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost4g*(rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu& +& (2, 0)**2))*zb(indorbp, indt+i) + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& +& **2)*temp335b39 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp335b39 END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 21) THEN + IF (branch .LT. 20) THEN + temp335b40 = cost4g*6.d0*zb(indorbp, indt+i) + temp335b41 = rmu(2, 0)*rmu(3, 0)*temp335b40 + temp335b42 = fun0*rmu(1, 0)*temp335b40 + fun0b = fun0b + rmu(1, 0)*temp335b41 + rmub(1, 0) = rmub(1, 0) + fun0*temp335b41 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*temp335b42 + rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*temp335b42 + ELSE + temp335b43 = cost4g*3.d0*zb(indorbp, indt+i) + temp335b44 = fun0*rmu(3, 0)*temp335b43 + temp335b45 = (rmu(1, 0)**2-rmu(2, 0)**2)*temp335b43 + rmub(1, 0) = rmub(1, 0) + 2*rmu(1, 0)*temp335b44 + rmub(2, 0) = rmub(2, 0) - 2*rmu(2, 0)*temp335b44 + fun0b = fun0b + rmu(3, 0)*temp335b45 + rmub(3, 0) = rmub(3, 0) + fun0*temp335b45 + END IF + ELSE + temp335b46 = cost4g*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost4g*(3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(& +& 2, 0)**3)*zb(indorbp, indt+i) + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp335b46 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& +& 2)*temp335b46 END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 26) THEN + IF (branch .LT. 24) THEN + IF (branch .LT. 23) THEN + temp335b47 = cost5g*4.d0*zb(indorbp, indt+i) + temp335b48 = fun0*temp335b47 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)& +& **2))*temp335b47 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)& +& **2)*temp335b48 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp335b48 + END IF + ELSE IF (branch .LT. 25) THEN + temp335b49 = cost5g*4.d0*zb(indorbp, indt+i) + temp335b50 = fun0*temp335b49 + fun0b = fun0b + (rmu(2, 0)**3-3.d0*(rmu(1, 0)**2*rmu(2, 0)& +& ))*temp335b49 + rmub(2, 0) = rmub(2, 0) + (3*rmu(2, 0)**2-3.d0*rmu(1, 0)**& +& 2)*temp335b50 + rmub(1, 0) = rmub(1, 0) - 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp335b50 + END IF + ELSE IF (branch .LT. 28) THEN + IF (branch .LT. 27) THEN + temp335b51 = cost5g*4.d0*zb(indorbp, indt+i) + temp335b52 = fun0*temp335b51 + fun0b = fun0b + (3.d0*(rmu(1, 0)**2*rmu(2, 0))-rmu(2, 0)**& +& 3)*temp335b51 + rmub(1, 0) = rmub(1, 0) + 3.d0*rmu(2, 0)*2*rmu(1, 0)*& +& temp335b52 + rmub(2, 0) = rmub(2, 0) + (3.d0*rmu(1, 0)**2-3*rmu(2, 0)**& +& 2)*temp335b52 END IF ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + temp335b53 = cost5g*4.d0*zb(indorbp, indt+i) + temp335b54 = fun0*temp335b53 + fun0b = fun0b + (rmu(1, 0)**3-3.d0*(rmu(1, 0)*rmu(2, 0)**2))& +& *temp335b53 + rmub(1, 0) = rmub(1, 0) + (3*rmu(1, 0)**2-3.d0*rmu(2, 0)**2)& +& *temp335b54 + rmub(2, 0) = rmub(2, 0) - 3.d0*rmu(1, 0)*2*rmu(2, 0)*& +& temp335b54 END IF - temp404b = distp(0, 1+ic)*zb(indorbp, indt+i) + temp335b = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp404b - funb = funb + rmu(i, 0)*temp404b + rmub(i, 0) = rmub(i, 0) + fun*temp335b + funb0 = funb0 + rmu(i, 0)*temp335b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp403 = 0.5d0*rp2**2 - 3.5d0*rp2 + 3.d0 - temp402 = c0*r(0) - temp402b = distp(0, 1)*fun2b - temp401b = (c1*(1.d0-rp2)+r(0)**2*(c0*(3.d0-rp2)))*funb/r(0) - temp400 = r(0)**3 - distpb(0, 1) = distpb(0, 1) + temp401b + (c1*r(0)+c0*temp400)*& -& fun0b + (c1*rp1*(rp2-3.d0)+temp402*temp403)*fun2b - temp401 = distp(0, 1)/r(0) - temp402b0 = temp401*funb - temp400b = distp(0, 1)*fun0b - c1b = (1.d0-rp2)*temp402b0 + r(0)*temp400b + (rp2-3.d0)*rp1*& -& temp402b - temp402b1 = r(0)**2*temp402b0 - rp2b = (temp402*0.5d0*2*rp2-temp402*3.5d0+c1*rp1)*temp402b - c0*& -& temp402b1 - c1*temp402b0 - rp1b = r(0)*rp2b + (rp2-3.d0)*c1*temp402b - c0b = (3.d0-rp2)*temp402b1 + temp400*temp400b + temp403*r(0)*& -& temp402b - rb(0) = rb(0) + c0*(3.d0-rp2)*2*r(0)*temp402b0 - temp401*temp401b & -& + rp1*rp2b + 2.d0*dd1*rp1b + (c0*3*r(0)**2+c1)*temp400b + & -& temp403*c0*temp402b - dd1b = 2.d0*r(0)*rp1b - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b + temp334 = rp3**2 + temp333b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& +& temp334 + temp333 = dd1*distp(0, 1)/temp334 + temp333b0 = temp333*fun2b + rp1b = (2*rp1+4.d0*rp2+4.d0)*temp333b0 + temp332b18 = -(distp(0, 1)*(rp2+2.d0)*funb0/rp3) + dd1b = temp332b18 + r(0)**2*rp1b + distp(0, 1)*temp333b + temp332 = dd1/rp3 + distpb(0, 1) = distpb(0, 1) + fun0b - temp332*(rp2+2.d0)*funb0 + & +& dd1*temp333b + rp3b = -(temp332*temp332b18) - temp333*2*rp3*temp333b + rp2b = 2*(rp2+1.d0)*rp3b - temp332*distp(0, 1)*funb0 + (4.d0*rp1-& +& 2.d0)*temp333b0 + dd2b = r(0)*rp2b + rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b ELSE distpb = 0.0_8 - c0b = 0.0_8 - c1b = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 END IF - DO ic=5,1,-1 + DO ic=9,1,-1 DO k=indtm,i0,-1 - temp399 = r(k)**3 - temp398 = c0*distp(k, 1+ic) - temp398b = distp(k, 1)*zb(indorbp, k) - distpb(k, 1) = distpb(k, 1) + (temp398*temp399+c1*r(k))*zb(& -& indorbp, k) - c0b = c0b + temp399*distp(k, 1+ic)*temp398b - distpb(k, 1+ic) = distpb(k, 1+ic) + temp399*c0*temp398b - rb(k) = rb(k) + (c1+temp398*3*r(k)**2)*temp398b - c1b = c1b + r(k)*temp398b + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) + temp332b0 = cost5g*4.d0*distpb(i, 10) + temp332b1 = (rmu(1, i)**2-rmu(2, i)**2)*temp332b0 + temp332b2 = rmu(1, i)*rmu(2, i)*temp332b0 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp332b2 + rmu(2, i)*& +& temp332b1 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp332b1 - 2*rmu(2, i)*& +& temp332b2 + distpb(i, 10) = 0.0_8 + temp332b3 = cost5g*distpb(i, 9) + rmub(1, i) = rmub(1, i) + (4*rmu(1, i)**3-6.d0*rmu(2, i)**2*2*rmu(& +& 1, i))*temp332b3 + distpb(i, 9) = 0.0_8 + temp332b4 = cost4g*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 8) + temp332b5 = cost4g*rmu(2, i)*rmu(3, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp332b4 - 2*rmu(2, i)*& +& temp332b5 + (4*rmu(2, i)**3-6.d0*rmu(1, i)**2*2*rmu(2, i))*& +& temp332b3 + rmub(3, i) = rmub(3, i) + rmu(2, i)*temp332b4 + distpb(i, 8) = 0.0_8 + temp332b6 = cost4g*(rmu(1, i)**2-3.0*rmu(2, i)**2)*distpb(i, 7) + temp332b7 = cost4g*rmu(1, i)*rmu(3, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp332b6 + 2*rmu(1, i)*& +& temp332b7 + 3.d0*2*rmu(1, i)*temp332b5 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp332b6 + rmub(2, i) = rmub(2, i) - 3.0*2*rmu(2, i)*temp332b7 + distpb(i, 7) = 0.0_8 + temp332b8 = cost3g*2.d0*distpb(i, 6) + temp332b9 = (7.d0*rmu(3, i)**2-r(i)**2)*temp332b8 + temp332b10 = rmu(1, i)*rmu(2, i)*temp332b8 + rmub(1, i) = rmub(1, i) + rmu(2, i)*temp332b9 + rmub(2, i) = rmub(2, i) + rmu(1, i)*temp332b9 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp332b10 distpb(i, 6) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) + temp332b11 = cost3g*(7.d0*rmu(3, i)**2-r(i)**2)*distpb(i, 5) + temp332b12 = cost3g*(rmu(1, i)**2-rmu(2, i)**2)*distpb(i, 5) distpb(i, 5) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) - distpb(i, 2) = 0.0_8 - END DO - dd1b = 0.0_8 - cb = 0.0_8 - DO k=indtm,indtmin,-1 - temp397 = r(k)**2 - temp397b6 = c*DEXP(-(dd1*temp397))*distpb(k, 1) - cb = cb + DEXP(-(dd1*temp397))*distpb(k, 1) - dd1b = dd1b - temp397*temp397b6 - rb(k) = rb(k) - dd1*2*r(k)*temp397b6 - distpb(k, 1) = 0.0_8 - END DO - temp397b5 = 2.25d0*c1b/dd1 - cb = cb + temp397b5 - c0b - dd1b = dd1b + 1.24420067280413253d0*2.25d0*dd1**1.25D0*cb - c*& -& temp397b5/dd1 - ddb(indparp) = ddb(indparp) + dd1b - CASE (100) -! ******************* END GAUSSIAN BASIS ************************ -! ** ** ** ** ** ** ** JASTROW ORBITALS ** ** ** ** ** ** ** ** * -! 2s single gaussian -! exp(-dd2*r^2) - dd2 = dd(indpar+1) - indorbp = indorb + 1 - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) - END DO -! endif - IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)*2.d0) - distpb = 0.0_8 - temp404b6 = 2.d0**2*dd2*distp(0, 1)*zb(indorbp, indt+4) - temp404b7 = 2.d0*(2.d0*(dd2*r(0)**2)-3.d0)*zb(indorbp, indt+4) - dd2b = distp(0, 1)*temp404b7 + r(0)**2*temp404b6 - rb(0) = rb(0) + dd2*2*r(0)*temp404b6 - distpb(0, 1) = dd2*temp404b7 - zb(indorbp, indt+4) = 0.0_8 - funb = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - dd2b = dd2b - 2.d0*distp(0, 1)*funb - distpb(0, 1) = distpb(0, 1) - 2.d0*dd2*funb - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=indtm,indtmin,-1 - temp404b5 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp404b5 - rb(k) = rb(k) - dd2*2*r(k)*temp404b5 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (101) -! 2s without cusp condition -! dd1*( dd3 +exp(-dd2*r^2)) - dd2 = dd(indpar+1) - indorbp = indorb + 1 - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) - END DO -! endif - IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)*2.d0) - distpb = 0.0_8 - temp404b9 = 2.d0**2*dd2*distp(0, 1)*zb(indorbp, indt+4) - temp404b10 = 2.d0*(2.d0*(dd2*r(0)**2)-3.d0)*zb(indorbp, indt+4) - dd2b = distp(0, 1)*temp404b10 + r(0)**2*temp404b9 - rb(0) = rb(0) + dd2*2*r(0)*temp404b9 - distpb(0, 1) = dd2*temp404b10 - zb(indorbp, indt+4) = 0.0_8 - funb = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - dd2b = dd2b - 2.d0*distp(0, 1)*funb - distpb(0, 1) = distpb(0, 1) - 2.d0*dd2*funb - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - dd3b = 0.0_8 - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=indtm,indtmin,-1 - temp404b8 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp404b8 - rb(k) = rb(k) - dd2*2*r(k)*temp404b8 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (102) -! 2s double gaussian with constant -! (dd3+ exp (-dd2 r^2)+dd4*exp(-dd5*r^2)) - dd2 = dd(indpar+1) - dd4 = dd(indpar+3) - dd5 = dd(indpar+4) - indorbp = indorb + 1 - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) - distp(k, 2) = DEXP(-(dd5*r(k)*r(k))) - END DO -! write(6,*) ' function inside = ',z(indorbp,i) -! endif - IF (typec .NE. 1) THEN - fun = -(2.d0*(dd2*distp(0, 1)+dd5*dd4*distp(0, 2))) - fun2 = r(0)**2 - distpb = 0.0_8 - temp404b14 = 2.d0*zb(indorbp, indt+4) - temp404b15 = dd2*distp(0, 1)*2.d0*temp404b14 - temp404b16 = (2.d0*(dd2*fun2)-3.d0)*temp404b14 - temp404b17 = (2.d0*(dd5*fun2)-3.d0)*temp404b14 - temp404b18 = dd5*dd4*distp(0, 2)*2.d0*temp404b14 - dd2b = distp(0, 1)*temp404b16 + fun2*temp404b15 - fun2b = dd5*temp404b18 + dd2*temp404b15 - distpb(0, 1) = dd2*temp404b16 - dd5b = fun2*temp404b18 + distp(0, 2)*dd4*temp404b17 - dd4b = distp(0, 2)*dd5*temp404b17 - distpb(0, 2) = dd5*dd4*temp404b17 - zb(indorbp, indt+4) = 0.0_8 - funb = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - rb(0) = rb(0) + 2*r(0)*fun2b - temp404b13 = -(2.d0*funb) - dd2b = dd2b + distp(0, 1)*temp404b13 - distpb(0, 1) = distpb(0, 1) + dd2*temp404b13 - dd5b = dd5b + distp(0, 2)*dd4*temp404b13 - dd4b = dd4b + distp(0, 2)*dd5*temp404b13 - distpb(0, 2) = distpb(0, 2) + dd5*dd4*temp404b13 - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - dd4b = 0.0_8 - dd5b = 0.0_8 - END IF - dd3b = 0.0_8 - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) - dd4b = dd4b + distp(i, 2)*zb(indorbp, i) - distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + temp332b13 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 4) + temp332b14 = cost2g*rmu(2, i)*rmu(3, i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + temp332b15 = cost2g*(7.d0*rmu(3, i)**2-3.d0*r(i)**2)*distpb(i, 3) + temp332b16 = cost2g*rmu(1, i)*rmu(3, i)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + temp332b17 = cost1g*distpb(i, 2) + rb(i) = rb(i) + (3.d0*4*r(i)**3-30.d0*rmu(3, i)**2*2*r(i))*& +& temp332b17 - 3.d0*2*r(i)*temp332b16 - 2*r(i)*temp332b12 - 3.d0*2& +& *r(i)*temp332b14 - 2*r(i)*temp332b10 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp332b11 + rmub(2, i) = rmub(2, i) - 2*rmu(2, i)*temp332b11 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp332b12 + rmub(2, i) = rmub(2, i) + rmu(3, i)*temp332b13 + rmub(3, i) = rmub(3, i) + 7.d0*2*rmu(3, i)*temp332b14 + rmu(2, i)*& +& temp332b13 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp332b15 + rmub(3, i) = rmub(3, i) + (35.d0*4*rmu(3, i)**3-30.d0*r(i)**2*2*& +& rmu(3, i))*temp332b17 + 7.d0*2*rmu(3, i)*temp332b16 + rmu(1, i)*& +& temp332b15 + distpb(i, 2) = 0.0_8 END DO + cb = 0.0_8 DO k=indtm,indtmin,-1 - temp404b11 = DEXP(-(dd5*r(k)**2))*distpb(k, 2) - dd5b = dd5b - r(k)**2*temp404b11 - distpb(k, 2) = 0.0_8 - temp404b12 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - rb(k) = rb(k) - dd2*2*r(k)*temp404b12 - dd5*2*r(k)*temp404b11 - dd2b = dd2b - r(k)**2*temp404b12 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp331 = dd2*r(k) + 1.d0 + temp332b = costb/temp331 + temp331b0 = -(dd1*r(k)**2*temp332b/temp331) + dd1b = dd1b + r(k)**2*temp332b + rb(k) = rb(k) + dd2*temp331b0 + dd1*2*r(k)*temp332b + dd2b = dd2b + r(k)*temp331b0 END DO - ddb(indpar+4) = ddb(indpar+4) + dd5b - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (104) -! 2p double gaussian -! dd1 * x_mu (exp(-dd2 r^2)+dd3 * exp(-dd4*r^2)) + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocg*2.75d0*dd1**1.75D0*cb + ELSE + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocg*2.75d0*dd1**1.75D0*& +& cb + END IF + ddb(indparp) = ddb(indparp) + dd1b + CASE (2100:2199) +! p gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative 1100 + npower = iopt + 1 - 2100 +! indorbp=indorb dd2 = dd(indpar+1) - dd3 = dd(indpar+2) - dd4 = dd(indpar+3) DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k)**2)) - distp(k, 2) = DEXP(-(dd4*r(k)**2)) + distp(k, 1) = -(r(k)**(2*npower)*DEXP(-(dd2*r(k)**2))) END DO -! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = 2.d0*(-(dd2*distp(0, 1))-dd4*dd3*distp(0, 2)) - fun2 = 2.d0*(dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0, 1)+dd4*dd3*(-& -& 1.d0+2.d0*dd4*r(0)**2)*distp(0, 2)) -! indorbp=indorb + rp1 = r(0)**2 + fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 + fun2 = (npower*(2.d0*npower-1.d0)-(1.d0+4.d0*npower)*dd2*rp1+2.d0*& +& (dd2*rp1)**2)*distp(0, 1)*2.d0/rp1 +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -16577,375 +15514,710 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp404b29 = rmu(ic, 0)*zb(indorbp, indt+4) + temp339b2 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp404b29 - fun2b = fun2b + temp404b29 + funb0 = funb0 + 4.d0*temp339b2 + fun2b = fun2b + temp339b2 + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp339b1 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp339b1 + funb0 = funb0 + rmu(ic, 0)*temp339b1 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + distpb = 0.0_8 + temp338 = distp(0, 1)/rp1 + temp339b = 2.d0*temp338*fun2b + temp339b0 = -((npower*4.d0+1.d0)*temp339b) + temp338b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& +& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 + temp337 = distp(0, 1)/rp1 + temp338b0 = 2.d0*temp337*funb0 + dd2b = rp1*temp339b0 - rp1*temp338b0 + 2.d0*rp1**2*2*dd2*temp339b + temp337b = 2.d0*(npower-dd2*rp1)*funb0/rp1 + rp1b = dd2*temp339b0 - temp337*temp337b - temp338*temp338b - dd2*& +& temp338b0 + 2.d0*dd2**2*2*rp1*temp339b + distpb(0, 1) = temp337b + fun0b + temp338b + rb(0) = rb(0) + 2*r(0)*rp1b + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO ic=3,1,-1 + DO i=indtm,i0,-1 + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO k=indtm,indtmin,-1 + temp336 = r(k)**2 + temp335 = 2*npower + temp335b56 = -(r(k)**temp335*DEXP(-(dd2*temp336))*distpb(k, 1)) + IF (r(k) .LE. 0.0 .AND. (temp335 .EQ. 0.0 .OR. temp335 .NE. INT(& +& temp335))) THEN + rb(k) = rb(k) - dd2*2*r(k)*temp335b56 + ELSE + rb(k) = rb(k) - dd2*2*r(k)*temp335b56 - DEXP(-(dd2*temp336))*& +& temp335*r(k)**(temp335-1)*distpb(k, 1) + END IF + dd2b = dd2b - temp336*temp335b56 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (72) +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization obtained by Mathematica + c = dd1**3.25d0*0.79296269381073167718d0 +! C= dd1^13/4 /Sqrt[Integrate[x^12 Exp[-2 x^2],{x,0,Infinity}]] +! endif + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + END DO + DO i=indtmin,indtm + DO k=1,5 + CALL PUSHREAL8(adr8ibuf,adr8buf,zv(k)) + zv(k) = rmu(3, i)**k + CALL PUSHREAL8(adr8ibuf,adr8buf,yv(k)) + yv(k) = rmu(2, i)**k + CALL PUSHREAL8(adr8ibuf,adr8buf,xv(k)) + xv(k) = rmu(1, i)**k + END DO + CALL PUSHREAL8(adr8ibuf,adr8buf,r2) + r2 = xv(2) + yv(2) + zv(2) + CALL PUSHREAL8(adr8ibuf,adr8buf,r4) + r4 = r2*r2 +! lz=0 + distp(i, 2) = cost1h*(63.d0*zv(5)-70.d0*zv(3)*r2+15.d0*zv(1)*r4) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = 21.d0*zv(4) - 14.d0*zv(2)*r2 + r4 +! lz=+/-1 + distp(i, 3) = cost2h*rmu(1, i)*cost +! lz=+/-1 + distp(i, 4) = cost2h*rmu(2, i)*cost + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = 3.d0*zv(3) - zv(1)*r2 +! lz=+/-2 + distp(i, 5) = cost3h*(xv(2)-yv(2))*cost +! lz=+/-2 + distp(i, 6) = 2.d0*cost3h*xv(1)*yv(1)*cost + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = 9.d0*zv(2) - r2 +! lz=+/-3 + distp(i, 7) = cost4h*(xv(3)-3.d0*xv(1)*yv(2))*cost +! lz=+/-3 + distp(i, 8) = -(cost4h*(yv(3)-3.d0*yv(1)*xv(2))*cost) +! lz=+/-4 + distp(i, 9) = cost5h*(xv(4)-6.d0*xv(2)*yv(2)+yv(4))*zv(1) +! lz=+/-4 + distp(i, 10) = cost5h*4.d0*(xv(3)*yv(1)-yv(3)*xv(1))*zv(1) +! lz=+/-5 + distp(i, 11) = cost6h*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4)) +! lz=+/-5 + distp(i, 12) = -(cost6h*(-(5.d0*xv(4)*yv(1))+10.d0*xv(2)*yv(3)-yv(& +& 5))) + END DO + DO ic=1,11 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1) + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) + DO k=1,5 + CALL PUSHREAL8(adr8ibuf,adr8buf,zv(k)) + zv(k) = rmu(3, 0)**k + CALL PUSHREAL8(adr8ibuf,adr8buf,yv(k)) + yv(k) = rmu(2, 0)**k + CALL PUSHREAL8(adr8ibuf,adr8buf,xv(k)) + xv(k) = rmu(1, 0)**k + END DO + CALL PUSHREAL8(adr8ibuf,adr8buf,r2) + r2 = xv(2) + yv(2) + zv(2) + CALL PUSHREAL8(adr8ibuf,adr8buf,r4) + r4 = r2*r2 +! indorbp=indorb + DO ic=1,11 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + IF (ic .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + ELSE IF (ic .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (ic .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE IF (ic .EQ. 4) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (ic .EQ. 5) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + ELSE IF (ic .EQ. 6) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE IF (ic .EQ. 7) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (ic .EQ. 8) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + ELSE IF (ic .EQ. 9) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE IF (ic .EQ. 10) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (ic .EQ. 11) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + END DO + distpb = 0.0_8 + zvb = 0.0_8 + xvb = 0.0_8 + funb0 = 0.0_8 + yvb = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + r2b = 0.0_8 + r4b = 0.0_8 + DO ic=11,1,-1 + temp340b61 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (12.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 12.d0*temp340b61 + fun2b = fun2b + temp340b61 zb(indorbp, indt+4) = 0.0_8 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 6) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + IF (branch .LT. 1) THEN + temp340b11 = cost1h*fun0*zb(indorbp, indt+3) + temp340b12 = cost1h*20.d0*zb(indorbp, indt+2) + temp340b13 = (3.d0*xv(2)+3.d0*yv(2)-4.d0*zv(2))*& +& temp340b12 + temp340b14 = cost1h*20.d0*zb(indorbp, indt+1) + temp340b15 = (3.d0*xv(2)+3.d0*yv(2)-4.d0*zv(2))*& +& temp340b14 + fun0b = fun0b + zv(1)*yv(1)*temp340b13 + zv(1)*xv(1)*& +& temp340b15 + cost1h*(175.d0*zv(4)-150.d0*(zv(2)*r2)+& +& 15.d0*r4)*zb(indorbp, indt+3) + zvb(4) = zvb(4) + 175.d0*temp340b11 + zvb(2) = zvb(2) - 150.d0*r2*temp340b11 + r2b = r2b - 150.d0*zv(2)*temp340b11 + r4b = r4b + 15.d0*temp340b11 + temp340b16 = fun0*yv(1)*zv(1)*temp340b12 + yvb(1) = yvb(1) + zv(1)*fun0*temp340b13 + zvb(1) = zvb(1) + fun0*yv(1)*temp340b13 + xvb(2) = xvb(2) + 3.d0*temp340b16 + temp340b17 = fun0*xv(1)*zv(1)*temp340b14 + yvb(2) = yvb(2) + 3.d0*temp340b17 + 3.d0*temp340b16 + zvb(2) = zvb(2) - 4.d0*temp340b16 + xvb(1) = xvb(1) + zv(1)*fun0*temp340b15 + zvb(1) = zvb(1) + fun0*xv(1)*temp340b15 + xvb(2) = xvb(2) + 3.d0*temp340b17 + zvb(2) = zvb(2) - 4.d0*temp340b17 + ELSE + temp340b18 = cost2h*fun0*zb(indorbp, indt+3) + temp340b19 = -(24.d0*zv(1)*temp340b18) + fun0b = fun0b + cost2h*(4.d0*(xv(3)*yv(1))+4.d0*(xv(1)*& +& yv(3))-24.d0*(xv(1)*yv(1)*zv(2)))*zb(indorbp, indt+2) & +& + cost2h*(5.d0*xv(4)+6.d0*(xv(2)*yv(2))+yv(4)+8.d0*zv(& +& 4)-12.d0*(yv(2)*zv(2))-36.d0*(xv(2)*zv(2)))*zb(indorbp& +& , indt+1) + cost2h*(32.d0*(zv(3)*xv(1))-24.d0*(xv(1)*& +& yv(2)*zv(1))-24.d0*(xv(3)*zv(1)))*zb(indorbp, indt+3) + zvb(3) = zvb(3) + 32.d0*xv(1)*temp340b18 + xvb(1) = xvb(1) + yv(2)*temp340b19 + 32.d0*zv(3)*& +& temp340b18 + yvb(2) = yvb(2) + xv(1)*temp340b19 + zvb(1) = zvb(1) + (-(24.d0*xv(3))-24.d0*xv(1)*yv(2))*& +& temp340b18 + temp340b20 = cost2h*fun0*zb(indorbp, indt+2) + xvb(3) = xvb(3) + 4.d0*yv(1)*temp340b20 - 24.d0*zv(1)*& +& temp340b18 + temp340b21 = -(24.d0*zv(2)*temp340b20) + yvb(1) = yvb(1) + xv(1)*temp340b21 + 4.d0*xv(3)*& +& temp340b20 + xvb(1) = xvb(1) + yv(1)*temp340b21 + 4.d0*yv(3)*& +& temp340b20 + yvb(3) = yvb(3) + 4.d0*xv(1)*temp340b20 + zvb(2) = zvb(2) - 24.d0*xv(1)*yv(1)*temp340b20 + temp340b22 = cost2h*fun0*zb(indorbp, indt+1) + xvb(4) = xvb(4) + 5.d0*temp340b22 + xvb(2) = xvb(2) + (6.d0*yv(2)-36.d0*zv(2))*temp340b22 + yvb(2) = yvb(2) + (6.d0*xv(2)-12.d0*zv(2))*temp340b22 + yvb(4) = yvb(4) + temp340b22 + zvb(4) = zvb(4) + 8.d0*temp340b22 + zvb(2) = zvb(2) + (-(36.d0*xv(2))-12.d0*yv(2))*& +& temp340b22 + END IF + ELSE + temp340b23 = cost2h*fun0*zb(indorbp, indt+3) + temp340b24 = -(24.d0*zv(1)*temp340b23) + fun0b = fun0b + cost2h*(5.d0*yv(4)+6.d0*(xv(2)*yv(2))+xv(4& +& )+8.d0*zv(4)-12.d0*(xv(2)*zv(2))-36.d0*(yv(2)*zv(2)))*zb& +& (indorbp, indt+2) - cost2h*(24.d0*(xv(1)*yv(1)*zv(2))-& +& 4.d0*(xv(1)*yv(3))-4.d0*(xv(3)*yv(1)))*zb(indorbp, indt+& +& 1) + cost2h*(32.d0*(zv(3)*yv(1))-24.d0*(yv(1)*xv(2)*zv(1& +& ))-24.d0*(yv(3)*zv(1)))*zb(indorbp, indt+3) + zvb(3) = zvb(3) + 32.d0*yv(1)*temp340b23 + yvb(1) = yvb(1) + xv(2)*temp340b24 + 32.d0*zv(3)*& +& temp340b23 + temp340b25 = cost2h*fun0*zb(indorbp, indt+2) + xvb(2) = xvb(2) + (6.d0*yv(2)-12.d0*zv(2))*temp340b25 + yv& +& (1)*temp340b24 + zvb(1) = zvb(1) + (-(24.d0*yv(3))-24.d0*yv(1)*xv(2))*& +& temp340b23 + yvb(3) = yvb(3) - 24.d0*zv(1)*temp340b23 + yvb(4) = yvb(4) + 5.d0*temp340b25 + yvb(2) = yvb(2) + (6.d0*xv(2)-36.d0*zv(2))*temp340b25 + xvb(4) = xvb(4) + temp340b25 + zvb(4) = zvb(4) + 8.d0*temp340b25 + temp340b26 = -(cost2h*fun0*zb(indorbp, indt+1)) + zvb(2) = zvb(2) + 24.d0*xv(1)*yv(1)*temp340b26 + (-(36.d0*& +& yv(2))-12.d0*xv(2))*temp340b25 + temp340b27 = 24.d0*zv(2)*temp340b26 + xvb(1) = xvb(1) + yv(1)*temp340b27 - 4.d0*yv(3)*temp340b26 + yvb(1) = yvb(1) + xv(1)*temp340b27 - 4.d0*xv(3)*temp340b26 + yvb(3) = yvb(3) - 4.d0*xv(1)*temp340b26 + xvb(3) = xvb(3) - 4.d0*yv(1)*temp340b26 + END IF + ELSE IF (branch .LT. 5) THEN + IF (branch .LT. 4) THEN + temp340b28 = cost3h*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost3h*(4.d0*(yv(3)*zv(1))-4.d0*(yv(1)*zv(& +& 3)))*zb(indorbp, indt+2) + cost3h*(4.d0*(xv(1)*zv(3))-& +& 4.d0*(xv(3)*zv(1)))*zb(indorbp, indt+1) + cost3h*(yv(4)-& +& xv(4)+6.d0*(xv(2)*zv(2))-6.d0*(yv(2)*zv(2)))*zb(indorbp& +& , indt+3) + yvb(4) = yvb(4) + temp340b28 + xvb(4) = xvb(4) - temp340b28 + xvb(2) = xvb(2) + 6.d0*zv(2)*temp340b28 + zvb(2) = zvb(2) + (6.d0*xv(2)-6.d0*yv(2))*temp340b28 + yvb(2) = yvb(2) - 6.d0*zv(2)*temp340b28 + temp340b29 = cost3h*fun0*zb(indorbp, indt+2) + yvb(3) = yvb(3) + 4.d0*zv(1)*temp340b29 + zvb(1) = zvb(1) + 4.d0*yv(3)*temp340b29 + yvb(1) = yvb(1) - 4.d0*zv(3)*temp340b29 + temp340b30 = cost3h*fun0*zb(indorbp, indt+1) + zvb(3) = zvb(3) + 4.d0*xv(1)*temp340b30 - 4.d0*yv(1)*& +& temp340b29 + xvb(1) = xvb(1) + 4.d0*zv(3)*temp340b30 + xvb(3) = xvb(3) - 4.d0*zv(1)*temp340b30 + zvb(1) = zvb(1) - 4.d0*xv(3)*temp340b30 + ELSE + temp340b31 = -(cost3h*fun0*zb(indorbp, indt+3)) + temp340b32 = -(12.d0*zv(2)*temp340b31) + fun0b = fun0b - cost3h*(2.d0*(xv(3)*zv(1))+6.d0*(xv(1)*yv(& +& 2)*zv(1))-4.d0*(xv(1)*zv(3)))*zb(indorbp, indt+2) - & +& cost3h*(6.d0*(xv(2)*yv(1)*zv(1))+2.d0*(yv(3)*zv(1))-4.d0& +& *(yv(1)*zv(3)))*zb(indorbp, indt+1) - cost3h*(2.d0*(xv(3& +& )*yv(1))+2.d0*(xv(1)*yv(3))-12.d0*(xv(1)*yv(1)*zv(2)))*& +& zb(indorbp, indt+3) + xvb(3) = xvb(3) + 2.d0*yv(1)*temp340b31 + yvb(1) = yvb(1) + xv(1)*temp340b32 + 2.d0*xv(3)*temp340b31 + xvb(1) = xvb(1) + yv(1)*temp340b32 + 2.d0*yv(3)*temp340b31 + yvb(3) = yvb(3) + 2.d0*xv(1)*temp340b31 + zvb(2) = zvb(2) - 12.d0*xv(1)*yv(1)*temp340b31 + temp340b33 = -(cost3h*fun0*zb(indorbp, indt+2)) + temp340b34 = 6.d0*zv(1)*temp340b33 + xvb(3) = xvb(3) + 2.d0*zv(1)*temp340b33 + zvb(1) = zvb(1) + (6.d0*xv(1)*yv(2)+2.d0*xv(3))*temp340b33 + xvb(1) = xvb(1) + yv(2)*temp340b34 - 4.d0*zv(3)*temp340b33 + yvb(2) = yvb(2) + xv(1)*temp340b34 + zvb(3) = zvb(3) - 4.d0*xv(1)*temp340b33 + temp340b35 = -(cost3h*fun0*zb(indorbp, indt+1)) + temp340b36 = 6.d0*zv(1)*temp340b35 + xvb(2) = xvb(2) + yv(1)*temp340b36 + yvb(1) = yvb(1) + xv(2)*temp340b36 - 4.d0*zv(3)*temp340b35 + zvb(1) = zvb(1) + (2.d0*yv(3)+6.d0*xv(2)*yv(1))*temp340b35 + yvb(3) = yvb(3) + 2.d0*zv(1)*temp340b35 + zvb(3) = zvb(3) - 4.d0*yv(1)*temp340b35 + END IF + ELSE + temp340b37 = cost4h*fun0*zb(indorbp, indt+3) + temp340b38 = -(48.d0*zv(1)*temp340b37) + fun0b = fun0b + cost4h*(4.d0*(xv(3)*yv(1))+12.d0*(xv(1)*yv(3& +& ))-48.d0*(xv(1)*yv(1)*zv(2)))*zb(indorbp, indt+2) + cost4h& +& *(6.d0*(xv(2)*yv(2))-5.d0*xv(4)+3.d0*yv(4)+24.d0*(xv(2)*zv& +& (2))-24.d0*(yv(2)*zv(2)))*zb(indorbp, indt+1) + cost4h*(& +& 16.d0*(xv(3)*zv(1))-48.d0*(xv(1)*yv(2)*zv(1)))*zb(indorbp& +& , indt+3) + xvb(3) = xvb(3) + 16.d0*zv(1)*temp340b37 + zvb(1) = zvb(1) + (16.d0*xv(3)-48.d0*xv(1)*yv(2))*temp340b37 + xvb(1) = xvb(1) + yv(2)*temp340b38 + yvb(2) = yvb(2) + xv(1)*temp340b38 + temp340b39 = cost4h*fun0*zb(indorbp, indt+2) + temp340b40 = -(48.d0*zv(2)*temp340b39) + xvb(3) = xvb(3) + 4.d0*yv(1)*temp340b39 + yvb(1) = yvb(1) + xv(1)*temp340b40 + 4.d0*xv(3)*temp340b39 + xvb(1) = xvb(1) + yv(1)*temp340b40 + 12.d0*yv(3)*temp340b39 + yvb(3) = yvb(3) + 12.d0*xv(1)*temp340b39 + temp340b41 = cost4h*fun0*zb(indorbp, indt+1) + zvb(2) = zvb(2) + (24.d0*xv(2)-24.d0*yv(2))*temp340b41 - & +& 48.d0*xv(1)*yv(1)*temp340b39 + xvb(2) = xvb(2) + (24.d0*zv(2)+6.d0*yv(2))*temp340b41 + yvb(2) = yvb(2) + (6.d0*xv(2)-24.d0*zv(2))*temp340b41 + xvb(4) = xvb(4) - 5.d0*temp340b41 + yvb(4) = yvb(4) + 3.d0*temp340b41 + END IF + ELSE IF (branch .LT. 9) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 7) THEN + temp340b42 = -(cost4h*fun0*zb(indorbp, indt+3)) + temp340b43 = -(48.d0*zv(1)*temp340b42) + fun0b = fun0b - cost4h*(3.d0*xv(4)+6.d0*(xv(2)*yv(2))-5.d0& +& *yv(4)+24.d0*(yv(2)*zv(2))-24.d0*(xv(2)*zv(2)))*zb(& +& indorbp, indt+2) - cost4h*(12.d0*(xv(3)*yv(1))+4.d0*(xv(& +& 1)*yv(3))-48.d0*(xv(1)*yv(1)*zv(2)))*zb(indorbp, indt+1)& +& - cost4h*(16.d0*(yv(3)*zv(1))-48.d0*(xv(2)*yv(1)*zv(1)))& +& *zb(indorbp, indt+3) + yvb(3) = yvb(3) + 16.d0*zv(1)*temp340b42 + zvb(1) = zvb(1) + (16.d0*yv(3)-48.d0*xv(2)*yv(1))*& +& temp340b42 + xvb(2) = xvb(2) + yv(1)*temp340b43 + yvb(1) = yvb(1) + xv(2)*temp340b43 + temp340b44 = -(cost4h*fun0*zb(indorbp, indt+2)) + xvb(4) = xvb(4) + 3.d0*temp340b44 + xvb(2) = xvb(2) + (6.d0*yv(2)-24.d0*zv(2))*temp340b44 + yvb(2) = yvb(2) + (24.d0*zv(2)+6.d0*xv(2))*temp340b44 + yvb(4) = yvb(4) - 5.d0*temp340b44 + temp340b45 = -(cost4h*fun0*zb(indorbp, indt+1)) + zvb(2) = zvb(2) + (24.d0*yv(2)-24.d0*xv(2))*temp340b44 - & +& 48.d0*xv(1)*yv(1)*temp340b45 + temp340b46 = -(48.d0*zv(2)*temp340b45) + xvb(3) = xvb(3) + 12.d0*yv(1)*temp340b45 + yvb(1) = yvb(1) + xv(1)*temp340b46 + 12.d0*xv(3)*& +& temp340b45 + xvb(1) = xvb(1) + yv(1)*temp340b46 + 4.d0*yv(3)*temp340b45 + yvb(3) = yvb(3) + 4.d0*xv(1)*temp340b45 + ELSE + temp340b47 = cost5h*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost5h*(4.d0*(yv(3)*zv(1))-12.d0*(xv(2)*yv& +& (1)*zv(1)))*zb(indorbp, indt+2) + cost5h*(4.d0*(xv(3)*zv& +& (1))-12.d0*(xv(1)*yv(2)*zv(1)))*zb(indorbp, indt+1) + & +& cost5h*(xv(4)-6.d0*(xv(2)*yv(2))+yv(4))*zb(indorbp, indt& +& +3) + xvb(4) = xvb(4) + temp340b47 + temp340b48 = cost5h*fun0*zb(indorbp, indt+2) + temp340b49 = -(12.d0*zv(1)*temp340b48) + xvb(2) = xvb(2) + yv(1)*temp340b49 - 6.d0*yv(2)*temp340b47 + yvb(2) = yvb(2) - 6.d0*xv(2)*temp340b47 + yvb(4) = yvb(4) + temp340b47 + yvb(3) = yvb(3) + 4.d0*zv(1)*temp340b48 + temp340b50 = cost5h*fun0*zb(indorbp, indt+1) + zvb(1) = zvb(1) + (4.d0*xv(3)-12.d0*xv(1)*yv(2))*& +& temp340b50 + (4.d0*yv(3)-12.d0*xv(2)*yv(1))*temp340b48 + yvb(1) = yvb(1) + xv(2)*temp340b49 + temp340b51 = -(12.d0*zv(1)*temp340b50) + xvb(3) = xvb(3) + 4.d0*zv(1)*temp340b50 + xvb(1) = xvb(1) + yv(2)*temp340b51 + yvb(2) = yvb(2) + xv(1)*temp340b51 + END IF + ELSE + temp340b52 = -(cost5h*fun0*zb(indorbp, indt+3)) + fun0b = fun0b - cost5h*(12.d0*(xv(1)*yv(2)*zv(1))-4.d0*(xv(3& +& )*zv(1)))*zb(indorbp, indt+2) - cost5h*(4.d0*(yv(3)*zv(1))& +& -12.d0*(xv(2)*yv(1)*zv(1)))*zb(indorbp, indt+1) - cost5h*(& +& 4.d0*(xv(1)*yv(3))-4.d0*(xv(3)*yv(1)))*zb(indorbp, indt+3) + xvb(1) = xvb(1) + 4.d0*yv(3)*temp340b52 + yvb(3) = yvb(3) + 4.d0*xv(1)*temp340b52 + xvb(3) = xvb(3) - 4.d0*yv(1)*temp340b52 + yvb(1) = yvb(1) - 4.d0*xv(3)*temp340b52 + temp340b53 = -(cost5h*fun0*zb(indorbp, indt+2)) + temp340b54 = 12.d0*zv(1)*temp340b53 + xvb(1) = xvb(1) + yv(2)*temp340b54 + yvb(2) = yvb(2) + xv(1)*temp340b54 + temp340b55 = -(cost5h*fun0*zb(indorbp, indt+1)) + zvb(1) = zvb(1) + (4.d0*yv(3)-12.d0*xv(2)*yv(1))*temp340b55 & +& + (12.d0*xv(1)*yv(2)-4.d0*xv(3))*temp340b53 + xvb(3) = xvb(3) - 4.d0*zv(1)*temp340b53 + temp340b56 = -(12.d0*zv(1)*temp340b55) + yvb(3) = yvb(3) + 4.d0*zv(1)*temp340b55 + xvb(2) = xvb(2) + yv(1)*temp340b56 + yvb(1) = yvb(1) + xv(2)*temp340b56 + END IF + ELSE IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + temp340b57 = cost6h*fun0*zb(indorbp, indt+2) + fun0b = fun0b + cost6h*(5.d0*xv(4)-30.d0*(xv(2)*yv(2))+5.d0*& +& yv(4))*zb(indorbp, indt+1) + cost6h*(20.d0*(xv(1)*yv(3))-& +& 20.d0*(xv(3)*yv(1)))*zb(indorbp, indt+2) + xvb(1) = xvb(1) + 20.d0*yv(3)*temp340b57 + yvb(3) = yvb(3) + 20.d0*xv(1)*temp340b57 + xvb(3) = xvb(3) - 20.d0*yv(1)*temp340b57 + yvb(1) = yvb(1) - 20.d0*xv(3)*temp340b57 + temp340b58 = cost6h*fun0*zb(indorbp, indt+1) + xvb(4) = xvb(4) + 5.d0*temp340b58 + xvb(2) = xvb(2) - 30.d0*yv(2)*temp340b58 + yvb(2) = yvb(2) - 30.d0*xv(2)*temp340b58 + yvb(4) = yvb(4) + 5.d0*temp340b58 + END IF + ELSE + temp340b59 = -(cost6h*fun0*zb(indorbp, indt+2)) + fun0b = fun0b - cost6h*(20.d0*(xv(1)*yv(3))-20.d0*(xv(3)*yv(1)& +& ))*zb(indorbp, indt+1) - cost6h*(30.d0*(xv(2)*yv(2))-5.d0*xv& +& (4)-5.d0*yv(4))*zb(indorbp, indt+2) + xvb(2) = xvb(2) + 30.d0*yv(2)*temp340b59 + yvb(2) = yvb(2) + 30.d0*xv(2)*temp340b59 + xvb(4) = xvb(4) - 5.d0*temp340b59 + yvb(4) = yvb(4) - 5.d0*temp340b59 + temp340b60 = -(cost6h*fun0*zb(indorbp, indt+1)) + xvb(1) = xvb(1) + 20.d0*yv(3)*temp340b60 + yvb(3) = yvb(3) + 20.d0*xv(1)*temp340b60 + xvb(3) = xvb(3) - 20.d0*yv(1)*temp340b60 + yvb(1) = yvb(1) - 20.d0*xv(3)*temp340b60 + END IF DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp404b28 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp404b28 - funb = funb + rmu(ic, 0)*temp404b28 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + temp340b10 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp340b10 + funb0 = funb0 + rmu(i, 0)*temp340b10 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp404b22 = 2.d0*fun2b - temp404b23 = dd2*distp(0, 1)*2.d0*temp404b22 - temp404b24 = (2.d0*(dd2*r(0)**2)-1.d0)*temp404b22 - temp404b25 = (2.d0*(dd4*r(0)**2)-1.d0)*temp404b22 - temp404b26 = dd4*dd3*distp(0, 2)*2.d0*temp404b22 - temp404b27 = 2.d0*funb - dd2b = distp(0, 1)*temp404b24 - distp(0, 1)*temp404b27 + r(0)**2*& -& temp404b23 - rb(0) = rb(0) + dd4*2*r(0)*temp404b26 + dd2*2*r(0)*temp404b23 - distpb(0, 1) = dd2*temp404b24 - dd4b = r(0)**2*temp404b26 - distp(0, 2)*dd3*temp404b27 + distp(0, & -& 2)*dd3*temp404b25 - dd3b = distp(0, 2)*fun0b - distp(0, 2)*dd4*temp404b27 + distp(0, 2& -& )*dd4*temp404b25 - distpb(0, 2) = dd4*dd3*temp404b25 - distpb(0, 1) = distpb(0, 1) - dd2*temp404b27 - distpb(0, 2) = distpb(0, 2) - dd4*dd3*temp404b27 - distpb(0, 1) = distpb(0, 1) + fun0b - distpb(0, 2) = distpb(0, 2) + dd3*fun0b - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - dd3b = 0.0_8 - dd4b = 0.0_8 - END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - temp404b21 = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& -& indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp404b21 - dd3b = dd3b + distp(i, 2)*temp404b21 - distpb(i, 2) = distpb(i, 2) + dd3*temp404b21 - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO k=indtm,indtmin,-1 - temp404b19 = DEXP(-(dd4*r(k)**2))*distpb(k, 2) - dd4b = dd4b - r(k)**2*temp404b19 - distpb(k, 2) = 0.0_8 - temp404b20 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - rb(k) = rb(k) - dd2*2*r(k)*temp404b20 - dd4*2*r(k)*temp404b19 - dd2b = dd2b - r(k)**2*temp404b20 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (103) -! 2p single gaussian - dd2 = dd(indpar+1) - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k)**2)) - END DO -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)*2.d0) - fun2 = 2.d0*dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0, 1) -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp404b34 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp404b34 - fun2b = fun2b + temp404b34 - zb(indorbp, indt+4) = 0.0_8 - fun0b = fun0b + zb(indorbp, indt+ic) - DO i=3,1,-1 - temp404b33 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp404b33 - funb = funb + rmu(ic, 0)*temp404b33 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + CALL POPREAL8(adr8ibuf,adr8buf,r4) + r2b = r2b + 2*r2*r4b + CALL POPREAL8(adr8ibuf,adr8buf,r2) + xvb(2) = xvb(2) + r2b + yvb(2) = yvb(2) + r2b + zvb(2) = zvb(2) + r2b + DO k=5,1,-1 + CALL POPREAL8(adr8ibuf,adr8buf,xv(k)) + IF (.NOT.(rmu(1, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(1, 0) = rmub(1, 0) + k*rmu(1, 0)**(k-1)*xvb(k) + xvb(k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,yv(k)) + IF (.NOT.(rmu(2, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(2, 0) = rmub(2, 0) + k*rmu(2, 0)**(k-1)*yvb(k) + yvb(k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,zv(k)) + IF (.NOT.(rmu(3, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(3, 0) = rmub(3, 0) + k*rmu(3, 0)**(k-1)*zvb(k) + zvb(k) = 0.0_8 END DO - distpb = 0.0_8 - temp404b31 = 2.d0**2*dd2*distp(0, 1)*fun2b - temp404b32 = 2.d0*(2.d0*(dd2*r(0)**2)-1.d0)*fun2b - dd2b = distp(0, 1)*temp404b32 - 2.d0*distp(0, 1)*funb + r(0)**2*& -& temp404b31 - rb(0) = rb(0) + dd2*2*r(0)*temp404b31 - distpb(0, 1) = fun0b - 2.d0*dd2*funb + dd2*temp404b32 + temp340b9 = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp340b9 - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp340b9 + distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb0 + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd2b = 0.0_8 + zvb = 0.0_8 + xvb = 0.0_8 + yvb = 0.0_8 END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=11,1,-1 + DO k=indtm,i0,-1 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO k=indtm,indtmin,-1 - temp404b30 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp404b30 - rb(k) = rb(k) - dd2*2*r(k)*temp404b30 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (105) -! 2s double gaussian without constant -! (exp (-dd2 r^2)+dd4*exp(-dd5*r^2)) -! dd1=1.d0 - dd2 = dd(indpar+1) -! dd3=dd(indpar+2) -! dd4=dd(indpar+3) -! dd5=dd(indpar+4) - dd4 = dd(indpar+2) - dd5 = dd(indpar+3) - indorbp = indorb + 1 - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) - distp(k, 2) = DEXP(-(dd5*r(k)*r(k))) - END DO -! write(6,*) ' function inside = ',z(indorbp,i) -! endif - IF (typec .NE. 1) THEN - fun = -(2.d0*(dd2*distp(0, 1)+dd5*dd4*distp(0, 2))) - fun2 = r(0)**2 - distpb = 0.0_8 - temp404b38 = 2.d0*zb(indorbp, indt+4) - temp404b39 = dd2*distp(0, 1)*2.d0*temp404b38 - temp404b40 = (2.d0*(dd2*fun2)-3.d0)*temp404b38 - temp404b41 = (2.d0*(dd5*fun2)-3.d0)*temp404b38 - temp404b42 = dd5*dd4*distp(0, 2)*2.d0*temp404b38 - dd2b = distp(0, 1)*temp404b40 + fun2*temp404b39 - fun2b = dd5*temp404b42 + dd2*temp404b39 - distpb(0, 1) = dd2*temp404b40 - dd5b = fun2*temp404b42 + distp(0, 2)*dd4*temp404b41 - dd4b = distp(0, 2)*dd5*temp404b41 - distpb(0, 2) = dd5*dd4*temp404b41 - zb(indorbp, indt+4) = 0.0_8 - funb = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 + DO i=indtm,indtmin,-1 + temp340b = -(cost6h*distpb(i, 12)) + xvb(2) = xvb(2) + 10.d0*yv(3)*temp340b + yvb(3) = yvb(3) + 10.d0*xv(2)*temp340b + xvb(4) = xvb(4) - 5.d0*yv(1)*temp340b + yvb(1) = yvb(1) - 5.d0*xv(4)*temp340b + yvb(5) = yvb(5) - temp340b + distpb(i, 12) = 0.0_8 + temp340b0 = cost6h*distpb(i, 11) + xvb(5) = xvb(5) + temp340b0 + xvb(3) = xvb(3) - 10.d0*yv(2)*temp340b0 + yvb(2) = yvb(2) - 10.d0*xv(3)*temp340b0 + xvb(1) = xvb(1) + 5.d0*yv(4)*temp340b0 + yvb(4) = yvb(4) + 5.d0*xv(1)*temp340b0 + distpb(i, 11) = 0.0_8 + temp340b1 = cost5h*4.d0*distpb(i, 10) + temp340b2 = zv(1)*temp340b1 + xvb(3) = xvb(3) + yv(1)*temp340b2 + yvb(1) = yvb(1) + xv(3)*temp340b2 + yvb(3) = yvb(3) - xv(1)*temp340b2 + xvb(1) = xvb(1) - yv(3)*temp340b2 + distpb(i, 10) = 0.0_8 + zvb(1) = zvb(1) + cost5h*(xv(4)-6.d0*(xv(2)*yv(2))+yv(4))*distpb(i& +& , 9) + (xv(3)*yv(1)-yv(3)*xv(1))*temp340b1 + temp340b3 = cost5h*zv(1)*distpb(i, 9) + xvb(4) = xvb(4) + temp340b3 + distpb(i, 9) = 0.0_8 + temp340b4 = -(cost4h*cost*distpb(i, 8)) + xvb(2) = xvb(2) - 3.d0*yv(1)*temp340b4 - 6.d0*yv(2)*temp340b3 + yvb(2) = yvb(2) - 6.d0*xv(2)*temp340b3 + yvb(4) = yvb(4) + temp340b3 + yvb(3) = yvb(3) + temp340b4 + yvb(1) = yvb(1) - 3.d0*xv(2)*temp340b4 + costb = -(cost4h*(yv(3)-3.d0*(yv(1)*xv(2)))*distpb(i, 8)) + distpb(i, 8) = 0.0_8 + temp340b5 = cost4h*cost*distpb(i, 7) + xvb(3) = xvb(3) + temp340b5 + costb = costb + cost4h*(xv(3)-3.d0*(xv(1)*yv(2)))*distpb(i, 7) + distpb(i, 7) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp340b6 = cost3h*2.d0*distpb(i, 6) + xvb(1) = xvb(1) + yv(1)*cost*temp340b6 - 3.d0*yv(2)*temp340b5 + yvb(2) = yvb(2) - 3.d0*xv(1)*temp340b5 + zvb(2) = zvb(2) + 9.d0*costb + r2b = -costb + distpb(i, 6) = 0.0_8 + temp340b7 = cost3h*distpb(i, 5) + costb = (xv(2)-yv(2))*temp340b7 + yv(1)*xv(1)*temp340b6 + yvb(1) = yvb(1) + xv(1)*cost*temp340b6 + xvb(2) = xvb(2) + cost*temp340b7 + yvb(2) = yvb(2) - cost*temp340b7 + distpb(i, 5) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + zvb(3) = zvb(3) + 3.d0*costb + zvb(1) = zvb(1) - r2*costb + r2b = r2b - zv(1)*costb + rmub(2, i) = rmub(2, i) + cost2h*cost*distpb(i, 4) + costb = cost2h*rmu(2, i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost2h*cost*distpb(i, 3) + costb = costb + cost2h*rmu(1, i)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + zvb(4) = zvb(4) + 21.d0*costb + zvb(2) = zvb(2) - 14.d0*r2*costb + temp340b8 = cost1h*distpb(i, 2) + r4b = 15.d0*zv(1)*temp340b8 + costb + r2b = r2b + 2*r2*r4b - 70.d0*zv(3)*temp340b8 - 14.d0*zv(2)*costb + zvb(5) = zvb(5) + 63.d0*temp340b8 + zvb(3) = zvb(3) - 70.d0*r2*temp340b8 + zvb(1) = zvb(1) + 15.d0*r4*temp340b8 + distpb(i, 2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,r4) + CALL POPREAL8(adr8ibuf,adr8buf,r2) + xvb(2) = xvb(2) + r2b + yvb(2) = yvb(2) + r2b + zvb(2) = zvb(2) + r2b + DO k=5,1,-1 + CALL POPREAL8(adr8ibuf,adr8buf,xv(k)) + IF (.NOT.(rmu(1, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(1, i) = rmub(1, i) + k*rmu(1, i)**(k-1)*xvb(k) + xvb(k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,yv(k)) + IF (.NOT.(rmu(2, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(2, i) = rmub(2, i) + k*rmu(2, i)**(k-1)*yvb(k) + yvb(k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,zv(k)) + IF (.NOT.(rmu(3, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(3, i) = rmub(3, i) + k*rmu(3, i)**(k-1)*zvb(k) + zvb(k) = 0.0_8 END DO - rb(0) = rb(0) + 2*r(0)*fun2b - temp404b37 = -(2.d0*funb) - dd2b = dd2b + distp(0, 1)*temp404b37 - distpb(0, 1) = distpb(0, 1) + dd2*temp404b37 - dd5b = dd5b + distp(0, 2)*dd4*temp404b37 - dd4b = dd4b + distp(0, 2)*dd5*temp404b37 - distpb(0, 2) = distpb(0, 2) + dd5*dd4*temp404b37 - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - dd4b = 0.0_8 - dd5b = 0.0_8 - END IF - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd4b = dd4b + distp(i, 2)*zb(indorbp, i) - distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 END DO + dd1b = 0.0_8 + cb = 0.0_8 DO k=indtm,indtmin,-1 - temp404b35 = DEXP(-(dd5*r(k)**2))*distpb(k, 2) - dd5b = dd5b - r(k)**2*temp404b35 - distpb(k, 2) = 0.0_8 - temp404b36 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - rb(k) = rb(k) - dd2*2*r(k)*temp404b36 - dd5*2*r(k)*temp404b35 - dd2b = dd2b - r(k)**2*temp404b36 + temp339 = r(k)**2 + temp339b3 = c*DEXP(-(dd1*temp339))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp339))*distpb(k, 1) + dd1b = dd1b - temp339*temp339b3 + rb(k) = rb(k) - dd1*2*r(k)*temp339b3 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+3) = ddb(indpar+3) + dd5b - ddb(indpar+2) = ddb(indpar+2) + dd4b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (106) -! 2s without cusp condition -! dd1*( dd3 +1/(1+dd2*r^2)) + dd1b = dd1b + 0.79296269381073167718d0*3.25d0*dd1**2.25D0*cb + ddb(indparp) = ddb(indparp) + dd1b + CASE (152) +! 2s gaussian for pseudo +! 2s with cusp condition +! ( r^3*exp(-dd2*r^2)) ! with no cusp condition dd2 = dd(indpar+1) indorbp = indorb + 1 DO k=indtmin,indtm - distp(k, 1) = 1.d0/(1.d0+dd2*r(k)*r(k)) + distp(k, 1) = DEXP(-(dd2*r(k)**2))*r(k) END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)**2*2.d0) + rp1 = r(0)**2*dd2 + fun = (3.d0-2.d0*rp1)*distp(0, 1) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) - funb = 2.d0*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp405b = (1.-3.d0*(dd2*r(0)**2))*fun2b - temp405b0 = -(fun*distp(0, 1)*3.d0*fun2b) - funb = funb + distp(0, 1)*temp405b - distpb(0, 1) = fun*temp405b - 2.d0*dd2*2*distp(0, 1)*funb - dd2b = r(0)**2*temp405b0 - 2.d0*distp(0, 1)**2*funb - rb(0) = rb(0) + dd2*2*r(0)*temp405b0 - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - dd3b = 0.0_8 - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=indtm,indtmin,-1 - temp404 = dd2*r(k)**2 + 1.d0 - temp404b43 = -(distpb(k, 1)/temp404**2) - dd2b = dd2b + r(k)**2*temp404b43 - rb(k) = rb(k) + dd2*2*r(k)*temp404b43 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (107) -! 2p single lorentian parent of 103 - dd2 = dd(indpar+1) - DO k=indtmin,indtm - distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**2) - END DO -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)**2*2.d0) - fun2 = fun*distp(0, 1)*(1.d0-3.d0*dd2*r(0)**2) -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp406b2 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp406b2 - fun2b = fun2b + temp406b2 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp406b1 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp406b1 - funb = funb + rmu(ic, 0)*temp406b1 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - distpb = 0.0_8 - temp406b = (1.d0-3.d0*(dd2*r(0)**2))*fun2b - temp406b0 = -(fun*distp(0, 1)*3.d0*fun2b) - funb = funb + distp(0, 1)*temp406b - distpb(0, 1) = fun0b - 2.d0*dd2*2*distp(0, 1)*funb + fun*temp406b - dd2b = r(0)**2*temp406b0 - 2.d0*distp(0, 1)**2*funb - rb(0) = rb(0) + dd2*2*r(0)*temp406b0 - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + rp1b = (distp(0, 1)*4.d0*2*rp1-distp(0, 1)*14.d0)*fun2b - distp(0& +& , 1)*2.d0*funb0 + distpb(0, 1) = (3.d0-2.d0*rp1)*funb0 + (4.d0*rp1**2-14.d0*rp1+6.d0& +& )*fun2b + rb(0) = rb(0) + dd2*2*r(0)*rp1b + dd2b = r(0)**2*rp1b + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO i=indtm,i0,-1 + distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO DO k=indtm,indtmin,-1 - temp405 = dd2*r(k)**2 + 1.d0 - temp405b1 = -(distpb(k, 1)/temp405**2) - dd2b = dd2b + r(k)**2*temp405b1 - rb(k) = rb(k) + dd2*2*r(k)*temp405b1 + temp340 = r(k)**2 + temp340b62 = r(k)*DEXP(-(dd2*temp340))*distpb(k, 1) + dd2b = dd2b - temp340*temp340b62 + rb(k) = rb(k) + DEXP(-(dd2*temp340))*distpb(k, 1) - dd2*2*r(k)*& +& temp340b62 distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (108) -! 2s double lorentian with constant parent of 102 -! (dd3+ L(dd2 r^2)+dd4*L(dd5*r^2)) ; L(x)=1/1+x^2 + CASE (126) +! 2s double exp with constant +! (dd3+ exp (-dd2 r)+dd4*exp(-dd5*r)) dd2 = dd(indpar+1) dd4 = dd(indpar+3) dd5 = dd(indpar+4) indorbp = indorb + 1 DO k=indtmin,indtm - distp(k, 1) = 1.d0/(1.d0+dd2*r(k)*r(k)) - distp(k, 2) = 1.d0/(1.d0+dd5*r(k)*r(k)) + distp(k, 1) = DEXP(-(dd2*r(k))) + distp(k, 2) = DEXP(-(dd5*r(k))) END DO -! write(6,*) ' function inside = ',z(indorbp,i) -! endif +! write(6,*) ' function inside = ',z(indorbp,i) +! endif IF (typec .NE. 1) THEN - fun = -(2.d0*(dd2*distp(0, 1)**2+dd5*dd4*distp(0, 2)**2)) + fun = -((dd2*distp(0, 1)+dd5*dd4*distp(0, 2))/r(0)) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) - funb = 2.d0*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp409 = distp(0, 1)**3 - temp409b = 2.d0*(3.d0*(dd2*r(0)**2)-1.d0)*fun2b - temp409b0 = 2.d0*dd2*temp409*3.d0*fun2b - temp408 = distp(0, 2)**3 - temp408b = 2.d0*(3.d0*(dd5*r(0)**2)-1.d0)*fun2b - temp408b0 = 2.d0*dd5*dd4*temp408*3.d0*fun2b - temp408b1 = -(2.d0*funb) - dd2b = distp(0, 1)**2*temp408b1 + r(0)**2*temp409b0 + temp409*& -& temp409b - distpb(0, 1) = dd2*3*distp(0, 1)**2*temp409b - rb(0) = rb(0) + dd5*2*r(0)*temp408b0 + dd2*2*r(0)*temp409b0 - temp408b2 = distp(0, 2)**2*temp408b1 - dd5b = dd4*temp408b2 + r(0)**2*temp408b0 + temp408*dd4*temp408b - dd4b = dd5*temp408b2 + temp408*dd5*temp408b - distpb(0, 2) = dd5*dd4*3*distp(0, 2)**2*temp408b - distpb(0, 1) = distpb(0, 1) + dd2*2*distp(0, 1)*temp408b1 - distpb(0, 2) = distpb(0, 2) + dd5*dd4*2*distp(0, 2)*temp408b1 + temp341b1 = dd5**2*fun2b + temp341b2 = -(funb0/r(0)) + dd2b = distp(0, 1)*temp341b2 + distp(0, 1)*2*dd2*fun2b + distpb(0, 1) = dd2**2*fun2b + dd5b = distp(0, 2)*dd4*temp341b2 + dd4*distp(0, 2)*2*dd5*fun2b + dd4b = distp(0, 2)*dd5*temp341b2 + distp(0, 2)*temp341b1 + distpb(0, 2) = dd4*temp341b1 + distpb(0, 1) = distpb(0, 1) + dd2*temp341b2 + distpb(0, 2) = distpb(0, 2) + dd5*dd4*temp341b2 + rb(0) = rb(0) - (dd2*distp(0, 1)+dd5*dd4*distp(0, 2))*temp341b2/r(& +& 0) ELSE distpb = 0.0_8 dd2b = 0.0_8 @@ -16961,195 +16233,83 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & zb(indorbp, i) = 0.0_8 END DO DO k=indtm,indtmin,-1 - temp407 = dd5*r(k)**2 + 1.d0 - temp407b = -(distpb(k, 2)/temp407**2) - dd5b = dd5b + r(k)**2*temp407b + temp341b = DEXP(-(dd5*r(k)))*distpb(k, 2) + dd5b = dd5b - r(k)*temp341b distpb(k, 2) = 0.0_8 - temp406 = dd2*r(k)**2 + 1.d0 - temp406b3 = -(distpb(k, 1)/temp406**2) - rb(k) = rb(k) + dd2*2*r(k)*temp406b3 + dd5*2*r(k)*temp407b - dd2b = dd2b + r(k)**2*temp406b3 + temp341b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd2*temp341b0 - dd5*temp341b + dd2b = dd2b - r(k)*temp341b0 distpb(k, 1) = 0.0_8 END DO ddb(indpar+4) = ddb(indpar+4) + dd5b ddb(indpar+3) = ddb(indpar+3) + dd4b ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (109) -! 2p double Lorentian -! dd1 * x_mu (L(dd2 r^2)+dd3 * L(dd4*r^2)) ; L(x)=1/(1+x^2) - dd2 = dd(indpar+1) - dd3 = dd(indpar+2) - dd4 = dd(indpar+3) - DO k=indtmin,indtm - distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**2) - distp(k, 2) = 1.d0/(1.d0+dd4*r(k)**2) - END DO -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun = 2.d0*(-(dd2*distp(0, 1)**2)-dd4*dd3*distp(0, 2)**2) -! fun2=2.d0*(dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0,1) -! 1+dd4*dd3*(-1.d0+2.d0*dd4*r(0)**2)*distp(0,2)) - fun2 = 2*dd2*distp(0, 1)**3*(-1.d0+3.d0*dd2*r(0)**2) + 2*dd3*dd4*& -& distp(0, 2)**3*(-1.d0+3.d0*dd4*r(0)**2) -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp414b0 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp414b0 - fun2b = fun2b + temp414b0 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp414b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp414b - funb = funb + rmu(ic, 0)*temp414b - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - distpb = 0.0_8 - temp413 = distp(0, 1)**3 - temp413b = 2*(3.d0*(dd2*r(0)**2)-1.d0)*fun2b - temp413b0 = 2*dd2*temp413*3.d0*fun2b - temp412 = distp(0, 2)**3 - temp412b0 = 2*(3.d0*(dd4*r(0)**2)-1.d0)*fun2b - temp412b1 = 2*dd3*dd4*temp412*3.d0*fun2b - temp412b2 = 2.d0*funb - dd2b = r(0)**2*temp413b0 - distp(0, 1)**2*temp412b2 + temp413*& -& temp413b - distpb(0, 1) = dd2*3*distp(0, 1)**2*temp413b - rb(0) = rb(0) + dd4*2*r(0)*temp412b1 + dd2*2*r(0)*temp413b0 - temp412b3 = -(distp(0, 2)**2*temp412b2) - dd3b = dd4*temp412b3 + distp(0, 2)*fun0b + temp412*dd4*temp412b0 - dd4b = dd3*temp412b3 + r(0)**2*temp412b1 + temp412*dd3*temp412b0 - distpb(0, 2) = dd3*dd4*3*distp(0, 2)**2*temp412b0 - distpb(0, 1) = distpb(0, 1) - dd2*2*distp(0, 1)*temp412b2 - distpb(0, 2) = distpb(0, 2) - dd4*dd3*2*distp(0, 2)*temp412b2 - distpb(0, 1) = distpb(0, 1) + fun0b - distpb(0, 2) = distpb(0, 2) + dd3*fun0b - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - dd3b = 0.0_8 - dd4b = 0.0_8 - END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - temp412b = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& -& indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp412b - dd3b = dd3b + distp(i, 2)*temp412b - distpb(i, 2) = distpb(i, 2) + dd3*temp412b - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO k=indtm,indtmin,-1 - temp411 = dd4*r(k)**2 + 1.d0 - temp411b = -(distpb(k, 2)/temp411**2) - dd4b = dd4b + r(k)**2*temp411b - distpb(k, 2) = 0.0_8 - temp410 = dd2*r(k)**2 + 1.d0 - temp410b = -(distpb(k, 1)/temp410**2) - rb(k) = rb(k) + dd2*2*r(k)*temp410b + dd4*2*r(k)*temp411b - dd2b = dd2b + r(k)**2*temp410b - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (110) -! 2s without cusp condition -! dd1*( dd3 +1/(1+dd2*r^3)) + CASE (153) +! 2s with cusp condition +! (-r^5*exp(-dd2*r^2)) ! derivative of 152 dd2 = dd(indpar+1) indorbp = indorb + 1 DO k=indtmin,indtm - distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**3) + distp(k, 1) = DEXP(-(dd2*r(k)**2))*r(k)**3 END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)**2*3.d0*r(0)) + rp1 = dd2*r(0)**2 + fun = (-5.d0+2.d0*rp1)*distp(0, 1) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) - funb = 2.d0*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp415 = r(0)**3 - temp415b = (2.d0-4.d0*(dd2*temp415))*fun2b - temp415b0 = -(fun*distp(0, 1)*4.d0*fun2b) - funb = funb + distp(0, 1)*temp415b - distpb(0, 1) = fun*temp415b - 3.d0*dd2*r(0)*2*distp(0, 1)*funb - temp415b1 = -(3.d0*distp(0, 1)**2*funb) - dd2b = r(0)*temp415b1 + temp415*temp415b0 - rb(0) = rb(0) + dd2*temp415b1 + dd2*3*r(0)**2*temp415b0 + rp1b = distp(0, 1)*2.d0*funb0 + (distp(0, 1)*22.d0-distp(0, 1)*& +& 4.d0*2*rp1)*fun2b + distpb(0, 1) = (2.d0*rp1-5.d0)*funb0 + (22.d0*rp1-4.d0*rp1**2-& +& 20.d0)*fun2b + dd2b = r(0)**2*rp1b + rb(0) = rb(0) + dd2*2*r(0)*rp1b ELSE distpb = 0.0_8 dd2b = 0.0_8 END IF - dd3b = 0.0_8 DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) - r(i)**2*zb(indorbp, i) + rb(i) = rb(i) - distp(i, 1)*2*r(i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO DO k=indtm,indtmin,-1 - temp414 = r(k)**3 - temp414b1 = -(distpb(k, 1)/(dd2*temp414+1.d0)**2) - dd2b = dd2b + temp414*temp414b1 - rb(k) = rb(k) + dd2*3*r(k)**2*temp414b1 + temp341 = r(k)**2 + temp341b3 = r(k)**3*DEXP(-(dd2*temp341))*distpb(k, 1) + dd2b = dd2b - temp341*temp341b3 + rb(k) = rb(k) + DEXP(-(dd2*temp341))*3*r(k)**2*distpb(k, 1) - dd2*& +& 2*r(k)*temp341b3 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (111) -! 2p single r_mu/(1+b r^3) parent of 103 + CASE (121) +! 2p single exponential dd2 = dd(indpar+1) DO k=indtmin,indtm - distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**3) + distp(k, 1) = DEXP(-(dd2*r(k))) END DO -! indorbp=indorb +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)**2*3.d0*r(0)) - fun2 = fun*distp(0, 1)*(2.d0-4.d0*dd2*r(0)**3) -! indorbp=indorb + fun = -(dd2*distp(0, 1)/r(0)) + fun2 = dd2**2*distp(0, 1) +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -17159,36 +16319,32 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp418b0 = rmu(ic, 0)*zb(indorbp, indt+4) + temp343b0 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp418b0 - fun2b = fun2b + temp418b0 + funb0 = funb0 + 4.d0*temp343b0 + fun2b = fun2b + temp343b0 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp418b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp418b - funb = funb + rmu(ic, 0)*temp418b + temp343b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp343b + funb0 = funb0 + rmu(ic, 0)*temp343b rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp417 = r(0)**3 - temp417b = (2.d0-4.d0*(dd2*temp417))*fun2b - temp417b0 = -(fun*distp(0, 1)*4.d0*fun2b) - funb = funb + distp(0, 1)*temp417b - distpb(0, 1) = fun0b - 3.d0*dd2*r(0)*2*distp(0, 1)*funb + fun*& -& temp417b - temp417b1 = -(3.d0*distp(0, 1)**2*funb) - dd2b = r(0)*temp417b1 + temp417*temp417b0 - rb(0) = rb(0) + dd2*temp417b1 + dd2*3*r(0)**2*temp417b0 + temp342b0 = -(distp(0, 1)*funb0/r(0)) + dd2b = temp342b0 + distp(0, 1)*2*dd2*fun2b + temp342 = dd2/r(0) + distpb(0, 1) = fun0b - temp342*funb0 + dd2**2*fun2b + rb(0) = rb(0) - temp342*temp342b0 ELSE distpb = 0.0_8 dd2b = 0.0_8 @@ -17202,305 +16358,228 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=indtm,indtmin,-1 - temp416 = r(k)**3 - temp416b = -(distpb(k, 1)/(dd2*temp416+1.d0)**2) - dd2b = dd2b + temp416*temp416b - rb(k) = rb(k) + dd2*3*r(k)**2*temp416b + temp342b = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp342b + rb(k) = rb(k) - dd2*temp342b distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (112) -! 2p single r_mu/(1+b r)^3 parent of 103 + CASE (149) +! derivative of 131 with respect z_1 +! - r^4 exp(-z_1 r^2) dd2 = dd(indpar+1) + indorbp = indorb + 1 DO k=indtmin,indtm - distp(k, 1) = 1.d0/(1.d0+dd2*r(k))**3 - END DO -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun = -(3.d0*dd2*distp(0, 1)/(r(0)*(1.d0+dd2*r(0)))) - fun2 = 12.d0*dd2**2/(1.+dd2*r(0))**5 -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp422b0 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp422b0 - fun2b = fun2b + temp422b0 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp422b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp422b - funb = funb + rmu(ic, 0)*temp422b - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - temp421 = (dd2*r(0)+1.)**5 - temp421b = 12.d0*fun2b/temp421 - temp421b0 = -(dd2**2*5*(dd2*r(0)+1.)**4*temp421b/temp421) - temp420 = dd2*r(0) + 1.d0 - temp420b = -(3.d0*funb/(r(0)*temp420)) - temp420b0 = -(dd2*distp(0, 1)*temp420b/(r(0)*temp420)) - dd2b = distp(0, 1)*temp420b + r(0)**2*temp420b0 + r(0)*temp421b0 +& -& 2*dd2*temp421b - rb(0) = rb(0) + (r(0)*dd2+temp420)*temp420b0 + dd2*temp421b0 - distpb = 0.0_8 - distpb(0, 1) = fun0b + dd2*temp420b - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO k=indtm,indtmin,-1 - temp418 = dd2*r(k) + 1.d0 - temp419 = temp418**3 - temp418b1 = -(3*temp418**2*distpb(k, 1)/temp419**2) - dd2b = dd2b + r(k)*temp418b1 - rb(k) = rb(k) + dd2*temp418b1 - distpb(k, 1) = 0.0_8 + distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (113) -! 2s without cusp condition -! dd1*( dd3 +r^2/(1+dd2*r)^4) - dd2 = dd(indpar+1) - indorbp = indorb + 1 -! endif +! endif IF (typec .NE. 1) THEN - fun = (2.d0-2.d0*dd2*r(0))/(1+dd2*r(0))**5 + fun0 = dd2*r(0)**2 + fun = -(2.d0*r(0)**2*distp(0, 1)*(2.d0-fun0)) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) - funb = 2.d0*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO - temp425 = (dd2*r(0)+1)**6 - temp425b = 2.d0*fun2b/temp425 - temp425b0 = -((3.d0*(dd2**2*r(0)**2)-6.d0*(dd2*r(0))+1.d0)*6*(dd2*& -& r(0)+1)**5*temp425b/temp425) - temp424 = (dd2*r(0)+1)**5 - temp424b = funb/temp424 - temp424b0 = -((2.d0-2.d0*(dd2*r(0)))*5*(dd2*r(0)+1)**4*temp424b/& -& temp424) - dd2b = r(0)*temp424b0 - 2.d0*r(0)*temp424b + r(0)*temp425b0 + (& -& 3.d0*r(0)**2*2*dd2-6.d0*r(0))*temp425b - rb(0) = rb(0) + dd2*temp424b0 - 2.d0*dd2*temp424b + dd2*temp425b0 & -& + (3.d0*dd2**2*2*r(0)-6.d0*dd2)*temp425b + distpb = 0.0_8 + temp343b2 = -(2.d0*(2.d0*fun0**2-9.d0*fun0+6.d0)*fun2b) + temp343b3 = -(2.d0*r(0)**2*distp(0, 1)*fun2b) + temp343b4 = -(2.d0*r(0)**2*funb0) + fun0b = (2.d0*2*fun0-9.d0)*temp343b3 - distp(0, 1)*temp343b4 + rb(0) = rb(0) + dd2*2*r(0)*fun0b - 2.d0*distp(0, 1)*(2.d0-fun0)*2*& +& r(0)*funb0 + distp(0, 1)*2*r(0)*temp343b2 + distpb(0, 1) = (2.d0-fun0)*temp343b4 + r(0)**2*temp343b2 + dd2b = r(0)**2*fun0b ELSE + distpb = 0.0_8 dd2b = 0.0_8 END IF - distpb = 0.0_8 - dd3b = 0.0_8 DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) - r(i)**4*zb(indorbp, i) + rb(i) = rb(i) - distp(i, 1)*4*r(i)**3*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO DO k=indtm,indtmin,-1 - temp422 = dd2*r(k) + 1.d0 - temp423 = temp422**4 - temp422b1 = -(r(k)**2*4*temp422**3*distpb(k, 1)/temp423**2) - rb(k) = rb(k) + dd2*temp422b1 + 2*r(k)*distpb(k, 1)/temp423 - dd2b = dd2b + r(k)*temp422b1 + temp343b1 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp343b1 + rb(k) = rb(k) - dd2*2*r(k)*temp343b1 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (114) -! 2s without cusp condition -! dd1*( dd3 +r^2/(1+dd2*r)^3) - dd2 = dd(indpar+1) - indorbp = indorb + 1 -! endif - IF (typec .NE. 1) THEN - fun = (2.d0-dd2*r(0))/(1+dd2*r(0))**4 - fun2b = zb(indorbp, indt+4) - funb = 2.d0*zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - temp429 = (dd2*r(0)+1)**5 - temp429b = 2.d0*fun2b/temp429 - temp429b0 = 2*dd2*r(0)*temp429b - temp429b1 = -(((dd2*r(0))**2-4.d0*(dd2*r(0))+1.d0)*5*(dd2*r(0)+1)& -& **4*temp429b/temp429) - temp428 = (dd2*r(0)+1)**4 - temp428b = funb/temp428 - temp428b0 = -((2.d0-dd2*r(0))*4*(dd2*r(0)+1)**3*temp428b/temp428) - dd2b = r(0)*temp428b0 - r(0)*temp428b + r(0)*temp429b1 - 4.d0*r(0)& -& *temp429b + r(0)*temp429b0 - rb(0) = rb(0) + dd2*temp428b0 - dd2*temp428b + dd2*temp429b1 - & -& 4.d0*dd2*temp429b + dd2*temp429b0 - ELSE - dd2b = 0.0_8 - END IF - distpb = 0.0_8 - dd3b = 0.0_8 - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + CASE (147) +! 3d single gaussian + dd1 = dd(indpar+1) + DO k=indtmin,indtm + distp(k, 1) = DEXP(-(dd1*r(k)**2)) END DO - DO k=indtm,indtmin,-1 - temp426 = dd2*r(k) + 1.d0 - temp427 = temp426**3 - temp426b = -(r(k)**2*3*temp426**2*distpb(k, 1)/temp427**2) - rb(k) = rb(k) + dd2*temp426b + 2*r(k)*distpb(k, 1)/temp427 - dd2b = dd2b + r(k)*temp426b - distpb(k, 1) = 0.0_8 + DO i=indtmin,indtm + distp(i, 3) = distp(i, 1) + distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d + distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d + distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d END DO - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (115) -! 2s double lorentian with constant parent of 102 -! (dd3+ r^2/(1+dd2*r)^3+dd4*r^3/(1+dd5*r)^4; - dd2 = dd(indpar+1) - dd4 = dd(indpar+3) - dd5 = dd(indpar+4) - indorbp = indorb + 1 - DO k=indtmin,indtm - distp(k, 1) = r(k)**2/(1.d0+dd2*r(k))**3 - distp(k, 2) = r(k)**3/(1.d0+dd5*r(k))**4 +! indorbp=indorb + DO ic=1,5 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic END DO -! write(6,*) ' function inside = ',z(indorbp,i) -! endif +! endif IF (typec .NE. 1) THEN - fun = (2.d0-dd2*r(0))/(1+dd2*r(0))**4 - dd4*r(0)*(-3.d0+dd5*r(0))/& -& (1.d0+dd5*r(0))**5 - fun2b = zb(indorbp, indt+4) - funb = 2.d0*zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 + fun0 = distp(0, 3) + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = ((2.d0*dd1*r(0))**2-2.d0*dd1)*distp(0, 1) +! indorbp=indorb + DO ic=1,5 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + IF (ic .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + ELSE IF (ic .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (ic .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE IF (ic .EQ. 4) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (ic .EQ. 5) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + END DO + distpb = 0.0_8 + funb0 = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=5,1,-1 + temp344b5 = distp(0, 3+ic)*zb(indorbp, indt+4) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 6.d0*temp344b5 + fun2b = fun2b + temp344b5 + zb(indorbp, indt+4) = 0.0_8 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + IF (branch .LT. 1) THEN + temp344b0 = cost1d*4.d0*zb(indorbp, indt+3) + rmub(3, 0) = rmub(3, 0) + fun0*temp344b0 + temp344b1 = -(cost1d*2.d0*zb(indorbp, indt+2)) + temp344b2 = -(cost1d*2.d0*zb(indorbp, indt+1)) + fun0b = fun0b + rmu(2, 0)*temp344b1 + rmu(1, 0)*temp344b2 & +& + rmu(3, 0)*temp344b0 + rmub(2, 0) = rmub(2, 0) + fun0*temp344b1 + rmub(1, 0) = rmub(1, 0) + fun0*temp344b2 + ELSE + temp344b3 = -(cost2d*2.d0*zb(indorbp, indt+2)) + rmub(2, 0) = rmub(2, 0) + fun0*temp344b3 + temp344b4 = cost2d*2.d0*zb(indorbp, indt+1) + fun0b = fun0b + rmu(1, 0)*temp344b4 + rmu(2, 0)*temp344b3 + rmub(1, 0) = rmub(1, 0) + fun0*temp344b4 + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+2) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+1) + & +& cost3d*rmu(1, 0)*zb(indorbp, indt+2) + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+1) + END IF + ELSE IF (branch .LT. 5) THEN + IF (branch .LT. 4) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+2) + & +& cost3d*rmu(2, 0)*zb(indorbp, indt+3) + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+2) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+1) + cost3d*& +& rmu(1, 0)*zb(indorbp, indt+3) + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+1) + END IF + DO i=3,1,-1 + temp344b = distp(0, 3+ic)*zb(indorbp, indt+i) + distpb(0, 3+ic) = distpb(0, 3+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp344b + funb0 = funb0 + rmu(i, 0)*temp344b + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp440 = (dd2*r(0)+1)**5 - temp440b = 2.d0*fun2b/temp440 - temp440b0 = 2*dd2*r(0)*temp440b - temp440b1 = -(((dd2*r(0))**2-4.d0*(dd2*r(0))+1.d0)*5*(dd2*r(0)+1)& -& **4*temp440b/temp440) - temp439 = (dd5*r(0)+1.d0)**6 - temp438 = dd4*r(0)/temp439 - temp439b = 2.d0*temp438*fun2b - temp439b0 = 2*dd5*r(0)*temp439b - temp438b = 2.d0*((dd5*r(0))**2-6.d0*(dd5*r(0))+3.d0)*fun2b/temp439 - temp438b0 = -(temp438*6*(dd5*r(0)+1.d0)**5*temp438b) - temp437 = (dd2*r(0)+1)**4 - temp437b = funb/temp437 - temp437b0 = -((2.d0-dd2*r(0))*4*(dd2*r(0)+1)**3*temp437b/temp437) - dd2b = r(0)*temp437b0 - r(0)*temp437b + r(0)*temp440b1 - 4.d0*r(0)& -& *temp440b + r(0)*temp440b0 - temp436 = (dd5*r(0)+1.d0)**5 - temp436b = -(funb/temp436) - temp435 = dd5*r(0) - 3.d0 - temp434 = dd4*r(0) - temp434b = -(temp434*temp435*5*(dd5*r(0)+1.d0)**4*temp436b/temp436& -& ) - rb(0) = rb(0) + dd2*temp437b0 - dd2*temp437b + (temp434*dd5+& -& temp435*dd4)*temp436b + dd5*temp434b + dd5*temp438b0 + dd4*& -& temp438b - 6.d0*dd5*temp439b + dd5*temp439b0 + dd2*temp440b1 - & -& 4.d0*dd2*temp440b + dd2*temp440b0 - dd5b = temp434*r(0)*temp436b + r(0)*temp434b + r(0)*temp438b0 - & -& 6.d0*r(0)*temp439b + r(0)*temp439b0 - dd4b = temp435*r(0)*temp436b + r(0)*temp438b + temp343 = 2.d0*dd1*r(0) + temp343b6 = distp(0, 1)*2*temp343*2.d0*fun2b + dd1b = r(0)*temp343b6 - distp(0, 1)*2.d0*fun2b - 2.d0*distp(0, 1)*& +& funb0 + rb(0) = rb(0) + dd1*temp343b6 + distpb(0, 1) = distpb(0, 1) + (temp343**2-2.d0*dd1)*fun2b - 2.d0*& +& dd1*funb0 + distpb(0, 3) = distpb(0, 3) + fun0b ELSE - dd2b = 0.0_8 - dd4b = 0.0_8 - dd5b = 0.0_8 + distpb = 0.0_8 + dd1b = 0.0_8 END IF - distpb = 0.0_8 - dd3b = 0.0_8 - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) - dd4b = dd4b + distp(i, 2)*zb(indorbp, i) - distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=5,1,-1 + DO i=indtm,i0,-1 + distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO i=indtm,indtmin,-1 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + distpb(i, 8) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + distpb(i, 1) = distpb(i, 1) + distpb(i, 3) + distpb(i, 3) = 0.0_8 END DO DO k=indtm,indtmin,-1 - temp432 = dd5*r(k) + 1.d0 - temp433 = temp432**4 - temp432b = -(r(k)**3*4*temp432**3*distpb(k, 2)/temp433**2) - rb(k) = rb(k) + dd5*temp432b + 3*r(k)**2*distpb(k, 2)/temp433 - dd5b = dd5b + r(k)*temp432b - distpb(k, 2) = 0.0_8 - temp430 = dd2*r(k) + 1.d0 - temp431 = temp430**3 - temp430b = -(r(k)**2*3*temp430**2*distpb(k, 1)/temp431**2) - rb(k) = rb(k) + dd2*temp430b + 2*r(k)*distpb(k, 1)/temp431 - dd2b = dd2b + r(k)*temp430b + temp343b5 = DEXP(-(dd1*r(k)**2))*distpb(k, 1) + dd1b = dd1b - r(k)**2*temp343b5 + rb(k) = rb(k) - dd1*2*r(k)*temp343b5 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+4) = ddb(indpar+4) + dd5b - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (116) -! 2p double Lorentian -! dd1 * x_mu (L^3(dd2 r)+dd3 r * L(dd4*r)^4) ; L(x)=1/(1+x) + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (134) +! 2p single exponential r^3 e^{-z r} ! dd2 = dd(indpar+1) - dd3 = dd(indpar+2) - dd4 = dd(indpar+3) DO k=indtmin,indtm - distp(k, 1) = 1.d0/(1.d0+dd2*r(k))**3 - distp(k, 2) = r(k)/(1.d0+dd4*r(k))**4 + distp(k, 1) = DEXP(-(dd2*r(k))) END DO -! indorbp=indorb +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = -(3.d0*dd2*distp(0, 1)/(r(0)*(1.d0+dd2*r(0)))) + dd3*distp(0& -& , 2)/r(0)**2*(1.d0-3*dd4*r(0))/(1.d0+dd4*r(0)) - fun2 = 12.d0*dd2**2/(1.+dd2*r(0))**5 + dd3*4.d0*dd4*(-2.d0+3.d0*& -& dd4*r(0))/(1.+dd4*r(0))**6 -! fun0=distp(0,1)+dd3*distp(0,2) -! fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) -! fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) -! 1+2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) -! indorbp=indorb + fun = distp(0, 1)*(3.d0-dd2*r(0))*r(0) +! fun= derivative of fun0 respect to r divided dy r + fun2 = distp(0, 1)*(dd2**2*r(0)**3-6*dd2*r(0)**2+6*r(0)) +! fun2= second derivative of fun0 respect to r +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -17510,237 +16589,78 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp451b0 = rmu(ic, 0)*zb(indorbp, indt+4) + temp345b0 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp451b0 - fun2b = fun2b + temp451b0 + funb0 = funb0 + 4.d0*temp345b0 + fun2b = fun2b + temp345b0 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp451b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp451b - funb = funb + rmu(ic, 0)*temp451b + temp345b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp345b + funb0 = funb0 + rmu(ic, 0)*temp345b rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp450 = (dd2*r(0)+1.)**5 - temp450b = 12.d0*fun2b/temp450 - temp450b0 = -(dd2**2*5*(dd2*r(0)+1.)**4*temp450b/temp450) - temp449 = (dd4*r(0)+1.)**6 - temp448 = 3.d0*dd4*r(0) - 2.d0 - temp448b = 4.d0*fun2b/temp449 - temp448b0 = dd3*dd4*3.d0*temp448b - temp448b1 = -(dd3*dd4*temp448*6*(dd4*r(0)+1.)**5*temp448b/temp449) - temp445 = dd2*r(0) + 1.d0 - temp445b0 = -(3.d0*funb/(r(0)*temp445)) - temp445b1 = -(dd2*distp(0, 1)*temp445b0/(r(0)*temp445)) - dd2b = distp(0, 1)*temp445b0 + r(0)**2*temp445b1 + r(0)*temp450b0 & -& + 2*dd2*temp450b - temp446 = r(0)**2*(dd4*r(0)+1.d0) - temp448b2 = funb/temp446 - temp447 = (-3)*(dd4*r(0)) + 1.d0 - temp447b = -(dd3*distp(0, 2)*3*temp448b2) - temp446b = -(dd3*distp(0, 2)*temp447*temp448b2/temp446) - temp446b0 = r(0)**2*temp446b - rb(0) = rb(0) + dd4*temp447b + (dd4*r(0)+1.d0)*2*r(0)*temp446b + & -& dd4*temp446b0 + (r(0)*dd2+temp445)*temp445b1 + dd4*temp448b1 + & -& dd4*temp448b0 + dd2*temp450b0 - dd3b = temp447*distp(0, 2)*temp448b2 + distp(0, 2)*fun0b + temp448& -& *dd4*temp448b - dd4b = r(0)*temp447b + r(0)*temp446b0 + r(0)*temp448b1 + r(0)*& -& temp448b0 + temp448*dd3*temp448b - distpb = 0.0_8 - distpb(0, 2) = temp447*dd3*temp448b2 - distpb(0, 1) = fun0b + dd2*temp445b0 - distpb(0, 2) = distpb(0, 2) + dd3*fun0b + distpb = 0.0_8 + temp344 = r(0)**3 + temp344b8 = distp(0, 1)*fun2b + temp344b9 = (3.d0-dd2*r(0))*funb0 + distpb(0, 1) = r(0)*temp344b9 + r(0)**3*fun0b + (dd2**2*temp344-6*& +& (dd2*r(0)**2)+6*r(0))*fun2b + temp344b10 = distp(0, 1)*r(0)*funb0 + dd2b = (temp344*2*dd2-6*r(0)**2)*temp344b8 - r(0)*temp344b10 + rb(0) = rb(0) + distp(0, 1)*temp344b9 - dd2*temp344b10 + distp(0, & +& 1)*3*r(0)**2*fun0b + (dd2**2*3*r(0)**2-6*dd2*2*r(0)+6)*temp344b8 ELSE distpb = 0.0_8 dd2b = 0.0_8 - dd3b = 0.0_8 - dd4b = 0.0_8 END IF DO ic=3,1,-1 DO i=indtm,i0,-1 - temp445b = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& -& indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp445b - dd3b = dd3b + distp(i, 2)*temp445b - distpb(i, 2) = distpb(i, 2) + dd3*temp445b + temp344b7 = r(i)**3*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp344b7 + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp344b7 + rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*3*r(i)**2*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=indtm,indtmin,-1 - temp443 = dd4*r(k) + 1.d0 - temp444 = temp443**4 - temp443b = -(r(k)*4*temp443**3*distpb(k, 2)/temp444**2) - rb(k) = rb(k) + dd4*temp443b + distpb(k, 2)/temp444 - dd4b = dd4b + r(k)*temp443b - distpb(k, 2) = 0.0_8 - temp441 = dd2*r(k) + 1.d0 - temp442 = temp441**3 - temp441b = -(3*temp441**2*distpb(k, 1)/temp442**2) - dd2b = dd2b + r(k)*temp441b - rb(k) = rb(k) + dd2*temp441b + temp344b6 = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp344b6 + rb(k) = rb(k) - dd2*temp344b6 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (117) -! 2s double lorentian with constant parent of 102 -! (dd3+r^3/(1+dd5*r)^4; - dd5 = dd(indpar+2) - indorbp = indorb + 1 -! write(6,*) ' function inside = ',z(indorbp,i) -! endif - IF (typec .NE. 1) THEN - fun = -(r(0)*(-3.d0+dd5*r(0))/(1.d0+dd5*r(0))**5) - fun2b = zb(indorbp, indt+4) - funb = 2.d0*zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - temp455 = (dd5*r(0)+1.d0)**6 - temp454 = r(0)/temp455 - temp455b = 2.d0*temp454*fun2b - temp455b0 = 2*dd5*r(0)*temp455b - temp454b = 2.d0*((dd5*r(0))**2-6.d0*(dd5*r(0))+3.d0)*fun2b/temp455 - temp454b0 = -(temp454*6*(dd5*r(0)+1.d0)**5*temp454b) - temp453 = (dd5*r(0)+1.d0)**5 - temp453b = -(funb/temp453) - temp453b0 = -(r(0)*(dd5*r(0)-3.d0)*5*(dd5*r(0)+1.d0)**4*temp453b/& -& temp453) - dd5b = r(0)**2*temp453b + r(0)*temp453b0 + r(0)*temp454b0 - 6.d0*r& -& (0)*temp455b + r(0)*temp455b0 - rb(0) = rb(0) + (r(0)*dd5+dd5*r(0)-3.d0)*temp453b + dd5*temp453b0 & -& + dd5*temp454b0 + temp454b - 6.d0*dd5*temp455b + dd5*temp455b0 - ELSE - dd5b = 0.0_8 - END IF - distpb = 0.0_8 - dd3b = 0.0_8 - DO i=indtm,i0,-1 - dd3b = dd3b + zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=indtm,indtmin,-1 - temp451 = dd5*r(k) + 1.d0 - temp452 = temp451**4 - temp451b1 = -(r(k)**3*4*temp451**3*distpb(k, 1)/temp452**2) - rb(k) = rb(k) + dd5*temp451b1 + 3*r(k)**2*distpb(k, 1)/temp452 - dd5b = dd5b + r(k)*temp451b1 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+2) = ddb(indpar+2) + dd5b - ddb(indpar+1) = ddb(indpar+1) + dd3b - CASE (118) -! 2s double lorentian with constant parent of 102 -! (dd1+ 1/ (1 + Exp[ dd2 (r^2 - r_0^2) ] ) | dd3=r_0 -! Fermi distribution with r^2 - dd2 = dd(indpar+2) - dd3 = -(dd2*dd(indpar+3)**2) - indorbp = indorb + 1 - DO k=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,arg) - arg = dd2*r(k)**2 + dd3 - IF (arg .GT. 200) THEN - distp(k, 1) = DEXP(200.d0) - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - distp(k, 1) = DEXP(arg) - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF - END DO -! write(6,*) ' function inside = ',z(indorbp,i) -! endif - IF (typec .NE. 1) THEN - fun = -(2.d0*dd2*distp(0, 1)/(1.d0+distp(0, 1))**2) - fun2b = zb(indorbp, indt+4) - funb = 2.d0*zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp458 = (distp(0, 1)+1.d0)**3 - temp457 = -(2.d0*dd2*r(0)**2) - 1.d0 - temp456 = -(2.d0*dd2*r(0)**2) + 1.d0 - temp456b = -(2.d0*dd2*fun2b/temp458) - temp456b0 = -(distp(0, 1)**2*2.d0*temp456b) - temp456b1 = distp(0, 1)*2.d0*temp456b - temp456b2 = -(2.d0*(distp(0, 1)**2*temp456-distp(0, 1)*temp457)*& -& fun2b/temp458) - temp456b3 = -(2.d0*funb/(distp(0, 1)+1.d0)**2) - distpb(0, 1) = (dd2-dd2*distp(0, 1)*2/(distp(0, 1)+1.d0))*& -& temp456b3 - dd2*3*(distp(0, 1)+1.d0)**2*temp456b2/temp458 + (& -& temp456*2*distp(0, 1)-temp457)*temp456b - dd2b = distp(0, 1)*temp456b3 + temp456b2 + r(0)**2*temp456b1 + r(0& -& )**2*temp456b0 - rb(0) = rb(0) + dd2*2*r(0)*temp456b1 + dd2*2*r(0)*temp456b0 - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - dd1b = 0.0_8 - DO i=indtm,i0,-1 - dd1b = dd1b + zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) - zb(indorbp, i)/(distp(i, 1)+1.d0)**2 - zb(indorbp, i) = 0.0_8 - END DO - dd3b = 0.0_8 - DO k=indtm,indtmin,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 2) THEN - distpb(k, 1) = 0.0_8 - argb = 0.0_8 - ELSE - argb = DEXP(arg)*distpb(k, 1) - distpb(k, 1) = 0.0_8 - END IF - CALL POPREAL8(adr8ibuf,adr8buf,arg) - dd2b = dd2b + r(k)**2*argb - rb(k) = rb(k) + dd2*2*r(k)*argb - dd3b = dd3b + argb - END DO - dd2b = dd2b - dd(indpar+3)**2*dd3b - ddb(indpar+3) = ddb(indpar+3) - dd2*2*dd(indpar+3)*dd3b - ddb(indpar+2) = ddb(indpar+2) + dd2b - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (119) -! 2p single r_mu/(1+b r^2)^(3/2) parent of 103 + CASE (146) +! 2p single exponential -r^2 e^{-z r^2} ! derivative of 103 dd2 = dd(indpar+1) DO k=indtmin,indtm - distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**2)**1.5d0 + distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) END DO -! indorbp=indorb +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = -(3.d0*dd2*distp(0, 1)/(1.d0+dd2*r(0)**2)) - fun2 = 3.d0*dd2*(-1.d0+4.d0*dd2*r(0)**2)/(1.d0+dd2*r(0)**2)**3.5d0 -! indorbp=indorb + rp2 = dd2*r(0)*r(0) + fun = distp(0, 1)*(-2.d0+2.d0*rp2) + fun2 = (-2.d0+10.d0*rp2-4.d0*rp2*rp2)*distp(0, 1) +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -17750,92 +16670,88 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp465b0 = rmu(ic, 0)*zb(indorbp, indt+4) + temp345b4 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp465b0 - fun2b = fun2b + temp465b0 + funb0 = funb0 + 4.d0*temp345b4 + fun2b = fun2b + temp345b4 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp465b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp465b - funb = funb + rmu(ic, 0)*temp465b + temp345b3 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp345b3 + funb0 = funb0 + rmu(ic, 0)*temp345b3 rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp462 = dd2*r(0)**2 + 1.d0 - temp464 = temp462**3.5d0 - temp463 = 4.d0*dd2*r(0)**2 - 1.d0 - temp463b = 3.d0*fun2b/temp464 - temp463b0 = dd2*4.d0*temp463b - temp462b = -(dd2*temp463*3.5d0*temp462**2.5D0*temp463b/temp464) - temp461 = dd2*r(0)**2 + 1.d0 - temp462b0 = -(3.d0*funb/temp461) - temp461b = -(dd2*distp(0, 1)*temp462b0/temp461) - dd2b = distp(0, 1)*temp462b0 + r(0)**2*temp461b + r(0)**2*temp462b& -& + r(0)**2*temp463b0 + temp463*temp463b - rb(0) = rb(0) + dd2*2*r(0)*temp461b + dd2*2*r(0)*temp462b + dd2*2*& -& r(0)*temp463b0 - distpb = 0.0_8 - distpb(0, 1) = fun0b + dd2*temp462b0 + distpb = 0.0_8 + rp2b = distp(0, 1)*2.d0*funb0 + (distp(0, 1)*10.d0-distp(0, 1)*& +& 4.d0*2*rp2)*fun2b + distpb(0, 1) = (2.d0*rp2-2.d0)*funb0 - r(0)**2*fun0b + (10.d0*rp2-& +& 4.d0*rp2**2-2.d0)*fun2b + rb(0) = rb(0) + dd2*2*r(0)*rp2b - distp(0, 1)*2*r(0)*fun0b + dd2b = r(0)**2*rp2b ELSE distpb = 0.0_8 dd2b = 0.0_8 END IF DO ic=3,1,-1 DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + temp345b2 = -(r(i)**2*zb(indorbp, i)) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp345b2 + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp345b2 + rb(i) = rb(i) - rmu(ic, i)*distp(i, 1)*2*r(i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=indtm,indtmin,-1 - temp459 = dd2*r(k)**2 + 1.d0 - temp460 = temp459**1.5d0 - temp459b = -(1.5d0*temp459**0.5D0*distpb(k, 1)/temp460**2) - dd2b = dd2b + r(k)**2*temp459b - rb(k) = rb(k) + dd2*2*r(k)*temp459b + temp345b1 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp345b1 + rb(k) = rb(k) - dd2*2*r(k)*temp345b1 distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (120) -! 2p double cubic -! dd1 * x_mu (L^3(dd2 r)+dd3 L(dd4*r)^3) ; L(x)=1/(1+x) - dd2 = dd(indpar+1) - dd3 = dd(indpar+2) - dd4 = dd(indpar+3) + CASE (25) +! 4p without cusp condition +! r^2 ( e^{-z2 r } + z1 e^{-z3 r } ) + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + dd3 = dd(indpar+3) +! if(iflagnorm.gt.2) then + c = 1.d0/2.d0/DSQRT(120960.d0*pi*(1.d0/(2.d0*dd1)**9+2.d0*dd3/(dd1+& +& dd2)**9+dd3**2/(2.d0*dd2)**9)) +! endif DO k=indtmin,indtm - distp(k, 1) = 1.d0/(1.d0+dd2*r(k))**3 - distp(k, 2) = 1.d0/(1.d0+dd4*r(k))**3 + distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 2) = c*DEXP(-(dd2*r(k))) + END DO + DO i=indtmin,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = r(i)**2*(distp(i, 1)+dd3*distp(i, 2)) END DO -! indorbp=indorb +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = -(3.d0*dd2*distp(0, 1)/(r(0)*(1.d0+dd2*r(0)))) - 3.d0*dd4*& -& dd3*distp(0, 2)/(r(0)*(1.d0+dd4*r(0))) - fun2 = 12.d0*dd2**2/(1.+dd2*r(0))**5 + 12.d0*dd3*dd4**2/(1.+dd4*r(& -& 0))**5 -! fun0=distp(0,1)+dd3*distp(0,2) -! fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) -! fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) -! 1+2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) -! indorbp=indorb + fun = (2.d0*r(0)-dd1*r(0)**2)*distp(0, 1) + dd3*(2.d0*r(0)-dd2*r(0& +& )**2)*distp(0, 2) + fun2 = ((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))*distp(0, 1) + dd3*((dd2*& +& r(0))**2+2.d0-4.d0*dd2*r(0))*distp(0, 2) +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -17845,228 +16761,486 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp473b0 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp473b0 - fun2b = fun2b + temp473b0 + temp354 = fun/r(0) + temp355b = rmu(ic, 0)*zb(indorbp, indt+4) + temp354b = 4.d0*temp355b/r(0) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*temp354+fun2)*zb(indorbp, indt& +& +4) + funb0 = funb0 + temp354b + rb(0) = rb(0) - temp354*temp354b + fun2b = fun2b + temp355b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp473b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp473b - funb = funb + rmu(ic, 0)*temp473b - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + temp353 = fun/r(0) + temp353b10 = rmu(ic, 0)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(ic, 0) = rmub(ic, 0) + temp353*rmu(i, 0)*zb(indorbp, indt& +& +i) + rmub(i, 0) = rmub(i, 0) + temp353*rmu(ic, 0)*zb(indorbp, indt+& +& i) + funb0 = funb0 + temp353b10 + rb(0) = rb(0) - temp353*temp353b10 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp472 = (dd2*r(0)+1.)**5 - temp472b = 12.d0*fun2b/temp472 - temp472b0 = -(dd2**2*5*(dd2*r(0)+1.)**4*temp472b/temp472) - temp471 = (dd4*r(0)+1.)**5 - temp471b = 12.d0*fun2b/temp471 - temp471b0 = -(dd3*dd4**2*5*(dd4*r(0)+1.)**4*temp471b/temp471) - temp470 = dd2*r(0) + 1.d0 - temp470b = -(3.d0*funb/(r(0)*temp470)) - temp470b0 = -(dd2*distp(0, 1)*temp470b/(r(0)*temp470)) - dd2b = distp(0, 1)*temp470b + r(0)**2*temp470b0 + r(0)*temp472b0 +& -& 2*dd2*temp472b - temp469 = dd4*r(0) + 1.d0 - temp469b0 = -(3.d0*funb/(r(0)*temp469)) - temp469b1 = -(dd4*dd3*distp(0, 2)*temp469b0/(r(0)*temp469)) - rb(0) = rb(0) + (r(0)*dd2+temp470)*temp470b0 + (r(0)*dd4+temp469)*& -& temp469b1 + dd4*temp471b0 + dd2*temp472b0 - dd3b = distp(0, 2)*dd4*temp469b0 + distp(0, 2)*fun0b + dd4**2*& -& temp471b - dd4b = distp(0, 2)*dd3*temp469b0 + r(0)**2*temp469b1 + r(0)*& -& temp471b0 + dd3*2*dd4*temp471b - distpb = 0.0_8 - distpb(0, 1) = dd2*temp470b - distpb(0, 2) = dd4*dd3*temp469b0 - distpb(0, 1) = distpb(0, 1) + fun0b - distpb(0, 2) = distpb(0, 2) + dd3*fun0b + distpb = 0.0_8 + temp353b2 = distp(0, 1)*fun2b + temp353b3 = 2*dd1*r(0)*temp353b2 + temp353b4 = dd3*distp(0, 2)*fun2b + temp353b5 = 2*dd2*r(0)*temp353b4 + temp353b6 = ((dd2*r(0))**2-4.d0*(dd2*r(0))+2.d0)*fun2b + temp353b7 = distp(0, 1)*funb0 + dd1b = r(0)*temp353b3 - 4.d0*r(0)*temp353b2 - r(0)**2*temp353b7 + temp353b8 = dd3*distp(0, 2)*funb0 + rb(0) = rb(0) + (2.d0-dd1*2*r(0))*temp353b7 + (2.d0-dd2*2*r(0))*& +& temp353b8 - 4.d0*dd2*temp353b4 + dd2*temp353b5 - 4.d0*dd1*& +& temp353b2 + dd1*temp353b3 + distpb(0, 1) = ((dd1*r(0))**2-4.d0*(dd1*r(0))+2.d0)*fun2b + dd2b = r(0)*temp353b5 - 4.d0*r(0)*temp353b4 - r(0)**2*temp353b8 + temp353b9 = (2.d0*r(0)-dd2*r(0)**2)*funb0 + dd3b = distp(0, 2)*temp353b9 + distp(0, 2)*temp353b6 + distpb(0, 2) = dd3*temp353b6 + distpb(0, 1) = distpb(0, 1) + (2.d0*r(0)-dd1*r(0)**2)*funb0 + distpb(0, 2) = distpb(0, 2) + dd3*temp353b9 + distpb(0, 3) = distpb(0, 3) + fun0b ELSE distpb = 0.0_8 + dd1b = 0.0_8 dd2b = 0.0_8 dd3b = 0.0_8 - dd4b = 0.0_8 END IF DO ic=3,1,-1 DO i=indtm,i0,-1 - temp469b = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& -& indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp469b - dd3b = dd3b + distp(i, 2)*temp469b - distpb(i, 2) = distpb(i, 2) + dd3*temp469b + rmub(ic, i) = rmub(ic, i) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + rmu(ic, i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + DO i=indtm,indtmin,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + temp353b1 = r(i)**2*distpb(i, 3) + rb(i) = rb(i) + (distp(i, 1)+dd3*distp(i, 2))*2*r(i)*distpb(i, 3) + distpb(i, 1) = distpb(i, 1) + temp353b1 + dd3b = dd3b + distp(i, 2)*temp353b1 + distpb(i, 2) = distpb(i, 2) + dd3*temp353b1 + distpb(i, 3) = 0.0_8 + END DO + cb = 0.0_8 DO k=indtm,indtmin,-1 - temp467 = dd4*r(k) + 1.d0 - temp468 = temp467**3 - temp467b = -(3*temp467**2*distpb(k, 2)/temp468**2) - dd4b = dd4b + r(k)*temp467b + temp353b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp353b distpb(k, 2) = 0.0_8 - temp465 = dd2*r(k) + 1.d0 - temp466 = temp465**3 - temp465b1 = -(3*temp465**2*distpb(k, 1)/temp466**2) - rb(k) = rb(k) + dd2*temp465b1 + dd4*temp467b - dd2b = dd2b + r(k)*temp465b1 + temp353b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp353b0 - dd2*temp353b + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp353b0 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (121) -! 2p single exponential - dd2 = dd(indpar+1) + temp352 = 2.d0**9 + temp351 = temp352*dd2**9 + temp350 = dd3**2/temp351 + temp349 = (dd1+dd2)**9 + temp348 = 2.d0**9 + temp347 = temp348*dd1**9 + temp346 = 120960.d0*pi*(1.0/temp347+2.d0*dd3/temp349+temp350) + temp345 = DSQRT(temp346) + IF (temp346 .EQ. 0.0) THEN + temp345b5 = 0.0 + ELSE + temp345b5 = -(pi*120960.d0*cb/(2.d0*temp345**2*2.D0*DSQRT(temp346)& +& )) + END IF + temp345b6 = 2.d0*temp345b5/temp349 + temp345b7 = -(dd3*9*(dd1+dd2)**8*temp345b6/temp349) + dd1b = dd1b + temp345b7 - temp348*9*dd1**8*temp345b5/temp347**2 + dd3b = dd3b + 2*dd3*temp345b5/temp351 + temp345b6 + dd2b = dd2b + temp345b7 - temp350*temp352*9*dd2**8*temp345b5/temp351 + ddb(indpar+3) = ddb(indpar+3) + dd3b + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (32) +! 2p triple zeta +! 3d without cusp condition triple Z + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd(indpar+3) + dd3 = dd(indpar+4) + peff2 = dd(indpar+5) +! if(iflagnorm.gt.2) then + c = 1/2.d0*DSQRT(5.d0/pi)/DSQRT(1/(2.d0*dd1)**7+2*peff/(dd1+dd2)**7+& +& peff**2/(2.d0*dd2)**7+2*peff2/(dd1+dd3)**7+peff2**2/(2.d0*dd3)**7+& +& 2*peff*peff2/(dd2+dd3)**7)/DSQRT(720.d0) +! endif DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k))) + distp(k, 1) = DEXP(-(dd1*r(k))) + distp(k, 2) = DEXP(-(dd2*r(k))) + distp(k, 3) = DEXP(-(dd3*r(k))) END DO -! indorbp=indorb - DO ic=1,3 + DO i=indtmin,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) + distp(i, 4) = c*(distp(i, 1)+peff*distp(i, 2)+peff2*distp(i, 3)) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) +!lz=0 + distp(i, 5) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) +!lz=+/-2 + distp(i, 6) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) +! lz=+/- 2 + distp(i, 7) = rmu(1, i)*rmu(2, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) +! lz=+/-1 + distp(i, 8) = rmu(2, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 9)) +! lz=+/-1 + distp(i, 9) = rmu(1, i)*rmu(3, i)*cost3d + END DO +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)/r(0)) - fun2 = dd2**2*distp(0, 1) -! indorbp=indorb - DO ic=1,3 + fun0 = distp(0, 4) + fun = c*(-(dd1*distp(0, 1))-peff*dd2*distp(0, 2)-peff2*dd3*distp(0& +& , 3)) + fun2 = c*(dd1**2*distp(0, 1)+peff*dd2**2*distp(0, 2)+peff2*dd3**2*& +& distp(0, 3)) +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + IF (ic .EQ. 1) THEN + IF (i .NE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO END DO - funb = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=3,1,-1 - temp474b0 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp474b0 - fun2b = fun2b + temp474b0 + DO ic=5,1,-1 + temp371 = fun/r(0) + temp372b = distp(0, 4+ic)*zb(indorbp, indt+4) + temp371b3 = 6.d0*temp372b/r(0) + distpb(0, 4+ic) = distpb(0, 4+ic) + (6.d0*temp371+fun2)*zb(& +& indorbp, indt+4) + funb0 = funb0 + temp371b3 + rb(0) = rb(0) - temp371*temp371b3 + fun2b = fun2b + temp372b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp474b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp474b - funb = funb + rmu(ic, 0)*temp474b - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp371b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp371b + fun0b = fun0b + rmu(i, 0)*temp371b + ELSE + temp371b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp371b0 + fun0b = fun0b + rmu(i, 0)*temp371b0 + END IF + ELSE IF (branch .LT. 4) THEN + temp371b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp371b1 + fun0b = fun0b + rmu(i, 0)*temp371b1 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp371b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp371b2 + fun0b = fun0b + rmu(i, 0)*temp371b2 + ELSE + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + temp370 = fun/r(0) + temp370b7 = distp(0, 4+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 4+ic) = distpb(0, 4+ic) + temp370*rmu(i, 0)*zb(& +& indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp370*distp(0, 4+ic)*zb(indorbp, & +& indt+i) + funb0 = funb0 + temp370b7 + rb(0) = rb(0) - temp370*temp370b7 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp473b2 = -(distp(0, 1)*funb/r(0)) - dd2b = temp473b2 + distp(0, 1)*2*dd2*fun2b - temp473 = dd2/r(0) - distpb(0, 1) = fun0b - temp473*funb + dd2**2*fun2b - rb(0) = rb(0) - temp473*temp473b2 + temp370b3 = c*fun2b + temp370b4 = dd2**2*temp370b3 + temp370b5 = dd3**2*temp370b3 + cb = (-(dd1*distp(0, 1))-peff*dd2*distp(0, 2)-peff2*dd3*distp(0, 3& +& ))*funb0 + (dd1**2*distp(0, 1)+dd2**2*(peff*distp(0, 2))+dd3**2*& +& (peff2*distp(0, 3)))*fun2b + temp370b6 = c*funb0 + dd1b = distp(0, 1)*2*dd1*temp370b3 - distp(0, 1)*temp370b6 + distpb(0, 1) = distpb(0, 1) + dd1**2*temp370b3 + dd2b = peff*distp(0, 2)*2*dd2*temp370b3 - distp(0, 2)*peff*& +& temp370b6 + peffb = distp(0, 2)*temp370b4 - distp(0, 2)*dd2*temp370b6 + distpb(0, 2) = distpb(0, 2) + peff*temp370b4 + dd3b = peff2*distp(0, 3)*2*dd3*temp370b3 - distp(0, 3)*peff2*& +& temp370b6 + peff2b = distp(0, 3)*temp370b5 - distp(0, 3)*dd3*temp370b6 + distpb(0, 3) = distpb(0, 3) + peff2*temp370b5 + distpb(0, 1) = distpb(0, 1) - dd1*temp370b6 + distpb(0, 2) = distpb(0, 2) - peff*dd2*temp370b6 + distpb(0, 3) = distpb(0, 3) - peff2*dd3*temp370b6 + distpb(0, 4) = distpb(0, 4) + fun0b ELSE distpb = 0.0_8 + peffb = 0.0_8 + dd1b = 0.0_8 dd2b = 0.0_8 + dd3b = 0.0_8 + peff2b = 0.0_8 + cb = 0.0_8 END IF - DO ic=3,1,-1 + DO ic=5,1,-1 DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) + distpb(i, 4+ic) = distpb(i, 4+ic) + distp(i, 4)*zb(indorbp, i) + distpb(i, 4) = distpb(i, 4) + distp(i, 4+ic)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + DO i=indtm,indtmin,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 9)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 9) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 9) + distpb(i, 9) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 8) + distpb(i, 8) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 7) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 5) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) + temp370b2 = c*distpb(i, 4) + cb = cb + (distp(i, 1)+peff*distp(i, 2)+peff2*distp(i, 3))*distpb(& +& i, 4) + distpb(i, 1) = distpb(i, 1) + temp370b2 + peffb = peffb + distp(i, 2)*temp370b2 + distpb(i, 2) = distpb(i, 2) + peff*temp370b2 + peff2b = peff2b + distp(i, 3)*temp370b2 + distpb(i, 3) = distpb(i, 3) + peff2*temp370b2 + distpb(i, 4) = 0.0_8 + END DO DO k=indtm,indtmin,-1 - temp473b1 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp473b1 - rb(k) = rb(k) - dd2*temp473b1 + temp370b = DEXP(-(dd3*r(k)))*distpb(k, 3) + dd3b = dd3b - r(k)*temp370b + distpb(k, 3) = 0.0_8 + temp370b0 = DEXP(-(dd2*r(k)))*distpb(k, 2) + distpb(k, 2) = 0.0_8 + temp370b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd2*temp370b0 - dd1*temp370b1 - dd3*temp370b + dd2b = dd2b - r(k)*temp370b0 + dd1b = dd1b - r(k)*temp370b1 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (122) -! 2s with cusp condition -! dd1*( dd3 +exp(-dd2*r)*(1+dd2*r)) + temp369 = (dd2+dd3)**7 + temp355 = peff*peff2/temp369 + temp368 = 2.d0**7 + temp367 = temp368*dd3**7 + temp366 = peff2**2/temp367 + temp365 = (dd1+dd3)**7 + temp364 = 2.d0**7 + temp363 = temp364*dd2**7 + temp362 = peff**2/temp363 + temp361 = (dd1+dd2)**7 + temp360 = 2.d0**7 + temp359 = temp360*dd1**7 + temp356 = 1.0/temp359 + 2*(peff/temp361) + temp362 + 2*(peff2/& +& temp365) + temp366 + 2*temp355 + temp358 = DSQRT(temp356) + temp357 = 2.d0*DSQRT(720.d0) + IF (temp356 .EQ. 0.0) THEN + temp356b = 0.0 + ELSE + temp356b = -(DSQRT(5.d0/pi)*cb/(temp357*temp358**2*2.D0*DSQRT(& +& temp356))) + END IF + temp356b0 = 2*temp356b/temp361 + temp356b1 = -(peff*7*(dd1+dd2)**6*temp356b0/temp361) + temp356b2 = 2*temp356b/temp365 + temp356b3 = -(peff2*7*(dd1+dd3)**6*temp356b2/temp365) + temp355b0 = 2*temp356b/temp369 + temp355b1 = -(temp355*7*(dd2+dd3)**6*temp355b0) + dd1b = dd1b + temp356b3 + temp356b1 - temp360*7*dd1**6*temp356b/& +& temp359**2 + peffb = peffb + peff2*temp355b0 + 2*peff*temp356b/temp363 + & +& temp356b0 + dd2b = dd2b + temp355b1 - temp362*temp364*7*dd2**6*temp356b/temp363 & +& + temp356b1 + peff2b = peff2b + peff*temp355b0 + 2*peff2*temp356b/temp367 + & +& temp356b2 + dd3b = dd3b + temp355b1 - temp366*temp368*7*dd3**6*temp356b/temp367 & +& + temp356b3 + ddb(indpar+5) = ddb(indpar+5) + peff2b + ddb(indpar+4) = ddb(indpar+4) + dd3b + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (145) +! 2s without cusp condition !derivative 100 +! -(r^2*exp(-dd2*r^2)) dd2 = dd(indpar+1) indorbp = indorb + 1 DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k))) + distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = -(dd2**2*distp(0, 1)) - funb = 2.d0*zb(indorbp, indt+4) + fun0 = dd2*r(0)**2 + fun = -(2.d0*distp(0, 1)*(1.d0-fun0)) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO - funb = funb + (1.d0-dd2*r(0))*fun2b - dd2b = -(distp(0, 1)*2*dd2*funb) - fun*r(0)*fun2b - rb(0) = rb(0) - fun*dd2*fun2b distpb = 0.0_8 - distpb(0, 1) = -(dd2**2*funb) + temp372b1 = -(2.d0*distp(0, 1)*fun2b) + distpb(0, 1) = -(2.d0*(1.d0-fun0)*funb0) - 2.d0*(2.d0*fun0**2-5.d0& +& *fun0+1.d0)*fun2b + fun0b = 2.d0*distp(0, 1)*funb0 + (2.d0*2*fun0-5.d0)*temp372b1 + dd2b = r(0)**2*fun0b + rb(0) = rb(0) + dd2*2*r(0)*fun0b ELSE distpb = 0.0_8 dd2b = 0.0_8 END IF - dd3b = 0.0_8 DO i=indtm,i0,-1 - temp474b2 = distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + (dd2*r(i)+1.d0)*zb(indorbp, i) - dd2b = dd2b + r(i)*temp474b2 - rb(i) = rb(i) + dd2*temp474b2 - dd3b = dd3b + zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) - r(i)**2*zb(indorbp, i) + rb(i) = rb(i) - distp(i, 1)*2*r(i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO DO k=indtm,indtmin,-1 - temp474b1 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp474b1 - rb(k) = rb(k) - dd2*temp474b1 + temp372b0 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp372b0 + rb(k) = rb(k) - dd2*2*r(k)*temp372b0 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (123) -! 2p double exp -! dd1 * x_mu (exp(-dd2 r)+dd3 * exp(-dd4*r)) - dd2 = dd(indpar+1) - dd3 = dd(indpar+2) - dd4 = dd(indpar+3) + CASE (21) +! 2p without cusp condition + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd(indpar+3) + c = 0.5d0/DSQRT(8.d0*pi*(1.d0/(2.d0*dd1)**5+2.d0*peff/(dd1+dd2)**5+& +& peff**2/(2.d0*dd2)**5)) DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k))) - distp(k, 2) = DEXP(-(dd4*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 2) = c*DEXP(-(dd2*r(k))) + END DO + DO i=indtmin,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = distp(i, 1) + peff*distp(i, 2) END DO -! indorbp=indorb +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = -((dd2*distp(0, 1)+dd3*dd4*distp(0, 2))/r(0)) - fun2 = dd2**2*distp(0, 1) + dd3*dd4**2*distp(0, 2) -! indorbp=indorb + fun = (-(dd1*distp(0, 1))-dd2*peff*distp(0, 2))/r(0) + fun2 = dd1**2*distp(0, 1) + peff*dd2**2*distp(0, 2) +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -18076,115 +17250,134 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END IF END DO END DO - funb = 0.0_8 - fun0b = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp474b9 = rmu(ic, 0)*zb(indorbp, indt+4) + temp380b4 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp474b9 - fun2b = fun2b + temp474b9 + funb0 = funb0 + 4.d0*temp380b4 + fun2b = fun2b + temp380b4 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp474b8 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp474b8 - funb = funb + rmu(ic, 0)*temp474b8 + IF (.NOT.branch .LT. 2) distpb(0, 3) = distpb(0, 3) + zb(& +& indorbp, indt+i) + temp380b3 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp380b3 + funb0 = funb0 + rmu(ic, 0)*temp380b3 rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp474b6 = dd4**2*fun2b - temp474b7 = -(funb/r(0)) - dd2b = distp(0, 1)*temp474b7 + distp(0, 1)*2*dd2*fun2b - distpb(0, 1) = dd2**2*fun2b - dd4b = distp(0, 2)*dd3*temp474b7 + dd3*distp(0, 2)*2*dd4*fun2b - dd3b = distp(0, 2)*dd4*temp474b7 + distp(0, 2)*fun0b + distp(0, 2)& -& *temp474b6 - distpb(0, 2) = dd3*temp474b6 - distpb(0, 1) = distpb(0, 1) + dd2*temp474b7 - distpb(0, 2) = distpb(0, 2) + dd3*dd4*temp474b7 - rb(0) = rb(0) - (dd2*distp(0, 1)+dd3*dd4*distp(0, 2))*temp474b7/r(& -& 0) - distpb(0, 1) = distpb(0, 1) + fun0b - distpb(0, 2) = distpb(0, 2) + dd3*fun0b + temp380b1 = dd2**2*fun2b + temp380b2 = funb0/r(0) + dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*temp380b2 + distpb(0, 1) = distpb(0, 1) + dd1**2*fun2b + dd2b = peff*distp(0, 2)*2*dd2*fun2b - distp(0, 2)*peff*temp380b2 + peffb = distp(0, 2)*temp380b1 - distp(0, 2)*dd2*temp380b2 + distpb(0, 2) = distpb(0, 2) + peff*temp380b1 + distpb(0, 1) = distpb(0, 1) - dd1*temp380b2 + distpb(0, 2) = distpb(0, 2) - dd2*peff*temp380b2 + rb(0) = rb(0) - (-(dd1*distp(0, 1))-dd2*peff*distp(0, 2))*& +& temp380b2/r(0) ELSE distpb = 0.0_8 + peffb = 0.0_8 + dd1b = 0.0_8 dd2b = 0.0_8 - dd3b = 0.0_8 - dd4b = 0.0_8 END IF DO ic=3,1,-1 DO i=indtm,i0,-1 - temp474b5 = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& -& indorbp, i) - distpb(i, 1) = distpb(i, 1) + temp474b5 - dd3b = dd3b + distp(i, 2)*temp474b5 - distpb(i, 2) = distpb(i, 2) + dd3*temp474b5 + rmub(ic, i) = rmub(ic, i) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + rmu(ic, i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + DO i=indtm,indtmin,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distpb(i, 1) = distpb(i, 1) + distpb(i, 3) + peffb = peffb + distp(i, 2)*distpb(i, 3) + distpb(i, 2) = distpb(i, 2) + peff*distpb(i, 3) + distpb(i, 3) = 0.0_8 + END DO + cb = 0.0_8 DO k=indtm,indtmin,-1 - temp474b3 = DEXP(-(dd4*r(k)))*distpb(k, 2) - dd4b = dd4b - r(k)*temp474b3 + temp380b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp380b distpb(k, 2) = 0.0_8 - temp474b4 = DEXP(-(dd2*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd2*temp474b4 - dd4*temp474b3 - dd2b = dd2b - r(k)*temp474b4 + temp380b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp380b0 - dd2*temp380b + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp380b0 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (124) -! 2s double exp with constant and cusp cond. -! (dd3+ exp (-dd2 r)*(1+dd2*r)+dd4*exp(-dd5*r)*(1+dd5*r)) + temp379 = 2.d0**5 + temp378 = temp379*dd2**5 + temp377 = peff**2/temp378 + temp376 = (dd1+dd2)**5 + temp375 = 2.d0**5 + temp374 = temp375*dd1**5 + temp373 = 8.d0*pi*(1.0/temp374+2.d0*peff/temp376+temp377) + temp372 = DSQRT(temp373) + IF (temp373 .EQ. 0.0) THEN + temp372b2 = 0.0 + ELSE + temp372b2 = -(0.5d0*pi*8.d0*cb/(temp372**2*2.D0*DSQRT(temp373))) + END IF + temp372b3 = 2.d0*temp372b2/temp376 + temp372b4 = -(peff*5*(dd1+dd2)**4*temp372b3/temp376) + dd1b = dd1b + temp372b4 - temp375*5*dd1**4*temp372b2/temp374**2 + peffb = peffb + 2*peff*temp372b2/temp378 + temp372b3 + dd2b = dd2b + temp372b4 - temp377*temp379*5*dd2**4*temp372b2/temp378 + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (108) +! 3p single zeta +! 2s double lorentian with constant parent of 102 +! (dd3+ L(dd2 r^2)+dd4*L(dd5*r^2)) ; L(x)=1/1+x^2 dd2 = dd(indpar+1) dd4 = dd(indpar+3) dd5 = dd(indpar+4) indorbp = indorb + 1 DO k=indtmin,indtm - distp(k, 3) = DEXP(-(dd2*r(k))) - distp(k, 4) = DEXP(-(dd5*r(k))) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(k, 1)) - distp(k, 1) = distp(k, 3)*(1.d0+dd2*r(k)) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(k, 2)) - distp(k, 2) = distp(k, 4)*(1.d0+dd5*r(k)) + distp(k, 1) = 1.d0/(1.d0+dd2*r(k)*r(k)) + distp(k, 2) = 1.d0/(1.d0+dd5*r(k)*r(k)) END DO -! write(6,*) ' function inside = ',z(indorbp,i) -! endif +! write(6,*) ' function inside = ',z(indorbp,i) +! endif IF (typec .NE. 1) THEN - fun = -(dd2**2*distp(0, 3)) - dd5**2*dd4*distp(0, 4) - funb = 2.d0*zb(indorbp, indt+4) + fun = -(2.d0*(dd2*distp(0, 1)**2+dd5*dd4*distp(0, 2)**2)) fun2b = zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp474b14 = -((1.d0-dd2*r(0))*fun2b) - temp474b15 = -(dd2**2*distp(0, 3)*fun2b) - temp474b16 = -((1.d0-dd5*r(0))*fun2b) - temp474b17 = dd5**2*temp474b16 - temp474b18 = -(dd5**2*dd4*distp(0, 4)*fun2b) - dd2b = distp(0, 3)*2*dd2*temp474b14 - r(0)*temp474b15 - distp(0, 3& -& )*2*dd2*funb - distpb(0, 3) = dd2**2*temp474b14 - rb(0) = rb(0) - dd5*temp474b18 - dd2*temp474b15 - dd5b = dd4*distp(0, 4)*2*dd5*temp474b16 - r(0)*temp474b18 - dd4*& -& distp(0, 4)*2*dd5*funb - temp474b19 = -(dd5**2*funb) - dd4b = distp(0, 4)*temp474b19 + distp(0, 4)*temp474b17 - distpb(0, 4) = dd4*temp474b17 - distpb(0, 3) = distpb(0, 3) - dd2**2*funb - distpb(0, 4) = distpb(0, 4) + dd4*temp474b19 + temp383 = distp(0, 1)**3 + temp383b = 2.d0*(3.d0*(dd2*r(0)**2)-1.d0)*fun2b + temp383b0 = 2.d0*dd2*temp383*3.d0*fun2b + temp382 = distp(0, 2)**3 + temp382b = 2.d0*(3.d0*(dd5*r(0)**2)-1.d0)*fun2b + temp382b0 = 2.d0*dd5*dd4*temp382*3.d0*fun2b + temp382b1 = -(2.d0*funb0) + dd2b = distp(0, 1)**2*temp382b1 + r(0)**2*temp383b0 + temp383*& +& temp383b + distpb(0, 1) = dd2*3*distp(0, 1)**2*temp383b + rb(0) = rb(0) + dd5*2*r(0)*temp382b0 + dd2*2*r(0)*temp383b0 + temp382b2 = distp(0, 2)**2*temp382b1 + dd5b = dd4*temp382b2 + r(0)**2*temp382b0 + temp382*dd4*temp382b + dd4b = dd5*temp382b2 + temp382*dd5*temp382b + distpb(0, 2) = dd5*dd4*3*distp(0, 2)**2*temp382b + distpb(0, 1) = distpb(0, 1) + dd2*2*distp(0, 1)*temp382b1 + distpb(0, 2) = distpb(0, 2) + dd5*dd4*2*distp(0, 2)*temp382b1 ELSE distpb = 0.0_8 dd2b = 0.0_8 @@ -18200,161 +17393,98 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & zb(indorbp, i) = 0.0_8 END DO DO k=indtm,indtmin,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(k, 2)) - temp474b10 = distp(k, 4)*distpb(k, 2) - distpb(k, 4) = distpb(k, 4) + (dd5*r(k)+1.d0)*distpb(k, 2) + temp381 = dd5*r(k)**2 + 1.d0 + temp381b = -(distpb(k, 2)/temp381**2) + dd5b = dd5b + r(k)**2*temp381b distpb(k, 2) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(k, 1)) - temp474b11 = distp(k, 3)*distpb(k, 1) - distpb(k, 3) = distpb(k, 3) + (dd2*r(k)+1.d0)*distpb(k, 1) + temp380 = dd2*r(k)**2 + 1.d0 + temp380b5 = -(distpb(k, 1)/temp380**2) + rb(k) = rb(k) + dd2*2*r(k)*temp380b5 + dd5*2*r(k)*temp381b + dd2b = dd2b + r(k)**2*temp380b5 distpb(k, 1) = 0.0_8 - temp474b12 = DEXP(-(dd5*r(k)))*distpb(k, 4) - dd5b = dd5b + r(k)*temp474b10 - r(k)*temp474b12 - distpb(k, 4) = 0.0_8 - temp474b13 = DEXP(-(dd2*r(k)))*distpb(k, 3) - rb(k) = rb(k) + dd2*temp474b11 - dd2*temp474b13 - dd5*temp474b12 +& -& dd5*temp474b10 - dd2b = dd2b + r(k)*temp474b11 - r(k)*temp474b13 - distpb(k, 3) = 0.0_8 END DO ddb(indpar+4) = ddb(indpar+4) + dd5b ddb(indpar+3) = ddb(indpar+3) + dd4b ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (125) -! 2s with cusp condition -! dd1*( dd3 +exp(-dd2*r)) ! with no cusp condition - dd2 = dd(indpar+1) - indorbp = indorb + 1 - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k))) - END DO -! endif - IF (typec .NE. 1) THEN - fun = -(dd2*distp(0, 1)/r(0)) - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp474b21 = -(distp(0, 1)*funb/r(0)) - dd2b = temp474b21 + distp(0, 1)*2*dd2*fun2b - temp474 = dd2/r(0) - distpb(0, 1) = dd2**2*fun2b - temp474*funb - rb(0) = rb(0) - temp474*temp474b21 - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - dd3b = 0.0_8 - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=indtm,indtmin,-1 - temp474b20 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp474b20 - rb(k) = rb(k) - dd2*temp474b20 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+2) = ddb(indpar+2) + dd3b - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (126) -! 2s double exp with constant -! (dd3+ exp (-dd2 r)+dd4*exp(-dd5*r)) + CASE (131) +! 2s without cusp condition +! dd1*(r^2*exp(-dd2*r^2)) dd2 = dd(indpar+1) - dd4 = dd(indpar+3) - dd5 = dd(indpar+4) indorbp = indorb + 1 DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k))) - distp(k, 2) = DEXP(-(dd5*r(k))) + distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) END DO -! write(6,*) ' function inside = ',z(indorbp,i) -! endif +! endif IF (typec .NE. 1) THEN - fun = -((dd2*distp(0, 1)+dd5*dd4*distp(0, 2))/r(0)) - funb = 2.d0*zb(indorbp, indt+4) + fun0 = dd2*r(0)**2 + fun = 2.d0*distp(0, 1)*(1.d0-fun0) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp475b1 = dd5**2*fun2b - temp475b2 = -(funb/r(0)) - dd2b = distp(0, 1)*temp475b2 + distp(0, 1)*2*dd2*fun2b - distpb(0, 1) = dd2**2*fun2b - dd5b = distp(0, 2)*dd4*temp475b2 + dd4*distp(0, 2)*2*dd5*fun2b - dd4b = distp(0, 2)*dd5*temp475b2 + distp(0, 2)*temp475b1 - distpb(0, 2) = dd4*temp475b1 - distpb(0, 1) = distpb(0, 1) + dd2*temp475b2 - distpb(0, 2) = distpb(0, 2) + dd5*dd4*temp475b2 - rb(0) = rb(0) - (dd2*distp(0, 1)+dd5*dd4*distp(0, 2))*temp475b2/r(& -& 0) + temp384b0 = 2.d0*distp(0, 1)*fun2b + distpb(0, 1) = 2.d0*(1.d0-fun0)*funb0 + 2.d0*(2.d0*fun0**2-5.d0*& +& fun0+1.d0)*fun2b + fun0b = (2.d0*2*fun0-5.d0)*temp384b0 - 2.d0*distp(0, 1)*funb0 + dd2b = r(0)**2*fun0b + rb(0) = rb(0) + dd2*2*r(0)*fun0b ELSE distpb = 0.0_8 dd2b = 0.0_8 - dd4b = 0.0_8 - dd5b = 0.0_8 END IF - dd3b = 0.0_8 DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - dd3b = dd3b + zb(indorbp, i) - dd4b = dd4b + distp(i, 2)*zb(indorbp, i) - distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO DO k=indtm,indtmin,-1 - temp475b = DEXP(-(dd5*r(k)))*distpb(k, 2) - dd5b = dd5b - r(k)*temp475b - distpb(k, 2) = 0.0_8 - temp475b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd2*temp475b0 - dd5*temp475b - dd2b = dd2b - r(k)*temp475b0 + temp384b = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp384b + rb(k) = rb(k) - dd2*2*r(k)*temp384b distpb(k, 1) = 0.0_8 END DO - ddb(indpar+4) = ddb(indpar+4) + dd5b - ddb(indpar+3) = ddb(indpar+3) + dd4b - ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (127) -! 3d without cusp and one parmater + CASE (133) +! 4d one parmater dd1 = dd(indpar+1) DO k=indtmin,indtm distp(k, 1) = DEXP(-(dd1*r(k))) END DO DO i=indtmin,indtm - distp(i, 3) = distp(i, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distp(i, 3) = distp(i, 1)*r(i) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d END DO -! indorbp=indorb +! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN fun0 = distp(0, 3) - fun = -(dd1*distp(0, 1)) - fun2 = dd1**2*distp(0, 1) -! indorbp=indorb + fun = (1.d0-dd1*r(0))*distp(0, 1) + fun2 = dd1*(dd1*r(0)-2.d0)*distp(0, 1) +! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN @@ -18401,18 +17531,18 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=5,1,-1 - temp476 = fun/r(0) - temp477b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp476b3 = 6.d0*temp477b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp476+fun2)*zb(& + temp385 = fun/r(0) + temp386b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp385b3 = 6.d0*temp386b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp385+fun2)*zb(& & indorbp, indt+4) - funb = funb + temp476b3 - rb(0) = rb(0) - temp476*temp476b3 - fun2b = fun2b + temp477b + funb0 = funb0 + temp385b3 + rb(0) = rb(0) - temp385*temp385b3 + fun2b = fun2b + temp386b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -18420,24 +17550,24 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN IF (branch .LT. 2) THEN - temp476b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp476b - fun0b = fun0b + rmu(i, 0)*temp476b + temp385b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp385b + fun0b = fun0b + rmu(i, 0)*temp385b ELSE - temp476b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp476b0 - fun0b = fun0b + rmu(i, 0)*temp476b0 + temp385b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp385b0 + fun0b = fun0b + rmu(i, 0)*temp385b0 END IF ELSE IF (branch .LT. 4) THEN - temp476b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp476b1 - fun0b = fun0b + rmu(i, 0)*temp476b1 + temp385b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp385b1 + fun0b = fun0b + rmu(i, 0)*temp385b1 END IF ELSE IF (branch .LT. 7) THEN IF (branch .LT. 6) THEN - temp476b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp476b2 - fun0b = fun0b + rmu(i, 0)*temp476b2 + temp385b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp385b2 + fun0b = fun0b + rmu(i, 0)*temp385b2 ELSE rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) @@ -18467,20 +17597,25 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp475 = fun/r(0) - temp475b4 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp475*rmu(i, 0)*zb(& + temp384 = fun/r(0) + temp384b4 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp384*rmu(i, 0)*zb(& & indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp475*distp(0, 3+ic)*zb(indorbp, & + rmub(i, 0) = rmub(i, 0) + temp384*distp(0, 3+ic)*zb(indorbp, & & indt+i) - funb = funb + temp475b4 - rb(0) = rb(0) - temp475*temp475b4 + funb0 = funb0 + temp384b4 + rb(0) = rb(0) - temp384*temp384b4 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb - distpb(0, 1) = distpb(0, 1) + dd1**2*fun2b - dd1*funb + temp384b2 = dd1*distp(0, 1)*fun2b + temp384b3 = (dd1*r(0)-2.d0)*fun2b + dd1b = distp(0, 1)*temp384b3 - distp(0, 1)*r(0)*funb0 + r(0)*& +& temp384b2 + rb(0) = rb(0) + dd1*temp384b2 - distp(0, 1)*dd1*funb0 + distpb(0, 1) = distpb(0, 1) + (1.d0-dd1*r(0))*funb0 + dd1*& +& temp384b3 distpb(0, 3) = distpb(0, 3) + fun0b ELSE distpb = 0.0_8 @@ -18495,94 +17630,355 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) distpb(i, 8) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) distpb(i, 7) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - distpb(i, 1) = distpb(i, 1) + distpb(i, 3) + CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) + distpb(i, 1) = distpb(i, 1) + r(i)*distpb(i, 3) + rb(i) = rb(i) + distp(i, 1)*distpb(i, 3) distpb(i, 3) = 0.0_8 END DO DO k=indtm,indtmin,-1 - temp475b3 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp475b3 - rb(k) = rb(k) - dd1*temp475b3 + temp384b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp384b1 + rb(k) = rb(k) - dd1*temp384b1 distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (128) -! 2s with cusp condition -! ( r^2*exp(-dd2*r)) ! with no cusp condition - dd2 = dd(indpar+1) + CASE (66) +! derivative of 57 (orbital 1s STO regolarized for r->0) +! dR(r)/dz with R(r)= C(z) * P(z*r) * exp(-z*r) +! P(x) = (x+a)^n/(1+(x+a)^n) with a so that P(0)==dP(0)/dx +! C(z) = const * z^(3/2) normalization +! the following definitions are in module constants +! n -> costSTO1s_n = 4 +! a -> costSTO1s_a = 1.2263393530877080588 +! const(n) -> costSTO1s_c = 0.58542132302621750732 +! +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k))) + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! if(dd1.gt.0.) then + c = coststo1s_c*dd1**1.5d0 +! else +! c=1.d0 +! endif +! endif + DO i=indtmin,indtm + distp(i, 1) = c*DEXP(-(dd1*r(i))) + END DO + DO i=i0,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = dd1*r(i) + coststo1s_a + CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) + rp4 = rp1**coststo1s_n END DO -! endif IF (typec .NE. 1) THEN - fun = (2.d0-dd2*r(0))*distp(0, 1) - funb = 2.d0*zb(indorbp, indt+4) + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = dd1*r(0) + coststo1s_a + rp2 = rp1**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) + rp4 = rp1**coststo1s_n + rp6 = rp4**2 +! the first derivative /r + fun = distp(0, 1)*(dd1*rp4*(-(2.d0*coststo1s_a*(coststo1s_n**2*(-& +& 1.d0+rp4)+coststo1s_n*(1.d0+2.d0*rp1)*(1.d0+rp4)-rp2*(1.d0+rp4)& +& **2))+rp1*(2*coststo1s_n**2*(-1+rp4)+coststo1s_n*(-3.d0+4.d0*rp1& +& )*(1.d0+rp4)-rp1*(-5.d0+2.d0*rp1)*(1.d0+rp4)**2)))/(2.d0*rp2*(& +& coststo1s_a-rp1)*(1.d0+rp4)**3) +! fun=+distp(0,1)*rp4/(1.d0+rp4)*(1.5d0/dd1 + r(0)* & +! &(-1.d0+(costSTO1s_n)/(rp1*(1.d0+rp4)))) & +! &*(dd1*(2.d0 + 5.d0/(-dd1*r(0)) + & +! &(4.d0*costSTO1s_n**2)/(rp2*(1.d0+rp4)**2) + & +! &(costSTO1s_n*((3.d0 - 2.d0*costSTO1s_n - 4.d0*rp1)*rp1& +! &+ 2.d0*costSTO1s_a*(1.d0+costSTO1s_n+2.d0*rp1)))/ & +! &(rp2*(dd1*r(0))*(1 + rp4))))/2.d0 +! the second derivative derivative + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp477b1 = distp(0, 1)*fun2b - temp477b2 = 2*dd2*r(0)*temp477b1 - dd2b = r(0)*temp477b2 - 4*r(0)*temp477b1 - distp(0, 1)*r(0)*funb - rb(0) = rb(0) + dd2*temp477b2 - 4*dd2*temp477b1 - distp(0, 1)*dd2*& -& funb - distpb(0, 1) = (2.d0-dd2*r(0))*funb + ((dd2*r(0))**2-4*(dd2*r(0))+& -& 2.d0)*fun2b + temp410 = (rp4+1)**4 + temp397 = 2.d0*rp1*rp2 + temp398 = temp397*temp410 + temp409 = distp(0, 1)*dd1*rp4 + temp399 = temp409/temp398 + temp409b = -(temp399*fun2b) + temp408 = coststo1s_n**3 + temp404 = 6.d0*rp2 - 8.d0*rp1 - 3.d0 + temp407 = (rp4+1.d0)**3 + temp406 = rp2*(2.d0*rp1-7.d0) + temp405 = temp406*temp407 - coststo1s_n*temp404*(rp4+1.d0)**2 - & +& coststo1s_n**2*(6.d0*rp1-1.d0)*(rp6-1.d0) - 2*temp408*(rp4*(rp4-& +& 4.d0)+1.d0) + temp405b = rp1*temp409b + temp404b = -(coststo1s_n*(rp4+1.d0)**2*temp405b) + temp404b0 = -(coststo1s_n**2*temp405b) + temp404b1 = -(temp408*2*temp405b) + temp403 = coststo1s_n**3 + temp402 = 3.d0*rp1*(rp1+1.d0) + 2.d0 + temp401 = (rp4+1.d0)**3 + temp400 = 3.d0*coststo1s_n**2 + temp400b = coststo1s_a*2.d0*temp409b + temp400b0 = coststo1s_n*(rp4+1.d0)**2*3.d0*temp400b + temp399b = -((rp1*temp405+coststo1s_a*2.d0*(temp400*((rp1+1.d0)*(& +& rp6-1.d0))-rp1*rp2*temp401+coststo1s_n*((rp4+1.d0)**2*temp402)+& +& temp403*(rp4*(rp4-4.d0)+1.d0)))*fun2b/temp398) + temp398b = -(temp399*temp399b) + temp397b = temp410*temp398b + temp396 = (rp4+1.d0)**3 + temp389 = 2.d0*rp2*(coststo1s_a-rp1) + temp390 = temp389*temp396 + temp395 = distp(0, 1)*dd1*rp4 + temp391 = temp395/temp390 + temp395b = temp391*funb0 + temp394 = (rp4+1.d0)**2 + temp393 = rp1*(2.d0*rp1-5.d0) + temp392 = 2*coststo1s_n**2*(rp4-1) + coststo1s_n*(4.d0*rp1-3.d0)*(& +& rp4+1.d0) - temp393*temp394 + temp392b = -(coststo1s_a*2.d0*temp395b) + temp391b = (rp1*temp392-coststo1s_a*2.d0*(coststo1s_n**2*(rp4-1.d0& +& )+coststo1s_n*((2.d0*rp1+1.d0)*(rp4+1.d0))-rp2*(rp4+1.d0)**2))*& +& funb0/temp390 + temp390b = -(temp391*temp391b) + temp389b0 = temp396*temp390b + rp2b = (coststo1s_a-rp1)*2.d0*temp389b0 - (rp4+1.d0)**2*temp392b +& +& 2.d0*rp1*temp397b - temp401*rp1*temp400b + 6.d0*temp404b + & +& temp407*(2.d0*rp1-7.d0)*temp405b + rp6b = temp400*(rp1+1.d0)*temp400b + (6.d0*rp1-1.d0)*temp404b0 + temp392b0 = rp1*temp395b + rp4b = (coststo1s_n*(4.d0*rp1-3.d0)-temp393*2*(rp4+1.d0)+2*& +& coststo1s_n**2)*temp392b0 + (coststo1s_n*(2.d0*rp1+1.d0)-rp2*2*(& +& rp4+1.d0)+coststo1s_n**2)*temp392b + distp(0, 1)*dd1*temp391b + & +& temp389*3*(rp4+1.d0)**2*temp390b + 2*rp4*rp6b + temp397*4*(rp4+1& +& )**3*temp398b + distp(0, 1)*dd1*temp399b + (temp403*rp4+temp403*& +& (rp4-4.d0)+coststo1s_n*temp402*2*(rp4+1.d0)-rp1*rp2*3*(rp4+1.d0)& +& **2)*temp400b + (2*rp4-4.d0)*temp404b1 + (temp406*3*(rp4+1.d0)**& +& 2-coststo1s_n*temp404*2*(rp4+1.d0))*temp405b + IF (rp1 .LE. 0.0 .AND. (coststo1s_n .EQ. 0.0 .OR. coststo1s_n .NE.& +& INT(coststo1s_n))) THEN + rp1b = temp392*temp395b + (coststo1s_n*(rp4+1.d0)*4.d0-temp394*(& +& 2.d0*rp1-5.d0)-temp394*rp1*2.d0)*temp392b0 + coststo1s_n*(rp4+& +& 1.d0)*2.d0*temp392b - 2.d0*rp2*temp389b0 + 2*rp1*rp2b + rp2*& +& 2.d0*temp397b + (2*rp1+1.d0)*temp400b0 + (temp400*(rp6-1.d0)-& +& temp401*rp2)*temp400b + (rp6-1.d0)*6.d0*temp404b0 - 8.d0*& +& temp404b + temp407*rp2*2.d0*temp405b + temp405*temp409b + ELSE + rp1b = temp392*temp395b + (coststo1s_n*(rp4+1.d0)*4.d0-temp394*(& +& 2.d0*rp1-5.d0)-temp394*rp1*2.d0)*temp392b0 + coststo1s_n*(rp4+& +& 1.d0)*2.d0*temp392b - 2.d0*rp2*temp389b0 + 2*rp1*rp2b + & +& coststo1s_n*rp1**(coststo1s_n-1)*rp4b + rp2*2.d0*temp397b + (2& +& *rp1+1.d0)*temp400b0 + (temp400*(rp6-1.d0)-temp401*rp2)*& +& temp400b + (rp6-1.d0)*6.d0*temp404b0 - 8.d0*temp404b + temp407& +& *rp2*2.d0*temp405b + temp405*temp409b + END IF + distpb(0, 1) = dd1*rp4*temp391b + dd1*rp4*temp399b + dd1b = distp(0, 1)*rp4*temp391b + r(0)*rp1b + distp(0, 1)*rp4*& +& temp399b + CALL POPREAL8(adr8ibuf,adr8buf,rp4) + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + rb(0) = rb(0) + dd1*rp1b ELSE distpb = 0.0_8 - dd2b = 0.0_8 + dd1b = 0.0_8 END IF DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) + temp386 = rp4/(rp4+1.d0) + temp389b = distp(i, 1)*temp386*zb(indorbp, i) + temp387 = rp1*(rp4+1.d0) + temp388 = coststo1s_n/temp387 + temp387b = -(r(i)*temp388*temp389b/temp387) + temp387b0 = (1.5d0/dd1+r(i)*(temp388-1.d0))*zb(indorbp, i) + temp386b1 = distp(i, 1)*temp387b0/(rp4+1.d0) + rp4b = (1.0_8-temp386)*temp386b1 + rp1*temp387b + IF (rp1 .LE. 0.0 .AND. (coststo1s_n .EQ. 0.0 .OR. coststo1s_n .NE.& +& INT(coststo1s_n))) THEN + rp1b = (rp4+1.d0)*temp387b + ELSE + rp1b = coststo1s_n*rp1**(coststo1s_n-1)*rp4b + (rp4+1.d0)*& +& temp387b + END IF + dd1b = dd1b + r(i)*rp1b - 1.5d0*temp389b/dd1**2 + rb(i) = rb(i) + dd1*rp1b + (temp388-1.d0)*temp389b + distpb(i, 1) = distpb(i, 1) + temp386*temp387b0 zb(indorbp, i) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,rp4) + CALL POPREAL8(adr8ibuf,adr8buf,rp1) END DO - DO k=indtm,indtmin,-1 - temp477b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp477b0 - rb(k) = rb(k) - dd2*temp477b0 - distpb(k, 1) = 0.0_8 + cb = 0.0_8 + DO i=indtm,indtmin,-1 + temp386b0 = c*DEXP(-(dd1*r(i)))*distpb(i, 1) + cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) + dd1b = dd1b - r(i)*temp386b0 + rb(i) = rb(i) - dd1*temp386b0 + distpb(i, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (129) -! 2p single exponential r e^{-z r} ! parent of 121 + dd1b = dd1b + coststo1s_c*1.5d0*dd1**0.5D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (57) +! orbital 1s (no cusp) - STO regolarized for r->0 +! R(r)= C(z) * P(z*r) * exp(-z*r) +! P(x) = (x+a)^n/(1+(x+a)^n) with a so that P(0)==dP(0)/dx +! C(z) = const * z^(3/2) normalization +! the following definitions are in module constants +! n -> costSTO1s_n = 4 +! a -> costSTO1s_a = 1.2263393530877080588 +! const(n) -> costSTO1s_c = 0.58542132302621750732 +! +! +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! if(dd1.gt.0.) then + c = coststo1s_c*dd1**1.5d0 +! else +! c=1.d0 +! endif +! endif + DO i=indtmin,indtm + distp(i, 1) = c*DEXP(-(dd1*r(i))) + END DO + DO i=i0,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) + rp4 = (dd1*r(i)+coststo1s_a)**coststo1s_n + END DO + IF (typec .NE. 1) THEN + rp1 = dd1*r(0) + coststo1s_a + rp2 = rp1**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) + rp4 = rp1**coststo1s_n +! the first derivative /r +!fun=-z(indorbp,0)*((dd1**2*(-costSTO1s_n+rp1+rp1*rp4))/ & +! &(rp1*(-costSTO1s_a+rp1)*(1.d0+rp4))) + fun = -(distp(0, 1)*rp4*(dd1**2*(-coststo1s_n+rp1+rp1*rp4)/(rp1*(-& +& coststo1s_a+rp1)*(1.d0+rp4)**2))) +! the second derivative derivative + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp419 = (rp4+1.d0)**3 + temp416 = rp2*temp419 + temp417b = (rp2*(rp4+1.d0)**2-coststo1s_n*((2.d0*rp1+1.d0)*(rp4+& +& 1.d0))-coststo1s_n**2*(rp4-1.d0))*fun2b/temp416 + temp419b = dd1**2*temp417b + temp418 = distp(0, 1)*rp4*dd1**2 + temp417 = temp418/temp416 + temp416b = -(temp417*temp417b) + temp416b0 = temp417*fun2b + temp415 = (rp4+1.d0)**2 + temp412 = rp1*(rp1-coststo1s_a)*temp415 + temp415b = -(funb0/temp412) + temp413 = rp1 - coststo1s_n + rp1*rp4 + temp414b = temp413*temp415b + temp415b0 = dd1**2*temp414b + distpb(0, 1) = rp4*temp415b0 + rp4*temp419b + temp414 = distp(0, 1)*rp4*dd1**2 + temp413b = temp414*temp415b + temp412b = -(temp414*temp413*temp415b/temp412) + rp4b = distp(0, 1)*temp415b0 + rp1*temp413b + rp1*(rp1-coststo1s_a& +& )*2*(rp4+1.d0)*temp412b + (rp2*2*(rp4+1.d0)-coststo1s_n*(2.d0*& +& rp1+1.d0)-coststo1s_n**2)*temp416b0 + rp2*3*(rp4+1.d0)**2*& +& temp416b + distp(0, 1)*temp419b + rp2b = (rp4+1.d0)**2*temp416b0 + temp419*temp416b + IF (rp1 .LE. 0.0 .AND. (coststo1s_n .EQ. 0.0 .OR. coststo1s_n .NE.& +& INT(coststo1s_n))) THEN + rp1b = (rp4+1.0_8)*temp413b + (temp415*rp1+temp415*(rp1-& +& coststo1s_a))*temp412b + 2*rp1*rp2b - coststo1s_n*(rp4+1.d0)*& +& 2.d0*temp416b0 + ELSE + rp1b = (rp4+1.0_8)*temp413b + (temp415*rp1+temp415*(rp1-& +& coststo1s_a))*temp412b + 2*rp1*rp2b + coststo1s_n*rp1**(& +& coststo1s_n-1)*rp4b - coststo1s_n*(rp4+1.d0)*2.d0*temp416b0 + END IF + dd1b = distp(0, 1)*rp4*2*dd1*temp414b + r(0)*rp1b + distp(0, 1)*& +& rp4*2*dd1*temp417b + CALL POPREAL8(adr8ibuf,adr8buf,rp4) + rb(0) = rb(0) + dd1*rp1b + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + END IF + DO i=indtm,i0,-1 + temp411 = rp4/(rp4+1.d0) + temp411b0 = distp(i, 1)*zb(indorbp, i)/(rp4+1.d0) + distpb(i, 1) = distpb(i, 1) + temp411*zb(indorbp, i) + rp4b = (1.0_8-temp411)*temp411b0 + zb(indorbp, i) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,rp4) + IF (coststo1s_a + dd1*r(i) .LE. 0.0 .AND. (coststo1s_n .EQ. 0.0 & +& .OR. coststo1s_n .NE. INT(coststo1s_n))) THEN + temp411b1 = 0.0 + ELSE + temp411b1 = coststo1s_n*(coststo1s_a+dd1*r(i))**(coststo1s_n-1)*& +& rp4b + END IF + dd1b = dd1b + r(i)*temp411b1 + rb(i) = rb(i) + dd1*temp411b1 + END DO + cb = 0.0_8 + DO i=indtm,indtmin,-1 + temp411b = c*DEXP(-(dd1*r(i)))*distpb(i, 1) + cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) + dd1b = dd1b - r(i)*temp411b + rb(i) = rb(i) - dd1*temp411b + distpb(i, 1) = 0.0_8 + END DO + dd1b = dd1b + coststo1s_c*1.5d0*dd1**0.5D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (123) +! 2p double exp +! dd1 * x_mu (exp(-dd2 r)+dd3 * exp(-dd4*r)) dd2 = dd(indpar+1) + dd3 = dd(indpar+2) + dd4 = dd(indpar+3) DO k=indtmin,indtm distp(k, 1) = DEXP(-(dd2*r(k))) + distp(k, 2) = DEXP(-(dd4*r(k))) END DO -! indorbp=indorb +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = distp(0, 1)*(1.d0-dd2*r(0))/r(0) - fun2 = dd2*(dd2*r(0)-2.d0)*distp(0, 1) -! indorbp=indorb + fun = -((dd2*distp(0, 1)+dd3*dd4*distp(0, 2))/r(0)) + fun2 = dd2**2*distp(0, 1) + dd3*dd4**2*distp(0, 2) +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -18592,265 +17988,494 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp478b2 = rmu(ic, 0)*zb(indorbp, indt+4) + temp420b5 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp478b2 - fun2b = fun2b + temp478b2 + funb0 = funb0 + 4.d0*temp420b5 + fun2b = fun2b + temp420b5 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp478b1 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp478b1 - funb = funb + rmu(ic, 0)*temp478b1 + temp420b4 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp420b4 + funb0 = funb0 + rmu(ic, 0)*temp420b4 rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp478b = dd2*distp(0, 1)*fun2b - temp478b0 = (dd2*r(0)-2.d0)*fun2b - temp477 = distp(0, 1)/r(0) - dd2b = distp(0, 1)*temp478b0 - temp477*r(0)*funb + r(0)*temp478b - temp477b5 = (1.d0-dd2*r(0))*funb/r(0) - rb(0) = rb(0) + distp(0, 1)*fun0b - temp477*dd2*funb - temp477*& -& temp477b5 + dd2*temp478b - distpb(0, 1) = temp477b5 + r(0)*fun0b + dd2*temp478b0 + temp420b2 = dd4**2*fun2b + temp420b3 = -(funb0/r(0)) + dd2b = distp(0, 1)*temp420b3 + distp(0, 1)*2*dd2*fun2b + distpb(0, 1) = dd2**2*fun2b + dd4b = distp(0, 2)*dd3*temp420b3 + dd3*distp(0, 2)*2*dd4*fun2b + dd3b = distp(0, 2)*dd4*temp420b3 + distp(0, 2)*fun0b + distp(0, 2)& +& *temp420b2 + distpb(0, 2) = dd3*temp420b2 + distpb(0, 1) = distpb(0, 1) + dd2*temp420b3 + distpb(0, 2) = distpb(0, 2) + dd3*dd4*temp420b3 + rb(0) = rb(0) - (dd2*distp(0, 1)+dd3*dd4*distp(0, 2))*temp420b3/r(& +& 0) + distpb(0, 1) = distpb(0, 1) + fun0b + distpb(0, 2) = distpb(0, 2) + dd3*fun0b ELSE distpb = 0.0_8 dd2b = 0.0_8 + dd3b = 0.0_8 + dd4b = 0.0_8 END IF DO ic=3,1,-1 DO i=indtm,i0,-1 - temp477b4 = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*r(i)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + r(i)*temp477b4 - rb(i) = rb(i) + distp(i, 1)*temp477b4 + temp420b1 = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& +& indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp420b1 + dd3b = dd3b + distp(i, 2)*temp420b1 + distpb(i, 2) = distpb(i, 2) + dd3*temp420b1 zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=indtm,indtmin,-1 - temp477b3 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp477b3 - rb(k) = rb(k) - dd2*temp477b3 + temp420b = DEXP(-(dd4*r(k)))*distpb(k, 2) + dd4b = dd4b - r(k)*temp420b + distpb(k, 2) = 0.0_8 + temp420b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd2*temp420b0 - dd4*temp420b + dd2b = dd2b - r(k)*temp420b0 distpb(k, 1) = 0.0_8 END DO + ddb(indpar+3) = ddb(indpar+3) + dd4b + ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (130) -! 2p single exponential r^2 e^{-z r} ! parent of 121 - dd2 = dd(indpar+1) + CASE (87) +! f orbitals +! R(r)= c*exp(-z r^2)*(9/4/z-r^2) +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) + dd2 = DSQRT(dd1) +! if(iflagnorm.gt.2) then +! overall normalization +! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0)*ratiocf + c = dd1**2.25d0*ratiocf +! endif DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k))) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) + END DO + DO i=indtmin,indtm + distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) +! lz=0 + distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) +! lz=+/-1 + distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) +! lz=+/-2 + distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) +! lz=+/-2 + distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) +! lz=+/-3 + distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) END DO -! indorbp=indorb - DO ic=1,3 +! lz=+/-3 + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic + DO k=i0,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 + END DO END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = distp(0, 1)*(2.d0-dd2*r(0)) - fun2 = (2.d0-4.d0*dd2*r(0)+(dd2*r(0))**2)*distp(0, 1) -! indorbp=indorb - DO ic=1,3 + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = (1.d0+0.5d0*rp2)/rp3 + fun0 = distp(0, 1)*(9.d0/4.d0/dd1-r(0)**2*cost) + fun = 0.25d0*distp(0, 1)*(-26.d0-59.d0*rp2-36.d0*rp1-3.d0*rp1*rp2+& +& 2.d0*rp1**2)/rp3**2 + fun2 = 0.25d0*distp(0, 1)*(-26.d0-66.d0*rp2+22.d0*rp1+178.d0*rp1*& +& rp2+165.d0*rp1**2+54.d0*rp1**2*rp2+rp1**3-2.d0*rp1**3*rp2)/rp3**& +& 3 +! indorbp=indorb + DO ic=1,7 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + IF (ic .EQ. 1) THEN + IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF + ELSE IF (ic .EQ. 6) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + END IF + ELSE IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) END IF END DO END DO - funb = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=3,1,-1 - temp478b8 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp478b8 - fun2b = fun2b + temp478b8 + DO ic=7,1,-1 + temp431b23 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 8.d0*temp431b23 + fun2b = fun2b + temp431b23 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp478b7 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp478b7 - funb = funb + rmu(ic, 0)*temp478b7 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + IF (branch .LT. 11) THEN + IF (branch .LT. 6) THEN + IF (branch .LT. 4) THEN + IF (branch .LT. 3) THEN + IF (.NOT.branch .LT. 2) THEN + temp431b2 = cost1f*zb(indorbp, indt+i) + fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& +& temp431b2 + rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& +& temp431b2 + rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp431b2 + END IF + temp431b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) + temp431b1 = rmu(i, 0)*temp431b0 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp431b0 + fun0b = fun0b + rmu(3, 0)*temp431b1 + rmub(3, 0) = rmub(3, 0) + fun0*temp431b1 + GOTO 150 + ELSE + temp431b5 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp431b5 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp431b5 + rb(0) = rb(0) - fun0*2*r(0)*temp431b5 + END IF + ELSE IF (.NOT.branch .LT. 5) THEN + temp431b6 = cost2f*10.d0*zb(indorbp, indt+i) + temp431b7 = rmu(i, 0)*temp431b6 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp431b6 + fun0b = fun0b + rmu(1, 0)*temp431b7 + rmub(1, 0) = rmub(1, 0) + fun0*temp431b7 + END IF + temp431b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp431b4 = rmu(i, 0)*temp431b3 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp431b3 + fun0b = fun0b + rmu(1, 0)*temp431b4 + rmub(1, 0) = rmub(1, 0) + fun0*temp431b4 + ELSE IF (branch .LT. 9) THEN + IF (branch .LT. 8) THEN + IF (branch .LT. 7) THEN + temp431b10 = cost2f*zb(indorbp, indt+i) + fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp431b10 + rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& +& temp431b10 + rb(0) = rb(0) - fun0*2*r(0)*temp431b10 + END IF + ELSE + temp431b11 = cost2f*10.d0*zb(indorbp, indt+i) + temp431b12 = rmu(i, 0)*temp431b11 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp431b11 + fun0b = fun0b + rmu(2, 0)*temp431b12 + rmub(2, 0) = rmub(2, 0) + fun0*temp431b12 + END IF + temp431b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) + temp431b9 = rmu(i, 0)*temp431b8 + rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp431b8 + fun0b = fun0b + rmu(2, 0)*temp431b9 + rmub(2, 0) = rmub(2, 0) + fun0*temp431b9 + ELSE IF (branch .LT. 10) THEN + temp431b13 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp431b13 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp431b13 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp431b13 + ELSE + temp431b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp431b14 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp431b14 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp431b14 + END IF + ELSE IF (branch .LT. 16) THEN + IF (branch .LT. 14) THEN + IF (branch .LT. 13) THEN + IF (branch .LT. 12) THEN + temp431b15 = cost3f*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp431b15 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp431b15 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp431b15 + ELSE + temp431b16 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp431b16 + rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp431b16 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp431b16 + END IF + ELSE + temp431b17 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp431b17 + rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp431b17 + rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp431b17 + END IF + ELSE IF (branch .LT. 15) THEN + temp431b18 = cost3f*2.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp431b18 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp431b18 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp431b18 + ELSE + temp431b19 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp431b19 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp431b19 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp431b19 + END IF + ELSE IF (branch .LT. 19) THEN + IF (branch .LT. 18) THEN + IF (.NOT.branch .LT. 17) THEN + temp431b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp431b20 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp431b20 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp431b20 + END IF + ELSE + temp431b21 = cost4f*6.d0*zb(indorbp, indt+i) + fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp431b21 + rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp431b21 + rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp431b21 + END IF + ELSE IF (.NOT.branch .LT. 20) THEN + temp431b22 = cost4f*3.d0*zb(indorbp, indt+i) + fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp431b22 + rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp431b22 + rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp431b22 + END IF + 150 temp431b = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp431b + funb0 = funb0 + rmu(i, 0)*temp431b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp478b5 = distp(0, 1)*fun2b - temp478b6 = 2*dd2*r(0)*temp478b5 - dd2b = r(0)*temp478b6 - 4.d0*r(0)*temp478b5 - distp(0, 1)*r(0)*& -& funb - rb(0) = rb(0) + distp(0, 1)*2*r(0)*fun0b - distp(0, 1)*dd2*funb - & -& 4.d0*dd2*temp478b5 + dd2*temp478b6 - distpb(0, 1) = (2.d0-dd2*r(0))*funb + r(0)**2*fun0b + ((dd2*r(0))& -& **2-4.d0*(dd2*r(0))+2.d0)*fun2b + temp430 = rp3**3 + temp428 = distp(0, 1)/temp430 + temp429 = rp1**3 + temp429b = 0.25d0*temp428*fun2b + temp428b = 0.25d0*(22.d0*rp1-66.d0*rp2+178.d0*(rp1*rp2)+165.d0*rp1& +& **2+54.d0*(rp1**2*rp2)+rp1**3-2.d0*(temp429*rp2)-26.d0)*fun2b/& +& temp430 + temp427 = rp3**2 + temp426 = distp(0, 1)/temp427 + temp427b = 0.25d0*temp426*funb0 + rp1b = (2.d0*2*rp1-3.d0*rp2-36.d0)*temp427b + (3*rp1**2-2.d0*rp2*3& +& *rp1**2+54.d0*rp2*2*rp1+165.d0*2*rp1+178.d0*rp2+22.d0)*temp429b + temp426b = 0.25d0*(2.d0*rp1**2-36.d0*rp1-59.d0*rp2-3.d0*(rp1*rp2)-& +& 26.d0)*funb0/temp427 + temp424b0 = distp(0, 1)*fun0b + costb = -(r(0)**2*temp424b0) + rp3b = -(temp426*2*rp3*temp426b) - (0.5d0*rp2+1.d0)*costb/rp3**2 -& +& temp428*3*rp3**2*temp428b + rp2b = ((-59.d0)-3.d0*rp1)*temp427b + 2*(rp2+1.d0)*rp3b + 0.5d0*& +& costb/rp3 + (54.d0*rp1**2-2.d0*temp429+178.d0*rp1-66.d0)*& +& temp429b + temp425 = 4.d0*dd1 + temp424 = 9.d0/temp425 + distpb(0, 1) = distpb(0, 1) + temp426b + (temp424-r(0)**2*cost)*& +& fun0b + temp428b + dd1b = r(0)**2*rp1b - temp424*4.d0*temp424b0/temp425 + rb(0) = rb(0) + dd2*rp2b + dd1*2*r(0)*rp1b - cost*2*r(0)*temp424b0 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = r(0)*rp2b ELSE distpb = 0.0_8 + dd1b = 0.0_8 dd2b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - temp478b4 = r(i)**2*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp478b4 - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp478b4 - rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*2*r(i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=7,1,-1 + DO k=indtm,i0,-1 + temp424b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) + temp423 = 4.d0*dd1 + temp422 = 9.d0/temp423 + temp422b = (temp422-r(k)**2*cost)*zb(indorbp, k) + dd1b = dd1b - temp422*4.d0*temp424b/temp423 + costb = -(r(k)**2*temp424b) + temp421 = dd2*r(k) + 1.d0 + temp422b0 = costb/temp421**2 + temp421b8 = -((0.5d0*(dd2*r(k))+1.d0)*2*temp422b0/temp421) + rb(k) = rb(k) + 0.5d0*dd2*temp422b0 + dd2*temp421b8 - cost*2*r(k& +& )*temp424b + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp422b + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp422b + zb(indorbp, k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + dd2b = dd2b + r(k)*temp421b8 + 0.5d0*r(k)*temp422b0 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO k=indtm,indtmin,-1 - temp478b3 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp478b3 - rb(k) = rb(k) - dd2*temp478b3 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (131) -! 2s without cusp condition -! dd1*(r^2*exp(-dd2*r^2)) - dd2 = dd(indpar+1) - indorbp = indorb + 1 - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) - END DO -! endif - IF (typec .NE. 1) THEN - fun0 = dd2*r(0)**2 - fun = 2.d0*distp(0, 1)*(1.d0-fun0) - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp478b10 = 2.d0*distp(0, 1)*fun2b - distpb(0, 1) = 2.d0*(1.d0-fun0)*funb + 2.d0*(2.d0*fun0**2-5.d0*& -& fun0+1.d0)*fun2b - fun0b = (2.d0*2*fun0-5.d0)*temp478b10 - 2.d0*distp(0, 1)*funb - dd2b = r(0)**2*fun0b - rb(0) = rb(0) + dd2*2*r(0)*fun0b - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO i=indtm,indtmin,-1 + temp421b0 = cost4f*rmu(2, i)*distpb(i, 8) + rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 8) - 2*rmu(2, i)*temp421b0 + distpb(i, 8) = 0.0_8 + temp421b1 = cost4f*rmu(1, i)*distpb(i, 7) + rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& +& distpb(i, 7) + 2*rmu(1, i)*temp421b1 + 3.d0*2*rmu(1, i)*& +& temp421b0 + rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp421b1 + distpb(i, 7) = 0.0_8 + temp421b2 = cost3f*2.d0*distpb(i, 6) + temp421b3 = rmu(2, i)*temp421b2 + rmub(3, i) = rmub(3, i) + rmu(1, i)*temp421b3 + rmub(1, i) = rmub(1, i) + rmu(3, i)*temp421b3 + rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp421b2 + distpb(i, 6) = 0.0_8 + temp421b4 = cost3f*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& +& distpb(i, 5) + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp421b4 + distpb(i, 5) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 4) - 2*rmu(2, i)*temp421b4 + temp421b5 = cost2f*rmu(2, i)*distpb(i, 4) + rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp421b5 + distpb(i, 4) = 0.0_8 + temp421b6 = cost2f*rmu(1, i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& +& distpb(i, 3) + distpb(i, 3) = 0.0_8 + temp421b7 = cost1f*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - 2*r(i)*temp421b6 - 3.d0*2*r(i)*temp421b7 - 2*r(i)*& +& temp421b5 + rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& +& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp421b7 + 5.d0*2*rmu(3, i)*& +& temp421b6 + distpb(i, 2) = 0.0_8 END DO + cb = 0.0_8 DO k=indtm,indtmin,-1 - temp478b9 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp478b9 - rb(k) = rb(k) - dd2*2*r(k)*temp478b9 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp420 = dd2*r(k) + 1.d0 + temp421b = costb/temp420 + temp420b6 = -(dd1*r(k)**2*temp421b/temp420) + dd1b = dd1b + r(k)**2*temp421b + rb(k) = rb(k) + dd2*temp420b6 + dd1*2*r(k)*temp421b + dd2b = dd2b + r(k)*temp420b6 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (132) -! 2s with cusp condition -! ( r^3*exp(-dd2*r)) ! with no cusp condition - dd2 = dd(indpar+1) - indorbp = indorb + 1 - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k)))*r(k) - END DO -! endif - IF (typec .NE. 1) THEN - fun = (3.d0-dd2*r(0))*distp(0, 1) - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp478b12 = distp(0, 1)*fun2b - temp478b13 = 2*dd2*r(0)*temp478b12 - dd2b = r(0)*temp478b13 - 6*r(0)*temp478b12 - distp(0, 1)*r(0)*funb - rb(0) = rb(0) + dd2*temp478b13 - 6*dd2*temp478b12 - distp(0, 1)*& -& dd2*funb - distpb(0, 1) = (3.d0-dd2*r(0))*funb + ((dd2*r(0))**2-6*(dd2*r(0))+& -& 6.d0)*fun2b + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocf*2.25d0*dd1**1.25D0*cb ELSE - distpb = 0.0_8 - dd2b = 0.0_8 + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocf*2.25d0*dd1**1.25D0*& +& cb END IF - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=indtm,indtmin,-1 - temp478b11 = r(k)*DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp478b11 - rb(k) = rb(k) + DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2*temp478b11 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (133) -! 4d one parmater - dd1 = dd(indpar+1) + ddb(indparp) = ddb(indparp) + dd1b + CASE (47) +! d orbitals cartesian !!! +! R(r)= exp(-alpha r^2) +! each gaussian term is normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization + c = dd1**1.75d0*1.64592278064948967213d0 +! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) +! endif DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k))) - END DO - DO i=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = distp(i, 1)*r(i) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) - distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) - distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) - distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) - distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) - distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO -! indorbp=indorb - DO ic=1,5 + DO i=indtmin,indtm + distp(i, 2) = rmu(1, i)**2 + distp(i, 3) = rmu(2, i)**2 + distp(i, 4) = rmu(3, i)**2 +! lz=+/-2 + distp(i, 5) = rmu(1, i)*rmu(2, i)*cost3d +! lz=+/-1 + distp(i, 6) = rmu(2, i)*rmu(3, i)*cost3d +! lz=+/-1 + distp(i, 7) = rmu(1, i)*rmu(3, i)*cost3d + END DO + DO ic=1,6 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 3) - fun = (1.d0-dd1*r(0))*distp(0, 1) - fun2 = dd1*(dd1*r(0)-2.d0)*distp(0, 1) -! indorbp=indorb - DO ic=1,5 + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1) + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) +! indorbp=indorb + DO ic=1,6 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE + IF (ic .LE. 3) THEN + IF (i .EQ. ic) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) END IF - ELSE IF (ic .EQ. 2) THEN + ELSE IF (ic .EQ. 4) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) ELSE IF (i .EQ. 2) THEN @@ -18858,95 +18483,91 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - END IF - ELSE IF (ic .EQ. 5) THEN + ELSE IF (ic .EQ. 6) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) END IF END DO +!endif for ic +!enddo for i + IF (ic .LE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp479 = fun/r(0) - temp480b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp479b3 = 6.d0*temp480b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp479+fun2)*zb(& -& indorbp, indt+4) - funb = funb + temp479b3 - rb(0) = rb(0) - temp479*temp479b3 - fun2b = fun2b + temp480b - zb(indorbp, indt+4) = 0.0_8 + DO ic=6,1,-1 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 2) THEN + temp432b1 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 6.d0*temp432b1 + fun2b = fun2b + temp432b1 + distpb(0, 1) = distpb(0, 1) + 2.d0*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + ELSE + temp432b2 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 6.d0*temp432b2 + fun2b = fun2b + temp432b2 + zb(indorbp, indt+4) = 0.0_8 + END IF DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN + IF (branch .LT. 7) THEN + IF (branch .LT. 4) THEN IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp479b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp479b - fun0b = fun0b + rmu(i, 0)*temp479b - ELSE - temp479b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp479b0 - fun0b = fun0b + rmu(i, 0)*temp479b0 + IF (.NOT.branch .LT. 2) THEN + rmub(i, 0) = rmub(i, 0) + 2.d0*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + 2.d0*rmu(i, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 4) THEN - temp479b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp479b1 - fun0b = fun0b + rmu(i, 0)*temp479b1 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp479b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp479b2 - fun0b = fun0b + rmu(i, 0)*temp479b2 ELSE rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 6) THEN + IF (.NOT.branch .LT. 5) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& + ELSE IF (branch .LT. 10) THEN + IF (branch .LT. 9) THEN + IF (.NOT.branch .LT. 8) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN + ELSE IF (branch .LT. 12) THEN + IF (branch .LT. 11) THEN rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF @@ -18954,255 +18575,87 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp478 = fun/r(0) - temp478b17 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp478*rmu(i, 0)*zb(& -& indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp478*distp(0, 3+ic)*zb(indorbp, & + temp432b0 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - funb = funb + temp478b17 - rb(0) = rb(0) - temp478*temp478b17 - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - temp478b15 = dd1*distp(0, 1)*fun2b - temp478b16 = (dd1*r(0)-2.d0)*fun2b - dd1b = distp(0, 1)*temp478b16 - distp(0, 1)*r(0)*funb + r(0)*& -& temp478b15 - rb(0) = rb(0) + dd1*temp478b15 - distp(0, 1)*dd1*funb - distpb(0, 1) = distpb(0, 1) + (1.d0-dd1*r(0))*funb + dd1*& -& temp478b16 - distpb(0, 3) = distpb(0, 3) + fun0b - ELSE - distpb = 0.0_8 - dd1b = 0.0_8 - END IF - DO ic=5,1,-1 - DO i=indtm,i0,-1 - distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO i=indtm,indtmin,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) - distpb(i, 8) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) - distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distpb(i, 1) = distpb(i, 1) + r(i)*distpb(i, 3) - rb(i) = rb(i) + distp(i, 1)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - END DO - DO k=indtm,indtmin,-1 - temp478b14 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp478b14 - rb(k) = rb(k) - dd1*temp478b14 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (134) -! 2p single exponential r^3 e^{-z r} ! - dd2 = dd(indpar+1) - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k))) - END DO -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun = distp(0, 1)*(3.d0-dd2*r(0))*r(0) -! fun= derivative of fun0 respect to r divided dy r - fun2 = distp(0, 1)*(dd2**2*r(0)**3-6*dd2*r(0)**2+6*r(0)) -! fun2= second derivative of fun0 respect to r -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp481b0 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp481b0 - fun2b = fun2b + temp481b0 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp481b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp481b - funb = funb + rmu(ic, 0)*temp481b - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - distpb = 0.0_8 - temp480 = r(0)**3 - temp480b2 = distp(0, 1)*fun2b - temp480b3 = (3.d0-dd2*r(0))*funb - distpb(0, 1) = r(0)*temp480b3 + r(0)**3*fun0b + (dd2**2*temp480-6*& -& (dd2*r(0)**2)+6*r(0))*fun2b - temp480b4 = distp(0, 1)*r(0)*funb - dd2b = (temp480*2*dd2-6*r(0)**2)*temp480b2 - r(0)*temp480b4 - rb(0) = rb(0) + distp(0, 1)*temp480b3 - dd2*temp480b4 + distp(0, 1& -& )*3*r(0)**2*fun0b + (dd2**2*3*r(0)**2-6*dd2*2*r(0)+6)*temp480b2 - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - temp480b1 = r(i)**3*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp480b1 - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp480b1 - rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*3*r(i)**2*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO k=indtm,indtmin,-1 - temp480b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp480b0 - rb(k) = rb(k) - dd2*temp480b0 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (135) -! 2p single exponential r^4 e^{-z r} ! - dd2 = dd(indpar+1) - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k))) - END DO -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun = distp(0, 1)*(4.d0-dd2*r(0))*r(0)**2 - fun2 = distp(0, 1)*(12*r(0)**2-8*dd2*r(0)**3+dd2**2*r(0)**4) -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp483b0 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp483b0 - fun2b = fun2b + temp483b0 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp483b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp483b - funb = funb + rmu(ic, 0)*temp483b - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp432b0 + funb0 = funb0 + rmu(i, 0)*temp432b0 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp482 = r(0)**4 - temp481 = r(0)**3 - temp481b3 = distp(0, 1)*fun2b - temp481b4 = (4.d0-dd2*r(0))*funb - distpb(0, 1) = r(0)**2*temp481b4 + r(0)**4*fun0b + (12*r(0)**2-8*(& -& dd2*temp481)+dd2**2*temp482)*fun2b - temp481b5 = distp(0, 1)*r(0)**2*funb - rb(0) = rb(0) + distp(0, 1)*2*r(0)*temp481b4 - dd2*temp481b5 + & -& distp(0, 1)*4*r(0)**3*fun0b + (dd2**2*4*r(0)**3-8*dd2*3*r(0)**2+& -& 12*2*r(0))*temp481b3 - dd2b = (temp482*2*dd2-8*temp481)*temp481b3 - r(0)*temp481b5 + temp432b = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp432b - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp432b + distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb0 + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd2b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - temp481b2 = r(i)**4*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp481b2 - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp481b2 - rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*4*r(i)**3*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=6,1,-1 + DO k=indtm,i0,-1 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + DO i=indtm,indtmin,-1 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 6) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + rmub(3, i) = rmub(3, i) + 2*rmu(3, i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + rmub(2, i) = rmub(2, i) + 2*rmu(2, i)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*distpb(i, 2) + distpb(i, 2) = 0.0_8 + END DO + dd1b = 0.0_8 + cb = 0.0_8 DO k=indtm,indtmin,-1 - temp481b1 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp481b1 - rb(k) = rb(k) - dd2*temp481b1 + temp431 = r(k)**2 + temp431b24 = c*DEXP(-(dd1*temp431))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp431))*distpb(k, 1) + dd1b = dd1b - temp431*temp431b24 + rb(k) = rb(k) - dd1*2*r(k)*temp431b24 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (136) -! 2p single exponential r^5 e^{-z r} ! + dd1b = dd1b + 1.64592278064948967213d0*1.75d0*dd1**0.75D0*cb + ddb(indparp) = ddb(indparp) + dd1b + CASE (104) +! 2p double gaussian +! dd1 * x_mu (exp(-dd2 r^2)+dd3 * exp(-dd4*r^2)) dd2 = dd(indpar+1) + dd3 = dd(indpar+2) + dd4 = dd(indpar+3) DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k))) + distp(k, 1) = DEXP(-(dd2*r(k)**2)) + distp(k, 2) = DEXP(-(dd4*r(k)**2)) END DO -! indorbp=indorb +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun = distp(0, 1)*(5.d0-dd2*r(0))*r(0)**3 - fun2 = distp(0, 1)*(20*r(0)**3-10*dd2*r(0)**4+dd2**2*r(0)**5) -! indorbp=indorb + fun = 2.d0*(-(dd2*distp(0, 1))-dd4*dd3*distp(0, 2)) + fun2 = 2.d0*(dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0, 1)+dd4*dd3*(-& +& 1.d0+2.d0*dd4*r(0)**2)*distp(0, 2)) +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -19212,175 +18665,304 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp485b0 = rmu(ic, 0)*zb(indorbp, indt+4) + temp432b13 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp485b0 - fun2b = fun2b + temp485b0 + funb0 = funb0 + 4.d0*temp432b13 + fun2b = fun2b + temp432b13 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp485b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp485b - funb = funb + rmu(ic, 0)*temp485b + temp432b12 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp432b12 + funb0 = funb0 + rmu(ic, 0)*temp432b12 rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp484 = r(0)**5 - temp483 = r(0)**4 - temp483b3 = distp(0, 1)*fun2b - temp483b4 = r(0)**3*funb - distpb(0, 1) = (5.d0-dd2*r(0))*temp483b4 + r(0)**5*fun0b + (20*r(0& -& )**3-10*(dd2*temp483)+dd2**2*temp484)*fun2b - rb(0) = rb(0) + distp(0, 1)*(5.d0-dd2*r(0))*3*r(0)**2*funb - distp& -& (0, 1)*dd2*temp483b4 + distp(0, 1)*5*r(0)**4*fun0b + (dd2**2*5*r& -& (0)**4-10*dd2*4*r(0)**3+20*3*r(0)**2)*temp483b3 - dd2b = (temp484*2*dd2-10*temp483)*temp483b3 - distp(0, 1)*r(0)*& -& temp483b4 + temp432b6 = 2.d0*fun2b + temp432b7 = dd2*distp(0, 1)*2.d0*temp432b6 + temp432b8 = (2.d0*(dd2*r(0)**2)-1.d0)*temp432b6 + temp432b9 = (2.d0*(dd4*r(0)**2)-1.d0)*temp432b6 + temp432b10 = dd4*dd3*distp(0, 2)*2.d0*temp432b6 + temp432b11 = 2.d0*funb0 + dd2b = distp(0, 1)*temp432b8 - distp(0, 1)*temp432b11 + r(0)**2*& +& temp432b7 + rb(0) = rb(0) + dd4*2*r(0)*temp432b10 + dd2*2*r(0)*temp432b7 + distpb(0, 1) = dd2*temp432b8 + dd4b = r(0)**2*temp432b10 - distp(0, 2)*dd3*temp432b11 + distp(0, & +& 2)*dd3*temp432b9 + dd3b = distp(0, 2)*fun0b - distp(0, 2)*dd4*temp432b11 + distp(0, 2& +& )*dd4*temp432b9 + distpb(0, 2) = dd4*dd3*temp432b9 + distpb(0, 1) = distpb(0, 1) - dd2*temp432b11 + distpb(0, 2) = distpb(0, 2) - dd4*dd3*temp432b11 + distpb(0, 1) = distpb(0, 1) + fun0b + distpb(0, 2) = distpb(0, 2) + dd3*fun0b ELSE distpb = 0.0_8 dd2b = 0.0_8 + dd3b = 0.0_8 + dd4b = 0.0_8 END IF DO ic=3,1,-1 DO i=indtm,i0,-1 - temp483b2 = r(i)**5*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp483b2 - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp483b2 - rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*5*r(i)**4*zb(indorbp, i) + temp432b5 = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& +& indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp432b5 + dd3b = dd3b + distp(i, 2)*temp432b5 + distpb(i, 2) = distpb(i, 2) + dd3*temp432b5 zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=indtm,indtmin,-1 - temp483b1 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp483b1 - rb(k) = rb(k) - dd2*temp483b1 + temp432b3 = DEXP(-(dd4*r(k)**2))*distpb(k, 2) + dd4b = dd4b - r(k)**2*temp432b3 + distpb(k, 2) = 0.0_8 + temp432b4 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + rb(k) = rb(k) - dd2*2*r(k)*temp432b4 - dd4*2*r(k)*temp432b3 + dd2b = dd2b - r(k)**2*temp432b4 distpb(k, 1) = 0.0_8 END DO + ddb(indpar+3) = ddb(indpar+3) + dd4b + ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (137) -! 2s with cusp condition -! dd1*(exp(-dd2*r)*(1+dd2*r)) - dd2 = dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=1.d0/dsqrt(1/4.d0/dd2**3+12*dd2/(2.d0*dd2)**4+ -! &3*dd2**2/4/dd2**5)/dsqrt(4.0*pi) -! endif + CASE (199) +! derivative of 200 LA COSTANTE + indorbp = indorb + 1 +! endif + IF (typec .NE. 1) THEN + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + zb(indorbp, indt+i) = 0.0_8 + END DO + END IF + DO i=indtm,i0,-1 + zb(indorbp, i) = 0.0_8 + END DO + distpb = 0.0_8 + CASE (11) +! R(r)=r**2*(exp(-z1*r)+p*exp(-z2*r)) +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd(indpar+3) +! if(iflagnorm.gt.2) then + c = 1.d0/2.d0/DSQRT(pi*720.d0*(1.d0/(2.d0*dd1)**7+2.d0*peff/(dd1+dd2& +& )**7+peff**2/(2.d0*dd2)**7)) +! endif DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k))) + distp(k, 2) = c*DEXP(-(dd2*r(k))) END DO -! endif IF (typec .NE. 1) THEN - fun = -(dd2**2*distp(0, 1)) - funb = 2.d0*zb(indorbp, indt+4) + rp1 = r(0)**2 +! the first derivative + fun = distp(0, 1)*(2.d0*r(0)-dd1*rp1) + peff*distp(0, 2)*(2.d0*r(0& +& )-dd2*rp1) +! +! the second derivative + temp441b = 2.d0*zb(indorbp, indt+4)/r(0) + funb0 = temp441b + rb(0) = rb(0) - fun*temp441b/r(0) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + temp440 = fun/r(0) + temp440b8 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(i, 0) = rmub(i, 0) + temp440*zb(indorbp, indt+i) + funb0 = funb0 + temp440b8 + rb(0) = rb(0) - temp440*temp440b8 zb(indorbp, indt+i) = 0.0_8 END DO - funb = funb + (1.d0-dd2*r(0))*fun2b - dd2b = -(distp(0, 1)*2*dd2*funb) - fun*r(0)*fun2b - rb(0) = rb(0) - fun*dd2*fun2b distpb = 0.0_8 - distpb(0, 1) = -(dd2**2*funb) + temp440b2 = distp(0, 1)*fun2b + temp440b3 = (dd2**2*rp1-4.d0*(dd2*r(0))+2.d0)*fun2b + temp440b4 = peff*distp(0, 2)*fun2b + distpb(0, 1) = (dd1**2*rp1-4.d0*(dd1*r(0))+2.d0)*fun2b + temp440b5 = distp(0, 1)*funb0 + dd1b = (rp1*2*dd1-4.d0*r(0))*temp440b2 - rp1*temp440b5 + temp440b6 = peff*distp(0, 2)*funb0 + rp1b = dd2**2*temp440b4 - dd2*temp440b6 - dd1*temp440b5 + dd1**2*& +& temp440b2 + rb(0) = rb(0) + 2.d0*temp440b5 + 2.d0*temp440b6 + 2*r(0)*rp1b - & +& 4.d0*dd2*temp440b4 - 4.d0*dd1*temp440b2 + temp440b7 = (2.d0*r(0)-dd2*rp1)*funb0 + peffb = distp(0, 2)*temp440b7 + distp(0, 2)*temp440b3 + distpb(0, 2) = peff*temp440b3 + dd2b = (rp1*2*dd2-4.d0*r(0))*temp440b4 - rp1*temp440b6 + distpb(0, 1) = distpb(0, 1) + (2.d0*r(0)-dd1*rp1)*funb0 + distpb(0, 2) = distpb(0, 2) + peff*temp440b7 ELSE distpb = 0.0_8 + peffb = 0.0_8 + dd1b = 0.0_8 dd2b = 0.0_8 END IF DO i=indtm,i0,-1 - temp485b2 = distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + (dd2*r(i)+1.d0)*zb(indorbp, i) - dd2b = dd2b + r(i)*temp485b2 - rb(i) = rb(i) + dd2*temp485b2 + temp440b1 = r(i)**2*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp440b1 + peffb = peffb + distp(i, 2)*temp440b1 + distpb(i, 2) = distpb(i, 2) + peff*temp440b1 + rb(i) = rb(i) + (distp(i, 1)+peff*distp(i, 2))*2*r(i)*zb(indorbp, & +& i) zb(indorbp, i) = 0.0_8 END DO + cb = 0.0_8 DO k=indtm,indtmin,-1 - temp485b1 = DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2b = dd2b - r(k)*temp485b1 - rb(k) = rb(k) - dd2*temp485b1 + temp440b = c*DEXP(-(dd2*r(k)))*distpb(k, 2) + cb = cb + DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp440b + distpb(k, 2) = 0.0_8 + temp440b0 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp440b0 - dd2*temp440b + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp440b0 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (138) -! 2s with cusp condition -! ( -dd2*r^2*exp(-dd2*r)) ! with no cusp condition der of 137 - dd2 = dd(indpar+1) + temp439 = 2.d0**7 + temp438 = temp439*dd2**7 + temp437 = peff**2/temp438 + temp436 = (dd1+dd2)**7 + temp435 = 2.d0**7 + temp434 = temp435*dd1**7 + temp433 = 720.d0*pi*(1.0/temp434+2.d0*peff/temp436+temp437) + temp432 = DSQRT(temp433) + IF (temp433 .EQ. 0.0) THEN + temp432b14 = 0.0 + ELSE + temp432b14 = -(pi*720.d0*cb/(2.d0*temp432**2*2.D0*DSQRT(temp433))) + END IF + temp432b15 = 2.d0*temp432b14/temp436 + temp432b16 = -(peff*7*(dd1+dd2)**6*temp432b15/temp436) + dd1b = dd1b + temp432b16 - temp435*7*dd1**6*temp432b14/temp434**2 + peffb = peffb + 2*peff*temp432b14/temp438 + temp432b15 + dd2b = dd2b + temp432b16 - temp437*temp439*7*dd2**6*temp432b14/& +& temp438 + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (39) +! 4s single zeta +! R(r)=r**3*exp(-z1*r) +! +! if(iocc(indshellp).eq.1) then indorbp = indorb + 1 + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 +! c=dsqrt((2*dd1)**7/720.d0/pi)/2.d0 + c = dd1**3.5d0*0.11894160774351807429d0 +! c=-c +! endif + c0 = -c + c1 = 3.5d0*c/dd1 DO k=indtmin,indtm - distp(k, 1) = -(dd2*DEXP(-(dd2*r(k)))) + distp(k, 1) = DEXP(-(dd1*r(k))) END DO -! endif IF (typec .NE. 1) THEN - fun = (2.d0-dd2*r(0))*distp(0, 1) - funb = 2.d0*zb(indorbp, indt+4) + rp1 = r(0)**3 + rp2 = r(0)**2 +! fun=(2.d0-dd1*r(0))*distp(0,1) +! fun2=(2.d0-4*dd1*r(0)+(dd1*r(0))**2)*distp(0,1) +! +!c the first derivative/r + fun = distp(0, 1)*(c0*(3.d0*r(0)-dd1*rp2)+c1*(2.d0-dd1*r(0))) +!c +!c the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp485b4 = distp(0, 1)*fun2b - temp485b5 = 2*dd2*r(0)*temp485b4 - dd2b = r(0)*temp485b5 - 4*r(0)*temp485b4 - distp(0, 1)*r(0)*funb - rb(0) = rb(0) + dd2*temp485b5 - 4*dd2*temp485b4 - distp(0, 1)*dd2*& -& funb - distpb(0, 1) = (2.d0-dd2*r(0))*funb + ((dd2*r(0))**2-4*(dd2*r(0))+& -& 2.d0)*fun2b + temp443 = (dd1*r(0))**2 - 4*(dd1*r(0)) + 2.d0 + temp444 = 6.d0*r(0) - 6.d0*dd1*rp2 + dd1**2*rp1 + temp445b = distp(0, 1)*fun2b + temp444b = c0*temp445b + temp443b = c1*temp445b + temp443b0 = 2*dd1*r(0)*temp443b + temp442 = 3.d0*r(0) - dd1*rp2 + distpb(0, 1) = (c0*temp442+c1*(2.d0-dd1*r(0)))*funb0 + (c0*temp444& +& +c1*temp443)*fun2b + temp443b1 = distp(0, 1)*funb0 + c0b = temp442*temp443b1 + temp444*temp445b + temp442b0 = c0*temp443b1 + rp2b = -(dd1*temp442b0) - 6.d0*dd1*temp444b + rp1b = dd1**2*temp444b + rb(0) = rb(0) + 3.d0*temp442b0 - c1*dd1*temp443b1 + 3*r(0)**2*rp1b& +& + 2*r(0)*rp2b - 4*dd1*temp443b + dd1*temp443b0 + 6.d0*temp444b + dd1b = r(0)*temp443b0 - c1*r(0)*temp443b1 - 4*r(0)*temp443b - rp2*& +& temp442b0 + (rp1*2*dd1-6.d0*rp2)*temp444b + c1b = (2.d0-dd1*r(0))*temp443b1 + temp443*temp445b ELSE distpb = 0.0_8 - dd2b = 0.0_8 + c0b = 0.0_8 + c1b = 0.0_8 + dd1b = 0.0_8 END IF DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) + temp442b = distp(i, 1)*zb(indorbp, i) + temp441 = r(i)**3 + c0b = c0b + temp441*temp442b + rb(i) = rb(i) + (c1*2*r(i)+c0*3*r(i)**2)*temp442b + c1b = c1b + r(i)**2*temp442b + distpb(i, 1) = distpb(i, 1) + (c0*temp441+c1*r(i)**2)*zb(indorbp, & +& i) zb(indorbp, i) = 0.0_8 END DO DO k=indtm,indtmin,-1 - temp485b3 = -(dd2*DEXP(-(dd2*r(k)))*distpb(k, 1)) - dd2b = dd2b - r(k)*temp485b3 - DEXP(-(dd2*r(k)))*distpb(k, 1) - rb(k) = rb(k) - dd2*temp485b3 + temp441b1 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp441b1 + rb(k) = rb(k) - dd1*temp441b1 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (139) -! 2s with cusp condition -! ( r^3*exp(-dd2*r)) ! der of 128 + temp441b0 = 3.5d0*c1b/dd1 + cb = temp441b0 - c0b + dd1b = dd1b + 0.11894160774351807429d0*3.5d0*dd1**2.5D0*cb - c*& +& temp441b0/dd1 + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (132) +! +! 3p single zeta +! 2s with cusp condition +! ( r^3*exp(-dd2*r)) ! with no cusp condition dd2 = dd(indpar+1) indorbp = indorb + 1 DO k=indtmin,indtm - distp(k, 1) = -(DEXP(-(dd2*r(k)))*r(k)) + distp(k, 1) = DEXP(-(dd2*r(k)))*r(k) END DO -! endif +! endif IF (typec .NE. 1) THEN fun = (3.d0-dd2*r(0))*distp(0, 1) - funb = 2.d0*zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp485b7 = distp(0, 1)*fun2b - temp485b8 = 2*dd2*r(0)*temp485b7 - dd2b = r(0)*temp485b8 - 6*r(0)*temp485b7 - distp(0, 1)*r(0)*funb - rb(0) = rb(0) + dd2*temp485b8 - 6*dd2*temp485b7 - distp(0, 1)*dd2*& -& funb - distpb(0, 1) = (3.d0-dd2*r(0))*funb + ((dd2*r(0))**2-6*(dd2*r(0))+& -& 6.d0)*fun2b + temp445b1 = distp(0, 1)*fun2b + temp445b2 = 2*dd2*r(0)*temp445b1 + dd2b = r(0)*temp445b2 - 6*r(0)*temp445b1 - distp(0, 1)*r(0)*funb0 + rb(0) = rb(0) + dd2*temp445b2 - 6*dd2*temp445b1 - distp(0, 1)*dd2*& +& funb0 + distpb(0, 1) = (3.d0-dd2*r(0))*funb0 + ((dd2*r(0))**2-6*(dd2*r(0))& +& +6.d0)*fun2b ELSE distpb = 0.0_8 dd2b = 0.0_8 @@ -19391,206 +18973,51 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & zb(indorbp, i) = 0.0_8 END DO DO k=indtm,indtmin,-1 - temp485b6 = -(r(k)*DEXP(-(dd2*r(k)))*distpb(k, 1)) - dd2b = dd2b - r(k)*temp485b6 - rb(k) = rb(k) - DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2*temp485b6 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (140) -! 2p single exponential -r e^{-z r} ! der of 121 - dd2 = dd(indpar+1) - DO k=indtmin,indtm - distp(k, 1) = -DEXP(-(dd2*r(k))) - END DO -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun = distp(0, 1)*(1.d0-dd2*r(0))/r(0) - fun2 = dd2*(dd2*r(0)-2.d0)*distp(0, 1) -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp486b2 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp486b2 - fun2b = fun2b + temp486b2 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp486b1 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp486b1 - funb = funb + rmu(ic, 0)*temp486b1 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - distpb = 0.0_8 - temp486b = dd2*distp(0, 1)*fun2b - temp486b0 = (dd2*r(0)-2.d0)*fun2b - temp485 = distp(0, 1)/r(0) - dd2b = distp(0, 1)*temp486b0 - temp485*r(0)*funb + r(0)*temp486b - temp485b11 = (1.d0-dd2*r(0))*funb/r(0) - rb(0) = rb(0) + distp(0, 1)*fun0b - temp485*dd2*funb - temp485*& -& temp485b11 + dd2*temp486b - distpb(0, 1) = temp485b11 + r(0)*fun0b + dd2*temp486b0 - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - temp485b10 = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*r(i)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + r(i)*temp485b10 - rb(i) = rb(i) + distp(i, 1)*temp485b10 - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO k=indtm,indtmin,-1 - temp485b9 = -(DEXP(-(dd2*r(k)))*distpb(k, 1)) - dd2b = dd2b - r(k)*temp485b9 - rb(k) = rb(k) - dd2*temp485b9 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (141) -! 2p single exponential r^2 e^{-z r} ! parent of 121 - dd2 = dd(indpar+1) - DO k=indtmin,indtm - distp(k, 1) = -DEXP(-(dd2*r(k))) - END DO -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - fun = distp(0, 1)*(2.d0-dd2*r(0)) - fun2 = (2.d0-4.d0*dd2*r(0)+(dd2*r(0))**2)*distp(0, 1) -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp486b8 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp486b8 - fun2b = fun2b + temp486b8 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp486b7 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp486b7 - funb = funb + rmu(ic, 0)*temp486b7 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - distpb = 0.0_8 - temp486b5 = distp(0, 1)*fun2b - temp486b6 = 2*dd2*r(0)*temp486b5 - dd2b = r(0)*temp486b6 - 4.d0*r(0)*temp486b5 - distp(0, 1)*r(0)*& -& funb - rb(0) = rb(0) + distp(0, 1)*2*r(0)*fun0b - distp(0, 1)*dd2*funb - & -& 4.d0*dd2*temp486b5 + dd2*temp486b6 - distpb(0, 1) = (2.d0-dd2*r(0))*funb + r(0)**2*fun0b + ((dd2*r(0))& -& **2-4.d0*(dd2*r(0))+2.d0)*fun2b - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - temp486b4 = r(i)**2*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp486b4 - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp486b4 - rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*2*r(i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO k=indtm,indtmin,-1 - temp486b3 = -(DEXP(-(dd2*r(k)))*distpb(k, 1)) - dd2b = dd2b - r(k)*temp486b3 - rb(k) = rb(k) - dd2*temp486b3 + temp445b0 = r(k)*DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp445b0 + rb(k) = rb(k) + DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2*temp445b0 distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (142) -! der of 127 -! 4d one parmater + CASE (30) +! 3d without cusp and one parmater dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c= & +! &1.d0/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) + c = dd1**3.5d0*0.26596152026762178d0 +! endif DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k))) END DO DO i=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = distp(i, 1)*r(i) - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) + distp(i, 3) = distp(i, 1) +! lz=0 distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) +! lz=+/-2 distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) +! lz=+/-2 distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) +! lz=+/-1 distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) +! lz=+/-1 distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d END DO -! indorbp=indorb +! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun0 = -distp(0, 3) - fun = -((1.d0-dd1*r(0))*distp(0, 1)) - fun2 = -(dd1*(dd1*r(0)-2.d0)*distp(0, 1)) -! indorbp=indorb + fun0 = distp(0, 3) + fun = -(dd1*distp(0, 1)) + fun2 = dd1**2*distp(0, 1) +! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN @@ -19637,18 +19064,18 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=5,1,-1 - temp487 = fun/r(0) - temp488b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp487b3 = 6.d0*temp488b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp487+fun2)*zb(& + temp446 = fun/r(0) + temp447b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp446b3 = 6.d0*temp447b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp446+fun2)*zb(& & indorbp, indt+4) - funb = funb + temp487b3 - rb(0) = rb(0) - temp487*temp487b3 - fun2b = fun2b + temp488b + funb0 = funb0 + temp446b3 + rb(0) = rb(0) - temp446*temp446b3 + fun2b = fun2b + temp447b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -19656,24 +19083,24 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN IF (branch .LT. 2) THEN - temp487b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp487b - fun0b = fun0b + rmu(i, 0)*temp487b + temp446b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp446b + fun0b = fun0b + rmu(i, 0)*temp446b ELSE - temp487b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp487b0 - fun0b = fun0b + rmu(i, 0)*temp487b0 + temp446b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp446b0 + fun0b = fun0b + rmu(i, 0)*temp446b0 END IF ELSE IF (branch .LT. 4) THEN - temp487b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp487b1 - fun0b = fun0b + rmu(i, 0)*temp487b1 + temp446b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp446b1 + fun0b = fun0b + rmu(i, 0)*temp446b1 END IF ELSE IF (branch .LT. 7) THEN IF (branch .LT. 6) THEN - temp487b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp487b2 - fun0b = fun0b + rmu(i, 0)*temp487b2 + temp446b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp446b2 + fun0b = fun0b + rmu(i, 0)*temp446b2 ELSE rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) @@ -19694,115 +19121,889 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + temp445 = fun/r(0) + temp445b4 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp445*rmu(i, 0)*zb(& +& indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp445*distp(0, 3+ic)*zb(indorbp, & +& indt+i) + funb0 = funb0 + temp445b4 + rb(0) = rb(0) - temp445*temp445b4 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb0 + distpb(0, 1) = distpb(0, 1) + dd1**2*fun2b - dd1*funb0 + distpb(0, 3) = distpb(0, 3) + fun0b + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + END IF + DO ic=5,1,-1 + DO i=indtm,i0,-1 + distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO i=indtm,indtmin,-1 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + distpb(i, 8) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + distpb(i, 1) = distpb(i, 1) + distpb(i, 3) + distpb(i, 3) = 0.0_8 + END DO + cb = 0.0_8 + DO k=indtm,indtmin,-1 + temp445b3 = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp445b3 + rb(k) = rb(k) - dd1*temp445b3 + distpb(k, 1) = 0.0_8 + END DO + dd1b = dd1b + 0.26596152026762178d0*3.5d0*dd1**2.5D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (73) +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization obtained by Mathematica + c = dd1**3.75d0*0.43985656185609913955d0 +! C= dd1^15/4 /Sqrt[Integrate[x^14 Exp[-2 x^2],{x,0,Infinity}]] +! endif + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) + END DO + DO i=indtmin,indtm + DO k=1,6 + CALL PUSHREAL8(adr8ibuf,adr8buf,zv(k)) + zv(k) = rmu(3, i)**k + CALL PUSHREAL8(adr8ibuf,adr8buf,yv(k)) + yv(k) = rmu(2, i)**k + CALL PUSHREAL8(adr8ibuf,adr8buf,xv(k)) + xv(k) = rmu(1, i)**k + END DO + CALL PUSHREAL8(adr8ibuf,adr8buf,r2) + r2 = xv(2) + yv(2) + zv(2) + CALL PUSHREAL8(adr8ibuf,adr8buf,r4) + r4 = r2*r2 + r6 = r2*r4 +! lz=0 + distp(i, 2) = cost1i*(231.d0*zv(6)-315.d0*zv(4)*r2+105.d0*zv(2)*r4& +& -5.d0*r6) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = 33.d0*zv(5) - 30.d0*zv(3)*r2 + 5.d0*zv(1)*r4 +! lz=+/-1 + distp(i, 3) = cost2i*rmu(1, i)*cost +! lz=+/-1 + distp(i, 4) = cost2i*rmu(2, i)*cost + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = 33.d0*zv(4) - 18.d0*zv(2)*r2 + r4 +! lz=+/-2 + distp(i, 5) = cost3i*(xv(2)-yv(2))*cost +! lz=+/-2 + distp(i, 6) = 2.d0*cost3i*xv(1)*yv(1)*cost + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = 11.d0*zv(3) - 3.d0*zv(1)*r2 +! lz=+/-3 + distp(i, 7) = cost4i*(xv(3)-3.d0*xv(1)*yv(2))*cost +! lz=+/-3 + distp(i, 8) = -(cost4i*(yv(3)-3.d0*yv(1)*xv(2))*cost) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = 11.d0*zv(2) - r2 +! lz=+/-4 + distp(i, 9) = cost5i*(xv(4)-6.d0*xv(2)*yv(2)+yv(4))*cost +! lz=+/-4 + distp(i, 10) = cost5i*4.d0*(xv(3)*yv(1)-yv(3)*xv(1))*cost +! lz=+/-5 + distp(i, 11) = cost6i*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4))*& +& zv(1) +! lz=+/-5 + distp(i, 12) = -(cost6i*(-(5.d0*xv(4)*yv(1))+10.d0*xv(2)*yv(3)-yv(& +& 5))*zv(1)) +! lz=+/-6 + distp(i, 13) = cost7i*(xv(6)-15.d0*xv(4)*yv(2)+15.d0*xv(2)*yv(4)-& +& yv(6)) +! lz=+/-6 + distp(i, 14) = -(cost7i*(-(6.d0*xv(5)*yv(1))+20.d0*xv(3)*yv(3)-& +& 6.d0*yv(5)*xv(1))) + END DO + DO ic=1,13 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + END DO +! endif + IF (typec .NE. 1) THEN + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1) + fun = -(2.d0*dd1*distp(0, 1)) + fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) + DO k=1,6 + CALL PUSHREAL8(adr8ibuf,adr8buf,zv(k)) + zv(k) = rmu(3, 0)**k + CALL PUSHREAL8(adr8ibuf,adr8buf,yv(k)) + yv(k) = rmu(2, 0)**k + CALL PUSHREAL8(adr8ibuf,adr8buf,xv(k)) + xv(k) = rmu(1, 0)**k + END DO +! indorbp=indorb + DO ic=1,13 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) +! if(iocc(indshell+ic).eq.1) then + indorbp = indorb + ic + IF (ic .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + ELSE IF (ic .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (ic .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE IF (ic .EQ. 4) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (ic .EQ. 5) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + ELSE IF (ic .EQ. 6) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE IF (ic .EQ. 7) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (ic .EQ. 8) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + ELSE IF (ic .EQ. 9) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE IF (ic .EQ. 10) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (ic .EQ. 11) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + ELSE IF (ic .EQ. 12) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE IF (ic .EQ. 13) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) + END IF + END DO + distpb = 0.0_8 + zvb = 0.0_8 + xvb = 0.0_8 + funb0 = 0.0_8 + yvb = 0.0_8 + fun0b = 0.0_8 + fun2b = 0.0_8 + DO ic=13,1,-1 + temp448b91 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (14.d0*fun+fun2)*zb(indorbp& +& , indt+4) + funb0 = funb0 + 14.d0*temp448b91 + fun2b = fun2b + temp448b91 + zb(indorbp, indt+4) = 0.0_8 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 7) THEN + IF (branch .LT. 4) THEN + IF (branch .LT. 2) THEN + IF (branch .LT. 1) THEN + temp448b13 = cost1i*fun0*zb(indorbp, indt+3) + temp448b14 = 360.d0*zv(1)*temp448b13 + fun0b = fun0b + cost1i*(360.d0*(xv(2)*yv(1)*zv(2))-60.d0& +& *(xv(2)*yv(3))-30.d0*yv(5)-30.d0*(xv(4)*yv(1))+360.d0*& +& (yv(3)*zv(2))-240.d0*(yv(1)*zv(4)))*zb(indorbp, indt+2& +& ) + cost1i*(360.d0*(xv(3)*zv(2))-60.d0*(xv(3)*yv(2))-& +& 30.d0*(xv(1)*yv(4))-30.d0*xv(5)+360.d0*(xv(1)*yv(2)*zv& +& (2))-240.d0*(xv(1)*zv(4)))*zb(indorbp, indt+1) + & +& cost1i*(180.d0*(xv(4)*zv(1))+360.d0*(xv(2)*yv(2)*zv(1)& +& )+180.d0*(yv(4)*zv(1))+96.d0*zv(5)-480.d0*(yv(2)*zv(3)& +& )-480.d0*(xv(2)*zv(3)))*zb(indorbp, indt+3) + xvb(4) = xvb(4) + 180.d0*zv(1)*temp448b13 + zvb(1) = zvb(1) + (180.d0*yv(4)+360.d0*xv(2)*yv(2)+& +& 180.d0*xv(4))*temp448b13 + temp448b15 = cost1i*fun0*zb(indorbp, indt+2) + temp448b16 = 360.d0*zv(2)*temp448b15 + xvb(2) = xvb(2) + yv(1)*temp448b16 - 60.d0*yv(3)*& +& temp448b15 - 480.d0*zv(3)*temp448b13 + yv(2)*& +& temp448b14 + yvb(2) = yvb(2) + xv(2)*temp448b14 - 480.d0*zv(3)*& +& temp448b13 + yvb(4) = yvb(4) + 180.d0*zv(1)*temp448b13 + zvb(5) = zvb(5) + 96.d0*temp448b13 + zvb(3) = zvb(3) + (-(480.d0*xv(2))-480.d0*yv(2))*& +& temp448b13 + yvb(1) = yvb(1) + (-(240.d0*zv(4))-30.d0*xv(4))*& +& temp448b15 + xv(2)*temp448b16 + zvb(2) = zvb(2) + (360.d0*yv(3)+360.d0*xv(2)*yv(1))*& +& temp448b15 + yvb(3) = yvb(3) + (360.d0*zv(2)-60.d0*xv(2))*temp448b15 + yvb(5) = yvb(5) - 30.d0*temp448b15 + xvb(4) = xvb(4) - 30.d0*yv(1)*temp448b15 + zvb(4) = zvb(4) - 240.d0*yv(1)*temp448b15 + temp448b17 = cost1i*fun0*zb(indorbp, indt+1) + temp448b18 = 360.d0*zv(2)*temp448b17 + xvb(3) = xvb(3) + (360.d0*zv(2)-60.d0*yv(2))*temp448b17 + zvb(2) = zvb(2) + (360.d0*xv(1)*yv(2)+360.d0*xv(3))*& +& temp448b17 + yvb(2) = yvb(2) + xv(1)*temp448b18 - 60.d0*xv(3)*& +& temp448b17 + xvb(1) = xvb(1) + yv(2)*temp448b18 + (-(240.d0*zv(4))-& +& 30.d0*yv(4))*temp448b17 + yvb(4) = yvb(4) - 30.d0*xv(1)*temp448b17 + xvb(5) = xvb(5) - 30.d0*temp448b17 + zvb(4) = zvb(4) - 240.d0*xv(1)*temp448b17 + ELSE + temp448b19 = cost2i*fun0*zb(indorbp, indt+3) + temp448b20 = -(60.d0*zv(2)*temp448b19) + fun0b = fun0b + cost2i*(20.d0*(xv(3)*yv(1)*zv(1))+20.d0*& +& (xv(1)*yv(3)*zv(1))-40.d0*(xv(1)*yv(1)*zv(3)))*zb(& +& indorbp, indt+2) + cost2i*(25.d0*(xv(4)*zv(1))+30.d0*(& +& xv(2)*yv(2)*zv(1))+5.d0*(yv(4)*zv(1))+8.d0*zv(5)-20.d0& +& *(yv(2)*zv(3))-60.d0*(xv(2)*zv(3)))*zb(indorbp, indt+1& +& ) + cost2i*(5.d0*xv(5)+10.d0*(xv(3)*yv(2))+5.d0*(yv(4)& +& *xv(1))+40.d0*(xv(1)*zv(4))-60.d0*(xv(1)*yv(2)*zv(2))-& +& 60.d0*(xv(3)*zv(2)))*zb(indorbp, indt+3) + xvb(5) = xvb(5) + 5.d0*temp448b19 + xvb(3) = xvb(3) + (10.d0*yv(2)-60.d0*zv(2))*temp448b19 + yvb(2) = yvb(2) + xv(1)*temp448b20 + 10.d0*xv(3)*& +& temp448b19 + yvb(4) = yvb(4) + 5.d0*xv(1)*temp448b19 + xvb(1) = xvb(1) + yv(2)*temp448b20 + (40.d0*zv(4)+5.d0*& +& yv(4))*temp448b19 + zvb(4) = zvb(4) + 40.d0*xv(1)*temp448b19 + zvb(2) = zvb(2) + (-(60.d0*xv(3))-60.d0*xv(1)*yv(2))*& +& temp448b19 + temp448b21 = cost2i*fun0*zb(indorbp, indt+2) + temp448b22 = 20.d0*zv(1)*temp448b21 + temp448b23 = 20.d0*zv(1)*temp448b21 + temp448b24 = -(40.d0*zv(3)*temp448b21) + xvb(3) = xvb(3) + yv(1)*temp448b22 + yvb(1) = yvb(1) + xv(1)*temp448b24 + xv(3)*temp448b22 + zvb(1) = zvb(1) + (20.d0*xv(1)*yv(3)+20.d0*xv(3)*yv(1))*& +& temp448b21 + xvb(1) = xvb(1) + yv(1)*temp448b24 + yv(3)*temp448b23 + yvb(3) = yvb(3) + xv(1)*temp448b23 + zvb(3) = zvb(3) - 40.d0*xv(1)*yv(1)*temp448b21 + temp448b25 = cost2i*fun0*zb(indorbp, indt+1) + temp448b26 = 30.d0*zv(1)*temp448b25 + xvb(4) = xvb(4) + 25.d0*zv(1)*temp448b25 + zvb(1) = zvb(1) + (5.d0*yv(4)+30.d0*xv(2)*yv(2)+25.d0*xv& +& (4))*temp448b25 + xvb(2) = xvb(2) + yv(2)*temp448b26 - 60.d0*zv(3)*& +& temp448b25 + yvb(2) = yvb(2) + xv(2)*temp448b26 - 20.d0*zv(3)*& +& temp448b25 + yvb(4) = yvb(4) + 5.d0*zv(1)*temp448b25 + zvb(5) = zvb(5) + 8.d0*temp448b25 + zvb(3) = zvb(3) + (-(60.d0*xv(2))-20.d0*yv(2))*& +& temp448b25 + END IF + ELSE IF (branch .LT. 3) THEN + temp448b27 = -(cost2i*fun0*zb(indorbp, indt+3)) + temp448b28 = 60.d0*zv(2)*temp448b27 + fun0b = fun0b - cost2i*(20.d0*(xv(2)*zv(3))-30.d0*(xv(2)*& +& yv(2)*zv(1))-25.d0*(yv(4)*zv(1))-5.d0*(xv(4)*zv(1))+& +& 60.d0*(yv(2)*zv(3))-8.d0*zv(5))*zb(indorbp, indt+2) - & +& cost2i*(40.d0*(xv(1)*yv(1)*zv(3))-20.d0*(xv(1)*yv(3)*zv(& +& 1))-20.d0*(xv(3)*yv(1)*zv(1)))*zb(indorbp, indt+1) - & +& cost2i*(60.d0*(xv(2)*yv(1)*zv(2))-10.d0*(xv(2)*yv(3))-& +& 5.d0*yv(5)-5.d0*(xv(4)*yv(1))+60.d0*(yv(3)*zv(2))-40.d0*& +& (yv(1)*zv(4)))*zb(indorbp, indt+3) + xvb(2) = xvb(2) + yv(1)*temp448b28 - 10.d0*yv(3)*& +& temp448b27 + yvb(1) = yvb(1) + (-(40.d0*zv(4))-5.d0*xv(4))*temp448b27 +& +& xv(2)*temp448b28 + zvb(2) = zvb(2) + (60.d0*yv(3)+60.d0*xv(2)*yv(1))*& +& temp448b27 + yvb(3) = yvb(3) + (60.d0*zv(2)-10.d0*xv(2))*temp448b27 + yvb(5) = yvb(5) - 5.d0*temp448b27 + xvb(4) = xvb(4) - 5.d0*yv(1)*temp448b27 + zvb(4) = zvb(4) - 40.d0*yv(1)*temp448b27 + temp448b29 = -(cost2i*fun0*zb(indorbp, indt+2)) + temp448b30 = -(30.d0*zv(1)*temp448b29) + xvb(2) = xvb(2) + yv(2)*temp448b30 + 20.d0*zv(3)*& +& temp448b29 + zvb(3) = zvb(3) + (60.d0*yv(2)+20.d0*xv(2))*temp448b29 + yvb(2) = yvb(2) + 60.d0*zv(3)*temp448b29 + xv(2)*& +& temp448b30 + zvb(1) = zvb(1) + (-(5.d0*xv(4))-25.d0*yv(4)-30.d0*xv(2)*& +& yv(2))*temp448b29 + yvb(4) = yvb(4) - 25.d0*zv(1)*temp448b29 + xvb(4) = xvb(4) - 5.d0*zv(1)*temp448b29 + zvb(5) = zvb(5) - 8.d0*temp448b29 + temp448b31 = -(cost2i*fun0*zb(indorbp, indt+1)) + temp448b32 = 40.d0*zv(3)*temp448b31 + temp448b33 = -(20.d0*zv(1)*temp448b31) + temp448b34 = -(20.d0*zv(1)*temp448b31) + xvb(1) = xvb(1) + yv(3)*temp448b33 + yv(1)*temp448b32 + yvb(1) = yvb(1) + xv(3)*temp448b34 + xv(1)*temp448b32 + zvb(3) = zvb(3) + 40.d0*xv(1)*yv(1)*temp448b31 + yvb(3) = yvb(3) + xv(1)*temp448b33 + zvb(1) = zvb(1) + (-(20.d0*xv(3)*yv(1))-20.d0*xv(1)*yv(3))& +& *temp448b31 + xvb(3) = xvb(3) + yv(1)*temp448b34 + ELSE + temp448b35 = cost3i*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost3i*(2.d0*(xv(4)*yv(1))-4.d0*(xv(2)*yv(& +& 3))-6.d0*yv(5)+64.d0*(yv(3)*zv(2))-32.d0*(yv(1)*zv(4)))*& +& zb(indorbp, indt+2) + cost3i*(6.d0*xv(5)+4.d0*(xv(3)*yv(& +& 2))-2.d0*(xv(1)*yv(4))+32.d0*(xv(1)*zv(4))-64.d0*(xv(3)*& +& zv(2)))*zb(indorbp, indt+1) + cost3i*(32.d0*(yv(4)*zv(1)& +& )-32.d0*(xv(4)*zv(1))+64.d0*(xv(2)*zv(3))-64.d0*(yv(2)*& +& zv(3)))*zb(indorbp, indt+3) + yvb(4) = yvb(4) + 32.d0*zv(1)*temp448b35 + zvb(1) = zvb(1) + (32.d0*yv(4)-32.d0*xv(4))*temp448b35 + xvb(4) = xvb(4) - 32.d0*zv(1)*temp448b35 + xvb(2) = xvb(2) + 64.d0*zv(3)*temp448b35 + zvb(3) = zvb(3) + (64.d0*xv(2)-64.d0*yv(2))*temp448b35 + yvb(2) = yvb(2) - 64.d0*zv(3)*temp448b35 + temp448b36 = cost3i*fun0*zb(indorbp, indt+2) + xvb(4) = xvb(4) + 2.d0*yv(1)*temp448b36 + yvb(1) = yvb(1) + (2.d0*xv(4)-32.d0*zv(4))*temp448b36 + xvb(2) = xvb(2) - 4.d0*yv(3)*temp448b36 + yvb(3) = yvb(3) + (64.d0*zv(2)-4.d0*xv(2))*temp448b36 + yvb(5) = yvb(5) - 6.d0*temp448b36 + zvb(2) = zvb(2) + 64.d0*yv(3)*temp448b36 + temp448b37 = cost3i*fun0*zb(indorbp, indt+1) + zvb(4) = zvb(4) + 32.d0*xv(1)*temp448b37 - 32.d0*yv(1)*& +& temp448b36 + xvb(5) = xvb(5) + 6.d0*temp448b37 + xvb(3) = xvb(3) + (4.d0*yv(2)-64.d0*zv(2))*temp448b37 + yvb(2) = yvb(2) + 4.d0*xv(3)*temp448b37 + xvb(1) = xvb(1) + (32.d0*zv(4)-2.d0*yv(4))*temp448b37 + yvb(4) = yvb(4) - 2.d0*xv(1)*temp448b37 + zvb(2) = zvb(2) - 64.d0*xv(3)*temp448b37 + END IF + ELSE IF (branch .LT. 6) THEN + IF (branch .LT. 5) THEN + temp448b38 = -(cost3i*fun0*zb(indorbp, indt+3)) + temp448b39 = 64.d0*zv(1)*temp448b38 + temp448b40 = 64.d0*zv(1)*temp448b38 + temp448b41 = -(128.d0*zv(3)*temp448b38) + fun0b = fun0b - cost3i*(32.d0*(xv(3)*zv(2))-12.d0*(xv(3)*& +& yv(2))-10.d0*(xv(1)*yv(4))-2.d0*xv(5)+96.d0*(xv(1)*yv(2)& +& *zv(2))-32.d0*(xv(1)*zv(4)))*zb(indorbp, indt+2) - & +& cost3i*(96.d0*(xv(2)*yv(1)*zv(2))-12.d0*(xv(2)*yv(3))-& +& 2.d0*yv(5)-10.d0*(xv(4)*yv(1))+32.d0*(yv(3)*zv(2))-32.d0& +& *(yv(1)*zv(4)))*zb(indorbp, indt+1) - cost3i*(64.d0*(xv(& +& 3)*yv(1)*zv(1))+64.d0*(xv(1)*yv(3)*zv(1))-128.d0*(xv(1)*& +& yv(1)*zv(3)))*zb(indorbp, indt+3) + xvb(3) = xvb(3) + yv(1)*temp448b39 + yvb(1) = yvb(1) + xv(1)*temp448b41 + xv(3)*temp448b39 + zvb(1) = zvb(1) + (64.d0*xv(1)*yv(3)+64.d0*xv(3)*yv(1))*& +& temp448b38 + xvb(1) = xvb(1) + yv(1)*temp448b41 + yv(3)*temp448b40 + yvb(3) = yvb(3) + xv(1)*temp448b40 + zvb(3) = zvb(3) - 128.d0*xv(1)*yv(1)*temp448b38 + temp448b42 = -(cost3i*fun0*zb(indorbp, indt+2)) + temp448b43 = 96.d0*zv(2)*temp448b42 + xvb(3) = xvb(3) + (32.d0*zv(2)-12.d0*yv(2))*temp448b42 + zvb(2) = zvb(2) + (96.d0*xv(1)*yv(2)+32.d0*xv(3))*& +& temp448b42 + yvb(2) = yvb(2) + xv(1)*temp448b43 - 12.d0*xv(3)*& +& temp448b42 + xvb(1) = xvb(1) + yv(2)*temp448b43 + (-(32.d0*zv(4))-10.d0& +& *yv(4))*temp448b42 + yvb(4) = yvb(4) - 10.d0*xv(1)*temp448b42 + xvb(5) = xvb(5) - 2.d0*temp448b42 + zvb(4) = zvb(4) - 32.d0*xv(1)*temp448b42 + temp448b44 = -(cost3i*fun0*zb(indorbp, indt+1)) + temp448b45 = 96.d0*zv(2)*temp448b44 + xvb(2) = xvb(2) + yv(1)*temp448b45 - 12.d0*yv(3)*& +& temp448b44 + yvb(1) = yvb(1) + (-(32.d0*zv(4))-10.d0*xv(4))*temp448b44 & +& + xv(2)*temp448b45 + zvb(2) = zvb(2) + (32.d0*yv(3)+96.d0*xv(2)*yv(1))*& +& temp448b44 + yvb(3) = yvb(3) + (32.d0*zv(2)-12.d0*xv(2))*temp448b44 + yvb(5) = yvb(5) - 2.d0*temp448b44 + xvb(4) = xvb(4) - 10.d0*yv(1)*temp448b44 + zvb(4) = zvb(4) - 32.d0*yv(1)*temp448b44 + ELSE + temp448b46 = cost4i*fun0*zb(indorbp, indt+3) + temp448b47 = -(72.d0*zv(2)*temp448b46) + fun0b = fun0b + cost4i*(12.d0*(xv(3)*yv(1)*zv(1))+36.d0*(& +& xv(1)*yv(3)*zv(1))-48.d0*(xv(1)*yv(1)*zv(3)))*zb(indorbp& +& , indt+2) + cost4i*(18.d0*(xv(2)*yv(2)*zv(1))-15.d0*(xv(& +& 4)*zv(1))+9.d0*(yv(4)*zv(1))+24.d0*(xv(2)*zv(3))-24.d0*(& +& yv(2)*zv(3)))*zb(indorbp, indt+1) + cost4i*(6.d0*(xv(3)*& +& yv(2))-3.d0*xv(5)+9.d0*(xv(1)*yv(4))+24.d0*(xv(3)*zv(2))& +& -72.d0*(xv(1)*yv(2)*zv(2)))*zb(indorbp, indt+3) + xvb(3) = xvb(3) + (24.d0*zv(2)+6.d0*yv(2))*temp448b46 + yvb(2) = yvb(2) + xv(1)*temp448b47 + 6.d0*xv(3)*temp448b46 + xvb(5) = xvb(5) - 3.d0*temp448b46 + xvb(1) = xvb(1) + yv(2)*temp448b47 + 9.d0*yv(4)*temp448b46 + yvb(4) = yvb(4) + 9.d0*xv(1)*temp448b46 + zvb(2) = zvb(2) + (24.d0*xv(3)-72.d0*xv(1)*yv(2))*& +& temp448b46 + temp448b48 = cost4i*fun0*zb(indorbp, indt+2) + temp448b49 = 12.d0*zv(1)*temp448b48 + temp448b50 = 36.d0*zv(1)*temp448b48 + temp448b51 = -(48.d0*zv(3)*temp448b48) + xvb(3) = xvb(3) + yv(1)*temp448b49 + yvb(1) = yvb(1) + xv(1)*temp448b51 + xv(3)*temp448b49 + zvb(1) = zvb(1) + (36.d0*xv(1)*yv(3)+12.d0*xv(3)*yv(1))*& +& temp448b48 + xvb(1) = xvb(1) + yv(1)*temp448b51 + yv(3)*temp448b50 + yvb(3) = yvb(3) + xv(1)*temp448b50 + zvb(3) = zvb(3) - 48.d0*xv(1)*yv(1)*temp448b48 + temp448b52 = cost4i*fun0*zb(indorbp, indt+1) + temp448b53 = 18.d0*zv(1)*temp448b52 + xvb(2) = xvb(2) + 24.d0*zv(3)*temp448b52 + yv(2)*& +& temp448b53 + yvb(2) = yvb(2) + xv(2)*temp448b53 - 24.d0*zv(3)*& +& temp448b52 + zvb(1) = zvb(1) + (9.d0*yv(4)-15.d0*xv(4)+18.d0*xv(2)*yv(2& +& ))*temp448b52 + xvb(4) = xvb(4) - 15.d0*zv(1)*temp448b52 + yvb(4) = yvb(4) + 9.d0*zv(1)*temp448b52 + zvb(3) = zvb(3) + (24.d0*xv(2)-24.d0*yv(2))*temp448b52 + END IF + ELSE + temp448b54 = -(cost4i*fun0*zb(indorbp, indt+3)) + temp448b55 = -(72.d0*zv(2)*temp448b54) + fun0b = fun0b - cost4i*(9.d0*(xv(4)*zv(1))+18.d0*(xv(2)*yv(2& +& )*zv(1))-15.d0*(yv(4)*zv(1))+24.d0*(yv(2)*zv(3))-24.d0*(xv& +& (2)*zv(3)))*zb(indorbp, indt+2) - cost4i*(36.d0*(xv(3)*yv(& +& 1)*zv(1))+12.d0*(xv(1)*yv(3)*zv(1))-48.d0*(xv(1)*yv(1)*zv(& +& 3)))*zb(indorbp, indt+1) - cost4i*(9.d0*(xv(4)*yv(1))+6.d0& +& *(xv(2)*yv(3))-3.d0*yv(5)+24.d0*(yv(3)*zv(2))-72.d0*(xv(2)& +& *yv(1)*zv(2)))*zb(indorbp, indt+3) + xvb(4) = xvb(4) + 9.d0*yv(1)*temp448b54 + yvb(1) = yvb(1) + xv(2)*temp448b55 + 9.d0*xv(4)*temp448b54 + xvb(2) = xvb(2) + yv(1)*temp448b55 + 6.d0*yv(3)*temp448b54 + yvb(3) = yvb(3) + (24.d0*zv(2)+6.d0*xv(2))*temp448b54 + yvb(5) = yvb(5) - 3.d0*temp448b54 + zvb(2) = zvb(2) + (24.d0*yv(3)-72.d0*xv(2)*yv(1))*temp448b54 + temp448b56 = -(cost4i*fun0*zb(indorbp, indt+2)) + temp448b57 = 18.d0*zv(1)*temp448b56 + xvb(4) = xvb(4) + 9.d0*zv(1)*temp448b56 + zvb(1) = zvb(1) + (18.d0*xv(2)*yv(2)-15.d0*yv(4)+9.d0*xv(4))& +& *temp448b56 + xvb(2) = xvb(2) + yv(2)*temp448b57 - 24.d0*zv(3)*temp448b56 + yvb(2) = yvb(2) + 24.d0*zv(3)*temp448b56 + xv(2)*temp448b57 + yvb(4) = yvb(4) - 15.d0*zv(1)*temp448b56 + zvb(3) = zvb(3) + (24.d0*yv(2)-24.d0*xv(2))*temp448b56 + temp448b58 = -(cost4i*fun0*zb(indorbp, indt+1)) + temp448b59 = 36.d0*zv(1)*temp448b58 + temp448b60 = 12.d0*zv(1)*temp448b58 + temp448b61 = -(48.d0*zv(3)*temp448b58) + xvb(3) = xvb(3) + yv(1)*temp448b59 + yvb(1) = yvb(1) + xv(1)*temp448b61 + xv(3)*temp448b59 + zvb(1) = zvb(1) + (12.d0*xv(1)*yv(3)+36.d0*xv(3)*yv(1))*& +& temp448b58 + xvb(1) = xvb(1) + yv(1)*temp448b61 + yv(3)*temp448b60 + yvb(3) = yvb(3) + xv(1)*temp448b60 + zvb(3) = zvb(3) - 48.d0*xv(1)*yv(1)*temp448b58 + END IF + ELSE IF (branch .LT. 11) THEN + IF (branch .LT. 9) THEN + IF (branch .LT. 8) THEN + temp448b62 = cost5i*fun0*zb(indorbp, indt+3) + temp448b63 = -(120.d0*zv(1)*temp448b62) + fun0b = fun0b + cost5i*(10.d0*(xv(4)*yv(1))+20.d0*(xv(2)*& +& yv(3))-6.d0*yv(5)+40.d0*(yv(3)*zv(2))-120.d0*(xv(2)*yv(1& +& )*zv(2)))*zb(indorbp, indt+2) + cost5i*(20.d0*(xv(3)*yv(& +& 2))-6.d0*xv(5)+10.d0*(xv(1)*yv(4))+40.d0*(xv(3)*zv(2))-& +& 120.d0*(xv(1)*yv(2)*zv(2)))*zb(indorbp, indt+1) + cost5i& +& *(20.d0*(xv(4)*zv(1))-120.d0*(xv(2)*yv(2)*zv(1))+20.d0*(& +& yv(4)*zv(1)))*zb(indorbp, indt+3) + xvb(4) = xvb(4) + 20.d0*zv(1)*temp448b62 + zvb(1) = zvb(1) + (20.d0*yv(4)-120.d0*xv(2)*yv(2)+20.d0*xv& +& (4))*temp448b62 + xvb(2) = xvb(2) + yv(2)*temp448b63 + yvb(2) = yvb(2) + xv(2)*temp448b63 + yvb(4) = yvb(4) + 20.d0*zv(1)*temp448b62 + temp448b64 = cost5i*fun0*zb(indorbp, indt+2) + temp448b65 = -(120.d0*zv(2)*temp448b64) + xvb(4) = xvb(4) + 10.d0*yv(1)*temp448b64 + yvb(1) = yvb(1) + xv(2)*temp448b65 + 10.d0*xv(4)*& +& temp448b64 + xvb(2) = xvb(2) + yv(1)*temp448b65 + 20.d0*yv(3)*& +& temp448b64 + yvb(3) = yvb(3) + (40.d0*zv(2)+20.d0*xv(2))*temp448b64 + yvb(5) = yvb(5) - 6.d0*temp448b64 + temp448b66 = cost5i*fun0*zb(indorbp, indt+1) + zvb(2) = zvb(2) + (40.d0*xv(3)-120.d0*xv(1)*yv(2))*& +& temp448b66 + (40.d0*yv(3)-120.d0*xv(2)*yv(1))*temp448b64 + temp448b67 = -(120.d0*zv(2)*temp448b66) + xvb(3) = xvb(3) + (40.d0*zv(2)+20.d0*yv(2))*temp448b66 + yvb(2) = yvb(2) + xv(1)*temp448b67 + 20.d0*xv(3)*& +& temp448b66 + xvb(5) = xvb(5) - 6.d0*temp448b66 + xvb(1) = xvb(1) + yv(2)*temp448b67 + 10.d0*yv(4)*& +& temp448b66 + yvb(4) = yvb(4) + 10.d0*xv(1)*temp448b66 + ELSE + temp448b68 = -(cost5i*fun0*zb(indorbp, indt+3)) + temp448b69 = 80.d0*zv(1)*temp448b68 + temp448b70 = -(80.d0*zv(1)*temp448b68) + fun0b = fun0b - cost5i*(4.d0*xv(5)-20.d0*(xv(1)*yv(4))+& +& 120.d0*(xv(1)*yv(2)*zv(2))-40.d0*(xv(3)*zv(2)))*zb(& +& indorbp, indt+2) - cost5i*(20.d0*(xv(4)*yv(1))-4.d0*yv(5& +& )+40.d0*(yv(3)*zv(2))-120.d0*(xv(2)*yv(1)*zv(2)))*zb(& +& indorbp, indt+1) - cost5i*(80.d0*(xv(1)*yv(3)*zv(1))-& +& 80.d0*(xv(3)*yv(1)*zv(1)))*zb(indorbp, indt+3) + xvb(1) = xvb(1) + yv(3)*temp448b69 + yvb(3) = yvb(3) + xv(1)*temp448b69 + zvb(1) = zvb(1) + (80.d0*xv(1)*yv(3)-80.d0*xv(3)*yv(1))*& +& temp448b68 + xvb(3) = xvb(3) + yv(1)*temp448b70 + yvb(1) = yvb(1) + xv(3)*temp448b70 + temp448b71 = -(cost5i*fun0*zb(indorbp, indt+2)) + temp448b72 = 120.d0*zv(2)*temp448b71 + xvb(5) = xvb(5) + 4.d0*temp448b71 + xvb(1) = xvb(1) + yv(2)*temp448b72 - 20.d0*yv(4)*& +& temp448b71 + yvb(4) = yvb(4) - 20.d0*xv(1)*temp448b71 + yvb(2) = yvb(2) + xv(1)*temp448b72 + temp448b73 = -(cost5i*fun0*zb(indorbp, indt+1)) + zvb(2) = zvb(2) + (40.d0*yv(3)-120.d0*xv(2)*yv(1))*& +& temp448b73 + (120.d0*xv(1)*yv(2)-40.d0*xv(3))*temp448b71 + xvb(3) = xvb(3) - 40.d0*zv(2)*temp448b71 + temp448b74 = -(120.d0*zv(2)*temp448b73) + xvb(4) = xvb(4) + 20.d0*yv(1)*temp448b73 + yvb(1) = yvb(1) + xv(2)*temp448b74 + 20.d0*xv(4)*& +& temp448b73 + yvb(5) = yvb(5) - 4.d0*temp448b73 + yvb(3) = yvb(3) + 40.d0*zv(2)*temp448b73 + xvb(2) = xvb(2) + yv(1)*temp448b74 END IF + ELSE IF (branch .LT. 10) THEN + temp448b75 = cost6i*fun0*zb(indorbp, indt+3) + fun0b = fun0b + cost6i*(20.d0*(xv(1)*yv(3)*zv(1))-20.d0*(xv(& +& 3)*yv(1)*zv(1)))*zb(indorbp, indt+2) + cost6i*(5.d0*(xv(4)& +& *zv(1))-30.d0*(xv(2)*yv(2)*zv(1))+5.d0*(yv(4)*zv(1)))*zb(& +& indorbp, indt+1) + cost6i*(xv(5)-10.d0*(xv(3)*yv(2))+5.d0*& +& (xv(1)*yv(4)))*zb(indorbp, indt+3) + xvb(5) = xvb(5) + temp448b75 + xvb(3) = xvb(3) - 10.d0*yv(2)*temp448b75 + yvb(2) = yvb(2) - 10.d0*xv(3)*temp448b75 + temp448b76 = cost6i*fun0*zb(indorbp, indt+2) + temp448b77 = 20.d0*zv(1)*temp448b76 + xvb(1) = xvb(1) + yv(3)*temp448b77 + 5.d0*yv(4)*temp448b75 + yvb(4) = yvb(4) + 5.d0*xv(1)*temp448b75 + temp448b78 = -(20.d0*zv(1)*temp448b76) + yvb(3) = yvb(3) + xv(1)*temp448b77 + temp448b79 = cost6i*fun0*zb(indorbp, indt+1) + zvb(1) = zvb(1) + (5.d0*yv(4)-30.d0*xv(2)*yv(2)+5.d0*xv(4))*& +& temp448b79 + (20.d0*xv(1)*yv(3)-20.d0*xv(3)*yv(1))*& +& temp448b76 + xvb(3) = xvb(3) + yv(1)*temp448b78 + yvb(1) = yvb(1) + xv(3)*temp448b78 + temp448b80 = -(30.d0*zv(1)*temp448b79) + xvb(4) = xvb(4) + 5.d0*zv(1)*temp448b79 + xvb(2) = xvb(2) + yv(2)*temp448b80 + yvb(2) = yvb(2) + xv(2)*temp448b80 + yvb(4) = yvb(4) + 5.d0*zv(1)*temp448b79 ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + temp448b81 = -(cost6i*fun0*zb(indorbp, indt+3)) + fun0b = fun0b - cost6i*(30.d0*(xv(2)*yv(2)*zv(1))-5.d0*(xv(4& +& )*zv(1))-5.d0*(yv(4)*zv(1)))*zb(indorbp, indt+2) - cost6i*& +& (20.d0*(xv(1)*yv(3)*zv(1))-20.d0*(xv(3)*yv(1)*zv(1)))*zb(& +& indorbp, indt+1) - cost6i*(10.d0*(xv(2)*yv(3))-5.d0*(xv(4)& +& *yv(1))-yv(5))*zb(indorbp, indt+3) + xvb(2) = xvb(2) + 10.d0*yv(3)*temp448b81 + yvb(3) = yvb(3) + 10.d0*xv(2)*temp448b81 + xvb(4) = xvb(4) - 5.d0*yv(1)*temp448b81 + yvb(1) = yvb(1) - 5.d0*xv(4)*temp448b81 + yvb(5) = yvb(5) - temp448b81 + temp448b82 = -(cost6i*fun0*zb(indorbp, indt+2)) + temp448b83 = 30.d0*zv(1)*temp448b82 + xvb(2) = xvb(2) + yv(2)*temp448b83 + yvb(2) = yvb(2) + xv(2)*temp448b83 + temp448b84 = -(cost6i*fun0*zb(indorbp, indt+1)) + zvb(1) = zvb(1) + (20.d0*xv(1)*yv(3)-20.d0*xv(3)*yv(1))*& +& temp448b84 + (30.d0*xv(2)*yv(2)-5.d0*xv(4)-5.d0*yv(4))*& +& temp448b82 + xvb(4) = xvb(4) - 5.d0*zv(1)*temp448b82 + yvb(4) = yvb(4) - 5.d0*zv(1)*temp448b82 + temp448b85 = 20.d0*zv(1)*temp448b84 + temp448b86 = -(20.d0*zv(1)*temp448b84) + xvb(1) = xvb(1) + yv(3)*temp448b85 + yvb(3) = yvb(3) + xv(1)*temp448b85 + xvb(3) = xvb(3) + yv(1)*temp448b86 + yvb(1) = yvb(1) + xv(3)*temp448b86 END IF - temp486 = fun/r(0) - temp486b12 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp486*rmu(i, 0)*zb(& -& indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp486*distp(0, 3+ic)*zb(indorbp, & + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 12) THEN + temp448b87 = cost7i*fun0*zb(indorbp, indt+2) + fun0b = fun0b + cost7i*(6.d0*xv(5)-60.d0*(xv(3)*yv(2))+30.d0& +& *(xv(1)*yv(4)))*zb(indorbp, indt+1) + cost7i*(60.d0*(xv(2)& +& *yv(3))-30.d0*(xv(4)*yv(1))-6.d0*yv(5))*zb(indorbp, indt+2& +& ) + xvb(2) = xvb(2) + 60.d0*yv(3)*temp448b87 + yvb(3) = yvb(3) + 60.d0*xv(2)*temp448b87 + xvb(4) = xvb(4) - 30.d0*yv(1)*temp448b87 + yvb(1) = yvb(1) - 30.d0*xv(4)*temp448b87 + yvb(5) = yvb(5) - 6.d0*temp448b87 + temp448b88 = cost7i*fun0*zb(indorbp, indt+1) + xvb(5) = xvb(5) + 6.d0*temp448b88 + xvb(3) = xvb(3) - 60.d0*yv(2)*temp448b88 + yvb(2) = yvb(2) - 60.d0*xv(3)*temp448b88 + xvb(1) = xvb(1) + 30.d0*yv(4)*temp448b88 + yvb(4) = yvb(4) + 30.d0*xv(1)*temp448b88 + END IF + ELSE + temp448b89 = -(cost7i*fun0*zb(indorbp, indt+2)) + fun0b = fun0b - cost7i*(60.d0*(xv(2)*yv(3))-30.d0*(xv(4)*yv(1)& +& )-6.d0*yv(5))*zb(indorbp, indt+1) - cost7i*(60.d0*(xv(3)*yv(& +& 2))-6.d0*xv(5)-30.d0*(xv(1)*yv(4)))*zb(indorbp, indt+2) + xvb(3) = xvb(3) + 60.d0*yv(2)*temp448b89 + yvb(2) = yvb(2) + 60.d0*xv(3)*temp448b89 + xvb(5) = xvb(5) - 6.d0*temp448b89 + xvb(1) = xvb(1) - 30.d0*yv(4)*temp448b89 + yvb(4) = yvb(4) - 30.d0*xv(1)*temp448b89 + temp448b90 = -(cost7i*fun0*zb(indorbp, indt+1)) + xvb(2) = xvb(2) + 60.d0*yv(3)*temp448b90 + yvb(3) = yvb(3) + 60.d0*xv(2)*temp448b90 + xvb(4) = xvb(4) - 30.d0*yv(1)*temp448b90 + yvb(1) = yvb(1) - 30.d0*xv(4)*temp448b90 + yvb(5) = yvb(5) - 6.d0*temp448b90 + END IF + DO i=3,1,-1 + temp448b12 = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - funb = funb + temp486b12 - rb(0) = rb(0) - temp486*temp486b12 + rmub(i, 0) = rmub(i, 0) + fun*temp448b12 + funb0 = funb0 + rmu(i, 0)*temp448b12 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp486b10 = -(dd1*distp(0, 1)*fun2b) - temp486b11 = -((dd1*r(0)-2.d0)*fun2b) - dd1b = distp(0, 1)*r(0)*funb + distp(0, 1)*temp486b11 + r(0)*& -& temp486b10 - rb(0) = rb(0) + distp(0, 1)*dd1*funb + dd1*temp486b10 - distpb(0, 1) = distpb(0, 1) + dd1*temp486b11 - (1.d0-dd1*r(0))*& -& funb - distpb(0, 3) = distpb(0, 3) - fun0b + DO k=6,1,-1 + CALL POPREAL8(adr8ibuf,adr8buf,xv(k)) + IF (.NOT.(rmu(1, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(1, 0) = rmub(1, 0) + k*rmu(1, 0)**(k-1)*xvb(k) + xvb(k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,yv(k)) + IF (.NOT.(rmu(2, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(2, 0) = rmub(2, 0) + k*rmu(2, 0)**(k-1)*yvb(k) + yvb(k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,zv(k)) + IF (.NOT.(rmu(3, 0) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(3, 0) = rmub(3, 0) + k*rmu(3, 0)**(k-1)*zvb(k) + zvb(k) = 0.0_8 + END DO + temp448b11 = -(fun*2.d0*fun2b) + funb0 = funb0 + (1.d0-2.d0*(dd1*r(0)**2))*fun2b + dd1b = r(0)**2*temp448b11 - 2.d0*distp(0, 1)*funb0 + rb(0) = rb(0) + dd1*2*r(0)*temp448b11 + distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb0 + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd1b = 0.0_8 + zvb = 0.0_8 + xvb = 0.0_8 + yvb = 0.0_8 END IF - DO ic=5,1,-1 - DO i=indtm,i0,-1 - distpb(i, 3+ic) = distpb(i, 3+ic) - distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) - distp(i, 3+ic)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=13,1,-1 + DO k=indtm,i0,-1 + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + temp448b = -(cost7i*distpb(i, 14)) + xvb(3) = xvb(3) + 20.d0*yv(3)*temp448b + yvb(3) = yvb(3) + 20.d0*xv(3)*temp448b + xvb(5) = xvb(5) - 6.d0*yv(1)*temp448b + yvb(1) = yvb(1) - 6.d0*xv(5)*temp448b + yvb(5) = yvb(5) - 6.d0*xv(1)*temp448b + xvb(1) = xvb(1) - 6.d0*yv(5)*temp448b + distpb(i, 14) = 0.0_8 + temp448b0 = cost7i*distpb(i, 13) + xvb(6) = xvb(6) + temp448b0 + xvb(4) = xvb(4) - 15.d0*yv(2)*temp448b0 + yvb(2) = yvb(2) - 15.d0*xv(4)*temp448b0 + distpb(i, 13) = 0.0_8 + temp448b1 = -(cost6i*zv(1)*distpb(i, 12)) + xvb(2) = xvb(2) + 10.d0*yv(3)*temp448b1 + 15.d0*yv(4)*temp448b0 + yvb(4) = yvb(4) + 15.d0*xv(2)*temp448b0 + yvb(6) = yvb(6) - temp448b0 + yvb(3) = yvb(3) + 10.d0*xv(2)*temp448b1 + xvb(4) = xvb(4) - 5.d0*yv(1)*temp448b1 + yvb(1) = yvb(1) - 5.d0*xv(4)*temp448b1 + yvb(5) = yvb(5) - temp448b1 + zvb(1) = zvb(1) - cost6i*(10.d0*(xv(2)*yv(3))-5.d0*(xv(4)*yv(1))-& +& yv(5))*distpb(i, 12) + distpb(i, 12) = 0.0_8 + temp448b2 = cost6i*zv(1)*distpb(i, 11) + xvb(5) = xvb(5) + temp448b2 + xvb(3) = xvb(3) - 10.d0*yv(2)*temp448b2 + yvb(2) = yvb(2) - 10.d0*xv(3)*temp448b2 + xvb(1) = xvb(1) + 5.d0*yv(4)*temp448b2 + yvb(4) = yvb(4) + 5.d0*xv(1)*temp448b2 + zvb(1) = zvb(1) + cost6i*(xv(5)-10.d0*(xv(3)*yv(2))+5.d0*(xv(1)*yv& +& (4)))*distpb(i, 11) + distpb(i, 11) = 0.0_8 + temp448b3 = cost5i*4.d0*distpb(i, 10) + temp448b4 = cost*temp448b3 + xvb(3) = xvb(3) + yv(1)*temp448b4 + yvb(1) = yvb(1) + xv(3)*temp448b4 + yvb(3) = yvb(3) - xv(1)*temp448b4 + xvb(1) = xvb(1) - yv(3)*temp448b4 + distpb(i, 10) = 0.0_8 + costb = cost5i*(xv(4)-6.d0*(xv(2)*yv(2))+yv(4))*distpb(i, 9) + (xv& +& (3)*yv(1)-yv(3)*xv(1))*temp448b3 + temp448b5 = cost5i*cost*distpb(i, 9) + xvb(4) = xvb(4) + temp448b5 + distpb(i, 9) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp448b6 = -(cost4i*cost*distpb(i, 8)) + xvb(2) = xvb(2) - 3.d0*yv(1)*temp448b6 - 6.d0*yv(2)*temp448b5 + yvb(2) = yvb(2) - 6.d0*xv(2)*temp448b5 + yvb(4) = yvb(4) + temp448b5 + zvb(2) = zvb(2) + 11.d0*costb + r2b = -costb + yvb(3) = yvb(3) + temp448b6 + yvb(1) = yvb(1) - 3.d0*xv(2)*temp448b6 + costb = -(cost4i*(yv(3)-3.d0*(yv(1)*xv(2)))*distpb(i, 8)) distpb(i, 8) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + temp448b7 = cost4i*cost*distpb(i, 7) + xvb(3) = xvb(3) + temp448b7 + costb = costb + cost4i*(xv(3)-3.d0*(xv(1)*yv(2)))*distpb(i, 7) distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp448b8 = cost3i*2.d0*distpb(i, 6) + xvb(1) = xvb(1) + yv(1)*cost*temp448b8 - 3.d0*yv(2)*temp448b7 + yvb(2) = yvb(2) - 3.d0*xv(1)*temp448b7 + zvb(3) = zvb(3) + 11.d0*costb + zvb(1) = zvb(1) - 3.d0*r2*costb + r2b = r2b - 3.d0*zv(1)*costb distpb(i, 6) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + temp448b9 = cost3i*distpb(i, 5) + costb = (xv(2)-yv(2))*temp448b9 + yv(1)*xv(1)*temp448b8 + yvb(1) = yvb(1) + xv(1)*cost*temp448b8 + xvb(2) = xvb(2) + cost*temp448b9 + yvb(2) = yvb(2) - cost*temp448b9 distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + CALL POPREAL8(adr8ibuf,adr8buf,cost) + zvb(4) = zvb(4) + 33.d0*costb + zvb(2) = zvb(2) - 18.d0*r2*costb + r2b = r2b - 18.d0*zv(2)*costb + r4b = costb + rmub(2, i) = rmub(2, i) + cost2i*cost*distpb(i, 4) + costb = cost2i*rmu(2, i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distpb(i, 1) = distpb(i, 1) + r(i)*distpb(i, 3) - rb(i) = rb(i) + distp(i, 1)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2i*cost*distpb(i, 3) + costb = costb + cost2i*rmu(1, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + zvb(5) = zvb(5) + 33.d0*costb + zvb(3) = zvb(3) - 30.d0*r2*costb + temp448b10 = cost1i*distpb(i, 2) + r6b = -(5.d0*temp448b10) + r4b = r4b + 105.d0*zv(2)*temp448b10 + r2*r6b + 5.d0*zv(1)*costb + r2b = r2b + 2*r2*r4b - 315.d0*zv(4)*temp448b10 + r4*r6b - 30.d0*zv& +& (3)*costb + zvb(1) = zvb(1) + 5.d0*r4*costb + zvb(6) = zvb(6) + 231.d0*temp448b10 + zvb(4) = zvb(4) - 315.d0*r2*temp448b10 + zvb(2) = zvb(2) + r2b + 105.d0*r4*temp448b10 + distpb(i, 2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,r4) + CALL POPREAL8(adr8ibuf,adr8buf,r2) + xvb(2) = xvb(2) + r2b + yvb(2) = yvb(2) + r2b + DO k=6,1,-1 + CALL POPREAL8(adr8ibuf,adr8buf,xv(k)) + IF (.NOT.(rmu(1, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(1, i) = rmub(1, i) + k*rmu(1, i)**(k-1)*xvb(k) + xvb(k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,yv(k)) + IF (.NOT.(rmu(2, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(2, i) = rmub(2, i) + k*rmu(2, i)**(k-1)*yvb(k) + yvb(k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,zv(k)) + IF (.NOT.(rmu(3, i) .LE. 0.0 .AND. (k .EQ. 0.0 .OR. k .NE. INT(k& +& )))) rmub(3, i) = rmub(3, i) + k*rmu(3, i)**(k-1)*zvb(k) + zvb(k) = 0.0_8 + END DO END DO + dd1b = 0.0_8 + cb = 0.0_8 DO k=indtm,indtmin,-1 - temp486b9 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp486b9 - rb(k) = rb(k) - dd1*temp486b9 + temp447 = r(k)**2 + temp447b0 = c*DEXP(-(dd1*temp447))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp447))*distpb(k, 1) + dd1b = dd1b - temp447*temp447b0 + rb(k) = rb(k) - dd1*2*r(k)*temp447b0 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (143) -! 4d one parmater der of 133 - dd1 = dd(indpar+1) + dd1b = dd1b + 0.43985656185609913955d0*3.75d0*dd1**2.75D0*cb + ddb(indparp) = ddb(indparp) + dd1b + CASE (65) +! 2s gaussian for pseudo +! d orbitals +! R(r)= c0 r^3 exp(-alpha r^2)+ c1 r exp(-alpha r^2) +! each gaussian term is normalized +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization to be done +! c=8.d0/dsqrt(21.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) + c = dd1**2.25d0*1.24420067280413253d0 +! endif + c0 = -c + c1 = 2.25d0*c/dd1 DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k))) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO DO i=indtmin,indtm - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = distp(i, 1)*r(i)**2 - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) - distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) - distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) - distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) - distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d - CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) - distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d +! lz=0 + distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d +! lz=+/-2 + distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d +! lz=+/-2 + distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d +! lz=+/-1 + distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d +! lz=+/-1 + distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d END DO -! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun0 = -distp(0, 3) - fun = -((-2.d0+dd1*r(0))*distp(0, 1)) - fun2 = ((dd1*r(0))**2-4.d0*r(0)*dd1+2.d0)*distp(0, 1) -! indorbp=indorb + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + rp1 = 2.d0*dd1*r(0) + rp2 = rp1*r(0) + fun0 = distp(0, 1)*(c1*r(0)+c0*r(0)**3) + fun = (c1*(1.d0-rp2)+c0*r(0)**2*(3.d0-rp2))*distp(0, 1)/r(0) + fun2 = distp(0, 1)*(c1*rp1*(rp2-3.d0)+c0*r(0)*(3.d0-3.5d0*rp2+& +& 0.5d0*rp2**2)) +! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN @@ -19849,15 +20050,15 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=5,1,-1 - temp488b8 = distp(0, 3+ic)*zb(indorbp, indt+4) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*fun+fun2)*zb(indorbp, & + temp455b4 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & & indt+4) - funb = funb + 6.d0*temp488b8 - fun2b = fun2b + temp488b8 + funb0 = funb0 + 6.d0*temp455b4 + fun2b = fun2b + temp455b4 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -19865,24 +20066,24 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN IF (branch .LT. 2) THEN - temp488b4 = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp488b4 - fun0b = fun0b + rmu(i, 0)*temp488b4 + temp455b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp455b0 + fun0b = fun0b + rmu(i, 0)*temp455b0 ELSE - temp488b5 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp488b5 - fun0b = fun0b + rmu(i, 0)*temp488b5 + temp455b1 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp455b1 + fun0b = fun0b + rmu(i, 0)*temp455b1 END IF ELSE IF (branch .LT. 4) THEN - temp488b6 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp488b6 - fun0b = fun0b + rmu(i, 0)*temp488b6 + temp455b2 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp455b2 + fun0b = fun0b + rmu(i, 0)*temp455b2 END IF ELSE IF (branch .LT. 7) THEN IF (branch .LT. 6) THEN - temp488b7 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp488b7 - fun0b = fun0b + rmu(i, 0)*temp488b7 + temp455b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp455b3 + fun0b = fun0b + rmu(i, 0)*temp455b3 ELSE rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) @@ -19912,91 +20113,126 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp488b3 = distp(0, 3+ic)*zb(indorbp, indt+i) - distpb(0, 3+ic) = distpb(0, 3+ic) + rmu(i, 0)*fun*zb(indorbp, & + temp455b = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp488b3 - funb = funb + rmu(i, 0)*temp488b3 + rmub(i, 0) = rmub(i, 0) + fun*temp455b + funb0 = funb0 + rmu(i, 0)*temp455b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp488b1 = distp(0, 1)*fun2b - temp488b2 = 2*dd1*r(0)*temp488b1 - dd1b = r(0)*temp488b2 - 4.d0*r(0)*temp488b1 - distp(0, 1)*r(0)*& -& funb - rb(0) = rb(0) + dd1*temp488b2 - 4.d0*dd1*temp488b1 - distp(0, 1)*& -& dd1*funb - distpb(0, 1) = distpb(0, 1) + ((dd1*r(0))**2-4.d0*(r(0)*dd1)+2.d0)& -& *fun2b - (dd1*r(0)-2.d0)*funb - distpb(0, 3) = distpb(0, 3) - fun0b + temp454 = 0.5d0*rp2**2 - 3.5d0*rp2 + 3.d0 + temp453 = c0*r(0) + temp453b = distp(0, 1)*fun2b + temp452b = (c1*(1.d0-rp2)+r(0)**2*(c0*(3.d0-rp2)))*funb0/r(0) + temp451 = r(0)**3 + distpb(0, 1) = distpb(0, 1) + temp452b + (c1*r(0)+c0*temp451)*& +& fun0b + (c1*rp1*(rp2-3.d0)+temp453*temp454)*fun2b + temp452 = distp(0, 1)/r(0) + temp453b0 = temp452*funb0 + temp451b = distp(0, 1)*fun0b + c1b = (1.d0-rp2)*temp453b0 + r(0)*temp451b + (rp2-3.d0)*rp1*& +& temp453b + temp453b1 = r(0)**2*temp453b0 + rp2b = (temp453*0.5d0*2*rp2-temp453*3.5d0+c1*rp1)*temp453b - c0*& +& temp453b1 - c1*temp453b0 + rp1b = r(0)*rp2b + (rp2-3.d0)*c1*temp453b + c0b = (3.d0-rp2)*temp453b1 + temp451*temp451b + temp454*r(0)*& +& temp453b + rb(0) = rb(0) + c0*(3.d0-rp2)*2*r(0)*temp453b0 - temp452*temp452b & +& + rp1*rp2b + 2.d0*dd1*rp1b + (c0*3*r(0)**2+c1)*temp451b + & +& temp454*c0*temp453b + dd1b = 2.d0*r(0)*rp1b + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd1b = 0.0_8 + c0b = 0.0_8 + c1b = 0.0_8 END IF DO ic=5,1,-1 - DO i=indtm,i0,-1 - distpb(i, 3+ic) = distpb(i, 3+ic) - distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) - distp(i, 3+ic)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO k=indtm,i0,-1 + temp450 = r(k)**3 + temp449 = c0*distp(k, 1+ic) + temp449b = distp(k, 1)*zb(indorbp, k) + distpb(k, 1) = distpb(k, 1) + (temp449*temp450+c1*r(k))*zb(& +& indorbp, k) + c0b = c0b + temp450*distp(k, 1+ic)*temp449b + distpb(k, 1+ic) = distpb(k, 1+ic) + temp450*c0*temp449b + rb(k) = rb(k) + (c1+temp449*3*r(k)**2)*temp449b + c1b = c1b + r(k)*temp449b + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO i=indtm,indtmin,-1 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) - distpb(i, 8) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 7)) - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) - distpb(i, 7) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 6)) - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) distpb(i, 6) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 5)) - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) distpb(i, 5) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 4)) - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) distpb(i, 4) = 0.0_8 - CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distpb(i, 1) = distpb(i, 1) + r(i)**2*distpb(i, 3) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*distpb(i, 3) + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) distpb(i, 3) = 0.0_8 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) + distpb(i, 2) = 0.0_8 END DO + dd1b = 0.0_8 + cb = 0.0_8 DO k=indtm,indtmin,-1 - temp488b0 = DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1b = dd1b - r(k)*temp488b0 - rb(k) = rb(k) - dd1*temp488b0 + temp448 = r(k)**2 + temp448b93 = c*DEXP(-(dd1*temp448))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp448))*distpb(k, 1) + dd1b = dd1b - temp448*temp448b93 + rb(k) = rb(k) - dd1*2*r(k)*temp448b93 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (144) -! 2p single exponential -r^3 e^{-z r} ! derivative of 130 - dd2 = dd(indpar+1) + temp448b92 = 2.25d0*c1b/dd1 + cb = cb + temp448b92 - c0b + dd1b = dd1b + 1.24420067280413253d0*2.25d0*dd1**1.25D0*cb - c*& +& temp448b92/dd1 + ddb(indparp) = ddb(indparp) + dd1b + CASE (82) +! ******************* END GAUSSIAN BASIS ************************ +! ** ** ** ** ** ** ** JASTROW ORBITALS ** ** ** ** ** ** ** ** * + dd1 = dd(indpar+1) + dd2 = DSQRT(dd1) +! if(iflagnorm.gt.2) then +! ratiocp--> ratiocp*dsqrt(2.d0)*pi**(-0.75d0)*2**1.25 +! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0*ratiocp + c = dd1**1.25d0*ratiocp +! endif DO k=indtmin,indtm - distp(k, 1) = -DEXP(-(dd2*r(k))) + CALL PUSHREAL8(adr8ibuf,adr8buf,cost) + cost = dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k, 1) = c*DEXP(-cost) END DO -! indorbp=indorb +! indorbp=indorb +! DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif IF (typec .NE. 1) THEN - fun = distp(0, 1)*(3.d0-dd2*r(0))*r(0) -! fun= derivative of fun0 respect to r divided dy r - fun2 = distp(0, 1)*(dd2**2*r(0)**3-6*dd2*r(0)**2+6*r(0)) -! fun2= second derivative of fun0 respect to r -! indorbp=indorb +! fun=-2.d0*dd1*distp(0,1) +! fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + rp1 = dd1*r(0)**2 + rp2 = dd2*r(0) + rp3 = (1.d0+rp2)**2 + fun = -(dd1*distp(0, 1)*(2.d0+rp2)/rp3) +! the second derivative + fun2 = dd1*distp(0, 1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**& +& 2)/rp3**2 +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -20006,122 +20242,95 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp489b0 = rmu(ic, 0)*zb(indorbp, indt+4) + temp459b0 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp489b0 - fun2b = fun2b + temp489b0 + funb0 = funb0 + 4.d0*temp459b0 + fun2b = fun2b + temp459b0 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp489b = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp489b - funb = funb + rmu(ic, 0)*temp489b + temp459b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp459b + funb0 = funb0 + rmu(ic, 0)*temp459b rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - temp488 = r(0)**3 - temp488b11 = distp(0, 1)*fun2b - temp488b12 = (3.d0-dd2*r(0))*funb - distpb(0, 1) = r(0)*temp488b12 + r(0)**3*fun0b + (dd2**2*temp488-6& -& *(dd2*r(0)**2)+6*r(0))*fun2b - temp488b13 = distp(0, 1)*r(0)*funb - dd2b = (temp488*2*dd2-6*r(0)**2)*temp488b11 - r(0)*temp488b13 - rb(0) = rb(0) + distp(0, 1)*temp488b12 - dd2*temp488b13 + distp(0& -& , 1)*3*r(0)**2*fun0b + (dd2**2*3*r(0)**2-6*dd2*2*r(0)+6)*& -& temp488b11 + temp458 = rp3**2 + temp457b = (4.d0*rp1-2.d0*rp2+4.d0*(rp1*rp2)+rp1**2-2.d0)*fun2b/& +& temp458 + temp457 = dd1*distp(0, 1)/temp458 + temp457b0 = temp457*fun2b + rp1b = (2*rp1+4.d0*rp2+4.d0)*temp457b0 + temp456b0 = -(distp(0, 1)*(rp2+2.d0)*funb0/rp3) + dd1b = temp456b0 + r(0)**2*rp1b + distp(0, 1)*temp457b + temp456 = dd1/rp3 + distpb(0, 1) = fun0b - temp456*(rp2+2.d0)*funb0 + dd1*temp457b + rp3b = -(temp456*temp456b0) - temp457*2*rp3*temp457b + rp2b = 2*(rp2+1.d0)*rp3b - temp456*distp(0, 1)*funb0 + (4.d0*rp1-& +& 2.d0)*temp457b0 + dd2b = r(0)*rp2b + rb(0) = rb(0) + dd1*2*r(0)*rp1b + dd2*rp2b ELSE distpb = 0.0_8 + dd1b = 0.0_8 dd2b = 0.0_8 END IF DO ic=3,1,-1 DO i=indtm,i0,-1 - temp488b10 = r(i)**3*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp488b10 - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp488b10 - rb(i) = rb(i) + rmu(ic, i)*distp(i, 1)*3*r(i)**2*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + cb = 0.0_8 DO k=indtm,indtmin,-1 - temp488b9 = -(DEXP(-(dd2*r(k)))*distpb(k, 1)) - dd2b = dd2b - r(k)*temp488b9 - rb(k) = rb(k) - dd2*temp488b9 + cb = cb + DEXP(-cost)*distpb(k, 1) + costb = -(c*DEXP(-cost)*distpb(k, 1)) distpb(k, 1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,cost) + temp455 = dd2*r(k) + 1.d0 + temp456b = costb/temp455 + temp455b5 = -(dd1*r(k)**2*temp456b/temp455) + dd1b = dd1b + r(k)**2*temp456b + rb(k) = rb(k) + dd2*temp455b5 + dd1*2*r(k)*temp456b + dd2b = dd2b + r(k)*temp455b5 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (145) -! 2s without cusp condition !derivative 100 -! -(r^2*exp(-dd2*r^2)) - dd2 = dd(indpar+1) - indorbp = indorb + 1 - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) - END DO -! endif - IF (typec .NE. 1) THEN - fun0 = dd2*r(0)**2 - fun = -(2.d0*distp(0, 1)*(1.d0-fun0)) - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - temp489b2 = -(2.d0*distp(0, 1)*fun2b) - distpb(0, 1) = -(2.d0*(1.d0-fun0)*funb) - 2.d0*(2.d0*fun0**2-5.d0*& -& fun0+1.d0)*fun2b - fun0b = 2.d0*distp(0, 1)*funb + (2.d0*2*fun0-5.d0)*temp489b2 - dd2b = r(0)**2*fun0b - rb(0) = rb(0) + dd2*2*r(0)*fun0b + IF (dd1 .EQ. 0.0) THEN + dd1b = dd1b + ratiocp*1.25d0*dd1**0.25D0*cb ELSE - distpb = 0.0_8 - dd2b = 0.0_8 + dd1b = dd1b + dd2b/(2.D0*DSQRT(dd1)) + ratiocp*1.25d0*dd1**0.25D0*& +& cb END IF - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) - r(i)**2*zb(indorbp, i) - rb(i) = rb(i) - distp(i, 1)*2*r(i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=indtm,indtmin,-1 - temp489b1 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp489b1 - rb(k) = rb(k) - dd2*2*r(k)*temp489b1 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (146) -! 2p single exponential -r^2 e^{-z r^2} ! derivative of 103 + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (111) +! 2p single r_mu/(1+b r^3) parent of 103 dd2 = dd(indpar+1) DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) + distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**3) END DO -! indorbp=indorb +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - rp2 = dd2*r(0)*r(0) - fun = distp(0, 1)*(-2.d0+2.d0*rp2) - fun2 = (-2.d0+10.d0*rp2-4.d0*rp2*rp2)*distp(0, 1) -! indorbp=indorb + fun = -(dd2*distp(0, 1)**2*3.d0*r(0)) + fun2 = fun*distp(0, 1)*(2.d0-4.d0*dd2*r(0)**3) +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -20131,239 +20340,196 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp489b6 = rmu(ic, 0)*zb(indorbp, indt+4) + temp461b0 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp489b6 - fun2b = fun2b + temp489b6 + funb0 = funb0 + 4.d0*temp461b0 + fun2b = fun2b + temp461b0 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp489b5 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp489b5 - funb = funb + rmu(ic, 0)*temp489b5 + temp461b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp461b + funb0 = funb0 + rmu(ic, 0)*temp461b rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO distpb = 0.0_8 - rp2b = distp(0, 1)*2.d0*funb + (distp(0, 1)*10.d0-distp(0, 1)*4.d0& -& *2*rp2)*fun2b - distpb(0, 1) = (2.d0*rp2-2.d0)*funb - r(0)**2*fun0b + (10.d0*rp2-& -& 4.d0*rp2**2-2.d0)*fun2b - rb(0) = rb(0) + dd2*2*r(0)*rp2b - distp(0, 1)*2*r(0)*fun0b - dd2b = r(0)**2*rp2b + temp460 = r(0)**3 + temp460b = (2.d0-4.d0*(dd2*temp460))*fun2b + temp460b0 = -(fun*distp(0, 1)*4.d0*fun2b) + funb0 = funb0 + distp(0, 1)*temp460b + distpb(0, 1) = fun0b - 3.d0*dd2*r(0)*2*distp(0, 1)*funb0 + fun*& +& temp460b + temp460b1 = -(3.d0*distp(0, 1)**2*funb0) + dd2b = r(0)*temp460b1 + temp460*temp460b0 + rb(0) = rb(0) + dd2*temp460b1 + dd2*3*r(0)**2*temp460b0 ELSE distpb = 0.0_8 dd2b = 0.0_8 END IF DO ic=3,1,-1 DO i=indtm,i0,-1 - temp489b4 = -(r(i)**2*zb(indorbp, i)) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp489b4 - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp489b4 - rb(i) = rb(i) - rmu(ic, i)*distp(i, 1)*2*r(i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=indtm,indtmin,-1 - temp489b3 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp489b3 - rb(k) = rb(k) - dd2*2*r(k)*temp489b3 + temp459 = r(k)**3 + temp459b1 = -(distpb(k, 1)/(dd2*temp459+1.d0)**2) + dd2b = dd2b + temp459*temp459b1 + rb(k) = rb(k) + dd2*3*r(k)**2*temp459b1 distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (147) -! 3d single gaussian + CASE (62) dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c=2.d0/pi**0.75d0*(2.d0*dd1)**1.75d0/dsqrt(5.d0) + c = dd1**1.75d0*1.2749263037197753d0 +! endif DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k)**2)) - END DO - DO i=indtmin,indtm - distp(i, 3) = distp(i, 1) - distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d - distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d - distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO -! indorbp=indorb - DO ic=1,5 +! indorbp=indorb +! + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 3) - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = ((2.d0*dd1*r(0))**2-2.d0*dd1)*distp(0, 1) -! indorbp=indorb - DO ic=1,5 + fun0 = distp(0, 1)*r(0) + cost = 2.d0*dd1*r(0)**2 + fun = distp(0, 1)*(1.d0-cost)/r(0) + fun2 = 2.d0*dd1*fun0*(cost-3.d0) +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - IF (ic .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) - ELSE IF (ic .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (ic .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE IF (ic .EQ. 4) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (ic .EQ. 5) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=5,1,-1 - temp490b5 = distp(0, 3+ic)*zb(indorbp, indt+4) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 6.d0*temp490b5 - fun2b = fun2b + temp490b5 + DO ic=3,1,-1 + temp463b1 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp463b1 + fun2b = fun2b + temp463b1 zb(indorbp, indt+4) = 0.0_8 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - IF (branch .LT. 1) THEN - temp490b0 = cost1d*4.d0*zb(indorbp, indt+3) - rmub(3, 0) = rmub(3, 0) + fun0*temp490b0 - temp490b1 = -(cost1d*2.d0*zb(indorbp, indt+2)) - temp490b2 = -(cost1d*2.d0*zb(indorbp, indt+1)) - fun0b = fun0b + rmu(2, 0)*temp490b1 + rmu(1, 0)*temp490b2 & -& + rmu(3, 0)*temp490b0 - rmub(2, 0) = rmub(2, 0) + fun0*temp490b1 - rmub(1, 0) = rmub(1, 0) + fun0*temp490b2 - ELSE - temp490b3 = -(cost2d*2.d0*zb(indorbp, indt+2)) - rmub(2, 0) = rmub(2, 0) + fun0*temp490b3 - temp490b4 = cost2d*2.d0*zb(indorbp, indt+1) - fun0b = fun0b + rmu(1, 0)*temp490b4 + rmu(2, 0)*temp490b3 - rmub(1, 0) = rmub(1, 0) + fun0*temp490b4 - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+2) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+1) + & -& cost3d*rmu(1, 0)*zb(indorbp, indt+2) - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+1) - END IF - ELSE IF (branch .LT. 5) THEN - IF (branch .LT. 4) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+2) + & -& cost3d*rmu(2, 0)*zb(indorbp, indt+3) - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+2) - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+3) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+1) + cost3d*& -& rmu(1, 0)*zb(indorbp, indt+3) - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+1) - END IF DO i=3,1,-1 - temp490b = distp(0, 3+ic)*zb(indorbp, indt+i) - distpb(0, 3+ic) = distpb(0, 3+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp490b - funb = funb + rmu(i, 0)*temp490b + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp463b0 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp463b0 + funb0 = funb0 + rmu(ic, 0)*temp463b0 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp489 = 2.d0*dd1*r(0) - temp489b8 = distp(0, 1)*2*temp489*2.d0*fun2b - dd1b = r(0)*temp489b8 - distp(0, 1)*2.d0*fun2b - 2.d0*distp(0, 1)*& -& funb - rb(0) = rb(0) + dd1*temp489b8 - distpb(0, 1) = distpb(0, 1) + (temp489**2-2.d0*dd1)*fun2b - 2.d0*& -& dd1*funb - distpb(0, 3) = distpb(0, 3) + fun0b + temp463b = 2.d0*(cost-3.d0)*fun2b + temp462b0 = distp(0, 1)*funb0/r(0) + costb = 2.d0*dd1*fun0*fun2b - temp462b0 + dd1b = 2.d0*r(0)**2*costb + fun0*temp463b + fun0b = fun0b + dd1*temp463b + distpb = 0.0_8 + temp462 = (-cost+1.d0)/r(0) + distpb(0, 1) = r(0)*fun0b + temp462*funb0 + rb(0) = rb(0) + 2.d0*dd1*2*r(0)*costb + distp(0, 1)*fun0b - & +& temp462*temp462b0 ELSE distpb = 0.0_8 dd1b = 0.0_8 END IF - DO ic=5,1,-1 + DO ic=3,1,-1 DO i=indtm,i0,-1 - distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) - distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) + temp462b = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*r(i)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + r(i)*temp462b + rb(i) = rb(i) + distp(i, 1)*temp462b zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=indtm,indtmin,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) - distpb(i, 8) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) - distpb(i, 7) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - distpb(i, 1) = distpb(i, 1) + distpb(i, 3) - distpb(i, 3) = 0.0_8 - END DO + cb = 0.0_8 DO k=indtm,indtmin,-1 - temp489b7 = DEXP(-(dd1*r(k)**2))*distpb(k, 1) - dd1b = dd1b - r(k)**2*temp489b7 - rb(k) = rb(k) - dd1*2*r(k)*temp489b7 + temp461 = r(k)**2 + temp461b1 = c*DEXP(-(dd1*temp461))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp461))*distpb(k, 1) + dd1b = dd1b - temp461*temp461b1 + rb(k) = rb(k) - dd1*2*r(k)*temp461b1 distpb(k, 1) = 0.0_8 END DO + dd1b = dd1b + 1.2749263037197753d0*1.75d0*dd1**0.75D0*cb ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (148) -! derivative of 147 with respect to dd1 + CASE (42) +! derivative of 62 with respect zeta +! 4d without cusp and one parmater derivative of 30 dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c= & +! &1.d0/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) + c = dd1**3.5d0*0.26596152026762178d0 +! c= +! &1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) +! endif + c0 = -c + c1 = 3.5d0*c/dd1 DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k)**2)) + distp(k, 1) = DEXP(-(dd1*r(k))) END DO DO i=indtmin,indtm CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 3)) - distp(i, 3) = -(r(i)**2*distp(i, 1)) + distp(i, 3) = distp(i, 1)*(c0*r(i)+c1) CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 4)) +! lz=0 distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 5)) +! lz=+/ distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 6)) +! lz=+/-2 distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 7)) +! lz=+/-1 distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d CALL PUSHREAL8(adr8ibuf,adr8buf,distp(i, 8)) +! lz=+/-1 distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d END DO -! indorbp=indorb +! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN fun0 = distp(0, 3) - fun = 2.d0*(dd1*r(0)**2-1.d0)*r(0)*distp(0, 1) - fun2 = -(2.d0*(2.d0*dd1**2*r(0)**4+1.d0-5.d0*dd1*r(0)**2)*distp(0& -& , 1)) -! indorbp=indorb + fun = -(dd1*distp(0, 3)) + c0*distp(0, 1) + fun2 = dd1**2*distp(0, 3) - 2.d0*dd1*c0*distp(0, 1) +! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN @@ -20410,18 +20576,18 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=5,1,-1 - temp492 = fun/r(0) - temp493b = distp(0, 3+ic)*zb(indorbp, indt+4) - temp492b3 = 6.d0*temp493b/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp492+fun2)*zb(& + temp464 = fun/r(0) + temp465b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp464b3 = 6.d0*temp465b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp464+fun2)*zb(& & indorbp, indt+4) - funb = funb + temp492b3 - rb(0) = rb(0) - temp492*temp492b3 - fun2b = fun2b + temp493b + funb0 = funb0 + temp464b3 + rb(0) = rb(0) - temp464*temp464b3 + fun2b = fun2b + temp465b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -20429,24 +20595,24 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN IF (branch .LT. 2) THEN - temp492b = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp492b - fun0b = fun0b + rmu(i, 0)*temp492b + temp464b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp464b + fun0b = fun0b + rmu(i, 0)*temp464b ELSE - temp492b0 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp492b0 - fun0b = fun0b + rmu(i, 0)*temp492b0 + temp464b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp464b0 + fun0b = fun0b + rmu(i, 0)*temp464b0 END IF ELSE IF (branch .LT. 4) THEN - temp492b1 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp492b1 - fun0b = fun0b + rmu(i, 0)*temp492b1 + temp464b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp464b1 + fun0b = fun0b + rmu(i, 0)*temp464b1 END IF ELSE IF (branch .LT. 7) THEN IF (branch .LT. 6) THEN - temp492b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp492b2 - fun0b = fun0b + rmu(i, 0)*temp492b2 + temp464b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp464b2 + fun0b = fun0b + rmu(i, 0)*temp464b2 ELSE rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) @@ -20476,31 +20642,27 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp491 = fun/r(0) - temp491b = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) - distpb(0, 3+ic) = distpb(0, 3+ic) + temp491*rmu(i, 0)*zb(& + temp463 = fun/r(0) + temp463b6 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp463*rmu(i, 0)*zb(& & indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + temp491*distp(0, 3+ic)*zb(indorbp, & + rmub(i, 0) = rmub(i, 0) + temp463*distp(0, 3+ic)*zb(indorbp, & & indt+i) - funb = funb + temp491b - rb(0) = rb(0) - temp491*temp491b + funb0 = funb0 + temp463b6 + rb(0) = rb(0) - temp463*temp463b6 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp490 = r(0)**4 - temp490b7 = -(2.d0*distp(0, 1)*fun2b) - temp490b8 = 2.d0*r(0)*distp(0, 1)*funb - dd1b = r(0)**2*temp490b8 + (2.d0*temp490*2*dd1-5.d0*r(0)**2)*& -& temp490b7 - temp490b9 = 2.d0*(dd1*r(0)**2-1.d0)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp490b8 + distp(0, 1)*temp490b9 + (& -& 2.d0*dd1**2*4*r(0)**3-5.d0*dd1*2*r(0))*temp490b7 - distpb(0, 1) = distpb(0, 1) + r(0)*temp490b9 - 2.d0*(2.d0*(dd1**2*& -& temp490)-5.d0*(dd1*r(0)**2)+1.d0)*fun2b - distpb(0, 3) = distpb(0, 3) + fun0b + temp463b5 = -(2.d0*distp(0, 1)*fun2b) + dd1b = c0*temp463b5 - distp(0, 3)*funb0 + distp(0, 3)*2*dd1*fun2b + distpb(0, 3) = distpb(0, 3) + dd1**2*fun2b + c0b = distp(0, 1)*funb0 + dd1*temp463b5 + distpb(0, 1) = distpb(0, 1) + c0*funb0 - 2.d0*dd1*c0*fun2b + distpb(0, 3) = distpb(0, 3) + fun0b - dd1*funb0 ELSE distpb = 0.0_8 + c0b = 0.0_8 dd1b = 0.0_8 END IF DO ic=5,1,-1 @@ -20511,6 +20673,7 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + c1b = 0.0_8 DO i=indtm,indtmin,-1 CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 8)) rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) @@ -20533,84 +20696,275 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) distpb(i, 4) = 0.0_8 CALL POPREAL8(adr8ibuf,adr8buf,distp(i, 3)) - rb(i) = rb(i) - distp(i, 1)*2*r(i)*distpb(i, 3) - distpb(i, 1) = distpb(i, 1) - r(i)**2*distpb(i, 3) + temp463b4 = distp(i, 1)*distpb(i, 3) + distpb(i, 1) = distpb(i, 1) + (c0*r(i)+c1)*distpb(i, 3) + c0b = c0b + r(i)*temp463b4 + rb(i) = rb(i) + c0*temp463b4 + c1b = c1b + temp463b4 distpb(i, 3) = 0.0_8 END DO DO k=indtm,indtmin,-1 - temp490b6 = DEXP(-(dd1*r(k)**2))*distpb(k, 1) - dd1b = dd1b - r(k)**2*temp490b6 - rb(k) = rb(k) - dd1*2*r(k)*temp490b6 + temp463b3 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp463b3 + rb(k) = rb(k) - dd1*temp463b3 + distpb(k, 1) = 0.0_8 + END DO + temp463b2 = 3.5d0*c1b/dd1 + cb = temp463b2 - c0b + dd1b = dd1b + 0.26596152026762178d0*3.5d0*dd1**2.5D0*cb - c*& +& temp463b2/dd1 + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (4) +! normalized +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) +! if(iflagnorm.gt.2) then + c = dd1**2.5d0/DSQRT(3.d0*pi*(1.d0+dd2**2/3.d0)) +! endif + DO k=indtmin,indtm + distp(k, 1) = c*DEXP(-(dd1*r(k))) + END DO + IF (typec .NE. 1) THEN + fun = distp(0, 1)*(1.d0-dd1*r(0)) + funp = -(dd2*dd1*distp(0, 1)*rmu(3, 0)) + temp468b = zb(indorbp, indt+4)/r(0) + funb0 = 2.d0*temp468b + funpb = 4.d0*temp468b + rb(0) = rb(0) - (2.d0*fun+4.d0*funp)*temp468b/r(0) + fun2b = zb(indorbp, indt+4) + fun2pb = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + distpb = 0.0_8 + dd2b = distp(0, 1)*zb(indorbp, indt+3) + distpb(0, 1) = dd2*zb(indorbp, indt+3) + DO i=3,1,-1 + temp467b6 = rmu(i, 0)*zb(indorbp, indt+i)/r(0) + temp467 = (fun+funp)/r(0) + funb0 = funb0 + temp467b6 + funpb = funpb + temp467b6 + rb(0) = rb(0) - temp467*temp467b6 + rmub(i, 0) = rmub(i, 0) + temp467*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + temp467b1 = dd2*distp(0, 1)*fun2pb + temp467b2 = dd1**2*rmu(3, 0)*fun2pb + temp467b3 = distp(0, 1)*fun2b + temp467b4 = -(distp(0, 1)*rmu(3, 0)*funpb) + dd1b = (r(0)*2*dd1-2.d0)*temp467b3 - distp(0, 1)*r(0)*funb0 + dd2*& +& temp467b4 + rmu(3, 0)*2*dd1*temp467b1 + temp467b5 = -(dd2*dd1*funpb) + rmub(3, 0) = rmub(3, 0) + distp(0, 1)*temp467b5 + dd1**2*temp467b1 + dd2b = dd2b + dd1*temp467b4 + distp(0, 1)*temp467b2 + distpb(0, 1) = distpb(0, 1) + (dd1**2*r(0)-2.d0*dd1)*fun2b + (1.d0& +& -dd1*r(0))*funb0 + rmu(3, 0)*temp467b5 + dd2*temp467b2 + rb(0) = rb(0) + dd1**2*temp467b3 - distp(0, 1)*dd1*funb0 + ELSE + distpb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 + END IF + DO i=indtm,i0,-1 + temp467b0 = distp(i, 1)*zb(indorbp, i) + rb(i) = rb(i) + temp467b0 + dd2b = dd2b + rmu(3, i)*temp467b0 + rmub(3, i) = rmub(3, i) + dd2*temp467b0 + distpb(i, 1) = distpb(i, 1) + (r(i)+dd2*rmu(3, i))*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + cb = 0.0_8 + DO k=indtm,indtmin,-1 + temp467b = c*DEXP(-(dd1*r(k)))*distpb(k, 1) + cb = cb + DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp467b + rb(k) = rb(k) - dd1*temp467b distpb(k, 1) = 0.0_8 END DO + temp466 = 3.d0*pi*(dd2**2/3.d0+1.d0) + temp465 = DSQRT(temp466) + dd1b = dd1b + 2.5d0*dd1**1.5D0*cb/temp465 + IF (.NOT.temp466 .EQ. 0.0) dd2b = dd2b - dd1**2.5d0*pi*2*dd2*cb/(& +& temp465**2*2.D0*DSQRT(temp466)) + ddb(indpar+2) = ddb(indpar+2) + dd2b ddb(indpar+1) = ddb(indpar+1) + dd1b - CASE (149) -! derivative of 131 with respect z_1 -! - r^4 exp(-z_1 r^2) + CASE (137) +! 2s single Z NO CUSP +! 2s with cusp condition +! dd1*(exp(-dd2*r)*(1+dd2*r)) dd2 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! c=1.d0/dsqrt(1/4.d0/dd2**3+12*dd2/(2.d0*dd2)**4+ +! &3*dd2**2/4/dd2**5)/dsqrt(4.0*pi) +! endif indorbp = indorb + 1 DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k)*r(k))) + distp(k, 1) = DEXP(-(dd2*r(k))) END DO -! endif +! endif IF (typec .NE. 1) THEN - fun0 = dd2*r(0)**2 - fun = -(2.d0*r(0)**2*distp(0, 1)*(2.d0-fun0)) - funb = 2.d0*zb(indorbp, indt+4) + fun = -(dd2**2*distp(0, 1)) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO + funb0 = funb0 + (1.d0-dd2*r(0))*fun2b + dd2b = -(distp(0, 1)*2*dd2*funb0) - fun*r(0)*fun2b + rb(0) = rb(0) - fun*dd2*fun2b distpb = 0.0_8 - temp493b1 = -(2.d0*(2.d0*fun0**2-9.d0*fun0+6.d0)*fun2b) - temp493b2 = -(2.d0*r(0)**2*distp(0, 1)*fun2b) - temp493b3 = -(2.d0*r(0)**2*funb) - fun0b = (2.d0*2*fun0-9.d0)*temp493b2 - distp(0, 1)*temp493b3 - rb(0) = rb(0) + dd2*2*r(0)*fun0b - 2.d0*distp(0, 1)*(2.d0-fun0)*2*& -& r(0)*funb + distp(0, 1)*2*r(0)*temp493b1 - distpb(0, 1) = (2.d0-fun0)*temp493b3 + r(0)**2*temp493b1 - dd2b = r(0)**2*fun0b + distpb(0, 1) = -(dd2**2*funb0) ELSE distpb = 0.0_8 dd2b = 0.0_8 END IF DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) - r(i)**4*zb(indorbp, i) - rb(i) = rb(i) - distp(i, 1)*4*r(i)**3*zb(indorbp, i) + temp468b1 = distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + (dd2*r(i)+1.d0)*zb(indorbp, i) + dd2b = dd2b + r(i)*temp468b1 + rb(i) = rb(i) + dd2*temp468b1 zb(indorbp, i) = 0.0_8 END DO DO k=indtm,indtmin,-1 - temp493b0 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp493b0 - rb(k) = rb(k) - dd2*2*r(k)*temp493b0 + temp468b0 = DEXP(-(dd2*r(k)))*distpb(k, 1) + dd2b = dd2b - r(k)*temp468b0 + rb(k) = rb(k) - dd2*temp468b0 distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (150) -! 2p single exponential r e^{-z r^2} + CASE (8) +! s orbital +! +! - angmom = 0 +! - type = Gaussian +! - normalized = yes +! - angtype = spherical +! - npar = 2 +! - multiplicity = 1 +! +! = exp(-dd1*r) + (dd1-zeta) * r * exp(-dd2*r) +! +! 2s double Z WITH CUSP +! + indorbp = indorb + 1 + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd1 - zeta(1) + DO k=indtmin,indtm + distp(k, 1) = DEXP(-(dd1*r(k))) + distp(k, 2) = DEXP(-(dd2*r(k))) + END DO + c = 1.d0/DSQRT(1.d0/4.d0/dd1**3+12.d0*peff/(dd1+dd2)**4+3*peff**2/4/& +& dd2**5)/DSQRT(4.0*pi) + IF (typec .NE. 1) THEN + fun = -(dd1*distp(0, 1)) + peff*distp(0, 2)*(1.d0-dd2*r(0)) + fun2 = distp(0, 1)*dd1**2 + peff*distp(0, 2)*(dd2**2*r(0)-2.d0*dd2& +& ) + temp476 = fun/r(0) + temp476b = c*2.d0*zb(indorbp, indt+4)/r(0) + cb = (2.d0*temp476+fun2)*zb(indorbp, indt+4) + funb0 = temp476b + rb(0) = rb(0) - temp476*temp476b + fun2b = c*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + temp475 = rmu(i, 0)/r(0) + temp475b5 = fun*c*zb(indorbp, indt+i)/r(0) + funb0 = funb0 + temp475*c*zb(indorbp, indt+i) + cb = cb + temp475*fun*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp475b5 + rb(0) = rb(0) - temp475*temp475b5 + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp475b1 = (dd2**2*r(0)-2.d0*dd2)*fun2b + temp475b2 = peff*distp(0, 2)*fun2b + distpb(0, 1) = dd1**2*fun2b + dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb0 + temp475b3 = (1.d0-dd2*r(0))*funb0 + peffb = distp(0, 2)*temp475b3 + distp(0, 2)*temp475b1 + distpb(0, 2) = peff*temp475b3 + peff*temp475b1 + temp475b4 = peff*distp(0, 2)*funb0 + dd2b = (r(0)*2*dd2-2.d0)*temp475b2 - r(0)*temp475b4 + rb(0) = rb(0) + dd2**2*temp475b2 - dd2*temp475b4 + distpb(0, 1) = distpb(0, 1) - dd1*funb0 + ELSE + distpb = 0.0_8 + peffb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 + cb = 0.0_8 + END IF + DO i=indtm,i0,-1 + temp475b = c*zb(indorbp, i) + temp475b0 = distp(i, 2)*temp475b + cb = cb + (distp(i, 1)+r(i)*peff*distp(i, 2))*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp475b + rb(i) = rb(i) + peff*temp475b0 + peffb = peffb + r(i)*temp475b0 + distpb(i, 2) = distpb(i, 2) + r(i)*peff*temp475b + zb(indorbp, i) = 0.0_8 + END DO + temp474 = 4*dd2**5 + temp468 = peff**2/temp474 + temp473 = (dd1+dd2)**4 + temp472 = 4.d0*dd1**3 + temp469 = 1.0/temp472 + 12.d0*peff/temp473 + 3*temp468 + temp471 = DSQRT(temp469) + temp470 = DSQRT(4.0*pi) + IF (temp469 .EQ. 0.0) THEN + temp469b = 0.0 + ELSE + temp469b = -(cb/(temp470*temp471**2*2.D0*DSQRT(temp469))) + END IF + temp469b0 = 12.d0*temp469b/temp473 + temp469b1 = -(peff*4*(dd1+dd2)**3*temp469b0/temp473) + temp468b4 = 3*temp469b/temp474 + dd1b = dd1b + temp469b1 - 4.d0*3*dd1**2*temp469b/temp472**2 + peffb = peffb + 2*peff*temp468b4 + temp469b0 + dd2b = dd2b + temp469b1 - temp468*4*5*dd2**4*temp468b4 + DO k=indtm,indtmin,-1 + temp468b2 = DEXP(-(dd2*r(k)))*distpb(k, 2) + dd2b = dd2b - r(k)*temp468b2 + distpb(k, 2) = 0.0_8 + temp468b3 = DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) - dd1*temp468b3 - dd2*temp468b2 + dd1b = dd1b - r(k)*temp468b3 + distpb(k, 1) = 0.0_8 + END DO + dd1b = dd1b + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (109) +! 2p double Lorentian +! dd1 * x_mu (L(dd2 r^2)+dd3 * L(dd4*r^2)) ; L(x)=1/(1+x^2) dd2 = dd(indpar+1) + dd3 = dd(indpar+2) + dd4 = dd(indpar+3) DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k)**2)) + distp(k, 1) = 1.d0/(1.d0+dd2*r(k)**2) + distp(k, 2) = 1.d0/(1.d0+dd4*r(k)**2) END DO -! indorbp=indorb +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - fun0 = distp(0, 1)*r(0) - cost = 2.d0*dd2*r(0)**2 - fun = distp(0, 1)*(1.d0-cost)/r(0) - fun2 = 2.d0*dd2*fun0*(cost-3.d0) -! indorbp=indorb + fun = 2.d0*(-(dd2*distp(0, 1)**2)-dd4*dd3*distp(0, 2)**2) +! fun2=2.d0*(dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0,1) +! 1+dd4*dd3*(-1.d0+2.d0*dd4*r(0)**2)*distp(0,2)) + fun2 = 2*dd2*distp(0, 1)**3*(-1.d0+3.d0*dd2*r(0)**2) + 2*dd3*dd4*& +& distp(0, 2)**3*(-1.d0+3.d0*dd4*r(0)**2) +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -20620,78 +20974,98 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp494b1 = rmu(ic, 0)*zb(indorbp, indt+4) + temp481b0 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp494b1 - fun2b = fun2b + temp494b1 + funb0 = funb0 + 4.d0*temp481b0 + fun2b = fun2b + temp481b0 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp494b0 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp494b0 - funb = funb + rmu(ic, 0)*temp494b0 + temp481b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp481b + funb0 = funb0 + rmu(ic, 0)*temp481b rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp494b = 2.d0*(cost-3.d0)*fun2b - temp493b6 = distp(0, 1)*funb/r(0) - costb = 2.d0*dd2*fun0*fun2b - temp493b6 - dd2b = 2.d0*r(0)**2*costb + fun0*temp494b - fun0b = fun0b + dd2*temp494b distpb = 0.0_8 - temp493 = (-cost+1.d0)/r(0) - distpb(0, 1) = r(0)*fun0b + temp493*funb - rb(0) = rb(0) + 2.d0*dd2*2*r(0)*costb + distp(0, 1)*fun0b - & -& temp493*temp493b6 + temp480 = distp(0, 1)**3 + temp480b = 2*(3.d0*(dd2*r(0)**2)-1.d0)*fun2b + temp480b0 = 2*dd2*temp480*3.d0*fun2b + temp479 = distp(0, 2)**3 + temp479b0 = 2*(3.d0*(dd4*r(0)**2)-1.d0)*fun2b + temp479b1 = 2*dd3*dd4*temp479*3.d0*fun2b + temp479b2 = 2.d0*funb0 + dd2b = r(0)**2*temp480b0 - distp(0, 1)**2*temp479b2 + temp480*& +& temp480b + distpb(0, 1) = dd2*3*distp(0, 1)**2*temp480b + rb(0) = rb(0) + dd4*2*r(0)*temp479b1 + dd2*2*r(0)*temp480b0 + temp479b3 = -(distp(0, 2)**2*temp479b2) + dd3b = dd4*temp479b3 + distp(0, 2)*fun0b + temp479*dd4*temp479b0 + dd4b = dd3*temp479b3 + r(0)**2*temp479b1 + temp479*dd3*temp479b0 + distpb(0, 2) = dd3*dd4*3*distp(0, 2)**2*temp479b0 + distpb(0, 1) = distpb(0, 1) - dd2*2*distp(0, 1)*temp479b2 + distpb(0, 2) = distpb(0, 2) - dd4*dd3*2*distp(0, 2)*temp479b2 + distpb(0, 1) = distpb(0, 1) + fun0b + distpb(0, 2) = distpb(0, 2) + dd3*fun0b ELSE distpb = 0.0_8 dd2b = 0.0_8 + dd3b = 0.0_8 + dd4b = 0.0_8 END IF DO ic=3,1,-1 DO i=indtm,i0,-1 - temp493b5 = rmu(ic, i)*zb(indorbp, i) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*r(i)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + r(i)*temp493b5 - rb(i) = rb(i) + distp(i, 1)*temp493b5 + temp479b = rmu(ic, i)*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + (distp(i, 1)+dd3*distp(i, 2))*zb(& +& indorbp, i) + distpb(i, 1) = distpb(i, 1) + temp479b + dd3b = dd3b + distp(i, 2)*temp479b + distpb(i, 2) = distpb(i, 2) + dd3*temp479b zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=indtm,indtmin,-1 - temp493b4 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp493b4 - rb(k) = rb(k) - dd2*2*r(k)*temp493b4 + temp478 = dd4*r(k)**2 + 1.d0 + temp478b = -(distpb(k, 2)/temp478**2) + dd4b = dd4b + r(k)**2*temp478b + distpb(k, 2) = 0.0_8 + temp477 = dd2*r(k)**2 + 1.d0 + temp477b = -(distpb(k, 1)/temp477**2) + rb(k) = rb(k) + dd2*2*r(k)*temp477b + dd4*2*r(k)*temp478b + dd2b = dd2b + r(k)**2*temp477b distpb(k, 1) = 0.0_8 END DO + ddb(indpar+3) = ddb(indpar+3) + dd4b + ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (151) -! 2p single exponential -r^3 e^{-z r^2} ! parent of 150 + CASE (112) +! 2p single r_mu/(1+b r)^3 parent of 103 dd2 = dd(indpar+1) DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k)**2)) + distp(k, 1) = 1.d0/(1.d0+dd2*r(k))**3 END DO -! indorbp=indorb +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - cost = dd2*r(0)**2 - fun = distp(0, 1)*(-3.d0+2.d0*cost)*r(0) - fun2 = -(2.d0*distp(0, 1)*r(0)*(3.d0-7.d0*cost+2.d0*cost**2)) -! indorbp=indorb + fun = -(3.d0*dd2*distp(0, 1)/(r(0)*(1.d0+dd2*r(0)))) + fun2 = 12.d0*dd2**2/(1.+dd2*r(0))**5 +! indorbp=indorb DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (i .EQ. ic) THEN @@ -20701,1027 +21075,601 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END IF END DO END DO - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=3,1,-1 - temp494b8 = rmu(ic, 0)*zb(indorbp, indt+4) + temp485b0 = rmu(ic, 0)*zb(indorbp, indt+4) rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp494b8 - fun2b = fun2b + temp494b8 + funb0 = funb0 + 4.d0*temp485b0 + fun2b = fun2b + temp485b0 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp494b7 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp494b7 - funb = funb + rmu(ic, 0)*temp494b7 + temp485b = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp485b + funb0 = funb0 + rmu(ic, 0)*temp485b rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp494b4 = -(2.d0*(2.d0*cost**2-7.d0*cost+3.d0)*fun2b) - temp494b5 = -(2.d0*distp(0, 1)*r(0)*fun2b) - temp494b6 = (2.d0*cost-3.d0)*funb - distpb(0, 1) = r(0)*temp494b6 - r(0)**3*fun0b + r(0)*temp494b4 - costb = distp(0, 1)*r(0)*2.d0*funb + (2.d0*2*cost-7.d0)*temp494b5 - rb(0) = rb(0) + distp(0, 1)*temp494b6 - distp(0, 1)*3*r(0)**2*& -& fun0b + dd2*2*r(0)*costb + distp(0, 1)*temp494b4 - dd2b = r(0)**2*costb + temp484 = (dd2*r(0)+1.)**5 + temp484b = 12.d0*fun2b/temp484 + temp484b0 = -(dd2**2*5*(dd2*r(0)+1.)**4*temp484b/temp484) + temp483 = dd2*r(0) + 1.d0 + temp483b = -(3.d0*funb0/(r(0)*temp483)) + temp483b0 = -(dd2*distp(0, 1)*temp483b/(r(0)*temp483)) + dd2b = distp(0, 1)*temp483b + r(0)**2*temp483b0 + r(0)*temp484b0 +& +& 2*dd2*temp484b + rb(0) = rb(0) + (r(0)*dd2+temp483)*temp483b0 + dd2*temp484b0 + distpb = 0.0_8 + distpb(0, 1) = fun0b + dd2*temp483b ELSE distpb = 0.0_8 dd2b = 0.0_8 END IF DO ic=3,1,-1 DO i=indtm,i0,-1 - temp494b3 = -(r(i)**3*zb(indorbp, i)) - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp494b3 - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp494b3 - rb(i) = rb(i) - rmu(ic, i)*distp(i, 1)*3*r(i)**2*zb(indorbp, i) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO DO k=indtm,indtmin,-1 - temp494b2 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) - dd2b = dd2b - r(k)**2*temp494b2 - rb(k) = rb(k) - dd2*2*r(k)*temp494b2 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (152) -! 2s with cusp condition -! ( r^3*exp(-dd2*r^2)) ! with no cusp condition - dd2 = dd(indpar+1) - indorbp = indorb + 1 - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k)**2))*r(k) - END DO -! endif - IF (typec .NE. 1) THEN - rp1 = r(0)**2*dd2 - fun = (3.d0-2.d0*rp1)*distp(0, 1) - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - rp1b = (distp(0, 1)*4.d0*2*rp1-distp(0, 1)*14.d0)*fun2b - distp(0& -& , 1)*2.d0*funb - distpb(0, 1) = (3.d0-2.d0*rp1)*funb + (4.d0*rp1**2-14.d0*rp1+6.d0)& -& *fun2b - rb(0) = rb(0) + dd2*2*r(0)*rp1b - dd2b = r(0)**2*rp1b - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) - rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=indtm,indtmin,-1 - temp494 = r(k)**2 - temp494b9 = r(k)*DEXP(-(dd2*temp494))*distpb(k, 1) - dd2b = dd2b - temp494*temp494b9 - rb(k) = rb(k) + DEXP(-(dd2*temp494))*distpb(k, 1) - dd2*2*r(k)*& -& temp494b9 + temp481 = dd2*r(k) + 1.d0 + temp482 = temp481**3 + temp481b1 = -(3*temp481**2*distpb(k, 1)/temp482**2) + dd2b = dd2b + r(k)*temp481b1 + rb(k) = rb(k) + dd2*temp481b1 distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (153) -! 2s with cusp condition -! (-r^5*exp(-dd2*r^2)) ! derivative of 152 + CASE (151) +! 2p single exponential -r^3 e^{-z r^2} ! parent of 150 dd2 = dd(indpar+1) - indorbp = indorb + 1 - DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd2*r(k)**2))*r(k)**3 - END DO -! endif - IF (typec .NE. 1) THEN - rp1 = dd2*r(0)**2 - fun = (-5.d0+2.d0*rp1)*distp(0, 1) - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - distpb = 0.0_8 - rp1b = distp(0, 1)*2.d0*funb + (distp(0, 1)*22.d0-distp(0, 1)*4.d0& -& *2*rp1)*fun2b - distpb(0, 1) = (2.d0*rp1-5.d0)*funb + (22.d0*rp1-4.d0*rp1**2-20.d0& -& )*fun2b - dd2b = r(0)**2*rp1b - rb(0) = rb(0) + dd2*2*r(0)*rp1b - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) - r(i)**2*zb(indorbp, i) - rb(i) = rb(i) - distp(i, 1)*2*r(i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - DO k=indtm,indtmin,-1 - temp495 = r(k)**2 - temp495b = r(k)**3*DEXP(-(dd2*temp495))*distpb(k, 1) - dd2b = dd2b - temp495*temp495b - rb(k) = rb(k) + DEXP(-(dd2*temp495))*3*r(k)**2*distpb(k, 1) - dd2*& -& 2*r(k)*temp495b - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (154) -! Jastrow single gaussian f orbital -! R(r)= exp(-alpha r^2) -! unnormalized -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k)**2)) - END DO - DO i=indtmin,indtm - distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) -! lz=0 - distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) -! lz=+/-2 - distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) -! lz=+/-2 - distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) -! lz=+/-3 - distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) + distp(k, 1) = DEXP(-(dd2*r(k)**2)) END DO -! lz=+/-3 - DO ic=1,7 +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN -! dd1=dd(indparp) - fun0 = distp(0, 1) - fun = -(2.d0*dd1*distp(0, 1)) - fun2 = fun*(1.d0-2.d0*dd1*r(0)**2) -! indorbp=indorb - DO ic=1,7 + cost = dd2*r(0)**2 + fun = distp(0, 1)*(-3.d0+2.d0*cost)*r(0) + fun2 = -(2.d0*distp(0, 1)*r(0)*(3.d0-7.d0*cost+2.d0*cost**2)) +! indorbp=indorb + DO ic=1,3 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic - IF (ic .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) - ELSE IF (ic .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE IF (ic .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE IF (ic .EQ. 4) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (ic .EQ. 5) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - ELSE IF (ic .EQ. 6) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - END IF + DO i=1,3 + IF (i .EQ. ic) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + END IF + END DO END DO - distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=7,1,-1 - temp496b29 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 8.d0*temp496b29 - fun2b = fun2b + temp496b29 - zb(indorbp, indt+4) = 0.0_8 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 4) THEN - IF (branch .LT. 2) THEN - IF (branch .LT. 1) THEN - temp496b10 = cost1f*zb(indorbp, indt+3) - temp496b11 = -(cost1f*6.d0*zb(indorbp, indt+2)) - temp496b12 = -(cost1f*6.d0*zb(indorbp, indt+1)) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp496b11 + rmu(3, 0)& -& *rmu(1, 0)*temp496b12 + (9.d0*rmu(3, 0)**2-3.d0*r(0)**2)& -& *temp496b10 - rmub(3, 0) = rmub(3, 0) + fun0*9.d0*2*rmu(3, 0)*temp496b10 - rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp496b10 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp496b11 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp496b11 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp496b12 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp496b12 - ELSE - temp496b13 = cost2f*8.d0*zb(indorbp, indt+3) - temp496b14 = -(cost2f*2.d0*zb(indorbp, indt+2)) - fun0b = fun0b + rmu(1, 0)*rmu(2, 0)*temp496b14 + cost2f*(& -& 5.d0*rmu(3, 0)**2-r(0)**2-2.d0*rmu(1, 0)**2)*zb(indorbp& -& , indt+1) + rmu(1, 0)*rmu(3, 0)*temp496b13 - rmub(3, 0) = rmub(3, 0) + rmu(1, 0)*fun0*temp496b13 - rmub(1, 0) = rmub(1, 0) + fun0*rmu(3, 0)*temp496b13 - rmub(2, 0) = rmub(2, 0) + rmu(1, 0)*fun0*temp496b14 - rmub(1, 0) = rmub(1, 0) + fun0*rmu(2, 0)*temp496b14 - temp496b15 = cost2f*fun0*zb(indorbp, indt+1) - rmub(3, 0) = rmub(3, 0) + 5.d0*2*rmu(3, 0)*temp496b15 - rb(0) = rb(0) - 2*r(0)*temp496b15 - rmub(1, 0) = rmub(1, 0) - 2.d0*2*rmu(1, 0)*temp496b15 - END IF - ELSE IF (branch .LT. 3) THEN - temp496b16 = cost2f*8.d0*zb(indorbp, indt+3) - temp496b17 = -(cost2f*2.d0*zb(indorbp, indt+1)) - fun0b = fun0b + cost2f*(5.d0*rmu(3, 0)**2-r(0)**2-2.d0*rmu(2& -& , 0)**2)*zb(indorbp, indt+2) + rmu(2, 0)*rmu(1, 0)*& -& temp496b17 + rmu(2, 0)*rmu(3, 0)*temp496b16 - rmub(3, 0) = rmub(3, 0) + rmu(2, 0)*fun0*temp496b16 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(3, 0)*temp496b16 - temp496b18 = cost2f*fun0*zb(indorbp, indt+2) - rmub(3, 0) = rmub(3, 0) + 5.d0*2*rmu(3, 0)*temp496b18 - rb(0) = rb(0) - 2*r(0)*temp496b18 - rmub(2, 0) = rmub(2, 0) - 2.d0*2*rmu(2, 0)*temp496b18 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp496b17 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp496b17 - ELSE - temp496b19 = cost3f*zb(indorbp, indt+3) - temp496b20 = -(cost3f*2.d0*zb(indorbp, indt+2)) - temp496b21 = cost3f*2.d0*zb(indorbp, indt+1) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp496b20 + rmu(3, 0)*& -& rmu(1, 0)*temp496b21 + (rmu(1, 0)**2-rmu(2, 0)**2)*& -& temp496b19 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp496b19 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp496b20 - fun0*2& -& *rmu(2, 0)*temp496b19 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp496b20 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp496b21 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp496b21 - END IF - ELSE IF (branch .LT. 6) THEN - IF (branch .LT. 5) THEN - temp496b22 = cost3f*2.d0*zb(indorbp, indt+3) - temp496b23 = cost3f*2.d0*zb(indorbp, indt+2) - temp496b24 = cost3f*2.d0*zb(indorbp, indt+1) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp496b23 + rmu(3, 0)*& -& rmu(2, 0)*temp496b24 + rmu(2, 0)*rmu(1, 0)*temp496b22 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp496b22 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp496b22 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp496b23 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp496b23 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp496b24 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp496b24 - ELSE - temp496b25 = -(cost4f*6.d0*zb(indorbp, indt+2)) - temp496b26 = cost4f*3.d0*zb(indorbp, indt+1) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp496b26 + rmu& -& (2, 0)*rmu(1, 0)*temp496b25 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp496b25 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp496b25 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp496b26 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp496b26 - END IF - ELSE - temp496b27 = cost4f*3.d0*zb(indorbp, indt+2) - temp496b28 = cost4f*6.d0*zb(indorbp, indt+1) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp496b28 + (rmu(1, 0)**2& -& -rmu(2, 0)**2)*temp496b27 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp496b27 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp496b27 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp496b28 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp496b28 - END IF + DO ic=3,1,-1 + temp485b7 = rmu(ic, 0)*zb(indorbp, indt+4) + rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) + funb0 = funb0 + 4.d0*temp485b7 + fun2b = fun2b + temp485b7 + zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 - temp496b9 = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp496b9 - funb = funb + rmu(i, 0)*temp496b9 + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) + temp485b6 = rmu(i, 0)*zb(indorbp, indt+i) + rmub(ic, 0) = rmub(ic, 0) + fun*temp485b6 + funb0 = funb0 + rmu(ic, 0)*temp485b6 + rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp496b8 = -(fun*2.d0*fun2b) - funb = funb + (1.d0-2.d0*(dd1*r(0)**2))*fun2b - dd1b = r(0)**2*temp496b8 - 2.d0*distp(0, 1)*funb - rb(0) = rb(0) + dd1*2*r(0)*temp496b8 - distpb(0, 1) = distpb(0, 1) + fun0b - 2.d0*dd1*funb + distpb = 0.0_8 + temp485b3 = -(2.d0*(2.d0*cost**2-7.d0*cost+3.d0)*fun2b) + temp485b4 = -(2.d0*distp(0, 1)*r(0)*fun2b) + temp485b5 = (2.d0*cost-3.d0)*funb0 + distpb(0, 1) = r(0)*temp485b5 - r(0)**3*fun0b + r(0)*temp485b3 + costb = distp(0, 1)*r(0)*2.d0*funb0 + (2.d0*2*cost-7.d0)*temp485b4 + rb(0) = rb(0) + distp(0, 1)*temp485b5 - distp(0, 1)*3*r(0)**2*& +& fun0b + dd2*2*r(0)*costb + distp(0, 1)*temp485b3 + dd2b = r(0)**2*costb ELSE distpb = 0.0_8 - dd1b = 0.0_8 + dd2b = 0.0_8 END IF - DO ic=7,1,-1 - DO k=indtm,i0,-1 - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*zb(indorbp, k) - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*zb(indorbp, k) - zb(indorbp, k) = 0.0_8 + DO ic=3,1,-1 + DO i=indtm,i0,-1 + temp485b2 = -(r(i)**3*zb(indorbp, i)) + rmub(ic, i) = rmub(ic, i) + distp(i, 1)*temp485b2 + distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*temp485b2 + rb(i) = rb(i) - rmu(ic, i)*distp(i, 1)*3*r(i)**2*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - DO i=indtm,indtmin,-1 - temp496b0 = cost4f*rmu(2, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 8) - 2*rmu(2, i)*temp496b0 - distpb(i, 8) = 0.0_8 - temp496b1 = cost4f*rmu(1, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& -& distpb(i, 7) + 2*rmu(1, i)*temp496b1 + 3.d0*2*rmu(1, i)*& -& temp496b0 - rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp496b1 - distpb(i, 7) = 0.0_8 - temp496b2 = cost3f*2.d0*distpb(i, 6) - temp496b3 = rmu(2, i)*temp496b2 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp496b3 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp496b3 - rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp496b2 - distpb(i, 6) = 0.0_8 - temp496b4 = cost3f*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 5) - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp496b4 - distpb(i, 5) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 4) - 2*rmu(2, i)*temp496b4 - temp496b5 = cost2f*rmu(2, i)*distpb(i, 4) - rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp496b5 - distpb(i, 4) = 0.0_8 - temp496b6 = cost2f*rmu(1, i)*distpb(i, 3) - rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 3) - distpb(i, 3) = 0.0_8 - temp496b7 = cost1f*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - 2*r(i)*temp496b6 - 3.d0*2*r(i)*temp496b7 - 2*r(i)*& -& temp496b5 - rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& -& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp496b7 + 5.d0*2*rmu(3, i)*& -& temp496b6 - distpb(i, 2) = 0.0_8 - END DO DO k=indtm,indtmin,-1 - temp496b = DEXP(-(dd1*r(k)**2))*distpb(k, 1) - dd1b = dd1b - r(k)**2*temp496b - rb(k) = rb(k) - dd1*2*r(k)*temp496b + temp485b1 = DEXP(-(dd2*r(k)**2))*distpb(k, 1) + dd2b = dd2b - r(k)**2*temp485b1 + rb(k) = rb(k) - dd2*2*r(k)*temp485b1 distpb(k, 1) = 0.0_8 END DO - ddb(indparp) = ddb(indparp) + dd1b - CASE (155) -! Jastrow single gaussian f orbital -! derivative of 154 with respect to z -! unnormalized f orbitals -! R(r)= -r^2*exp(-z r^2) -! indorbp=indorb - indparp = indpar + 1 - dd1 = dd(indparp) + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (127) +! 3d without cusp and one parmater + dd1 = dd(indpar+1) DO k=indtmin,indtm - distp(k, 1) = DEXP(-(dd1*r(k)**2)) + distp(k, 1) = DEXP(-(dd1*r(k))) END DO DO i=indtmin,indtm - distp(i, 2) = cost1f*rmu(3, i)*(5.d0*rmu(3, i)**2-3.d0*r(i)**2) -! lz=0 - distp(i, 3) = cost2f*rmu(1, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 4) = cost2f*rmu(2, i)*(5.d0*rmu(3, i)**2-r(i)**2) -! lz=+/-1 - distp(i, 5) = cost3f*rmu(3, i)*(rmu(1, i)**2-rmu(2, i)**2) -! lz=+/-2 - distp(i, 6) = cost3f*2.d0*rmu(3, i)*rmu(1, i)*rmu(2, i) -! lz=+/-2 - distp(i, 7) = cost4f*rmu(1, i)*(rmu(1, i)**2-3.d0*rmu(2, i)**2) -! lz=+/-3 - distp(i, 8) = cost4f*rmu(2, i)*(3.d0*rmu(1, i)**2-rmu(2, i)**2) + distp(i, 3) = distp(i, 1) + distp(i, 4) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d + distp(i, 5) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d + distp(i, 6) = rmu(1, i)*rmu(2, i)*cost3d + distp(i, 7) = rmu(2, i)*rmu(3, i)*cost3d + distp(i, 8) = rmu(1, i)*rmu(3, i)*cost3d END DO -! lz=+/-3 - DO ic=1,7 +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) - dd1 = dd(indparp) - fun0 = -(r(0)**2*distp(0, 1)) - fun = 2.d0*(dd1*r(0)**2-1.d0)*distp(0, 1) - fun2 = -(2.d0*(2.d0*dd1**2*r(0)**4+1.d0-5.d0*dd1*r(0)**2)*distp(0& -& , 1)) -! indorbp=indorb - DO ic=1,7 + fun0 = distp(0, 3) + fun = -(dd1*distp(0, 1)) + fun2 = dd1**2*distp(0, 1) +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN - IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - ELSE + IF (i .NE. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) END IF ELSE IF (ic .EQ. 2) THEN IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 3) THEN + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) END IF ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 2) THEN + IF (i .EQ. 1) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 3) THEN + ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) ELSE CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) END IF ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 1) THEN + IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - ELSE + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) END IF ELSE IF (ic .EQ. 5) THEN IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - ELSE IF (i .EQ. 2) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF - ELSE IF (ic .EQ. 6) THEN - IF (i .EQ. 1) THEN + ELSE IF (i .EQ. 3) THEN CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,17) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,16) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) END IF - ELSE IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,18) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,20) ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,19) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=7,1,-1 - temp497b23 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (8.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 8.d0*temp497b23 - fun2b = fun2b + temp497b23 + DO ic=5,1,-1 + temp486 = fun/r(0) + temp487b = distp(0, 3+ic)*zb(indorbp, indt+4) + temp486b3 = 6.d0*temp487b/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + (6.d0*temp486+fun2)*zb(& +& indorbp, indt+4) + funb0 = funb0 + temp486b3 + rb(0) = rb(0) - temp486*temp486b3 + fun2b = fun2b + temp487b zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 11) THEN - IF (branch .LT. 6) THEN - IF (branch .LT. 4) THEN - IF (branch .LT. 3) THEN - IF (.NOT.branch .LT. 2) THEN - temp497b2 = cost1f*zb(indorbp, indt+i) - fun0b = fun0b + (15.d0*rmu(i, 0)**2-3.d0*r(0)**2)*& -& temp497b2 - rmub(i, 0) = rmub(i, 0) + fun0*15.d0*2*rmu(i, 0)*& -& temp497b2 - rb(0) = rb(0) - fun0*3.d0*2*r(0)*temp497b2 - END IF - temp497b0 = -(cost1f*6.d0*zb(indorbp, indt+i)) - temp497b1 = rmu(i, 0)*temp497b0 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(3, 0)*temp497b0 - fun0b = fun0b + rmu(3, 0)*temp497b1 - rmub(3, 0) = rmub(3, 0) + fun0*temp497b1 - GOTO 150 + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp486b = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp486b + fun0b = fun0b + rmu(i, 0)*temp486b ELSE - temp497b5 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp497b5 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp497b5 - rb(0) = rb(0) - fun0*2*r(0)*temp497b5 - END IF - ELSE IF (.NOT.branch .LT. 5) THEN - temp497b6 = cost2f*10.d0*zb(indorbp, indt+i) - temp497b7 = rmu(i, 0)*temp497b6 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp497b6 - fun0b = fun0b + rmu(1, 0)*temp497b7 - rmub(1, 0) = rmub(1, 0) + fun0*temp497b7 - END IF - temp497b3 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp497b4 = rmu(i, 0)*temp497b3 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(1, 0)*temp497b3 - fun0b = fun0b + rmu(1, 0)*temp497b4 - rmub(1, 0) = rmub(1, 0) + fun0*temp497b4 - ELSE IF (branch .LT. 9) THEN - IF (branch .LT. 8) THEN - IF (branch .LT. 7) THEN - temp497b10 = cost2f*zb(indorbp, indt+i) - fun0b = fun0b + (5.d0*rmu(3, 0)**2-r(0)**2)*temp497b10 - rmub(3, 0) = rmub(3, 0) + fun0*5.d0*2*rmu(3, 0)*& -& temp497b10 - rb(0) = rb(0) - fun0*2*r(0)*temp497b10 + temp486b0 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp486b0 + fun0b = fun0b + rmu(i, 0)*temp486b0 END IF - ELSE - temp497b11 = cost2f*10.d0*zb(indorbp, indt+i) - temp497b12 = rmu(i, 0)*temp497b11 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp497b11 - fun0b = fun0b + rmu(2, 0)*temp497b12 - rmub(2, 0) = rmub(2, 0) + fun0*temp497b12 + ELSE IF (branch .LT. 4) THEN + temp486b1 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp486b1 + fun0b = fun0b + rmu(i, 0)*temp486b1 END IF - temp497b8 = -(cost2f*2.d0*zb(indorbp, indt+i)) - temp497b9 = rmu(i, 0)*temp497b8 - rmub(i, 0) = rmub(i, 0) + fun0*rmu(2, 0)*temp497b8 - fun0b = fun0b + rmu(2, 0)*temp497b9 - rmub(2, 0) = rmub(2, 0) + fun0*temp497b9 - ELSE IF (branch .LT. 10) THEN - temp497b13 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp497b13 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp497b13 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp497b13 - ELSE - temp497b14 = -(cost3f*2.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp497b14 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp497b14 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp497b14 - END IF - ELSE IF (branch .LT. 16) THEN - IF (branch .LT. 14) THEN - IF (branch .LT. 13) THEN - IF (branch .LT. 12) THEN - temp497b15 = cost3f*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp497b15 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp497b15 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp497b15 - ELSE - temp497b16 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(2, 0)*temp497b16 - rmub(2, 0) = rmub(2, 0) + rmu(3, 0)*fun0*temp497b16 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(2, 0)*temp497b16 - END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp486b2 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp486b2 + fun0b = fun0b + rmu(i, 0)*temp486b2 ELSE - temp497b17 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(3, 0)*rmu(1, 0)*temp497b17 - rmub(1, 0) = rmub(1, 0) + rmu(3, 0)*fun0*temp497b17 - rmub(3, 0) = rmub(3, 0) + fun0*rmu(1, 0)*temp497b17 + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 15) THEN - temp497b18 = cost3f*2.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp497b18 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp497b18 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp497b18 - ELSE - temp497b19 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp497b19 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp497b19 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp497b19 + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - ELSE IF (branch .LT. 19) THEN - IF (branch .LT. 18) THEN - IF (.NOT.branch .LT. 17) THEN - temp497b20 = -(cost4f*6.d0*zb(indorbp, indt+i)) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp497b20 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp497b20 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp497b20 + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) END IF - ELSE - temp497b21 = cost4f*6.d0*zb(indorbp, indt+i) - fun0b = fun0b + rmu(2, 0)*rmu(1, 0)*temp497b21 - rmub(1, 0) = rmub(1, 0) + rmu(2, 0)*fun0*temp497b21 - rmub(2, 0) = rmub(2, 0) + fun0*rmu(1, 0)*temp497b21 - END IF - ELSE IF (.NOT.branch .LT. 20) THEN - temp497b22 = cost4f*3.d0*zb(indorbp, indt+i) - fun0b = fun0b + (rmu(1, 0)**2-rmu(2, 0)**2)*temp497b22 - rmub(1, 0) = rmub(1, 0) + fun0*2*rmu(1, 0)*temp497b22 - rmub(2, 0) = rmub(2, 0) - fun0*2*rmu(2, 0)*temp497b22 - END IF - 150 temp497b = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp497b - funb = funb + rmu(i, 0)*temp497b - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - temp496 = r(0)**4 - temp496b40 = -(2.d0*distp(0, 1)*fun2b) - temp496b41 = 2.d0*distp(0, 1)*funb - dd1b = r(0)**2*temp496b41 + (2.d0*temp496*2*dd1-5.d0*r(0)**2)*& -& temp496b40 - rb(0) = rb(0) + dd1*2*r(0)*temp496b41 - distp(0, 1)*2*r(0)*fun0b +& -& (2.d0*dd1**2*4*r(0)**3-5.d0*dd1*2*r(0))*temp496b40 - distpb(0, 1) = distpb(0, 1) + 2.d0*(dd1*r(0)**2-1.d0)*funb - r(0)& -& **2*fun0b - 2.d0*(2.d0*(dd1**2*temp496)-5.d0*(dd1*r(0)**2)+1.d0)& -& *fun2b - CALL POPREAL8(adr8ibuf,adr8buf,dd1) - ddb(indparp) = ddb(indparp) + dd1b - ELSE - distpb = 0.0_8 - END IF - DO ic=7,1,-1 - DO k=indtm,i0,-1 - temp496b39 = -(r(k)**2*zb(indorbp, k)) - rb(k) = rb(k) - distp(k, 1)*distp(k, 1+ic)*2*r(k)*zb(indorbp, k) - distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp496b39 - distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp496b39 - zb(indorbp, k) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO i=indtm,indtmin,-1 - temp496b31 = cost4f*rmu(2, i)*distpb(i, 8) - rmub(2, i) = rmub(2, i) + cost4f*(3.d0*rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 8) - 2*rmu(2, i)*temp496b31 - distpb(i, 8) = 0.0_8 - temp496b32 = cost4f*rmu(1, i)*distpb(i, 7) - rmub(1, i) = rmub(1, i) + cost4f*(rmu(1, i)**2-3.d0*rmu(2, i)**2)*& -& distpb(i, 7) + 2*rmu(1, i)*temp496b32 + 3.d0*2*rmu(1, i)*& -& temp496b31 - rmub(2, i) = rmub(2, i) - 3.d0*2*rmu(2, i)*temp496b32 - distpb(i, 7) = 0.0_8 - temp496b33 = cost3f*2.d0*distpb(i, 6) - temp496b34 = rmu(2, i)*temp496b33 - rmub(3, i) = rmub(3, i) + rmu(1, i)*temp496b34 - rmub(1, i) = rmub(1, i) + rmu(3, i)*temp496b34 - rmub(2, i) = rmub(2, i) + rmu(3, i)*rmu(1, i)*temp496b33 - distpb(i, 6) = 0.0_8 - temp496b35 = cost3f*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3f*(rmu(1, i)**2-rmu(2, i)**2)*& -& distpb(i, 5) - rmub(1, i) = rmub(1, i) + 2*rmu(1, i)*temp496b35 - distpb(i, 5) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 4) - 2*rmu(2, i)*temp496b35 - temp496b36 = cost2f*rmu(2, i)*distpb(i, 4) - rmub(3, i) = rmub(3, i) + 5.d0*2*rmu(3, i)*temp496b36 - distpb(i, 4) = 0.0_8 - temp496b37 = cost2f*rmu(1, i)*distpb(i, 3) - rmub(1, i) = rmub(1, i) + cost2f*(5.d0*rmu(3, i)**2-r(i)**2)*& -& distpb(i, 3) - distpb(i, 3) = 0.0_8 - temp496b38 = cost1f*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - 2*r(i)*temp496b37 - 3.d0*2*r(i)*temp496b38 - 2*r(i& -& )*temp496b36 - rmub(3, i) = rmub(3, i) + cost1f*(5.d0*rmu(3, i)**2-3.d0*r(i)**2)*& -& distpb(i, 2) + 5.d0*2*rmu(3, i)*temp496b38 + 5.d0*2*rmu(3, i)*& -& temp496b37 - distpb(i, 2) = 0.0_8 - END DO - dd1b = 0.0_8 - DO k=indtm,indtmin,-1 - temp496b30 = DEXP(-(dd1*r(k)**2))*distpb(k, 1) - dd1b = dd1b - r(k)**2*temp496b30 - rb(k) = rb(k) - dd1*2*r(k)*temp496b30 - distpb(k, 1) = 0.0_8 - END DO - ddb(indparp) = ddb(indparp) + dd1b - CASE (199) -! derivative of 200 LA COSTANTE - indorbp = indorb + 1 -! endif - IF (typec .NE. 1) THEN - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - zb(indorbp, indt+i) = 0.0_8 - END DO - END IF - DO i=indtm,i0,-1 - zb(indorbp, i) = 0.0_8 - END DO - distpb = 0.0_8 - CASE (200) -! THE COSTANT - indorbp = indorb + 1 -! endif - IF (typec .NE. 1) THEN - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - zb(indorbp, indt+i) = 0.0_8 - END DO - END IF - DO i=indtm,i0,-1 - zb(indorbp, i) = 0.0_8 - END DO - distpb = 0.0_8 - CASE (1000:1099) -! s gaussian r**(2*npower)*exp(-alpha*r**2) - npower = iopt - 1000 - indorbp = indorb + 1 - dd2 = dd(indpar+1) - DO k=indtmin,indtm - distp(k, 1) = r(k)**(2*npower)*DEXP(-(dd2*r(k)**2)) - END DO -! endif - IF (typec .NE. 1) THEN - rp1 = r(0)**2 - fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 - funb = 2.d0*zb(indorbp, indt+4) - fun2b = zb(indorbp, indt+4) - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + temp485 = fun/r(0) + temp485b9 = distp(0, 3+ic)*rmu(i, 0)*zb(indorbp, indt+i)/r(0) + distpb(0, 3+ic) = distpb(0, 3+ic) + temp485*rmu(i, 0)*zb(& +& indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + temp485*distp(0, 3+ic)*zb(indorbp, & +& indt+i) + funb0 = funb0 + temp485b9 + rb(0) = rb(0) - temp485*temp485b9 + zb(indorbp, indt+i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp500 = distp(0, 1)/rp1 - temp501b = 2.d0*temp500*fun2b - temp501b0 = -((npower*4.d0+1.d0)*temp501b) - temp500b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& -& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 - temp499 = distp(0, 1)/rp1 - temp500b0 = 2.d0*temp499*funb - dd2b = rp1*temp501b0 - rp1*temp500b0 + 2.d0*rp1**2*2*dd2*temp501b - temp499b = 2.d0*(npower-dd2*rp1)*funb/rp1 - rp1b = dd2*temp501b0 - temp499*temp499b - temp500*temp500b - dd2*& -& temp500b0 + 2.d0*dd2**2*2*rp1*temp501b - distpb(0, 1) = temp499b + temp500b - rb(0) = rb(0) + 2*r(0)*rp1b + dd1b = distp(0, 1)*2*dd1*fun2b - distp(0, 1)*funb0 + distpb(0, 1) = distpb(0, 1) + dd1**2*fun2b - dd1*funb0 + distpb(0, 3) = distpb(0, 3) + fun0b ELSE distpb = 0.0_8 - dd2b = 0.0_8 + dd1b = 0.0_8 END IF - DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + DO ic=5,1,-1 + DO i=indtm,i0,-1 + distpb(i, 3+ic) = distpb(i, 3+ic) + distp(i, 3)*zb(indorbp, i) + distpb(i, 3) = distpb(i, 3) + distp(i, 3+ic)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO i=indtm,indtmin,-1 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 8) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 8) + distpb(i, 8) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 7) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 7) + distpb(i, 7) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 6) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 5) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 4) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + distpb(i, 1) = distpb(i, 1) + distpb(i, 3) + distpb(i, 3) = 0.0_8 END DO DO k=indtm,indtmin,-1 - temp498 = r(k)**2 - temp497 = 2*npower - temp497b24 = r(k)**temp497*DEXP(-(dd2*temp498))*distpb(k, 1) - IF (r(k) .LE. 0.0 .AND. (temp497 .EQ. 0.0 .OR. temp497 .NE. INT(& -& temp497))) THEN - rb(k) = rb(k) - dd2*2*r(k)*temp497b24 - ELSE - rb(k) = rb(k) + DEXP(-(dd2*temp498))*temp497*r(k)**(temp497-1)*& -& distpb(k, 1) - dd2*2*r(k)*temp497b24 - END IF - dd2b = dd2b - temp498*temp497b24 + temp485b8 = DEXP(-(dd1*r(k)))*distpb(k, 1) + dd1b = dd1b - r(k)*temp485b8 + rb(k) = rb(k) - dd1*temp485b8 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (2000:2099) -! s gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative of 1000 - npower = iopt + 1 - 2000 - indorbp = indorb + 1 + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (139) +! 2s with cusp condition +! ( r^3*exp(-dd2*r)) ! der of 128 dd2 = dd(indpar+1) + indorbp = indorb + 1 DO k=indtmin,indtm - distp(k, 1) = -(r(k)**(2*npower)*DEXP(-(dd2*r(k)**2))) + distp(k, 1) = -(DEXP(-(dd2*r(k)))*r(k)) END DO -! endif +! endif IF (typec .NE. 1) THEN - rp1 = r(0)**2 - fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 - funb = 2.d0*zb(indorbp, indt+4) + fun = (3.d0-dd2*r(0))*distp(0, 1) + funb0 = 2.d0*zb(indorbp, indt+4) fun2b = zb(indorbp, indt+4) zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) - funb = funb + rmu(i, 0)*zb(indorbp, indt+i) zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - temp504 = distp(0, 1)/rp1 - temp505b = 2.d0*temp504*fun2b - temp505b0 = -((npower*4.d0+1.d0)*temp505b) - temp504b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& -& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 - temp503 = distp(0, 1)/rp1 - temp504b0 = 2.d0*temp503*funb - dd2b = rp1*temp505b0 - rp1*temp504b0 + 2.d0*rp1**2*2*dd2*temp505b - temp503b = 2.d0*(npower-dd2*rp1)*funb/rp1 - rp1b = dd2*temp505b0 - temp503*temp503b - temp504*temp504b - dd2*& -& temp504b0 + 2.d0*dd2**2*2*rp1*temp505b - distpb(0, 1) = temp503b + temp504b - rb(0) = rb(0) + 2*r(0)*rp1b + temp487b1 = distp(0, 1)*fun2b + temp487b2 = 2*dd2*r(0)*temp487b1 + dd2b = r(0)*temp487b2 - 6*r(0)*temp487b1 - distp(0, 1)*r(0)*funb0 + rb(0) = rb(0) + dd2*temp487b2 - 6*dd2*temp487b1 - distp(0, 1)*dd2*& +& funb0 + distpb(0, 1) = (3.d0-dd2*r(0))*funb0 + ((dd2*r(0))**2-6*(dd2*r(0))& +& +6.d0)*fun2b ELSE distpb = 0.0_8 dd2b = 0.0_8 END IF DO i=indtm,i0,-1 - distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + r(i)**2*zb(indorbp, i) + rb(i) = rb(i) + distp(i, 1)*2*r(i)*zb(indorbp, i) zb(indorbp, i) = 0.0_8 END DO DO k=indtm,indtmin,-1 - temp502 = r(k)**2 - temp501 = 2*npower - temp501b1 = -(r(k)**temp501*DEXP(-(dd2*temp502))*distpb(k, 1)) - IF (r(k) .LE. 0.0 .AND. (temp501 .EQ. 0.0 .OR. temp501 .NE. INT(& -& temp501))) THEN - rb(k) = rb(k) - dd2*2*r(k)*temp501b1 - ELSE - rb(k) = rb(k) - dd2*2*r(k)*temp501b1 - DEXP(-(dd2*temp502))*& -& temp501*r(k)**(temp501-1)*distpb(k, 1) - END IF - dd2b = dd2b - temp502*temp501b1 + temp487b0 = -(r(k)*DEXP(-(dd2*r(k)))*distpb(k, 1)) + dd2b = dd2b - r(k)*temp487b0 + rb(k) = rb(k) - DEXP(-(dd2*r(k)))*distpb(k, 1) - dd2*temp487b0 distpb(k, 1) = 0.0_8 END DO ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (1100:1199) -! p gaussian r**(2*npower)*exp(-alpha*r**2) - npower = iopt - 1100 -! indorbp=indorb - dd2 = dd(indpar+1) + CASE (45, 69) +! d orbitals +! R(r)= c*exp(-z r^2)*(7/4/z-r^2) +! indorbp=indorb + indparp = indpar + 1 + dd1 = dd(indparp) +! if(iflagnorm.gt.2) then +! overall normalization +! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) + c = dd1**1.75d0*1.64592278064948967213d0 +! endif DO k=indtmin,indtm - distp(k, 1) = r(k)**(2*npower)*DEXP(-(dd2*r(k)**2)) + distp(k, 1) = c*DEXP(-(dd1*r(k)**2)) END DO - DO ic=1,3 + DO i=indtmin,indtm +! lz=0 + distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d +! lz=+/-2 + distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d +! lz=+/-2 + distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d +! lz=+/-1 + distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d +! lz=+/-1 + distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d + END DO + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN - rp1 = r(0)**2 - fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 - fun2 = (npower*(2.d0*npower-1.d0)-(1.d0+4.d0*npower)*dd2*rp1+2.d0*& -& (dd2*rp1)**2)*distp(0, 1)*2.d0/rp1 -! indorbp=indorb - DO ic=1,3 + CALL PUSHREAL8(adr8ibuf,adr8buf,dd1) + dd1 = dd(indparp) + fun0 = distp(0, 1)*(7.d0/4.d0/dd1-r(0)**2) + fun = distp(0, 1)*(2.d0*dd1*r(0)**2-11.d0/2.d0) + fun2 = distp(0, 1)*(-(4.d0*dd1**2*r(0)**4)+17.d0*dd1*r(0)**2-11.d0& +& /2.d0) +! indorbp=indorb + DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + IF (ic .EQ. 1) THEN + IF (i .NE. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + END IF + ELSE IF (ic .EQ. 2) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE IF (ic .EQ. 3) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) + ELSE IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) + END IF + ELSE IF (ic .EQ. 4) THEN + IF (i .EQ. 2) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) + END IF + ELSE IF (ic .EQ. 5) THEN + IF (i .EQ. 1) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) + ELSE IF (i .EQ. 3) THEN + CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) + END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) END IF END DO END DO - funb = 0.0_8 + distpb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 - DO ic=3,1,-1 - temp509b2 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp509b2 - fun2b = fun2b + temp509b2 + DO ic=5,1,-1 + temp493b4 = distp(0, 1+ic)*zb(indorbp, indt+4) + distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & +& indt+4) + funb0 = funb0 + 6.d0*temp493b4 + fun2b = fun2b + temp493b4 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp509b1 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp509b1 - funb = funb + rmu(ic, 0)*temp509b1 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - distpb = 0.0_8 - temp508 = distp(0, 1)/rp1 - temp509b = 2.d0*temp508*fun2b - temp509b0 = -((npower*4.d0+1.d0)*temp509b) - temp508b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& -& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 - temp507 = distp(0, 1)/rp1 - temp508b0 = 2.d0*temp507*funb - dd2b = rp1*temp509b0 - rp1*temp508b0 + 2.d0*rp1**2*2*dd2*temp509b - temp507b = 2.d0*(npower-dd2*rp1)*funb/rp1 - rp1b = dd2*temp509b0 - temp507*temp507b - temp508*temp508b - dd2*& -& temp508b0 + 2.d0*dd2**2*2*rp1*temp509b - distpb(0, 1) = temp507b + fun0b + temp508b - rb(0) = rb(0) + 2*r(0)*rp1b - ELSE - distpb = 0.0_8 - dd2b = 0.0_8 - END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO k=indtm,indtmin,-1 - temp506 = r(k)**2 - temp505 = 2*npower - temp505b1 = r(k)**temp505*DEXP(-(dd2*temp506))*distpb(k, 1) - IF (r(k) .LE. 0.0 .AND. (temp505 .EQ. 0.0 .OR. temp505 .NE. INT(& -& temp505))) THEN - rb(k) = rb(k) - dd2*2*r(k)*temp505b1 - ELSE - rb(k) = rb(k) + DEXP(-(dd2*temp506))*temp505*r(k)**(temp505-1)*& -& distpb(k, 1) - dd2*2*r(k)*temp505b1 - END IF - dd2b = dd2b - temp506*temp505b1 - distpb(k, 1) = 0.0_8 - END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (2100:2199) -! p gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative 1100 - npower = iopt + 1 - 2100 -! indorbp=indorb - dd2 = dd(indpar+1) - DO k=indtmin,indtm - distp(k, 1) = -(r(k)**(2*npower)*DEXP(-(dd2*r(k)**2))) - END DO - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - END DO -! endif - IF (typec .NE. 1) THEN - rp1 = r(0)**2 - fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 - fun2 = (npower*(2.d0*npower-1.d0)-(1.d0+4.d0*npower)*dd2*rp1+2.d0*& -& (dd2*rp1)**2)*distp(0, 1)*2.d0/rp1 -! indorbp=indorb - DO ic=1,3 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (i .EQ. ic) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + IF (branch .LT. 9) THEN + IF (branch .LT. 5) THEN + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + temp493b0 = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp493b0 + fun0b = fun0b + rmu(i, 0)*temp493b0 + ELSE + temp493b1 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp493b1 + fun0b = fun0b + rmu(i, 0)*temp493b1 + END IF + ELSE IF (branch .LT. 4) THEN + temp493b2 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp493b2 + fun0b = fun0b + rmu(i, 0)*temp493b2 + END IF + ELSE IF (branch .LT. 7) THEN + IF (branch .LT. 6) THEN + temp493b3 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp493b3 + fun0b = fun0b + rmu(i, 0)*temp493b3 + ELSE + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (.NOT.branch .LT. 8) THEN + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 13) THEN + IF (branch .LT. 11) THEN + IF (branch .LT. 10) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& +& ) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 12) THEN + rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) + END IF + ELSE IF (branch .LT. 15) THEN + IF (branch .LT. 14) THEN + rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) + END IF ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) + fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - END DO - END DO - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=3,1,-1 - temp513b2 = rmu(ic, 0)*zb(indorbp, indt+4) - rmub(ic, 0) = rmub(ic, 0) + (4.d0*fun+fun2)*zb(indorbp, indt+4) - funb = funb + 4.d0*temp513b2 - fun2b = fun2b + temp513b2 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (.NOT.branch .LT. 2) fun0b = fun0b + zb(indorbp, indt+i) - temp513b1 = rmu(i, 0)*zb(indorbp, indt+i) - rmub(ic, 0) = rmub(ic, 0) + fun*temp513b1 - funb = funb + rmu(ic, 0)*temp513b1 - rmub(i, 0) = rmub(i, 0) + rmu(ic, 0)*fun*zb(indorbp, indt+i) + temp493b = distp(0, 1+ic)*zb(indorbp, indt+i) + distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & +& indt+i) + rmub(i, 0) = rmub(i, 0) + fun*temp493b + funb0 = funb0 + rmu(i, 0)*temp493b zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - distpb = 0.0_8 - temp512 = distp(0, 1)/rp1 - temp513b = 2.d0*temp512*fun2b - temp513b0 = -((npower*4.d0+1.d0)*temp513b) - temp512b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& -& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 - temp511 = distp(0, 1)/rp1 - temp512b0 = 2.d0*temp511*funb - dd2b = rp1*temp513b0 - rp1*temp512b0 + 2.d0*rp1**2*2*dd2*temp513b - temp511b = 2.d0*(npower-dd2*rp1)*funb/rp1 - rp1b = dd2*temp513b0 - temp511*temp511b - temp512*temp512b - dd2*& -& temp512b0 + 2.d0*dd2**2*2*rp1*temp513b - distpb(0, 1) = temp511b + fun0b + temp512b - rb(0) = rb(0) + 2*r(0)*rp1b + temp492 = r(0)**4 + temp492b = distp(0, 1)*fun2b + temp491 = 4.d0*dd1 + temp490 = 7.d0/temp491 + distpb(0, 1) = distpb(0, 1) + (2.d0*(dd1*r(0)**2)-11.d0/2.d0)*& +& funb0 + (temp490-r(0)**2)*fun0b + (17.d0*(dd1*r(0)**2)-11.d0/& +& 2.d0-4.d0*(dd1**2*temp492))*fun2b + temp492b0 = distp(0, 1)*2.d0*funb0 + dd1b = r(0)**2*temp492b0 - distp(0, 1)*temp490*4.d0*fun0b/temp491 & +& + (17.d0*r(0)**2-4.d0*temp492*2*dd1)*temp492b + rb(0) = rb(0) + dd1*2*r(0)*temp492b0 - distp(0, 1)*2*r(0)*fun0b + & +& (17.d0*dd1*2*r(0)-4.d0*dd1**2*4*r(0)**3)*temp492b + CALL POPREAL8(adr8ibuf,adr8buf,dd1) + ddb(indparp) = ddb(indparp) + dd1b ELSE distpb = 0.0_8 - dd2b = 0.0_8 END IF - DO ic=3,1,-1 - DO i=indtm,i0,-1 - rmub(ic, i) = rmub(ic, i) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + rmu(ic, i)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 + dd1b = 0.0_8 + DO ic=5,1,-1 + DO k=indtm,i0,-1 + temp490b = distp(k, 1)*distp(k, 1+ic)*zb(indorbp, k) + temp489 = 4.d0*dd1 + temp488 = 7.d0/temp489 + temp488b = (temp488-r(k)**2)*zb(indorbp, k) + dd1b = dd1b - temp488*4.d0*temp490b/temp489 + rb(k) = rb(k) - 2*r(k)*temp490b + distpb(k, 1) = distpb(k, 1) + distp(k, 1+ic)*temp488b + distpb(k, 1+ic) = distpb(k, 1+ic) + distp(k, 1)*temp488b + zb(indorbp, k) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO + DO i=indtm,indtmin,-1 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) + distpb(i, 2) = 0.0_8 + END DO + cb = 0.0_8 DO k=indtm,indtmin,-1 - temp510 = r(k)**2 - temp509 = 2*npower - temp509b3 = -(r(k)**temp509*DEXP(-(dd2*temp510))*distpb(k, 1)) - IF (r(k) .LE. 0.0 .AND. (temp509 .EQ. 0.0 .OR. temp509 .NE. INT(& -& temp509))) THEN - rb(k) = rb(k) - dd2*2*r(k)*temp509b3 - ELSE - rb(k) = rb(k) - dd2*2*r(k)*temp509b3 - DEXP(-(dd2*temp510))*& -& temp509*r(k)**(temp509-1)*distpb(k, 1) - END IF - dd2b = dd2b - temp510*temp509b3 + temp487 = r(k)**2 + temp487b3 = c*DEXP(-(dd1*temp487))*distpb(k, 1) + cb = cb + DEXP(-(dd1*temp487))*distpb(k, 1) + dd1b = dd1b - temp487*temp487b3 + rb(k) = rb(k) - dd1*2*r(k)*temp487b3 distpb(k, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b + dd1b = dd1b + 1.64592278064948967213d0*1.75d0*dd1**0.75D0*cb + ddb(indparp) = ddb(indparp) + dd1b CASE (1200:1299) -! d gaussian r**(2*npower)*exp(-alpha*r**2) +! derivative of 17 with respect to z +! d gaussian r**(2*npower)*exp(-alpha*r**2) npower = iopt - 1200 -! indorbp=indorb +! indorbp=indorb dd2 = dd(indpar+1) DO k=indtmin,indtm distp(k, 1) = r(k)**(2*npower)*DEXP(-(dd2*r(k)**2)) @@ -21735,20 +21683,20 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END DO DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic END DO -! endif +! endif IF (typec .NE. 1) THEN rp1 = r(0)**2 fun0 = distp(0, 1) fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 fun2 = (npower*(2.d0*npower-1.d0)-(1.d0+4.d0*npower)*dd2*rp1+2.d0*& & (dd2*rp1)**2)*distp(0, 1)*2.d0/rp1 -! indorbp=indorb +! indorbp=indorb DO ic=1,5 CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then +! if(iocc(indshell+ic).eq.1) then indorbp = indorb + ic DO i=1,3 IF (ic .EQ. 1) THEN @@ -21795,15 +21743,15 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & END DO END DO distpb = 0.0_8 - funb = 0.0_8 + funb0 = 0.0_8 fun0b = 0.0_8 fun2b = 0.0_8 DO ic=5,1,-1 - temp517b6 = distp(0, 1+ic)*zb(indorbp, indt+4) + temp497b6 = distp(0, 1+ic)*zb(indorbp, indt+4) distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & & indt+4) - funb = funb + 6.d0*temp517b6 - fun2b = fun2b + temp517b6 + funb0 = funb0 + 6.d0*temp497b6 + fun2b = fun2b + temp497b6 zb(indorbp, indt+4) = 0.0_8 DO i=3,1,-1 CALL POPINTEGER4(adi4ibuf,adi4buf,branch) @@ -21811,24 +21759,24 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & IF (branch .LT. 5) THEN IF (branch .LT. 3) THEN IF (branch .LT. 2) THEN - temp517b2 = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp517b2 - fun0b = fun0b + rmu(i, 0)*temp517b2 + temp497b2 = -(cost1d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp497b2 + fun0b = fun0b + rmu(i, 0)*temp497b2 ELSE - temp517b3 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp517b3 - fun0b = fun0b + rmu(i, 0)*temp517b3 + temp497b3 = cost1d*4.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp497b3 + fun0b = fun0b + rmu(i, 0)*temp497b3 END IF ELSE IF (branch .LT. 4) THEN - temp517b4 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp517b4 - fun0b = fun0b + rmu(i, 0)*temp517b4 + temp497b4 = cost2d*2.d0*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun0*temp497b4 + fun0b = fun0b + rmu(i, 0)*temp497b4 END IF ELSE IF (branch .LT. 7) THEN IF (branch .LT. 6) THEN - temp517b5 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp517b5 - fun0b = fun0b + rmu(i, 0)*temp517b5 + temp497b5 = -(cost2d*2.d0*zb(indorbp, indt+i)) + rmub(i, 0) = rmub(i, 0) + fun0*temp497b5 + fun0b = fun0b + rmu(i, 0)*temp497b5 ELSE rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& & ) @@ -21858,278 +21806,1428 @@ SUBROUTINE MAKEFUN_B(iopt, indt, i0, indtmin, indtm, typec, indpar, & rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) END IF - temp517b1 = distp(0, 1+ic)*zb(indorbp, indt+i) + temp497b1 = distp(0, 1+ic)*zb(indorbp, indt+i) distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & & indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp517b1 - funb = funb + rmu(i, 0)*temp517b1 + rmub(i, 0) = rmub(i, 0) + fun*temp497b1 + funb0 = funb0 + rmu(i, 0)*temp497b1 zb(indorbp, indt+i) = 0.0_8 END DO CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) END DO - temp516 = distp(0, 1)/rp1 - temp517b = 2.d0*temp516*fun2b - temp517b0 = -((npower*4.d0+1.d0)*temp517b) - temp516b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& -& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 - temp515 = distp(0, 1)/rp1 - temp516b0 = 2.d0*temp515*funb - dd2b = rp1*temp517b0 - rp1*temp516b0 + 2.d0*rp1**2*2*dd2*temp517b - temp515b = 2.d0*(npower-dd2*rp1)*funb/rp1 - rp1b = dd2*temp517b0 - temp515*temp515b - temp516*temp516b - dd2*& -& temp516b0 + 2.d0*dd2**2*2*rp1*temp517b - distpb(0, 1) = distpb(0, 1) + temp515b + fun0b + temp516b - rb(0) = rb(0) + 2*r(0)*rp1b + temp496 = distp(0, 1)/rp1 + temp497b = 2.d0*temp496*fun2b + temp497b0 = -((npower*4.d0+1.d0)*temp497b) + temp496b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& +& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 + temp495 = distp(0, 1)/rp1 + temp496b0 = 2.d0*temp495*funb0 + dd2b = rp1*temp497b0 - rp1*temp496b0 + 2.d0*rp1**2*2*dd2*temp497b + temp495b = 2.d0*(npower-dd2*rp1)*funb0/rp1 + rp1b = dd2*temp497b0 - temp495*temp495b - temp496*temp496b - dd2*& +& temp496b0 + 2.d0*dd2**2*2*rp1*temp497b + distpb(0, 1) = distpb(0, 1) + temp495b + fun0b + temp496b + rb(0) = rb(0) + 2*r(0)*rp1b + ELSE + distpb = 0.0_8 + dd2b = 0.0_8 + END IF + DO ic=5,1,-1 + DO i=indtm,i0,-1 + distpb(i, 1+ic) = distpb(i, 1+ic) + distp(i, 1)*zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + distp(i, 1+ic)*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + END DO + DO i=indtm,indtmin,-1 + rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) + rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) + distpb(i, 6) = 0.0_8 + rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) + rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) + distpb(i, 5) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) + rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) + distpb(i, 4) = 0.0_8 + rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) + rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) + distpb(i, 3) = 0.0_8 + rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) + rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) + distpb(i, 2) = 0.0_8 + END DO + DO k=indtm,indtmin,-1 + temp494 = r(k)**2 + temp493 = 2*npower + temp493b5 = r(k)**temp493*DEXP(-(dd2*temp494))*distpb(k, 1) + IF (r(k) .LE. 0.0 .AND. (temp493 .EQ. 0.0 .OR. temp493 .NE. INT(& +& temp493))) THEN + rb(k) = rb(k) - dd2*2*r(k)*temp493b5 + ELSE + rb(k) = rb(k) + DEXP(-(dd2*temp494))*temp493*r(k)**(temp493-1)*& +& distpb(k, 1) - dd2*2*r(k)*temp493b5 + END IF + dd2b = dd2b - temp494*temp493b5 + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+1) = ddb(indpar+1) + dd2b + CASE (90:99) +! cartesian orbitals +! +! - angmom := iopt - 90 +! - type = Gaussian +! - normalized = yes +! - angtype = cartesian +! - npar = 1 +! - multiplicity := (iopt - 90 + 2) * (iopt - 90 + 1) // 2 +! + indorbp = indorb + 1 + dd1 = dd(indpar+1) + multiplicity = (iopt-90+2)*(iopt-90+1)/2 + powers(:, -2, :) = 0.0d0 + powers(:, -1, :) = 0.0d0 + powers(:, 0, :) = 1.0d0 + DO ii=1,iopt-90 + DO k=indtmin,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,powers(1, ii, k)) + powers(1, ii, k) = powers(1, ii-1, k)*rmu(1, k) + CALL PUSHREAL8(adr8ibuf,adr8buf,powers(2, ii, k)) + powers(2, ii, k) = powers(2, ii-1, k)*rmu(2, k) + CALL PUSHREAL8(adr8ibuf,adr8buf,powers(3, ii, k)) + powers(3, ii, k) = powers(3, ii-1, k)*rmu(3, k) + END DO + END DO +! * 2.829 + c = 0.712705470354990_8*dd1**0.75_8 + IF (iopt - 90 .NE. 0) THEN + CALL PUSHREAL8(adr8ibuf,adr8buf,c) + c = c*(8_4*dd1)**((iopt-90)/2.0_8) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + END IF + DO k=i0,indtm + distp(k, 1) = DEXP(-(1.0_8*dd1*r(k)*r(k)))*c + END DO + DO k=i0,indtm + count = 0 + DO ii=iopt-90,0,-1 + ad_from = iopt - 90 - ii + DO jj=ad_from,0,-1 + kk = iopt - 90 - ii - jj + z(indorbp+count, k) = 1.0_8 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = 1.0_8 + DO i=ii+1,2*ii + rp1 = rp1*i + END DO + z(indorbp+count, k) = z(indorbp+count, k)/DSQRT(rp1) + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = 1.0_8 + DO i=jj+1,2*jj + rp1 = rp1*i + END DO + z(indorbp+count, k) = z(indorbp+count, k)/DSQRT(rp1) + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = 1.0_8 + DO i=kk+1,2*kk + rp1 = rp1*i + END DO + z(indorbp+count, k) = z(indorbp+count, k)/DSQRT(rp1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,count) + count = count + 1 + END DO + CALL PUSHINTEGER4(adi4ibuf,adi4buf,ad_from) + END DO + END DO +! We need to calculate it again for derivatives, it could not be done in previous loop because of case if i0 /= indtmin + IF (typec .NE. 1) THEN + count = 0 + DO ii=iopt-90,0,-1 + ad_from0 = iopt - 90 - ii + DO jj=ad_from0,0,-1 + kk = iopt - 90 - ii - jj + z(indorbp+count, indt+1) = 1.0_8 + z(indorbp+count, indt+2) = 1.0_8 + z(indorbp+count, indt+3) = 1.0_8 + z(indorbp+count, indt+4) = 1.0_8 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = 1.0_8 + DO i=ii+1,2*ii + rp1 = rp1*i + END DO + z(indorbp+count, indt+1) = z(indorbp+count, indt+1)/DSQRT(rp1) + z(indorbp+count, indt+2) = z(indorbp+count, indt+2)/DSQRT(rp1) + z(indorbp+count, indt+3) = z(indorbp+count, indt+3)/DSQRT(rp1) + z(indorbp+count, indt+4) = z(indorbp+count, indt+4)/DSQRT(rp1) + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = 1.0_8 + DO i=jj+1,2*jj + rp1 = rp1*i + END DO + z(indorbp+count, indt+1) = z(indorbp+count, indt+1)/DSQRT(rp1) + z(indorbp+count, indt+2) = z(indorbp+count, indt+2)/DSQRT(rp1) + z(indorbp+count, indt+3) = z(indorbp+count, indt+3)/DSQRT(rp1) + z(indorbp+count, indt+4) = z(indorbp+count, indt+4)/DSQRT(rp1) + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = 1.0_8 + DO i=kk+1,2*kk + rp1 = rp1*i + END DO + z(indorbp+count, indt+1) = z(indorbp+count, indt+1)/DSQRT(rp1) + z(indorbp+count, indt+2) = z(indorbp+count, indt+2)/DSQRT(rp1) + z(indorbp+count, indt+3) = z(indorbp+count, indt+3)/DSQRT(rp1) + z(indorbp+count, indt+4) = z(indorbp+count, indt+4)/DSQRT(rp1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,count) + count = count + 1 + END DO + CALL PUSHINTEGER4(adi4ibuf,adi4buf,ad_from0) + END DO + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + END IF +! Initialize gradients and laplacians (radial part) + IF (typec .NE. 1) THEN + tmp = -(2.0d0*dd1*rmu(1, 0)*distp(0, 1)) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(indt+1, 1)) + distp(indt+1, 1) = tmp + tmp0 = -(2.0d0*dd1*rmu(2, 0)*distp(0, 1)) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(indt+2, 1)) + distp(indt+2, 1) = tmp0 + tmp1 = -(2.0d0*dd1*rmu(3, 0)*distp(0, 1)) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(indt+3, 1)) + distp(indt+3, 1) = tmp1 + tmp2 = dd1*(4.0d0*dd1*(r(0)*r(0))-6.0d0)*distp(0, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(indt+4, 1)) + distp(indt+4, 1) = tmp2 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + END IF + DO k=i0,indtm + count = 0 + DO ii=iopt-90,0,-1 + ad_from1 = iopt - 90 - ii + DO jj=ad_from1,0,-1 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,kk) + kk = iopt - 90 - ii - jj + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, k)) + z(indorbp+count, k) = z(indorbp+count, k)*powers(1, ii, k) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, k)) + z(indorbp+count, k) = z(indorbp+count, k)*powers(2, jj, k) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, k)) + z(indorbp+count, k) = z(indorbp+count, k)*powers(3, kk, k) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,count) + count = count + 1 + END DO + CALL PUSHINTEGER4(adi4ibuf,adi4buf,ad_from1) + END DO + END DO + IF (typec .NE. 1) THEN +! Solve ang_mom = 0, 1 separately + IF (iopt - 90 .EQ. 0) THEN + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+1)) + z(indorbp, indt+1) = distp(indt+1, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+2)) + z(indorbp, indt+2) = distp(indt+2, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+3)) + z(indorbp, indt+3) = distp(indt+3, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+4)) + z(indorbp, indt+4) = distp(indt+4, 1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) + ELSE IF (iopt - 90 .EQ. 1) THEN + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = DSQRT(2.0_8) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+1)) + z(indorbp, indt+1) = (distp(indt+1, 1)*rmu(1, indtmin)+distp(0, & +& 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+2)) + z(indorbp, indt+2) = distp(indt+2, 1)*rmu(1, indtmin)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+3)) + z(indorbp, indt+3) = distp(indt+3, 1)*rmu(1, indtmin)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+1)) + z(indorbp+1, indt+1) = distp(indt+1, 1)*rmu(2, indtmin)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+2)) + z(indorbp+1, indt+2) = (distp(indt+2, 1)*rmu(2, indtmin)+distp(0& +& , 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+3)) + z(indorbp+1, indt+3) = distp(indt+3, 1)*rmu(2, indtmin)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+1)) + z(indorbp+2, indt+1) = distp(indt+1, 1)*rmu(3, indtmin)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+2)) + z(indorbp+2, indt+2) = distp(indt+2, 1)*rmu(3, indtmin)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+3)) + z(indorbp+2, indt+3) = (distp(indt+3, 1)*rmu(3, indtmin)+distp(0& +& , 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+4)) + z(indorbp, indt+4) = (distp(indt+4, 1)*rmu(1, indtmin)+2.0d0*& +& distp(indt+1, 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+4)) + z(indorbp+1, indt+4) = (distp(indt+4, 1)*rmu(2, indtmin)+2.0d0*& +& distp(indt+2, 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+4)) + z(indorbp+2, indt+4) = (distp(indt+4, 1)*rmu(3, indtmin)+2.0d0*& +& distp(indt+3, 1))/rp1 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) + ELSE IF (iopt - 90 .EQ. 2) THEN + CALL PUSHREAL8(adr8ibuf,adr8buf,rp1) + rp1 = 2.0_8 + rp2 = DSQRT(12.0_8) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+1)) + z(indorbp, indt+1) = (distp(indt+1, 1)*rmu(1, indtmin)*rmu(1, & +& indtmin)+2*rmu(1, indtmin)*distp(0, 1))/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+2)) + z(indorbp, indt+2) = distp(indt+2, 1)*rmu(1, indtmin)*rmu(1, & +& indtmin)/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+3)) + z(indorbp, indt+3) = distp(indt+3, 1)*rmu(1, indtmin)*rmu(1, & +& indtmin)/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+1)) + z(indorbp+1, indt+1) = (distp(indt+1, 1)*rmu(1, indtmin)*rmu(2, & +& indtmin)+rmu(2, indtmin)*distp(0, 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+2)) + z(indorbp+1, indt+2) = (distp(indt+2, 1)*rmu(1, indtmin)*rmu(2, & +& indtmin)+rmu(1, indtmin)*distp(0, 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+3)) + z(indorbp+1, indt+3) = distp(indt+3, 1)*rmu(1, indtmin)*rmu(2, & +& indtmin)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+1)) + z(indorbp+2, indt+1) = (distp(indt+1, 1)*rmu(1, indtmin)*rmu(3, & +& indtmin)+rmu(3, indtmin)*distp(0, 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+2)) + z(indorbp+2, indt+2) = distp(indt+2, 1)*rmu(1, indtmin)*rmu(3, & +& indtmin)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+3)) + z(indorbp+2, indt+3) = distp(indt+3, 1)*rmu(1, indtmin)*rmu(3, & +& indtmin) + rmu(1, indtmin)*distp(0, 1)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+3, indt+1)) + z(indorbp+3, indt+1) = distp(indt+1, 1)*rmu(2, indtmin)*rmu(2, & +& indtmin)/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+3, indt+2)) + z(indorbp+3, indt+2) = (distp(indt+2, 1)*rmu(2, indtmin)*rmu(2, & +& indtmin)+2*rmu(2, indtmin)*distp(0, 1))/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+3, indt+3)) + z(indorbp+3, indt+3) = distp(indt+3, 1)*rmu(2, indtmin)*rmu(2, & +& indtmin)/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+4, indt+1)) + z(indorbp+4, indt+1) = distp(indt+1, 1)*rmu(2, indtmin)*rmu(3, & +& indtmin)/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+4, indt+2)) + z(indorbp+4, indt+2) = (distp(indt+2, 1)*rmu(2, indtmin)*rmu(3, & +& indtmin)+rmu(3, indtmin)*distp(0, 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+4, indt+3)) + z(indorbp+4, indt+3) = (distp(indt+3, 1)*rmu(2, indtmin)*rmu(3, & +& indtmin)+rmu(2, indtmin)*distp(0, 1))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+5, indt+1)) + z(indorbp+5, indt+1) = distp(indt+1, 1)*rmu(3, indtmin)*rmu(3, & +& indtmin)/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+5, indt+2)) + z(indorbp+5, indt+2) = distp(indt+2, 1)*rmu(3, indtmin)*rmu(3, & +& indtmin)/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+5, indt+3)) + z(indorbp+5, indt+3) = (distp(indt+3, 1)*rmu(3, indtmin)*rmu(3, & +& indtmin)+2*rmu(3, indtmin)*distp(0, 1))/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp, indt+4)) + z(indorbp, indt+4) = (1.0d0*distp(indt+4, 1)*rmu(1, indtmin)*rmu& +& (1, indtmin)+4.0d0*distp(indt+1, 1)*rmu(1, indtmin)+2.0d0*& +& distp(0, 1))/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+4)) + z(indorbp+1, indt+4) = (1.0d0*distp(indt+4, 1)*rmu(1, indtmin)*& +& rmu(2, indtmin)+2.0d0*distp(indt+2, 1)*rmu(1, indtmin)+2.0d0*& +& distp(indt+1, 1)*rmu(2, indtmin))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+4)) + z(indorbp+2, indt+4) = (1.0d0*distp(indt+4, 1)*rmu(1, indtmin)*& +& rmu(3, indtmin)+2.0d0*distp(indt+3, 1)*rmu(1, indtmin)+2.0d0*& +& distp(indt+1, 1)*rmu(3, indtmin))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+3, indt+4)) + z(indorbp+3, indt+4) = (1.0d0*distp(indt+4, 1)*rmu(2, indtmin)*& +& rmu(2, indtmin)+4.0d0*distp(indt+2, 1)*rmu(2, indtmin)+2.0d0*& +& distp(0, 1))/rp2 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+4, indt+4)) + z(indorbp+4, indt+4) = (1.0d0*distp(indt+4, 1)*rmu(2, indtmin)*& +& rmu(3, indtmin)+2.0d0*distp(indt+3, 1)*rmu(2, indtmin)+2.0d0*& +& distp(indt+2, 1)*rmu(3, indtmin))/rp1 + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+5, indt+4)) + z(indorbp+5, indt+4) = (1.0d0*distp(indt+4, 1)*rmu(3, indtmin)*& +& rmu(3, indtmin)+4.0d0*distp(indt+3, 1)*rmu(3, indtmin)+2.0d0*& +& distp(0, 1))/rp2 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) + ELSE + count = 0 + DO ii=iopt-90,0,-1 + ad_from2 = iopt - 90 - ii + DO jj=ad_from2,0,-1 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,kk) + kk = iopt - 90 - ii - jj + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) +! First store polynomial part into respective places +! Then solve full laplacian using using lower derivatives +! Then do the same thing for gradients +! Then finally the values + z(indorbp+count, indt+1) = z(indorbp+count, indt+1)*powers(1& +& , ii-1, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + z(indorbp+count, indt+1) = z(indorbp+count, indt+1)*powers(2& +& , jj, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + z(indorbp+count, indt+1) = z(indorbp+count, indt+1)*powers(3& +& , kk, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + z(indorbp+count, indt+1) = z(indorbp+count, indt+1)*ii + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + z(indorbp+count, indt+2) = z(indorbp+count, indt+2)*powers(1& +& , ii, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + z(indorbp+count, indt+2) = z(indorbp+count, indt+2)*powers(2& +& , jj-1, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + z(indorbp+count, indt+2) = z(indorbp+count, indt+2)*powers(3& +& , kk, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + z(indorbp+count, indt+2) = z(indorbp+count, indt+2)*jj + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + z(indorbp+count, indt+3) = z(indorbp+count, indt+3)*powers(1& +& , ii, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + z(indorbp+count, indt+3) = z(indorbp+count, indt+3)*powers(2& +& , jj, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + z(indorbp+count, indt+3) = z(indorbp+count, indt+3)*powers(3& +& , kk-1, 0) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + z(indorbp+count, indt+3) = z(indorbp+count, indt+3)*kk + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+4)) + z(indorbp+count, indt+4) = z(indorbp+count, indt+4)*(powers(& +& 1, ii-2, 0)*powers(2, jj, 0)*powers(3, kk, 0)*ii*(ii-1)+& +& powers(1, ii, 0)*powers(2, jj-2, 0)*powers(3, kk, 0)*jj*(& +& jj-1)+powers(1, ii, 0)*powers(2, jj, 0)*powers(3, kk-2, 0)& +& *kk*(kk-1)) +! All polynomial parts are now stored +! Now solve laplacian + tmp3 = z(indorbp+count, indt+4)*distp(0, 1) + 2.0_8*z(& +& indorbp+count, indt+1)*distp(indt+1, 1) + 2.0_8*z(indorbp+& +& count, indt+2)*distp(indt+2, 1) + 2.0_8*z(indorbp+count, & +& indt+3)*distp(indt+3, 1) + z(indorbp+count, indtmin)*distp& +& (indt+4, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+4)) + z(indorbp+count, indt+4) = tmp3 +! Now solve gradients + tmp4 = z(indorbp+count, indt+1)*distp(0, 1) + z(indorbp+& +& count, indtmin)*distp(indt+1, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + z(indorbp+count, indt+1) = tmp4 + tmp5 = z(indorbp+count, indt+2)*distp(0, 1) + z(indorbp+& +& count, indtmin)*distp(indt+2, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + z(indorbp+count, indt+2) = tmp5 + tmp6 = z(indorbp+count, indt+3)*distp(0, 1) + z(indorbp+& +& count, indtmin)*distp(indt+3, 1) + CALL PUSHREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + z(indorbp+count, indt+3) = tmp6 + CALL PUSHINTEGER4(adi4ibuf,adi4buf,count) + count = count + 1 + END DO + CALL PUSHINTEGER4(adi4ibuf,adi4buf,ad_from2) + END DO + CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) + END IF + ELSE + CALL PUSHINTEGER4(adi4ibuf,adi4buf,0) + END IF +! Multiply by radial part for values + DO ii=1,multiplicity + CALL PUSHINTEGER4(adi4ibuf,adi4buf,kk) + END DO + distpb = 0.0_8 + DO ii=multiplicity,1,-1 + DO kk=indtm,i0,-1 + distpb(kk, 1) = distpb(kk, 1) + z(indorbp+ii-1, kk)*zb(indorbp+& +& ii-1, kk) + zb(indorbp+ii-1, kk) = distp(kk, 1)*zb(indorbp+ii-1, kk) + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,kk) + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 3) THEN + IF (branch .LT. 2) THEN + IF (branch .LT. 1) THEN + powersb = 0.0_8 + ELSE + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+4)) + distpb(indt+4, 1) = distpb(indt+4, 1) + zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+3)) + distpb(indt+3, 1) = distpb(indt+3, 1) + zb(indorbp, indt+3) + zb(indorbp, indt+3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+2)) + distpb(indt+2, 1) = distpb(indt+2, 1) + zb(indorbp, indt+2) + zb(indorbp, indt+2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+1)) + distpb(indt+1, 1) = distpb(indt+1, 1) + zb(indorbp, indt+1) + zb(indorbp, indt+1) = 0.0_8 + powersb = 0.0_8 + END IF + ELSE + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+4)) + temp499b4 = zb(indorbp+2, indt+4)/rp1 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(3, indtmin)*& +& temp499b4 + rmub(3, indtmin) = rmub(3, indtmin) + distp(indt+4, 1)*temp499b4 + distpb(indt+3, 1) = distpb(indt+3, 1) + 2.0d0*temp499b4 + zb(indorbp+2, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+4)) + temp499b5 = zb(indorbp+1, indt+4)/rp1 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(2, indtmin)*& +& temp499b5 + rmub(2, indtmin) = rmub(2, indtmin) + distp(indt+4, 1)*temp499b5 + distpb(indt+2, 1) = distpb(indt+2, 1) + 2.0d0*temp499b5 + zb(indorbp+1, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+4)) + temp499b6 = zb(indorbp, indt+4)/rp1 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(1, indtmin)*& +& temp499b6 + rmub(1, indtmin) = rmub(1, indtmin) + distp(indt+4, 1)*temp499b6 + distpb(indt+1, 1) = distpb(indt+1, 1) + 2.0d0*temp499b6 + zb(indorbp, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+3)) + temp499b7 = zb(indorbp+2, indt+3)/rp1 + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(3, indtmin)*& +& temp499b7 + zb(indorbp+2, indt+3) = 0.0_8 + rmub(3, indtmin) = rmub(3, indtmin) + distp(indt+2, 1)*zb(& +& indorbp+2, indt+2)/rp1 + distp(indt+3, 1)*temp499b7 + distpb(0, 1) = distpb(0, 1) + temp499b7 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+2)) + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(3, indtmin)*zb(& +& indorbp+2, indt+2)/rp1 + zb(indorbp+2, indt+2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+1)) + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(3, indtmin)*zb(& +& indorbp+2, indt+1)/rp1 + rmub(3, indtmin) = rmub(3, indtmin) + distp(indt+1, 1)*zb(& +& indorbp+2, indt+1)/rp1 + zb(indorbp+2, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+3)) + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(2, indtmin)*zb(& +& indorbp+1, indt+3)/rp1 + rmub(2, indtmin) = rmub(2, indtmin) + distp(indt+3, 1)*zb(& +& indorbp+1, indt+3)/rp1 + zb(indorbp+1, indt+3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+2)) + temp499b8 = zb(indorbp+1, indt+2)/rp1 + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(2, indtmin)*& +& temp499b8 + zb(indorbp+1, indt+2) = 0.0_8 + rmub(2, indtmin) = rmub(2, indtmin) + distp(indt+1, 1)*zb(& +& indorbp+1, indt+1)/rp1 + distp(indt+2, 1)*temp499b8 + distpb(0, 1) = distpb(0, 1) + temp499b8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+1)) + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(2, indtmin)*zb(& +& indorbp+1, indt+1)/rp1 + zb(indorbp+1, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+3)) + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(1, indtmin)*zb(& +& indorbp, indt+3)/rp1 + rmub(1, indtmin) = rmub(1, indtmin) + distp(indt+3, 1)*zb(& +& indorbp, indt+3)/rp1 + zb(indorbp, indt+3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+2)) + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(1, indtmin)*zb(& +& indorbp, indt+2)/rp1 + rmub(1, indtmin) = rmub(1, indtmin) + distp(indt+2, 1)*zb(& +& indorbp, indt+2)/rp1 + zb(indorbp, indt+2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+1)) + temp499b9 = zb(indorbp, indt+1)/rp1 + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(1, indtmin)*& +& temp499b9 + rmub(1, indtmin) = rmub(1, indtmin) + distp(indt+1, 1)*temp499b9 + distpb(0, 1) = distpb(0, 1) + temp499b9 + zb(indorbp, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + powersb = 0.0_8 + END IF + ELSE IF (branch .LT. 4) THEN + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+5, indt+4)) + temp499b10 = zb(indorbp+5, indt+4)/rp2 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(3, indtmin)**2*& +& temp499b10 + rmub(3, indtmin) = rmub(3, indtmin) + (4.0d0*distp(indt+3, 1)+& +& distp(indt+4, 1)*2*rmu(3, indtmin))*temp499b10 + distpb(indt+3, 1) = distpb(indt+3, 1) + 4.0d0*rmu(3, indtmin)*& +& temp499b10 + distpb(0, 1) = distpb(0, 1) + 2.0d0*temp499b10 + zb(indorbp+5, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+4, indt+4)) + temp499b11 = zb(indorbp+4, indt+4)/rp1 + temp499b12 = distp(indt+4, 1)*temp499b11 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(2, indtmin)*rmu(3, & +& indtmin)*temp499b11 + rmub(2, indtmin) = rmub(2, indtmin) + 2.0d0*distp(indt+3, 1)*& +& temp499b11 + rmu(3, indtmin)*temp499b12 + rmub(3, indtmin) = rmub(3, indtmin) + 2.0d0*distp(indt+2, 1)*& +& temp499b11 + rmu(2, indtmin)*temp499b12 + distpb(indt+3, 1) = distpb(indt+3, 1) + 2.0d0*rmu(2, indtmin)*& +& temp499b11 + distpb(indt+2, 1) = distpb(indt+2, 1) + 2.0d0*rmu(3, indtmin)*& +& temp499b11 + zb(indorbp+4, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+3, indt+4)) + temp499b13 = zb(indorbp+3, indt+4)/rp2 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(2, indtmin)**2*& +& temp499b13 + rmub(2, indtmin) = rmub(2, indtmin) + (4.0d0*distp(indt+2, 1)+& +& distp(indt+4, 1)*2*rmu(2, indtmin))*temp499b13 + distpb(indt+2, 1) = distpb(indt+2, 1) + 4.0d0*rmu(2, indtmin)*& +& temp499b13 + distpb(0, 1) = distpb(0, 1) + 2.0d0*temp499b13 + zb(indorbp+3, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+4)) + temp499b14 = zb(indorbp+2, indt+4)/rp1 + temp499b15 = distp(indt+4, 1)*temp499b14 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(1, indtmin)*rmu(3, & +& indtmin)*temp499b14 + rmub(1, indtmin) = rmub(1, indtmin) + 2.0d0*distp(indt+3, 1)*& +& temp499b14 + rmu(3, indtmin)*temp499b15 + rmub(3, indtmin) = rmub(3, indtmin) + 2.0d0*distp(indt+1, 1)*& +& temp499b14 + rmu(1, indtmin)*temp499b15 + distpb(indt+3, 1) = distpb(indt+3, 1) + 2.0d0*rmu(1, indtmin)*& +& temp499b14 + distpb(indt+1, 1) = distpb(indt+1, 1) + 2.0d0*rmu(3, indtmin)*& +& temp499b14 + zb(indorbp+2, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+4)) + temp499b16 = zb(indorbp+1, indt+4)/rp1 + temp499b17 = distp(indt+4, 1)*temp499b16 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(1, indtmin)*rmu(2, & +& indtmin)*temp499b16 + rmub(1, indtmin) = rmub(1, indtmin) + 2.0d0*distp(indt+2, 1)*& +& temp499b16 + rmu(2, indtmin)*temp499b17 + rmub(2, indtmin) = rmub(2, indtmin) + 2.0d0*distp(indt+1, 1)*& +& temp499b16 + rmu(1, indtmin)*temp499b17 + distpb(indt+2, 1) = distpb(indt+2, 1) + 2.0d0*rmu(1, indtmin)*& +& temp499b16 + distpb(indt+1, 1) = distpb(indt+1, 1) + 2.0d0*rmu(2, indtmin)*& +& temp499b16 + zb(indorbp+1, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+4)) + temp499b18 = zb(indorbp, indt+4)/rp2 + distpb(indt+4, 1) = distpb(indt+4, 1) + rmu(1, indtmin)**2*& +& temp499b18 + rmub(1, indtmin) = rmub(1, indtmin) + (4.0d0*distp(indt+1, 1)+& +& distp(indt+4, 1)*2*rmu(1, indtmin))*temp499b18 + distpb(indt+1, 1) = distpb(indt+1, 1) + 4.0d0*rmu(1, indtmin)*& +& temp499b18 + distpb(0, 1) = distpb(0, 1) + 2.0d0*temp499b18 + zb(indorbp, indt+4) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+5, indt+3)) + temp499b19 = zb(indorbp+5, indt+3)/rp2 + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(3, indtmin)**2*& +& temp499b19 + zb(indorbp+5, indt+3) = 0.0_8 + rmub(3, indtmin) = rmub(3, indtmin) + distp(indt+2, 1)*2*rmu(3, & +& indtmin)*zb(indorbp+5, indt+2)/rp2 + (2*distp(0, 1)+distp(indt+3& +& , 1)*2*rmu(3, indtmin))*temp499b19 + distpb(0, 1) = distpb(0, 1) + 2*rmu(3, indtmin)*temp499b19 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+5, indt+2)) + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(3, indtmin)**2*zb(& +& indorbp+5, indt+2)/rp2 + zb(indorbp+5, indt+2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+5, indt+1)) + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(3, indtmin)**2*zb(& +& indorbp+5, indt+1)/rp2 + rmub(3, indtmin) = rmub(3, indtmin) + distp(indt+1, 1)*2*rmu(3, & +& indtmin)*zb(indorbp+5, indt+1)/rp2 + zb(indorbp+5, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+4, indt+3)) + temp499b20 = zb(indorbp+4, indt+3)/rp1 + temp499b21 = distp(indt+3, 1)*temp499b20 + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(2, indtmin)*rmu(3, & +& indtmin)*temp499b20 + rmub(2, indtmin) = rmub(2, indtmin) + distp(0, 1)*temp499b20 + rmu& +& (3, indtmin)*temp499b21 + rmub(3, indtmin) = rmub(3, indtmin) + rmu(2, indtmin)*temp499b21 + distpb(0, 1) = distpb(0, 1) + rmu(2, indtmin)*temp499b20 + zb(indorbp+4, indt+3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+4, indt+2)) + temp499b22 = zb(indorbp+4, indt+2)/rp1 + temp499b23 = distp(indt+2, 1)*temp499b22 + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(2, indtmin)*rmu(3, & +& indtmin)*temp499b22 + rmub(2, indtmin) = rmub(2, indtmin) + rmu(3, indtmin)*temp499b23 + zb(indorbp+4, indt+2) = 0.0_8 + temp499b24 = rmu(2, indtmin)*zb(indorbp+4, indt+1)/rp1 + rmub(3, indtmin) = rmub(3, indtmin) + distp(indt+1, 1)*temp499b24 & +& + distp(0, 1)*temp499b22 + rmu(2, indtmin)*temp499b23 + distpb(0, 1) = distpb(0, 1) + rmu(3, indtmin)*temp499b22 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+4, indt+1)) + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(3, indtmin)*temp499b24 + rmub(2, indtmin) = rmub(2, indtmin) + distp(indt+1, 1)*rmu(3, & +& indtmin)*zb(indorbp+4, indt+1)/rp1 + zb(indorbp+4, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+3, indt+3)) + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(2, indtmin)**2*zb(& +& indorbp+3, indt+3)/rp2 + rmub(2, indtmin) = rmub(2, indtmin) + distp(indt+3, 1)*2*rmu(2, & +& indtmin)*zb(indorbp+3, indt+3)/rp2 + zb(indorbp+3, indt+3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+3, indt+2)) + temp499b25 = zb(indorbp+3, indt+2)/rp2 + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(2, indtmin)**2*& +& temp499b25 + zb(indorbp+3, indt+2) = 0.0_8 + rmub(2, indtmin) = rmub(2, indtmin) + distp(indt+1, 1)*2*rmu(2, & +& indtmin)*zb(indorbp+3, indt+1)/rp2 + (2*distp(0, 1)+distp(indt+2& +& , 1)*2*rmu(2, indtmin))*temp499b25 + distpb(0, 1) = distpb(0, 1) + 2*rmu(2, indtmin)*temp499b25 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+3, indt+1)) + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(2, indtmin)**2*zb(& +& indorbp+3, indt+1)/rp2 + zb(indorbp+3, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+3)) + temp499b26 = distp(indt+3, 1)*zb(indorbp+2, indt+3) + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(1, indtmin)*rmu(3, & +& indtmin)*zb(indorbp+2, indt+3) + rmub(1, indtmin) = rmub(1, indtmin) + distp(0, 1)*zb(indorbp+2, & +& indt+3)/rp1 + rmu(3, indtmin)*temp499b26 + distpb(0, 1) = distpb(0, 1) + rmu(1, indtmin)*zb(indorbp+2, indt+3& +& )/rp1 + zb(indorbp+2, indt+3) = 0.0_8 + temp499b27 = rmu(1, indtmin)*zb(indorbp+2, indt+2)/rp1 + rmub(3, indtmin) = rmub(3, indtmin) + distp(indt+2, 1)*temp499b27 & +& + rmu(1, indtmin)*temp499b26 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+2)) + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(3, indtmin)*temp499b27 + rmub(1, indtmin) = rmub(1, indtmin) + distp(indt+2, 1)*rmu(3, & +& indtmin)*zb(indorbp+2, indt+2)/rp1 + zb(indorbp+2, indt+2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+2, indt+1)) + temp499b28 = zb(indorbp+2, indt+1)/rp1 + temp499b29 = distp(indt+1, 1)*temp499b28 + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(1, indtmin)*rmu(3, & +& indtmin)*temp499b28 + rmub(1, indtmin) = rmub(1, indtmin) + rmu(3, indtmin)*temp499b29 + rmub(3, indtmin) = rmub(3, indtmin) + distp(0, 1)*temp499b28 + rmu& +& (1, indtmin)*temp499b29 + distpb(0, 1) = distpb(0, 1) + rmu(3, indtmin)*temp499b28 + zb(indorbp+2, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+3)) + temp499b30 = rmu(1, indtmin)*zb(indorbp+1, indt+3)/rp1 + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(2, indtmin)*temp499b30 + rmub(2, indtmin) = rmub(2, indtmin) + distp(indt+3, 1)*temp499b30 + rmub(1, indtmin) = rmub(1, indtmin) + distp(indt+3, 1)*rmu(2, & +& indtmin)*zb(indorbp+1, indt+3)/rp1 + zb(indorbp+1, indt+3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+2)) + temp499b31 = zb(indorbp+1, indt+2)/rp1 + temp499b32 = distp(indt+2, 1)*temp499b31 + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(1, indtmin)*rmu(2, & +& indtmin)*temp499b31 + rmub(1, indtmin) = rmub(1, indtmin) + distp(0, 1)*temp499b31 + rmu& +& (2, indtmin)*temp499b32 + rmub(2, indtmin) = rmub(2, indtmin) + rmu(1, indtmin)*temp499b32 + distpb(0, 1) = distpb(0, 1) + rmu(1, indtmin)*temp499b31 + zb(indorbp+1, indt+2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+1, indt+1)) + temp499b33 = zb(indorbp+1, indt+1)/rp1 + temp499b34 = distp(indt+1, 1)*temp499b33 + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(1, indtmin)*rmu(2, & +& indtmin)*temp499b33 + rmub(1, indtmin) = rmub(1, indtmin) + rmu(2, indtmin)*temp499b34 + rmub(2, indtmin) = rmub(2, indtmin) + distp(0, 1)*temp499b33 + rmu& +& (1, indtmin)*temp499b34 + distpb(0, 1) = distpb(0, 1) + rmu(2, indtmin)*temp499b33 + zb(indorbp+1, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+3)) + distpb(indt+3, 1) = distpb(indt+3, 1) + rmu(1, indtmin)**2*zb(& +& indorbp, indt+3)/rp2 + rmub(1, indtmin) = rmub(1, indtmin) + distp(indt+3, 1)*2*rmu(1, & +& indtmin)*zb(indorbp, indt+3)/rp2 + zb(indorbp, indt+3) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+2)) + distpb(indt+2, 1) = distpb(indt+2, 1) + rmu(1, indtmin)**2*zb(& +& indorbp, indt+2)/rp2 + rmub(1, indtmin) = rmub(1, indtmin) + distp(indt+2, 1)*2*rmu(1, & +& indtmin)*zb(indorbp, indt+2)/rp2 + zb(indorbp, indt+2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp, indt+1)) + temp499b35 = zb(indorbp, indt+1)/rp2 + distpb(indt+1, 1) = distpb(indt+1, 1) + rmu(1, indtmin)**2*& +& temp499b35 + rmub(1, indtmin) = rmub(1, indtmin) + (2*distp(0, 1)+distp(indt+1& +& , 1)*2*rmu(1, indtmin))*temp499b35 + distpb(0, 1) = distpb(0, 1) + 2*rmu(1, indtmin)*temp499b35 + zb(indorbp, indt+1) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + powersb = 0.0_8 + ELSE + powersb = 0.0_8 + DO ii=0,iopt-90,1 + CALL POPINTEGER4(adi4ibuf,adi4buf,ad_from2) + DO jj=0,ad_from2,1 + CALL POPINTEGER4(adi4ibuf,adi4buf,count) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + tmp6b = zb(indorbp+count, indt+3) + zb(indorbp+count, indt+3) = distp(0, 1)*tmp6b + distpb(0, 1) = distpb(0, 1) + z(indorbp+count, indt+3)*tmp6b + zb(indorbp+count, indtmin) = zb(indorbp+count, indtmin) + & +& distp(indt+3, 1)*tmp6b + distpb(indt+3, 1) = distpb(indt+3, 1) + z(indorbp+count, & +& indtmin)*tmp6b + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + tmp5b = zb(indorbp+count, indt+2) + zb(indorbp+count, indt+2) = distp(0, 1)*tmp5b + distpb(0, 1) = distpb(0, 1) + z(indorbp+count, indt+2)*tmp5b + zb(indorbp+count, indtmin) = zb(indorbp+count, indtmin) + & +& distp(indt+2, 1)*tmp5b + distpb(indt+2, 1) = distpb(indt+2, 1) + z(indorbp+count, & +& indtmin)*tmp5b + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + tmp4b = zb(indorbp+count, indt+1) + zb(indorbp+count, indt+1) = distp(0, 1)*tmp4b + distpb(0, 1) = distpb(0, 1) + z(indorbp+count, indt+1)*tmp4b + zb(indorbp+count, indtmin) = zb(indorbp+count, indtmin) + & +& distp(indt+1, 1)*tmp4b + distpb(indt+1, 1) = distpb(indt+1, 1) + z(indorbp+count, & +& indtmin)*tmp4b + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+4)) + tmp3b = zb(indorbp+count, indt+4) + zb(indorbp+count, indt+4) = distp(0, 1)*tmp3b + distpb(0, 1) = distpb(0, 1) + z(indorbp+count, indt+4)*tmp3b + zb(indorbp+count, indt+1) = zb(indorbp+count, indt+1) + 2.0_8*& +& distp(indt+1, 1)*tmp3b + distpb(indt+1, 1) = distpb(indt+1, 1) + 2.0_8*z(indorbp+count& +& , indt+1)*tmp3b + zb(indorbp+count, indt+2) = zb(indorbp+count, indt+2) + 2.0_8*& +& distp(indt+2, 1)*tmp3b + distpb(indt+2, 1) = distpb(indt+2, 1) + 2.0_8*z(indorbp+count& +& , indt+2)*tmp3b + zb(indorbp+count, indt+3) = zb(indorbp+count, indt+3) + 2.0_8*& +& distp(indt+3, 1)*tmp3b + distpb(indt+3, 1) = distpb(indt+3, 1) + 2.0_8*z(indorbp+count& +& , indt+3)*tmp3b + zb(indorbp+count, indtmin) = zb(indorbp+count, indtmin) + & +& distp(indt+4, 1)*tmp3b + distpb(indt+4, 1) = distpb(indt+4, 1) + z(indorbp+count, & +& indtmin)*tmp3b + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+4)) + temp502 = powers(3, kk-2, 0) + temp501 = powers(1, ii, 0)*powers(2, jj, 0) + temp499 = powers(1, ii, 0)*powers(3, kk, 0) + temp500 = powers(2, jj, 0)*powers(3, kk, 0) + temp501b = z(indorbp+count, indt+4)*zb(indorbp+count, indt+4) + temp501b0 = ii*(ii-1)*temp501b + temp500b = powers(1, ii-2, 0)*temp501b0 + temp500b0 = jj*(jj-1)*temp501b + temp499b36 = powers(2, jj-2, 0)*temp500b0 + temp499b37 = kk*(kk-1)*temp501b + powersb(1, ii-2, 0) = powersb(1, ii-2, 0) + temp500*temp501b0 + powersb(2, jj, 0) = powersb(2, jj, 0) + temp502*powers(1, ii, & +& 0)*temp499b37 + powers(3, kk, 0)*temp500b + powersb(3, kk, 0) = powersb(3, kk, 0) + powers(1, ii, 0)*& +& temp499b36 + powers(2, jj, 0)*temp500b + powersb(2, jj-2, 0) = powersb(2, jj-2, 0) + temp499*temp500b0 + powersb(1, ii, 0) = powersb(1, ii, 0) + temp502*powers(2, jj, & +& 0)*temp499b37 + powers(3, kk, 0)*temp499b36 + powersb(3, kk-2, 0) = powersb(3, kk-2, 0) + temp501*temp499b37 + zb(indorbp+count, indt+4) = (ii*(ii-1)*(powers(1, ii-2, 0)*& +& temp500)+jj*(jj-1)*(powers(2, jj-2, 0)*temp499)+kk*(kk-1)*(& +& temp501*temp502))*zb(indorbp+count, indt+4) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + zb(indorbp+count, indt+3) = kk*zb(indorbp+count, indt+3) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + powersb(3, kk-1, 0) = powersb(3, kk-1, 0) + z(indorbp+count, & +& indt+3)*zb(indorbp+count, indt+3) + zb(indorbp+count, indt+3) = powers(3, kk-1, 0)*zb(indorbp+& +& count, indt+3) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + powersb(2, jj, 0) = powersb(2, jj, 0) + z(indorbp+count, indt+& +& 3)*zb(indorbp+count, indt+3) + zb(indorbp+count, indt+3) = powers(2, jj, 0)*zb(indorbp+count& +& , indt+3) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+3)) + powersb(1, ii, 0) = powersb(1, ii, 0) + z(indorbp+count, indt+& +& 3)*zb(indorbp+count, indt+3) + zb(indorbp+count, indt+3) = powers(1, ii, 0)*zb(indorbp+count& +& , indt+3) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + zb(indorbp+count, indt+2) = jj*zb(indorbp+count, indt+2) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + powersb(3, kk, 0) = powersb(3, kk, 0) + z(indorbp+count, indt+& +& 2)*zb(indorbp+count, indt+2) + zb(indorbp+count, indt+2) = powers(3, kk, 0)*zb(indorbp+count& +& , indt+2) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + powersb(2, jj-1, 0) = powersb(2, jj-1, 0) + z(indorbp+count, & +& indt+2)*zb(indorbp+count, indt+2) + zb(indorbp+count, indt+2) = powers(2, jj-1, 0)*zb(indorbp+& +& count, indt+2) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+2)) + powersb(1, ii, 0) = powersb(1, ii, 0) + z(indorbp+count, indt+& +& 2)*zb(indorbp+count, indt+2) + zb(indorbp+count, indt+2) = powers(1, ii, 0)*zb(indorbp+count& +& , indt+2) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + zb(indorbp+count, indt+1) = ii*zb(indorbp+count, indt+1) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + powersb(3, kk, 0) = powersb(3, kk, 0) + z(indorbp+count, indt+& +& 1)*zb(indorbp+count, indt+1) + zb(indorbp+count, indt+1) = powers(3, kk, 0)*zb(indorbp+count& +& , indt+1) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + powersb(2, jj, 0) = powersb(2, jj, 0) + z(indorbp+count, indt+& +& 1)*zb(indorbp+count, indt+1) + zb(indorbp+count, indt+1) = powers(2, jj, 0)*zb(indorbp+count& +& , indt+1) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, indt+1)) + powersb(1, ii-1, 0) = powersb(1, ii-1, 0) + z(indorbp+count, & +& indt+1)*zb(indorbp+count, indt+1) + zb(indorbp+count, indt+1) = powers(1, ii-1, 0)*zb(indorbp+& +& count, indt+1) + CALL POPINTEGER4(adi4ibuf,adi4buf,kk) + END DO + END DO + END IF + DO k=indtm,i0,-1 + DO ii=0,iopt-90,1 + CALL POPINTEGER4(adi4ibuf,adi4buf,ad_from1) + DO jj=0,ad_from1,1 + CALL POPINTEGER4(adi4ibuf,adi4buf,count) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, k)) + powersb(3, kk, k) = powersb(3, kk, k) + z(indorbp+count, k)*zb& +& (indorbp+count, k) + zb(indorbp+count, k) = powers(3, kk, k)*zb(indorbp+count, k) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, k)) + powersb(2, jj, k) = powersb(2, jj, k) + z(indorbp+count, k)*zb& +& (indorbp+count, k) + zb(indorbp+count, k) = powers(2, jj, k)*zb(indorbp+count, k) + CALL POPREAL8(adr8ibuf,adr8buf,z(indorbp+count, k)) + powersb(1, ii, k) = powersb(1, ii, k) + z(indorbp+count, k)*zb& +& (indorbp+count, k) + zb(indorbp+count, k) = powers(1, ii, k)*zb(indorbp+count, k) + CALL POPINTEGER4(adi4ibuf,adi4buf,kk) + END DO + END DO + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (branch .LT. 1) THEN + dd1b = 0.0_8 + ELSE + CALL POPREAL8(adr8ibuf,adr8buf,distp(indt+4, 1)) + tmp2b = distpb(indt+4, 1) + distpb(indt+4, 1) = 0.0_8 + temp499b = dd1*distp(0, 1)*4.0d0*tmp2b + temp499b0 = (4.0d0*(dd1*r(0)**2)-6.0d0)*tmp2b + dd1b = distp(0, 1)*temp499b0 + r(0)**2*temp499b + rb(0) = rb(0) + dd1*2*r(0)*temp499b + distpb(0, 1) = distpb(0, 1) + dd1*temp499b0 + CALL POPREAL8(adr8ibuf,adr8buf,distp(indt+3, 1)) + tmp1b = distpb(indt+3, 1) + distpb(indt+3, 1) = 0.0_8 + temp499b1 = -(2.0d0*distp(0, 1)*tmp1b) + distpb(0, 1) = distpb(0, 1) - 2.0d0*dd1*rmu(3, 0)*tmp1b + CALL POPREAL8(adr8ibuf,adr8buf,distp(indt+2, 1)) + tmp0b = distpb(indt+2, 1) + distpb(indt+2, 1) = 0.0_8 + temp499b2 = -(2.0d0*distp(0, 1)*tmp0b) + distpb(0, 1) = distpb(0, 1) - 2.0d0*dd1*rmu(2, 0)*tmp0b + CALL POPREAL8(adr8ibuf,adr8buf,distp(indt+1, 1)) + tmpb = distpb(indt+1, 1) + temp499b3 = -(2.0d0*distp(0, 1)*tmpb) + dd1b = dd1b + rmu(2, 0)*temp499b2 + rmu(1, 0)*temp499b3 + rmu(3, 0& +& )*temp499b1 + rmub(3, 0) = rmub(3, 0) + dd1*temp499b1 + rmub(2, 0) = rmub(2, 0) + dd1*temp499b2 + distpb(indt+1, 1) = 0.0_8 + rmub(1, 0) = rmub(1, 0) + dd1*temp499b3 + distpb(0, 1) = distpb(0, 1) - 2.0d0*dd1*rmu(1, 0)*tmpb + END IF + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 1) THEN + DO ii=0,iopt-90,1 + CALL POPINTEGER4(adi4ibuf,adi4buf,ad_from0) + DO jj=0,ad_from0,1 + CALL POPINTEGER4(adi4ibuf,adi4buf,count) + zb(indorbp+count, indt+4) = zb(indorbp+count, indt+4)/DSQRT(& +& rp1) + zb(indorbp+count, indt+3) = zb(indorbp+count, indt+3)/DSQRT(& +& rp1) + zb(indorbp+count, indt+2) = zb(indorbp+count, indt+2)/DSQRT(& +& rp1) + zb(indorbp+count, indt+1) = zb(indorbp+count, indt+1)/DSQRT(& +& rp1) + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + zb(indorbp+count, indt+4) = zb(indorbp+count, indt+4)/DSQRT(& +& rp1) + zb(indorbp+count, indt+3) = zb(indorbp+count, indt+3)/DSQRT(& +& rp1) + zb(indorbp+count, indt+2) = zb(indorbp+count, indt+2)/DSQRT(& +& rp1) + zb(indorbp+count, indt+1) = zb(indorbp+count, indt+1)/DSQRT(& +& rp1) + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + zb(indorbp+count, indt+4) = zb(indorbp+count, indt+4)/DSQRT(& +& rp1) + zb(indorbp+count, indt+3) = zb(indorbp+count, indt+3)/DSQRT(& +& rp1) + zb(indorbp+count, indt+2) = zb(indorbp+count, indt+2)/DSQRT(& +& rp1) + zb(indorbp+count, indt+1) = zb(indorbp+count, indt+1)/DSQRT(& +& rp1) + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + zb(indorbp+count, indt+4) = 0.0_8 + zb(indorbp+count, indt+3) = 0.0_8 + zb(indorbp+count, indt+2) = 0.0_8 + zb(indorbp+count, indt+1) = 0.0_8 + END DO + END DO + END IF + DO k=indtm,i0,-1 + DO ii=0,iopt-90,1 + CALL POPINTEGER4(adi4ibuf,adi4buf,ad_from) + DO jj=0,ad_from,1 + CALL POPINTEGER4(adi4ibuf,adi4buf,count) + zb(indorbp+count, k) = zb(indorbp+count, k)/DSQRT(rp1) + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + zb(indorbp+count, k) = zb(indorbp+count, k)/DSQRT(rp1) + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + zb(indorbp+count, k) = zb(indorbp+count, k)/DSQRT(rp1) + CALL POPREAL8(adr8ibuf,adr8buf,rp1) + zb(indorbp+count, k) = 0.0_8 + END DO + END DO + END DO + cb = 0.0_8 + DO k=indtm,i0,-1 + temp498 = r(k)**2 + temp498b = c*DEXP(-(dd1*temp498))*distpb(k, 1) + dd1b = dd1b - temp498*temp498b + rb(k) = rb(k) - dd1*2*r(k)*temp498b + cb = cb + DEXP(-(dd1*temp498))*distpb(k, 1) + distpb(k, 1) = 0.0_8 + END DO + CALL POPINTEGER4(adi4ibuf,adi4buf,branch) + IF (.NOT.branch .LT. 1) THEN + CALL POPREAL8(adr8ibuf,adr8buf,c) + temp497 = (iopt-90)/2.0_8 + IF (.NOT.(8_4*dd1 .LE. 0.0 .AND. (temp497 .EQ. 0.0 .OR. temp497 & +& .NE. INT(temp497)))) dd1b = dd1b + c*temp497*(8_4*dd1)**(& +& temp497-1)*8_4*cb + cb = (8_4*dd1)**temp497*cb + END IF + dd1b = dd1b + 0.712705470354990_8*0.75_8*dd1**(-0.242)*cb + DO ii=iopt-90,1,-1 + DO k=indtm,indtmin,-1 + CALL POPREAL8(adr8ibuf,adr8buf,powers(3, ii, k)) + powersb(3, ii-1, k) = powersb(3, ii-1, k) + rmu(3, k)*powersb(3& +& , ii, k) + rmub(3, k) = rmub(3, k) + powers(3, ii-1, k)*powersb(3, ii, k) + powersb(3, ii, k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,powers(2, ii, k)) + powersb(2, ii-1, k) = powersb(2, ii-1, k) + rmu(2, k)*powersb(2& +& , ii, k) + rmub(2, k) = rmub(2, k) + powers(2, ii-1, k)*powersb(2, ii, k) + powersb(2, ii, k) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,powers(1, ii, k)) + powersb(1, ii-1, k) = powersb(1, ii-1, k) + rmu(1, k)*powersb(1& +& , ii, k) + rmub(1, k) = rmub(1, k) + powers(1, ii-1, k)*powersb(1, ii, k) + powersb(1, ii, k) = 0.0_8 + END DO + END DO + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (117) +! 2s double lorentian with constant parent of 102 +! (dd3+r^3/(1+dd5*r)^4; + dd5 = dd(indpar+2) + indorbp = indorb + 1 +! write(6,*) ' function inside = ',z(indorbp,i) +! endif + IF (typec .NE. 1) THEN + fun = -(r(0)*(-3.d0+dd5*r(0))/(1.d0+dd5*r(0))**5) + fun2b = zb(indorbp, indt+4) + funb0 = 2.d0*zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + temp507 = (dd5*r(0)+1.d0)**6 + temp506 = r(0)/temp507 + temp507b = 2.d0*temp506*fun2b + temp507b0 = 2*dd5*r(0)*temp507b + temp506b = 2.d0*((dd5*r(0))**2-6.d0*(dd5*r(0))+3.d0)*fun2b/temp507 + temp506b0 = -(temp506*6*(dd5*r(0)+1.d0)**5*temp506b) + temp505 = (dd5*r(0)+1.d0)**5 + temp505b = -(funb0/temp505) + temp505b0 = -(r(0)*(dd5*r(0)-3.d0)*5*(dd5*r(0)+1.d0)**4*temp505b/& +& temp505) + dd5b = r(0)**2*temp505b + r(0)*temp505b0 + r(0)*temp506b0 - 6.d0*r& +& (0)*temp507b + r(0)*temp507b0 + rb(0) = rb(0) + (r(0)*dd5+dd5*r(0)-3.d0)*temp505b + dd5*temp505b0 & +& + dd5*temp506b0 + temp506b - 6.d0*dd5*temp507b + dd5*temp507b0 + ELSE + dd5b = 0.0_8 + END IF + distpb = 0.0_8 + dd3b = 0.0_8 + DO i=indtm,i0,-1 + dd3b = dd3b + zb(indorbp, i) + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + DO k=indtm,indtmin,-1 + temp503 = dd5*r(k) + 1.d0 + temp504 = temp503**4 + temp503b = -(r(k)**3*4*temp503**3*distpb(k, 1)/temp504**2) + rb(k) = rb(k) + dd5*temp503b + 3*r(k)**2*distpb(k, 1)/temp504 + dd5b = dd5b + r(k)*temp503b + distpb(k, 1) = 0.0_8 + END DO + ddb(indpar+2) = ddb(indpar+2) + dd5b + ddb(indpar+1) = ddb(indpar+1) + dd3b + CASE (50) +! R(r)=(c0*r**4+c1*r**3)*exp(-z1*r) +! +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then + c = DSQRT((2*dd1)**9/40320.d0/pi)/2.d0 +! endif + c0 = -c + c1 = 4.5d0*c/dd1 + DO k=indtmin,indtm + distp(k, 1) = r(k)*DEXP(-(dd1*r(k))) + END DO + IF (typec .NE. 1) THEN + rp1 = r(0)*dd1 + rp2 = rp1*rp1 +!c the first derivative/r + fun = -(distp(0, 1)*(c0*r(0)*(rp1-4.d0)+c1*(rp1-3.d0))) +!c +!c the second derivative + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp511 = rp2 - 8.d0*rp1 + 12.d0 + temp510 = c0*r(0) + temp510b0 = distp(0, 1)*fun2b + distpb(0, 1) = (temp510*temp511+c1*(rp2-6*rp1+6.d0))*fun2b - (c0*r& +& (0)*(rp1-4.d0)+c1*(rp1-3.d0))*funb0 + temp510b1 = -(distp(0, 1)*funb0) + c0b = (rp1-4.d0)*r(0)*temp510b1 + temp511*r(0)*temp510b0 + rp2b = (c1+temp510)*temp510b0 + rp1b = (c1+c0*r(0))*temp510b1 + 2*rp1*rp2b + ((-6)*c1-temp510*8.d0& +& )*temp510b0 + rb(0) = rb(0) + (rp1-4.d0)*c0*temp510b1 + dd1*rp1b + temp511*c0*& +& temp510b0 + c1b = (rp1-3.d0)*temp510b1 + (rp2-6*rp1+6.d0)*temp510b0 + dd1b = r(0)*rp1b + ELSE + distpb = 0.0_8 + c0b = 0.0_8 + c1b = 0.0_8 + dd1b = 0.0_8 + END IF + DO i=indtm,i0,-1 + temp510b = distp(i, 1)*zb(indorbp, i) + temp509 = r(i)**3 + c0b = c0b + temp509*temp510b + rb(i) = rb(i) + (c1*2*r(i)+c0*3*r(i)**2)*temp510b + c1b = c1b + r(i)**2*temp510b + distpb(i, 1) = distpb(i, 1) + (c0*temp509+c1*r(i)**2)*zb(indorbp, & +& i) + zb(indorbp, i) = 0.0_8 + END DO + DO k=indtm,indtmin,-1 + temp509b0 = r(k)*DEXP(-(dd1*r(k)))*distpb(k, 1) + rb(k) = rb(k) + DEXP(-(dd1*r(k)))*distpb(k, 1) - dd1*temp509b0 + dd1b = dd1b - r(k)*temp509b0 + distpb(k, 1) = 0.0_8 + END DO + temp509b = 4.5d0*c1b/dd1 + cb = temp509b - c0b + temp508 = 2**9 + IF (temp508*(dd1**9/(40320.d0*pi)) .EQ. 0.0) THEN + dd1b = dd1b - c*temp509b/dd1 + ELSE + dd1b = dd1b + temp508*9*dd1**8*cb/(2.d0*2.D0*DSQRT(temp508*(dd1**9& +& /(40320.d0*pi)))*40320.d0*pi) - c*temp509b/dd1 + END IF + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (3) +! +! +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) + dd2 = dd(indpar+2) + peff = dd(indpar+3) +! if(iflagnorm.gt.2) then + c = 1.d0/2.d0/DSQRT(2.d0*pi*(1.d0/(2.d0*dd1)**3+2.d0*peff/(dd1+dd2)& +& **3+peff**2/(2.d0*dd2)**3)) + ad_from3 = indpar + 1 +! endif + DO i=ad_from3,indpar+2 + DO k=indtmin,indtm + distp(k, i-indpar) = c*DEXP(-(dd(i)*r(k))) + END DO + END DO + CALL PUSHINTEGER4(adi4ibuf,adi4buf,i - 1) + CALL PUSHINTEGER4(adi4ibuf,adi4buf,ad_from3) + IF (typec .NE. 1) THEN + fun = -(dd1*distp(0, 1)) - peff*dd2*distp(0, 2) + distpb = 0.0_8 + temp521 = dd1/r(0) + temp521b = -(distp(0, 1)*2.d0*zb(indorbp, indt+4)/r(0)) + temp521b0 = peff*distp(0, 2)*zb(indorbp, indt+4) + temp520 = dd2/r(0) + temp520b = -(2.d0*temp521b0/r(0)) + temp520b0 = (dd2**2-2.d0*temp520)*zb(indorbp, indt+4) + dd1b = temp521b + distp(0, 1)*2*dd1*zb(indorbp, indt+4) + rb(0) = rb(0) - temp520*temp520b - temp521*temp521b + distpb(0, 1) = (dd1**2-2.d0*temp521)*zb(indorbp, indt+4) + dd2b = temp520b + 2*dd2*temp521b0 + peffb = distp(0, 2)*temp520b0 + distpb(0, 2) = peff*temp520b0 + zb(indorbp, indt+4) = 0.0_8 + funb0 = 0.0_8 + DO i=3,1,-1 + temp519 = fun/r(0) + temp519b = rmu(i, 0)*zb(indorbp, indt+i)/r(0) + rmub(i, 0) = rmub(i, 0) + temp519*zb(indorbp, indt+i) + funb0 = funb0 + temp519b + rb(0) = rb(0) - temp519*temp519b + zb(indorbp, indt+i) = 0.0_8 + END DO + dd1b = dd1b - distp(0, 1)*funb0 + distpb(0, 1) = distpb(0, 1) - dd1*funb0 + peffb = peffb - distp(0, 2)*dd2*funb0 + dd2b = dd2b - distp(0, 2)*peff*funb0 + distpb(0, 2) = distpb(0, 2) - peff*dd2*funb0 + ELSE + distpb = 0.0_8 + peffb = 0.0_8 + dd1b = 0.0_8 + dd2b = 0.0_8 + END IF + DO i=indtm,i0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + peffb = peffb + distp(i, 2)*zb(indorbp, i) + distpb(i, 2) = distpb(i, 2) + peff*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 + END DO + cb = 0.0_8 + CALL POPINTEGER4(adi4ibuf,adi4buf,ad_from3) + CALL POPINTEGER4(adi4ibuf,adi4buf,ad_to) + DO i=ad_to,ad_from3,-1 + DO k=indtm,indtmin,-1 + temp518 = -(dd(i)*r(k)) + temp518b = c*DEXP(temp518)*distpb(k, i-indpar) + cb = cb + DEXP(temp518)*distpb(k, i-indpar) + ddb(i) = ddb(i) - r(k)*temp518b + rb(k) = rb(k) - dd(i)*temp518b + distpb(k, i-indpar) = 0.0_8 + END DO + END DO + temp517 = 2.d0**3*dd2**3 + temp516 = peff**2/temp517 + temp515 = (dd1+dd2)**3 + temp514 = 2.d0**3*dd1**3 + temp513 = 2.d0*pi*(1.0/temp514+2.d0*peff/temp515+temp516) + temp512 = DSQRT(temp513) + IF (temp513 .EQ. 0.0) THEN + temp512b = 0.0 + ELSE + temp512b = -(pi*cb/(temp512**2*2.D0*DSQRT(temp513))) + END IF + temp512b0 = 2.d0*temp512b/temp515 + temp512b1 = -(peff*3*(dd1+dd2)**2*temp512b0/temp515) + dd1b = dd1b + temp512b1 - 2.d0**3*3*dd1**2*temp512b/temp514**2 + peffb = peffb + 2*peff*temp512b/temp517 + temp512b0 + dd2b = dd2b + temp512b1 - temp516*2.d0**3*3*dd2**2*temp512b/temp517 + ddb(indpar+3) = ddb(indpar+3) + peffb + ddb(indpar+2) = ddb(indpar+2) + dd2b + ddb(indpar+1) = ddb(indpar+1) + dd1b + CASE (124) +! 2s 2pz Hybryd single Z +! 2s double exp with constant and cusp cond. +! (dd3+ exp (-dd2 r)*(1+dd2*r)+dd4*exp(-dd5*r)*(1+dd5*r)) + dd2 = dd(indpar+1) + dd4 = dd(indpar+3) + dd5 = dd(indpar+4) + indorbp = indorb + 1 + DO k=indtmin,indtm + distp(k, 3) = DEXP(-(dd2*r(k))) + distp(k, 4) = DEXP(-(dd5*r(k))) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(k, 1)) + distp(k, 1) = distp(k, 3)*(1.d0+dd2*r(k)) + CALL PUSHREAL8(adr8ibuf,adr8buf,distp(k, 2)) + distp(k, 2) = distp(k, 4)*(1.d0+dd5*r(k)) + END DO +! write(6,*) ' function inside = ',z(indorbp,i) +! endif + IF (typec .NE. 1) THEN + fun = -(dd2**2*distp(0, 3)) - dd5**2*dd4*distp(0, 4) + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 + END DO + distpb = 0.0_8 + temp522b3 = -((1.d0-dd2*r(0))*fun2b) + temp522b4 = -(dd2**2*distp(0, 3)*fun2b) + temp522b5 = -((1.d0-dd5*r(0))*fun2b) + temp522b6 = dd5**2*temp522b5 + temp522b7 = -(dd5**2*dd4*distp(0, 4)*fun2b) + dd2b = distp(0, 3)*2*dd2*temp522b3 - r(0)*temp522b4 - distp(0, 3)*& +& 2*dd2*funb0 + distpb(0, 3) = dd2**2*temp522b3 + rb(0) = rb(0) - dd5*temp522b7 - dd2*temp522b4 + dd5b = dd4*distp(0, 4)*2*dd5*temp522b5 - r(0)*temp522b7 - dd4*& +& distp(0, 4)*2*dd5*funb0 + temp522b8 = -(dd5**2*funb0) + dd4b = distp(0, 4)*temp522b8 + distp(0, 4)*temp522b6 + distpb(0, 4) = dd4*temp522b6 + distpb(0, 3) = distpb(0, 3) - dd2**2*funb0 + distpb(0, 4) = distpb(0, 4) + dd4*temp522b8 ELSE distpb = 0.0_8 dd2b = 0.0_8 + dd4b = 0.0_8 + dd5b = 0.0_8 END IF - DO ic=5,1,-1 - DO i=indtm,i0,-1 - distpb(i, 1+ic) = distpb(i, 1+ic) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + distp(i, 1+ic)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - DO i=indtm,indtmin,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) - distpb(i, 2) = 0.0_8 + dd3b = 0.0_8 + DO i=indtm,i0,-1 + distpb(i, 1) = distpb(i, 1) + zb(indorbp, i) + dd3b = dd3b + zb(indorbp, i) + dd4b = dd4b + distp(i, 2)*zb(indorbp, i) + distpb(i, 2) = distpb(i, 2) + dd4*zb(indorbp, i) + zb(indorbp, i) = 0.0_8 END DO DO k=indtm,indtmin,-1 - temp514 = r(k)**2 - temp513 = 2*npower - temp513b3 = r(k)**temp513*DEXP(-(dd2*temp514))*distpb(k, 1) - IF (r(k) .LE. 0.0 .AND. (temp513 .EQ. 0.0 .OR. temp513 .NE. INT(& -& temp513))) THEN - rb(k) = rb(k) - dd2*2*r(k)*temp513b3 - ELSE - rb(k) = rb(k) + DEXP(-(dd2*temp514))*temp513*r(k)**(temp513-1)*& -& distpb(k, 1) - dd2*2*r(k)*temp513b3 - END IF - dd2b = dd2b - temp514*temp513b3 + CALL POPREAL8(adr8ibuf,adr8buf,distp(k, 2)) + temp522b = distp(k, 4)*distpb(k, 2) + distpb(k, 4) = distpb(k, 4) + (dd5*r(k)+1.d0)*distpb(k, 2) + distpb(k, 2) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,distp(k, 1)) + temp522b0 = distp(k, 3)*distpb(k, 1) + distpb(k, 3) = distpb(k, 3) + (dd2*r(k)+1.d0)*distpb(k, 1) distpb(k, 1) = 0.0_8 + temp522b1 = DEXP(-(dd5*r(k)))*distpb(k, 4) + dd5b = dd5b + r(k)*temp522b - r(k)*temp522b1 + distpb(k, 4) = 0.0_8 + temp522b2 = DEXP(-(dd2*r(k)))*distpb(k, 3) + rb(k) = rb(k) + dd2*temp522b0 - dd2*temp522b2 - dd5*temp522b1 + & +& dd5*temp522b + dd2b = dd2b + r(k)*temp522b0 - r(k)*temp522b2 + distpb(k, 3) = 0.0_8 END DO + ddb(indpar+4) = ddb(indpar+4) + dd5b + ddb(indpar+3) = ddb(indpar+3) + dd4b + ddb(indpar+2) = ddb(indpar+2) + dd3b ddb(indpar+1) = ddb(indpar+1) + dd2b - CASE (2200:2299) -! d gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative 1200 - npower = iopt + 1 - 2200 -! indorbp=indorb - dd2 = dd(indpar+1) - DO k=indtmin,indtm - distp(k, 1) = -(r(k)**(2*npower)*DEXP(-(dd2*r(k)**2))) - END DO + CASE (28) +! R(r)=(Z*b*r)^4/(1+(Z*b*r)^4)*exp(-z*r) orbital 1s (no cusp) +! d -> b1s (defined in module constants) +! normadization: cost1s, depends on b1s +! if(iocc(indshellp).eq.1) then + indorbp = indorb + 1 + dd1 = dd(indpar+1) +! if(iflagnorm.gt.2) then +! if(dd1.gt.0.) then + c = cost1s*dd1**1.5d0 +! else +! c=1.d0 +! endif +! endif DO i=indtmin,indtm - distp(i, 2) = (3.d0*rmu(3, i)**2-r(i)**2)*cost1d - distp(i, 3) = (rmu(1, i)**2-rmu(2, i)**2)*cost2d - distp(i, 4) = rmu(1, i)*rmu(2, i)*cost3d - distp(i, 5) = rmu(2, i)*rmu(3, i)*cost3d - distp(i, 6) = rmu(1, i)*rmu(3, i)*cost3d + distp(i, 1) = c*DEXP(-(dd1*r(i))) END DO - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic + DO i=i0,indtm + CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) + rp4 = (dd1*b1s*r(i))**4 END DO -! endif IF (typec .NE. 1) THEN - rp1 = r(0)**2 - fun0 = distp(0, 1) - fun = (npower-dd2*rp1)*distp(0, 1)*2.d0/rp1 - fun2 = (npower*(2.d0*npower-1.d0)-(1.d0+4.d0*npower)*dd2*rp1+2.d0*& -& (dd2*rp1)**2)*distp(0, 1)*2.d0/rp1 -! indorbp=indorb - DO ic=1,5 - CALL PUSHINTEGER4(adi4ibuf,adi4buf,indorbp) -! if(iocc(indshell+ic).eq.1) then - indorbp = indorb + ic - DO i=1,3 - IF (ic .EQ. 1) THEN - IF (i .NE. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,1) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,2) - END IF - ELSE IF (ic .EQ. 2) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,3) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,5) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,4) - END IF - ELSE IF (ic .EQ. 3) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,6) - ELSE IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,8) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,7) - END IF - ELSE IF (ic .EQ. 4) THEN - IF (i .EQ. 2) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,9) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,11) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,10) - END IF - ELSE IF (ic .EQ. 5) THEN - IF (i .EQ. 1) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,13) - ELSE IF (i .EQ. 3) THEN - CALL PUSHINTEGER4(adi4ibuf,adi4buf,15) - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,14) - END IF - ELSE - CALL PUSHINTEGER4(adi4ibuf,adi4buf,12) - END IF - END DO + rp1 = dd1*b1s*r(0) + rp2 = rp1**2 + CALL PUSHREAL8(adr8ibuf,adr8buf,rp4) + rp4 = rp2**2 + rp5 = r(0)*dd1 + rp6 = (b1s*dd1)**2*rp2 +! the first derivative /r + fun = -(distp(0, 1)*rp6*(-4.d0+rp5+rp4*rp5)/(1.d0+rp4)**2) +! the second derivative derivative + funb0 = 2.d0*zb(indorbp, indt+4) + fun2b = zb(indorbp, indt+4) + zb(indorbp, indt+4) = 0.0_8 + DO i=3,1,-1 + funb0 = funb0 + rmu(i, 0)*zb(indorbp, indt+i) + rmub(i, 0) = rmub(i, 0) + fun*zb(indorbp, indt+i) + zb(indorbp, indt+i) = 0.0_8 END DO distpb = 0.0_8 - funb = 0.0_8 - fun0b = 0.0_8 - fun2b = 0.0_8 - DO ic=5,1,-1 - temp521b6 = distp(0, 1+ic)*zb(indorbp, indt+4) - distpb(0, 1+ic) = distpb(0, 1+ic) + (6.d0*fun+fun2)*zb(indorbp, & -& indt+4) - funb = funb + 6.d0*temp521b6 - fun2b = fun2b + temp521b6 - zb(indorbp, indt+4) = 0.0_8 - DO i=3,1,-1 - CALL POPINTEGER4(adi4ibuf,adi4buf,branch) - IF (branch .LT. 9) THEN - IF (branch .LT. 5) THEN - IF (branch .LT. 3) THEN - IF (branch .LT. 2) THEN - temp521b2 = -(cost1d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp521b2 - fun0b = fun0b + rmu(i, 0)*temp521b2 - ELSE - temp521b3 = cost1d*4.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp521b3 - fun0b = fun0b + rmu(i, 0)*temp521b3 - END IF - ELSE IF (branch .LT. 4) THEN - temp521b4 = cost2d*2.d0*zb(indorbp, indt+i) - rmub(i, 0) = rmub(i, 0) + fun0*temp521b4 - fun0b = fun0b + rmu(i, 0)*temp521b4 - END IF - ELSE IF (branch .LT. 7) THEN - IF (branch .LT. 6) THEN - temp521b5 = -(cost2d*2.d0*zb(indorbp, indt+i)) - rmub(i, 0) = rmub(i, 0) + fun0*temp521b5 - fun0b = fun0b + rmu(i, 0)*temp521b5 - ELSE - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (.NOT.branch .LT. 8) THEN - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 13) THEN - IF (branch .LT. 11) THEN - IF (branch .LT. 10) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i& -& ) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 12) THEN - rmub(2, 0) = rmub(2, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(2, 0)*zb(indorbp, indt+i) - END IF - ELSE IF (branch .LT. 15) THEN - IF (branch .LT. 14) THEN - rmub(3, 0) = rmub(3, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(3, 0)*zb(indorbp, indt+i) - END IF - ELSE - rmub(1, 0) = rmub(1, 0) + cost3d*fun0*zb(indorbp, indt+i) - fun0b = fun0b + cost3d*rmu(1, 0)*zb(indorbp, indt+i) - END IF - temp521b1 = distp(0, 1+ic)*zb(indorbp, indt+i) - distpb(0, 1+ic) = distpb(0, 1+ic) + rmu(i, 0)*fun*zb(indorbp, & -& indt+i) - rmub(i, 0) = rmub(i, 0) + fun*temp521b1 - funb = funb + rmu(i, 0)*temp521b1 - zb(indorbp, indt+i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) - END DO - temp520 = distp(0, 1)/rp1 - temp521b = 2.d0*temp520*fun2b - temp521b0 = -((npower*4.d0+1.d0)*temp521b) - temp520b = 2.d0*(npower*(npower*2.d0-1.d0)+2.d0*(dd2**2*rp1**2)-(& -& npower*4.d0+1.d0)*(dd2*rp1))*fun2b/rp1 - temp519 = distp(0, 1)/rp1 - temp520b0 = 2.d0*temp519*funb - dd2b = rp1*temp521b0 - rp1*temp520b0 + 2.d0*rp1**2*2*dd2*temp521b - temp519b = 2.d0*(npower-dd2*rp1)*funb/rp1 - rp1b = dd2*temp521b0 - temp519*temp519b - temp520*temp520b - dd2*& -& temp520b0 + 2.d0*dd2**2*2*rp1*temp521b - distpb(0, 1) = distpb(0, 1) + temp519b + fun0b + temp520b - rb(0) = rb(0) + 2*r(0)*rp1b + temp526 = (rp4+1.d0)**3 + temp525 = distp(0, 1)*rp6/temp526 + temp526b = temp525*fun2b + temp526b0 = 2*rp4*rp5*temp526b + temp525b = (rp5**2-8*rp5-20*rp4+2*(rp4*rp5**2)-8*(rp4*rp5)+(rp4*& +& rp5)**2+12.d0)*fun2b/temp526 + temp524 = (rp4+1.d0)**2 + temp523 = distp(0, 1)*rp6/temp524 + temp523b = -(temp523*funb0) + rp5b = (rp4+1.0_8)*temp523b + rp4*temp526b0 + (2**2*rp4*rp5-8*rp4+& +& 2*rp5-8)*temp526b + temp523b0 = -((rp5+rp4*rp5-4.d0)*funb0/temp524) + rp4b = rp5*temp523b - temp523*2*(rp4+1.d0)*temp523b0 - temp525*3*(& +& rp4+1.d0)**2*temp525b + rp5*temp526b0 + (2*rp5**2-8*rp5-20)*& +& temp526b + distpb(0, 1) = rp6*temp523b0 + rp6*temp525b + rp6b = distp(0, 1)*temp523b0 + distp(0, 1)*temp525b + temp523b1 = b1s**2*rp6b + rp2b = 2*rp2*rp4b + dd1**2*temp523b1 + rp1b = 2*rp1*rp2b + dd1b = r(0)*rp5b + b1s*r(0)*rp1b + rp2*2*dd1*temp523b1 + rb(0) = rb(0) + b1s*dd1*rp1b + dd1*rp5b + CALL POPREAL8(adr8ibuf,adr8buf,rp4) ELSE distpb = 0.0_8 - dd2b = 0.0_8 + dd1b = 0.0_8 END IF - DO ic=5,1,-1 - DO i=indtm,i0,-1 - distpb(i, 1+ic) = distpb(i, 1+ic) + distp(i, 1)*zb(indorbp, i) - distpb(i, 1) = distpb(i, 1) + distp(i, 1+ic)*zb(indorbp, i) - zb(indorbp, i) = 0.0_8 - END DO - CALL POPINTEGER4(adi4ibuf,adi4buf,indorbp) + DO i=indtm,i0,-1 + temp522 = rp4/(rp4+1.d0) + temp522b10 = distp(i, 1)*zb(indorbp, i)/(rp4+1.d0) + distpb(i, 1) = distpb(i, 1) + temp522*zb(indorbp, i) + rp4b = (1.0_8-temp522)*temp522b10 + zb(indorbp, i) = 0.0_8 + CALL POPREAL8(adr8ibuf,adr8buf,rp4) + temp522b11 = 4*b1s**4*dd1**3*r(i)**3*rp4b + dd1b = dd1b + r(i)*temp522b11 + rb(i) = rb(i) + dd1*temp522b11 END DO + cb = 0.0_8 DO i=indtm,indtmin,-1 - rmub(1, i) = rmub(1, i) + cost3d*rmu(3, i)*distpb(i, 6) - rmub(3, i) = rmub(3, i) + cost3d*rmu(1, i)*distpb(i, 6) - distpb(i, 6) = 0.0_8 - rmub(2, i) = rmub(2, i) + cost3d*rmu(3, i)*distpb(i, 5) - rmub(3, i) = rmub(3, i) + cost3d*rmu(2, i)*distpb(i, 5) - distpb(i, 5) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost3d*rmu(2, i)*distpb(i, 4) - rmub(2, i) = rmub(2, i) + cost3d*rmu(1, i)*distpb(i, 4) - distpb(i, 4) = 0.0_8 - rmub(1, i) = rmub(1, i) + cost2d*2*rmu(1, i)*distpb(i, 3) - rmub(2, i) = rmub(2, i) - cost2d*2*rmu(2, i)*distpb(i, 3) - distpb(i, 3) = 0.0_8 - rmub(3, i) = rmub(3, i) + cost1d*3.d0*2*rmu(3, i)*distpb(i, 2) - rb(i) = rb(i) - cost1d*2*r(i)*distpb(i, 2) - distpb(i, 2) = 0.0_8 - END DO - DO k=indtm,indtmin,-1 - temp518 = r(k)**2 - temp517 = 2*npower - temp517b7 = -(r(k)**temp517*DEXP(-(dd2*temp518))*distpb(k, 1)) - IF (r(k) .LE. 0.0 .AND. (temp517 .EQ. 0.0 .OR. temp517 .NE. INT(& -& temp517))) THEN - rb(k) = rb(k) - dd2*2*r(k)*temp517b7 - ELSE - rb(k) = rb(k) - dd2*2*r(k)*temp517b7 - DEXP(-(dd2*temp518))*& -& temp517*r(k)**(temp517-1)*distpb(k, 1) - END IF - dd2b = dd2b - temp518*temp517b7 - distpb(k, 1) = 0.0_8 + temp522b9 = c*DEXP(-(dd1*r(i)))*distpb(i, 1) + cb = cb + DEXP(-(dd1*r(i)))*distpb(i, 1) + dd1b = dd1b - r(i)*temp522b9 + rb(i) = rb(i) - dd1*temp522b9 + distpb(i, 1) = 0.0_8 END DO - ddb(indpar+1) = ddb(indpar+1) + dd2b + dd1b = dd1b + cost1s*1.5d0*dd1**0.5D0*cb + ddb(indpar+1) = ddb(indpar+1) + dd1b CASE DEFAULT distpb = 0.0_8 END SELECT diff --git a/src/c_adjoint_forward/compute_fast.f90 b/src/c_adjoint_forward/compute_fast.f90 index 1111047..c55ee21 100644 --- a/src/c_adjoint_forward/compute_fast.f90 +++ b/src/c_adjoint_forward/compute_fast.f90 @@ -25,11 +25,6 @@ subroutine compute_eloc_logpsi(indt, indt4, indt4j, nelorb, nelup, neldo & ! variables contraction and contractionj in the main, respectively ! (>0 if contracted orbitals are used). - - ! nelorbjmax=max(nelorbj,1) - ! neldomax=max(neldo,1) - ! indtmax=max(indt,1) - ! nshelljmax=max(nshellj,1) #ifdef _NVTX use nvtx #endif @@ -45,8 +40,9 @@ subroutine compute_eloc_logpsi(indt, indt4, indt4j, nelorb, nelup, neldo & &, ndiff, n_body_on, gamma, lrdmc_der, lrdmc_nonodes & &, molecular, npar_eagp, eagp_pfaff, timings, cutweight & &, true_wagner, npow, membig, membigcpu & - &,count_zerowf,count_allwf,yes_crystalj,nelsquare,vpotsav_ee & - &,yes_sparse,nnozeroj,nelorbjh2,nozeroj, norm_metric + &, count_zerowf,count_allwf,yes_crystalj,nelsquare,vpotsav_ee & + &, yes_sparse,nnozeroj,nelorbjh2,nozeroj, norm_metric & + &, use_qmckl, qmckl_ctx implicit none integer nelup, nelused, neldo, nel, i, j, k, ierr, j1, j2, info & @@ -67,33 +63,33 @@ subroutine compute_eloc_logpsi(indt, indt4, indt4j, nelorb, nelup, neldo & &, kion(*), kionj(*)& &, ioccj(*), nparpshell(lmax, ncore), kindion(ncore + 1)& &, indtm(nelup + neldo), pshell(ncore), jpseudo(lmax, ncore), ipsip(*) - real*8 tabpip(nelup + neldo, indt + 4), tmu(nelup + neldo, max(indt, 1)) & - &, psip(*), winv(ipc * nelorb, 0:indt4, nelup + neldo) & - &, winvj(nelorbjmax, 0:indt4j, nelup + neldo) & - &, winvup(ipc * nelup, indt + 4), winvdo(max(ipc * neldo, 1), indt + 4)& - &, ainv(ipc * nelup_mat, nelup_mat) & - &, ainvup(ipc * nelup, nelorbh), ainvdo(max(ipc * neldo, 1), nelorbh), ukwald & - &, wconfn, vj(*), vju(*), dist_kel(3) & - &, jastrow1, dd(*), zeta(nion), grad1(3), grad2, rion(3, nion) & - &, iond(nion, nion) & - &, dist(nion, nelup + neldo), r(0:indt,nion), rmu(3,0:indt, nion) & - &, ivic(3, indtmax, nelup + neldo), alat, plat(3), vold & - &, vpot, vpotreg(2, *) & - &, rc(3), winvbar(ipf * ipc * nelorbh, nel_mat), detmat(ipc * ipf * nelorbh, *)& - &, winvjbar(max(int(ipj * nelorbjh,8)*(nelup+neldo),1)), jasmat(*), cnorm(*) & - &, prefactor(indt - istart + 1, nelup + neldo), pseudolocal(nelup + neldo)& - &, rcutoff(ncore) & - &, parshell(3, *), wpseudo(2 * lmax), legendre(lmax - 1, nintpseudo)& - &, versor(3, nintpseudo)& - &, wintpseudo(nintpseudo), vpseudolocal, costz(*), costz3(*), costz0 & - &, angle(18, *), logpsi(ipc), eloc(ipc), psidetln, psidetlnt(ipc), jasmatsz(*) & - &, winvjbarsz(*) & - &, iond_cart(3, nion, nion), cutreg& - &, mu_c(*), cellscalen(12), celldmo(6), detmat_c(*), projm(*)& - &, muj_c(*), jasmat_c(*), jasmatsz_c(*), psisn, cost, psidetln_old& - &, jastrowee_old, jastrowei_old, winvjbar_old, winvjbarsz_old, ainv_old& - &, winvfn_old, winvbar_old, winvbarfn_old, winvup_old, winvdo_old& - &, winvuplap_old, winvdolap_old, logpsi_old, agp_old, vpotreg_old, tmu_old, kel_old, tabpip_old(2),timep + real*8 tabpip(nelup + neldo, indt + 4), tmu(nelup + neldo, max(indt, 1))& + &, psip(*), winv(ipc * nelorb, 0:indt4, nelup + neldo) & + &, winvj(nelorbjmax, 0:indt4j, nelup + neldo) & + &, winvup(ipc * nelup, indt + 4), winvdo(max(ipc * neldo, 1), indt + 4)& + &, ainv(ipc * nelup_mat, nelup_mat) & + &, ainvup(ipc * nelup, nelorbh), ainvdo(max(ipc * neldo, 1), nelorbh), ukwald& + &, wconfn, vj(*), vju(*), dist_kel(3) & + &, jastrow1, dd(*), zeta(nion), grad1(3), grad2, rion(3, nion)& + &, iond(nion, nion) & + &, dist(nion, nelup + neldo), r(0:indt,nion), rmu(3,0:indt, nion)& + &, ivic(3, indtmax, nelup + neldo), alat, plat(3), vold & + &, vpot, vpotreg(2, *) & + &, rc(3), winvbar(ipf * ipc * nelorbh, nel_mat), detmat(ipc * ipf * nelorbh, *)& + &, winvjbar(max(int(ipj * nelorbjh,8)*(nelup+neldo),1)), jasmat(*), cnorm(*)& + &, prefactor(indt - istart + 1, nelup + neldo), pseudolocal(nelup + neldo)& + &, rcutoff(ncore) & + &, parshell(3, *), wpseudo(2 * lmax), legendre(lmax - 1, nintpseudo)& + &, versor(3, nintpseudo) & + &, wintpseudo(nintpseudo), vpseudolocal, costz(*), costz3(*), costz0& + &, angle(18, *), logpsi(ipc), eloc(ipc), psidetln, psidetlnt(ipc), jasmatsz(*)& + &, winvjbarsz(*) & + &, iond_cart(3, nion, nion), cutreg & + &, mu_c(*), cellscalen(12), celldmo(6), detmat_c(*), projm(*) & + &, muj_c(*), jasmat_c(*), jasmatsz_c(*), psisn, cost, psidetln_old& + &, jastrowee_old, jastrowei_old, winvjbar_old, winvjbarsz_old, ainv_old& + &, winvfn_old, winvbar_old, winvbarfn_old, winvup_old, winvdo_old& + &, winvuplap_old, winvdolap_old, logpsi_old, agp_old, vpotreg_old, tmu_old, kel_old, tabpip_old(2),timep real*8 kel(3, nelup + neldo, 0:indt), kelind(3, nelup + neldo) logical iessz, iesiesd, yesprojm, lrdmc_deru @@ -196,17 +192,13 @@ subroutine compute_eloc_logpsi(indt, indt4, indt4j, nelorb, nelup, neldo & kel_old=sum(kel(:,:,:)) tabpip_old(1)=sum(abs(tabpip(:,1:indt))) tabpip_old(2)=sum(abs(tabpip(:,indt+1:indt+4))) -!allocate(ainv_sav(ipc*nel_mat,nel_mat)) -!ainv_sav=ainv if(indt.gt.0) tmu_old=sum(abs(tmu(:,:))) ainv_old=sum(abs(ainv(:,:))) winvup_old=sum(abs(winvup(:,:))) -! winvup_sav=winvup winvuplap_old=sum(abs(winvup(:,indt+1:indt+4))) winvdo_old=sum(abs(winvdo(:,:))) -! winvdo_sav=winvdo winvdolap_old=sum(abs(winvdo(:,indt+1:indt+4))) jastrowee_old=sum(abs(jastrowall_ee(:,:,0,walker))) jastrowei_old=sum(abs(jastrowall_ei(1,:,walker))) @@ -1327,227 +1319,287 @@ subroutine task2(kelind, rion, dist, kel, vpseudolocal, prefactor, ivic, tmu) end subroutine task2 subroutine task4(kel, rion, dd, vju, winv, winvj) - implicit none - real*8, intent(in) :: kel(3, nel, 0:indt), rion(3, nion) - real*8, intent(inout) :: winv(ipc * nelorbh, 0:indt4, nel)& - &, winvj(nelorbjmax, 0:indt4j, nel), dd(*), vju(*) - - ! input kel(3,nel,1:indt) - ! output winv(nelorb,nel,indt+4),winvj(nelorbj,nel,indtj+4) - ! all the rest is not used later. - if(.not.yesupwf.and..not.yesupwfj) return - - if(yesupwf) winv=0.d0 - if(yesupwfj.and.nelorbj.ne.0) winvj=0.d0 - - - if(membigcpu.and.indt4.ne.0.and.indt4j.ne.0) then - do j = 1, nelup - if(yesupwf) then - call upnewwf(indt, 0, indtm(j), 0, nshellh, ioptorb, ioccup, kel(1, j, 0) & - &, nel, r, rmu, dd, zeta, rion, psip, winv(1, 0, j), nelorb, nion, kion & - &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& - &, indpar_tab, indorb_tab, indshell_tab, .true.) - ! if(yesupwfj) iflagnorm=-iflagnorm - endif - if(nelorbj.ne.0.and.yesupwfj) then - call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0) & - &, nel, r, rmu, vju, zeta, rion, psip, winvj(1, 0, j), nelorbj & - &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& - &, indparj_tab, indorbj_tab, indshellj_tab, .true.) - ! elseif(yesupwf) then - ! iflagnorm=-iflagnorm - ! if(iflagnorm.ne.1) iflagnorm=2 - endif - enddo - - do j = nelup + 1, nel - if(yesupwf) then - call upnewwf(indt, 0, indtm(j), 0, nshelldoh, ioptorb, ioccdo, kel(1, j, 0) & - &, nel, r, rmu, dd, zeta, rion, psip, winv(1, 0, j), nelorb, nion, kion & - &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& - &, indpar_tab, indorb_tab, indshell_tab, .false.) - ! if(yesupwfj) iflagnorm=-iflagnorm - endif - if(nelorbj.ne.0.and.yesupwfj) then - call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0)& - &, nel, r, rmu, vju, zeta, rion, psip, winvj(1, 0, j), nelorbj & - &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& - &, indparj_tab, indorbj_tab, indshellj_tab, .false.) - ! elseif(yesupwf) then - ! iflagnorm=-iflagnorm - ! if(iflagnorm.ne.1) iflagnorm=2 - endif - enddo - elseif(membigcpu.and.indt4.eq.0.and.indt4j.eq.0) then - -! Allocated winv_big && winvj_big - do j = 1, nelup -! if(yesupwf) then - call upnewwf(indt, 0, indtm(j), 0, nshellh, ioptorb, ioccup, kel(1, j, 0) & - &, nel, r, rmu, dd, zeta, rion, psip, winv_big(1, 0, j), nelorb, nion, kion & - &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& - &, indpar_tab, indorb_tab, indshell_tab, .true.) - ! if(yesupwfj) iflagnorm=-iflagnorm -! endif - if(nelorbj.ne.0) then - call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0) & - &, nel, r, rmu, vju, zeta, rion, psip, winvj_big(1, 0, j), nelorbj & - &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& - &, indparj_tab, indorbj_tab, indshellj_tab, .true.) - ! elseif(yesupwf) then - ! iflagnorm=-iflagnorm - ! if(iflagnorm.ne.1) iflagnorm=2 - endif - enddo - - do j = nelup + 1, nel -! if(yesupwf) then - call upnewwf(indt, 0, indtm(j), 0, nshelldoh, ioptorb, ioccdo, kel(1, j, 0) & - &, nel, r, rmu, dd, zeta, rion, psip, winv_big(1, 0, j), nelorb, nion, kion & - &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& - &, indpar_tab, indorb_tab, indshell_tab, .false.) - ! if(yesupwfj) iflagnorm=-iflagnorm -! endif - if(nelorbj.ne.0) then - call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0)& - &, nel, r, rmu, vju, zeta, rion, psip, winvj_big(1, 0, j), nelorbj & - &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& - &, indparj_tab, indorbj_tab, indshellj_tab, .false.) - ! elseif(yesupwf) then - ! iflagnorm=-iflagnorm - ! if(iflagnorm.ne.1) iflagnorm=2 - endif - enddo - winv(:,0,1:nel)=winv_big(:,0,1:nel) - if(nelorbj.ne.0) winvj(:,0,1:nel)=winvj_big(:,0,1:nel) - - - elseif(membigcpu.and.indt4.eq.0) then - -! allocated winv_big only winvj is already big - do j = 1, nelup -! if(yesupwf) then - call upnewwf(indt, 0, indtm(j), 0, nshellh, ioptorb, ioccup, kel(1, j, 0) & - &, nel, r, rmu, dd, zeta, rion, psip, winv_big(1, 0, j), nelorb, nion, kion & - &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& - &, indpar_tab, indorb_tab, indshell_tab, .true.) - ! if(yesupwfj) iflagnorm=-iflagnorm -! endif - if(nelorbj.ne.0.and.yesupwfj) then - call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0) & - &, nel, r, rmu, vju, zeta, rion, psip, winvj(1, 0, j), nelorbj & - &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& - &, indparj_tab, indorbj_tab, indshellj_tab, .true.) - ! elseif(yesupwf) then - ! iflagnorm=-iflagnorm - ! if(iflagnorm.ne.1) iflagnorm=2 - endif - enddo - - do j = nelup + 1, nel -! if(yesupwf) then - call upnewwf(indt, 0, indtm(j), 0, nshelldoh, ioptorb, ioccdo, kel(1, j, 0) & - &, nel, r, rmu, dd, zeta, rion, psip, winv_big(1, 0, j), nelorb, nion, kion & - &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& - &, indpar_tab, indorb_tab, indshell_tab, .false.) - ! if(yesupwfj) iflagnorm=-iflagnorm -! endif - if(nelorbj.ne.0.and.yesupwfj) then - call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0)& - &, nel, r, rmu, vju, zeta, rion, psip, winvj(1, 0, j), nelorbj & - &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& - &, indparj_tab, indorbj_tab, indshellj_tab, .false.) - ! elseif(yesupwf) then - ! iflagnorm=-iflagnorm - ! if(iflagnorm.ne.1) iflagnorm=2 - endif - enddo - winv(:,0,1:nel)=winv_big(:,0,1:nel) - - elseif(membigcpu.and.indt4j.eq.0) then - -! allocated winvj_big - do j = 1, nelup - if(yesupwf) then - call upnewwf(indt, 0, indtm(j), 0, nshellh, ioptorb, ioccup, kel(1, j, 0) & - &, nel, r, rmu, dd, zeta, rion, psip, winv(1, 0, j), nelorb, nion, kion & - &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& - &, indpar_tab, indorb_tab, indshell_tab, .true.) - ! if(yesupwfj) iflagnorm=-iflagnorm - endif - if(nelorbj.ne.0) then - call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0) & - &, nel, r, rmu, vju, zeta, rion, psip, winvj_big(1, 0, j), nelorbj & - &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& - &, indparj_tab, indorbj_tab, indshellj_tab, .true.) - ! elseif(yesupwf) then - ! iflagnorm=-iflagnorm - ! if(iflagnorm.ne.1) iflagnorm=2 - endif - enddo - - do j = nelup + 1, nel - if(yesupwf) then - call upnewwf(indt, 0, indtm(j), 0, nshelldoh, ioptorb, ioccdo, kel(1, j, 0) & - &, nel, r, rmu, dd, zeta, rion, psip, winv(1, 0, j), nelorb, nion, kion & - &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& - &, indpar_tab, indorb_tab, indshell_tab, .false.) - ! if(yesupwfj) iflagnorm=-iflagnorm - endif - if(nelorbj.ne.0) then - call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0)& - &, nel, r, rmu, vju, zeta, rion, psip, winvj_big(1, 0, j), nelorbj & - &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& - &, indparj_tab, indorbj_tab, indshellj_tab, .false.) - ! elseif(yesupwf) then - ! iflagnorm=-iflagnorm - ! if(iflagnorm.ne.1) iflagnorm=2 - endif - enddo - if(nelorbj.ne.0) winvj(:,0,1:nel)=winvj_big(:,0,1:nel) + + use qmckl + + implicit none + + real*8, intent(in) :: kel(3, nel, 0:indt), rion(3, nion) + real*8, intent(inout) :: winv(ipc * nelorbh, 0:indt4, nel)& + &, winvj(nelorbjmax, 0:indt4j, nel), dd(*), vju(*) + +#ifdef _QMCKL + integer*4 :: ii, l + integer(qmckl_exit_code) :: rc + integer*8, save :: ao_num=0, npoints_qmckl=0 + real*8, allocatable :: ao_vgl_qmckl(:,:,:) & + &, ao_value_qmckl(:,:) & + &, kel_tmp(:,:) +#endif + + if(.not.yesupwf.and..not.yesupwfj) return + + if(yesupwf) winv=0.d0 + if(yesupwfj.and.nelorbj.ne.0) winvj=0.d0 + + if(membigcpu.and.indt4.ne.0.and.indt4j.ne.0) then + if(yesupwf) then + if (.not.use_qmckl) then + do j = 1, nelup + call upnewwf(indt, 0, indtm(j), 0, nshellh, ioptorb, ioccup, kel(1, j, 0)& + &, nel, r, rmu, dd, zeta, rion, psip, winv(1, 0, j), nelorb, nion, kion& + &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& + &, indpar_tab, indorb_tab, indshell_tab, .true.) + end do + do j = nelup + 1, nel + call upnewwf(indt, 0, indtm(j), 0, nshelldoh, ioptorb, ioccdo, kel(1, j, 0)& + &, nel, r, rmu, dd, zeta, rion, psip, winv(1, 0, j), nelorb, nion, kion& + &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& + &, indpar_tab, indorb_tab, indshell_tab, .false.) + end do +#ifdef _QMCKL + else + + if (npoints_qmckl == 0) then + rc = qmckl_get_ao_basis_ao_num(qmckl_ctx, ao_num) + if (rc /= QMCKL_SUCCESS) then + print *, 'Error getting ao_num', qmckl_ctx + call abort() + end if + end if + + npoints_qmckl = sum(indtm(1:nel) + 1) + + allocate(ao_value_qmckl(ao_num, npoints_qmckl), kel_tmp(3,npoints_qmckl)) + + l=0 + do j=1,nel + do k=1,indtm(j) + l = l+1 + kel_tmp(1:3,l) = kel(1:3,j,k) + end do + end do + + rc = qmckl_set_point(qmckl_ctx, 'N', npoints_qmckl, kel_tmp, 3_8*npoints_qmckl) + + if (rc /= QMCKL_SUCCESS) then + print *, 'Error setting electron coords' + call abort() + end if + + rc = qmckl_get_ao_basis_ao_value_inplace( & + &qmckl_ctx, & + &ao_value_qmckl, & + &ao_num*npoints_qmckl) + + if (rc /= QMCKL_SUCCESS) then + print *, 'Error getting AOs from QMCkl' + call abort() + end if + + rc = qmckl_set_point(qmckl_ctx, 'N', int(nel,8), kel, 3_8*nel) + + if (rc /= QMCKL_SUCCESS) then + print *, 'Error setting electron coords' + call abort() + end if + + allocate (ao_vgl_qmckl(ao_num, 5, nel)) + + rc = qmckl_get_ao_basis_ao_vgl_inplace( & + &qmckl_ctx, & + &ao_vgl_qmckl, & + &ao_num*5_8*nel) + + if (rc /= QMCKL_SUCCESS) then + print *, 'Error getting AOs from QMCkl 2' + call abort() + end if + + k=0 + do j=1,nel + do ii=1,ao_num + winv(ii,0,j) = ao_vgl_qmckl(ii,1,j) + end do + do i=1,indtm(j) + k = k+1 + do ii=1,ao_num + winv(ii,i,j) = ao_value_qmckl(ii,k) + end do + end do + do ii=1,ao_num + winv(ii,indt+1,j) = ao_vgl_qmckl(ii,2,j) + winv(ii,indt+2,j) = ao_vgl_qmckl(ii,3,j) + winv(ii,indt+3,j) = ao_vgl_qmckl(ii,4,j) + winv(ii,indt+4,j) = ao_vgl_qmckl(ii,5,j) + end do + end do + + deallocate(ao_value_qmckl) + deallocate(ao_vgl_qmckl) + +#endif + end if + end if - else - do j = 1, nelup - if(yesupwf) then - call upnewwf(0, 0, 0, 1, nshellh, ioptorb, ioccup, kel(1, j, 0) & - &, nel, r, rmu, dd, zeta, rion, psip, winv(1, 0, j), nelorb, nion, kion & - &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& - &, indpar_tab, indorb_tab, indshell_tab, .true.) - ! if(yesupwfj) iflagnorm=-iflagnorm - endif - if(nelorbj.ne.0.and.yesupwfj) then - call upnewwf(0, 0, 0, 1, nshelljh, ioptorbj, ioccj, kel(1, j, 0) & - &, nel, r, rmu, vju, zeta, rion, psip, winvj(1, 0, j), nelorbj & - &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& - &, indparj_tab, indorbj_tab, indshellj_tab, .true.) - ! elseif(yesupwf) then - ! iflagnorm=-iflagnorm - ! if(iflagnorm.ne.1) iflagnorm=2 - endif - enddo + if(nelorbj.ne.0.and.yesupwfj) then + ! TODO: These loops can be merged + do j = 1, nelup + call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0)& + &, nel, r, rmu, vju, zeta, rion, psip, winvj(1, 0, j), nelorbj& + &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& + &, indparj_tab, indorbj_tab, indshellj_tab, .true.) + end do + do j = nelup + 1, nel + call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0)& + &, nel, r, rmu, vju, zeta, rion, psip, winvj(1, 0, j), nelorbj& + &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& + &, indparj_tab, indorbj_tab, indshellj_tab, .false.) + end do + end if - do j = nelup + 1, nel - if(yesupwf) then - call upnewwf(0, 0, 0, 1, nshelldoh, ioptorb, ioccdo, kel(1, j, 0) & - &, nel, r, rmu, dd, zeta, rion, psip, winv(1, 0, j), nelorb, nion, kion & - &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& - &, indpar_tab, indorb_tab, indshell_tab, .false.) - ! if(yesupwfj) iflagnorm=-iflagnorm - endif - if(nelorbj.ne.0.and.yesupwfj) then - call upnewwf(0, 0, 0, 1, nshelljh, ioptorbj, ioccj, kel(1, j, 0)& - &, nel, r, rmu, vju, zeta, rion, psip, winvj(1, 0, j), nelorbj & - &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& - &, indparj_tab, indorbj_tab, indshellj_tab, .false.) - ! elseif(yesupwf) then - ! iflagnorm=-iflagnorm - ! if(iflagnorm.ne.1) iflagnorm=2 + do j = nelup + 1, nel + if(yesupwf) then + call upnewwf(indt, 0, indtm(j), 0, nshelldoh, ioptorb, ioccdo, kel(1, j, 0)& + &, nel, r, rmu, dd, zeta, rion, psip, winv(1, 0, j), nelorb, nion, kion& + &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& + &, indpar_tab, indorb_tab, indshell_tab, .false.) + endif + if(nelorbj.ne.0.and.yesupwfj) then + call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0)& + &, nel, r, rmu, vju, zeta, rion, psip, winvj(1, 0, j), nelorbj& + &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& + &, indparj_tab, indorbj_tab, indshellj_tab, .false.) + endif + enddo + elseif(membigcpu.and.indt4.eq.0.and.indt4j.eq.0) then + + do j = 1, nelup + call upnewwf(indt, 0, indtm(j), 0, nshellh, ioptorb, ioccup, kel(1, j, 0)& + &, nel, r, rmu, dd, zeta, rion, psip, winv_big(1, 0, j), nelorb, nion, kion& + &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9 & + &, indpar_tab, indorb_tab, indshell_tab, .true.) + if(nelorbj.ne.0) then + call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0)& + &, nel, r, rmu, vju, zeta, rion, psip, winvj_big(1, 0, j), nelorbj& + &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& + &, indparj_tab, indorbj_tab, indshellj_tab, .true.) + endif + enddo + + do j = nelup + 1, nel + call upnewwf(indt, 0, indtm(j), 0, nshelldoh, ioptorb, ioccdo, kel(1, j, 0)& + &, nel, r, rmu, dd, zeta, rion, psip, winv_big(1, 0, j), nelorb, nion, kion& + &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9 & + &, indpar_tab, indorb_tab, indshell_tab, .false.) + if(nelorbj.ne.0) then + call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0)& + &, nel, r, rmu, vju, zeta, rion, psip, winvj_big(1, 0, j), nelorbj& + &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& + &, indparj_tab, indorbj_tab, indshellj_tab, .false.) + endif + enddo + winv(:,0,1:nel)=winv_big(:,0,1:nel) + if(nelorbj.ne.0) winvj(:,0,1:nel)=winvj_big(:,0,1:nel) + + + elseif(membigcpu.and.indt4.eq.0) then + + ! allocated winv_big only winvj is already big + do j = 1, nelup + call upnewwf(indt, 0, indtm(j), 0, nshellh, ioptorb, ioccup, kel(1, j, 0)& + &, nel, r, rmu, dd, zeta, rion, psip, winv_big(1, 0, j), nelorb, nion, kion& + &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9 & + &, indpar_tab, indorb_tab, indshell_tab, .true.) + if(nelorbj.ne.0.and.yesupwfj) then + call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0)& + &, nel, r, rmu, vju, zeta, rion, psip, winvj(1, 0, j), nelorbj& + &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& + &, indparj_tab, indorbj_tab, indshellj_tab, .true.) + endif + enddo + + do j = nelup + 1, nel + call upnewwf(indt, 0, indtm(j), 0, nshelldoh, ioptorb, ioccdo, kel(1, j, 0)& + &, nel, r, rmu, dd, zeta, rion, psip, winv_big(1, 0, j), nelorb, nion, kion& + &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9 & + &, indpar_tab, indorb_tab, indshell_tab, .false.) + if(nelorbj.ne.0.and.yesupwfj) then + call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0)& + &, nel, r, rmu, vju, zeta, rion, psip, winvj(1, 0, j), nelorbj& + &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& + &, indparj_tab, indorbj_tab, indshellj_tab, .false.) + endif + enddo + winv(:,0,1:nel)=winv_big(:,0,1:nel) + + elseif(membigcpu.and.indt4j.eq.0) then + + ! allocated winvj_big + do j = 1, nelup + if(yesupwf) then + call upnewwf(indt, 0, indtm(j), 0, nshellh, ioptorb, ioccup, kel(1, j, 0)& + &, nel, r, rmu, dd, zeta, rion, psip, winv(1, 0, j), nelorb, nion, kion& + &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& + &, indpar_tab, indorb_tab, indshell_tab, .true.) + endif + if(nelorbj.ne.0) then + call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0)& + &, nel, r, rmu, vju, zeta, rion, psip, winvj_big(1, 0, j), nelorbj& + &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& + &, indparj_tab, indorbj_tab, indshellj_tab, .true.) + endif + enddo + + do j = nelup + 1, nel + if(yesupwf) then + call upnewwf(indt, 0, indtm(j), 0, nshelldoh, ioptorb, ioccdo, kel(1, j, 0)& + &, nel, r, rmu, dd, zeta, rion, psip, winv(1, 0, j), nelorb, nion, kion& + &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& + &, indpar_tab, indorb_tab, indshell_tab, .false.) + endif + if(nelorbj.ne.0) then + call upnewwf(indt, 0, indtm(j), 0, nshelljh, ioptorbj, ioccj, kel(1, j, 0)& + &, nel, r, rmu, vju, zeta, rion, psip, winvj_big(1, 0, j), nelorbj& + &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& + &, indparj_tab, indorbj_tab, indshellj_tab, .false.) + endif + enddo + if(nelorbj.ne.0) winvj(:,0,1:nel)=winvj_big(:,0,1:nel) + + else + do j = 1, nelup + if(yesupwf) then + call upnewwf(0, 0, 0, 1, nshellh, ioptorb, ioccup, kel(1, j, 0)& + &, nel, r, rmu, dd, zeta, rion, psip, winv(1, 0, j), nelorb, nion, kion& + &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& + &, indpar_tab, indorb_tab, indshell_tab, .true.) + endif + if(nelorbj.ne.0.and.yesupwfj) then + call upnewwf(0, 0, 0, 1, nshelljh, ioptorbj, ioccj, kel(1, j, 0)& + &, nel, r, rmu, vju, zeta, rion, psip, winvj(1, 0, j), nelorbj& + &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& + &, indparj_tab, indorbj_tab, indshellj_tab, .true.) + endif + enddo + + do j = nelup + 1, nel + if(yesupwf) then + call upnewwf(0, 0, 0, 1, nshelldoh, ioptorb, ioccdo, kel(1, j, 0)& + &, nel, r, rmu, dd, zeta, rion, psip, winv(1, 0, j), nelorb, nion, kion& + &, iflagnorm, cnorm, LBox, rmucos, rmusin, 1d-9& + &, indpar_tab, indorb_tab, indshell_tab, .false.) + endif + if(nelorbj.ne.0.and.yesupwfj) then + call upnewwf(0, 0, 0, 1, nshelljh, ioptorbj, ioccj, kel(1, j, 0)& + &, nel, r, rmu, vju, zeta, rion, psip, winvj(1, 0, j), nelorbj& + &, nion, kionj, iflagnorm, cnorm(nshell + 1), LBox, rmucos, rmusin, 1d-9& + &, indparj_tab, indorbj_tab, indshellj_tab, .false.) + endif + enddo endif - enddo - endif - return - + return + end subroutine task4 subroutine task5(winv, winvj, jasmat, jasmatsz, muj_c, jasmat_c, jasmatsz_c, detmat, mu_c& diff --git a/src/c_adjoint_forward/makefun.f90 b/src/c_adjoint_forward/makefun.f90 index a2398df..9314d83 100644 Binary files a/src/c_adjoint_forward/makefun.f90 and b/src/c_adjoint_forward/makefun.f90 differ diff --git a/src/c_adjoint_forward/makefun0.f90 b/src/c_adjoint_forward/makefun0.f90 index 549bda1..4344eac 100644 --- a/src/c_adjoint_forward/makefun0.f90 +++ b/src/c_adjoint_forward/makefun0.f90 @@ -1,4 +1,3 @@ -!TL off !########################################################### @@ -7,8392 +6,8634 @@ !# # !########################################################### - SUBROUTINE makefun0 (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,dd,zeta,r,rmu,distp,iflagnorm_unused,cr) + !TL off +SUBROUTINE makefun0 (iopt,indt,typec,indpar,indorb,indshell,nelskip,z,dd,zeta,r,rmu,distp,iflagnorm_unused,cr) - use constants - implicit none - integer iopt,indt,i,k,nelskip,indpar,indorbp ,indorb,indshell,indshellp,ic,iflagnorm_unused,indparp,npower,typec - real*8 z(nelskip,0:*),dd(*),zeta(*),rmu(3,0:0) ,r(0:0) ,distp(0:0,20),peff,fun,fun0,fun2,rp1,rp2,rp3,rp4,rp5,rp6,rp7,rp8 ,dd1,dd2,dd3,dd4,dd5,c,cr,funp,fun2p ,peff2,arg,c0,c1,cost,zv(6),yv(6),xv(6),r2,r4,r6 ! up to i -! -! indorb are the number of orbitals occupied before calling -! this subroutine -! -! indpar is the number of variational parameters used -! before calling this subroutine -! -! indshell is the index of the last occupied orbital -! in the shell, characterized by occupation number iocc(indshell) -! -! z(i,indt+4) contains the laplacian of the orbital i -! z(i,indt+mu) contains the gradient of the orbital i (mu=1,2,3) -! In the following given a radial part of the orbital f(r) -! fun=1/r d f(r)/d r -! fun2= d^2 f(r)/dr^2 - select case(iopt) -! Cyrus basis - case(80) -! R(r)=exp(-z*r**2) single zeta - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) - dd2=dsqrt(dd1) -! if(iflagnorm.gt.2) then -! c=(2.d0*dd1/pi)**(3.d0/4.d0)*ratiocs -! ratiocs--> ratiocs*(2/pi)**3/4 - c=dd1**0.75d0*ratiocs -! endif - do k=0,0 - cost=dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k,1)=c*dexp(-cost) - enddo - do i=0,0 - z(indorbp,i)=distp(i,1) - enddo - if(typec.ne.1) then -! the first derivative /r - rp1=dd1*r(0)**2 - rp2=dd2*r(0) - rp3=(1.d0+rp2)**2 - fun=-dd1*distp(0,1)*(2.d0+rp2)/rp3 -! the second derivative - fun2=dd1*distp(0,1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**2)/rp3**2 - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - case(81) ! derivative of bump gaussian -! R(r)=c*exp(-z*r**2)*(3/4/z-r**2) - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) - dd2=dsqrt(dd1) -! c=(2.d0*dd1/pi)**(3.d0/4.d0)*ratiocs - c=dd1**0.75d0*ratiocs - do k=0,0 - cost=dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k,1)=c*dexp(-cost) - enddo - do i=0,0 - cost=(1.d0+0.5d0*dd2*r(i))/(1.d0+dd2*r(i))**2 - z(indorbp,i)=distp(i,1)*(3.d0/4.d0/dd1-r(i)**2*cost) - enddo - if(typec.ne.1) then -! the first derivative /r - rp1=dd1*r(0)**2 - rp2=dd2*r(0) - rp3=(1.d0+rp2)**2 - fun=0.25d0*distp(0,1)*& - &(-14.d0-29.d0*rp2-12.d0*rp1+3.d0*rp1*rp2+2.d0*rp1**2)/rp3**2 -! the second derivative - fun2=0.25d0*distp(0,1)*& - &(-14.d0-30.d0*rp2+34.d0*rp1+118.d0*rp1*rp2+87.d0*rp1**2& - &+18.d0*rp1**2*rp2-5.d0*rp1**3-2.d0*rp1**3*rp2)/rp3**3 - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - case(82) - dd1=dd(indpar+1) - dd2=dsqrt(dd1) -! if(iflagnorm.gt.2) then -! ratiocp--> ratiocp*dsqrt(2.d0)*pi**(-0.75d0)*2**1.25 -! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0*ratiocp - c=dd1**1.25d0*ratiocp -! endif - do k=0,0 - cost=dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k,1)=c*dexp(-cost) - enddo -! indorbp=indorb -! - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1) -! fun=-2.d0*dd1*distp(0,1) -! fun2=fun*(1.d0-2.d0*dd1*r(0)**2) - rp1=dd1*r(0)**2 - rp2=dd2*r(0) - rp3=(1.d0+rp2)**2 - fun=-dd1*distp(0,1)*(2.d0+rp2)/rp3 -! the second derivative - fun2=dd1*distp(0,1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**2)/rp3**2 -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(83) ! derivative of 36 -! R(r)=x*exp(-z*r**2)*(5/4/z-r**2) - dd1=dd(indpar+1) - dd2=dsqrt(dd1) -! if(iflagnorm.gt.2) then -! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0*ratiocp - c=dd1**1.25d0*ratiocp -! endif - do k=0,0 - cost=dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k,1)=c*dexp(-cost) - enddo -! indorbp=indorb -! - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - cost=(1.d0+0.5d0*dd2*r(i))/(1.d0+dd2*r(i))**2 - z(indorbp,i)=rmu(ic,i)*distp(i,1)*(1.25d0/dd1-r(i)**2*cost) - enddo -! endif - enddo - if(typec.ne.1) then - rp1=dd1*r(0)**2 - rp2=dd2*r(0) - rp3=(1.d0+rp2)**2 - cost=(1.d0+0.5d0*rp2)/rp3 - fun0=distp(0,1)*(1.25d0/dd1-r(0)**2*cost) - fun=0.25d0*distp(0,1)*& - &(-18.d0-39.d0*rp2-20.d0*rp1+rp1*rp2+2.d0*rp1**2)/rp3**2 - fun2=0.25d0*distp(0,1)*& - &(-18.d0-42.d0*rp2+30.d0*rp1+138.d0*rp1*rp2+113.d0*rp1**2& - &+30.d0*rp1**2*rp2-3.d0*rp1**3-2.d0*rp1**3*rp2)/rp3**3 -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(84) -! d orbitals -! R(r)= exp(-alpha r^2) -! each gaussian term is normalized -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) - dd2=dsqrt(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)*ratiocd - c=ratiocd*dd1**1.75d0 -! endif - do k=0,0 - cost=dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k,1)=c*dexp(-cost) - enddo - do i=0,0 - ! lz=0 - distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - ! lz=+/-2 - distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - ! lz=+/-2 - distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d - ! lz=+/-1 - distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d - ! lz=+/-1 - distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d - enddo - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1) - rp1=dd1*r(0)**2 - rp2=dd2*r(0) - rp3=(1.d0+rp2)**2 - fun=-dd1*distp(0,1)*(2.d0+rp2)/rp3 -! the second derivative - fun2=dd1*distp(0,1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**2)/rp3**2 -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - ! derivative of 37 with respect to z - case(85) -! d orbitals -! R(r)= c*exp(-z r^2)*(7/4/z-r^2) -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) - dd2=dsqrt(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)*ratiocd - c=dd1**1.75d0*ratiocd -! endif - do k=0,0 - cost=dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k,1)=c*dexp(-cost) - enddo - do i=0,0 - ! lz=0 - distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - ! lz=+/-2 - distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - ! lz=+/-2 - distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d - ! lz=+/-1 - distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d - ! lz=+/-1 - distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d - enddo - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - cost=(1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 - z(indorbp,k)=distp(k,1)*(7.d0/4.d0/dd1-r(k)**2*cost)*& - & distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - rp1=dd1*r(0)**2 - rp2=dd2*r(0) - rp3=(1.d0+rp2)**2 - cost=(1.d0+0.5d0*rp2)/rp3 - fun0=distp(0,1)*(7.d0/4.d0/dd1-r(0)**2*cost) - fun=0.25d0*distp(0,1)*& - &(-22.d0-49.d0*rp2-28.d0*rp1-rp1*rp2+2.d0*rp1**2)/rp3**2 - fun2=-0.25d0*distp(0,1)*& - &(22.d0+54.d0*rp2-26.d0*rp1-158.d0*rp1*rp2-139.d0*rp1**2& - &-42.d0*rp1**2*rp2+rp1**3+2.d0*rp1**3*rp2)/rp3**3 -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - case(86) -! f single gaussian orbital -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) - dd2=dsqrt(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0)*ratiocf - c=dd1**2.25d0*ratiocf -! endif - do k=0,0 - cost=dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k,1)=c*dexp(-cost) - enddo - do i=0,0 - distp(i,2)=cost1f*rmu(3,i) & - & *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=0 - distp(i,3)=cost2f*rmu(1,i) & - & *(5.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-1 - distp(i,4)=cost2f*rmu(2,i) & - & *(5.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-1 - distp(i,5)=cost3f*rmu(3,i) & - & *(rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-2 - distp(i,6)=cost3f*2.d0*rmu(3,i) & - & *rmu(1,i)*rmu(2,i) - ! lz=+/-2 - distp(i,7)=cost4f*rmu(1,i) & - & *(rmu(1,i)**2-3.d0*rmu(2,i)**2) - ! lz=+/-3 - distp(i,8)=cost4f*rmu(2,i) & - & *(3.d0*rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-3 - enddo - do ic=1,7 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1) - rp1=dd1*r(0)**2 - rp2=dd2*r(0) - rp3=(1.d0+rp2)**2 - fun=-dd1*distp(0,1)*(2.d0+rp2)/rp3 -! the second derivative - fun2=dd1*distp(0,1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**2)/rp3**2 -! indorbp=indorb - do ic=1,7 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - if(ic.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) - if(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) - endif - elseif(ic.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) - endif - elseif(ic.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) - endif - elseif(ic.eq.4) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) - endif - elseif(ic.eq.6) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) - endif - else - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+7 - indorb=indorbp - ! derivative of 48 with respect to z - case(87) -! f orbitals -! R(r)= c*exp(-z r^2)*(9/4/z-r^2) -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) - dd2=dsqrt(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0)*ratiocf - c=dd1**2.25d0*ratiocf -! endif - do k=0,0 - cost=dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k,1)=c*dexp(-cost) - enddo - do i=0,0 - distp(i,2)=cost1f*rmu(3,i) & - & *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=0 - distp(i,3)=cost2f*rmu(1,i) & - & *(5.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-1 - distp(i,4)=cost2f*rmu(2,i) & - & *(5.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-1 - distp(i,5)=cost3f*rmu(3,i) & - & *(rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-2 - distp(i,6)=cost3f*2.d0*rmu(3,i) & - & *rmu(1,i)*rmu(2,i) - ! lz=+/-2 - distp(i,7)=cost4f*rmu(1,i) & - & *(rmu(1,i)**2-3.d0*rmu(2,i)**2) - ! lz=+/-3 - distp(i,8)=cost4f*rmu(2,i) & - & *(3.d0*rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-3 - enddo - do ic=1,7 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - cost=(1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 - z(indorbp,k)=distp(k,1)*(9.d0/4.d0/dd1-r(k)**2*cost)*& - & distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - rp1=dd1*r(0)**2 - rp2=dd2*r(0) - rp3=(1.d0+rp2)**2 - cost=(1.d0+0.5d0*rp2)/rp3 - fun0=distp(0,1)*(9.d0/4.d0/dd1-r(0)**2*cost) - fun=0.25d0*distp(0,1)*& - &(-26.d0-59.d0*rp2-36.d0*rp1-3.d0*rp1*rp2+2.d0*rp1**2)/rp3**2 - fun2=0.25d0*distp(0,1)*& - &(-26.d0-66.d0*rp2+22.d0*rp1+178.d0*rp1*rp2+165.d0*rp1**2& - &+54.d0*rp1**2*rp2+rp1**3-2.d0*rp1**3*rp2)/rp3**3 -! indorbp=indorb - do ic=1,7 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - if(ic.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) - if(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) - endif - elseif(ic.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) - endif - elseif(ic.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) - endif - elseif(ic.eq.4) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) - endif - elseif(ic.eq.6) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) - endif - else - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+7 - indorb=indorbp - case(88) -! g single gaussian orbital -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) - dd2=dsqrt(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0)*ratiocg - c=dd1**2.75d0*ratiocg -! endif - do k=0,0 - cost=dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k,1)=c*dexp(-cost) - enddo - do i=0,0 - distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & - & -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) - ! lz=0 - distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & - & *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=+/-1 - distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & - & *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=+/-1 - distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & - & *(7.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-2 - distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & - & *(7.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-2 - distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & - & *(rmu(1,i)**2-3.0*rmu(2,i)**2) - ! lz=+/-3 - distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & - & *(3.d0*rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-3 - distp(i,9)=cost5g*(rmu(1,i)**4 & - & -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) - ! lz=+/-4 - distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & - & *(rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-4 - enddo - do ic=1,9 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1) - rp1=dd1*r(0)**2 - rp2=dd2*r(0) - rp3=(1.d0+rp2)**2 - fun=-dd1*distp(0,1)*(2.d0+rp2)/rp3 -! the second derivative - fun2=dd1*distp(0,1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**2)/rp3**2 -! indorbp=indorb - do ic=1,9 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun - if(ic.eq.1) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) - endif - elseif(ic.eq.4) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) - endif - elseif(ic.eq.6) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) - endif - elseif(ic.eq.7) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) - endif - elseif(ic.eq.8) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) - endif - elseif(ic.eq.9) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) - endif - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+9 - indorb=indorbp - case(89) -! g single gaussian orbital -! derivative of 51 -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) - dd2=dsqrt(dd1) -! if(iflagnorm.gt.2) then -! overall normalization -! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0)*ratiocg - c=dd1**2.75d0*ratiocg -! endif - do k=0,0 - cost=dd1*r(k)**2/(1.d0+dd2*r(k)) - distp(k,1)=c*dexp(-cost) - enddo - do i=0,0 - distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & - & -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) - ! lz=0 - distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & - & *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=+/-1 - distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & - & *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=+/-1 - distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & - & *(7.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-2 - distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & - & *(7.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-2 - distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & - & *(rmu(1,i)**2-3.0*rmu(2,i)**2) - ! lz=+/-3 - distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & - & *(3.d0*rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-3 - distp(i,9)=cost5g*(rmu(1,i)**4 & - & -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) - ! lz=+/-4 - distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & - & *(rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-4 - enddo - do ic=1,9 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - cost=(1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 - z(indorbp,k)=distp(k,1)*(11.d0/4.d0/dd1-r(k)**2*cost)*& - & distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - rp1=dd1*r(0)**2 - rp2=dd2*r(0) - rp3=(1.d0+rp2)**2 - cost=(1.d0+0.5d0*rp2)/rp3 - fun0=distp(0,1)*(11.d0/4.d0/dd1-r(0)**2*cost) - fun=0.25d0*distp(0,1)*& - &(-30.d0-69.d0*rp2-44.d0*rp1-5.d0*rp1*rp2+2.d0*rp1**2)/rp3**2 - fun2=0.25d0*distp(0,1)*& - &(-30.d0-78.d0*rp2+18.d0*rp1+198.d0*rp1*rp2+191.d0*rp1**2& - &+66.d0*rp1**2*rp2+3.d0*rp1**3-2.d0*rp1**3*rp2)/rp3**3 -! indorbp=indorb - do ic=1,9 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun - if(ic.eq.1) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) - endif - elseif(ic.eq.4) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) - endif - elseif(ic.eq.6) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) - endif - elseif(ic.eq.7) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) - endif - elseif(ic.eq.8) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) - endif - elseif(ic.eq.9) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) - endif - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+9 - indorb=indorbp -! WARNING IN DFT it is assumed that UMRIGAR orbitals could be extended -! up to number 99, so i,h,... are possible extensions. - ! 1s single Z NO CUSP! - case(1) - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dd1*dsqrt(dd1)/dsqrt(pi) - c=dd1*dsqrt(dd1)*0.56418958354775628695d0 -! endif - indorbp=indorb+1 - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - enddo - do i=0,0 - z(indorbp,i)=distp(i,1) - enddo - if(typec.ne.1) then - fun=-dd1*distp(0,1) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0)/r(0) - enddo - z(indorbp,indt+4)=(-2.d0*dd1/r(0)+dd1**2) & - & *distp(0,1) - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - ! 1s double Z with cusp cond - case(2) -! - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) - dd2=dd(indpar+2) - peff=(zeta(1)-dd1)/(dd2-zeta(1)) -! if(iflagnorm.gt.2) then - c=1.d0/2.d0/dsqrt(2.d0*pi*(1.d0/(2.d0*dd1)**3 & - & +2.d0*peff/(dd1+dd2)**3+peff**2/(2.d0*dd2)**3)) -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - distp(k,2)=c*dexp(-dd2*r(k)) - enddo - do i=0,0 - z(indorbp,i)=distp(i,1)+peff*distp(i,2) - enddo - if(typec.ne.1) then - fun=(-dd1*distp(0,1)-dd2*distp(0,2)*peff)/r(0) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=(-2.d0*dd1/r(0)+dd1**2) & - & *distp(0,1)+peff*(-2.d0*dd2/r(0)+dd2**2) & - & *distp(0,2) - endif - indorb=indorbp -! endif - indpar=indpar+2 - indshell=indshellp - ! 1s double Z NO CUSP - case(3) -! - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) - dd2=dd(indpar+2) - peff=dd(indpar+3) -! if(iflagnorm.gt.2) then - c=1.d0/2.d0/dsqrt(2.d0*pi*(1.d0/(2.d0*dd1)**3 & - & +2.d0*peff/(dd1+dd2)**3+peff**2/(2.d0*dd2)**3)) -! endif - do i=indpar+1,indpar+2 - do k=0,0 - distp(k,i-indpar)=c*dexp(-dd(i)*r(k)) - enddo - enddo - do i=0,0 - z(indorbp,i)=distp(i,1)+peff*distp(i,2) - enddo - if(typec.ne.1) then - fun=-dd1*distp(0,1)-peff*dd2*distp(0,2) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0)/r(0) - enddo - z(indorbp,indt+4)=(-2.d0*dd1/r(0)+dd1**2) & - & *distp(0,1)+peff*(-2.d0*dd2/r(0)+dd2**2) & - & *distp(0,2) - endif - indorb=indorbp -! endif - indpar=indpar+3 - indshell=indshellp - ! 2s 2pz Hybryd single Z - case(4) - ! normalized - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) - dd2=dd(indpar+2) -! if(iflagnorm.gt.2) then - c=dd1**2.5d0/dsqrt(3.d0*pi*(1.d0+dd2**2/3.d0)) -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - enddo - do i=0,0 - z(indorbp,i)=(r(i)+dd2*rmu(3,i))*distp(i,1) - enddo - if(typec.ne.1) then - fun=distp(0,1)*(1.d0-dd1*r(0)) - funp=-dd2*dd1*distp(0,1)*rmu(3,0) - fun2=distp(0,1)*(dd1**2*r(0)-2.d0*dd1) - fun2p=dd1**2*dd2*distp(0,1)*rmu(3,0) - do i=1,3 - z(indorbp,indt+i)=(fun+funp)*rmu(i,0)/r(0) - enddo - z(indorbp,indt+3)=z(indorbp,indt+3)+dd2*distp(0,1) - z(indorbp,indt+4)=(2.d0*fun+4.d0*funp)/r(0) & - & +(fun2+fun2p) - endif - indorb=indorbp -! endif - indpar=indpar+2 - indshell=indshellp - ! 2s single Z NO CUSP - case(5) - ! normalized - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)) - enddo -! if(iflagnorm.gt.2) then -! c=dd1**2.5d0/dsqrt(3.d0*pi) - c=dd1**2.5d0*0.32573500793527994772d0 -! endif - do i=0,0 - z(indorbp,i)=c*r(i)*distp(i,1) - enddo - if(typec.ne.1) then - fun=distp(0,1)*(1.d0-dd1*r(0)) - fun2=distp(0,1)*(dd1**2*r(0)-2.d0*dd1) - do i=1,3 - z(indorbp,indt+i)=c*fun*rmu(i,0)/r(0) - enddo - z(indorbp,indt+4)=c*2.d0*fun/r(0)+c*fun2 - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - ! 2s double Z NO CUSP - case(6) - ! normalized - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) - dd2=dd(indpar+2) - peff=dd(indpar+3) -! if(iflagnorm.gt.2) then -! c= WRONG -! &0.5*dsqrt((1.d0/dd1**5/32.d0+2.d0*peff/(dd1+dd2)**5 -! &+peff**2/dd2**5/32.d0)/(24.d0*pi)) - c=1.d0/dsqrt((3.d0*pi)* & - & (1.d0/dd1**5+ 64.d0*peff/(dd1+dd2)**5+peff**2/dd2**5)) -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - distp(k,2)=c*dexp(-dd2*r(k)) - enddo - do i=0,0 - z(indorbp,i)=r(i)*(distp(i,1)+distp(i,2)*peff) - enddo - if(typec.ne.1) then - fun=distp(0,1)*(1.d0-dd1*r(0)) & - & +peff*distp(0,2)*(1.d0-dd2*r(0)) - fun2=distp(0,1)*(dd1**2*r(0)-2.d0*dd1)+peff*distp(0,2) & - & *(dd2**2*r(0)-2.d0*dd2) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0)/r(0) - enddo - z(indorbp,indt+4)=(2.d0*fun/r(0)+fun2) - endif - indorb=indorbp -! endif - indpar=indpar+3 - indshell=indshellp - ! 2s double Z NO CUSP - case(7) - ! normalized IS WRONG!!! - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) - dd2=dd(indpar+2) - peff=dd(indpar+3) - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)) - distp(k,2)=dexp(-dd2*r(k)) - enddo -! if(iflagnorm.gt.2) then - c= & - &1/dsqrt(1/(3.D0/4.D0/dd1**5+peff**2/dd2**3/4+12*peff/ & - & (dd1+dd2)**4))*1.d0/dsqrt(4.0*pi) -! endif - do i=0,0 - z(indorbp,i)=c*(distp(i,1)+r(i)*distp(i,2)*peff) - enddo - if(typec.ne.1) then - fun=-dd1*distp(0,1)+peff*distp(0,2)*(1.d0-dd2*r(0)) - fun2=distp(0,1)*dd1**2 & - &+peff*distp(0,2)*(dd2**2*r(0)-2.d0*dd2) - do i=1,3 - z(indorbp,indt+i)=fun*c*rmu(i,0)/r(0) - enddo - z(indorbp,indt+4)=c*(2.d0*fun/r(0)+fun2) - endif - indorb=indorbp -! endif - indpar=indpar+3 - indshell=indshellp - ! 2s double Z WITH CUSP - case(8) - ! normalized -! exp(-dd1*r) + (dd1-zeta) * r * exp(-dd2*r) - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) - dd2=dd(indpar+2) - peff=dd1-zeta(1) - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)) - distp(k,2)=dexp(-dd2*r(k)) - enddo -! if(iflagnorm.gt.2) then - c=1.d0/dsqrt(1/4.d0/dd1**3+12*peff/(dd1+dd2)**4+ & - &3*peff**2/4/dd2**5)/dsqrt(4.0*pi) -! endif - do i=0,0 - z(indorbp,i)=c*(distp(i,1)+r(i)*distp(i,2)*peff) - enddo - if(typec.ne.1) then - fun=-dd1*distp(0,1)+peff*distp(0,2)*(1.d0-dd2*r(0)) - fun2=distp(0,1)*dd1**2 & - &+peff*distp(0,2)*(dd2**2*r(0)-2.d0*dd2) - do i=1,3 - z(indorbp,indt+i)=fun*c*rmu(i,0)/r(0) - enddo - z(indorbp,indt+4)=c*(2.d0*fun/r(0)+fun2) - endif - indorb=indorbp -! endif - indpar=indpar+2 - indshell=indshellp - ! 3s single zeta - case(10) -! R(r)=r**2*exp(-z1*r) - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2*dd1)**7/720.d0/pi)/2.d0 - c=dd1**3.5d0*0.11894160774351807429d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - enddo - do i=0,0 - z(indorbp,i)=distp(i,1)*r(i)**2 - enddo - if(typec.ne.1) then - fun=(2.d0-dd1*r(0))*distp(0,1) - fun2=(2.d0-4*dd1*r(0)+(dd1*r(0))**2)*distp(0,1) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - ! 3s double zeta - case(11) -! R(r)=r**2*(exp(-z1*r)+p*exp(-z2*r)) - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) - dd2=dd(indpar+2) - peff=dd(indpar+3) -! if(iflagnorm.gt.2) then - c=1.d0/2.d0/dsqrt(pi*720.d0*(1.d0/(2.d0*dd1)**7+ & - & 2.d0*peff/(dd1+dd2)**7+peff**2/(2.d0*dd2)**7)) -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - distp(k,2)=c*dexp(-dd2*r(k)) - enddo - do i=0,0 - z(indorbp,i)=(distp(i,1)+peff*distp(i,2))*r(i)**2 - enddo - if(typec.ne.1) then - rp1=r(0)**2 -! the first derivative - fun=distp(0,1)*(2.d0*r(0)-dd1*rp1) & - & +peff*distp(0,2)*(2.d0*r(0)-dd2*rp1) -! -! the second derivative - fun2=distp(0,1)*(2.d0-4.d0*dd1*r(0)+dd1**2*rp1) & - & +peff*distp(0,2)*(2.d0-4.d0*dd2*r(0)+dd2**2*rp1) -! - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0)/r(0) - enddo - z(indorbp,indt+4)=2.d0*fun/r(0)+fun2 - endif - indorb=indorbp -! endif - indpar=indpar+3 - indshell=indshellp - ! 4s single zeta - case(12) -! R(r)=r**3*exp(-z1*r) -! - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 - c=dd1**4.5d0*.03178848180059307346d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - enddo - do i=0,0 - z(indorbp,i)=distp(i,1)*r(i)**3 - enddo - if(typec.ne.1) then - rp1=r(0)**3 - rp2=r(0)**2 -! -!c the first derivative - fun=distp(0,1)*(3.d0*rp2-dd1*rp1) -!c -!c the second derivative - fun2=distp(0,1)*(6.d0*r(0)-6.d0*dd1*rp2+dd1**2*rp1) -!c - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0)/r(0) - enddo - z(indorbp,indt+4)=2.d0*fun/r(0)+fun2 - endif -! - indorb=indorbp -! -! endif - indpar=indpar+1 - indshell=indshellp -! - ! 4s double zeta - case(13) -! R(r)=r**3*(exp(-z1*r)+z3*exp(-z2*r)) -! - indshellp=indshell+1 -! -! -! if(iocc(indshellp).eq.1) then -! - indorbp=indorb+1 - dd1=dd(indpar+1) - dd2=dd(indpar+2) - dd3=dd(indpar+3) -! if(iflagnorm.gt.2) then - c=1.d0/2.d0/dsqrt(pi*40320.d0*(1.d0/(2.d0*dd1)**9+ & - & 2.d0*dd3/(dd1+dd2)**9+dd3**2/(2.d0*dd2)**9)) -! endif -! - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - distp(k,2)=c*dexp(-dd2*r(k)) - enddo - do i=0,0 - z(indorbp,i)=(distp(i,1)+dd3*distp(i,2))*r(i)**3 - enddo -! - if(typec.ne.1) then - rp1=r(0)**3 - rp2=r(0)**2 -! -!c the first derivative - fun=distp(0,1)*(3.d0*rp2-dd1*rp1) & - & +dd3*distp(0,2)*(3.d0*rp2-dd2*rp1) -!c -! the second derivative - fun2=distp(0,1)*(6.d0*r(0)-6.d0*dd1*rp2+dd1**2*rp1) & - & +dd3*distp(0,2)*(6.d0*r(0)-6.d0*dd2*rp2+dd2**2*rp1) -!c - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0)/r(0) - enddo -! - z(indorbp,indt+4)=2.d0*fun/r(0)+fun2 -! - endif - indorb=indorbp -! endif - indpar=indpar+3 - indshell=indshellp - ! 1s single Z pseudo - case(14) -! (1.d0 + dd1 r) * exp(-dd1 * r) ! normalized - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)) - enddo -! if(iflagnorm.gt.2) then -! c=dsqrt(dd1**3.d0/7.d0/pi) - c=dd1**1.5d0*0.213243618622923d0 -! endif - do i=0,0 - z(indorbp,i)=c*(1.d0+dd1*r(i))*distp(i,1) - enddo - if(typec.ne.1) then - fun=-distp(0,1)*dd1**2*r(0) - fun2=-distp(0,1)*dd1**2*(1.d0-dd1*r(0)) - do i=1,3 - z(indorbp,indt+i)=c*fun*rmu(i,0)/r(0) - enddo - z(indorbp,indt+4)=c*2.d0*fun/r(0)+c*fun2 - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - ! 1s single Z pseudo - case(15) -! (r**2 + dd2*(1 + dd1*r))*exp(-dd1*r) ! normalized - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) - dd2=dd(indpar+2) - c=dsqrt(2.d0*dd1**7/pi/ & - & (45.d0+42.d0*dd1**2*dd2+14.d0*dd1**4*dd2**2)) - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - enddo - do i=0,0 - z(indorbp,i)=(r(i)**2+dd2*(1.d0+dd1*r(i))) & - & *distp(i,1) - enddo - if(typec.ne.1) then - fun=distp(0,1)*r(0)*(2.d0-dd1**2*dd2-dd1*r(0)) - fun2=distp(0,1)*((1.d0-dd1*r(0)) & - & *(3.d0-dd1**2*dd2-dd1*r(0))-1.d0) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0)/r(0) - enddo - z(indorbp,indt+4)=2.d0*fun/r(0)+fun2 - endif - indorb=indorbp -! endif - indpar=indpar+2 - indshell=indshellp - ! 2s gaussian for pseudo - case(16) -! R(r)=exp(-z*r**2) single zeta - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then - if(dd1.ne.0.) then - c=0.71270547035499016d0*dd1**0.75d0 -! c=(2.d0*dd1/pi)**(3.d0/4.d0) - else -! ! the constant - c=1.d0 - endif -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - do i=0,0 - z(indorbp,i)=distp(i,1) - enddo - if(typec.ne.1) then -! the first derivative /r - fun=-2.d0*dd1*distp(0,1) -! the second derivative - fun2=fun*(1.d0-2.d0*dd1*r(0)**2) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - ! 2s gaussian for pseudo - case(17) -! R(r)=r**2*exp(-z*r**2) single zeta - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=4.d0*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)/dsqrt(15.d0) - c=.73607904464954686606d0*dd1**1.75d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - do i=0,0 - z(indorbp,i)=distp(i,1)*r(i)**2 - enddo - if(typec.ne.1) then - rp1=r(0)**2 -! the first derivative / r - fun=2.d0*distp(0,1)*(1.d0-dd1*rp1) -! the second derivative - fun2=2.d0*distp(0,1)*(1.d0-5.d0*dd1*rp1+2.d0*dd1**2*rp1**2) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - ! 2s gaussian for pseudo - case(18) -! R(r)=r**4*exp(-z*r**2) single zeta - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=(2.d0*dd1**11/pi)**(1.d0/4.d0)*(512.d0/945.d0/pi) - c=dd1**2.75d0*0.1540487967684377d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - do i=0,0 - z(indorbp,i)=r(i)**4*distp(i,1) - enddo - if(typec.ne.1) then - rp1=r(0)**2 -! the first derivative - fun=distp(0,1)*rp1*(4.d0-2.d0*dd1*rp1) -! the second derivative - fun2=distp(0,1)*rp1*(12.d0-18.d0*dd1*rp1 & - & +4.d0*dd1**2*rp1**2) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - ! derivative of 16 with respect to z - case(19) -! R(r)=c*exp(-z*r**2)*(3/4/z-r**2) - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! if(dd1.ne.0.) then -! c=(2.d0*dd1/pi)**(3.d0/4.d0) - c=0.71270547035499016d0*dd1**0.75d0 -! else -! c=1.d0 -! endif -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - do i=0,0 - z(indorbp,i)=distp(i,1)*(3.d0/4.d0/dd1-r(i)**2) - enddo - if(typec.ne.1) then -! the first derivative /r - fun=distp(0,1)*(2.d0*dd1*r(0)**2-7.d0/2.d0) -! the second derivative - fun2=distp(0,1)*(-4.d0*dd1**2*r(0)**4 & - & +13.d0*dd1*r(0)**2-7.d0/2.d0) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - ! 2p single zeta - case(20) -! 2p single Z with no cusp condition - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2.d0*dd1)**5/8.d0/pi)/2.d0 - c=dd1**2.5d0*0.5641895835477562d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - enddo -! indorbp=indorb -! - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1) - fun=-dd1*distp(0,1) - fun2=dd1**2*distp(0,1) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun/r(0) - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun/r(0)+fun2) -! endif - enddo - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - ! 2p double zeta - case(21) -! 2p without cusp condition - dd1=dd(indpar+1) - dd2=dd(indpar+2) - peff=dd(indpar+3) - c=0.5d0/dsqrt(8.d0*pi*(1.d0/(2.d0*dd1)**5 & - & +2.d0*peff/(dd1+dd2)**5+peff**2/(2.d0*dd2)**5)) - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - distp(k,2)=c*dexp(-dd2*r(k)) - enddo - do i=0,0 - distp(i,3)=distp(i,1)+peff*distp(i,2) - enddo -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,3) - enddo -! endif - enddo - if(typec.ne.1) then - fun=(-dd1*distp(0,1)-dd2*peff*distp(0,2))/r(0) - fun2=dd1**2*distp(0,1)+peff*dd2**2*distp(0,2) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)*fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+distp(0,3) - enddo - z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+3 - indshell=indshell+3 - indorb=indorbp - ! 3p single zeta - case(22) -! 3p without cusp condition -! r e^{-z1 r } - dd1=dd(indpar+1) -! c=dsqrt((2.d0*dd1)**7/240.d0/pi)/2.d0 - c=dd1**3.5d0*0.2060129077457011d0 -! - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - distp(k,2)=r(k)*distp(k,1) - enddo -! -! indorbp=indorb -! - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,2) - enddo -! endif - enddo -! -! - if(typec.ne.1) then - fun0=distp(0,2) - fun=(1.d0-dd1*r(0))*distp(0,1) - fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) -! -! indorbp=indorb -! - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun/r(0) - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0)* & - & (4.d0*fun/r(0)+fun2) -! -! endif - enddo -! -! - !endif for indt - endif -! - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - ! 3p double zeta - case(23) -! 3p without cusp condition -! r ( e^{-z2 r } + z1 e^{-z3 r } ) - dd1=dd(indpar+1) - dd2=dd(indpar+2) - dd3=dd(indpar+3) -! if(iflagnorm.gt.2) then - c=1.d0/2.d0/dsqrt(240.d0*pi*(1.d0/(2.d0*dd1)**7 & - & +2.d0*dd3/(dd1+dd2)**7+dd3**2/(2.d0*dd2)**7)) -! endif -! - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - distp(k,2)=c*dexp(-dd2*r(k)) - enddo -! - do i=0,0 - distp(i,3)=r(i)*(distp(i,1)+dd3*distp(i,2)) - enddo -! -! indorbp=indorb -! - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,3) - enddo -! endif - enddo -! -! - if(typec.ne.1) then - fun0=distp(0,3) - fun=(1.d0-dd1*r(0))*distp(0,1) & - &+dd3*(1.d0-dd2*r(0))*distp(0,2) - fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) & - &+dd3*dd2*(dd2*r(0)-2.d0)*distp(0,2) -! -! indorbp=indorb -! - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun/r(0) - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0)* & - & (4.d0*fun/r(0)+fun2) -! -! endif - enddo -! -! - !endif for indt - endif -! - indpar=indpar+3 - indshell=indshell+3 - indorb=indorbp - ! 4p single zeta - case(24) -!c 4p without cusp condition -!c r^2 e^{-z1 r } - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2.d0*dd1)**9/120960.d0/pi)/2.d0 - c=dd1**4.5d0*0.01835308852470193d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - enddo - do i=0,0 - distp(i,3)=r(i)**2*distp(i,1) - enddo -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,3) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,3) - fun=(2.d0*r(0)-dd1*r(0)**2)*distp(0,1) - fun2=((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))*distp(0,1) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun/r(0) - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun/r(0)+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - ! 4p double zeta - case(25) -! 4p without cusp condition -! r^2 ( e^{-z2 r } + z1 e^{-z3 r } ) - dd1=dd(indpar+1) - dd2=dd(indpar+2) - dd3=dd(indpar+3) -! if(iflagnorm.gt.2) then - c=1.d0/2.d0/dsqrt(120960.d0*pi*(1.d0/(2.d0*dd1)**9 & - & +2.d0*dd3/(dd1+dd2)**9+dd3**2/(2.d0*dd2)**9)) -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - distp(k,2)=c*dexp(-dd2*r(k)) - enddo - do i=0,0 - distp(i,3)=r(i)**2*(distp(i,1)+dd3*distp(i,2)) - enddo -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,3) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,3) - fun=(2.d0*r(0)-dd1*r(0)**2)*distp(0,1) & - &+dd3*(2.d0*r(0)-dd2*r(0)**2)*distp(0,2) - fun2=((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))*distp(0,1) & - &+dd3*((dd2*r(0))**2+2.d0-4.d0*dd2*r(0))*distp(0,2) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun/r(0) - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun/r(0)+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+3 - indshell=indshell+3 - indorb=indorbp - ! 2p triple zeta - case(26) -! 2p without cusp condition - dd1=dd(indpar+1) - dd2=dd(indpar+2) - peff=dd(indpar+3) - dd3=dd(indpar+4) - peff2=dd(indpar+5) -! if(iflagnorm.gt.2) then - c=1.d0/2.d0/dsqrt(8.d0*pi*(1.d0/(2.d0*dd1)**5 & - & +2.d0*peff/(dd1+dd2)**5+peff**2/(2.d0*dd2)**5 & - & +2.d0*peff2/(dd1+dd3)**5+peff2**2/(2.d0*dd3)**5 & - & +2.d0*peff2*peff/(dd2+dd3)**5)) -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - distp(k,2)=c*dexp(-dd2*r(k)) - distp(k,3)=c*dexp(-dd3*r(k)) - enddo - do i=0,0 - distp(i,4)=distp(i,1)+peff*distp(i,2)+peff2*distp(i,3) - enddo -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,4) - enddo -! endif - enddo - if(typec.ne.1) then - fun=(-dd1*distp(0,1)-dd2*peff*distp(0,2) & - & -dd3*peff2*distp(0,3))/r(0) - fun2=dd1**2*distp(0,1)+peff*dd2**2*distp(0,2) & - & +peff2*dd3**2*distp(0,3) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)*fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+distp(0,4) - enddo - z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+5 - indshell=indshell+3 - indorb=indorbp - ! 3p triple zeta - case(27) -! 2p without cusp condition - dd1=dd(indpar+1) - dd2=dd(indpar+2) - peff=dd(indpar+3) - dd3=dd(indpar+4) - peff2=dd(indpar+5) -! if(iflagnorm.gt.2) then - c=1.d0/2.d0/dsqrt(240.d0*pi*(1.d0/(2.d0*dd1)**7 & - & +2.d0*peff/(dd1+dd2)**7+peff**2/(2.d0*dd2)**7 & - & +2.d0*peff2/(dd1+dd3)**7+peff2**2/(2.d0*dd3)**7 & - & +2.d0*peff2*peff/(dd2+dd3)**7)) -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - distp(k,2)=c*dexp(-dd2*r(k)) - distp(k,3)=c*dexp(-dd3*r(k)) - enddo - do i=0,0 - distp(i,4)=r(i)*(distp(i,1)+peff*distp(i,2) & - & +peff2*distp(i,3)) - enddo -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,4) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,4) - fun=(1.d0-dd1*r(0))*distp(0,1) & - &+peff*(1.d0-dd2*r(0))*distp(0,2) & - &+peff2*(1.d0-dd3*r(0))*distp(0,3) - fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) & - &+peff*dd2*(dd2*r(0)-2.d0)*distp(0,2) & - &+peff2*dd3*(dd3*r(0)-2.d0)*distp(0,3) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun/r(0) - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0)* & - & (4.d0*fun/r(0)+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+5 - indshell=indshell+3 - indorb=indorbp - case(28) -! R(r)=(Z*b*r)^4/(1+(Z*b*r)^4)*exp(-z*r) orbital 1s (no cusp) -! d -> b1s (defined in module constants) -! normadization: cost1s, depends on b1s - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! if(dd1.gt.0.) then - c=cost1s*dd1**1.5d0 -! else -! c=1.d0 -! endif -! endif - do i=0,0 - distp(i,1)=c*dexp(-dd1*r(i)) - enddo - do i=0,0 - rp4=(dd1*b1s*r(i))**4 - z(indorbp,i)=distp(i,1)*rp4/(1.d0+rp4) - enddo - if(typec.ne.1) then - rp1=dd1*b1s*r(0) - rp2=rp1**2 - rp4=rp2**2 - rp5=r(0)*dd1 - rp6=(b1s*dd1)**2*rp2 -! the first derivative /r - fun=-distp(0,1)*rp6*(-4.d0+rp5+rp4*rp5)/(1.d0+rp4)**2 -! the second derivative derivative - fun2=distp(0,1)*rp6*(12.d0-8*rp5+rp5**2-20*rp4-& - &8*rp4*rp5+2*rp4*rp5**2+(rp4*rp5)**2)/(1.d0+rp4)**3 - ! gradient: dR(r)/dr_i=r_i*fun - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - ! laplacian = 2*fun+fun2 - z(indorbp,indt+4)=2.d0*fun+fun2 - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - case(29) -! derivative of (28) - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! if(dd1.gt.0.) then - c=cost1s*dd1**1.5d0 -! else -! c=1.d0 -! endif -! endif -! if(dd1.gt.0.) then - c1=1.5d0/dd1 -! else -! c1=0.d0 -! endif - do i=0,0 - distp(i,1)=c*dexp(-dd1*r(i)) - enddo - do i=0,0 -! rp1=(b1s*r(i))**4*dd1**3 -! rp4=rp1*dd1 -! rp5=dd1*r(i) -! z(indorbp,i)=distp(i,1)*& -! &(c1*rp4/(1+rp4)-rp1*(-4+rp5+rp4*rp5)/(1+rp4)**2) - rp4=(b1s*dd1*r(i))**4 - rp5=dd1*r(i) - z(indorbp,i)=distp(i,1)*rp4/(1+rp4)*& - &(c1 - (1.d0/dd1)*(-4+rp5+rp4*rp5)/(1+rp4)) - enddo - if(typec.ne.1) then - rp1=dd1*b1s*r(0) - rp2=rp1**2 - rp4=rp2**2 - rp5=rp4*rp1 - rp8=rp4*rp4 - fun=distp(0,1)* (dd1*rp2*(4*b1s**2*(11-5*rp4) +2*(rp1+rp5)**2 & - & -b1s*rp1*(21+26*rp4+5*rp8)))/(2.*(1+rp4)**3) - fun2=distp(0,1)*(dd1*rp2*(b1s*(31 + 7*rp4)*(rp1 + rp5)**2 & - & - 2*(rp1 + rp5)**3 + 64*b1s**2*rp1*(-2 - rp4 + rp8) + & - & 4*b1s**3*(33 - 134*rp4 + 25*rp8)))/(2.*b1s*(1 + rp4)**4) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 -! endif - indorb=indorbp - endif - indpar=indpar+1 - indshell=indshellp - case(57) -! orbital 1s (no cusp) - STO regolarized for r->0 -! R(r)= C(z) * P(z*r) * exp(-z*r) -! P(x) = (x+a)^n/(1+(x+a)^n) with a so that P(0)==dP(0)/dx -! C(z) = const * z^(3/2) normalization -! the following definitions are in module constants -! n -> costSTO1s_n = 4 -! a -> costSTO1s_a = 1.2263393530877080588 -! const(n) -> costSTO1s_c = 0.58542132302621750732 -! -! - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! if(dd1.gt.0.) then - c=costSTO1s_c*dd1**1.5d0 -! else -! c=1.d0 -! endif -! endif - do i=0,0 - distp(i,1)=c*dexp(-dd1*r(i)) - enddo - do i=0,0 - rp4=(dd1*r(i)+costSTO1s_a)**costSTO1s_n - z(indorbp,i)=distp(i,1)*rp4/(1.d0+rp4) - enddo - if(typec.ne.1) then - rp1=dd1*r(0)+costSTO1s_a - rp2=rp1**2 - rp4=rp1**costSTO1s_n - rp6=rp4**2 -! the first derivative /r - !fun=-z(indorbp,0)*((dd1**2*(-costSTO1s_n+rp1+rp1*rp4))/& - ! &(rp1*(-costSTO1s_a+rp1)*(1.d0+rp4))) - fun=-distp(0,1)*rp4*& - &((dd1**2*(-costSTO1s_n+rp1+rp1*rp4))/& - &(rp1*(-costSTO1s_a+rp1)*(1.d0+rp4)**2)) -! the second derivative derivative - fun2=+distp(0,1)*rp4*(dd1**2*(-(costSTO1s_n**2*& - &(-1.d0+rp4))-costSTO1s_n*(1.d0+2.d0*rp1)*(1.d0+rp4)& - &+rp2*(1.d0+rp4)**2)) / (rp2*(1.d0+rp4)**3) - ! gradient: dR(r)/dr_i=r_i*fun - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - ! laplacian = 2*fun+fun2 - z(indorbp,indt+4)=2.d0*fun+fun2 - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - case(66) -! derivative of 57 (orbital 1s STO regolarized for r->0) -! dR(r)/dz with R(r)= C(z) * P(z*r) * exp(-z*r) -! P(x) = (x+a)^n/(1+(x+a)^n) with a so that P(0)==dP(0)/dx -! C(z) = const * z^(3/2) normalization -! the following definitions are in module constants -! n -> costSTO1s_n = 4 -! a -> costSTO1s_a = 1.2263393530877080588 -! const(n) -> costSTO1s_c = 0.58542132302621750732 -! - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! if(dd1.gt.0.) then - c=costSTO1s_c*dd1**1.5d0 -! else -! c=1.d0 -! endif -! endif - do i=0,0 - distp(i,1)=c*dexp(-dd1*r(i)) - enddo - do i=0,0 - rp1=dd1*r(i)+costSTO1s_a - rp4=rp1**costSTO1s_n - z(indorbp,i)=distp(i,1)*rp4/(1.d0+rp4)* & - &(1.5d0/dd1 + r(i)* & - &(-1.d0+(costSTO1s_n)/(rp1*(1.d0+rp4)))) - enddo - if(typec.ne.1) then - rp1=dd1*r(0)+costSTO1s_a - rp2=rp1**2 - rp4=rp1**costSTO1s_n - rp6=rp4**2 -! the first derivative /r - fun=distp(0,1)*(dd1*rp4*(-2.d0*costSTO1s_a*(costSTO1s_n**2*& - &(-1.d0+rp4)+costSTO1s_n*(1.d0+2.d0*rp1)*(1.d0+rp4)-rp2* & - &(1.d0+rp4)**2) +rp1*(2*costSTO1s_n**2*(-1+rp4)+costSTO1s_n& - &*(-3.d0+4.d0*rp1)*(1.d0+rp4)-rp1*(-5.d0+2.d0*rp1)*(1.d0+ & - &rp4)**2)))/(2.d0*rp2*(costSTO1s_a-rp1)*(1.d0+rp4)**3) -! fun=+distp(0,1)*rp4/(1.d0+rp4)*(1.5d0/dd1 + r(0)* & -! &(-1.d0+(costSTO1s_n)/(rp1*(1.d0+rp4)))) & -! & *(dd1*(2.d0 + 5.d0/(-dd1*r(0)) + & -! &(4.d0*costSTO1s_n**2)/(rp2*(1.d0+rp4)**2) + & -! &(costSTO1s_n*((3.d0 - 2.d0*costSTO1s_n - 4.d0*rp1)*rp1& -! & + 2.d0*costSTO1s_a*(1.d0+costSTO1s_n+2.d0*rp1)))/ & -! &(rp2*(dd1*r(0))*(1 + rp4))))/2.d0 -! the second derivative derivative - fun2=-distp(0,1)*(dd1*rp4*(rp1*(-(costSTO1s_n*(-3.d0-8.d0*rp1+ & - & 6.d0*rp2)*(1.d0+rp4)**2)+rp2*(-7.d0+2.d0*rp1)*(1.d0+rp4)**3- & - & costSTO1s_n**2*(-1.d0+6.d0*rp1)*(-1.d0+rp6)-2*costSTO1s_n**3*& - &(1.d0+rp4*(-4.d0+rp4))) + 2.d0*costSTO1s_a*(-(rp1*rp2*(1.d0 + & - & rp4)**3) + 3.d0*costSTO1s_n**2*(1.d0+rp1)*(-1.d0+rp6)+ & - & costSTO1s_n*(1.d0+rp4)**2*(2.d0+3.d0*rp1*(1.d0+rp1)) + & - & costSTO1s_n**3*(1.d0+rp4*(-4.d0+rp4)))))/ & - &(2.d0*rp1*rp2*(1+rp4)**4) -! fun2=-distp(0,1)*rp4/(1.d0+rp4)*(1.5d0/dd1 + r(0)* & -! &(-1.d0+(costSTO1s_n)/(rp1*(1.d0+rp4)))) & -! &*(dd1*(rp1*(-(costSTO1s_n*(-3 - 8*rp1 & -! & + 6*rp2)*(1 + rp4)**2) + rp2*(-7 + 2*rp1)*(1 + rp4)**3 - & -! & costSTO1s_n**2*(-1 + 6*rp1)*(-1 + rp6) - 2*costSTO1s_n**3* & -! &(1 + rp4*(-4 + rp4))) - 2*costSTO1s_a*(-(rp1*rp2*(1 + rp4)**3)& -! & + 3*costSTO1s_n**2*(1 + rp1)*(-1 + rp6) + costSTO1s_n*(1 + & -! & rp4)**2 *(2 + 3*rp1*(1 +rp1)) + costSTO1s_n**3*(1 + rp4*(-4 +& -! & rp4)))))/(2.*rp1*rp2*(1 + rp4)**3) - ! gradient: dR(r)/dr_i=r_i*fun - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - ! laplacian = 2*fun+fun2 - z(indorbp,indt+4)=2.d0*fun+fun2 - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - case(30) -! 3d without cusp and one parmater - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c= & -! & 1.d0/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) - c=dd1**3.5d0*0.26596152026762178d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - enddo - do i=0,0 - distp(i,3)=distp(i,1) - ! lz=0 - distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - ! lz=+/-2 - distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - ! lz=+/-2 - distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d - ! lz=+/-1 - distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d - ! lz=+/-1 - distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d - enddo -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=distp(i,3+ic)*distp(i,3) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,3) - fun=-dd1*distp(0,1) - fun2=dd1**2*distp(0,1) -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & - & *fun/r(0) - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif -! - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - case(31) -! 3d without cusp condition double Z - dd1=dd(indpar+1) - dd2=dd(indpar+2) - peff=dd(indpar+3) -! if(iflagnorm.gt.2) then - c=1/2.d0*dsqrt(5.d0/pi) & - &/dsqrt(1/dd1**7/128.d0+2*peff/(dd1+dd2)**7 & - &+peff**2/dd2**7/128.d0)/dsqrt(720.d0) -! endif - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)) - distp(k,2)=dexp(-dd2*r(k)) - enddo - do i=0,0 - distp(i,3)=c*(distp(i,1)+peff*distp(i,2)) - !lz=0 - distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - !lz=+/-2 - distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - ! lz=+/- 2 - distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d - ! lz=+/-1 - distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d - ! lz=+/-1 - distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d - enddo -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=distp(i,3+ic)*distp(i,3) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,3) - fun=c*(-dd1*distp(0,1)-peff*dd2*distp(0,2)) - fun2=c*(dd1**2*distp(0,1) & - & +peff*dd2**2*distp(0,2)) -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0)*fun/r(0) - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+3 - indshell=indshell+5 - indorb=indorbp - case(32) -! 3d without cusp condition triple Z - dd1=dd(indpar+1) - dd2=dd(indpar+2) - peff=dd(indpar+3) - dd3=dd(indpar+4) - peff2=dd(indpar+5) -! if(iflagnorm.gt.2) then - c=1/2.d0*dsqrt(5.d0/pi) & - &/dsqrt(1/(2.d0*dd1)**7+2*peff/(dd1+dd2)**7 & - &+peff**2/(2.d0*dd2)**7+2*peff2/(dd1+dd3)**7 & - &+peff2**2/(2.d0*dd3)**7+2*peff*peff2/(dd2+dd3)**7)/dsqrt(720.d0) -! endif - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)) - distp(k,2)=dexp(-dd2*r(k)) - distp(k,3)=dexp(-dd3*r(k)) - enddo - do i=0,0 - distp(i,4)=c*(distp(i,1)+peff*distp(i,2)+peff2*distp(i,3)) - !lz=0 - distp(i,5)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - !lz=+/-2 - distp(i,6)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - ! lz=+/- 2 - distp(i,7)=rmu(1,i)*rmu(2,i)*cost3d - ! lz=+/-1 - distp(i,8)=rmu(2,i)*rmu(3,i)*cost3d - ! lz=+/-1 - distp(i,9)=rmu(1,i)*rmu(3,i)*cost3d - enddo -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=distp(i,4+ic)*distp(i,4) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,4) - fun=c*(-dd1*distp(0,1)-peff*dd2*distp(0,2) & - & -peff2*dd3*distp(0,3)) - fun2=c*(dd1**2*distp(0,1)+peff*dd2**2*distp(0,2) & - & +peff2*dd3**2*distp(0,3)) -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,4+ic)*rmu(i,0)*fun/r(0) - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,4+ic)*(6.d0*fun/r(0)+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+5 - indshell=indshell+5 - indorb=indorbp - case(33) -! 4d without cusp and one parmater - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c= -! & 1/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) -! c= & -! & 1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) - c=dd1**4.5d0*0.0710812062076410d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - enddo - do i=0,0 - distp(i,3)=distp(i,1)*r(i) - ! lz=0 - distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - ! lz=+/ - distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - ! lz=+/-2 - distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d - ! lz=+/-1 - distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d - ! lz=+/-1 - distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d - enddo -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=distp(i,3+ic)*distp(i,3) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,3) - fun=-dd1*distp(0,3)+distp(0,1) - fun2=dd1**2*distp(0,3)-2.d0*dd1*distp(0,1) -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & - & *fun/r(0) - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - endif -! - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - ! 2s single Z WITH CUSP zero - case(34) - ! normalized -! exp(-dd1*r) + dd1*r*exp(-dd1*r) - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! peff=dd1 -! if(iflagnorm.gt.2) then -! c=1.d0/dsqrt(1.d0/4.d0/dd1**3+12.d0*dd1/(2.d0*dd1)**4+ & -! &3.d0*dd1**2/4.d0/dd1**5)/dsqrt(4.d0*pi) -! c=dd1*dsqrt(dd1)/dsqrt(7.d0*pi) - c=dd1*dsqrt(dd1)*.2132436186229231d0 -! endif - do i=0,0 - distp(i,1)=c*dexp(-dd1*r(i)) - enddo - do i=0,0 - z(indorbp,i)=distp(i,1)*(1.d0+r(i)*dd1) - enddo - if(typec.ne.1) then - fun=-dd1**2*distp(0,1) - fun2=fun*(1.d0-dd1*r(0)) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=(2.d0*fun+fun2) - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - ! 2s single Z WITH CUSP - case(35) - ! normalized -! exp(-dd1*r) + dd1* r * exp(-dd2*r) - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) - dd2=dd(indpar+2) - peff=dd1 - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)) - distp(k,2)=dexp(-dd2*r(k)) - enddo -! if(iflagnorm.gt.2) then - c=1.d0/dsqrt(1/4.d0/dd1**3+12*peff/(dd1+dd2)**4+ & - &3*peff**2/4/dd2**5)/dsqrt(4.0*pi) -! endif - do i=0,0 - z(indorbp,i)=c*(distp(i,1)+r(i)*distp(i,2)*peff) - enddo - if(typec.ne.1) then - fun=-dd1*distp(0,1)+peff*distp(0,2)*(1.d0-dd2*r(0)) - fun2=distp(0,1)*dd1**2 & - &+peff*distp(0,2)*(dd2**2*r(0)-2.d0*dd2) - do i=1,3 - z(indorbp,indt+i)=fun*c*rmu(i,0)/r(0) - enddo - z(indorbp,indt+4)=c*(2.d0*fun/r(0)+fun2) - endif - indorb=indorbp -! endif - indpar=indpar+2 - indshell=indshellp - ! single gaussian p orbitals - case(36) - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0 - c=dd1**1.25d0*1.42541094070998d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo -! indorbp=indorb -! - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1) - fun=-2.d0*dd1*distp(0,1) - fun2=fun*(1.d0-2.d0*dd1*r(0)**2) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - enddo - z(indorbp,indt+ic)=z(indorbp,indt+ic)+fun0 - z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(37,68) -! d orbitals -! R(r)= exp(-alpha r^2) -! each gaussian term is normalized -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) - c=dd1**1.75d0*1.64592278064948967213d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - do i=0,0 - ! lz=0 - distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - ! lz=+/-2 - distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - ! lz=+/-2 - distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d - ! lz=+/-1 - distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d - ! lz=+/-1 - distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d - enddo - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - dd1=dd(indparp) - fun0=distp(0,1) - fun=-2.d0*dd1*distp(0,1) - fun2=fun*(1.d0-2.d0*dd1*r(0)**2) -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - enddo - if(ic.eq.1) then -! if(i.ne.3) then - z(indorbp,indt+1)=z(indorbp,indt+1)- & - & 2.d0*rmu(1,0)*fun0*cost1d - z(indorbp,indt+2)=z(indorbp,indt+2)- & - & 2.d0*rmu(2,0)*fun0*cost1d -! else - z(indorbp,indt+3)=z(indorbp,indt+3)+ & - & 4.d0*rmu(3,0)*fun0*cost1d -! endif - elseif(ic.eq.2) then -! if(i.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1)+ & - & 2.d0*rmu(1,0)*fun0*cost2d -! elseif(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2)- & - & 2.d0*rmu(2,0)*fun0*cost2d -! endif - elseif(ic.eq.3) then -! if(i.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1)+ & - & rmu(2,0)*fun0*cost3d -! elseif(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2)+ & - & rmu(1,0)*fun0*cost3d -! endif - elseif(ic.eq.4) then -! if(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2)+ & - & rmu(3,0)*fun0*cost3d -! elseif(i.eq.3) then - z(indorbp,indt+3)=z(indorbp,indt+3)+ & - & rmu(2,0)*fun0*cost3d -! endif - elseif(ic.eq.5) then -! if(i.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1)+ & - & rmu(3,0)*fun0*cost3d -! elseif(i.eq.3) then - z(indorbp,indt+3)=z(indorbp,indt+3)+ & - & rmu(1,0)*fun0*cost3d - !endif for i -! endif - !endif for ic - endif - !enddo for i -! enddo - z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - case(47) -! d orbitals cartesian !!! -! R(r)= exp(-alpha r^2) -! each gaussian term is normalized -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization - c=dd1**1.75d0*1.64592278064948967213d0 -! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - do i=0,0 - distp(i,2)=rmu(1,i)**2 - distp(i,3)=rmu(2,i)**2 - distp(i,4)=rmu(3,i)**2 - ! lz=+/-2 - distp(i,5)=rmu(1,i)*rmu(2,i)*cost3d - ! lz=+/-1 - distp(i,6)=rmu(2,i)*rmu(3,i)*cost3d - ! lz=+/-1 - distp(i,7)=rmu(1,i)*rmu(3,i)*cost3d - enddo - do ic=1,6 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - dd1=dd(indparp) - fun0=distp(0,1) - fun=-2.d0*dd1*distp(0,1) - fun2=fun*(1.d0-2.d0*dd1*r(0)**2) -! indorbp=indorb - do ic=1,6 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - if(ic.le.3) then - if(i.eq.ic) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0 - endif - elseif(ic.eq.4) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.6) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - if(ic.le.3) then - z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2)+2.d0*distp(0,1) - else - z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) - endif - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+6 - indorb=indorbp - case(48) -! f single gaussian orbital -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) - c=dd1**2.25d0*1.47215808929909374563d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - do i=0,0 - distp(i,2)=cost1f*rmu(3,i) & - & *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=0 - distp(i,3)=cost2f*rmu(1,i) & - & *(5.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-1 - distp(i,4)=cost2f*rmu(2,i) & - & *(5.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-1 - distp(i,5)=cost3f*rmu(3,i) & - & *(rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-2 - distp(i,6)=cost3f*2.d0*rmu(3,i) & - & *rmu(1,i)*rmu(2,i) - ! lz=+/-2 - distp(i,7)=cost4f*rmu(1,i) & - & *(rmu(1,i)**2-3.d0*rmu(2,i)**2) - ! lz=+/-3 - distp(i,8)=cost4f*rmu(2,i) & - & *(3.d0*rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-3 - enddo - do ic=1,7 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - dd1=dd(indparp) - fun0=distp(0,1) - fun=-2.d0*dd1*distp(0,1) - fun2=fun*(1.d0-2.d0*dd1*r(0)**2) -! indorbp=indorb - do ic=1,7 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - enddo - if(ic.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1)- & - & 6.d0*cost1f*fun0*rmu(1,0)*rmu(3,0) - z(indorbp,indt+2)=z(indorbp,indt+2)- & - & 6.d0*cost1f*fun0*rmu(2,0)*rmu(3,0) - z(indorbp,indt+3)=z(indorbp,indt+3)+ & - & cost1f*fun0*(9.d0*rmu(3,0)**2-3.d0*r(0)**2) - elseif(ic.eq.2) then - z(indorbp,indt+1)=z(indorbp,indt+1)+ & - &cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2-2.d0*rmu(1,0)**2) - z(indorbp,indt+2)=z(indorbp,indt+2)- & - & 2.d0*cost2f*fun0*rmu(2,0)*rmu(1,0) - z(indorbp,indt+3)=z(indorbp,indt+3)+ & - & 8.d0*cost2f*fun0*rmu(3,0)*rmu(1,0) - elseif(ic.eq.3) then - z(indorbp,indt+1)=z(indorbp,indt+1)- & - & 2.d0*cost2f*fun0*rmu(1,0)*rmu(2,0) - z(indorbp,indt+2)=z(indorbp,indt+2)+ & -&cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2-2.d0*rmu(2,0)**2) - z(indorbp,indt+3)=z(indorbp,indt+3)+ & - & 8.d0*cost2f*fun0*rmu(3,0)*rmu(2,0) - elseif(ic.eq.4) then - z(indorbp,indt+1)=z(indorbp,indt+1)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) - z(indorbp,indt+2)=z(indorbp,indt+2)- & - & 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) - z(indorbp,indt+3)=z(indorbp,indt+3)+ & - & cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - elseif(ic.eq.5) then - z(indorbp,indt+1)=z(indorbp,indt+1)+ & - & 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) - z(indorbp,indt+2)=z(indorbp,indt+2)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) - z(indorbp,indt+3)=z(indorbp,indt+3)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) - elseif(ic.eq.6) then - z(indorbp,indt+1)=z(indorbp,indt+1)+ & - & 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - z(indorbp,indt+2)=z(indorbp,indt+2)- & - & 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) - else - z(indorbp,indt+1)=z(indorbp,indt+1)+ & - & 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) - z(indorbp,indt+2)=z(indorbp,indt+2)+ & - & 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - endif - z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+7 - indorb=indorbp - ! derivative of 48 with respect to z - case(49) -! f orbitals -! R(r)= c*exp(-z r^2)*(9/4/z-r^2) -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) - c=dd1**2.25d0*1.47215808929909374563d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - do i=0,0 - distp(i,2)=cost1f*rmu(3,i) & - & *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=0 - distp(i,3)=cost2f*rmu(1,i) & - & *(5.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-1 - distp(i,4)=cost2f*rmu(2,i) & - & *(5.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-1 - distp(i,5)=cost3f*rmu(3,i) & - & *(rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-2 - distp(i,6)=cost3f*2.d0*rmu(3,i) & - & *rmu(1,i)*rmu(2,i) - ! lz=+/-2 - distp(i,7)=cost4f*rmu(1,i) & - & *(rmu(1,i)**2-3.d0*rmu(2,i)**2) - ! lz=+/-3 - distp(i,8)=cost4f*rmu(2,i) & - & *(3.d0*rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-3 - enddo - do ic=1,7 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*(9.d0/4.d0/dd1-r(k)**2)* & - & distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - dd1=dd(indparp) - fun0=distp(0,1)*(9.d0/4.d0/dd1-r(0)**2) - fun=distp(0,1)*(2.d0*dd1*r(0)**2-13.d0/2.d0) - fun2=distp(0,1)*(-4.d0*dd1**2*r(0)**4 & - & +19.d0*dd1*r(0)**2-13.d0/2.d0) -! indorbp=indorb - do ic=1,7 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - if(ic.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) - if(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) - endif - elseif(ic.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) - endif - elseif(ic.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) - endif - elseif(ic.eq.4) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) - endif - elseif(ic.eq.6) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) - endif - else - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+7 - indorb=indorbp - case(70) -! f single Slater orbital -! R(r)= exp(-alpha r) -! normalized -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! l = 3 -! \int d\omega Y*Y = 4 pi / (2 l + 1) -! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5 * 3**2 / 2**2 / dd1**9 -! c=1.d0/dsqrt(10.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(9.d0/2.d0)/3.d0 - c=dd1**4.5d0*0.084104417400672d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - enddo - do i=0,0 - distp(i,2)=cost1f*rmu(3,i) & - & *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=0 - distp(i,3)=cost2f*rmu(1,i) & - & *(5.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-1 - distp(i,4)=cost2f*rmu(2,i) & - & *(5.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-1 - distp(i,5)=cost3f*rmu(3,i) & - & *(rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-2 - distp(i,6)=cost3f*2.d0*rmu(3,i) & - & *rmu(1,i)*rmu(2,i) - ! lz=+/-2 - distp(i,7)=cost4f*rmu(1,i) & - & *(rmu(1,i)**2-3.d0*rmu(2,i)**2) - ! lz=+/-3 - distp(i,8)=cost4f*rmu(2,i) & - & *(3.d0*rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-3 - enddo - do ic=1,7 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - dd1=dd(indparp) - fun0=distp(0,1) - fun=-dd1*distp(0,1)/r(0) - fun2=dd1**2*distp(0,1) -! indorbp=indorb - do ic=1,7 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - if(ic.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) - if(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) - endif - elseif(ic.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) - endif - elseif(ic.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) - endif - elseif(ic.eq.4) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) - endif - elseif(ic.eq.6) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) - endif - else - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+7 - indorb=indorbp - case(71) -! f single Slater orbital derivative of 70 -! R(r)= (9.d0/2.0 1/dd1 - r) * exp(-alpha r) -! normalized -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! l = 3 -! \int d\omega Y*Y = 4 pi / (2 l + 1) -! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5 * 3**2 / 2**2 / dd1**9 -! c=1.d0/dsqrt(10.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(9.d0/2.d0)/3.d0 - c=dd1**4.5d0*0.084104417400672d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - enddo - do i=0,0 - distp(i,2)=cost1f*rmu(3,i) & - & *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=0 - distp(i,3)=cost2f*rmu(1,i) & - & *(5.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-1 - distp(i,4)=cost2f*rmu(2,i) & - & *(5.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-1 - distp(i,5)=cost3f*rmu(3,i) & - & *(rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-2 - distp(i,6)=cost3f*2.d0*rmu(3,i) & - & *rmu(1,i)*rmu(2,i) - ! lz=+/-2 - distp(i,7)=cost4f*rmu(1,i) & - & *(rmu(1,i)**2-3.d0*rmu(2,i)**2) - ! lz=+/-3 - distp(i,8)=cost4f*rmu(2,i) & - & *(3.d0*rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-3 - enddo - do ic=1,7 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*distp(k,1+ic)*(9.d0/2.d0/dd1 - r(k)) - enddo -! endif - enddo - if(typec.ne.1) then - dd1=dd(indparp) - fun0=distp(0,1)*(9.d0/2.d0/dd1-r(0)) - fun=distp(0,1)*(dd1-11.d0/2.d0/r(0)) - fun2=dd1*distp(0,1)*(13.d0/2.d0-dd1*r(0)) -! indorbp=indorb - do ic=1,7 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - if(ic.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) - if(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) - endif - elseif(ic.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) - endif - elseif(ic.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) - endif - elseif(ic.eq.4) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) - endif - elseif(ic.eq.6) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) - endif - else - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+7 - indorb=indorbp - ! 3s -derivative of 34 with respect to dd1 - case(38) -! R(r)=r**2*exp(-z1*r) - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=1.d0/dsqrt(1.d0/4.d0/dd1**3+12.d0*dd1/(2.d0*dd1)**4+ & -! &3.d0*dd1**2/4.d0/dd1**5)/dsqrt(4.d0*pi) -! c=dd1*dsqrt(dd1)/dsqrt(7.d0*pi) - c=dd1*dsqrt(dd1)*0.21324361862292308211d0 -! endif - c0=-c*dd1 - c1=1.5d0*c/dd1 - do i=0,0 - distp(i,1)=dexp(-dd1*r(i)) - enddo - do i=0,0 - z(indorbp,i)=(c0*r(i)**2+c1*(1.d0+dd1*r(i))) & - &*distp(i,1) - enddo - c1=c1*dd1**2 - if(typec.ne.1) then - fun=(c0*(2.d0-dd1*r(0))-c1)*distp(0,1) - fun2=(c0*(2.d0-4*dd1*r(0)+(dd1*r(0))**2) & - &+c1*(dd1*r(0)-1.d0))*distp(0,1) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - ! 4s single zeta derivative of 10 - case(39) -! R(r)=r**3*exp(-z1*r) -! - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 -! c=dsqrt((2*dd1)**7/720.d0/pi)/2.d0 - c=dd1**3.5d0*0.11894160774351807429d0 -! c=-c -! endif - c0=-c - c1=3.5d0*c/dd1 - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)) - enddo - do i=0,0 - z(indorbp,i)=(c0*r(i)**3+c1*r(i)**2)*distp(i,1) - enddo - if(typec.ne.1) then - rp1=r(0)**3 - rp2=r(0)**2 -! fun=(2.d0-dd1*r(0))*distp(0,1) -! fun2=(2.d0-4*dd1*r(0)+(dd1*r(0))**2)*distp(0,1) -! -!c the first derivative/r - fun=distp(0,1)*(c0*(3.d0*r(0)-dd1*rp2) & - &+c1*(2.d0-dd1*r(0))) -!c -!c the second derivative - fun2=distp(0,1)* & - &(c0*(6.d0*r(0)-6.d0*dd1*rp2+dd1**2*rp1) & - &+c1*(2.d0-4*dd1*r(0)+(dd1*r(0))**2)) -!c - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - endif -! - indorb=indorbp -! -! endif - indpar=indpar+1 - indshell=indshellp -! - ! 3p single zeta - case(40) -! 3p without cusp condition derivative of 20 -! r e^{-z1 r } - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2.d0*dd1)**5/8.d0/pi)/2.d0 - c=dd1**2.5d0*0.5641895835477562d0 -! endif - c0=-c - c1=2.5d0*c/dd1 -! - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)) - distp(k,2)=r(k)*distp(k,1) - enddo -! -! indorbp=indorb -! - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*(c0*distp(i,2)+c1*distp(i,1)) - enddo -! endif - enddo -! -! - if(typec.ne.1) then - fun0=c0*distp(0,2)+c1*distp(0,1) - fun=(c0*(1.d0-dd1*r(0))-c1*dd1)*distp(0,1) - fun2=(c0*dd1*(dd1*r(0)-2.d0)+c1*dd1**2)*distp(0,1) -! -! indorbp=indorb -! - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun/r(0) - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0)* & - & (4.d0*fun/r(0)+fun2) -! -! endif - enddo -! -! - !endif for indt - endif -! - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - ! 4p single zeta - case(41) -!c 4p without cusp condition derivative of 22 -!c r^2 e^{-z1 r } - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt((2.d0*dd1)**7/240.d0/pi)/2.d0 - c=dd1**3.5d0*0.2060129077457011d0 -! endif - c0=-c - c1=3.5d0*c/dd1 - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)) - enddo - do i=0,0 - distp(i,3)=r(i)**2*distp(i,1) - enddo -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*(c0*distp(i,3)+c1*r(i)*distp(i,1)) - enddo -! endif - enddo - if(typec.ne.1) then -! fun=(1.d0-dd1*r(0))*distp(0,1) -! fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) - fun0=c0*distp(0,3)+c1*r(0)*distp(0,1) - fun=(c0*(2.d0-dd1*r(0))*r(0) & - &+c1*(1.d0-dd1*r(0)))*distp(0,1) - fun2=(c0*((dd1*r(0))**2+2.d0-4.d0*dd1*r(0)) & - &+c1*dd1*(dd1*r(0)-2.d0))*distp(0,1) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun/r(0) - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun/r(0)+fun2) -! endif - enddo - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(42) -! 4d without cusp and one parmater derivative of 30 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c= & -! & 1.d0/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) - c=dd1**3.5d0*0.26596152026762178d0 -! c= -! & 1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) -! endif - c0=-c - c1=3.5d0*c/dd1 - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)) - enddo - do i=0,0 - distp(i,3)=distp(i,1)*(c0*r(i)+c1) - ! lz=0 - distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - ! lz=+/ - distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - ! lz=+/-2 - distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d - ! lz=+/-1 - distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d - ! lz=+/-1 - distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d - enddo -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=distp(i,3+ic)*distp(i,3) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,3) - fun=-dd1*distp(0,3)+c0*distp(0,1) - fun2=dd1**2*distp(0,3)-2.d0*dd1*c0*distp(0,1) -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & - & *fun/r(0) - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif -! - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - case(43) -! 4d without cusp and one parmater derivative of 33 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c= & -! & 1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) - c=dd1**4.5d0*0.0710812062076410d0 -! endif - c0=-c - c1=4.5d0*c/dd1 - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)) - enddo - do i=0,0 - distp(i,3)=distp(i,1)*(c0*r(i)**2+c1*r(i)) - ! lz=0 - distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - ! lz=+/ - distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - ! lz=+/-2 - distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d - ! lz=+/-1 - distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d - ! lz=+/-1 - distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d - enddo -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=distp(i,3+ic)*distp(i,3) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,3) - fun=-dd1*distp(0,3)+distp(0,1)*(2.d0*c0*r(0)+c1) - fun2=dd1**2*distp(0,3)+distp(0,1)* & - &(-2.d0*dd1*(2.d0*c0*r(0)+c1)+2.d0*c0) -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & - & *fun/r(0) - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - endif -! - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - ! derivative of 36 with respect zeta - case(44) -! R(r)=x*exp(-z*r**2)*(5/4/z-r**2) - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0 - c=dd1**1.25d0*1.42541094070998d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo -! indorbp=indorb -! - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1)* & - & (5.d0/4.d0/dd1-r(i)**2) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1)*(5.d0/4.d0/dd1-r(0)**2) - fun=distp(0,1)*(2.d0*dd1*r(0)**2-9.d0/2.d0) - fun2=distp(0,1)*(-4.d0*dd1**2*r(0)**4 & - & +15.d0*dd1*r(0)**2-9.d0/2.d0) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - ! derivative of 37 with respect to z - case(45,69) -! d orbitals -! R(r)= c*exp(-z r^2)*(7/4/z-r^2) -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) - c=dd1**1.75d0*1.64592278064948967213d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - do i=0,0 - ! lz=0 - distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - ! lz=+/-2 - distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - ! lz=+/-2 - distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d - ! lz=+/-1 - distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d - ! lz=+/-1 - distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d - enddo - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*(7.d0/4.d0/dd1-r(k)**2)* & - & distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - dd1=dd(indparp) - fun0=distp(0,1)*(7.d0/4.d0/dd1-r(0)**2) - fun=distp(0,1)*(2.d0*dd1*r(0)**2-11.d0/2.d0) - fun2=distp(0,1)*(-4.d0*dd1**2*r(0)**4 & - & +17.d0*dd1*r(0)**2-11.d0/2.d0) -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - ! derivative of 17 with respect to z - case(46) -! R(r)=c*r**2*exp(-z*r**2)*(7/4/z-r**2) - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then - c=4.d0*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)/dsqrt(15.d0) -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - do i=0,0 - z(indorbp,i)=distp(i,1)*(7.d0/4.d0/dd1*r(i)**2 & - & -r(i)**4) - enddo - if(typec.ne.1) then - rp1=r(0)**2 -! the first derivative / r - fun=distp(0,1)*(7.d0-15.d0*dd1*rp1 & - & +4.d0*(dd1*rp1)**2)/2.d0/dd1 -! the second derivative - fun2=distp(0,1)*(7.d0-59*dd1*rp1+50*(dd1*rp1)**2 & - & -8*(dd1*rp1)**3)/2.d0/dd1 - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - ! 5s single zeta derivative of 12 - case(50) -! R(r)=(c0*r**4+c1*r**3)*exp(-z1*r) -! - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then - c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 -! endif - c0=-c - c1=4.5d0*c/dd1 - do k=0,0 - distp(k,1)=r(k)*dexp(-dd1*r(k)) - enddo - do i=0,0 - z(indorbp,i)=(c0*r(i)**3+c1*r(i)**2)*distp(i,1) - enddo - if(typec.ne.1) then - rp1=r(0)*dd1 - rp2=rp1*rp1 -!c the first derivative/r - fun=-distp(0,1)*(c0*r(0)*(rp1-4.d0)+c1*(rp1-3.d0)) -!c -!c the second derivative - fun2=distp(0,1)* & - &(c0*r(0)*(12.d0-8.d0*rp1+rp2)+c1*(6.d0-6*rp1+rp2)) -!c - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - endif -! - indorb=indorbp -! -! endif - indpar=indpar+1 - indshell=indshellp -! - case(51) -! g single gaussian orbital -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0) - c=dd1**2.75d0*1.11284691281640568826d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - do i=0,0 - distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & - & -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) - ! lz=0 - distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & - & *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=+/-1 - distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & - & *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=+/-1 - distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & - & *(7.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-2 - distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & - & *(7.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-2 - distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & - & *(rmu(1,i)**2-3.0*rmu(2,i)**2) - ! lz=+/-3 - distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & - & *(3.d0*rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-3 - distp(i,9)=cost5g*(rmu(1,i)**4 & - & -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) - ! lz=+/-4 - distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & - & *(rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-4 - enddo - do ic=1,9 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - dd1=dd(indparp) - fun0=distp(0,1) - fun=-2.d0*dd1*distp(0,1) - fun2=fun*(1.d0-2.d0*dd1*r(0)**2) -! indorbp=indorb - do ic=1,9 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun - enddo - if(ic.eq.1) then -! if(i.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) -! elseif(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2) & - +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) -! else - z(indorbp,indt+3)=z(indorbp,indt+3) & - +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) -! endif - elseif(ic.eq.2) then -! if(i.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) -! elseif(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2) & - +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) -! else - z(indorbp,indt+3)=z(indorbp,indt+3) & - +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) -! endif - elseif(ic.eq.3) then -! if(i.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) -! elseif(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2) & - +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) -! else - z(indorbp,indt+3)=z(indorbp,indt+3) & - +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) -! endif - elseif(ic.eq.4) then -! if(i.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) -! elseif(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2) & - +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) -! else - z(indorbp,indt+3)=z(indorbp,indt+3) & - +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) -! endif - elseif(ic.eq.5) then -! if(i.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) -! elseif(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2) & - +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) -! else - z(indorbp,indt+3)=z(indorbp,indt+3) & - +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) -! endif - elseif(ic.eq.6) then -! if(i.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) -! elseif(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2) & - -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) -! else - z(indorbp,indt+3)=z(indorbp,indt+3) & - +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) -! endif - elseif(ic.eq.7) then -! if(i.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) -! elseif(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2) & - +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) -! else - z(indorbp,indt+3)=z(indorbp,indt+3) & - +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) -! endif - elseif(ic.eq.8) then -! if(i.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) -! elseif(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2) & - +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) -! endif - elseif(ic.eq.9) then -! if(i.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) -! elseif(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2) & - +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) -! endif - endif - !enddo for i -! enddo - z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+9 - indorb=indorbp - case(52) -! g single gaussian orbital -! derivative of 51 -! R(r)= exp(-alpha r^2) -! normalized -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0) - c=dd1**2.75d0*1.11284691281640568826d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - do i=0,0 - distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & - & -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) - ! lz=0 - distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & - & *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=+/-1 - distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & - & *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=+/-1 - distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & - & *(7.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-2 - distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & - & *(7.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-2 - distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & - & *(rmu(1,i)**2-3.0*rmu(2,i)**2) - ! lz=+/-3 - distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & - & *(3.d0*rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-3 - distp(i,9)=cost5g*(rmu(1,i)**4 & - & -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) - ! lz=+/-4 - distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & - & *(rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-4 - enddo - do ic=1,9 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*(11.d0/4.d0/dd1-r(k)**2)* & - & distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - dd1=dd(indparp) - fun0=distp(0,1)*(11.d0/4.d0/dd1-r(0)**2) - fun=distp(0,1)*(2.d0*dd1*r(0)**2-15.d0/2.d0) - fun2=distp(0,1)*(-4.d0*dd1**2*r(0)**4 & - & +21.d0*dd1*r(0)**2-15.d0/2.d0) -! indorbp=indorb - do ic=1,9 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun - if(ic.eq.1) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) - endif - elseif(ic.eq.4) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) - endif - elseif(ic.eq.6) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) - endif - elseif(ic.eq.7) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) - endif - elseif(ic.eq.8) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) - endif - elseif(ic.eq.9) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) - endif - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+9 - indorb=indorbp - case(55) -! g single Slater orbital -! R(r)= exp(-alpha r) -! normalized -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! l = 4 -! \int d\omega Y*Y = 4 pi / (2 l + 1) -! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5**2 * 3**4 / 2**3 / dd1**11 -! c=1.d0/dsqrt(7.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(11.d0/2.d0)/3.d0/5.d0 - c=dd1**5.5d0*.020104801169736915d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - enddo - do i=0,0 - distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & - & -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) - ! lz=0 - distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & - & *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=+/-1 - distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & - & *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=+/-1 - distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & - & *(7.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-2 - distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & - & *(7.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-2 - distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & - & *(rmu(1,i)**2-3.0*rmu(2,i)**2) - ! lz=+/-3 - distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & - & *(3.d0*rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-3 - distp(i,9)=cost5g*(rmu(1,i)**4 & - & -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) - ! lz=+/-4 - distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & - & *(rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-4 - enddo - do ic=1,9 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - dd1=dd(indparp) - fun0=distp(0,1) - fun=-dd1*distp(0,1)/r(0) - fun2=dd1**2*distp(0,1) -! indorbp=indorb - do ic=1,9 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun - if(ic.eq.1) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) - endif - elseif(ic.eq.4) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) - endif - elseif(ic.eq.6) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) - endif - elseif(ic.eq.7) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) - endif - elseif(ic.eq.8) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) - endif - elseif(ic.eq.9) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) - endif - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+9 - indorb=indorbp - case(56) -! g single Slater orbital derivative of 55 -! R(r)= (11.d0/2.0 1/dd1 - r) * exp(-alpha r) -! normalized -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization -! l = 4 -! \int d\omega Y*Y = 4 pi / (2 l + 1) -! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5**2 * 3**4 / 2**3 / dd1**11 - c=dd1**5.5d0*.020104801169736915d0 -! c=1.d0/dsqrt(7.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(11.d0/2.d0)/3.d0/5.d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)) - enddo - do i=0,0 - distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & - & -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) - ! lz=0 - distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & - & *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=+/-1 - distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & - & *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=+/-1 - distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & - & *(7.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-2 - distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & - & *(7.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-2 - distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & - & *(rmu(1,i)**2-3.0*rmu(2,i)**2) - ! lz=+/-3 - distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & - & *(3.d0*rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-3 - distp(i,9)=cost5g*(rmu(1,i)**4 & - & -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) - ! lz=+/-4 - distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & - & *(rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-4 - enddo - do ic=1,9 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*distp(k,1+ic)*(11.d0/2.d0/dd1 - r(k)) - enddo -! endif - enddo - if(typec.ne.1) then - dd1=dd(indparp) - fun0=distp(0,1)*(11.d0/2.d0/dd1-r(0)) - fun=distp(0,1)*(dd1-13.d0/2.d0/r(0)) - fun2=dd1*distp(0,1)*(15.d0/2.d0-dd1*r(0)) -! indorbp=indorb - do ic=1,9 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun - if(ic.eq.1) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) - endif - elseif(ic.eq.4) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) - endif - elseif(ic.eq.6) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) - endif - elseif(ic.eq.7) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) - endif - elseif(ic.eq.8) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) - endif - elseif(ic.eq.9) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i) & - +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) - endif - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+9 - indorb=indorbp - case(72) ! h-orbitals -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization obtained by Mathematica - c=dd1**3.25d0*0.79296269381073167718d0 -! C= dd1^13/4 /Sqrt[Integrate[x^12 Exp[-2 x^2],{x,0,Infinity}]] -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - do i=0,0 - do k=1,5 - zv(k)=rmu(3,i)**k - yv(k)=rmu(2,i)**k - xv(k)=rmu(1,i)**k - enddo - r2=xv(2)+yv(2)+zv(2) - r4=r2*r2 - ! lz=0 - distp(i,2)=cost1h*(63.d0*zv(5)-70.d0*zv(3)*r2+15.d0*zv(1)*r4) - cost=(21.d0*zv(4)-14.d0*zv(2)*r2+r4) - ! lz=+/-1 - distp(i,3)=cost2h*rmu(1,i)*cost - ! lz=+/-1 - distp(i,4)=cost2h*rmu(2,i)*cost - cost=3.d0*zv(3)-zv(1)*r2 - ! lz=+/-2 - distp(i,5)=cost3h*(xv(2)-yv(2))*cost - ! lz=+/-2 - distp(i,6)=2.d0*cost3h*xv(1)*yv(1)*cost - cost=9.d0*zv(2)-r2 - ! lz=+/-3 - distp(i,7)=cost4h*(xv(3)-3.d0*xv(1)*yv(2))*cost - ! lz=+/-3 - distp(i,8)=-cost4h*(yv(3)-3.d0*yv(1)*xv(2))*cost - ! lz=+/-4 - distp(i,9)=cost5h*(xv(4)-6.d0*xv(2)*yv(2)+yv(4))*zv(1) - ! lz=+/-4 - distp(i,10)=cost5h*4.d0*(xv(3)*yv(1)-yv(3)*xv(1))*zv(1) - ! lz=+/-5 - distp(i,11)=cost6h*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4)) - ! lz=+/-5 - distp(i,12)=-cost6h*(-5.d0*xv(4)*yv(1)+10.d0*xv(2)*yv(3)-yv(5)) - enddo - do ic=1,11 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - dd1=dd(indparp) - fun0=distp(0,1) - fun=-2.d0*dd1*distp(0,1) - fun2=fun*(1.d0-2.d0*dd1*r(0)**2) - do k=1,5 - zv(k)=rmu(3,0)**k - yv(k)=rmu(2,0)**k - xv(k)=rmu(1,0)**k - enddo - r2=xv(2)+yv(2)+zv(2) - r4=r2*r2 -! indorbp=indorb - do ic=1,11 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun - enddo - if(ic.eq.1) then -! if(i.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &+cost1h*fun0*20.d0*xv(1)*zv(1)*(3.d0*xv(2)+3.d0*yv(2)-4.d0*zv(2)) -! elseif(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2) & - &+cost1h*fun0*20.d0*yv(1)*zv(1)*(3.d0*xv(2)+3.d0*yv(2)-4.d0*zv(2)) - z(indorbp,indt+3)=z(indorbp,indt+3)& - &+cost1h*fun0*(175.d0*zv(4)-150.d0*zv(2)*r2+15.d0*r4) - elseif(ic.eq.2) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &+cost2h*fun0*(5.d0*xv(4)+6.d0*xv(2)*yv(2)+yv(4)-36.d0*xv(2)*zv(2)& - &-12.d0*yv(2)*zv(2)+8.d0*zv(4)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &+cost2h*fun0*(4.d0*xv(3)*yv(1)+4.d0*xv(1)*yv(3)-24.d0*xv(1)*yv(1)*zv(2)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &+cost2h*fun0*(-24.d0*xv(3)*zv(1)-24.d0*xv(1)*yv(2)*zv(1)+32.d0*zv(3)*xv(1)) - elseif(ic.eq.3) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &-cost2h*fun0*(-4.d0*xv(3)*yv(1)-4.d0*xv(1)*yv(3)+24.d0*xv(1)*yv(1)*zv(2)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &+cost2h*fun0*(5.d0*yv(4)+6.d0*xv(2)*yv(2)+xv(4)-36.d0*yv(2)*zv(2)& - &-12.d0*xv(2)*zv(2)+8.d0*zv(4)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &+cost2h*fun0*(-24.d0*yv(3)*zv(1)-24.d0*yv(1)*xv(2)*zv(1)& - &+32.d0*zv(3)*yv(1)) - elseif(ic.eq.4) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &+cost3h*fun0*(-4.d0*xv(3)*zv(1)+4.d0*xv(1)*zv(3)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &+cost3h*fun0*(4.d0*yv(3)*zv(1)-4.d0*yv(1)*zv(3)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &+cost3h*fun0*(-xv(4)+yv(4)+6.d0*xv(2)*zv(2)-6.d0*yv(2)*zv(2)) - elseif(ic.eq.5) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &-cost3h*fun0*(6.d0*xv(2)*yv(1)*zv(1)+2.d0*yv(3)*zv(1)-4.d0*yv(1)*zv(3)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &-cost3h*fun0*(2.d0*xv(3)*zv(1)+6.d0*xv(1)*yv(2)*zv(1)-4.d0*xv(1)*zv(3)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &-cost3h*fun0*(2.d0*xv(3)*yv(1)+2.d0*xv(1)*yv(3)-12.d0*xv(1)*yv(1)*zv(2)) - elseif(ic.eq.6) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &+cost4h*fun0*(-5.d0*xv(4)+6.d0*xv(2)*yv(2)+3.d0*yv(4)+24.d0*xv(2)*zv(2)-24.d0*yv(2)*zv(2)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &+cost4h*fun0*(4.d0*xv(3)*yv(1)+12.d0*xv(1)*yv(3)-48.d0*xv(1)*yv(1)*zv(2)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &+cost4h*fun0*(16.d0*xv(3)*zv(1)-48.d0*xv(1)*yv(2)*zv(1)) - elseif(ic.eq.7) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &-cost4h*fun0*(12.d0*xv(3)*yv(1)+4.d0*xv(1)*yv(3)-48.d0*xv(1)*yv(1)*zv(2)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &-cost4h*fun0*(3.d0*xv(4)+6.d0*xv(2)*yv(2)-5.d0*yv(4)-24.d0*xv(2)*zv(2)+24.d0*yv(2)*zv(2)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &-cost4h*fun0*(-48.d0*xv(2)*yv(1)*zv(1)+16.d0*yv(3)*zv(1)) - elseif(ic.eq.8) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &+cost5h*fun0*(4.d0*xv(3)*zv(1)-12.d0*xv(1)*yv(2)*zv(1)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &+cost5h*fun0*(-12.d0*xv(2)*yv(1)*zv(1)+4.d0*yv(3)*zv(1)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &+cost5h*fun0*(xv(4)-6.d0*xv(2)*yv(2)+yv(4)) - elseif(ic.eq.9) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &-cost5h*fun0*(-12.d0*xv(2)*yv(1)*zv(1)+4.d0*yv(3)*zv(1)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &-cost5h*fun0*(-4.d0*xv(3)*zv(1)+12.d0*xv(1)*yv(2)*zv(1)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &-cost5h*fun0*(-4.d0*xv(3)*yv(1)+4.d0*xv(1)*yv(3)) - elseif(ic.eq.10) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &+cost6h*fun0*(5.d0*xv(4)-30.d0*xv(2)*yv(2)+5.d0*yv(4)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &+cost6h*fun0*(-20.d0*xv(3)*yv(1)+20.d0*xv(1)*yv(3)) - elseif(ic.eq.11) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &-cost6h*fun0*(-20.d0*xv(3)*yv(1)+20.d0*xv(1)*yv(3)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &-cost6h*fun0*(-5.d0*xv(4)+30.d0*xv(2)*yv(2)-5.d0*yv(4)) - endif - z(indorbp,indt+4)=distp(0,1+ic)*(12.d0*fun+fun2) - !endif for iocc -! endif - enddo ! enddo fot ic - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+11 - indorb=indorbp - ! 2s gaussian for pseudo - case(73) ! I-orbitals -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization obtained by Mathematica - c=dd1**3.75d0*0.43985656185609913955d0 -! C= dd1^15/4 /Sqrt[Integrate[x^14 Exp[-2 x^2],{x,0,Infinity}]] -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - do i=0,0 - do k=1,6 - zv(k)=rmu(3,i)**k - yv(k)=rmu(2,i)**k - xv(k)=rmu(1,i)**k - enddo - r2=xv(2)+yv(2)+zv(2) - r4=r2*r2 - r6=r2*r4 - ! lz=0 - distp(i,2)=cost1i*(231.d0*zv(6)-315.d0*zv(4)*r2+105.d0*zv(2)*r4-5.d0*r6) - cost=(33.d0*zv(5)-30.d0*zv(3)*r2+5.d0*zv(1)*r4) - ! lz=+/-1 - distp(i,3)=cost2i*rmu(1,i)*cost - ! lz=+/-1 - distp(i,4)=cost2i*rmu(2,i)*cost - cost=33.d0*zv(4)-18.d0*zv(2)*r2+r4 - ! lz=+/-2 - distp(i,5)=cost3i*(xv(2)-yv(2))*cost - ! lz=+/-2 - distp(i,6)=2.d0*cost3i*xv(1)*yv(1)*cost - cost=11.d0*zv(3)-3.d0*zv(1)*r2 - ! lz=+/-3 - distp(i,7)=cost4i*(xv(3)-3.d0*xv(1)*yv(2))*cost - ! lz=+/-3 - distp(i,8)=-cost4i*(yv(3)-3.d0*yv(1)*xv(2))*cost - cost=11.d0*zv(2)-r2 - ! lz=+/-4 - distp(i,9)=cost5i*(xv(4)-6.d0*xv(2)*yv(2)+yv(4))*cost - ! lz=+/-4 - distp(i,10)=cost5i*4.d0*(xv(3)*yv(1)-yv(3)*xv(1))*cost - ! lz=+/-5 - distp(i,11)=cost6i*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4))*zv(1) - ! lz=+/-5 - distp(i,12)=-cost6i*(-5.d0*xv(4)*yv(1)+10.d0*xv(2)*yv(3)-yv(5))*zv(1) - ! lz=+/-6 - distp(i,13)=cost7i*(xv(6)-15.d0*xv(4)*yv(2)+15.d0*xv(2)*yv(4)-yv(6)) - ! lz=+/-6 - distp(i,14)=-cost7i*(-6.d0*xv(5)*yv(1)+20.d0*xv(3)*yv(3)-6.d0*yv(5)*xv(1)) - enddo - do ic=1,13 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - dd1=dd(indparp) - fun0=distp(0,1) - fun=-2.d0*dd1*distp(0,1) - fun2=fun*(1.d0-2.d0*dd1*r(0)**2) - do k=1,6 - zv(k)=rmu(3,0)**k - yv(k)=rmu(2,0)**k - xv(k)=rmu(1,0)**k - enddo - r2=xv(2)+yv(2)+zv(2) - r4=r2*r2 - r6=r2*r4 -! indorbp=indorb - do ic=1,13 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun - enddo - if(ic.eq.1) then -! if(i.eq.1) then -! lz =0 - z(indorbp,indt+1)=z(indorbp,indt+1) & - &+cost1i*fun0*(-30.d0*xv(5)-60.d0*xv(3)*yv(2)-30.d0*xv(1)*yv(4) & - &+360.d0*xv(3)*zv(2)+360.d0*xv(1)*yv(2)*zv(2)-240.d0*xv(1)*zv(4)) -! elseif(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2) & - &+cost1i*fun0*(-30.d0*xv(4)*yv(1)-60.d0*xv(2)*yv(3)-30.d0*yv(5) & - &+360.d0*xv(2)*yv(1)*zv(2)+360.d0*yv(3)*zv(2)-240.d0*yv(1)*zv(4)) - z(indorbp,indt+3)=z(indorbp,indt+3)& - &+cost1i*fun0*(180.d0*xv(4)*zv(1)+360.d0*xv(2)*yv(2)*zv(1)+180.d0*yv(4)*zv(1)& - &-480.d0*xv(2)*zv(3)-480.d0*yv(2)*zv(3)+96.d0*zv(5)) - elseif(ic.eq.2) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &+cost2i*fun0*(25.d0*xv(4)*zv(1)+30.d0*xv(2)*yv(2)*zv(1)+5.d0*yv(4)*zv(1)& - &-60.d0*xv(2)*zv(3)-20.d0*yv(2)*zv(3)+8.d0*zv(5)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &+cost2i*fun0*(20.d0*xv(3)*yv(1)*zv(1)+20.d0*xv(1)*yv(3)*zv(1) & - &-40.d0*xv(1)*yv(1)*zv(3)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &+cost2i*fun0*(5.d0*xv(5)+10.d0*xv(3)*yv(2)+5.d0*yv(4)*xv(1)& - &-60.d0*xv(3)*zv(2)-60.d0*xv(1)*yv(2)*zv(2)+40.d0*xv(1)*zv(4)) - elseif(ic.eq.3) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &-cost2i*fun0*(-20.d0*xv(3)*yv(1)*zv(1)-20.d0*xv(1)*yv(3)*zv(1) & - &+40.d0*xv(1)*yv(1)*zv(3)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &-cost2i*fun0*(-5.d0*xv(4)*zv(1)-30.d0*xv(2)*yv(2)*zv(1)-25.d0*yv(4)*zv(1) & - &+20.d0*xv(2)*zv(3)+60.d0*yv(2)*zv(3)-8.d0*zv(5)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &-cost2i*fun0*(-5.d0*xv(4)*yv(1)-10.d0*xv(2)*yv(3)-5.d0*yv(5)& - &+60.d0*xv(2)*yv(1)*zv(2)+60.d0*yv(3)*zv(2)-40.d0*yv(1)*zv(4)) - elseif(ic.eq.4) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &+cost3i*fun0*(6.d0*xv(5)+4.d0*xv(3)*yv(2)-2.d0*xv(1)*yv(4)& - &-64.d0*xv(3)*zv(2)+32.d0*xv(1)*zv(4)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &+cost3i*fun0*(2.d0*xv(4)*yv(1)-4.d0*xv(2)*yv(3)-6.d0*yv(5)& - &+64.d0*yv(3)*zv(2)-32.d0*yv(1)*zv(4)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &+cost3i*fun0*(-32.d0*xv(4)*zv(1)+32.d0*yv(4)*zv(1)+64.d0*xv(2)*zv(3)& - &-64.d0*yv(2)*zv(3)) - elseif(ic.eq.5) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &-cost3i*fun0*(-10.d0*xv(4)*yv(1)-12.d0*xv(2)*yv(3)-2.d0*yv(5)& - & +96.d0*xv(2)*yv(1)*zv(2)+32.d0*yv(3)*zv(2)-32.d0*yv(1)*zv(4)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &-cost3i*fun0*(-2.d0*xv(5)-12.d0*xv(3)*yv(2)-10.d0*xv(1)*yv(4)& - & +32.d0*xv(3)*zv(2)+96.d0*xv(1)*yv(2)*zv(2)-32.d0*xv(1)*zv(4)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &-cost3i*fun0*(64.d0*xv(3)*yv(1)*zv(1)+64.d0*xv(1)*yv(3)*zv(1)-128.d0*xv(1)*yv(1)*zv(3)) - elseif(ic.eq.6) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &+cost4i*fun0*(-15.d0*xv(4)*zv(1)+18.d0*xv(2)*yv(2)*zv(1)+9.d0*yv(4)*zv(1) & - &+24.d0*xv(2)*zv(3)-24.d0*yv(2)*zv(3)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &+cost4i*fun0*(12.d0*xv(3)*yv(1)*zv(1)+36.d0*xv(1)*yv(3)*zv(1)-48.d0*xv(1)*yv(1)*zv(3)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &+cost4i*fun0*(-3.d0*xv(5)+6.d0*xv(3)*yv(2)+9.d0*xv(1)*yv(4)+24.d0*xv(3)*zv(2)& - &-72.d0*xv(1)*yv(2)*zv(2)) - elseif(ic.eq.7) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &-cost4i*fun0*(36.d0*xv(3)*yv(1)*zv(1)+12.d0*xv(1)*yv(3)*zv(1)-48.d0*xv(1)*yv(1)*zv(3)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &-cost4i*fun0*(9.d0*xv(4)*zv(1)+18.d0*xv(2)*yv(2)*zv(1)-15.d0*yv(4)*zv(1) & - &-24.d0*xv(2)*zv(3)+24.d0*yv(2)*zv(3)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &-cost4i*fun0*(9.d0*xv(4)*yv(1)+6.d0*xv(2)*yv(3)-3.d0*yv(5) & - &-72.d0*xv(2)*yv(1)*zv(2)+24.d0*yv(3)*zv(2)) - elseif(ic.eq.8) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &+cost5i*fun0*(-6.d0*xv(5)+20.d0*xv(3)*yv(2)+10.d0*xv(1)*yv(4)& - &+40.d0*xv(3)*zv(2)-120.d0*xv(1)*yv(2)*zv(2)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &+cost5i*fun0*(10.d0*xv(4)*yv(1)+20.d0*xv(2)*yv(3)-6.d0*yv(5)& - &-120.d0*xv(2)*yv(1)*zv(2)+40.d0*yv(3)*zv(2)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &+cost5i*fun0*(20.d0*xv(4)*zv(1)-120.d0*xv(2)*yv(2)*zv(1)+20.d0*yv(4)*zv(1)) - elseif(ic.eq.9) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &-cost5i*fun0*(20.d0*xv(4)*yv(1)-4.d0*yv(5)-120.d0*xv(2)*yv(1)*zv(2)& - &+40.d0*yv(3)*zv(2)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &-cost5i*fun0*(4.d0*xv(5)-20.d0*xv(1)*yv(4)-40.d0*xv(3)*zv(2)& - &+120.d0*xv(1)*yv(2)*zv(2)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &-cost5i*fun0*(-80.d0*xv(3)*yv(1)*zv(1)+80.d0*xv(1)*yv(3)*zv(1)) - elseif(ic.eq.10) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &+cost6i*fun0*(5.d0*xv(4)*zv(1)-30.d0*xv(2)*yv(2)*zv(1)+5.d0*yv(4)*zv(1)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &+cost6i*fun0*(-20.d0*xv(3)*yv(1)*zv(1)+20.d0*xv(1)*yv(3)*zv(1)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &+cost6i*fun0*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4)) - elseif(ic.eq.11) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &-cost6i*fun0*(-20.d0*xv(3)*yv(1)*zv(1)+20.d0*xv(1)*yv(3)*zv(1)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &-cost6i*fun0*(-5.d0*xv(4)*zv(1)+30.d0*xv(2)*yv(2)*zv(1)-5.d0*yv(4)*zv(1)) - z(indorbp,indt+3)=z(indorbp,indt+3) & - &-cost6i*fun0*(-5.d0*xv(4)*yv(1)+10.d0*xv(2)*yv(3)-yv(5)) - elseif(ic.eq.12) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &+cost7i*fun0*(6.d0*xv(5)-60.d0*xv(3)*yv(2)+30.d0*xv(1)*yv(4)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &+cost7i*fun0*(-30.d0*xv(4)*yv(1)+60.d0*xv(2)*yv(3)-6.d0*yv(5)) - elseif(ic.eq.13) then - z(indorbp,indt+1)=z(indorbp,indt+1) & - &-cost7i*fun0*(-30.d0*xv(4)*yv(1)+60.d0*xv(2)*yv(3)-6.d0*yv(5)) - z(indorbp,indt+2)=z(indorbp,indt+2) & - &-cost7i*fun0*(-6.d0*xv(5)+60.d0*xv(3)*yv(2)-30.d0*xv(1)*yv(4)) - endif - z(indorbp,indt+4)=distp(0,1+ic)*(14.d0*fun+fun2) - !endif for iocc -! endif - enddo ! enddo fot ic - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+13 - indorb=indorbp - ! 2s gaussian for pseudo - case(60) -! R(r)=r**3*exp(-z*r**2) single zeta - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=2.d0/pi**(3.d0/4.d0)*(2.d0*dd1)**(9.d0/4.d0)*dsqrt(2.d0/105.d0) - c=dd1**2.25d0*.55642345640820284397d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2)*r(k) - enddo - do i=0,0 - z(indorbp,i)=distp(i,1)*r(i)**2 - enddo - if(typec.ne.1) then - rp1=r(0)**2*dd1 -! the first derivative / r - fun=distp(0,1)*(3.d0-2.d0*rp1) -! the second derivative - fun2=distp(0,1)*(6.d0-14.d0*rp1+4.d0*rp1**2) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - ! 3s -derivative of 60 with respect to dd1 - case(61) -! R(r)=c (-r**5*exp(-z1*r**2)+c1 r**3 exp(-z1*r**2)) - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - indorbp=indorb+1 - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=2.d0/pi**(3.d0/4.d0)*(2.d0*dd1)**(9.d0/4.d0)*dsqrt(2.d0/105.d0) - c=dd1**2.25d0*.55642345640820284397d0 -! endif - c1=2.25d0/dd1 - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2)*r(k) - enddo - do i=0,0 - z(indorbp,i)=(-r(i)**4+c1*r(i)**2)*distp(i,1) - enddo - if(typec.ne.1) then - rp1=r(0)**2 - rp2=rp1*dd1 - fun=c1*distp(0,1)*(3.d0-2.d0*rp2) & - &+distp(0,1)*rp1*(-5.d0+2.d0*rp2) -! the second derivative - fun2=c1*distp(0,1)*(6.d0-14.d0*rp2+4.d0*rp2**2) & - &+distp(0,1)*rp1*(-20.d0+22.d0*rp2-4.d0*rp2**2) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - endif - indorb=indorbp -! endif - indpar=indpar+1 - indshell=indshellp - ! single gaussianx r p orbitals - case(62) - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=2.d0/pi**0.75d0*(2.d0*dd1)**1.75d0/dsqrt(5.d0) - c=dd1**1.75d0*1.2749263037197753d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo -! indorbp=indorb -! - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1)*r(0) - cost=2.d0*dd1*r(0)**2 - fun=distp(0,1)*(1.d0-cost)/r(0) - fun2=2.d0*dd1*fun0*(cost-3.d0) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - ! derivative of 62 with respect zeta - case(63) -! R(r)=c x*exp(-z*r**2)*r (c1 - r^2) - dd1=dd(indpar+1) -! if(iflagnorm.gt.2) then - c=dd1**1.75d0*1.2749263037197753d0 -! c=2.d0/pi**0.75d0*(2.d0*dd1)**1.75d0/dsqrt(5.d0) -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - c1=1.75d0/dd1 -! indorbp=indorb -! - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1)* & - & (c1-r(i)**2)*r(i) - enddo -! endif - enddo - if(typec.ne.1) then - rp1=dd1*r(0)**2 - cost=2.d0*rp1 - fun0=distp(0,1)*r(0)*(c1-r(0)**2) - fun=distp(0,1)*(c1*(1.d0-cost)/r(0)+ & - &(-3.d0+cost)*r(0)) -! My bug !!! -! fun2=distp(0,1)*(c1*2.d0*dd1*fun0*(cost-3.d0) -! &-2.d0*r(0)*(3.d0-7.d0*rp1+2.d0*rp1**2)) - fun2=-2.d0*distp(0,1)*r(0)* & - & (3.d0-7.d0*rp1+2.d0*rp1**2+c1*dd1*(3.d0-cost)) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(64) -! d orbitals -! R(r)= r exp(-alpha r^2) -! each gaussian term is normalized -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) -! if(iflagnorm.gt.2) then -! c=8.d0/dsqrt(21.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) - c=dd1**2.25d0*1.24420067280413253d0 -! endif - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - do i=0,0 - ! lz=0 - distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - ! lz=+/-2 - distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - ! lz=+/-2 - distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d - ! lz=+/-1 - distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d - ! lz=+/-1 - distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d - enddo - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*distp(k,1+ic)*r(k) - enddo -! endif - enddo - if(typec.ne.1) then - dd1=dd(indparp) - rp1=2.d0*dd1*r(0) - rp2=rp1*r(0) - fun0=distp(0,1)*r(0) - fun=(1.d0-rp2)*distp(0,1)/r(0) - fun2=distp(0,1)*rp1*(rp2-3.d0) -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - endif - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - case(65) -! d orbitals -! R(r)= c0 r^3 exp(-alpha r^2)+ c1 r exp(-alpha r^2) -! each gaussian term is normalized -! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) -! if(iflagnorm.gt.2) then -! overall normalization to be done -! c=8.d0/dsqrt(21.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) - c=dd1**2.25d0*1.24420067280413253d0 -! endif - c0=-c - c1=2.25d0*c/dd1 - do k=0,0 - distp(k,1)=c*dexp(-dd1*r(k)**2) - enddo - do i=0,0 - ! lz=0 - distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - ! lz=+/-2 - distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - ! lz=+/-2 - distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d - ! lz=+/-1 - distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d - ! lz=+/-1 - distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d - enddo - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*(c0*distp(k,1+ic)*r(k)**3+ & - & c1*r(k)) - enddo -! endif - enddo - if(typec.ne.1) then - dd1=dd(indparp) - rp1=2.d0*dd1*r(0) - rp2=rp1*r(0) - fun0=distp(0,1)*(c1*r(0)+c0*r(0)**3) - fun=(c1*(1.d0-rp2)+c0*r(0)**2*(3.d0-rp2)) & - & *distp(0,1)/r(0) - fun2=distp(0,1)*(c1*rp1*(rp2-3.d0)+c0*r(0) & - & *(3.d0-3.5d0*rp2+0.5d0*rp2**2)) -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp -! ******************* END GAUSSIAN BASIS ************************ -! ** ** ** ** ** ** ** JASTROW ORBITALS ** ** ** ** ** ** ** ** * - case(100) -! 2s single gaussian -! exp(-dd2*r^2) - dd2=dd(indpar+1) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)*r(k)) - enddo -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1) - enddo -! endif - if(typec.ne.1) then - fun=-dd2*distp(0,1)*2.d0 - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*dd2*(-3.d0+2.d0*dd2*r(0)**2)* & - & distp(0,1) - !endif for indt - endif - indpar=indpar+1 - indshell=indshellp - indorb=indorbp - case(101) -! 2s without cusp condition -! dd1*( dd3 +exp(-dd2*r^2)) - dd2=dd(indpar+1) - dd3=dd(indpar+2) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)*r(k)) - enddo -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)+dd3 - enddo -! endif - if(typec.ne.1) then - fun=-dd2*distp(0,1)*2.d0 - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*dd2*(-3.d0+2.d0*dd2*r(0)**2)* & - & distp(0,1) - !endif for indt - endif - indpar=indpar+2 - indshell=indshellp - indorb=indorbp - case(102) -! 2s double gaussian with constant -! (dd3+ exp (-dd2 r^2)+dd4*exp(-dd5*r^2)) - dd2=dd(indpar+1) - dd3=dd(indpar+2) - dd4=dd(indpar+3) - dd5=dd(indpar+4) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)*r(k)) - distp(k,2)=dexp(-dd5*r(k)*r(k)) - enddo -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=(distp(i,1)+dd3+dd4*distp(i,2)) -! write(6,*) ' function inside = ',z(indorbp,i) - enddo -! endif - if(typec.ne.1) then - fun=-2.d0*(dd2*distp(0,1)+dd5*dd4*distp(0,2)) - fun2=r(0)**2 -! write(6,*) ' fun inside = ',fun,fun2 - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*(dd2*(-3.d0+2.d0*dd2*fun2)* & - & distp(0,1)+dd5*dd4*(-3.d0+2.d0*dd5*fun2)*distp(0,2)) -! write(6,*) ' lap 106 =',z(indorbp,indt+4) -! stop - !endif for indt - endif - indpar=indpar+4 - indshell=indshellp - indorb=indorbp - case(104) -! 2p double gaussian -! dd1 * x_mu (exp(-dd2 r^2)+dd3 * exp(-dd4*r^2)) - dd2=dd(indpar+1) - dd3=dd(indpar+2) - dd4=dd(indpar+3) - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)**2) - distp(k,2)=dexp(-dd4*r(k)**2) - enddo -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*(distp(i,1)+dd3*distp(i,2)) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=(distp(0,1)+dd3*distp(0,2)) - fun=2.d0*(-dd2*distp(0,1) & - & -dd4*dd3*distp(0,2)) - fun2=2.d0*(dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0,1) & - &+dd4*dd3*(-1.d0+2.d0*dd4*r(0)**2)*distp(0,2)) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+3 - indshell=indshell+3 - indorb=indorbp - case(103) -! 2p single gaussian - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)**2) - enddo -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1) - fun=-dd2*distp(0,1)*2.d0 - fun2=2.d0*dd2*(-1.d0+2.d0*dd2*r(0)**2)* & - & distp(0,1) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - enddo - z(indorbp,indt+ic)=z(indorbp,indt+ic)+fun0 - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(105) + use constants + implicit none + integer iopt,indt,i,k,nelskip,indpar,indorbp ,indorb,indshell,indshellp,ic,iflagnorm_unused,indparp,npower,typec ,ii,jj,kk + real*8 z(nelskip,0:*),dd(*),zeta(*),rmu(3,0:0) ,r(0:0) ,distp(0:0,20),peff,fun,fun0,fun2 ,rp1,rp2,rp3,rp4,rp5,rp6,rp7,rp8 ,dd1,dd2,dd3,dd4,dd5,c,cr,funp,fun2p,funb ,peff2,arg,c0,c1,cost,zv(6),yv(6),xv(6),r2,r4,r6 ! up to i + integer :: count, multiplicity + integer, parameter :: max_power = 20 + real*8 :: powers(3,-2:max_power,0:0) + ! + ! indorb are the number of orbitals occupied before calling + ! this subroutine + ! + ! indpar is the number of variational parameters used + ! before calling this subroutine + ! + ! indshell is the index of the last occupied orbital + ! in the shell, characterized by occupation number iocc(indshell) + ! + ! z(i,indt+4) contains the laplacian of the orbital i + ! z(i,indt+mu) contains the gradient of the orbital i (mu=1,2,3) + ! In the following given a radial part of the orbital f(r) + ! fun=1/r d f(r)/d r + !print *,__FILE__ + !print *,'makefun: iopt=',iopt + !print *,'makefun: i=',' a=',' b=' + !print *,'makefun: indpar=',indpar,' indorb=',indorb,' indshell=',indshell + !print *,'makefun: nelskip=',nelskip +select case (iopt) +case (105) ! 2s double gaussian without constant ! (exp (-dd2 r^2)+dd4*exp(-dd5*r^2)) ! dd1=1.d0 - dd2=dd(indpar+1) +dd2=dd(indpar+1) ! dd3=dd(indpar+2) ! dd4=dd(indpar+3) ! dd5=dd(indpar+4) - dd4=dd(indpar+2) - dd5=dd(indpar+3) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)*r(k)) - distp(k,2)=dexp(-dd5*r(k)*r(k)) - enddo +dd4=dd(indpar+2) +dd5=dd(indpar+3) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)*r(k)) + distp(k,2)=dexp(-dd5*r(k)*r(k)) +end do ! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)+dd4*distp(i,2) +do i=0,0 + z(indorbp,i)=distp(i,1)+dd4*distp(i,2) ! write(6,*) ' function inside = ',z(indorbp,i) - enddo -! endif - if(typec.ne.1) then - fun=-2.d0*(dd2*distp(0,1)+dd5*dd4*distp(0,2)) - fun2=r(0)**2 -! write(6,*) ' fun inside = ',fun,fun2 - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*(dd2*(-3.d0+2.d0*dd2*fun2)* & - & distp(0,1)+dd5*dd4*(-3.d0+2.d0*dd5*fun2)*distp(0,2)) - !endif for indt - endif - indpar=indpar+3 - indshell=indshellp - indorb=indorbp - case(106) -! 2s without cusp condition -! dd1*( dd3 +1/(1+dd2*r^2)) - dd2=dd(indpar+1) - dd3=dd(indpar+2) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=1.d0/(1.d0+dd2*r(k)*r(k)) - enddo -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)+dd3 - enddo -! endif - if(typec.ne.1) then - fun=-dd2*distp(0,1)**2*2.d0 - fun2=fun*distp(0,1)*(1.-3.d0*dd2*r(0)**2) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=fun2+2.d0*fun - !endif for indt - endif - indpar=indpar+2 - indshell=indshellp - indorb=indorbp - case(107) -! 2p single lorentian parent of 103 - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=1.d0/(1.d0+dd2*r(k)**2) - enddo -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1) - fun=-dd2*distp(0,1)**2*2.d0 - fun2=fun*distp(0,1)*(1.d0-3.d0*dd2*r(0)**2) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(108) -! 2s double lorentian with constant parent of 102 -! (dd3+ L(dd2 r^2)+dd4*L(dd5*r^2)) ; L(x)=1/1+x^2 - dd2=dd(indpar+1) - dd3=dd(indpar+2) - dd4=dd(indpar+3) - dd5=dd(indpar+4) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=1.d0/(1.d0+dd2*r(k)*r(k)) - distp(k,2)=1.d0/(1.d0+dd5*r(k)*r(k)) - enddo -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=(distp(i,1)+dd3+dd4*distp(i,2)) -! write(6,*) ' function inside = ',z(indorbp,i) - enddo -! endif - if(typec.ne.1) then - fun=-2.d0*(dd2*distp(0,1)**2+dd5*dd4*distp(0,2)**2) - fun2=2.d0*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) & - & +2.d0*dd5*dd4*distp(0,2)**3*(-1.d0+3.d0*dd5*r(0)**2) -! write(6,*) ' fun inside = ',fun,fun2 - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=fun2+2.d0*fun -! write(6,*) ' lap 106 =',z(indorbp,indt+4) - !endif for indt - endif - indpar=indpar+4 - indshell=indshellp - indorb=indorbp - case(109) -! 2p double Lorentian -! dd1 * x_mu (L(dd2 r^2)+dd3 * L(dd4*r^2)) ; L(x)=1/(1+x^2) - dd2=dd(indpar+1) - dd3=dd(indpar+2) - dd4=dd(indpar+3) - do k=0,0 - distp(k,1)=1.d0/(1.d0+dd2*r(k)**2) - distp(k,2)=1.d0/(1.d0+dd4*r(k)**2) - enddo -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*(distp(i,1)+dd3*distp(i,2)) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1)+dd3*distp(0,2) - fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) -! fun2=2.d0*(dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0,1) -! 1+dd4*dd3*(-1.d0+2.d0*dd4*r(0)**2)*distp(0,2)) - fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) & - &+2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+3 - indshell=indshell+3 - indorb=indorbp - case(110) -! 2s without cusp condition -! dd1*( dd3 +1/(1+dd2*r^3)) - dd2=dd(indpar+1) - dd3=dd(indpar+2) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=1.d0/(1.d0+dd2*r(k)**3) - enddo -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)+dd3 - enddo -! endif - if(typec.ne.1) then - fun=-dd2*distp(0,1)**2*3.d0*r(0) - fun2=fun*distp(0,1)*(2.d0-4.d0*dd2*r(0)**3) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=fun2+2.d0*fun - !endif for indt - endif - indpar=indpar+2 - indshell=indshellp - indorb=indorbp - case(111) -! 2p single r_mu/(1+b r^3) parent of 103 - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=1.d0/(1.d0+dd2*r(k)**3) - enddo -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1) - fun=-dd2*distp(0,1)**2*3.d0*r(0) - fun2=fun*distp(0,1)*(2.d0-4.d0*dd2*r(0)**3) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(112) -! 2p single r_mu/(1+b r)^3 parent of 103 - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=1.d0/(1.d0+dd2*r(k))**3 - enddo -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1) - fun=-3.d0*dd2*distp(0,1)/(r(0)*(1.d0+dd2*r(0))) - fun2=12.d0*dd2**2/(1.+dd2*r(0))**5 -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(113) +end do +! endif +if(typec.ne.1) then + fun=-2.d0*(dd2*distp(0,1)+dd5*dd4*distp(0,2)) + fun2=r(0)**2 + ! write(6,*) ' fun inside = ',fun,fun2 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*(dd2*(-3.d0+2.d0*dd2*fun2)* & + distp(0,1)+dd5*dd4*(-3.d0+2.d0*dd5*fun2)*distp(0,2)) + !endif for indt +end if +indpar=indpar+3 +indshell=indshellp +indorb=indorbp +case (40) + ! 3p without cusp condition derivative of 20 + ! r e^{-z1 r } + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=dsqrt((2.d0*dd1)**5/8.d0/pi)/2.d0 + c=dd1**2.5d0*0.5641895835477562d0 + ! endif + c0=-c + c1=2.5d0*c/dd1 + ! + do k=0,0 + distp(k,1)=dexp(-dd1*r(k)) + distp(k,2)=r(k)*distp(k,1) + end do + ! + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*(c0*distp(i,2)+c1*distp(i,1)) + end do + ! endif + end do + ! + ! + if(typec.ne.1) then + fun0=c0*distp(0,2)+c1*distp(0,1) + fun=(c0*(1.d0-dd1*r(0))-c1*dd1)*distp(0,1) + fun2=(c0*dd1*(dd1*r(0)-2.d0)+c1*dd1**2)*distp(0,1) + ! + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun/r(0) + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)* & + (4.d0*fun/r(0)+fun2) + ! + ! endif + end do + ! + ! + !endif for indt + end if + ! + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp + ! 4p single zeta +case (52) + ! g single gaussian orbital + ! derivative of 51 + ! R(r)= exp(-alpha r^2) + ! normalized + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0) + c=dd1**2.75d0*1.11284691281640568826d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do i=0,0 + distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & + -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) + ! lz=0 + distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & + *(rmu(1,i)**2-3.0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + distp(i,9)=cost5g*(rmu(1,i)**4 & + -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) + ! lz=+/-4 + distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-4 + end do + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*(11.d0/4.d0/dd1-r(k)**2)* & + distp(k,1+ic) + end do + ! endif + end do + if(typec.ne.1) then + dd1=dd(indparp) + fun0=distp(0,1)*(11.d0/4.d0/dd1-r(0)**2) + fun=distp(0,1)*(2.d0*dd1*r(0)**2-15.d0/2.d0) + fun2=distp(0,1)*(-4.d0*dd1**2*r(0)**4 & + +21.d0*dd1*r(0)**2-15.d0/2.d0) + ! indorbp=indorb + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun + if(ic.eq.1) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + elseif(ic.eq.7) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + end if + elseif(ic.eq.8) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) + end if + elseif(ic.eq.9) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+9 + indorb=indorbp +case (31) + ! 3d without cusp condition double Z + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + ! if(iflagnorm.gt.2) then + c=1/2.d0*dsqrt(5.d0/pi) & + /dsqrt(1/dd1**7/128.d0+2*peff/(dd1+dd2)**7 & + +peff**2/dd2**7/128.d0)/dsqrt(720.d0) + ! endif + do k=0,0 + distp(k,1)=dexp(-dd1*r(k)) + distp(k,2)=dexp(-dd2*r(k)) + end do + do i=0,0 + distp(i,3)=c*(distp(i,1)+peff*distp(i,2)) + !lz=0 + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + !lz=+/-2 + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/- 2 + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d + end do + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif + end do + if(typec.ne.1) then + fun0=distp(0,3) + fun=c*(-dd1*distp(0,1)-peff*dd2*distp(0,2)) + fun2=c*(dd1**2*distp(0,1) & + +peff*dd2**2*distp(0,2)) + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0)*fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+3 + indshell=indshell+5 + indorb=indorbp +case (113) ! 2s without cusp condition ! dd1*( dd3 +r^2/(1+dd2*r)^4) - dd2=dd(indpar+1) - dd3=dd(indpar+2) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=r(k)**2/(1.d0+dd2*r(k))**4 - enddo -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)+dd3 - enddo -! endif - if(typec.ne.1) then - fun= (2.d0-2.d0*dd2*r(0))/(1+dd2*r(0))**5 - fun2=2.d0*(1.d0-6.d0*dd2*r(0)+3.d0*(dd2*r(0))**2) & - &/(1+dd2*r(0))**6 - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=fun2+2.d0*fun - !endif for indt - endif - indpar=indpar+2 - indshell=indshellp - indorb=indorbp - case(114) -! 2s without cusp condition -! dd1*( dd3 +r^2/(1+dd2*r)^3) - dd2=dd(indpar+1) - dd3=dd(indpar+2) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=r(k)**2/(1.d0+dd2*r(k))**3 - enddo -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)+dd3 - enddo -! endif - if(typec.ne.1) then - fun= (2.d0-dd2*r(0))/(1+dd2*r(0))**4 - fun2=2.d0*(1.d0-4.d0*dd2*r(0)+(dd2*r(0))**2) & - &/(1+dd2*r(0))**5 - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=fun2+2.d0*fun - !endif for indt - endif - indpar=indpar+2 - indshell=indshellp - indorb=indorbp - case(115) -! 2s double lorentian with constant parent of 102 -! (dd3+ r^2/(1+dd2*r)^3+dd4*r^3/(1+dd5*r)^4; - dd2=dd(indpar+1) - dd3=dd(indpar+2) - dd4=dd(indpar+3) - dd5=dd(indpar+4) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=r(k)**2/(1.d0+dd2*r(k))**3 - distp(k,2)=r(k)**3/(1.d0+dd5*r(k))**4 - enddo -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=(distp(i,1)+dd3+dd4*distp(i,2)) -! write(6,*) ' function inside = ',z(indorbp,i) - enddo -! endif - if(typec.ne.1) then - fun= (2.d0-dd2*r(0))/(1+dd2*r(0))**4 & - & -dd4*r(0)*(-3.d0+dd5*r(0))/(1.d0+dd5*r(0))**5 - fun2=2.d0*(1.d0-4.d0*dd2*r(0)+(dd2*r(0))**2) & - &/(1+dd2*r(0))**5 & - &+dd4*2.d0*r(0)*(3.d0-6.d0*dd5*r(0)+(dd5*r(0))**2) & - &/(1.d0+dd5*r(0))**6 -! write(6,*) ' fun inside = ',fun,fun2 - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=fun2+2.d0*fun -! write(6,*) ' lap 106 =',z(indorbp,indt+4) - !endif for indt - endif - indpar=indpar+4 - indshell=indshellp - indorb=indorbp - case(116) -! 2p double Lorentian -! dd1 * x_mu (L^3(dd2 r)+dd3 r * L(dd4*r)^4) ; L(x)=1/(1+x) - dd2=dd(indpar+1) - dd3=dd(indpar+2) - dd4=dd(indpar+3) - do k=0,0 - distp(k,1)=1.d0/(1.d0+dd2*r(k))**3 - distp(k,2)=r(k)/(1.d0+dd4*r(k))**4 - enddo -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*(distp(i,1)+dd3*distp(i,2)) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1)+dd3*distp(0,2) - fun=-3.d0*dd2*distp(0,1)/(r(0)*(1.d0+dd2*r(0))) & - &+dd3*distp(0,2)/r(0)**2*(1.d0-3*dd4*r(0)) & - &/(1.d0+dd4*r(0)) - fun2=12.d0*dd2**2/(1.+dd2*r(0))**5 & - &+dd3*4.d0*dd4*(-2.d0+3.d0*dd4*r(0))/(1.+dd4*r(0))**6 -! fun0=distp(0,1)+dd3*distp(0,2) -! fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) -! fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) -! 1+2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+3 - indshell=indshell+3 - indorb=indorbp - case(117) -! 2s double lorentian with constant parent of 102 -! (dd3+r^3/(1+dd5*r)^4; - dd3=dd(indpar+1) - dd5=dd(indpar+2) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=r(k)**3/(1.d0+dd5*r(k))**4 - enddo -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=dd3+distp(i,1) -! write(6,*) ' function inside = ',z(indorbp,i) - enddo -! endif - if(typec.ne.1) then - fun= & - & -r(0)*(-3.d0+dd5*r(0))/(1.d0+dd5*r(0))**5 - fun2= & - &+2.d0*r(0)*(3.d0-6.d0*dd5*r(0)+(dd5*r(0))**2) & - &/(1.d0+dd5*r(0))**6 -! write(6,*) ' fun inside = ',fun,fun2 - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=fun2+2.d0*fun -! write(6,*) ' lap 106 =',z(indorbp,indt+4) - !endif for indt - endif - indpar=indpar+2 - indshell=indshellp - indorb=indorbp - case(118) -! 2s double lorentian with constant parent of 102 -! (dd1+ 1/ (1 + Exp[ dd2 (r^2 - r_0^2) ] ) | dd3=r_0 -! Fermi distribution with r^2 - dd1=dd(indpar+1) - dd2=dd(indpar+2) - dd3=-dd2*dd(indpar+3)**2 - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - arg=dd2*r(k)**2+dd3 - if(arg.gt.200) then - distp(k,1)=dexp(200.d0) - else - distp(k,1)=dexp(arg) - endif - enddo +dd2=dd(indpar+1) +dd3=dd(indpar+2) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=r(k)**2/(1.d0+dd2*r(k))**4 +end do ! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=dd1+1.d0/(1.d0+distp(i,1)) -! write(6,*) ' function inside = ',z(indorbp,i) - enddo -! endif - if(typec.ne.1) then - fun= -2.d0*dd2*distp(0,1)/(1.d0+distp(0,1))**2 - fun2=-2.d0*dd2*(-distp(0,1)*(-1.d0-2.d0*dd2*r(0)**2) & - &+distp(0,1)**2*(1.d0-2.d0*dd2*r(0)**2))/(1.d0+distp(0,1))**3 -! write(6,*) ' fun inside = ',fun,fun2 - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=fun2+2.d0*fun -! write(6,*) ' lap 106 =',z(indorbp,indt+4) - !endif for indt - endif - indpar=indpar+3 - indshell=indshellp - indorb=indorbp - case(119) -! 2p single r_mu/(1+b r^2)^(3/2) parent of 103 - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=1.d0/(1.d0+dd2*r(k)**2)**1.5d0 - enddo -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1) - fun=-3.d0*dd2*distp(0,1)/(1.d0+dd2*r(0)**2) - fun2=3.d0*dd2*(-1.d0+4.d0*dd2*r(0)**2) & - &/(1.d0+dd2*r(0)**2)**3.5d0 -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(120) -! 2p double cubic -! dd1 * x_mu (L^3(dd2 r)+dd3 L(dd4*r)^3) ; L(x)=1/(1+x) - dd2=dd(indpar+1) - dd3=dd(indpar+2) - dd4=dd(indpar+3) - do k=0,0 - distp(k,1)=1.d0/(1.d0+dd2*r(k))**3 - distp(k,2)=1.d0/(1.d0+dd4*r(k))**3 - enddo -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*(distp(i,1)+dd3*distp(i,2)) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1)+dd3*distp(0,2) - fun=-3.d0*dd2*distp(0,1)/(r(0)*(1.d0+dd2*r(0))) & - & -3.d0*dd4*dd3*distp(0,2)/(r(0)*(1.d0+dd4*r(0))) - fun2=12.d0*dd2**2/(1.+dd2*r(0))**5 & - & +12.d0*dd3*dd4**2/(1.+dd4*r(0))**5 -! fun0=distp(0,1)+dd3*distp(0,2) -! fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) -! fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) -! 1+2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+3 - indshell=indshell+3 - indorb=indorbp - case(121) -! 2p single exponential - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)) - enddo +do i=0,0 + z(indorbp,i)=distp(i,1)+dd3 +end do +! endif +if(typec.ne.1) then + fun= (2.d0-2.d0*dd2*r(0))/(1+dd2*r(0))**5 + fun2=2.d0*(1.d0-6.d0*dd2*r(0)+3.d0*(dd2*r(0))**2) & + /(1+dd2*r(0))**6 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=fun2+2.d0*fun + !endif for indt +end if +indpar=indpar+2 +indshell=indshellp +indorb=indorbp +case (10000:11000) + ! Reserved for dummy orbitals +case (107) +! 2p single lorentian parent of 103 +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=1.d0/(1.d0+dd2*r(k)**2) +end do ! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1) - fun=-dd2*distp(0,1)/r(0) - fun2=dd2**2*distp(0,1) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(122) -! 2s with cusp condition -! dd1*( dd3 +exp(-dd2*r)*(1+dd2*r)) - dd2=dd(indpar+1) - dd3=dd(indpar+2) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)) - enddo -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)*(1.d0+dd2*r(i))+dd3 - enddo -! endif - if(typec.ne.1) then - fun=-dd2**2*distp(0,1) - fun2=fun*(1.d0-dd2*r(0)) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - !endif for indt - endif - indpar=indpar+2 - indshell=indshellp - indorb=indorbp - case(123) -! 2p double exp -! dd1 * x_mu (exp(-dd2 r)+dd3 * exp(-dd4*r)) - dd2=dd(indpar+1) - dd3=dd(indpar+2) - dd4=dd(indpar+3) - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)) - distp(k,2)=dexp(-dd4*r(k)) - enddo +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1) + fun=-dd2*distp(0,1)**2*2.d0 + fun2=fun*distp(0,1)*(1.d0-3.d0*dd2*r(0)**2) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (43) + ! 4d without cusp and one parmater derivative of 33 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c= & + ! &1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) + c=dd1**4.5d0*0.0710812062076410d0 + ! endif + c0=-c + c1=4.5d0*c/dd1 + do k=0,0 + distp(k,1)=dexp(-dd1*r(k)) + end do + do i=0,0 + distp(i,3)=distp(i,1)*(c0*r(i)**2+c1*r(i)) + ! lz=0 + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/ + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d + end do + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif + end do + if(typec.ne.1) then + fun0=distp(0,3) + fun=-dd1*distp(0,3)+distp(0,1)*(2.d0*c0*r(0)+c1) + fun2=dd1**2*distp(0,3)+distp(0,1)* & + (-2.d0*dd1*(2.d0*c0*r(0)+c1)+2.d0*c0) + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + end if + ! + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp + ! derivative of 36 with respect zeta +case (6) + ! normalized + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + ! if(iflagnorm.gt.2) then + ! c= WRONG + ! &0.5*dsqrt((1.d0/dd1**5/32.d0+2.d0*peff/(dd1+dd2)**5 + ! &+peff**2/dd2**5/32.d0)/(24.d0*pi)) + c=1.d0/dsqrt((3.d0*pi)* & + (1.d0/dd1**5+ 64.d0*peff/(dd1+dd2)**5+peff**2/dd2**5)) + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + end do + do i=0,0 + z(indorbp,i)=r(i)*(distp(i,1)+distp(i,2)*peff) + end do + if(typec.ne.1) then + fun=distp(0,1)*(1.d0-dd1*r(0)) & + +peff*distp(0,2)*(1.d0-dd2*r(0)) + fun2=distp(0,1)*(dd1**2*r(0)-2.d0*dd1)+peff*distp(0,2) & + *(dd2**2*r(0)-2.d0*dd2) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=(2.d0*fun/r(0)+fun2) + end if + indorb=indorbp + ! endif + indpar=indpar+3 + indshell=indshellp + ! 2s double Z NO CUSP +case (136) +! 2p single exponential r^5 e^{-z r} ! +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)) +end do ! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*(distp(i,1)+dd3*distp(i,2)) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1)+dd3*distp(0,2) - fun=-(dd2*distp(0,1)+dd3*dd4*distp(0,2))/r(0) - fun2=dd2**2*distp(0,1)+dd3*dd4**2*distp(0,2) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+3 - indshell=indshell+3 - indorb=indorbp - case(124) -! 2s double exp with constant and cusp cond. -! (dd3+ exp (-dd2 r)*(1+dd2*r)+dd4*exp(-dd5*r)*(1+dd5*r)) - dd2=dd(indpar+1) - dd3=dd(indpar+2) - dd4=dd(indpar+3) - dd5=dd(indpar+4) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,3)=dexp(-dd2*r(k)) - distp(k,4)=dexp(-dd5*r(k)) - distp(k,1)=distp(k,3)*(1.d0+dd2*r(k)) - distp(k,2)=distp(k,4)*(1.d0+dd5*r(k)) - enddo +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**5 + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1)*r(0)**5 + fun=distp(0,1)*(5.d0-dd2*r(0))*r(0)**3 + fun2=distp(0,1)*(20*r(0)**3-10*dd2*r(0)**4 & + +dd2**2*r(0)**5) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (200) +! THE COSTANT +indorbp=indorb+1 +indshellp=indshell+1 +! if(iocc(indshellp).eq.1) then +do i=0,0 + z(indorbp,i)=1.d0 +end do +! endif +if(typec.ne.1) then + do i=1,3 + z(indorbp,indt+i)=0 + end do + z(indorbp,indt+4)=0 + !endif for indt +end if +indshell=indshellp +indorb=indorbp +case (118) +! 2s double lorentian with constant parent of 102 +! (dd1+ 1/ (1 + Exp[ dd2 (r^2 - r_0^2) ] ) | dd3=r_0 +! Fermi distribution with r^2 +dd1=dd(indpar+1) +dd2=dd(indpar+2) +dd3=-dd2*dd(indpar+3)**2 +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + arg=dd2*r(k)**2+dd3 + if(arg.gt.200) then + distp(k,1)=dexp(200.d0) + else + distp(k,1)=dexp(arg) + end if +end do ! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)+dd3+dd4*distp(i,2) +do i=0,0 + z(indorbp,i)=dd1+1.d0/(1.d0+distp(i,1)) ! write(6,*) ' function inside = ',z(indorbp,i) - enddo -! endif - if(typec.ne.1) then - fun=-dd2**2*distp(0,3)-dd5**2*dd4*distp(0,4) - fun2=-dd2**2*distp(0,3)*(1.d0-dd2*r(0)) & - & -dd4*dd5**2*distp(0,4)*(1.d0-dd5*r(0)) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - !endif for indt - endif - indpar=indpar+4 - indshell=indshellp - indorb=indorbp - case(125) +end do +! endif +if(typec.ne.1) then + fun= -2.d0*dd2*distp(0,1)/(1.d0+distp(0,1))**2 + fun2=-2.d0*dd2*(-distp(0,1)*(-1.d0-2.d0*dd2*r(0)**2) & + +distp(0,1)**2*(1.d0-2.d0*dd2*r(0)**2))/(1.d0+distp(0,1))**3 + ! write(6,*) ' fun inside = ',fun,fun2 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=fun2+2.d0*fun + ! write(6,*) ' lap 106 =',z(indorbp,indt+4) + !endif for indt +end if +indpar=indpar+3 +indshell=indshellp +indorb=indorbp +case (15) + ! (r**2 + dd2*(1 + dd1*r))*exp(-dd1*r) ! normalized + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + c=dsqrt(2.d0*dd1**7/pi/ & + (45.d0+42.d0*dd1**2*dd2+14.d0*dd1**4*dd2**2)) + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + end do + do i=0,0 + z(indorbp,i)=(r(i)**2+dd2*(1.d0+dd1*r(i))) & + *distp(i,1) + end do + if(typec.ne.1) then + fun=distp(0,1)*r(0)*(2.d0-dd1**2*dd2-dd1*r(0)) + fun2=distp(0,1)*((1.d0-dd1*r(0)) & + *(3.d0-dd1**2*dd2-dd1*r(0))-1.d0) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=2.d0*fun/r(0)+fun2 + end if + indorb=indorbp + ! endif + indpar=indpar+2 + indshell=indshellp + ! 2s gaussian for pseudo +case (122) ! 2s with cusp condition -! dd1*( dd3 +exp(-dd2*r)) ! with no cusp condition - dd2=dd(indpar+1) - dd3=dd(indpar+2) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)) - enddo -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)+dd3 - enddo -! endif - if(typec.ne.1) then - fun=-dd2*distp(0,1)/r(0) - fun2=dd2**2*distp(0,1) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - !endif for indt - endif - indpar=indpar+2 - indshell=indshellp - indorb=indorbp - case(126) -! 2s double exp with constant -! (dd3+ exp (-dd2 r)+dd4*exp(-dd5*r)) - dd2=dd(indpar+1) - dd3=dd(indpar+2) - dd4=dd(indpar+3) - dd5=dd(indpar+4) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)) - distp(k,2)=dexp(-dd5*r(k)) - enddo +! dd1*( dd3 +exp(-dd2*r)*(1+dd2*r)) +dd2=dd(indpar+1) +dd3=dd(indpar+2) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)) +end do ! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)+dd3+dd4*distp(i,2) -! write(6,*) ' function inside = ',z(indorbp,i) - enddo -! endif - if(typec.ne.1) then - fun=-(dd2*distp(0,1)+dd5*dd4*distp(0,2))/r(0) - fun2=dd2**2*distp(0,1)+dd4*dd5**2*distp(0,2) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - !endif for indt - endif - indpar=indpar+4 - indshell=indshellp - indorb=indorbp - case(127) -! 3d without cusp and one parmater - dd1=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)) - enddo - do i=0,0 - distp(i,3)=distp(i,1) - distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d - distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d - distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d - enddo -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=distp(i,3+ic)*distp(i,3) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,3) - fun=-dd1*distp(0,1) - fun2=dd1**2*distp(0,1) -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & - & *fun/r(0) - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif -! - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - case(128) +do i=0,0 + z(indorbp,i)=distp(i,1)*(1.d0+dd2*r(i))+dd3 +end do +! endif +if(typec.ne.1) then + fun=-dd2**2*distp(0,1) + fun2=fun*(1.d0-dd2*r(0)) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if +indpar=indpar+2 +indshell=indshellp +indorb=indorbp +case (128) ! 2s with cusp condition ! ( r^2*exp(-dd2*r)) ! with no cusp condition - dd2=dd(indpar+1) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)) - enddo +dd2=dd(indpar+1) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)) +end do ! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)*r(i)**2 - enddo -! endif - if(typec.ne.1) then - fun=(2.d0-dd2*r(0))*distp(0,1) - fun2=(2.d0-4*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - !endif for indt - endif - indpar=indpar+1 - indshell=indshellp - indorb=indorbp - case(129) -! 2p single exponential r e^{-z r} ! parent of 121 - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)) - enddo +do i=0,0 + z(indorbp,i)=distp(i,1)*r(i)**2 +end do +! endif +if(typec.ne.1) then + fun=(2.d0-dd2*r(0))*distp(0,1) + fun2=(2.d0-4*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if +indpar=indpar+1 +indshell=indshellp +indorb=indorbp +case (16) + ! s orbital + ! + ! - angmom = 0 + ! - type = Gaussian + ! - normalized = yes + ! - angtype = spherical + ! - npar = 1 + ! - multiplicity = 1 + ! + ! = N * R + ! + ! where N is the normalization constant + ! N = (2*alpha/pi)**(3/4) + ! + ! and R is the radial part + ! R = exp(-alpha*r**2) + ! + indshellp=indshell+1 + indorbp=indorb+1 + dd1=dd(indpar+1) + if(dd1.ne.0.) then + c=0.71270547035499016d0*dd1**0.75d0 + else + c=1.d0 + end if + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do i=0,0 + z(indorbp,i)=distp(i,1) + end do + if(typec.ne.1) then + ! the first derivative /r + fun=-2.d0*dd1*distp(0,1) + ! the second derivative + fun2=fun*(1.d0-2.d0*dd1*r(0)*r(0)) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + if(typec.eq.2) then + ! Backflow + funb=(fun2-fun)/(r(0)*r(0)) + z(indorbp,indt+5)=funb*rmu(1,0)*rmu(1,0)+fun + z(indorbp,indt+6)=funb*rmu(2,0)*rmu(2,0)+fun + z(indorbp,indt+7)=funb*rmu(3,0)*rmu(3,0)+fun + z(indorbp,indt+8)=funb*rmu(1,0)*rmu(2,0) + z(indorbp,indt+9)=funb*rmu(1,0)*rmu(3,0) + z(indorbp,indt+10)=funb*rmu(2,0)*rmu(3,0) + end if + end if + indorb=indorbp + indpar=indpar+1 + indshell=indshellp +case (2200:2299) +! d gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative 1200 +npower=iopt+1-2200 ! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1)*r(0) - fun=distp(0,1)*(1.d0-dd2*r(0))/r(0) - fun2=dd2*(dd2*r(0)-2.d0)*distp(0,1) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(130) -! 2p single exponential r^2 e^{-z r} ! parent of 121 - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)) - enddo +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=-r(k)**(2*npower)*dexp(-dd2*r(k)**2) +end do +do i=0,0 + distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d + distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d + distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d +end do +do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=distp(i,1+ic)*distp(i,1) + end do + ! endif +end do +if(typec.ne.1) then + rp1=r(0)**2 + fun0=distp(0,1) + fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 + fun2=(npower*(2.d0*npower-1.d0)- & + (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & + distp(0,1)*2.d0/rp1 + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+5 +indorb=indorbp +case (55) + ! g single Slater orbital + ! R(r)= exp(-alpha r) + ! normalized + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + ! if(iflagnorm.gt.2) then + ! overall normalization + ! l = 4 + ! \int d\omega Y*Y = 4 pi / (2 l + 1) + ! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5**2 * 3**4 / 2**3 / dd1**11 + ! c=1.d0/dsqrt(7.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(11.d0/2.d0)/3.d0/5.d0 + c=dd1**5.5d0*.020104801169736915d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + end do + do i=0,0 + distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & + -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) + ! lz=0 + distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & + *(rmu(1,i)**2-3.0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + distp(i,9)=cost5g*(rmu(1,i)**4 & + -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) + ! lz=+/-4 + distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-4 + end do + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + if(typec.ne.1) then + dd1=dd(indparp) + fun0=distp(0,1) + fun=-dd1*distp(0,1)/r(0) + fun2=dd1**2*distp(0,1) + ! indorbp=indorb + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun + if(ic.eq.1) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + elseif(ic.eq.7) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + end if + elseif(ic.eq.8) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) + end if + elseif(ic.eq.9) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+9 + indorb=indorbp +case (2) + ! + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=(zeta(1)-dd1)/(dd2-zeta(1)) + ! if(iflagnorm.gt.2) then + c=1.d0/2.d0/dsqrt(2.d0*pi*(1.d0/(2.d0*dd1)**3 & + +2.d0*peff/(dd1+dd2)**3+peff**2/(2.d0*dd2)**3)) + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + end do + do i=0,0 + z(indorbp,i)=distp(i,1)+peff*distp(i,2) + end do + if(typec.ne.1) then + fun=(-dd1*distp(0,1)-dd2*distp(0,2)*peff)/r(0) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=(-2.d0*dd1/r(0)+dd1**2) & + *distp(0,1)+peff*(-2.d0*dd2/r(0)+dd2**2) & + *distp(0,2) + end if + indorb=indorbp + ! endif + indpar=indpar+2 + indshell=indshellp + ! 1s double Z NO CUSP +case (23) + ! 3p without cusp condition + ! r ( e^{-z2 r } + z1 e^{-z3 r } ) + dd1=dd(indpar+1) + dd2=dd(indpar+2) + dd3=dd(indpar+3) + ! if(iflagnorm.gt.2) then + c=1.d0/2.d0/dsqrt(240.d0*pi*(1.d0/(2.d0*dd1)**7 & + +2.d0*dd3/(dd1+dd2)**7+dd3**2/(2.d0*dd2)**7)) + ! endif + ! + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + end do + ! + do i=0,0 + distp(i,3)=r(i)*(distp(i,1)+dd3*distp(i,2)) + end do + ! + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,3) + end do + ! endif + end do + ! + ! + if(typec.ne.1) then + fun0=distp(0,3) + fun=(1.d0-dd1*r(0))*distp(0,1) & + +dd3*(1.d0-dd2*r(0))*distp(0,2) + fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) & + +dd3*dd2*(dd2*r(0)-2.d0)*distp(0,2) + ! + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun/r(0) + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)* & + (4.d0*fun/r(0)+fun2) + ! + ! endif + end do + ! + ! + !endif for indt + end if + ! + indpar=indpar+3 + indshell=indshell+3 + indorb=indorbp + ! 4p single zeta +case (80) + ! R(r)=exp(-z*r**2) single zeta + indshellp=indshell+1 + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dsqrt(dd1) + ! if(iflagnorm.gt.2) then + ! c=(2.d0*dd1/pi)**(3.d0/4.d0)*ratiocs + ! ratiocs--> ratiocs*(2/pi)**3/4 + c=dd1**0.75d0*ratiocs + ! endif + do k=0,0 + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + do i=0,0 + z(indorbp,i)=distp(i,1) + end do + if(typec.ne.1) then + ! the first derivative /r + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + fun=-dd1*distp(0,1)*(2.d0+rp2)/rp3 + ! the second derivative + fun2=dd1*distp(0,1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**2)/rp3**2 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + indorb=indorbp + indpar=indpar+1 + indshell=indshellp +case (17) + ! 2s gaussian for pseudo + ! R(r)=r**2*exp(-z*r**2) single zeta + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=4.d0*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)/dsqrt(15.d0) + c=.73607904464954686606d0*dd1**1.75d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do i=0,0 + z(indorbp,i)=distp(i,1)*r(i)**2 + end do + if(typec.ne.1) then + rp1=r(0)**2 + ! the first derivative / r + fun=2.d0*distp(0,1)*(1.d0-dd1*rp1) + ! the second derivative + fun2=2.d0*distp(0,1)*(1.d0-5.d0*dd1*rp1+2.d0*dd1**2*rp1**2) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + indorb=indorbp + ! endif + indpar=indpar+1 + indshell=indshellp + ! 2s gaussian for pseudo +case (10) + ! s orbital + ! + ! - angmom = 0 + ! - type = Slater + ! - normalized = yes + ! - angtype = spherical + ! - npar = 1 + ! - multiplicity = 1 + ! + ! = N * R + ! + ! 3s single zeta + ! and R is the radial part + ! R(r) = r**2*exp(-z1*r) + ! + indshellp=indshell+1 + indorbp=indorb+1 + dd1=dd(indpar+1) + c=dd1**3.5d0*0.11894160774351807429d0 + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + end do + do i=0,0 + z(indorbp,i)=distp(i,1)*r(i)**2 + end do + if(typec.ne.1) then + fun=(2.d0-dd1*r(0))*distp(0,1) + fun2=(2.d0-4*dd1*r(0)+(dd1*r(0))**2)*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + indorb=indorbp + indpar=indpar+1 + indshell=indshellp +case (129) +! 2p single exponential r e^{-z r} ! parent of 121 +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)) +end do ! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**2 - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1)*r(0)**2 - fun=distp(0,1)*(2.d0-dd2*r(0)) - fun2=(2.d0-4.d0*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(131) +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1)*r(0) + fun=distp(0,1)*(1.d0-dd2*r(0))/r(0) + fun2=dd2*(dd2*r(0)-2.d0)*distp(0,1) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (110) ! 2s without cusp condition -! dd1*(r^2*exp(-dd2*r^2)) - dd2=dd(indpar+1) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)*r(k)) - enddo +! dd1*( dd3 +1/(1+dd2*r^3)) +dd2=dd(indpar+1) +dd3=dd(indpar+2) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=1.d0/(1.d0+dd2*r(k)**3) +end do ! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)*r(i)**2 - enddo -! endif - if(typec.ne.1) then - fun0=dd2*r(0)**2 - fun=2.d0*distp(0,1)*(1.d0-fun0) - fun2=2.d0*distp(0,1)*(1.d0-5.d0*fun0+2.d0*fun0**2) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - !endif for indt - endif - indpar=indpar+1 - indshell=indshellp - indorb=indorbp - case(132) -! 2s with cusp condition -! ( r^3*exp(-dd2*r)) ! with no cusp condition - dd2=dd(indpar+1) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=dexp(-dd2*r(k))*r(k) - enddo +do i=0,0 + z(indorbp,i)=distp(i,1)+dd3 +end do +! endif +if(typec.ne.1) then + fun=-dd2*distp(0,1)**2*3.d0*r(0) + fun2=fun*distp(0,1)*(2.d0-4.d0*dd2*r(0)**3) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=fun2+2.d0*fun + !endif for indt +end if +indpar=indpar+2 +indshell=indshellp +indorb=indorbp +case (46) + ! R(r)=c*r**2*exp(-z*r**2)*(7/4/z-r**2) + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + c=4.d0*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)/dsqrt(15.d0) + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do i=0,0 + z(indorbp,i)=distp(i,1)*(7.d0/4.d0/dd1*r(i)**2 & + -r(i)**4) + end do + if(typec.ne.1) then + rp1=r(0)**2 + ! the first derivative / r + fun=distp(0,1)*(7.d0-15.d0*dd1*rp1 & + +4.d0*(dd1*rp1)**2)/2.d0/dd1 + ! the second derivative + fun2=distp(0,1)*(7.d0-59*dd1*rp1+50*(dd1*rp1)**2 & + -8*(dd1*rp1)**3)/2.d0/dd1 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + indorb=indorbp + ! endif + indpar=indpar+1 + indshell=indshellp + ! 5s single zeta derivative of 12 +case (143) +! 4d one parmater der of 133 +dd1=dd(indpar+1) +do k=0,0 + distp(k,1)=dexp(-dd1*r(k)) +end do +do i=0,0 + distp(i,3)=distp(i,1)*r(i)**2 + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d +end do +! indorbp=indorb +do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=-distp(i,3+ic)*distp(i,3) + end do + ! endif +end do +if(typec.ne.1) then + fun0=-distp(0,3) + fun=-(-2.d0+dd1*r(0))*distp(0,1) + fun2=((dd1*r(0))**2 -4.d0*r(0)*dd1+2.d0)*distp(0,1) + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt +end if +! +indpar=indpar+1 +indshell=indshell+5 +indorb=indorbp +case (7) + ! normalized IS WRONG!!! + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + do k=0,0 + distp(k,1)=dexp(-dd1*r(k)) + distp(k,2)=dexp(-dd2*r(k)) + end do + ! if(iflagnorm.gt.2) then + c= & + 1/dsqrt(1/(3.D0/4.D0/dd1**5+peff**2/dd2**3/4+12*peff/ & + (dd1+dd2)**4))*1.d0/dsqrt(4.0*pi) + ! endif + do i=0,0 + z(indorbp,i)=c*(distp(i,1)+r(i)*distp(i,2)*peff) + end do + if(typec.ne.1) then + fun=-dd1*distp(0,1)+peff*distp(0,2)*(1.d0-dd2*r(0)) + fun2=distp(0,1)*dd1**2 & + +peff*distp(0,2)*(dd2**2*r(0)-2.d0*dd2) + do i=1,3 + z(indorbp,indt+i)=fun*c*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=c*(2.d0*fun/r(0)+fun2) + end if + indorb=indorbp + ! endif + indpar=indpar+3 + indshell=indshellp + ! 2s double Z WITH CUSP +case (36) + ! p orbital + ! + ! - angmom = 1 + ! - type = Gaussian + ! - normalized = yes + ! - angtype = spherical + ! - npar = 1 + ! - multiplicity = 3 + ! + dd1=dd(indpar+1) + c=dd1**1.25d0*1.42541094070998d0 + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do ic=1,3 + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + end do + if(typec.ne.1) then + fun0=distp(0,1) + fun=-2.d0*dd1*distp(0,1) + fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + do ic=1,3 + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)*fun + end do + z(indorbp,indt+ic)=z(indorbp,indt+ic)+fun0 + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + end do + end if + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp +case (29) + ! derivative of (28) + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! if(dd1.gt.0.) then + c=cost1s*dd1**1.5d0 + ! else + ! c=1.d0 + ! endif + ! endif + ! if(dd1.gt.0.) then + c1=1.5d0/dd1 + ! else + ! c1=0.d0 + ! endif + do i=0,0 + distp(i,1)=c*dexp(-dd1*r(i)) + end do + do i=0,0 + ! rp1=(b1s*r(i))**4*dd1**3 + ! rp4=rp1*dd1 + ! rp5=dd1*r(i) + ! z(indorbp,i)=distp(i,1)* & + ! &(c1*rp4/(1+rp4)-rp1*(-4+rp5+rp4*rp5)/(1+rp4)**2) + rp4=(b1s*dd1*r(i))**4 + rp5=dd1*r(i) + z(indorbp,i)=distp(i,1)*rp4/(1+rp4)* & + (c1 - (1.d0/dd1)*(-4+rp5+rp4*rp5)/(1+rp4)) + end do + if(typec.ne.1) then + rp1=dd1*b1s*r(0) + rp2=rp1**2 + rp4=rp2**2 + rp5=rp4*rp1 + rp8=rp4*rp4 + fun=distp(0,1)* (dd1*rp2*(4*b1s**2*(11-5*rp4) +2*(rp1+rp5)**2 & + -b1s*rp1*(21+26*rp4+5*rp8)))/(2.*(1+rp4)**3) + fun2=distp(0,1)*(dd1*rp2*(b1s*(31 + 7*rp4)*(rp1 + rp5)**2 & + - 2*(rp1 + rp5)**3 + 64*b1s**2*rp1*(-2 - rp4 + rp8) + & + 4*b1s**3*(33 - 134*rp4 + 25*rp8)))/(2.*b1s*(1 + rp4)**4) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + ! endif + indorb=indorbp + end if + indpar=indpar+1 + indshell=indshellp +case (44) + ! R(r)=x*exp(-z*r**2)*(5/4/z-r**2) + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0 + c=dd1**1.25d0*1.42541094070998d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1)* & + (5.d0/4.d0/dd1-r(i)**2) + end do + ! endif + end do + if(typec.ne.1) then + fun0=distp(0,1)*(5.d0/4.d0/dd1-r(0)**2) + fun=distp(0,1)*(2.d0*dd1*r(0)**2-9.d0/2.d0) + fun2=distp(0,1)*(-4.d0*dd1**2*r(0)**4 & + +15.d0*dd1*r(0)**2-9.d0/2.d0) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + ! endif + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp + ! derivative of 37 with respect to z +case (64) + ! d orbitals + ! R(r)= r exp(-alpha r^2) + ! each gaussian term is normalized + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + ! if(iflagnorm.gt.2) then + ! c=8.d0/dsqrt(21.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) + c=dd1**2.25d0*1.24420067280413253d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do i=0,0 + ! lz=0 + distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/-2 + distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d + end do + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*distp(k,1+ic)*r(k) + end do + ! endif + end do + if(typec.ne.1) then + dd1=dd(indparp) + rp1=2.d0*dd1*r(0) + rp2=rp1*r(0) + fun0=distp(0,1)*r(0) + fun=(1.d0-rp2)*distp(0,1)/r(0) + fun2=distp(0,1)*rp1*(rp2-3.d0) + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + end if + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp +case (106) +! 2s without cusp condition +! dd1*( dd3 +1/(1+dd2*r^2)) +dd2=dd(indpar+1) +dd3=dd(indpar+2) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=1.d0/(1.d0+dd2*r(k)*r(k)) +end do ! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)*r(i)**2 - enddo -! endif - if(typec.ne.1) then - fun=(3.d0-dd2*r(0))*distp(0,1) - fun2=(6.d0-6*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - !endif for indt - endif - indpar=indpar+1 - indshell=indshellp - indorb=indorbp - case(133) +do i=0,0 + z(indorbp,i)=distp(i,1)+dd3 +end do +! endif +if(typec.ne.1) then + fun=-dd2*distp(0,1)**2*2.d0 + fun2=fun*distp(0,1)*(1.-3.d0*dd2*r(0)**2) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=fun2+2.d0*fun + !endif for indt +end if +indpar=indpar+2 +indshell=indshellp +indorb=indorbp +case (71) + ! f single Slater orbital derivative of 70 + ! R(r)= (9.d0/2.0 1/dd1 - r) * exp(-alpha r) + ! normalized + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + ! if(iflagnorm.gt.2) then + ! overall normalization + ! l = 3 + ! \int d\omega Y*Y = 4 pi / (2 l + 1) + ! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5 * 3**2 / 2**2 / dd1**9 + ! c=1.d0/dsqrt(10.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(9.d0/2.d0)/3.d0 + c=dd1**4.5d0*0.084104417400672d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + end do + do i=0,0 + distp(i,2)=cost1f*rmu(3,i) & + *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=0 + distp(i,3)=cost2f*rmu(1,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2f*rmu(2,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3f*rmu(3,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-2 + distp(i,6)=cost3f*2.d0*rmu(3,i) & + *rmu(1,i)*rmu(2,i) + ! lz=+/-2 + distp(i,7)=cost4f*rmu(1,i) & + *(rmu(1,i)**2-3.d0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4f*rmu(2,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + end do + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*distp(k,1+ic)*(9.d0/2.d0/dd1 - r(k)) + end do + ! endif + end do + if(typec.ne.1) then + dd1=dd(indparp) + fun0=distp(0,1)*(9.d0/2.d0/dd1-r(0)) + fun=distp(0,1)*(dd1-11.d0/2.d0/r(0)) + fun2=dd1*distp(0,1)*(13.d0/2.d0-dd1*r(0)) + ! indorbp=indorb + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) + if(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) + end if + elseif(ic.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + end if + elseif(ic.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + end if + else + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+7 + indorb=indorbp + ! 3s -derivative of 34 with respect to dd1 +case (14) + ! (1.d0 + dd1 r) * exp(-dd1 * r) ! normalized + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + do k=0,0 + distp(k,1)=dexp(-dd1*r(k)) + end do + ! if(iflagnorm.gt.2) then + ! c=dsqrt(dd1**3.d0/7.d0/pi) + c=dd1**1.5d0*0.213243618622923d0 + ! endif + do i=0,0 + z(indorbp,i)=c*(1.d0+dd1*r(i))*distp(i,1) + end do + if(typec.ne.1) then + fun=-distp(0,1)*dd1**2*r(0) + fun2=-distp(0,1)*dd1**2*(1.d0-dd1*r(0)) + do i=1,3 + z(indorbp,indt+i)=c*fun*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=c*2.d0*fun/r(0)+c*fun2 + end if + indorb=indorbp + ! endif + indpar=indpar+1 + indshell=indshellp + ! 1s single Z pseudo +case (60) + ! R(r)=r**3*exp(-z*r**2) single zeta + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=2.d0/pi**(3.d0/4.d0)*(2.d0*dd1)**(9.d0/4.d0)*dsqrt(2.d0/105.d0) + c=dd1**2.25d0*.55642345640820284397d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2)*r(k) + end do + do i=0,0 + z(indorbp,i)=distp(i,1)*r(i)**2 + end do + if(typec.ne.1) then + rp1=r(0)**2*dd1 + ! the first derivative / r + fun=distp(0,1)*(3.d0-2.d0*rp1) + ! the second derivative + fun2=distp(0,1)*(6.d0-14.d0*rp1+4.d0*rp1**2) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + indorb=indorbp + ! endif + indpar=indpar+1 + indshell=indshellp + ! 3s -derivative of 60 with respect to dd1 +case (19) + ! R(r)=c*exp(-z*r**2)*(3/4/z-r**2) + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! if(dd1.ne.0.) then + ! c=(2.d0*dd1/pi)**(3.d0/4.d0) + c=0.71270547035499016d0*dd1**0.75d0 + ! else + ! c=1.d0 + ! endif + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do i=0,0 + z(indorbp,i)=distp(i,1)*(3.d0/4.d0/dd1-r(i)**2) + end do + if(typec.ne.1) then + ! the first derivative /r + fun=distp(0,1)*(2.d0*dd1*r(0)**2-7.d0/2.d0) + ! the second derivative + fun2=distp(0,1)*(-4.d0*dd1**2*r(0)**4 & + +13.d0*dd1*r(0)**2-7.d0/2.d0) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + indorb=indorbp + ! endif + indpar=indpar+1 + indshell=indshellp + ! 2p single zeta +case (51) + ! g single gaussian orbital + ! R(r)= exp(-alpha r^2) + ! normalized + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0) + c=dd1**2.75d0*1.11284691281640568826d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do i=0,0 + distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & + -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) + ! lz=0 + distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & + *(rmu(1,i)**2-3.0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + distp(i,9)=cost5g*(rmu(1,i)**4 & + -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) + ! lz=+/-4 + distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-4 + end do + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + if(typec.ne.1) then + dd1=dd(indparp) + fun0=distp(0,1) + fun=-2.d0*dd1*distp(0,1) + fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + ! indorbp=indorb + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun + end do + if(ic.eq.1) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) + ! else + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) + ! endif + elseif(ic.eq.2) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + ! else + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + ! endif + elseif(ic.eq.3) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + ! else + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + ! endif + elseif(ic.eq.4) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) + ! else + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) + ! endif + elseif(ic.eq.5) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) + ! else + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + ! endif + elseif(ic.eq.6) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + ! else + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + ! endif + elseif(ic.eq.7) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + ! else + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + ! endif + elseif(ic.eq.8) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) + ! endif + elseif(ic.eq.9) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + ! endif + end if + !enddo for i + ! enddo + z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+9 + indorb=indorbp +case (142) ! 4d one parmater - dd1=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)) - enddo - do i=0,0 - distp(i,3)=distp(i,1)*r(i) - distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d - distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d - distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d - enddo +dd1=dd(indpar+1) +do k=0,0 + distp(k,1)=dexp(-dd1*r(k)) +end do +do i=0,0 + distp(i,3)=distp(i,1)*r(i) + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d +end do ! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=distp(i,3+ic)*distp(i,3) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,3) - fun=(1.d0-dd1*r(0))*distp(0,1) - fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & - & *fun/r(0) - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif +do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=-distp(i,3+ic)*distp(i,3) + end do + ! endif +end do +if(typec.ne.1) then + fun0=-distp(0,3) + fun=-(1.d0-dd1*r(0))*distp(0,1) + fun2=-dd1*(dd1*r(0)-2.d0)*distp(0,1) + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt +end if ! - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - case(134) -! 2p single exponential r^3 e^{-z r} ! - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)) - enddo +indpar=indpar+1 +indshell=indshell+5 +indorb=indorbp +case (33) + ! 4d without cusp and one parmater + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c= + ! &1/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) + ! c= & + ! &1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) + c=dd1**4.5d0*0.0710812062076410d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + end do + do i=0,0 + distp(i,3)=distp(i,1)*r(i) + ! lz=0 + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/ + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d + end do + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif + end do + if(typec.ne.1) then + fun0=distp(0,3) + fun=-dd1*distp(0,3)+distp(0,1) + fun2=dd1**2*distp(0,3)-2.d0*dd1*distp(0,1) + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + end if + ! + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp + ! 2s single Z WITH CUSP zero +case (154) +! Jastrow single gaussian f orbital +! R(r)= exp(-alpha r^2) +! unnormalized ! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**3 - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1)*r(0)**3 - fun=distp(0,1)*(3.d0-dd2*r(0))*r(0) -! fun= derivative of fun0 respect to r divided dy r - fun2=distp(0,1)*(dd2**2*r(0)**3-6*dd2*r(0)**2 & - & +6*r(0)) -! fun2= second derivative of fun0 respect to r -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(135) -! 2p single exponential r^4 e^{-z r} ! - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)) - enddo +indparp=indpar+1 +dd1=dd(indparp) +do k=0,0 + distp(k,1)=dexp(-dd1*r(k)**2) +end do +do i=0,0 + distp(i,2)=cost1f*rmu(3,i) & + *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=0 + distp(i,3)=cost2f*rmu(1,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2f*rmu(2,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3f*rmu(3,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-2 + distp(i,6)=cost3f*2.d0*rmu(3,i) & + *rmu(1,i)*rmu(2,i) + ! lz=+/-2 + distp(i,7)=cost4f*rmu(1,i) & + *(rmu(1,i)**2-3.d0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4f*rmu(2,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 +end do +do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif +end do +if(typec.ne.1) then + ! dd1=dd(indparp) + fun0=distp(0,1) + fun=-2.d0*dd1*distp(0,1) + fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + ! indorbp=indorb + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + end do + if(ic.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1)- & + 6.d0*cost1f*fun0*rmu(1,0)*rmu(3,0) + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 6.d0*cost1f*fun0*rmu(2,0)*rmu(3,0) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + cost1f*fun0*(9.d0*rmu(3,0)**2-3.d0*r(0)**2) + elseif(ic.eq.2) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2-2.d0*rmu(1,0)**2) + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 2.d0*cost2f*fun0*rmu(2,0)*rmu(1,0) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + 8.d0*cost2f*fun0*rmu(3,0)*rmu(1,0) + elseif(ic.eq.3) then + z(indorbp,indt+1)=z(indorbp,indt+1)- & + 2.d0*cost2f*fun0*rmu(1,0)*rmu(2,0) + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2-2.d0*rmu(2,0)**2) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + 8.d0*cost2f*fun0*rmu(3,0)*rmu(2,0) + elseif(ic.eq.4) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + elseif(ic.eq.5) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) + elseif(ic.eq.6) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + else + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+7 +indorb=indorbp +case (34) + ! normalized + ! exp(-dd1*r) + dd1*r*exp(-dd1*r) + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + ! peff=dd1 + ! if(iflagnorm.gt.2) then + ! c=1.d0/dsqrt(1.d0/4.d0/dd1**3+12.d0*dd1/(2.d0*dd1)**4+& + ! &3.d0*dd1**2/4.d0/dd1**5)/dsqrt(4.d0*pi) + ! c=dd1*dsqrt(dd1)/dsqrt(7.d0*pi) + c=dd1*dsqrt(dd1)*.2132436186229231d0 + ! endif + do i=0,0 + distp(i,1)=c*dexp(-dd1*r(i)) + end do + do i=0,0 + z(indorbp,i)=distp(i,1)*(1.d0+r(i)*dd1) + end do + if(typec.ne.1) then + fun=-dd1**2*distp(0,1) + fun2=fun*(1.d0-dd1*r(0)) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=(2.d0*fun+fun2) + end if + indorb=indorbp + ! endif + indpar=indpar+1 + indshell=indshellp + ! 2s single Z WITH CUSP +case (18) + ! R(r)=r**4*exp(-z*r**2) single zeta + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=(2.d0*dd1**11/pi)**(1.d0/4.d0)*(512.d0/945.d0/pi) + c=dd1**2.75d0*0.1540487967684377d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do i=0,0 + z(indorbp,i)=r(i)**4*distp(i,1) + end do + if(typec.ne.1) then + rp1=r(0)**2 + ! the first derivative + fun=distp(0,1)*rp1*(4.d0-2.d0*dd1*rp1) + ! the second derivative + fun2=distp(0,1)*rp1*(12.d0-18.d0*dd1*rp1 & + +4.d0*dd1**2*rp1**2) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + indorb=indorbp + ! endif + indpar=indpar+1 + indshell=indshellp + ! derivative of 16 with respect to z +case (41) + !c 4p without cusp condition derivative of 22 + !c r^2 e^{-z1 r } + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=dsqrt((2.d0*dd1)**7/240.d0/pi)/2.d0 + c=dd1**3.5d0*0.2060129077457011d0 + ! endif + c0=-c + c1=3.5d0*c/dd1 + do k=0,0 + distp(k,1)=dexp(-dd1*r(k)) + end do + do i=0,0 + distp(i,3)=r(i)**2*distp(i,1) + end do + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*(c0*distp(i,3)+c1*r(i)*distp(i,1)) + end do + ! endif + end do + if(typec.ne.1) then + ! fun=(1.d0-dd1*r(0))*distp(0,1) + ! fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) + fun0=c0*distp(0,3)+c1*r(0)*distp(0,1) + fun=(c0*(2.d0-dd1*r(0))*r(0) & + +c1*(1.d0-dd1*r(0)))*distp(0,1) + fun2=(c0*((dd1*r(0))**2+2.d0-4.d0*dd1*r(0)) & + +c1*dd1*(dd1*r(0)-2.d0))*distp(0,1) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun/r(0) + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun/r(0)+fun2) + ! endif + end do + end if + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp +case (125) +! 2s with cusp condition +! dd1*( dd3 +exp(-dd2*r)) ! with no cusp condition +dd2=dd(indpar+1) +dd3=dd(indpar+2) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)) +end do +! if(iocc(indshellp).eq.1) then +do i=0,0 + z(indorbp,i)=distp(i,1)+dd3 +end do +! endif +if(typec.ne.1) then + fun=-dd2*distp(0,1)/r(0) + fun2=dd2**2*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if +indpar=indpar+2 +indshell=indshellp +indorb=indorbp +case (116) +! 2p double Lorentian +! dd1 * x_mu (L^3(dd2 r)+dd3 r * L(dd4*r)^4) ; L(x)=1/(1+x) +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) +do k=0,0 + distp(k,1)=1.d0/(1.d0+dd2*r(k))**3 + distp(k,2)=r(k)/(1.d0+dd4*r(k))**4 +end do ! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**4 - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1)*r(0)**4 - fun=distp(0,1)*(4.d0-dd2*r(0))*r(0)**2 - fun2=distp(0,1)*(12*r(0)**2-8*dd2*r(0)**3 & - & +dd2**2*r(0)**4) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(136) -! 2p single exponential r^5 e^{-z r} ! - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)) - enddo +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*(distp(i,1)+dd3*distp(i,2)) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1)+dd3*distp(0,2) + fun=-3.d0*dd2*distp(0,1)/(r(0)*(1.d0+dd2*r(0))) & + +dd3*distp(0,2)/r(0)**2*(1.d0-3*dd4*r(0)) & + /(1.d0+dd4*r(0)) + fun2=12.d0*dd2**2/(1.+dd2*r(0))**5 & + +dd3*4.d0*dd4*(-2.d0+3.d0*dd4*r(0))/(1.+dd4*r(0))**6 + ! fun0=distp(0,1)+dd3*distp(0,2) + ! fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) + ! fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) + ! 1+2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+3 +indshell=indshell+3 +indorb=indorbp +case (48) + ! f orbital + ! + ! - angmom = 3 + ! - type = Gaussian + ! - normalized = yes + ! - angtype = spherical + ! - npar = 1 + ! - multiplicity = 7 + ! + indparp=indpar+1 + dd1=dd(indparp) + c=dd1**2.25d0*1.47215808929909374563d0 + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do i=0,0 + distp(i,2)=cost1f*rmu(3,i) & + *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=0 + distp(i,3)=cost2f*rmu(1,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2f*rmu(2,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3f*rmu(3,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-2 + distp(i,6)=cost3f*2.d0*rmu(3,i) & + *rmu(1,i)*rmu(2,i) + ! lz=+/-2 + distp(i,7)=cost4f*rmu(1,i) & + *(rmu(1,i)**2-3.d0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4f*rmu(2,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + end do + do ic=1,7 + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + end do + if(typec.ne.1) then + dd1=dd(indparp) + fun0=distp(0,1) + fun=-2.d0*dd1*distp(0,1) + fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + do ic=1,7 + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + end do + if(ic.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1)- & + 6.d0*cost1f*fun0*rmu(1,0)*rmu(3,0) + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 6.d0*cost1f*fun0*rmu(2,0)*rmu(3,0) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + cost1f*fun0*(9.d0*rmu(3,0)**2-3.d0*r(0)**2) + elseif(ic.eq.2) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2-2.d0*rmu(1,0)**2) + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 2.d0*cost2f*fun0*rmu(2,0)*rmu(1,0) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + 8.d0*cost2f*fun0*rmu(3,0)*rmu(1,0) + elseif(ic.eq.3) then + z(indorbp,indt+1)=z(indorbp,indt+1)- & + 2.d0*cost2f*fun0*rmu(1,0)*rmu(2,0) + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2-2.d0*rmu(2,0)**2) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + 8.d0*cost2f*fun0*rmu(3,0)*rmu(2,0) + elseif(ic.eq.4) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + elseif(ic.eq.5) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) + elseif(ic.eq.6) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + else + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) + end do + end if + indpar=indpar+1 + indshell=indshell+7 + indorb=indorbp +case (102) + ! 2s double gaussian with constant + ! (dd3+ exp (-dd2 r^2)+dd4*exp(-dd5*r^2)) + dd2=dd(indpar+1) + dd3=dd(indpar+2) + dd4=dd(indpar+3) + dd5=dd(indpar+4) + indorbp=indorb+1 + indshellp=indshell+1 + do k=0,0 + distp(k,1)=dexp(-dd2*r(k)*r(k)) + distp(k,2)=dexp(-dd5*r(k)*r(k)) + end do + ! if(iocc(indshellp).eq.1) then + do i=0,0 + z(indorbp,i)=(distp(i,1)+dd3+dd4*distp(i,2)) +! write(6,*) ' function inside = ',z(indorbp,i) +end do +! endif +if(typec.ne.1) then + fun=-2.d0*(dd2*distp(0,1)+dd5*dd4*distp(0,2)) + fun2=r(0)**2 + ! write(6,*) ' fun inside = ',fun,fun2 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*(dd2*(-3.d0+2.d0*dd2*fun2)* & + distp(0,1)+dd5*dd4*(-3.d0+2.d0*dd5*fun2)*distp(0,2)) + ! write(6,*) ' lap 106 =',z(indorbp,indt+4) + ! stop + !endif for indt +end if +indpar=indpar+4 +indshell=indshellp +indorb=indorbp +case (35) + ! normalized + ! exp(-dd1*r) + dd1* r * exp(-dd2*r) + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd1 + do k=0,0 + distp(k,1)=dexp(-dd1*r(k)) + distp(k,2)=dexp(-dd2*r(k)) + end do + ! if(iflagnorm.gt.2) then + c=1.d0/dsqrt(1/4.d0/dd1**3+12*peff/(dd1+dd2)**4+ & + 3*peff**2/4/dd2**5)/dsqrt(4.0*pi) + ! endif + do i=0,0 + z(indorbp,i)=c*(distp(i,1)+r(i)*distp(i,2)*peff) + end do + if(typec.ne.1) then + fun=-dd1*distp(0,1)+peff*distp(0,2)*(1.d0-dd2*r(0)) + fun2=distp(0,1)*dd1**2 & + +peff*distp(0,2)*(dd2**2*r(0)-2.d0*dd2) + do i=1,3 + z(indorbp,indt+i)=fun*c*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=c*(2.d0*fun/r(0)+fun2) + end if + indorb=indorbp + ! endif + indpar=indpar+2 + indshell=indshellp + ! single gaussian p orbitals +case (103) +! 2p single gaussian +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)**2) +end do ! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**5 - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1)*r(0)**5 - fun=distp(0,1)*(5.d0-dd2*r(0))*r(0)**3 - fun2=distp(0,1)*(20*r(0)**3-10*dd2*r(0)**4 & - & +dd2**2*r(0)**5) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(137) -! 2s with cusp condition -! dd1*(exp(-dd2*r)*(1+dd2*r)) - dd2=dd(indpar+1) -! if(iflagnorm.gt.2) then -! c=1.d0/dsqrt(1/4.d0/dd2**3+12*dd2/(2.d0*dd2)**4+ -! &3*dd2**2/4/dd2**5)/dsqrt(4.0*pi) -! endif - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)) - enddo +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1) + fun=-dd2*distp(0,1)*2.d0 + fun2=2.d0*dd2*(-1.d0+2.d0*dd2*r(0)**2)* & + distp(0,1) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + end do + z(indorbp,indt+ic)=z(indorbp,indt+ic)+fun0 + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (120) +! 2p double cubic +! dd1 * x_mu (L^3(dd2 r)+dd3 L(dd4*r)^3) ; L(x)=1/(1+x) +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) +do k=0,0 + distp(k,1)=1.d0/(1.d0+dd2*r(k))**3 + distp(k,2)=1.d0/(1.d0+dd4*r(k))**3 +end do +! indorbp=indorb +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*(distp(i,1)+dd3*distp(i,2)) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1)+dd3*distp(0,2) + fun=-3.d0*dd2*distp(0,1)/(r(0)*(1.d0+dd2*r(0))) & + -3.d0*dd4*dd3*distp(0,2)/(r(0)*(1.d0+dd4*r(0))) + fun2=12.d0*dd2**2/(1.+dd2*r(0))**5 & + +12.d0*dd3*dd4**2/(1.+dd4*r(0))**5 + ! fun0=distp(0,1)+dd3*distp(0,2) + ! fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) + ! fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) + ! 1+2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+3 +indshell=indshell+3 +indorb=indorbp +case (135) +! 2p single exponential r^4 e^{-z r} ! +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)) +end do +! indorbp=indorb +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**4 + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1)*r(0)**4 + fun=distp(0,1)*(4.d0-dd2*r(0))*r(0)**2 + fun2=distp(0,1)*(12*r(0)**2-8*dd2*r(0)**3 & + +dd2**2*r(0)**4) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (114) +! 2s without cusp condition +! dd1*( dd3 +r^2/(1+dd2*r)^3) +dd2=dd(indpar+1) +dd3=dd(indpar+2) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=r(k)**2/(1.d0+dd2*r(k))**3 +end do ! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)*(1.d0+dd2*r(i)) - enddo -! endif - if(typec.ne.1) then - fun=-dd2**2*distp(0,1) - fun2=fun*(1.d0-dd2*r(0)) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - !endif for indt - endif - indpar=indpar+1 - indshell=indshellp - indorb=indorbp - case(138) +do i=0,0 + z(indorbp,i)=distp(i,1)+dd3 +end do +! endif +if(typec.ne.1) then + fun= (2.d0-dd2*r(0))/(1+dd2*r(0))**4 + fun2=2.d0*(1.d0-4.d0*dd2*r(0)+(dd2*r(0))**2) & + /(1+dd2*r(0))**5 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=fun2+2.d0*fun + !endif for indt +end if +indpar=indpar+2 +indshell=indshellp +indorb=indorbp +case (63) + ! R(r)=c x*exp(-z*r**2)*r (c1 - r^2) + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + c=dd1**1.75d0*1.2749263037197753d0 + ! c=2.d0/pi**0.75d0*(2.d0*dd1)**1.75d0/dsqrt(5.d0) + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + c1=1.75d0/dd1 + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1)* & + (c1-r(i)**2)*r(i) + end do + ! endif + end do + if(typec.ne.1) then + rp1=dd1*r(0)**2 + cost=2.d0*rp1 + fun0=distp(0,1)*r(0)*(c1-r(0)**2) + fun=distp(0,1)*(c1*(1.d0-cost)/r(0)+ & + (-3.d0+cost)*r(0)) + ! My bug !!! + ! fun2=distp(0,1)*(c1*2.d0*dd1*fun0*(cost-3.d0) + ! &-2.d0*r(0)*(3.d0-7.d0*rp1+2.d0*rp1**2)) + fun2=-2.d0*distp(0,1)*r(0)* & + (3.d0-7.d0*rp1+2.d0*rp1**2+c1*dd1*(3.d0-cost)) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + ! endif + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp +case (148) +! derivative of 147 with respect to dd1 +dd1=dd(indpar+1) +do k=0,0 + distp(k,1)=dexp(-dd1*r(k)**2) +end do +do i=0,0 + distp(i,3)=-r(i)**2*distp(i,1) + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d +end do +! indorbp=indorb +do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,3) + fun=2.d0*(dd1*r(0)**2-1.d0)*r(0)*distp(0,1) + fun2=-2.d0*(2.d0*dd1**2*r(0)**4+1.d0 & + -5.d0*dd1*r(0)**2)*distp(0,1) + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt +end if +! +indpar=indpar+1 +indshell=indshell+5 +indorb=indorbp +case (12) + ! R(r)=r**3*exp(-z1*r) + ! + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 + c=dd1**4.5d0*.03178848180059307346d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + end do + do i=0,0 + z(indorbp,i)=distp(i,1)*r(i)**3 + end do + if(typec.ne.1) then + rp1=r(0)**3 + rp2=r(0)**2 + ! + !c the first derivative + fun=distp(0,1)*(3.d0*rp2-dd1*rp1) + !c + !c the second derivative + fun2=distp(0,1)*(6.d0*r(0)-6.d0*dd1*rp2+dd1**2*rp1) + !c + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=2.d0*fun/r(0)+fun2 + end if + ! + indorb=indorbp + ! + ! endif + indpar=indpar+1 + indshell=indshellp + ! + ! 4s double zeta +case (1000:1099) +! s gaussian r**(2*npower)*exp(-alpha*r**2) +npower=iopt-1000 +indorbp=indorb+1 +indshellp=indshell+1 +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=r(k)**(2*npower)*dexp(-dd2*r(k)**2) +end do +! if(iocc(indshellp).eq.1) then +do i=0,0 + z(indorbp,i)=distp(i,1) +end do +! endif +if(typec.ne.1) then + rp1=r(0)**2 + fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 + fun2=(npower*(2.d0*npower-1.d0)- & + (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & + distp(0,1)*2.d0/rp1 + ! if(iocc(indshellp).eq.1) then + do i=1,3 + z(indorbp,indt+i)=rmu(i,0)*fun + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + ! endif + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+1 +indorb=indorbp +case (144) +! 2p single exponential -r^3 e^{-z r} ! derivative of 130 +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=-dexp(-dd2*r(k)) +end do +! indorbp=indorb +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**3 + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1)*r(0)**3 + fun=distp(0,1)*(3.d0-dd2*r(0))*r(0) + ! fun= derivative of fun0 respect to r divided dy r + fun2=distp(0,1)*(dd2**2*r(0)**3-6*dd2*r(0)**2 & + +6*r(0)) + ! fun2= second derivative of fun0 respect to r + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (70) + ! f single Slater orbital + ! R(r)= exp(-alpha r) + ! normalized + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + ! if(iflagnorm.gt.2) then + ! overall normalization + ! l = 3 + ! \int d\omega Y*Y = 4 pi / (2 l + 1) + ! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5 * 3**2 / 2**2 / dd1**9 + ! c=1.d0/dsqrt(10.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(9.d0/2.d0)/3.d0 + c=dd1**4.5d0*0.084104417400672d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + end do + do i=0,0 + distp(i,2)=cost1f*rmu(3,i) & + *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=0 + distp(i,3)=cost2f*rmu(1,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2f*rmu(2,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3f*rmu(3,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-2 + distp(i,6)=cost3f*2.d0*rmu(3,i) & + *rmu(1,i)*rmu(2,i) + ! lz=+/-2 + distp(i,7)=cost4f*rmu(1,i) & + *(rmu(1,i)**2-3.d0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4f*rmu(2,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + end do + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + if(typec.ne.1) then + dd1=dd(indparp) + fun0=distp(0,1) + fun=-dd1*distp(0,1)/r(0) + fun2=dd1**2*distp(0,1) + ! indorbp=indorb + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) + if(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) + end if + elseif(ic.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + end if + elseif(ic.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + end if + else + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+7 + indorb=indorbp +case (100) + ! 2s single gaussian + ! exp(-dd2*r^2) + dd2=dd(indpar+1) + indorbp=indorb+1 + indshellp=indshell+1 + do k=0,0 + distp(k,1)=dexp(-dd2*r(k)*r(k)) + end do + ! if(iocc(indshellp).eq.1) then + do i=0,0 + z(indorbp,i)=distp(i,1) + end do + ! endif + if(typec.ne.1) then + fun=-dd2*distp(0,1)*2.d0 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*dd2*(-3.d0+2.d0*dd2*r(0)**2)* & + distp(0,1) + !endif for indt + end if + indpar=indpar+1 + indshell=indshellp + indorb=indorbp +case (138) ! 2s with cusp condition ! ( -dd2*r^2*exp(-dd2*r)) ! with no cusp condition der of 137 - dd2=dd(indpar+1) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=-dd2*dexp(-dd2*r(k)) - enddo +dd2=dd(indpar+1) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=-dd2*dexp(-dd2*r(k)) +end do ! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)*r(i)**2 - enddo -! endif - if(typec.ne.1) then - fun=(2.d0-dd2*r(0))*distp(0,1) - fun2=(2.d0-4*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - !endif for indt - endif - indpar=indpar+1 - indshell=indshellp - indorb=indorbp - case(139) -! 2s with cusp condition -! ( r^3*exp(-dd2*r)) ! der of 128 - dd2=dd(indpar+1) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=-dexp(-dd2*r(k))*r(k) - enddo -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)*r(i)**2 - enddo -! endif - if(typec.ne.1) then - fun=(3.d0-dd2*r(0))*distp(0,1) - fun2=(6.d0-6*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - !endif for indt - endif - indpar=indpar+1 - indshell=indshellp - indorb=indorbp - case(140) -! 2p single exponential -r e^{-z r} ! der of 121 - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=-dexp(-dd2*r(k)) - enddo +do i=0,0 + z(indorbp,i)=distp(i,1)*r(i)**2 +end do +! endif +if(typec.ne.1) then + fun=(2.d0-dd2*r(0))*distp(0,1) + fun2=(2.d0-4*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if +indpar=indpar+1 +indshell=indshellp +indorb=indorbp +case (56) + ! g single Slater orbital derivative of 55 + ! R(r)= (11.d0/2.0 1/dd1 - r) * exp(-alpha r) + ! normalized + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + ! if(iflagnorm.gt.2) then + ! overall normalization + ! l = 4 + ! \int d\omega Y*Y = 4 pi / (2 l + 1) + ! \int dr r^{2 l + 2} Exp [- 2 dd1 r^2 ] = 7 * 5**2 * 3**4 / 2**3 / dd1**11 + c=dd1**5.5d0*.020104801169736915d0 + ! c=1.d0/dsqrt(7.d0)*(2.d0/pi)**(1.d0/2.d0)*dd1**(11.d0/2.d0)/3.d0/5.d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + end do + do i=0,0 + distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & + -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) + ! lz=0 + distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & + *(rmu(1,i)**2-3.0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + distp(i,9)=cost5g*(rmu(1,i)**4 & + -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) + ! lz=+/-4 + distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-4 + end do + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*distp(k,1+ic)*(11.d0/2.d0/dd1 - r(k)) + end do + ! endif + end do + if(typec.ne.1) then + dd1=dd(indparp) + fun0=distp(0,1)*(11.d0/2.d0/dd1-r(0)) + fun=distp(0,1)*(dd1-13.d0/2.d0/r(0)) + fun2=dd1*distp(0,1)*(15.d0/2.d0-dd1*r(0)) + ! indorbp=indorb + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun + if(ic.eq.1) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + elseif(ic.eq.7) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + end if + elseif(ic.eq.8) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) + end if + elseif(ic.eq.9) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+9 + indorb=indorbp +case (1) + ! s orbital + ! + ! - angmom = 0 + ! - type = Slater + ! - normalized = yes + ! - angtype = spherical + ! - npar = 1 + ! - multiplicity = 1 + ! + indshellp=indshell+1 + dd1=dd(indpar+1) + c=dd1*dsqrt(dd1)*0.56418958354775628695d0 + indorbp=indorb+1 + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + end do + do i=0,0 + z(indorbp,i)=distp(i,1) + end do + if(typec.ne.1) then + fun=-dd1*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=(-2.d0*dd1/r(0)+dd1**2)*distp(0,1) + end if + indorb=indorbp + indpar=indpar+1 + indshell=indshellp +case (49) + ! f orbitals + ! R(r)= c*exp(-z r^2)*(9/4/z-r^2) + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) + c=dd1**2.25d0*1.47215808929909374563d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do i=0,0 + distp(i,2)=cost1f*rmu(3,i) & + *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=0 + distp(i,3)=cost2f*rmu(1,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2f*rmu(2,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3f*rmu(3,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-2 + distp(i,6)=cost3f*2.d0*rmu(3,i) & + *rmu(1,i)*rmu(2,i) + ! lz=+/-2 + distp(i,7)=cost4f*rmu(1,i) & + *(rmu(1,i)**2-3.d0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4f*rmu(2,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + end do + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*(9.d0/4.d0/dd1-r(k)**2)* & + distp(k,1+ic) + end do + ! endif + end do + if(typec.ne.1) then + dd1=dd(indparp) + fun0=distp(0,1)*(9.d0/4.d0/dd1-r(0)**2) + fun=distp(0,1)*(2.d0*dd1*r(0)**2-13.d0/2.d0) + fun2=distp(0,1)*(-4.d0*dd1**2*r(0)**4 & + +19.d0*dd1*r(0)**2-13.d0/2.d0) + ! indorbp=indorb + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) + if(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) + end if + elseif(ic.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + end if + elseif(ic.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + end if + else + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+7 + indorb=indorbp +case (141) +! 2p single exponential r^2 e^{-z r} ! parent of 121 +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=-dexp(-dd2*r(k)) +end do ! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1)*r(0) - fun=distp(0,1)*(1.d0-dd2*r(0))/r(0) - fun2=dd2*(dd2*r(0)-2.d0)*distp(0,1) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(141) +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**2 + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1)*r(0)**2 + fun=distp(0,1)*(2.d0-dd2*r(0)) + fun2=(2.d0-4.d0*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +! der of 127 +case (26) + ! s orbital + ! + ! - angmom = 1 + ! - type = Slater + ! - normalized = yes + ! - angtype = spherical + ! - npar = 5 + ! - multiplicity = 3 + ! + ! 2p with cusp conditions + ! + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + dd3=dd(indpar+4) + peff2=dd(indpar+5) + c=1.d0/2.d0/dsqrt(8.d0*pi*(1.d0/(2.d0*dd1)**5 & + +2.d0*peff/(dd1+dd2)**5+peff**2/(2.d0*dd2)**5 & + +2.d0*peff2/(dd1+dd3)**5+peff2**2/(2.d0*dd3)**5 & + +2.d0*peff2*peff/(dd2+dd3)**5)) + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + distp(k,3)=c*dexp(-dd3*r(k)) + end do + do i=0,0 + distp(i,4)=distp(i,1)+peff*distp(i,2)+peff2*distp(i,3) + end do + do ic=1,3 + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,4) + end do + end do + if(typec.ne.1) then + fun=(-dd1*distp(0,1)-dd2*peff*distp(0,2) & + -dd3*peff2*distp(0,3))/r(0) + fun2=dd1**2*distp(0,1)+peff*dd2**2*distp(0,2) & + +peff2*dd3**2*distp(0,3) + do ic=1,3 + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)*fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+distp(0,4) + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + end do + end if + indpar=indpar+5 + indshell=indshell+3 + indorb=indorbp +case (86) + ! f single gaussian orbital + ! R(r)= exp(-alpha r^2) + ! normalized + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + dd2=dsqrt(dd1) + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0)*ratiocf + c=dd1**2.25d0*ratiocf + ! endif + do k=0,0 + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + do i=0,0 + distp(i,2)=cost1f*rmu(3,i) & + *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=0 + distp(i,3)=cost2f*rmu(1,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2f*rmu(2,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3f*rmu(3,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-2 + distp(i,6)=cost3f*2.d0*rmu(3,i) & + *rmu(1,i)*rmu(2,i) + ! lz=+/-2 + distp(i,7)=cost4f*rmu(1,i) & + *(rmu(1,i)**2-3.d0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4f*rmu(2,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + end do + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + if(typec.ne.1) then + fun0=distp(0,1) + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + fun=-dd1*distp(0,1)*(2.d0+rp2)/rp3 + ! the second derivative + fun2=dd1*distp(0,1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**2)/rp3**2 + ! indorbp=indorb + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) + if(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) + end if + elseif(ic.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + end if + elseif(ic.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + end if + else + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+7 + indorb=indorbp + ! derivative of 48 with respect to z +case (101) + ! 2s without cusp condition + ! dd1*( dd3 +exp(-dd2*r^2)) + dd2=dd(indpar+1) + dd3=dd(indpar+2) + indorbp=indorb+1 + indshellp=indshell+1 + do k=0,0 + distp(k,1)=dexp(-dd2*r(k)*r(k)) + end do + ! if(iocc(indshellp).eq.1) then + do i=0,0 + z(indorbp,i)=distp(i,1)+dd3 + end do + ! endif + if(typec.ne.1) then + fun=-dd2*distp(0,1)*2.d0 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*dd2*(-3.d0+2.d0*dd2*r(0)**2)* & + distp(0,1) + !endif for indt + end if + indpar=indpar+2 + indshell=indshellp + indorb=indorbp +case (150) +! 2p single exponential r e^{-z r^2} +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)**2) +end do +! indorbp=indorb +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1)*r(0) + cost=2.d0*dd2*r(0)**2 + fun=distp(0,1)*(1.d0-cost)/r(0) + fun2=2.d0*dd2*fun0*(cost-3.d0) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (155) +! Jastrow single gaussian f orbital +! derivative of 154 with respect to z +! unnormalized f orbitals +! R(r)= -r^2*exp(-z r^2) +! indorbp=indorb +indparp=indpar+1 +dd1=dd(indparp) +do k=0,0 + distp(k,1)=dexp(-dd1*r(k)**2) +end do +do i=0,0 + distp(i,2)=cost1f*rmu(3,i) & + *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=0 + distp(i,3)=cost2f*rmu(1,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2f*rmu(2,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3f*rmu(3,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-2 + distp(i,6)=cost3f*2.d0*rmu(3,i) & + *rmu(1,i)*rmu(2,i) + ! lz=+/-2 + distp(i,7)=cost4f*rmu(1,i) & + *(rmu(1,i)**2-3.d0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4f*rmu(2,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 +end do +do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=-r(k)**2*distp(k,1)*distp(k,1+ic) + end do + ! endif +end do +if(typec.ne.1) then + dd1=dd(indparp) + fun0=-r(0)**2*distp(0,1) + fun=2.d0*(dd1*r(0)**2-1.d0)*distp(0,1) + fun2=-2.d0*(2.d0*dd1**2*r(0)**4+1.d0 & + -5.d0*dd1*r(0)**2)*distp(0,1) + ! indorbp=indorb + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) + if(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) + end if + elseif(ic.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + end if + elseif(ic.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + end if + else + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+7 +indorb=indorbp +case (83) + ! R(r)=x*exp(-z*r**2)*(5/4/z-r**2) + dd1=dd(indpar+1) + dd2=dsqrt(dd1) + c=dd1**1.25d0*ratiocp + do k=0,0 + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + cost=(1.d0+0.5d0*dd2*r(i))/(1.d0+dd2*r(i))**2 + z(indorbp,i)=rmu(ic,i)*distp(i,1)*(1.25d0/dd1-r(i)**2*cost) + end do + ! endif + end do + if(typec.ne.1) then + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + cost=(1.d0+0.5d0*rp2)/rp3 + fun0=distp(0,1)*(1.25d0/dd1-r(0)**2*cost) + fun=0.25d0*distp(0,1)* & + (-18.d0-39.d0*rp2-20.d0*rp1+rp1*rp2+2.d0*rp1**2)/rp3**2 + fun2=0.25d0*distp(0,1)* & + (-18.d0-42.d0*rp2+30.d0*rp1+138.d0*rp1*rp2+113.d0*rp1**2 & + +30.d0*rp1**2*rp2-3.d0*rp1**3-2.d0*rp1**3*rp2)/rp3**3 + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + ! endif + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp +case (81) + ! R(r)=c*exp(-z*r**2)*(3/4/z-r**2) + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dsqrt(dd1) + ! c=(2.d0*dd1/pi)**(3.d0/4.d0)*ratiocs + c=dd1**0.75d0*ratiocs + do k=0,0 + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + do i=0,0 + cost=(1.d0+0.5d0*dd2*r(i))/(1.d0+dd2*r(i))**2 + z(indorbp,i)=distp(i,1)*(3.d0/4.d0/dd1-r(i)**2*cost) + end do + if(typec.ne.1) then + ! the first derivative /r + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + fun=0.25d0*distp(0,1)* & + (-14.d0-29.d0*rp2-12.d0*rp1+3.d0*rp1*rp2+2.d0*rp1**2)/rp3**2 + ! the second derivative + fun2=0.25d0*distp(0,1)* & + (-14.d0-30.d0*rp2+34.d0*rp1+118.d0*rp1*rp2+87.d0*rp1**2 & + +18.d0*rp1**2*rp2-5.d0*rp1**3-2.d0*rp1**3*rp2)/rp3**3 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + indorb=indorbp + indpar=indpar+1 + indshell=indshellp +case (130) ! 2p single exponential r^2 e^{-z r} ! parent of 121 - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=-dexp(-dd2*r(k)) - enddo +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)) +end do ! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**2 - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1)*r(0)**2 - fun=distp(0,1)*(2.d0-dd2*r(0)) - fun2=(2.d0-4.d0*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - ! der of 127 - case(142) -! 4d one parmater - dd1=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)) - enddo - do i=0,0 - distp(i,3)=distp(i,1)*r(i) - distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d - distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d - distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d - enddo -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=-distp(i,3+ic)*distp(i,3) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=-distp(0,3) - fun=-(1.d0-dd1*r(0))*distp(0,1) - fun2=-dd1*(dd1*r(0)-2.d0)*distp(0,1) -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & - & *fun/r(0) - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif -! - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - case(143) -! 4d one parmater der of 133 - dd1=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)) - enddo - do i=0,0 - distp(i,3)=distp(i,1)*r(i)**2 - distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d - distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d - distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d - enddo -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=-distp(i,3+ic)*distp(i,3) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=-distp(0,3) - fun=-(-2.d0+dd1*r(0))*distp(0,1) - fun2=((dd1*r(0))**2 -4.d0*r(0)*dd1+2.d0)*distp(0,1) -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & - & *fun - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif -! - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - case(144) -! 2p single exponential -r^3 e^{-z r} ! derivative of 130 - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=-dexp(-dd2*r(k)) - enddo +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**2 + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1)*r(0)**2 + fun=distp(0,1)*(2.d0-dd2*r(0)) + fun2=(2.d0-4.d0*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (89) + ! g single gaussian orbital + ! derivative of 51 + ! R(r)= exp(-alpha r^2) + ! normalized + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + dd2=dsqrt(dd1) + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0)*ratiocg + c=dd1**2.75d0*ratiocg + ! endif + do k=0,0 + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + do i=0,0 + distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & + -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) + ! lz=0 + distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & + *(rmu(1,i)**2-3.0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + distp(i,9)=cost5g*(rmu(1,i)**4 & + -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) + ! lz=+/-4 + distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-4 + end do + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + cost=(1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 + z(indorbp,k)=distp(k,1)*(11.d0/4.d0/dd1-r(k)**2*cost)* & + distp(k,1+ic) + end do + ! endif + end do + if(typec.ne.1) then + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + cost=(1.d0+0.5d0*rp2)/rp3 + fun0=distp(0,1)*(11.d0/4.d0/dd1-r(0)**2*cost) + fun=0.25d0*distp(0,1)* & + (-30.d0-69.d0*rp2-44.d0*rp1-5.d0*rp1*rp2+2.d0*rp1**2)/rp3**2 + fun2=0.25d0*distp(0,1)* & + (-30.d0-78.d0*rp2+18.d0*rp1+198.d0*rp1*rp2+191.d0*rp1**2 & + +66.d0*rp1**2*rp2+3.d0*rp1**3-2.d0*rp1**3*rp2)/rp3**3 + ! indorbp=indorb + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun + if(ic.eq.1) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + elseif(ic.eq.7) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + end if + elseif(ic.eq.8) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) + end if + elseif(ic.eq.9) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+9 + indorb=indorbp + ! WARNING IN DFT it is assumed that UMRIGAR orbitals could be extended + ! up to number 99, so i,h,... are possible extensions. + ! 1s single Z NO CUSP! +case (1100:1199) +! p gaussian r**(2*npower)*exp(-alpha*r**2) +npower=iopt-1100 ! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**3 - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1)*r(0)**3 - fun=distp(0,1)*(3.d0-dd2*r(0))*r(0) -! fun= derivative of fun0 respect to r divided dy r - fun2=distp(0,1)*(dd2**2*r(0)**3-6*dd2*r(0)**2 & - & +6*r(0)) -! fun2= second derivative of fun0 respect to r -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(145) -! 2s without cusp condition !derivative 100 -! -(r^2*exp(-dd2*r^2)) - dd2=dd(indpar+1) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)*r(k)) - enddo -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=-distp(i,1)*r(i)**2 - enddo -! endif - if(typec.ne.1) then - fun0=dd2*r(0)**2 - fun=-2.d0*distp(0,1)*(1.d0-fun0) - fun2=-2.d0*distp(0,1)*(1.d0-5.d0*fun0+2.d0*fun0**2) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - !endif for indt - endif - indpar=indpar+1 - indshell=indshellp - indorb=indorbp - case(146) -! 2p single exponential -r^2 e^{-z r^2} ! derivative of 103 - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)*r(k)) - enddo +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=r(k)**(2*npower)*dexp(-dd2*r(k)**2) +end do +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif +end do +if(typec.ne.1) then + rp1=r(0)**2 + fun0=distp(0,1) + fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 + fun2=(npower*(2.d0*npower-1.d0)- & + (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & + distp(0,1)*2.d0/rp1 + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)*fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (119) +! 2p single r_mu/(1+b r^2)^(3/2) parent of 103 +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=1.d0/(1.d0+dd2*r(k)**2)**1.5d0 +end do ! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=-rmu(ic,i)*distp(i,1)*r(i)*r(i) - enddo -! endif - enddo - if(typec.ne.1) then - rp2=dd2*r(0)*r(0) - fun0=-distp(0,1)*r(0)*r(0) - fun=distp(0,1)*(-2.d0+2.d0*rp2) - fun2=(-2.d0+10.d0*rp2-4.d0*rp2*rp2)*distp(0,1) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(147) -! 3d single gaussian - dd1=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)**2) - enddo - do i=0,0 - distp(i,3)=distp(i,1) - distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d - distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d - distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d - enddo -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=distp(i,3+ic)*distp(i,3) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,3) - fun=-2.d0*dd1*distp(0,1) - fun2=((2.d0*dd1*r(0))**2-2.d0*dd1)*distp(0,1) -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0)*fun - enddo - if(ic.eq.1) then -! if(i.ne.3) then - z(indorbp,indt+1)=z(indorbp,indt+1)- & - & 2.d0*rmu(1,0)*fun0*cost1d - z(indorbp,indt+2)=z(indorbp,indt+2)- & - & 2.d0*rmu(2,0)*fun0*cost1d -! else - z(indorbp,indt+3)=z(indorbp,indt+3)+ & - & 4.d0*rmu(3,0)*fun0*cost1d -! endif - elseif(ic.eq.2) then -! if(i.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1)+ & - & 2.d0*rmu(1,0)*fun0*cost2d -! elseif(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2)- & - & 2.d0*rmu(2,0)*fun0*cost2d -! endif - elseif(ic.eq.3) then -! if(i.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1)+ & - & rmu(2,0)*fun0*cost3d -! elseif(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2)+ & - & rmu(1,0)*fun0*cost3d -! endif - elseif(ic.eq.4) then -! if(i.eq.2) then - z(indorbp,indt+2)=z(indorbp,indt+2)+ & - & rmu(3,0)*fun0*cost3d -! elseif(i.eq.3) then - z(indorbp,indt+3)=z(indorbp,indt+3)+ & - & rmu(2,0)*fun0*cost3d -! endif - elseif(ic.eq.5) then -! if(i.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1)+ & - & rmu(3,0)*fun0*cost3d -! elseif(i.eq.3) then - z(indorbp,indt+3)=z(indorbp,indt+3)+ & - & rmu(1,0)*fun0*cost3d - !endif for i -! endif - !endif for ic - endif - !enddo for i -! enddo - z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif -! - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - case(148) -! derivative of 147 with respect to dd1 - dd1=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)**2) - enddo - do i=0,0 - distp(i,3)=-r(i)**2*distp(i,1) - distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d - distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d - distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d - enddo -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=distp(i,3+ic)*distp(i,3) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,3) - fun=2.d0*(dd1*r(0)**2-1.d0)*r(0)*distp(0,1) - fun2=-2.d0*(2.d0*dd1**2*r(0)**4+1.d0 & - & -5.d0*dd1*r(0)**2)*distp(0,1) -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & - & *fun/r(0) - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif -! - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - case(149) -! derivative of 131 with respect z_1 -! - r^4 exp(-z_1 r^2) - dd2=dd(indpar+1) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)*r(k)) - enddo +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1) + fun=-3.d0*dd2*distp(0,1)/(1.d0+dd2*r(0)**2) + fun2=3.d0*dd2*(-1.d0+4.d0*dd2*r(0)**2) & + /(1.d0+dd2*r(0)**2)**3.5d0 + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (27) + ! 2p without cusp condition + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + dd3=dd(indpar+4) + peff2=dd(indpar+5) + ! if(iflagnorm.gt.2) then + c=1.d0/2.d0/dsqrt(240.d0*pi*(1.d0/(2.d0*dd1)**7 & + +2.d0*peff/(dd1+dd2)**7+peff**2/(2.d0*dd2)**7 & + +2.d0*peff2/(dd1+dd3)**7+peff2**2/(2.d0*dd3)**7 & + +2.d0*peff2*peff/(dd2+dd3)**7)) + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + distp(k,3)=c*dexp(-dd3*r(k)) + end do + do i=0,0 + distp(i,4)=r(i)*(distp(i,1)+peff*distp(i,2) & + +peff2*distp(i,3)) + end do + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,4) + end do + ! endif + end do + if(typec.ne.1) then + fun0=distp(0,4) + fun=(1.d0-dd1*r(0))*distp(0,1) & + +peff*(1.d0-dd2*r(0))*distp(0,2) & + +peff2*(1.d0-dd3*r(0))*distp(0,3) + fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) & + +peff*dd2*(dd2*r(0)-2.d0)*distp(0,2) & + +peff2*dd3*(dd3*r(0)-2.d0)*distp(0,3) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun/r(0) + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)* & + (4.d0*fun/r(0)+fun2) + ! endif + end do + !endif for indt + end if + indpar=indpar+5 + indshell=indshell+3 + indorb=indorbp +case (85) + ! d orbitals + ! R(r)= c*exp(-z r^2)*(7/4/z-r^2) + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + dd2=dsqrt(dd1) + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)*ratiocd + c=dd1**1.75d0*ratiocd + ! endif + do k=0,0 + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + do i=0,0 + ! lz=0 + distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/-2 + distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d + end do + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + cost=(1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 + z(indorbp,k)=distp(k,1)*(7.d0/4.d0/dd1-r(k)**2*cost)* & + distp(k,1+ic) + end do + ! endif + end do + if(typec.ne.1) then + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + cost=(1.d0+0.5d0*rp2)/rp3 + fun0=distp(0,1)*(7.d0/4.d0/dd1-r(0)**2*cost) + fun=0.25d0*distp(0,1)* & + (-22.d0-49.d0*rp2-28.d0*rp1-rp1*rp2+2.d0*rp1**2)/rp3**2 + fun2=-0.25d0*distp(0,1)* & + (22.d0+54.d0*rp2-26.d0*rp1-158.d0*rp1*rp2-139.d0*rp1**2 & + -42.d0*rp1**2*rp2+rp1**3+2.d0*rp1**3*rp2)/rp3**3 + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp +case (115) +! 2s double lorentian with constant parent of 102 +! (dd3+ r^2/(1+dd2*r)^3+dd4*r^3/(1+dd5*r)^4; +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) +dd5=dd(indpar+4) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=r(k)**2/(1.d0+dd2*r(k))**3 + distp(k,2)=r(k)**3/(1.d0+dd5*r(k))**4 +end do ! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=-distp(i,1)*r(i)**4 - enddo -! endif - if(typec.ne.1) then - fun0=dd2*r(0)**2 - fun=-2.d0*r(0)**2*distp(0,1)*(2.d0-fun0) - fun2=-2.d0*r(0)**2*distp(0,1)*(6.d0-9.d0*fun0+2.d0*fun0**2) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - !endif for indt - endif - indpar=indpar+1 - indshell=indshellp - indorb=indorbp - case(150) -! 2p single exponential r e^{-z r^2} - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)**2) - enddo +do i=0,0 + z(indorbp,i)=(distp(i,1)+dd3+dd4*distp(i,2)) +! write(6,*) ' function inside = ',z(indorbp,i) +end do +! endif +if(typec.ne.1) then + fun= (2.d0-dd2*r(0))/(1+dd2*r(0))**4 & + -dd4*r(0)*(-3.d0+dd5*r(0))/(1.d0+dd5*r(0))**5 + fun2=2.d0*(1.d0-4.d0*dd2*r(0)+(dd2*r(0))**2) & + /(1+dd2*r(0))**5 & + +dd4*2.d0*r(0)*(3.d0-6.d0*dd5*r(0)+(dd5*r(0))**2) & + /(1.d0+dd5*r(0))**6 + ! write(6,*) ' fun inside = ',fun,fun2 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=fun2+2.d0*fun + ! write(6,*) ' lap 106 =',z(indorbp,indt+4) + !endif for indt +end if +indpar=indpar+4 +indshell=indshellp +indorb=indorbp +case (22) + ! 3p without cusp condition + ! r e^{-z1 r } + dd1=dd(indpar+1) + ! c=dsqrt((2.d0*dd1)**7/240.d0/pi)/2.d0 + c=dd1**3.5d0*0.2060129077457011d0 + ! + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=r(k)*distp(k,1) + end do + ! + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,2) + end do + ! endif + end do + ! + ! + if(typec.ne.1) then + fun0=distp(0,2) + fun=(1.d0-dd1*r(0))*distp(0,1) + fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) + ! + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun/r(0) + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)* & + (4.d0*fun/r(0)+fun2) + ! + ! endif + end do + ! + ! + !endif for indt + end if + ! + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp + ! 3p double zeta +case (13) + ! R(r)=r**3*(exp(-z1*r)+z3*exp(-z2*r)) + ! + indshellp=indshell+1 + ! + ! + ! if(iocc(indshellp).eq.1) then + ! + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + dd3=dd(indpar+3) + ! if(iflagnorm.gt.2) then + c=1.d0/2.d0/dsqrt(pi*40320.d0*(1.d0/(2.d0*dd1)**9+ & + 2.d0*dd3/(dd1+dd2)**9+dd3**2/(2.d0*dd2)**9)) + ! endif + ! + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + end do + do i=0,0 + z(indorbp,i)=(distp(i,1)+dd3*distp(i,2))*r(i)**3 + end do + ! + if(typec.ne.1) then + rp1=r(0)**3 + rp2=r(0)**2 + ! + !c the first derivative + fun=distp(0,1)*(3.d0*rp2-dd1*rp1) & + +dd3*distp(0,2)*(3.d0*rp2-dd2*rp1) + !c + ! the second derivative + fun2=distp(0,1)*(6.d0*r(0)-6.d0*dd1*rp2+dd1**2*rp1) & + +dd3*distp(0,2)*(6.d0*r(0)-6.d0*dd2*rp2+dd2**2*rp1) + !c + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0)/r(0) + end do + ! + z(indorbp,indt+4)=2.d0*fun/r(0)+fun2 + ! + end if + indorb=indorbp + ! endif + indpar=indpar+3 + indshell=indshellp + ! 1s single Z pseudo +case (37,68) + ! d orbital + ! + ! - angmom = 2 + ! - type = Gaussian + ! - normalized = yes + ! - angtype = spherical + ! - npar = 1 + ! - multiplicity = 5 + ! + indparp=indpar+1 + dd1=dd(indparp) + c=dd1**1.75d0*1.64592278064948967213d0 + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do i=0,0 + ! lz=0 + distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/-2 + distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d + end do + do ic=1,5 + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + end do + if(typec.ne.1) then + dd1=dd(indparp) + fun0=distp(0,1) + fun=-2.d0*dd1*distp(0,1) + fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + do ic=1,5 + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + end do + if(ic.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1)- & + 2.d0*rmu(1,0)*fun0*cost1d + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 2.d0*rmu(2,0)*fun0*cost1d + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + 4.d0*rmu(3,0)*fun0*cost1d + elseif(ic.eq.2) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 2.d0*rmu(1,0)*fun0*cost2d + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 2.d0*rmu(2,0)*fun0*cost2d + elseif(ic.eq.3) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + rmu(2,0)*fun0*cost3d + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + rmu(1,0)*fun0*cost3d + elseif(ic.eq.4) then + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + rmu(3,0)*fun0*cost3d + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + rmu(2,0)*fun0*cost3d + elseif(ic.eq.5) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + rmu(3,0)*fun0*cost3d + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + rmu(1,0)*fun0*cost3d + end if + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + end do + end if + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp +case (140) +! 2p single exponential -r e^{-z r} ! der of 121 +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=-dexp(-dd2*r(k)) +end do ! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i) - enddo -! endif - enddo - if(typec.ne.1) then - fun0=distp(0,1)*r(0) - cost=2.d0*dd2*r(0)**2 - fun=distp(0,1)*(1.d0-cost)/r(0) - fun2=2.d0*dd2*fun0*(cost-3.d0) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(151) -! 2p single exponential -r^3 e^{-z r^2} ! parent of 150 - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)**2) - enddo +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1)*r(0) + fun=distp(0,1)*(1.d0-dd2*r(0))/r(0) + fun2=dd2*(dd2*r(0)-2.d0)*distp(0,1) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (2000:2099) +! s gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative of 1000 +npower=iopt+1-2000 +indorbp=indorb+1 +indshellp=indshell+1 +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=-r(k)**(2*npower)*dexp(-dd2*r(k)**2) +end do +! if(iocc(indshellp).eq.1) then +do i=0,0 + z(indorbp,i)=distp(i,1) +end do +! endif +if(typec.ne.1) then + rp1=r(0)**2 + fun0=distp(0,1) + fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 + fun2=(npower*(2.d0*npower-1.d0)- & + (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & + distp(0,1)*2.d0/rp1 + ! if(iocc(indshellp).eq.1) then + do i=1,3 + z(indorbp,indt+i)=rmu(i,0)*fun + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + ! endif + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+1 +indorb=indorbp +case (61) + ! R(r)=c (-r**5*exp(-z1*r**2)+c1 r**3 exp(-z1*r**2)) + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=2.d0/pi**(3.d0/4.d0)*(2.d0*dd1)**(9.d0/4.d0)*dsqrt(2.d0/105.d0) + c=dd1**2.25d0*.55642345640820284397d0 + ! endif + c1=2.25d0/dd1 + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2)*r(k) + end do + do i=0,0 + z(indorbp,i)=(-r(i)**4+c1*r(i)**2)*distp(i,1) + end do + if(typec.ne.1) then + rp1=r(0)**2 + rp2=rp1*dd1 + fun=c1*distp(0,1)*(3.d0-2.d0*rp2) & + +distp(0,1)*rp1*(-5.d0+2.d0*rp2) + ! the second derivative + fun2=c1*distp(0,1)*(6.d0-14.d0*rp2+4.d0*rp2**2) & + +distp(0,1)*rp1*(-20.d0+22.d0*rp2-4.d0*rp2**2) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + indorb=indorbp + ! endif + indpar=indpar+1 + indshell=indshellp + ! single gaussianx r p orbitals +case (20) + ! 2p single Z with no cusp condition + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=dsqrt((2.d0*dd1)**5/8.d0/pi)/2.d0 + c=dd1**2.5d0*0.5641895835477562d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + end do + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif + end do + if(typec.ne.1) then + fun0=distp(0,1) + fun=-dd1*distp(0,1) + fun2=dd1**2*distp(0,1) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun/r(0) + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun/r(0)+fun2) + ! endif + end do + end if + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp + ! 2p double zeta +case (38) + ! R(r)=r**2*exp(-z1*r) + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=1.d0/dsqrt(1.d0/4.d0/dd1**3+12.d0*dd1/(2.d0*dd1)**4+& + ! &3.d0*dd1**2/4.d0/dd1**5)/dsqrt(4.d0*pi) + ! c=dd1*dsqrt(dd1)/dsqrt(7.d0*pi) + c=dd1*dsqrt(dd1)*0.21324361862292308211d0 + ! endif + c0=-c*dd1 + c1=1.5d0*c/dd1 + do i=0,0 + distp(i,1)=dexp(-dd1*r(i)) + end do + do i=0,0 + z(indorbp,i)=(c0*r(i)**2+c1*(1.d0+dd1*r(i))) & + *distp(i,1) + end do + c1=c1*dd1**2 + if(typec.ne.1) then + fun=(c0*(2.d0-dd1*r(0))-c1)*distp(0,1) + fun2=(c0*(2.d0-4*dd1*r(0)+(dd1*r(0))**2) & + +c1*(dd1*r(0)-1.d0))*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + indorb=indorbp + ! endif + indpar=indpar+1 + indshell=indshellp + ! 4s single zeta derivative of 10 +case (84) + ! d orbitals + ! R(r)= exp(-alpha r^2) + ! each gaussian term is normalized + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + dd2=dsqrt(dd1) + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0)*ratiocd + c=ratiocd*dd1**1.75d0 + ! endif + do k=0,0 + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + do i=0,0 + ! lz=0 + distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/-2 + distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d + end do + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + if(typec.ne.1) then + fun0=distp(0,1) + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + fun=-dd1*distp(0,1)*(2.d0+rp2)/rp3 + ! the second derivative + fun2=dd1*distp(0,1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**2)/rp3**2 + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp + ! derivative of 37 with respect to z +case (24) + !c 4p without cusp condition + !c r^2 e^{-z1 r } + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=dsqrt((2.d0*dd1)**9/120960.d0/pi)/2.d0 + c=dd1**4.5d0*0.01835308852470193d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + end do + do i=0,0 + distp(i,3)=r(i)**2*distp(i,1) + end do + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,3) + end do + ! endif + end do + if(typec.ne.1) then + fun0=distp(0,3) + fun=(2.d0*r(0)-dd1*r(0)**2)*distp(0,1) + fun2=((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))*distp(0,1) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun/r(0) + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun/r(0)+fun2) + ! endif + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp + ! 4p double zeta +case (5) + ! normalized + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + do k=0,0 + distp(k,1)=dexp(-dd1*r(k)) + end do + ! if(iflagnorm.gt.2) then + ! c=dd1**2.5d0/dsqrt(3.d0*pi) + c=dd1**2.5d0*0.32573500793527994772d0 + ! endif + do i=0,0 + z(indorbp,i)=c*r(i)*distp(i,1) + end do + if(typec.ne.1) then + fun=distp(0,1)*(1.d0-dd1*r(0)) + fun2=distp(0,1)*(dd1**2*r(0)-2.d0*dd1) + do i=1,3 + z(indorbp,indt+i)=c*fun*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=c*2.d0*fun/r(0)+c*fun2 + end if + indorb=indorbp + ! endif + indpar=indpar+1 + indshell=indshellp + ! 2s double Z NO CUSP +case (88) + ! g single gaussian orbital + ! R(r)= exp(-alpha r^2) + ! normalized + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + dd2=dsqrt(dd1) + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=16.d0/dsqrt(105.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(11.d0/4.d0)*ratiocg + c=dd1**2.75d0*ratiocg + ! endif + do k=0,0 + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + do i=0,0 + distp(i,2)=cost1g*(35.d0*rmu(3,i)**4 & + -30.d0*rmu(3,i)**2*r(i)**2+3.d0*r(i)**4) + ! lz=0 + distp(i,3)=cost2g*rmu(1,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2g*rmu(2,i)*rmu(3,i) & + *(7.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3g*(rmu(1,i)**2-rmu(2,i)**2) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,6)=cost3g*2.d0*rmu(1,i)*rmu(2,i) & + *(7.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-2 + distp(i,7)=cost4g*rmu(1,i)*rmu(3,i) & + *(rmu(1,i)**2-3.0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4g*rmu(2,i)*rmu(3,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + distp(i,9)=cost5g*(rmu(1,i)**4 & + -6.d0*rmu(1,i)**2*rmu(2,i)**2+rmu(2,i)**4) + ! lz=+/-4 + distp(i,10)=cost5g*4.d0*rmu(1,i)*rmu(2,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-4 + end do + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + if(typec.ne.1) then + fun0=distp(0,1) + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + fun=-dd1*distp(0,1)*(2.d0+rp2)/rp3 + ! the second derivative + fun2=dd1*distp(0,1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**2)/rp3**2 + ! indorbp=indorb + do ic=1,9 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun + if(ic.eq.1) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(1,0)*rmu(3,0)**2+12.d0*rmu(1,0)*r(0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(-60.d0*rmu(2,0)*rmu(3,0)**2+12.d0*rmu(2,0)*r(0)**2) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost1g*fun0*(80.d0*rmu(3,0)**3-48.d0*rmu(3,0)*r(0)**2) + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-9.d0*rmu(1,0)**2*rmu(3,0)-3.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(1,0)**2*rmu(3,0)-9.d0*rmu(2,0)**2*rmu(3,0)+4.d0*rmu(3,0)**3) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost2g*fun0*(-3.d0*rmu(2,0)*(rmu(1,0)**2+rmu(2,0)**2-4.d0*rmu(3,0)**2)) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(4.d0*(rmu(2,0)**3-3.d0*rmu(2,0)*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(12.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0)) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(2,0)*(3.d0*rmu(1,0)**2+rmu(2,0)**2-6.d0*rmu(3,0)**2)) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*(-2.d0*rmu(1,0)*(rmu(1,0)**2+3.d0*rmu(2,0)**2-6.d0*rmu(3,0)**2)) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost3g*fun0*24.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + -cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + elseif(ic.eq.7) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*6.d0*rmu(1,0)*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*3.d0*(rmu(1,0)**2-rmu(2,0)**2)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost4g*fun0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + end if + elseif(ic.eq.8) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(2,0)**3-3.d0*rmu(1,0)**2*rmu(2,0)) + end if + elseif(ic.eq.9) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(3.d0*rmu(1,0)**2*rmu(2,0)-rmu(2,0)**3) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i) & + +cost5g*fun0*4.d0*(rmu(1,0)**3-3.d0*rmu(1,0)*rmu(2,0)**2) + end if + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(10.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+9 + indorb=indorbp +case (2100:2199) +! p gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative 1100 +npower=iopt+1-2100 ! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=-rmu(ic,i)*distp(i,1)*r(i)**3 - enddo -! endif - enddo - if(typec.ne.1) then - fun0=-distp(0,1)*r(0)**3 - cost=dd2*r(0)**2 - fun=distp(0,1)*(-3.d0+2.d0*cost)*r(0) - fun2=-2.d0*distp(0,1)*r(0)*(3.d0-7.d0*cost+2.d0*cost**2) -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & - & fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0) & - & *(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(152) +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=-r(k)**(2*npower)*dexp(-dd2*r(k)**2) +end do +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif +end do +if(typec.ne.1) then + rp1=r(0)**2 + fun0=distp(0,1) + fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 + fun2=(npower*(2.d0*npower-1.d0)- & + (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & + distp(0,1)*2.d0/rp1 + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)*fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (72) + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + ! if(iflagnorm.gt.2) then + ! overall normalization obtained by Mathematica + c=dd1**3.25d0*0.79296269381073167718d0 + ! C= dd1^13/4 /Sqrt[Integrate[x^12 Exp[-2 x^2],{x,0,Infinity}]] + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do i=0,0 + do k=1,5 + zv(k)=rmu(3,i)**k + yv(k)=rmu(2,i)**k + xv(k)=rmu(1,i)**k + end do + r2=xv(2)+yv(2)+zv(2) + r4=r2*r2 + ! lz=0 + distp(i,2)=cost1h*(63.d0*zv(5)-70.d0*zv(3)*r2+15.d0*zv(1)*r4) + cost=(21.d0*zv(4)-14.d0*zv(2)*r2+r4) + ! lz=+/-1 + distp(i,3)=cost2h*rmu(1,i)*cost + ! lz=+/-1 + distp(i,4)=cost2h*rmu(2,i)*cost + cost=3.d0*zv(3)-zv(1)*r2 + ! lz=+/-2 + distp(i,5)=cost3h*(xv(2)-yv(2))*cost + ! lz=+/-2 + distp(i,6)=2.d0*cost3h*xv(1)*yv(1)*cost + cost=9.d0*zv(2)-r2 + ! lz=+/-3 + distp(i,7)=cost4h*(xv(3)-3.d0*xv(1)*yv(2))*cost + ! lz=+/-3 + distp(i,8)=-cost4h*(yv(3)-3.d0*yv(1)*xv(2))*cost + ! lz=+/-4 + distp(i,9)=cost5h*(xv(4)-6.d0*xv(2)*yv(2)+yv(4))*zv(1) + ! lz=+/-4 + distp(i,10)=cost5h*4.d0*(xv(3)*yv(1)-yv(3)*xv(1))*zv(1) + ! lz=+/-5 + distp(i,11)=cost6h*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4)) + ! lz=+/-5 + distp(i,12)=-cost6h*(-5.d0*xv(4)*yv(1)+10.d0*xv(2)*yv(3)-yv(5)) + end do + do ic=1,11 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + if(typec.ne.1) then + dd1=dd(indparp) + fun0=distp(0,1) + fun=-2.d0*dd1*distp(0,1) + fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + do k=1,5 + zv(k)=rmu(3,0)**k + yv(k)=rmu(2,0)**k + xv(k)=rmu(1,0)**k + end do + r2=xv(2)+yv(2)+zv(2) + r4=r2*r2 + ! indorbp=indorb + do ic=1,11 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun + end do + if(ic.eq.1) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost1h*fun0*20.d0*xv(1)*zv(1)*(3.d0*xv(2)+3.d0*yv(2)-4.d0*zv(2)) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost1h*fun0*20.d0*yv(1)*zv(1)*(3.d0*xv(2)+3.d0*yv(2)-4.d0*zv(2)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost1h*fun0*(175.d0*zv(4)-150.d0*zv(2)*r2+15.d0*r4) + elseif(ic.eq.2) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost2h*fun0*(5.d0*xv(4)+6.d0*xv(2)*yv(2)+yv(4)-36.d0*xv(2)*zv(2)& + -12.d0*yv(2)*zv(2)+8.d0*zv(4)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost2h*fun0*(4.d0*xv(3)*yv(1)+4.d0*xv(1)*yv(3)-24.d0*xv(1)*yv(1)*zv(2)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost2h*fun0*(-24.d0*xv(3)*zv(1)-24.d0*xv(1)*yv(2)*zv(1)+32.d0*zv(3)*xv(1)) + elseif(ic.eq.3) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost2h*fun0*(-4.d0*xv(3)*yv(1)-4.d0*xv(1)*yv(3)+24.d0*xv(1)*yv(1)*zv(2)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost2h*fun0*(5.d0*yv(4)+6.d0*xv(2)*yv(2)+xv(4)-36.d0*yv(2)*zv(2)& + -12.d0*xv(2)*zv(2)+8.d0*zv(4)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost2h*fun0*(-24.d0*yv(3)*zv(1)-24.d0*yv(1)*xv(2)*zv(1) & + +32.d0*zv(3)*yv(1)) + elseif(ic.eq.4) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost3h*fun0*(-4.d0*xv(3)*zv(1)+4.d0*xv(1)*zv(3)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost3h*fun0*(4.d0*yv(3)*zv(1)-4.d0*yv(1)*zv(3)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost3h*fun0*(-xv(4)+yv(4)+6.d0*xv(2)*zv(2)-6.d0*yv(2)*zv(2)) + elseif(ic.eq.5) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost3h*fun0*(6.d0*xv(2)*yv(1)*zv(1)+2.d0*yv(3)*zv(1)-4.d0*yv(1)*zv(3)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost3h*fun0*(2.d0*xv(3)*zv(1)+6.d0*xv(1)*yv(2)*zv(1)-4.d0*xv(1)*zv(3)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + -cost3h*fun0*(2.d0*xv(3)*yv(1)+2.d0*xv(1)*yv(3)-12.d0*xv(1)*yv(1)*zv(2)) + elseif(ic.eq.6) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost4h*fun0*(-5.d0*xv(4)+6.d0*xv(2)*yv(2)+3.d0*yv(4)+24.d0*xv(2)*zv(2)-24.d0*yv(2)*zv(2)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost4h*fun0*(4.d0*xv(3)*yv(1)+12.d0*xv(1)*yv(3)-48.d0*xv(1)*yv(1)*zv(2)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost4h*fun0*(16.d0*xv(3)*zv(1)-48.d0*xv(1)*yv(2)*zv(1)) + elseif(ic.eq.7) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost4h*fun0*(12.d0*xv(3)*yv(1)+4.d0*xv(1)*yv(3)-48.d0*xv(1)*yv(1)*zv(2)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost4h*fun0*(3.d0*xv(4)+6.d0*xv(2)*yv(2)-5.d0*yv(4)-24.d0*xv(2)*zv(2)+24.d0*yv(2)*zv(2)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + -cost4h*fun0*(-48.d0*xv(2)*yv(1)*zv(1)+16.d0*yv(3)*zv(1)) + elseif(ic.eq.8) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost5h*fun0*(4.d0*xv(3)*zv(1)-12.d0*xv(1)*yv(2)*zv(1)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost5h*fun0*(-12.d0*xv(2)*yv(1)*zv(1)+4.d0*yv(3)*zv(1)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost5h*fun0*(xv(4)-6.d0*xv(2)*yv(2)+yv(4)) + elseif(ic.eq.9) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost5h*fun0*(-12.d0*xv(2)*yv(1)*zv(1)+4.d0*yv(3)*zv(1)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost5h*fun0*(-4.d0*xv(3)*zv(1)+12.d0*xv(1)*yv(2)*zv(1)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + -cost5h*fun0*(-4.d0*xv(3)*yv(1)+4.d0*xv(1)*yv(3)) + elseif(ic.eq.10) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost6h*fun0*(5.d0*xv(4)-30.d0*xv(2)*yv(2)+5.d0*yv(4)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost6h*fun0*(-20.d0*xv(3)*yv(1)+20.d0*xv(1)*yv(3)) + elseif(ic.eq.11) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost6h*fun0*(-20.d0*xv(3)*yv(1)+20.d0*xv(1)*yv(3)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost6h*fun0*(-5.d0*xv(4)+30.d0*xv(2)*yv(2)-5.d0*yv(4)) + end if + z(indorbp,indt+4)=distp(0,1+ic)*(12.d0*fun+fun2) + !endif for iocc + ! endif + end do ! enddo fot ic + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+11 + indorb=indorbp + ! 2s gaussian for pseudo +case (152) ! 2s with cusp condition ! ( r^3*exp(-dd2*r^2)) ! with no cusp condition - dd2=dd(indpar+1) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)**2)*r(k) - enddo +dd2=dd(indpar+1) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)**2)*r(k) +end do ! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1)*r(i)**2 - enddo -! endif - if(typec.ne.1) then - rp1=r(0)**2*dd2 - fun=(3.d0-2.d0*rp1)*distp(0,1) - fun2=(6.d0-14.d0*rp1+4.d0*rp1**2)*distp(0,1) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - !endif for indt - endif - indpar=indpar+1 - indshell=indshellp - indorb=indorbp - case(153) +do i=0,0 + z(indorbp,i)=distp(i,1)*r(i)**2 +end do +! endif +if(typec.ne.1) then + rp1=r(0)**2*dd2 + fun=(3.d0-2.d0*rp1)*distp(0,1) + fun2=(6.d0-14.d0*rp1+4.d0*rp1**2)*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if +indpar=indpar+1 +indshell=indshellp +indorb=indorbp +case (126) +! 2s double exp with constant +! (dd3+ exp (-dd2 r)+dd4*exp(-dd5*r)) +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) +dd5=dd(indpar+4) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)) + distp(k,2)=dexp(-dd5*r(k)) +end do +! if(iocc(indshellp).eq.1) then +do i=0,0 + z(indorbp,i)=distp(i,1)+dd3+dd4*distp(i,2) +! write(6,*) ' function inside = ',z(indorbp,i) +end do +! endif +if(typec.ne.1) then + fun=-(dd2*distp(0,1)+dd5*dd4*distp(0,2))/r(0) + fun2=dd2**2*distp(0,1)+dd4*dd5**2*distp(0,2) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if +indpar=indpar+4 +indshell=indshellp +indorb=indorbp +case (153) ! 2s with cusp condition ! (-r^5*exp(-dd2*r^2)) ! derivative of 152 - dd2=dd(indpar+1) - indorbp=indorb+1 - indshellp=indshell+1 - do k=0,0 - distp(k,1)=dexp(-dd2*r(k)**2)*r(k)**3 - enddo +dd2=dd(indpar+1) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)**2)*r(k)**3 +end do ! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=-distp(i,1)*r(i)**2 - enddo -! endif - if(typec.ne.1) then - rp1=dd2*r(0)**2 - fun=(-5.d0+2.d0*rp1)*distp(0,1) - fun2=(-20.d0+22.d0*rp1-4.d0*rp1**2)*distp(0,1) - do i=1,3 - z(indorbp,indt+i)=fun*rmu(i,0) - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 - !endif for indt - endif - indpar=indpar+1 - indshell=indshellp - indorb=indorbp - case(154) -! Jastrow single gaussian f orbital -! R(r)= exp(-alpha r^2) -! unnormalized +do i=0,0 + z(indorbp,i)=-distp(i,1)*r(i)**2 +end do +! endif +if(typec.ne.1) then + rp1=dd2*r(0)**2 + fun=(-5.d0+2.d0*rp1)*distp(0,1) + fun2=(-20.d0+22.d0*rp1-4.d0*rp1**2)*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if +indpar=indpar+1 +indshell=indshellp +indorb=indorbp +case (121) +! 2p single exponential +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)) +end do ! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)**2) - enddo - do i=0,0 - distp(i,2)=cost1f*rmu(3,i) & - & *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=0 - distp(i,3)=cost2f*rmu(1,i) & - & *(5.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-1 - distp(i,4)=cost2f*rmu(2,i) & - & *(5.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-1 - distp(i,5)=cost3f*rmu(3,i) & - & *(rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-2 - distp(i,6)=cost3f*2.d0*rmu(3,i) & - & *rmu(1,i)*rmu(2,i) - ! lz=+/-2 - distp(i,7)=cost4f*rmu(1,i) & - & *(rmu(1,i)**2-3.d0*rmu(2,i)**2) - ! lz=+/-3 - distp(i,8)=cost4f*rmu(2,i) & - & *(3.d0*rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-3 - enddo - do ic=1,7 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=distp(k,1)*distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then -! dd1=dd(indparp) - fun0=distp(0,1) - fun=-2.d0*dd1*distp(0,1) - fun2=fun*(1.d0-2.d0*dd1*r(0)**2) -! indorbp=indorb - do ic=1,7 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - enddo - if(ic.eq.1) then - z(indorbp,indt+1)=z(indorbp,indt+1)- & - & 6.d0*cost1f*fun0*rmu(1,0)*rmu(3,0) - z(indorbp,indt+2)=z(indorbp,indt+2)- & - & 6.d0*cost1f*fun0*rmu(2,0)*rmu(3,0) - z(indorbp,indt+3)=z(indorbp,indt+3)+ & - & cost1f*fun0*(9.d0*rmu(3,0)**2-3.d0*r(0)**2) - elseif(ic.eq.2) then - z(indorbp,indt+1)=z(indorbp,indt+1)+ & - &cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2-2.d0*rmu(1,0)**2) - z(indorbp,indt+2)=z(indorbp,indt+2)- & - & 2.d0*cost2f*fun0*rmu(2,0)*rmu(1,0) - z(indorbp,indt+3)=z(indorbp,indt+3)+ & - & 8.d0*cost2f*fun0*rmu(3,0)*rmu(1,0) - elseif(ic.eq.3) then - z(indorbp,indt+1)=z(indorbp,indt+1)- & - & 2.d0*cost2f*fun0*rmu(1,0)*rmu(2,0) - z(indorbp,indt+2)=z(indorbp,indt+2)+ & -&cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2-2.d0*rmu(2,0)**2) - z(indorbp,indt+3)=z(indorbp,indt+3)+ & - & 8.d0*cost2f*fun0*rmu(3,0)*rmu(2,0) - elseif(ic.eq.4) then - z(indorbp,indt+1)=z(indorbp,indt+1)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) - z(indorbp,indt+2)=z(indorbp,indt+2)- & - & 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) - z(indorbp,indt+3)=z(indorbp,indt+3)+ & - & cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - elseif(ic.eq.5) then - z(indorbp,indt+1)=z(indorbp,indt+1)+ & - & 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) - z(indorbp,indt+2)=z(indorbp,indt+2)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) - z(indorbp,indt+3)=z(indorbp,indt+3)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) - elseif(ic.eq.6) then - z(indorbp,indt+1)=z(indorbp,indt+1)+ & - & 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - z(indorbp,indt+2)=z(indorbp,indt+2)- & - & 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) - else - z(indorbp,indt+1)=z(indorbp,indt+1)+ & - & 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) - z(indorbp,indt+2)=z(indorbp,indt+2)+ & - & 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - endif - z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+7 - indorb=indorbp - case(155) -! Jastrow single gaussian f orbital -! derivative of 154 with respect to z -! unnormalized f orbitals -! R(r)= -r^2*exp(-z r^2) +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1) + fun=-dd2*distp(0,1)/r(0) + fun2=dd2**2*distp(0,1) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (149) +! derivative of 131 with respect z_1 +! - r^4 exp(-z_1 r^2) +dd2=dd(indpar+1) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)*r(k)) +end do +! if(iocc(indshellp).eq.1) then +do i=0,0 + z(indorbp,i)=-distp(i,1)*r(i)**4 +end do +! endif +if(typec.ne.1) then + fun0=dd2*r(0)**2 + fun=-2.d0*r(0)**2*distp(0,1)*(2.d0-fun0) + fun2=-2.d0*r(0)**2*distp(0,1)*(6.d0-9.d0*fun0+2.d0*fun0**2) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if +indpar=indpar+1 +indshell=indshellp +indorb=indorbp +case (147) +! 3d single gaussian +dd1=dd(indpar+1) +do k=0,0 + distp(k,1)=dexp(-dd1*r(k)**2) +end do +do i=0,0 + distp(i,3)=distp(i,1) + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d +end do +! indorbp=indorb +do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,3) + fun=-2.d0*dd1*distp(0,1) + fun2=((2.d0*dd1*r(0))**2-2.d0*dd1)*distp(0,1) + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0)*fun + end do + if(ic.eq.1) then + ! if(i.ne.3) then + z(indorbp,indt+1)=z(indorbp,indt+1)- & + 2.d0*rmu(1,0)*fun0*cost1d + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 2.d0*rmu(2,0)*fun0*cost1d + ! else + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + 4.d0*rmu(3,0)*fun0*cost1d + ! endif + elseif(ic.eq.2) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + 2.d0*rmu(1,0)*fun0*cost2d + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2)- & + 2.d0*rmu(2,0)*fun0*cost2d + ! endif + elseif(ic.eq.3) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + rmu(2,0)*fun0*cost3d + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + rmu(1,0)*fun0*cost3d + ! endif + elseif(ic.eq.4) then + ! if(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2)+ & + rmu(3,0)*fun0*cost3d + ! elseif(i.eq.3) then + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + rmu(2,0)*fun0*cost3d + ! endif + elseif(ic.eq.5) then + ! if(i.eq.1) then + z(indorbp,indt+1)=z(indorbp,indt+1)+ & + rmu(3,0)*fun0*cost3d + ! elseif(i.eq.3) then + z(indorbp,indt+3)=z(indorbp,indt+3)+ & + rmu(1,0)*fun0*cost3d + !endif for i + ! endif + !endif for ic + end if + !enddo for i + ! enddo + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt +end if +! +indpar=indpar+1 +indshell=indshell+5 +indorb=indorbp +case (134) +! 2p single exponential r^3 e^{-z r} ! +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)) +end do ! indorbp=indorb - indparp=indpar+1 - dd1=dd(indparp) - do k=0,0 - distp(k,1)=dexp(-dd1*r(k)**2) - enddo - do i=0,0 - distp(i,2)=cost1f*rmu(3,i) & - & *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) - ! lz=0 - distp(i,3)=cost2f*rmu(1,i) & - & *(5.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-1 - distp(i,4)=cost2f*rmu(2,i) & - & *(5.d0*rmu(3,i)**2-r(i)**2) - ! lz=+/-1 - distp(i,5)=cost3f*rmu(3,i) & - & *(rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-2 - distp(i,6)=cost3f*2.d0*rmu(3,i) & - & *rmu(1,i)*rmu(2,i) - ! lz=+/-2 - distp(i,7)=cost4f*rmu(1,i) & - & *(rmu(1,i)**2-3.d0*rmu(2,i)**2) - ! lz=+/-3 - distp(i,8)=cost4f*rmu(2,i) & - & *(3.d0*rmu(1,i)**2-rmu(2,i)**2) - ! lz=+/-3 - enddo - do ic=1,7 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do k=0,0 - z(indorbp,k)=-r(k)**2*distp(k,1)*distp(k,1+ic) - enddo -! endif - enddo - if(typec.ne.1) then - dd1=dd(indparp) - fun0=-r(0)**2*distp(0,1) - fun=2.d0*(dd1*r(0)**2-1.d0)*distp(0,1) - fun2=-2.d0*(2.d0*dd1**2*r(0)**4+1.d0 & - & -5.d0*dd1*r(0)**2)*distp(0,1) -! indorbp=indorb - do ic=1,7 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - if(ic.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) - if(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) - endif - elseif(ic.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) - endif - elseif(ic.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) - endif - elseif(ic.eq.4) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) - endif - elseif(ic.eq.6) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) - endif - else - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) - endif - !endif for ic - endif - !enddo for i - enddo +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i)**3 + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1)*r(0)**3 + fun=distp(0,1)*(3.d0-dd2*r(0))*r(0) + ! fun= derivative of fun0 respect to r divided dy r + fun2=distp(0,1)*(dd2**2*r(0)**3-6*dd2*r(0)**2 & + +6*r(0)) + ! fun2= second derivative of fun0 respect to r + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (146) +! 2p single exponential -r^2 e^{-z r^2} ! derivative of 103 +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)*r(k)) +end do +! indorbp=indorb +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=-rmu(ic,i)*distp(i,1)*r(i)*r(i) + end do + ! endif +end do +if(typec.ne.1) then + rp2=dd2*r(0)*r(0) + fun0=-distp(0,1)*r(0)*r(0) + fun=distp(0,1)*(-2.d0+2.d0*rp2) + fun2=(-2.d0+10.d0*rp2-4.d0*rp2*rp2)*distp(0,1) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (25) + ! 4p without cusp condition + ! r^2 ( e^{-z2 r } + z1 e^{-z3 r } ) + dd1=dd(indpar+1) + dd2=dd(indpar+2) + dd3=dd(indpar+3) + ! if(iflagnorm.gt.2) then + c=1.d0/2.d0/dsqrt(120960.d0*pi*(1.d0/(2.d0*dd1)**9 & + +2.d0*dd3/(dd1+dd2)**9+dd3**2/(2.d0*dd2)**9)) + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + end do + do i=0,0 + distp(i,3)=r(i)**2*(distp(i,1)+dd3*distp(i,2)) + end do + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,3) + end do + ! endif + end do + if(typec.ne.1) then + fun0=distp(0,3) + fun=(2.d0*r(0)-dd1*r(0)**2)*distp(0,1) & + +dd3*(2.d0*r(0)-dd2*r(0)**2)*distp(0,2) + fun2=((dd1*r(0))**2+2.d0-4.d0*dd1*r(0))*distp(0,1) & + +dd3*((dd2*r(0))**2+2.d0-4.d0*dd2*r(0))*distp(0,2) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun/r(0) + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun/r(0)+fun2) + ! endif + end do + !endif for indt + end if + indpar=indpar+3 + indshell=indshell+3 + indorb=indorbp + ! 2p triple zeta +case (32) + ! 3d without cusp condition triple Z + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + dd3=dd(indpar+4) + peff2=dd(indpar+5) + ! if(iflagnorm.gt.2) then + c=1/2.d0*dsqrt(5.d0/pi) & + /dsqrt(1/(2.d0*dd1)**7+2*peff/(dd1+dd2)**7 & + +peff**2/(2.d0*dd2)**7+2*peff2/(dd1+dd3)**7 & + +peff2**2/(2.d0*dd3)**7+2*peff*peff2/(dd2+dd3)**7)/dsqrt(720.d0) + ! endif + do k=0,0 + distp(k,1)=dexp(-dd1*r(k)) + distp(k,2)=dexp(-dd2*r(k)) + distp(k,3)=dexp(-dd3*r(k)) + end do + do i=0,0 + distp(i,4)=c*(distp(i,1)+peff*distp(i,2)+peff2*distp(i,3)) + !lz=0 + distp(i,5)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + !lz=+/-2 + distp(i,6)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/- 2 + distp(i,7)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,8)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,9)=rmu(1,i)*rmu(3,i)*cost3d + end do + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=distp(i,4+ic)*distp(i,4) + end do + ! endif + end do + if(typec.ne.1) then + fun0=distp(0,4) + fun=c*(-dd1*distp(0,1)-peff*dd2*distp(0,2) & + -peff2*dd3*distp(0,3)) + fun2=c*(dd1**2*distp(0,1)+peff*dd2**2*distp(0,2) & + +peff2*dd3**2*distp(0,3)) + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,4+ic)*rmu(i,0)*fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,4+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+5 + indshell=indshell+5 + indorb=indorbp +case (145) +! 2s without cusp condition !derivative 100 +! -(r^2*exp(-dd2*r^2)) +dd2=dd(indpar+1) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)*r(k)) +end do +! if(iocc(indshellp).eq.1) then +do i=0,0 + z(indorbp,i)=-distp(i,1)*r(i)**2 +end do +! endif +if(typec.ne.1) then + fun0=dd2*r(0)**2 + fun=-2.d0*distp(0,1)*(1.d0-fun0) + fun2=-2.d0*distp(0,1)*(1.d0-5.d0*fun0+2.d0*fun0**2) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if +indpar=indpar+1 +indshell=indshellp +indorb=indorbp +case (21) + ! 2p without cusp condition + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + c=0.5d0/dsqrt(8.d0*pi*(1.d0/(2.d0*dd1)**5 & + +2.d0*peff/(dd1+dd2)**5+peff**2/(2.d0*dd2)**5)) + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + end do + do i=0,0 + distp(i,3)=distp(i,1)+peff*distp(i,2) + end do + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,3) + end do + ! endif + end do + if(typec.ne.1) then + fun=(-dd1*distp(0,1)-dd2*peff*distp(0,2))/r(0) + fun2=dd1**2*distp(0,1)+peff*dd2**2*distp(0,2) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)*fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+distp(0,3) + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + ! endif + end do + !endif for indt + end if + indpar=indpar+3 + indshell=indshell+3 + indorb=indorbp + ! 3p single zeta +case (108) +! 2s double lorentian with constant parent of 102 +! (dd3+ L(dd2 r^2)+dd4*L(dd5*r^2)) ; L(x)=1/1+x^2 +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) +dd5=dd(indpar+4) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=1.d0/(1.d0+dd2*r(k)*r(k)) + distp(k,2)=1.d0/(1.d0+dd5*r(k)*r(k)) +end do +! if(iocc(indshellp).eq.1) then +do i=0,0 + z(indorbp,i)=(distp(i,1)+dd3+dd4*distp(i,2)) +! write(6,*) ' function inside = ',z(indorbp,i) +end do +! endif +if(typec.ne.1) then + fun=-2.d0*(dd2*distp(0,1)**2+dd5*dd4*distp(0,2)**2) + fun2=2.d0*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) & + +2.d0*dd5*dd4*distp(0,2)**3*(-1.d0+3.d0*dd5*r(0)**2) + ! write(6,*) ' fun inside = ',fun,fun2 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=fun2+2.d0*fun + ! write(6,*) ' lap 106 =',z(indorbp,indt+4) + !endif for indt +end if +indpar=indpar+4 +indshell=indshellp +indorb=indorbp +case (131) +! 2s without cusp condition +! dd1*(r^2*exp(-dd2*r^2)) +dd2=dd(indpar+1) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)*r(k)) +end do +! if(iocc(indshellp).eq.1) then +do i=0,0 + z(indorbp,i)=distp(i,1)*r(i)**2 +end do +! endif +if(typec.ne.1) then + fun0=dd2*r(0)**2 + fun=2.d0*distp(0,1)*(1.d0-fun0) + fun2=2.d0*distp(0,1)*(1.d0-5.d0*fun0+2.d0*fun0**2) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if +indpar=indpar+1 +indshell=indshellp +indorb=indorbp +case (133) +! 4d one parmater +dd1=dd(indpar+1) +do k=0,0 + distp(k,1)=dexp(-dd1*r(k)) +end do +do i=0,0 + distp(i,3)=distp(i,1)*r(i) + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d +end do +! indorbp=indorb +do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,3) + fun=(1.d0-dd1*r(0))*distp(0,1) + fun2=dd1*(dd1*r(0)-2.d0)*distp(0,1) + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt +end if +! +indpar=indpar+1 +indshell=indshell+5 +indorb=indorbp +case (66) + ! derivative of 57 (orbital 1s STO regolarized for r->0) + ! dR(r)/dz with R(r)= C(z) * P(z*r) * exp(-z*r) + ! P(x) = (x+a)^n/(1+(x+a)^n) with a so that P(0)==dP(0)/dx + ! C(z) = const * z^(3/2) normalization + ! the following definitions are in module constants + ! n -> costSTO1s_n = 4 + ! a -> costSTO1s_a = 1.2263393530877080588 + ! const(n) -> costSTO1s_c = 0.58542132302621750732 + ! + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! if(dd1.gt.0.) then + c=costSTO1s_c*dd1**1.5d0 + ! else + ! c=1.d0 + ! endif + ! endif + do i=0,0 + distp(i,1)=c*dexp(-dd1*r(i)) + end do + do i=0,0 + rp1=dd1*r(i)+costSTO1s_a + rp4=rp1**costSTO1s_n + z(indorbp,i)=distp(i,1)*rp4/(1.d0+rp4)* & + (1.5d0/dd1 + r(i)* & + (-1.d0+(costSTO1s_n)/(rp1*(1.d0+rp4)))) + end do + if(typec.ne.1) then + rp1=dd1*r(0)+costSTO1s_a + rp2=rp1**2 + rp4=rp1**costSTO1s_n + rp6=rp4**2 + ! the first derivative /r + fun=distp(0,1)*(dd1*rp4*(-2.d0*costSTO1s_a*(costSTO1s_n**2* & + (-1.d0+rp4)+costSTO1s_n*(1.d0+2.d0*rp1)*(1.d0+rp4)-rp2* & + (1.d0+rp4)**2) +rp1*(2*costSTO1s_n**2*(-1+rp4)+costSTO1s_n & + *(-3.d0+4.d0*rp1)*(1.d0+rp4)-rp1*(-5.d0+2.d0*rp1)*(1.d0+ & + rp4)**2)))/(2.d0*rp2*(costSTO1s_a-rp1)*(1.d0+rp4)**3) + ! fun=+distp(0,1)*rp4/(1.d0+rp4)*(1.5d0/dd1 + r(0)* & + ! &(-1.d0+(costSTO1s_n)/(rp1*(1.d0+rp4)))) & + ! &*(dd1*(2.d0 + 5.d0/(-dd1*r(0)) + & + ! &(4.d0*costSTO1s_n**2)/(rp2*(1.d0+rp4)**2) + & + ! &(costSTO1s_n*((3.d0 - 2.d0*costSTO1s_n - 4.d0*rp1)*rp1& + ! &+ 2.d0*costSTO1s_a*(1.d0+costSTO1s_n+2.d0*rp1)))/ & + ! &(rp2*(dd1*r(0))*(1 + rp4))))/2.d0 + ! the second derivative derivative + fun2=-distp(0,1)*(dd1*rp4*(rp1*(-(costSTO1s_n*(-3.d0-8.d0*rp1+ & + 6.d0*rp2)*(1.d0+rp4)**2)+rp2*(-7.d0+2.d0*rp1)*(1.d0+rp4)**3- & + costSTO1s_n**2*(-1.d0+6.d0*rp1)*(-1.d0+rp6)-2*costSTO1s_n**3*& + (1.d0+rp4*(-4.d0+rp4))) + 2.d0*costSTO1s_a*(-(rp1*rp2*(1.d0 +& + rp4)**3) + 3.d0*costSTO1s_n**2*(1.d0+rp1)*(-1.d0+rp6)+ & + costSTO1s_n*(1.d0+rp4)**2*(2.d0+3.d0*rp1*(1.d0+rp1)) + & + costSTO1s_n**3*(1.d0+rp4*(-4.d0+rp4)))))/ & + (2.d0*rp1*rp2*(1+rp4)**4) + ! fun2=-distp(0,1)*rp4/(1.d0+rp4)*(1.5d0/dd1 + r(0)*& + ! &(-1.d0+(costSTO1s_n)/(rp1*(1.d0+rp4)))) & + ! &*(dd1*(rp1*(-(costSTO1s_n*(-3 - 8*rp1 & + ! &+ 6*rp2)*(1 + rp4)**2) + rp2*(-7 + 2*rp1)*(1 + rp4)**3 - & + ! &costSTO1s_n**2*(-1 + 6*rp1)*(-1 + rp6) - 2*costSTO1s_n**3* & + ! &(1 + rp4*(-4 + rp4))) - 2*costSTO1s_a*(-(rp1*rp2*(1 + rp4)**3)& + ! &+ 3*costSTO1s_n**2*(1 + rp1)*(-1 + rp6) + costSTO1s_n*(1 + & + ! &rp4)**2 *(2 + 3*rp1*(1 +rp1)) + costSTO1s_n**3*(1 + rp4*(-4 +& + ! &rp4)))))/(2.*rp1*rp2*(1 + rp4)**3) + ! gradient: dR(r)/dr_i=r_i*fun + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + ! laplacian = 2*fun+fun2 + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + indorb=indorbp + ! endif + indpar=indpar+1 + indshell=indshellp +case (57) + ! orbital 1s (no cusp) - STO regolarized for r->0 + ! R(r)= C(z) * P(z*r) * exp(-z*r) + ! P(x) = (x+a)^n/(1+(x+a)^n) with a so that P(0)==dP(0)/dx + ! C(z) = const * z^(3/2) normalization + ! the following definitions are in module constants + ! n -> costSTO1s_n = 4 + ! a -> costSTO1s_a = 1.2263393530877080588 + ! const(n) -> costSTO1s_c = 0.58542132302621750732 + ! + ! + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! if(dd1.gt.0.) then + c=costSTO1s_c*dd1**1.5d0 + ! else + ! c=1.d0 + ! endif + ! endif + do i=0,0 + distp(i,1)=c*dexp(-dd1*r(i)) + end do + do i=0,0 + rp4=(dd1*r(i)+costSTO1s_a)**costSTO1s_n + z(indorbp,i)=distp(i,1)*rp4/(1.d0+rp4) + end do + if(typec.ne.1) then + rp1=dd1*r(0)+costSTO1s_a + rp2=rp1**2 + rp4=rp1**costSTO1s_n + rp6=rp4**2 + ! the first derivative /r + !fun=-z(indorbp,0)*((dd1**2*(-costSTO1s_n+rp1+rp1*rp4))/ & + ! &(rp1*(-costSTO1s_a+rp1)*(1.d0+rp4))) + fun=-distp(0,1)*rp4* & + ((dd1**2*(-costSTO1s_n+rp1+rp1*rp4))/ & + (rp1*(-costSTO1s_a+rp1)*(1.d0+rp4)**2)) + ! the second derivative derivative + fun2=+distp(0,1)*rp4*(dd1**2*(-(costSTO1s_n**2* & + (-1.d0+rp4))-costSTO1s_n*(1.d0+2.d0*rp1)*(1.d0+rp4) & + +rp2*(1.d0+rp4)**2)) / (rp2*(1.d0+rp4)**3) + ! gradient: dR(r)/dr_i=r_i*fun + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + ! laplacian = 2*fun+fun2 + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + indorb=indorbp + ! endif + indpar=indpar+1 + indshell=indshellp +case (123) +! 2p double exp +! dd1 * x_mu (exp(-dd2 r)+dd3 * exp(-dd4*r)) +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)) + distp(k,2)=dexp(-dd4*r(k)) +end do +! indorbp=indorb +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*(distp(i,1)+dd3*distp(i,2)) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1)+dd3*distp(0,2) + fun=-(dd2*distp(0,1)+dd3*dd4*distp(0,2))/r(0) + fun2=dd2**2*distp(0,1)+dd3*dd4**2*distp(0,2) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+3 +indshell=indshell+3 +indorb=indorbp +case (87) + ! f orbitals + ! R(r)= c*exp(-z r^2)*(9/4/z-r^2) + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + dd2=dsqrt(dd1) + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=8.d0/dsqrt(15.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0)*ratiocf + c=dd1**2.25d0*ratiocf + ! endif + do k=0,0 + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + do i=0,0 + distp(i,2)=cost1f*rmu(3,i) & + *(5.d0*rmu(3,i)**2-3.d0*r(i)**2) + ! lz=0 + distp(i,3)=cost2f*rmu(1,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,4)=cost2f*rmu(2,i) & + *(5.d0*rmu(3,i)**2-r(i)**2) + ! lz=+/-1 + distp(i,5)=cost3f*rmu(3,i) & + *(rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-2 + distp(i,6)=cost3f*2.d0*rmu(3,i) & + *rmu(1,i)*rmu(2,i) + ! lz=+/-2 + distp(i,7)=cost4f*rmu(1,i) & + *(rmu(1,i)**2-3.d0*rmu(2,i)**2) + ! lz=+/-3 + distp(i,8)=cost4f*rmu(2,i) & + *(3.d0*rmu(1,i)**2-rmu(2,i)**2) + ! lz=+/-3 + end do + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + cost=(1.d0+0.5d0*dd2*r(k))/(1.d0+dd2*r(k))**2 + z(indorbp,k)=distp(k,1)*(9.d0/4.d0/dd1-r(k)**2*cost)* & + distp(k,1+ic) + end do + ! endif + end do + if(typec.ne.1) then + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + cost=(1.d0+0.5d0*rp2)/rp3 + fun0=distp(0,1)*(9.d0/4.d0/dd1-r(0)**2*cost) + fun=0.25d0*distp(0,1)* & + (-26.d0-59.d0*rp2-36.d0*rp1-3.d0*rp1*rp2+2.d0*rp1**2)/rp3**2 + fun2=0.25d0*distp(0,1)* & + (-26.d0-66.d0*rp2+22.d0*rp1+178.d0*rp1*rp2+165.d0*rp1**2 & + +54.d0*rp1**2*rp2+rp1**3-2.d0*rp1**3*rp2)/rp3**3 + ! indorbp=indorb + do ic=1,7 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost1f*fun0*rmu(i,0)*rmu(3,0) + if(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost1f*fun0*(15.d0*rmu(i,0)**2-3.d0*r(0)**2) + end if + elseif(ic.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(1,0) + end if + elseif(ic.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost2f*fun0*(5.d0*rmu(3,0)**2-r(0)**2) + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 10.d0*cost2f*fun0*rmu(i,0)*rmu(2,0) + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + cost3f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(2,0)*rmu(3,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(3,0) + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*cost3f*fun0*rmu(1,0)*rmu(2,0) + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + end if + else + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 6.d0*cost4f*fun0*rmu(1,0)*rmu(2,0) + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 3.d0*cost4f*fun0*(rmu(1,0)**2-rmu(2,0)**2) + end if + !endif for ic + end if + !enddo for i + end do z(indorbp,indt+4)=distp(0,1+ic)*(8.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+7 - indorb=indorbp - case(199) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+7 + indorb=indorbp +case (47) + ! d orbitals cartesian !!! + ! R(r)= exp(-alpha r^2) + ! each gaussian term is normalized + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + ! if(iflagnorm.gt.2) then + ! overall normalization + c=dd1**1.75d0*1.64592278064948967213d0 + ! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do i=0,0 + distp(i,2)=rmu(1,i)**2 + distp(i,3)=rmu(2,i)**2 + distp(i,4)=rmu(3,i)**2 + ! lz=+/-2 + distp(i,5)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,6)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,7)=rmu(1,i)*rmu(3,i)*cost3d + end do + do ic=1,6 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + if(typec.ne.1) then + dd1=dd(indparp) + fun0=distp(0,1) + fun=-2.d0*dd1*distp(0,1) + fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + ! indorbp=indorb + do ic=1,6 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.le.3) then + if(i.eq.ic) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0 + end if + elseif(ic.eq.4) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.6) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + if(ic.le.3) then + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2)+2.d0*distp(0,1) + else + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + end if + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+6 + indorb=indorbp +case (104) +! 2p double gaussian +! dd1 * x_mu (exp(-dd2 r^2)+dd3 * exp(-dd4*r^2)) +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)**2) + distp(k,2)=dexp(-dd4*r(k)**2) +end do +! indorbp=indorb +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*(distp(i,1)+dd3*distp(i,2)) + end do + ! endif +end do +if(typec.ne.1) then + fun0=(distp(0,1)+dd3*distp(0,2)) + fun=2.d0*(-dd2*distp(0,1) & + -dd4*dd3*distp(0,2)) + fun2=2.d0*(dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0,1) & + +dd4*dd3*(-1.d0+2.d0*dd4*r(0)**2)*distp(0,2)) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+3 +indshell=indshell+3 +indorb=indorbp +case (199) ! derivative of 200 LA COSTANTE - indorbp=indorb+1 - indshellp=indshell+1 -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=0.d0 - enddo -! endif - if(typec.ne.1) then - do i=1,3 - z(indorbp,indt+i)=0.d0 - enddo - z(indorbp,indt+4)=0 - !endif for indt - endif - indshell=indshellp - indorb=indorbp - case(200) -! THE COSTANT - indorbp=indorb+1 - indshellp=indshell+1 +indorbp=indorb+1 +indshellp=indshell+1 ! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=1.d0 - enddo -! endif - if(typec.ne.1) then - do i=1,3 - z(indorbp,indt+i)=0 - enddo - z(indorbp,indt+4)=0 - !endif for indt - endif - indshell=indshellp - indorb=indorbp - case(1000:1099) -! s gaussian r**(2*npower)*exp(-alpha*r**2) - npower=iopt-1000 - indorbp=indorb+1 - indshellp=indshell+1 - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=r(k)**(2*npower)*dexp(-dd2*r(k)**2) - enddo -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1) - enddo -! endif - if(typec.ne.1) then - rp1=r(0)**2 - fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 - fun2=(npower*(2.d0*npower-1.d0)- & - & (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & - & distp(0,1)*2.d0/rp1 +do i=0,0 + z(indorbp,i)=0.d0 +end do +! endif +if(typec.ne.1) then + do i=1,3 + z(indorbp,indt+i)=0.d0 + end do + z(indorbp,indt+4)=0 + !endif for indt +end if +indshell=indshellp +indorb=indorbp +case (11) + ! R(r)=r**2*(exp(-z1*r)+p*exp(-z2*r)) + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + ! if(iflagnorm.gt.2) then + c=1.d0/2.d0/dsqrt(pi*720.d0*(1.d0/(2.d0*dd1)**7+ & + 2.d0*peff/(dd1+dd2)**7+peff**2/(2.d0*dd2)**7)) + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + distp(k,2)=c*dexp(-dd2*r(k)) + end do + do i=0,0 + z(indorbp,i)=(distp(i,1)+peff*distp(i,2))*r(i)**2 + end do + if(typec.ne.1) then + rp1=r(0)**2 + ! the first derivative + fun=distp(0,1)*(2.d0*r(0)-dd1*rp1) & + +peff*distp(0,2)*(2.d0*r(0)-dd2*rp1) + ! + ! the second derivative + fun2=distp(0,1)*(2.d0-4.d0*dd1*r(0)+dd1**2*rp1) & + +peff*distp(0,2)*(2.d0-4.d0*dd2*r(0)+dd2**2*rp1) + ! + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=2.d0*fun/r(0)+fun2 + end if + indorb=indorbp + ! endif + indpar=indpar+3 + indshell=indshellp + ! 4s single zeta +case (39) + ! R(r)=r**3*exp(-z1*r) + ! + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 + ! c=dsqrt((2*dd1)**7/720.d0/pi)/2.d0 + c=dd1**3.5d0*0.11894160774351807429d0 + ! c=-c + ! endif + c0=-c + c1=3.5d0*c/dd1 + do k=0,0 + distp(k,1)=dexp(-dd1*r(k)) + end do + do i=0,0 + z(indorbp,i)=(c0*r(i)**3+c1*r(i)**2)*distp(i,1) + end do + if(typec.ne.1) then + rp1=r(0)**3 + rp2=r(0)**2 + ! fun=(2.d0-dd1*r(0))*distp(0,1) + ! fun2=(2.d0-4*dd1*r(0)+(dd1*r(0))**2)*distp(0,1) + ! + !c the first derivative/r + fun=distp(0,1)*(c0*(3.d0*r(0)-dd1*rp2) & + +c1*(2.d0-dd1*r(0))) + !c + !c the second derivative + fun2=distp(0,1)* & + (c0*(6.d0*r(0)-6.d0*dd1*rp2+dd1**2*rp1) & + +c1*(2.d0-4*dd1*r(0)+(dd1*r(0))**2)) + !c + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + ! + indorb=indorbp + ! + ! endif + indpar=indpar+1 + indshell=indshellp + ! + ! 3p single zeta +case (132) +! 2s with cusp condition +! ( r^3*exp(-dd2*r)) ! with no cusp condition +dd2=dd(indpar+1) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=dexp(-dd2*r(k))*r(k) +end do ! if(iocc(indshellp).eq.1) then - do i=1,3 - z(indorbp,indt+i)=rmu(i,0)*fun - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 -! endif - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+1 - indorb=indorbp - case(2000:2099) -! s gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative of 1000 - npower=iopt+1-2000 - indorbp=indorb+1 - indshellp=indshell+1 - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=-r(k)**(2*npower)*dexp(-dd2*r(k)**2) - enddo -! if(iocc(indshellp).eq.1) then - do i=0,0 - z(indorbp,i)=distp(i,1) - enddo -! endif - if(typec.ne.1) then - rp1=r(0)**2 - fun0=distp(0,1) - fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 - fun2=(npower*(2.d0*npower-1.d0)- & - & (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & - & distp(0,1)*2.d0/rp1 +do i=0,0 + z(indorbp,i)=distp(i,1)*r(i)**2 +end do +! endif +if(typec.ne.1) then + fun=(3.d0-dd2*r(0))*distp(0,1) + fun2=(6.d0-6*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if +indpar=indpar+1 +indshell=indshellp +indorb=indorbp +case (30) + ! 3d without cusp and one parmater + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c= & + ! &1.d0/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) + c=dd1**3.5d0*0.26596152026762178d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + end do + do i=0,0 + distp(i,3)=distp(i,1) + ! lz=0 + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/-2 + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d + end do + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif + end do + if(typec.ne.1) then + fun0=distp(0,3) + fun=-dd1*distp(0,1) + fun2=dd1**2*distp(0,1) + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + ! + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp +case (73) + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + ! if(iflagnorm.gt.2) then + ! overall normalization obtained by Mathematica + c=dd1**3.75d0*0.43985656185609913955d0 + ! C= dd1^15/4 /Sqrt[Integrate[x^14 Exp[-2 x^2],{x,0,Infinity}]] + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do i=0,0 + do k=1,6 + zv(k)=rmu(3,i)**k + yv(k)=rmu(2,i)**k + xv(k)=rmu(1,i)**k + end do + r2=xv(2)+yv(2)+zv(2) + r4=r2*r2 + r6=r2*r4 + ! lz=0 + distp(i,2)=cost1i*(231.d0*zv(6)-315.d0*zv(4)*r2+105.d0*zv(2)*r4-5.d0*r6) + cost=(33.d0*zv(5)-30.d0*zv(3)*r2+5.d0*zv(1)*r4) + ! lz=+/-1 + distp(i,3)=cost2i*rmu(1,i)*cost + ! lz=+/-1 + distp(i,4)=cost2i*rmu(2,i)*cost + cost=33.d0*zv(4)-18.d0*zv(2)*r2+r4 + ! lz=+/-2 + distp(i,5)=cost3i*(xv(2)-yv(2))*cost + ! lz=+/-2 + distp(i,6)=2.d0*cost3i*xv(1)*yv(1)*cost + cost=11.d0*zv(3)-3.d0*zv(1)*r2 + ! lz=+/-3 + distp(i,7)=cost4i*(xv(3)-3.d0*xv(1)*yv(2))*cost + ! lz=+/-3 + distp(i,8)=-cost4i*(yv(3)-3.d0*yv(1)*xv(2))*cost + cost=11.d0*zv(2)-r2 + ! lz=+/-4 + distp(i,9)=cost5i*(xv(4)-6.d0*xv(2)*yv(2)+yv(4))*cost + ! lz=+/-4 + distp(i,10)=cost5i*4.d0*(xv(3)*yv(1)-yv(3)*xv(1))*cost + ! lz=+/-5 + distp(i,11)=cost6i*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4))*zv(1) + ! lz=+/-5 + distp(i,12)=-cost6i*(-5.d0*xv(4)*yv(1)+10.d0*xv(2)*yv(3)-yv(5))*zv(1) + ! lz=+/-6 + distp(i,13)=cost7i*(xv(6)-15.d0*xv(4)*yv(2)+15.d0*xv(2)*yv(4)-yv(6)) + ! lz=+/-6 + distp(i,14)=-cost7i*(-6.d0*xv(5)*yv(1)+20.d0*xv(3)*yv(3)-6.d0*yv(5)*xv(1)) + end do + do ic=1,13 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*distp(k,1+ic) + end do + ! endif + end do + if(typec.ne.1) then + dd1=dd(indparp) + fun0=distp(0,1) + fun=-2.d0*dd1*distp(0,1) + fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + do k=1,6 + zv(k)=rmu(3,0)**k + yv(k)=rmu(2,0)**k + xv(k)=rmu(1,0)**k + end do + r2=xv(2)+yv(2)+zv(2) + r4=r2*r2 + r6=r2*r4 + ! indorbp=indorb + do ic=1,13 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0)*fun + end do + if(ic.eq.1) then + ! if(i.eq.1) then + ! lz =0 + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost1i*fun0*(-30.d0*xv(5)-60.d0*xv(3)*yv(2)-30.d0*xv(1)*yv(4)& + +360.d0*xv(3)*zv(2)+360.d0*xv(1)*yv(2)*zv(2)-240.d0*xv(1)*zv(4)) + ! elseif(i.eq.2) then + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost1i*fun0*(-30.d0*xv(4)*yv(1)-60.d0*xv(2)*yv(3)-30.d0*yv(5)& + +360.d0*xv(2)*yv(1)*zv(2)+360.d0*yv(3)*zv(2)-240.d0*yv(1)*zv(4)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost1i*fun0*(180.d0*xv(4)*zv(1)+360.d0*xv(2)*yv(2)*zv(1)+180.d0*yv(4)*zv(1)& + -480.d0*xv(2)*zv(3)-480.d0*yv(2)*zv(3)+96.d0*zv(5)) + elseif(ic.eq.2) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost2i*fun0*(25.d0*xv(4)*zv(1)+30.d0*xv(2)*yv(2)*zv(1)+5.d0*yv(4)*zv(1)& + -60.d0*xv(2)*zv(3)-20.d0*yv(2)*zv(3)+8.d0*zv(5)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost2i*fun0*(20.d0*xv(3)*yv(1)*zv(1)+20.d0*xv(1)*yv(3)*zv(1)& + -40.d0*xv(1)*yv(1)*zv(3)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost2i*fun0*(5.d0*xv(5)+10.d0*xv(3)*yv(2)+5.d0*yv(4)*xv(1)& + -60.d0*xv(3)*zv(2)-60.d0*xv(1)*yv(2)*zv(2)+40.d0*xv(1)*zv(4)) + elseif(ic.eq.3) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost2i*fun0*(-20.d0*xv(3)*yv(1)*zv(1)-20.d0*xv(1)*yv(3)*zv(1)& + +40.d0*xv(1)*yv(1)*zv(3)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost2i*fun0*(-5.d0*xv(4)*zv(1)-30.d0*xv(2)*yv(2)*zv(1)-25.d0*yv(4)*zv(1)& + +20.d0*xv(2)*zv(3)+60.d0*yv(2)*zv(3)-8.d0*zv(5)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + -cost2i*fun0*(-5.d0*xv(4)*yv(1)-10.d0*xv(2)*yv(3)-5.d0*yv(5)& + +60.d0*xv(2)*yv(1)*zv(2)+60.d0*yv(3)*zv(2)-40.d0*yv(1)*zv(4)) + elseif(ic.eq.4) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost3i*fun0*(6.d0*xv(5)+4.d0*xv(3)*yv(2)-2.d0*xv(1)*yv(4)& + -64.d0*xv(3)*zv(2)+32.d0*xv(1)*zv(4)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost3i*fun0*(2.d0*xv(4)*yv(1)-4.d0*xv(2)*yv(3)-6.d0*yv(5)& + +64.d0*yv(3)*zv(2)-32.d0*yv(1)*zv(4)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost3i*fun0*(-32.d0*xv(4)*zv(1)+32.d0*yv(4)*zv(1)+64.d0*xv(2)*zv(3)& + -64.d0*yv(2)*zv(3)) + elseif(ic.eq.5) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost3i*fun0*(-10.d0*xv(4)*yv(1)-12.d0*xv(2)*yv(3)-2.d0*yv(5)& + +96.d0*xv(2)*yv(1)*zv(2)+32.d0*yv(3)*zv(2)-32.d0*yv(1)*zv(4)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost3i*fun0*(-2.d0*xv(5)-12.d0*xv(3)*yv(2)-10.d0*xv(1)*yv(4)& + +32.d0*xv(3)*zv(2)+96.d0*xv(1)*yv(2)*zv(2)-32.d0*xv(1)*zv(4)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + -cost3i*fun0*(64.d0*xv(3)*yv(1)*zv(1)+64.d0*xv(1)*yv(3)*zv(1)-128.d0*xv(1)*yv(1)*zv(3)) + elseif(ic.eq.6) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost4i*fun0*(-15.d0*xv(4)*zv(1)+18.d0*xv(2)*yv(2)*zv(1)+9.d0*yv(4)*zv(1)& + +24.d0*xv(2)*zv(3)-24.d0*yv(2)*zv(3)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost4i*fun0*(12.d0*xv(3)*yv(1)*zv(1)+36.d0*xv(1)*yv(3)*zv(1)-48.d0*xv(1)*yv(1)*zv(3)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost4i*fun0*(-3.d0*xv(5)+6.d0*xv(3)*yv(2)+9.d0*xv(1)*yv(4)+24.d0*xv(3)*zv(2)& + -72.d0*xv(1)*yv(2)*zv(2)) + elseif(ic.eq.7) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost4i*fun0*(36.d0*xv(3)*yv(1)*zv(1)+12.d0*xv(1)*yv(3)*zv(1)-48.d0*xv(1)*yv(1)*zv(3)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost4i*fun0*(9.d0*xv(4)*zv(1)+18.d0*xv(2)*yv(2)*zv(1)-15.d0*yv(4)*zv(1)& + -24.d0*xv(2)*zv(3)+24.d0*yv(2)*zv(3)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + -cost4i*fun0*(9.d0*xv(4)*yv(1)+6.d0*xv(2)*yv(3)-3.d0*yv(5)& + -72.d0*xv(2)*yv(1)*zv(2)+24.d0*yv(3)*zv(2)) + elseif(ic.eq.8) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost5i*fun0*(-6.d0*xv(5)+20.d0*xv(3)*yv(2)+10.d0*xv(1)*yv(4)& + +40.d0*xv(3)*zv(2)-120.d0*xv(1)*yv(2)*zv(2)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost5i*fun0*(10.d0*xv(4)*yv(1)+20.d0*xv(2)*yv(3)-6.d0*yv(5)& + -120.d0*xv(2)*yv(1)*zv(2)+40.d0*yv(3)*zv(2)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost5i*fun0*(20.d0*xv(4)*zv(1)-120.d0*xv(2)*yv(2)*zv(1)+20.d0*yv(4)*zv(1)) + elseif(ic.eq.9) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost5i*fun0*(20.d0*xv(4)*yv(1)-4.d0*yv(5)-120.d0*xv(2)*yv(1)*zv(2)& + +40.d0*yv(3)*zv(2)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost5i*fun0*(4.d0*xv(5)-20.d0*xv(1)*yv(4)-40.d0*xv(3)*zv(2)& + +120.d0*xv(1)*yv(2)*zv(2)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + -cost5i*fun0*(-80.d0*xv(3)*yv(1)*zv(1)+80.d0*xv(1)*yv(3)*zv(1)) + elseif(ic.eq.10) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost6i*fun0*(5.d0*xv(4)*zv(1)-30.d0*xv(2)*yv(2)*zv(1)+5.d0*yv(4)*zv(1)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost6i*fun0*(-20.d0*xv(3)*yv(1)*zv(1)+20.d0*xv(1)*yv(3)*zv(1)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + +cost6i*fun0*(xv(5)-10.d0*xv(3)*yv(2)+5.d0*xv(1)*yv(4)) + elseif(ic.eq.11) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost6i*fun0*(-20.d0*xv(3)*yv(1)*zv(1)+20.d0*xv(1)*yv(3)*zv(1)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost6i*fun0*(-5.d0*xv(4)*zv(1)+30.d0*xv(2)*yv(2)*zv(1)-5.d0*yv(4)*zv(1)) + z(indorbp,indt+3)=z(indorbp,indt+3) & + -cost6i*fun0*(-5.d0*xv(4)*yv(1)+10.d0*xv(2)*yv(3)-yv(5)) + elseif(ic.eq.12) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + +cost7i*fun0*(6.d0*xv(5)-60.d0*xv(3)*yv(2)+30.d0*xv(1)*yv(4)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + +cost7i*fun0*(-30.d0*xv(4)*yv(1)+60.d0*xv(2)*yv(3)-6.d0*yv(5)) + elseif(ic.eq.13) then + z(indorbp,indt+1)=z(indorbp,indt+1) & + -cost7i*fun0*(-30.d0*xv(4)*yv(1)+60.d0*xv(2)*yv(3)-6.d0*yv(5)) + z(indorbp,indt+2)=z(indorbp,indt+2) & + -cost7i*fun0*(-6.d0*xv(5)+60.d0*xv(3)*yv(2)-30.d0*xv(1)*yv(4)) + end if + z(indorbp,indt+4)=distp(0,1+ic)*(14.d0*fun+fun2) + !endif for iocc + ! endif + end do ! enddo fot ic + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+13 + indorb=indorbp + ! 2s gaussian for pseudo +case (65) + ! d orbitals + ! R(r)= c0 r^3 exp(-alpha r^2)+ c1 r exp(-alpha r^2) + ! each gaussian term is normalized + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + ! if(iflagnorm.gt.2) then + ! overall normalization to be done + ! c=8.d0/dsqrt(21.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(9.d0/4.d0) + c=dd1**2.25d0*1.24420067280413253d0 + ! endif + c0=-c + c1=2.25d0*c/dd1 + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do i=0,0 + ! lz=0 + distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/-2 + distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d + end do + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*(c0*distp(k,1+ic)*r(k)**3+ & + c1*r(k)) + end do + ! endif + end do + if(typec.ne.1) then + dd1=dd(indparp) + rp1=2.d0*dd1*r(0) + rp2=rp1*r(0) + fun0=distp(0,1)*(c1*r(0)+c0*r(0)**3) + fun=(c1*(1.d0-rp2)+c0*r(0)**2*(3.d0-rp2)) & + *distp(0,1)/r(0) + fun2=distp(0,1)*(c1*rp1*(rp2-3.d0)+c0*r(0) & + *(3.d0-3.5d0*rp2+0.5d0*rp2**2)) + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp + ! ******************* END GAUSSIAN BASIS ************************ + ! ** ** ** ** ** ** ** JASTROW ORBITALS ** ** ** ** ** ** ** ** * +case (82) + dd1=dd(indpar+1) + dd2=dsqrt(dd1) + ! if(iflagnorm.gt.2) then + ! ratiocp--> ratiocp*dsqrt(2.d0)*pi**(-0.75d0)*2**1.25 + ! c=dsqrt(2.d0)*pi**(-0.75d0)*(2.d0*dd1)**1.25d0*ratiocp + c=dd1**1.25d0*ratiocp + ! endif + do k=0,0 + cost=dd1*r(k)**2/(1.d0+dd2*r(k)) + distp(k,1)=c*dexp(-cost) + end do + ! indorbp=indorb + ! + do ic=1,3 + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + end do + if(typec.ne.1) then + fun0=distp(0,1) + ! fun=-2.d0*dd1*distp(0,1) + ! fun2=fun*(1.d0-2.d0*dd1*r(0)**2) + rp1=dd1*r(0)**2 + rp2=dd2*r(0) + rp3=(1.d0+rp2)**2 + fun=-dd1*distp(0,1)*(2.d0+rp2)/rp3 + ! the second derivative + fun2=dd1*distp(0,1)*(-2.d0-2.d0*rp2+4.d0*rp1+4.d0*rp1*rp2+rp1**2)/rp3**2 + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + end do + end if + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp +case (111) +! 2p single r_mu/(1+b r^3) parent of 103 +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=1.d0/(1.d0+dd2*r(k)**3) +end do +! indorbp=indorb +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1) + fun=-dd2*distp(0,1)**2*3.d0*r(0) + fun2=fun*distp(0,1)*(2.d0-4.d0*dd2*r(0)**3) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (62) + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c=2.d0/pi**0.75d0*(2.d0*dd1)**1.75d0/dsqrt(5.d0) + c=dd1**1.75d0*1.2749263037197753d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + ! indorbp=indorb + ! + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1)*r(i) + end do + ! endif + end do + if(typec.ne.1) then + fun0=distp(0,1)*r(0) + cost=2.d0*dd1*r(0)**2 + fun=distp(0,1)*(1.d0-cost)/r(0) + fun2=2.d0*dd1*fun0*(cost-3.d0) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) + ! endif + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+3 + indorb=indorbp + ! derivative of 62 with respect zeta +case (42) + ! 4d without cusp and one parmater derivative of 30 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! c= & + ! &1.d0/(2.d0**3*3.d0)*dsqrt(1.d0/pi)*(2.d0*dd1)**(7.d0/2.d0) + c=dd1**3.5d0*0.26596152026762178d0 + ! c= + ! &1.d0/(2.d0**3*3.d0)/dsqrt(56.d0*pi)*(2.d0*dd1)**(9.d0/2.d0) + ! endif + c0=-c + c1=3.5d0*c/dd1 + do k=0,0 + distp(k,1)=dexp(-dd1*r(k)) + end do + do i=0,0 + distp(i,3)=distp(i,1)*(c0*r(i)+c1) + ! lz=0 + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/ + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d + end do + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif + end do + if(typec.ne.1) then + fun0=distp(0,3) + fun=-dd1*distp(0,3)+c0*distp(0,1) + fun2=dd1**2*distp(0,3)-2.d0*dd1*c0*distp(0,1) + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + ! + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp +case (4) + ! normalized + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + ! if(iflagnorm.gt.2) then + c=dd1**2.5d0/dsqrt(3.d0*pi*(1.d0+dd2**2/3.d0)) + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)) + end do + do i=0,0 + z(indorbp,i)=(r(i)+dd2*rmu(3,i))*distp(i,1) + end do + if(typec.ne.1) then + fun=distp(0,1)*(1.d0-dd1*r(0)) + funp=-dd2*dd1*distp(0,1)*rmu(3,0) + fun2=distp(0,1)*(dd1**2*r(0)-2.d0*dd1) + fun2p=dd1**2*dd2*distp(0,1)*rmu(3,0) + do i=1,3 + z(indorbp,indt+i)=(fun+funp)*rmu(i,0)/r(0) + end do + z(indorbp,indt+3)=z(indorbp,indt+3)+dd2*distp(0,1) + z(indorbp,indt+4)=(2.d0*fun+4.d0*funp)/r(0) & + +(fun2+fun2p) + end if + indorb=indorbp + ! endif + indpar=indpar+2 + indshell=indshellp + ! 2s single Z NO CUSP +case (137) +! 2s with cusp condition +! dd1*(exp(-dd2*r)*(1+dd2*r)) +dd2=dd(indpar+1) +! if(iflagnorm.gt.2) then +! c=1.d0/dsqrt(1/4.d0/dd2**3+12*dd2/(2.d0*dd2)**4+ +! &3*dd2**2/4/dd2**5)/dsqrt(4.0*pi) + ! endif +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)) +end do ! if(iocc(indshellp).eq.1) then - do i=1,3 - z(indorbp,indt+i)=rmu(i,0)*fun - enddo - z(indorbp,indt+4)=2.d0*fun+fun2 -! endif - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+1 - indorb=indorbp - case(1100:1199) -! p gaussian r**(2*npower)*exp(-alpha*r**2) - npower=iopt-1100 +do i=0,0 + z(indorbp,i)=distp(i,1)*(1.d0+dd2*r(i)) +end do +! endif +if(typec.ne.1) then + fun=-dd2**2*distp(0,1) + fun2=fun*(1.d0-dd2*r(0)) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if +indpar=indpar+1 +indshell=indshellp +indorb=indorbp +case (8) + ! s orbital + ! + ! - angmom = 0 + ! - type = Gaussian + ! - normalized = yes + ! - angtype = spherical + ! - npar = 2 + ! - multiplicity = 1 + ! + ! = exp(-dd1*r) + (dd1-zeta) * r * exp(-dd2*r) + ! + ! 2s double Z WITH CUSP + ! + indshellp=indshell+1 + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd1-zeta(1) + do k=0,0 + distp(k,1)=dexp(-dd1*r(k)) + distp(k,2)=dexp(-dd2*r(k)) + end do + c= 1.d0/dsqrt(1.d0/4.d0/dd1**3+12.d0*peff/(dd1+dd2)**4& + &+ 3*peff**2/4/dd2**5)/dsqrt(4.0*pi) + do i=0,0 + z(indorbp,i)=c*(distp(i,1)+r(i)*distp(i,2)*peff) + end do + if(typec.ne.1) then + fun=-dd1*distp(0,1)+peff*distp(0,2)*(1.d0-dd2*r(0)) + fun2=distp(0,1)*dd1**2& + &+ peff*distp(0,2)*(dd2**2*r(0)-2.d0*dd2) + do i=1,3 + z(indorbp,indt+i)=fun*c*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=c*(2.d0*fun/r(0)+fun2) + end if + indorb=indorbp + indpar=indpar+2 + indshell=indshellp +case (109) +! 2p double Lorentian +! dd1 * x_mu (L(dd2 r^2)+dd3 * L(dd4*r^2)) ; L(x)=1/(1+x^2) +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) +do k=0,0 + distp(k,1)=1.d0/(1.d0+dd2*r(k)**2) + distp(k,2)=1.d0/(1.d0+dd4*r(k)**2) +end do ! indorbp=indorb - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=r(k)**(2*npower)*dexp(-dd2*r(k)**2) - enddo - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1) - enddo -! endif - enddo - if(typec.ne.1) then - rp1=r(0)**2 - fun0=distp(0,1) - fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 - fun2=(npower*(2.d0*npower-1.d0)- & - & (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & - & distp(0,1)*2.d0/rp1 -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)*fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(2100:2199) -! p gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative 1100 - npower=iopt+1-2100 +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*(distp(i,1)+dd3*distp(i,2)) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1)+dd3*distp(0,2) + fun=2.d0*(-dd2*distp(0,1)**2-dd4*dd3*distp(0,2)**2) + ! fun2=2.d0*(dd2*(-1.d0+2.d0*dd2*r(0)**2)*distp(0,1) + ! 1+dd4*dd3*(-1.d0+2.d0*dd4*r(0)**2)*distp(0,2)) + fun2=2*dd2*distp(0,1)**3*(-1.d0+3.d0*dd2*r(0)**2) & + +2*dd3*dd4*distp(0,2)**3*(-1.d0+3.d0*dd4*r(0)**2) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+3 +indshell=indshell+3 +indorb=indorbp +case (112) +! 2p single r_mu/(1+b r)^3 parent of 103 +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=1.d0/(1.d0+dd2*r(k))**3 +end do ! indorbp=indorb - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=-r(k)**(2*npower)*dexp(-dd2*r(k)**2) - enddo - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=rmu(ic,i)*distp(i,1) - enddo -! endif - enddo - if(typec.ne.1) then - rp1=r(0)**2 - fun0=distp(0,1) - fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 - fun2=(npower*(2.d0*npower-1.d0)- & - & (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & - & distp(0,1)*2.d0/rp1 -! indorbp=indorb - do ic=1,3 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)*fun - if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 - enddo - z(indorbp,indt+4)=rmu(ic,0)*(4.d0*fun+fun2) -! endif - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+3 - indorb=indorbp - case(1200:1299) -! d gaussian r**(2*npower)*exp(-alpha*r**2) - npower=iopt-1200 +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=rmu(ic,i)*distp(i,1) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,1) + fun=-3.d0*dd2*distp(0,1)/(r(0)*(1.d0+dd2*r(0))) + fun2=12.d0*dd2**2/(1.+dd2*r(0))**5 + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (151) +! 2p single exponential -r^3 e^{-z r^2} ! parent of 150 +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=dexp(-dd2*r(k)**2) +end do ! indorbp=indorb - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=r(k)**(2*npower)*dexp(-dd2*r(k)**2) - enddo - do i=0,0 - distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d - distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d - distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d - enddo - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=distp(i,1+ic)*distp(i,1) - enddo -! endif - enddo - if(typec.ne.1) then - rp1=r(0)**2 - fun0=distp(0,1) - fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 - fun2=(npower*(2.d0*npower-1.d0)- & - & (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & - & distp(0,1)*2.d0/rp1 -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo +do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=-rmu(ic,i)*distp(i,1)*r(i)**3 + end do + ! endif +end do +if(typec.ne.1) then + fun0=-distp(0,1)*r(0)**3 + cost=dd2*r(0)**2 + fun=distp(0,1)*(-3.d0+2.d0*cost)*r(0) + fun2=-2.d0*distp(0,1)*r(0)*(3.d0-7.d0*cost+2.d0*cost**2) + ! indorbp=indorb + do ic=1,3 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=rmu(ic,0)*rmu(i,0)* & + fun + if(i.eq.ic) z(indorbp,indt+i)=z(indorbp,indt+i)+fun0 + end do + z(indorbp,indt+4)=rmu(ic,0) & + *(4.d0*fun+fun2) + ! endif + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+3 +indorb=indorbp +case (127) +! 3d without cusp and one parmater +dd1=dd(indpar+1) +do k=0,0 + distp(k,1)=dexp(-dd1*r(k)) +end do +do i=0,0 + distp(i,3)=distp(i,1) + distp(i,4)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + distp(i,5)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + distp(i,6)=rmu(1,i)*rmu(2,i)*cost3d + distp(i,7)=rmu(2,i)*rmu(3,i)*cost3d + distp(i,8)=rmu(1,i)*rmu(3,i)*cost3d +end do +! indorbp=indorb +do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=distp(i,3+ic)*distp(i,3) + end do + ! endif +end do +if(typec.ne.1) then + fun0=distp(0,3) + fun=-dd1*distp(0,1) + fun2=dd1**2*distp(0,1) + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,3+ic)*rmu(i,0) & + *fun/r(0) + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,3+ic)*(6.d0*fun/r(0)+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt +end if +! +indpar=indpar+1 +indshell=indshell+5 +indorb=indorbp +case (139) +! 2s with cusp condition +! ( r^3*exp(-dd2*r)) ! der of 128 +dd2=dd(indpar+1) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=-dexp(-dd2*r(k))*r(k) +end do +! if(iocc(indshellp).eq.1) then +do i=0,0 + z(indorbp,i)=distp(i,1)*r(i)**2 +end do +! endif +if(typec.ne.1) then + fun=(3.d0-dd2*r(0))*distp(0,1) + fun2=(6.d0-6*dd2*r(0)+(dd2*r(0))**2)*distp(0,1) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if +indpar=indpar+1 +indshell=indshellp +indorb=indorbp +case (45,69) + ! d orbitals + ! R(r)= c*exp(-z r^2)*(7/4/z-r^2) + ! indorbp=indorb + indparp=indpar+1 + dd1=dd(indparp) + ! if(iflagnorm.gt.2) then + ! overall normalization + ! c=4.d0/dsqrt(3.d0)*(2.d0/pi)**(3.d0/4.d0)*dd1**(7.d0/4.d0) + c=dd1**1.75d0*1.64592278064948967213d0 + ! endif + do k=0,0 + distp(k,1)=c*dexp(-dd1*r(k)**2) + end do + do i=0,0 + ! lz=0 + distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + ! lz=+/-2 + distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + ! lz=+/-2 + distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d + ! lz=+/-1 + distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d + ! lz=+/-1 + distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d + end do + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do k=0,0 + z(indorbp,k)=distp(k,1)*(7.d0/4.d0/dd1-r(k)**2)* & + distp(k,1+ic) + end do + ! endif + end do + if(typec.ne.1) then + dd1=dd(indparp) + fun0=distp(0,1)*(7.d0/4.d0/dd1-r(0)**2) + fun=distp(0,1)*(2.d0*dd1*r(0)**2-11.d0/2.d0) + fun2=distp(0,1)*(-4.d0*dd1**2*r(0)**4 & + +17.d0*dd1*r(0)**2-11.d0/2.d0) + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - case(2200:2299) -! d gaussian -r**(2*(npower+1))*exp(-alpha*r**2) derivative 1200 - npower=iopt+1-2200 + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt + end if + indpar=indpar+1 + indshell=indshell+5 + indorb=indorbp + ! derivative of 17 with respect to z +case (1200:1299) +! d gaussian r**(2*npower)*exp(-alpha*r**2) +npower=iopt-1200 ! indorbp=indorb - dd2=dd(indpar+1) - do k=0,0 - distp(k,1)=-r(k)**(2*npower)*dexp(-dd2*r(k)**2) - enddo - do i=0,0 - distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d - distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d - distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d - distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d - distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d - enddo - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=0,0 - z(indorbp,i)=distp(i,1+ic)*distp(i,1) - enddo -! endif - enddo - if(typec.ne.1) then - rp1=r(0)**2 - fun0=distp(0,1) - fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 - fun2=(npower*(2.d0*npower-1.d0)- & - & (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & - & distp(0,1)*2.d0/rp1 -! indorbp=indorb - do ic=1,5 -! if(iocc(indshell+ic).eq.1) then - indorbp=indorb+ic - do i=1,3 - z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & - & *fun - if(ic.eq.1) then - if(i.ne.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost1d - else - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 4.d0*rmu(i,0)*fun0*cost1d - endif - elseif(ic.eq.2) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & 2.d0*rmu(i,0)*fun0*cost2d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)- & - & 2.d0*rmu(i,0)*fun0*cost2d - endif - elseif(ic.eq.3) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - elseif(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - endif - elseif(ic.eq.4) then - if(i.eq.2) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(2,0)*fun0*cost3d - endif - elseif(ic.eq.5) then - if(i.eq.1) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(3,0)*fun0*cost3d - elseif(i.eq.3) then - z(indorbp,indt+i)=z(indorbp,indt+i)+ & - & rmu(1,0)*fun0*cost3d - !endif for i - endif - !endif for ic - endif - !enddo for i - enddo - z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) - !endif for iocc -! endif - ! enddo fot ic - enddo - !endif for indt - endif - indpar=indpar+1 - indshell=indshell+5 - indorb=indorbp - case default - write(6,*) 'WARNING makefun: orbital',iopt,'not found' - iflagerr=1 - end select +dd2=dd(indpar+1) +do k=0,0 + distp(k,1)=r(k)**(2*npower)*dexp(-dd2*r(k)**2) +end do +do i=0,0 + distp(i,2)=(3.d0*rmu(3,i)**2-r(i)**2)*cost1d + distp(i,3)=(rmu(1,i)**2-rmu(2,i)**2)*cost2d + distp(i,4)=rmu(1,i)*rmu(2,i)*cost3d + distp(i,5)=rmu(2,i)*rmu(3,i)*cost3d + distp(i,6)=rmu(1,i)*rmu(3,i)*cost3d +end do +do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=0,0 + z(indorbp,i)=distp(i,1+ic)*distp(i,1) + end do + ! endif +end do +if(typec.ne.1) then + rp1=r(0)**2 + fun0=distp(0,1) + fun=(npower-dd2*rp1)*distp(0,1)*2.d0/rp1 + fun2=(npower*(2.d0*npower-1.d0)- & + (1.d0+4.d0*npower)*dd2*rp1+2.d0*(dd2*rp1)**2)* & + distp(0,1)*2.d0/rp1 + ! indorbp=indorb + do ic=1,5 + ! if(iocc(indshell+ic).eq.1) then + indorbp=indorb+ic + do i=1,3 + z(indorbp,indt+i)=distp(0,1+ic)*rmu(i,0) & + *fun + if(ic.eq.1) then + if(i.ne.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost1d + else + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 4.d0*rmu(i,0)*fun0*cost1d + end if + elseif(ic.eq.2) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + 2.d0*rmu(i,0)*fun0*cost2d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)- & + 2.d0*rmu(i,0)*fun0*cost2d + end if + elseif(ic.eq.3) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + elseif(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + end if + elseif(ic.eq.4) then + if(i.eq.2) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(2,0)*fun0*cost3d + end if + elseif(ic.eq.5) then + if(i.eq.1) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(3,0)*fun0*cost3d + elseif(i.eq.3) then + z(indorbp,indt+i)=z(indorbp,indt+i)+ & + rmu(1,0)*fun0*cost3d + !endif for i + end if + !endif for ic + end if + !enddo for i + end do + z(indorbp,indt+4)=distp(0,1+ic)*(6.d0*fun+fun2) + !endif for iocc + ! endif + ! enddo fot ic + end do + !endif for indt +end if +indpar=indpar+1 +indshell=indshell+5 +indorb=indorbp +case (90:99) + ! cartesian orbitals + ! + ! - angmom := iopt - 90 + ! - type = Gaussian + ! - normalized = yes + ! - angtype = cartesian + ! - npar = 1 + ! - multiplicity := (iopt - 90 + 2) * (iopt - 90 + 1) // 2 + ! + indshellp=indshell+1 + indorbp=indorb+1 + dd1=dd(indpar+1) + multiplicity = (iopt - 90 + 2) * (iopt - 90 + 1) / 2 + powers(:,-2,:) = 0.0d0 + powers(:,-1,:) = 0.0d0 + powers(:,0,:) = 1.0d0 + do ii = 1, iopt - 90 + do k = 0, 0 + powers(1, ii, k) = powers(1, ii-1, k) * rmu(1, k) + powers(2, ii, k) = powers(2, ii-1, k) * rmu(2, k) + powers(3, ii, k) = powers(3, ii-1, k) * rmu(3, k) + end do + end do + c = 0.712705470354990_8 * dd1 ** 0.75_8! * 2.829 + if (iopt - 90 .ne. 0) then + c = c * (8_4 * dd1) ** ((iopt - 90)/2.0_8) + end if + do k = 0, 0 + distp(k,1) = dexp(-1.0_8 * dd1 * r(k) * r(k)) * c + end do + do k = 0, 0 + count = 0 + do ii = (iopt - 90), 0, -1 + do jj = (iopt - 90) - ii, 0, -1 + kk = (iopt - 90) - ii - jj + z(indorbp + count, k) = 1.0_8 + rp1 = 1.0_8 + do i = ii + 1, 2 * ii + rp1 = rp1 * i + end do + z(indorbp + count, k) = z(indorbp + count, k) / dsqrt(rp1) + rp1 = 1.0_8 + do i = jj + 1, 2 * jj + rp1 = rp1 * i + end do + z(indorbp + count, k) = z(indorbp + count, k) / dsqrt(rp1) + rp1 = 1.0_8 + do i = kk + 1, 2 * kk + rp1 = rp1 * i + end do + z(indorbp + count, k) = z(indorbp + count, k) / dsqrt(rp1) + count = count + 1 + end do + end do + end do + ! We need to calculate it again for derivatives, it could not be done in previous loop because of case if 0 /= 0 + if (typec .ne. 1) then + count = 0 + do ii = (iopt - 90), 0, -1 + do jj = (iopt - 90) - ii, 0, -1 + kk = (iopt - 90) - ii - jj + z(indorbp + count, indt + 1) = 1.0_8 + z(indorbp + count, indt + 2) = 1.0_8 + z(indorbp + count, indt + 3) = 1.0_8 + z(indorbp + count, indt + 4) = 1.0_8 + rp1 = 1.0_8 + do i = ii + 1, 2 * ii + rp1 = rp1 * i + end do + z(indorbp + count, indt + 1) = z(indorbp + count, indt + 1) / dsqrt(rp1) + z(indorbp + count, indt + 2) = z(indorbp + count, indt + 2) / dsqrt(rp1) + z(indorbp + count, indt + 3) = z(indorbp + count, indt + 3) / dsqrt(rp1) + z(indorbp + count, indt + 4) = z(indorbp + count, indt + 4) / dsqrt(rp1) + rp1 = 1.0_8 + do i = jj + 1, 2 * jj + rp1 = rp1 * i + end do + z(indorbp + count, indt + 1) = z(indorbp + count, indt + 1) / dsqrt(rp1) + z(indorbp + count, indt + 2) = z(indorbp + count, indt + 2) / dsqrt(rp1) + z(indorbp + count, indt + 3) = z(indorbp + count, indt + 3) / dsqrt(rp1) + z(indorbp + count, indt + 4) = z(indorbp + count, indt + 4) / dsqrt(rp1) + rp1 = 1.0_8 + do i = kk + 1, 2 * kk + rp1 = rp1 * i + end do + z(indorbp + count, indt + 1) = z(indorbp + count, indt + 1) / dsqrt(rp1) + z(indorbp + count, indt + 2) = z(indorbp + count, indt + 2) / dsqrt(rp1) + z(indorbp + count, indt + 3) = z(indorbp + count, indt + 3) / dsqrt(rp1) + z(indorbp + count, indt + 4) = z(indorbp + count, indt + 4) / dsqrt(rp1) + count = count + 1 + end do + end do + end if + ! Initialize gradients and laplacians (radial part) + if (typec .ne. 1) then + distp(indt + 1, 1) = -2.0d0 * dd1 * rmu(1, 0) * distp(0, 1) + distp(indt + 2, 1) = -2.0d0 * dd1 * rmu(2, 0) * distp(0, 1) + distp(indt + 3, 1) = -2.0d0 * dd1 * rmu(3, 0) * distp(0, 1) + distp(indt + 4, 1) = dd1 * (4.0d0 * dd1 * (r(0) * r(0)) - 6.0d0) * distp(0, 1) + end if + do k = 0, 0 + count = 0 + do ii = (iopt - 90), 0, -1 + do jj = (iopt - 90) - ii, 0, -1 + kk = (iopt - 90) - ii - jj + z(indorbp + count, k) = z(indorbp + count, k) * powers(1, ii, k) + z(indorbp + count, k) = z(indorbp + count, k) * powers(2, jj, k) + z(indorbp + count, k) = z(indorbp + count, k) * powers(3, kk, k) + count = count + 1 + end do + end do + end do + if (typec .ne. 1) then + ! Solve ang_mom = 0, 1 separately + if (iopt - 90 .eq. 0) then + z(indorbp, indt + 1) = distp(indt + 1, 1) + z(indorbp, indt + 2) = distp(indt + 2, 1) + z(indorbp, indt + 3) = distp(indt + 3, 1) + z(indorbp, indt + 4) = distp(indt + 4, 1) + else if (iopt - 90 .eq. 1) then + rp1 = dsqrt(2.0_8) + z(indorbp , indt + 1) = (distp(indt + 1, 1) * rmu(1, 0) + distp(0, 1)) / rp1 + z(indorbp , indt + 2) = (distp(indt + 2, 1) * rmu(1, 0)) / rp1 + z(indorbp , indt + 3) = (distp(indt + 3, 1) * rmu(1, 0)) / rp1 + z(indorbp + 1, indt + 1) = (distp(indt + 1, 1) * rmu(2, 0)) / rp1 + z(indorbp + 1, indt + 2) = (distp(indt + 2, 1) * rmu(2, 0) + distp(0, 1)) / rp1 + z(indorbp + 1, indt + 3) = (distp(indt + 3, 1) * rmu(2, 0)) / rp1 + z(indorbp + 2, indt + 1) = (distp(indt + 1, 1) * rmu(3, 0)) / rp1 + z(indorbp + 2, indt + 2) = (distp(indt + 2, 1) * rmu(3, 0)) / rp1 + z(indorbp + 2, indt + 3) = (distp(indt + 3, 1) * rmu(3, 0) + distp(0, 1)) / rp1 + z(indorbp , indt + 4) = (distp(indt + 4, 1) * rmu(1, 0) + 2.0d0 * distp(indt + 1, 1)) / rp1 + z(indorbp + 1, indt + 4) = (distp(indt + 4, 1) * rmu(2, 0) + 2.0d0 * distp(indt + 2, 1)) / rp1 + z(indorbp + 2, indt + 4) = (distp(indt + 4, 1) * rmu(3, 0) + 2.0d0 * distp(indt + 3, 1)) / rp1 + else if (iopt - 90 .eq. 2) then + rp1 = 2.0_8 + rp2 = dsqrt(12.0_8) + z(indorbp , indt + 1) = (distp(indt + 1, 1) & + & * rmu(1, 0) * rmu(1, 0) + 2 * rmu(1, 0) * distp(0, 1)) / rp2 + z(indorbp , indt + 2) = (distp(indt + 2, 1) & + & * rmu(1, 0) * rmu(1, 0)) / rp2 + z(indorbp , indt + 3) = (distp(indt + 3, 1) & + & * rmu(1, 0) * rmu(1, 0)) / rp2 + z(indorbp + 1, indt + 1) = (distp(indt + 1, 1) & + & * rmu(1, 0) * rmu(2, 0) + rmu(2, 0) * distp(0, 1)) / rp1 + z(indorbp + 1, indt + 2) = (distp(indt + 2, 1) & + & * rmu(1, 0) * rmu(2, 0) + rmu(1, 0) * distp(0, 1)) / rp1 + z(indorbp + 1, indt + 3) = (distp(indt + 3, 1) & + & * rmu(1, 0) * rmu(2, 0)) / rp1 + z(indorbp + 2, indt + 1) = (distp(indt + 1, 1) & + & * rmu(1, 0) * rmu(3, 0) + rmu(3, 0) * distp(0, 1)) / rp1 + z(indorbp + 2, indt + 2) = (distp(indt + 2, 1) & + & * rmu(1, 0) * rmu(3, 0)) / rp1 + z(indorbp + 2, indt + 3) = (distp(indt + 3, 1) & + & * rmu(1, 0) * rmu(3, 0)) + rmu(1, 0) * distp(0, 1)/ rp1 + z(indorbp + 3, indt + 1) = (distp(indt + 1, 1) & + & * rmu(2, 0) * rmu(2, 0)) / rp2 + z(indorbp + 3, indt + 2) = (distp(indt + 2, 1) & + & * rmu(2, 0) * rmu(2, 0) + 2 * rmu(2, 0) * distp(0, 1)) / rp2 + z(indorbp + 3, indt + 3) = (distp(indt + 3, 1) & + & * rmu(2, 0) * rmu(2, 0)) / rp2 + z(indorbp + 4, indt + 1) = (distp(indt + 1, 1) & + & * rmu(2, 0) * rmu(3, 0)) / rp1 + z(indorbp + 4, indt + 2) = (distp(indt + 2, 1) & + & * rmu(2, 0) * rmu(3, 0) + rmu(3, 0) * distp(0, 1)) / rp1 + z(indorbp + 4, indt + 3) = (distp(indt + 3, 1) & + & * rmu(2, 0) * rmu(3, 0) + rmu(2, 0) * distp(0, 1)) / rp1 + z(indorbp + 5, indt + 1) = (distp(indt + 1, 1) & + & * rmu(3, 0) * rmu(3, 0)) / rp2 + z(indorbp + 5, indt + 2) = (distp(indt + 2, 1) & + & * rmu(3, 0) * rmu(3, 0)) / rp2 + z(indorbp + 5, indt + 3) = (distp(indt + 3, 1) & + & * rmu(3, 0) * rmu(3, 0) + 2 * rmu(3, 0) * distp(0, 1)) / rp2 + z(indorbp , indt + 4) = (1.0d0 * distp(indt + 4, 1) * rmu(1, 0) * rmu(1, 0)& + & + 4.0d0 * distp(indt + 1, 1) * rmu(1, 0)& + & + 2.0d0 * distp(0, 1)) / rp2 + z(indorbp + 1, indt + 4) = (1.0d0 * distp(indt + 4, 1) * rmu(1, 0) * rmu(2, 0)& + & + 2.0d0 * distp(indt + 2, 1) * rmu(1, 0)& + & + 2.0d0 * distp(indt + 1, 1) * rmu(2, 0)) / rp1 + z(indorbp + 2, indt + 4) = (1.0d0 * distp(indt + 4, 1) * rmu(1, 0) * rmu(3, 0)& + & + 2.0d0 * distp(indt + 3, 1) * rmu(1, 0)& + & + 2.0d0 * distp(indt + 1, 1) * rmu(3, 0)) / rp1 + z(indorbp + 3, indt + 4) = (1.0d0 * distp(indt + 4, 1) * rmu(2, 0) * rmu(2, 0)& + & + 4.0d0 * distp(indt + 2, 1) * rmu(2, 0)& + & + 2.0d0 * distp(0, 1)) / rp2 + z(indorbp + 4, indt + 4) = (1.0d0 * distp(indt + 4, 1) * rmu(2, 0) * rmu(3, 0)& + & + 2.0d0 * distp(indt + 3, 1) * rmu(2, 0)& + & + 2.0d0 * distp(indt + 2, 1) * rmu(3, 0)) / rp1 + z(indorbp + 5, indt + 4) = (1.0d0 * distp(indt + 4, 1) * rmu(3, 0) * rmu(3, 0)& + & + 4.0d0 * distp(indt + 3, 1) * rmu(3, 0)& + & + 2.0d0 * distp(0, 1)) / rp2 + else + count = 0 + do ii = (iopt - 90), 0, -1 + do jj = (iopt - 90) - ii, 0, -1 + kk = (iopt - 90) - ii - jj + ! First store polynomial part into respective places + ! Then solve full laplacian using using lower derivatives + ! Then do the same thing for gradients + ! Then finally the values + z(indorbp + count, indt + 1) = z(indorbp + count, indt + 1) * powers(1, ii-1, 0) + z(indorbp + count, indt + 1) = z(indorbp + count, indt + 1) * powers(2, jj, 0) + z(indorbp + count, indt + 1) = z(indorbp + count, indt + 1) * powers(3, kk, 0) + z(indorbp + count, indt + 1) = z(indorbp + count, indt + 1) * ii + z(indorbp + count, indt + 2) = z(indorbp + count, indt + 2) * powers(1, ii, 0) + z(indorbp + count, indt + 2) = z(indorbp + count, indt + 2) * powers(2, jj-1, 0) + z(indorbp + count, indt + 2) = z(indorbp + count, indt + 2) * powers(3, kk, 0) + z(indorbp + count, indt + 2) = z(indorbp + count, indt + 2) * jj + z(indorbp + count, indt + 3) = z(indorbp + count, indt + 3) * powers(1, ii, 0) + z(indorbp + count, indt + 3) = z(indorbp + count, indt + 3) * powers(2, jj, 0) + z(indorbp + count, indt + 3) = z(indorbp + count, indt + 3) * powers(3, kk-1, 0) + z(indorbp + count, indt + 3) = z(indorbp + count, indt + 3) * kk + z(indorbp + count, indt + 4) = z(indorbp + count, indt + 4) & + & * (powers(1, ii-2, 0) * powers(2, jj, 0) * powers(3, kk, 0) * ii * (ii-1)& + & + powers(1, ii, 0) * powers(2, jj-2, 0) * powers(3, kk, 0) * jj * (jj-1)& + & + powers(1, ii, 0) * powers(2, jj, 0) * powers(3, kk-2, 0) * kk * (kk-1)) + ! All polynomial parts are now stored + ! Now solve laplacian + z(indorbp + count, indt + 4) = z(indorbp + count, indt + 4) * distp(0, 1) & + & + 2.0_8 * z(indorbp + count, indt + 1) * distp(indt + 1, 1) & + & + 2.0_8 * z(indorbp + count, indt + 2) * distp(indt + 2, 1) & + & + 2.0_8 * z(indorbp + count, indt + 3) * distp(indt + 3, 1) & + & + z(indorbp + count, 0) * distp(indt + 4, 1) + ! Now solve gradients + z(indorbp + count, indt + 1) = z(indorbp + count, indt + 1) * distp(0, 1) & + & + z(indorbp + count, 0) * distp(indt + 1, 1) + z(indorbp + count, indt + 2) = z(indorbp + count, indt + 2) * distp(0, 1) & + & + z(indorbp + count, 0) * distp(indt + 2, 1) + z(indorbp + count, indt + 3) = z(indorbp + count, indt + 3) * distp(0, 1) & + & + z(indorbp + count, 0) * distp(indt + 3, 1) + count = count + 1 + end do + end do + end if + end if + ! Multiply by radial part for values + do ii = 1, multiplicity + do kk = 0, 0 + z(indorbp + ii - 1, kk) = z(indorbp + ii - 1, kk) * distp(kk, 1) + end do + end do + indpar=indpar + 1 + indshell=indshell + multiplicity + indorb=indorb + multiplicity +case (117) +! 2s double lorentian with constant parent of 102 +! (dd3+r^3/(1+dd5*r)^4; +dd3=dd(indpar+1) +dd5=dd(indpar+2) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,1)=r(k)**3/(1.d0+dd5*r(k))**4 +end do +! if(iocc(indshellp).eq.1) then +do i=0,0 + z(indorbp,i)=dd3+distp(i,1) +! write(6,*) ' function inside = ',z(indorbp,i) +end do +! endif +if(typec.ne.1) then + fun= & + -r(0)*(-3.d0+dd5*r(0))/(1.d0+dd5*r(0))**5 + fun2= & + +2.d0*r(0)*(3.d0-6.d0*dd5*r(0)+(dd5*r(0))**2) & + /(1.d0+dd5*r(0))**6 + ! write(6,*) ' fun inside = ',fun,fun2 + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=fun2+2.d0*fun + ! write(6,*) ' lap 106 =',z(indorbp,indt+4) + !endif for indt +end if +indpar=indpar+2 +indshell=indshellp +indorb=indorbp +case (50) + ! R(r)=(c0*r**4+c1*r**3)*exp(-z1*r) + ! + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + c=dsqrt((2*dd1)**9/40320.d0/pi)/2.d0 + ! endif + c0=-c + c1=4.5d0*c/dd1 + do k=0,0 + distp(k,1)=r(k)*dexp(-dd1*r(k)) + end do + do i=0,0 + z(indorbp,i)=(c0*r(i)**3+c1*r(i)**2)*distp(i,1) + end do + if(typec.ne.1) then + rp1=r(0)*dd1 + rp2=rp1*rp1 + !c the first derivative/r + fun=-distp(0,1)*(c0*r(0)*(rp1-4.d0)+c1*(rp1-3.d0)) + !c + !c the second derivative + fun2=distp(0,1)* & + (c0*r(0)*(12.d0-8.d0*rp1+rp2)+c1*(6.d0-6*rp1+rp2)) + !c + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + ! + indorb=indorbp + ! + ! endif + indpar=indpar+1 + indshell=indshellp + ! +case (3) + ! + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + dd2=dd(indpar+2) + peff=dd(indpar+3) + ! if(iflagnorm.gt.2) then + c=1.d0/2.d0/dsqrt(2.d0*pi*(1.d0/(2.d0*dd1)**3 & + +2.d0*peff/(dd1+dd2)**3+peff**2/(2.d0*dd2)**3)) + ! endif + do i=indpar+1,indpar+2 + do k=0,0 + distp(k,i-indpar)=c*dexp(-dd(i)*r(k)) + end do + end do + do i=0,0 + z(indorbp,i)=distp(i,1)+peff*distp(i,2) + end do + if(typec.ne.1) then + fun=-dd1*distp(0,1)-peff*dd2*distp(0,2) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0)/r(0) + end do + z(indorbp,indt+4)=(-2.d0*dd1/r(0)+dd1**2) & + *distp(0,1)+peff*(-2.d0*dd2/r(0)+dd2**2) & + *distp(0,2) + end if + indorb=indorbp + ! endif + indpar=indpar+3 + indshell=indshellp + ! 2s 2pz Hybryd single Z +case (124) +! 2s double exp with constant and cusp cond. +! (dd3+ exp (-dd2 r)*(1+dd2*r)+dd4*exp(-dd5*r)*(1+dd5*r)) +dd2=dd(indpar+1) +dd3=dd(indpar+2) +dd4=dd(indpar+3) +dd5=dd(indpar+4) +indorbp=indorb+1 +indshellp=indshell+1 +do k=0,0 + distp(k,3)=dexp(-dd2*r(k)) + distp(k,4)=dexp(-dd5*r(k)) + distp(k,1)=distp(k,3)*(1.d0+dd2*r(k)) + distp(k,2)=distp(k,4)*(1.d0+dd5*r(k)) +end do +! if(iocc(indshellp).eq.1) then +do i=0,0 + z(indorbp,i)=distp(i,1)+dd3+dd4*distp(i,2) +! write(6,*) ' function inside = ',z(indorbp,i) +end do +! endif +if(typec.ne.1) then + fun=-dd2**2*distp(0,3)-dd5**2*dd4*distp(0,4) + fun2=-dd2**2*distp(0,3)*(1.d0-dd2*r(0)) & + -dd4*dd5**2*distp(0,4)*(1.d0-dd5*r(0)) + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + z(indorbp,indt+4)=2.d0*fun+fun2 + !endif for indt +end if +indpar=indpar+4 +indshell=indshellp +indorb=indorbp +case (28) + ! R(r)=(Z*b*r)^4/(1+(Z*b*r)^4)*exp(-z*r) orbital 1s (no cusp) + ! d -> b1s (defined in module constants) + ! normadization: cost1s, depends on b1s + indshellp=indshell+1 + ! if(iocc(indshellp).eq.1) then + indorbp=indorb+1 + dd1=dd(indpar+1) + ! if(iflagnorm.gt.2) then + ! if(dd1.gt.0.) then + c=cost1s*dd1**1.5d0 + ! else + ! c=1.d0 + ! endif + ! endif + do i=0,0 + distp(i,1)=c*dexp(-dd1*r(i)) + end do + do i=0,0 + rp4=(dd1*b1s*r(i))**4 + z(indorbp,i)=distp(i,1)*rp4/(1.d0+rp4) + end do + if(typec.ne.1) then + rp1=dd1*b1s*r(0) + rp2=rp1**2 + rp4=rp2**2 + rp5=r(0)*dd1 + rp6=(b1s*dd1)**2*rp2 + ! the first derivative /r + fun=-distp(0,1)*rp6*(-4.d0+rp5+rp4*rp5)/(1.d0+rp4)**2 + ! the second derivative derivative + fun2=distp(0,1)*rp6*(12.d0-8*rp5+rp5**2-20*rp4- & + 8*rp4*rp5+2*rp4*rp5**2+(rp4*rp5)**2)/(1.d0+rp4)**3 + ! gradient: dR(r)/dr_i=r_i*fun + do i=1,3 + z(indorbp,indt+i)=fun*rmu(i,0) + end do + ! laplacian = 2*fun+fun2 + z(indorbp,indt+4)=2.d0*fun+fun2 + end if + indorb=indorbp + ! endif + indpar=indpar+1 + indshell=indshellp +case default +write(6,*) 'WARNING makefun: orbital',iopt,'not found' +iflagerr=1 +end select ! ** ** ** ** ** ** ** END OF JASTROW ORBITALS ** ** ** ** ** ** ** ** * - return - END +return +end diff --git a/src/c_adjoint_forward/makefun0_bump.f90 b/src/c_adjoint_forward/makefun0_bump.f90 index b04f9e7..d94920e 100644 --- a/src/c_adjoint_forward/makefun0_bump.f90 +++ b/src/c_adjoint_forward/makefun0_bump.f90 @@ -1,4 +1,3 @@ -!TL off !########################################################### @@ -7,7 +6,8 @@ !# # !########################################################### - SUBROUTINE makefun0_bump (iopt,iocc,indt,typec,indpar,indorb,indshell,nelskip,z,dd,r,rmu,distp,iflagnorm_fake,c) + !TL off +SUBROUTINE makefun0_bump (iopt,iocc,indt,typec,indpar,indorb,indshell,nelskip,z,dd,r,rmu,distp,iflagnorm_fake,c) use allio, only: cutoff_p ! user-defined cutoff for bump orbitals (see file bump_orbitals_new.f90) use constants diff --git a/src/c_adjoint_forward/makefun0_pbc.f90 b/src/c_adjoint_forward/makefun0_pbc.f90 index b33c9e5..d8cea46 100644 --- a/src/c_adjoint_forward/makefun0_pbc.f90 +++ b/src/c_adjoint_forward/makefun0_pbc.f90 @@ -1,4 +1,3 @@ -!TL off !########################################################### @@ -7,7 +6,8 @@ !# # !########################################################### - SUBROUTINE makefun0_pbc (iopt,iocc,indt,typec,indpar,indorb,indshell,nelskip,z,dd,r,rmu,distp,iflagnorm_fake,c,rmucos,rmusin,sinphase,cosphase) + !TL off +SUBROUTINE makefun0_pbc (iopt,iocc,indt,typec,indpar,indorb,indshell,nelskip,z,dd,r,rmu,distp,iflagnorm_fake,c,rmucos,rmusin,sinphase,cosphase) use constants use Cell, only:cellscale,rphase diff --git a/src/c_adjoint_forward/upwf.f90 b/src/c_adjoint_forward/upwf.f90 index a821b18..26e03db 100644 --- a/src/c_adjoint_forward/upwf.f90 +++ b/src/c_adjoint_forward/upwf.f90 @@ -17,9 +17,14 @@ subroutine upnewwf(indt, i0, indtm, typecomp, nshell, ioptorb, iocc, kel, nel, r nion, kion, iflagnorm, cnorm, LBox, rmucos, rmusin, mindist, indpar_tab, indorb_tab, indshell_tab, yesupel) use allio, only: ikshift, iespbc, rank, gamma_point, yes_crystalj& - &, yes_scemama, lepsbas, novec_loop1, slaterorb_read, nshell_det + &, yes_scemama, lepsbas, novec_loop1, slaterorb_read, nshell_det& + &, use_qmckl, qmckl_ctx use Cell, only: cellscale, cellpi, rphase, phase2pi, phase2pi_down, sinphase, cosphase, s2r, car2cry use Constants, only: ipc + use qmckl +#ifdef _QMCKL_GPU + !use qmckl_gpu +#endif implicit none ! input @@ -52,6 +57,11 @@ subroutine upnewwf(indt, i0, indtm, typecomp, nshell, ioptorb, iocc, kel, nel, r real*8 dd(indpar_tab(nshell + 1)) real*8 phs(3) ! scratch phase for Lbox=3 ! + ! QMCKL + integer*4 :: rc + integer*8, save :: ao_num=0, npoints_qmckl=0 + double precision, allocatable :: ao_vgl_qmckl(:,:), ao_value_qmckl(:,:) + ! integer, external :: omp_get_num_threads ! --------------------------------------------------------------------- ! orbital types are defined by the variable Lbox: @@ -316,65 +326,151 @@ subroutine upnewwf(indt, i0, indtm, typecomp, nshell, ioptorb, iocc, kel, nel, r &, kion, ioptorb, indpar_tab, indorb_tab, indshell_tab, mindist, phs, dd, z, dimx, dimy& &, nelskip, iesjas, rmu, rion, cnorm, zeta, rmucos) else + if (.not.use_qmckl) then !$omp parallel do default(shared)& !$omp private(i,ll,i_ion,indpar,indorb,indshell,do_makefun,yeszero_z) - do i = 1, nshell - indpar = max(indpar_tab(i), 0) - indorb = indorb_tab(i) - indshell = indshell_tab(i) - do_makefun = .true. - if (yes_scemama .and. ioptorb(i) .ne. 200) then - i_ion = kion(i) -! do_makefun=.false. - if (slaterorb_read(i + mshift)) then - do ll = i0u, indtm - if (dd(indpar + 1)*r(ll, i_ion) .lt. lepsbas) then -! do_makefun=.true. - yeszero_z(ll) = .false. - else - yeszero_z(ll) = .true. - end if - end do - else -! do_makefun=.true. ! I am afraid the compiler vectorize wrong - do ll = i0u, indtm - if (dd(indpar + 1)*r(ll, i_ion)*r(ll, i_ion) .lt. lepsbas) then - yeszero_z(ll) = .false. - else - yeszero_z(ll) = .true. + do i = 1, nshell + indpar = max(indpar_tab(i), 0) + indorb = indorb_tab(i) + indshell = indshell_tab(i) + do_makefun = .true. + if (yes_scemama .and. ioptorb(i) .ne. 200) then + i_ion = kion(i) + if (slaterorb_read(i + mshift)) then + do ll = i0u, indtm + if (dd(indpar + 1)*r(ll, i_ion) .lt. lepsbas) then + yeszero_z(ll) = .false. + else + yeszero_z(ll) = .true. + end if + end do + else + do ll = i0u, indtm + if (dd(indpar + 1)*r(ll, i_ion)*r(ll, i_ion) .lt. lepsbas) then + yeszero_z(ll) = .false. + else + yeszero_z(ll) = .true. + end if + end do + end if + do_makefun = .not. all(yeszero_z(i0u:indtm)) + end if + if (do_makefun) then + call makefun(ioptorb(i), indt, i0, indtmin, indtm, typecomp& + &, indpar, indorb, indshell, nelskip, z, dd, zeta(kion(i)), r(0, kion(i)), rmu(1, 0, kion(i))& + &, distp(dimp*(i - 1) + 1), iflagnorm, cnorm(i)) + if (yes_scemama .and. indtm .gt. 0 .and. ioptorb(i) .ne. 200) then + do ll = i0, indtm + if (yeszero_z(ll)) then + z(indorb_tab(i) + 1:indorb_tab(i + 1), ll) = 0.d0 + end if + end do + if (yeszero_z(0) .and. typecomp .ne. 1) then + do ll = indt + 1, indt + 4 + z(indorb_tab(i) + 1:indorb_tab(i + 1), ll) = 0.d0 + end do end if - end do + end if + end if + end do +!$omp end parallel do +#ifdef _QMCKL + else + if (npoints_qmckl == 0) then + rc = qmckl_get_ao_basis_ao_num(qmckl_ctx, ao_num) + if (rc /= QMCKL_SUCCESS) then + write(0,*) 'Error getting ao_num' + call abort() end if - do_makefun = .not. all(yeszero_z(i0u:indtm)) end if - if (do_makefun) then - call makefun(ioptorb(i), indt, i0, indtmin, indtm, typecomp & - , indpar, indorb, indshell, nelskip, z, dd, zeta(kion(i)), r(0, kion(i)), rmu(1, 0, kion(i)) & - , distp(dimp*(i - 1) + 1), iflagnorm, cnorm(i)) - if (yes_scemama .and. indtm .gt. 0 .and. ioptorb(i) .ne. 200) then - do ll = i0, indtm - if (yeszero_z(ll)) then - z(indorb_tab(i) + 1:indorb_tab(i + 1), ll) = 0.d0 - end if - end do - if (yeszero_z(0) .and. typecomp .ne. 1) then - do ll = indt + 1, indt + 4 - z(indorb_tab(i) + 1:indorb_tab(i + 1), ll) = 0.d0 + + if (typecomp.eq.1) then ! Only values + npoints_qmckl = (indtm-i0+1)*1_8 + allocate(ao_value_qmckl(ao_num, i0:indtm)) + rc = qmckl_set_point(qmckl_ctx, 'N', npoints_qmckl, kel(1:3,1,i0:indtm), 3_8*npoints_qmckl) + + if (rc /= QMCKL_SUCCESS) then + write(0,*) 'Error setting electron coords' + call abort() + end if + + rc = qmckl_get_ao_basis_ao_value_inplace( & + qmckl_ctx, & + ao_value_qmckl, & + ao_num*npoints_qmckl) + + if (rc /= QMCKL_SUCCESS) then + write(0,*) 'Error getting AOs from QMCkl' + call abort() + end if + + do jj=i0,indtm + do ii=1,ao_num + z(ii,jj) = ao_value_qmckl(ii,jj) end do - end if + end do + + deallocate(ao_value_qmckl) + else + npoints_qmckl = (indtm-i0)*1_8 + allocate(ao_vgl_qmckl(ao_num, 5)) + allocate(ao_value_qmckl(ao_num, i0+1:indtm)) + rc = qmckl_set_point(qmckl_ctx, 'N', npoints_qmckl, kel(1:3,1,i0+1:indtm), 3_8*npoints_qmckl) + + if (rc /= QMCKL_SUCCESS) then + write(0,*) 'Error setting electron coords' + call abort() + end if + + rc = qmckl_get_ao_basis_ao_value_inplace( & + qmckl_ctx, & + ao_value_qmckl, & + ao_num*npoints_qmckl) + + if (rc /= QMCKL_SUCCESS) then + write(0,*) 'Error getting AOs from QMCkl' + call abort() + end if + + rc = qmckl_set_point(qmckl_ctx, 'N', 1_8, kel(1:3,1,i0), 3_8) + + if (rc /= QMCKL_SUCCESS) then + write(0,*) 'Error setting electron coords 2' + call abort() end if + + rc = qmckl_get_ao_basis_ao_vgl_inplace( & + qmckl_ctx, & + ao_vgl_qmckl, & + ao_num*5_8) + + if (rc /= QMCKL_SUCCESS) then + write(0,*) 'Error getting AOs from QMCkl 2' + call abort() + end if + + do jj=i0+1,indtm + do ii=1,ao_num + z(ii,jj) = ao_value_qmckl(ii,jj) + end do + end do + + do ii=1,ao_num + z(ii,i0) = ao_vgl_qmckl(ii,1) + z(ii,indt+1) = ao_vgl_qmckl(ii,2) + z(ii,indt+2) = ao_vgl_qmckl(ii,3) + z(ii,indt+3) = ao_vgl_qmckl(ii,4) + z(ii,indt+4) = ao_vgl_qmckl(ii,5) + end do + + deallocate(ao_value_qmckl) + deallocate(ao_vgl_qmckl) end if - end do -!$omp end parallel do +#endif + end if end if - ! if(iflagnorm.lt.0) then - ! iflagnorm=-iflagnorm - ! if(iflagnorm.ne.1) iflagnorm=2 - ! endif - ! Restore that the tables are for the Jastrow if (iesjas) then - ! indpar_tab(1)=-1 LBox = LBox_sav end if end if @@ -515,11 +611,9 @@ subroutine makefun_grid(distp_true_, distp_, rmusin, r, rphs, cphs_r& indshell = indshell_tab(i) do_makefun = .true. if (yes_scemama .and. ioptorb(i) .ne. 200) then -! do_makefun=.false. if (slaterorb_read(i + mshift)) then do ll = i0u, indtm if (dd(indpar + 1)*r(ll, i_ion) .lt. lepsbas) then -! do_makefun=.true. yeszero_z(ll) = .false. else yeszero_z(ll) = .true. @@ -528,7 +622,6 @@ subroutine makefun_grid(distp_true_, distp_, rmusin, r, rphs, cphs_r& else do ll = i0u, indtm if (dd(indpar + 1)*r(ll, i_ion)*r(ll, i_ion) .lt. lepsbas) then -! do_makefun=.true. yeszero_z(ll) = .false. else yeszero_z(ll) = .true. @@ -555,8 +648,6 @@ subroutine makefun_grid(distp_true_, distp_, rmusin, r, rphs, cphs_r& end if select case (case_upz) -! if(ipc.eq.2.and..not.iesjas) then ! complex case -! if(typecomp.eq.1) then case (1) do ll = i0, indtm call zaxrpy(indorb_tab(i), indorb, cphs_r(ll, i_ion), distp_(1, ll), z(1, ll)) @@ -568,24 +659,18 @@ subroutine makefun_grid(distp_true_, distp_, rmusin, r, rphs, cphs_r& do ll = indt + 1, indt + 4 call zaxrpy(indorb_tab(i), indorb, cphs_r(0, i_ion), distp_(1, ll), z(1, ll)) end do -! else ! real case -! if(typecomp.eq.1) then case (3) do ll = i0, indtm call daxrpy(indorb_tab(i), indorb, rphs(ll, i_ion), distp_(1, ll), z(1, ll)) end do -! else case (4) do ll = i0, indtm call daxrpy(indorb_tab(i), indorb, rphs(ll, i_ion), distp_(1, ll), z(1, ll)) end do - ! rphs(0) = exp(-zimg*sum(phs(:)*((kpip(:)-rmucos(:,kion(i),0))))) do ll = indt + 1, indt + 4 call daxrpy(indorb_tab(i), indorb, rphs(0, i_ion), distp_(1, ll), z(1, ll)) end do end select -! endif -! endif end if ! endif do_makefun end if end do @@ -597,9 +682,15 @@ end subroutine makefun_grid subroutine upnewwf0(indt, typecomp, nshell, ioptorb, iocc, kel, nel, r, rmu, dd, zeta, rion, distp, z, nelskip, & nion, kion, iflagnorm, cnorm, LBox, rmucos, rmusin, mindist, indpar_tab, indorb_tab, indshell_tab, yesupel) - use allio, only: ikshift, iespbc, rank, gamma_point, yes_crystalj, yes_scemama, lepsbas, slaterorb_read, nshell_det + use allio, only: ikshift, iespbc, rank, gamma_point, yes_crystalj& + &, yes_scemama, lepsbas, slaterorb_read, nshell_det& + &, use_qmckl, qmckl_ctx use Cell, only: cellscale, cellpi, rphase, phase2pi, phase2pi_down, sinphase, cosphase, s2r, car2cry use Constants, only: ipc + use qmckl +#ifdef _QMCKL_GPU + !use qmckl_gpu +#endif implicit none ! input @@ -613,7 +704,6 @@ subroutine upnewwf0(indt, typecomp, nshell, ioptorb, iocc, kel, nel, r, rmu, dd, ! specify the phase choice for crystal basis, ignored for Jastrow logical, intent(in) :: yesupel logical do_makefun, yeszero_z - ! real(8), dimension(:,:,:), allocatable:: distp_true ! local variables real*8 kpip(3) @@ -631,6 +721,11 @@ subroutine upnewwf0(indt, typecomp, nshell, ioptorb, iocc, kel, nel, r, rmu, dd, real*8 dd(indpar_tab(nshell + 1)) real*8 phs(3) ! scratch phase for Lbox=3 ! + ! QMCKL + integer*4 :: rc + integer*8, save :: ao_num=0, npoints_qmckl=0 + double precision, allocatable :: ao_vgl_qmckl(:,:), ao_value_qmckl(:,:) + ! integer, external :: omp_get_num_threads ! --------------------------------------------------------------------- ! orbital types are defined by the variable Lbox: @@ -805,15 +900,15 @@ subroutine upnewwf0(indt, typecomp, nshell, ioptorb, iocc, kel, nel, r, rmu, dd, !$omp parallel do default(shared) private(k) do k = 1, nion rmu(:, 0, k) = kel(:, 1, 0) - rion(:, k) - rmucos(:, 0, k) = & - &car2cry(:, 1)*rmu(1, 0, k) + car2cry(:, 2)*rmu(2, 0, k) + car2cry(:, 3)*rmu(3, 0, k) + rmucos(:, 0, k) = & + &car2cry(:, 1)*rmu(1, 0, k) + car2cry(:, 2)*rmu(2, 0, k) + car2cry(:, 3)*rmu(3, 0, k) rmucos(1, 0, k) = anint(rmucos(1, 0, k)/cellscale(1)) rmucos(2, 0, k) = anint(rmucos(2, 0, k)/cellscale(2)) rmucos(3, 0, k) = anint(rmucos(3, 0, k)/cellscale(3)) - rmu(:, 0, k) = rmu(:, 0, k)& - & - s2r(:, 1)*rmucos(1, 0, k) - s2r(:, 2)*rmucos(2, 0, k) - s2r(:, 3)*rmucos(3, 0, k) - r(0, k) = max(dsqrt(rmu(1, 0, k)**2 + rmu(2, 0, k)**2 + & - rmu(3, 0, k)**2), mindist) + rmu(:, 0, k) = rmu(:, 0, k) & + & - s2r(:, 1)*rmucos(1, 0, k) - s2r(:, 2)*rmucos(2, 0, k) - s2r(:, 3)*rmucos(3, 0, k) + r(0, k) = max(dsqrt(rmu(1, 0, k)**2 + rmu(2, 0, k)**2 + & + &rmu(3, 0, k)**2), mindist) end do !$omp end parallel do @@ -823,8 +918,8 @@ subroutine upnewwf0(indt, typecomp, nshell, ioptorb, iocc, kel, nel, r, rmu, dd, rmu(1, 0, k) = kel(1, 1, 0) - rion(1, k) rmu(2, 0, k) = kel(2, 1, 0) - rion(2, k) rmu(3, 0, k) = kel(3, 1, 0) - rion(3, k) - r(0, k) = max(dsqrt(rmu(1, 0, k)**2 + rmu(2, 0, k)**2 + & - rmu(3, 0, k)**2), mindist) + r(0, k) = max(dsqrt(rmu(1, 0, k)**2 + rmu(2, 0, k)**2 + & + &rmu(3, 0, k)**2), mindist) end do !$omp end parallel do end if @@ -853,66 +948,120 @@ subroutine upnewwf0(indt, typecomp, nshell, ioptorb, iocc, kel, nel, r, rmu, dd, indpar = max(indpar_tab(i), 0) indorb = indorb_tab(i) indshell = indshell_tab(i) - call makefun0_bump(ioptorb(i), iocc, indt, typecomp & - , indpar, indorb, indshell, nelskip, z, dd, r(0, kion(i)), rmu(1, 0, kion(i))& - &, distp(dimp*(i - 1) + 1), iflagnorm, cnorm(i)) + call makefun0_bump(ioptorb(i), iocc, indt, typecomp & + &, indpar, indorb, indshell, nelskip, z, dd, r(0, kion(i)), rmu(1, 0, kion(i))& + &, distp(dimp*(i - 1) + 1), iflagnorm, cnorm(i)) end do !$omp end parallel do elseif (abs(LBox) .eq. 3.d0) then call makefun_grid0(distp(indp4), distp(indp5), distp(indp3), distp(indp2)& - &, distp(indp1), distp& - &, nshell, nion, indt, typecomp, ishift, iflagnorm& - &, kion, ioptorb, indpar_tab, indorb_tab, indshell_tab, mindist, phs, dd, z, dimx, dimy& - &, nelskip, iesjas, rmu, rion, cnorm, zeta, rmucos) + &, distp(indp1), distp & + &, nshell, nion, indt, typecomp, ishift, iflagnorm & + &, kion, ioptorb, indpar_tab, indorb_tab, indshell_tab, mindist, phs, dd, z, dimx, dimy& + &, nelskip, iesjas, rmu, rion, cnorm, zeta, rmucos) else + if (.not.use_qmckl) then !$omp parallel do default(shared)& !$omp private(i,ll,i_ion,indpar,indorb,indshell,do_makefun,yeszero_z) - do i = 1, nshell - indpar = max(indpar_tab(i), 0) - indorb = indorb_tab(i) - indshell = indshell_tab(i) - do_makefun = .true. - if (yes_scemama .and. ioptorb(i) .ne. 200) then - i_ion = kion(i) -! do_makefun=.false. - if (slaterorb_read(i + mshift)) then - if (dd(indpar + 1)*r(0, i_ion) .lt. lepsbas) then -! do_makefun=.true. - yeszero_z = .false. - else - yeszero_z = .true. - end if - else -! do_makefun=.true. ! I am afraid the compiler vectorize wrong - if (dd(indpar + 1)*r(0, i_ion)*r(0, i_ion) .lt. lepsbas) then - yeszero_z = .false. + do i = 1, nshell + indpar = max(indpar_tab(i), 0) + indorb = indorb_tab(i) + indshell = indshell_tab(i) + do_makefun = .true. + if (yes_scemama .and. ioptorb(i) .ne. 200) then + i_ion = kion(i) + if (slaterorb_read(i + mshift)) then + if (dd(indpar + 1)*r(0, i_ion) .lt. lepsbas) then + yeszero_z = .false. + else + yeszero_z = .true. + end if else - yeszero_z = .true. + if (dd(indpar + 1)*r(0, i_ion)*r(0, i_ion) .lt. lepsbas) then + yeszero_z = .false. + else + yeszero_z = .true. + end if end if + do_makefun = .not. yeszero_z + end if + if (do_makefun) then + call makefun0(ioptorb(i), indt, typecomp & + &, indpar, indorb, indshell, nelskip, z, dd, zeta(kion(i)), r(0, kion(i)), rmu(1, 0, kion(i))& + &, distp(dimp*(i - 1) + 1), iflagnorm, cnorm(i)) + end if + end do +!$omp end parallel do +#ifdef _QMCKL + else + if (ao_num == 0) then + rc = qmckl_get_ao_basis_ao_num(qmckl_ctx, ao_num) + if (rc /= QMCKL_SUCCESS) then + print *, 'Error getting ao_num', rc, qmckl_ctx, ao_num + call abort() end if - do_makefun = .not. yeszero_z end if - if (do_makefun) then - call makefun0(ioptorb(i), indt, typecomp & - , indpar, indorb, indshell, nelskip, z, dd, zeta(kion(i)), r(0, kion(i)), rmu(1, 0, kion(i)) & - , distp(dimp*(i - 1) + 1), iflagnorm, cnorm(i)) + + if (typecomp.eq.1) then ! Only values + rc = qmckl_set_point(qmckl_ctx, 'N', 1_8, kel(1:3,1,0), 3_8) + + if (rc /= QMCKL_SUCCESS) then + print *, 'Error setting electron coords' + call abort() + end if + + rc = qmckl_get_ao_basis_ao_value_inplace( & + &qmckl_ctx, & + &z(1,0), & + &ao_num) + + if (rc /= QMCKL_SUCCESS) then + print *, 'Error getting AOs from QMCkl' + call abort() + end if + + else + allocate(ao_vgl_qmckl(ao_num, 5)) + + rc = qmckl_set_point(qmckl_ctx, 'N', 1_8, kel(1:3,1,0), 3_8) + + if (rc /= QMCKL_SUCCESS) then + print *, 'Error setting electron coords 2' + call abort() + end if + + rc = qmckl_get_ao_basis_ao_vgl_inplace( & + &qmckl_ctx, & + &ao_vgl_qmckl, & + &ao_num*5_8) + + if (rc /= QMCKL_SUCCESS) then + print *, 'Error getting AOs from QMCkl 2' + call abort() + end if + + do ii=1,ao_num + z(ii,0) = ao_vgl_qmckl(ii,1) + z(ii,indt+1) = ao_vgl_qmckl(ii,2) + z(ii,indt+2) = ao_vgl_qmckl(ii,3) + z(ii,indt+3) = ao_vgl_qmckl(ii,4) + z(ii,indt+4) = ao_vgl_qmckl(ii,5) + end do + + deallocate(ao_vgl_qmckl) end if - end do -!$omp end parallel do +#endif + end if end if - ! if(iflagnorm.lt.0) then - ! iflagnorm=-iflagnorm - ! if(iflagnorm.ne.1) iflagnorm=2 - ! endif - ! Restore that the tables are for the Jastrow if (iesjas) then - ! indpar_tab(1)=-1 LBox = LBox_sav end if + return end subroutine upnewwf0 + subroutine makefun_grid0(distp_true_, distp_, rmusin, r, rphs, cphs_r& &, nshell, nion, indt, typecomp, ishift, iflagnorm& &, kion, ioptorb, indpar_tab, indorb_tab, indshell_tab, mindist, phs, dd, z, dimx, dimy& diff --git a/src/m_common/CMakeLists.txt b/src/m_common/CMakeLists.txt index 37f0f2b..bb21698 100644 --- a/src/m_common/CMakeLists.txt +++ b/src/m_common/CMakeLists.txt @@ -61,82 +61,84 @@ if( ${LIBRARY} MATCHES common-.* ) mod_extpot.f90 mod_IO.f90 mpiio.f90 + nvtx.f90 + qmckl.f90 sub_comm.f90 symmetries.f90 + trexio.f90 types.f90 # subroutines - kind.f90 - fft_scalar.f90 - fft_stick.c - fftw.c atom_weight.f90 - plot_3d_data.f90 - plot_3d_data_tilted.f90 - dgemm_my.f90 - error.f90 - ioptorbcontr.f90 - memOP.f90 - pareff.f90 - rotate_tools.f90 - slaterorb.f90 - zgemm_my.f90 bconstraint.f90 + bconstrbra.f90 bconstrbr_complex.f90 bconstrbr.f90 - bconstrbra.f90 - checkmatrix.f90 + bspline90_22.f90 + constrbra_complex.f90 + constrbra.f90 + constrbr_complex.f90 + constrbr.f90 + convertdec.f90 + copy_eagp.f90 + definition.f90 + descriptors.f90 + dgemm_my.f90 dscalzero.f90 + dsktri.f90 + dsktrs.f90 dsortx.f90 - iesdr1iesd.f90 - iesdr2iesd.f90 - upsim.f90 - upsimp.f90 - copy_eagp.f90 + error.f90 extv.f90 - bspline90_22.f90 - dsktrs.f90 + fft_scalar.f90 + fft_stick.c + fftw.c + fileOP.f90 fillmatrix.f90 + findmaxmat.f90 findrionref.f90 forces_ext.f90 + fortran.c + fort11_io.f90 graham.f90 grahamo.f90 + checkmatrix.f90 + iesdr1iesd.f90 + iesdr2iesd.f90 + initconf_pbc.f90 invsymeps.f90 + io.c + ioptorbcontr.f90 + kind.f90 + max_ovlp.f90 + memOP.f90 molec_pfaff.f90 - symmetrize_agp.f90 - upwinv.f90 - upwinvp.f90 - write_type_orb.f90 - zsktri.f90 - dsktri.f90 - save_jall_fn.f90 - scalevect.f90 - zsktrs_qp.f90 - zsktrs.f90 - update_jastrowall.f90 + pareff.f90 + plot_3d_data.f90 + plot_3d_data_tilted.f90 + print_eigenvalues.f90 random.f90 - convertdec.f90 - io.c - fortran.c randomnumber.c - fort11_io.f90 + ran.f90 read_pseudo.f90 + rotate_tools.f90 + save_jall_fn.f90 + scalevect.f90 + slaterorb.f90 + symmetrize_agp.f90 Thomas_Fermi_model.f90 - definition.f90 - descriptors.f90 - fileOP.f90 - upvpotaa.f90 - constrbr.f90 - constrbr_complex.f90 - findmaxmat.f90 - initconf_pbc.f90 - print_eigenvalues.f90 updatedwarp.f90 - constrbra.f90 - constrbra_complex.f90 - max_ovlp.f90 + update_jastrowall.f90 + upsim.f90 + upsimp.f90 + upvpotaa.f90 upvpot_ei.f90 - nvtx.f90 - ran.f90 + upwinv.f90 + upwinvp.f90 + write_type_orb.f90 + zgemm_my.f90 + zsktri.f90 + zsktrs.f90 + zsktrs_qp.f90 ${HELP_FILE} ${VER_FILE} ) diff --git a/src/m_common/Makefile b/src/m_common/Makefile index 9ee1c2c..1e2dfdd 100644 --- a/src/m_common/Makefile +++ b/src/m_common/Makefile @@ -17,6 +17,7 @@ TARGET_MODULES := $(BUILD_DIR)/common_module.a # First set modules: MODULE_SRCS := $(SRC_DIR)/constants.f90 \ + $(SRC_DIR)/qmckl.f90 \ $(SRC_DIR)/symmetries.f90 \ $(SRC_DIR)/cell.f90 \ $(SRC_DIR)/dielectric.f90 \ diff --git a/src/m_common/allio.f90 b/src/m_common/allio.f90 index 7bc81e2..59db0fe 100644 --- a/src/m_common/allio.f90 +++ b/src/m_common/allio.f90 @@ -19,6 +19,7 @@ module allio use Ewald use types use kpoints_mod + use qmckl use io_m, only: lchlen ! by E. Coccia (22/11/10) use extpot, only: ext_pot, link_atom, mm_restr, write_rwalk @@ -126,7 +127,8 @@ module allio divide_tpar, multiply_tpar, n_sigmas_tpar !end added Andrea Tirelli - integer*8 :: handle + integer(kind=qmckl_context) :: qmckl_ctx + integer(kind=8) :: handle integer*4 ldworkspace, lzworkspace, dev_Info(1) real*8, allocatable, dimension(:) :: dev_dgetrf_workspace complex*16, allocatable, dimension(:) :: dev_zgetrf_workspace @@ -211,6 +213,7 @@ module allio integer npsa, lmax, istart, indteff, lzeff character(3) pseudoname character(60) pseudofile + character(60) :: trexiofile = '' integer, dimension(:, :), allocatable :: nparpshell, jpseudo & &, indtm integer, dimension(:), allocatable :: kindion, pshell @@ -305,7 +308,7 @@ module allio &, real_contracted, gauge_fixing, yesmin_read& &, noopt_onebody, real_agp, softcusp, scalermax, yeswritebead, yes_hessc& &, no_sjbra, manyfort10, shift_origin, shiftx, shifty, shiftz& - &, double_mesh, change_parr& + &, double_mesh, change_parr, use_qmckl, setup_qmckl& &, default_epsdgel, read_molecul, hybyes, pfaffup, k6gen, noblocking, add_diff& &, lrdmc_der, lrdmc_nonodes, nosingledet, enforce_detailb, nowrite12& &, yes_fastbranch, flush_write, yes_adams, only_molecular, add_offmol, novec_loop1 @@ -367,7 +370,8 @@ module allio namelist /pseudo/ nintpsa, npsamax, pseudorandom - namelist /readio/ ncore, np3, np, iread, writescratch, wherescratch, unreliable, ifreqdump, nowrite12, flush_write + namelist /readio/ ncore, np3, np, iread, writescratch, wherescratch& + &, unreliable, ifreqdump, nowrite12, flush_write, trexiofile, setup_qmckl namelist /vmc/ tstep, hopfraction, epscut, epstlrat, epscuttype, alat2v, shift, change_epscut, change_tstep & &, epsvar, theta_reg, true_wagner, cutweight, nbra_cyrus, typereg, npow diff --git a/src/m_common/ioptorbcontr.f90 b/src/m_common/ioptorbcontr.f90 index 5a8efdf..14c16fb 100644 --- a/src/m_common/ioptorbcontr.f90 +++ b/src/m_common/ioptorbcontr.f90 @@ -452,6 +452,10 @@ function multioptorb(ioptorb) multioptorb = 11 ! h case (73, 900) multioptorb = 13 ! i + case (90:99) ! cartesian orbitals + multioptorb = (ioptorb - 90 + 2) * (ioptorb - 90 + 1) / 2 + case (10000:11000) + multioptorb = ioptorb - 10000 case default multioptorb = 0 end select diff --git a/src/m_common/qmckl.f90 b/src/m_common/qmckl.f90 new file mode 100644 index 0000000..2ea70b5 --- /dev/null +++ b/src/m_common/qmckl.f90 @@ -0,0 +1,412 @@ +#ifdef _QMCKL +#include "qmckl_f.F90" + +subroutine setup_qmckl_ctx(& + & number_of_atoms& + &, number_of_shells& + &, atomic_numbers& + &, atomic_coordinates& + &, shell_to_ion& + &, shell_types& + &, shell_exponents& + &, context) + + use qmckl + use constants, only: pi + + implicit none + integer*4, intent(in) :: number_of_atoms + integer*4, intent(in) :: number_of_shells + integer(kind=qmckl_context), intent(out) :: context + integer*4, intent(in) :: shell_to_ion(number_of_shells) + integer*4, intent(in) :: shell_types(number_of_shells) + + real*8, intent(in) :: shell_exponents(number_of_shells) + real*8, intent(in) :: atomic_numbers(number_of_atoms) + real*8, intent(in) :: atomic_coordinates(3,number_of_atoms) + + integer(kind=qmckl_exit_code) :: rc + + integer*4 :: ii, jj, kk, ll, mm, count + + integer*4 :: shell_types_(number_of_shells) + integer*8 :: primitive_numbers_(number_of_shells) + integer*8 :: primitive_to_shell_(number_of_shells) + integer*8 :: ao_factor_number_ + + real*8 :: shell_factor_(number_of_shells) + real*8 :: shell_exponents_(number_of_shells) + real*8 :: shell_coefficients_(number_of_shells) + real*8 :: prim_factor_(number_of_shells) + real*8, dimension(:), allocatable :: ao_factor_ + + ! Number of shell for each atom + integer*8 :: nucleus_shell_num(number_of_atoms) + integer*8 :: nucleus_shell_index(number_of_atoms) + + !##################################################################### + !# # + !# This subroutine sets up the QMCkl context. # + !# Setup nuclei information. # + !# # + !##################################################################### + +#ifdef _DEBUG + write(*,*) "QMCKL: Creating context" +#endif + + context = qmckl_context_create() + if (context.eq.QMCKL_NULL_CONTEXT) then + write(0,*) "Error: qmckl_context_create" + stop 1 + end if + +#ifdef _DEBUG + write(*,'("QMCKL: Setting up nuclei number: ",I4)') number_of_atoms +#endif + + rc = qmckl_set_nucleus_num(context, 1_8 * number_of_atoms) + if (rc.ne.QMCKL_SUCCESS) then + write(0,*) "Error: qmckl_set_nucleus_num" + stop 1 + end if + +#ifdef _DEBUG + write(*,'("QMCKL: Setting up nuclei charge: ",F4.2)') atomic_numbers +#endif + + rc = qmckl_set_nucleus_charge(context, 1.0_8 * idnint(atomic_numbers), 1_8 * size(atomic_numbers)) + if (rc.ne.QMCKL_SUCCESS) then + write(0,*) "Error: qmckl_set_nucleus_charge" + stop 1 + end if + +#ifdef _DEBUG + write(*,'("QMCKL: Setting up nuclei coord: ")') + do ii = 1, number_of_atoms + write(*,'(3F8.3)') atomic_coordinates(:,ii) + end do +#endif + + rc = qmckl_set_nucleus_coord(context, "N", atomic_coordinates, 3_8 * number_of_atoms) + if (rc.ne.QMCKL_SUCCESS) then + write(0,*) "Error: qmckl_set_nucleus_coord" + stop 1 + end if + + !##################################################################### + !# # + !# Setup the basis set. # + !# # + !##################################################################### + +#ifdef _DEBUG + write(*,'("QMCKL: Setting up basis set type: G")') +#endif + + rc = qmckl_set_ao_basis_type(context, "G") + if (rc.ne.QMCKL_SUCCESS) then + write(0,*) "Error: qmckl_set_ao_basis_type" + stop 1 + end if + +#ifdef _DEBUG + write(*,'("QMCKL: Setting up basis set shell number: ",I4)') number_of_shells +#endif + + rc = qmckl_set_ao_basis_shell_num(context, 1_8 * number_of_shells) + if (rc.ne.QMCKL_SUCCESS) then + write(0,*) "Error: qmckl_set_ao_basis_shell_num" + stop 1 + end if + +#ifdef _DEBUG + write(*,'("QMCKL: Setting up basis set prim number:")') + do ii = 1, number_of_shells + write(*,'(I4)') shell_to_ion(ii) + end do +#endif + + rc = qmckl_set_ao_basis_prim_num(context, 1_8 * number_of_shells) + if (rc.ne.QMCKL_SUCCESS) then + write(0,*) "Error: qmckl_set_ao_basis_prim_num" + stop 1 + end if + + nucleus_shell_num = 0_8 + do ii = 1, size(shell_to_ion) + nucleus_shell_num(shell_to_ion(ii)) = nucleus_shell_num(shell_to_ion(ii)) + 1 + end do + +#ifdef _DEBUG + write(*,'("QMCKL: Setting up basis set nucleus shell number: ")') + do ii = 1, number_of_atoms + write(*,'(I4)') nucleus_shell_num(ii) + end do +#endif + + rc = qmckl_set_ao_basis_nucleus_shell_num(context, nucleus_shell_num, 1_8 * number_of_atoms) + + if (rc.ne.QMCKL_SUCCESS) then + write(0,*) "Error: qmckl_set_ao_basis_nucleus_shell_num" + stop 1 + end if + + do ii = 1, number_of_atoms + nucleus_shell_index(ii) = sum(nucleus_shell_num(1:ii-1)) + end do + +#ifdef _DEBUG + write(*,'("QMCKL: Setting up basis set nucleus shell index: ")') + do ii = 1, number_of_atoms + write(*,'(I4)') nucleus_shell_index(ii) + end do +#endif + + rc = qmckl_set_ao_basis_nucleus_index(context, nucleus_shell_index, 1_8 * number_of_atoms) + + if (rc.ne.QMCKL_SUCCESS) then + write(0,*) "Error: qmckl_get_ao_basis_nucleus_index" + stop 1 + end if + +#ifdef _DEBUG + print *, "QMCKL: Setting up basis set shell type (reading): " + do ii = 1, number_of_shells + write(*,'(I4)') shell_types(ii) + end do +#endif + + do ii = 1, number_of_shells + if (shell_types(ii).gt.99) then + write(0,*) "Error: shell_indeces(ii) > 99" + stop 1 + end if + if (shell_types(ii).lt.90) then + if (shell_types(ii).eq.16.or. & + & shell_types(ii).eq.36) then + shell_types_(ii) = shell_types(ii) - 90 + write(0,*) "Warning: shell_indeces(ii) < 90, setting to s-type or p-type shell." + else + write(0,*) "Error: shell_indeces(ii) < 90" + stop 1 + end if + end if + if (shell_types(ii).eq.16) then + shell_types_(ii) = 0 + else if (shell_types(ii).eq.36) then + shell_types_(ii) = 1 + else + shell_types_(ii) = shell_types(ii) - 90 + end if + end do + +#ifdef _DEBUG + print *, "QMCKL: Setting up basis set shell type: " + do ii = 1, number_of_shells + write(*,'(I4)') shell_types_(ii) + end do +#endif + + rc = qmckl_set_ao_basis_shell_ang_mom(context, shell_types_, 1_8 * number_of_shells) + + if (rc.ne.QMCKL_SUCCESS) then + write(0,*) "Error: qmckl_set_ao_basis_shell_ang_mom" + stop 1 + end if + + do ii = 1, number_of_shells + primitive_numbers_(ii) = 1_8 + end do + +#ifdef _DEBUG + write(*,'("QMCKL: Setting up primitive numbers for shells:")') + do ii = 1, number_of_shells + write(*,'(I4)') primitive_numbers_(ii) + end do +#endif + + rc = qmckl_set_ao_basis_shell_prim_num(context& + &, primitive_numbers_& + &, 1_8 * number_of_shells) + + if (rc.ne.QMCKL_SUCCESS) then + write(0,*) "Error: qmckl_set_ao_basis_shell_prim_num" + stop 1 + end if + + do ii = 1, number_of_shells + primitive_to_shell_(ii) = ii - 1 + end do + +#ifdef _DEBUG + write(*,'("QMCKL: Setting up primitive to shell map:")') + do ii = 1, number_of_shells + write(*,'(I4)') primitive_to_shell_(ii) + end do +#endif + + rc = qmckl_set_ao_basis_shell_prim_index(context& + &, primitive_to_shell_& + &, 1_8 * number_of_shells) + + if (rc.ne.QMCKL_SUCCESS) then + write(0,*) "Error: qmckl_set_ao_basis_nucleus_shell_num" + stop 1 + end if + + do ii = 1, number_of_shells + shell_factor_(ii) = 1.0_8 + end do + +#ifdef _DEBUG + write(*,'("QMCKL: Setting up shell factor:")') + do ii = 1, number_of_shells + write(*,'(F8.3)') shell_factor_(ii) + end do +#endif + + rc = qmckl_set_ao_basis_shell_factor(context& + &, shell_factor_& + &, 1_8 * number_of_shells) + + if (rc.ne.QMCKL_SUCCESS) then + write(0,*) "Error: qmckl_set_ao_basis_shell_factor" + stop 1 + end if + + do ii = 1, number_of_shells + shell_exponents_(ii) = shell_exponents(ii) + end do + +#ifdef _DEBUG + write(*,'("QMCKL: Setting up shell exponents:")') + do ii = 1, number_of_shells + write(*,'(F8.3)') shell_exponents_(ii) + end do +#endif + + rc = qmckl_set_ao_basis_exponent(context& + &, shell_exponents_& + &, 1_8 * number_of_shells) + + if (rc /= 0) then + write(0,*) "qmckl_set_ao_basis_exponent failed" + stop 1 + end if + + do ii = 1, number_of_shells + shell_coefficients_(ii) = 1.0_8 + end do + +#ifdef _DEBUG + write(*,'("QMCKL: Setting up shell coefficients:")') + do ii = 1, number_of_shells + write(*,'(F8.3)') shell_coefficients_(ii) + end do +#endif + + rc = qmckl_set_ao_basis_coefficient(context& + &, shell_coefficients_& + &, 1_8 * number_of_shells) + + if (rc /= 0) then + write(0,*) "qmckl_set_ao_basis_coefficient failed" + stop 1 + end if + + do ii = 1, number_of_shells + prim_factor_(ii) = (2.0_8 * shell_exponents_(ii) / pi)**(3.0_8/4.0_8) + prim_factor_(ii) = prim_factor_(ii)& + & * (8.0_8 * shell_exponents_(ii))**(1.0_8 * shell_types_(ii) * 0.5_8) + end do + +#ifdef _DEBUG + write(*,'("QMCKL: Setting up primitive factor:")') + do ii = 1, number_of_shells + write(*,'(F8.3)') prim_factor_(ii) + end do +#endif + + rc = qmckl_set_ao_basis_prim_factor(context& + &, prim_factor_& + &, 1_8 * number_of_shells) + + if (rc /= 0) then + write(0,*) "qmckl_set_ao_basis_prim_factor failed" + stop 1 + end if + + ao_factor_number_ = 0_8 + do ii = 1, number_of_shells + ao_factor_number_ = ao_factor_number_& + &+ (shell_types_(ii) + 1_8) * (shell_types_(ii) + 2_8) / 2_8 + end do + +#ifdef _DEBUG + write(*,'("QMCKL: Setting up ao factor number: ",I4)') ao_factor_number_ +#endif + + rc = qmckl_set_ao_basis_ao_num(context& + &, ao_factor_number_) + + if (rc /= 0) then + write(0,*) "qmckl_set_ao_basis_ao_num failed" + stop 1 + end if + + if (allocated(ao_factor_)) deallocate(ao_factor_) + allocate(ao_factor_(ao_factor_number_)) + + count = 1 + do ll = 1, number_of_shells + do ii = shell_types_(ll), 0, -1 + do jj = shell_types_(ll) - ii, 0, -1 + kk = shell_types_(ll) - ii - jj + ao_factor_(count) = 1.0_8 + do mm = ii + 1, 2 * ii + ao_factor_(count) = ao_factor_(count) / mm + end do + do mm = jj + 1, 2 * jj + ao_factor_(count) = ao_factor_(count) / mm + end do + do mm = kk + 1, 2 * kk + ao_factor_(count) = ao_factor_(count) / mm + end do + ao_factor_(count) = dsqrt(ao_factor_(count)) + count = count + 1 + end do + end do + end do + +#ifdef _DEBUG + write(*,'("QMCKL: Setting up ao factor: ")') + do ii = 1, ao_factor_number_ + write(*,'(F8.3)') ao_factor_(ii) + end do +#endif + + rc = qmckl_set_ao_basis_ao_factor(context& + &, ao_factor_& + &, 1_8 * ao_factor_number_) + + if (rc /= 0) then + write(0,*) "qmckl_set_ao_basis_ao_factor failed" + stop 1 + end if + + if (allocated(ao_factor_)) deallocate(ao_factor_) + +end subroutine setup_qmckl_ctx + +#else +module qmckl + ! This module defines the dummy Fortran interface to the QMCkl library. + use, intrinsic :: iso_c_binding + integer , parameter :: qmckl_context = c_int64_t + integer*8, parameter :: QMCKL_NULL_CONTEXT = 0 + integer , parameter :: qmckl_exit_code = c_int32_t + integer(qmckl_exit_code), parameter :: QMCKL_SUCCESS = 0 + +end module +#endif diff --git a/src/m_common/slaterorb.f90 b/src/m_common/slaterorb.f90 index 27b0a42..b5481c7 100644 --- a/src/m_common/slaterorb.f90 +++ b/src/m_common/slaterorb.f90 @@ -32,9 +32,9 @@ function slaterorb(ioptorb) case (1:8, 10:15, 20:29, 30:35, 38:43, 50, 55:57, 66, 70, 71, 80:89, & 121:123, 125:130, 133:144) slaterorb = .true. - case (16:19, 36, 37, 44:49, 51:54, 58:59, 60:65, 68:69, 72, 73, 100:105, 108, 109, & + case (16:19, 36, 37, 44:49, 51:54, 58:59, 60:65, 68:69, 72, 73, 90:99, 100:105, 108, 109, & 131, 132, 145:155, 161, 1000:1099, 2000:2099, 1100:1199, & - 2100:2199, 1200:1299, 2200:2299, 200) + 2100:2199, 1200:1299, 2200:2299, 200, 10000:11000) ! the constant orbital is considered Gaussian slaterorb = .false. case default diff --git a/src/m_common/trexio.f90 b/src/m_common/trexio.f90 new file mode 100644 index 0000000..82c7706 --- /dev/null +++ b/src/m_common/trexio.f90 @@ -0,0 +1,16 @@ +#ifdef _TREXIO +#include "trexio_f.f90" +#else + +module trexio + use, intrinsic :: iso_c_binding + implicit none + + integer, parameter :: trexio_exit_code = c_int32_t + integer, parameter :: trexio_back_end_t = c_int32_t + integer, parameter :: trexio_t = c_size_t + + integer(trexio_exit_code), parameter :: TREXIO_SUCCESS = 0 + +end +#endif diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 610300b..88ccaa3 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -140,6 +140,8 @@ if(EXT_MODTEST) add_subdirectory(test_upwinvp_complex) #add_subdirectory(test_upwinvp_pfaff) #add_subdirectory(test_upwinvp_pfaff_complex) + + add_subdirectory(test_makefun) # ###################################################################### @@ -154,6 +156,7 @@ if(EXT_DFT) # add_subdirectory(test_dft_open) + add_subdirectory(test_dft_open_cartesian) add_subdirectory(test_dft_pbc_gamma) add_subdirectory(test_dft_pbc_twist_real) add_subdirectory(test_dft_pbc_twist_complex) @@ -199,6 +202,8 @@ if(EXT_TOOLS AND EXT_QMC) # MD add_subdirectory(test_MD_classical_vmc) add_subdirectory(test_MD_quantum_vmc) + + add_subdirectory(test_setup_qmckl) ###################################################################### diff --git a/test/test_dft_open_cartesian/CMakeLists.txt b/test/test_dft_open_cartesian/CMakeLists.txt new file mode 100644 index 0000000..cd9fc04 --- /dev/null +++ b/test/test_dft_open_cartesian/CMakeLists.txt @@ -0,0 +1,28 @@ +get_filename_component(PARENT_DIR ${CMAKE_CURRENT_SOURCE_DIR} NAME) + +foreach( EXECUTABLE IN LISTS EXECUTABLES_S_L + EXECUTABLES_P_L ) + if( ${EXECUTABLE} MATCHES prep-.* ) + set( PREFIX "" ) + if( ${EXECUTABLE} MATCHES ".*-mpi" ) + foreach(N 1;2) + set( PREFIX "mpirun -np ${N}" ) + set( _TEST_NAME "Test DFT open system cartesian (num mpi = ${N} ${EXECUTABLE})" ) + add_test_dependency_tree( + NAME ${_TEST_NAME} + COMMAND ${BASH_EXECUTABLE} cm.test.sh $ prep.out out_true.o REFERENCE_fort.10_new 5 ${PREFIX} + WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR} + DEPENDENCY_TREE ${PARENT_DIR} + ) + endforeach() + else() + set( _TEST_NAME "Test DFT open system cartesian (num mpi = ${N} ${EXECUTABLE})" ) + add_test_dependency_tree( + NAME ${_TEST_NAME} + COMMAND ${BASH_EXECUTABLE} cm.test.sh $ prep.out out_true.o REFERENCE_fort.10_new 5 ${PREFIX} + WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR} + DEPENDENCY_TREE ${PARENT_DIR} + ) + endif() + endif() +endforeach() diff --git a/test/test_dft_open_cartesian/REFERENCE_fort.10_new b/test/test_dft_open_cartesian/REFERENCE_fort.10_new new file mode 100644 index 0000000..d9e7438 --- /dev/null +++ b/test/test_dft_open_cartesian/REFERENCE_fort.10_new @@ -0,0 +1,318 @@ + # Nelup #Nel # Ion + 1 2 2 + # Shell Det. # Shell Jas. + 17 0 + # Jas 2body # Det # 3 body atomic par. + -6 84 0 + # Det mat. =/0 # Jas mat. =/0 + 126 0 + # Eq. Det atomic par. # Eq. 3 body atomic. par. + 8 0 + # unconstrained iesfree,iessw,ieskinr,I/O flag + 0 63 1 0 + # Ion coordinates + 1.00000000000000 1.00000000000000 -0.661404143619020 + 0.000000000000000E+000 0.000000000000000E+000 + 1.00000000000000 1.00000000000000 0.661404143619020 + 0.000000000000000E+000 0.000000000000000E+000 + # Constraints for forces: ion - coordinate + 2 1 1 -2 1 + # Parameters Jastrow two body + 1 1.00000000000000 + # Parameters atomic wf + 1 1 90 + 1 0.325800000000000 + 1 1 90 + 1 33.8700000000000 + 1 1 90 + 1 5.09500000000000 + 1 1 90 + 1 1.15900000000000 + 1 1 90 + 1 0.102700000000000 + 3 1 91 + 1 1.40700000000000 + 3 1 91 + 1 0.388000000000000 + 6 1 92 + 1 1.05700000000000 + 1 1 90 + 2 0.325800000000000 + 1 1 90 + 2 33.8700000000000 + 1 1 90 + 2 5.09500000000000 + 1 1 90 + 2 1.15900000000000 + 1 1 90 + 2 0.102700000000000 + 3 1 91 + 2 1.40700000000000 + 3 1 91 + 2 0.388000000000000 + 6 1 92 + 2 1.05700000000000 + 1 68 1000000 + 1 1 2 3 4 5 + 6 7 8 9 10 11 + 12 13 14 15 16 17 + 18 19 20 21 22 23 + 24 25 26 27 28 29 + 30 31 32 33 34 + 4.42533456826050 1.24376991058331 -1.05569634948328 + 1.84830984107615 -0.706880176213957 0.867457414153999 + 4.371503159461554E-016 4.052314039881821E-015 1.44517674205182 + 4.366298989033623E-015 3.809452753245068E-015 3.049531134721041E-002 + 1.325328735646281E-015 5.800915303666443E-015 -0.772863443655091 + 1.068589661201713E-015 -0.772863443655137 -4.42490708969086 + -1.24373848907174 1.05564825621233 -1.84833494486991 + 0.706660212771657 0.867438648881507 -6.245004513516506E-016 + -6.494804694057166E-015 1.44522002201453 -1.186550857568136E-015 + -1.564720575331080E-015 -3.060585294849377E-002 2.428612866367530E-015 + 8.715250743307479E-015 0.772769405004287 -3.150257832373882E-015 + 0.772769405004333 + # Parameters atomic Jastrow wf + # Occupation atomic orbitals + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + # Occupation atomic orbitals Jastrow + # Nonzero values of detmat + 1 1 0.000000000000000E+000 + 1 2 0.000000000000000E+000 + 1 3 0.000000000000000E+000 + 1 4 0.000000000000000E+000 + 1 5 0.000000000000000E+000 + 1 6 0.000000000000000E+000 + 1 9 0.000000000000000E+000 + 1 18 0.000000000000000E+000 + 1 19 0.000000000000000E+000 + 1 20 0.000000000000000E+000 + 1 21 0.000000000000000E+000 + 1 22 0.000000000000000E+000 + 1 23 0.000000000000000E+000 + 1 26 0.000000000000000E+000 + 2 2 0.000000000000000E+000 + 2 3 0.000000000000000E+000 + 2 4 0.000000000000000E+000 + 2 5 0.000000000000000E+000 + 2 6 0.000000000000000E+000 + 2 9 0.000000000000000E+000 + 2 19 0.000000000000000E+000 + 2 20 0.000000000000000E+000 + 2 21 0.000000000000000E+000 + 2 22 0.000000000000000E+000 + 2 23 0.000000000000000E+000 + 2 26 0.000000000000000E+000 + 3 3 0.000000000000000E+000 + 3 4 0.000000000000000E+000 + 3 5 0.000000000000000E+000 + 3 6 0.000000000000000E+000 + 3 9 0.000000000000000E+000 + 3 20 0.000000000000000E+000 + 3 21 0.000000000000000E+000 + 3 22 0.000000000000000E+000 + 3 23 0.000000000000000E+000 + 3 26 0.000000000000000E+000 + 4 4 0.000000000000000E+000 + 4 5 0.000000000000000E+000 + 4 6 0.000000000000000E+000 + 4 9 0.000000000000000E+000 + 4 21 0.000000000000000E+000 + 4 22 0.000000000000000E+000 + 4 23 0.000000000000000E+000 + 4 26 0.000000000000000E+000 + 5 5 0.000000000000000E+000 + 5 6 0.000000000000000E+000 + 5 9 0.000000000000000E+000 + 5 22 0.000000000000000E+000 + 5 23 0.000000000000000E+000 + 5 26 0.000000000000000E+000 + 6 6 0.000000000000000E+000 + 6 9 0.000000000000000E+000 + 6 23 0.000000000000000E+000 + 6 26 0.000000000000000E+000 + 7 7 0.000000000000000E+000 + 7 10 0.000000000000000E+000 + 7 24 0.000000000000000E+000 + 7 27 0.000000000000000E+000 + 8 8 0.000000000000000E+000 + 8 11 0.000000000000000E+000 + 8 28 0.000000000000000E+000 + 9 9 0.000000000000000E+000 + 9 26 0.000000000000000E+000 + 10 10 0.000000000000000E+000 + 10 27 0.000000000000000E+000 + 11 11 0.000000000000000E+000 + 18 2 0.000000000000000E+000 + 18 3 0.000000000000000E+000 + 18 4 0.000000000000000E+000 + 18 5 0.000000000000000E+000 + 18 6 0.000000000000000E+000 + 18 9 0.000000000000000E+000 + 18 18 0.000000000000000E+000 + 18 19 0.000000000000000E+000 + 18 20 0.000000000000000E+000 + 18 21 0.000000000000000E+000 + 18 22 0.000000000000000E+000 + 18 23 0.000000000000000E+000 + 18 26 0.000000000000000E+000 + 19 3 0.000000000000000E+000 + 19 4 0.000000000000000E+000 + 19 5 0.000000000000000E+000 + 19 6 0.000000000000000E+000 + 19 9 0.000000000000000E+000 + 19 19 0.000000000000000E+000 + 19 20 0.000000000000000E+000 + 19 21 0.000000000000000E+000 + 19 22 0.000000000000000E+000 + 19 23 0.000000000000000E+000 + 19 26 0.000000000000000E+000 + 20 4 0.000000000000000E+000 + 20 5 0.000000000000000E+000 + 20 6 0.000000000000000E+000 + 20 9 0.000000000000000E+000 + 20 20 0.000000000000000E+000 + 20 21 0.000000000000000E+000 + 20 22 0.000000000000000E+000 + 20 23 0.000000000000000E+000 + 20 26 0.000000000000000E+000 + 21 5 0.000000000000000E+000 + 21 6 0.000000000000000E+000 + 21 9 0.000000000000000E+000 + 21 21 0.000000000000000E+000 + 21 22 0.000000000000000E+000 + 21 23 0.000000000000000E+000 + 21 26 0.000000000000000E+000 + 22 6 0.000000000000000E+000 + 22 9 0.000000000000000E+000 + 22 22 0.000000000000000E+000 + 22 23 0.000000000000000E+000 + 22 26 0.000000000000000E+000 + 23 9 0.000000000000000E+000 + 23 23 0.000000000000000E+000 + 23 26 0.000000000000000E+000 + 24 10 0.000000000000000E+000 + 24 24 0.000000000000000E+000 + 24 27 0.000000000000000E+000 + 25 8 0.000000000000000E+000 + 25 11 0.000000000000000E+000 + 25 25 0.000000000000000E+000 + 25 28 0.000000000000000E+000 + 26 26 0.000000000000000E+000 + 27 27 0.000000000000000E+000 + 28 11 0.000000000000000E+000 + 28 28 0.000000000000000E+000 + 35 35 1.00000000000000 + # Grouped par. in the chosen ordered basis + 2 1 1 18 18 + 2 1 2 18 19 + 2 1 3 18 20 + 2 1 4 18 21 + 2 1 5 18 22 + 2 1 6 -18 23 + 2 1 9 -18 26 + 1 1 18 + 2 1 19 18 2 + 2 1 20 18 3 + 2 1 21 18 4 + 2 1 22 18 5 + 2 1 23 -18 6 + 2 1 26 -18 9 + 2 2 2 19 19 + 2 2 3 19 20 + 2 2 4 19 21 + 2 2 5 19 22 + 2 2 6 -19 23 + 2 2 9 -19 26 + 1 2 19 + 2 2 20 19 3 + 2 2 21 19 4 + 2 2 22 19 5 + 2 2 23 -19 6 + 2 2 26 -19 9 + 2 3 3 20 20 + 2 3 4 20 21 + 2 3 5 20 22 + 2 3 6 -20 23 + 2 3 9 -20 26 + 1 3 20 + 2 3 21 20 4 + 2 3 22 20 5 + 2 3 23 -20 6 + 2 3 26 -20 9 + 2 4 4 21 21 + 2 4 5 21 22 + 2 4 6 -21 23 + 2 4 9 -21 26 + 1 4 21 + 2 4 22 21 5 + 2 4 23 -21 6 + 2 4 26 -21 9 + 2 5 5 22 22 + 2 5 6 -22 23 + 2 5 9 -22 26 + 1 5 22 + 2 5 23 -22 6 + 2 5 26 -22 9 + 2 6 6 23 23 + 2 6 9 23 26 + 1 6 23 + 2 6 26 23 9 + 4 7 7 8 8 24 + 24 25 25 + 4 7 10 8 11 24 + 27 25 28 + 2 7 24 25 8 + 4 7 27 8 28 24 + 10 25 11 + 2 9 9 26 26 + 1 9 26 + 4 10 10 11 11 27 + 27 28 28 + 2 10 27 28 11 + -1 35 35 + # Nonzero values of jasmat + # Eq. par. in the 3-body Jastrow in the chosen basis + # Eq. par. in the atomic Det par.in the chosen basis + 2 1 9 + 2 2 10 + 2 3 11 + 2 4 12 + 2 5 13 + 2 6 14 + 2 7 15 + 2 8 16 + # Eq. par. in the atomic 3-body par. in the chosen basis diff --git a/test/test_dft_open_cartesian/cm.test.sh b/test/test_dft_open_cartesian/cm.test.sh new file mode 100755 index 0000000..b222bf3 --- /dev/null +++ b/test/test_dft_open_cartesian/cm.test.sh @@ -0,0 +1,41 @@ +#!/bin/bash +set -euo pipefail + +if [[ $# -gt 0 ]]; then + PREP=$1 + OUT=$2 + TRUEOUT=$3 + FORT10=$4 + ROUND_OFF=$5 + if [[ $# -gt 5 ]]; then + PREFIX=$6 + else + PREFIX="" + fi +else + source ../settings.sh +fi + +if [ ! -f "$PREP" ]; then + echo "Executable $PREP does not exists" + exit 1 +fi + +echo " DFT-OPEN TEST CARTESIAN" +echo " dir=test_dft_open_cartesian" +$PREFIX $PREP < prep.d > $OUT +[ $? -eq 0 ] && echo " Run without non-zero exit code" || exit 1 +DFT_ene_ref=`grep "Final variational DFT" ${TRUEOUT} | awk -v ROUND_OFF=${ROUND_OFF} '{printf("%.*f\n", ROUND_OFF, $7)}'` +DFT_ene=`grep "Final variational DFT" $OUT | awk -v ROUND_OFF=${ROUND_OFF} '{printf("%.*f\n", ROUND_OFF, $7)}'` +dft_ene_diff=`echo "scale=${ROUND_OFF}; ${DFT_ene_ref} - ${DFT_ene}" | bc -l` +echo " -DFT energy = ${DFT_ene}" +echo " -DFT energy (ref) = ${DFT_ene_ref}" +echo " -The diff = ${dft_ene_diff}" +echo " -If the diff is finite, there is something wrong." + +echo `grep ERR $OUT` + +[ -z "${dft_ene_diff}" ] && exit 1 + +exit_code=`echo "$dft_ene_diff>0" | bc -l` +exit ${exit_code} diff --git a/test/test_dft_open_cartesian/fort.10 b/test/test_dft_open_cartesian/fort.10 new file mode 100644 index 0000000..258504d --- /dev/null +++ b/test/test_dft_open_cartesian/fort.10 @@ -0,0 +1,318 @@ + # Nelup #Nel # Ion + 1 2 2 + # Shell Det. # Shell Jas. + 17 0 + # Jas 2body # Det # 3 body atomic par. + -6 84 0 + # Det mat. =/0 # Jas mat. =/0 + 126 0 + # Eq. Det atomic par. # Eq. 3 body atomic. par. + 8 0 + # unconstrained iesfree,iessw,ieskinr,I/O flag + 0 63 1 0 + # Ion coordinates + 1.000000000000000 1.000000000000000 -0.6614041436190200 + 0.000000000000000 0.000000000000000 + 1.000000000000000 1.000000000000000 0.6614041436190200 + 0.000000000000000 0.000000000000000 + # Constraints for forces: ion - coordinate + 2 1 1 -2 1 + # Parameters Jastrow two body + 1 1.000000000000000 + # Parameters atomic wf + 1 1 90 + 1 0.3258000000000000 + 1 1 90 + 1 33.87000000000000 + 1 1 90 + 1 5.095000000000000 + 1 1 90 + 1 1.159000000000000 + 1 1 90 + 1 0.1027000000000000 + 3 1 91 + 1 1.407000000000000 + 3 1 91 + 1 0.3880000000000000 + 6 1 92 + 1 1.057000000000000 + 1 1 90 + 2 0.3258000000000000 + 1 1 90 + 2 33.87000000000000 + 1 1 90 + 2 5.095000000000000 + 1 1 90 + 2 1.159000000000000 + 1 1 90 + 2 0.1027000000000000 + 3 1 91 + 2 1.407000000000000 + 3 1 91 + 2 0.3880000000000000 + 6 1 92 + 2 1.057000000000000 + 1 68 1000000 + 1 1 2 3 4 5 + 6 7 8 9 10 11 + 12 13 14 15 16 17 + 18 19 20 21 22 23 + 24 25 26 27 28 29 + 30 31 32 33 34 + 0.4773390020722277 1.8302570961505125E-004 3.6588698222654037E-003 + 7.6758060809089382E-002 0.3138498810951429 -1.4744368036752616E-002 + -7.8939404925953971E-016 2.1991685816152851E-016 6.2681900941708446E-003 + 4.2932779727167247E-015 3.4767653166178913E-015 -2.5636229841279404E-003 + 2.8991566092262389E-016 -1.3063416451006282E-015 4.6547785259192474E-003 + 4.8339153860266215E-016 4.6547785259115175E-003 0.4773390020722259 + 1.8302570961476307E-004 3.6588698222660993E-003 7.6758060809089868E-002 + 0.3138498810950336 1.4744368036753684E-002 5.9631119486702744E-017 + 1.2087295682590427E-015 -6.2681900941480850E-003 -3.6503460844328206E-015 + -3.9778429031592233E-015 -2.5636229841296890E-003 2.6817740736428952E-016 + -6.7431276491378145E-016 4.6547785259198008E-003 -7.6424902918734855E-016 + 4.6547785259127665E-003 + # Parameters atomic Jastrow wf + # Occupation atomic orbitals + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + # Occupation atomic orbitals Jastrow + # Nonzero values of detmat + 1 1 0.000000000000000 + 1 2 0.000000000000000 + 1 3 0.000000000000000 + 1 4 0.000000000000000 + 1 5 0.000000000000000 + 1 6 0.000000000000000 + 1 9 0.000000000000000 + 1 18 0.000000000000000 + 1 19 0.000000000000000 + 1 20 0.000000000000000 + 1 21 0.000000000000000 + 1 22 0.000000000000000 + 1 23 0.000000000000000 + 1 26 0.000000000000000 + 2 2 0.000000000000000 + 2 3 0.000000000000000 + 2 4 0.000000000000000 + 2 5 0.000000000000000 + 2 6 0.000000000000000 + 2 9 0.000000000000000 + 2 19 0.000000000000000 + 2 20 0.000000000000000 + 2 21 0.000000000000000 + 2 22 0.000000000000000 + 2 23 0.000000000000000 + 2 26 0.000000000000000 + 3 3 0.000000000000000 + 3 4 0.000000000000000 + 3 5 0.000000000000000 + 3 6 0.000000000000000 + 3 9 0.000000000000000 + 3 20 0.000000000000000 + 3 21 0.000000000000000 + 3 22 0.000000000000000 + 3 23 0.000000000000000 + 3 26 0.000000000000000 + 4 4 0.000000000000000 + 4 5 0.000000000000000 + 4 6 0.000000000000000 + 4 9 0.000000000000000 + 4 21 0.000000000000000 + 4 22 0.000000000000000 + 4 23 0.000000000000000 + 4 26 0.000000000000000 + 5 5 0.000000000000000 + 5 6 0.000000000000000 + 5 9 0.000000000000000 + 5 22 0.000000000000000 + 5 23 0.000000000000000 + 5 26 0.000000000000000 + 6 6 0.000000000000000 + 6 9 0.000000000000000 + 6 23 0.000000000000000 + 6 26 0.000000000000000 + 7 7 0.000000000000000 + 7 10 0.000000000000000 + 7 24 0.000000000000000 + 7 27 0.000000000000000 + 8 8 0.000000000000000 + 8 11 0.000000000000000 + 8 28 0.000000000000000 + 9 9 0.000000000000000 + 9 26 0.000000000000000 + 10 10 0.000000000000000 + 10 27 0.000000000000000 + 11 11 0.000000000000000 + 18 2 0.000000000000000 + 18 3 0.000000000000000 + 18 4 0.000000000000000 + 18 5 0.000000000000000 + 18 6 0.000000000000000 + 18 9 0.000000000000000 + 18 18 0.000000000000000 + 18 19 0.000000000000000 + 18 20 0.000000000000000 + 18 21 0.000000000000000 + 18 22 0.000000000000000 + 18 23 0.000000000000000 + 18 26 0.000000000000000 + 19 3 0.000000000000000 + 19 4 0.000000000000000 + 19 5 0.000000000000000 + 19 6 0.000000000000000 + 19 9 0.000000000000000 + 19 19 0.000000000000000 + 19 20 0.000000000000000 + 19 21 0.000000000000000 + 19 22 0.000000000000000 + 19 23 0.000000000000000 + 19 26 0.000000000000000 + 20 4 0.000000000000000 + 20 5 0.000000000000000 + 20 6 0.000000000000000 + 20 9 0.000000000000000 + 20 20 0.000000000000000 + 20 21 0.000000000000000 + 20 22 0.000000000000000 + 20 23 0.000000000000000 + 20 26 0.000000000000000 + 21 5 0.000000000000000 + 21 6 0.000000000000000 + 21 9 0.000000000000000 + 21 21 0.000000000000000 + 21 22 0.000000000000000 + 21 23 0.000000000000000 + 21 26 0.000000000000000 + 22 6 0.000000000000000 + 22 9 0.000000000000000 + 22 22 0.000000000000000 + 22 23 0.000000000000000 + 22 26 0.000000000000000 + 23 9 0.000000000000000 + 23 23 0.000000000000000 + 23 26 0.000000000000000 + 24 10 0.000000000000000 + 24 24 0.000000000000000 + 24 27 0.000000000000000 + 25 8 0.000000000000000 + 25 11 0.000000000000000 + 25 25 0.000000000000000 + 25 28 0.000000000000000 + 26 26 0.000000000000000 + 27 27 0.000000000000000 + 28 11 0.000000000000000 + 28 28 0.000000000000000 + 35 35 1.000000000000000 + # Grouped par. in the chosen ordered basis + 2 1 1 18 18 + 2 1 2 18 19 + 2 1 3 18 20 + 2 1 4 18 21 + 2 1 5 18 22 + 2 1 6 -18 23 + 2 1 9 -18 26 + 1 1 18 + 2 1 19 18 2 + 2 1 20 18 3 + 2 1 21 18 4 + 2 1 22 18 5 + 2 1 23 -18 6 + 2 1 26 -18 9 + 2 2 2 19 19 + 2 2 3 19 20 + 2 2 4 19 21 + 2 2 5 19 22 + 2 2 6 -19 23 + 2 2 9 -19 26 + 1 2 19 + 2 2 20 19 3 + 2 2 21 19 4 + 2 2 22 19 5 + 2 2 23 -19 6 + 2 2 26 -19 9 + 2 3 3 20 20 + 2 3 4 20 21 + 2 3 5 20 22 + 2 3 6 -20 23 + 2 3 9 -20 26 + 1 3 20 + 2 3 21 20 4 + 2 3 22 20 5 + 2 3 23 -20 6 + 2 3 26 -20 9 + 2 4 4 21 21 + 2 4 5 21 22 + 2 4 6 -21 23 + 2 4 9 -21 26 + 1 4 21 + 2 4 22 21 5 + 2 4 23 -21 6 + 2 4 26 -21 9 + 2 5 5 22 22 + 2 5 6 -22 23 + 2 5 9 -22 26 + 1 5 22 + 2 5 23 -22 6 + 2 5 26 -22 9 + 2 6 6 23 23 + 2 6 9 23 26 + 1 6 23 + 2 6 26 23 9 + 4 7 7 8 8 24 + 24 25 25 + 4 7 10 8 11 24 + 27 25 28 + 2 7 24 25 8 + 4 7 27 8 28 24 + 10 25 11 + 2 9 9 26 26 + 1 9 26 + 4 10 10 11 11 27 + 27 28 28 + 2 10 27 28 11 + -1 35 35 + # Nonzero values of jasmat + # Eq. par. in the 3-body Jastrow in the chosen basis + # Eq. par. in the atomic Det par.in the chosen basis + 2 1 9 + 2 2 10 + 2 3 11 + 2 4 12 + 2 5 13 + 2 6 14 + 2 7 15 + 2 8 16 + # Eq. par. in the atomic 3-body par. in the chosen basis diff --git a/test/test_dft_open_cartesian/gen_serial_ref.sh b/test/test_dft_open_cartesian/gen_serial_ref.sh new file mode 100755 index 0000000..b89653b --- /dev/null +++ b/test/test_dft_open_cartesian/gen_serial_ref.sh @@ -0,0 +1,13 @@ +#!/bin/bash + +PREP=../../build_docker_intel/prep-serial.x +FORT10=REFERENCE_fort.10_new +OUT=out_true.o + +debug_root=`pwd` + +cd $debug_root +$PREP < prep.d > $OUT +cp fort.10_new ${FORT10} +grep ERR $OUT +cd $debug_root diff --git a/test/test_dft_open_cartesian/out_true.o b/test/test_dft_open_cartesian/out_true.o new file mode 100644 index 0000000..9349843 --- /dev/null +++ b/test/test_dft_open_cartesian/out_true.o @@ -0,0 +1,472 @@ + ---------------------------------------------------------------------------- + TurboRVB version 1.0.0 git rev. N/A + + Ab-initio Quantum Monte Carlo Package + + Developer: Sandro Sorella + Website: https://turborvb.sissa.it + GitHub: https://github.com/sissaschool/turborvb + Project PIs: Michele Casula and Kosuke Nakano + Contacts: michele.casula@gmail.com and kousuke_1123@icloud.com + + When you publish a paper using TurboRVB, please cite the following paper. + + TurboRVB: a many-body toolkit for ab initio electronic simulations, + K. Nakano*, C. Attaccalite, M. Barborini, L. Capriotti, M. Casula*, + E. Coccia, M. Dagrada, Y. Luo, G. Mazzola, A. Zen, and S. Sorella*, + J. Chem. Phys. 152, 204121 (2020), doi:10.1063/5.0005037 + + ---------------------------------------------------------------------------- + Number of threads /mpi proc = 1 + Warning init. value of threads/mpi task 1 + Initial path : + /app/minicode/test/test_dft_open_cartesian + + + + + + + + + + + + + After reading simulation + Default value of pseudorandom = T + After reading pseudo + Pseudopotential file name : pseudo.dat + Read value of epscut 1.000000000000000E-005 + After reading vmc + Default value of parcut = 0.000000000000000E+000 + After reading optimization + Default value of epsdgel = 1.000000000000000E-003 + Default value of nweight for forces nweight X -1 + Default value for tolcg = 1.000000000000000E-006 + Default value for minzj = -1000.00000000000 + Default value of minimum one-two body Jastrow = 5.000000000000000E-002 + After reading readio + Default value of iread 0 + Default value of epsbas = 1.000000000000000E-009 + After reading parameters + Default value of add_pulay = 2 + Default value for ieser= 0 + Basis set cutoff chosen: 1.000000000000000E-009 + after parameters + Parameters: iesinv,iesm,iesd,iesfree,iessw,iesup,ieskin + Parameters before read 0 0 0 0 + 0 0 0 + Reading the begin in fast. . . . + Reading zeta and rion in fast . . . . + Reading ieskin in fast. . . . + Reading 2-body jastrow in fast . . . . + Reading det shells in fast. . . . + Reading jas shells in fast. . . . + Reading det occupation in fast. . . . 35 + Reading jas occupation in fast. . . . 0 + Reading det nnozero in fast. . . . + Reading det nnozero symmetries in fast.... + Reading jas nnozero in fast.... + Reading jas nnozero symmetries in fast.... + Reading Z-det symmetries in fast.... + Reading Z-jas symmetries in fast.... + Warning NO DMC cutoff on the local energy + Default value of epscuttype= 2 + Read value of epscut= 1.000000000000000E-005 + Default value of tstep= 2.00000000000000 + Read value for nintpsa 0 + Parameters after read 0 0 0 0 + 0 0 0 0 + Default value of prep 0 + Default value for nscra 6 + Default value for nbra 8 + Warning ncg<= #parameters!, changed to 0 + kl read = -7 + before dynamic + Fixing the parameters EACH TIME + Total number of bins per processor = 1 + Collective + normal parameters + np read = 0 + Warning srcomplex turned to false (real case) + + tparf = 0.350000000000000 + Default cutoff on the weight = 0.000000000000000E+000 + itestrfn = -5 + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + from prep : Warning # -1 + Warning Scratch files not written + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + Scratch extension ./scratch + + START reading the wave function fort.10 + + Reading the begin . . . . + Number of different atomic species = 1 + Open Boundary Conditions + Reading ieskin . . . . + Number of moved ionic coordinates 2 + Reading 2-body jastrow . . . . + opposite phase = F + same phase = T + yes_hermite before = F + Reading det shells . . . . + Warn. Ions are not in ascending order in Det ! + Check shell det = 17 + USING 1 CONTRACTED DET ORBITALS + USING 1 MOLECULAR DET ORBITALS + iesup dimension atomic basis = 16 84 + Reading jas shells . . . . + USING UNCONTRACTED JASTROW ORBITALS + Reading det occupation . . . . + Number of total det orbitals 35 + Number of occupied det orbitals 35 + Preliminary allocation 2.016000000000000E-006 + transpip = 6.560000000000001E-007 + Number of total det orbitals (root) 34 + Number of occupied det orbitals (root) 34 + Reading jas occupation . . . . + Number of total Jas orbitals 0 + Number of occupied Jas orbitals 0 + Before allocation standard + nion = 2 + nel = 2 + indt= 0 + npm= 1 + nwm= 1 + nws= 1 + nelorbj= 0 + iscrapip= 7 + iscraipsip= 253 + nelorb= 34 + nelcol= 34 + nelup= 1 + nelorb_c= 35 + nelorbj_c= 0 + nelcol_c= 35 + nshell= 16 + nshellj= 0 + npsamax= 4 + nintpseudo= 0 + Memory required DFT = 1.618400000000000E-005 Gbyte + Memory winv = 1.360000000000000E-006 + iscramax for master = 259 + Reading det nnozero . . . . + Reading det nnozero symmetries .... + Number of non zero geminal lambda for det 126 + Number of non fixed geminal lambda for det 126 + Number of non zero lambda (root) 595 + Reading jas nnozero .... + Location constant orbitals in Jastrow + Reading jas nnozero symmetries .... 0 + Number of non zero geminal lambda for Jas 0 + Number of non fixed geminal lambda for Jas 0 + Number of accepted nnozeron Jas Sz 0 + Check repeated in the symmetry table Jastrow + Reading Z-AGP symmetries .... + Touched det zeta par = 8 + Touched Jas zeta par = 0 + Time spent in update_kgrid= 9.536743164062500E-007 + Warning number niesd suggested (# par one/two body Jastrow) = 2 + in such case one has an independent one body for each different atomic specie + scale one body = -0.915879398033504 + + END reading the wave function fort.10 + + symmagp = T + Number 1body Jastrow parameters: 1 + 1 1.00000000000000 + initial costz, costz3, zeta_Q_Caffarel + 1 1.18920711500272 1.68179283050743 + 1.00000000000000 + 2 1.18920711500272 1.68179283050743 + 1.00000000000000 + After reading molecul + Warning yesavopt forced to false with mol optimiz.!!! + Default value of nmol 1 + Default value of nmolmin 1 + Default value of nmolmax 1 + after read molec + Default value of nmolmaxw= 1 + error converter 1.000000000000000E-014 + # mesh read 50 30 30 + Default value for buffer = 1000 + lattice mesh read ax,ay,az 0.250000000000000 0.250000000000000 + 0.250000000000000 + # molecular orbital Det considered/projected + 1 1 1 + Default value of shift_origin T + Default value for relative machine precision = 1.110223024625157E-016 + mixing used = 0.500000000000000 + Default value of typedft = 1 + Default value of mixingder = 5.000000000000000E-002 + Warning epsover used = 1.000000000000000E-013 + maxold used = 3 + Warning epssr set to zero in this case + decoupled run = F + Warning corr_hartree set to false + + CALCULATION INFORMATION + # Hartree Atomic Units used + # computation type = single phase + # iopt = 1 + # memlarge = F + # basis type = OPEN + # basis dim = 34 + # Number MOs = 1 + # contracted_on = F + # One-body Jastrow = 1 + # typedft = 1 + # typeopt = 4 + # spin calculation = F + # external H charge field = 0.00000 + # bands = 2 + # mixing = 0.50000 + # optocc = 0 + # smearing = 0.00000000 + # k-points = 1 + # Optimize overlaps = T + + + -------------------------------------------- + DFT calculation - Gamma point calculation + -------------------------------------------- + + Minimum ion-mesh distance = 0.197735241593094 + Origin shift used = -6.00000000000000 -3.62500000000000 + -3.62500000000000 + New center of mesh = 0.125000000000000 0.000000000000000E+000 + 0.000000000000000E+000 + Total number of buffers (lower bound) 45 + after initialize_mesh + after initialize molecorb F + after initialize dent F + Warning if you do not see after initialize fourier, try to use larger OMP_NUM_ + THREADS + after initialize fourier + + Total occupation UP read from std input + 1 2.00000000000000 + 2 0.000000000000000E+000 + Read last occupied paired orbital = 1 + Asymptotic value of one-body dft pot = 0.7559674441 + Read molecular orbitals 1 1 35 34 2 + Molecorb read: 0.18093492E+01 + Correction Coulomb = 0.176809131489431 + 0.10830E-03 Gbyte per MPI task for threading in initialize_mats_new! + 0.81600E-03 Gbyte per MPI task for the buffer, proportional to nbufd! + 0.13600E-05 Gbyte per MPI task for the buffer, proportional to threads! + Computing overlap matrices: + double_overs/same_phase: F T + scale one body = -0.915879398033504 + Buf number = 1 taking 0.01 sec. + Buf number = 2 taking 0.01 sec. + Buf number = 3 taking 0.01 sec. + Buf number = 4 taking 0.01 sec. + Buf number = 5 taking 0.01 sec. + Buf number = 6 taking 0.01 sec. + Buf number = 7 taking 0.01 sec. + Buf number = 8 taking 0.01 sec. + Buf number = 9 taking 0.01 sec. + Buf number = 10 taking 0.00 sec. + Buf number = 11 taking 0.00 sec. + Buf number = 12 taking 0.00 sec. + Buf number = 13 taking 0.00 sec. + Buf number = 14 taking 0.00 sec. + Buf number = 15 taking 0.00 sec. + Buf number = 16 taking 0.00 sec. + Buf number = 17 taking 0.00 sec. + Buf number = 18 taking 0.00 sec. + Buf number = 19 taking 0.00 sec. + Buf number = 20 taking 0.00 sec. + Buf number = 21 taking 0.00 sec. + Buf number = 22 taking 0.00 sec. + Buf number = 23 taking 0.00 sec. + Buf number = 24 taking 0.00 sec. + Buf number = 25 taking 0.00 sec. + Buf number = 26 taking 0.00 sec. + Buf number = 27 taking 0.00 sec. + Buf number = 28 taking 0.00 sec. + Buf number = 29 taking 0.00 sec. + Buf number = 30 taking 0.00 sec. + Buf number = 31 taking 0.00 sec. + Buf number = 32 taking 0.00 sec. + Buf number = 33 taking 0.00 sec. + Buf number = 34 taking 0.00 sec. + Buf number = 35 taking 0.00 sec. + Buf number = 36 taking 0.00 sec. + Buf number = 37 taking 0.00 sec. + Buf number = 38 taking 0.00 sec. + Buf number = 39 taking 0.00 sec. + Buf number = 40 taking 0.00 sec. + Buf number = 41 taking 0.00 sec. + Buf number = 42 taking 0.00 sec. + Buf number = 43 taking 0.00 sec. + Buf number = 44 taking 0.00 sec. + Buf number = 45 taking 0.00 sec. + overlap/hamiltonian matrix elements computed + q=0 contribution Ewald (H) = 0.000000000000000E+000 6.28318530717959 + Total time initialization = 0.171569108963013 + Eigenvalue one body Ham + + Check matrix elements sum: + overs 66.6446186548540 + overham -117.292196864084 + oversdo 0.000000000000000E+000 + overhamdo 0.000000000000000E+000 + hamilt 0.000000000000000E+000 + + Lowest/Max eigenvalue overlap mat = 2.772488728013528E-004 + 3.96816105521753 + Condition number basis set = 6.986835184948259E-005 + Optimal lwork found = 918 + Total occupations found up/down: 2.0000000000 0.0000000000 + + Eigenvalues/occupations before starting SC cycle + + # k-point: 0.00000000 0.00000000 0.00000000 + 1 -17.6126147983 2.0000000000 + 2 -17.0595628252 0.0000000000 + + Fermi energy: -17.33608881 + Entropic contribution: 0.00000000 + Total charge: 2.000000 + Spin variance before = 0.000000000000000E+000 + |spin| = 0.000000000000000E+000 + Efree -35.2252295966495 + DFT initialization OK + # Molecorb start: 4.249825 + + ------------------------------ + Starting SC cycle + ------------------------------ + + Total occupations found up/down: 2.0000000000 0.0000000000 + + Fermi energy: -14.12910384 + Entropic contribution: 0.00000000 + + Iter,E,xc,corr 1 -32.3132356 -2.8116832 -0.1686544 2.9119940 + + Total charge: 2.000000 + Full norm correction before = 3.476947276401199E-006 + Total occupations found up/down: 2.0000000000 0.0000000000 + + Fermi energy: -14.13069236 + Entropic contribution: 0.00000000 + Full norm correction after = 3.052707448055237E-006 + jac diag= -7.178790863093814E-007 + Norm corr.= 1 0.0007937586 + Warning simple mixing = 0.425686009368853 + Total charge: 2.000000 + Total occupations found up/down: 2.0000000000 0.0000000000 + + Fermi energy: -14.14252698 + Entropic contribution: 0.00000000 + + Iter,E,xc,corr 2 -32.3131199 -2.7968226 -0.1682179 0.0001157 + + Total charge: 2.000000 + Full norm correction before = 2.733293613031752E-006 + Total occupations found up/down: 2.0000000000 0.0000000000 + + Fermi energy: -14.14344880 + Entropic contribution: 0.00000000 + Full norm correction after = 1.298801073164567E-006 + jac diag= -4.053191568509362E-005 -1.935624709668505E-006 + Norm corr.= 2 0.0005296461 + Warning last mixing = 2.72315780073842 + Total charge: 2.000000 + Total occupations found up/down: 2.0000000000 0.0000000000 + + Fermi energy: -14.15146664 + Entropic contribution: 0.00000000 + + Iter,E,xc,corr 3 -32.3130528 -2.7869735 -0.1679284 0.0000671 + + Total charge: 2.000000 + Full norm correction before = 2.803754094765289E-007 + Total occupations found up/down: 2.0000000000 0.0000000000 + + Fermi energy: -14.15190837 + Entropic contribution: 0.00000000 + Full norm correction after = 2.449615945066339E-007 + jac diag= -1.034121541174215E-004 -1.049166892912521E-006 + 4.758276040322888E-015 + Norm corr.= 3 0.0002584098 + Warning last mixing = -281.823132735642 + Total charge: 2.000000 + Total occupations found up/down: 2.0000000000 0.0000000000 + + Fermi energy: -14.15608926 + Entropic contribution: 0.00000000 + + Iter,E,xc,corr 4 -32.3130406 -2.7820511 -0.1677848 0.0000123 + + Total charge: 2.000000 + Full norm correction before = 6.683527435095086E-008 + Total occupations found up/down: 2.0000000000 0.0000000000 + + Fermi energy: -14.15630532 + Entropic contribution: 0.00000000 + Full norm correction after = 6.016931453141681E-008 + jac diag= -3.821744868215404E-005 -6.998923877512186E-008 + -6.662138083216155E-011 + Norm corr.= 4 0.0001284153 + Warning last mixing = 12.6178762760372 + Total charge: 2.000000 + Total occupations found up/down: 2.0000000000 0.0000000000 + + Fermi energy: -14.15822269 + Entropic contribution: 0.00000000 + + Iter,E,xc,corr 5 -32.3130377 -2.7796464 -0.1677144 0.0000029 + + Total charge: 2.000000 + Full norm correction before = 1.649155723331469E-008 + Total occupations found up/down: 2.0000000000 0.0000000000 + + Fermi energy: -14.15832826 + Entropic contribution: 0.00000000 + Full norm correction after = 1.486491650307479E-008 + jac diag= -9.192114677780702E-006 -3.870221128050366E-009 + -3.931332393604530E-013 + Norm corr.= 5 0.0000638375 + Warning last mixing = -2.08292762550928 + Total charge: 2.000000 + + ------------------------ + SC cycle completed + ------------------------ + + Sorted eigenvalues/occupations up + 1 -14.4631815542715 2.00000000000000 + 2 -13.8532638319445 0.000000000000000E+000 + Check orthogonality h psi with psi i =/ j 0.000000000000000E+000 + Variational energy without orth. -32.3130366846186 + Variational const with no orth. -3.38227558744281 + Final molecorb written 4.62515994777317 + OK Turbo-DFT converged with energy tollerance 0.000002928230515 < 0.000009999999747 + # Iterations = 5 + Final variational DFT energy (Ha) = -32.313036684618638 + Final self consistent energy (Ha) = -32.313037654234648 + Final exchange energy = -2.777243108842488 + Final correlation energy = -0.167643986924337 + Final Fermi energy = -14.158328259481893 Ha = -385.267738866248784 eV + Final Hartree energy(H) = 5.081576400016431 + + Turbo-DFT TIMINGS + Total time (sec.) = 2.355763196945190 + Total initialization time (sec.) = 0.171569108963013 + Total loading time matrices (sec.) = 1.420242547988892 + Total diagonalization time (sec.) = 0.000649690628052 + Total/Upload FFT time (sec.) = 0.142464637756348 0.000000000000000 + Total self-consistent cycle time (sec.) = 1.805390119552612 + Total density symmetrization time (sec.) = 0.000000000000000 + Total time dgemm = 0.045932531356812 + + + Write the parameters of the final wavefunction! + Passi qui from real to eff V + Passi qui from eff to real VI diff --git a/test/test_dft_open_cartesian/prep.d b/test/test_dft_open_cartesian/prep.d new file mode 100644 index 0000000..a8a46fd --- /dev/null +++ b/test/test_dft_open_cartesian/prep.d @@ -0,0 +1,50 @@ +&simulation + itestr4=-4 + iopt=1 + maxtime=3600 +/ + +&pseudo + npsamax=4 +/ + +&vmc +/ + +&optimization + molopt=1 +/ + +&readio + writescratch=1 +/ + +¶meters + yes_kpoints=.false. +/ + +&kpoints +/ + +&molecul + ax=0.25 + ay=0.25 + az=0.25 + nx=50 + ny=30 + nz=30 +/ + +&dft + contracted_on=.false. + maxit=50 + epsdft=1e-05 + mixing=0.5 + typedft=1 + optocc=0 + epsshell=0.0 + memlarge=.false. + nelocc=1 +/ + +2 diff --git a/test/test_makefun/CMakeLists.txt b/test/test_makefun/CMakeLists.txt new file mode 100644 index 0000000..82dbc37 --- /dev/null +++ b/test/test_makefun/CMakeLists.txt @@ -0,0 +1,4 @@ +add_test(NAME "Test Makefun" + COMMAND $ + WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR} + ) diff --git a/test/test_makefun/data/pa_016_v8phkcqbxb1zmnr.dat b/test/test_makefun/data/pa_016_v8phkcqbxb1zmnr.dat new file mode 100644 index 0000000..8eec6f3 Binary files /dev/null and b/test/test_makefun/data/pa_016_v8phkcqbxb1zmnr.dat differ diff --git a/test/test_makefun/data/pa_026_sjyi814djjrpahi.dat b/test/test_makefun/data/pa_026_sjyi814djjrpahi.dat new file mode 100644 index 0000000..7796f26 Binary files /dev/null and b/test/test_makefun/data/pa_026_sjyi814djjrpahi.dat differ diff --git a/test/test_makefun/data/pa_036_wuxyqbw8rtgtrzj.dat b/test/test_makefun/data/pa_036_wuxyqbw8rtgtrzj.dat new file mode 100644 index 0000000..2651a01 Binary files /dev/null and b/test/test_makefun/data/pa_036_wuxyqbw8rtgtrzj.dat differ diff --git a/test/test_makefun/data/pa_037_zamqnnptvosr1fw.dat b/test/test_makefun/data/pa_037_zamqnnptvosr1fw.dat new file mode 100644 index 0000000..fdebe24 Binary files /dev/null and b/test/test_makefun/data/pa_037_zamqnnptvosr1fw.dat differ diff --git a/test/test_makefun/data/pa_048_d81scqjafqgkvqk.dat b/test/test_makefun/data/pa_048_d81scqjafqgkvqk.dat new file mode 100644 index 0000000..89dbf15 Binary files /dev/null and b/test/test_makefun/data/pa_048_d81scqjafqgkvqk.dat differ diff --git a/test/test_makefun/data/pa_068_sbkgs1wh18yecwd.dat b/test/test_makefun/data/pa_068_sbkgs1wh18yecwd.dat new file mode 100644 index 0000000..781b543 Binary files /dev/null and b/test/test_makefun/data/pa_068_sbkgs1wh18yecwd.dat differ diff --git a/test/test_makefun/data/pa_090_qye4ggn1fvuhwfl.dat b/test/test_makefun/data/pa_090_qye4ggn1fvuhwfl.dat new file mode 100644 index 0000000..3ba8ef9 Binary files /dev/null and b/test/test_makefun/data/pa_090_qye4ggn1fvuhwfl.dat differ diff --git a/test/test_makefun/data/pa_091_quxzxeghjum8o88.dat b/test/test_makefun/data/pa_091_quxzxeghjum8o88.dat new file mode 100644 index 0000000..e4b092d Binary files /dev/null and b/test/test_makefun/data/pa_091_quxzxeghjum8o88.dat differ diff --git a/test/test_makefun/data/pa_092_r48sawyb1glurel.dat b/test/test_makefun/data/pa_092_r48sawyb1glurel.dat new file mode 100644 index 0000000..d9e97dc Binary files /dev/null and b/test/test_makefun/data/pa_092_r48sawyb1glurel.dat differ diff --git a/test/test_makefun/data/pa_093_fzgfeeysxsposro.dat b/test/test_makefun/data/pa_093_fzgfeeysxsposro.dat new file mode 100644 index 0000000..516406e Binary files /dev/null and b/test/test_makefun/data/pa_093_fzgfeeysxsposro.dat differ diff --git a/test/test_makefun/data/pa_094_yemwwxoxx8jjxnt.dat b/test/test_makefun/data/pa_094_yemwwxoxx8jjxnt.dat new file mode 100644 index 0000000..b1dbbb9 Binary files /dev/null and b/test/test_makefun/data/pa_094_yemwwxoxx8jjxnt.dat differ diff --git a/test/test_makefun/data/pa_095_jpcikwt8vuqdtsu.dat b/test/test_makefun/data/pa_095_jpcikwt8vuqdtsu.dat new file mode 100644 index 0000000..83b4024 Binary files /dev/null and b/test/test_makefun/data/pa_095_jpcikwt8vuqdtsu.dat differ diff --git a/test/test_makefun/data/pa_096_matbrhymhxrxzdu.dat b/test/test_makefun/data/pa_096_matbrhymhxrxzdu.dat new file mode 100644 index 0000000..f6e0cea Binary files /dev/null and b/test/test_makefun/data/pa_096_matbrhymhxrxzdu.dat differ diff --git a/test/test_makefun/data/pa_097_awlreqwgdmvq4wm.dat b/test/test_makefun/data/pa_097_awlreqwgdmvq4wm.dat new file mode 100644 index 0000000..a847906 Binary files /dev/null and b/test/test_makefun/data/pa_097_awlreqwgdmvq4wm.dat differ diff --git a/test/test_makefun/data/pa_098_4ecconnd1jvkdpq.dat b/test/test_makefun/data/pa_098_4ecconnd1jvkdpq.dat new file mode 100644 index 0000000..72d4c84 Binary files /dev/null and b/test/test_makefun/data/pa_098_4ecconnd1jvkdpq.dat differ diff --git a/test/test_makefun/data/pa_099_8jpqcoojtmwbgjj.dat b/test/test_makefun/data/pa_099_8jpqcoojtmwbgjj.dat new file mode 100644 index 0000000..afde546 Binary files /dev/null and b/test/test_makefun/data/pa_099_8jpqcoojtmwbgjj.dat differ diff --git a/test/test_makefun/data/sv_016_mjyos4xasamgxzq.dat b/test/test_makefun/data/sv_016_mjyos4xasamgxzq.dat new file mode 100644 index 0000000..dae5df5 Binary files /dev/null and b/test/test_makefun/data/sv_016_mjyos4xasamgxzq.dat differ diff --git a/test/test_makefun/data/sv_016_os4xasamgxzqlrh.dat b/test/test_makefun/data/sv_016_os4xasamgxzqlrh.dat new file mode 100644 index 0000000..d03509f Binary files /dev/null and b/test/test_makefun/data/sv_016_os4xasamgxzqlrh.dat differ diff --git a/test/test_makefun/data/sv_016_p4lmjyos4xasamg.dat b/test/test_makefun/data/sv_016_p4lmjyos4xasamg.dat new file mode 100644 index 0000000..a8a1465 Binary files /dev/null and b/test/test_makefun/data/sv_016_p4lmjyos4xasamg.dat differ diff --git a/test/test_makefun/data/sv_026_hziuieb1njozapa.dat b/test/test_makefun/data/sv_026_hziuieb1njozapa.dat new file mode 100644 index 0000000..3be6a4b Binary files /dev/null and b/test/test_makefun/data/sv_026_hziuieb1njozapa.dat differ diff --git a/test/test_makefun/data/sv_026_uu4hziuieb1njoz.dat b/test/test_makefun/data/sv_026_uu4hziuieb1njoz.dat new file mode 100644 index 0000000..c2c90b3 Binary files /dev/null and b/test/test_makefun/data/sv_026_uu4hziuieb1njoz.dat differ diff --git a/test/test_makefun/data/sv_026_ydcuu4hziuieb1n.dat b/test/test_makefun/data/sv_026_ydcuu4hziuieb1n.dat new file mode 100644 index 0000000..4b3714c Binary files /dev/null and b/test/test_makefun/data/sv_026_ydcuu4hziuieb1n.dat differ diff --git a/test/test_makefun/data/sv_036_4bvquojlw81enqp.dat b/test/test_makefun/data/sv_036_4bvquojlw81enqp.dat new file mode 100644 index 0000000..da91384 Binary files /dev/null and b/test/test_makefun/data/sv_036_4bvquojlw81enqp.dat differ diff --git a/test/test_makefun/data/sv_036_prh4bvquojlw81e.dat b/test/test_makefun/data/sv_036_prh4bvquojlw81e.dat new file mode 100644 index 0000000..4eb00c8 Binary files /dev/null and b/test/test_makefun/data/sv_036_prh4bvquojlw81e.dat differ diff --git a/test/test_makefun/data/sv_036_ybxprh4bvquojlw.dat b/test/test_makefun/data/sv_036_ybxprh4bvquojlw.dat new file mode 100644 index 0000000..4eeb913 Binary files /dev/null and b/test/test_makefun/data/sv_036_ybxprh4bvquojlw.dat differ diff --git a/test/test_makefun/data/sv_037_kg4ndeolwbhzzan.dat b/test/test_makefun/data/sv_037_kg4ndeolwbhzzan.dat new file mode 100644 index 0000000..8ef69a7 Binary files /dev/null and b/test/test_makefun/data/sv_037_kg4ndeolwbhzzan.dat differ diff --git a/test/test_makefun/data/sv_037_ndeolwbhzzantxg.dat b/test/test_makefun/data/sv_037_ndeolwbhzzantxg.dat new file mode 100644 index 0000000..e1099ef Binary files /dev/null and b/test/test_makefun/data/sv_037_ndeolwbhzzantxg.dat differ diff --git a/test/test_makefun/data/sv_037_olwbhzzantxggle.dat b/test/test_makefun/data/sv_037_olwbhzzantxggle.dat new file mode 100644 index 0000000..c62a6d3 Binary files /dev/null and b/test/test_makefun/data/sv_037_olwbhzzantxggle.dat differ diff --git a/test/test_makefun/data/sv_048_celtkoqa4mso1rh.dat b/test/test_makefun/data/sv_048_celtkoqa4mso1rh.dat new file mode 100644 index 0000000..e8eb71a Binary files /dev/null and b/test/test_makefun/data/sv_048_celtkoqa4mso1rh.dat differ diff --git a/test/test_makefun/data/sv_048_qa4mso1rhwjawtm.dat b/test/test_makefun/data/sv_048_qa4mso1rhwjawtm.dat new file mode 100644 index 0000000..31cb5e9 Binary files /dev/null and b/test/test_makefun/data/sv_048_qa4mso1rhwjawtm.dat differ diff --git a/test/test_makefun/data/sv_048_tkoqa4mso1rhwja.dat b/test/test_makefun/data/sv_048_tkoqa4mso1rhwja.dat new file mode 100644 index 0000000..0075d4b Binary files /dev/null and b/test/test_makefun/data/sv_048_tkoqa4mso1rhwja.dat differ diff --git a/test/test_makefun/data/sv_068_njhzski1ojivg1g.dat b/test/test_makefun/data/sv_068_njhzski1ojivg1g.dat new file mode 100644 index 0000000..08281f6 Binary files /dev/null and b/test/test_makefun/data/sv_068_njhzski1ojivg1g.dat differ diff --git a/test/test_makefun/data/sv_068_zeynjhzski1ojiv.dat b/test/test_makefun/data/sv_068_zeynjhzski1ojiv.dat new file mode 100644 index 0000000..52afb76 Binary files /dev/null and b/test/test_makefun/data/sv_068_zeynjhzski1ojiv.dat differ diff --git a/test/test_makefun/data/sv_068_zski1ojivg1gnrt.dat b/test/test_makefun/data/sv_068_zski1ojivg1gnrt.dat new file mode 100644 index 0000000..24c111f Binary files /dev/null and b/test/test_makefun/data/sv_068_zski1ojivg1gnrt.dat differ diff --git a/test/test_makefun/data/sv_090_dckns4tuvhtmorp.dat b/test/test_makefun/data/sv_090_dckns4tuvhtmorp.dat new file mode 100644 index 0000000..b337f32 Binary files /dev/null and b/test/test_makefun/data/sv_090_dckns4tuvhtmorp.dat differ diff --git a/test/test_makefun/data/sv_090_i4hdckns4tuvhtm.dat b/test/test_makefun/data/sv_090_i4hdckns4tuvhtm.dat new file mode 100644 index 0000000..7102f5a Binary files /dev/null and b/test/test_makefun/data/sv_090_i4hdckns4tuvhtm.dat differ diff --git a/test/test_makefun/data/sv_090_wxyi4hdckns4tuv.dat b/test/test_makefun/data/sv_090_wxyi4hdckns4tuv.dat new file mode 100644 index 0000000..9a4694a Binary files /dev/null and b/test/test_makefun/data/sv_090_wxyi4hdckns4tuv.dat differ diff --git a/test/test_makefun/data/sv_091_dznwca8wknswkth.dat b/test/test_makefun/data/sv_091_dznwca8wknswkth.dat new file mode 100644 index 0000000..67253ee Binary files /dev/null and b/test/test_makefun/data/sv_091_dznwca8wknswkth.dat differ diff --git a/test/test_makefun/data/sv_091_wca8wknswkthwfo.dat b/test/test_makefun/data/sv_091_wca8wknswkthwfo.dat new file mode 100644 index 0000000..177a0fa Binary files /dev/null and b/test/test_makefun/data/sv_091_wca8wknswkthwfo.dat differ diff --git a/test/test_makefun/data/sv_091_wdldznwca8wknsw.dat b/test/test_makefun/data/sv_091_wdldznwca8wknsw.dat new file mode 100644 index 0000000..a03bba7 Binary files /dev/null and b/test/test_makefun/data/sv_091_wdldznwca8wknsw.dat differ diff --git a/test/test_makefun/data/sv_092_81okdunwzsfloa4.dat b/test/test_makefun/data/sv_092_81okdunwzsfloa4.dat new file mode 100644 index 0000000..5717b55 Binary files /dev/null and b/test/test_makefun/data/sv_092_81okdunwzsfloa4.dat differ diff --git a/test/test_makefun/data/sv_092_kdunwzsfloa4b8o.dat b/test/test_makefun/data/sv_092_kdunwzsfloa4b8o.dat new file mode 100644 index 0000000..33a81a8 Binary files /dev/null and b/test/test_makefun/data/sv_092_kdunwzsfloa4b8o.dat differ diff --git a/test/test_makefun/data/sv_092_nwzsfloa4b8o4ml.dat b/test/test_makefun/data/sv_092_nwzsfloa4b8o4ml.dat new file mode 100644 index 0000000..ee29c06 Binary files /dev/null and b/test/test_makefun/data/sv_092_nwzsfloa4b8o4ml.dat differ diff --git a/test/test_makefun/data/sv_093_fhcyzktidrvn8li.dat b/test/test_makefun/data/sv_093_fhcyzktidrvn8li.dat new file mode 100644 index 0000000..cf980df Binary files /dev/null and b/test/test_makefun/data/sv_093_fhcyzktidrvn8li.dat differ diff --git a/test/test_makefun/data/sv_093_tidrvn8lifhfsla.dat b/test/test_makefun/data/sv_093_tidrvn8lifhfsla.dat new file mode 100644 index 0000000..00b3502 Binary files /dev/null and b/test/test_makefun/data/sv_093_tidrvn8lifhfsla.dat differ diff --git a/test/test_makefun/data/sv_093_yzktidrvn8lifhf.dat b/test/test_makefun/data/sv_093_yzktidrvn8lifhf.dat new file mode 100644 index 0000000..a82d236 Binary files /dev/null and b/test/test_makefun/data/sv_093_yzktidrvn8lifhf.dat differ diff --git a/test/test_makefun/data/sv_094_ndr4uhxdaeitins.dat b/test/test_makefun/data/sv_094_ndr4uhxdaeitins.dat new file mode 100644 index 0000000..d4871d9 Binary files /dev/null and b/test/test_makefun/data/sv_094_ndr4uhxdaeitins.dat differ diff --git a/test/test_makefun/data/sv_094_oflndr4uhxdaeit.dat b/test/test_makefun/data/sv_094_oflndr4uhxdaeit.dat new file mode 100644 index 0000000..511c591 Binary files /dev/null and b/test/test_makefun/data/sv_094_oflndr4uhxdaeit.dat differ diff --git a/test/test_makefun/data/sv_094_yemoflndr4uhxda.dat b/test/test_makefun/data/sv_094_yemoflndr4uhxda.dat new file mode 100644 index 0000000..ddbae55 Binary files /dev/null and b/test/test_makefun/data/sv_094_yemoflndr4uhxda.dat differ diff --git a/test/test_makefun/data/sv_095_ct1rxemozh4n1hv.dat b/test/test_makefun/data/sv_095_ct1rxemozh4n1hv.dat new file mode 100644 index 0000000..5f1a39c Binary files /dev/null and b/test/test_makefun/data/sv_095_ct1rxemozh4n1hv.dat differ diff --git a/test/test_makefun/data/sv_095_mozh4n1hv1wa4sp.dat b/test/test_makefun/data/sv_095_mozh4n1hv1wa4sp.dat new file mode 100644 index 0000000..f766cc8 Binary files /dev/null and b/test/test_makefun/data/sv_095_mozh4n1hv1wa4sp.dat differ diff --git a/test/test_makefun/data/sv_095_rxemozh4n1hv1wa.dat b/test/test_makefun/data/sv_095_rxemozh4n1hv1wa.dat new file mode 100644 index 0000000..a9f4e5f Binary files /dev/null and b/test/test_makefun/data/sv_095_rxemozh4n1hv1wa.dat differ diff --git a/test/test_makefun/data/sv_096_al8clyottmnrh1a.dat b/test/test_makefun/data/sv_096_al8clyottmnrh1a.dat new file mode 100644 index 0000000..ee57d9b Binary files /dev/null and b/test/test_makefun/data/sv_096_al8clyottmnrh1a.dat differ diff --git a/test/test_makefun/data/sv_096_crhqghal8clyott.dat b/test/test_makefun/data/sv_096_crhqghal8clyott.dat new file mode 100644 index 0000000..b040fda Binary files /dev/null and b/test/test_makefun/data/sv_096_crhqghal8clyott.dat differ diff --git a/test/test_makefun/data/sv_096_qghal8clyottmnr.dat b/test/test_makefun/data/sv_096_qghal8clyottmnr.dat new file mode 100644 index 0000000..f6d0c38 Binary files /dev/null and b/test/test_makefun/data/sv_096_qghal8clyottmnr.dat differ diff --git a/test/test_makefun/data/sv_097_gsvcokmlof8xkx1.dat b/test/test_makefun/data/sv_097_gsvcokmlof8xkx1.dat new file mode 100644 index 0000000..185bd64 Binary files /dev/null and b/test/test_makefun/data/sv_097_gsvcokmlof8xkx1.dat differ diff --git a/test/test_makefun/data/sv_097_l4jujhgsvcokmlo.dat b/test/test_makefun/data/sv_097_l4jujhgsvcokmlo.dat new file mode 100644 index 0000000..4bd063b Binary files /dev/null and b/test/test_makefun/data/sv_097_l4jujhgsvcokmlo.dat differ diff --git a/test/test_makefun/data/sv_097_ujhgsvcokmlof8x.dat b/test/test_makefun/data/sv_097_ujhgsvcokmlof8x.dat new file mode 100644 index 0000000..c75c961 Binary files /dev/null and b/test/test_makefun/data/sv_097_ujhgsvcokmlof8x.dat differ diff --git a/test/test_makefun/data/sv_098_8djsj4alpc1uxgv.dat b/test/test_makefun/data/sv_098_8djsj4alpc1uxgv.dat new file mode 100644 index 0000000..61cb64b Binary files /dev/null and b/test/test_makefun/data/sv_098_8djsj4alpc1uxgv.dat differ diff --git a/test/test_makefun/data/sv_098_thw8djsj4alpc1u.dat b/test/test_makefun/data/sv_098_thw8djsj4alpc1u.dat new file mode 100644 index 0000000..3cdf7f8 Binary files /dev/null and b/test/test_makefun/data/sv_098_thw8djsj4alpc1u.dat differ diff --git a/test/test_makefun/data/sv_098_uluthw8djsj4alp.dat b/test/test_makefun/data/sv_098_uluthw8djsj4alp.dat new file mode 100644 index 0000000..711f929 Binary files /dev/null and b/test/test_makefun/data/sv_098_uluthw8djsj4alp.dat differ diff --git a/test/test_makefun/data/sv_099_bzvrkxgf1hnjnn4.dat b/test/test_makefun/data/sv_099_bzvrkxgf1hnjnn4.dat new file mode 100644 index 0000000..55d98c7 Binary files /dev/null and b/test/test_makefun/data/sv_099_bzvrkxgf1hnjnn4.dat differ diff --git a/test/test_makefun/data/sv_099_chptxqbzvrkxgf1.dat b/test/test_makefun/data/sv_099_chptxqbzvrkxgf1.dat new file mode 100644 index 0000000..7b37e6e Binary files /dev/null and b/test/test_makefun/data/sv_099_chptxqbzvrkxgf1.dat differ diff --git a/test/test_makefun/data/sv_099_txqbzvrkxgf1hnj.dat b/test/test_makefun/data/sv_099_txqbzvrkxgf1hnj.dat new file mode 100644 index 0000000..27a9be4 Binary files /dev/null and b/test/test_makefun/data/sv_099_txqbzvrkxgf1hnj.dat differ diff --git a/test/test_makefun/data/svgl_016_hfkjqbqmuyndceq.dat b/test/test_makefun/data/svgl_016_hfkjqbqmuyndceq.dat new file mode 100644 index 0000000..c702490 Binary files /dev/null and b/test/test_makefun/data/svgl_016_hfkjqbqmuyndceq.dat differ diff --git a/test/test_makefun/data/svgl_016_snvrmhfkjqbqmuy.dat b/test/test_makefun/data/svgl_016_snvrmhfkjqbqmuy.dat new file mode 100644 index 0000000..a17a330 Binary files /dev/null and b/test/test_makefun/data/svgl_016_snvrmhfkjqbqmuy.dat differ diff --git a/test/test_makefun/data/svgl_016_uou1a1avrukrx8k.dat b/test/test_makefun/data/svgl_016_uou1a1avrukrx8k.dat new file mode 100644 index 0000000..2103db0 Binary files /dev/null and b/test/test_makefun/data/svgl_016_uou1a1avrukrx8k.dat differ diff --git a/test/test_makefun/data/svgl_016_wameojewxhugiec.dat b/test/test_makefun/data/svgl_016_wameojewxhugiec.dat new file mode 100644 index 0000000..30cdbd9 Binary files /dev/null and b/test/test_makefun/data/svgl_016_wameojewxhugiec.dat differ diff --git a/test/test_makefun/data/svgl_026_fcjwrlqvcxk8ku4.dat b/test/test_makefun/data/svgl_026_fcjwrlqvcxk8ku4.dat new file mode 100644 index 0000000..33c276c Binary files /dev/null and b/test/test_makefun/data/svgl_026_fcjwrlqvcxk8ku4.dat differ diff --git a/test/test_makefun/data/svgl_026_ogsyt1nduvyb8qx.dat b/test/test_makefun/data/svgl_026_ogsyt1nduvyb8qx.dat new file mode 100644 index 0000000..147acf3 Binary files /dev/null and b/test/test_makefun/data/svgl_026_ogsyt1nduvyb8qx.dat differ diff --git a/test/test_makefun/data/svgl_026_qppuxiktpxwv8ph.dat b/test/test_makefun/data/svgl_026_qppuxiktpxwv8ph.dat new file mode 100644 index 0000000..ff7e0cb Binary files /dev/null and b/test/test_makefun/data/svgl_026_qppuxiktpxwv8ph.dat differ diff --git a/test/test_makefun/data/svgl_026_yyczwogsyt1nduv.dat b/test/test_makefun/data/svgl_026_yyczwogsyt1nduv.dat new file mode 100644 index 0000000..17644db Binary files /dev/null and b/test/test_makefun/data/svgl_026_yyczwogsyt1nduv.dat differ diff --git a/test/test_makefun/data/svgl_036_dzmnsqlhzsjozh8.dat b/test/test_makefun/data/svgl_036_dzmnsqlhzsjozh8.dat new file mode 100644 index 0000000..d1fbd36 Binary files /dev/null and b/test/test_makefun/data/svgl_036_dzmnsqlhzsjozh8.dat differ diff --git a/test/test_makefun/data/svgl_036_nhp4qxrokugozmt.dat b/test/test_makefun/data/svgl_036_nhp4qxrokugozmt.dat new file mode 100644 index 0000000..67650f7 Binary files /dev/null and b/test/test_makefun/data/svgl_036_nhp4qxrokugozmt.dat differ diff --git a/test/test_makefun/data/svgl_036_tefbtcoozhfbcz1.dat b/test/test_makefun/data/svgl_036_tefbtcoozhfbcz1.dat new file mode 100644 index 0000000..68dfe79 Binary files /dev/null and b/test/test_makefun/data/svgl_036_tefbtcoozhfbcz1.dat differ diff --git a/test/test_makefun/data/svgl_036_xrokugozmtcpjtg.dat b/test/test_makefun/data/svgl_036_xrokugozmtcpjtg.dat new file mode 100644 index 0000000..ce35b0f Binary files /dev/null and b/test/test_makefun/data/svgl_036_xrokugozmtcpjtg.dat differ diff --git a/test/test_makefun/data/svgl_037_18ihhzkjvjeuu1j.dat b/test/test_makefun/data/svgl_037_18ihhzkjvjeuu1j.dat new file mode 100644 index 0000000..df1c3e4 Binary files /dev/null and b/test/test_makefun/data/svgl_037_18ihhzkjvjeuu1j.dat differ diff --git a/test/test_makefun/data/svgl_037_bfwce1rhtzqwuxy.dat b/test/test_makefun/data/svgl_037_bfwce1rhtzqwuxy.dat new file mode 100644 index 0000000..e1aeb40 Binary files /dev/null and b/test/test_makefun/data/svgl_037_bfwce1rhtzqwuxy.dat differ diff --git a/test/test_makefun/data/svgl_037_csooro1dwyvgurz.dat b/test/test_makefun/data/svgl_037_csooro1dwyvgurz.dat new file mode 100644 index 0000000..49f3ef7 Binary files /dev/null and b/test/test_makefun/data/svgl_037_csooro1dwyvgurz.dat differ diff --git a/test/test_makefun/data/svgl_037_ryb4dcsooro1dwy.dat b/test/test_makefun/data/svgl_037_ryb4dcsooro1dwy.dat new file mode 100644 index 0000000..504210f Binary files /dev/null and b/test/test_makefun/data/svgl_037_ryb4dcsooro1dwy.dat differ diff --git a/test/test_makefun/data/svgl_048_1ovnnbxmzhlratw.dat b/test/test_makefun/data/svgl_048_1ovnnbxmzhlratw.dat new file mode 100644 index 0000000..b839621 Binary files /dev/null and b/test/test_makefun/data/svgl_048_1ovnnbxmzhlratw.dat differ diff --git a/test/test_makefun/data/svgl_048_bxmzhlratwy11fo.dat b/test/test_makefun/data/svgl_048_bxmzhlratwy11fo.dat new file mode 100644 index 0000000..b6c8d52 Binary files /dev/null and b/test/test_makefun/data/svgl_048_bxmzhlratwy11fo.dat differ diff --git a/test/test_makefun/data/svgl_048_nalmdjp8pnjduov.dat b/test/test_makefun/data/svgl_048_nalmdjp8pnjduov.dat new file mode 100644 index 0000000..f7b126d Binary files /dev/null and b/test/test_makefun/data/svgl_048_nalmdjp8pnjduov.dat differ diff --git a/test/test_makefun/data/svgl_048_quqkmdggtrahwhv.dat b/test/test_makefun/data/svgl_048_quqkmdggtrahwhv.dat new file mode 100644 index 0000000..d6d02e2 Binary files /dev/null and b/test/test_makefun/data/svgl_048_quqkmdggtrahwhv.dat differ diff --git a/test/test_makefun/data/svgl_068_axd4ui4s1pjiyng.dat b/test/test_makefun/data/svgl_068_axd4ui4s1pjiyng.dat new file mode 100644 index 0000000..c4894a1 Binary files /dev/null and b/test/test_makefun/data/svgl_068_axd4ui4s1pjiyng.dat differ diff --git a/test/test_makefun/data/svgl_068_gquvuaxd4ui4s1p.dat b/test/test_makefun/data/svgl_068_gquvuaxd4ui4s1p.dat new file mode 100644 index 0000000..cb0e8b7 Binary files /dev/null and b/test/test_makefun/data/svgl_068_gquvuaxd4ui4s1p.dat differ diff --git a/test/test_makefun/data/svgl_068_izgctxefe4oezeq.dat b/test/test_makefun/data/svgl_068_izgctxefe4oezeq.dat new file mode 100644 index 0000000..193171b Binary files /dev/null and b/test/test_makefun/data/svgl_068_izgctxefe4oezeq.dat differ diff --git a/test/test_makefun/data/svgl_068_kdpntaulxvhd81s.dat b/test/test_makefun/data/svgl_068_kdpntaulxvhd81s.dat new file mode 100644 index 0000000..7277613 Binary files /dev/null and b/test/test_makefun/data/svgl_068_kdpntaulxvhd81s.dat differ diff --git a/test/test_makefun/data/svgl_090_1jwishbktq1144f.dat b/test/test_makefun/data/svgl_090_1jwishbktq1144f.dat new file mode 100644 index 0000000..ed5b70f Binary files /dev/null and b/test/test_makefun/data/svgl_090_1jwishbktq1144f.dat differ diff --git a/test/test_makefun/data/svgl_090_auyduazxsfpgtig.dat b/test/test_makefun/data/svgl_090_auyduazxsfpgtig.dat new file mode 100644 index 0000000..53b9850 Binary files /dev/null and b/test/test_makefun/data/svgl_090_auyduazxsfpgtig.dat differ diff --git a/test/test_makefun/data/svgl_090_utyoiyzylpiltva.dat b/test/test_makefun/data/svgl_090_utyoiyzylpiltva.dat new file mode 100644 index 0000000..eb7b674 Binary files /dev/null and b/test/test_makefun/data/svgl_090_utyoiyzylpiltva.dat differ diff --git a/test/test_makefun/data/svgl_090_ykooqutyoiyzylp.dat b/test/test_makefun/data/svgl_090_ykooqutyoiyzylp.dat new file mode 100644 index 0000000..a44e69e Binary files /dev/null and b/test/test_makefun/data/svgl_090_ykooqutyoiyzylp.dat differ diff --git a/test/test_makefun/data/svgl_091_dytqpgfaechmivw.dat b/test/test_makefun/data/svgl_091_dytqpgfaechmivw.dat new file mode 100644 index 0000000..35144ee Binary files /dev/null and b/test/test_makefun/data/svgl_091_dytqpgfaechmivw.dat differ diff --git a/test/test_makefun/data/svgl_091_ijs8tbgpa8jkdkq.dat b/test/test_makefun/data/svgl_091_ijs8tbgpa8jkdkq.dat new file mode 100644 index 0000000..d349563 Binary files /dev/null and b/test/test_makefun/data/svgl_091_ijs8tbgpa8jkdkq.dat differ diff --git a/test/test_makefun/data/svgl_091_lmwjtwyss18ejju.dat b/test/test_makefun/data/svgl_091_lmwjtwyss18ejju.dat new file mode 100644 index 0000000..8275fd7 Binary files /dev/null and b/test/test_makefun/data/svgl_091_lmwjtwyss18ejju.dat differ diff --git a/test/test_makefun/data/svgl_091_wyss18ejjupyvwo.dat b/test/test_makefun/data/svgl_091_wyss18ejjupyvwo.dat new file mode 100644 index 0000000..83505bf Binary files /dev/null and b/test/test_makefun/data/svgl_091_wyss18ejjupyvwo.dat differ diff --git a/test/test_makefun/data/svgl_092_fqszeufwlrf4gfv.dat b/test/test_makefun/data/svgl_092_fqszeufwlrf4gfv.dat new file mode 100644 index 0000000..1fa1557 Binary files /dev/null and b/test/test_makefun/data/svgl_092_fqszeufwlrf4gfv.dat differ diff --git a/test/test_makefun/data/svgl_092_g4ziv1tk1kxzeiw.dat b/test/test_makefun/data/svgl_092_g4ziv1tk1kxzeiw.dat new file mode 100644 index 0000000..729bc07 Binary files /dev/null and b/test/test_makefun/data/svgl_092_g4ziv1tk1kxzeiw.dat differ diff --git a/test/test_makefun/data/svgl_092_i8jpuv4cmhpg8vl.dat b/test/test_makefun/data/svgl_092_i8jpuv4cmhpg8vl.dat new file mode 100644 index 0000000..85752cd Binary files /dev/null and b/test/test_makefun/data/svgl_092_i8jpuv4cmhpg8vl.dat differ diff --git a/test/test_makefun/data/svgl_092_ufwlrf4gfvgqmwl.dat b/test/test_makefun/data/svgl_092_ufwlrf4gfvgqmwl.dat new file mode 100644 index 0000000..032ae9d Binary files /dev/null and b/test/test_makefun/data/svgl_092_ufwlrf4gfvgqmwl.dat differ diff --git a/test/test_makefun/data/svgl_093_8nrgpjk84r4yxma.dat b/test/test_makefun/data/svgl_093_8nrgpjk84r4yxma.dat new file mode 100644 index 0000000..2704615 Binary files /dev/null and b/test/test_makefun/data/svgl_093_8nrgpjk84r4yxma.dat differ diff --git a/test/test_makefun/data/svgl_093_bsoomciitxsebrr.dat b/test/test_makefun/data/svgl_093_bsoomciitxsebrr.dat new file mode 100644 index 0000000..e60e04d Binary files /dev/null and b/test/test_makefun/data/svgl_093_bsoomciitxsebrr.dat differ diff --git a/test/test_makefun/data/svgl_093_ojpsswhpowyasrt.dat b/test/test_makefun/data/svgl_093_ojpsswhpowyasrt.dat new file mode 100644 index 0000000..9e9c429 Binary files /dev/null and b/test/test_makefun/data/svgl_093_ojpsswhpowyasrt.dat differ diff --git a/test/test_makefun/data/svgl_093_yomug8nrgpjk84r.dat b/test/test_makefun/data/svgl_093_yomug8nrgpjk84r.dat new file mode 100644 index 0000000..7d34e89 Binary files /dev/null and b/test/test_makefun/data/svgl_093_yomug8nrgpjk84r.dat differ diff --git a/test/test_makefun/data/svgl_094_fdyrwjkmm4lnyte.dat b/test/test_makefun/data/svgl_094_fdyrwjkmm4lnyte.dat new file mode 100644 index 0000000..cef4eba Binary files /dev/null and b/test/test_makefun/data/svgl_094_fdyrwjkmm4lnyte.dat differ diff --git a/test/test_makefun/data/svgl_094_lhgvefdyrwjkmm4.dat b/test/test_makefun/data/svgl_094_lhgvefdyrwjkmm4.dat new file mode 100644 index 0000000..489e87e Binary files /dev/null and b/test/test_makefun/data/svgl_094_lhgvefdyrwjkmm4.dat differ diff --git a/test/test_makefun/data/svgl_094_pheqpnnziwgshrt.dat b/test/test_makefun/data/svgl_094_pheqpnnziwgshrt.dat new file mode 100644 index 0000000..a218260 Binary files /dev/null and b/test/test_makefun/data/svgl_094_pheqpnnziwgshrt.dat differ diff --git a/test/test_makefun/data/svgl_094_qklcavyvsvppfwb.dat b/test/test_makefun/data/svgl_094_qklcavyvsvppfwb.dat new file mode 100644 index 0000000..b98a3ec Binary files /dev/null and b/test/test_makefun/data/svgl_094_qklcavyvsvppfwb.dat differ diff --git a/test/test_makefun/data/svgl_095_el1rzsldcjt1ojx.dat b/test/test_makefun/data/svgl_095_el1rzsldcjt1ojx.dat new file mode 100644 index 0000000..e4ea126 Binary files /dev/null and b/test/test_makefun/data/svgl_095_el1rzsldcjt1ojx.dat differ diff --git a/test/test_makefun/data/svgl_095_gyo1hhrnssswzx8.dat b/test/test_makefun/data/svgl_095_gyo1hhrnssswzx8.dat new file mode 100644 index 0000000..5d592d2 Binary files /dev/null and b/test/test_makefun/data/svgl_095_gyo1hhrnssswzx8.dat differ diff --git a/test/test_makefun/data/svgl_095_hrnssswzx8llcsn.dat b/test/test_makefun/data/svgl_095_hrnssswzx8llcsn.dat new file mode 100644 index 0000000..96c2aca Binary files /dev/null and b/test/test_makefun/data/svgl_095_hrnssswzx8llcsn.dat differ diff --git a/test/test_makefun/data/svgl_095_x4ofzbifszphftp.dat b/test/test_makefun/data/svgl_095_x4ofzbifszphftp.dat new file mode 100644 index 0000000..c25ef1a Binary files /dev/null and b/test/test_makefun/data/svgl_095_x4ofzbifszphftp.dat differ diff --git a/test/test_makefun/data/svgl_096_1mwuciuutlhvpnt.dat b/test/test_makefun/data/svgl_096_1mwuciuutlhvpnt.dat new file mode 100644 index 0000000..df3c537 Binary files /dev/null and b/test/test_makefun/data/svgl_096_1mwuciuutlhvpnt.dat differ diff --git a/test/test_makefun/data/svgl_096_ag1pfikwuphlegu.dat b/test/test_makefun/data/svgl_096_ag1pfikwuphlegu.dat new file mode 100644 index 0000000..c874e22 Binary files /dev/null and b/test/test_makefun/data/svgl_096_ag1pfikwuphlegu.dat differ diff --git a/test/test_makefun/data/svgl_096_iuutlhvpnttfn1m.dat b/test/test_makefun/data/svgl_096_iuutlhvpnttfn1m.dat new file mode 100644 index 0000000..c4b47f1 Binary files /dev/null and b/test/test_makefun/data/svgl_096_iuutlhvpnttfn1m.dat differ diff --git a/test/test_makefun/data/svgl_096_kuh84lsnlt8wzn1.dat b/test/test_makefun/data/svgl_096_kuh84lsnlt8wzn1.dat new file mode 100644 index 0000000..3db2c29 Binary files /dev/null and b/test/test_makefun/data/svgl_096_kuh84lsnlt8wzn1.dat differ diff --git a/test/test_makefun/data/svgl_097_emwbxza4cnzksrw.dat b/test/test_makefun/data/svgl_097_emwbxza4cnzksrw.dat new file mode 100644 index 0000000..32a7f58 Binary files /dev/null and b/test/test_makefun/data/svgl_097_emwbxza4cnzksrw.dat differ diff --git a/test/test_makefun/data/svgl_097_vgq8jkbfpyatupg.dat b/test/test_makefun/data/svgl_097_vgq8jkbfpyatupg.dat new file mode 100644 index 0000000..a5e38f5 Binary files /dev/null and b/test/test_makefun/data/svgl_097_vgq8jkbfpyatupg.dat differ diff --git a/test/test_makefun/data/svgl_097_vrsupglctx8qsyy.dat b/test/test_makefun/data/svgl_097_vrsupglctx8qsyy.dat new file mode 100644 index 0000000..ca77cf0 Binary files /dev/null and b/test/test_makefun/data/svgl_097_vrsupglctx8qsyy.dat differ diff --git a/test/test_makefun/data/svgl_097_za4cnzksrwp1wap.dat b/test/test_makefun/data/svgl_097_za4cnzksrwp1wap.dat new file mode 100644 index 0000000..f42f8f6 Binary files /dev/null and b/test/test_makefun/data/svgl_097_za4cnzksrwp1wap.dat differ diff --git a/test/test_makefun/data/svgl_098_cskmdzmjwnu18sa.dat b/test/test_makefun/data/svgl_098_cskmdzmjwnu18sa.dat new file mode 100644 index 0000000..f784366 Binary files /dev/null and b/test/test_makefun/data/svgl_098_cskmdzmjwnu18sa.dat differ diff --git a/test/test_makefun/data/svgl_098_ok8jfaxcsdce44r.dat b/test/test_makefun/data/svgl_098_ok8jfaxcsdce44r.dat new file mode 100644 index 0000000..8f812fd Binary files /dev/null and b/test/test_makefun/data/svgl_098_ok8jfaxcsdce44r.dat differ diff --git a/test/test_makefun/data/svgl_098_qcadse1r4jujxqy.dat b/test/test_makefun/data/svgl_098_qcadse1r4jujxqy.dat new file mode 100644 index 0000000..c386915 Binary files /dev/null and b/test/test_makefun/data/svgl_098_qcadse1r4jujxqy.dat differ diff --git a/test/test_makefun/data/svgl_098_zjosbok8jfaxcsd.dat b/test/test_makefun/data/svgl_098_zjosbok8jfaxcsd.dat new file mode 100644 index 0000000..e6b0db7 Binary files /dev/null and b/test/test_makefun/data/svgl_098_zjosbok8jfaxcsd.dat differ diff --git a/test/test_makefun/data/svgl_099_b4vkypclbkcj8uo.dat b/test/test_makefun/data/svgl_099_b4vkypclbkcj8uo.dat new file mode 100644 index 0000000..9b70b3a Binary files /dev/null and b/test/test_makefun/data/svgl_099_b4vkypclbkcj8uo.dat differ diff --git a/test/test_makefun/data/svgl_099_rseimb4vkypclbk.dat b/test/test_makefun/data/svgl_099_rseimb4vkypclbk.dat new file mode 100644 index 0000000..fef023d Binary files /dev/null and b/test/test_makefun/data/svgl_099_rseimb4vkypclbk.dat differ diff --git a/test/test_makefun/data/svgl_099_t4wuvfpimxmmqvu.dat b/test/test_makefun/data/svgl_099_t4wuvfpimxmmqvu.dat new file mode 100644 index 0000000..4a351bf Binary files /dev/null and b/test/test_makefun/data/svgl_099_t4wuvfpimxmmqvu.dat differ diff --git a/test/test_makefun/data/svgl_099_wooxyvggk4my1qc.dat b/test/test_makefun/data/svgl_099_wooxyvggk4my1qc.dat new file mode 100644 index 0000000..c6a6c74 Binary files /dev/null and b/test/test_makefun/data/svgl_099_wooxyvggk4my1qc.dat differ diff --git a/test/test_makefun/parameters.csv b/test/test_makefun/parameters.csv new file mode 100644 index 0000000..84412e2 --- /dev/null +++ b/test/test_makefun/parameters.csv @@ -0,0 +1,17 @@ +iopt,angmom,type_,normalized,angtype,multiplicity,npar +16,0,Gaussian,yes,spherical,1,1 +36,1,Gaussian,yes,spherical,3,1 +48,3,Gaussian,yes,spherical,7,1 +26,1,Slater,yes,spherical,3,5 +37,2,Gaussian,yes,spherical,5,1 +68,2,Gaussian,yes,spherical,5,1 +90,0,Gaussian,yes,cartesian,1,1 +91,1,Gaussian,yes,cartesian,3,1 +92,2,Gaussian,yes,cartesian,6,1 +93,3,Gaussian,yes,cartesian,10,1 +94,4,Gaussian,yes,cartesian,15,1 +95,5,Gaussian,yes,cartesian,21,1 +96,6,Gaussian,yes,cartesian,28,1 +97,7,Gaussian,yes,cartesian,36,1 +98,8,Gaussian,yes,cartesian,45,1 +99,9,Gaussian,yes,cartesian,55,1 diff --git a/test/test_setup_qmckl/CMakeLists.txt b/test/test_setup_qmckl/CMakeLists.txt new file mode 100644 index 0000000..74cea2a --- /dev/null +++ b/test/test_setup_qmckl/CMakeLists.txt @@ -0,0 +1,13 @@ +get_filename_component(PARENT_DIR ${CMAKE_CURRENT_SOURCE_DIR} NAME) + +foreach( EXECUTABLE IN LISTS EXECUTABLES_S_L + EXECUTABLES_P_L ) + if( ${EXECUTABLE} MATCHES turborvb-serial) + add_test( + NAME "test qmckl setup (${EXECUTABLE})" + COMMAND ${BASH_EXECUTABLE} cm.test.sh $ $ datasvmc.d out_vmc fort.21_true 6 + WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR} + ) + endif() + +endforeach() diff --git a/test/test_setup_qmckl/cm.test.sh b/test/test_setup_qmckl/cm.test.sh new file mode 100755 index 0000000..c0ce735 --- /dev/null +++ b/test/test_setup_qmckl/cm.test.sh @@ -0,0 +1,45 @@ +#!/bin/bash +set -euo pipefail + +if [[ $# -gt 0 ]]; then + TURBO=$1 + READF=$2 + IN=$3 + OUT=$4 + REF_FORT21=$5 + ROUND_OFF=$6 +else + source ../settings.sh +fi + +if [ ! -f "$TURBO" ]; then + echo "Executable $TURBO does not exists" + exit 1 +fi + +cat $IN | $TURBO | tee > $OUT + +[ $? -eq 0 ] && echo " Run without non-zero exit code" || exit 1 + +if [ $(grep -c ERR $OUT) -gt 0 ]; then + echo " Errors in output:" + echo `grep ERR $OUT` + exit 1 +fi + +#check energies +echo " Calculate local energies:'0 1 1 1' | readf.x" +echo "0 1 1 1" | $READF >& /dev/null + +echo " Rounds off values in fort.21 < 10**-${ROUND_OFF}". +cat fort.21 | awk -v ROUND_OFF=${ROUND_OFF} '{printf("%.*f %.*f %.*f\n", ROUND_OFF, $1, ROUND_OFF, $2, ROUND_OFF, $3)}' > fort.21_roundoff +cat ${REF_FORT21} | awk -v ROUND_OFF=${ROUND_OFF} '{printf("%.*f %.*f %.*f\n", ROUND_OFF, $1, ROUND_OFF, $2, ROUND_OFF, $3)}' > REFERENCE_fortXXI_roundoff +# +#diff fort.21 +echo " Compares fort.21_roundoff and REFERENCE_fortXXI_roundoff." +echo " If you do not see any "diff" here, they are consistent." + +if [ $(diff fort.21_roundoff REFERENCE_fortXXI_roundoff | wc -l) -gt 0 ]; then + diff fort.21_roundoff REFERENCE_fortXXI_roundoff + exit 1 +fi diff --git a/test/test_setup_qmckl/datasvmc.d b/test/test_setup_qmckl/datasvmc.d new file mode 100644 index 0000000..e6f68eb --- /dev/null +++ b/test/test_setup_qmckl/datasvmc.d @@ -0,0 +1,22 @@ +&simulation +ngen=100 +nscra=1 +nbra=0 +iseedr=25113183 +yesfast=2 +/ +&pseudo +!nintpsa=6 +!npsamax=1 +/ +&vmc +tstep=3.3 +!epscut=0.0 +/ +&readio +trexiofile="fort.10" +/ +¶meters +ieskin=0 +warp=.false. +/ diff --git a/test/test_setup_qmckl/fort.10 b/test/test_setup_qmckl/fort.10 new file mode 100644 index 0000000..561e519 --- /dev/null +++ b/test/test_setup_qmckl/fort.10 @@ -0,0 +1,125 @@ + # Nelup #Nel # Ion + 1 2 2 + # Shell Det. # Shell Jas. + 11 0 + # Jas 2body # Det # 3 body atomic par. + 0 94 0 + # Det mat. =/0 # Jas mat. =/0 + 1 0 + # Eq. Det atomic par. # Eq. 3 body atomic. par. + 5 0 + # unconstrained iesfree,iessw,ieskinr,I/O flag + 0 1 2 0 + # Ion coordinates + 1.00000000000000 1.01000000000000 0.000000000000000E+000 + 0.000000000000000E+000 0.000000000000000E+000 + 1.00000000000000 1.01000000000000 2.00000000000000 + 0.000000000000000E+000 0.000000000000000E+000 + # Constraints for forces: ion - coordinate + 1 1 1 + 1 2 1 + # Parameters Jastrow two body + 0 + # Parameters atomic wf + 1 1 90 + 1 0.500000000000000 + 1 1 90 + 1 0.900000000000000 + 3 1 91 + 1 1.10000000000000 + 6 1 92 + 1 1.50000000000000 + 10 1 93 + 1 1.11110000000000 + 1 1 90 + 2 0.500000000000000 + 1 1 90 + 2 0.900000000000000 + 3 1 91 + 2 1.10000000000000 + 6 1 92 + 2 1.50000000000000 + 10 1 93 + 2 1.11110000000000 + 1 84 1000000 + 1 1 2 3 4 5 + 6 7 8 9 10 11 + 12 13 14 15 16 17 + 18 19 20 21 22 23 + 24 25 26 27 28 29 + 30 31 32 33 34 35 + 36 37 38 39 40 41 + 42 0.671097793457233 8.707773760402356E-002 + 5.746861247576396E-003 2.435118079402443E-016 -3.291637795665991E-016 + -7.707858430692591E-002 -5.502326025363935E-017 2.276824562219559E-018 + -7.739497269065233E-002 -2.992397996059992E-017 -7.739497269065584E-002 + 2.058220908937753E-002 -4.250072516143177E-017 2.153225514556212E-016 + 9.136196104611873E-004 7.963464956906030E-017 9.136196104615164E-004 + -3.452099717193846E-016 -2.168404344971009E-017 -1.537398680584445E-016 + 5.153212925823603E-016 0.670774467458982 8.721107949094381E-002 + -5.985009213858345E-003 -1.049507702965968E-016 -1.242495689668388E-016 + -7.656459376857978E-002 1.644192594574267E-016 -1.225148454908620E-016 + -7.735465482852649E-002 -6.266688556966216E-017 -7.735465482853002E-002 + -2.149315310860120E-002 7.994635769364988E-017 -6.911788849595091E-017 + -9.718092005896210E-004 6.608212241299150E-017 -9.718092005892780E-004 + -7.741203511546502E-017 -3.599551212651875E-017 -7.855044739657480E-017 + -2.187496467602121E-016 + # Parameters atomic Jastrow wf + # Occupation atomic orbitals + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 1 + # Occupation atomic orbitals Jastrow + # Nonzero values of detmat + 1 1 1.00000000000000 + # Grouped par. in the chosen ordered basis + -1 1 1 + # Nonzero values of jasmat + # Eq. par. in the 3-body Jastrow in the chosen basis + # Eq. par. in the atomic Det par.in the chosen basis + 2 1 6 + 2 2 7 + 2 3 8 + 2 4 9 + 2 5 10 + # Eq. par. in the atomic 3-body par. in the chosen basis diff --git a/test/test_setup_qmckl/fort.21_true b/test/test_setup_qmckl/fort.21_true new file mode 100644 index 0000000..46d5fa7 --- /dev/null +++ b/test/test_setup_qmckl/fort.21_true @@ -0,0 +1,100 @@ + -0.140067995232E+01 0.100000000000E+01 0.100000000000E+01 + -0.140067995232E+01 0.100000000000E+01 0.200000000000E+01 + -0.845565898267E+00 0.100000000000E+01 0.300000000000E+01 + -0.105175834147E+01 0.100000000000E+01 0.400000000000E+01 + -0.665966184319E+00 0.100000000000E+01 0.500000000000E+01 + -0.925414522807E+00 0.100000000000E+01 0.600000000000E+01 + -0.431495162211E+00 0.100000000000E+01 0.700000000000E+01 + -0.703251572917E+00 0.100000000000E+01 0.800000000000E+01 + -0.703251572917E+00 0.100000000000E+01 0.900000000000E+01 + -0.703251572917E+00 0.100000000000E+01 0.100000000000E+02 + -0.903722638676E+00 0.100000000000E+01 0.110000000000E+02 + 0.264818039440E+01 0.100000000000E+01 0.120000000000E+02 + -0.122589846647E+01 0.100000000000E+01 0.130000000000E+02 + -0.130051379472E+01 0.100000000000E+01 0.140000000000E+02 + -0.713301592257E+00 0.100000000000E+01 0.150000000000E+02 + -0.713301592257E+00 0.100000000000E+01 0.160000000000E+02 + -0.968957332401E+00 0.100000000000E+01 0.170000000000E+02 + -0.924811573635E+00 0.100000000000E+01 0.180000000000E+02 + -0.113394828427E+01 0.100000000000E+01 0.190000000000E+02 + -0.892977671105E+00 0.100000000000E+01 0.200000000000E+02 + -0.118603592655E+01 0.100000000000E+01 0.210000000000E+02 + -0.379625897369E+00 0.100000000000E+01 0.220000000000E+02 + -0.680973349275E+00 0.100000000000E+01 0.230000000000E+02 + -0.118337935997E+01 0.100000000000E+01 0.240000000000E+02 + -0.123110244588E+01 0.100000000000E+01 0.250000000000E+02 + -0.839378166991E+00 0.100000000000E+01 0.260000000000E+02 + -0.123820692196E+01 0.100000000000E+01 0.270000000000E+02 + -0.791850000128E+00 0.100000000000E+01 0.280000000000E+02 + -0.753567267766E+00 0.100000000000E+01 0.290000000000E+02 + -0.753567267766E+00 0.100000000000E+01 0.300000000000E+02 + 0.372967076839E+00 0.100000000000E+01 0.310000000000E+02 + 0.372967076839E+00 0.100000000000E+01 0.320000000000E+02 + -0.622518758915E+00 0.100000000000E+01 0.330000000000E+02 + -0.579346452227E+00 0.100000000000E+01 0.340000000000E+02 + 0.256053614756E+00 0.100000000000E+01 0.350000000000E+02 + 0.146658153905E+01 0.100000000000E+01 0.360000000000E+02 + -0.313744473283E+00 0.100000000000E+01 0.370000000000E+02 + -0.704876795815E+00 0.100000000000E+01 0.380000000000E+02 + -0.131579006298E+01 0.100000000000E+01 0.390000000000E+02 + -0.125497970577E+01 0.100000000000E+01 0.400000000000E+02 + -0.954346603387E+00 0.100000000000E+01 0.410000000000E+02 + -0.954346603387E+00 0.100000000000E+01 0.420000000000E+02 + -0.102003053042E+01 0.100000000000E+01 0.430000000000E+02 + -0.104110073723E+01 0.100000000000E+01 0.440000000000E+02 + -0.869749438605E+00 0.100000000000E+01 0.450000000000E+02 + -0.517015703521E+00 0.100000000000E+01 0.460000000000E+02 + -0.103640182266E+01 0.100000000000E+01 0.470000000000E+02 + -0.107031876738E+01 0.100000000000E+01 0.480000000000E+02 + -0.100444151678E+01 0.100000000000E+01 0.490000000000E+02 + -0.934354657021E+00 0.100000000000E+01 0.500000000000E+02 + -0.193121881710E+01 0.100000000000E+01 0.510000000000E+02 + -0.193121881710E+01 0.100000000000E+01 0.520000000000E+02 + -0.209804681716E+01 0.100000000000E+01 0.530000000000E+02 + -0.363587673172E+00 0.100000000000E+01 0.540000000000E+02 + -0.351286221582E+00 0.100000000000E+01 0.550000000000E+02 + 0.776366305300E-01 0.100000000000E+01 0.560000000000E+02 + -0.381297104109E+00 0.100000000000E+01 0.570000000000E+02 + -0.117048310105E+01 0.100000000000E+01 0.580000000000E+02 + -0.113355818538E+01 0.100000000000E+01 0.590000000000E+02 + -0.867917648020E+00 0.100000000000E+01 0.600000000000E+02 + -0.159232830934E+01 0.100000000000E+01 0.610000000000E+02 + -0.145786232182E+01 0.100000000000E+01 0.620000000000E+02 + -0.171965320491E+01 0.100000000000E+01 0.630000000000E+02 + -0.181693226571E+01 0.100000000000E+01 0.640000000000E+02 + -0.167048683695E+01 0.100000000000E+01 0.650000000000E+02 + -0.115174937252E+01 0.100000000000E+01 0.660000000000E+02 + -0.140011437005E+01 0.100000000000E+01 0.670000000000E+02 + -0.138327260946E+01 0.100000000000E+01 0.680000000000E+02 + -0.123709671242E+01 0.100000000000E+01 0.690000000000E+02 + -0.129603389565E+01 0.100000000000E+01 0.700000000000E+02 + -0.462001935769E+00 0.100000000000E+01 0.710000000000E+02 + -0.386344139635E+00 0.100000000000E+01 0.720000000000E+02 + -0.148990047306E+01 0.100000000000E+01 0.730000000000E+02 + -0.157338088955E+01 0.100000000000E+01 0.740000000000E+02 + -0.132186713075E+01 0.100000000000E+01 0.750000000000E+02 + -0.939179134427E+00 0.100000000000E+01 0.760000000000E+02 + -0.793140401954E+00 0.100000000000E+01 0.770000000000E+02 + -0.749271697337E+00 0.100000000000E+01 0.780000000000E+02 + -0.126060893927E+00 0.100000000000E+01 0.790000000000E+02 + -0.247474017502E+00 0.100000000000E+01 0.800000000000E+02 + -0.902706663905E+00 0.100000000000E+01 0.810000000000E+02 + -0.181958952462E+00 0.100000000000E+01 0.820000000000E+02 + 0.219354110811E-01 0.100000000000E+01 0.830000000000E+02 + -0.490597037804E-01 0.100000000000E+01 0.840000000000E+02 + -0.696546359735E-01 0.100000000000E+01 0.850000000000E+02 + -0.122305775927E+01 0.100000000000E+01 0.860000000000E+02 + -0.122305775927E+01 0.100000000000E+01 0.870000000000E+02 + -0.469142098506E+00 0.100000000000E+01 0.880000000000E+02 + -0.404897295548E+00 0.100000000000E+01 0.890000000000E+02 + 0.741668935418E+00 0.100000000000E+01 0.900000000000E+02 + 0.741668935418E+00 0.100000000000E+01 0.910000000000E+02 + 0.741668935418E+00 0.100000000000E+01 0.920000000000E+02 + -0.833246497296E+00 0.100000000000E+01 0.930000000000E+02 + -0.937836930255E+00 0.100000000000E+01 0.940000000000E+02 + -0.937836930255E+00 0.100000000000E+01 0.950000000000E+02 + -0.680915351807E+00 0.100000000000E+01 0.960000000000E+02 + -0.680915351807E+00 0.100000000000E+01 0.970000000000E+02 + -0.845196490945E+00 0.100000000000E+01 0.980000000000E+02 + -0.567040228147E+00 0.100000000000E+01 0.990000000000E+02 + -0.824946170307E+00 0.100000000000E+01 0.100000000000E+03 diff --git a/test/test_setup_qmckl/pseudo.dat b/test/test_setup_qmckl/pseudo.dat new file mode 100644 index 0000000..c364bf2 --- /dev/null +++ b/test/test_setup_qmckl/pseudo.dat @@ -0,0 +1,13 @@ +ECP + 1 0.800000 2 + 1 3 + 0.000000 2.000000 1.000000 + 1.000000 1.000000 21.243595 + 21.243595 3.000000 21.243595 + -10.851924 2.000000 21.776967 + 2 0.800000 2 + 1 3 + 0.000000 2.000000 1.000000 + 1.000000 1.000000 21.243595 + 21.243595 3.000000 21.243595 + -10.851924 2.000000 21.776967