LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-21 11:03:29 +01:00
Code Releases Activity

Merge branch 'dev' of github.com:QuantumPackage/qp2 into dev

Browse Source
This commit is contained in:
Anthony Scemama 2020-05-29 00:11:16 +02:00
commit 8fdd44c6f0
84 changed files with 33523 additions and 5731 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
bin/qp_convert_output_to_ezfio
View File

@ -335,7 +335,7 @@ def write_ezfio(res, filename):
def get_full_path(file_path):
file_path = os.path.expanduser(file_path)
file_path = os.path.expandvars(file_path)
file_path = os.path.abspath(file_path)
# file_path = os.path.abspath(file_path)
return file_path

2
bin/qp_reset
View File

@ -112,7 +112,7 @@ qp_edit --check ${ezfio}
if [[ $mos -eq 1 ]] ; then
qp set mo_two_e_ints io_mo_two_e_integrals None
qp set mo_one_e_ints io_mo_integrals_e_n None
qp set mo_one_e_ints io_mo_integrals_n_e None
qp set mo_one_e_ints io_mo_integrals_kinetic None
qp set mo_one_e_ints io_mo_integrals_pseudo None
qp set mo_one_e_ints io_mo_one_e_integrals None

2
config/gfortran_debug.cfg
View File

@ -51,7 +51,7 @@ FCFLAGS : -Ofast
# -g : Extra debugging information
#
[DEBUG]
FCFLAGS : -g -msse4.2 -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized
FCFLAGS : -g -msse4.2 -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan
# OpenMP flags
#################

2
config/travis.cfg
View File

@ -53,7 +53,7 @@ FCFLAGS : -Ofast -fimplicit-none
# -g : Extra debugging information
#
[DEBUG]
FCFLAGS : -Ofast -fcheck=all -g -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant
FCFLAGS : -Ofast -fcheck=all -g -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant
# OpenMP flags

1317
data/basis/aug-cc-pv5z_ecp_ncsu → data/basis/aug-cc-pcv5z_ecp_ccecp
View File

File diff suppressed because it is too large Load Diff

841
data/basis/aug-cc-pvdz_ecp_ncsu → data/basis/aug-cc-pcvdz_ecp_ccecp
View File

@ -1,519 +1,195 @@
HYDROGEN
S 8
1 23.843185 0.00411490
2 10.212443 0.01046440
3 4.374164 0.02801110
4 1.873529 0.07588620
5 0.802465 0.18210620
6 0.343709 0.34852140
7 0.147217 0.37823130
8 0.063055 0.11642410
! Obtained from
! https://pseudopotentiallibrary.org
$DATA
POTASSIUM
S 13
1 33.190598 0.00093460
2 17.266513 -0.01746080
3 8.982438 0.15299840
4 4.672871 -0.34050680
5 2.430935 -0.22863440
6 1.264628 0.22672980
7 0.657889 0.54910420
8 0.342249 0.42310450
9 0.178046 0.09104080
10 0.092623 0.00345520
11 0.048185 -0.00028370
12 0.025067 0.00055460
13 0.013040 0.00000310
S 13
1 33.190598 -0.00013550
2 17.266513 0.00327580
3 8.982438 -0.03127550
4 4.672871 0.07304500
5 2.430935 0.04905170
6 1.264628 -0.05320270
7 0.657889 -0.13678160
8 0.342249 -0.16629980
9 0.178046 -0.15469740
10 0.092623 0.00178980
11 0.048185 0.40887000
12 0.025067 0.56715150
13 0.013040 0.18420760
P 12
1 25.955983 0.00005310
2 12.863527 0.00359740
3 6.375036 -0.04058580
4 3.159405 -0.04220760
5 1.565770 0.20965770
6 0.775980 0.39509450
7 0.384568 0.37504360
8 0.190588 0.15682480
9 0.094453 0.01966940
10 0.046810 0.00125380
11 0.023199 0.00029050
12 0.011497 -0.00000980
P 12
1 25.955983 -0.00001130
2 12.863527 -0.00050130
3 6.375036 0.00601080
4 3.159405 0.00570550
5 1.565770 -0.03288980
6 0.775980 -0.05912520
7 0.384568 -0.06798030
8 0.190588 -0.04852530
9 0.094453 0.02182800
10 0.046810 0.27827650
11 0.023199 0.48640440
12 0.011497 0.31832720
D 11
1 25.002828 0.00002860
2 10.959775 -0.00030190
3 4.804124 0.00482980
4 2.105846 0.01402200
5 0.923080 0.02589140
6 0.404624 0.03605440
7 0.177364 0.04862730
8 0.077746 0.10242950
9 0.034079 0.28114010
10 0.014938 0.51238900
11 0.006548 0.25265610
S 1
1 0.040680 1.00000000
1 0.910504 1.00000000
S 1
1 0.139013 1.00000000
1 0.538624 1.00000000
S 1
1 0.051786 1.00000000
S 1
1 0.019252 1.00000000
S 1
1 0.009626 1.00000000
P 1
1 0.166430 1.00000000
1 0.479550 1.00000000
P 1
1 0.740212 1.00000000
1 0.234482 1.00000000
P 1
1 0.027763 1.00000000
P 1
1 0.012100 1.00000000
P 1
1 0.006050 1.00000000
D 1
1 1.034207 1.00000000
D 1
1 0.013386 1.00000000
D 1
1 0.006693 1.00000000
SODIUM
S 12
1 50.364926 -0.00144900
2 24.480199 -0.00059000
3 11.898760 -0.11881800
4 5.783470 -0.01085600
5 2.811093 0.25078300
6 1.366350 0.44727600
7 0.664123 0.34725400
8 0.322801 0.08065200
9 0.156900 0.00120800
10 0.076262 0.00040900
11 0.037068 0.00011200
12 0.018017 0.00007200
S 12
1 50.364926 0.00021200
2 24.480199 0.00037900
3 11.898760 0.01958200
4 5.783470 0.00062300
5 2.811093 -0.04578100
6 1.366350 -0.08872800
7 0.664123 -0.11295200
8 0.322801 -0.10839600
9 0.156900 0.00990100
10 0.076262 0.35541800
11 0.037068 0.56145100
12 0.018017 0.19899800
S 1
1 0.073591 1.00000000
S 1
1 0.036796 1.00000000
P 12
1 77.769943 0.00005400
2 42.060816 -0.00001600
3 22.748020 0.01257100
4 12.302957 0.07960100
5 6.653887 0.14044200
6 3.598664 0.21214100
7 1.946289 0.26179900
8 1.052624 0.25582000
9 0.569297 0.18035900
10 0.307897 0.07216500
11 0.166522 0.01066300
12 0.090061 0.00153800
P 12
1 77.769943 -0.00065600
2 42.060816 0.00313700
3 22.748020 -0.01100400
4 12.302957 0.00937600
5 6.653887 -0.06647900
6 3.598664 0.05895900
7 1.946289 -0.22105000
8 1.052624 0.30349100
9 0.569297 -0.67170500
10 0.307897 1.06436000
11 0.166522 -1.53048900
12 0.090061 1.84316700
P 1
1 0.063647 1.00000000
P 1
1 0.031823 1.00000000
D 1
1 0.093145 1.00000000
D 1
1 0.046573 1.00000000
MAGNESIUM
S 12
1 63.931893 -0.00079400
2 31.602596 0.00747900
3 15.621687 -0.13624600
4 7.722059 -0.03203300
5 3.817142 0.21682300
6 1.886877 0.45136400
7 0.932714 0.37759900
8 0.461056 0.09431900
9 0.227908 0.00170300
10 0.112659 0.00048500
11 0.055689 -0.00015100
12 0.027528 0.00003100
S 12
1 63.931893 0.00010600
2 31.602596 -0.00108600
3 15.621687 0.02867600
4 7.722059 0.00578100
5 3.817142 -0.05065300
6 1.886877 -0.11687700
7 0.932714 -0.16512100
8 0.461056 -0.11801600
9 0.227908 0.10836500
10 0.112659 0.41475500
11 0.055689 0.47763300
12 0.027528 0.17347600
S 1
1 0.041150 1.00000000
S 1
1 0.020575 1.00000000
P 12
1 28.231094 0.01131700
2 14.891993 0.08703900
3 7.855575 0.16268300
4 4.143841 0.24138600
5 2.185889 0.29006400
6 1.153064 0.25299100
7 0.608245 0.13309700
8 0.320851 0.02894100
9 0.169250 0.00320900
10 0.089280 0.00026800
11 0.047095 0.00025700
12 0.024843 -0.00003700
P 12
1 28.231094 -0.00182200
2 14.891993 -0.01360300
3 7.855575 -0.02570000
4 4.143841 -0.03907600
5 2.185889 -0.04877900
6 1.153064 -0.04599000
7 0.608245 -0.03165800
8 0.320851 0.04917800
9 0.169250 0.18690900
10 0.089280 0.37939600
11 0.047095 0.33543100
12 0.024843 0.18405800
P 1
1 0.038365 1.00000000
P 1
1 0.019183 1.00000000
D 1
1 0.196017 1.00000000
D 1
1 0.098008 1.00000000
ALUMINUM
S 12
1 78.990577 -0.00048100
2 39.484884 0.01309500
3 19.737241 -0.14615300
4 9.866021 -0.04520600
5 4.931711 0.19070800
6 2.465206 0.45320700
7 1.232278 0.39882400
8 0.615977 0.10364800
9 0.307907 0.00224700
10 0.153913 0.00079000
11 0.076936 -0.00014000
12 0.038458 0.00006400
S 12
1 78.990577 0.00002400
2 39.484884 -0.00262700
3 19.737241 0.03694800
4 9.866021 0.01070500
5 4.931711 -0.05334200
6 2.465206 -0.14418800
7 1.232278 -0.21396900
8 0.615977 -0.12558500
9 0.307907 0.19397000
10 0.153913 0.48467400
11 0.076936 0.41941400
12 0.038458 0.11043000
S 1
1 0.062950 1.00000000
S 1
1 0.030399 1.00000000
P 12
1 33.993368 0.01190800
2 17.617051 0.09748500
3 9.130030 0.18047400
4 4.731635 0.26552200
5 2.452168 0.30797700
6 1.270835 0.23506100
7 0.658610 0.08963100
8 0.341324 0.01108300
9 0.176891 0.00157700
10 0.091674 0.00000700
11 0.047510 0.00021500
12 0.024622 -0.00002200
P 12
1 33.993368 -0.00218300
2 17.617051 -0.01736200
3 9.130030 -0.03229200
4 4.731635 -0.04981000
5 2.452168 -0.05992600
6 1.270835 -0.05255300
7 0.658610 0.00198900
8 0.341324 0.13005200
9 0.176891 0.28008900
10 0.091674 0.37433900
11 0.047510 0.27285700
12 0.024622 0.08514500
P 1
1 0.053015 1.00000000
P 1
1 0.014456 1.00000000
D 1
1 0.189387 1.00000000
D 1
1 0.053602 1.00000000
SILICON
S 12
1 96.651837 -0.00044000
2 48.652547 0.01867100
3 24.490692 -0.15435300
4 12.328111 -0.05773800
5 6.205717 0.16808700
6 3.123831 0.45342800
7 1.572472 0.41767500
8 0.791550 0.11190100
9 0.398450 0.00333700
10 0.200572 0.00099500
11 0.100964 -0.00003800
12 0.050823 0.00006900
S 12
1 96.651837 -0.00000400
2 48.652547 -0.00442100
3 24.490692 0.04336200
4 12.328111 0.01585300
5 6.205717 -0.05170600
6 3.123831 -0.16289500
7 1.572472 -0.25021800
8 0.791550 -0.12421600
9 0.398450 0.24632500
10 0.200572 0.50589900
11 0.100964 0.38631400
12 0.050823 0.08770100
S 1
1 0.086279 1.00000000
S 1
1 0.052598 1.00000000
P 12
1 40.315996 0.01293800
2 21.171265 0.09812900
3 11.117733 0.17932400
4 5.838290 0.26388600
5 3.065879 0.30927200
6 1.609995 0.23274800
7 0.845462 0.08590000
8 0.443980 0.01026000
9 0.233149 0.00156000
10 0.122434 -0.00000300
11 0.064294 0.00023200
12 0.033763 -0.00002300
P 12
1 40.315996 0.00283300
2 21.171265 0.02086900
3 11.117733 0.03823600
4 5.838290 0.05967900
5 3.065879 0.07277600
6 1.609995 0.06112900
7 0.845462 -0.01677600
8 0.443980 -0.17225900
9 0.233149 -0.32119600
10 0.122434 -0.36282800
11 0.064294 -0.22078900
12 0.033763 -0.05515200
P 1
1 0.079370 1.00000000
P 1
1 0.025699 1.00000000
D 1
1 0.274454 1.00000000
D 1
1 0.082112 1.00000000
PHOSPHORUS
S 12
1 269.443884 0.00005500
2 127.601401 -0.00062400
3 60.428603 0.01940000
4 28.617367 -0.16550900
5 13.552418 -0.05426500
6 6.418062 0.25444000
7 3.039422 0.54966100
8 1.439389 0.32228500
9 0.681656 0.02663200
10 0.322814 0.00420300
11 0.152876 -0.00123300
12 0.072398 0.00049700
S 12
1 269.443884 0.00001800
2 127.601401 -0.00002600
3 60.428603 -0.00493300
4 28.617367 0.05012000
5 13.552418 0.01580100
6 6.418062 -0.08446300
7 3.039422 -0.24674200
8 1.439389 -0.27632600
9 0.681656 0.10027400
10 0.322814 0.51720100
11 0.152876 0.47975800
12 0.072398 0.12409900
S 1
1 0.111116 1.00000000
S 1
1 0.070425 1.00000000
P 12
1 48.154282 0.01288400
2 25.406431 0.09709500
3 13.404555 0.17821500
4 7.072308 0.26596400
5 3.731384 0.31293300
6 1.968696 0.23068600
7 1.038693 0.08048900
8 0.548020 0.00908500
9 0.289138 0.00124800
10 0.152550 -0.00006600
11 0.080486 0.00012900
12 0.042465 -0.00002900
P 12
1 48.154282 -0.00315200
2 25.406431 -0.02300600
3 13.404555 -0.04239800
4 7.072308 -0.06747700
5 3.731384 -0.08295200
6 1.968696 -0.06602600
7 1.038693 0.03446800
8 0.548020 0.20901800
9 0.289138 0.34717900
10 0.152550 0.34480600
11 0.080486 0.18173100
12 0.042465 0.03664900
P 1
1 0.110006 1.00000000
P 1
1 0.032651 1.00000000
D 1
1 0.373518 1.00000000
D 1
1 0.111363 1.00000000
SULFUR
S 12
1 306.317903 0.00006400
2 146.602801 -0.00078500
3 70.163647 0.02247100
4 33.580104 -0.16987100
5 16.071334 -0.06189700
6 7.691691 0.24003900
7 3.681219 0.55164900
8 1.761820 0.33438600
9 0.843202 0.03132300
10 0.403554 0.00443600
11 0.193140 -0.00101500
12 0.092436 0.00050700
S 12
1 306.317903 0.00002100
2 146.602801 -0.00000400
3 70.163647 -0.00611900
4 33.580104 0.05447100
5 16.071334 0.01934400
6 7.691691 -0.08383900
7 3.681219 -0.26532200
8 1.761820 -0.29306500
9 0.843202 0.11373000
10 0.403554 0.52928200
11 0.193140 0.46625400
12 0.092436 0.12580000
S 1
1 0.138193 1.00000000
S 1
1 0.091639 1.00000000
P 12
1 55.148271 0.01344700
2 29.056588 0.10167000
3 15.309371 0.18519200
4 8.066220 0.27583600
5 4.249940 0.31707300
6 2.239213 0.21706600
7 1.179799 0.06576500
8 0.621614 0.00651700
9 0.327517 0.00111100
10 0.172562 0.00022200
11 0.090920 0.00018100
12 0.047904 0.00000800
P 12
1 55.148271 0.00354200
2 29.056588 0.02579700
3 15.309371 0.04726000
4 8.066220 0.07559400
5 4.249940 0.09198000
6 2.239213 0.06206700
7 1.179799 -0.07125300
8 0.621614 -0.25020600
9 0.327517 -0.34929500
10 0.172562 -0.31270000
11 0.090920 -0.15589800
12 0.047904 -0.03041800
P 1
1 0.132347 1.00000000
P 1
1 0.043576 1.00000000
D 1
1 0.480399 1.00000000
D 1
1 0.145431 1.00000000
CHLORINE
S 10
1 15.583847 0.002501
2 8.858485 -0.010046
3 5.035519 0.085810
4 2.862391 -0.290136
5 1.627098 -0.140314
6 0.924908 0.146839
7 0.525755 0.392484
8 0.298860 0.425061
9 0.169884 0.227195
10 0.096569 0.059828
S 1
1 0.648040 1.000000
S 1
1 0.151979 1.000000
P 10
1 7.682894 -0.004609
2 4.507558 -0.001798
3 2.644587 -0.068614
4 1.551581 0.062352
5 0.910313 0.166337
6 0.534081 0.282292
7 0.313346 0.275967
8 0.183840 0.241328
9 0.107859 0.110223
10 0.063281 0.040289
P 1
1 0.633351 1.000000
P 1
1 0.405005 1.000000
D 1
1 0.633222 1.000000
D 1
1 0.211734 1.000000
ARGON
S 12
1 400.805381 0.00009200
2 194.251428 -0.00125400
3 94.144487 0.02887900
4 45.627384 -0.17710600
5 22.113437 -0.07716500
6 10.717338 0.21018700
7 5.194187 0.55436900
8 2.517377 0.35907000
9 1.220054 0.04076900
10 0.591302 0.00508700
11 0.286576 -0.00064400
12 0.138890 0.00053300
S 12
1 400.805381 0.00001900
2 194.251428 0.00011400
3 94.144487 -0.00869300
4 45.627384 0.06117500
5 22.113437 0.02679200
6 10.717338 -0.07778000
7 5.194187 -0.29074700
8 2.517377 -0.32003600
9 1.220054 0.12393300
10 0.591302 0.53916300
11 0.286576 0.45626000
12 0.138890 0.13189200
S 1
1 0.200844 1.00000000
S 1
1 0.100422 1.00000000
P 12
1 71.845693 0.01423900
2 38.318786 0.10317800
3 20.437263 0.18518400
4 10.900182 0.27635700
5 5.813595 0.31813000
6 3.100671 0.21149400
7 1.653738 0.06192600
8 0.882019 0.00582100
9 0.470423 0.00083800
10 0.250899 -0.00004700
11 0.133817 0.00007700
12 0.071371 -0.00001800
P 12
1 71.845693 0.00414500
2 38.318786 0.02880000
3 20.437263 0.05191600
4 10.900182 0.08435600
5 5.813595 0.10330300
6 3.100671 0.05976300
7 1.653738 -0.09852400
8 0.882019 -0.27287100
9 0.470423 -0.34211200
10 0.250899 -0.28931700
11 0.133817 -0.14332900
12 0.071371 -0.03249500
P 1
1 0.205249 1.00000000
P 1
1 0.102624 1.00000000
D 1
1 0.745011 1.00000000
D 1
1 0.372505 1.00000000
CALCIUM
S 13
1 38.909972 0.00094450
2 20.573489 -0.01770900
3 10.878148 0.14349340
4 5.751777 -0.28035140
5 3.041228 -0.28847700
6 1.608037 0.17248640
7 0.850243 0.55290080
8 0.449563 0.46769880
9 0.237704 0.09929150
10 0.125685 0.00665130
11 0.066456 -0.00192570
12 0.035138 0.00096120
13 0.018579 -0.00024390
S 13
1 38.909972 -0.00018310
2 20.573489 0.00425520
3 10.878148 -0.03727720
4 5.751777 0.07704740
5 3.041228 0.07822310
6 1.608037 -0.05175260
7 0.850243 -0.17462310
8 0.449563 -0.25326320
9 0.237704 -0.16061050
10 0.125685 0.12654760
11 0.066456 0.46487670
12 0.035138 0.47840060
13 0.018579 0.15642960
P 12
1 31.519451 -0.00013110
2 15.831494 0.00581110
3 7.951795 -0.04461000
4 3.994003 -0.04239180
5 2.006096 0.18028850
6 1.007616 0.40747440
7 0.506102 0.38646720
8 0.254203 0.15452190
9 0.127681 0.01706770
10 0.064131 0.00315970
11 0.032211 -0.00022470
12 0.016179 0.00016830
P 12
1 31.519451 0.00002060
2 15.831494 -0.00124550
3 7.951795 0.01011140
4 3.994003 0.00894270
5 2.006096 -0.04458680
6 1.007616 -0.09627520
7 0.506102 -0.11300730
8 0.254203 -0.06533320
9 0.127681 0.14680910
10 0.064131 0.44119800
11 0.032211 0.42763180
12 0.016179 0.12519670
D 11
1 28.997930 0.00227830
2 13.712713 0.01197270
3 6.484549 0.02273230
4 3.066452 0.06997740
5 1.450082 0.12588700
6 0.685723 0.17597110
7 0.324269 0.20962750
8 0.153342 0.25661550
9 0.072513 0.28874140
10 0.034291 0.22477940
11 0.016216 0.08294810
S 1
1 1.383790 1.00000000
S 1
1 0.701508 1.00000000
S 1
1 0.066369 1.00000000
S 1
1 0.026432 1.00000000
S 1
1 0.006700 1.00000000
P 1
1 0.563426 1.00000000
P 1
1 0.261483 1.00000000
P 1
1 0.076223 1.00000000
P 1
1 0.027633 1.00000000
P 1
1 0.005400 1.00000000
D 1
1 1.493098 1.00000000
D 1
1 0.050522 1.00000000
D 1
1 0.008800 1.00000000
SCANDIUM
S 13
@ -640,6 +316,20 @@ F 1
1 0.083742 1.00000000
F 1
1 0.280673 1.00000000
S 1
1 0.531583 1.00000000
S 1
1 2.006315 1.00000000
P 1
1 0.608728 1.00000000
P 1
1 2.759507 1.00000000
D 1
1 1.412796 1.00000000
D 1
1 4.010741 1.00000000
F 1
1 1.670187 1.00000000
TITANIUM
S 13
@ -766,6 +456,20 @@ F 1
1 0.146931 1.00000000
F 1
1 0.499717 1.00000000
S 1
1 0.591537 1.00000000
S 1
1 2.205011 1.00000000
P 1
1 0.675360 1.00000000
P 1
1 3.138882 1.00000000
D 1
1 1.759833 1.00000000
D 1
1 5.086016 1.00000000
F 1
1 2.117563 1.00000000
VANADIUM
S 13
@ -892,6 +596,20 @@ F 1
1 0.308388 1.00000000
F 1
1 1.138450 1.00000000
S 1
1 0.736615 1.00000000
S 1
1 2.619861 1.00000000
P 1
1 0.973954 1.00000000
P 1
1 4.004062 1.00000000
D 1
1 0.749306 1.00000000
D 1
1 1.799378 1.00000000
F 1
1 3.352552 1.00000000
CHROMIUM
S 13
@ -1018,6 +736,20 @@ F 1
1 0.311720 1.00000000
F 1
1 1.112997 1.00000000
S 1
1 0.734112 1.00000000
S 1
1 2.811823 1.00000000
P 1
1 0.851456 1.00000000
P 1
1 3.937167 1.00000000
D 1
1 0.845872 1.00000000
D 1
1 2.147155 1.00000000
F 1
1 3.530639 1.00000000
MANGANESE
S 13
@ -1144,6 +876,20 @@ F 1
1 0.373591 1.00000000
F 1
1 1.357898 1.00000000
S 1
1 0.832852 1.00000000
S 1
1 3.133156 1.00000000
P 1
1 1.020743 1.00000000
P 1
1 4.582593 1.00000000
D 1
1 0.985022 1.00000000
D 1
1 2.435684 1.00000000
F 1
1 4.198704 1.00000000
IRON
S 13
@ -1270,6 +1016,20 @@ F 1
1 0.463696 1.00000000
F 1
1 1.696126 1.00000000
S 1
1 0.909741 1.00000000
S 1
1 3.519995 1.00000000
P 1
1 1.151345 1.00000000
P 1
1 5.187368 1.00000000
D 1
1 1.172100 1.00000000
D 1
1 2.828034 1.00000000
F 1
1 5.078925 1.00000000
COBALT
S 13
@ -1396,6 +1156,20 @@ F 1
1 0.557444 1.00000000
F 1
1 2.012568 1.00000000
S 1
1 1.010269 1.00000000
S 1
1 3.893671 1.00000000
P 1
1 1.270490 1.00000000
P 1
1 5.677091 1.00000000
D 1
1 1.291245 1.00000000
D 1
1 3.118104 1.00000000
F 1
1 5.891548 1.00000000
NICKEL
S 13
@ -1522,7 +1296,21 @@ F 1
1 0.650562 1.00000000
F 1
1 2.317543 1.00000000
S 1
1 1.099912 1.00000000
S 1
1 4.266474 1.00000000
P 1
1 1.398024 1.00000000
P 1
1 6.294441 1.00000000
D 1
1 1.406397 1.00000000
D 1
1 3.410393 1.00000000
F 1
1 6.722827 1.00000000
COPPER
S 13
1 104.471138 0.00074100
@ -1648,6 +1436,20 @@ F 1
1 0.771675 1.00000000
F 1
1 2.739578 1.00000000
S 1
1 1.218913 1.00000000
S 1
1 4.750059 1.00000000
P 1
1 1.551117 1.00000000
P 1
1 6.973554 1.00000000
D 1
1 1.873424 1.00000000
D 1
1 4.248371 1.00000000
F 1
1 6.750816 1.00000000
ZINC
S 13
@ -1774,4 +1576,19 @@ F 1
1 0.893402 1.00000000
F 1
1 3.171936 1.00000000
S 1
1 1.375940 1.00000000
S 1
1 5.098898 1.00000000
P 1
1 1.706665 1.00000000
P 1
1 7.892989 1.00000000
D 1
1 2.029918 1.00000000
D 1
1 4.655140 1.00000000
F 1
1 8.867564 1.00000000
$END

1136
data/basis/aug-cc-pvqz_ecp_ncsu → data/basis/aug-cc-pcvqz_ecp_ccecp
View File

File diff suppressed because it is too large Load Diff

975
data/basis/aug-cc-pvtz_ecp_ncsu → data/basis/aug-cc-pcvtz_ecp_ccecp
View File

File diff suppressed because it is too large Load Diff

4459
data/basis/aug-cc-pv5z_ecp_ccecp Normal file
View File

File diff suppressed because it is too large Load Diff

2170
data/basis/aug-cc-pvdz_ecp_ccecp Normal file
View File

File diff suppressed because it is too large Load Diff

3630
data/basis/aug-cc-pvqz_ecp_ccecp Normal file
View File

File diff suppressed because it is too large Load Diff

2866
data/basis/aug-cc-pvtz_ecp_ccecp Normal file
View File

File diff suppressed because it is too large Load Diff

3060
data/basis/cc-pcv5z_ecp_ccecp Normal file
View File

File diff suppressed because it is too large Load Diff

1502
data/basis/cc-pcvdz_ecp_ccecp Normal file
View File

File diff suppressed because it is too large Load Diff

1281
data/basis/cc-pvqz_ecp_ncsu → data/basis/cc-pcvqz_ecp_ccecp
View File

File diff suppressed because it is too large Load Diff

1101
data/basis/cc-pvtz_ecp_ncsu → data/basis/cc-pcvtz_ecp_ccecp
View File

File diff suppressed because it is too large Load Diff

1019
data/basis/cc-pv5z_ecp_bfd Normal file
View File

File diff suppressed because it is too large Load Diff

4156
data/basis/cc-pv5z_ecp_ccecp Normal file
View File

File diff suppressed because it is too large Load Diff

1234
data/basis/cc-pvdz_ecp_ncsu → data/basis/cc-pvdz_ecp_ccecp
View File

File diff suppressed because it is too large Load Diff

3370
data/basis/cc-pvqz_ecp_ccecp Normal file
View File

File diff suppressed because it is too large Load Diff

2654
data/basis/cc-pvtz_ecp_ccecp Normal file
View File

File diff suppressed because it is too large Load Diff

433
data/pseudo/ccecp Normal file
View File

@ -0,0 +1,433 @@
H GEN 0 1
3
1.00000000000000 1 21.24359508259891
21.24359508259891 3 21.24359508259891
-10.85192405303825 2 21.77696655044365
1
0.00000000000000 2 1.000000000000000
He GEN 0 1
3
2.000000 1 32.000000
64.00000 3 32.000000
-27.70084 2 33.713355
1
0.000000 2 1.0000000
Li GEN 2 1
3
1.000 1 15.0000000000000
15.0000000000000 3 15.0479971422127
-1.24272969818004 2 1.80605426846072
1
6.75286789026804 2 1.33024777689591
Be GEN 2 1
4
2 1 17.94900205362972
35.89800410725944 3 24.13200289331664
-12.77499846818315 2 20.13800265282147
-2.96001382478467 2 4.333170937885760
1
12.66391859014478 2 2.487403700772570
B GEN 2 1
3
3.00000 1 31.49298
94.47895 3 22.56509
-9.74800 2 8.64669
1
20.74800 2 4.06246
C GEN 2 1
3
4.00000 1 14.43502
57.74008 3 8.39889
-25.81955 2 7.38188
1
52.13345 2 7.76079
N GEN 2 1
6
3.25000 1 12.91881
1.75000 1 9.22825
41.98612 3 12.96581
16.14945 3 8.05477
-26.09522 2 12.54876
-10.32626 2 7.53360
2
34.77692 2 9.41609
15.20330 2 8.16694
O GEN 2 1
3
6.000000 1 12.30997
73.85984 3 14.76962
-47.87600 2 13.71419
1
85.86406 2 13.65512
F GEN 2 1
3
7.0 1 12.08758490486192
84.61309433403344 3 12.83806306400466
-53.02751706539332 2 12.31234562699041
1
78.90177172847011 2 14.78076492090162
Ne GEN 2 1
3
8.000 1 14.79351199705315
118.34809597642520 3 16.58203947626090
-70.27885884380557 2 16.08073529218220
1
81.62205749824426 2 16.55441468334002
Na GEN 10 2
3
1.000000 1 4.311678
4.311678 3 1.925689
-2.083137 2 1.549498
2
6.234064 2 5.377666
9.075931 2 1.408414
2
3.232724 2 1.379949
2.494079 2 0.862453
Mg GEN 10 2
3
2.000000 1 6.048538
12.097075 3 2.796989
-17.108313 2 2.547408
2
6.428631 2 5.936017
14.195491 2 1.592891
2
3.315069 2 1.583969
4.403025 2 1.077297
Al GEN 10 2
3
3.000000 1 5.073893
15.221680 3 8.607001
-11.165685 2 3.027490
2
14.879513 2 7.863954
20.746863 2 2.061358
2
7.786227 2 3.125175
7.109015 2 1.414930
Si GEN 10 2
3
4.000000 1 5.168316
20.673264 3 8.861690
-14.818174 2 3.933474
2
14.832760 2 9.447023
26.349664 2 2.553812
2
7.621400 2 3.660001
10.331583 2 1.903653
P GEN 10 2
3
5.000000 1 5.872694
29.363469 3 9.891298
-17.011136 2 4.692469
2
15.259383 2 12.091334
31.707918 2 3.044535
2
7.747190 2 4.310884
13.932528 2 2.426903
S GEN 10 2
3
6.000000 1 6.151144
36.906864 3 11.561575
-19.819533 2 5.390961
2
15.925748 2 16.117687
38.515895 2 3.608629
2
8.062221 2 6.228956
18.737525 2 2.978074
Cl GEN 10 2
3
7.000000 1 7.944352
55.610463 3 12.801261
-22.860784 2 6.296744
2
15.839234 2 17.908432
44.469504 2 4.159880
2
8.321946 2 7.931763
24.044745 2 3.610412
Ar GEN 10 2
3
8.000000 1 8.317181
66.537451 3 13.124648
-24.100393 2 6.503132
2
18.910152 2 27.068139
53.040012 2 4.801263
2
8.015534 2 11.135735
28.220208 2 4.126631
K GEN 10 2
4
9.000 1 7.27386331637373
65.46476984736357 3 11.1729834540799
-10.84433558416271 2 7.70617523948938
-15.96316084113368 2 5.62491694962345
2
11.86687269408012 2 11.4425076498453
90.07677060151201 2 6.53712447768095
2
11.53420167311457 2 9.63121897030662
27.72023517356577 2 4.50881062128081
Ca GEN 10 2
4
10.000 1 7.041331745291820
70.41331745291820 3 14.01444871170631
-92.87298019372959 2 13.76936244330539
-5.753568238854550 2 4.717259669813990
2
149.3026232361631 2 11.24016734279034
23.75932943609596 2 5.353611600469730
2
99.20411436357747 2 13.06654848325639
13.45216129084917 2 4.027484971490170
Sc GEN 10 2
4
11.00000000 1 16.02394388
176.26338271 3 14.08647403
-83.68149599 2 11.93985121
0.43282764 2 3.69440111
2
153.96530175 2 11.49466541
14.93675657 2 5.01031394
2
97.21725690 2 11.45126730
10.81704018 2 4.76798446
Ti GEN 10 2
4
12.00000000 1 18.41366202
220.96394426 3 15.92292414
-94.29025824 2 13.65000623
0.09791142 2 5.09555210
2
173.94657235 2 12.70580613
18.83768333 2 6.11178551
2
111.45672882 2 12.64091929
11.17702682 2 5.35437415
V GEN 10 2
4
13.00000000 1 20.32168914
264.18195885 3 19.59698040
-115.29293208 2 17.33147348
-0.66288726 2 5.12320657
2
195.56713891 2 15.12502150
22.88642834 2 6.29898914
2
126.42119500 2 15.93855113
16.03597127 2 5.74006266
Cr GEN 10 2
4
14.00000000 1 18.28091074
255.93275041 3 17.09800655
-132.01826317 2 16.72267276
-0.77388761 2 5.02865105
2
219.48146209 2 16.90078760
28.07933176 2 7.33662150
2
139.98396871 2 17.31974516
19.54835786 2 6.92409757
Mn GEN 10 2
4
15.00000000 1 21.91937433
328.79061500 3 21.35527127
-162.05172805 2 21.27162653
-1.82694272 2 7.93913962
2
244.66870492 2 18.92044965
33.54162717 2 8.32764757
2
162.35033685 2 20.17347020
24.17956695 2 7.80047874
Fe GEN 10 2
4
16.00000000 1 23.22091713
371.53467417 3 23.54714679
-181.22603445 2 23.47256344
-2.37305236 2 9.85238815
2
277.50032547 2 22.21062697
46.20495585 2 9.51515800
2
194.99875056 2 24.57000871
31.67945132 2 8.86648776
Co GEN 10 2
4
17.00000000 1 25.00124115
425.02109971 3 22.83490096
-195.48211282 2 23.47468155
-2.81572866 2 10.33794825
2
271.77708486 2 23.41427030
54.26461121 2 10.76931694
2
201.53430745 2 25.47446316
38.99231927 2 10.68404901
Ni GEN 10 2
4
18.000 1 2.82630001015327e+01
508.7340018275886 3 2.69360254587070e+01
-2.20099999296390e+02 2 2.70860075292970e+01
-2.13493270999809e+00 2 1.22130001295874e+01
2
3.21240002430625e+02 2 2.64320193944270e+01
6.03470084610628e+01 2 1.17489696842121e+01
2
2.36539998999428e+02 2 2.94929998193907e+01
4.43969887908906e+01 2 1.15569831458722e+01
Cu GEN 10 2
4
19.00000000 1 31.53811263
599.22413997 3 31.06925531
-244.68915484 2 30.59035868
-1.29349525 2 14.05141063
2
370.71371824 2 29.35562242
66.27560813 2 12.77235919
2
271.66281028 2 33.51694543
49.76265057 2 12.52471484
Zn GEN 10 2
4
20.00000000 1 35.80797616
716.15952323 3 34.53646083
-204.68393323 2 28.62830178
0.76026614 2 7.96239682
2
431.70804302 2 35.02141356
95.87640437 2 14.63498691
2
313.57770563 2 42.22979234
74.01270048 2 14.57429304
Ga GEN 28 3
4
3.0 1 17.00473938158134
51.01421814474402 3 14.99961796477555
-39.00062591247301 2 11.99279249750992
35.44659356093000 2 14.99282276192415
2
21.78930966695012 2 1.85781132082231
-2.86685089713932 2 0.91950586478827
2
18.63985979160424 2 1.92030166263971
-1.63369679761927 2 1.00895888918239
2
2.03523714898590 2 0.62750876923831
-0.08532375682035 2 0.32619029984635
Ge GEN 28 3
4
4.0 1 1.478962662442
5.9158506497680 3 3.188905647765
-12.033712959815 2 1.927438978253
1.283543489065 2 1.545539235916
2
43.265429324814 2 2.894473589836
-1.909339873965 2 1.550339816290
2
35.263014141211 2 2.986528872039
0.963439928853 2 1.283381203893
2
2.339019442484 2 1.043001142249
0.541380654081 2 0.554562729807
As GEN 28 3
4
5.0 1 1.28593131534589
6.429656576729450 3 9.93487432688877
-15.01243900647766 2 1.89568153750512
2.89881363078702 2 1.72825641453405
2
75.65519437230579 2 3.47938697518409
-3.31145348709338 2 1.63747973017064
2
67.96186740640852 2 3.22936389274538
-3.09455795155570 2 1.66636575135787
2
24.30473448724631 2 2.06816256325470
0.93945624468575 2 1.54699940726544
Se GEN 28 3
4
6.0 1 2.97705189898323
17.862311393899380 3 7.01667360591764
-20.00913150638712 2 3.96066255032528
10.00573531473560 2 5.02826321004214
2
71.37928031464314 2 4.17536331935161
0.42619859321245 2 2.14491059745542
2
50.94828961394475 2 4.28772186507645
5.54288117697892 2 2.09538253707367
2
6.20469719059516 2 1.39403720595047
0.53395702862692 2 1.69659923150419
Br GEN 28 3
4
7.00000000000000 1 3.665770450000000
25.6603931500000 3 5.293022720000000
13.0402619252684 2 3.176376149835153
-21.908838668870 2 2.897543523376016
2
85.8843473075379 2 4.971806723636273
4.62125463404037 2 2.042687217782981
2
55.3617154916148 2 4.711839367430644
11.0314096124871 2 2.384292508891309
2
26.4104098578207 2 3.412863477885576
5.46873883641966 2 1.530284946887900
Kr GEN 28 3
4
8.0 1 10.79423805030976
86.353904402478080 3 13.32338941541937
-11.11453291523170 2 9.292050205053670
10.22951903851239 2 20.14895793077237
2
92.88955174083402 2 5.49072858263344
12.92947788650997 2 3.86301190150576
2
43.09952401633328 2 4.03857692489950
9.50975957670500 2 3.30678898758958
2
17.80494496367218 2 4.21348003421066
4.58911494794530 2 1.54989721316990

263
data/pseudo/ncsu
View File

@ -1,263 +0,0 @@
H GEN 0 1
3
1.00000000000000 1 21.24359508259891
21.24359508259891 3 21.24359508259891
-10.85192405303825 2 21.77696655044365
1
0.00000000000000 2 1.000000000000000
B GEN 2 1
3
3.00000 1 31.49298
94.47895 3 22.56509
-9.74800 2 8.64669
1
20.74800 2 4.06246
C GEN 2 1
3
4.00000 1 14.43502
57.74008 3 8.39889
-25.81955 2 7.38188
1
52.13345 2 7.76079
N GEN 2 1
6
3.25000 1 12.91881
1.75000 1 9.22825
41.98612 3 12.96581
16.14945 3 8.05477
-26.09522 2 12.54876
-10.32626 2 7.53360
2
34.77692 2 9.41609
15.20330 2 8.16694
O GEN 2 1
3
6.000000 1 12.30997
73.85984 3 14.76962
-47.87600 2 13.71419
1
85.86406 2 13.65512
F GEN 2 1
3
7.0 1 11.3954401213
79.7680808491 3 10.49201883
-49.4990068225 2 10.2868054098
1
51.3934743997 2 11.3903478843
Na GEN 10 2
3
1.000000 1 4.311678
4.311678 3 1.925689
-2.083137 2 1.549498
2
6.234064 2 5.377666
9.075931 2 1.408414
2
3.232724 2 1.379949
2.494079 2 0.862453
Mg GEN 10 2
3
2.000000 1 6.048538
12.097075 3 2.796989
-17.108313 2 2.547408
2
6.428631 2 5.936017
14.195491 2 1.592891
2
3.315069 2 1.583969
4.403025 2 1.077297
Al GEN 2 1
3
11.000000 1 11.062056
121.682619 3 12.369778
-82.624567 2 11.965444
2
25.157259 2 81.815564
113.067525 2 24.522883
Si GEN 10 2
3
4.000000 1 5.168316
20.673264 3 8.861690
-14.818174 2 3.933474
2
14.832760 2 9.447023
26.349664 2 2.553812
2
7.621400 2 3.660001
10.331583 2 1.903653
P GEN 2 1
3
13.000000 1 15.073300
195.952906 3 18.113176
-117.611086 2 17.371539
2
25.197230 2 101.982019
189.426261 2 37.485881
S GEN 2 1
3
14.000000 1 17.977612
251.686565 3 20.435964
-135.538891 2 19.796579
2
25.243283 2 111.936344
227.060768 2 43.941844
Cl GEN 2 1
3
15.000000 1 22.196266
332.943994 3 26.145117
-161.999982 2 25.015118
2
26.837357 2 124.640433
277.296696 2 52.205433
Ar GEN 2 1
3
16.000000 1 23.431337
374.901386 3 26.735872
-178.039517 2 26.003325
2
25.069215 2 135.620522
332.151842 2 60.471053
Sc GEN 10 2
4
11.00000000 1 16.02394388
176.26338271 3 14.08647403
-83.68149599 2 11.93985121
0.43282764 2 3.69440111
2
153.96530175 2 11.49466541
14.93675657 2 5.01031394
2
97.21725690 2 11.45126730
10.81704018 2 4.76798446
Ti GEN 10 2
4
12.00000000 1 18.41366202
220.96394426 3 15.92292414
-94.29025824 2 13.65000623
0.09791142 2 5.09555210
2
173.94657235 2 12.70580613
18.83768333 2 6.11178551
2
111.45672882 2 12.64091929
11.17702682 2 5.35437415
V GEN 10 2
4
13.00000000 1 20.32168914
264.18195885 3 19.59698040
-115.29293208 2 17.33147348
-0.66288726 2 5.12320657
2
195.56713891 2 15.12502150
22.88642834 2 6.29898914
2
126.42119500 2 15.93855113
16.03597127 2 5.74006266
Cr GEN 10 2
4
14.00000000 1 18.28091074
255.93275041 3 17.09800655
-132.01826317 2 16.72267276
-0.77388761 2 5.02865105
2
219.48146209 2 16.90078760
28.07933176 2 7.33662150
2
139.98396871 2 17.31974516
19.54835786 2 6.92409757
Mn GEN 10 2
4
15.00000000 1 21.91937433
328.79061500 3 21.35527127
-162.05172805 2 21.27162653
-1.82694272 2 7.93913962
2
244.66870492 2 18.92044965
33.54162717 2 8.32764757
2
162.35033685 2 20.17347020
24.17956695 2 7.80047874
Fe GEN 10 2
4
16.00000000 1 23.22091713
371.53467417 3 23.54714679
-181.22603445 2 23.47256344
-2.37305236 2 9.85238815
2
277.50032547 2 22.21062697
46.20495585 2 9.51515800
2
194.99875056 2 24.57000871
31.67945132 2 8.86648776
Co GEN 10 2
4
17.00000000 1 25.00124115
425.02109971 3 22.83490096
-195.48211282 2 23.47468155
-2.81572866 2 10.33794825
2
271.77708486 2 23.41427030
54.26461121 2 10.76931694
2
201.53430745 2 25.47446316
38.99231927 2 10.68404901
Ni GEN 10 2
4
18.000 1 2.82630001015327e+01
508.7340018275886 3 2.69360254587070e+01
-2.20099999296390e+02 2 2.70860075292970e+01
-2.13493270999809e+00 2 1.22130001295874e+01
2
3.21240002430625e+02 2 2.64320193944270e+01
6.03470084610628e+01 2 1.17489696842121e+01
2
2.36539998999428e+02 2 2.94929998193907e+01
4.43969887908906e+01 2 1.15569831458722e+01
Cu GEN 10 2
4
19.00000000 1 31.53811263
599.22413997 3 31.06925531
-244.68915484 2 30.59035868
-1.29349525 2 14.05141063
2
370.71371824 2 29.35562242
66.27560813 2 12.77235919
2
271.66281028 2 33.51694543
49.76265057 2 12.52471484
Zn GEN 10 2
4
20.00000000 1 35.80797616
716.15952323 3 34.53646083
-204.68393323 2 28.62830178
0.76026614 2 7.96239682
2
431.70804302 2 35.02141356
95.87640437 2 14.63498691
2
313.57770563 2 42.22979234
74.01270048 2 14.57429304

5
ocaml/Generic_input_of_rst.ml
View File

@ -1,6 +1,7 @@
open Sexplib
open Sexplib.Std
open Qptypes
open Qputils
let fail_msg str (ex,range) =
@ -25,7 +26,7 @@ let fail_msg str (ex,range) =
in
let str = String_ext.tr str ~target:'(' ~replacement:' '
|> String_ext.split ~on:')'
|> List.map String_ext.strip
|> list_map String_ext.strip
|> List.filter (fun x ->
match String_ext.substr_index ~pos:0 ~pattern:"##" x with
| None -> false
@ -48,7 +49,7 @@ let of_rst t_of_sexp s =
Rst_string.to_string s
|> String_ext.split ~on:'\n'
|> List.filter (fun line -> String.contains line '=')
|> List.map (fun line ->
|> list_map (fun line ->
"("^(
String_ext.tr ~target:'=' ~replacement:' ' line
)^")" )

113
ocaml/Input_ao_basis.ml
View File

@ -13,6 +13,8 @@ module Ao_basis : sig
ao_coef : AO_coef.t array;
ao_expo : AO_expo.t array;
ao_cartesian : bool;
ao_normalized : bool;
primitives_normalized : bool;
} [@@deriving sexp]
;;
val read : unit -> t option
@ -34,6 +36,8 @@ end = struct
ao_coef : AO_coef.t array;
ao_expo : AO_expo.t array;
ao_cartesian : bool;
ao_normalized : bool;
primitives_normalized : bool;
} [@@deriving sexp]
;;
@ -107,6 +111,24 @@ end = struct
Ezfio.get_ao_basis_ao_cartesian ()
;;
let read_ao_normalized () =
if not (Ezfio.has_ao_basis_ao_normalized()) then
get_default "ao_normalized"
|> bool_of_string
|> Ezfio.set_ao_basis_ao_normalized
;
Ezfio.get_ao_basis_ao_normalized ()
;;
let read_primitives_normalized () =
if not (Ezfio.has_ao_basis_primitives_normalized()) then
get_default "primitives_normalized"
|> bool_of_string
|> Ezfio.set_ao_basis_primitives_normalized
;
Ezfio.get_ao_basis_primitives_normalized ()
;;
let to_long_basis b =
let ao_num = AO_number.to_int b.ao_num in
let gto_array = Array.init (AO_number.to_int b.ao_num)
@ -169,6 +191,8 @@ end = struct
ao_coef ;
ao_expo ;
ao_cartesian ;
ao_normalized ;
primitives_normalized ;
} = b
in
write_md5 b ;
@ -178,14 +202,14 @@ end = struct
in
let ao_prim_num =
Array.to_list ao_prim_num
|> List.map AO_prim_number.to_int
|> list_map AO_prim_number.to_int
in
Ezfio.set_ao_basis_ao_prim_num (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| ao_num |] ~data:ao_prim_num) ;
let ao_nucl =
Array.to_list ao_nucl
|> List.map Nucl_number.to_int
|> list_map Nucl_number.to_int
in
Ezfio.set_ao_basis_ao_nucl(Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| ao_num |] ~data:ao_nucl) ;
@ -193,25 +217,27 @@ end = struct
let ao_power =
let l = Array.to_list ao_power in
List.concat [
(List.map (fun a -> Positive_int.to_int a.Symmetry.Xyz.x) l) ;
(List.map (fun a -> Positive_int.to_int a.Symmetry.Xyz.y) l) ;
(List.map (fun a -> Positive_int.to_int a.Symmetry.Xyz.z) l) ]
(list_map (fun a -> Positive_int.to_int a.Symmetry.Xyz.x) l) ;
(list_map (fun a -> Positive_int.to_int a.Symmetry.Xyz.y) l) ;
(list_map (fun a -> Positive_int.to_int a.Symmetry.Xyz.z) l) ]
in
Ezfio.set_ao_basis_ao_power(Ezfio.ezfio_array_of_list
~rank:2 ~dim:[| ao_num ; 3 |] ~data:ao_power) ;
Ezfio.set_ao_basis_ao_cartesian(ao_cartesian);
Ezfio.set_ao_basis_ao_normalized(ao_normalized);
Ezfio.set_ao_basis_primitives_normalized(primitives_normalized);
let ao_coef =
Array.to_list ao_coef
|> List.map AO_coef.to_float
|> list_map AO_coef.to_float
in
Ezfio.set_ao_basis_ao_coef(Ezfio.ezfio_array_of_list
~rank:2 ~dim:[| ao_num ; ao_prim_num_max |] ~data:ao_coef) ;
let ao_expo =
Array.to_list ao_expo
|> List.map AO_expo.to_float
|> list_map AO_expo.to_float
in
Ezfio.set_ao_basis_ao_expo(Ezfio.ezfio_array_of_list
~rank:2 ~dim:[| ao_num ; ao_prim_num_max |] ~data:ao_expo) ;
@ -233,6 +259,8 @@ end = struct
ao_coef = read_ao_coef () ;
ao_expo = read_ao_expo () ;
ao_cartesian = read_ao_cartesian () ;
ao_normalized = read_ao_normalized () ;
primitives_normalized = read_primitives_normalized () ;
}
in
to_md5 result
@ -271,8 +299,8 @@ end = struct
| Some (s', g', n') ->
if s <> s' || n <> n' then find2 (s,g,n) a (i+1)
else
let lc = List.map (fun (prim, _) -> prim) g.Gto.lc
and lc' = List.map (fun (prim, _) -> prim) g'.Gto.lc
let lc = list_map (fun (prim, _) -> prim) g.Gto.lc
and lc' = list_map (fun (prim, _) -> prim) g'.Gto.lc
in
if lc <> lc' then find2 (s,g,n) a (i+1) else (a.(i) <- None ; i)
in
@ -286,14 +314,14 @@ end = struct
let of_long_basis long_basis name ao_cartesian =
let ao_num = List.length long_basis |> AO_number.of_int in
let ao_prim_num =
List.map (fun (_,g,_) -> List.length g.Gto.lc
list_map (fun (_,g,_) -> List.length g.Gto.lc
|> AO_prim_number.of_int ) long_basis
|> Array.of_list
and ao_nucl =
List.map (fun (_,_,n) -> n) long_basis
list_map (fun (_,_,n) -> n) long_basis
|> Array.of_list
and ao_power =
List.map (fun (x,_,_) -> x) long_basis
list_map (fun (x,_,_) -> x) long_basis
|> Array.of_list
in
let ao_prim_num_max = Array.fold_left (fun s x ->
@ -303,15 +331,15 @@ end = struct
in
let gtos =
List.map (fun (_,x,_) -> x) long_basis
list_map (fun (_,x,_) -> x) long_basis
in
let create_expo_coef ec =
let coefs =
begin match ec with
| `Coefs -> List.map (fun x->
List.map (fun (_,coef) -> AO_coef.to_float coef) x.Gto.lc ) gtos
| `Expos -> List.map (fun x->
List.map (fun (prim,_) -> AO_expo.to_float
| `Coefs -> list_map (fun x->
list_map (fun (_,coef) -> AO_coef.to_float coef) x.Gto.lc ) gtos
| `Expos -> list_map (fun x->
list_map (fun (prim,_) -> AO_expo.to_float
prim.GaussianPrimitive.expo) x.Gto.lc ) gtos
end
in
@ -340,7 +368,10 @@ end = struct
in
{ ao_basis = name ;
ao_num ; ao_prim_num ; ao_prim_num_max ; ao_nucl ;
ao_power ; ao_coef ; ao_expo ; ao_cartesian }
ao_power ; ao_coef ; ao_expo ; ao_cartesian ;
ao_normalized = bool_of_string @@ get_default "ao_normalized";
primitives_normalized = bool_of_string @@ get_default "primitives_normalized";
}
;;
let reorder b =
@ -394,6 +425,14 @@ Cartesian coordinates (6d,10f,...) ::
ao_cartesian = %s
Use normalized primitive functions ::
primitives_normalized = %s
Use normalized basis functions ::
ao_normalized = %s
Basis set (read-only) ::
%s
@ -407,9 +446,11 @@ Basis set (read-only) ::
" (AO_basis_name.to_string b.ao_basis)
(string_of_bool b.ao_cartesian)
(string_of_bool b.primitives_normalized)
(string_of_bool b.ao_normalized)
(Basis.to_string short_basis
|> String_ext.split ~on:'\n'
|> List.map (fun x-> " "^x)
|> list_map (fun x-> " "^x)
|> String.concat "\n"
) print_sym
@ -434,31 +475,35 @@ Basis set (read-only) ::
let to_string b =
Printf.sprintf "
ao_basis = %s
ao_num = %s
ao_prim_num = %s
ao_prim_num_max = %s
ao_nucl = %s
ao_power = %s
ao_coef = %s
ao_expo = %s
ao_cartesian = %s
md5 = %s
ao_basis = %s
ao_num = %s
ao_prim_num = %s
ao_prim_num_max = %s
ao_nucl = %s
ao_power = %s
ao_coef = %s
ao_expo = %s
ao_cartesian = %s
ao_normalized = %s
primitives_normalized = %s
md5 = %s
"
(AO_basis_name.to_string b.ao_basis)
(AO_number.to_string b.ao_num)
(b.ao_prim_num |> Array.to_list |> List.map
(b.ao_prim_num |> Array.to_list |> list_map
(AO_prim_number.to_string) |> String.concat ", " )
(AO_prim_number.to_string b.ao_prim_num_max)
(b.ao_nucl |> Array.to_list |> List.map Nucl_number.to_string |>
(b.ao_nucl |> Array.to_list |> list_map Nucl_number.to_string |>
String.concat ", ")
(b.ao_power |> Array.to_list |> List.map (fun x->
(b.ao_power |> Array.to_list |> list_map (fun x->
"("^(Symmetry.Xyz.to_string x)^")" )|> String.concat ", ")
(b.ao_coef |> Array.to_list |> List.map AO_coef.to_string
(b.ao_coef |> Array.to_list |> list_map AO_coef.to_string
|> String.concat ", ")
(b.ao_expo |> Array.to_list |> List.map AO_expo.to_string
(b.ao_expo |> Array.to_list |> list_map AO_expo.to_string
|> String.concat ", ")
(b.ao_cartesian |> string_of_bool)
(b.ao_normalized |> string_of_bool)
(b.primitives_normalized |> string_of_bool)
(to_md5 b |> MD5.to_string )
;;

12
ocaml/Input_determinants_by_hand.ml
View File

@ -377,7 +377,7 @@ end = struct
(coefs_string i)
(Determinant.to_string ~mo_num:mo_num b.psi_det.(i)
|> String_ext.split ~on:'\n'
|> List.map (fun x -> " "^x)
|> list_map (fun x -> " "^x)
|> String.concat "\n"
)
)
@ -427,7 +427,7 @@ psi_det = %s
(b.n_det |> Det_number.to_string)
(b.n_states |> States_number.to_string)
(b.expected_s2 |> Positive_float.to_string)
(b.state_average_weight |> Array.to_list |> List.map Positive_float.to_string |> String.concat ",")
(b.state_average_weight |> Array.to_list |> list_map Positive_float.to_string |> String.concat ",")
(b.psi_coef |> Array.map Det_coef.to_string |> Array.to_list
|> String.concat ", ")
(b.psi_det |> Array.map (Determinant.to_string ~mo_num) |> Array.to_list
@ -457,7 +457,7 @@ psi_det = %s
else
( (String.contains line '=') && (line.[0] = ' ') )
)
|> List.map (fun line ->
|> list_map (fun line ->
"("^(
String_ext.tr line ~target:'=' ~replacement:' '
|> String.trim
@ -468,7 +468,7 @@ psi_det = %s
(* Handle determinant coefs *)
let dets = match ( dets
|> String_ext.split ~on:'\n'
|> List.map String.trim
|> list_map String.trim
) with
| _::lines -> lines
| _ -> failwith "Error in determinants"
@ -481,7 +481,7 @@ psi_det = %s
| ""::c::tail ->
let c =
String_ext.split ~on:'\t' c
|> List.map (fun x -> Det_coef.of_float (Float.of_string x))
|> list_map (fun x -> Det_coef.of_float (Float.of_string x))
|> Array.of_list
in
read_coefs (c::accu) tail
@ -499,7 +499,7 @@ psi_det = %s
let i =
i-1
in
List.map (fun x -> Det_coef.to_string x.(i)) buffer
list_map (fun x -> Det_coef.to_string x.(i)) buffer
|> String.concat " "
in
let rec build_result = function

4
ocaml/Input_mo_basis.ml
View File

@ -257,9 +257,9 @@ mo_coef = %s
"
(MO_label.to_string b.mo_label)
(MO_number.to_string b.mo_num)
(b.mo_class |> Array.to_list |> List.map
(b.mo_class |> Array.to_list |> list_map
(MO_class.to_string) |> String.concat ", " )
(b.mo_occ |> Array.to_list |> List.map
(b.mo_occ |> Array.to_list |> list_map
(MO_occ.to_string) |> String.concat ", " )
(b.mo_coef |> Array.map
(fun x-> Array.map MO_coef.to_string x |>

22
ocaml/Input_nuclei_by_hand.ml
View File

@ -50,7 +50,7 @@ end = struct
in
let labels =
Array.to_list labels
|> List.map Element.to_string
|> list_map Element.to_string
in
Ezfio.ezfio_array_of_list ~rank:1
~dim:[| nucl_num |] ~data:labels
@ -70,7 +70,7 @@ end = struct
in
let charges =
Array.to_list charges
|> List.map Charge.to_float
|> list_map Charge.to_float
in
Ezfio.ezfio_array_of_list ~rank:1
~dim:[| nucl_num |] ~data:charges
@ -101,9 +101,9 @@ end = struct
in
let coord = Array.to_list coord in
let coord =
(List.map (fun x-> x.Point3d.x) coord) @
(List.map (fun x-> x.Point3d.y) coord) @
(List.map (fun x-> x.Point3d.z) coord)
(list_map (fun x-> x.Point3d.x) coord) @
(list_map (fun x-> x.Point3d.y) coord) @
(list_map (fun x-> x.Point3d.z) coord)
in
Ezfio.ezfio_array_of_list ~rank:2
~dim:[| nucl_num ; 3 |] ~data:coord
@ -159,11 +159,11 @@ nucl_charge = %s
nucl_coord = %s
"
(Nucl_number.to_string b.nucl_num)
(b.nucl_label |> Array.to_list |> List.map
(b.nucl_label |> Array.to_list |> list_map
(Element.to_string) |> String.concat ", " )
(b.nucl_charge |> Array.to_list |> List.map
(b.nucl_charge |> Array.to_list |> list_map
(Charge.to_string) |> String.concat ", " )
(b.nucl_coord |> Array.to_list |> List.map
(b.nucl_coord |> Array.to_list |> list_map
(Point3d.to_string ~units:Units.Bohr) |> String.concat "\n" )
;;
@ -226,11 +226,11 @@ Nuclear coordinates in xyz format (Angstroms) ::
let result =
{ nucl_num = List.length atom_list
|> Nucl_number.of_int ~max:nmax;
nucl_label = List.map (fun x ->
nucl_label = list_map (fun x ->
x.Atom.element) atom_list |> Array.of_list ;
nucl_charge = List.map (fun x ->
nucl_charge = list_map (fun x ->
x.Atom.charge ) atom_list |> Array.of_list ;
nucl_coord = List.map (fun x ->
nucl_coord = list_map (fun x ->
x.Atom.coord ) atom_list |> Array.of_list ;
}
in Some result

3
ocaml/Long_basis.ml
View File

@ -1,4 +1,5 @@
open Qptypes
open Qputils
open Sexplib.Std
type t = (Symmetry.Xyz.t * Gto.t * Nucl_number.t ) list [@@deriving sexp]
@ -39,7 +40,7 @@ let to_basis b =
let to_string b =
let middle = List.map (fun (x,y,z) ->
let middle = list_map (fun (x,y,z) ->
"( "^((string_of_int (Nucl_number.to_int z)))^", "^
(Symmetry.Xyz.to_string x)^", "^(Gto.to_string y)
^" )"

5
ocaml/MO_class.ml
View File

@ -1,4 +1,5 @@
open Qptypes
open Qputils
open Sexplib.Std
@ -13,7 +14,7 @@ type t =
let to_string x =
let print_list l =
let s = List.map (fun x-> MO_number.to_int x |> string_of_int ) l
let s = list_map (fun x-> MO_number.to_int x |> string_of_int ) l
|> (String.concat ", ")
in
"("^s^")"
@ -43,7 +44,7 @@ let of_string s =
let _mo_number_list_of_range range =
Range.of_string range |> List.map MO_number.of_int
Range.of_string range |> list_map MO_number.of_int
let create_core range = Core (_mo_number_list_of_range range)

13
ocaml/Message.ml
View File

@ -1,5 +1,6 @@
open Sexplib.Std
open Qptypes
open Qputils
(** New job : Request to create a new multi-tasked job *)
@ -193,12 +194,12 @@ end = struct
}
let create ~state ~task_ids =
{ state = State.of_string state ;
task_ids = List.map Id.Task.of_int task_ids
task_ids = list_map Id.Task.of_int task_ids
}
let to_string x =
Printf.sprintf "del_task %s %s"
(State.to_string x.state)
(String.concat "|" @@ List.map Id.Task.to_string x.task_ids)
(String.concat "|" @@ list_map Id.Task.to_string x.task_ids)
end
@ -219,7 +220,7 @@ end = struct
else "done"
in
Printf.sprintf "del_task_reply %s %s"
more (String.concat "|" @@ List.map Id.Task.to_string x.task_ids)
more (String.concat "|" @@ list_map Id.Task.to_string x.task_ids)
end
@ -303,7 +304,7 @@ end = struct
"get_tasks_reply ok"
let to_string_list x =
"get_tasks_reply ok" :: (
List.map (fun (task_id, task) ->
list_map (fun (task_id, task) ->
match task_id with
| Some task_id -> Printf.sprintf "%d %s" (Id.Task.to_int task_id) task
| None -> Printf.sprintf "0 terminate"
@ -408,14 +409,14 @@ end = struct
let create ~state ~client_id ~task_ids =
{ client_id = Id.Client.of_int client_id ;
state = State.of_string state ;
task_ids = List.map Id.Task.of_int task_ids;
task_ids = list_map Id.Task.of_int task_ids;
}
let to_string x =
Printf.sprintf "task_done %s %d %s"
(State.to_string x.state)
(Id.Client.to_int x.client_id)
(String.concat "|" @@ List.map Id.Task.to_string x.task_ids)
(String.concat "|" @@ list_map Id.Task.to_string x.task_ids)
end
(** Terminate *)

7
ocaml/Molecule.ml
View File

@ -1,4 +1,5 @@
open Qptypes
open Qputils
open Sexplib.Std
exception MultiplicityError of string
@ -96,7 +97,7 @@ let to_string_general ~f m =
let title =
name m
in
[ string_of_int n ; title ] @ (List.map f nuclei)
[ string_of_int n ; title ] @ (list_map f nuclei)
|> String.concat "\n"
let to_string =
@ -112,7 +113,7 @@ let of_xyz_string
s =
let l = String_ext.split s ~on:'\n'
|> List.filter (fun x -> x <> "")
|> List.map (fun x -> Atom.of_string units x)
|> list_map (fun x -> Atom.of_string units x)
in
let ne = ( get_charge {
nuclei=l ;
@ -190,7 +191,7 @@ let of_file
let distance_matrix molecule =
let coord =
molecule.nuclei
|> List.map (fun x -> x.Atom.coord)
|> list_map (fun x -> x.Atom.coord)
|> Array.of_list
in
let n =

3
ocaml/Point3d.ml
View File

@ -1,4 +1,5 @@
open Qptypes
open Qputils
open Sexplib.Std
type t = {
@ -23,7 +24,7 @@ let of_string ~units s =
let l = s
|> String_ext.split ~on:' '
|> List.filter (fun x -> x <> "")
|> List.map float_of_string
|> list_map float_of_string
|> Array.of_list
in
{ x = l.(0) *. f ;

5
ocaml/Pseudo.ml
View File

@ -1,4 +1,5 @@
open Sexplib.Std
open Qputils
open Qptypes
@ -81,7 +82,7 @@ let to_string_local = function
| t ->
"Local component:" ::
( Printf.sprintf "%20s %8s %20s" "Coeff." "r^n" "Exp." ) ::
( List.map (fun (l,c) -> Printf.sprintf "%20f %8d %20f"
( list_map (fun (l,c) -> Printf.sprintf "%20f %8d %20f"
(AO_coef.to_float c)
(R_power.to_int l.GaussianPrimitive_local.r_power)
(AO_expo.to_float l.GaussianPrimitive_local.expo)
@ -95,7 +96,7 @@ let to_string_non_local = function
| t ->
"Non-local component:" ::
( Printf.sprintf "%20s %8s %20s %8s" "Coeff." "r^n" "Exp." "Proj") ::
( List.map (fun (l,c) ->
( list_map (fun (l,c) ->
let p =
Positive_int.to_int l.GaussianPrimitive_non_local.proj
in

4
ocaml/Qpackage.ml
View File

@ -30,7 +30,7 @@ let bit_kind_size = lazy (
in
begin match (String_ext.rsplit2 ~on:':' line) with
| Some (_ ,buffer) ->
begin match (String_ext.split ~on:'=' buffer |> List.map String.trim) with
begin match (String_ext.split ~on:'=' buffer |> list_map String.trim) with
| ["bit_kind_size"; x] ->
int_of_string x |> Bit_kind_size.of_int
| _ -> get_data tail
@ -58,7 +58,7 @@ let executables = lazy (
result
in
lines
|> List.map (fun x ->
|> list_map (fun x ->
let e = String_ext.split ~on:' ' x
|> List.filter (fun x -> x <> "")
in

3
ocaml/Qputils.ml
View File

@ -53,3 +53,6 @@ let input_lines ic =
let string_of_string s = s
let list_map f l =
List.rev_map f l
|> List.rev

42
ocaml/qp_create_ezfio.ml
View File

@ -38,7 +38,7 @@ let dummy_centers ~threshold ~molecule ~nuclei =
| _ -> assert false
in
aux [] (n-1,n-1)
|> List.map (fun (i,x,j,y,r) ->
|> list_map (fun (i,x,j,y,r) ->
let f =
x /. (x +. y)
in
@ -270,7 +270,7 @@ let run ?o b au c d m p cart xyz_file =
(* Write Pseudo *)
let pseudo =
List.map (fun x ->
list_map (fun x ->
match pseudo_channel x.Atom.element with
| Some channel -> Pseudo.read_element channel x.Atom.element
| None -> Pseudo.empty x.Atom.element
@ -292,7 +292,7 @@ let run ?o b au c d m p cart xyz_file =
|> Elec_beta_number.of_int;
Molecule.nuclei =
let charges =
List.map (fun x -> Positive_int.to_int x.Pseudo.n_elec
list_map (fun x -> Positive_int.to_int x.Pseudo.n_elec
|> Float.of_int) pseudo
|> Array.of_list
in
@ -315,13 +315,13 @@ let run ?o b au c d m p cart xyz_file =
(* Write Nuclei *)
let labels =
List.map (fun x->Element.to_string x.Atom.element) nuclei
list_map (fun x->Element.to_string x.Atom.element) nuclei
and charges =
List.map (fun x-> Atom.(Charge.to_float x.charge)) nuclei
list_map (fun x-> Atom.(Charge.to_float x.charge)) nuclei
and coords =
(List.map (fun x-> x.Atom.coord.Point3d.x) nuclei) @
(List.map (fun x-> x.Atom.coord.Point3d.y) nuclei) @
(List.map (fun x-> x.Atom.coord.Point3d.z) nuclei) in
(list_map (fun x-> x.Atom.coord.Point3d.x) nuclei) @
(list_map (fun x-> x.Atom.coord.Point3d.y) nuclei) @
(list_map (fun x-> x.Atom.coord.Point3d.z) nuclei) in
let nucl_num = (List.length labels) in
Ezfio.set_nuclei_nucl_num nucl_num ;
Ezfio.set_nuclei_nucl_label (Ezfio.ezfio_array_of_list
@ -365,7 +365,7 @@ let run ?o b au c d m p cart xyz_file =
let kmax =
Array.init (lmax+1) (fun i->
List.map (fun x ->
list_map (fun x ->
List.filter (fun (y,_) ->
(Positive_int.to_int y.Pseudo.GaussianPrimitive_non_local.proj) = i)
x.Pseudo.non_local
@ -478,7 +478,7 @@ let run ?o b au c d m p cart xyz_file =
in
let result = do_work [] 1 nuclei
|> List.rev
|> List.map (fun (x,i) ->
|> list_map (fun (x,i) ->
try
let e =
match x.Atom.element with
@ -512,30 +512,30 @@ let run ?o b au c d m p cart xyz_file =
let ao_num = List.length long_basis in
Ezfio.set_ao_basis_ao_num ao_num;
Ezfio.set_ao_basis_ao_basis b;
let ao_prim_num = List.map (fun (_,g,_) -> List.length g.Gto.lc) long_basis
and ao_nucl = List.map (fun (_,_,n) -> Nucl_number.to_int n) long_basis
let ao_prim_num = list_map (fun (_,g,_) -> List.length g.Gto.lc) long_basis
and ao_nucl = list_map (fun (_,_,n) -> Nucl_number.to_int n) long_basis
and ao_power=
let l = List.map (fun (x,_,_) -> x) long_basis in
(List.map (fun t -> Positive_int.to_int Symmetry.Xyz.(t.x)) l)@
(List.map (fun t -> Positive_int.to_int Symmetry.Xyz.(t.y)) l)@
(List.map (fun t -> Positive_int.to_int Symmetry.Xyz.(t.z)) l)
let l = list_map (fun (x,_,_) -> x) long_basis in
(list_map (fun t -> Positive_int.to_int Symmetry.Xyz.(t.x)) l)@
(list_map (fun t -> Positive_int.to_int Symmetry.Xyz.(t.y)) l)@
(list_map (fun t -> Positive_int.to_int Symmetry.Xyz.(t.z)) l)
in
let ao_prim_num_max = List.fold_left (fun s x ->
if x > s then x
else s) 0 ao_prim_num
in
let gtos =
List.map (fun (_,x,_) -> x) long_basis
list_map (fun (_,x,_) -> x) long_basis
in
let create_expo_coef ec =
let coefs =
begin match ec with
| `Coefs -> List.map (fun x->
List.map (fun (_,coef) ->
| `Coefs -> list_map (fun x->
list_map (fun (_,coef) ->
AO_coef.to_float coef) x.Gto.lc) gtos
| `Expos -> List.map (fun x->
List.map (fun (prim,_) -> AO_expo.to_float
| `Expos -> list_map (fun x->
list_map (fun (prim,_) -> AO_expo.to_float
prim.GaussianPrimitive.expo) x.Gto.lc) gtos
end
in

12
src/ao_basis/EZFIO.cfg
View File

@ -55,3 +55,15 @@ doc: If |true|, use |AOs| in Cartesian coordinates (6d,10f,...)
interface: ezfio, provider
default: false
[ao_normalized]
type: logical
doc: Use normalized basis functions
interface: ezfio, provider
default: true
[primitives_normalized]
type: logical
doc: Use normalized primitive functions
interface: ezfio, provider
default: true

37
src/ao_basis/aos.irp.f
View File

@ -20,25 +20,38 @@ END_PROVIDER
C_A(2) = 0.d0
C_A(3) = 0.d0
ao_coef_normalized = 0.d0
do i=1,ao_num
powA(1) = ao_power(i,1)
powA(2) = ao_power(i,2)
powA(3) = ao_power(i,3)
do j=1,ao_prim_num(i)
call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,j),powA,powA,overlap_x,overlap_y,overlap_z,norm,nz)
ao_coef_normalized(i,j) = ao_coef(i,j)/sqrt(norm)
enddo
! Normalization of the primitives
if (primitives_normalized) then
do j=1,ao_prim_num(i)
call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,j),powA,powA,overlap_x,overlap_y,overlap_z,norm,nz)
ao_coef_normalized(i,j) = ao_coef(i,j)/sqrt(norm)
enddo
else
do j=1,ao_prim_num(i)
ao_coef_normalized(i,j) = ao_coef(i,j)
enddo
endif
! Normalization of the contracted basis functions
norm = 0.d0
do j=1,ao_prim_num(i)
do k=1,ao_prim_num(i)
call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,k),powA,powA,overlap_x,overlap_y,overlap_z,c,nz)
norm = norm+c*ao_coef_normalized(i,j)*ao_coef_normalized(i,k)
enddo
enddo
ao_coef_normalization_factor(i) = 1.d0/sqrt(norm)
if (ao_normalized) then
norm = 0.d0
do j=1,ao_prim_num(i)
do k=1,ao_prim_num(i)
call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,k),powA,powA,overlap_x,overlap_y,overlap_z,c,nz)
norm = norm+c*ao_coef_normalized(i,j)*ao_coef_normalized(i,k)
enddo
enddo
ao_coef_normalization_factor(i) = 1.d0/sqrt(norm)
else
ao_coef_normalization_factor(i) = 1.d0
endif
enddo
END_PROVIDER

11
src/ao_one_e_ints/ao_ortho_canonical.irp.f
View File

@ -79,7 +79,7 @@ BEGIN_PROVIDER [ double precision, ao_cart_to_sphe_inv, (ao_cart_to_sphe_num,ao_
call get_pseudo_inverse(ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1),&
ao_num,ao_cart_to_sphe_num, &
ao_cart_to_sphe_inv, size(ao_cart_to_sphe_inv,1))
ao_cart_to_sphe_inv, size(ao_cart_to_sphe_inv,1), lin_dep_cutoff)
END_PROVIDER
@ -107,16 +107,13 @@ END_PROVIDER
ao_ortho_canonical_coef(i,i) = 1.d0
enddo
!call ortho_lowdin(ao_overlap,size(ao_overlap,1),ao_num,ao_ortho_canonical_coef,size(ao_ortho_canonical_coef,1),ao_num)
!ao_ortho_canonical_num=ao_num
!return
call write_double(6, lin_dep_cutoff, "Linear dependencies cut-off")
if (ao_cartesian) then
ao_ortho_canonical_num = ao_num
call ortho_canonical(ao_overlap,size(ao_overlap,1), &
ao_num,ao_ortho_canonical_coef,size(ao_ortho_canonical_coef,1), &
ao_ortho_canonical_num)
ao_ortho_canonical_num, lin_dep_cutoff)
else
@ -131,7 +128,7 @@ END_PROVIDER
ao_ortho_canonical_num = ao_cart_to_sphe_num
call ortho_canonical(ao_cart_to_sphe_overlap, size(ao_cart_to_sphe_overlap,1), &
ao_cart_to_sphe_num, S, size(S,1), ao_ortho_canonical_num)
ao_cart_to_sphe_num, S, size(S,1), ao_ortho_canonical_num, lin_dep_cutoff)
call dgemm('N','N', ao_num, ao_ortho_canonical_num, ao_cart_to_sphe_num, 1.d0, &
ao_cart_to_sphe_coef, size(ao_cart_to_sphe_coef,1), &

7
src/ao_one_e_ints/ao_overlap.irp.f
View File

@ -162,7 +162,8 @@ BEGIN_PROVIDER [ double precision, S_inv,(ao_num,ao_num) ]
BEGIN_DOC
! Inverse of the overlap matrix
END_DOC
call get_pseudo_inverse(ao_overlap,size(ao_overlap,1),ao_num,ao_num,S_inv,size(S_inv,1))
call get_pseudo_inverse(ao_overlap,size(ao_overlap,1),ao_num,ao_num,S_inv, &
size(S_inv,1),lin_dep_cutoff)
END_PROVIDER
BEGIN_PROVIDER [ complex*16, S_inv_complex,(ao_num,ao_num) ]
@ -170,8 +171,8 @@ BEGIN_PROVIDER [ complex*16, S_inv_complex,(ao_num,ao_num) ]
BEGIN_DOC
! Inverse of the overlap matrix
END_DOC
call get_pseudo_inverse_complex(ao_overlap_complex, &
size(ao_overlap_complex,1),ao_num,ao_num,S_inv_complex,size(S_inv_complex,1))
call get_pseudo_inverse_complex(ao_overlap_complex, size(ao_overlap_complex,1),&
ao_num,ao_num,S_inv_complex,size(S_inv_complex,1),lin_dep_cutoff)
END_PROVIDER
BEGIN_PROVIDER [ double precision, S_half_inv, (AO_num,AO_num) ]

10
src/ao_one_e_ints/pot_ao_ints.irp.f
View File

@ -3,6 +3,8 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
! Nucleus-electron interaction, in the |AO| basis set.
!
! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle`
!
! These integrals also contain the pseudopotential integrals.
END_DOC
implicit none
double precision :: alpha, beta, gama, delta
@ -75,11 +77,11 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
!$OMP END DO
!$OMP END PARALLEL
endif
IF (DO_PSEUDO) THEN
ao_integrals_n_e += ao_pseudo_integrals
ENDIF
IF (DO_PSEUDO) THEN
ao_integrals_n_e += ao_pseudo_integrals
ENDIF
endif
if (write_ao_integrals_n_e) then

59
src/ao_one_e_ints/pseudopot.f90
View File

@ -238,9 +238,6 @@ ntotB=n_b(1)+n_b(2)+n_b(3)
ntot=ntotA+ntotB
nkl_max=4
!=!=!=!=!=!=!=!=!=!
! A l l o c a t e !
!=!=!=!=!=!=!=!=!=!
allocate (array_coefs_A(0:ntot,3))
allocate (array_coefs_B(0:ntot,3))
@ -254,16 +251,8 @@ allocate (array_I_B(-(lmax+ntot):lmax+ntot,0:lmax+ntot,0:ntot,0:ntot,0:ntot))
if(ac.eq.0.d0.and.bc.eq.0.d0)then
!=!=!=!=!=!
! I n i t !
!=!=!=!=!=!
accu=0.d0
!=!=!=!=!=!=!=!
! c a l c u l !
!=!=!=!=!=!=!=!
do k=1,kmax
do l=0,lmax
ktot=ntot+n_kl(k,l)
@ -278,18 +267,10 @@ if(ac.eq.0.d0.and.bc.eq.0.d0)then
enddo
enddo
!=!=!=!=!
! E n d !
!=!=!=!=!
Vpseudo=accu*fourpi
else if(ac.ne.0.d0.and.bc.ne.0.d0)then
!=!=!=!=!=!
! I n i t !
!=!=!=!=!=!
f=fourpi*fourpi
theta_AC0=dacos( (a(3)-c(3))/ac )
@ -330,10 +311,6 @@ else if(ac.ne.0.d0.and.bc.ne.0.d0)then
array_coefs_B(k3p,3) = binom_func(n_b(3),k3p)*(c(3)-b(3))**(n_b(3)-k3p)
enddo
!=!=!=!=!=!=!=!
! c a l c u l !
!=!=!=!=!=!=!=!
accu=0.d0
do l=0,lmax
do m=-l,l
@ -408,18 +385,10 @@ else if(ac.ne.0.d0.and.bc.ne.0.d0)then
enddo
enddo
!=!=!=!=!
! E n d !
!=!=!=!=!
Vpseudo=f*accu
else if(ac.eq.0.d0.and.bc.ne.0.d0)then
!=!=!=!=!=!
! I n i t !
!=!=!=!=!=!
f=fourpi**1.5d0
theta_BC0=dacos( (b(3)-c(3))/bc )
phi_BC0=datan2((b(2)-c(2))/bc,(b(1)-c(1))/bc)
@ -448,10 +417,6 @@ else if(ac.eq.0.d0.and.bc.ne.0.d0)then
array_coefs_B(k3p,3) = binom_func(n_b(3),k3p)*(c(3)-b(3))**(n_b(3)-k3p)
enddo
!=!=!=!=!=!=!=!
! c a l c u l !
!=!=!=!=!=!=!=!
accu=0.d0
do l=0,lmax
do m=-l,l
@ -498,18 +463,10 @@ else if(ac.eq.0.d0.and.bc.ne.0.d0)then
enddo
enddo
!=!=!=!=!
! E n d !
!=!=!=!=!
Vpseudo=f*accu
else if(ac.ne.0.d0.and.bc.eq.0.d0)then
!=!=!=!=!=!
! I n i t !
!=!=!=!=!=!
f=fourpi**1.5d0
theta_AC0=dacos( (a(3)-c(3))/ac )
phi_AC0=datan2((a(2)-c(2))/ac,(a(1)-c(1))/ac)
@ -538,10 +495,6 @@ else if(ac.ne.0.d0.and.bc.eq.0.d0)then
array_coefs_A(k3,3) = binom_func(n_a(3),k3)*(c(3)-a(3))**(n_a(3)-k3)
enddo
!=!=!=!=!=!=!=!
! c a l c u l !
!=!=!=!=!=!=!=!
accu=0.d0
do l=0,lmax
do m=-l,l
@ -587,10 +540,6 @@ else if(ac.ne.0.d0.and.bc.eq.0.d0)then
enddo
enddo
!=!=!=!=!
! E n d !
!=!=!=!=!
Vpseudo=f*accu
endif
@ -1885,7 +1834,7 @@ double precision function int_prod_bessel(l,gam,n,m,a,b,arg)
pi=dacos(-1.d0)
a_over_b_square = (a/b)**2
! Calcul first term of the sequence
! First term of the sequence
term_a =dble_fact(nlm-1) / (dble_fact(n_1)*dble_fact(m_1))
expo=0.5d0*dfloat(nlm+1)
@ -1894,7 +1843,7 @@ double precision function int_prod_bessel(l,gam,n,m,a,b,arg)
s_0_0=term_rap*a**(n)*b**(m)
if(mod(nlm,2).eq.0)s_0_0=s_0_0*dsqrt(pi*.5d0)
! Initialise the first recurence terme for the q loop
! Initialize the first recurrence term for the q loop
s_q_0 = s_0_0
@ -1914,6 +1863,10 @@ double precision function int_prod_bessel(l,gam,n,m,a,b,arg)
two_qkmp1 = 2.d0*(qk+mk)+1.d0
do k=0,q-1
s_q_k = two_qkmp1*qk*inverses(k)*s_q_k
! if (s_q_k < 1.d-32) then
! s_q_k = 0.d0
! exit
! endif
sum=sum+s_q_k
two_qkmp1 = two_qkmp1-2.d0
qk = qk-1.d0

13
src/ao_one_e_ints/screening.irp.f Normal file
View File

@ -0,0 +1,13 @@
logical function ao_one_e_integral_zero(i,k)
implicit none
integer, intent(in) :: i,k
ao_one_e_integral_zero = .False.
if (.not.((io_ao_integrals_overlap/='None').or.is_periodic)) then
if (ao_overlap_abs(i,k) < ao_integrals_threshold) then
ao_one_e_integral_zero = .True.
return
endif
endif
end

9
src/ao_two_e_erf_ints/map_integrals_erf.irp.f
View File

@ -85,9 +85,10 @@ double precision function get_ao_two_e_integral_erf(i,j,k,l,map) result(result)
type(map_type), intent(inout) :: map
integer :: ii
real(integral_kind) :: tmp
logical, external :: ao_two_e_integral_zero
PROVIDE ao_two_e_integrals_erf_in_map ao_integrals_erf_cache ao_integrals_erf_cache_min
!DIR$ FORCEINLINE
if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < ao_integrals_threshold ) then
if (ao_two_e_integral_zero(i,j,k,l)) then
tmp = 0.d0
else if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < ao_integrals_threshold) then
tmp = 0.d0
@ -127,10 +128,11 @@ subroutine get_ao_two_e_integrals_erf(j,k,l,sze,out_val)
integer :: i
integer(key_kind) :: hash
double precision :: thresh
logical, external :: ao_one_e_integral_zero
PROVIDE ao_two_e_integrals_erf_in_map ao_integrals_erf_map
thresh = ao_integrals_threshold
if (ao_overlap_abs(j,l) < thresh) then
if (ao_one_e_integral_zero(j,l)) then
out_val = 0.d0
return
endif
@ -156,11 +158,12 @@ subroutine get_ao_two_e_integrals_erf_non_zero(j,k,l,sze,out_val,out_val_index,n
integer :: i
integer(key_kind) :: hash
double precision :: thresh,tmp
logical, external :: ao_one_e_integral_zero
PROVIDE ao_two_e_integrals_erf_in_map
thresh = ao_integrals_threshold
non_zero_int = 0
if (ao_overlap_abs(j,l) < thresh) then
if (ao_one_e_integral_zero(j,l)) then
out_val = 0.d0
return
endif

9
src/ao_two_e_erf_ints/two_e_integrals_erf.irp.f
View File

@ -291,8 +291,10 @@ subroutine compute_ao_two_e_integrals_erf(j,k,l,sze,buffer_value)
double precision :: ao_two_e_integral_erf
integer :: i
logical, external :: ao_one_e_integral_zero
logical, external :: ao_two_e_integral_zero
if (ao_overlap_abs(j,l) < thresh) then
if (ao_one_e_integral_zero(j,l)) then
buffer_value = 0._integral_kind
return
endif
@ -302,7 +304,7 @@ subroutine compute_ao_two_e_integrals_erf(j,k,l,sze,buffer_value)
endif
do i = 1, ao_num
if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < thresh) then
if (ao_two_e_integral_zero(i,j,k,l)) then
buffer_value(i) = 0._integral_kind
cycle
endif
@ -618,6 +620,7 @@ subroutine compute_ao_integrals_erf_jl(j,l,n_integrals,buffer_i,buffer_value)
double precision :: integral, wall_0
double precision :: thr
integer :: kk, m, j1, i1
logical, external :: ao_two_e_integral_zero
thr = ao_integrals_threshold
@ -634,7 +637,7 @@ subroutine compute_ao_integrals_erf_jl(j,l,n_integrals,buffer_i,buffer_value)
if (i1 > j1) then
exit
endif
if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < thr) then
if (ao_two_e_integral_zero(i,j,k,l)) then
cycle
endif
if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < thr ) then

43
src/ao_two_e_ints/map_integrals.irp.f
View File

@ -333,11 +333,10 @@ double precision function get_ao_two_e_integral(i,j,k,l,map) result(result)
type(map_type), intent(inout) :: map
integer :: ii
real(integral_kind) :: tmp
logical, external :: ao_two_e_integral_zero
PROVIDE ao_two_e_integrals_in_map ao_integrals_cache ao_integrals_cache_min
!DIR$ FORCEINLINE
if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < ao_integrals_threshold ) then
tmp = 0.d0
else if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < ao_integrals_threshold) then
if (ao_two_e_integral_zero(i,j,k,l)) then
tmp = 0.d0
else
ii = l-ao_integrals_cache_min
@ -427,9 +426,8 @@ complex*16 function get_ao_two_e_integral_periodic(i,j,k,l,map) result(result)
complex(integral_kind) :: tmp
PROVIDE ao_two_e_integrals_in_map ao_integrals_cache_periodic ao_integrals_cache_min
!DIR$ FORCEINLINE
if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < ao_integrals_threshold ) then
tmp = (0.d0,0.d0)
else if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < ao_integrals_threshold) then
logical, external :: ao_two_e_integral_zero
if (ao_two_e_integral_zero(i,j,k,l)) then
tmp = (0.d0,0.d0)
else
ii = l-ao_integrals_cache_min
@ -481,11 +479,10 @@ subroutine get_ao_two_e_integrals(j,k,l,sze,out_val)
integer :: i
integer(key_kind) :: hash
double precision :: thresh
logical, external :: ao_one_e_integral_zero
PROVIDE ao_two_e_integrals_in_map ao_integrals_map
thresh = ao_integrals_threshold
if (ao_overlap_abs(j,l) < thresh) then
if (ao_one_e_integral_zero(j,l)) then
out_val = 0.d0
return
endif
@ -511,11 +508,10 @@ subroutine get_ao_two_e_integrals_periodic(j,k,l,sze,out_val)
integer :: i
integer(key_kind) :: hash
double precision :: thresh
logical, external :: ao_one_e_integral_zero
PROVIDE ao_two_e_integrals_in_map ao_integrals_map
thresh = ao_integrals_threshold
if (ao_overlap_abs(j,l) < thresh) then
if (ao_one_e_integral_zero(j,l)) then
out_val = 0.d0
return
endif
@ -540,12 +536,13 @@ subroutine get_ao_two_e_integrals_non_zero(j,k,l,sze,out_val,out_val_index,non_z
integer :: i
integer(key_kind) :: hash
double precision :: thresh,tmp
double precision :: tmp
logical, external :: ao_one_e_integral_zero
logical, external :: ao_two_e_integral_zero
PROVIDE ao_two_e_integrals_in_map
thresh = ao_integrals_threshold
non_zero_int = 0
if (ao_overlap_abs(j,l) < thresh) then
if (ao_one_e_integral_zero(j,l)) then
out_val = 0.d0
return
endif
@ -555,12 +552,12 @@ subroutine get_ao_two_e_integrals_non_zero(j,k,l,sze,out_val,out_val_index,non_z
integer, external :: ao_l4
double precision, external :: ao_two_e_integral
!DIR$ FORCEINLINE
if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < thresh) then
if (ao_two_e_integral_zero(i,j,k,l)) then
cycle
endif
call two_e_integrals_index(i,j,k,l,hash)
call map_get(ao_integrals_map, hash,tmp)
if (dabs(tmp) < thresh ) cycle
if (dabs(tmp) < ao_integrals_threshold) cycle
non_zero_int = non_zero_int+1
out_val_index(non_zero_int) = i
out_val(non_zero_int) = tmp
@ -584,10 +581,12 @@ subroutine get_ao_two_e_integrals_non_zero_jl(j,l,thresh,sze_max,sze,out_val,out
integer :: i,k
integer(key_kind) :: hash
double precision :: tmp
logical, external :: ao_one_e_integral_zero
logical, external :: ao_two_e_integral_zero
PROVIDE ao_two_e_integrals_in_map
non_zero_int = 0
if (ao_overlap_abs(j,l) < thresh) then
if (ao_one_e_integral_zero(j,l)) then
out_val = 0.d0
return
endif
@ -598,7 +597,7 @@ subroutine get_ao_two_e_integrals_non_zero_jl(j,l,thresh,sze_max,sze,out_val,out
integer, external :: ao_l4
double precision, external :: ao_two_e_integral
!DIR$ FORCEINLINE
if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < thresh) then
if (ao_two_e_integral_zero(i,j,k,l)) then
cycle
endif
call two_e_integrals_index(i,j,k,l,hash)
@ -630,10 +629,12 @@ subroutine get_ao_two_e_integrals_non_zero_jl_from_list(j,l,thresh,list,n_list,s
integer :: i,k
integer(key_kind) :: hash
double precision :: tmp
logical, external :: ao_one_e_integral_zero
logical, external :: ao_two_e_integral_zero
PROVIDE ao_two_e_integrals_in_map
non_zero_int = 0
if (ao_overlap_abs(j,l) < thresh) then
if (ao_one_e_integral_zero(j,l)) then
out_val = 0.d0
return
endif
@ -646,7 +647,7 @@ subroutine get_ao_two_e_integrals_non_zero_jl_from_list(j,l,thresh,list,n_list,s
integer, external :: ao_l4
double precision, external :: ao_two_e_integral
!DIR$ FORCEINLINE
if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < thresh) then
if (ao_two_e_integral_zero(i,j,k,l)) then
cycle
endif
call two_e_integrals_index(i,j,k,l,hash)

15
src/ao_two_e_ints/screening.irp.f Normal file
View File

@ -0,0 +1,15 @@
logical function ao_two_e_integral_zero(i,j,k,l)
implicit none
integer, intent(in) :: i,j,k,l
ao_two_e_integral_zero = .False.
if (.not.(read_ao_two_e_integrals.or.is_periodic)) then
if (ao_overlap_abs(j,l)*ao_overlap_abs(i,k) < ao_integrals_threshold) then
ao_two_e_integral_zero = .True.
return
endif
if (ao_two_e_integral_schwartz(j,l)*ao_two_e_integral_schwartz(i,k) < ao_integrals_threshold) then
ao_two_e_integral_zero = .True.
endif
endif
end

271
src/ao_two_e_ints/two_e_integrals.irp.f
View File

@ -18,89 +18,89 @@ double precision function ao_two_e_integral(i,j,k,l)
if (ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
ao_two_e_integral = ao_two_e_integral_schwartz_accel(i,j,k,l)
return
endif
else
dim1 = n_pt_max_integrals
dim1 = n_pt_max_integrals
num_i = ao_nucl(i)
num_j = ao_nucl(j)
num_k = ao_nucl(k)
num_l = ao_nucl(l)
ao_two_e_integral = 0.d0
num_i = ao_nucl(i)
num_j = ao_nucl(j)
num_k = ao_nucl(k)
num_l = ao_nucl(l)
ao_two_e_integral = 0.d0
if (num_i /= num_j .or. num_k /= num_l .or. num_j /= num_k)then
do p = 1, 3
I_power(p) = ao_power(i,p)
J_power(p) = ao_power(j,p)
K_power(p) = ao_power(k,p)
L_power(p) = ao_power(l,p)
I_center(p) = nucl_coord(num_i,p)
J_center(p) = nucl_coord(num_j,p)
K_center(p) = nucl_coord(num_k,p)
L_center(p) = nucl_coord(num_l,p)
enddo
if (num_i /= num_j .or. num_k /= num_l .or. num_j /= num_k)then
do p = 1, 3
I_power(p) = ao_power(i,p)
J_power(p) = ao_power(j,p)
K_power(p) = ao_power(k,p)
L_power(p) = ao_power(l,p)
I_center(p) = nucl_coord(num_i,p)
J_center(p) = nucl_coord(num_j,p)
K_center(p) = nucl_coord(num_k,p)
L_center(p) = nucl_coord(num_l,p)
enddo
double precision :: coef1, coef2, coef3, coef4
double precision :: p_inv,q_inv
double precision :: general_primitive_integral
double precision :: coef1, coef2, coef3, coef4
double precision :: p_inv,q_inv
double precision :: general_primitive_integral
do p = 1, ao_prim_num(i)
coef1 = ao_coef_normalized_ordered_transp(p,i)
do q = 1, ao_prim_num(j)
coef2 = coef1*ao_coef_normalized_ordered_transp(q,j)
call give_explicit_poly_and_gaussian(P_new,P_center,pp,fact_p,iorder_p,&
ao_expo_ordered_transp(p,i),ao_expo_ordered_transp(q,j), &
I_power,J_power,I_center,J_center,dim1)
p_inv = 1.d0/pp
do r = 1, ao_prim_num(k)
coef3 = coef2*ao_coef_normalized_ordered_transp(r,k)
do s = 1, ao_prim_num(l)
coef4 = coef3*ao_coef_normalized_ordered_transp(s,l)
call give_explicit_poly_and_gaussian(Q_new,Q_center,qq,fact_q,iorder_q,&
ao_expo_ordered_transp(r,k),ao_expo_ordered_transp(s,l), &
K_power,L_power,K_center,L_center,dim1)
q_inv = 1.d0/qq
integral = general_primitive_integral(dim1, &
P_new,P_center,fact_p,pp,p_inv,iorder_p, &
Q_new,Q_center,fact_q,qq,q_inv,iorder_q)
ao_two_e_integral = ao_two_e_integral + coef4 * integral
enddo ! s
enddo ! r
enddo ! q
enddo ! p
do p = 1, ao_prim_num(i)
coef1 = ao_coef_normalized_ordered_transp(p,i)
do q = 1, ao_prim_num(j)
coef2 = coef1*ao_coef_normalized_ordered_transp(q,j)
call give_explicit_poly_and_gaussian(P_new,P_center,pp,fact_p,iorder_p,&
ao_expo_ordered_transp(p,i),ao_expo_ordered_transp(q,j), &
I_power,J_power,I_center,J_center,dim1)
p_inv = 1.d0/pp
do r = 1, ao_prim_num(k)
coef3 = coef2*ao_coef_normalized_ordered_transp(r,k)
do s = 1, ao_prim_num(l)
coef4 = coef3*ao_coef_normalized_ordered_transp(s,l)
call give_explicit_poly_and_gaussian(Q_new,Q_center,qq,fact_q,iorder_q,&
ao_expo_ordered_transp(r,k),ao_expo_ordered_transp(s,l), &
K_power,L_power,K_center,L_center,dim1)
q_inv = 1.d0/qq
integral = general_primitive_integral(dim1, &
P_new,P_center,fact_p,pp,p_inv,iorder_p, &
Q_new,Q_center,fact_q,qq,q_inv,iorder_q)
ao_two_e_integral = ao_two_e_integral + coef4 * integral
enddo ! s
enddo ! r
enddo ! q
enddo ! p
else
else
do p = 1, 3
I_power(p) = ao_power(i,p)
J_power(p) = ao_power(j,p)
K_power(p) = ao_power(k,p)
L_power(p) = ao_power(l,p)
enddo
double precision :: ERI
do p = 1, 3
I_power(p) = ao_power(i,p)
J_power(p) = ao_power(j,p)
K_power(p) = ao_power(k,p)
L_power(p) = ao_power(l,p)
enddo
double precision :: ERI
do p = 1, ao_prim_num(i)
coef1 = ao_coef_normalized_ordered_transp(p,i)
do q = 1, ao_prim_num(j)
coef2 = coef1*ao_coef_normalized_ordered_transp(q,j)
do r = 1, ao_prim_num(k)
coef3 = coef2*ao_coef_normalized_ordered_transp(r,k)
do s = 1, ao_prim_num(l)
coef4 = coef3*ao_coef_normalized_ordered_transp(s,l)
integral = ERI( &
ao_expo_ordered_transp(p,i),ao_expo_ordered_transp(q,j),ao_expo_ordered_transp(r,k),ao_expo_ordered_transp(s,l),&
I_power(1),J_power(1),K_power(1),L_power(1), &
I_power(2),J_power(2),K_power(2),L_power(2), &
I_power(3),J_power(3),K_power(3),L_power(3))
ao_two_e_integral = ao_two_e_integral + coef4 * integral
enddo ! s
enddo ! r
enddo ! q
enddo ! p
do p = 1, ao_prim_num(i)
coef1 = ao_coef_normalized_ordered_transp(p,i)
do q = 1, ao_prim_num(j)
coef2 = coef1*ao_coef_normalized_ordered_transp(q,j)
do r = 1, ao_prim_num(k)
coef3 = coef2*ao_coef_normalized_ordered_transp(r,k)
do s = 1, ao_prim_num(l)
coef4 = coef3*ao_coef_normalized_ordered_transp(s,l)
integral = ERI( &
ao_expo_ordered_transp(p,i),ao_expo_ordered_transp(q,j),ao_expo_ordered_transp(r,k),ao_expo_ordered_transp(s,l),&
I_power(1),J_power(1),K_power(1),L_power(1), &
I_power(2),J_power(2),K_power(2),L_power(2), &
I_power(3),J_power(3),K_power(3),L_power(3))
ao_two_e_integral = ao_two_e_integral + coef4 * integral
enddo ! s
enddo ! r
enddo ! q
enddo ! p
endif
endif
end
double precision function ao_two_e_integral_schwartz_accel(i,j,k,l)
@ -300,22 +300,17 @@ subroutine compute_ao_two_e_integrals(j,k,l,sze,buffer_value)
double precision :: ao_two_e_integral
integer :: i
logical, external :: ao_one_e_integral_zero
logical, external :: ao_two_e_integral_zero
if (ao_overlap_abs(j,l) < thresh) then
buffer_value = 0._integral_kind
return
endif
if (ao_two_e_integral_schwartz(j,l) < thresh ) then
if (ao_one_e_integral_zero(j,l)) then
buffer_value = 0._integral_kind
return
endif
do i = 1, ao_num
if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < thresh) then
buffer_value(i) = 0._integral_kind
cycle
endif
if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < thresh ) then
if (ao_two_e_integral_zero(i,j,k,l)) then
buffer_value(i) = 0._integral_kind
cycle
endif
@ -348,8 +343,6 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ]
integer :: kk, m, j1, i1, lmax
character*(64) :: fmt
integral = ao_two_e_integral(1,1,1,1)
double precision :: map_mb
PROVIDE read_ao_two_e_integrals io_ao_two_e_integrals
if (read_ao_two_e_integrals) then
@ -357,66 +350,72 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ]
call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
print*, 'AO integrals provided'
ao_two_e_integrals_in_map = .True.
return
endif
else
print*, 'Providing the AO integrals'
call wall_time(wall_0)
call wall_time(wall_1)
call cpu_time(cpu_1)
print*, 'Providing the AO integrals'
call wall_time(wall_0)
call wall_time(wall_1)
call cpu_time(cpu_1)
integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'ao_integrals')
character(len=:), allocatable :: task
allocate(character(len=ao_num*12) :: task)
write(fmt,*) '(', ao_num, '(I5,X,I5,''|''))'
do l=1,ao_num
write(task,fmt) (i,l, i=1,l)
integer, external :: add_task_to_taskserver
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task)) == -1) then
stop 'Unable to add task to server'
if (.True.) then
! Avoid openMP
integral = ao_two_e_integral(1,1,1,1)
endif
enddo
deallocate(task)
integer, external :: zmq_set_running
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Failed in zmq_set_running'
endif
integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'ao_integrals')
PROVIDE nproc
!$OMP PARALLEL DEFAULT(shared) private(i) num_threads(nproc+1)
i = omp_get_thread_num()
if (i==0) then
call ao_two_e_integrals_in_map_collector(zmq_socket_pull)
else
call ao_two_e_integrals_in_map_slave_inproc(i)
character(len=:), allocatable :: task
allocate(character(len=ao_num*12) :: task)
write(fmt,*) '(', ao_num, '(I5,X,I5,''|''))'
do l=1,ao_num
write(task,fmt) (i,l, i=1,l)
integer, external :: add_task_to_taskserver
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task)) == -1) then
stop 'Unable to add task to server'
endif
!$OMP END PARALLEL
enddo
deallocate(task)
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'ao_integrals')
integer, external :: zmq_set_running
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Failed in zmq_set_running'
endif
PROVIDE nproc
!$OMP PARALLEL DEFAULT(shared) private(i) num_threads(nproc+1)
i = omp_get_thread_num()
if (i==0) then
call ao_two_e_integrals_in_map_collector(zmq_socket_pull)
else
call ao_two_e_integrals_in_map_slave_inproc(i)
endif
!$OMP END PARALLEL
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'ao_integrals')
print*, 'Sorting the map'
call map_sort(ao_integrals_map)
call cpu_time(cpu_2)
call wall_time(wall_2)
integer(map_size_kind) :: get_ao_map_size, ao_map_size
ao_map_size = get_ao_map_size()
print*, 'Sorting the map'
call map_sort(ao_integrals_map)
call cpu_time(cpu_2)
call wall_time(wall_2)
integer(map_size_kind) :: get_ao_map_size, ao_map_size
ao_map_size = get_ao_map_size()
print*, 'AO integrals provided:'
print*, ' Size of AO map : ', map_mb(ao_integrals_map) ,'MB'
print*, ' Number of AO integrals :', ao_map_size
print*, ' cpu time :',cpu_2 - cpu_1, 's'
print*, ' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )'
print*, 'AO integrals provided:'
print*, ' Size of AO map : ', map_mb(ao_integrals_map) ,'MB'
print*, ' Number of AO integrals :', ao_map_size
print*, ' cpu time :',cpu_2 - cpu_1, 's'
print*, ' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )'
ao_two_e_integrals_in_map = .True.
ao_two_e_integrals_in_map = .True.
if (write_ao_two_e_integrals.and.mpi_master) then
call ezfio_set_work_empty(.False.)
call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read')
endif
if (write_ao_two_e_integrals.and.mpi_master) then
call ezfio_set_work_empty(.False.)
call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read')
endif
END_PROVIDER
@ -1173,6 +1172,7 @@ subroutine compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
double precision :: integral, wall_0
double precision :: thr
integer :: kk, m, j1, i1
logical, external :: ao_two_e_integral_zero
thr = ao_integrals_threshold
@ -1189,10 +1189,7 @@ subroutine compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
if (i1 > j1) then
exit
endif
if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < thr) then
cycle
endif
if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < thr ) then
if (ao_two_e_integral_zero(i,j,k,l)) then
cycle
endif
!DIR$ FORCEINLINE

19
src/becke_numerical_grid/EZFIO.cfg
View File

@ -14,3 +14,22 @@ type: double precision
doc: threshold on the weight of a given grid point
interface: ezfio,provider,ocaml
default: 1.e-20
[my_grid_becke]
type: logical
doc: if True, the number of angular and radial grid points are read from EZFIO
interface: ezfio,provider,ocaml
default: False
[my_n_pt_r_grid]
type: integer
doc: Number of radial grid points given from input
interface: ezfio,provider,ocaml
default: 300
[my_n_pt_a_grid]
type: integer
doc: Number of angular grid points given from input. Warning, this number cannot be any integer. See file list_angular_grid
interface: ezfio,provider,ocaml
default: 1202

7
src/becke_numerical_grid/grid_becke.irp.f
View File

@ -8,7 +8,8 @@
!
! These numbers are automatically set by setting the grid_type_sgn parameter
END_DOC
select case (grid_type_sgn)
if(.not.my_grid_becke)then
select case (grid_type_sgn)
case(0)
n_points_radial_grid = 23
n_points_integration_angular = 170
@ -25,6 +26,10 @@ select case (grid_type_sgn)
write(*,*) '!!! Quadrature grid not available !!!'
stop
end select
else
n_points_radial_grid = my_n_pt_r_grid
n_points_integration_angular = my_n_pt_a_grid
endif
END_PROVIDER
BEGIN_PROVIDER [integer, n_points_grid_per_atom]

32
src/becke_numerical_grid/list_angular_grid Normal file
View File

@ -0,0 +1,32 @@
0006
0014
0026
0038
0050
0074
0086
0110
0146
0170
0194
0230
0266
0302
0350
0434
0590
0770
0974
1202
1454
1730
2030
2354
2702
3074
3470
3890
4334
4802
5294
5810

152
src/cas_based_on_top/two_body_dens_rout.irp.f Normal file
View File

@ -0,0 +1,152 @@
subroutine give_n2_ii_val_ab(r1,r2,two_bod_dens)
implicit none
BEGIN_DOC
! contribution from purely inactive orbitals to n2_{\Psi^B}(r_1,r_2) for a CAS wave function
END_DOC
double precision, intent(in) :: r1(3),r2(3)
double precision, intent(out):: two_bod_dens
integer :: i,j,m,n,i_m,i_n
integer :: i_i,i_j
double precision, allocatable :: mos_array_inact_r1(:),mos_array_inact_r2(:)
double precision, allocatable :: mos_array_r1(:) , mos_array_r2(:)
! You get all orbitals in r_1 and r_2
allocate(mos_array_r1(mo_num) , mos_array_r2(mo_num) )
call give_all_mos_at_r(r1,mos_array_r1)
call give_all_mos_at_r(r2,mos_array_r2)
! You extract the inactive orbitals
allocate(mos_array_inact_r1(n_inact_orb) , mos_array_inact_r2(n_inact_orb) )
do i_m = 1, n_inact_orb
mos_array_inact_r1(i_m) = mos_array_r1(list_inact(i_m))
enddo
do i_m = 1, n_inact_orb
mos_array_inact_r2(i_m) = mos_array_r2(list_inact(i_m))
enddo
two_bod_dens = 0.d0
! You browse all OCCUPIED ALPHA electrons in the \mathcal{A} space
do m = 1, n_inact_orb ! electron 1
! You browse all OCCUPIED BETA electrons in the \mathcal{A} space
do n = 1, n_inact_orb ! electron 2
! two_bod_dens(r_1,r_2) = n_alpha(r_1) * n_beta(r_2)
two_bod_dens += mos_array_inact_r1(m) * mos_array_inact_r1(m) * mos_array_inact_r2(n) * mos_array_inact_r2(n)
enddo
enddo
end
subroutine give_n2_ia_val_ab(r1,r2,two_bod_dens,istate)
BEGIN_DOC
! contribution from inactive and active orbitals to n2_{\Psi^B}(r_1,r_2) for the "istate" state of a CAS wave function
END_DOC
implicit none
integer, intent(in) :: istate
double precision, intent(in) :: r1(3),r2(3)
double precision, intent(out):: two_bod_dens
integer :: i,orb_i,a,orb_a,n,m,b
double precision :: rho
double precision, allocatable :: mos_array_r1(:) , mos_array_r2(:)
double precision, allocatable :: mos_array_inact_r1(:),mos_array_inact_r2(:)
double precision, allocatable :: mos_array_act_r1(:),mos_array_act_r2(:)
two_bod_dens = 0.d0
! You get all orbitals in r_1 and r_2
allocate(mos_array_r1(mo_num) , mos_array_r2(mo_num) )
call give_all_mos_at_r(r1,mos_array_r1)
call give_all_mos_at_r(r2,mos_array_r2)
! You extract the inactive orbitals
allocate( mos_array_inact_r1(n_inact_orb) , mos_array_inact_r2(n_inact_orb) )
do i = 1, n_inact_orb
mos_array_inact_r1(i) = mos_array_r1(list_inact(i))
enddo
do i= 1, n_inact_orb
mos_array_inact_r2(i) = mos_array_r2(list_inact(i))
enddo
! You extract the active orbitals
allocate( mos_array_act_r1(n_act_orb) , mos_array_act_r2(n_act_orb) )
do i= 1, n_act_orb
mos_array_act_r1(i) = mos_array_r1(list_act(i))
enddo
do i= 1, n_act_orb
mos_array_act_r2(i) = mos_array_r2(list_act(i))
enddo
! Contracted density : intermediate quantity
two_bod_dens = 0.d0
do a = 1, n_act_orb
do i = 1, n_inact_orb
do b = 1, n_act_orb
rho = one_e_act_dm_beta_mo_for_dft(b,a,istate) + one_e_act_dm_alpha_mo_for_dft(b,a,istate)
two_bod_dens += mos_array_inact_r1(i) * mos_array_inact_r1(i) * mos_array_act_r2(a) * mos_array_act_r2(b) * rho
enddo
enddo
enddo
end
subroutine give_n2_aa_val_ab(r1,r2,two_bod_dens,istate)
BEGIN_DOC
! contribution from purely active orbitals to n2_{\Psi^B}(r_1,r_2) for the "istate" state of a CAS wave function
END_DOC
implicit none
integer, intent(in) :: istate
double precision, intent(in) :: r1(3),r2(3)
double precision, intent(out):: two_bod_dens
integer :: i,orb_i,a,orb_a,n,m,b,c,d
double precision :: rho
double precision, allocatable :: mos_array_r1(:) , mos_array_r2(:)
double precision, allocatable :: mos_array_act_r1(:),mos_array_act_r2(:)
two_bod_dens = 0.d0
! You get all orbitals in r_1 and r_2
allocate(mos_array_r1(mo_num) , mos_array_r2(mo_num) )
call give_all_mos_at_r(r1,mos_array_r1)
call give_all_mos_at_r(r2,mos_array_r2)
! You extract the active orbitals
allocate( mos_array_act_r1(n_act_orb) , mos_array_act_r2(n_act_orb) )
do i= 1, n_act_orb
mos_array_act_r1(i) = mos_array_r1(list_act(i))
enddo
do i= 1, n_act_orb
mos_array_act_r2(i) = mos_array_r2(list_act(i))
enddo
! Contracted density : intermediate quantity
two_bod_dens = 0.d0
do a = 1, n_act_orb ! 1
do b = 1, n_act_orb ! 2
do c = 1, n_act_orb ! 1
do d = 1, n_act_orb ! 2
rho = mos_array_act_r1(c) * mos_array_act_r2(d) * act_2_rdm_ab_mo(d,c,b,a,istate)
two_bod_dens += rho * mos_array_act_r1(a) * mos_array_act_r2(b)
enddo
enddo
enddo
enddo
end
subroutine give_n2_cas(r1,r2,istate,n2_psi)
implicit none
BEGIN_DOC
! returns mu(r), f_psi, n2_psi for a general cas wave function
END_DOC
integer, intent(in) :: istate
double precision, intent(in) :: r1(3),r2(3)
double precision, intent(out) :: n2_psi
double precision :: two_bod_dens_ii
double precision :: two_bod_dens_ia
double precision :: two_bod_dens_aa
! inactive-inactive part of n2_psi(r1,r2)
call give_n2_ii_val_ab(r1,r2,two_bod_dens_ii)
! inactive-active part of n2_psi(r1,r2)
call give_n2_ia_val_ab(r1,r2,two_bod_dens_ia,istate)
! active-active part of n2_psi(r1,r2)
call give_n2_aa_val_ab(r1,r2,two_bod_dens_aa,istate)
n2_psi = two_bod_dens_ii + two_bod_dens_ia + two_bod_dens_aa
end

1
src/casscf/casscf.irp.f
View File

@ -5,6 +5,7 @@ program casscf
END_DOC
call reorder_orbitals_for_casscf
no_vvvv_integrals = .True.
touch no_vvvv_integrals
pt2_max = 0.02
SOFT_TOUCH no_vvvv_integrals pt2_max
call run_stochastic_cipsi

25
src/cipsi/selection.irp.f
View File

@ -22,7 +22,7 @@ END_PROVIDER
subroutine update_pt2_and_variance_weights(pt2, variance, norm, N_st)
implicit none
BEGIN_DOC
! Updates the rPT2- and Variance- matching weights.
! Updates the PT2- and Variance- matching weights.
END_DOC
integer, intent(in) :: N_st
double precision, intent(in) :: pt2(N_st)
@ -46,16 +46,17 @@ subroutine update_pt2_and_variance_weights(pt2, variance, norm, N_st)
i_iter = 1
endif
dt = 0.5d0
dt = 2.0d0
do k=1,N_st
! rPT2
rpt2(k) = pt2(k)/(1.d0 + norm(k))
enddo
avg = sum(rpt2(1:N_st)) / dble(N_st) - 1.d-32 ! Avoid future division by zero
avg = sum(pt2(1:N_st)) / dble(N_st) - 1.d-32 ! Avoid future division by zero
do k=1,N_st
element = exp(dt*(rpt2(k)/avg -1.d0))
element = min(1.5d0 , element)
element = exp(dt*(pt2(k)/avg -1.d0))
element = min(2.0d0 , element)
element = max(0.5d0 , element)
memo_pt2(k,i_iter) = element
pt2_match_weight(k) *= product(memo_pt2(k,:))
@ -64,14 +65,20 @@ subroutine update_pt2_and_variance_weights(pt2, variance, norm, N_st)
avg = sum(variance(1:N_st)) / dble(N_st) + 1.d-32 ! Avoid future division by zero
do k=1,N_st
element = exp(dt*(variance(k)/avg -1.d0))
element = min(1.5d0 , element)
element = min(2.0d0 , element)
element = max(0.5d0 , element)
memo_variance(k,i_iter) = element
variance_match_weight(k) *= product(memo_variance(k,:))
enddo
if (N_det < 100) then
! For tiny wave functions, weights are 1.d0
pt2_match_weight(:) = 1.d0
variance_match_weight(:) = 1.d0
endif
threshold_davidson_pt2 = min(1.d-6, &
max(threshold_davidson, 1.e-1 * PT2_relative_error * minval(abs(rpt2(1:N_states)))) )
max(threshold_davidson, 1.e-1 * PT2_relative_error * minval(abs(pt2(1:N_states)))) )
SOFT_TOUCH pt2_match_weight variance_match_weight threshold_davidson_pt2
end
@ -325,7 +332,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
i = psi_bilinear_matrix_rows(l_a)
if (nt + exc_degree(i) <= 4) then
idx = psi_det_sorted_order(psi_bilinear_matrix_order(l_a))
if (psi_average_norm_contrib_sorted(idx) > 0.d0) then
if (psi_average_norm_contrib_sorted(idx) > 1.d-20) then
indices(k) = idx
k=k+1
endif
@ -349,7 +356,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
idx = psi_det_sorted_order( &
psi_bilinear_matrix_order( &
psi_bilinear_matrix_transp_order(l_a)))
if (psi_average_norm_contrib_sorted(idx) > 0.d0) then
if (psi_average_norm_contrib_sorted(idx) > 1.d-20) then
indices(k) = idx
k=k+1
endif

5
src/davidson/davidson_parallel.irp.f
View File

@ -438,6 +438,11 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
ipos=1
do imin=1,N_det,tasksize
imax = min(N_det,imin-1+tasksize)
if (imin==1) then
istep = 2
else
istep = 1
endif
do ishift=0,istep-1
write(task(ipos:ipos+50),'(4(I11,1X),1X,1A)') imin, imax, ishift, istep, '|'
ipos = ipos+50

67
src/dft_one_e/effective_pot.irp.f
View File

@ -31,20 +31,73 @@
END_PROVIDER
BEGIN_PROVIDER [double precision, ao_effective_one_e_potential, (ao_num, ao_num,N_states)]
&BEGIN_PROVIDER [double precision, ao_effective_one_e_potential_without_kin, (ao_num, ao_num,N_states)]
BEGIN_PROVIDER [double precision, effective_one_e_potential_sa, (mo_num, mo_num)]
&BEGIN_PROVIDER [double precision, effective_one_e_potential_without_kin_sa, (mo_num, mo_num)]
implicit none
BEGIN_DOC
! ao_effective_one_e_potential(i,j) = $\rangle i_{AO}| v_{H}^{sr} |j_{AO}\rangle + \rangle i_{AO}| h_{core} |j_{AO}\rangle + \rangle i_{AO}|v_{xc} |j_{AO}\rangle$
!
! State-averaged potential in MO basis
END_DOC
integer :: istate
effective_one_e_potential_sa(:,:) = 0.d0
effective_one_e_potential_without_kin_sa(:,:) = 0.d0
do istate = 1, N_states
call mo_to_ao_no_overlap(effective_one_e_potential(1,1,istate),size(effective_one_e_potential,1),ao_effective_one_e_potential(1,1,istate),size(ao_effective_one_e_potential,1))
call mo_to_ao_no_overlap(effective_one_e_potential_without_kin(1,1,istate),size(effective_one_e_potential_without_kin,1),ao_effective_one_e_potential_without_kin(1,1,istate),size(ao_effective_one_e_potential_without_kin,1))
effective_one_e_potential_sa(:,:) += effective_one_e_potential(:,:,istate) * state_average_weight(istate)
effective_one_e_potential_without_kin_sa(:,:) += effective_one_e_potential_without_kin(:,:,istate) * state_average_weight(istate)
enddo
END_PROVIDER
BEGIN_PROVIDER [double precision, ao_effective_one_e_potential, (ao_num, ao_num,N_states)]
&BEGIN_PROVIDER [double precision, ao_effective_one_e_potential_without_kin, (ao_num, ao_num,N_states)]
implicit none
integer :: i,j,istate
effective_one_e_potential = 0.d0
BEGIN_DOC
! Effective_one_e_potential(i,j) = $\rangle i_{MO}| v_{H}^{sr} |j_{MO}\rangle + \rangle i_{MO}| h_{core} |j_{MO}\rangle + \rangle i_{MO}|v_{xc} |j_{MO}\rangle$
!
! on the |MO| basis
!
! Taking the expectation value does not provide any energy, but
!
! effective_one_e_potential(i,j) is the potential coupling DFT and WFT parts
!
! and it is used in any RS-DFT based calculations
END_DOC
do istate = 1, N_states
do j = 1, mo_num
do i = 1, mo_num
effective_one_e_potential(i,j,istate) = short_range_Hartree_operator(i,j,istate) + mo_integrals_n_e(i,j) + mo_kinetic_integrals(i,j) &
+ 0.5d0 * (potential_x_alpha_mo(i,j,istate) + potential_c_alpha_mo(i,j,istate) &
+ potential_x_beta_mo(i,j,istate) + potential_c_beta_mo(i,j,istate) )
effective_one_e_potential_without_kin(i,j,istate) = short_range_Hartree_operator(i,j,istate) + mo_integrals_n_e(i,j) &
+ 0.5d0 * (potential_x_alpha_mo(i,j,istate) + potential_c_alpha_mo(i,j,istate) &
+ potential_x_beta_mo(i,j,istate) + potential_c_beta_mo(i,j,istate) )
enddo
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [double precision, ao_effective_one_e_potential_sa, (ao_num, ao_num)]
&BEGIN_PROVIDER [double precision, ao_effective_one_e_potential_without_kin_sa, (ao_num, ao_num)]
implicit none
BEGIN_DOC
! State-averaged potential in AO basis
END_DOC
integer :: istate
ao_effective_one_e_potential_sa(:,:) = 0.d0
ao_effective_one_e_potential_without_kin_sa(:,:) = 0.d0
do istate = 1, N_states
ao_effective_one_e_potential_sa(:,:) += ao_effective_one_e_potential(:,:,istate) * state_average_weight(istate)
ao_effective_one_e_potential_without_kin_sa(:,:) += ao_effective_one_e_potential_without_kin(:,:,istate) * state_average_weight(istate)
enddo
END_PROVIDER

3
src/dft_utils_func/routines_exc_sr_lda.irp.f
View File

@ -138,6 +138,8 @@ subroutine ex_lda_sr(mu,rho_a,rho_b,ex,vx_a,vx_b)
!Density and kF
rho_a_2=rho_a*2.D0
akf = ckf*(rho_a_2**f13)
! Avoid division by zero
if (akf == 0.d0) akf = 1.d-20
a = mu/(z2*akf)
a2 = a*a
a3 = a2*a
@ -169,6 +171,7 @@ subroutine ex_lda_sr(mu,rho_a,rho_b,ex,vx_a,vx_b)
!Density and kF
rho_b_2= rho_b * 2.d0
akf = ckf*(rho_b_2**f13)
if (akf == 0.d0) akf = 1.d-20
a = mu/(z2*akf)
a2 = a*a
a3 = a2*a

6
src/ezfio_files/ezfio.irp.f
View File

@ -1,4 +1,4 @@
BEGIN_PROVIDER [ character*(128), ezfio_filename ]
BEGIN_PROVIDER [ character*(1024), ezfio_filename ]
implicit none
BEGIN_DOC
! Name of EZFIO file. It is obtained from the QPACKAGE_INPUT environment
@ -34,7 +34,7 @@ BEGIN_PROVIDER [ character*(128), ezfio_filename ]
! Adjust out-of-memory killer flag such that the current process will be
! killed first by the OOM killer, allowing compute nodes to survive
integer :: getpid
character*(64) :: command, pidc
character*(1024) :: command, pidc
write(pidc,*) getpid()
write(command,*) 'echo 15 > /proc//'//trim(adjustl(pidc))//'/oom_adj'
call system(command)
@ -43,7 +43,7 @@ BEGIN_PROVIDER [ character*(128), ezfio_filename ]
END_PROVIDER
BEGIN_PROVIDER [ character*(128), ezfio_work_dir ]
BEGIN_PROVIDER [ character*(1024), ezfio_work_dir ]
implicit none
BEGIN_DOC
! EZFIO/work/

2
src/ezfio_files/get_unit_and_open.irp.f
View File

@ -17,7 +17,7 @@ integer function getUnitAndOpen(f,mode)
END_DOC
character*(*) :: f
character*(128) :: new_f
character*(256) :: new_f
integer :: iunit
logical :: is_open, exists
character :: mode

4
src/ezfio_files/qp_stop.irp.f
View File

@ -1,5 +1,5 @@
BEGIN_PROVIDER [ character*(128), qp_stop_filename ]
&BEGIN_PROVIDER [ character*(128), qp_kill_filename ]
BEGIN_PROVIDER [ character*(256), qp_stop_filename ]
&BEGIN_PROVIDER [ character*(256), qp_kill_filename ]
&BEGIN_PROVIDER [ integer, qp_stop_variable ]
implicit none
BEGIN_DOC

13
src/hartree_fock/10.hf.bats
View File

@ -5,12 +5,13 @@ source $QP_ROOT/quantum_package.rc
function run() {
thresh=1.e-7
thresh=1.e-5
test_exe scf || skip
qp set_file $1
qp edit --check
qp reset --mos
qp run scf
qp set scf_utils n_it_scf_max 50
qp run scf
# qp set_frozen_core
energy="$(ezfio get hartree_fock energy)"
eq $energy $2 $thresh
@ -39,7 +40,7 @@ function run() {
}
@test "SO" { # 0.539000 5.70403s
run so.ezfio -25.7175263371941
run so.ezfio -25.7175272905296
}
@test "HCO" { # 0.636700 1.55279s
@ -107,13 +108,13 @@ function run() {
}
@test "C2H2" { # 19.599000 37.7923s
run c2h2.ezfio -12.12144019495306
run c2h2.ezfio -12.12144044853196
}
@test "SiH3" { # 20.316100 54.0861s
[[ -n $TRAVIS ]] && skip
run sih3.ezfio -5.455398769158780
run sih3.ezfio -5.455400439077580
}
@test "OH" { # 32.042200 1.36478m
@ -130,6 +131,6 @@ function run() {
@test "SO2" { # 71.894900 3.22567m
[[ -n $TRAVIS ]] && skip
run so2.ezfio -41.55800190733211
run so2.ezfio -41.55800401346361
}

6
src/hartree_fock/fock_matrix_hf.irp.f
View File

@ -25,7 +25,7 @@
!$OMP local_threshold)&
!$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha,SCF_density_matrix_ao_beta,&
!$OMP ao_integrals_map,ao_integrals_threshold, ao_two_e_integral_schwartz, &
!$OMP ao_overlap_abs, ao_two_e_integral_alpha, ao_two_e_integral_beta)
!$OMP ao_two_e_integral_alpha, ao_two_e_integral_beta)
allocate(keys(1), values(1))
allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), &
@ -48,8 +48,8 @@
l = ll(1)
j = jj(1)
if (ao_overlap_abs(k,l)*ao_overlap_abs(i,j) &
< ao_integrals_threshold) then
logical, external :: ao_two_e_integral_zero
if (ao_two_e_integral_zero(i,k,j,l)) then
cycle
endif
local_threshold = ao_two_e_integral_schwartz(k,l)*ao_two_e_integral_schwartz(i,j)

6
src/kohn_sham/fock_matrix_ks.irp.f
View File

@ -28,7 +28,7 @@
!$OMP local_threshold)&
!$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha,SCF_density_matrix_ao_beta,&
!$OMP ao_integrals_map,ao_integrals_threshold, ao_two_e_integral_schwartz, &
!$OMP ao_overlap_abs, ao_two_e_integral_alpha, ao_two_e_integral_beta)
!$OMP ao_two_e_integral_alpha, ao_two_e_integral_beta)
allocate(keys(1), values(1))
allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), &
@ -51,8 +51,8 @@
l = ll(1)
j = jj(1)
if (ao_overlap_abs(k,l)*ao_overlap_abs(i,j) &
< ao_integrals_threshold) then
logical, external :: ao_two_e_integral_zero
if (ao_two_e_integral_zero(i,k,j,l)) then
cycle
endif
local_threshold = ao_two_e_integral_schwartz(k,l)*ao_two_e_integral_schwartz(i,j)

6
src/kohn_sham_rs/fock_matrix_rs_ks.irp.f
View File

@ -26,7 +26,7 @@
!$OMP local_threshold)&
!$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha,SCF_density_matrix_ao_beta,&
!$OMP ao_integrals_map,ao_integrals_threshold, ao_two_e_integral_schwartz, &
!$OMP ao_overlap_abs, ao_two_e_integral_alpha, ao_two_e_integral_beta)
!$OMP ao_two_e_integral_alpha, ao_two_e_integral_beta)
allocate(keys(1), values(1))
allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), &
@ -49,8 +49,8 @@
l = ll(1)
j = jj(1)
if (ao_overlap_abs(k,l)*ao_overlap_abs(i,j) &
< ao_integrals_threshold) then
logical, external :: ao_two_e_integral_zero
if (ao_two_e_integral_zero(i,k,j,l)) then
cycle
endif
local_threshold = ao_two_e_integral_schwartz(k,l)*ao_two_e_integral_schwartz(i,j)

2
src/mo_guess/mo_ortho_lowdin.irp.f
View File

@ -13,7 +13,7 @@ BEGIN_PROVIDER [double precision, ao_ortho_lowdin_coef, (ao_num,ao_num)]
do j=1, ao_num
tmp_matrix(j,j) = 1.d0
enddo
call ortho_lowdin(ao_overlap,ao_num,ao_num,tmp_matrix,ao_num,ao_num)
call ortho_lowdin(ao_overlap,ao_num,ao_num,tmp_matrix,ao_num,ao_num,lin_dep_cutoff)
do i=1, ao_num
do j=1, ao_num
ao_ortho_lowdin_coef(j,i) = tmp_matrix(i,j)

5
src/mo_one_e_ints/EZFIO.cfg
View File

@ -48,3 +48,8 @@ doc: Read/Write |MO| one-electron integrals from/to disk [ Write | Read | None ]
interface: ezfio,provider,ocaml
default: None
[lin_dep_cutoff]
type: Threshold
doc: Remove linear dependencies when the eigenvalues of the overlap matrix are below this value
interface: ezfio,provider,ocaml
default: 1.e-6

2
src/mo_one_e_ints/orthonormalize.irp.f
View File

@ -3,7 +3,7 @@ subroutine orthonormalize_mos
integer :: m,p,s
m = size(mo_coef,1)
p = size(mo_overlap,1)
call ortho_lowdin(mo_overlap,p,mo_num,mo_coef,m,ao_num)
call ortho_lowdin(mo_overlap,p,mo_num,mo_coef,m,ao_num,lin_dep_cutoff)
mo_label = 'Orthonormalized'
SOFT_TOUCH mo_coef mo_label
end

6
src/mo_two_e_ints/EZFIO.cfg
View File

@ -11,3 +11,9 @@ interface: ezfio,provider,ocaml
default: 1.e-15
ezfio_name: threshold_mo
[no_vvvv_integrals]
type: logical
doc: If `True`, computes all integrals except for the integrals having 3 or 4 virtual indices
interface: ezfio,provider,ocaml
default: false

16
src/mo_two_e_ints/four_idx_novvvv.irp.f
View File

@ -1,11 +1,11 @@
BEGIN_PROVIDER [ logical, no_vvvv_integrals ]
implicit none
BEGIN_DOC
!BEGIN_PROVIDER [ logical, no_vvvv_integrals ]
! implicit none
! BEGIN_DOC
! If `True`, computes all integrals except for the integrals having 3 or 4 virtual indices
END_DOC
no_vvvv_integrals = .False.
END_PROVIDER
! END_DOC
!
! no_vvvv_integrals = .False.
!END_PROVIDER
BEGIN_PROVIDER [ double precision, mo_coef_novirt, (ao_num,n_core_inact_act_orb) ]
implicit none
@ -56,6 +56,8 @@ subroutine four_idx_novvvv
BEGIN_DOC
! Retransform MO integrals for next CAS-SCF step
END_DOC
print*,'Using partial transformation'
print*,'It will not transform all integrals with at least 3 indices within the virtuals'
integer :: i,j,k,l,n_integrals
double precision, allocatable :: f(:,:,:), f2(:,:,:), d(:,:), T(:,:,:,:), T2(:,:,:,:)
double precision, external :: get_ao_two_e_integral

110
src/mo_two_e_ints/map_integrals.irp.f
View File

@ -127,7 +127,6 @@ double precision function mo_two_e_integral(i,j,k,l)
integer, intent(in) :: i,j,k,l
double precision :: get_two_e_integral
PROVIDE mo_two_e_integrals_in_map mo_integrals_cache
PROVIDE mo_two_e_integrals_in_map
!DIR$ FORCEINLINE
mo_two_e_integral = get_two_e_integral(i,j,k,l,mo_integrals_map)
return
@ -202,47 +201,12 @@ subroutine get_mo_two_e_integrals_ij(k,l,sze,out_array,map)
integer, intent(in) :: k,l, sze
double precision, intent(out) :: out_array(sze,sze)
type(map_type), intent(inout) :: map
integer :: i,j,kk,ll,m
integer(key_kind),allocatable :: hash(:)
integer ,allocatable :: pairs(:,:), iorder(:)
integer :: j
real(integral_kind), allocatable :: tmp_val(:)
PROVIDE mo_two_e_integrals_in_map
allocate (hash(sze*sze), pairs(2,sze*sze),iorder(sze*sze), &
tmp_val(sze*sze))
kk=0
out_array = 0.d0
do j=1,sze
do i=1,sze
kk += 1
!DIR$ FORCEINLINE
call two_e_integrals_index(i,j,k,l,hash(kk))
pairs(1,kk) = i
pairs(2,kk) = j
iorder(kk) = kk
enddo
call get_mo_two_e_integrals(j,k,l,sze,out_array(1,j),map)
enddo
logical :: integral_is_in_map
if (key_kind == 8) then
call i8radix_sort(hash,iorder,kk,-1)
else if (key_kind == 4) then
call iradix_sort(hash,iorder,kk,-1)
else if (key_kind == 2) then
call i2radix_sort(hash,iorder,kk,-1)
endif
call map_get_many(mo_integrals_map, hash, tmp_val, kk)
do ll=1,kk
m = iorder(ll)
i=pairs(1,m)
j=pairs(2,m)
out_array(i,j) = tmp_val(ll)
enddo
deallocate(pairs,hash,iorder,tmp_val)
end
subroutine get_mo_two_e_integrals_i1j1(k,l,sze,out_array,map)
@ -256,47 +220,13 @@ subroutine get_mo_two_e_integrals_i1j1(k,l,sze,out_array,map)
integer, intent(in) :: k,l, sze
double precision, intent(out) :: out_array(sze,sze)
type(map_type), intent(inout) :: map
integer :: i,j,kk,ll,m
integer(key_kind),allocatable :: hash(:)
integer ,allocatable :: pairs(:,:), iorder(:)
real(integral_kind), allocatable :: tmp_val(:)
integer :: j
PROVIDE mo_two_e_integrals_in_map
allocate (hash(sze*sze), pairs(2,sze*sze),iorder(sze*sze), &
tmp_val(sze*sze))
kk=0
out_array = 0.d0
do j=1,sze
do i=1,sze
kk += 1
!DIR$ FORCEINLINE
call two_e_integrals_index(i,k,j,l,hash(kk))
pairs(1,kk) = i
pairs(2,kk) = j
iorder(kk) = kk
enddo
call get_mo_two_e_integrals(k,j,l,sze,out_array(1,j),map)
enddo
logical :: integral_is_in_map
if (key_kind == 8) then
call i8radix_sort(hash,iorder,kk,-1)
else if (key_kind == 4) then
call iradix_sort(hash,iorder,kk,-1)
else if (key_kind == 2) then
call i2radix_sort(hash,iorder,kk,-1)
endif
call map_get_many(mo_integrals_map, hash, tmp_val, kk)
do ll=1,kk
m = iorder(ll)
i=pairs(1,m)
j=pairs(2,m)
out_array(i,j) = tmp_val(ll)
enddo
deallocate(pairs,hash,iorder,tmp_val)
end
@ -312,25 +242,13 @@ subroutine get_mo_two_e_integrals_coulomb_ii(k,l,sze,out_val,map)
double precision, intent(out) :: out_val(sze)
type(map_type), intent(inout) :: map
integer :: i
integer(key_kind) :: hash(sze)
real(integral_kind) :: tmp_val(sze)
double precision, external :: get_two_e_integral
PROVIDE mo_two_e_integrals_in_map
integer :: kk
do i=1,sze
!DIR$ FORCEINLINE
call two_e_integrals_index(k,i,l,i,hash(i))
out_val(i) = get_two_e_integral(k,i,l,i,map)
enddo
if (integral_kind == 8) then
call map_get_many(map, hash, out_val, sze)
else
call map_get_many(map, hash, tmp_val, sze)
! Conversion to double precision
do i=1,sze
out_val(i) = dble(tmp_val(i))
enddo
endif
end
subroutine get_mo_two_e_integrals_exch_ii(k,l,sze,out_val,map)
@ -345,25 +263,13 @@ subroutine get_mo_two_e_integrals_exch_ii(k,l,sze,out_val,map)
double precision, intent(out) :: out_val(sze)
type(map_type), intent(inout) :: map
integer :: i
integer(key_kind) :: hash(sze)
real(integral_kind) :: tmp_val(sze)
double precision, external :: get_two_e_integral
PROVIDE mo_two_e_integrals_in_map
integer :: kk
do i=1,sze
!DIR$ FORCEINLINE
call two_e_integrals_index(k,i,i,l,hash(i))
out_val(i) = get_two_e_integral(k,i,i,l,map)
enddo
if (integral_kind == 8) then
call map_get_many(map, hash, out_val, sze)
else
call map_get_many(map, hash, tmp_val, sze)
! Conversion to double precision
do i=1,sze
out_val(i) = dble(tmp_val(i))
enddo
endif
end

2
src/mo_two_e_ints/mo_bi_integrals.irp.f
View File

@ -189,7 +189,6 @@ subroutine add_integrals_to_map(mask_ijkl)
two_e_tmp_2 = 0.d0
do j1 = 1,ao_num
call get_ao_two_e_integrals(j1,k1,l1,ao_num,two_e_tmp_0(1,j1))
! call compute_ao_two_e_integrals(j1,k1,l1,ao_num,two_e_tmp_0(1,j1))
enddo
do j1 = 1,ao_num
kmax = 0
@ -747,7 +746,6 @@ subroutine add_integrals_to_map_no_exit_34(mask_ijkl)
two_e_tmp_2 = 0.d0
do j1 = 1,ao_num
call get_ao_two_e_integrals(j1,k1,l1,ao_num,two_e_tmp_0(1,j1))
! call compute_ao_two_e_integrals(j1,k1,l1,ao_num,two_e_tmp_0(1,j1))
enddo
do j1 = 1,ao_num
kmax = 0

18
src/nuclei/nuclei.irp.f
View File

@ -42,6 +42,7 @@ BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ]
' Atom Charge X Y Z '
write(6,ft) &
'================','============','============','============','============'
do i=1,nucl_num
write(6,f) nucl_label(i), nucl_charge(i), &
nucl_coord(i,1)*a0, &
@ -52,6 +53,21 @@ BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ]
'================','============','============','============','============'
write(6,'(A)') ''
if (nucl_num > 1) then
double precision :: dist_min, x, y, z
dist_min = huge(1.d0)
do i=1,nucl_num
do j=i+1,nucl_num
x = nucl_coord(i,1)-nucl_coord(j,1)
y = nucl_coord(i,2)-nucl_coord(j,2)
z = nucl_coord(i,3)-nucl_coord(j,3)
dist_min = min(x*x + y*y + z*z, dist_min)
enddo
enddo
write(6,'(A,F12.4,A)') 'Minimal interatomic distance found: ', &
dsqrt(dist_min)*a0,' Angstrom'
endif
endif
IRP_IF MPI_DEBUG
@ -211,7 +227,7 @@ END_PROVIDER
END_DOC
integer :: iunit, i
integer, external :: getUnitAndOpen
character*(128) :: filename
character*(1024) :: filename
if (mpi_master) then
call getenv('QP_ROOT',filename)
filename = trim(filename)//'/data/list_element.txt'

2
src/scf_utils/huckel.irp.f
View File

@ -23,8 +23,6 @@ subroutine huckel_guess
Fock_matrix_ao_alpha(1:ao_num,1:ao_num) = A(1:ao_num,1:ao_num)
Fock_matrix_ao_beta (1:ao_num,1:ao_num) = A(1:ao_num,1:ao_num)
! TOUCH mo_coef
TOUCH Fock_matrix_ao_alpha Fock_matrix_ao_beta
mo_coef = eigenvectors_fock_matrix_mo
SOFT_TOUCH mo_coef

114
src/scf_utils/roothaan_hall_scf.irp.f
View File

@ -196,6 +196,13 @@ END_DOC
double precision,allocatable :: scratch(:,:)
integer :: i,j,k,i_DIIS,j_DIIS
double precision :: rcond, ferr, berr
integer, allocatable :: iwork(:)
integer :: lwork
if (dim_DIIS < 1) then
return
endif
allocate( &
B_matrix_DIIS(dim_DIIS+1,dim_DIIS+1), &
@ -239,77 +246,70 @@ END_DOC
B_matrix_DIIS(dim_DIIS+1,dim_DIIS+1) = 0.d0
C_vector_DIIS(dim_DIIS+1) = -1.d0
! Solve the linear system C = B.X
deallocate(scratch)
! Estimate condition number of B
double precision :: anorm
integer :: info
integer,allocatable :: ipiv(:)
allocate( &
ipiv(dim_DIIS+1) &
)
double precision, allocatable :: AF(:,:)
allocate (AF(dim_DIIS+1,dim_DIIS+1))
double precision :: rcond, ferr, berr
integer :: iwork(dim_DIIS+1), lwork
double precision, external :: dlange
call dsysvx('N','U',dim_DIIS+1,1, &
B_matrix_DIIS,size(B_matrix_DIIS,1), &
AF, size(AF,1), &
ipiv, &
C_vector_DIIS,size(C_vector_DIIS,1), &
X_vector_DIIS,size(X_vector_DIIS,1), &
rcond, &
ferr, &
berr, &
scratch,-1, &
iwork, &
info &
)
lwork = int(scratch(1,1))
deallocate(scratch)
lwork = max((dim_DIIS+1)**2, (dim_DIIS+1)*5)
allocate(AF(dim_DIIS+1,dim_DIIS+1))
allocate(ipiv(2*(dim_DIIS+1)), iwork(2*(dim_DIIS+1)) )
allocate(scratch(lwork,1))
call dsysvx('N','U',dim_DIIS+1,1, &
B_matrix_DIIS,size(B_matrix_DIIS,1), &
AF, size(AF,1), &
ipiv, &
C_vector_DIIS,size(C_vector_DIIS,1), &
X_vector_DIIS,size(X_vector_DIIS,1), &
rcond, &
ferr, &
berr, &
scratch,size(scratch), &
iwork, &
info &
)
anorm = dlange('1', dim_DIIS+1, dim_DIIS+1, B_matrix_DIIS, &
size(B_matrix_DIIS,1), scratch)
if(info < 0) then
stop 'bug in DIIS'
AF(:,:) = B_matrix_DIIS(:,:)
call dgetrf(dim_DIIS+1,dim_DIIS+1,AF,size(AF,1),ipiv,info)
if (info /= 0) then
dim_DIIS = 0
return
endif
call dgecon( '1', dim_DIIS+1, AF, &
size(AF,1), anorm, rcond, scratch, iwork, info )
if (info /= 0) then
dim_DIIS = 0
return
endif
if (rcond < 1.d-14) then
dim_DIIS = 0
return
endif
if (rcond > 1.d-12) then
! Solve the linear system C = B.X
X_vector_DIIS = C_vector_DIIS
call dgesv ( dim_DIIS+1 , 1, B_matrix_DIIS, size(B_matrix_DIIS,1), &
ipiv , X_vector_DIIS , size(X_vector_DIIS,1), info)
deallocate(scratch,AF,iwork)
if(info < 0) then
stop 'bug in DIIS'
endif
! Compute extrapolated Fock matrix
!$OMP PARALLEL DO PRIVATE(i,j,k) DEFAULT(SHARED) if (ao_num > 200)
do j=1,ao_num
do i=1,ao_num
Fock_matrix_AO_(i,j) = 0.d0
enddo
do k=1,dim_DIIS
if (dabs(X_vector_DIIS(k)) < 1.d-10) cycle
do i=1,ao_num
Fock_matrix_AO_(i,j) = Fock_matrix_AO_(i,j) + &
X_vector_DIIS(k)*Fock_matrix_DIIS(i,j,dim_DIIS-k+1)
enddo
enddo
!$OMP PARALLEL DO PRIVATE(i,j,k) DEFAULT(SHARED) if (ao_num > 200)
do j=1,ao_num
do i=1,ao_num
Fock_matrix_AO_(i,j) = 0.d0
enddo
do k=1,dim_DIIS
if (dabs(X_vector_DIIS(k)) < 1.d-10) cycle
do i=1,ao_num
Fock_matrix_AO_(i,j) = Fock_matrix_AO_(i,j) + &
X_vector_DIIS(k)*Fock_matrix_DIIS(i,j,dim_DIIS-k+1)
enddo
!$OMP END PARALLEL DO
else
dim_DIIS = 0
endif
enddo
enddo
!$OMP END PARALLEL DO
end

2
src/tools/molden.irp.f
View File

@ -17,7 +17,7 @@ program molden
write(i_unit_output,'(A)') '[Molden Format]'
write(i_unit_output,'(A)') '[Atoms] AU'
write(i_unit_output,'(A)') '[Atoms] ANGSTROM'
do i = 1, nucl_num
write(i_unit_output,'(A2,2X,I4,2X,I4,3(2X,F15.10))') &
trim(element_name(int(nucl_charge(i)))), &

2
src/two_body_rdm/act_2_rdm.irp.f
View File

@ -2,6 +2,8 @@
BEGIN_PROVIDER [double precision, act_2_rdm_ab_mo, (n_act_orb,n_act_orb,n_act_orb,n_act_orb,N_states)]
implicit none
BEGIN_DOC
! 12 12
! 1 2 1 2 == <ij|kl>
! act_2_rdm_ab_mo(i,j,k,l,istate) = STATE SPECIFIC physicist notation for 2RDM of alpha/beta electrons
!
! <Psi_{istate}| a^{\dagger}_{i \alpha} a^{\dagger}_{j \beta} a_{l \beta} a_{k \alpha} |Psi_{istate}>

2
src/utils/extrapolation.irp.f
View File

@ -23,7 +23,7 @@ subroutine extrapolate_data(N_data, data, pt2, output)
x(i,2) = pt2_rev(i)
enddo
do ifit=2,N_data
call get_pseudo_inverse(x,size(x,1),ifit,2,x_inv,size(x_inv,1))
call get_pseudo_inverse(x,size(x,1),ifit,2,x_inv,size(x_inv,1),1.d-10)
ab = matmul(x_inv(1:2,1:ifit),y(1:ifit))
output(ifit) = ab(1)
enddo

1
src/utils/integration.irp.f
View File

@ -75,7 +75,6 @@ subroutine give_explicit_poly_and_gaussian(P_new,P_center,p,fact_k,iorder,alpha,
P_new(0,1) = 0.d0
P_new(0,2) = 0.d0
P_new(0,3) = 0.d0
!DIR$ FORCEINLINE
call gaussian_product(alpha,A_center,beta,B_center,fact_k,p,P_center)
if (fact_k < thresh) then

138
src/utils/linear_algebra.irp.f
View File

@ -47,14 +47,14 @@ subroutine svd_complex(A,LDA,U,LDU,D,Vt,LDVt,m,n)
implicit none
BEGIN_DOC
! Compute A = U.D.Vt
!
!
! LDx : leftmost dimension of x
!
! Dimension of A is m x n
! A,U,Vt are complex*16
! D is double precision
END_DOC
integer, intent(in) :: LDA, LDU, LDVt, m, n
complex*16, intent(in) :: A(LDA,n)
complex*16, intent(out) :: U(LDU,m)
@ -63,12 +63,12 @@ subroutine svd_complex(A,LDA,U,LDU,D,Vt,LDVt,m,n)
complex*16,allocatable :: work(:)
double precision,allocatable :: rwork(:)
integer :: info, lwork, i, j, k, lrwork
complex*16,allocatable :: A_tmp(:,:)
allocate (A_tmp(LDA,n))
allocate (A_tmp(LDA,n))
A_tmp = A
lrwork = 5*min(m,n)
! Find optimal size for temp arrays
allocate(work(1),rwork(lrwork))
lwork = -1
@ -76,25 +76,25 @@ subroutine svd_complex(A,LDA,U,LDU,D,Vt,LDVt,m,n)
D, U, LDU, Vt, LDVt, work, lwork, rwork, info)
lwork = int(work(1))
deallocate(work)
allocate(work(lwork))
call zgesvd('A','A', m, n, A_tmp, LDA, &
D, U, LDU, Vt, LDVt, work, lwork, rwork, info)
deallocate(work,rwork,A_tmp)
if (info /= 0) then
print *, info, ': SVD failed'
stop
endif
end
subroutine ortho_canonical_complex(overlap,LDA,N,C,LDC,m)
subroutine ortho_canonical_complex(overlap,LDA,N,C,LDC,m,cutoff)
implicit none
BEGIN_DOC
! Compute C_new=C_old.U.s^-1/2 canonical orthogonalization.
!
! overlap : overlap matrix
! overlap : overlap matrix
!
! LDA : leftmost dimension of overlap array
!
@ -108,10 +108,11 @@ subroutine ortho_canonical_complex(overlap,LDA,N,C,LDC,m)
! m : Coefficients matrix is MxN, ( array is (LDC,N) )
!
END_DOC
integer, intent(in) :: lda, ldc, n
integer, intent(out) :: m
complex*16, intent(in) :: overlap(lda,n)
double precision, intent(in) :: cutoff
complex*16, intent(inout) :: C(ldc,n)
complex*16, allocatable :: U(:,:)
complex*16, allocatable :: Vt(:,:)
@ -119,19 +120,19 @@ subroutine ortho_canonical_complex(overlap,LDA,N,C,LDC,m)
complex*16, allocatable :: S(:,:)
!DIR$ ATTRIBUTES ALIGN : 64 :: U, Vt, D
integer :: info, i, j
if (n < 2) then
return
endif
allocate (U(ldc,n), Vt(lda,n), D(n), S(lda,n))
call svd_complex(overlap,lda,U,ldc,D,Vt,lda,n,n)
D(:) = dsqrt(D(:))
m=n
do i=1,n
if ( D(i) >= 1.d-6 ) then
if ( D(i) >= cutoff ) then
D(i) = 1.d0/D(i)
else
m = i-1
@ -139,39 +140,39 @@ subroutine ortho_canonical_complex(overlap,LDA,N,C,LDC,m)
exit
endif
enddo
do i=m+1,n
do i=m+1,n
D(i) = 0.d0
enddo
enddo
do i=1,m
if ( D(i) >= 1.d5 ) then
print *, 'Warning: Basis set may have linear dependence problems'
endif
enddo
do j=1,n
do i=1,n
S(i,j) = U(i,j)*D(j)
enddo
enddo
do j=1,n
do i=1,n
U(i,j) = C(i,j)
enddo
enddo
call zgemm('N','N',n,n,n,(1.d0,0.d0),U,size(U,1),S,size(S,1),(0.d0,0.d0),C,size(C,1))
deallocate (U, Vt, D, S)
end
deallocate (U, Vt, D, S)
end
subroutine ortho_qr_complex(A,LDA,m,n)
implicit none
BEGIN_DOC
! Orthogonalization using Q.R factorization
!
!
! A : matrix to orthogonalize
!
! LDA : leftmost dimension of A
@ -183,7 +184,7 @@ subroutine ortho_qr_complex(A,LDA,m,n)
END_DOC
integer, intent(in) :: m,n, LDA
complex*16, intent(inout) :: A(LDA,n)
integer :: lwork, info
integer, allocatable :: jpvt(:)
complex*16, allocatable :: tau(:), work(:)
@ -215,7 +216,7 @@ subroutine ortho_qr_unblocked_complex(A,LDA,m,n)
END_DOC
integer, intent(in) :: m,n, LDA
double precision, intent(inout) :: A(LDA,n)
integer :: info
integer, allocatable :: jpvt(:)
double precision, allocatable :: tau(:), work(:)
@ -228,13 +229,13 @@ subroutine ortho_qr_unblocked_complex(A,LDA,m,n)
! call dorg2r(m, n, n, A, LDA, tau, WORK, INFO)
! deallocate(WORK,jpvt,tau)
end
subroutine ortho_lowdin_complex(overlap,LDA,N,C,LDC,m)
subroutine ortho_lowdin_complex(overlap,LDA,N,C,LDC,m,cutoff)
implicit none
BEGIN_DOC
! Compute C_new=C_old.S^-1/2 orthogonalization.
!
! overlap : overlap matrix
! overlap : overlap matrix
!
! LDA : leftmost dimension of overlap array
!
@ -248,7 +249,7 @@ subroutine ortho_lowdin_complex(overlap,LDA,N,C,LDC,m)
! M : Coefficients matrix is MxN, ( array is (LDC,N) )
!
END_DOC
integer, intent(in) :: LDA, ldc, n, m
complex*16, intent(in) :: overlap(lda,n)
complex*16, intent(inout) :: C(ldc,n)
@ -256,8 +257,9 @@ subroutine ortho_lowdin_complex(overlap,LDA,N,C,LDC,m)
complex*16, allocatable :: Vt(:,:)
double precision, allocatable :: D(:)
complex*16, allocatable :: S(:,:)
double precision, intent(in) :: cutoff
integer :: info, i, j, k
if (n < 2) then
return
endif
@ -267,12 +269,13 @@ subroutine ortho_lowdin_complex(overlap,LDA,N,C,LDC,m)
call svd_complex(overlap,lda,U,ldc,D,Vt,lda,n,n)
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP SHARED(S,U,D,Vt,n,C,m) &
!$OMP SHARED(S,U,D,Vt,n,C,m,cutoff) &
!$OMP PRIVATE(i,j,k)
!$OMP DO
do i=1,n
if ( D(i) < 1.d-6 ) then
if ( D(i) < cutoff) then
print *, 'Removed Linear dependencies :', 1.d0/D(i)
D(i) = 0.d0
else
D(i) = 1.d0/dsqrt(D(i))
@ -294,7 +297,7 @@ subroutine ortho_lowdin_complex(overlap,LDA,N,C,LDC,m)
!$OMP END DO NOWAIT
endif
enddo
!$OMP BARRIER
!$OMP DO
do j=1,n
@ -303,11 +306,11 @@ subroutine ortho_lowdin_complex(overlap,LDA,N,C,LDC,m)
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
call zgemm('N','N',m,n,n,(1.d0,0.d0),U,size(U,1),S,size(S,1),(0.d0,0.d0),C,size(C,1))
deallocate(U,Vt,S,D)
end
@ -340,15 +343,16 @@ subroutine get_inverse_complex(A,LDA,m,C,LDC)
end
subroutine get_pseudo_inverse_complex(A,LDA,m,n,C,LDC)
subroutine get_pseudo_inverse_complex(A,LDA,m,n,C,LDC,cutoff)
implicit none
BEGIN_DOC
! Find C = A^-1
END_DOC
integer, intent(in) :: m,n, LDA, LDC
complex*16, intent(in) :: A(LDA,n)
double precision, intent(in) :: cutoff
complex*16, intent(out) :: C(LDC,m)
double precision, allocatable :: D(:), rwork(:)
complex*16, allocatable :: U(:,:), Vt(:,:), work(:), A_tmp(:,:)
integer :: info, lwork
@ -373,15 +377,15 @@ subroutine get_pseudo_inverse_complex(A,LDA,m,n,C,LDC)
print *, info, ':: SVD failed'
stop 1
endif
do i=1,n
if (D(i)/D(1) > 1.d-10) then
if (D(i)/D(1) > cutoff) then
D(i) = 1.d0/D(i)
else
D(i) = 0.d0
endif
enddo
C = (0.d0,0.d0)
do i=1,m
do j=1,n
@ -390,9 +394,9 @@ subroutine get_pseudo_inverse_complex(A,LDA,m,n,C,LDC)
enddo
enddo
enddo
deallocate(U,D,Vt,work,A_tmp,rwork)
end
subroutine lapack_diagd_diag_in_place_complex(eigvalues,eigvectors,nmax,n)
@ -475,7 +479,7 @@ subroutine lapack_diagd_diag_in_place_complex(eigvalues,eigvectors,nmax,n)
end
subroutine lapack_diagd_diag_complex(eigvalues,eigvectors,H,nmax,n)
implicit none
implicit none
BEGIN_DOC
! Diagonalize matrix H(complex)
!
@ -617,7 +621,7 @@ subroutine lapack_diagd_complex(eigvalues,eigvectors,H,nmax,n)
allocate (work(lwork),iwork(liwork),rwork(lrwork))
call ZHEEVD( 'V', 'U', n, A, nmax, eigenvalues, work, lwork, &
rwork, lrwork, iwork, liwork, info )
deallocate(work,iwork,rwork)
deallocate(work,iwork,rwork)
if (info < 0) then
@ -640,7 +644,7 @@ subroutine lapack_diagd_complex(eigvalues,eigvectors,H,nmax,n)
end
subroutine lapack_diag_complex(eigvalues,eigvectors,H,nmax,n)
implicit none
implicit none
BEGIN_DOC
! Diagonalize matrix H (complex)
!
@ -695,10 +699,10 @@ subroutine lapack_diag_complex(eigvalues,eigvectors,H,nmax,n)
do j=1,n
print *, H(i,j)
enddo
enddo
enddo
stop 1
end if
eigvectors = (0.d0,0.d0)
eigvalues = 0.d0
do j = 1, n
@ -708,12 +712,12 @@ subroutine lapack_diag_complex(eigvalues,eigvectors,H,nmax,n)
enddo
enddo
deallocate(A,eigenvalues)
end
end
subroutine matrix_vector_product_complex(u0,u1,matrix,sze,lda)
implicit none
BEGIN_DOC
! performs u1 += u0 * matrix
! performs u1 += u0 * matrix
END_DOC
integer, intent(in) :: sze,lda
complex*16, intent(in) :: u0(sze)
@ -727,7 +731,7 @@ subroutine matrix_vector_product_complex(u0,u1,matrix,sze,lda)
call zhemv('U', sze, (1.d0,0.d0), matrix, lda, u0, incx, (1.d0,0.d0), u1, incy)
end
subroutine ortho_canonical(overlap,LDA,N,C,LDC,m)
subroutine ortho_canonical(overlap,LDA,N,C,LDC,m,cutoff)
implicit none
BEGIN_DOC
! Compute C_new=C_old.U.s^-1/2 canonical orthogonalization.
@ -750,6 +754,7 @@ subroutine ortho_canonical(overlap,LDA,N,C,LDC,m)
integer, intent(in) :: lda, ldc, n
integer, intent(out) :: m
double precision, intent(in) :: overlap(lda,n)
double precision, intent(in) :: cutoff
double precision, intent(inout) :: C(ldc,n)
double precision, allocatable :: U(:,:)
double precision, allocatable :: Vt(:,:)
@ -769,7 +774,7 @@ subroutine ortho_canonical(overlap,LDA,N,C,LDC,m)
D(:) = dsqrt(D(:))
m=n
do i=1,n
if ( D(i) >= 1.d-6 ) then
if ( D(i) >= cutoff ) then
D(i) = 1.d0/D(i)
else
m = i-1
@ -840,7 +845,7 @@ subroutine ortho_qr(A,LDA,m,n)
call dorgqr(m, n, n, A, LDA, TAU, WORK, LWORK, INFO)
! /!\ int(WORK(1)) becomes negative when WORK(1) > 2147483648
LWORK=max(n,int(WORK(1)))
deallocate(WORK)
allocate(WORK(LWORK))
call dorgqr(m, n, n, A, LDA, TAU, WORK, LWORK, INFO)
@ -874,7 +879,7 @@ subroutine ortho_qr_unblocked(A,LDA,m,n)
deallocate(WORK,TAU)
end
subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m)
subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m,cutoff)
implicit none
BEGIN_DOC
! Compute C_new=C_old.S^-1/2 orthogonalization.
@ -896,6 +901,7 @@ subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m)
integer, intent(in) :: LDA, ldc, n, m
double precision, intent(in) :: overlap(lda,n)
double precision, intent(in) :: cutoff
double precision, intent(inout) :: C(ldc,n)
double precision, allocatable :: U(:,:)
double precision, allocatable :: Vt(:,:)
@ -912,12 +918,13 @@ subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m)
call svd(overlap,lda,U,ldc,D,Vt,lda,n,n)
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP SHARED(S,U,D,Vt,n,C,m) &
!$OMP SHARED(S,U,D,Vt,n,C,m,cutoff) &
!$OMP PRIVATE(i,j,k)
!$OMP DO
do i=1,n
if ( D(i) < 1.d-6 ) then
if ( D(i) < cutoff ) then
print *, 'Removed Linear dependencies :', 1.d0/D(i)
D(i) = 0.d0
else
D(i) = 1.d0/dsqrt(D(i))
@ -986,13 +993,14 @@ subroutine get_inverse(A,LDA,m,C,LDC)
deallocate(ipiv,work)
end
subroutine get_pseudo_inverse(A,LDA,m,n,C,LDC)
subroutine get_pseudo_inverse(A,LDA,m,n,C,LDC,cutoff)
implicit none
BEGIN_DOC
! Find C = A^-1
END_DOC
integer, intent(in) :: m,n, LDA, LDC
double precision, intent(in) :: A(LDA,n)
double precision, intent(in) :: cutoff
double precision, intent(out) :: C(LDC,m)
double precision, allocatable :: U(:,:), D(:), Vt(:,:), work(:), A_tmp(:,:)
@ -1020,7 +1028,7 @@ subroutine get_pseudo_inverse(A,LDA,m,n,C,LDC)
endif
do i=1,n
if (D(i)/D(1) > 1.d-10) then
if (D(i)/D(1) > cutoff) then
D(i) = 1.d0/D(i)
else
D(i) = 0.d0
@ -1053,7 +1061,7 @@ subroutine find_rotation(A,LDA,B,m,C,n)
double precision, allocatable :: A_inv(:,:)
allocate(A_inv(LDA,n))
call get_pseudo_inverse(A,LDA,m,n,A_inv,LDA)
call get_pseudo_inverse(A,LDA,m,n,A_inv,LDA,1.d-10)
integer :: i,j,k
call dgemm('N','N',n,n,m,1.d0,A_inv,n,B,LDA,0.d0,C,n)

205
src/utils/need.irp.f
View File

@ -1,205 +0,0 @@
double precision function SABpartial(zA,zB,A,B,nA,nB,gamA,gamB,l)
implicit double precision(a-h,o-z)
dimension nA(3),nB(3)
dimension A(3),B(3)
gamtot=gamA+gamB
SABpartial=1.d0
u=gamA/gamtot*A(l)+gamB/gamtot*B(l)
arg=gamtot*u**2-gamA*A(l)**2-gamB*B(l)**2
alpha=dexp(arg)
&/gamtot**((1.d0+dfloat(nA(l))+dfloat(nB(l)))/2.d0)
wA=dsqrt(gamtot)*(u-A(l))
wB=dsqrt(gamtot)*(u-B(l))
boundA=dsqrt(gamtot)*(zA-u)
boundB=dsqrt(gamtot)*(zB-u)
accu=0.d0
do n=0,nA(l)
do m=0,nB(l)
integ=nA(l)+nB(l)-n-m
accu=accu
& +wA**n*wB**m*binom(nA(l),n)*binom(nB(l),m)
& *(rinteg(integ,boundB)-rinteg(integ,boundA))
enddo
enddo
SABpartial=SABpartial*accu*alpha
end
double precision function rintgauss(n)
implicit double precision(a-h,o-z)
rintgauss=dsqrt(dacos(-1.d0))
if(n.eq.0)return
if(n.eq.1)then
rintgauss=0.d0
return
endif
if(iand(n,1).eq.1)then
rintgauss=0.d0
return
endif
rintgauss=rintgauss/2.d0**(n/2)
rintgauss=rintgauss*ddfact2(n-1)
end
double precision function rinteg(n,u)
implicit double precision(a-h,o-z)
include 'constants.include.F'
ichange=1
factor=1.d0
if(u.lt.0.d0)then
u=-u
factor=(-1.d0)**(n+1)
ichange=-1
endif
if(iand(n,1).eq.0)then
rinteg=0.d0
do l=0,n-2,2
prod=b_coef(l,u)
do k=l+2,n-2,2
prod=prod*a_coef(k)
enddo
rinteg=rinteg+prod
enddo
prod=dsqrt(pi)/2.d0*erf0(u)
do k=0,n-2,2
prod=prod*a_coef(k)
enddo
rinteg=rinteg+prod
endif
if(iand(n,1).eq.1)then
rinteg=0.d0
do l=1,n-2,2
prod=b_coef(l,u)
do k=l+2,n-2,2
prod=prod*a_coef(k)
enddo
rinteg=rinteg+prod
enddo
prod=0.5d0*(1.d0-dexp(-u**2))
do k=1,n-2,2
prod=prod*a_coef(k)
enddo
rinteg=rinteg+prod
endif
rinteg=rinteg*factor
if(ichange.eq.-1)u=-u
end
double precision function erf0(x)
implicit double precision (a-h,o-z)
if(x.lt.0.d0)then
erf0=-gammp(0.5d0,x**2)
else
erf0=gammp(0.5d0,x**2)
endif
end
double precision function gammp(a,x)
implicit double precision (a-h,o-z)
if(x.lt.0..or.a.le.0.)stop 'error in gammp'
if(x.lt.a+1.)then
call gser(gammp,a,x,gln)
else
call gcf(gammcf,a,x,gln)
gammp=1.-gammcf
endif
return
end
subroutine gser(gamser,a,x,gln)
implicit double precision (a-h,o-z)
parameter (itmax=100,eps=3.e-7)
gln=gammln(a)
if(x.le.0.)then
if(x.lt.0.) stop 'error in gser'
gamser=0.
return
endif
ap=a
sum=1./a
del=sum
do 11 n=1,itmax
ap=ap+1.
del=del*x/ap
sum=sum+del
if(abs(del).lt.abs(sum)*eps)go to 1
11 continue
stop 'a too large, itmax too small'
1 gamser=sum*exp(-x+a*log(x)-gln)
return
end
subroutine gcf(gammcf,a,x,gln)
implicit double precision (a-h,o-z)
parameter (itmax=100,eps=3.e-7)
gln=gammln(a)
gold=0.
a0=1.
a1=x
b0=0.
b1=1.
fac=1.
do 11 n=1,itmax
an=float(n)
ana=an-a
a0=(a1+a0*ana)*fac
b0=(b1+b0*ana)*fac
anf=an*fac
a1=x*a0+anf*a1
b1=x*b0+anf*b1
if(a1.ne.0.)then
fac=1./a1
g=b1*fac
if(abs((g-gold)/g).lt.eps)go to 1
gold=g
endif
11 continue
stop 'a too large, itmax too small'
1 gammcf=exp(-x+a*log(x)-gln)*g
return
end
double precision function ddfact2(n)
implicit double precision(a-h,o-z)
if(iand(n,1).eq.0)stop 'error in ddfact2'
ddfact2=1.d0
do i=1,n,2
ddfact2=ddfact2*dfloat(i)
enddo
end
double precision function a_coef(n)
implicit double precision(a-h,o-z)
a_coef=dfloat(n+1)/2.d0
end
double precision function b_coef(n,u)
implicit double precision(a-h,o-z)
b_coef=-0.5d0*u**(n+1)*dexp(-u**2)
end
double precision function gammln(xx)
implicit double precision (a-h,o-z)
real*8 cof(6),stp,half,one,fpf,x,tmp,ser
data cof,stp/76.18009173d0,-86.50532033d0,24.01409822d0,
* -1.231739516d0,.120858003d-2,-.536382d-5,2.50662827465d0/
data half,one,fpf/0.5d0,1.0d0,5.5d0/
x=xx-one
tmp=x+fpf
tmp=(x+half)*log(tmp)-tmp
ser=one
do 11 j=1,6
x=x+one
ser=ser+cof(j)/x
11 continue
gammln=tmp+log(stp*ser)
return
end

5
src/utils/prim_in_r.irp.f
View File

@ -24,8 +24,9 @@ double precision function primitive_value_explicit(power_prim,center_prim,alpha,
end
double precision function give_pol_in_r(r,pol,center, alpha,iorder, max_dim)
double precision :: r(3), center(3), alpha,pol(0:max_dim,3)
implicit none
integer, intent(in) :: iorder(3), max_dim
double precision :: r(3), center(3), alpha,pol(0:max_dim,3)
integer :: i,m
double precision :: gauss(3), x
gauss = 0.d0
@ -33,7 +34,7 @@ double precision function give_pol_in_r(r,pol,center, alpha,iorder, max_dim)
do m = 1, 3
x = r(m) - center(m)
do i = 0, iorder(m)
gauss(m) += pol(i,m) * dexp(-alpha *x**2 ) * x**i
gauss(m) += pol(i,m) * dexp(-alpha *x*x ) * x**i
enddo
enddo
give_pol_in_r = gauss(1) * gauss(2) * gauss(3)

54
src/utils/shank.irp.f Normal file
View File

@ -0,0 +1,54 @@
double precision function shank_general(array,n,nmax)
implicit none
integer, intent(in) :: n,nmax
double precision, intent(in) :: array(0:nmax) ! array of the partial sums
integer :: ntmp,i
double precision :: sum(0:nmax),shank1(0:nmax)
if(n.lt.3)then
print*,'You asked to Shank a sum but the order is smaller than 3 ...'
print*,'n = ',n
print*,'stopping ....'
stop
endif
ntmp = n
sum = array
i = 0
do while(ntmp.ge.2)
i += 1
! print*,'i = ',i
call shank(sum,ntmp,nmax,shank1)
ntmp = ntmp - 2
sum = shank1
shank_general = shank1(ntmp)
enddo
end
subroutine shank(array,n,nmax,shank1)
implicit none
integer, intent(in) :: n,nmax
double precision, intent(in) :: array(0:nmax)
double precision, intent(out) :: shank1(0:nmax)
integer :: i,j
double precision :: shank_function
do i = 1, n-1
shank1(i-1) = shank_function(array,i,nmax)
enddo
end
double precision function shank_function(array,i,n)
implicit none
integer, intent(in) :: i,n
double precision, intent(in) :: array(0:n)
double precision :: b_n, b_n1
b_n = array(i) - array(i-1)
b_n1 = array(i+1) - array(i)
if(dabs(b_n1-b_n).lt.1.d-12)then
shank_function = array(i+1)
else
shank_function = array(i+1) - b_n1*b_n1/(b_n1-b_n)
endif
end

2
src/zmq/utils.irp.f
View File

@ -585,7 +585,7 @@ subroutine end_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
stop 'Wrong end of job'
endif
do i=1200,1,-1
do i=360,1,-1
rc = f77_zmq_send(zmq_to_qp_run_socket, 'end_job '//trim(zmq_state),8+len(trim(zmq_state)),0)
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 512, 0)
if (trim(message(1:13)) == 'error waiting') then