10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-07-22 18:57:31 +02:00

merge with LCPQ

This commit is contained in:
Yann Garniron 2016-07-06 16:15:47 +02:00
parent 1bc8bb0a06
commit ee257c3d6f
90 changed files with 6161 additions and 1217 deletions

View File

@ -1,11 +1,7 @@
Quantum package ![QP](https://raw.githubusercontent.com/LCPQ/quantum_package/master/data/qp.png)
===============
[![Build Status](https://travis-ci.org/LCPQ/quantum_package.svg?branch=master)](https://travis-ci.org/LCPQ/quantum_package) [![Build Status](https://travis-ci.org/LCPQ/quantum_package.svg?branch=master)](https://travis-ci.org/LCPQ/quantum_package)
[![Gitter](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/LCPQ/quantum_package?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Gitter](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/LCPQ/quantum_package?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)
Set of quantum chemistry programs and libraries. Set of quantum chemistry programs and libraries.
(under GNU GENERAL PUBLIC LICENSE v2) (under GNU GENERAL PUBLIC LICENSE v2)

View File

@ -51,7 +51,7 @@ FCFLAGS : -xSSE4.2 -O2 -ip -ftz
# #
[DEBUG] [DEBUG]
FC : -g -traceback FC : -g -traceback
FCFLAGS : -xAVX -C -fpe0 FCFLAGS : -xAVX -C -fpe0
IRPF90_FLAGS : --openmp IRPF90_FLAGS : --openmp
# OpenMP flags # OpenMP flags

4
configure vendored
View File

@ -142,7 +142,7 @@ ezfio = Info(
default_path=join(QP_ROOT_INSTALL, "EZFIO")) default_path=join(QP_ROOT_INSTALL, "EZFIO"))
zeromq = Info( zeromq = Info(
url='http://download.zeromq.org/zeromq-4.0.7.tar.gz', url='https://github.com/zeromq/zeromq4-1/releases/download/v4.1.4/zeromq-4.1.4.tar.gz',
description=' ZeroMQ', description=' ZeroMQ',
default_path=join(QP_ROOT_LIB, "libzmq.a")) default_path=join(QP_ROOT_LIB, "libzmq.a"))
@ -166,7 +166,7 @@ d_info = dict()
for m in ["ocaml", "m4", "curl", "zlib", "patch", "irpf90", "docopt", for m in ["ocaml", "m4", "curl", "zlib", "patch", "irpf90", "docopt",
"resultsFile", "ninja", "emsl", "ezfio", "p_graphviz", "resultsFile", "ninja", "emsl", "ezfio", "p_graphviz",
"zeromq", "f77zmq","bats" ]: "zeromq", "f77zmq","bats"]:
exec ("d_info['{0}']={0}".format(m)) exec ("d_info['{0}']={0}".format(m))

785
data/pseudo/tn_df Normal file
View File

@ -0,0 +1,785 @@
H GEN 0 2
6
1.00000000 1 34.44662515
-0.89096601 2 40.13885591
-4.35250792 2 24.66307521
-11.58011743 2 20.49225491
12.58011743 2 30.23909011
34.44662515 3 22.28419700
6
-262.22422461 2 17.87367530
258.22981252 2 28.75598991
5613.63467960 2 19.10096571
-4192.30569417 2 18.88256059
-1341.04802395 2 20.95302325
-79.28421640 2 34.10653707
6
-199.48848662 2 37.85954681
197.31066276 2 28.79454664
4870247.22276531 2 40.22839783
-5277181.77014563 2 40.34690459
-196566.81095176 2 39.13989706
603502.35555458 2 40.91315002
He GEN 0 2
6
2.00000000 1 22.64777484
-0.00700692 2 23.54196640
-8.90169316 2 18.71556903
113.56926776 2 15.15150658
-112.56926776 2 13.80465850
45.29554968 3 12.54192267
6
747.63794984 2 13.33611411
-753.70091072 2 23.45392111
-397.08293819 2 12.23651194
10.35341837 2 14.87987639
-1430.53848568 2 18.32138342
1818.26602949 2 21.24054054
6
305.67933642 2 21.32319132
-307.98355807 2 12.22370696
5957.66379729 2 14.11720170
-6099.62872267 2 14.41269814
523.59639310 2 17.66028106
-380.63505659 2 21.52626637
Li GEN 2 2
6
1.00000000 1 0.78732101
-2.23999912 2 0.79224763
0.10376190 2 1.79622268
4.27489122 2 1.83637465
-3.27489122 2 1.91213904
0.78732101 3 0.79291624
6
256.80790655 2 1.78312879
-255.81956741 2 0.95553059
90.30361668 2 0.87617279
272.13155048 2 1.09621549
-180.73373018 2 1.43900642
-180.70146573 2 1.83085147
6
-4.80714862 2 1.53942961
3.36281864 2 0.84742021
-305.38012622 2 0.78976831
-509.40184487 2 0.98031681
436.16121675 2 0.81548364
379.61797456 2 1.02582853
Be GEN 2 2
6
2.00000000 1 1.20639978
-5.40313229 2 1.18425537
1.72394027 2 2.81826911
2.83884922 2 2.37513515
-1.83884922 2 2.82920954
2.41279956 3 1.18219335
6
-1045.63679908 2 2.59240356
1047.85482764 2 1.41685787
-1899.15859219 2 1.48536566
1398.06780686 2 1.70076501
-696.13481389 2 2.03898674
1198.22571139 2 2.57766211
6
630.90931326 2 1.84421403
-632.78437074 2 1.13419132
441.35012255 2 1.13393716
435.97021325 2 1.22419150
-353.63284449 2 1.39760436
-522.69065435 2 1.88595068
B GEN 2 2
6
3.00000000 1 2.72292969
-11.78419674 2 2.41356794
5.22993640 2 4.60628004
0.42834165 2 3.81569642
0.57165835 2 4.75281449
8.16878907 3 2.42655010
6
-260.26050710 2 2.55536939
265.37594882 2 4.54575013
76.89512909 2 2.14992133
-57.25691791 2 2.71845869
4293.37943873 2 3.54567059
-4312.01708538 2 3.65811356
6
236.98381086 2 3.86703012
-239.59777090 2 2.15409783
4347.09682018 2 2.51320631
-4637.07702775 2 2.58243237
786.10765740 2 3.15459528
-495.13181880 2 3.69673537
C GEN 2 2
6
4.00000000 1 6.85914037
-69.31783111 2 7.66877502
58.73619595 2 8.89164866
-5.11066199 2 4.63398124
6.11066199 2 5.40104250
27.43656147 3 6.79273179
6
430.61454744 2 8.62389774
-421.35054055 2 5.03244470
-33212.40034531 2 6.89861917
44.12655159 2 3.96628687
96.39927700 2 5.01313881
33072.87650778 2 6.85964729
6
-104389.58452246 2 4.75057662
104386.03365951 2 8.95366858
690570.92310077 2 7.84605551
105067.78650436 2 4.75435948
-142604.06718444 2 8.80450514
-653033.64724842 2 7.81116996
N GEN 2 2
6
5.00000000 1 11.01983025
-747.65378590 2 7.70260962
731.28815439 2 7.83791198
-3.54162255 2 8.41784728
4.54162255 2 12.53426384
55.09915125 3 6.76845507
6
189.29450948 2 10.95064006
-174.81483163 2 7.48980682
148422.74289741 2 6.18035270
-167161.90534269 2 6.21695388
34280.43140051 2 6.81408633
-15540.26812247 2 7.23413705
6
-5338.70218681 2 6.15987128
5334.35386770 2 7.49726635
-1839.21100223 2 8.80963870
16010.85000728 2 6.52067091
-16722.95522386 2 6.97790252
2552.31199840 2 8.37871646
O GEN 2 2
6
6.00000000 1 8.86932353
-28.04199287 2 6.05326172
11.15704031 2 5.51480979
180.82432510 2 10.77878397
-179.82432510 2 10.23693413
53.21594115 3 7.90462675
6
-9212.20980516 2 7.28893859
9226.86567950 2 6.05971190
58203.26727502 2 10.83143357
-5120.48607364 2 5.75281092
-93321.50266843 2 10.51155711
40239.72318888 2 9.72227746
6
10001.55649464 2 7.43321349
-10012.86801601 2 5.85047476
8554.95973537 2 5.79011164
-20342.33136146 2 8.08750969
11739.44079236 2 8.43229920
48.92837040 2 4.71055456
F GEN 2 2
6
7.00000000 1 16.52048840
-10.46754024 2 13.26693551
-11.21567917 2 18.77563836
-32.41582195 2 10.96778594
33.41582195 2 21.09729680
115.64341877 3 13.46927525
6
1201.43391413 2 19.92490215
-1182.60889584 2 11.77163137
-8770.99026936 2 12.30043337
5336.21358848 2 11.63810105
8729.77565724 2 14.12189391
-5293.99672165 2 16.53091209
6
92.58757506 2 8.66992000
-108.46085404 2 9.40009036
-319.30686222 2 9.08633595
524.57586653 2 9.90194004
-443.63347077 2 13.57164540
239.36118945 2 16.47995554
Ne GEN 2 2
6
8.00000000 1 21.64664513
1794.02959527 2 14.45731213
-1828.03241002 2 14.11697591
23.90491418 2 14.10774236
-22.90491418 2 20.42359560
173.17316107 3 11.93940404
6
-5911.13460210 2 12.24993716
5941.26076308 2 20.24332306
2840.09993994 2 12.20646543
1742.40556167 2 11.50431394
8834.09207695 2 16.82066882
-13415.59681607 2 18.72208419
6
53626.32637171 2 20.56468824
-53639.90888359 2 19.92390926
-576.65341012 2 13.02834964
1907.80575476 2 15.43385134
5623.71426075 2 18.06950435
-6953.86800222 2 22.66963993
K GEN 18 2
6
1.00000000 1 0.50008727
1416.76952428 2 0.63134777
-1419.89095139 2 0.60241926
-302.74307268 2 0.68724573
303.74307268 2 0.55624069
0.50008727 3 0.50008691
6
-854959.33457742 2 0.55297829
854960.96236303 2 0.59508099
-2735051.37932036 2 0.55136787
-797902.82136562 2 0.59254779
-90621.33409241 2 0.60683509
3623576.53510235 2 0.55188848
6
5366450.44923246 2 0.56834617
-5366449.39460951 2 0.57395202
506392.75510780 2 0.65188562
1065012.45735119 2 0.60395254
-764583.36396565 2 0.55451976
-806820.84832728 2 0.64359720
Ca GEN 18 2
6
2.00000000 1 0.74758765
308735.40641498 2 0.72269274
-308740.90975833 2 0.72197603
7202.81432103 2 0.70435779
-7201.81432103 2 0.73462875
1.49517531 3 0.98521314
6
3358.40551562 2 0.85820603
-3354.33378202 2 0.50055931
645.82930380 2 0.77593512
-4032.30085432 2 0.85197466
3315.68514964 2 0.50005881
71.78714429 2 1.01826143
6
3797.10880911 2 0.54666026
-3794.15970380 2 0.55760964
1988.78457523 2 0.66771019
13912.48066729 2 0.71662858
-408.96685813 2 0.50701325
-15491.29677996 2 0.71335086
Sc GEN 18 2
6
3.00000000 1 6.99258598
-124.50237230 2 4.24128187
97.21802227 2 1.68870852
-87.09390293 2 1.51321231
88.09390293 2 5.62659050
20.97775795 3 2.67617421
6
375.73920548 2 5.45654024
-350.54708476 2 5.82486421
-11.58800164 2 0.51173797
12.31935173 2 0.56805032
20.80334597 2 0.78399590
-20.53480959 2 1.25273408
6
6092.78689761 2 1.30970450
-6068.65474455 2 6.97688197
6074.16548241 2 6.96312742
-2.71306889 2 0.50000000
562.44223581 2 1.09627007
-6632.89448781 2 1.28901234
Ti GEN 18 2
6
4.00000000 1 4.58962911
29.78882355 2 12.99080675
-64.03604684 2 6.47044482
4.09908827 2 7.32890448
-3.09908827 2 0.86508310
18.35851644 3 11.66884823
6
204.54741131 2 6.98984163
-173.26765359 2 1.14387234
-179.62280834 2 7.98041969
81.98571631 2 1.30274954
-105.23530836 2 0.79373704
203.87378660 2 0.87617820
6
47.21398743 2 4.46327869
-17.03315162 2 12.03758238
-1.80345968 2 1.82986618
-67.65022794 2 0.85432599
83.23157126 2 0.75234069
-12.77614240 2 0.56466795
V GEN 18 2
6
5.00000000 1 4.80344323
22.35774108 2 18.78787979
-64.07198704 2 7.13216682
4.33388926 2 9.27213879
-3.33388926 2 0.97989891
24.01721615 3 16.08839186
6
180.61077610 2 8.25076842
-142.94184574 2 0.97905818
-150.64642751 2 9.92043295
-6.71407277 2 0.62363714
176.09329684 2 0.95148528
-17.73131270 2 1.07801133
6
57.45110361 2 5.32960287
-20.81111514 2 14.24980571
-8.29286428 2 1.85925508
-5.73287020 2 0.58593750
29.10022105 2 0.79878530
-14.07269455 2 1.00225258
Cr GEN 18 2
6
6.00000000 1 12.84308988
-3.09604991 2 0.99382054
-44.89504234 2 7.58819115
-170.55613293 2 14.51774012
171.55613293 2 16.43682827
77.05853926 3 12.82491986
6
-18202.34922306 2 1.98782159
18244.42867028 2 31.32646602
30868.09979612 2 30.37846452
17868.98085600 2 1.97809129
-49114.96837018 2 30.73273877
378.88775116 2 2.67913288
6
29.20236180 2 19.25203633
12.37319603 2 0.97567458
4072.48148684 2 17.43196546
-17623.52674725 2 16.30880219
0.00000000 2 1.00000000
13552.04578438 2 15.92770430
Mn GEN 18 2
6
7.00000000 1 15.05016398
76.06668034 2 15.84783194
-134.18719488 2 9.80426007
5.15310013 2 22.40715541
-4.15310013 2 1.28870598
105.35114786 3 9.24698903
6
5.29793560 2 36.81344701
46.23395617 2 10.22325416
-60.32817992 2 19.40077237
47.36691946 2 10.31192728
-593.48022661 2 0.82035751
607.44155846 2 0.82499832
6
43.56050065 2 39.11191097
6.67450664 2 5.89010993
273.74198710 2 12.39309544
-27.45450618 2 46.10455298
-256.40166892 2 15.13448958
11.11513392 2 0.96513012
Fe GEN 18 2
6
8.00000000 1 15.22430826
44.74166498 2 23.61492800
-111.48295214 2 10.92989564
4.87905385 2 34.25190536
-3.87905385 2 1.33822720
121.79446608 3 12.33553803
6
-19.50464924 2 30.77395752
78.13974335 2 10.21396062
-93.51149367 2 7.16717891
-5331.00729306 2 2.86167947
2973.12062964 2 2.65030718
2452.39961633 2 3.20024669
6
24692.89537881 2 35.68878072
-24635.37117467 2 1.90446408
67.20321584 2 9.50100295
-24719.85685234 2 35.67756831
155.45498669 2 2.48480944
24498.19947049 2 1.90126047
Co GEN 18 2
6
9.00000000 1 16.99448342
49.13807967 2 27.18614115
-125.28324533 2 12.21218102
5.11388765 2 39.14513799
-4.11388765 2 1.47717612
152.95035078 3 13.67966454
6
-14.42629264 2 42.14707531
80.80701231 2 9.38147677
-241.37463154 2 5.80599555
-2375.49390008 2 3.20236619
1470.87516654 2 3.85735739
1146.99509265 2 2.77670509
6
136.98013925 2 35.88691706
-71.59603354 2 2.32679268
69.29537053 2 14.47120857
-182.97334302 2 33.48566094
53.73921710 2 5.03596368
60.93980797 2 1.71252673
Ni GEN 18 2
6
10.00000000 1 22.08639324
-144.93688782 2 14.51813938
58.56151708 2 31.72005545
5.46467869 2 46.47610840
-4.46467869 2 1.64348434
220.86393239 3 17.23929992
6
-1037.96291767 2 23.63013626
1112.68285967 2 22.54579447
-202.88667032 2 10.67846148
-1992.46747856 2 2.78611652
261.70081349 2 7.26891690
1934.65478930 2 2.71695433
6
-53.30731307 2 26.78098186
127.09013633 2 3.54449677
-4806.85555998 2 9.97427088
4887.04372410 2 10.06368893
-212.17359382 2 2.46160888
132.98697057 2 1.97486742
Cu GEN 18 2
6
11.00000000 1 2.82733696
-34.48196386 2 1.92614044
-60.25585479 2 16.36117816
95.74606505 2 26.07073787
-94.74606505 2 15.23964803
31.10070652 3 2.17204001
6
-45.62927216 2 31.69953680
125.91417027 2 1.14930323
-14.54702824 2 1.62190112
4.20903863 2 5.04037704
108.15433753 2 13.02666762
-96.81611101 2 1.08245080
6
95.22440516 2 11.30741812
-15.05535618 2 0.88219501
50.51809351 2 1.10244974
-44.11033096 2 1.38963093
24.77977412 2 1.74927941
-30.18619193 2 36.48037929
Zn GEN 18 2
6
12.00000000 1 31.07239014
-200.01988966 2 17.28158695
92.10229536 2 34.39655496
5.98135501 2 49.89939973
-4.98135501 2 1.96865590
372.86868168 3 19.34259724
6
-36.14038802 2 38.52109994
128.37782465 2 12.00212013
-1.61496737 2 1.07625274
-1.83786181 2 49.67118376
65.46563590 2 2.17772473
-61.01291439 2 3.24812913
6
-65.64354860 2 18.09701361
156.02859885 2 36.00255883
172.20201747 2 14.96596000
-192.17040837 2 36.71242576
4.39165632 2 5.39429237
16.57829500 2 1.49031308
Ga GEN 28 2
6
3.00000000 1 1.13608798
164.07678897 2 1.26217688
-167.28328999 2 1.14858151
-669.79177234 2 1.15353581
670.79177234 2 1.12952095
3.40826394 3 1.10744970
6
2326.37321481 2 0.75031475
-2323.38047364 2 0.75000124
386.83516033 2 2.39556890
3373.92258044 2 1.92296729
-3444.97340674 2 2.01243025
-314.78429931 2 1.54022372
6
-49.00749762 2 0.97248539
49.23559677 2 1.12030491
13.15736344 2 1.17799318
125.85888665 2 1.43966818
-194.32447492 2 1.61975153
56.31063114 2 1.96345236
Ge GEN 28 2
6
4.00000000 1 1.37803409
19.62241898 2 1.39153725
-23.72148814 2 1.27769848
2.49161805 2 1.59279926
-1.49161805 2 0.64699203
5.51213636 3 0.92923210
6
-2.74466220 2 0.87224298
6.62035166 2 1.17293014
-2420.40847648 2 1.99495027
-82306.43955717 2 2.42954180
6740.23721390 2 2.16484262
77987.61073589 2 2.43883104
6
-2107.38453991 2 1.16911036
2108.21076604 2 1.46731756
1481.43044167 2 1.13494844
-5605.67944848 2 1.57427397
1698.46708565 2 1.69705377
2426.78290985 2 1.49642085
As GEN 28 2
6
5.00000000 1 1.43022249
-9.34297986 2 1.49610460
4.21498088 2 6.47107540
10.09813510 2 3.25241162
-9.09813510 2 5.07144325
7.15111245 3 1.33657021
6
13218.94379269 2 1.93743539
-13214.39886844 2 1.06114866
-12968.43207956 2 1.94924972
13915.97822491 2 1.06566409
-954.00698285 2 1.23265097
7.46088753 2 4.89271387
6
1464.46500602 2 1.99905491
-1463.07044815 2 1.47578217
368.93680276 2 1.30626554
-20015.22902646 2 1.76510607
-4931.41969774 2 1.62454622
24578.71284776 2 1.71245824
Se GEN 28 2
6
6.00000000 1 1.51096144
18985.66456772 2 2.92355341
-18994.15945825 2 2.92032845
-67662.27071451 2 3.11248219
67663.27071451 2 3.11189793
9.06576863 3 1.65761092
6
9.98441274 2 1.51889669
-2.50844675 2 1.97738476
-180236.05319146 2 2.70806322
388717.66809223 2 2.76186155
-395809.31847294 2 2.85646715
187328.70401255 2 2.90992434
6
-0.64003892 2 1.60286011
4.75615253 2 1.39335643
-1221.08696720 2 2.09669307
-10412.15615824 2 2.41527013
11345.50935270 2 2.36453165
288.73492615 2 3.03391531
Br GEN 28 2
6
7.00000000 1 1.41289916
-7.52651514 2 1.15658370
-0.55005317 2 2.42725255
32.50767838 2 2.88316202
-31.50767838 2 2.65601102
9.89029412 3 1.40346702
6
28526.73706896 2 2.34791729
-28520.73498833 2 2.45113975
-99003.29767895 2 2.50553756
749850.19071550 2 2.81179865
-1128475.81390516 2 2.78141408
477629.92118992 2 2.68265676
6
17.76908748 2 1.31119911
-15.01578842 2 1.60289186
-18723.09651802 2 2.55330648
-655.15159005 2 2.02749820
16349.83148583 2 2.49321553
3029.41777740 2 2.76331597
Kr GEN 28 2
6
8.00000000 1 8.52108317
-122698.81335772 2 3.24264497
122687.31930993 2 3.40822193
-118092.31104849 2 3.40804203
118093.31104849 2 3.23631062
68.16866536 3 4.68396906
6
-494.70169718 2 5.76331362
503.25343741 2 2.73098609
-367021.57369848 2 3.66759371
-1529686.47073208 2 3.83008505
1834642.13235417 2 3.78655002
62066.91317383 2 4.17980892
6
-73.83484449 2 5.20603747
79.00632901 2 4.70236432
1062.70264892 2 4.15470411
-40873.21549348 2 3.08586486
43280.45283221 2 3.10363880
-3468.93856436 2 3.63224008
Al GEN 10 2
6
3.00000000 1 0.91821413
-12.79791788 2 1.10715442
7.32796626 2 2.03989390
-52053.92058080 2 2.04204466
52054.92058080 2 2.04199047
2.75464240 3 0.94029840
6
-42.72903905 2 1.99445589
47.15203530 2 1.12469986
3231.39534748 2 1.72843552
-398.06113457 2 1.37872018
6652.21368423 2 1.92811339
-9484.54780105 2 1.87995009
6
830.07508675 2 1.87943518
-827.97758021 2 1.42508183
-1235.04705829 2 1.80941062
-21.40768628 2 0.95469299
154.21154335 2 1.20079877
1103.24388863 2 1.53169350
Si GEN 10 2
6
4.00000000 1 1.22418085
40.72596063 2 2.05337336
-48.11509746 2 1.71412850
-37.28006653 2 2.41395005
38.28006653 2 2.32084434
4.89672339 3 1.35299631
6
-7.68509694 2 1.13070385
13.98411213 2 1.16859753
-116498.38332824 2 2.36994226
-9121.48068622 2 2.16734100
31941.11999828 2 2.44879942
93679.74429067 2 2.32322104
6
41248.64599856 2 1.86811003
-41245.51022334 2 2.10179754
-60.37864776 2 1.33467919
4180.55486914 2 2.29835912
-142125.41164262 2 1.93345601
138006.23630568 2 1.99192523
P GEN 10 2
6
5.00000000 1 3.71332384
-13724.87406260 2 3.31759335
13714.20593187 2 3.65850189
-19470.81568886 2 3.61426447
19471.81568886 2 3.37579099
18.56661922 3 2.21831587
6
-1411.99322697 2 3.20289077
1421.31824558 2 2.14807352
576236.74902855 2 2.65372234
-397754.23263905 2 2.69778221
-194403.08693812 2 2.58386669
15921.57087605 2 2.99361065
6
64.03084909 2 2.59482433
-58.63734715 2 3.43313766
365.80442210 2 2.95557705
-12.13895471 2 1.75387879
158.27628825 2 3.69699906
-510.94109430 2 3.15077203
S GEN 10 2
6
6.00000000 1 2.51977085
-84.83332404 2 3.22007986
70.54487302 2 4.71655238
3581.56671658 2 4.39998291
-3580.56671658 2 4.41784559
15.11862509 3 2.54586294
6
-231.72652822 2 4.61819246
244.26248418 2 2.30938314
-920.53494189 2 2.65072450
2410.83323256 2 3.31119070
-2429.46016726 2 3.80226712
940.16251250 2 4.46824294
6
957.88712772 2 4.48874898
-950.12559451 2 3.37845034
6481.05990210 2 3.83307173
-157.23448173 2 1.92699416
186.18956071 2 1.98946862
-6509.01396292 2 3.99439281
Cl GEN 10 2
6
7.00000000 1 6.06473582
-454.17116717 2 5.57110302
436.13184861 2 5.26917938
-712.97599461 2 4.62455647
713.97599461 2 4.94326867
42.45315074 3 3.47635853
6
3561.38023524 2 4.48278574
-3545.84042135 2 3.43372818
-348465.51723117 2 3.74855830
12627.08188052 2 3.20650110
404246.19776785 2 3.70673786
-68406.76197098 2 3.45681590
6
19.30024745 2 3.79400952
-9.26766424 2 3.06020678
508.81151546 2 4.47438492
-7.59455659 2 2.43219723
-757.15587217 2 4.97983429
256.93953188 2 5.71145786
Ar GEN 10 2
6
8.00000000 1 3.61306766
326.13269394 2 4.01911273
-346.66642426 2 5.31624938
-7083.13498801 2 4.62848435
7084.13498801 2 4.70295676
28.90454131 3 3.84612203
6
323.59441180 2 3.28236424
-306.35028843 2 3.72212609
-6283.46399338 2 4.23452843
435312.63926384 2 4.90386840
20087.00527001 2 5.30220051
-449115.17955704 2 4.93088566
6
-2470.88386165 2 5.66191962
2481.68427537 2 4.62960722
48097.69821672 2 2.45115265
-48060.46858390 2 2.45082141
-1386.79918148 2 4.23753203
1350.57102634 2 6.12344921

292
data/pseudo/tn_df_sc Normal file
View File

@ -0,0 +1,292 @@
Sc GEN 12 2
8
9.00000000 1 18.44478556
-28.08765281 2 1.72227091
6.39250114 2 38.78217945
135.57316128 3 4.25767220
30.42990876 3 30.59237471
732.69856731 4 3.04901650
-839.18407578 4 3.26586693
306.02608763 4 19.55311974
8
-0.66275990 2 28.84167604
15.34001225 2 2.35022973
-2135.70086146 3 2.36887926
-272.32226474 3 1.53860208
2408.02312621 3 2.24659807
101.49528202 4 3.20659052
2308.19070504 4 1.65816906
-2392.74854053 4 1.70062176
8
253.56902450 2 1.38158346
-244.79525414 2 7.79906720
613.28437434 3 3.46268859
-167.40250936 3 1.44953060
-445.88186498 3 4.19986338
-558.92885001 4 2.84253773
-139.52186395 4 8.10103826
-860.39715397 4 5.29686620
Ti GEN 12 2
8
10.00000000 1 22.29649672
-72305.15340277 2 6.07562013
72279.39956641 2 7.08549167
-5.38004642 3 1.85317121
228.34501358 3 11.48488557
72347.84359974 4 6.58565089
-36.31015055 4 10.79509368
524.90430538 4 4.36759114
8
-1486.27686725 2 1.90199524
1504.05739312 2 3.17280244
-346.63236251 3 7.28185273
297.60206194 3 1.60782556
49.03030057 3 31.70876802
1363.17044217 4 2.57136209
173.13661454 4 15.10326471
408.87838151 4 10.51280239
8
770.58828172 2 4.79017059
-760.06500844 2 16.39428027
4131.47101858 3 2.73641831
-2.86068712 3 1.26533109
-4128.61033146 3 2.75566672
-4681.55429918 4 13.54811035
-216.64417046 4 3.18165696
-3871.27097394 4 7.38011991
V GEN 12 2
8
11.00000000 1 7.61152016
-2254.24090893 2 3.39807975
2224.02899636 2 6.97361870
-110446453.80565737 3 4.55862146
110446537.53237911 3 4.55862102
3279.23908558 4 3.96488312
110445429.80748074 4 5.79893896
-110440859.60674113 4 5.79892709
8
793493.20383269 2 1.90936932
-793472.27490442 2 1.96341714
-208.86387558 3 5.49944355
258.48298732 3 4.42141770
-49.61911175 3 2.27427679
-42873.55595686 4 1.93670396
-750668.26686351 4 13.81929388
750696.33209725 4 13.81951796
8
563.75098077 2 2.73920868
-551.25384718 2 8.34159772
565.60881231 3 6.86565518
-552.54712531 3 7.02672916
-13.06168700 3 1.72160118
766.15325384 4 5.21722741
-1341.96583800 4 3.64504781
-2478.29367021 4 6.45896159
Cr GEN 12 2
8
12.00000000 1 37.30558989
-31.65683900 2 2.72495980
-3.82112970 2 82.35078893
-1340.05228092 3 5.03605834
1787.71935961 3 8.49223479
1670.38275859 4 5.05934149
-297.67363866 4 11.22316422
-1773.64577915 4 12.78798168
8
1321.32584937 2 2.01494487
-1297.16280545 2 9.11769637
172456.79432585 3 2.74640213
-172130.54143941 3 2.73601029
-326.25288644 3 8.22966405
3318.19479259 4 8.93660753
-4964.77333719 4 4.18996691
-7518.15931266 4 8.08712175
8
426.08303476 2 2.13852920
-410.95463497 2 6.95873057
-26339.61341213 3 10.51865586
27348.01671881 3 10.59655900
-1008.40330668 3 12.57249470
-1190.97633771 4 3.81958382
-242.50982893 4 2.30397730
-515.04540222 4 8.50147041
Mn GEN 12 2
8
13.00000000 1 5.18371402
-578541.89058487 2 5.06065032
578503.38848415 2 6.70792867
-51913.84692424 3 6.17952209
51981.23520653 3 6.17539491
363344.02202434 4 6.42176078
267112.71548476 4 5.85884127
322304.52239107 4 5.30004030
8
1419.16815158 2 2.36735511
-1393.80593768 2 10.44777616
90835.30824196 3 3.38832573
-87236.54130341 3 3.33976449
-3598.76693855 3 4.59371397
-6244.54083570 4 4.53305698
1227.60592152 4 6.80451212
-6185.56255228 4 8.40561309
8
4024.75281098 2 2.94114594
-4009.68099577 2 7.86104996
6036.24229971 3 5.47734943
597.55987937 3 7.26632213
-6633.80217908 3 5.64966653
-8536.73955532 4 4.35053539
-2120.81538582 4 3.10976563
-9025.36229250 4 6.88076377
Fe GEN 12 2
8
14.00000000 1 5.12237041
-40.17016318 2 2.51511645
-1.31093574 2 68.88205922
233.53970769 3 8.04518971
-161.82652195 3 11.87602774
-1791.82033120 4 5.09693593
1599.45078669 4 4.72210640
1.03695301 4 1.70594204
8
26.70612465 2 1.98046097
0.57578912 2 129.99498266
3039.39666376 3 2.39996246
-3165.32503397 3 2.43500497
125.92837021 3 5.42607639
-291.65810402 4 8.00515516
391.88052787 4 5.38996549
27.51771082 4 21.57361672
8
624.99065580 2 2.73200743
-610.14663705 2 8.14205971
1017.89543597 3 6.81776145
-40.92293045 3 25.88593190
-976.97250552 3 5.88766735
-1433.26030940 4 3.94271278
-167.70300401 4 2.68547503
-1659.40792313 4 8.24853344
Co GEN 12 2
8
15.00000000 1 7.54679164
144513.79744165 2 3.67362404
-144558.25171900 2 4.84501436
107.53071842 3 2.40342575
5.67115611 3 26.17864786
-58433.23776581 4 3.80837544
-86187.09039425 4 4.51680318
-24877.11683436 4 4.40937071
8
95.23258759 2 2.24610518
-66.50913381 2 5.03497074
5039.10184384 3 3.22714612
106438.82887427 3 4.39051698
-111477.93071810 3 4.34028955
-3416.23892647 4 3.35420522
-108155.92422115 4 5.08283495
111451.19401338 4 5.04411598
8
595.60664332 2 4.48956443
-581.05689813 2 7.69628175
-1377.49199281 3 3.90883087
825.53641688 3 4.85597858
551.95557593 3 2.42496884
-403.44284159 4 2.48937518
360.79216631 4 7.08237042
-1755.31252545 4 7.01264199
Ni GEN 12 2
8
16.00000000 1 7.69817381
1050.11428773 2 7.53303210
-1144.28791364 2 25.60798551
13641.04856576 3 13.90272560
-13517.87778478 3 14.02243059
-99.93959073 4 5.40919366
-14590.22326277 4 19.39187326
-6702.20081903 4 10.04177364
8
-137324.04248861 2 3.00959957
137399.59146577 2 2.97820277
137895.50489379 3 3.20429852
-1036.38091066 3 8.22563766
-136859.12398313 3 3.17346613
1370.72380067 4 18.22958633
-904.80564965 4 6.63637638
-4552.45338879 4 4.01705177
8
-315.28909178 2 15.14825706
371.76324185 2 5.57172908
471.27416207 3 2.88437623
165.43855728 3 3.75784965
-636.71271936 3 3.41699124
-172.18113847 4 5.67830819
-148.24251004 4 2.70288433
-2384.29249546 4 8.91177457
Cu GEN 12 2
8
17.00000000 1 14.72121260
0.43564135 2 173.23217215
-51.26559465 2 2.58024469
3.82433122 3 80.09883693
246.43628291 3 9.08368916
6456.72306266 4 4.49885474
-6459.98303523 4 4.56436500
-53.55070822 4 20.14135032
8
-7.61322720 2 104.42478595
38.51618543 2 3.64199543
-12.00344193 3 52.46064977
288.99573247 3 4.33410703
-276.99229053 3 8.38373584
876.14551285 4 3.01347300
-1144.52462196 4 3.25680498
-386.35474053 4 59.52152812
8
142.97388030 2 48.08520852
-128.80933064 2 49.90034500
-186.15554307 3 11.18440029
180.45159943 3 5.04653753
5.70394364 3 85.01391269
101.90155258 4 3.06268644
-238.17133323 4 3.55821337
583.56858981 4 22.24622222
Zn GEN 12 2
8
18.00000000 1 16.25309578
-62.06001046 2 3.04359000
8.22443626 2 52.31604625
284.31836352 3 4.12635237
8.23736049 3 129.68855961
11442.99692797 4 7.94323624
-11664.25528103 4 7.74821809
462.64311342 4 34.44853266
8
140.30017448 2 3.16683649
-108.24959569 2 14.80839343
88.79372352 3 43.94225321
949.52154936 3 3.34122685
-1038.31527288 3 8.34153430
780.81282740 4 18.34782011
-1958.42831296 4 4.00418064
18.92059615 4 597.07325481
8
664.93623774 2 5.16678579
-651.12455824 2 11.88724380
930.96426186 3 7.96788974
-913.07841414 3 5.27302550
-17.88584772 3 127.63757255
3275.61040524 4 37.54266998
-3957.43240479 4 9.90068894
-3622.67126499 4 37.33250038

785
data/pseudo/tn_hf Normal file
View File

@ -0,0 +1,785 @@
H GEN 0 2
6
1.00000000 1 33.97261756
-5.73227574 2 41.31028903
-0.09126064 2 25.25940941
-20.89980944 2 22.55290552
21.89980945 2 32.44131356
33.97261756 3 21.12884239
6
-792.10375913 2 18.05333002
788.69064150 2 28.72271273
243.76232429 2 17.34000000
1971.45741618 2 20.31094085
-1795.56663560 2 22.08154655
-418.65661775 2 30.98799599
6
20.17177614 2 43.35000000
-21.74798121 2 30.58059209
81.48044293 2 43.35000000
-250.69197995 2 42.07548166
88.72115024 2 36.90496619
81.48044293 2 43.35000000
He GEN 0 2
6
2.00000000 1 20.98762121
-33.61186426 2 22.14709418
24.51669349 2 23.61790706
130.14113834 2 15.38761786
-129.14113834 2 14.22621787
41.97524242 3 12.59257273
6
1056.41263785 2 13.17618363
-1062.28560366 2 23.62254131
-463.87351954 2 12.04168890
-676.20404915 2 15.14280380
-595.21618656 2 19.81607243
1736.29130578 2 22.34342328
6
428.21432838 2 21.71652417
-430.31401911 2 12.32378638
7327.65357096 2 14.04426129
-7501.20178041 2 14.34477832
827.37705616 2 17.58948890
-652.83515208 2 21.22706329
Li GEN 2 2
6
1.00000000 1 0.78732101
-2.23995793 2 0.79224763
0.10336496 2 1.79622268
4.26591073 2 1.83637465
-3.26591073 2 1.91213904
0.78732101 3 0.79291624
6
256.06005883 2 1.78312879
-255.07112703 2 0.95553059
89.99417499 2 0.87617279
271.48958394 2 1.09621549
-180.35430387 2 1.43900642
-180.12948429 2 1.83085147
6
-6.15265886 2 1.51120608
4.70876577 2 0.76936375
-145.31681550 2 0.76874061
-238.21930857 2 0.99080928
219.67347903 2 0.80457655
164.85986038 2 1.07164892
Be GEN 2 2
6
2.00000000 1 1.20639978
-5.40210132 2 1.18425537
1.72285109 2 2.81826911
2.83477794 2 2.37513515
-1.83477794 2 2.82920954
2.41279956 3 1.18219335
6
-1045.56923435 2 2.59240549
1047.78889524 2 1.41686040
-1899.02207714 2 1.48536195
1398.02036098 2 1.70076266
-696.17508584 2 2.03898393
1198.17691383 2 2.57766021
6
630.77503458 2 1.84421403
-632.64959849 2 1.13419132
441.30858401 2 1.13393716
435.76647651 2 1.22419150
-353.48689426 2 1.39760436
-522.59133089 2 1.88595068
B GEN 2 2
6
3.00000000 1 2.72292969
-11.77602579 2 2.41356794
5.22133296 2 4.60628004
0.40709712 2 3.81569642
0.59290288 2 4.75281449
8.16878906 3 2.42655010
6
-259.65579181 2 2.54943794
264.77623108 2 4.54559309
79.19161122 2 2.15270531
-59.67150303 2 2.71820746
4276.39654293 2 3.54458188
-4294.91608677 2 3.65732479
6
236.40878048 2 3.85965228
-239.02058908 2 2.15130911
4065.68265375 2 2.50786619
-4354.92616892 2 2.58144728
782.08428825 2 3.14947869
-491.84514677 2 3.69136935
C GEN 2 2
6
4.00000000 1 6.85924392
-68.83281650 2 7.67473342
58.31001518 2 8.89832626
-5.23010100 2 4.63334409
6.23010100 2 5.40036758
27.43697568 3 6.78357071
6
15927.37261280 2 7.83879438
-15918.16480090 2 5.19308059
2266.75441213 2 7.53204263
199.75030501 2 9.76960112
15915.92435302 2 5.19521204
-18381.42723477 2 7.82847044
6
-153360.42295057 2 4.77965478
153356.81223147 2 7.75552602
-369415.66050006 2 7.39994991
152547.92039307 2 4.77641318
-50035.07991665 2 8.01352516
266903.80850142 2 7.30461659
N GEN 2 2
6
5.00000000 1 11.01983025
-745.67280403 2 7.70260962
729.30210222 2 7.83791198
-3.61639106 2 8.41784728
4.61639106 2 12.53426384
55.09915126 3 6.76845507
6
190.73305357 2 10.95092720
-176.25003778 2 7.48977970
138618.50426238 2 6.17989888
-156031.83911197 2 6.21713643
33624.66842989 2 6.84042808
-16210.33273520 2 7.23938652
6
-6963.78021671 2 6.00000000
6959.42174113 2 6.82157159
-1881.92821431 2 8.95497565
13576.39988827 2 6.21477468
-14307.35309373 2 6.69426410
2613.87687182 2 8.63240466
O GEN 2 2
6
6.00000000 1 8.86965578
-28.03502457 2 6.05347085
11.15565054 2 5.51487970
180.73182495 2 10.77996678
-179.73182495 2 10.23800841
53.21793471 3 7.90307811
6
-9301.89903913 2 7.28355994
9316.57793048 2 6.06026884
59864.04331135 2 10.82203807
-5153.55178109 2 5.75221581
-94673.29831259 2 10.51025188
39963.80850689 2 9.71187643
6
1682.75815189 2 6.93414347
-1694.05800561 2 5.70161443
848.47217112 2 5.90927487
-8787.11179775 2 8.69956320
7632.94108771 2 8.89513889
306.69604455 2 4.97067782
F GEN 2 2
6
7.00000000 1 16.52363418
-6.34751135 2 13.25777643
-15.15415075 2 18.76649923
-34.29784879 2 10.97564997
35.29784879 2 21.10568925
115.66543928 3 13.45706123
6
3851.10542697 2 18.85020393
-3832.40250429 2 12.48878559
-237433.87385812 2 13.23599298
4380.91891820 2 11.79852686
240164.95590264 2 13.28196243
-7110.99868861 2 17.38283172
6
-154.12048513 2 8.59949907
138.11297468 2 9.44224375
90.42851925 2 8.92886754
24.83173716 2 10.18592724
-424.59591732 2 14.47166344
310.33244840 2 16.45175456
Ne GEN 2 2
6
8.00000000 1 21.65168713
1792.30188007 2 14.45374325
-1826.14661180 2 14.11313946
24.26469360 2 14.10779016
-23.26469360 2 20.42281751
173.21349705 3 11.94458523
6
-3233.03788910 2 12.39056574
3263.09949012 2 20.60119535
1065.47298248 2 11.30677784
846.05067282 2 12.27737462
-34052.05079344 2 17.82669542
32141.52790433 2 17.34318949
6
64989.42116117 2 20.31242587
-65003.08394100 2 20.05277414
-486.55828399 2 12.87396775
2895.04182579 2 15.84533388
-261.91821074 2 19.42277681
-2145.56672184 2 23.82700477
K GEN 18 2
6
1.00000000 1 0.68724959
7665.13435390 2 0.62381187
-7668.26785841 2 0.59278246
-3877.60874288 2 0.63961163
3878.60874288 2 0.57860350
0.68724959 3 0.50008691
6
477943.00813868 2 0.60446875
-477941.36080643 2 0.55281419
-533027.54468668 2 0.57763214
644866.44840953 2 0.56624742
-347063.87255621 2 0.60823749
235225.96911606 2 0.54903924
6
5177368.01138896 2 0.56835236
-5177366.94506877 2 0.57395949
479730.23987439 2 0.65183506
1027151.48932830 2 0.60393420
-737636.25038898 2 0.55451546
-769244.47868615 2 0.64345811
Ca GEN 18 2
6
2.00000000 1 1.02097432
-10036.20006734 2 0.76570985
10030.67757963 2 0.83608195
-8136.00883920 2 0.84362927
8137.00883920 2 0.75729596
2.04194863 3 0.94514267
6
-34706.02643508 2 0.85912364
34710.12533681 2 0.50000000
860.68953329 2 0.79227941
33806.87817612 2 0.85997136
-34747.30927870 2 0.50004940
80.74228959 2 1.01833438
6
514.89542915 2 0.50045897
-511.93073005 2 0.57886998
-1374495660.24999190 2 0.50000000
687246875.87136328 2 0.50000000
595.96081232 2 0.56402502
687248189.41960287 2 0.50000000
Sc GEN 18 2
6
3.00000000 1 8.57059896
39.59298139 2 7.59719947
-67.37349200 2 5.06179469
3.54689568 2 11.85222547
-2.54689568 2 0.70815643
25.71179688 3 5.04858060
6
414.99811890 2 5.58945823
-389.30527335 2 5.93611719
8.74915776 2 0.56803113
-23.92388226 2 0.60868170
42.12589000 2 0.76957270
-25.95178014 2 1.21300456
6
87.05758924 2 1.12946939
-62.19670511 2 8.56362761
66.37833241 2 7.27494713
16.41391965 2 0.74327556
43.70031508 2 2.03252459
-125.49197853 2 1.19227023
Ti GEN 18 2
6
4.00000000 1 4.77516915
28.34758957 2 10.86929502
-63.21363466 2 5.37319310
5.17935660 2 6.86168513
-4.17935660 2 0.95669336
19.10067660 3 3.52162434
6
211.66189616 2 7.01854391
-179.82099411 2 1.03880358
-185.28466640 2 8.02474194
43.44334388 2 1.22490803
-44.06205312 2 0.73917909
186.90335758 2 0.89595855
6
49.26886952 2 4.65596397
-18.32131307 2 12.03001514
-5.50633295 2 2.16547114
-342.25486254 2 0.92182600
304.90681508 2 0.90099079
43.85505055 2 0.99684289
V GEN 18 2
6
5.00000000 1 7.54069430
35.58763613 2 13.63949328
-78.03044429 2 6.35551182
6.53716910 2 2.59423528
-5.53716910 2 1.16176108
37.70347150 3 6.00940761
6
194.57815114 2 8.18606241
-156.25972501 2 0.95585889
-162.29334861 2 9.81441300
-7.74379387 2 0.70017858
244.84040986 2 0.97854682
-73.80312462 2 1.14925292
6
58.91069981 2 5.48333809
-21.55840127 2 14.40777862
-10.12891199 2 2.12080402
2.52953175 2 0.69388688
109.28174657 2 1.01378564
-100.68144081 2 1.02780261
Cr GEN 18 2
6
6.00000000 1 5.86829616
-3.09900314 2 0.98487638
-44.94655388 2 6.96616660
135.46731129 2 13.59887742
-134.46731129 2 11.34882544
35.20977696 3 8.91110617
6
-526.12421414 2 1.73784849
568.24328209 2 32.55674074
-4019.88240027 2 29.55364033
495.64908693 2 1.64707294
3445.48735974 2 29.05037955
79.74580069 2 3.85284016
6
31.31844062 2 19.50625909
10.30743573 2 0.86978393
-81.88780266 2 15.20370471
461.22634080 2 10.28610919
1.00599253 2 29.84121604
-379.34381792 2 10.93761710
Mn GEN 18 2
6
7.00000000 1 15.05016398
76.91199595 2 15.84783194
-135.08366030 2 9.80426007
5.12036990 2 21.62193241
-4.12036990 2 1.26331891
105.35114786 3 9.24698903
6
4.45077705 2 37.07900996
46.93892122 2 10.09409180
-59.63952162 2 18.98557107
47.25376130 2 10.16267391
2270.38024432 2 0.79460121
-2256.99438460 2 0.79345224
6
43.65884288 2 39.18960573
6.58957965 2 5.88646925
273.41973132 2 12.35978155
-27.85882166 2 45.92825074
-255.64090683 2 15.10051906
11.08093098 2 0.96083847
Fe GEN 18 2
6
8.00000000 1 20.13246747
61.79343671 2 20.09868712
-128.55600523 2 10.70685691
4.84472314 2 28.79726611
-3.84472314 2 1.31374323
161.05973977 3 11.74858936
6
-20.21006220 2 30.42214774
78.68908034 2 10.18491881
-104.38370168 2 6.69228251
11879.61125830 2 2.98725076
4067.63536025 2 2.63900793
-15841.86182474 2 2.88538957
6
52.35701571 2 38.26448010
4.85142656 2 5.90250183
2169.08154283 2 14.09502191
-40.04038813 2 42.65213493
-2140.34005623 2 14.44188153
12.29991314 2 1.06050818
Co GEN 18 2
6
9.00000000 1 18.31609159
47.84627034 2 26.91264651
-123.98809879 2 11.91957078
5.09540361 2 38.50128360
-4.09540361 2 1.45636943
164.84482431 3 13.41744556
6
-22.55314559 2 34.07535172
88.75521276 2 10.45260699
-158.32924566 2 5.91087540
-53402.80058080 2 3.13684604
49767.17959800 2 3.16692544
3794.95155282 2 2.81533596
6
61.92019742 2 38.11279103
2.85881103 2 5.82898971
-387.27158530 2 15.59733227
-64.65478412 2 38.57519906
439.30094674 2 13.98109833
13.62664636 2 1.17046441
Ni GEN 18 2
6
10.00000000 1 19.84291404
-195.32353012 2 16.02128656
108.98533897 2 26.59513762
6.08469364 2 39.39261550
-5.08469364 2 1.73812596
198.42914037 3 16.63287860
6
636.14358475 2 21.00974643
-561.54325704 2 22.88188409
-146.65571659 2 11.08963477
1590.91833845 2 2.66405882
203.15470938 2 6.84512029
-1646.41568069 2 2.74451213
6
67.70992628 2 28.31556957
5.37743585 2 4.16521410
374.49405320 2 17.37825451
-389.83846114 2 21.96153313
1.91671522 2 49.74424984
14.42906054 2 1.27579002
Cu GEN 18 2
6
11.00000000 1 35.47715926
-18105.91023962 2 21.73013363
18011.23386368 2 21.83870561
6.01228206 2 18.42008793
-5.01228206 2 1.78198604
390.24875182 3 20.58922180
6
-51.41016015 2 31.92243640
131.47547623 2 14.07215286
-100490.54220540 2 4.21909683
20675.75763691 2 3.56801887
263590.56712535 2 4.06536588
-183774.78117039 2 3.92650866
6
68.62159615 2 31.47726702
10.70810140 2 4.95987737
233.01753836 2 17.95562228
-258.78181256 2 26.97191776
12.01106739 2 46.85069031
14.75422657 2 1.35614623
Zn GEN 18 2
6
12.00000000 1 26.60492300
-196.98442222 2 17.93401272
89.18558790 2 36.25784521
6.19159911 2 49.96784160
-5.19159911 2 1.99109193
319.25907600 3 19.77027094
6
-177.37971474 2 32.01501166
269.42130045 2 23.08836163
60361.29701582 2 4.67975974
1343973.13568915 2 5.29114502
-619902.07009680 2 5.11539109
-784431.36064381 2 5.38368747
6
46.22045015 2 19.08371294
43.98275320 2 50.00000000
103.59052598 2 16.88459979
-129.86700605 2 37.83300205
11.83058445 2 5.11918008
15.44716451 2 1.45112568
Ga GEN 28 2
6
3.00000000 1 1.29464779
1852.96920182 2 1.20541500
-1856.15440251 2 1.17879070
-513.51787928 2 1.21964580
514.51787928 2 1.12868888
3.88394338 3 1.06946118
6
-10.41248284 2 0.75266853
13.44253658 2 0.82344143
-163070.82529640 2 1.96346903
118782.06261627 2 1.90761481
72439.51450979 2 2.00432013
-28149.75180125 2 1.83309310
6
-55.43707314 2 0.98715132
55.68679311 2 1.18143237
95.35935510 2 1.24163917
-111.55606197 2 1.48647971
6.22134153 2 1.87957113
10.97737885 2 2.24689865
Ge GEN 28 2
6
4.00000000 1 0.64699203
1042.65966555 2 1.17600365
-1045.50742663 2 1.40672708
-522.21837337 2 1.06148136
523.21837337 2 1.52689039
2.58796812 3 0.70634661
6
298.52031462 2 1.37488700
-295.91758286 2 3.05395101
-65778.83466330 2 1.99750874
253302.61962618 2 2.10159773
25864.29161720 2 2.35028323
-213387.07659768 2 2.16152517
6
-1416.87913796 2 1.43279054
1416.49405157 2 1.27947333
-4677.12774504 2 1.39756889
6758.57740664 2 1.50728327
-2630.12555402 2 1.70834188
549.67778384 2 1.92912262
As GEN 28 2
6
5.00000000 1 1.90897798
-8.55267316 2 1.59326524
3.44617934 2 1.10844459
-8.94709126 2 1.02625257
9.94709126 2 1.90897549
9.54488990 3 1.18318262
6
-299.57003383 2 1.31601774
303.89084920 2 0.88992491
34018.91875930 2 0.82417957
-44808.38727678 2 0.87058735
19528.43031171 2 0.91644709
-8737.95845690 2 0.77833472
6
46094.50987530 2 1.90902784
-46093.10097169 2 1.56895782
-1934.82978262 2 1.41134047
-240427.05172601 2 1.84187044
36043.17172862 2 1.53235052
206319.71069040 2 1.81590910
Se GEN 28 2
6
6.00000000 1 1.73885845
-4868.76631948 2 3.10952817
4860.07291481 2 2.76656612
247376.94576273 2 2.93723435
-247375.94576273 2 2.93039894
10.43315069 3 1.80783830
6
43.48906338 2 1.54256367
-36.07303722 2 1.99876644
-1338.16209913 2 2.22244851
88855.15492433 2 3.01653570
-93322.17292948 2 3.00370283
5806.18068397 2 2.62760372
6
101.24952978 2 1.51703915
-96.89194467 2 1.50669503
-561.81915381 2 2.17759706
1474.30831735 2 2.47900419
-87533.83638244 2 3.02701983
86622.34849171 2 3.03071493
Br GEN 28 2
6
7.00000000 1 1.29861066
-8.22129971 2 1.15959643
0.21335410 2 2.29768788
-14617.16154553 2 2.88622041
14618.16154553 2 2.88664159
9.09027461 3 1.38987227
6
1993.56030565 2 1.99554365
-1988.14839885 2 2.18330258
62338.94920254 2 2.78298975
91516.94063906 2 2.50252605
-109846.25447802 2 2.70576408
-44008.63516555 2 2.38434210
6
17.36412726 2 1.29580803
-14.67327121 2 1.60078690
-6128.76923065 2 2.16344915
12563.02678529 2 2.26961184
757.63553722 2 2.83383736
-7190.89195704 2 2.41971949
Kr GEN 28 2
6
8.00000000 1 6.82429532
2245.94610147 2 4.82301962
-2257.24927570 2 3.38163452
1889.52842356 2 3.29088128
-1888.52842356 2 4.98656184
54.59436254 3 3.01373570
6
-2003.10975854 2 6.01573226
2010.79212346 2 4.07497664
13467772.94730707 2 4.47273823
-18464141.82809087 2 4.45030979
-2607955.84552628 2 4.28291762
7604325.72641131 2 4.35368575
6
-6512.57971257 2 5.33963561
6517.54562224 2 4.41831473
55170.14413687 2 3.66247372
-35314.20447418 2 3.56293692
-27094.88743738 2 3.99199621
7239.94695795 2 5.23539786
Al GEN 10 2
6
3.00000000 1 0.90167530
-12.07740634 2 1.08338853
6.60507677 2 2.07851308
-13877404.00590185 2 2.08053590
13877405.00590186 2 2.08053570
2.70502591 3 0.92748596
6
-41.26842670 2 2.04866185
45.70193781 2 1.11866688
2946.69575922 2 1.71721106
-376.01922297 2 1.36753958
4331.41613799 2 1.93292012
-6901.09265568 2 1.86705782
6
504.79904464 2 1.88548919
-502.69536383 2 1.42616967
-769.46860271 2 1.80548694
-17.66088618 2 0.95520911
101.43853505 2 1.20112583
686.69150206 2 1.52824179
Si GEN 10 2
6
4.00000000 1 2.54461774
-2902.58084906 2 2.24978528
2895.18838752 2 2.53789008
7161.72254279 2 2.34887222
-7160.72254279 2 2.46336277
10.17847098 3 1.52421025
6
4.24352962 2 1.08064949
2.05989979 2 1.33341749
88608.14855737 2 2.39993059
-849.93508619 2 1.92845396
-1434647.87047626 2 2.35634772
1346890.65714548 2 2.35320332
6
-15264.86061936 2 1.82998100
15267.99758945 2 1.91566514
-0.49522434 2 1.35066217
2807.17037795 2 2.16756956
6912.45723497 2 1.79762600
-9718.13169060 2 2.03990309
P GEN 10 2
6
5.00000000 1 2.20104239
-14571.76154266 2 3.30954781
14561.08785293 2 3.65491917
-21023.88213100 2 3.60582863
21024.88213100 2 3.36814532
11.00521195 3 2.06883762
6
-214.99423753 2 3.00175595
224.31212541 2 1.90508764
-1320.42895216 2 2.23252373
2262.27394007 2 2.56842585
-5217.11058123 2 3.22957222
4276.26614237 2 3.32169865
6
-4655.41288683 2 1.51251059
4660.80718311 2 1.51289861
-994.25816078 2 3.31761981
-19.30793578 2 2.04639527
311.57919748 2 3.70626860
702.98798215 2 3.09154453
S GEN 10 2
6
6.00000000 1 3.76431332
518.21506704 2 2.91975646
-532.35656437 2 2.26777538
14394.84387811 2 2.49556645
-14393.84387811 2 2.51698479
22.58587994 3 2.71241239
6
-104.19902150 2 4.55895180
116.57081427 2 2.10503756
-994.81335242 2 2.63814508
2203.13414043 2 3.11140569
-1617.61176296 2 3.62963239
410.29160018 2 4.55921172
6
723.09548214 2 4.48128068
-715.46568241 2 3.35956681
9063.41201304 2 3.83857196
-16.38228027 2 1.92699416
44.06704522 2 2.30670170
-9090.09577098 2 3.92706305
Cl GEN 10 2
6
7.00000000 1 4.77392870
719885.76609499 2 4.74019033
-719903.82223984 2 4.74189768
-37102.89380181 2 4.67979490
37103.89380181 2 4.71510215
33.41750090 3 3.29732864
6
959.05010082 2 5.01134618
-943.54843009 2 3.64529189
-6456.16063099 2 4.20510279
637.70704529 2 2.74283267
-1479.66774202 2 3.00605599
7299.12201388 2 3.90198120
6
-121.63220275 2 3.86324469
131.70125226 2 3.08695111
5447.27282828 2 5.92092153
-52.94814165 2 2.63467524
559.83762330 2 5.08437179
-5953.16139883 2 5.86183616
Ar GEN 10 2
6
8.00000000 1 5.17746158
-76.72264736 2 5.90884243
56.16280755 2 3.53735685
-660.63282107 2 4.53072721
661.63282107 2 4.90879705
41.41969264 3 3.95156133
6
496.48392385 2 3.21092458
-479.29969508 2 3.39224537
-12086.26924659 2 4.28061928
37151.97923364 2 4.62803105
496310.90908097 2 5.10487541
-521375.61810527 2 5.08995306
6
-1901.02320099 2 5.53714820
1911.87432982 2 4.52372637
-127.53875733 2 2.45115265
198.78501467 2 2.62001527
-976.26297293 2 3.97593759
906.01814260 2 6.12659776

BIN
data/qp.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 42 KiB

View File

@ -6,6 +6,7 @@ cd -
# Normal installation # Normal installation
PACKAGES="core cryptokit ocamlfind sexplib ZMQ" PACKAGES="core cryptokit ocamlfind sexplib ZMQ"
#ppx_sexp_conv
# Needed for ZeroMQ # Needed for ZeroMQ
export C_INCLUDE_PATH="${QP_ROOT}"/lib:"${C_INCLUDE_PATH}" export C_INCLUDE_PATH="${QP_ROOT}"/lib:"${C_INCLUDE_PATH}"

View File

@ -15,14 +15,14 @@ function _install()
./configure --without-libsodium || exit 1 ./configure --without-libsodium || exit 1
make -j 8 || exit 1 make -j 8 || exit 1
rm -f -- "${QP_ROOT}"/lib/libzmq.a "${QP_ROOT}"/lib/libzmq.so "${QP_ROOT}"/lib/libzmq.so.? rm -f -- "${QP_ROOT}"/lib/libzmq.a "${QP_ROOT}"/lib/libzmq.so "${QP_ROOT}"/lib/libzmq.so.?
# cp .libs/libzmq.a "${QP_ROOT}"/lib cp .libs/libzmq.a "${QP_ROOT}"/lib
# cp .libs/libzmq.so "${QP_ROOT}"/lib/libzmq.so.5 cp .libs/libzmq.so "${QP_ROOT}"/lib/libzmq.so.5
cp src/.libs/libzmq.a "${QP_ROOT}"/lib # cp src/.libs/libzmq.a "${QP_ROOT}"/lib
cp src/.libs/libzmq.so "${QP_ROOT}"/lib/libzmq.so.4 # cp src/.libs/libzmq.so "${QP_ROOT}"/lib/libzmq.so.4
cp include/{zmq.h,zmq_utils.h} "${QP_ROOT}"/lib cp include/{zmq.h,zmq_utils.h} "${QP_ROOT}"/lib
cd "${QP_ROOT}"/lib cd "${QP_ROOT}"/lib
# ln -s libzmq.so.5 libzmq.so ln -s libzmq.so.5 libzmq.so
ln -s libzmq.so.4 libzmq.so # ln -s libzmq.so.4 libzmq.so
cd ${ORIG} cd ${ORIG}
return 0 return 0
} }

View File

@ -1,4 +1,4 @@
open Core.Std;; open Core.Std
exception AtomError of string exception AtomError of string
@ -27,12 +27,18 @@ let of_string ~units s =
coord = Point3d.of_string ~units (String.concat [x; y; z] ~sep:" ") coord = Point3d.of_string ~units (String.concat [x; y; z] ~sep:" ")
} }
| _ -> raise (AtomError s) | _ -> raise (AtomError s)
;;
let to_string ~units a = let to_string ~units a =
[ Element.to_string a.element ; [ Element.to_string a.element ;
Charge.to_string a.charge ; Charge.to_string a.charge ;
Point3d.to_string ~units a.coord ] Point3d.to_string ~units a.coord ]
|> String.concat ~sep:" " |> String.concat ~sep:" "
;;
let to_xyz a =
Printf.sprintf "%-3s %s"
(Element.to_string a.element)
(Point3d.to_string ~units:Units.Angstrom a.coord)

View File

@ -7,3 +7,4 @@ val sexp_of_t : t -> Sexplib.Sexp.t
val of_string : units:Units.units -> string -> t val of_string : units:Units.units -> string -> t
val to_string : units:Units.units -> t -> string val to_string : units:Units.units -> t -> string
val to_xyz : t -> string

View File

@ -35,11 +35,11 @@ let read_element in_channel at_number element =
read in_channel at_number read in_channel at_number
let to_string b =
let to_string_general ~fmt ~atom_sep b =
let new_nucleus n = let new_nucleus n =
Printf.sprintf "Atom %d" n Printf.sprintf "Atom %d" n
in in
let rec do_work accu current_nucleus = function let rec do_work accu current_nucleus = function
| [] -> List.rev accu | [] -> List.rev accu
| (g,n)::tail -> | (g,n)::tail ->
@ -47,15 +47,27 @@ let to_string b =
in in
let accu = let accu =
if (n <> current_nucleus) then if (n <> current_nucleus) then
(new_nucleus n)::""::accu (new_nucleus n)::atom_sep::accu
else else
accu accu
in in
do_work ((Gto.to_string g)::accu) n tail do_work ((Gto.to_string ~fmt g)::accu) n tail
in in
do_work [new_nucleus 1] 1 b do_work [new_nucleus 1] 1 b
|> String.concat ~sep:"\n" |> String.concat ~sep:"\n"
let to_string_gamess =
to_string_general ~fmt:Gto.Gamess ~atom_sep:""
let to_string_gaussian b =
String.concat ~sep:"\n"
[ to_string_general ~fmt:Gto.Gaussian ~atom_sep:"****" b ; "****" ]
let to_string ?(fmt=Gto.Gamess) =
match fmt with
| Gto.Gamess -> to_string_gamess
| Gto.Gaussian -> to_string_gaussian
include To_md5 include To_md5
let to_md5 = to_md5 sexp_of_t let to_md5 = to_md5 sexp_of_t

View File

@ -14,7 +14,7 @@ val read_element :
in_channel -> Nucl_number.t -> Element.t -> (Gto.t * Nucl_number.t) list in_channel -> Nucl_number.t -> Element.t -> (Gto.t * Nucl_number.t) list
(** Convert the basis to a string *) (** Convert the basis to a string *)
val to_string : (Gto.t * Nucl_number.t) list -> string val to_string : ?fmt:Gto.fmt -> (Gto.t * Nucl_number.t) list -> string
(** Convert the basis to an MD5 hash *) (** Convert the basis to an MD5 hash *)
val to_md5 : (Gto.t * Nucl_number.t) list -> MD5.t val to_md5 : (Gto.t * Nucl_number.t) list -> MD5.t

View File

@ -4,6 +4,10 @@ open Qptypes
exception GTO_Read_Failure of string exception GTO_Read_Failure of string
exception End_Of_Basis exception End_Of_Basis
type fmt =
| Gamess
| Gaussian
type t = type t =
{ sym : Symmetry.t ; { sym : Symmetry.t ;
lc : ((Primitive.t * AO_coef.t) list) lc : ((Primitive.t * AO_coef.t) list)
@ -68,8 +72,8 @@ let read_one in_channel =
(** Transform the gto to a string *) (** Write the GTO in Gamess format *)
let to_string { sym = sym ; lc = lc } = let to_string_gamess { sym = sym ; lc = lc } =
let result = let result =
Printf.sprintf "%s %3d" (Symmetry.to_string sym) (List.length lc) Printf.sprintf "%s %3d" (Symmetry.to_string sym) (List.length lc)
in in
@ -88,3 +92,30 @@ let to_string { sym = sym ; lc = lc } =
|> String.concat ~sep:"\n" |> String.concat ~sep:"\n"
(** Write the GTO in Gaussian format *)
let to_string_gaussian { sym = sym ; lc = lc } =
let result =
Printf.sprintf "%s %3d 1.00" (Symmetry.to_string sym) (List.length lc)
in
let rec do_work accu i = function
| [] -> List.rev accu
| (p,c)::tail ->
let p = AO_expo.to_float p.Primitive.expo
and c = AO_coef.to_float c
in
let result =
Printf.sprintf "%15.7f %15.7f" p c
in
do_work (result::accu) (i+1) tail
in
(do_work [result] 1 lc)
|> String.concat ~sep:"\n"
(** Transform the gto to a string *)
let to_string ?(fmt=Gamess) =
match fmt with
| Gamess -> to_string_gamess
| Gaussian -> to_string_gaussian

View File

@ -1,5 +1,9 @@
exception GTO_Read_Failure of string exception GTO_Read_Failure of string
exception End_Of_Basis exception End_Of_Basis
type fmt =
| Gamess
| Gaussian
type t = type t =
{ sym : Symmetry.t ; { sym : Symmetry.t ;
lc : (Primitive.t * Qptypes.AO_coef.t) list; lc : (Primitive.t * Qptypes.AO_coef.t) list;
@ -13,4 +17,4 @@ val of_prim_coef_list :
val read_one : in_channel -> t val read_one : in_channel -> t
(** Convert to string for printing *) (** Convert to string for printing *)
val to_string : t -> string val to_string : ?fmt:fmt -> t -> string

View File

@ -17,6 +17,7 @@ module Ao_basis : sig
;; ;;
val read : unit -> t option val read : unit -> t option
val to_string : t -> string val to_string : t -> string
val to_basis : t -> Basis.t
val write : t -> unit val write : t -> unit
val to_md5 : t -> MD5.t val to_md5 : t -> MD5.t
val to_rst : t -> Rst_string.t val to_rst : t -> Rst_string.t

View File

@ -13,6 +13,7 @@ module Nuclei : sig
val read : unit -> t option val read : unit -> t option
val write : t -> unit val write : t -> unit
val to_string : t -> string val to_string : t -> string
val to_atom_list : t -> Atom.t list
val to_rst : t -> Rst_string.t val to_rst : t -> Rst_string.t
val of_rst : Rst_string.t -> t option val of_rst : Rst_string.t -> t option
end = struct end = struct
@ -134,6 +135,22 @@ end = struct
;; ;;
let to_atom_list b =
let rec loop accu (coord, charge, label) = function
| -1 -> accu
| i ->
let atom =
{ Atom.element = label.(i) ;
Atom.charge = charge.(i) ;
Atom.coord = coord.(i) ;
}
in
loop (atom::accu) (coord, charge, label) (i-1)
in
loop [] (b.nucl_coord, b.nucl_charge, b.nucl_label)
( (Nucl_number.to_int b.nucl_num) - 1)
;;
let to_string b = let to_string b =
Printf.sprintf " Printf.sprintf "
nucl_num = %s nucl_num = %s

View File

@ -85,7 +85,7 @@ let name m =
String.concat (result) String.concat (result)
let to_string m = let to_string_general ~f m =
let { nuclei ; elec_alpha ; elec_beta } = m let { nuclei ; elec_alpha ; elec_beta } = m
in in
let n = let n =
@ -94,10 +94,15 @@ let to_string m =
let title = let title =
name m name m
in in
[ Int.to_string n ; title ] @ [ Int.to_string n ; title ] @ (List.map ~f nuclei)
(List.map ~f:(fun x -> Atom.to_string Units.Angstrom x) nuclei)
|> String.concat ~sep:"\n" |> String.concat ~sep:"\n"
let to_string =
to_string_general ~f:(fun x -> Atom.to_string Units.Angstrom x)
let to_xyz =
to_string_general ~f:Atom.to_xyz
let of_xyz_string let of_xyz_string
?(charge=(Charge.of_int 0)) ?(multiplicity=(Multiplicity.of_int 1)) ?(charge=(Charge.of_int 0)) ?(multiplicity=(Multiplicity.of_int 1))

View File

@ -20,6 +20,7 @@ val name : t -> string
(** Conversion for printing *) (** Conversion for printing *)
val to_string : t -> string val to_string : t -> string
val to_xyz : t -> string
(** Creates a molecule from an xyz file *) (** Creates a molecule from an xyz file *)

84
ocaml/TaskServer.mli Normal file
View File

@ -0,0 +1,84 @@
type t =
{
queue : Queuing_system.t ;
state : Message.State.t option ;
address_tcp : Address.Tcp.t option ;
address_inproc : Address.Inproc.t option ;
psi : Message.Psi.t option;
progress_bar : Progress_bar.t option ;
running : bool;
}
(** {1} Debugging *)
(** Fetch the QP_TASK_DEBUG environment variable *)
val debug_env : bool
(** Print a debug message *)
val debug : string -> unit
(** {1} ZMQ *)
(** ZeroMQ context *)
val zmq_context : ZMQ.Context.t
(** Bind a ZMQ socket *)
val bind_socket :
socket_type:string -> socket:'a ZMQ.Socket.t -> address:string -> unit
(** Name of the host on which the server runs *)
val hostname : string lazy_t
(** IP address of the current host *)
val ip_address : string lazy_t
(** Standard messages *)
val reply_ok : [> `Req ] ZMQ.Socket.t -> unit
val reply_wrong_state : [> `Req ] ZMQ.Socket.t -> unit
(** Stop server *)
val stop : port:int -> unit
(** {1} Server functions *)
(** Create a new job *)
val new_job : Message.Newjob_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t
(** Finish a running job *)
val end_job : Message.Endjob_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t
(** Connect a client *)
val connect: Message.Connect_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t
(** Disconnect a client *)
val disconnect: Message.Disconnect_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t
(** Add a task to the pool *)
val add_task: Message.AddTask_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t
(** Mark the task as done by the client *)
val task_done: Message.TaskDone_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t
(** Delete a task when it has been pulled by the collector *)
val del_task: Message.DelTask_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t
(** The client get a new task to execute *)
val get_task: Message.GetTask_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t
(** Terminate server *)
val terminate : t -> [> `Req ] ZMQ.Socket.t -> t
(** Put a wave function in the task server *)
val put_psi :
Message.PutPsi_msg.t -> string list -> t -> [> `Req ] ZMQ.Socket.t -> t
(** Get the wave function stored in the task server *)
val get_psi : Message.GetPsi_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t
(** Reply an Error message *)
val error : string -> t -> [> `Req ] ZMQ.Socket.t -> t
(** Run server *)
val run : port:int -> unit

View File

@ -1,3 +1,3 @@
true: package(core,sexplib.syntax,cryptokit,ZMQ) true: package(core,cryptokit,ZMQ,sexplib.syntax)
true: thread true: thread
false: profile false: profile

View File

@ -8,10 +8,9 @@ s.unset_skip()
s.filter_only_1h1p() s.filter_only_1h1p()
print s print s
s = H_apply("just_mono") s = H_apply("just_mono",do_double_exc=False)
s.set_selection_pt2("epstein_nesbet_2x2") s.set_selection_pt2("epstein_nesbet_2x2")
s.unset_skip() s.unset_skip()
s.unset_double_excitations()
print s print s
END_SHELL END_SHELL

View File

@ -15,7 +15,7 @@ subroutine routine
integer :: N_st, degree integer :: N_st, degree
double precision,allocatable :: E_before(:) double precision,allocatable :: E_before(:)
integer :: n_det_before integer :: n_det_before
N_st = N_states N_st = N_states_diag
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st)) allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
i = 0 i = 0
print*,'N_det = ',N_det print*,'N_det = ',N_det

View File

@ -20,22 +20,18 @@ print s
s = H_apply("CAS_S",do_double_exc=False) s = H_apply("CAS_S",do_double_exc=False)
s.unset_double_excitations()
print s print s
s = H_apply("CAS_S_selected_no_skip",do_double_exc=False) s = H_apply("CAS_S_selected_no_skip",do_double_exc=False)
s.unset_double_excitations()
s.set_selection_pt2("epstein_nesbet_2x2") s.set_selection_pt2("epstein_nesbet_2x2")
s.unset_skip() s.unset_skip()
print s print s
s = H_apply("CAS_S_selected",do_double_exc=False) s = H_apply("CAS_S_selected",do_double_exc=False)
s.unset_double_excitations()
s.set_selection_pt2("epstein_nesbet_2x2") s.set_selection_pt2("epstein_nesbet_2x2")
print s print s
s = H_apply("CAS_S_PT2",do_double_exc=False) s = H_apply("CAS_S_PT2",do_double_exc=False)
s.unset_double_excitations()
s.set_perturbation("epstein_nesbet_2x2") s.set_perturbation("epstein_nesbet_2x2")
print s print s

View File

@ -3,10 +3,10 @@ program ddci
integer :: i,k integer :: i,k
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:) double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:),E_before(:)
integer :: N_st, degree integer :: N_st, degree
N_st = N_states N_st = N_states_diag
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st)) allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
character*(64) :: perturbation character*(64) :: perturbation
pt2 = 1.d0 pt2 = 1.d0
@ -27,6 +27,8 @@ program ddci
print *, 'E+PT2 = ', CI_energy+pt2 print *, 'E+PT2 = ', CI_energy+pt2
print *, '-----' print *, '-----'
endif endif
call set_bitmask_particl_as_input(reunion_of_bitmask)
call set_bitmask_hole_as_input(reunion_of_bitmask)
do while (N_det < N_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max) do while (N_det < N_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max)
call H_apply_DDCI_selection(pt2, norm_pert, H_pert_diag, N_st) call H_apply_DDCI_selection(pt2, norm_pert, H_pert_diag, N_st)
@ -47,8 +49,21 @@ program ddci
print *, 'N_states = ', N_states print *, 'N_states = ', N_states
print *, 'PT2 = ', pt2 print *, 'PT2 = ', pt2
print *, 'E = ', CI_energy print *, 'E = ', CI_energy
print *, 'E+PT2 = ', CI_energy+pt2 print *, 'E+PT2 = ', E_before+pt2
print *, '-----' print *, '-----'
if(N_states_diag.gt.1)then
print*,'Variational Energy difference'
do i = 2, N_st
print*,'Delta E = ',CI_energy(i) - CI_energy(1)
enddo
endif
if(N_states.gt.1)then
print*,'Variational + perturbative Energy difference'
do i = 2, N_st
print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1))
enddo
endif
E_before = CI_energy
call ezfio_set_ddci_selected_energy(CI_energy) call ezfio_set_ddci_selected_energy(CI_energy)
enddo enddo
if(do_pt2_end)then if(do_pt2_end)then

View File

@ -1,6 +1,13 @@
[threshold_singles] [threshold_lmct]
type: double precision type: double precision
doc: threshold to select the pertinent single excitations at second order doc: threshold to select the pertinent LMCT excitations at second order
interface: ezfio,provider,ocaml
default: 0.01
[threshold_mlct]
type: double precision
doc: threshold to select the pertinent MLCT excitations at second order
interface: ezfio,provider,ocaml interface: ezfio,provider,ocaml
default: 0.01 default: 0.01
@ -16,6 +23,20 @@ doc: if true, you do the FOBOCI calculation perturbatively
interface: ezfio,provider,ocaml interface: ezfio,provider,ocaml
default: .False. default: .False.
[speed_up_convergence_foboscf]
type: logical
doc: if true, the threshold of the FOBO-SCF algorithms are increased with the iterations
interface: ezfio,provider,ocaml
default: .True.
[dressing_2h2p]
type: logical
doc: if true, you do dress with 2h2p excitations each FOBOCI matrix
interface: ezfio,provider,ocaml
default: .False.
[second_order_h] [second_order_h]
type: logical type: logical
doc: if true, you do the FOBOCI calculation using second order intermediate Hamiltonian doc: if true, you do the FOBOCI calculation using second order intermediate Hamiltonian

View File

@ -18,8 +18,22 @@ print s
s = H_apply("standard") s = H_apply("only_1h2p")
s.set_selection_pt2("epstein_nesbet") s.set_selection_pt2("epstein_nesbet")
s.filter_only_1h2p()
s.unset_skip()
print s
s = H_apply("only_2h2p")
s.set_selection_pt2("epstein_nesbet")
s.filter_only_2h2p()
s.unset_skip()
print s
s = H_apply("only_2p")
s.set_selection_pt2("epstein_nesbet")
s.filter_only_2p()
s.unset_skip() s.unset_skip()
print s print s

View File

@ -1 +1 @@
Perturbation Generators_restart Selectors_no_sorted Perturbation Selectors_no_sorted Hartree_Fock

View File

@ -6,9 +6,9 @@ subroutine all_single
double precision,allocatable :: E_before(:) double precision,allocatable :: E_before(:)
N_st = N_states N_st = N_states
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st)) allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
selection_criterion = 1.d-8 selection_criterion = 0.d0
soft_touch selection_criterion soft_touch selection_criterion
threshold_davidson = 1.d-5 threshold_davidson = 1.d-9
soft_touch threshold_davidson davidson_criterion soft_touch threshold_davidson davidson_criterion
i = 0 i = 0
print*,'Doing all the mono excitations !' print*,'Doing all the mono excitations !'
@ -52,10 +52,173 @@ subroutine all_single
enddo enddo
endif endif
E_before = CI_energy E_before = CI_energy
!!!!!!!!!!!!!!!!!!!!!!!!!!! DOING ONLY ONE ITERATION OF SELECTION AS THE SELECTION CRITERION IS SET TO ZERO
exit
enddo enddo
threshold_davidson = 1.d-10 ! threshold_davidson = 1.d-8
! soft_touch threshold_davidson davidson_criterion
! call diagonalize_CI
print*,'Final Step '
print*,'N_det = ',N_det
do i = 1, N_states_diag
print*,''
print*,'i = ',i
print*,'E = ',CI_energy(i)
print*,'S^2 = ',CI_eigenvectors_s2(i)
enddo
do i = 1, max(2,N_det_generators)
print*,'psi_coef = ',psi_coef(i,1)
enddo
deallocate(pt2,norm_pert,E_before)
end
subroutine all_1h2p
implicit none
integer :: i,k
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
integer :: N_st, degree
double precision,allocatable :: E_before(:)
N_st = N_states
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
selection_criterion = 0.d0
soft_touch selection_criterion
threshold_davidson = 1.d-5
soft_touch threshold_davidson davidson_criterion soft_touch threshold_davidson davidson_criterion
call diagonalize_CI i = 0
print*,''
print*,''
print*,''
print*,''
print*,''
print*,'*****************************'
print*,'Doing all the 1h2P excitations'
print*,'*****************************'
print*,''
print*,''
print*,'N_det = ',N_det
print*,'n_det_max = ',n_det_max
print*,'pt2_max = ',pt2_max
print*,'N_det_generators = ',N_det_generators
pt2=-1.d0
E_before = ref_bitmask_energy
print*,'Initial Step '
print*,'Inital determinants '
print*,'N_det = ',N_det
do i = 1, N_states_diag
print*,''
print*,'i = ',i
print*,'E = ',CI_energy(i)
print*,'S^2 = ',CI_eigenvectors_s2(i)
enddo
n_det_max = 100000
i = 0
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max)
i += 1
print*,'-----------------------'
print*,'i = ',i
call H_apply_only_1h2p(pt2, norm_pert, H_pert_diag, N_st)
call diagonalize_CI
print*,'N_det = ',N_det
print*,'E = ',CI_energy(1)
print*,'pt2 = ',pt2(1)
print*,'E+PT2 = ',E_before + pt2(1)
if(N_states_diag.gt.1)then
print*,'Variational Energy difference'
do i = 2, N_st
print*,'Delta E = ',CI_energy(i) - CI_energy(1)
enddo
endif
if(N_states.gt.1)then
print*,'Variational + perturbative Energy difference'
do i = 2, N_st
print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1))
enddo
endif
E_before = CI_energy
enddo
print*,'Final Step '
print*,'N_det = ',N_det
do i = 1, N_states_diag
print*,''
print*,'i = ',i
print*,'E = ',CI_energy(i)
print*,'S^2 = ',CI_eigenvectors_s2(i)
enddo
do i = 1, 2
print*,'psi_coef = ',psi_coef(i,1)
enddo
deallocate(pt2,norm_pert,E_before)
end
subroutine all_2h2p
implicit none
integer :: i,k
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
integer :: N_st, degree
double precision,allocatable :: E_before(:)
N_st = N_states
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
selection_criterion = 0.d0
soft_touch selection_criterion
threshold_davidson = 1.d-5
soft_touch threshold_davidson davidson_criterion
i = 0
print*,''
print*,''
print*,''
print*,''
print*,''
print*,'*****************************'
print*,'Doing all the 2h2P excitations'
print*,'*****************************'
print*,''
print*,''
print*,'N_det = ',N_det
print*,'n_det_max = ',n_det_max
print*,'pt2_max = ',pt2_max
print*,'N_det_generators = ',N_det_generators
pt2=-1.d0
E_before = ref_bitmask_energy
print*,'Initial Step '
print*,'Inital determinants '
print*,'N_det = ',N_det
do i = 1, N_states_diag
print*,''
print*,'i = ',i
print*,'E = ',CI_energy(i)
print*,'S^2 = ',CI_eigenvectors_s2(i)
enddo
n_det_max = 100000
i = 0
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max)
i += 1
print*,'-----------------------'
print*,'i = ',i
call H_apply_only_2h2p(pt2, norm_pert, H_pert_diag, N_st)
call diagonalize_CI
print*,'N_det = ',N_det
print*,'E = ',CI_energy(1)
print*,'pt2 = ',pt2(1)
print*,'E+PT2 = ',E_before + pt2(1)
if(N_states_diag.gt.1)then
print*,'Variational Energy difference'
do i = 2, N_st
print*,'Delta E = ',CI_energy(i) - CI_energy(1)
enddo
endif
if(N_states.gt.1)then
print*,'Variational + perturbative Energy difference'
do i = 2, N_st
print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1))
enddo
endif
E_before = CI_energy
enddo
print*,'Final Step ' print*,'Final Step '
print*,'N_det = ',N_det print*,'N_det = ',N_det
do i = 1, N_states_diag do i = 1, N_states_diag
@ -67,10 +230,89 @@ subroutine all_single
do i = 1, 2 do i = 1, 2
print*,'psi_coef = ',psi_coef(i,1) print*,'psi_coef = ',psi_coef(i,1)
enddo enddo
! call save_wavefunction
deallocate(pt2,norm_pert,E_before) deallocate(pt2,norm_pert,E_before)
end end
subroutine all_2p
implicit none
integer :: i,k
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
integer :: N_st, degree
double precision,allocatable :: E_before(:)
N_st = N_states
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
selection_criterion = 0.d0
soft_touch selection_criterion
threshold_davidson = 1.d-5
soft_touch threshold_davidson davidson_criterion
i = 0
print*,''
print*,''
print*,''
print*,''
print*,''
print*,'*****************************'
print*,'Doing all the 2P excitations'
print*,'*****************************'
print*,''
print*,''
print*,'N_det = ',N_det
print*,'n_det_max = ',n_det_max
print*,'pt2_max = ',pt2_max
print*,'N_det_generators = ',N_det_generators
pt2=-1.d0
E_before = ref_bitmask_energy
print*,'Initial Step '
print*,'Inital determinants '
print*,'N_det = ',N_det
do i = 1, N_states_diag
print*,''
print*,'i = ',i
print*,'E = ',CI_energy(i)
print*,'S^2 = ',CI_eigenvectors_s2(i)
enddo
n_det_max = 100000
i = 0
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max)
i += 1
print*,'-----------------------'
print*,'i = ',i
call H_apply_only_2p(pt2, norm_pert, H_pert_diag, N_st)
call diagonalize_CI
print*,'N_det = ',N_det
print*,'E = ',CI_energy(1)
print*,'pt2 = ',pt2(1)
print*,'E+PT2 = ',E_before + pt2(1)
if(N_states_diag.gt.1)then
print*,'Variational Energy difference'
do i = 2, N_st
print*,'Delta E = ',CI_energy(i) - CI_energy(1)
enddo
endif
if(N_states.gt.1)then
print*,'Variational + perturbative Energy difference'
do i = 2, N_st
print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1))
enddo
endif
E_before = CI_energy
enddo
print*,'Final Step '
print*,'N_det = ',N_det
do i = 1, N_states_diag
print*,''
print*,'i = ',i
print*,'E = ',CI_energy(i)
print*,'S^2 = ',CI_eigenvectors_s2(i)
enddo
deallocate(pt2,norm_pert,E_before)
do i = 1, 2
print*,'psi_coef = ',psi_coef(i,1)
enddo
end
subroutine all_single_no_1h_or_1p subroutine all_single_no_1h_or_1p
implicit none implicit none
integer :: i,k integer :: i,k
@ -79,6 +321,8 @@ subroutine all_single_no_1h_or_1p
double precision,allocatable :: E_before(:) double precision,allocatable :: E_before(:)
N_st = N_states N_st = N_states
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st)) allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
selection_criterion = 0.d0
soft_touch selection_criterion
threshold_davidson = 1.d-5 threshold_davidson = 1.d-5
soft_touch threshold_davidson davidson_criterion soft_touch threshold_davidson davidson_criterion
i = 0 i = 0
@ -124,7 +368,7 @@ subroutine all_single_no_1h_or_1p
endif endif
E_before = CI_energy E_before = CI_energy
enddo enddo
threshold_davidson = 1.d-10 threshold_davidson = 1.d-16
soft_touch threshold_davidson davidson_criterion soft_touch threshold_davidson davidson_criterion
call diagonalize_CI call diagonalize_CI
print*,'Final Step ' print*,'Final Step '
@ -215,85 +459,6 @@ subroutine all_single_no_1h_or_1p_or_2p
deallocate(pt2,norm_pert,E_before) deallocate(pt2,norm_pert,E_before)
end end
subroutine all_2p
implicit none
integer :: i,k
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
integer :: N_st, degree
double precision,allocatable :: E_before(:)
N_st = N_states
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
selection_criterion = 0.d0
soft_touch selection_criterion
threshold_davidson = 1.d-5
soft_touch threshold_davidson davidson_criterion
i = 0
print*,''
print*,''
print*,''
print*,''
print*,''
print*,'*****************************'
print*,'Doing all the 2P excitations'
print*,'*****************************'
print*,''
print*,''
print*,'N_det = ',N_det
print*,'n_det_max = ',n_det_max
print*,'pt2_max = ',pt2_max
print*,'N_det_generators = ',N_det_generators
pt2=-1.d0
E_before = ref_bitmask_energy
print*,'Initial Step '
print*,'Inital determinants '
print*,'N_det = ',N_det
do i = 1, N_states_diag
print*,''
print*,'i = ',i
print*,'E = ',CI_energy(i)
print*,'S^2 = ',CI_eigenvectors_s2(i)
enddo
n_det_max = 100000
i = 0
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max)
i += 1
print*,'-----------------------'
print*,'i = ',i
call H_apply_standard(pt2, norm_pert, H_pert_diag, N_st)
call diagonalize_CI
print*,'N_det = ',N_det
print*,'E = ',CI_energy(1)
print*,'pt2 = ',pt2(1)
print*,'E+PT2 = ',E_before + pt2(1)
if(N_states_diag.gt.1)then
print*,'Variational Energy difference'
do i = 2, N_st
print*,'Delta E = ',CI_energy(i) - CI_energy(1)
enddo
endif
if(N_states.gt.1)then
print*,'Variational + perturbative Energy difference'
do i = 2, N_st
print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1))
enddo
endif
E_before = CI_energy
enddo
print*,'Final Step '
print*,'N_det = ',N_det
do i = 1, N_states_diag
print*,''
print*,'i = ',i
print*,'E = ',CI_energy(i)
print*,'S^2 = ',CI_eigenvectors_s2(i)
enddo
! call save_wavefunction
deallocate(pt2,norm_pert,E_before)
end
subroutine all_1h_1p_routine subroutine all_1h_1p_routine
implicit none implicit none
integer :: i,k integer :: i,k

View File

@ -5,7 +5,7 @@ subroutine all_single_split(psi_det_generators_input,psi_coef_generators_input,N
integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,Ndet_generators_input) integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,Ndet_generators_input)
double precision, intent(inout) :: dressing_matrix(Ndet_generators_input,Ndet_generators_input) double precision, intent(inout) :: dressing_matrix(Ndet_generators_input,Ndet_generators_input)
double precision, intent(in) :: psi_coef_generators_input(ndet_generators_input,n_states) double precision, intent(in) :: psi_coef_generators_input(ndet_generators_input,n_states)
integer :: i,i_hole integer :: i,i_hole,j
n_det_max_jacobi = 50 n_det_max_jacobi = 50
soft_touch n_det_max_jacobi soft_touch n_det_max_jacobi
do i = 1, n_inact_orb do i = 1, n_inact_orb
@ -22,56 +22,339 @@ subroutine all_single_split(psi_det_generators_input,psi_coef_generators_input,N
call set_generators_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input) call set_generators_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input)
call set_psi_det_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input) call set_psi_det_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input)
call all_single call all_single
threshold_davidson = 1.d-10 ! call diagonalize_CI_SC2
soft_touch threshold_davidson davidson_criterion ! call update_matrix_dressing_sc2(dressing_matrix,ndet_generators_input,psi_det_generators_input,Diag_H_elements_SC2)
call diagonalize_CI
call provide_matrix_dressing(dressing_matrix,ndet_generators_input,psi_det_generators_input) call provide_matrix_dressing(dressing_matrix,ndet_generators_input,psi_det_generators_input)
enddo enddo
do i = 1, n_act_orb
i_hole = list_act(i)
print*,''
print*,'Doing all the single excitations from the orbital '
print*,i_hole
print*,''
print*,''
threshold_davidson = 1.d-4
soft_touch threshold_davidson davidson_criterion
call modify_bitmasks_for_hole(i_hole)
call set_bitmask_particl_as_input(reunion_of_bitmask)
call set_generators_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input)
call set_psi_det_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input)
call all_single
! call diagonalize_CI_SC2
! call update_matrix_dressing_sc2(dressing_matrix,ndet_generators_input,psi_det_generators_input,Diag_H_elements_SC2)
call provide_matrix_dressing(dressing_matrix,ndet_generators_input,psi_det_generators_input)
enddo
do i = 1, n_virt_orb
i_hole = list_virt(i)
print*,''
print*,'Doing all the single excitations from the orbital '
print*,i_hole
print*,''
print*,''
threshold_davidson = 1.d-4
soft_touch threshold_davidson davidson_criterion
call modify_bitmasks_for_hole(i_hole)
call set_bitmask_particl_as_input(reunion_of_bitmask)
call set_generators_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input)
call set_psi_det_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input)
call all_single
! call diagonalize_CI_SC2
! call update_matrix_dressing_sc2(dressing_matrix,ndet_generators_input,psi_det_generators_input,Diag_H_elements_SC2)
call provide_matrix_dressing(dressing_matrix,ndet_generators_input,psi_det_generators_input)
enddo
n_det_max_jacobi = 1000 n_det_max_jacobi = 1000
soft_touch n_det_max_jacobi soft_touch n_det_max_jacobi
end end
subroutine all_single_for_1h(dressing_matrix_1h1p,dressing_matrix_2h1p)
subroutine all_single_for_1p(i_particl,dressing_matrix_1h1p,dressing_matrix_1h2p,dressing_matrix_extra_1h_or_1p)
implicit none implicit none
use bitmasks use bitmasks
integer, intent(in) :: i_particl
double precision, intent(inout) :: dressing_matrix_1h1p(N_det_generators,N_det_generators) double precision, intent(inout) :: dressing_matrix_1h1p(N_det_generators,N_det_generators)
double precision, intent(inout) :: dressing_matrix_2h1p(N_det_generators,N_det_generators) double precision, intent(inout) :: dressing_matrix_1h2p(N_det_generators,N_det_generators)
integer :: i,i_hole double precision, intent(inout) :: dressing_matrix_extra_1h_or_1p(N_det_generators,N_det_generators)
integer :: i,j
n_det_max_jacobi = 50 n_det_max_jacobi = 50
soft_touch n_det_max_jacobi soft_touch n_det_max_jacobi
integer :: n_det_1h1p,n_det_2h1p call all_single
integer(bit_kind), allocatable :: psi_ref_out(:,:,:)
integer(bit_kind), allocatable :: psi_1h1p(:,:,:)
integer(bit_kind), allocatable :: psi_2h1p(:,:,:)
double precision, allocatable :: psi_ref_coef_out(:,:)
double precision, allocatable :: psi_coef_1h1p(:,:)
double precision, allocatable :: psi_coef_2h1p(:,:)
call all_single_no_1h_or_1p
threshold_davidson = 1.d-12 threshold_davidson = 1.d-12
soft_touch threshold_davidson davidson_criterion soft_touch threshold_davidson davidson_criterion
call diagonalize_CI call diagonalize_CI
call give_n_1h1p_and_n_2h1p_in_psi_det(n_det_1h1p,n_det_2h1p)
allocate(psi_ref_out(N_int,2,N_det_generators))
allocate(psi_1h1p(N_int,2,n_det_1h1p))
allocate(psi_2h1p(N_int,2,n_det_2h1p))
allocate(psi_ref_coef_out(N_det_generators,N_states))
allocate(psi_coef_1h1p(n_det_1h1p,N_states))
allocate(psi_coef_2h1p(n_det_2h1p,N_states))
call split_wf_generators_and_1h1p_and_2h1p(n_det_1h1p,n_det_2h1p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_2h1p,psi_coef_2h1p)
call provide_matrix_dressing_general(dressing_matrix_1h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
psi_1h1p,psi_coef_1h1p,n_det_1h1p)
call provide_matrix_dressing_general(dressing_matrix_2h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
psi_2h1p,psi_coef_2h1p,n_det_2h1p)
deallocate(psi_ref_out)
deallocate(psi_1h1p)
deallocate(psi_2h1p) double precision, allocatable :: matrix_ref_1h_1p(:,:)
deallocate(psi_ref_coef_out) double precision, allocatable :: matrix_ref_1h_1p_dressing_1h1p(:,:)
deallocate(psi_coef_1h1p) double precision, allocatable :: matrix_ref_1h_1p_dressing_1h2p(:,:)
deallocate(psi_coef_2h1p) double precision, allocatable :: psi_coef_ref_1h_1p(:,:)
double precision, allocatable :: psi_coef_1h1p(:,:)
double precision, allocatable :: psi_coef_1h2p(:,:)
integer(bit_kind), allocatable :: psi_det_1h2p(:,:,:)
integer(bit_kind), allocatable :: psi_det_ref_1h_1p(:,:,:)
integer(bit_kind), allocatable :: psi_det_1h1p(:,:,:)
integer :: n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p
double precision :: hka
double precision,allocatable :: eigenvectors(:,:), eigenvalues(:)
call give_n_ref_1h_1p_and_n_1h2p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p)
allocate(matrix_ref_1h_1p(n_det_ref_1h_1p,n_det_ref_1h_1p))
allocate(matrix_ref_1h_1p_dressing_1h1p(n_det_ref_1h_1p,n_det_ref_1h_1p))
allocate(matrix_ref_1h_1p_dressing_1h2p(n_det_ref_1h_1p,n_det_ref_1h_1p))
allocate(psi_det_ref_1h_1p(N_int,2,n_det_ref_1h_1p), psi_coef_ref_1h_1p(n_det_ref_1h_1p,N_states))
allocate(psi_det_1h2p(N_int,2,n_det_1h2p), psi_coef_1h2p(n_det_1h2p,N_states))
allocate(psi_det_1h1p(N_int,2,n_det_1h1p), psi_coef_1h1p(n_det_1h1p,N_states))
call give_wf_n_ref_1h_1p_and_n_1h2p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,&
psi_det_1h2p,psi_coef_1h2p,psi_det_1h1p,psi_coef_1h1p)
do i = 1, n_det_ref_1h_1p
do j = 1, n_det_ref_1h_1p
call i_h_j(psi_det_ref_1h_1p(1,1,i),psi_det_ref_1h_1p(1,1,j),N_int,hka)
matrix_ref_1h_1p(i,j) = hka
enddo
enddo
matrix_ref_1h_1p_dressing_1h1p = 0.d0
matrix_ref_1h_1p_dressing_1h2p = 0.d0
call provide_matrix_dressing_general(matrix_ref_1h_1p_dressing_1h2p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,n_det_ref_1h_1p, &
psi_det_1h2p,psi_coef_1h2p,n_det_1h2p)
call provide_matrix_dressing_general(matrix_ref_1h_1p_dressing_1h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,n_det_ref_1h_1p, &
psi_det_1h1p,psi_coef_1h1p,n_det_1h1p)
do i = 1, n_det_ref_1h_1p
do j = 1, n_det_ref_1h_1p
matrix_ref_1h_1p(i,j) += matrix_ref_1h_1p_dressing_1h2p(i,j) + matrix_ref_1h_1p_dressing_1h1p(i,j)
enddo
enddo
allocate(eigenvectors(n_det_ref_1h_1p,n_det_ref_1h_1p), eigenvalues(n_det_ref_1h_1p))
call lapack_diag(eigenvalues,eigenvectors,matrix_ref_1h_1p,n_det_ref_1h_1p,n_det_ref_1h_1p)
!do j = 1, n_det_ref_1h_1p
! print*,'coef = ',eigenvectors(j,1)
!enddo
print*,''
print*,'-----------------------'
print*,'-----------------------'
print*,'e_dressed = ',eigenvalues(1)+nuclear_repulsion
print*,'-----------------------'
! Extract the
integer, allocatable :: index_generator(:)
integer :: n_det_generators_tmp,degree
n_det_generators_tmp = 0
allocate(index_generator(n_det_ref_1h_1p))
do i = 1, n_det_ref_1h_1p
do j = 1, N_det_generators
call get_excitation_degree(psi_det_generators(1,1,j),psi_det_ref_1h_1p(1,1,i), degree, N_int)
if(degree == 0)then
n_det_generators_tmp +=1
index_generator(n_det_generators_tmp) = i
endif
enddo
enddo
if(n_det_generators_tmp .ne. n_det_generators)then
print*,'PB !!!'
print*,'if(n_det_generators_tmp .ne. n_det_genrators)then'
stop
endif
do i = 1, N_det_generators
print*,'psi_coef_dressed = ',eigenvectors(index_generator(i),1)
do j = 1, N_det_generators
dressing_matrix_1h1p(i,j) += matrix_ref_1h_1p_dressing_1h1p(index_generator(i),index_generator(j))
dressing_matrix_1h2p(i,j) += matrix_ref_1h_1p_dressing_1h2p(index_generator(i),index_generator(j))
enddo
enddo
print*,'-----------------------'
print*,'-----------------------'
deallocate(matrix_ref_1h_1p)
deallocate(matrix_ref_1h_1p_dressing_1h1p)
deallocate(matrix_ref_1h_1p_dressing_1h2p)
deallocate(psi_det_ref_1h_1p, psi_coef_ref_1h_1p)
deallocate(psi_det_1h2p, psi_coef_1h2p)
deallocate(psi_det_1h1p, psi_coef_1h1p)
deallocate(eigenvectors,eigenvalues)
deallocate(index_generator)
end
subroutine all_single_for_1h(i_hole,dressing_matrix_1h1p,dressing_matrix_2h1p,dressing_matrix_extra_1h_or_1p)
implicit none
use bitmasks
integer, intent(in) :: i_hole
double precision, intent(inout) :: dressing_matrix_1h1p(N_det_generators,N_det_generators)
double precision, intent(inout) :: dressing_matrix_2h1p(N_det_generators,N_det_generators)
double precision, intent(inout) :: dressing_matrix_extra_1h_or_1p(N_det_generators,N_det_generators)
integer :: i,j
n_det_max_jacobi = 50
soft_touch n_det_max_jacobi
call all_single
threshold_davidson = 1.d-12
soft_touch threshold_davidson davidson_criterion
call diagonalize_CI
double precision, allocatable :: matrix_ref_1h_1p(:,:)
double precision, allocatable :: matrix_ref_1h_1p_dressing_1h1p(:,:)
double precision, allocatable :: matrix_ref_1h_1p_dressing_2h1p(:,:)
double precision, allocatable :: psi_coef_ref_1h_1p(:,:)
double precision, allocatable :: psi_coef_1h1p(:,:)
double precision, allocatable :: psi_coef_2h1p(:,:)
integer(bit_kind), allocatable :: psi_det_2h1p(:,:,:)
integer(bit_kind), allocatable :: psi_det_ref_1h_1p(:,:,:)
integer(bit_kind), allocatable :: psi_det_1h1p(:,:,:)
integer :: n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p
double precision :: hka
double precision,allocatable :: eigenvectors(:,:), eigenvalues(:)
call give_n_ref_1h_1p_and_n_2h1p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p)
allocate(matrix_ref_1h_1p(n_det_ref_1h_1p,n_det_ref_1h_1p))
allocate(matrix_ref_1h_1p_dressing_1h1p(n_det_ref_1h_1p,n_det_ref_1h_1p))
allocate(matrix_ref_1h_1p_dressing_2h1p(n_det_ref_1h_1p,n_det_ref_1h_1p))
allocate(psi_det_ref_1h_1p(N_int,2,n_det_ref_1h_1p), psi_coef_ref_1h_1p(n_det_ref_1h_1p,N_states))
allocate(psi_det_2h1p(N_int,2,n_det_2h1p), psi_coef_2h1p(n_det_2h1p,N_states))
allocate(psi_det_1h1p(N_int,2,n_det_1h1p), psi_coef_1h1p(n_det_1h1p,N_states))
call give_wf_n_ref_1h_1p_and_n_2h1p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,&
psi_det_2h1p,psi_coef_2h1p,psi_det_1h1p,psi_coef_1h1p)
do i = 1, n_det_ref_1h_1p
do j = 1, n_det_ref_1h_1p
call i_h_j(psi_det_ref_1h_1p(1,1,i),psi_det_ref_1h_1p(1,1,j),N_int,hka)
matrix_ref_1h_1p(i,j) = hka
enddo
enddo
matrix_ref_1h_1p_dressing_1h1p = 0.d0
matrix_ref_1h_1p_dressing_2h1p = 0.d0
call provide_matrix_dressing_general(matrix_ref_1h_1p_dressing_2h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,n_det_ref_1h_1p, &
psi_det_2h1p,psi_coef_2h1p,n_det_2h1p)
call provide_matrix_dressing_general(matrix_ref_1h_1p_dressing_1h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,n_det_ref_1h_1p, &
psi_det_1h1p,psi_coef_1h1p,n_det_1h1p)
do i = 1, n_det_ref_1h_1p
do j = 1, n_det_ref_1h_1p
matrix_ref_1h_1p(i,j) += matrix_ref_1h_1p_dressing_2h1p(i,j) + matrix_ref_1h_1p_dressing_1h1p(i,j)
enddo
enddo
allocate(eigenvectors(n_det_ref_1h_1p,n_det_ref_1h_1p), eigenvalues(n_det_ref_1h_1p))
call lapack_diag(eigenvalues,eigenvectors,matrix_ref_1h_1p,n_det_ref_1h_1p,n_det_ref_1h_1p)
!do j = 1, n_det_ref_1h_1p
! print*,'coef = ',eigenvectors(j,1)
!enddo
print*,''
print*,'-----------------------'
print*,'-----------------------'
print*,'e_dressed = ',eigenvalues(1)+nuclear_repulsion
print*,'-----------------------'
! Extract the
integer, allocatable :: index_generator(:)
integer :: n_det_generators_tmp,degree
n_det_generators_tmp = 0
allocate(index_generator(n_det_ref_1h_1p))
do i = 1, n_det_ref_1h_1p
do j = 1, N_det_generators
call get_excitation_degree(psi_det_generators(1,1,j),psi_det_ref_1h_1p(1,1,i), degree, N_int)
if(degree == 0)then
n_det_generators_tmp +=1
index_generator(n_det_generators_tmp) = i
endif
enddo
enddo
if(n_det_generators_tmp .ne. n_det_generators)then
print*,'PB !!!'
print*,'if(n_det_generators_tmp .ne. n_det_genrators)then'
stop
endif
do i = 1, N_det_generators
print*,'psi_coef_dressed = ',eigenvectors(index_generator(i),1)
do j = 1, N_det_generators
dressing_matrix_1h1p(i,j) += matrix_ref_1h_1p_dressing_1h1p(index_generator(i),index_generator(j))
dressing_matrix_2h1p(i,j) += matrix_ref_1h_1p_dressing_2h1p(index_generator(i),index_generator(j))
enddo
enddo
print*,'-----------------------'
print*,'-----------------------'
deallocate(matrix_ref_1h_1p)
deallocate(matrix_ref_1h_1p_dressing_1h1p)
deallocate(matrix_ref_1h_1p_dressing_2h1p)
deallocate(psi_det_ref_1h_1p, psi_coef_ref_1h_1p)
deallocate(psi_det_2h1p, psi_coef_2h1p)
deallocate(psi_det_1h1p, psi_coef_1h1p)
deallocate(eigenvectors,eigenvalues)
deallocate(index_generator)
!return
!
!integer(bit_kind), allocatable :: psi_ref_out(:,:,:)
!integer(bit_kind), allocatable :: psi_1h1p(:,:,:)
!integer(bit_kind), allocatable :: psi_2h1p(:,:,:)
!integer(bit_kind), allocatable :: psi_extra_1h_or_1p(:,:,:)
!double precision, allocatable :: psi_ref_coef_out(:,:)
!double precision, allocatable :: psi_coef_extra_1h_or_1p(:,:)
!call all_single_no_1h_or_1p
!call give_n_1h1p_and_n_2h1p_in_psi_det(i_hole,n_det_extra_1h_or_1p,n_det_1h1p,n_det_2h1p)
!allocate(psi_ref_out(N_int,2,N_det_generators))
!allocate(psi_1h1p(N_int,2,n_det_1h1p))
!allocate(psi_2h1p(N_int,2,n_det_2h1p))
!allocate(psi_extra_1h_or_1p(N_int,2,n_det_extra_1h_or_1p))
!allocate(psi_ref_coef_out(N_det_generators,N_states))
!allocate(psi_coef_1h1p(n_det_1h1p,N_states))
!allocate(psi_coef_2h1p(n_det_2h1p,N_states))
!allocate(psi_coef_extra_1h_or_1p(n_det_extra_1h_or_1p,N_states))
!call split_wf_generators_and_1h1p_and_2h1p(i_hole,n_det_extra_1h_or_1p,n_det_1h1p,n_det_2h1p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_2h1p,psi_coef_2h1p,psi_extra_1h_or_1p,psi_coef_extra_1h_or_1p)
!do i = 1, n_det_extra_1h_or_1p
! print*,'----'
! print*,'c = ',psi_coef_extra_1h_or_1p(i,1)
! call debug_det(psi_extra_1h_or_1p(1,1,i),N_int)
! print*,'----'
!enddo
!call provide_matrix_dressing_general(dressing_matrix_1h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
! psi_1h1p,psi_coef_1h1p,n_det_1h1p)
!print*,'Dressing 1h1p '
!do j =1, N_det_generators
! print*,' dressing ',dressing_matrix_1h1p(j,:)
!enddo
!call provide_matrix_dressing_general(dressing_matrix_2h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
! psi_2h1p,psi_coef_2h1p,n_det_2h1p)
!print*,'Dressing 2h1p '
!do j =1, N_det_generators
! print*,' dressing ',dressing_matrix_2h1p(j,:)
!enddo
!call provide_matrix_dressing_for_extra_1h_or_1p(dressing_matrix_extra_1h_or_1p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
! psi_extra_1h_or_1p,psi_coef_extra_1h_or_1p,n_det_extra_1h_or_1p)
!print*,',dressing_matrix_extra_1h_or_1p'
!do j =1, N_det_generators
! print*,' dressing ',dressing_matrix_extra_1h_or_1p(j,:)
!enddo
!deallocate(psi_ref_out)
!deallocate(psi_1h1p)
!deallocate(psi_2h1p)
!deallocate(psi_extra_1h_or_1p)
!deallocate(psi_ref_coef_out)
!deallocate(psi_coef_1h1p)
!deallocate(psi_coef_2h1p)
!deallocate(psi_coef_extra_1h_or_1p)
end end
@ -197,47 +480,56 @@ subroutine all_single_split_for_1p(dressing_matrix_1h1p,dressing_matrix_1h2p)
soft_touch n_det_max_jacobi soft_touch n_det_max_jacobi
end end
subroutine all_single_for_1p(dressing_matrix_1h1p,dressing_matrix_1h2p) ! subroutine all_single_for_1p(i_particl,dressing_matrix_1h1p,dressing_matrix_1h2p,dressing_matrix_extra_1h_or_1p)
implicit none ! implicit none
use bitmasks ! use bitmasks
double precision, intent(inout) :: dressing_matrix_1h1p(N_det_generators,N_det_generators) ! integer, intent(in ) :: i_particl
double precision, intent(inout) :: dressing_matrix_1h2p(N_det_generators,N_det_generators) ! double precision, intent(inout) :: dressing_matrix_1h1p(N_det_generators,N_det_generators)
integer :: i,i_hole ! double precision, intent(inout) :: dressing_matrix_1h2p(N_det_generators,N_det_generators)
n_det_max_jacobi = 50 ! double precision, intent(inout) :: dressing_matrix_extra_1h_or_1p(N_det_generators,N_det_generators)
soft_touch n_det_max_jacobi ! integer :: i
! n_det_max_jacobi = 50
integer :: n_det_1h1p,n_det_1h2p ! soft_touch n_det_max_jacobi
integer(bit_kind), allocatable :: psi_ref_out(:,:,:) !
integer(bit_kind), allocatable :: psi_1h1p(:,:,:) ! integer :: n_det_1h1p,n_det_1h2p,n_det_extra_1h_or_1p
integer(bit_kind), allocatable :: psi_1h2p(:,:,:) ! integer(bit_kind), allocatable :: psi_ref_out(:,:,:)
double precision, allocatable :: psi_ref_coef_out(:,:) ! integer(bit_kind), allocatable :: psi_1h1p(:,:,:)
double precision, allocatable :: psi_coef_1h1p(:,:) ! integer(bit_kind), allocatable :: psi_1h2p(:,:,:)
double precision, allocatable :: psi_coef_1h2p(:,:) ! integer(bit_kind), allocatable :: psi_extra_1h_or_1p(:,:,:)
call all_single_no_1h_or_1p_or_2p ! double precision, allocatable :: psi_ref_coef_out(:,:)
! double precision, allocatable :: psi_coef_1h1p(:,:)
threshold_davidson = 1.d-12 ! double precision, allocatable :: psi_coef_1h2p(:,:)
soft_touch threshold_davidson davidson_criterion ! double precision, allocatable :: psi_coef_extra_1h_or_1p(:,:)
call diagonalize_CI !!!!call all_single_no_1h_or_1p_or_2p
call give_n_1h1p_and_n_1h2p_in_psi_det(n_det_1h1p,n_det_1h2p) ! call all_single
allocate(psi_ref_out(N_int,2,N_det_generators)) !
allocate(psi_1h1p(N_int,2,n_det_1h1p)) ! threshold_davidson = 1.d-12
allocate(psi_1h2p(N_int,2,n_det_1h2p)) ! soft_touch threshold_davidson davidson_criterion
allocate(psi_ref_coef_out(N_det_generators,N_states)) ! call diagonalize_CI
allocate(psi_coef_1h1p(n_det_1h1p,N_states)) ! call give_n_1h1p_and_n_1h2p_in_psi_det(i_particl,n_det_extra_1h_or_1p,n_det_1h1p,n_det_1h2p)
allocate(psi_coef_1h2p(n_det_1h2p,N_states)) ! allocate(psi_ref_out(N_int,2,N_det_generators))
call split_wf_generators_and_1h1p_and_1h2p(n_det_1h1p,n_det_1h2p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_1h2p,psi_coef_1h2p) ! allocate(psi_1h1p(N_int,2,n_det_1h1p))
call provide_matrix_dressing_general(dressing_matrix_1h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, & ! allocate(psi_1h2p(N_int,2,n_det_1h2p))
psi_1h1p,psi_coef_1h1p,n_det_1h1p) ! allocate(psi_extra_1h_or_1p(N_int,2,n_det_extra_1h_or_1p))
call provide_matrix_dressing_general(dressing_matrix_1h2p,psi_ref_out,psi_ref_coef_out,N_det_generators, & ! allocate(psi_ref_coef_out(N_det_generators,N_states))
psi_1h2p,psi_coef_1h2p,n_det_1h2p) ! allocate(psi_coef_1h1p(n_det_1h1p,N_states))
! allocate(psi_coef_1h2p(n_det_1h2p,N_states))
deallocate(psi_ref_out) ! allocate(psi_coef_extra_1h_or_1p(n_det_extra_1h_or_1p,N_states))
deallocate(psi_1h1p) ! call split_wf_generators_and_1h1p_and_1h2p(i_particl,n_det_extra_1h_or_1p,n_det_1h1p,n_det_1h2p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_1h2p,psi_coef_1h2p,psi_extra_1h_or_1p,psi_coef_extra_1h_or_1p)
deallocate(psi_1h2p) ! call provide_matrix_dressing_general(dressing_matrix_1h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
deallocate(psi_ref_coef_out) ! psi_1h1p,psi_coef_1h1p,n_det_1h1p)
deallocate(psi_coef_1h1p) ! call provide_matrix_dressing_general(dressing_matrix_1h2p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
deallocate(psi_coef_1h2p) ! psi_1h2p,psi_coef_1h2p,n_det_1h2p)
! call provide_matrix_dressing_for_extra_1h_or_1p(dressing_matrix_extra_1h_or_1p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
end ! psi_extra_1h_or_1p,psi_coef_extra_1h_or_1p,n_det_extra_1h_or_1p)
!
! deallocate(psi_ref_out)
! deallocate(psi_1h1p)
! deallocate(psi_1h2p)
! deallocate(psi_ref_coef_out)
! deallocate(psi_coef_1h1p)
! deallocate(psi_coef_1h2p)
!
! end

View File

@ -0,0 +1,436 @@
use bitmasks
subroutine collect_lmct(hole_particle,n_couples)
implicit none
integer, intent(out) :: hole_particle(1000,2), n_couples
BEGIN_DOC
! Collect all the couple holes/particles of the important LMCT
! hole_particle(i,1) = ith hole
! hole_particle(i,2) = ith particle
! n_couples is the number of important excitations
END_DOC
print*,'COLLECTING THE PERTINENT LMCT (1h)'
double precision, allocatable :: tmp(:,:)
allocate(tmp(size(one_body_dm_mo_alpha_osoci,1),size(one_body_dm_mo_alpha_osoci,2)))
tmp = one_body_dm_mo_alpha_osoci + one_body_dm_mo_beta_osoci
integer :: i,j,iorb,jorb
n_couples = 0
do i = 1,n_act_orb
iorb = list_act(i)
do j = 1, n_inact_orb
jorb = list_inact(j)
if(dabs(tmp(iorb,jorb)).gt.1.d-2)then
n_couples +=1
hole_particle(n_couples,1) = jorb
hole_particle(n_couples,2) = iorb
print*,'DM'
print*,hole_particle(n_couples,1),hole_particle(n_couples,2),tmp(iorb,jorb)
endif
enddo
enddo
deallocate(tmp)
print*,'number of meaning full couples of holes/particles '
print*,'n_couples = ',n_couples
end
subroutine collect_mlct(hole_particle,n_couples)
implicit none
integer, intent(out) :: hole_particle(1000,2), n_couples
BEGIN_DOC
! Collect all the couple holes/particles of the important LMCT
! hole_particle(i,1) = ith hole
! hole_particle(i,2) = ith particle
! n_couples is the number of important excitations
END_DOC
print*,'COLLECTING THE PERTINENT MLCT (1p)'
double precision, allocatable :: tmp(:,:)
allocate(tmp(size(one_body_dm_mo_alpha_osoci,1),size(one_body_dm_mo_alpha_osoci,2)))
tmp = one_body_dm_mo_alpha_osoci + one_body_dm_mo_beta_osoci
integer :: i,j,iorb,jorb
n_couples = 0
do i = 1,n_act_orb
iorb = list_act(i)
do j = 1, n_virt_orb
jorb = list_virt(j)
if(dabs(tmp(iorb,jorb)).gt.1.d-3)then
n_couples +=1
hole_particle(n_couples,1) = iorb
hole_particle(n_couples,2) = jorb
print*,'DM'
print*,hole_particle(n_couples,1),hole_particle(n_couples,2),tmp(iorb,jorb)
endif
enddo
enddo
deallocate(tmp)
print*,'number of meaning full couples of holes/particles '
print*,'n_couples = ',n_couples
end
subroutine collect_lmct_mlct(hole_particle,n_couples)
implicit none
integer, intent(out) :: hole_particle(1000,2), n_couples
BEGIN_DOC
! Collect all the couple holes/particles of the important LMCT
! hole_particle(i,1) = ith hole
! hole_particle(i,2) = ith particle
! n_couples is the number of important excitations
END_DOC
double precision, allocatable :: tmp(:,:)
print*,'COLLECTING THE PERTINENT LMCT (1h)'
print*,'AND THE PERTINENT MLCT (1p)'
allocate(tmp(size(one_body_dm_mo_alpha_osoci,1),size(one_body_dm_mo_alpha_osoci,2)))
tmp = one_body_dm_mo_alpha_osoci + one_body_dm_mo_beta_osoci
integer :: i,j,iorb,jorb
n_couples = 0
do i = 1,n_act_orb
iorb = list_act(i)
do j = 1, n_inact_orb
jorb = list_inact(j)
if(dabs(tmp(iorb,jorb)).gt.threshold_lmct)then
n_couples +=1
hole_particle(n_couples,1) = jorb
hole_particle(n_couples,2) = iorb
print*,'DM'
print*,hole_particle(n_couples,1),hole_particle(n_couples,2),tmp(iorb,jorb)
endif
enddo
do j = 1, n_virt_orb
jorb = list_virt(j)
if(dabs(tmp(iorb,jorb)).gt.threshold_mlct)then
n_couples +=1
hole_particle(n_couples,1) = iorb
hole_particle(n_couples,2) = jorb
print*,'DM'
print*,hole_particle(n_couples,1),hole_particle(n_couples,2),tmp(iorb,jorb)
endif
enddo
enddo
deallocate(tmp)
print*,'number of meaning full couples of holes/particles '
print*,'n_couples = ',n_couples
end
subroutine collect_1h1p(hole_particle,n_couples)
implicit none
integer, intent(out) :: hole_particle(1000,2), n_couples
BEGIN_DOC
! Collect all the couple holes/particles of the important LMCT
! hole_particle(i,1) = ith hole
! hole_particle(i,2) = ith particle
! n_couples is the number of important excitations
END_DOC
double precision, allocatable :: tmp(:,:)
print*,'COLLECTING THE PERTINENT 1h1p'
allocate(tmp(size(one_body_dm_mo_alpha_osoci,1),size(one_body_dm_mo_alpha_osoci,2)))
tmp = one_body_dm_mo_alpha_osoci + one_body_dm_mo_beta_osoci
integer :: i,j,iorb,jorb
n_couples = 0
do i = 1,n_virt_orb
iorb = list_virt(i)
do j = 1, n_inact_orb
jorb = list_inact(j)
if(dabs(tmp(iorb,jorb)).gt.1.d-2)then
n_couples +=1
hole_particle(n_couples,1) = jorb
hole_particle(n_couples,2) = iorb
print*,'DM'
print*,hole_particle(n_couples,1),hole_particle(n_couples,2),tmp(iorb,jorb)
endif
enddo
enddo
deallocate(tmp)
print*,'number of meaning full couples of holes/particles '
print*,'n_couples = ',n_couples
end
subroutine set_lmct_to_generators_restart
implicit none
integer :: i,j,m,n,i_hole,i_particle
integer :: hole_particle(1000,2), n_couples
integer(bit_kind) :: key_tmp(N_int,2)
integer :: N_det_total,i_ok
call collect_lmct(hole_particle,n_couples)
call set_generators_to_generators_restart
N_det_total = N_det_generators_restart
do i = 1, n_couples
i_hole = hole_particle(i,1)
i_particle = hole_particle(i,2)
do m = 1, N_det_cas
do n = 1, N_int
key_tmp(n,1) = psi_cas(n,1,m)
key_tmp(n,2) = psi_cas(n,2,m)
enddo
! You excite the beta electron from i_hole to i_particle
print*,'i_hole,i_particle 2 = ',i_hole,i_particle
call do_mono_excitation(key_tmp,i_hole,i_particle,2,i_ok)
print*,'i_ok = ',i_ok
if(i_ok==1)then
N_det_total +=1
do n = 1, N_int
psi_det_generators(n,1,N_det_total) = key_tmp(n,1)
psi_det_generators(n,2,N_det_total) = key_tmp(n,2)
enddo
endif
do n = 1, N_int
key_tmp(n,1) = psi_cas(n,1,m)
key_tmp(n,2) = psi_cas(n,2,m)
enddo
! You excite the alpha electron from i_hole to i_particle
print*,'i_hole,i_particle 1 = ',i_hole,i_particle
call do_mono_excitation(key_tmp,i_hole,i_particle,1,i_ok)
print*,'i_ok = ',i_ok
if(i_ok==1)then
N_det_total +=1
do n = 1, N_int
psi_det_generators(n,1,N_det_total) = key_tmp(n,1)
psi_det_generators(n,2,N_det_total) = key_tmp(n,2)
enddo
endif
enddo
enddo
N_det_generators = N_det_total
do i = 1, N_det_generators
psi_coef_generators(i,1) = 1.d0/dsqrt(dble(N_det_total))
enddo
print*,'number of generators in total = ',N_det_generators
touch N_det_generators psi_coef_generators psi_det_generators
end
subroutine set_mlct_to_generators_restart
implicit none
integer :: i,j,m,n,i_hole,i_particle
integer :: hole_particle(1000,2), n_couples
integer(bit_kind) :: key_tmp(N_int,2)
integer :: N_det_total,i_ok
call collect_mlct(hole_particle,n_couples)
call set_generators_to_generators_restart
N_det_total = N_det_generators_restart
do i = 1, n_couples
i_hole = hole_particle(i,1)
i_particle = hole_particle(i,2)
do m = 1, N_det_cas
do n = 1, N_int
key_tmp(n,1) = psi_cas(n,1,m)
key_tmp(n,2) = psi_cas(n,2,m)
enddo
! You excite the beta electron from i_hole to i_particle
print*,'i_hole,i_particle 2 = ',i_hole,i_particle
call do_mono_excitation(key_tmp,i_hole,i_particle,2,i_ok)
print*,'i_ok = ',i_ok
if(i_ok==1)then
N_det_total +=1
do n = 1, N_int
psi_det_generators(n,1,N_det_total) = key_tmp(n,1)
psi_det_generators(n,2,N_det_total) = key_tmp(n,2)
enddo
endif
do n = 1, N_int
key_tmp(n,1) = psi_cas(n,1,m)
key_tmp(n,2) = psi_cas(n,2,m)
enddo
! You excite the alpha electron from i_hole to i_particle
print*,'i_hole,i_particle 1 = ',i_hole,i_particle
call do_mono_excitation(key_tmp,i_hole,i_particle,1,i_ok)
print*,'i_ok = ',i_ok
if(i_ok==1)then
N_det_total +=1
do n = 1, N_int
psi_det_generators(n,1,N_det_total) = key_tmp(n,1)
psi_det_generators(n,2,N_det_total) = key_tmp(n,2)
enddo
endif
enddo
enddo
N_det_generators = N_det_total
do i = 1, N_det_generators
psi_coef_generators(i,1) = 1.d0/dsqrt(dble(N_det_total))
enddo
print*,'number of generators in total = ',N_det_generators
touch N_det_generators psi_coef_generators psi_det_generators
end
subroutine set_lmct_mlct_to_generators_restart
implicit none
integer :: i,j,m,n,i_hole,i_particle
integer :: hole_particle(1000,2), n_couples
integer(bit_kind) :: key_tmp(N_int,2)
integer :: N_det_total,i_ok
call collect_lmct_mlct(hole_particle,n_couples)
call set_generators_to_generators_restart
N_det_total = N_det_generators_restart
do i = 1, n_couples
i_hole = hole_particle(i,1)
i_particle = hole_particle(i,2)
do m = 1, N_det_cas
do n = 1, N_int
key_tmp(n,1) = psi_cas(n,1,m)
key_tmp(n,2) = psi_cas(n,2,m)
enddo
! You excite the beta electron from i_hole to i_particle
call do_mono_excitation(key_tmp,i_hole,i_particle,2,i_ok)
if(i_ok==1)then
N_det_total +=1
do n = 1, N_int
psi_det_generators(n,1,N_det_total) = key_tmp(n,1)
psi_det_generators(n,2,N_det_total) = key_tmp(n,2)
enddo
endif
do n = 1, N_int
key_tmp(n,1) = psi_cas(n,1,m)
key_tmp(n,2) = psi_cas(n,2,m)
enddo
! You excite the alpha electron from i_hole to i_particle
call do_mono_excitation(key_tmp,i_hole,i_particle,1,i_ok)
if(i_ok==1)then
N_det_total +=1
do n = 1, N_int
psi_det_generators(n,1,N_det_total) = key_tmp(n,1)
psi_det_generators(n,2,N_det_total) = key_tmp(n,2)
enddo
endif
enddo
enddo
N_det_generators = N_det_total
do i = 1, N_det_generators
psi_coef_generators(i,1) = 1.d0/dsqrt(dble(N_det_total))
enddo
print*,'number of generators in total = ',N_det_generators
touch N_det_generators psi_coef_generators psi_det_generators
end
subroutine set_lmct_mlct_to_psi_det
implicit none
integer :: i,j,m,n,i_hole,i_particle
integer :: hole_particle(1000,2), n_couples
integer(bit_kind) :: key_tmp(N_int,2)
integer :: N_det_total,i_ok
call collect_lmct_mlct(hole_particle,n_couples)
call set_psi_det_to_generators_restart
N_det_total = N_det_generators_restart
do i = 1, n_couples
i_hole = hole_particle(i,1)
i_particle = hole_particle(i,2)
do m = 1, N_det_generators_restart
do n = 1, N_int
key_tmp(n,1) = psi_det_generators_restart(n,1,m)
key_tmp(n,2) = psi_det_generators_restart(n,2,m)
enddo
! You excite the beta electron from i_hole to i_particle
call do_mono_excitation(key_tmp,i_hole,i_particle,2,i_ok)
if(i_ok==1)then
N_det_total +=1
do n = 1, N_int
psi_det(n,1,N_det_total) = key_tmp(n,1)
psi_det(n,2,N_det_total) = key_tmp(n,2)
enddo
endif
do n = 1, N_int
key_tmp(n,1) = psi_det_generators_restart(n,1,m)
key_tmp(n,2) = psi_det_generators_restart(n,2,m)
enddo
! You excite the alpha electron from i_hole to i_particle
call do_mono_excitation(key_tmp,i_hole,i_particle,1,i_ok)
if(i_ok==1)then
N_det_total +=1
do n = 1, N_int
psi_det(n,1,N_det_total) = key_tmp(n,1)
psi_det(n,2,N_det_total) = key_tmp(n,2)
enddo
endif
enddo
enddo
N_det = N_det_total
integer :: k
do k = 1, N_states
do i = 1, N_det
psi_coef(i,k) = 1.d0/dsqrt(dble(N_det_total))
enddo
enddo
SOFT_TOUCH N_det psi_det psi_coef
logical :: found_duplicates
call remove_duplicates_in_psi_det(found_duplicates)
end
subroutine set_1h1p_to_psi_det
implicit none
integer :: i,j,m,n,i_hole,i_particle
integer :: hole_particle(1000,2), n_couples
integer(bit_kind) :: key_tmp(N_int,2)
integer :: N_det_total,i_ok
call collect_1h1p(hole_particle,n_couples)
call set_psi_det_to_generators_restart
N_det_total = N_det_generators_restart
do i = 1, n_couples
i_hole = hole_particle(i,1)
i_particle = hole_particle(i,2)
do m = 1, N_det_generators_restart
do n = 1, N_int
key_tmp(n,1) = psi_det_generators_restart(n,1,m)
key_tmp(n,2) = psi_det_generators_restart(n,2,m)
enddo
! You excite the beta electron from i_hole to i_particle
call do_mono_excitation(key_tmp,i_hole,i_particle,2,i_ok)
if(i_ok==1)then
N_det_total +=1
do n = 1, N_int
psi_det(n,1,N_det_total) = key_tmp(n,1)
psi_det(n,2,N_det_total) = key_tmp(n,2)
enddo
endif
do n = 1, N_int
key_tmp(n,1) = psi_det_generators_restart(n,1,m)
key_tmp(n,2) = psi_det_generators_restart(n,2,m)
enddo
! You excite the alpha electron from i_hole to i_particle
call do_mono_excitation(key_tmp,i_hole,i_particle,1,i_ok)
if(i_ok==1)then
N_det_total +=1
do n = 1, N_int
psi_det(n,1,N_det_total) = key_tmp(n,1)
psi_det(n,2,N_det_total) = key_tmp(n,2)
enddo
endif
enddo
enddo
N_det = N_det_total
integer :: k
do k = 1, N_states
do i = 1, N_det
psi_coef(i,k) = 1.d0/dsqrt(dble(N_det_total))
enddo
enddo
SOFT_TOUCH N_det psi_det psi_coef
logical :: found_duplicates
call remove_duplicates_in_psi_det(found_duplicates)
end

View File

@ -0,0 +1,425 @@
BEGIN_PROVIDER [double precision, corr_energy_2h2p_per_orb_ab, (mo_tot_num)]
&BEGIN_PROVIDER [double precision, corr_energy_2h2p_ab_2_orb, (mo_tot_num,mo_tot_num)]
&BEGIN_PROVIDER [double precision, corr_energy_2h2p_bb_2_orb, (mo_tot_num,mo_tot_num)]
&BEGIN_PROVIDER [double precision, corr_energy_2h2p_for_1h1p_a, (mo_tot_num,mo_tot_num)]
&BEGIN_PROVIDER [double precision, corr_energy_2h2p_for_1h1p_b, (mo_tot_num,mo_tot_num)]
&BEGIN_PROVIDER [double precision, corr_energy_2h2p_for_1h1p_double, (mo_tot_num,mo_tot_num)]
&BEGIN_PROVIDER [double precision, corr_energy_2h2p_per_orb_aa, (mo_tot_num)]
&BEGIN_PROVIDER [double precision, corr_energy_2h2p_per_orb_bb, (mo_tot_num)]
&BEGIN_PROVIDER [ double precision, total_corr_e_2h2p]
use bitmasks
print*,''
print*,'Providing the 2h2p correlation energy'
print*,''
implicit none
integer(bit_kind) :: key_tmp(N_int,2)
integer :: i,j,k,l
integer :: i_hole,j_hole,k_part,l_part
double precision :: get_mo_bielec_integral_schwartz,hij,delta_e,exc,contrib
double precision :: diag_H_mat_elem
integer :: i_ok,ispin
! Alpha - Beta correlation energy
total_corr_e_2h2p = 0.d0
corr_energy_2h2p_ab_2_orb = 0.d0
corr_energy_2h2p_bb_2_orb = 0.d0
corr_energy_2h2p_per_orb_ab = 0.d0
corr_energy_2h2p_per_orb_aa = 0.d0
corr_energy_2h2p_per_orb_bb = 0.d0
corr_energy_2h2p_for_1h1p_a = 0.d0
corr_energy_2h2p_for_1h1p_b = 0.d0
corr_energy_2h2p_for_1h1p_double = 0.d0
do i = 1, n_inact_orb ! beta
i_hole = list_inact(i)
do k = 1, n_virt_orb ! beta
k_part = list_virt(k)
do j = 1, n_inact_orb ! alpha
j_hole = list_inact(j)
do l = 1, n_virt_orb ! alpha
l_part = list_virt(l)
key_tmp = ref_bitmask
ispin = 2
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
if(i_ok .ne.1)cycle
ispin = 1
call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok)
if(i_ok .ne.1)cycle
delta_e = (ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
contrib = hij*hij/delta_e
total_corr_e_2h2p += contrib
! Single orbital contribution
corr_energy_2h2p_per_orb_ab(i_hole) += contrib
corr_energy_2h2p_per_orb_ab(k_part) += contrib
! Couple of orbital contribution for the single 1h1p
corr_energy_2h2p_for_1h1p_a(j_hole,l_part) += contrib
corr_energy_2h2p_for_1h1p_a(l_part,j_hole) += contrib
corr_energy_2h2p_for_1h1p_b(j_hole,l_part) += contrib
corr_energy_2h2p_for_1h1p_b(l_part,j_hole) += contrib
! Couple of orbital contribution for the double 1h1p
corr_energy_2h2p_for_1h1p_double(i_hole,l_part) += contrib
corr_energy_2h2p_for_1h1p_double(l_part,i_hole) += contrib
corr_energy_2h2p_ab_2_orb(i_hole,j_hole) += contrib
corr_energy_2h2p_ab_2_orb(j_hole,i_hole) += contrib
corr_energy_2h2p_ab_2_orb(i_hole,k_part) += contrib
corr_energy_2h2p_ab_2_orb(k_part,i_hole) += contrib
corr_energy_2h2p_ab_2_orb(k_part,l_part) += contrib
corr_energy_2h2p_ab_2_orb(l_part,k_part) += contrib
enddo
enddo
enddo
enddo
! alpha alpha correlation energy
do i = 1, n_inact_orb
i_hole = list_inact(i)
do j = i+1, n_inact_orb
j_hole = list_inact(j)
do k = 1, n_virt_orb
k_part = list_virt(k)
do l = k+1,n_virt_orb
l_part = list_virt(l)
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map)
key_tmp = ref_bitmask
ispin = 1
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
if(i_ok .ne.1)cycle
ispin = 1
call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok)
if(i_ok .ne.1)cycle
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
hij = hij - exc
contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij))
total_corr_e_2h2p += contrib
! Single orbital contribution
corr_energy_2h2p_per_orb_aa(i_hole) += contrib
corr_energy_2h2p_per_orb_aa(k_part) += contrib
! Couple of orbital contribution for the single 1h1p
corr_energy_2h2p_for_1h1p_a(i_hole,k_part) += contrib
corr_energy_2h2p_for_1h1p_a(k_part,i_hole) += contrib
enddo
enddo
enddo
enddo
! beta beta correlation energy
do i = 1, n_inact_orb
i_hole = list_inact(i)
do j = i+1, n_inact_orb
j_hole = list_inact(j)
do k = 1, n_virt_orb
k_part = list_virt(k)
do l = k+1,n_virt_orb
l_part = list_virt(l)
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map)
key_tmp = ref_bitmask
ispin = 2
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
if(i_ok .ne.1)cycle
ispin = 2
call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok)
if(i_ok .ne.1)cycle
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
hij = hij - exc
contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij))
total_corr_e_2h2p += contrib
! Single orbital contribution
corr_energy_2h2p_per_orb_bb(i_hole) += contrib
corr_energy_2h2p_per_orb_bb(k_part) += contrib
corr_energy_2h2p_for_1h1p_b(i_hole,k_part) += contrib
corr_energy_2h2p_for_1h1p_b(k_part,i_hole) += contrib
! Two particle correlation energy
corr_energy_2h2p_bb_2_orb(i_hole,j_hole) += contrib
corr_energy_2h2p_bb_2_orb(j_hole,i_hole) += contrib
corr_energy_2h2p_bb_2_orb(i_hole,k_part) += contrib
corr_energy_2h2p_bb_2_orb(k_part,i_hole) += contrib
corr_energy_2h2p_bb_2_orb(k_part,l_part) += contrib
corr_energy_2h2p_bb_2_orb(l_part,k_part) += contrib
enddo
enddo
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [double precision, corr_energy_2h1p_ab_bb_per_2_orb, (mo_tot_num,mo_tot_num)]
&BEGIN_PROVIDER [double precision, corr_energy_2h1p_for_1h1p_a, (mo_tot_num,mo_tot_num)]
&BEGIN_PROVIDER [double precision, corr_energy_2h1p_for_1h1p_b, (mo_tot_num,mo_tot_num)]
&BEGIN_PROVIDER [double precision, corr_energy_2h1p_for_1h1p_double, (mo_tot_num,mo_tot_num)]
&BEGIN_PROVIDER [double precision, corr_energy_2h1p_per_orb_ab, (mo_tot_num)]
&BEGIN_PROVIDER [double precision, corr_energy_2h1p_per_orb_aa, (mo_tot_num)]
&BEGIN_PROVIDER [double precision, corr_energy_2h1p_per_orb_bb, (mo_tot_num)]
&BEGIN_PROVIDER [ double precision, total_corr_e_2h1p]
use bitmasks
implicit none
integer(bit_kind) :: key_tmp(N_int,2)
integer :: i,j,k,l
integer :: i_hole,j_hole,k_part,l_part
double precision :: get_mo_bielec_integral_schwartz,hij,delta_e,exc,contrib
double precision :: diag_H_mat_elem
integer :: i_ok,ispin
! Alpha - Beta correlation energy
total_corr_e_2h1p = 0.d0
corr_energy_2h1p_per_orb_ab = 0.d0
corr_energy_2h1p_per_orb_aa = 0.d0
corr_energy_2h1p_per_orb_bb = 0.d0
corr_energy_2h1p_ab_bb_per_2_orb = 0.d0
corr_energy_2h1p_for_1h1p_a = 0.d0
corr_energy_2h1p_for_1h1p_b = 0.d0
corr_energy_2h1p_for_1h1p_double = 0.d0
do i = 1, n_inact_orb
i_hole = list_inact(i)
do k = 1, n_act_orb
k_part = list_act(k)
do j = 1, n_inact_orb
j_hole = list_inact(j)
do l = 1, n_virt_orb
l_part = list_virt(l)
key_tmp = ref_bitmask
ispin = 2
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
if(i_ok .ne.1)cycle
ispin = 1
call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok)
if(i_ok .ne.1)cycle
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij))
total_corr_e_2h1p += contrib
corr_energy_2h1p_ab_bb_per_2_orb(i_hole,j_hole) += contrib
corr_energy_2h1p_per_orb_ab(i_hole) += contrib
corr_energy_2h1p_per_orb_ab(l_part) += contrib
enddo
enddo
enddo
enddo
! Alpha Alpha spin correlation energy
do i = 1, n_inact_orb
i_hole = list_inact(i)
do j = i+1, n_inact_orb
j_hole = list_inact(j)
do k = 1, n_act_orb
k_part = list_act(k)
do l = 1,n_virt_orb
l_part = list_virt(l)
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map)
key_tmp = ref_bitmask
ispin = 1
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
if(i_ok .ne.1)cycle
ispin = 1
call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok)
if(i_ok .ne.1)cycle
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
hij = hij - exc
contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij))
total_corr_e_2h1p += contrib
corr_energy_2h1p_per_orb_aa(i_hole) += contrib
corr_energy_2h1p_per_orb_aa(l_part) += contrib
enddo
enddo
enddo
enddo
! Beta Beta correlation energy
do i = 1, n_inact_orb
i_hole = list_inact(i)
do j = i+1, n_inact_orb
j_hole = list_inact(j)
do k = 1, n_act_orb
k_part = list_act(k)
do l = 1,n_virt_orb
l_part = list_virt(l)
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map)
key_tmp = ref_bitmask
ispin = 2
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
if(i_ok .ne.1)cycle
ispin = 2
call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok)
if(i_ok .ne.1)cycle
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
hij = hij - exc
contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij))
corr_energy_2h1p_ab_bb_per_2_orb(i_hole,j_hole) += contrib
total_corr_e_2h1p += contrib
corr_energy_2h1p_per_orb_bb(i_hole) += contrib
corr_energy_2h1p_per_orb_aa(l_part) += contrib
enddo
enddo
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [double precision, corr_energy_1h2p_per_orb_ab, (mo_tot_num)]
&BEGIN_PROVIDER [double precision, corr_energy_1h2p_two_orb, (mo_tot_num,mo_tot_num)]
&BEGIN_PROVIDER [double precision, corr_energy_1h2p_per_orb_aa, (mo_tot_num)]
&BEGIN_PROVIDER [double precision, corr_energy_1h2p_per_orb_bb, (mo_tot_num)]
&BEGIN_PROVIDER [ double precision, total_corr_e_1h2p]
use bitmasks
implicit none
integer(bit_kind) :: key_tmp(N_int,2)
integer :: i,j,k,l
integer :: i_hole,j_hole,k_part,l_part
double precision :: get_mo_bielec_integral_schwartz,hij,delta_e,exc,contrib
double precision :: diag_H_mat_elem
integer :: i_ok,ispin
! Alpha - Beta correlation energy
total_corr_e_1h2p = 0.d0
corr_energy_1h2p_per_orb_ab = 0.d0
corr_energy_1h2p_per_orb_aa = 0.d0
corr_energy_1h2p_per_orb_bb = 0.d0
do i = 1, n_virt_orb
i_hole = list_virt(i)
do k = 1, n_act_orb
k_part = list_act(k)
do j = 1, n_inact_orb
j_hole = list_inact(j)
do l = 1, n_virt_orb
l_part = list_virt(l)
key_tmp = ref_bitmask
ispin = 2
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
if(i_ok .ne.1)cycle
ispin = 1
call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok)
if(i_ok .ne.1)cycle
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij))
total_corr_e_1h2p += contrib
corr_energy_1h2p_per_orb_ab(i_hole) += contrib
corr_energy_1h2p_per_orb_ab(j_hole) += contrib
corr_energy_1h2p_two_orb(k_part,l_part) += contrib
corr_energy_1h2p_two_orb(l_part,k_part) += contrib
enddo
enddo
enddo
enddo
! Alpha Alpha correlation energy
do i = 1, n_virt_orb
i_hole = list_virt(i)
do j = 1, n_inact_orb
j_hole = list_inact(j)
do k = 1, n_act_orb
k_part = list_act(k)
do l = i+1,n_virt_orb
l_part = list_virt(l)
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map)
key_tmp = ref_bitmask
ispin = 1
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
if(i_ok .ne.1)cycle
ispin = 1
call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok)
if(i_ok .ne.1)cycle
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
hij = hij - exc
contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij))
total_corr_e_1h2p += contrib
corr_energy_1h2p_per_orb_aa(i_hole) += contrib
corr_energy_1h2p_per_orb_ab(j_hole) += contrib
corr_energy_1h2p_two_orb(k_part,l_part) += contrib
corr_energy_1h2p_two_orb(l_part,k_part) += contrib
enddo
enddo
enddo
enddo
! Beta Beta correlation energy
do i = 1, n_virt_orb
i_hole = list_virt(i)
do j = 1, n_inact_orb
j_hole = list_inact(j)
do k = 1, n_act_orb
k_part = list_act(k)
do l = i+1,n_virt_orb
l_part = list_virt(l)
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map)
key_tmp = ref_bitmask
ispin = 2
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
if(i_ok .ne.1)cycle
ispin = 2
call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok)
if(i_ok .ne.1)cycle
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
hij = hij - exc
contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij))
total_corr_e_1h2p += contrib
corr_energy_1h2p_per_orb_bb(i_hole) += contrib
corr_energy_1h2p_per_orb_ab(j_hole) += contrib
corr_energy_1h2p_two_orb(k_part,l_part) += contrib
corr_energy_1h2p_two_orb(l_part,k_part) += contrib
enddo
enddo
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [double precision, corr_energy_1h1p_spin_flip_per_orb, (mo_tot_num)]
&BEGIN_PROVIDER [ double precision, total_corr_e_1h1p_spin_flip]
use bitmasks
implicit none
integer(bit_kind) :: key_tmp(N_int,2)
integer :: i,j,k,l
integer :: i_hole,j_hole,k_part,l_part
double precision :: get_mo_bielec_integral_schwartz,hij,delta_e,exc,contrib
double precision :: diag_H_mat_elem
integer :: i_ok,ispin
! Alpha - Beta correlation energy
total_corr_e_1h1p_spin_flip = 0.d0
corr_energy_1h1p_spin_flip_per_orb = 0.d0
do i = 1, n_inact_orb
i_hole = list_inact(i)
do k = 1, n_act_orb
k_part = list_act(k)
do j = 1, n_act_orb
j_hole = list_act(j)
do l = 1, n_virt_orb
l_part = list_virt(l)
key_tmp = ref_bitmask
ispin = 2
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
if(i_ok .ne.1)cycle
ispin = 1
call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok)
if(i_ok .ne.1)cycle
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij))
total_corr_e_1h1p_spin_flip += contrib
corr_energy_1h1p_spin_flip_per_orb(i_hole) += contrib
enddo
enddo
enddo
enddo
END_PROVIDER

View File

@ -3,6 +3,7 @@ subroutine diag_inactive_virt_and_update_mos
integer :: i,j,i_inact,j_inact,i_virt,j_virt integer :: i,j,i_inact,j_inact,i_virt,j_virt
double precision :: tmp(mo_tot_num_align,mo_tot_num) double precision :: tmp(mo_tot_num_align,mo_tot_num)
character*(64) :: label character*(64) :: label
print*,'Diagonalizing the occ and virt Fock operator'
tmp = 0.d0 tmp = 0.d0
do i = 1, mo_tot_num do i = 1, mo_tot_num
tmp(i,i) = Fock_matrix_mo(i,i) tmp(i,i) = Fock_matrix_mo(i,i)
@ -33,3 +34,50 @@ subroutine diag_inactive_virt_and_update_mos
end end
subroutine diag_inactive_virt_new_and_update_mos
implicit none
integer :: i,j,i_inact,j_inact,i_virt,j_virt,k,k_act
double precision :: tmp(mo_tot_num_align,mo_tot_num),accu,get_mo_bielec_integral_schwartz
character*(64) :: label
tmp = 0.d0
do i = 1, mo_tot_num
tmp(i,i) = Fock_matrix_mo(i,i)
enddo
do i = 1, n_inact_orb
i_inact = list_inact(i)
do j = i+1, n_inact_orb
j_inact = list_inact(j)
accu =0.d0
do k = 1, n_act_orb
k_act = list_act(k)
accu += get_mo_bielec_integral_schwartz(i_inact,k_act,j_inact,k_act,mo_integrals_map)
accu -= get_mo_bielec_integral_schwartz(i_inact,k_act,k_act,j_inact,mo_integrals_map)
enddo
tmp(i_inact,j_inact) = Fock_matrix_mo(i_inact,j_inact) + accu
tmp(j_inact,i_inact) = Fock_matrix_mo(j_inact,i_inact) + accu
enddo
enddo
do i = 1, n_virt_orb
i_virt = list_virt(i)
do j = i+1, n_virt_orb
j_virt = list_virt(j)
accu =0.d0
do k = 1, n_act_orb
k_act = list_act(k)
accu += get_mo_bielec_integral_schwartz(i_virt,k_act,j_virt,k_act,mo_integrals_map)
enddo
tmp(i_virt,j_virt) = Fock_matrix_mo(i_virt,j_virt) - accu
tmp(j_virt,i_virt) = Fock_matrix_mo(j_virt,i_virt) - accu
enddo
enddo
label = "Canonical"
call mo_as_eigvectors_of_mo_matrix(tmp,size(tmp,1),size(tmp,2),label,1)
soft_touch mo_coef
end

View File

@ -58,24 +58,24 @@ subroutine standard_dress(delta_ij_generators_,size_buffer,Ndet_generators,i_gen
call i_h_j(det_buffer(1,1,i),det_buffer(1,1,i),Nint,haa) call i_h_j(det_buffer(1,1,i),det_buffer(1,1,i),Nint,haa)
f = 1.d0/(E_ref-haa) f = 1.d0/(E_ref-haa)
if(second_order_h)then ! if(second_order_h)then
lambda_i = f lambda_i = f
else ! else
! You write the new Hamiltonian matrix ! ! You write the new Hamiltonian matrix
do k = 1, Ndet_generators ! do k = 1, Ndet_generators
H_matrix_tmp(k,Ndet_generators+1) = H_array(k) ! H_matrix_tmp(k,Ndet_generators+1) = H_array(k)
H_matrix_tmp(Ndet_generators+1,k) = H_array(k) ! H_matrix_tmp(Ndet_generators+1,k) = H_array(k)
enddo ! enddo
H_matrix_tmp(Ndet_generators+1,Ndet_generators+1) = haa ! H_matrix_tmp(Ndet_generators+1,Ndet_generators+1) = haa
! Then diagonalize it ! ! Then diagonalize it
call lapack_diag(eigenvalues,eigenvectors,H_matrix_tmp,Ndet_generators+1,Ndet_generators+1) ! call lapack_diag(eigenvalues,eigenvectors,H_matrix_tmp,Ndet_generators+1,Ndet_generators+1)
! Then you extract the effective denominator ! ! Then you extract the effective denominator
accu = 0.d0 ! accu = 0.d0
do k = 1, Ndet_generators ! do k = 1, Ndet_generators
accu += eigenvectors(k,1) * H_array(k) ! accu += eigenvectors(k,1) * H_array(k)
enddo ! enddo
lambda_i = eigenvectors(Ndet_generators+1,1)/accu ! lambda_i = eigenvectors(Ndet_generators+1,1)/accu
endif ! endif
do k=1,idx(0) do k=1,idx(0)
contrib = H_array(idx(k)) * H_array(idx(k)) * lambda_i contrib = H_array(idx(k)) * H_array(idx(k)) * lambda_i
delta_ij_generators_(idx(k), idx(k)) += contrib delta_ij_generators_(idx(k), idx(k)) += contrib
@ -85,33 +85,6 @@ subroutine standard_dress(delta_ij_generators_,size_buffer,Ndet_generators,i_gen
delta_ij_generators_(idx(j), idx(k)) += contrib delta_ij_generators_(idx(j), idx(k)) += contrib
enddo enddo
enddo enddo
! H_matrix_tmp_bis(idx(k),idx(k)) += contrib
! H_matrix_tmp_bis(idx(k),idx(j)) += contrib
! H_matrix_tmp_bis(idx(j),idx(k)) += contrib
! do k = 1, Ndet_generators
! do j = 1, Ndet_generators
! H_matrix_tmp_bis(k,j) = H_matrix_tmp(k,j)
! enddo
! enddo
! double precision :: H_matrix_tmp_bis(Ndet_generators,Ndet_generators)
! double precision :: eigenvectors_bis(Ndet_generators,Ndet_generators), eigenvalues_bis(Ndet_generators)
! call lapack_diag(eigenvalues_bis,eigenvectors_bis,H_matrix_tmp_bis,Ndet_generators,Ndet_generators)
! print*,'f,lambda_i = ',f,lambda_i
! print*,'eigenvalues_bi(1)',eigenvalues_bis(1)
! print*,'eigenvalues ',eigenvalues(1)
! do k = 1, Ndet_generators
! print*,'coef,coef_dres = ', eigenvectors(k,1), eigenvectors_bis(k,1)
! enddo
! pause
! accu = 0.d0
! do k = 1, Ndet_generators
! do j = 1, Ndet_generators
! accu += eigenvectors(k,1) * eigenvectors(j,1) * (H_matrix_tmp(k,j) + delta_ij_generators_(k,j))
! enddo
! enddo
! print*,'accu,eigv = ',accu,eigenvalues(1)
! pause
enddo enddo
end end

View File

@ -0,0 +1,59 @@
program foboscf
implicit none
call run_prepare
no_oa_or_av_opt = .True.
touch no_oa_or_av_opt
call routine_fobo_scf
call save_mos
end
subroutine run_prepare
implicit none
no_oa_or_av_opt = .False.
touch no_oa_or_av_opt
call damping_SCF
call diag_inactive_virt_and_update_mos
end
subroutine routine_fobo_scf
implicit none
integer :: i,j
print*,''
print*,''
character*(64) :: label
label = "Natural"
do i = 1, 5
print*,'*******************************************************************************'
print*,'*******************************************************************************'
print*,'FOBO-SCF Iteration ',i
print*,'*******************************************************************************'
print*,'*******************************************************************************'
if(speed_up_convergence_foboscf)then
if(i==3)then
threshold_lmct = max(threshold_lmct,0.001)
threshold_mlct = max(threshold_mlct,0.05)
soft_touch threshold_lmct threshold_mlct
endif
if(i==4)then
threshold_lmct = max(threshold_lmct,0.005)
threshold_mlct = max(threshold_mlct,0.07)
soft_touch threshold_lmct threshold_mlct
endif
if(i==5)then
threshold_lmct = max(threshold_lmct,0.01)
threshold_mlct = max(threshold_mlct,0.1)
soft_touch threshold_lmct threshold_mlct
endif
endif
call FOBOCI_lmct_mlct_old_thr
call save_osoci_natural_mos
call damping_SCF
call diag_inactive_virt_and_update_mos
call clear_mo_map
call provide_properties
enddo
end

View File

@ -9,12 +9,9 @@ subroutine FOBOCI_lmct_mlct_old_thr
double precision :: norm_tmp(N_states),norm_total(N_states) double precision :: norm_tmp(N_states),norm_total(N_states)
logical :: test_sym logical :: test_sym
double precision :: thr,hij double precision :: thr,hij
double precision :: threshold
double precision, allocatable :: dressing_matrix(:,:) double precision, allocatable :: dressing_matrix(:,:)
logical :: verbose,is_ok logical :: verbose,is_ok
verbose = .True. verbose = .True.
threshold = threshold_singles
print*,'threshold = ',threshold
thr = 1.d-12 thr = 1.d-12
allocate(unpaired_bitmask(N_int,2)) allocate(unpaired_bitmask(N_int,2))
allocate (occ(N_int*bit_kind_size,2)) allocate (occ(N_int*bit_kind_size,2))
@ -36,7 +33,14 @@ subroutine FOBOCI_lmct_mlct_old_thr
print*,'' print*,''
print*,'' print*,''
print*,'DOING FIRST LMCT !!' print*,'DOING FIRST LMCT !!'
print*,'Threshold_lmct = ',threshold_lmct
integer(bit_kind) , allocatable :: zero_bitmask(:,:)
integer(bit_kind) , allocatable :: psi_singles(:,:,:)
logical :: lmct
double precision, allocatable :: psi_singles_coef(:,:)
allocate( zero_bitmask(N_int,2) )
do i = 1, n_inact_orb do i = 1, n_inact_orb
lmct = .True.
integer :: i_hole_osoci integer :: i_hole_osoci
i_hole_osoci = list_inact(i) i_hole_osoci = list_inact(i)
print*,'--------------------------' print*,'--------------------------'
@ -51,27 +55,91 @@ subroutine FOBOCI_lmct_mlct_old_thr
print*,'Passed set generators' print*,'Passed set generators'
call set_bitmask_particl_as_input(reunion_of_bitmask) call set_bitmask_particl_as_input(reunion_of_bitmask)
call set_bitmask_hole_as_input(reunion_of_bitmask) call set_bitmask_hole_as_input(reunion_of_bitmask)
call is_a_good_candidate(threshold,is_ok,verbose) call is_a_good_candidate(threshold_lmct,is_ok,verbose)
print*,'is_ok = ',is_ok print*,'is_ok = ',is_ok
if(.not.is_ok)cycle if(.not.is_ok)cycle
! so all the mono excitation on the new generators
allocate(dressing_matrix(N_det_generators,N_det_generators)) allocate(dressing_matrix(N_det_generators,N_det_generators))
dressing_matrix = 0.d0
if(.not.do_it_perturbative)then if(.not.do_it_perturbative)then
! call all_single
dressing_matrix = 0.d0
do k = 1, N_det_generators do k = 1, N_det_generators
do l = 1, N_det_generators do l = 1, N_det_generators
call i_h_j(psi_det_generators(1,1,k),psi_det_generators(1,1,l),N_int,hkl) call i_h_j(psi_det_generators(1,1,k),psi_det_generators(1,1,l),N_int,hkl)
dressing_matrix(k,l) = hkl dressing_matrix(k,l) = hkl
enddo enddo
enddo enddo
double precision :: hkl hkl = dressing_matrix(1,1)
! call all_single_split(psi_det_generators,psi_coef_generators,N_det_generators,dressing_matrix) do k = 1, N_det_generators
! call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix) dressing_matrix(k,k) = dressing_matrix(k,k) - hkl
call debug_det(reunion_of_bitmask,N_int) enddo
print*,'Naked matrix'
do k = 1, N_det_generators
write(*,'(100(F12.5,X))')dressing_matrix(k,:)
enddo
! Do all the single excitations on top of the CAS and 1h determinants
call set_bitmask_particl_as_input(reunion_of_bitmask)
call set_bitmask_hole_as_input(reunion_of_bitmask)
call all_single call all_single
! if(dressing_2h2p)then
! call diag_dressed_2h2p_hamiltonian_and_update_psi_det(i_hole_osoci,lmct)
! endif
! ! Change the mask of the holes and particles to perform all the
! ! double excitations that starts from the active space in order
! ! to introduce the Coulomb hole in the active space
! ! These are the 1h2p excitations that have the i_hole_osoci hole in common
! ! and the 2p if there is more than one electron in the active space
! do k = 1, N_int
! zero_bitmask(k,1) = 0_bit_kind
! zero_bitmask(k,2) = 0_bit_kind
! enddo
! ! hole is possible only in the orbital i_hole_osoci
! call set_bit_to_integer(i_hole_osoci,zero_bitmask(1,1),N_int)
! call set_bit_to_integer(i_hole_osoci,zero_bitmask(1,2),N_int)
! ! and in the active space
! do k = 1, n_act_orb
! call set_bit_to_integer(list_act(k),zero_bitmask(1,1),N_int)
! call set_bit_to_integer(list_act(k),zero_bitmask(1,2),N_int)
! enddo
! call set_bitmask_hole_as_input(zero_bitmask)
! call set_bitmask_particl_as_input(reunion_of_bitmask)
! call all_1h2p
! call diagonalize_CI_SC2
! call provide_matrix_dressing(dressing_matrix,n_det_generators,psi_det_generators)
! ! Change the mask of the holes and particles to perform all the
! ! double excitations that from the orbital i_hole_osoci
! do k = 1, N_int
! zero_bitmask(k,1) = 0_bit_kind
! zero_bitmask(k,2) = 0_bit_kind
! enddo
! ! hole is possible only in the orbital i_hole_osoci
! call set_bit_to_integer(i_hole_osoci,zero_bitmask(1,1),N_int)
! call set_bit_to_integer(i_hole_osoci,zero_bitmask(1,2),N_int)
! call set_bitmask_hole_as_input(zero_bitmask)
! call set_bitmask_particl_as_input(reunion_of_bitmask)
! call set_psi_det_to_generators
! call all_2h2p
! call diagonalize_CI_SC2
double precision :: hkl
call provide_matrix_dressing(dressing_matrix,n_det_generators,psi_det_generators)
hkl = dressing_matrix(1,1)
do k = 1, N_det_generators
dressing_matrix(k,k) = dressing_matrix(k,k) - hkl
enddo
print*,'Dressed matrix'
do k = 1, N_det_generators
write(*,'(100(F12.5,X))')dressing_matrix(k,:)
enddo
! call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix)
endif endif
call set_intermediate_normalization_lmct_old(norm_tmp,i_hole_osoci) call set_intermediate_normalization_lmct_old(norm_tmp,i_hole_osoci)
do k = 1, N_states do k = 1, N_states
print*,'norm_tmp = ',norm_tmp(k) print*,'norm_tmp = ',norm_tmp(k)
norm_total(k) += norm_tmp(k) norm_total(k) += norm_tmp(k)
@ -83,9 +151,12 @@ subroutine FOBOCI_lmct_mlct_old_thr
if(.True.)then if(.True.)then
print*,'' print*,''
print*,'DOING THEN THE MLCT !!' print*,'DOING THEN THE MLCT !!'
print*,'Threshold_mlct = ',threshold_mlct
lmct = .False.
do i = 1, n_virt_orb do i = 1, n_virt_orb
integer :: i_particl_osoci integer :: i_particl_osoci
i_particl_osoci = list_virt(i) i_particl_osoci = list_virt(i)
print*,'--------------------------' print*,'--------------------------'
! First set the current generators to the one of restart ! First set the current generators to the one of restart
call set_generators_to_generators_restart call set_generators_to_generators_restart
@ -107,7 +178,7 @@ subroutine FOBOCI_lmct_mlct_old_thr
call set_bitmask_particl_as_input(reunion_of_bitmask) call set_bitmask_particl_as_input(reunion_of_bitmask)
call set_bitmask_hole_as_input(reunion_of_bitmask) call set_bitmask_hole_as_input(reunion_of_bitmask)
!! ! so all the mono excitation on the new generators !! ! so all the mono excitation on the new generators
call is_a_good_candidate(threshold,is_ok,verbose) call is_a_good_candidate(threshold_mlct,is_ok,verbose)
print*,'is_ok = ',is_ok print*,'is_ok = ',is_ok
if(.not.is_ok)cycle if(.not.is_ok)cycle
allocate(dressing_matrix(N_det_generators,N_det_generators)) allocate(dressing_matrix(N_det_generators,N_det_generators))
@ -122,6 +193,9 @@ subroutine FOBOCI_lmct_mlct_old_thr
! call all_single_split(psi_det_generators,psi_coef_generators,N_det_generators,dressing_matrix) ! call all_single_split(psi_det_generators,psi_coef_generators,N_det_generators,dressing_matrix)
! call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix) ! call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix)
call all_single call all_single
! if(dressing_2h2p)then
! call diag_dressed_2h2p_hamiltonian_and_update_psi_det(i_particl_osoci,lmct)
! endif
endif endif
call set_intermediate_normalization_mlct_old(norm_tmp,i_particl_osoci) call set_intermediate_normalization_mlct_old(norm_tmp,i_particl_osoci)
do k = 1, N_states do k = 1, N_states
@ -132,24 +206,6 @@ subroutine FOBOCI_lmct_mlct_old_thr
deallocate(dressing_matrix) deallocate(dressing_matrix)
enddo enddo
endif endif
if(.False.)then
print*,'LAST loop for all the 1h-1p'
print*,'--------------------------'
! First set the current generators to the one of restart
call set_generators_to_generators_restart
call set_psi_det_to_generators
call initialize_bitmask_to_restart_ones
! Impose that only the hole i_hole_osoci can be done
call set_bitmask_particl_as_input(inact_virt_bitmask)
call set_bitmask_hole_as_input(inact_virt_bitmask)
! call set_bitmask_particl_as_input(reunion_of_bitmask)
! call set_bitmask_hole_as_input(reunion_of_bitmask)
call all_single
call set_intermediate_normalization_1h1p(norm_tmp)
norm_total += norm_tmp
call update_density_matrix_osoci
endif
print*,'norm_total = ',norm_total print*,'norm_total = ',norm_total
norm_total = norm_generators_restart norm_total = norm_generators_restart
@ -174,10 +230,8 @@ subroutine FOBOCI_mlct_old
double precision :: norm_tmp,norm_total double precision :: norm_tmp,norm_total
logical :: test_sym logical :: test_sym
double precision :: thr double precision :: thr
double precision :: threshold
logical :: verbose,is_ok logical :: verbose,is_ok
verbose = .False. verbose = .False.
threshold = 1.d-2
thr = 1.d-12 thr = 1.d-12
allocate(unpaired_bitmask(N_int,2)) allocate(unpaired_bitmask(N_int,2))
allocate (occ(N_int*bit_kind_size,2)) allocate (occ(N_int*bit_kind_size,2))
@ -216,7 +270,7 @@ subroutine FOBOCI_mlct_old
call set_bitmask_particl_as_input(reunion_of_bitmask) call set_bitmask_particl_as_input(reunion_of_bitmask)
call set_bitmask_hole_as_input(reunion_of_bitmask) call set_bitmask_hole_as_input(reunion_of_bitmask)
! ! so all the mono excitation on the new generators ! ! so all the mono excitation on the new generators
call is_a_good_candidate(threshold,is_ok,verbose) call is_a_good_candidate(threshold_mlct,is_ok,verbose)
print*,'is_ok = ',is_ok print*,'is_ok = ',is_ok
is_ok =.True. is_ok =.True.
if(.not.is_ok)cycle if(.not.is_ok)cycle
@ -250,10 +304,8 @@ subroutine FOBOCI_lmct_old
double precision :: norm_tmp,norm_total double precision :: norm_tmp,norm_total
logical :: test_sym logical :: test_sym
double precision :: thr double precision :: thr
double precision :: threshold
logical :: verbose,is_ok logical :: verbose,is_ok
verbose = .False. verbose = .False.
threshold = 1.d-2
thr = 1.d-12 thr = 1.d-12
allocate(unpaired_bitmask(N_int,2)) allocate(unpaired_bitmask(N_int,2))
allocate (occ(N_int*bit_kind_size,2)) allocate (occ(N_int*bit_kind_size,2))
@ -290,7 +342,7 @@ subroutine FOBOCI_lmct_old
call set_generators_to_psi_det call set_generators_to_psi_det
call set_bitmask_particl_as_input(reunion_of_bitmask) call set_bitmask_particl_as_input(reunion_of_bitmask)
call set_bitmask_hole_as_input(reunion_of_bitmask) call set_bitmask_hole_as_input(reunion_of_bitmask)
call is_a_good_candidate(threshold,is_ok,verbose) call is_a_good_candidate(threshold_lmct,is_ok,verbose)
print*,'is_ok = ',is_ok print*,'is_ok = ',is_ok
if(.not.is_ok)cycle if(.not.is_ok)cycle
! ! so all the mono excitation on the new generators ! ! so all the mono excitation on the new generators

View File

@ -0,0 +1,18 @@
program osoci_program
implicit none
do_it_perturbative = .True.
touch do_it_perturbative
call FOBOCI_lmct_mlct_old_thr
call provide_all_the_rest
end
subroutine provide_all_the_rest
implicit none
integer :: i
call update_one_body_dm_mo
call set_lmct_mlct_to_psi_det
call diagonalize_CI
call save_wavefunction
end

View File

@ -1,126 +1,74 @@
use bitmasks use bitmasks
BEGIN_PROVIDER [ integer, N_det_generators_restart ] BEGIN_PROVIDER [ integer, N_det_generators_restart ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Number of determinants in the wave function ! Read the wave function
END_DOC END_DOC
logical :: exists integer :: i
character*64 :: label
integer, save :: ifirst = 0 integer, save :: ifirst = 0
!if(ifirst == 0)then double precision :: norm
PROVIDE ezfio_filename if(ifirst == 0)then
call ezfio_has_determinants_n_det(exists) call ezfio_get_determinants_n_det(N_det_generators_restart)
print*,'exists = ',exists
if(.not.exists)then
print*,'The OSOCI needs a restart WF'
print*,'There are none in the EZFIO file ...'
print*,'Stopping ...'
stop
endif
print*,'passed N_det_generators_restart'
call ezfio_get_determinants_n_det(N_det_generators_restart)
ASSERT (N_det_generators_restart > 0)
ifirst = 1 ifirst = 1
!endif else
print*,'PB in generators_restart restart !!!'
endif
call write_int(output_determinants,N_det_generators_restart,'Number of generators_restart')
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), psi_det_generators_restart, (N_int,2,psi_det_size) ] BEGIN_PROVIDER [ integer(bit_kind), psi_det_generators_restart, (N_int,2,N_det_generators_restart) ]
&BEGIN_PROVIDER [ integer(bit_kind), ref_generators_restart, (N_int,2) ] &BEGIN_PROVIDER [ integer(bit_kind), ref_generators_restart, (N_int,2) ]
&BEGIN_PROVIDER [ double precision, psi_coef_generators_restart, (N_det_generators_restart,N_states) ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! The wave function determinants. Initialized with Hartree-Fock if the EZFIO file ! read wf
! is empty !
END_DOC END_DOC
integer :: i integer :: i, k
logical :: exists
character*64 :: label
integer, save :: ifirst = 0 integer, save :: ifirst = 0
!if(ifirst == 0)then double precision, allocatable :: psi_coef_read(:,:)
provide N_det_generators_restart if(ifirst == 0)then
if(.True.)then call read_dets(psi_det_generators_restart,N_int,N_det_generators_restart)
call ezfio_has_determinants_N_int(exists) do k = 1, N_int
if (exists) then ref_generators_restart(k,1) = psi_det_generators_restart(k,1,1)
call ezfio_has_determinants_bit_kind(exists) ref_generators_restart(k,2) = psi_det_generators_restart(k,2,1)
if (exists) then enddo
call ezfio_has_determinants_N_det(exists) allocate (psi_coef_read(N_det_generators_restart,N_states))
if (exists) then call ezfio_get_determinants_psi_coef(psi_coef_read)
call ezfio_has_determinants_N_states(exists) do k = 1, N_states
if (exists) then do i = 1, N_det_generators_restart
call ezfio_has_determinants_psi_det(exists) psi_coef_generators_restart(i,k) = psi_coef_read(i,k)
endif enddo
endif enddo
endif
endif
if(.not.exists)then
print*,'The OSOCI needs a restart WF'
print*,'There are none in the EZFIO file ...'
print*,'Stopping ...'
stop
endif
print*,'passed psi_det_generators_restart'
call read_dets(psi_det_generators_restart,N_int,N_det_generators_restart)
do i = 1, N_int
ref_generators_restart(i,1) = psi_det_generators_restart(i,1,1)
ref_generators_restart(i,2) = psi_det_generators_restart(i,2,1)
enddo
endif
ifirst = 1 ifirst = 1
!endif deallocate(psi_coef_read)
else
print*,'PB in generators_restart restart !!!'
endif
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ integer, size_select_max]
implicit none
BEGIN_PROVIDER [ double precision, psi_coef_generators_restart, (psi_det_size,N_states_diag) ] BEGIN_DOC
implicit none ! Size of the select_max array
BEGIN_DOC END_DOC
! The wave function coefficients. Initialized with Hartree-Fock if the EZFIO file size_select_max = 10000
! is empty
END_DOC
integer :: i,k, N_int2
logical :: exists
double precision, allocatable :: psi_coef_read(:,:)
character*(64) :: label
integer, save :: ifirst = 0
!if(ifirst == 0)then
psi_coef_generators_restart = 0.d0
do i=1,N_states_diag
psi_coef_generators_restart(i,i) = 1.d0
enddo
call ezfio_has_determinants_psi_coef(exists)
if(.not.exists)then
print*,'The OSOCI needs a restart WF'
print*,'There are none in the EZFIO file ...'
print*,'Stopping ...'
stop
endif
print*,'passed psi_coef_generators_restart'
if (exists) then
allocate (psi_coef_read(N_det_generators_restart,N_states))
call ezfio_get_determinants_psi_coef(psi_coef_read)
do k=1,N_states
do i=1,N_det_generators_restart
psi_coef_generators_restart(i,k) = psi_coef_read(i,k)
enddo
enddo
deallocate(psi_coef_read)
endif
ifirst = 1
!endif
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ double precision, select_max, (size_select_max) ]
implicit none
BEGIN_DOC
! Memo to skip useless selectors
END_DOC
select_max = huge(1.d0)
END_PROVIDER
BEGIN_PROVIDER [ integer, N_det_generators ]
&BEGIN_PROVIDER [ integer(bit_kind), psi_det_generators, (N_int,2,10000) ]
&BEGIN_PROVIDER [ double precision, psi_coef_generators, (10000,N_states) ]
END_PROVIDER

View File

@ -0,0 +1,83 @@
program test_sc2
implicit none
read_wf = .True.
touch read_wf
call routine
end
subroutine routine
implicit none
double precision, allocatable :: energies(:),diag_H_elements(:)
double precision, allocatable :: H_matrix(:,:)
allocate(energies(N_states),diag_H_elements(N_det))
call diagonalize_CI
call test_hcc
call test_mulliken
! call SC2_1h1p(psi_det,psi_coef,energies, &
! diag_H_elements,size(psi_coef,1),N_det,N_states_diag,N_int,threshold_convergence_SC2)
allocate(H_matrix(N_det,N_det))
call SC2_1h1p_full(psi_det,psi_coef,energies, &
H_matrix,size(psi_coef,1),N_det,N_states_diag,N_int,threshold_convergence_SC2)
deallocate(H_matrix)
integer :: i,j
double precision :: accu,coef_hf
! coef_hf = 1.d0/psi_coef(1,1)
! do i = 1, N_det
! psi_coef(i,1) *= coef_hf
! enddo
touch psi_coef
call pouet
end
subroutine pouet
implicit none
double precision :: accu,coef_hf
! provide one_body_dm_mo_alpha one_body_dm_mo_beta
! call density_matrix_1h1p(psi_det,psi_coef,one_body_dm_mo_alpha,one_body_dm_mo_beta,accu,size(psi_coef,1),N_det,N_states_diag,N_int)
! touch one_body_dm_mo_alpha one_body_dm_mo_beta
call test_hcc
call test_mulliken
! call save_wavefunction
end
subroutine test_hcc
implicit none
double precision :: accu
integer :: i,j
print*,'Z AU GAUSS MHZ cm^-1'
do i = 1, nucl_num
write(*,'(I2,X,F3.1,X,4(F16.6,X))')i,nucl_charge(i),spin_density_at_nucleous(i),iso_hcc_gauss(i),iso_hcc_mhz(i),iso_hcc_cm_1(i)
enddo
end
subroutine test_mulliken
double precision :: accu
integer :: i
integer :: j
accu= 0.d0
do i = 1, nucl_num
print*,i,nucl_charge(i),mulliken_spin_densities(i)
accu += mulliken_spin_densities(i)
enddo
print*,'Sum of Mulliken SD = ',accu
!print*,'AO SPIN POPULATIONS'
accu = 0.d0
!do i = 1, ao_num
! accu += spin_gross_orbital_product(i)
! write(*,'(X,I3,X,A4,X,I2,X,A4,X,F10.7)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),trim(l_to_charater(ao_l(i))),spin_gross_orbital_product(i)
!enddo
!print*,'sum = ',accu
!accu = 0.d0
!print*,'Angular momentum analysis'
!do i = 0, ao_l_max
! accu += spin_population_angular_momentum(i)
! print*,' ',trim(l_to_charater(i)),spin_population_angular_momentum(i)
!print*,'sum = ',accu
!enddo
end

View File

@ -6,6 +6,7 @@ subroutine set_generators_to_psi_det
END_DOC END_DOC
N_det_generators = N_det N_det_generators = N_det
integer :: i,k integer :: i,k
print*,'N_det = ',N_det
do i=1,N_det_generators do i=1,N_det_generators
do k=1,N_int do k=1,N_int
psi_det_generators(k,1,i) = psi_det(k,1,i) psi_det_generators(k,1,i) = psi_det(k,1,i)

View File

@ -24,6 +24,7 @@ subroutine new_approach
double precision, allocatable :: dressing_matrix_1h1p(:,:) double precision, allocatable :: dressing_matrix_1h1p(:,:)
double precision, allocatable :: dressing_matrix_2h1p(:,:) double precision, allocatable :: dressing_matrix_2h1p(:,:)
double precision, allocatable :: dressing_matrix_1h2p(:,:) double precision, allocatable :: dressing_matrix_1h2p(:,:)
double precision, allocatable :: dressing_matrix_extra_1h_or_1p(:,:)
double precision, allocatable :: H_matrix_tmp(:,:) double precision, allocatable :: H_matrix_tmp(:,:)
logical :: verbose,is_ok logical :: verbose,is_ok
@ -45,7 +46,7 @@ subroutine new_approach
verbose = .True. verbose = .True.
threshold = threshold_singles threshold = threshold_lmct
print*,'threshold = ',threshold print*,'threshold = ',threshold
thr = 1.d-12 thr = 1.d-12
print*,'' print*,''
@ -81,12 +82,14 @@ subroutine new_approach
! so all the mono excitation on the new generators ! so all the mono excitation on the new generators
allocate(dressing_matrix_1h1p(N_det_generators,N_det_generators)) allocate(dressing_matrix_1h1p(N_det_generators,N_det_generators))
allocate(dressing_matrix_2h1p(N_det_generators,N_det_generators)) allocate(dressing_matrix_2h1p(N_det_generators,N_det_generators))
allocate(dressing_matrix_extra_1h_or_1p(N_det_generators,N_det_generators))
dressing_matrix_1h1p = 0.d0 dressing_matrix_1h1p = 0.d0
dressing_matrix_2h1p = 0.d0 dressing_matrix_2h1p = 0.d0
dressing_matrix_extra_1h_or_1p = 0.d0
if(.not.do_it_perturbative)then if(.not.do_it_perturbative)then
n_good_hole +=1 n_good_hole +=1
! call all_single_split_for_1h(dressing_matrix_1h1p,dressing_matrix_2h1p) ! call all_single_split_for_1h(dressing_matrix_1h1p,dressing_matrix_2h1p)
call all_single_for_1h(dressing_matrix_1h1p,dressing_matrix_2h1p) call all_single_for_1h(i_hole_foboci,dressing_matrix_1h1p,dressing_matrix_2h1p,dressing_matrix_extra_1h_or_1p)
allocate(H_matrix_tmp(N_det_generators,N_det_generators)) allocate(H_matrix_tmp(N_det_generators,N_det_generators))
do j = 1,N_det_generators do j = 1,N_det_generators
do k = 1, N_det_generators do k = 1, N_det_generators
@ -96,7 +99,7 @@ subroutine new_approach
enddo enddo
do j = 1, N_det_generators do j = 1, N_det_generators
do k = 1, N_det_generators do k = 1, N_det_generators
H_matrix_tmp(j,k) += dressing_matrix_1h1p(j,k) + dressing_matrix_2h1p(j,k) H_matrix_tmp(j,k) += dressing_matrix_1h1p(j,k) + dressing_matrix_2h1p(j,k) + dressing_matrix_extra_1h_or_1p(j,k)
enddo enddo
enddo enddo
hjk = H_matrix_tmp(1,1) hjk = H_matrix_tmp(1,1)
@ -130,6 +133,7 @@ subroutine new_approach
endif endif
deallocate(dressing_matrix_1h1p) deallocate(dressing_matrix_1h1p)
deallocate(dressing_matrix_2h1p) deallocate(dressing_matrix_2h1p)
deallocate(dressing_matrix_extra_1h_or_1p)
enddo enddo
print*,'' print*,''
@ -155,12 +159,14 @@ subroutine new_approach
! so all the mono excitation on the new generators ! so all the mono excitation on the new generators
allocate(dressing_matrix_1h1p(N_det_generators,N_det_generators)) allocate(dressing_matrix_1h1p(N_det_generators,N_det_generators))
allocate(dressing_matrix_1h2p(N_det_generators,N_det_generators)) allocate(dressing_matrix_1h2p(N_det_generators,N_det_generators))
allocate(dressing_matrix_extra_1h_or_1p(N_det_generators,N_det_generators))
dressing_matrix_1h1p = 0.d0 dressing_matrix_1h1p = 0.d0
dressing_matrix_1h2p = 0.d0 dressing_matrix_1h2p = 0.d0
dressing_matrix_extra_1h_or_1p = 0.d0
if(.not.do_it_perturbative)then if(.not.do_it_perturbative)then
n_good_hole +=1 n_good_hole +=1
! call all_single_split_for_1p(dressing_matrix_1h1p,dressing_matrix_1h2p) ! call all_single_split_for_1p(dressing_matrix_1h1p,dressing_matrix_1h2p)
call all_single_for_1p(dressing_matrix_1h1p,dressing_matrix_1h2p) call all_single_for_1p(i_particl_osoci,dressing_matrix_1h1p,dressing_matrix_1h2p,dressing_matrix_extra_1h_or_1p)
allocate(H_matrix_tmp(N_det_generators,N_det_generators)) allocate(H_matrix_tmp(N_det_generators,N_det_generators))
do j = 1,N_det_generators do j = 1,N_det_generators
do k = 1, N_det_generators do k = 1, N_det_generators
@ -170,7 +176,7 @@ subroutine new_approach
enddo enddo
do j = 1, N_det_generators do j = 1, N_det_generators
do k = 1, N_det_generators do k = 1, N_det_generators
H_matrix_tmp(j,k) += dressing_matrix_1h1p(j,k) + dressing_matrix_1h2p(j,k) H_matrix_tmp(j,k) += dressing_matrix_1h1p(j,k) + dressing_matrix_1h2p(j,k) + dressing_matrix_extra_1h_or_1p(j,k)
enddo enddo
enddo enddo
hjk = H_matrix_tmp(1,1) hjk = H_matrix_tmp(1,1)
@ -205,7 +211,10 @@ subroutine new_approach
endif endif
deallocate(dressing_matrix_1h1p) deallocate(dressing_matrix_1h1p)
deallocate(dressing_matrix_1h2p) deallocate(dressing_matrix_1h2p)
deallocate(dressing_matrix_extra_1h_or_1p)
enddo enddo
double precision, allocatable :: H_matrix_total(:,:) double precision, allocatable :: H_matrix_total(:,:)
integer :: n_det_total integer :: n_det_total
n_det_total = N_det_generators_restart + n_good_det n_det_total = N_det_generators_restart + n_good_det
@ -221,7 +230,7 @@ subroutine new_approach
!!! Adding the averaged dressing coming from the 1h1p that are redundant for each of the "n_good_hole" 1h !!! Adding the averaged dressing coming from the 1h1p that are redundant for each of the "n_good_hole" 1h
H_matrix_total(i,j) += dressing_matrix_restart_1h1p(i,j)/dble(n_good_hole+n_good_particl) H_matrix_total(i,j) += dressing_matrix_restart_1h1p(i,j)/dble(n_good_hole+n_good_particl)
!!! Adding the dressing coming from the 2h1p that are not redundant for the any of CI calculations !!! Adding the dressing coming from the 2h1p that are not redundant for the any of CI calculations
H_matrix_total(i,j) += dressing_matrix_restart_2h1p(i,j) H_matrix_total(i,j) += dressing_matrix_restart_2h1p(i,j) + dressing_matrix_restart_1h2p(i,j)
enddo enddo
enddo enddo
do i = 1, n_good_det do i = 1, n_good_det
@ -244,25 +253,79 @@ subroutine new_approach
H_matrix_total(n_det_generators_restart+j,n_det_generators_restart+i) = hij H_matrix_total(n_det_generators_restart+j,n_det_generators_restart+i) = hij
enddo enddo
enddo enddo
print*,'H matrix to diagonalize'
double precision :: href ! Adding the correlation energy
href = H_matrix_total(1,1) logical :: orb_taken_good_det(mo_tot_num)
do i = 1, n_det_total double precision :: phase
H_matrix_total(i,i) -= href integer :: n_h,n_p,number_of_holes,number_of_particles
integer :: exc(0:2,2,2)
integer :: degree
integer :: h1,h2,p1,p2,s1,s2
logical, allocatable :: one_hole_or_one_p(:)
integer, allocatable :: holes_or_particle(:)
allocate(one_hole_or_one_p(n_good_det), holes_or_particle(n_good_det))
orb_taken_good_det = .False.
do i = 1, n_good_det
n_h = number_of_holes(psi_good_det(1,1,i))
n_p = number_of_particles(psi_good_det(1,1,i))
call get_excitation(ref_bitmask,psi_good_det(1,1,i),exc,degree,phase,N_int)
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
if(n_h == 0 .and. n_p == 1)then
orb_taken_good_det(h1) = .True.
one_hole_or_one_p(i) = .True.
holes_or_particle(i) = h1
endif
if(n_h == 1 .and. n_p == 0)then
orb_taken_good_det(p1) = .True.
one_hole_or_one_p(i) = .False.
holes_or_particle(i) = p1
endif
enddo enddo
do i = 1, n_det_total
write(*,'(100(X,F16.8))')H_matrix_total(i,:) do i = 1, N_det_generators_restart
enddo ! Add the 2h2p, 2h1p and 1h2p correlation energy
double precision, allocatable :: eigvalues(:),eigvectors(:,:) H_matrix_total(i,i) += total_corr_e_2h2p + total_corr_e_2h1p + total_corr_e_1h2p + total_corr_e_1h1p_spin_flip
allocate(eigvalues(n_det_total),eigvectors(n_det_total,n_det_total)) ! Substract the 2h1p part that have already been taken into account
call lapack_diag(eigvalues,eigvectors,H_matrix_total,n_det_total,n_det_total) do j = 1, n_inact_orb
print*,'e_dressed = ',eigvalues(1) + nuclear_repulsion + href iorb = list_inact(j)
do i = 1, n_det_total if(.not.orb_taken_good_det(iorb))cycle
print*,'coef = ',eigvectors(i,1) H_matrix_total(i,i) -= corr_energy_2h1p_per_orb_ab(iorb) - corr_energy_2h1p_per_orb_bb(iorb) - corr_energy_1h1p_spin_flip_per_orb(iorb)
enddo enddo
integer(bit_kind), allocatable :: psi_det_final(:,:,:) ! Substract the 1h2p part that have already been taken into account
double precision, allocatable :: psi_coef_final(:,:) do j = 1, n_virt_orb
double precision :: norm iorb = list_virt(j)
if(.not.orb_taken_good_det(iorb))cycle
H_matrix_total(i,i) -= corr_energy_1h2p_per_orb_ab(iorb) - corr_energy_1h2p_per_orb_aa(iorb)
enddo
enddo
do i = 1, N_good_det
! Repeat the 2h2p correlation energy
H_matrix_total(N_det_generators_restart+i,N_det_generators_restart+i) += total_corr_e_2h2p
! Substract the part that can not be repeated
! If it is a 1h
if(one_hole_or_one_p(i))then
! 2h2p
H_matrix_total(N_det_generators_restart+i,N_det_generators_restart+i) += -corr_energy_2h2p_per_orb_ab(holes_or_particle(i)) &
-corr_energy_2h2p_per_orb_bb(holes_or_particle(i))
! You can repeat a certain part of the 1h2p correlation energy
! that is everything except the part that involves the hole of the 1h
H_matrix_total(N_det_generators_restart+i,N_det_generators_restart+i) += total_corr_e_1h2p
H_matrix_total(N_det_generators_restart+i,N_det_generators_restart+i) += -corr_energy_1h2p_per_orb_ab(holes_or_particle(i)) &
-corr_energy_1h2p_per_orb_bb(holes_or_particle(i))
else
! 2h2p
H_matrix_total(N_det_generators_restart+i,N_det_generators_restart+i) += -corr_energy_2h2p_per_orb_ab(holes_or_particle(i)) &
-corr_energy_2h2p_per_orb_aa(holes_or_particle(i))
! You can repeat a certain part of the 2h1p correlation energy
! that is everything except the part that involves the hole of the 1p
! 2h1p
H_matrix_total(N_det_generators_restart+i,N_det_generators_restart+i) += -corr_energy_2h1p_per_orb_ab(holes_or_particle(i)) &
-corr_energy_2h1p_per_orb_aa(holes_or_particle(i))
endif
enddo
allocate(psi_coef_final(n_det_total, N_states)) allocate(psi_coef_final(n_det_total, N_states))
allocate(psi_det_final(N_int,2,n_det_total)) allocate(psi_det_final(N_int,2,n_det_total))
do i = 1, N_det_generators_restart do i = 1, N_det_generators_restart
@ -277,22 +340,222 @@ subroutine new_approach
psi_det_final(j,2,n_det_generators_restart+i) = psi_good_det(j,2,i) psi_det_final(j,2,n_det_generators_restart+i) = psi_good_det(j,2,i)
enddo enddo
enddo enddo
norm = 0.d0
double precision :: href
double precision, allocatable :: eigvalues(:),eigvectors(:,:)
integer(bit_kind), allocatable :: psi_det_final(:,:,:)
double precision, allocatable :: psi_coef_final(:,:)
double precision :: norm
allocate(eigvalues(n_det_total),eigvectors(n_det_total,n_det_total))
call lapack_diag(eigvalues,eigvectors,H_matrix_total,n_det_total,n_det_total)
print*,''
print*,''
print*,'H_matrix_total(1,1) = ',H_matrix_total(1,1)
print*,'e_dressed = ',eigvalues(1) + nuclear_repulsion
do i = 1, n_det_total do i = 1, n_det_total
do j = 1, N_states print*,'coef = ',eigvectors(i,1),H_matrix_total(i,i) - H_matrix_total(1,1)
psi_coef_final(i,j) = eigvectors(i,j)
enddo
norm += psi_coef_final(i,1)**2
! call debug_det(psi_det_final(1, 1, i), N_int)
enddo enddo
print*,'norm = ',norm
integer(bit_kind), allocatable :: psi_det_remaining_1h_or_1p(:,:,:)
integer(bit_kind), allocatable :: key_tmp(:,:)
integer :: n_det_remaining_1h_or_1p
integer :: ispin,i_ok
allocate(key_tmp(N_int,2),psi_det_remaining_1h_or_1p(N_int,2,n_inact_orb*n_act_orb+n_virt_orb*n_act_orb))
logical :: is_already_present
logical, allocatable :: one_hole_or_one_p_bis(:)
integer, allocatable :: holes_or_particle_bis(:)
double precision,allocatable :: H_array(:)
allocate(one_hole_or_one_p_bis(n_inact_orb*n_act_orb+n_virt_orb*n_act_orb), holes_or_particle_bis(n_inact_orb*n_act_orb+n_virt_orb*n_act_orb))
allocate(H_array(n_det_total))
! Dressing with the remaining 1h determinants
print*,''
print*,''
print*,'Dressing with the remaining 1h determinants'
n_det_remaining_1h_or_1p = 0
do i = 1, n_inact_orb
iorb = list_inact(i)
if(orb_taken_good_det(iorb))cycle
do j = 1, n_act_orb
jorb = list_act(j)
ispin = 2
key_tmp = ref_bitmask
call do_mono_excitation(key_tmp,iorb,jorb,ispin,i_ok)
if(i_ok .ne.1)cycle
is_already_present = .False.
H_array = 0.d0
call i_h_j(key_tmp,key_tmp,N_int,hij)
href = ref_bitmask_energy - hij
href = 1.d0/href
do k = 1, n_det_total
call get_excitation_degree(psi_det_final(1,1,k),key_tmp,degree,N_int)
if(degree == 0)then
is_already_present = .True.
exit
endif
enddo
if(is_already_present)cycle
n_det_remaining_1h_or_1p +=1
one_hole_or_one_p_bis(n_det_remaining_1h_or_1p) = .True.
holes_or_particle_bis(n_det_remaining_1h_or_1p) = iorb
do k = 1, N_int
psi_det_remaining_1h_or_1p(k,1,n_det_remaining_1h_or_1p) = key_tmp(k,1)
psi_det_remaining_1h_or_1p(k,2,n_det_remaining_1h_or_1p) = key_tmp(k,2)
enddo
! do k = 1, n_det_total
! call i_h_j(psi_det_final(1,1,k),key_tmp,N_int,hij)
! H_array(k) = hij
! enddo
! do k = 1, n_det_total
! do l = 1, n_det_total
! H_matrix_total(k,l) += H_array(k) * H_array(l) * href
! enddo
! enddo
enddo
enddo
! Dressing with the remaining 1p determinants
print*,'n_det_remaining_1h_or_1p = ',n_det_remaining_1h_or_1p
print*,'Dressing with the remaining 1p determinants'
do i = 1, n_virt_orb
iorb = list_virt(i)
if(orb_taken_good_det(iorb))cycle
do j = 1, n_act_orb
jorb = list_act(j)
ispin = 1
key_tmp = ref_bitmask
call do_mono_excitation(key_tmp,jorb,iorb,ispin,i_ok)
if(i_ok .ne.1)cycle
is_already_present = .False.
H_array = 0.d0
call i_h_j(key_tmp,key_tmp,N_int,hij)
href = ref_bitmask_energy - hij
href = 1.d0/href
do k = 1, n_det_total
call get_excitation_degree(psi_det_final(1,1,k),key_tmp,degree,N_int)
if(degree == 0)then
is_already_present = .True.
exit
endif
enddo
if(is_already_present)cycle
n_det_remaining_1h_or_1p +=1
one_hole_or_one_p_bis(n_det_remaining_1h_or_1p) = .False.
holes_or_particle_bis(n_det_remaining_1h_or_1p) = iorb
do k = 1, N_int
psi_det_remaining_1h_or_1p(k,1,n_det_remaining_1h_or_1p) = key_tmp(k,1)
psi_det_remaining_1h_or_1p(k,2,n_det_remaining_1h_or_1p) = key_tmp(k,2)
enddo
! do k = 1, n_det_total
! call i_h_j(psi_det_final(1,1,k),key_tmp,N_int,hij)
! H_array(k) = hij
! enddo
! do k = 1, n_det_total
! do l = 1, n_det_total
! H_matrix_total(k,l) += H_array(k) * H_array(l) * href
! enddo
! enddo
enddo
enddo
print*,'n_det_remaining_1h_or_1p = ',n_det_remaining_1h_or_1p
deallocate(key_tmp,H_array)
double precision, allocatable :: eigvalues_bis(:),eigvectors_bis(:,:),H_matrix_total_bis(:,:)
integer :: n_det_final
n_det_final = n_det_total + n_det_remaining_1h_or_1p
allocate(eigvalues_bis(n_det_final),eigvectors_bis(n_det_final,n_det_final),H_matrix_total_bis(n_det_final,n_det_final))
print*,'passed the allocate, building the big matrix'
do i = 1, n_det_total
do j = 1, n_det_total
H_matrix_total_bis(i,j) = H_matrix_total(i,j)
enddo
enddo
do i = 1, n_det_remaining_1h_or_1p
do j = 1, n_det_remaining_1h_or_1p
call i_h_j(psi_det_remaining_1h_or_1p(1,1,i),psi_det_remaining_1h_or_1p(1,1,j),N_int,hij)
H_matrix_total_bis(n_det_total+i,n_det_total+j) = hij
enddo
enddo
do i = 1, n_det_total
do j = 1, n_det_remaining_1h_or_1p
call i_h_j(psi_det_final(1,1,i),psi_det_remaining_1h_or_1p(1,1,j),N_int,hij)
H_matrix_total_bis(i,n_det_total+j) = hij
H_matrix_total_bis(n_det_total+j,i) = hij
enddo
enddo
print*,'passed the matrix'
do i = 1, n_det_remaining_1h_or_1p
if(one_hole_or_one_p_bis(i))then
H_matrix_total_bis(n_det_total+i,n_det_total+i) += total_corr_e_2h2p -corr_energy_2h2p_per_orb_ab(holes_or_particle_bis(i)) &
-corr_energy_2h2p_per_orb_bb(holes_or_particle_bis(i))
H_matrix_total_bis(n_det_total+i,n_det_total+i) += total_corr_e_1h2p -corr_energy_1h2p_per_orb_ab(holes_or_particle_bis(i)) &
-corr_energy_1h2p_per_orb_bb(holes_or_particle_bis(i))
else
H_matrix_total_bis(n_det_total+i,n_det_total+i) += total_corr_e_2h2p -corr_energy_2h2p_per_orb_ab(holes_or_particle_bis(i)) &
-corr_energy_2h2p_per_orb_aa(holes_or_particle_bis(i))
H_matrix_total_bis(n_det_total+i,n_det_total+i) += total_corr_e_1h2p -corr_energy_2h1p_per_orb_ab(holes_or_particle_bis(i)) &
-corr_energy_2h1p_per_orb_aa(holes_or_particle_bis(i))
endif
enddo
do i = 2, n_det_final
do j = i+1, n_det_final
H_matrix_total_bis(i,j) = 0.d0
H_matrix_total_bis(j,i) = 0.d0
enddo
enddo
do i = 1, n_det_final
write(*,'(500(F10.5,X))')H_matrix_total_bis(i,:)
enddo
call lapack_diag(eigvalues_bis,eigvectors_bis,H_matrix_total_bis,n_det_final,n_det_final)
print*,'e_dressed = ',eigvalues_bis(1) + nuclear_repulsion
do i = 1, n_det_final
print*,'coef = ',eigvectors_bis(i,1),H_matrix_total_bis(i,i) - H_matrix_total_bis(1,1)
enddo
do j = 1, N_states
do i = 1, n_det_total
psi_coef_final(i,j) = eigvectors_bis(i,j)
norm += psi_coef_final(i,j)**2
enddo
norm = 1.d0/dsqrt(norm)
do i = 1, n_det_total
psi_coef_final(i,j) = psi_coef_final(i,j) * norm
enddo
enddo
deallocate(eigvalues_bis,eigvectors_bis,H_matrix_total_bis)
!print*,'H matrix to diagonalize'
!href = H_matrix_total(1,1)
!do i = 1, n_det_total
! H_matrix_total(i,i) -= href
!enddo
!do i = 1, n_det_total
! write(*,'(100(X,F16.8))')H_matrix_total(i,:)
!enddo
!call lapack_diag(eigvalues,eigvectors,H_matrix_total,n_det_total,n_det_total)
!print*,'H_matrix_total(1,1) = ',H_matrix_total(1,1)
!print*,'e_dressed = ',eigvalues(1) + nuclear_repulsion
!do i = 1, n_det_total
! print*,'coef = ',eigvectors(i,1),H_matrix_total(i,i) - H_matrix_total(1,1)
!enddo
!norm = 0.d0
!do i = 1, n_det_total
! do j = 1, N_states
! psi_coef_final(i,j) = eigvectors(i,j)
! enddo
! norm += psi_coef_final(i,1)**2
!enddo
!print*,'norm = ',norm
call set_psi_det_as_input_psi(n_det_total,psi_det_final,psi_coef_final) call set_psi_det_as_input_psi(n_det_total,psi_det_final,psi_coef_final)
print*,''
!do i = 1, N_det do i = 1, N_det
! call debug_det(psi_det(1,1,i),N_int) call debug_det(psi_det(1,1,i),N_int)
! print*,'coef = ',psi_coef(i,1) print*,'coef = ',psi_coef(i,1)
!enddo enddo
provide one_body_dm_mo provide one_body_dm_mo
integer :: i_core,iorb,jorb,i_inact,j_inact,i_virt,j_virt,j_core integer :: i_core,iorb,jorb,i_inact,j_inact,i_virt,j_virt,j_core
@ -360,14 +623,14 @@ subroutine new_approach
print*,'ACTIVE ORBITAL ',iorb print*,'ACTIVE ORBITAL ',iorb
do j = 1, n_inact_orb do j = 1, n_inact_orb
jorb = list_inact(j) jorb = list_inact(j)
if(dabs(one_body_dm_mo(iorb,jorb)).gt.threshold_singles)then if(dabs(one_body_dm_mo(iorb,jorb)).gt.threshold_lmct)then
print*,'INACTIVE ' print*,'INACTIVE '
print*,'DM ',iorb,jorb,dabs(one_body_dm_mo(iorb,jorb)) print*,'DM ',iorb,jorb,dabs(one_body_dm_mo(iorb,jorb))
endif endif
enddo enddo
do j = 1, n_virt_orb do j = 1, n_virt_orb
jorb = list_virt(j) jorb = list_virt(j)
if(dabs(one_body_dm_mo(iorb,jorb)).gt.threshold_singles)then if(dabs(one_body_dm_mo(iorb,jorb)).gt.threshold_mlct)then
print*,'VIRT ' print*,'VIRT '
print*,'DM ',iorb,jorb,dabs(one_body_dm_mo(iorb,jorb)) print*,'DM ',iorb,jorb,dabs(one_body_dm_mo(iorb,jorb))
endif endif

View File

@ -0,0 +1,132 @@
program test_new_new
implicit none
read_wf = .True.
touch read_wf
call test
end
subroutine test
implicit none
integer :: i,j,k,l
call diagonalize_CI
call set_generators_to_psi_det
print*,'Initial coefficients'
do i = 1, N_det
print*,''
call debug_det(psi_det(1,1,i),N_int)
print*,'psi_coef = ',psi_coef(i,1)
print*,''
enddo
double precision, allocatable :: dressing_matrix(:,:)
double precision :: hij
double precision :: phase
integer :: n_h,n_p,number_of_holes,number_of_particles
integer :: exc(0:2,2,2)
integer :: degree
integer :: h1,h2,p1,p2,s1,s2
allocate(dressing_matrix(N_det_generators,N_det_generators))
do i = 1, N_det_generators
do j = 1, N_det_generators
call i_h_j(psi_det_generators(1,1,i),psi_det_generators(1,1,j),N_int,hij)
dressing_matrix(i,j) = hij
enddo
enddo
href = dressing_matrix(1,1)
print*,'Diagonal part of the dressing'
do i = 1, N_det_generators
print*,'delta e = ',dressing_matrix(i,i) - href
enddo
call all_single_split(psi_det_generators,psi_coef_generators,N_det_generators,dressing_matrix)
double precision :: href
print*,''
! One considers that the following excitation classes are not repeatable on the 1h and 1p determinants :
! + 1h1p spin flip
! + 2h1p
! + 1h2p
! But the 2h2p are correctly taken into account
!dressing_matrix(1,1) += total_corr_e_1h2p + total_corr_e_2h1p + total_corr_e_1h1p_spin_flip
!do i = 1, N_det_generators
! dressing_matrix(i,i) += total_corr_e_2h2p
! n_h = number_of_holes(psi_det(1,1,i))
! n_p = number_of_particles(psi_det(1,1,i))
! if(n_h == 1 .and. n_p ==0)then
!
! call get_excitation(ref_bitmask,psi_det_generators(1,1,i),exc,degree,phase,N_int)
! call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
! print*,''
! print*,' 1h det '
! print*,''
! call debug_det(psi_det_generators(1,1,i),N_int)
! print*,'h1,p1 = ',h1,p1
! print*,'total_corr_e_2h2p ',total_corr_e_2h2p
! print*,'corr_energy_2h2p_per_orb_ab(h1)',corr_energy_2h2p_per_orb_ab(h1)
! print*,'corr_energy_2h2p_per_orb_bb(h1)',corr_energy_2h2p_per_orb_bb(h1)
! dressing_matrix(i,i) += -corr_energy_2h2p_per_orb_ab(h1) - corr_energy_2h2p_per_orb_bb(h1)
! dressing_matrix(1,1) += -corr_energy_2h1p_per_orb_aa(h1) - corr_energy_2h1p_per_orb_ab(h1) -corr_energy_2h1p_per_orb_bb(h1) &
! -corr_energy_1h1p_spin_flip_per_orb(h1)
! endif
! if(n_h == 0 .and. n_p ==1)then
! call get_excitation(ref_bitmask,psi_det_generators(1,1,i),exc,degree,phase,N_int)
! call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
! print*,''
! print*,' 1p det '
! print*,''
! call debug_det(psi_det_generators(1,1,i),N_int)
! print*,'h1,p1 = ',h1,p1
! print*,'total_corr_e_2h2p ',total_corr_e_2h2p
! print*,'corr_energy_2h2p_per_orb_ab(p1)',corr_energy_2h2p_per_orb_ab(p1)
! print*,'corr_energy_2h2p_per_orb_aa(p1)',corr_energy_2h2p_per_orb_aa(p1)
! dressing_matrix(i,i) += -corr_energy_2h2p_per_orb_ab(p1) - corr_energy_2h2p_per_orb_aa(p1)
! dressing_matrix(1,1) += -corr_energy_1h2p_per_orb_aa(p1) - corr_energy_1h2p_per_orb_ab(p1) -corr_energy_1h2p_per_orb_bb(p1)
! endif
!enddo
!href = dressing_matrix(1,1)
!print*,'Diagonal part of the dressing'
!do i = 1, N_det_generators
! print*,'delta e = ',dressing_matrix(i,i) - href
!enddo
call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix)
print*,'After dressing matrix'
print*,''
print*,''
do i = 1, N_det
print*,'psi_coef = ',psi_coef(i,1)
enddo
!print*,''
!print*,''
!print*,'Canceling the dressing part of the interaction between 1h and 1p'
!do i = 2, N_det_generators
! do j = i+1, N_det_generators
! call i_h_j(psi_det_generators(1,1,i),psi_det_generators(1,1,j),N_int,hij)
! dressing_matrix(i,j) = hij
! dressing_matrix(j,i) = hij
! enddo
!enddo
!call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix)
!print*,''
!print*,''
!do i = 1, N_det
! print*,'psi_coef = ',psi_coef(i,1)
!enddo
!print*,''
!print*,''
!print*,'Canceling the interaction between 1h and 1p'
!print*,''
!print*,''
!do i = 2, N_det_generators
! do j = i+1, N_det_generators
! dressing_matrix(i,j) = 0.d0
! dressing_matrix(j,i) = 0.d0
! enddo
!enddo
!call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix)
!do i = 1, N_det
! print*,'psi_coef = ',psi_coef(i,1)
!enddo
call save_natural_mos
deallocate(dressing_matrix)
end

View File

@ -55,15 +55,11 @@ subroutine provide_matrix_dressing(dressing_matrix,ndet_generators_input,psi_det
i_pert = 0 i_pert = 0
endif endif
do j = 1, ndet_generators_input do j = 1, ndet_generators_input
if(dabs(H_array(j)*lambda_i).gt.0.5d0)then if(dabs(H_array(j)*lambda_i).gt.0.1d0)then
i_pert = 1 i_pert = 1
exit exit
endif endif
enddo enddo
! print*,''
! print*,'lambda_i,f = ',lambda_i,f
! print*,'i_pert = ',i_pert
! print*,''
if(i_pert==1)then if(i_pert==1)then
lambda_i = f lambda_i = f
i_pert_count +=1 i_pert_count +=1
@ -79,9 +75,122 @@ subroutine provide_matrix_dressing(dressing_matrix,ndet_generators_input,psi_det
enddo enddo
enddo enddo
enddo enddo
href = dressing_matrix(1,1)
print*,'Diagonal part of the dressing'
do i = 1, ndet_generators_input
print*,'delta e = ',dressing_matrix(i,i) - href
enddo
!print*,'i_pert_count = ',i_pert_count !print*,'i_pert_count = ',i_pert_count
end end
subroutine update_matrix_dressing_sc2(dressing_matrix,ndet_generators_input,psi_det_generators_input,H_jj_in)
use bitmasks
implicit none
integer, intent(in) :: ndet_generators_input
integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,ndet_generators_input)
double precision, intent(in) :: H_jj_in(N_det)
double precision, intent(inout) :: dressing_matrix(ndet_generators_input,ndet_generators_input)
integer :: i,j,n_det_ref_tmp,degree
double precision :: href
n_det_ref_tmp = 0
do i = 1, N_det
do j = 1, Ndet_generators_input
call get_excitation_degree(psi_det(1,1,i),psi_det_generators_input(1,1,j),degree,N_int)
if(degree == 0)then
dressing_matrix(j,j) += H_jj_in(i)
n_det_ref_tmp +=1
exit
endif
enddo
enddo
if( ndet_generators_input .ne. n_det_ref_tmp)then
print*,'Problem !!!! '
print*,' ndet_generators .ne. n_det_ref_tmp !!!'
print*,'ndet_generators,n_det_ref_tmp'
print*,ndet_generators_input,n_det_ref_tmp
stop
endif
href = dressing_matrix(1,1)
print*,''
print*,'Update with the SC2 dressing'
print*,''
print*,'Diagonal part of the dressing'
do i = 1, ndet_generators_input
print*,'delta e = ',dressing_matrix(i,i) - href
enddo
end
subroutine provide_matrix_dressing_for_extra_1h_or_1p(dressing_matrix,psi_det_ref_input,psi_coef_ref_input,n_det_ref_input, &
psi_det_outer_input,psi_coef_outer_input,n_det_outer_input)
use bitmasks
implicit none
integer, intent(in) :: n_det_ref_input
integer(bit_kind), intent(in) :: psi_det_ref_input(N_int,2,n_det_ref_input)
double precision, intent(in) :: psi_coef_ref_input(n_det_ref_input,N_states)
integer, intent(in) :: n_det_outer_input
integer(bit_kind), intent(in) :: psi_det_outer_input(N_int,2,n_det_outer_input)
double precision, intent(in) :: psi_coef_outer_input(n_det_outer_input,N_states)
double precision, intent(inout) :: dressing_matrix(n_det_ref_input,n_det_ref_input)
integer :: i_pert, i_pert_count,i,j,k
double precision :: f,href,hka,lambda_i
double precision :: H_array(n_det_ref_input),accu
integer :: n_h_out,n_p_out,n_p_in,n_h_in,number_of_holes,number_of_particles
call i_h_j(psi_det_ref_input(1,1,1),psi_det_ref_input(1,1,1),N_int,href)
i_pert_count = 0
do i = 1, n_det_outer_input
call i_h_j(psi_det_outer_input(1,1,i),psi_det_outer_input(1,1,i),N_int,hka)
f = 1.d0/(href - hka)
H_array = 0.d0
accu = 0.d0
! n_h_out = number_of_holes(psi_det_outer_input(1,1,i))
! n_p_out = number_of_particles(psi_det_outer_input(1,1,i))
do j=1,n_det_ref_input
n_h_in = number_of_holes(psi_det_ref_input(1,1,j))
n_p_in = number_of_particles(psi_det_ref_input(1,1,j))
! if(n_h_in == 0 .and. n_h_in == 0)then
call i_h_j(psi_det_outer_input(1,1,i),psi_det_ref_input(1,1,j),N_int,hka)
! else
! hka = 0.d0
! endif
H_array(j) = hka
accu += psi_coef_ref_input(j,1) * hka
enddo
lambda_i = psi_coef_outer_input(i,1)/accu
i_pert = 1
if(accu * f / psi_coef_outer_input(i,1) .gt. 0.5d0 .and. accu * f/psi_coef_outer_input(i,1).gt.0.d0)then
i_pert = 0
endif
do j = 1, n_det_ref_input
if(dabs(H_array(j)*lambda_i).gt.0.5d0)then
i_pert = 1
exit
endif
enddo
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! i_pert = 0
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
if(i_pert==1)then
lambda_i = f
i_pert_count +=1
endif
do k=1,n_det_ref_input
double precision :: contrib
contrib = H_array(k) * H_array(k) * lambda_i
dressing_matrix(k, k) += contrib
do j=k+1,n_det_ref_input
contrib = H_array(k) * H_array(j) * lambda_i
dressing_matrix(k, j) += contrib
dressing_matrix(j, k) += contrib
enddo
enddo
enddo
end
subroutine provide_matrix_dressing_general(dressing_matrix,psi_det_ref_input,psi_coef_ref_input,n_det_ref_input, & subroutine provide_matrix_dressing_general(dressing_matrix,psi_det_ref_input,psi_coef_ref_input,n_det_ref_input, &
psi_det_outer_input,psi_coef_outer_input,n_det_outer_input) psi_det_outer_input,psi_coef_outer_input,n_det_outer_input)
use bitmasks use bitmasks
@ -112,16 +221,17 @@ subroutine provide_matrix_dressing_general(dressing_matrix,psi_det_ref_input,psi
accu += psi_coef_ref_input(j,1) * hka accu += psi_coef_ref_input(j,1) * hka
enddo enddo
lambda_i = psi_coef_outer_input(i,1)/accu lambda_i = psi_coef_outer_input(i,1)/accu
i_pert = 1 i_pert = 0
if(accu * f / psi_coef_outer_input(i,1) .gt. 0.5d0 .and. accu * f/psi_coef_outer_input(i,1).gt.0.d0)then if(accu * f / psi_coef_outer_input(i,1) .gt. 0.5d0 .and. accu * f/psi_coef_outer_input(i,1).gt.0.d0)then
i_pert = 0 i_pert = 0
endif endif
do j = 1, n_det_ref_input do j = 1, n_det_ref_input
if(dabs(H_array(j)*lambda_i).gt.0.3d0)then if(dabs(H_array(j)*lambda_i).gt.0.5d0)then
i_pert = 1 i_pert = 1
exit exit
endif endif
enddo enddo
! i_pert = 0
if(i_pert==1)then if(i_pert==1)then
lambda_i = f lambda_i = f
i_pert_count +=1 i_pert_count +=1
@ -170,114 +280,379 @@ subroutine diag_dressed_matrix_and_set_to_psi_det(psi_det_generators_input,Ndet_
end end
subroutine give_n_1h1p_and_n_2h1p_in_psi_det(n_det_1h1p,n_det_2h1p) subroutine give_n_1h1p_and_n_2h1p_in_psi_det(i_hole,n_det_extra_1h_or_1p,n_det_1h1p,n_det_2h1p)
use bitmasks use bitmasks
implicit none implicit none
integer, intent(out) :: n_det_1h1p, n_det_2h1p integer, intent(in) :: i_hole
integer, intent(out) :: n_det_1h1p, n_det_2h1p,n_det_extra_1h_or_1p
integer :: i integer :: i
integer :: n_det_ref_restart_tmp,n_det_1h integer :: n_det_ref_restart_tmp,n_det_1h
integer :: number_of_holes,n_h, number_of_particles,n_p integer :: number_of_holes,n_h, number_of_particles,n_p
logical :: is_the_hole_in_det
n_det_ref_restart_tmp = 0 n_det_ref_restart_tmp = 0
n_det_1h = 0 n_det_1h = 0
n_det_1h1p = 0 n_det_1h1p = 0
n_det_2h1p = 0 n_det_2h1p = 0
n_det_extra_1h_or_1p = 0
do i = 1, N_det do i = 1, N_det
n_h = number_of_holes(psi_det(1,1,i)) n_h = number_of_holes(psi_det(1,1,i))
n_p = number_of_particles(psi_det(1,1,i)) n_p = number_of_particles(psi_det(1,1,i))
if(n_h == 0 .and. n_p == 0)then if(n_h == 0 .and. n_p == 0)then
n_det_ref_restart_tmp +=1 n_det_ref_restart_tmp +=1
else if (n_h ==1 .and. n_p==0)then else if (n_h ==1 .and. n_p==0)then
n_det_1h +=1 if(is_the_hole_in_det(psi_det(1,1,i),1,i_hole).or.is_the_hole_in_det(psi_det(1,1,i),2,i_hole))then
n_det_1h +=1
else
n_det_extra_1h_or_1p +=1
endif
else if (n_h ==0 .and. n_p==1)then
n_det_extra_1h_or_1p +=1
else if (n_h ==1 .and. n_p==1)then else if (n_h ==1 .and. n_p==1)then
n_det_1h1p +=1 n_det_1h1p +=1
else if (n_h ==2 .and. n_p==1)then else if (n_h ==2 .and. n_p==1)then
n_det_2h1p +=1 n_det_2h1p +=1
else else
print*,'PB !!!!' print*,'PB !!!!'
print*,'You have something else than a 1h, 1h1p or 2h1p' print*,'You have something else than a 1h, 1p, 1h1p or 2h1p'
print*,'n_h,n_p = ',n_h,n_p
call debug_det(psi_det(1,1,i),N_int) call debug_det(psi_det(1,1,i),N_int)
stop stop
endif endif
enddo enddo
! if(n_det_1h.ne.1)then
! print*,'PB !! You have more than one 1h'
! stop
! endif
if(n_det_ref_restart_tmp + n_det_1h .ne. n_det_generators)then if(n_det_ref_restart_tmp + n_det_1h .ne. n_det_generators)then
print*,'PB !!!!' print*,'PB !!!!'
print*,'You have forgotten something in your generators ... ' print*,'You have forgotten something in your generators ... '
stop stop
endif endif
if(n_det_2h1p + n_det_1h1p + n_det_extra_1h_or_1p + n_det_generators .ne. N_det)then
print*,'PB !!!!'
print*,'You have forgotten something in your generators ... '
stop
endif
end end
subroutine give_n_1h1p_and_n_1h2p_in_psi_det(n_det_1h1p,n_det_1h2p) subroutine give_n_ref_1h_1p_and_n_2h1p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p)
use bitmasks use bitmasks
implicit none implicit none
integer, intent(out) :: n_det_1h1p, n_det_1h2p integer, intent(out) :: n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p
integer :: i integer :: i
integer :: n_det_ref_restart_tmp,n_det_1h integer :: n_det_ref_restart_tmp,n_det_1h
integer :: number_of_holes,n_h, number_of_particles,n_p integer :: number_of_holes,n_h, number_of_particles,n_p
n_det_ref_restart_tmp = 0 logical :: is_the_hole_in_det
n_det_1h = 0 n_det_ref_1h_1p = 0
n_det_2h1p = 0
n_det_1h1p = 0 n_det_1h1p = 0
n_det_1h2p = 0
do i = 1, N_det do i = 1, N_det
n_h = number_of_holes(psi_det(1,1,i)) n_h = number_of_holes(psi_det(1,1,i))
n_p = number_of_particles(psi_det(1,1,i)) n_p = number_of_particles(psi_det(1,1,i))
if(n_h == 0 .and. n_p == 0)then if(n_h == 0 .and. n_p == 0)then
n_det_ref_restart_tmp +=1 n_det_ref_1h_1p +=1
else if (n_h ==1 .and. n_p==0)then
n_det_ref_1h_1p +=1
else if (n_h ==0 .and. n_p==1)then else if (n_h ==0 .and. n_p==1)then
n_det_1h +=1 n_det_ref_1h_1p +=1
else if (n_h ==1 .and. n_p==1)then
n_det_1h1p +=1
else if (n_h ==2 .and. n_p==1)then
n_det_2h1p +=1
else
print*,'PB !!!!'
print*,'You have something else than a 1h, 1p, 1h1p or 2h1p'
print*,'n_h,n_p = ',n_h,n_p
call debug_det(psi_det(1,1,i),N_int)
stop
endif
enddo
end
subroutine give_n_ref_1h_1p_and_n_1h2p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p)
use bitmasks
implicit none
integer, intent(out) :: n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p
integer :: i
integer :: n_det_ref_restart_tmp,n_det_1h
integer :: number_of_holes,n_h, number_of_particles,n_p
logical :: is_the_hole_in_det
n_det_ref_1h_1p = 0
n_det_1h2p = 0
n_det_1h1p = 0
do i = 1, N_det
n_h = number_of_holes(psi_det(1,1,i))
n_p = number_of_particles(psi_det(1,1,i))
if(n_h == 0 .and. n_p == 0)then
n_det_ref_1h_1p +=1
else if (n_h ==1 .and. n_p==0)then
n_det_ref_1h_1p +=1
else if (n_h ==0 .and. n_p==1)then
n_det_ref_1h_1p +=1
else if (n_h ==1 .and. n_p==1)then else if (n_h ==1 .and. n_p==1)then
n_det_1h1p +=1 n_det_1h1p +=1
else if (n_h ==1 .and. n_p==2)then else if (n_h ==1 .and. n_p==2)then
n_det_1h2p +=1 n_det_1h2p +=1
else else
print*,'PB !!!!' print*,'PB !!!!'
print*,'You have something else than a 1p, 1h1p or 1h2p' print*,'You have something else than a 1h, 1p, 1h1p or 1h2p'
print*,'n_h,n_p = ',n_h,n_p
call debug_det(psi_det(1,1,i),N_int) call debug_det(psi_det(1,1,i),N_int)
stop stop
endif endif
enddo enddo
if(n_det_ref_restart_tmp + n_det_1h .ne. n_det_generators)then
end
subroutine give_wf_n_ref_1h_1p_and_n_2h1p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,&
psi_det_2h1p,psi_coef_2h1p,psi_det_1h1p,psi_coef_1h1p)
use bitmasks
implicit none
integer, intent(in) :: n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p
integer(bit_kind), intent(out) :: psi_det_ref_1h_1p(N_int,2,n_det_ref_1h_1p)
integer(bit_kind), intent(out) :: psi_det_2h1p(N_int,2,n_det_2h1p)
integer(bit_kind), intent(out) :: psi_det_1h1p(N_int,2,n_det_1h1p)
double precision, intent(out) :: psi_coef_ref_1h_1p(n_det_ref_1h_1p,N_states)
double precision, intent(out) :: psi_coef_2h1p(n_det_2h1p,N_states)
double precision, intent(out) :: psi_coef_1h1p(n_det_1h1p,N_states)
integer :: n_det_ref_1h_1p_tmp,n_det_2h1p_tmp,n_det_1h1p_tmp
integer :: i,j
integer :: n_det_ref_restart_tmp,n_det_1h
integer :: number_of_holes,n_h, number_of_particles,n_p
logical :: is_the_hole_in_det
integer, allocatable :: index_ref_1h_1p(:)
integer, allocatable :: index_2h1p(:)
integer, allocatable :: index_1h1p(:)
allocate(index_ref_1h_1p(n_det))
allocate(index_2h1p(n_det))
allocate(index_1h1p(n_det))
n_det_ref_1h_1p_tmp = 0
n_det_2h1p_tmp = 0
n_det_1h1p_tmp = 0
do i = 1, N_det
n_h = number_of_holes(psi_det(1,1,i))
n_p = number_of_particles(psi_det(1,1,i))
if(n_h == 0 .and. n_p == 0)then
n_det_ref_1h_1p_tmp +=1
index_ref_1h_1p(n_det_ref_1h_1p_tmp) = i
else if (n_h ==1 .and. n_p==0)then
n_det_ref_1h_1p_tmp +=1
index_ref_1h_1p(n_det_ref_1h_1p_tmp) = i
else if (n_h ==0 .and. n_p==1)then
n_det_ref_1h_1p_tmp +=1
index_ref_1h_1p(n_det_ref_1h_1p_tmp) = i
else if (n_h ==1 .and. n_p==1)then
n_det_1h1p_tmp +=1
index_1h1p(n_det_1h1p_tmp) = i
else if (n_h ==2 .and. n_p==1)then
n_det_2h1p_tmp +=1
index_2h1p(n_det_2h1p_tmp) = i
else
print*,'PB !!!!' print*,'PB !!!!'
print*,'You have forgotten something in your generators ... ' print*,'You have something else than a 1h, 1p, 1h1p or 2h1p'
print*,'n_h,n_p = ',n_h,n_p
call debug_det(psi_det(1,1,i),N_int)
stop stop
endif endif
enddo
do i = 1, n_det_2h1p
do j = 1, N_int
psi_det_2h1p(j,1,i) = psi_det(j,1,index_2h1p(i))
psi_det_2h1p(j,2,i) = psi_det(j,2,index_2h1p(i))
enddo
do j = 1, N_states
psi_coef_2h1p(i,j) = psi_coef(index_2h1p(i),j)
enddo
enddo
do i = 1, n_det_1h1p
do j = 1, N_int
psi_det_1h1p(j,1,i) = psi_det(j,1,index_1h1p(i))
psi_det_1h1p(j,2,i) = psi_det(j,2,index_1h1p(i))
enddo
do j = 1, N_states
psi_coef_1h1p(i,j) = psi_coef(index_1h1p(i),j)
enddo
enddo
do i = 1, n_det_ref_1h_1p
do j = 1, N_int
psi_det_ref_1h_1p(j,1,i) = psi_det(j,1,index_ref_1h_1p(i))
psi_det_ref_1h_1p(j,2,i) = psi_det(j,2,index_ref_1h_1p(i))
enddo
do j = 1, N_states
psi_coef_ref_1h_1p(i,j) = psi_coef(index_ref_1h_1p(i),j)
enddo
enddo
end
subroutine give_wf_n_ref_1h_1p_and_n_1h2p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,&
psi_det_1h2p,psi_coef_1h2p,psi_det_1h1p,psi_coef_1h1p)
use bitmasks
implicit none
integer, intent(in) :: n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p
integer(bit_kind), intent(out) :: psi_det_ref_1h_1p(N_int,2,n_det_ref_1h_1p)
integer(bit_kind), intent(out) :: psi_det_1h2p(N_int,2,n_det_1h2p)
integer(bit_kind), intent(out) :: psi_det_1h1p(N_int,2,n_det_1h1p)
double precision, intent(out) :: psi_coef_ref_1h_1p(n_det_ref_1h_1p,N_states)
double precision, intent(out) :: psi_coef_1h2p(n_det_1h2p,N_states)
double precision, intent(out) :: psi_coef_1h1p(n_det_1h1p,N_states)
integer :: n_det_ref_1h_1p_tmp,n_det_1h2p_tmp,n_det_1h1p_tmp
integer :: i,j
integer :: n_det_ref_restart_tmp,n_det_1h
integer :: number_of_holes,n_h, number_of_particles,n_p
logical :: is_the_hole_in_det
integer, allocatable :: index_ref_1h_1p(:)
integer, allocatable :: index_1h2p(:)
integer, allocatable :: index_1h1p(:)
allocate(index_ref_1h_1p(n_det))
allocate(index_1h2p(n_det))
allocate(index_1h1p(n_det))
n_det_ref_1h_1p_tmp = 0
n_det_1h2p_tmp = 0
n_det_1h1p_tmp = 0
do i = 1, N_det
n_h = number_of_holes(psi_det(1,1,i))
n_p = number_of_particles(psi_det(1,1,i))
if(n_h == 0 .and. n_p == 0)then
n_det_ref_1h_1p_tmp +=1
index_ref_1h_1p(n_det_ref_1h_1p_tmp) = i
else if (n_h ==1 .and. n_p==0)then
n_det_ref_1h_1p_tmp +=1
index_ref_1h_1p(n_det_ref_1h_1p_tmp) = i
else if (n_h ==0 .and. n_p==1)then
n_det_ref_1h_1p_tmp +=1
index_ref_1h_1p(n_det_ref_1h_1p_tmp) = i
else if (n_h ==1 .and. n_p==1)then
n_det_1h1p_tmp +=1
index_1h1p(n_det_1h1p_tmp) = i
else if (n_h ==1 .and. n_p==2)then
n_det_1h2p_tmp +=1
index_1h2p(n_det_1h2p_tmp) = i
else
print*,'PB !!!!'
print*,'You have something else than a 1h, 1p, 1h1p or 1h2p'
print*,'n_h,n_p = ',n_h,n_p
call debug_det(psi_det(1,1,i),N_int)
stop
endif
enddo
do i = 1, n_det_1h2p
do j = 1, N_int
psi_det_1h2p(j,1,i) = psi_det(j,1,index_1h2p(i))
psi_det_1h2p(j,2,i) = psi_det(j,2,index_1h2p(i))
enddo
do j = 1, N_states
psi_coef_1h2p(i,j) = psi_coef(index_1h2p(i),j)
enddo
enddo
do i = 1, n_det_1h1p
do j = 1, N_int
psi_det_1h1p(j,1,i) = psi_det(j,1,index_1h1p(i))
psi_det_1h1p(j,2,i) = psi_det(j,2,index_1h1p(i))
enddo
do j = 1, N_states
psi_coef_1h1p(i,j) = psi_coef(index_1h1p(i),j)
enddo
enddo
do i = 1, n_det_ref_1h_1p
do j = 1, N_int
psi_det_ref_1h_1p(j,1,i) = psi_det(j,1,index_ref_1h_1p(i))
psi_det_ref_1h_1p(j,2,i) = psi_det(j,2,index_ref_1h_1p(i))
enddo
do j = 1, N_states
psi_coef_ref_1h_1p(i,j) = psi_coef(index_ref_1h_1p(i),j)
enddo
enddo
end
subroutine give_n_1h1p_and_n_1h2p_in_psi_det(i_particl,n_det_extra_1h_or_1p,n_det_1h1p,n_det_1h2p)
use bitmasks
implicit none
integer, intent(in) ::i_particl
integer, intent(out) :: n_det_1h1p, n_det_1h2p,n_det_extra_1h_or_1p
integer :: i
integer :: n_det_ref_restart_tmp,n_det_1p
integer :: number_of_holes,n_h, number_of_particles,n_p
logical :: is_the_particl_in_det
n_det_ref_restart_tmp = 0
n_det_1p = 0
n_det_1h1p = 0
n_det_1h2p = 0
n_det_extra_1h_or_1p = 0
do i = 1, N_det
n_h = number_of_holes(psi_det(1,1,i))
n_p = number_of_particles(psi_det(1,1,i))
if(n_h == 0 .and. n_p == 0)then
n_det_ref_restart_tmp +=1
else if (n_h ==0 .and. n_p==1)then
if(is_the_particl_in_det(psi_det(1,1,i),1,i_particl).or.is_the_particl_in_det(psi_det(1,1,i),2,i_particl))then
n_det_1p +=1
else
n_det_extra_1h_or_1p +=1
endif
else if (n_h ==1 .and. n_p==0)then
n_det_extra_1h_or_1p +=1
else if (n_h ==1 .and. n_p==1)then
n_det_1h1p +=1
else if (n_h ==1 .and. n_p==2)then
n_det_1h2p +=1
else
print*,'PB !!!!'
print*,'You have something else than a 1h, 1p, 1h1p or 1h2p'
call debug_det(psi_det(1,1,i),N_int)
stop
endif
enddo
!if(n_det_ref_restart_tmp + n_det_1h .ne. n_det_generators)then
! print*,'PB !!!!'
! print*,'You have forgotten something in your generators ... '
! stop
!endif
end end
subroutine split_wf_generators_and_1h1p_and_2h1p(n_det_1h1p,n_det_2h1p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_2h1p,psi_coef_2h1p) subroutine split_wf_generators_and_1h1p_and_2h1p(i_hole,n_det_extra_1h_or_1p,n_det_1h1p,n_det_2h1p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_2h1p,psi_coef_2h1p,psi_extra_1h_or_1p,psi_coef_extra_1h_or_1p)
use bitmasks use bitmasks
implicit none implicit none
integer, intent(in) :: n_det_1h1p,n_det_2h1p integer, intent(in) :: n_det_1h1p,n_det_2h1p,n_det_extra_1h_or_1p,i_hole
integer(bit_kind), intent(out) :: psi_ref_out(N_int,2,N_det_generators) integer(bit_kind), intent(out) :: psi_ref_out(N_int,2,N_det_generators)
integer(bit_kind), intent(out) :: psi_1h1p(N_int,2,n_det_1h1p) integer(bit_kind), intent(out) :: psi_1h1p(N_int,2,n_det_1h1p)
integer(bit_kind), intent(out) :: psi_2h1p(N_int,2,n_det_2h1p) integer(bit_kind), intent(out) :: psi_2h1p(N_int,2,n_det_2h1p)
integer(bit_kind), intent(out) :: psi_extra_1h_or_1p(N_int,2,n_det_extra_1h_or_1p)
double precision, intent(out) :: psi_ref_coef_out(N_det_generators,N_states) double precision, intent(out) :: psi_ref_coef_out(N_det_generators,N_states)
double precision, intent(out) :: psi_coef_1h1p(n_det_1h1p, N_states) double precision, intent(out) :: psi_coef_1h1p(n_det_1h1p, N_states)
double precision, intent(out) :: psi_coef_2h1p(n_det_2h1p, N_states) double precision, intent(out) :: psi_coef_2h1p(n_det_2h1p, N_states)
double precision, intent(out) :: psi_coef_extra_1h_or_1p(n_det_extra_1h_or_1p, N_states)
integer :: i,j integer :: i,j
integer :: degree integer :: degree
integer :: number_of_holes,n_h, number_of_particles,n_p integer :: number_of_holes,n_h, number_of_particles,n_p
integer :: n_det_generators_tmp,n_det_1h1p_tmp,n_det_2h1p_tmp integer :: n_det_generators_tmp,n_det_1h1p_tmp,n_det_2h1p_tmp,n_det_extra_1h_or_1p_tmp
integer :: n_det_1h_tmp
integer, allocatable :: index_generator(:) integer, allocatable :: index_generator(:)
integer, allocatable :: index_1h1p(:) integer, allocatable :: index_1h1p(:)
integer, allocatable :: index_2h1p(:) integer, allocatable :: index_2h1p(:)
integer, allocatable :: index_extra_1h_or_1p(:)
logical :: is_the_hole_in_det
allocate(index_1h1p(n_det)) allocate(index_1h1p(n_det))
allocate(index_2h1p(n_det)) allocate(index_2h1p(n_det))
allocate(index_extra_1h_or_1p(n_det))
allocate(index_generator(N_det)) allocate(index_generator(N_det))
n_det_generators_tmp = 0 n_det_generators_tmp = 0
n_det_1h1p_tmp = 0 n_det_1h1p_tmp = 0
n_det_2h1p_tmp = 0 n_det_2h1p_tmp = 0
n_det_extra_1h_or_1p_tmp = 0
n_det_1h_tmp = 0
do i = 1, n_det do i = 1, n_det
n_h = number_of_holes(psi_det(1,1,i)) n_h = number_of_holes(psi_det(1,1,i))
n_p = number_of_particles(psi_det(1,1,i)) n_p = number_of_particles(psi_det(1,1,i))
@ -287,6 +662,16 @@ subroutine split_wf_generators_and_1h1p_and_2h1p(n_det_1h1p,n_det_2h1p,psi_ref_o
else if (n_h ==2 .and. n_p==1)then else if (n_h ==2 .and. n_p==1)then
n_det_2h1p_tmp +=1 n_det_2h1p_tmp +=1
index_2h1p(n_det_2h1p_tmp) = i index_2h1p(n_det_2h1p_tmp) = i
else if (n_h ==0 .and. n_p==1)then
n_det_extra_1h_or_1p_tmp +=1
index_extra_1h_or_1p(n_det_extra_1h_or_1p_tmp) = i
else if (n_h ==1 .and. n_p==0)then
if(is_the_hole_in_det(psi_det(1,1,i),1,i_hole).or.is_the_hole_in_det(psi_det(1,1,i),2,i_hole))then
n_det_1h_tmp +=1
else
n_det_extra_1h_or_1p_tmp +=1
index_extra_1h_or_1p(n_det_extra_1h_or_1p_tmp) = i
endif
endif endif
do j = 1, N_det_generators do j = 1, N_det_generators
call get_excitation_degree(psi_det_generators(1,1,j),psi_det(1,1,i), degree, N_int) call get_excitation_degree(psi_det_generators(1,1,j),psi_det(1,1,i), degree, N_int)
@ -315,6 +700,12 @@ subroutine split_wf_generators_and_1h1p_and_2h1p(n_det_1h1p,n_det_2h1p,psi_ref_o
stop stop
endif endif
if(n_det_extra_1h_or_1p.ne.n_det_extra_1h_or_1p_tmp)then
print*,'PB !!!'
print*,'n_det_extra_1h_or_1p.ne.n_det_extra_1h_or_1p_tmp'
stop
endif
do i = 1,N_det_generators do i = 1,N_det_generators
do j = 1, N_int do j = 1, N_int
psi_ref_out(j,1,i) = psi_det(j,1,index_generator(i)) psi_ref_out(j,1,i) = psi_det(j,1,index_generator(i))
@ -345,41 +736,59 @@ subroutine split_wf_generators_and_1h1p_and_2h1p(n_det_1h1p,n_det_2h1p,psi_ref_o
enddo enddo
enddo enddo
do i = 1, n_det_extra_1h_or_1p
do j = 1, N_int
psi_extra_1h_or_1p(j,1,i) = psi_det(j,1,index_extra_1h_or_1p(i))
psi_extra_1h_or_1p(j,2,i) = psi_det(j,2,index_extra_1h_or_1p(i))
enddo
do j = 1, N_states
psi_coef_extra_1h_or_1p(i,j) = psi_coef(index_extra_1h_or_1p(i),j)
enddo
enddo
deallocate(index_generator) deallocate(index_generator)
deallocate(index_1h1p) deallocate(index_1h1p)
deallocate(index_2h1p) deallocate(index_2h1p)
deallocate(index_extra_1h_or_1p)
end end
subroutine split_wf_generators_and_1h1p_and_1h2p(n_det_1h1p,n_det_1h2p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_1h2p,psi_coef_1h2p) subroutine split_wf_generators_and_1h1p_and_1h2p(i_particl,n_det_extra_1h_or_1p,n_det_1h1p,n_det_1h2p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_1h2p,psi_coef_1h2p,psi_extra_1h_or_1p,psi_coef_extra_1h_or_1p)
use bitmasks use bitmasks
implicit none implicit none
integer, intent(in) :: n_det_1h1p,n_det_1h2p integer, intent(in) :: n_det_1h1p,n_det_1h2p,n_det_extra_1h_or_1p,i_particl
integer(bit_kind), intent(out) :: psi_ref_out(N_int,2,N_det_generators) integer(bit_kind), intent(out) :: psi_ref_out(N_int,2,N_det_generators)
integer(bit_kind), intent(out) :: psi_1h1p(N_int,2,n_det_1h1p) integer(bit_kind), intent(out) :: psi_1h1p(N_int,2,n_det_1h1p)
integer(bit_kind), intent(out) :: psi_1h2p(N_int,2,n_det_1h2p) integer(bit_kind), intent(out) :: psi_1h2p(N_int,2,n_det_1h2p)
integer(bit_kind), intent(out) :: psi_extra_1h_or_1p(N_int,2,n_det_extra_1h_or_1p)
double precision, intent(out) :: psi_ref_coef_out(N_det_generators,N_states) double precision, intent(out) :: psi_ref_coef_out(N_det_generators,N_states)
double precision, intent(out) :: psi_coef_1h1p(n_det_1h1p, N_states) double precision, intent(out) :: psi_coef_1h1p(n_det_1h1p, N_states)
double precision, intent(out) :: psi_coef_1h2p(n_det_1h2p, N_states) double precision, intent(out) :: psi_coef_1h2p(n_det_1h2p, N_states)
double precision, intent(out) :: psi_coef_extra_1h_or_1p(n_det_extra_1h_or_1p, N_states)
integer :: i,j integer :: i,j
integer :: degree integer :: degree
integer :: number_of_holes,n_h, number_of_particles,n_p integer :: number_of_holes,n_h, number_of_particles,n_p
integer :: n_det_generators_tmp,n_det_1h1p_tmp,n_det_1h2p_tmp integer :: n_det_generators_tmp,n_det_1h1p_tmp,n_det_1h2p_tmp,n_det_extra_1h_or_1p_tmp
integer, allocatable :: index_generator(:) integer, allocatable :: index_generator(:)
integer, allocatable :: index_1h1p(:) integer, allocatable :: index_1h1p(:)
integer, allocatable :: index_1h2p(:) integer, allocatable :: index_1h2p(:)
integer, allocatable :: index_extra_1h_or_1p(:)
logical :: is_the_particl_in_det
integer :: n_det_1p_tmp
allocate(index_1h1p(n_det)) allocate(index_1h1p(n_det))
allocate(index_1h2p(n_det)) allocate(index_1h2p(n_det))
allocate(index_extra_1h_or_1p(n_det))
allocate(index_generator(N_det)) allocate(index_generator(N_det))
n_det_generators_tmp = 0 n_det_generators_tmp = 0
n_det_1h1p_tmp = 0 n_det_1h1p_tmp = 0
n_det_1h2p_tmp = 0 n_det_1h2p_tmp = 0
n_det_extra_1h_or_1p_tmp = 0
n_det_1p_tmp = 0
do i = 1, n_det do i = 1, n_det
n_h = number_of_holes(psi_det(1,1,i)) n_h = number_of_holes(psi_det(1,1,i))
n_p = number_of_particles(psi_det(1,1,i)) n_p = number_of_particles(psi_det(1,1,i))
@ -389,6 +798,15 @@ subroutine split_wf_generators_and_1h1p_and_1h2p(n_det_1h1p,n_det_1h2p,psi_ref_o
else if (n_h ==1 .and. n_p==2)then else if (n_h ==1 .and. n_p==2)then
n_det_1h2p_tmp +=1 n_det_1h2p_tmp +=1
index_1h2p(n_det_1h2p_tmp) = i index_1h2p(n_det_1h2p_tmp) = i
else if (n_h ==1 .and. n_p==0)then
n_det_extra_1h_or_1p_tmp +=1
index_extra_1h_or_1p(n_det_extra_1h_or_1p_tmp) = i
else if (n_h ==0 .and. n_p==1)then
if(is_the_particl_in_det(psi_det(1,1,i),1,i_particl).or.is_the_particl_in_det(psi_det(1,1,i),2,i_particl))then
n_det_1p_tmp +=1
else
n_det_extra_1h_or_1p_tmp +=1
endif
endif endif
do j = 1, N_det_generators do j = 1, N_det_generators
call get_excitation_degree(psi_det_generators(1,1,j),psi_det(1,1,i), degree, N_int) call get_excitation_degree(psi_det_generators(1,1,j),psi_det(1,1,i), degree, N_int)
@ -448,9 +866,20 @@ subroutine split_wf_generators_and_1h1p_and_1h2p(n_det_1h1p,n_det_1h2p,psi_ref_o
enddo enddo
do i = 1, n_det_extra_1h_or_1p
do j = 1, N_int
psi_extra_1h_or_1p(j,1,i) = psi_det(j,1,index_extra_1h_or_1p(i))
psi_extra_1h_or_1p(j,2,i) = psi_det(j,2,index_extra_1h_or_1p(i))
enddo
do j = 1, N_states
psi_coef_extra_1h_or_1p(i,j) = psi_coef(index_extra_1h_or_1p(i),j)
enddo
enddo
deallocate(index_generator) deallocate(index_generator)
deallocate(index_1h1p) deallocate(index_1h1p)
deallocate(index_1h2p) deallocate(index_1h2p)
deallocate(index_extra_1h_or_1p)
end end

View File

@ -332,20 +332,20 @@ subroutine save_osoci_natural_mos
enddo enddo
tmp = tmp_bis tmp = tmp_bis
!! Symetrization act-virt !!! Symetrization act-virt
do j = 1, n_virt_orb ! do j = 1, n_virt_orb
j_virt= list_virt(j) ! j_virt= list_virt(j)
accu = 0.d0 ! accu = 0.d0
do i = 1, n_act_orb ! do i = 1, n_act_orb
jorb = list_act(i) ! jorb = list_act(i)
accu += dabs(tmp_bis(j_virt,jorb)) ! accu += dabs(tmp_bis(j_virt,jorb))
enddo ! enddo
do i = 1, n_act_orb ! do i = 1, n_act_orb
iorb = list_act(i) ! iorb = list_act(i)
tmp(j_virt,iorb) = dsign(accu/dble(n_act_orb),tmp_bis(j_virt,iorb)) ! tmp(j_virt,iorb) = dsign(accu/dble(n_act_orb),tmp_bis(j_virt,iorb))
tmp(iorb,j_virt) = dsign(accu/dble(n_act_orb),tmp_bis(j_virt,iorb)) ! tmp(iorb,j_virt) = dsign(accu/dble(n_act_orb),tmp_bis(j_virt,iorb))
enddo ! enddo
enddo ! enddo
!! Symetrization act-inact !! Symetrization act-inact
!do j = 1, n_inact_orb !do j = 1, n_inact_orb
@ -387,16 +387,16 @@ subroutine save_osoci_natural_mos
print*,'ACTIVE ORBITAL ',iorb print*,'ACTIVE ORBITAL ',iorb
do j = 1, n_inact_orb do j = 1, n_inact_orb
jorb = list_inact(j) jorb = list_inact(j)
if(dabs(tmp(iorb,jorb)).gt.threshold_singles)then if(dabs(tmp(iorb,jorb)).gt.threshold_lmct)then
print*,'INACTIVE ' print*,'INACTIVE '
print*,'DM ',iorb,jorb,dabs(tmp(iorb,jorb)) print*,'DM ',iorb,jorb,(tmp(iorb,jorb))
endif endif
enddo enddo
do j = 1, n_virt_orb do j = 1, n_virt_orb
jorb = list_virt(j) jorb = list_virt(j)
if(dabs(tmp(iorb,jorb)).gt.threshold_singles)then if(dabs(tmp(iorb,jorb)).gt.threshold_mlct)then
print*,'VIRT ' print*,'VIRT '
print*,'DM ',iorb,jorb,dabs(tmp(iorb,jorb)) print*,'DM ',iorb,jorb,(tmp(iorb,jorb))
endif endif
enddo enddo
enddo enddo
@ -410,8 +410,9 @@ subroutine save_osoci_natural_mos
enddo enddo
label = "Natural" label = "Natural"
call mo_as_eigvectors_of_mo_matrix(tmp,size(tmp,1),size(tmp,2),label,1) call mo_as_eigvectors_of_mo_matrix(tmp,size(tmp,1),size(tmp,2),label,1)
soft_touch mo_coef !soft_touch mo_coef
deallocate(tmp,occ) deallocate(tmp,occ)
@ -518,16 +519,16 @@ subroutine set_osoci_natural_mos
print*,'ACTIVE ORBITAL ',iorb print*,'ACTIVE ORBITAL ',iorb
do j = 1, n_inact_orb do j = 1, n_inact_orb
jorb = list_inact(j) jorb = list_inact(j)
if(dabs(tmp(iorb,jorb)).gt.threshold_singles)then if(dabs(tmp(iorb,jorb)).gt.threshold_lmct)then
print*,'INACTIVE ' print*,'INACTIVE '
print*,'DM ',iorb,jorb,dabs(tmp(iorb,jorb)) print*,'DM ',iorb,jorb,(tmp(iorb,jorb))
endif endif
enddo enddo
do j = 1, n_virt_orb do j = 1, n_virt_orb
jorb = list_virt(j) jorb = list_virt(j)
if(dabs(tmp(iorb,jorb)).gt.threshold_singles)then if(dabs(tmp(iorb,jorb)).gt.threshold_mlct)then
print*,'VIRT ' print*,'VIRT '
print*,'DM ',iorb,jorb,dabs(tmp(iorb,jorb)) print*,'DM ',iorb,jorb,(tmp(iorb,jorb))
endif endif
enddo enddo
enddo enddo
@ -602,15 +603,210 @@ end
subroutine provide_properties subroutine provide_properties
implicit none implicit none
integer :: i call print_mulliken_sd
double precision :: accu call print_hcc
if(.True.)then
accu= 0.d0
do i = 1, nucl_num
accu += mulliken_spin_densities(i)
print*,i,nucl_charge(i),mulliken_spin_densities(i)
enddo
print*,'Sum of Mulliken SD = ',accu
endif
end end
subroutine dress_diag_elem_2h1p(dressing_H_mat_elem,ndet,lmct,i_hole)
use bitmasks
double precision, intent(inout) :: dressing_H_mat_elem(Ndet)
integer, intent(in) :: ndet,i_hole
logical, intent(in) :: lmct
! if lmct = .True. ===> LMCT
! else ===> MLCT
implicit none
integer :: i
integer :: n_p,n_h,number_of_holes,number_of_particles
integer :: exc(0:2,2,2)
integer :: degree
double precision :: phase
integer :: h1,h2,p1,p2,s1,s2
do i = 1, N_det
n_h = number_of_holes(psi_det(1,1,i))
n_p = number_of_particles(psi_det(1,1,i))
call get_excitation(ref_bitmask,psi_det(1,1,i),exc,degree,phase,N_int)
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
if (n_h == 0.and.n_p==0)then ! CAS
dressing_H_mat_elem(i)+= total_corr_e_2h1p
if(lmct)then
dressing_H_mat_elem(i) += - corr_energy_2h1p_per_orb_ab(i_hole) - corr_energy_2h1p_per_orb_bb(i_hole)
endif
endif
if (n_h == 1.and.n_p==0)then ! 1h
dressing_H_mat_elem(i)+= 0.d0
else if (n_h == 0.and.n_p==1)then ! 1p
dressing_H_mat_elem(i)+= total_corr_e_2h1p
dressing_H_mat_elem(i) += - corr_energy_2h1p_per_orb_ab(p1) - corr_energy_2h1p_per_orb_aa(p1)
else if (n_h == 1.and.n_p==1)then ! 1h1p
! if(degree==1)then
dressing_H_mat_elem(i)+= total_corr_e_2h1p
dressing_H_mat_elem(i)+= - corr_energy_2h1p_per_orb_ab(h1)
! else
! dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(h1) &
! - 0.5d0 * (corr_energy_2h2p_per_orb_aa(h1) + corr_energy_2h2p_per_orb_bb(h1))
! dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(p2) &
! - 0.5d0 * (corr_energy_2h2p_per_orb_aa(p2) + corr_energy_2h2p_per_orb_bb(p2))
! dressing_H_mat_elem(i) += 0.5d0 * (corr_energy_2h2p_for_1h1p_double(h1,p1))
! endif
else if (n_h == 2.and.n_p==1)then ! 2h1p
dressing_H_mat_elem(i)+= 0.d0
else if (n_h == 1.and.n_p==2)then ! 1h2p
dressing_H_mat_elem(i)+= total_corr_e_2h1p
dressing_H_mat_elem(i) += - corr_energy_2h1p_per_orb_ab(h1)
endif
enddo
end
subroutine dress_diag_elem_1h2p(dressing_H_mat_elem,ndet,lmct,i_hole)
use bitmasks
double precision, intent(inout) :: dressing_H_mat_elem(Ndet)
integer, intent(in) :: ndet,i_hole
logical, intent(in) :: lmct
! if lmct = .True. ===> LMCT
! else ===> MLCT
implicit none
integer :: i
integer :: n_p,n_h,number_of_holes,number_of_particles
integer :: exc(0:2,2,2)
integer :: degree
double precision :: phase
integer :: h1,h2,p1,p2,s1,s2
do i = 1, N_det
n_h = number_of_holes(psi_det(1,1,i))
n_p = number_of_particles(psi_det(1,1,i))
call get_excitation(ref_bitmask,psi_det(1,1,i),exc,degree,phase,N_int)
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
if (n_h == 0.and.n_p==0)then ! CAS
dressing_H_mat_elem(i)+= total_corr_e_1h2p
if(.not.lmct)then
dressing_H_mat_elem(i) += - corr_energy_1h2p_per_orb_ab(i_hole) - corr_energy_1h2p_per_orb_aa(i_hole)
endif
endif
if (n_h == 1.and.n_p==0)then ! 1h
dressing_H_mat_elem(i)+= total_corr_e_1h2p - corr_energy_1h2p_per_orb_ab(h1)
else if (n_h == 0.and.n_p==1)then ! 1p
dressing_H_mat_elem(i)+= 0.d0
else if (n_h == 1.and.n_p==1)then ! 1h1p
if(degree==1)then
dressing_H_mat_elem(i)+= total_corr_e_1h2p
dressing_H_mat_elem(i)+= - corr_energy_1h2p_per_orb_ab(h1)
else
dressing_H_mat_elem(i) +=0.d0
endif
! dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(h1) &
! - 0.5d0 * (corr_energy_2h2p_per_orb_aa(h1) + corr_energy_2h2p_per_orb_bb(h1))
! dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(p2) &
! - 0.5d0 * (corr_energy_2h2p_per_orb_aa(p2) + corr_energy_2h2p_per_orb_bb(p2))
! dressing_H_mat_elem(i) += 0.5d0 * (corr_energy_2h2p_for_1h1p_double(h1,p1))
! endif
else if (n_h == 2.and.n_p==1)then ! 2h1p
dressing_H_mat_elem(i)+= total_corr_e_1h2p
dressing_H_mat_elem(i)+= - corr_energy_1h2p_per_orb_ab(h1) - corr_energy_1h2p_per_orb_ab(h1)
else if (n_h == 1.and.n_p==2)then ! 1h2p
dressing_H_mat_elem(i) += 0.d0
endif
enddo
end
subroutine dress_diag_elem_2h2p(dressing_H_mat_elem,ndet)
use bitmasks
double precision, intent(inout) :: dressing_H_mat_elem(Ndet)
integer, intent(in) :: ndet
implicit none
integer :: i
integer :: n_p,n_h,number_of_holes,number_of_particles
integer :: exc(0:2,2,2)
integer :: degree
double precision :: phase
integer :: h1,h2,p1,p2,s1,s2
do i = 1, N_det
dressing_H_mat_elem(i)+= total_corr_e_2h2p
n_h = number_of_holes(psi_det(1,1,i))
n_p = number_of_particles(psi_det(1,1,i))
call get_excitation(ref_bitmask,psi_det(1,1,i),exc,degree,phase,N_int)
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
if (n_h == 1.and.n_p==0)then ! 1h
dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(h1) &
- 0.5d0 * (corr_energy_2h2p_per_orb_aa(h1) + corr_energy_2h2p_per_orb_bb(h1))
else if (n_h == 0.and.n_p==1)then ! 1p
dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(p1) &
- 0.5d0 * (corr_energy_2h2p_per_orb_aa(p1) + corr_energy_2h2p_per_orb_bb(p1))
else if (n_h == 1.and.n_p==1)then ! 1h1p
if(degree==1)then
dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(h1) &
- 0.5d0 * (corr_energy_2h2p_per_orb_aa(h1) + corr_energy_2h2p_per_orb_bb(h1))
dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(p1) &
- 0.5d0 * (corr_energy_2h2p_per_orb_aa(p1) + corr_energy_2h2p_per_orb_bb(p1))
dressing_H_mat_elem(i) += 0.5d0 * (corr_energy_2h2p_for_1h1p_a(h1,p1) + corr_energy_2h2p_for_1h1p_b(h1,p1))
else
dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(h1) &
- 0.5d0 * (corr_energy_2h2p_per_orb_aa(h1) + corr_energy_2h2p_per_orb_bb(h1))
dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(p2) &
- 0.5d0 * (corr_energy_2h2p_per_orb_aa(p2) + corr_energy_2h2p_per_orb_bb(p2))
dressing_H_mat_elem(i) += 0.5d0 * (corr_energy_2h2p_for_1h1p_double(h1,p1))
endif
else if (n_h == 2.and.n_p==1)then ! 2h1p
dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(h1) - corr_energy_2h2p_per_orb_bb(h1) &
- corr_energy_2h2p_per_orb_ab(h2) &
- 0.5d0 * ( corr_energy_2h2p_per_orb_bb(h2) + corr_energy_2h2p_per_orb_bb(h2))
dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(p1)
if(s1.ne.s2)then
dressing_H_mat_elem(i) += corr_energy_2h2p_ab_2_orb(h1,h2)
else
dressing_H_mat_elem(i) += corr_energy_2h2p_bb_2_orb(h1,h2)
endif
else if (n_h == 1.and.n_p==2)then ! 1h2p
dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(h1) &
- 0.5d0 * (corr_energy_2h2p_per_orb_aa(h1) + corr_energy_2h2p_per_orb_bb(h1))
dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(p1) &
- 0.5d0 * (corr_energy_2h2p_per_orb_aa(p1) + corr_energy_2h2p_per_orb_bb(p1))
dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(p2) &
- 0.5d0 * (corr_energy_2h2p_per_orb_aa(p2) + corr_energy_2h2p_per_orb_bb(p2))
if(s1.ne.s2)then
dressing_H_mat_elem(i) += corr_energy_2h2p_ab_2_orb(p1,p2)
else
dressing_H_mat_elem(i) += corr_energy_2h2p_bb_2_orb(p1,p2)
endif
endif
enddo
end
subroutine diag_dressed_2h2p_hamiltonian_and_update_psi_det(i_hole,lmct)
implicit none
double precision, allocatable :: dressing_H_mat_elem(:),energies(:)
integer, intent(in) :: i_hole
logical, intent(in) :: lmct
! if lmct = .True. ===> LMCT
! else ===> MLCT
integer :: i
double precision :: hij
allocate(dressing_H_mat_elem(N_det),energies(N_states_diag))
print*,''
print*,'dressing with the 2h2p in a CC logic'
print*,''
do i = 1, N_det
call i_h_j(psi_det(1,1,i),psi_det(1,1,i),N_int,hij)
dressing_H_mat_elem(i) = hij
enddo
call dress_diag_elem_2h2p(dressing_H_mat_elem,N_det)
call dress_diag_elem_2h1p(dressing_H_mat_elem,N_det,lmct,i_hole)
call dress_diag_elem_1h2p(dressing_H_mat_elem,N_det,lmct,i_hole)
call davidson_diag_hjj(psi_det,psi_coef,dressing_H_mat_elem,energies,size(psi_coef,1),N_det,N_states_diag,N_int,output_determinants)
do i = 1, 2
print*,'psi_coef = ',psi_coef(i,1)
enddo
deallocate(dressing_H_mat_elem)
end

View File

@ -7,6 +7,11 @@ s.set_selection_pt2("epstein_nesbet_2x2")
#s.unset_openmp() #s.unset_openmp()
print s print s
#s = H_apply("FCI_PT2")
#s.set_perturbation("epstein_nesbet_2x2")
#s.unset_openmp()
#print s
s = H_apply_zmq("FCI_PT2") s = H_apply_zmq("FCI_PT2")
s.set_perturbation("epstein_nesbet_2x2") s.set_perturbation("epstein_nesbet_2x2")
s.unset_openmp() s.unset_openmp()

View File

@ -24,6 +24,8 @@ subroutine run_wf
integer(ZMQ_PTR) :: zmq_to_qp_run_socket integer(ZMQ_PTR) :: zmq_to_qp_run_socket
print *, 'Getting wave function' print *, 'Getting wave function'
zmq_context = f77_zmq_ctx_new ()
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
call zmq_get_psi(zmq_to_qp_run_socket, 1) call zmq_get_psi(zmq_to_qp_run_socket, 1)
@ -33,6 +35,8 @@ subroutine run_wf
call provide_everything call provide_everything
integer :: rc, i integer :: rc, i
print *, 'Contribution to PT2 running'
!$OMP PARALLEL PRIVATE(i) !$OMP PARALLEL PRIVATE(i)
i = omp_get_thread_num() i = omp_get_thread_num()
call H_apply_FCI_PT2_slave_tcp(i) call H_apply_FCI_PT2_slave_tcp(i)

View File

@ -8,17 +8,18 @@ BEGIN_PROVIDER [ integer, N_det_generators ]
integer :: i integer :: i
integer, save :: ifirst = 0 integer, save :: ifirst = 0
double precision :: norm double precision :: norm
read_wf = .True.
if(ifirst == 0)then if(ifirst == 0)then
N_det_generators = N_det call ezfio_get_determinants_n_det(N_det_generators)
ifirst = 1 ifirst = 1
else
print*,'PB in generators restart !!!'
endif endif
call write_int(output_determinants,N_det_generators,'Number of generators') call write_int(output_determinants,N_det_generators,'Number of generators')
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), psi_det_generators, (N_int,2,psi_det_size) ] BEGIN_PROVIDER [ integer(bit_kind), psi_det_generators, (N_int,2,N_det_generators) ]
&BEGIN_PROVIDER [ double precision, psi_coef_generators, (psi_det_size,N_states) ] &BEGIN_PROVIDER [ double precision, psi_coef_generators, (N_det_generators,N_states) ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! read wf ! read wf
@ -26,17 +27,20 @@ END_PROVIDER
END_DOC END_DOC
integer :: i, k integer :: i, k
integer, save :: ifirst = 0 integer, save :: ifirst = 0
double precision, allocatable :: psi_coef_read(:,:)
if(ifirst == 0)then if(ifirst == 0)then
do i=1,N_det_generators call read_dets(psi_det_generators,N_int,N_det_generators)
do k=1,N_int allocate (psi_coef_read(N_det_generators,N_states))
psi_det_generators(k,1,i) = psi_det(k,1,i) call ezfio_get_determinants_psi_coef(psi_coef_read)
psi_det_generators(k,2,i) = psi_det(k,2,i)
enddo
do k = 1, N_states do k = 1, N_states
psi_coef_generators(i,k) = psi_coef(i,k) do i = 1, N_det_generators
psi_coef_generators(i,k) = psi_coef_read(i,k)
enddo
enddo enddo
enddo
ifirst = 1 ifirst = 1
deallocate(psi_coef_read)
else
print*,'PB in generators restart !!!'
endif endif
END_PROVIDER END_PROVIDER

View File

@ -119,7 +119,9 @@ subroutine damping_SCF
write(output_hartree_fock,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') '====','================','================','================', '====' write(output_hartree_fock,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') '====','================','================','================', '===='
write(output_hartree_fock,*) write(output_hartree_fock,*)
call mo_as_eigvectors_of_mo_matrix(Fock_matrix_mo,size(Fock_matrix_mo,1),size(Fock_matrix_mo,2),mo_label,1) if(.not.no_oa_or_av_opt)then
call mo_as_eigvectors_of_mo_matrix(Fock_matrix_mo,size(Fock_matrix_mo,1),size(Fock_matrix_mo,2),mo_label,1)
endif
call write_double(output_hartree_fock, E_min, 'Hartree-Fock energy') call write_double(output_hartree_fock, E_min, 'Hartree-Fock energy')
call ezfio_set_hartree_fock_energy(E_min) call ezfio_set_hartree_fock_energy(E_min)

View File

@ -65,8 +65,17 @@ subroutine run_pt2(N_st,energy)
threshold_selectors = 1.d0 threshold_selectors = 1.d0
threshold_generators = 0.999d0 threshold_generators = 0.999d0
N_det_generators = lambda_mrcc_pt2(0) N_det_generators = lambda_mrcc_pt2(0) + N_det_cas
do i=1,N_det_generators do i=1,N_det_cas
do k=1,N_int
psi_det_generators(k,1,i) = psi_ref(k,1,i)
psi_det_generators(k,2,i) = psi_ref(k,2,i)
enddo
do k=1,N_st
psi_coef_generators(i,k) = psi_ref_coef(i,k)
enddo
enddo
do i=N_det_cas+1,N_det_generators
j = lambda_mrcc_pt2(i) j = lambda_mrcc_pt2(i)
do k=1,N_int do k=1,N_int
psi_det_generators(k,1,i) = psi_non_ref(k,1,j) psi_det_generators(k,1,i) = psi_non_ref(k,1,j)

View File

@ -25,7 +25,7 @@ print s
s = H_apply_zmq("mrcc_PT2") s = H_apply("mrcc_PT2")
s.energy = "ci_electronic_energy_dressed" s.energy = "ci_electronic_energy_dressed"
s.set_perturbation("epstein_nesbet_2x2") s.set_perturbation("epstein_nesbet_2x2")
s.unset_openmp() s.unset_openmp()
@ -36,6 +36,11 @@ s.energy = "psi_ref_energy_diagonalized"
s.set_perturbation("epstein_nesbet_2x2") s.set_perturbation("epstein_nesbet_2x2")
s.unset_openmp() s.unset_openmp()
print s print s
#s = H_apply_zmq("mrcc_PT2")
#s.energy = "ci_electronic_energy_dressed"
#s.set_perturbation("epstein_nesbet_2x2")
#s.unset_openmp()
#print s
END_SHELL END_SHELL

View File

@ -1,196 +0,0 @@
BEGIN_PROVIDER [ character*(128), ao_l_char, (ao_num) ]
implicit none
BEGIN_DOC
! ao_l = l value of the AO: a+b+c in x^a y^b z^c
END_DOC
integer :: i
do i=1,ao_num
ao_l_char(i) = l_to_character(ao_l(i))
enddo
END_PROVIDER
BEGIN_PROVIDER [ character*(128), l_to_character, (0:4)]
BEGIN_DOC
! character corresponding to the "L" value of an AO orbital
END_DOC
implicit none
l_to_character(0)='S'
l_to_character(1)='P'
l_to_character(2)='D'
l_to_character(3)='F'
l_to_character(4)='G'
END_PROVIDER
BEGIN_PROVIDER [ integer, Nucl_N_Aos, (nucl_num)]
&BEGIN_PROVIDER [ integer, N_AOs_max ]
implicit none
integer :: i
BEGIN_DOC
! Number of AOs per atom
END_DOC
Nucl_N_Aos = 0
do i = 1, ao_num
Nucl_N_Aos(ao_nucl(i)) +=1
enddo
N_AOs_max = maxval(Nucl_N_Aos)
END_PROVIDER
BEGIN_PROVIDER [ integer, Nucl_Aos, (nucl_num,N_AOs_max)]
implicit none
BEGIN_DOC
! List of AOs attached on each atom
END_DOC
integer :: i
integer, allocatable :: nucl_tmp(:)
allocate(nucl_tmp(nucl_num))
nucl_tmp = 0
Nucl_Aos = 0
do i = 1, ao_num
nucl_tmp(ao_nucl(i))+=1
Nucl_Aos(ao_nucl(i),nucl_tmp(ao_nucl(i))) = i
enddo
deallocate(nucl_tmp)
END_PROVIDER
BEGIN_PROVIDER [ integer, Nucl_list_shell_Aos, (nucl_num,N_AOs_max)]
&BEGIN_PROVIDER [ integer, Nucl_num_shell_Aos, (nucl_num)]
implicit none
integer :: i,j,k
BEGIN_DOC
! Index of the shell type Aos and of the corresponding Aos
! Per convention, for P,D,F and G AOs, we take the index
! of the AO with the the corresponding power in the "X" axis
END_DOC
do i = 1, nucl_num
Nucl_num_shell_Aos(i) = 0
do j = 1, Nucl_N_Aos(i)
if(ao_l(Nucl_Aos(i,j))==0)then
! S type function
Nucl_num_shell_Aos(i)+=1
Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j)
elseif(ao_l(Nucl_Aos(i,j))==1)then
! P type function
if(ao_power(Nucl_Aos(i,j),1)==1)then
Nucl_num_shell_Aos(i)+=1
Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j)
endif
elseif(ao_l(Nucl_Aos(i,j))==2)then
! D type function
if(ao_power(Nucl_Aos(i,j),1)==2)then
Nucl_num_shell_Aos(i)+=1
Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j)
endif
elseif(ao_l(Nucl_Aos(i,j))==3)then
! F type function
if(ao_power(Nucl_Aos(i,j),1)==3)then
Nucl_num_shell_Aos(i)+=1
Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j)
endif
elseif(ao_l(Nucl_Aos(i,j))==4)then
! G type function
if(ao_power(Nucl_Aos(i,j),1)==4)then
Nucl_num_shell_Aos(i)+=1
Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j)
endif
endif
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ character*(4), ao_l_char_space, (ao_num) ]
implicit none
integer :: i
character*(4) :: give_ao_character_space
do i=1,ao_num
if(ao_l(i)==0)then
! S type AO
give_ao_character_space = 'S '
elseif(ao_l(i) == 1)then
! P type AO
if(ao_power(i,1)==1)then
give_ao_character_space = 'X '
elseif(ao_power(i,2) == 1)then
give_ao_character_space = 'Y '
else
give_ao_character_space = 'Z '
endif
elseif(ao_l(i) == 2)then
! D type AO
if(ao_power(i,1)==2)then
give_ao_character_space = 'XX '
elseif(ao_power(i,2) == 2)then
give_ao_character_space = 'YY '
elseif(ao_power(i,3) == 2)then
give_ao_character_space = 'ZZ '
elseif(ao_power(i,1) == 1 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'XY '
elseif(ao_power(i,1) == 1 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'XZ '
else
give_ao_character_space = 'YZ '
endif
elseif(ao_l(i) == 3)then
! F type AO
if(ao_power(i,1)==3)then
give_ao_character_space = 'XXX '
elseif(ao_power(i,2) == 3)then
give_ao_character_space = 'YYY '
elseif(ao_power(i,3) == 3)then
give_ao_character_space = 'ZZZ '
elseif(ao_power(i,1) == 2 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'XXY '
elseif(ao_power(i,1) == 2 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'XXZ '
elseif(ao_power(i,2) == 2 .and. ao_power(i,1) == 1)then
give_ao_character_space = 'YYX '
elseif(ao_power(i,2) == 2 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'YYZ '
elseif(ao_power(i,3) == 2 .and. ao_power(i,1) == 1)then
give_ao_character_space = 'ZZX '
elseif(ao_power(i,3) == 2 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'ZZY '
elseif(ao_power(i,3) == 1 .and. ao_power(i,2) == 1 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'XYZ '
endif
elseif(ao_l(i) == 4)then
! G type AO
if(ao_power(i,1)==4)then
give_ao_character_space = 'XXXX'
elseif(ao_power(i,2) == 4)then
give_ao_character_space = 'YYYY'
elseif(ao_power(i,3) == 4)then
give_ao_character_space = 'ZZZZ'
elseif(ao_power(i,1) == 3 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'XXXY'
elseif(ao_power(i,1) == 3 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'XXXZ'
elseif(ao_power(i,2) == 3 .and. ao_power(i,1) == 1)then
give_ao_character_space = 'YYYX'
elseif(ao_power(i,2) == 3 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'YYYZ'
elseif(ao_power(i,3) == 3 .and. ao_power(i,1) == 1)then
give_ao_character_space = 'ZZZX'
elseif(ao_power(i,3) == 3 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'ZZZY'
elseif(ao_power(i,1) == 2 .and. ao_power(i,2) == 2)then
give_ao_character_space = 'XXYY'
elseif(ao_power(i,2) == 2 .and. ao_power(i,3) == 2)then
give_ao_character_space = 'YYZZ'
elseif(ao_power(i,1) == 2 .and. ao_power(i,2) == 1 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'XXYZ'
elseif(ao_power(i,2) == 2 .and. ao_power(i,1) == 1 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'YYXZ'
elseif(ao_power(i,3) == 2 .and. ao_power(i,1) == 1 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'ZZXY'
endif
endif
ao_l_char_space(i) = give_ao_character_space
enddo
END_PROVIDER

View File

@ -104,6 +104,8 @@ subroutine write_Ao_basis(i_unit_output)
write(i_unit_output,*)'' write(i_unit_output,*)''
write(i_unit_output,'(A47,2X,I3)')'TOTAL NUMBER OF BASIS SET SHELLS =', i_shell write(i_unit_output,'(A47,2X,I3)')'TOTAL NUMBER OF BASIS SET SHELLS =', i_shell
write(i_unit_output,'(A47,2X,I3)')'NUMBER OF CARTESIAN GAUSSIAN BASIS FUNCTIONS =', ao_num write(i_unit_output,'(A47,2X,I3)')'NUMBER OF CARTESIAN GAUSSIAN BASIS FUNCTIONS =', ao_num
! this is for the new version of molden
write(i_unit_output,'(A12)')'PP =NONE'
write(i_unit_output,*)'' write(i_unit_output,*)''
@ -126,7 +128,9 @@ subroutine write_Mo_basis(i_unit_output)
write(i_unit_output,'(18X,F8.5)')-1.d0 write(i_unit_output,'(18X,F8.5)')-1.d0
write(i_unit_output,*)'' write(i_unit_output,*)''
do i = 1, ao_num do i = 1, ao_num
write(i_unit_output,'(2X,I3, 2X A1, I3, 2X A4 , F9.6)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),(ao_l_char_space(i)),mo_coef(i,j) ! write(i_unit_output,'(2X,I3, 2X A1, I3, 2X A4 , F9.6)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),(ao_l_char_space(i)),mo_coef(i,j)
! F12.6 for larger coefficients...
write(i_unit_output,'(2X,I3, 2X A1, I3, 2X A4 , F12.6)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),(ao_l_char_space(i)),mo_coef(i,j)
! write(i_unit_output,'(I3, X A1, X I3, X A4 X F16.8)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),(ao_l_char_space(i)) ! write(i_unit_output,'(I3, X A1, X I3, X A4 X F16.8)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),(ao_l_char_space(i))
enddo enddo
write(i_unit_output,*)'' write(i_unit_output,*)''

View File

@ -125,6 +125,8 @@ subroutine pt2_moller_plesset ($arguments)
delta_e = (Fock_matrix_diag_mo(h1) - Fock_matrix_diag_mo(p1)) + & delta_e = (Fock_matrix_diag_mo(h1) - Fock_matrix_diag_mo(p1)) + &
(Fock_matrix_diag_mo(h2) - Fock_matrix_diag_mo(p2)) (Fock_matrix_diag_mo(h2) - Fock_matrix_diag_mo(p2))
delta_e = 1.d0/delta_e delta_e = 1.d0/delta_e
! print*,'h1,p1',h1,p1
! print*,'h2,p2',h2,p2
else if (degree == 1) then else if (degree == 1) then
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
delta_e = Fock_matrix_diag_mo(h1) - Fock_matrix_diag_mo(p1) delta_e = Fock_matrix_diag_mo(h1) - Fock_matrix_diag_mo(p1)

View File

@ -133,3 +133,16 @@ END_PROVIDER
enddo enddo
END_PROVIDER END_PROVIDER
subroutine print_hcc
implicit none
double precision :: accu
integer :: i,j
print*,'Z AU GAUSS MHZ cm^-1'
do i = 1, nucl_num
write(*,'(I2,X,F3.1,X,4(F16.6,X))')i,nucl_charge(i),spin_density_at_nucleous(i),iso_hcc_gauss(i),iso_hcc_mhz(i),iso_hcc_cm_1(i)
enddo
end

View File

@ -105,3 +105,34 @@ END_PROVIDER
enddo enddo
END_PROVIDER END_PROVIDER
subroutine print_mulliken_sd
implicit none
double precision :: accu
integer :: i
integer :: j
print*,'Mulliken spin densities'
accu= 0.d0
do i = 1, nucl_num
print*,i,nucl_charge(i),mulliken_spin_densities(i)
accu += mulliken_spin_densities(i)
enddo
print*,'Sum of Mulliken SD = ',accu
print*,'AO SPIN POPULATIONS'
accu = 0.d0
do i = 1, ao_num
accu += spin_gross_orbital_product(i)
write(*,'(X,I3,X,A4,X,I2,X,A4,X,F10.7)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),trim(l_to_charater(ao_l(i))),spin_gross_orbital_product(i)
enddo
print*,'sum = ',accu
accu = 0.d0
print*,'Angular momentum analysis'
do i = 0, ao_l_max
accu += spin_population_angular_momentum(i)
print*,' ',trim(l_to_charater(i)),spin_population_angular_momentum(i)
print*,'sum = ',accu
enddo
end

View File

@ -1,17 +1,6 @@
program print_hcc program print_hcc_main
implicit none implicit none
read_wf = .True. read_wf = .True.
touch read_wf touch read_wf
call test call print_hcc
end end
subroutine test
implicit none
double precision :: accu
integer :: i,j
print*,'Z AU GAUSS MHZ cm^-1'
do i = 1, nucl_num
write(*,'(I2,X,F3.1,X,4(F16.6,X))')i,nucl_charge(i),spin_density_at_nucleous(i),iso_hcc_gauss(i),iso_hcc_mhz(i),iso_hcc_cm_1(i)
enddo
end

View File

@ -2,34 +2,5 @@ program print_mulliken
implicit none implicit none
read_wf = .True. read_wf = .True.
touch read_wf touch read_wf
print*,'Mulliken spin densities' call print_mulliken_sd
call test
end end
subroutine test
double precision :: accu
integer :: i
integer :: j
accu= 0.d0
do i = 1, nucl_num
print*,i,nucl_charge(i),mulliken_spin_densities(i)
accu += mulliken_spin_densities(i)
enddo
print*,'Sum of Mulliken SD = ',accu
print*,'AO SPIN POPULATIONS'
accu = 0.d0
do i = 1, ao_num
accu += spin_gross_orbital_product(i)
write(*,'(X,I3,X,A4,X,I2,X,A4,X,F10.7)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),trim(l_to_charater(ao_l(i))),spin_gross_orbital_product(i)
enddo
print*,'sum = ',accu
accu = 0.d0
print*,'Angular momentum analysis'
do i = 0, ao_l_max
accu += spin_population_angular_momentum(i)
print*,' ',trim(l_to_charater(i)),spin_population_angular_momentum(i)
print*,'sum = ',accu
enddo
end

View File

@ -0,0 +1,102 @@
program e_curve
use bitmasks
implicit none
integer :: i,j,k, nab, m, l
double precision :: norm, E, hij, num, ci, cj
integer, allocatable :: iorder(:)
double precision , allocatable :: norm_sort(:)
nab = n_det_alpha_unique+n_det_beta_unique
allocate ( norm_sort(0:nab), iorder(0:nab) )
norm_sort(0) = 0.d0
iorder(0) = 0
do i=1,n_det_alpha_unique
norm_sort(i) = det_alpha_norm(i)
iorder(i) = i
enddo
do i=1,n_det_beta_unique
norm_sort(i+n_det_alpha_unique) = det_beta_norm(i)
iorder(i+n_det_alpha_unique) = -i
enddo
call dsort(norm_sort(1),iorder(1),nab)
if (.not.read_wf) then
stop 'Please set read_wf to true'
endif
PROVIDE psi_bilinear_matrix_values nuclear_repulsion
print *, ''
print *, '=============================='
print *, 'Energies at different cut-offs'
print *, '=============================='
print *, ''
print *, '=========================================================='
print '(A8,2X,A8,2X,A12,2X,A10,2X,A12)', 'Thresh.', 'Ndet', 'Cost', 'Norm', 'E'
print *, '=========================================================='
double precision :: thresh
integer(bit_kind), allocatable :: det_i(:,:), det_j(:,:)
thresh = 1.d-10
do j=0,nab
i = iorder(j)
if (i<0) then
do k=1,n_det
if (psi_bilinear_matrix_columns(k) == -i) then
psi_bilinear_matrix_values(k,1) = 0.d0
endif
enddo
else
do k=1,n_det
if (psi_bilinear_matrix_rows(k) == i) then
psi_bilinear_matrix_values(k,1) = 0.d0
endif
enddo
endif
if (thresh > norm_sort(j)) then
cycle
endif
num = 0.d0
norm = 0.d0
m = 0
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(k,l,det_i,det_j,ci,cj,hij) REDUCTION(+:norm,m,num)
allocate( det_i(N_int,2), det_j(N_int,2))
!$OMP DO SCHEDULE(guided)
do k=1,n_det
if (psi_bilinear_matrix_values(k,1) == 0.d0) then
cycle
endif
ci = psi_bilinear_matrix_values(k,1)
det_i(:,1) = psi_det_alpha_unique(:,psi_bilinear_matrix_rows(k))
det_i(:,2) = psi_det_beta_unique(:,psi_bilinear_matrix_columns(k))
do l=1,n_det
if (psi_bilinear_matrix_values(l,1) == 0.d0) then
cycle
endif
cj = psi_bilinear_matrix_values(l,1)
det_j(:,1) = psi_det_alpha_unique(:,psi_bilinear_matrix_rows(l))
det_j(:,2) = psi_det_beta_unique(:,psi_bilinear_matrix_columns(l))
call i_h_j(det_i, det_j, N_int, hij)
num = num + ci*cj*hij
enddo
norm = norm + ci*ci
m = m+1
enddo
!$OMP END DO
deallocate (det_i,det_j)
!$OMP END PARALLEL
if (m == 0) then
exit
endif
E = num / norm + nuclear_repulsion
print '(E9.1,2X,I8,2X,F10.2,2X,F10.8,2X,F12.6)', thresh, m, &
dble( elec_alpha_num**3 + elec_alpha_num**2 * (nab-1) ) / &
dble( elec_alpha_num**3 + elec_alpha_num**2 * (j-1)), norm, E
thresh = thresh * 2.d0
enddo
print *, '=========================================================='
deallocate (iorder, norm_sort)
end

View File

@ -1,9 +1,46 @@
program save_for_qmc program save_for_qmc
read_wf = .True.
TOUCH read_wf integer :: iunit
print *, "N_det = ", N_det integer, external :: get_unit_and_open
call write_spindeterminants logical :: exists
if (do_pseudo) then double precision :: e_ref
call write_pseudopotential
endif ! Determinants
read_wf = .True.
TOUCH read_wf
print *, "N_det = ", N_det
call write_spindeterminants
! Reference Energy
if (do_pseudo) then
call write_pseudopotential
endif
call system( &
'mkdir -p '//trim(ezfio_filename)//'/simulation ;' // &
'cp '//trim(ezfio_filename)//'/.version '//trim(ezfio_filename)//'/simulation/.version ; ' // &
'mkdir -p '//trim(ezfio_filename)//'/properties ;' // &
'cp '//trim(ezfio_filename)//'/.version '//trim(ezfio_filename)//'/properties/.version ; ' // &
'echo T > '//trim(ezfio_filename)//'/properties/e_loc' &
)
iunit = 13
open(unit=iunit,file=trim(ezfio_filename)//'/simulation/e_ref',action='write')
call ezfio_has_full_ci_energy_pt2(exists)
if (exists) then
call ezfio_get_full_ci_energy_pt2(e_ref)
else
call ezfio_has_full_ci_energy(exists)
if (exists) then
call ezfio_get_full_ci_energy(e_ref)
else
call ezfio_has_hartree_fock_energy(exists)
if (exists) then
call ezfio_get_hartree_fock_energy(e_ref)
else
e_ref = 0.d0
endif
endif
endif
write(iunit,*) e_ref
close(iunit)
end end

View File

@ -17,9 +17,11 @@ C
data small/1.d-6/ data small/1.d-6/
zprt=.true. zprt=.true.
niter=500 niter=1000000
conv=1.d-8 conv=1.d-8
C niter=1000000
C conv=1.d-6
write (6,5) n,m,conv write (6,5) n,m,conv
5 format (//5x,'Unitary transformation of',i3,' vectors'/ 5 format (//5x,'Unitary transformation of',i3,' vectors'/
* 5x,'following the principle of maximum overlap with a set of', * 5x,'following the principle of maximum overlap with a set of',

View File

@ -92,13 +92,182 @@
nrot(1) = 6 ! number of orbitals to be localized nrot(1) = 64 ! number of orbitals to be localized
integer :: index_rot(1000,1) integer :: index_rot(1000,1)
cmoref = 0.d0 cmoref = 0.d0
irot = 0
! H2 molecule for the mixed localization
do i=1,64
irot(i,1) = i+2
enddo
do i=1,17
cmoref(i+1,i,1)=1.d0
enddo
cmoref(19,19-1,1)=1.d0
cmoref(20,19-1,1)=-1.d0
cmoref(19,20-1,1)=-1.d0
cmoref(20,20-1,1)=-1.d0
cmoref(21,20-1,1)=2.d0
cmoref(22,21-1,1)=1.d0
cmoref(23,22-1,1)=1.d0
cmoref(24,23-1,1)=1.d0
cmoref(25,24-1,1)=1.d0
cmoref(26,24-1,1)=-1.d0
cmoref(25,25-1,1)=-1.d0
cmoref(26,25-1,1)=-1.d0
cmoref(27,25-1,1)=2.d0
cmoref(28,26-1,1)=1.d0
cmoref(29,27-1,1)=1.d0
cmoref(30,28-1,1)=1.d0
cmoref(31,29-1,1)=1.d0
cmoref(32,29-1,1)=-1.d0
cmoref(31,30-1,1)=-1.d0
cmoref(32,30-1,1)=-1.d0
cmoref(33,30-1,1)=2.d0
cmoref(34,31-1,1)=1.d0
cmoref(35,32-1,1)=1.d0
cmoref(36,33-1,1)=1.d0
do i=33,49
cmoref(i+5,i,1)= 1.d0
enddo
cmoref(55,52-2,1)=1.d0
cmoref(56,52-2,1)=-1.d0
cmoref(55,53-2,1)=-1.d0
cmoref(56,53-2,1)=-1.d0
cmoref(57,53-2,1)=2.d0
cmoref(58,54-2,1)=1.d0
cmoref(59,55-2,1)=1.d0
cmoref(60,56-2,1)=1.d0
cmoref(61,57-2,1)=1.d0
cmoref(62,57-2,1)=-1.d0
cmoref(61,58-2,1)=-1.d0
cmoref(62,58-2,1)=-1.d0
cmoref(63,58-2,1)=2.d0
cmoref(64,59-2,1)=1.d0
cmoref(65,60-2,1)=1.d0
cmoref(66,61-2,1)=1.d0
cmoref(67,62-2,1)=1.d0
cmoref(68,62-2,1)=-1.d0
cmoref(67,63-2,1)=-1.d0
cmoref(68,63-2,1)=-1.d0
cmoref(69,63-2,1)=2.d0
cmoref(70,64-2,1)=1.d0
cmoref(71,65-2,1)=1.d0
cmoref(72,66-2,1)=1.d0
! H2 molecule
! do i=1,66
! irot(i,1) = i
! enddo
!
! do i=1,18
! cmoref(i,i,1)=1.d0
! enddo
! cmoref(19,19,1)=1.d0
! cmoref(20,19,1)=-1.d0
! cmoref(19,20,1)=-1.d0
! cmoref(20,20,1)=-1.d0
! cmoref(21,20,1)=2.d0
! cmoref(22,21,1)=1.d0
! cmoref(23,22,1)=1.d0
! cmoref(24,23,1)=1.d0
!
!
! cmoref(25,24,1)=1.d0
! cmoref(26,24,1)=-1.d0
! cmoref(25,25,1)=-1.d0
! cmoref(26,25,1)=-1.d0
! cmoref(27,25,1)=2.d0
! cmoref(28,26,1)=1.d0
! cmoref(29,27,1)=1.d0
! cmoref(30,28,1)=1.d0
!
! cmoref(31,29,1)=1.d0
! cmoref(32,29,1)=-1.d0
! cmoref(31,30,1)=-1.d0
! cmoref(32,30,1)=-1.d0
! cmoref(33,30,1)=2.d0
! cmoref(34,31,1)=1.d0
! cmoref(35,32,1)=1.d0
! cmoref(36,33,1)=1.d0
!
! do i=34,51
! cmoref(i+3,i,1)= 1.d0
! enddo
!
! cmoref(55,52,1)=1.d0
! cmoref(56,52,1)=-1.d0
! cmoref(55,53,1)=-1.d0
! cmoref(56,53,1)=-1.d0
! cmoref(57,53,1)=2.d0
! cmoref(58,54,1)=1.d0
! cmoref(59,55,1)=1.d0
! cmoref(60,56,1)=1.d0
!
! cmoref(61,57,1)=1.d0
! cmoref(62,57,1)=-1.d0
! cmoref(61,58,1)=-1.d0
! cmoref(62,58,1)=-1.d0
! cmoref(63,58,1)=2.d0
! cmoref(64,59,1)=1.d0
! cmoref(65,60,1)=1.d0
! cmoref(66,61,1)=1.d0
!
! cmoref(67,62,1)=1.d0
! cmoref(68,62,1)=-1.d0
! cmoref(67,63,1)=-1.d0
! cmoref(68,63,1)=-1.d0
! cmoref(69,63,1)=2.d0
! cmoref(70,64,1)=1.d0
! cmoref(71,65,1)=1.d0
! cmoref(72,66,1)=1.d0
! H atom
! do i=1,33
! irot(i,1) = i
! enddo
!
! do i=1,18
! cmoref(i,i,1)=1.d0
! enddo
! cmoref(19,19,1)=1.d0
! cmoref(20,19,1)=-1.d0
! cmoref(19,20,1)=-1.d0
! cmoref(20,20,1)=-1.d0
! cmoref(21,20,1)=2.d0
! cmoref(22,21,1)=1.d0
! cmoref(23,22,1)=1.d0
! cmoref(24,23,1)=1.d0
! cmoref(25,24,1)=1.d0
! cmoref(26,24,1)=-1.d0
! cmoref(25,25,1)=-1.d0
! cmoref(26,25,1)=-1.d0
! cmoref(27,25,1)=2.d0
! cmoref(28,26,1)=1.d0
! cmoref(29,27,1)=1.d0
! cmoref(30,28,1)=1.d0
!
! cmoref(31,29,1)=1.d0
! cmoref(32,29,1)=-1.d0
! cmoref(31,30,1)=-1.d0
! cmoref(32,30,1)=-1.d0
! cmoref(33,30,1)=2.d0
! cmoref(34,31,1)=1.d0
! cmoref(35,32,1)=1.d0
! cmoref(36,33,1)=1.d0
! Definition of the index of the MO to be rotated ! Definition of the index of the MO to be rotated
! irot(2,1) = 21 ! the first mo to be rotated is the 21 th MO ! irot(2,1) = 21 ! the first mo to be rotated is the 21 th MO
@ -106,25 +275,67 @@
! irot(4,1) = 23 ! ! irot(4,1) = 23 !
! irot(5,1) = 24 ! ! irot(5,1) = 24 !
! irot(6,1) = 25 ! ! irot(6,1) = 25 !
! do i = 1,12
! irot(i,1) = i+6 !N2
! enddo ! irot(1,1) = 5
irot(1,1) = 5 ! irot(2,1) = 6
irot(2,1) = 6 ! irot(3,1) = 7
irot(3,1) = 7 ! irot(4,1) = 8
irot(4,1) = 8 ! irot(5,1) = 9
irot(5,1) = 9 ! irot(6,1) = 10
irot(6,1) = 10 !
! cmoref(5,1,1) = 1.d0 !
! cmoref(6,2,1) = 1.d0 !
! cmoref(7,3,1) = 1.d0 !
! cmoref(40,4,1) = 1.d0 !
! cmoref(41,5,1) = 1.d0 !
! cmoref(42,6,1) = 1.d0 !
!END N2
!HEXATRIENE
! irot(1,1) = 20
! irot(2,1) = 21
! irot(3,1) = 22
! irot(4,1) = 23
! irot(5,1) = 24
! irot(6,1) = 25
!
! cmoref(7,1,1) = 1.d0 !
! cmoref(26,1,1) = 1.d0 !
! cmoref(45,2,1) = 1.d0 !
! cmoref(64,2,1) = 1.d0 !
! cmoref(83,3,1) = 1.d0 !
! cmoref(102,3,1) = 1.d0 !
! cmoref(7,4,1) = 1.d0 !
! cmoref(26,4,1) = -1.d0 !
! cmoref(45,5,1) = 1.d0 !
! cmoref(64,5,1) = -1.d0 !
! cmoref(83,6,1) = 1.d0 !
! cmoref(102,6,1) = -1.d0 !
!END HEXATRIENE
!!!!H2 H2 CAS
! irot(1,1) = 1
! irot(2,1) = 2
!
! cmoref(1,1,1) = 1.d0
! cmoref(37,2,1) = 1.d0
!END H2
!!!! LOCALIZATION ON THE BASIS FUNCTIONS
! do i = 1, nrot(1)
! irot(i,1) = i
! cmoref(i,i,1) = 1.d0
! enddo
!END BASISLOC
! do i = 1, nrot(1)
! irot(i,1) = 4+i
! enddo
do i = 1, nrot(1) do i = 1, nrot(1)
print*,'irot(i,1) = ',irot(i,1) print*,'irot(i,1) = ',irot(i,1)
enddo enddo
pause ! pause
cmoref(4,1,1) = 1.d0 ! 2S function
cmoref(5,2,1) = 1.d0 ! 2S function
cmoref(6,3,1) = 1.d0 ! 2S function
cmoref(19,4,1) = 1.d0 ! 2S function
cmoref(20,5,1) = 1.d0 ! 2S function
cmoref(21,6,1) = 1.d0 ! 2S function
! you define the guess vectors that you want ! you define the guess vectors that you want
! the new MO to be close to ! the new MO to be close to
@ -138,233 +349,21 @@
! own guess vectors for the MOs ! own guess vectors for the MOs
! The new MOs are provided in output ! The new MOs are provided in output
! in the same order than the guess MOs ! in the same order than the guess MOs
! do i = 1, nrot(1)
! C-C bonds ! j = 5+(i-1)*15
! 1-2 ! cmoref(j,i,1) = 0.2d0
! i_atom = 1 ! cmoref(j+3,i,1) = 0.12d0
! shift = (i_atom -1) * 15 ! print*,'j = ',j
! cmoref(1+shift,1,1) = -0.012d0 ! 2S function ! enddo
! cmoref(2+shift,1,1) = 0.18d0 ! ! pause
! cmoref(3+shift,1,1) = 0.1d0 !
! cmoref(5+shift,1,1) = -0.1d0 ! 2pX function
! cmoref(6+shift,1,1) = -0.1d0 ! 2pZ function
! i_atom = 2
! shift = (i_atom -1) * 15
! cmoref(1+shift,1,1) = -0.012d0 ! 2S function
! cmoref(2+shift,1,1) = 0.18d0 !
! cmoref(3+shift,1,1) = 0.1d0 !
! cmoref(5+shift,1,1) = 0.1d0 ! 2pX function
! cmoref(6+shift,1,1) = 0.1d0 ! 2pZ function
! ! 1-3
! i_atom = 1
! shift = (i_atom -1) * 15
! cmoref(1+shift,2,1) = -0.012d0 ! 2S function
! cmoref(2+shift,2,1) = 0.18d0 !
! cmoref(3+shift,2,1) = 0.1d0 !
! cmoref(5+shift,2,1) = 0.1d0 ! 2pX function
! cmoref(6+shift,2,1) = -0.1d0 ! 2pZ function
! i_atom = 3
! shift = (i_atom -1) * 15
! cmoref(1+shift,2,1) = -0.012d0 ! 2S function
! cmoref(2+shift,2,1) = 0.18d0 !
! cmoref(3+shift,2,1) = 0.1d0 !
! cmoref(5+shift,2,1) = -0.1d0 ! 2pX function
! cmoref(6+shift,2,1) = 0.1d0 ! 2pZ function
! ! 4-6
! i_atom = 4
! shift = (i_atom -1) * 15
! cmoref(1+shift,3,1) = -0.012d0 ! 2S function
! cmoref(2+shift,3,1) = 0.18d0 !
! cmoref(3+shift,3,1) = 0.1d0 !
! cmoref(5+shift,3,1) = 0.1d0 ! 2pX function
! cmoref(6+shift,3,1) = -0.1d0 ! 2pZ function
! i_atom = 6
! shift = (i_atom -1) * 15
! cmoref(1+shift,3,1) = -0.012d0 ! 2S function
! cmoref(2+shift,3,1) = 0.18d0 !
! cmoref(3+shift,3,1) = 0.1d0 !
! cmoref(5+shift,3,1) = -0.1d0 ! 2pX function
! cmoref(6+shift,3,1) = 0.1d0 ! 2pZ function
! ! 6-5
! i_atom = 6
! shift = (i_atom -1) * 15
! cmoref(1+shift,4,1) = -0.012d0 ! 2S function
! cmoref(2+shift,4,1) = 0.18d0 !
! cmoref(3+shift,4,1) = 0.1d0 !
! cmoref(5+shift,4,1) = 0.1d0 ! 2pX function
! cmoref(6+shift,4,1) = 0.1d0 ! 2pZ function
! i_atom = 5
! shift = (i_atom -1) * 15
! cmoref(1+shift,4,1) = -0.012d0 ! 2S function
! cmoref(2+shift,4,1) = 0.18d0 !
! cmoref(3+shift,4,1) = 0.1d0 !
! cmoref(5+shift,4,1) = -0.1d0 ! 2pX function
! cmoref(6+shift,4,1) = -0.1d0 ! 2pZ function
! ! 2-4
! i_atom = 2
! shift = (i_atom -1) * 15
! cmoref(1+shift,5,1) = -0.012d0 ! 2S function
! cmoref(2+shift,5,1) = 0.18d0 !
! cmoref(3+shift,5,1) = 0.1d0 !
! cmoref(6+shift,5,1) = 0.1d0 ! 2pZ function
! i_atom = 4
! shift = (i_atom -1) * 15
! cmoref(1+shift,5,1) = -0.012d0 ! 2S function
! cmoref(2+shift,5,1) = 0.18d0 !
! cmoref(3+shift,5,1) = 0.1d0 !
! cmoref(6+shift,5,1) = -0.1d0 ! 2pZ function
! ! 3-5
! i_atom = 3
! shift = (i_atom -1) * 15
! cmoref(1+shift,6,1) = -0.012d0 ! 2S function
! cmoref(2+shift,6,1) = 0.18d0 !
! cmoref(3+shift,6,1) = 0.1d0 !
! cmoref(6+shift,6,1) = 0.1d0 ! 2pZ function
! i_atom = 5
! shift = (i_atom -1) * 15
! cmoref(1+shift,6,1) = -0.012d0 ! 2S function
! cmoref(2+shift,6,1) = 0.18d0 !
! cmoref(3+shift,6,1) = 0.1d0 !
! cmoref(6+shift,6,1) = -0.1d0 ! 2pZ function
! ! C-H bonds
! ! 2-7
! i_atom = 2
! shift = (i_atom -1) * 15
! cmoref(1+shift,7,1) = -0.012d0 ! 2S function
! cmoref(2+shift,7,1) = 0.18d0 !
! cmoref(3+shift,7,1) = 0.1d0 !
! cmoref(5+shift,7,1) = -0.1d0 ! 2pX function
! cmoref(6+shift,7,1) = 0.1d0 ! 2pZ function
!
! i_atom = 7
! shift_h = (6-1) * 15 + (i_atom - 6)*5
! cmoref(1+shift_h,7,1) = 0.12d0 ! 1S function
! ! 4-10
! i_atom = 4
! shift = (i_atom -1) * 15
! cmoref(1+shift,8,1) = -0.012d0 ! 2S function
! cmoref(2+shift,8,1) = 0.18d0 !
! cmoref(3+shift,8,1) = 0.1d0 !
! cmoref(5+shift,8,1) = -0.1d0 ! 2pX function
! cmoref(6+shift,8,1) = -0.1d0 ! 2pZ function
!
! i_atom = 10
! shift_h = (6-1) * 15 + (i_atom - 6)*5
! cmoref(1+shift_h,8,1) = 0.12d0 ! 1S function
! ! 5-11
! i_atom = 5
! shift = (i_atom -1) * 15
! cmoref(1+shift,9,1) = -0.012d0 ! 2S function
! cmoref(2+shift,9,1) = 0.18d0 !
! cmoref(3+shift,9,1) = 0.1d0 !
! cmoref(5+shift,9,1) = 0.1d0 ! 2pX function
! cmoref(6+shift,9,1) = -0.1d0 ! 2pZ function
!
! i_atom = 11
! shift_h = (6-1) * 15 + (i_atom - 6)*5
! cmoref(1+shift_h,9,1) = 0.12d0 ! 1S function
! ! 3-8
! i_atom = 3
! shift = (i_atom -1) * 15
! cmoref(1+shift,10,1) = -0.012d0 ! 2S function
! cmoref(2+shift,10,1) = 0.18d0 !
! cmoref(3+shift,10,1) = 0.1d0 !
!
! cmoref(5+shift,10,1) = 0.1d0 ! 2pX function
! cmoref(6+shift,10,1) = 0.1d0 ! 2pZ function
!
! i_atom = 8
! shift_h = (6-1) * 15 + (i_atom - 6)*5
! cmoref(1+shift_h,10,1) = 0.12d0 ! 1S function
! ! 1-9
! i_atom = 1
! shift = (i_atom -1) * 15
! cmoref(1+shift,11,1) = -0.012d0 ! 2S function
! cmoref(2+shift,11,1) = 0.18d0 !
! cmoref(3+shift,11,1) = 0.1d0 !
!
! cmoref(6+shift,11,1) = 0.1d0 ! 2pZ function
! i_atom = 9
! shift_h = (6-1) * 15 + (i_atom - 6)*5
! cmoref(1+shift_h,11,1) = 0.12d0 ! 1S function
!
! ! 6-12
! i_atom = 6
! shift = (i_atom -1) * 15
! cmoref(1+shift,12,1) = -0.012d0 ! 2S function
! cmoref(2+shift,12,1) = 0.18d0 !
! cmoref(3+shift,12,1) = 0.1d0 !
!
! cmoref(6+shift,12,1) = -0.1d0 ! 2pZ function
! i_atom = 12
! shift_h = (6-1) * 15 + (i_atom - 6)*5
! cmoref(1+shift_h,12,1) = 0.12d0 ! 1S function
! cmoref(12,1,1) = 1.d0 !
! cmoref(21,2,1) = 1.d0 !
! cmoref(30,2,1) = 1.d0 !
! cmoref(39,3,1) = 1.d0 !
! cmoref(48,3,1) = 1.d0 !
! cmoref(3,4,1) = 1.d0 !
! cmoref(12,4,1) =-1.d0 !
! cmoref(21,5,1) = 1.d0 !
! cmoref(30,5,1) =-1.d0 !
! cmoref(39,6,1) = 1.d0 !
! cmoref(48,6,1) =-1.d0 !
print*,'passed the definition of the referent vectors ' print*,'passed the definition of the referent vectors '
!Building the S (overlap) matrix in the AO basis.
do i = 1, ao_num do i = 1, ao_num
do j = 1, ao_num do j =1, ao_num
s(i,j,1) = ao_overlap(i,j) s(i,j,1) = ao_overlap(i,j)
enddo enddo
enddo enddo
!Now big loop over symmetry !Now big loop over symmetry
@ -398,20 +397,13 @@
! do i=1,nmo(isym) ! do i=1,nmo(isym)
do i=1,ao_num
do j=1,nrot(isym) do j=1,nrot(isym)
do i=1,ao_num
ddum(i,j)=0.d0 ddum(i,j)=0.d0
do k=1,ao_num
do k=1,ao_num ddum(i,j)=ddum(i,j)+s(i,k,isym)*cmo(k,irot(j,isym),isym)
enddo
ddum(i,j)=ddum(i,j)+s(i,k,isym)*cmo(k,irot(j,isym),isym) enddo
enddo
enddo
enddo enddo
@ -441,7 +433,7 @@
do i=1,nrot(isym) do i=1,nrot(isym)
do j=1,ao_num do j=1,ao_num
write (6,*) 'isym,',isym,nrot(isym),nmo(isym) ! write (6,*) 'isym,',isym,nrot(isym),nmo(isym)
newcmo(j,irot(i,isym),isym)=0.d0 newcmo(j,irot(i,isym),isym)=0.d0
do k=1,nrot(isym) do k=1,nrot(isym)
newcmo(j,irot(i,isym),isym)=newcmo(j,irot(i,isym),isym) + cmo(j,irot(k,isym),isym)*t(k,i) newcmo(j,irot(i,isym),isym)=newcmo(j,irot(i,isym),isym) + cmo(j,irot(k,isym),isym)*t(k,i)
@ -459,7 +451,7 @@
enddo !big loop over symmetry enddo !big loop over symmetry
10 format (4E20.12) 10 format (4E18.12)
! Now we copyt the newcmo into the mo_coef ! Now we copyt the newcmo into the mo_coef
@ -472,9 +464,7 @@
enddo enddo
enddo enddo
enddo enddo
! if(dabs(newcmo(3,19,1) - mo_coef(3,19)) .gt.1.d-10 )then ! pause
print*,'mo_coef(3,19)',mo_coef(3,19)
pause
! we say that it hase been touched, and valid and that everything that ! we say that it hase been touched, and valid and that everything that

View File

@ -183,6 +183,9 @@ def get_nb_permutation(str_):
def order_l_l_sym(l_l_sym): def order_l_l_sym(l_l_sym):
l_order_mo = [i for i,_ in enumerate(l_l_sym)]
n = 1 n = 1
for i in range(len(l_l_sym)): for i in range(len(l_l_sym)):
if n != 1: if n != 1:
@ -192,11 +195,11 @@ def order_l_l_sym(l_l_sym):
l = l_l_sym[i] l = l_l_sym[i]
n = get_nb_permutation(l[2]) n = get_nb_permutation(l[2])
l_l_sym[i:i + n] = sorted(l_l_sym[i:i + n], l_l_sym[i:i + n], l_order_mo[i:i+n] = zip(*sorted(zip(l_l_sym[i:i + n],l_order_mo[i:i+n]),
key=lambda x: x[2], key=lambda x: x[0][2],
cmp=compare_gamess_style) cmp=compare_gamess_style))
return l_l_sym return l_l_sym, l_order_mo
#========================== #==========================
@ -205,8 +208,13 @@ def order_l_l_sym(l_l_sym):
l_sym_without_header = sym_raw.split("\n")[3:-2] l_sym_without_header = sym_raw.split("\n")[3:-2]
l_l_sym_raw = [i.split() for i in l_sym_without_header] l_l_sym_raw = [i.split() for i in l_sym_without_header]
print len(l_l_sym_raw)
l_l_sym_expend_sym = expend_sym_l(l_l_sym_raw) l_l_sym_expend_sym = expend_sym_l(l_l_sym_raw)
l_l_sym_ordered = order_l_l_sym(l_l_sym_expend_sym) print len(l_l_sym_expend_sym)
l_l_sym_ordered, l_order_mo = order_l_l_sym(l_l_sym_expend_sym)
#======== #========
#MO COEF #MO COEF
@ -256,7 +264,7 @@ def print_mo_coef(mo_coef_block, l_l_sym):
i_a = int(l[1]) - 1 i_a = int(l[1]) - 1
sym = l[2] sym = l[2]
print l_label[i_a], sym, " ".join('{: 3.8f}'.format(i) print l_label[i_a], sym, " ".join('{0: 3.8f}'.format(i)
for i in a[i]) for i in a[i])
if i_block != nb_block - 1: if i_block != nb_block - 1:
@ -348,6 +356,7 @@ d_rep={"+":"1","-":"0"}
det_without_header = det_raw[pos+2::] det_without_header = det_raw[pos+2::]
for line_raw in det_without_header.split("\n"): for line_raw in det_without_header.split("\n"):
line = line_raw line = line_raw
@ -355,8 +364,14 @@ for line_raw in det_without_header.split("\n"):
try: try:
float(line) float(line)
except ValueError: except ValueError:
print line_raw.strip(), len(line_raw.strip())
print l_order_mo, len(l_order_mo)
line_order = [line_raw[i] for i in l_order_mo]
line= "".join([d_rep[x] if x in d_rep else x for x in line_raw]) line= "".join([d_rep[x] if x in d_rep else x for x in line_raw])
print line.strip() print line.strip()
print "END_DET" print "END_DET"

View File

@ -37,7 +37,7 @@ from qp_path import QP_ROOT, QP_SRC, QP_EZFIO
LIB = "" # join(QP_ROOT, "lib", "rdtsc.o") LIB = "" # join(QP_ROOT, "lib", "rdtsc.o")
EZFIO_LIB = join(QP_ROOT, "lib", "libezfio_irp.a") EZFIO_LIB = join(QP_ROOT, "lib", "libezfio_irp.a")
ZMQ_LIB = join(QP_ROOT, "lib", "libf77zmq.a") + " " + join(QP_ROOT, "lib", "libzmq.a") + " -lstdc++ -lrt" ZMQ_LIB = join(QP_ROOT, "lib", "libf77zmq.a") + " " + join(QP_ROOT, "lib", "libzmq.a") + " -lstdc++ -lrt"
ROOT_BUILD_NINJA = join(QP_ROOT, "config", "build.ninja") ROOT_BUILD_NINJA = join(QP_ROOT, "config", "build.ninja")
header = r"""# header = r"""#
@ -96,7 +96,8 @@ def ninja_create_env_variable(pwd_config_file):
l_string.append(str_) l_string.append(str_)
lib_lapack = get_compilation_option(pwd_config_file, "LAPACK_LIB") lib_lapack = get_compilation_option(pwd_config_file, "LAPACK_LIB")
l_string.append("LIB = {0} {1} {2} {3}".format(LIB, lib_lapack, EZFIO_LIB, ZMQ_LIB)) str_lib = " ".join([LIB, lib_lapack, EZFIO_LIB, ZMQ_LIB])
l_string.append("LIB = {0} ".format(str_lib))
l_string.append("") l_string.append("")
@ -387,6 +388,8 @@ def get_l_file_for_module(path_module):
l_src.append(f) l_src.append(f)
obj = '{0}.o'.format(os.path.splitext(f)[0]) obj = '{0}.o'.format(os.path.splitext(f)[0])
l_obj.append(obj) l_obj.append(obj)
elif f.lower().endswith(".o"):
l_obj.append(join(path_module.abs, f))
elif f == "EZFIO.cfg": elif f == "EZFIO.cfg":
l_depend.append(join(path_module.abs, "ezfio_interface.irp.f")) l_depend.append(join(path_module.abs, "ezfio_interface.irp.f"))

View File

@ -345,7 +345,7 @@ def save_ezfio_provider(path_head, dict_code_provider):
path = "{0}/ezfio_interface.irp.f".format(path_head) path = "{0}/ezfio_interface.irp.f".format(path_head)
l_output = ["! DO NOT MODIFY BY HAND", l_output = ["! DO NOT MODIFY BY HAND",
"! Created by $QP_ROOT/scripts/ezfio_interface.py", "! Created by $QP_ROOT/scripts/ezfio_interface/ei_handler.py",
"! from file {0}/EZFIO.cfg".format(path_head), "! from file {0}/EZFIO.cfg".format(path_head),
"\n"] "\n"]

View File

@ -22,6 +22,7 @@ BEGIN_PROVIDER [ %(type)s, %(name)s %(size)s ]
logical :: has logical :: has
PROVIDE ezfio_filename PROVIDE ezfio_filename
%(test_null_size)s
call ezfio_has_%(ezfio_dir)s_%(ezfio_name)s(has) call ezfio_has_%(ezfio_dir)s_%(ezfio_name)s(has)
if (has) then if (has) then
call ezfio_get_%(ezfio_dir)s_%(ezfio_name)s(%(name)s) call ezfio_get_%(ezfio_dir)s_%(ezfio_name)s(%(name)s)
@ -44,6 +45,7 @@ END_PROVIDER
def __repr__(self): def __repr__(self):
self.set_write() self.set_write()
self.set_test_null_size()
for v in self.values: for v in self.values:
if not v: if not v:
msg = "Error : %s is not set in EZFIO.cfg" % (v) msg = "Error : %s is not set in EZFIO.cfg" % (v)
@ -54,20 +56,31 @@ END_PROVIDER
return self.data % self.__dict__ return self.data % self.__dict__
def set_test_null_size(self):
if "size" not in self.__dict__:
self.__dict__["size"] = ""
if self.size != "":
self.test_null_size = "if (size(%s) == 0) return\n" % ( self.name )
else:
self.test_null_size = ""
def set_write(self): def set_write(self):
self.write = "" self.write = ""
if self.type in self.write_correspondance: if "size" in self.__dict__:
write = self.write_correspondance[self.type] return
output = self.output else:
name = self.name if self.type in self.write_correspondance:
write = self.write_correspondance[self.type]
output = self.output
name = self.name
l_write = ["", l_write = ["",
" call write_time(%(output)s)", " call write_time(%(output)s)",
" call %(write)s(%(output)s, %(name)s, &", " call %(write)s(%(output)s, %(name)s, &",
" '%(name)s')", " '%(name)s')",
""] ""]
self.write = "\n".join(l_write) % locals() self.write = "\n".join(l_write) % locals()
def set_type(self, t): def set_type(self, t):
self.type = t.lower() self.type = t.lower()

View File

@ -6,7 +6,7 @@ open Core.Std;;
WARNING WARNING
This file is autogenerad by This file is autogenerad by
`${{QP_ROOT}}/script/ezfio_interface/ei_handler.py` `${{QP_ROOT}}/scripts/ezfio_interface/ei_handler.py`
*) *)
@ -169,7 +169,9 @@ let run check_only ezfio_filename =
in in
(* Create the temp file *) (* Create the temp file *)
let temp_filename = create_temp_file ezfio_filename tasks in let temp_filename =
create_temp_file ezfio_filename tasks
in
(* Open the temp file with external editor *) (* Open the temp file with external editor *)
let editor = let editor =
@ -193,7 +195,7 @@ let run check_only ezfio_filename =
List.iter ~f:(fun x -> set temp_string x) tasks; List.iter ~f:(fun x -> set temp_string x) tasks;
(* Remove temp_file *) (* Remove temp_file *)
Sys.remove temp_filename; Sys.remove temp_filename
;; ;;

View File

@ -8,11 +8,22 @@ copy_buffer
declarations declarations
decls_main decls_main
deinit_thread deinit_thread
do_double_excitations skip
init_main
filter_integrals
filter2p
filter2h2p_double
filter2h2p_single
filter1h filter1h
filter1p filter1p
filter2h2p only_2p_single
filter2p only_2p_double
filter_only_1h1p_single
filter_only_1h1p_double
filter_only_1h2p_single
filter_only_1h2p_double
filter_only_2h2p_single
filter_only_2h2p_double
filterhole filterhole
filter_integrals filter_integrals
filter_only_1h1p_double filter_only_1h1p_double
@ -182,7 +193,7 @@ class H_apply(object):
if (is_a_2p(hole)) cycle if (is_a_2p(hole)) cycle
""" """
def filter_1p(self): def filter_1p(self):
self["filter0p"] = """ self["filter1p"] = """
! ! DIR$ FORCEINLINE ! ! DIR$ FORCEINLINE
if (is_a_1p(hole)) cycle if (is_a_1p(hole)) cycle
""" """
@ -208,6 +219,27 @@ class H_apply(object):
if (is_a_1h1p(key).eqv..False.) cycle if (is_a_1h1p(key).eqv..False.) cycle
""" """
def filter_only_2h2p(self):
self["filter_only_2h2p_single"] = """
! ! DIR$ FORCEINLINE
if (is_a_two_holes_two_particles(hole).eqv..False.) cycle
"""
self["filter_only_1h1p_double"] = """
! ! DIR$ FORCEINLINE
if (is_a_two_holes_two_particles(key).eqv..False.) cycle
"""
def filter_only_1h2p(self):
self["filter_only_1h2p_single"] = """
! ! DIR$ FORCEINLINE
if (is_a_1h2p(hole).eqv..False.) cycle
"""
self["filter_only_1h2p_double"] = """
! ! DIR$ FORCEINLINE
if (is_a_1h2p(key).eqv..False.) cycle
"""
def unset_skip(self): def unset_skip(self):
self["skip"] = """ self["skip"] = """
@ -215,9 +247,12 @@ class H_apply(object):
def set_filter_2h_2p(self): def set_filter_2h_2p(self):
self["filter2h2p"] = """ self["filter2h2p_double"] = """
if (is_a_two_holes_two_particles(key)) cycle if (is_a_two_holes_two_particles(key)) cycle
""" """
self["filter2h2p_single"] = """
if (is_a_two_holes_two_particles(hole)) cycle
"""
def set_perturbation(self,pert): def set_perturbation(self,pert):
@ -248,13 +283,13 @@ class H_apply(object):
""" """
self.data["deinit_thread"] = """ self.data["deinit_thread"] = """
!$ call omp_set_lock(lck) ! OMP CRITICAL
do k=1,N_st do k=1,N_st
sum_e_2_pert_in(k) = sum_e_2_pert_in(k) + sum_e_2_pert(k) sum_e_2_pert_in(k) = sum_e_2_pert_in(k) + sum_e_2_pert(k)
sum_norm_pert_in(k) = sum_norm_pert_in(k) + sum_norm_pert(k) sum_norm_pert_in(k) = sum_norm_pert_in(k) + sum_norm_pert(k)
sum_H_pert_diag_in(k) = sum_H_pert_diag_in(k) + sum_H_pert_diag(k) sum_H_pert_diag_in(k) = sum_H_pert_diag_in(k) + sum_H_pert_diag(k)
enddo enddo
!$ call omp_unset_lock(lck) ! OMP END CRITICAL
deallocate (e_2_pert_buffer, coef_pert_buffer) deallocate (e_2_pert_buffer, coef_pert_buffer)
""" """
self.data["size_max"] = "8192" self.data["size_max"] = "8192"
@ -356,12 +391,12 @@ class H_apply(object):
self.data["skip"] = """ self.data["skip"] = """
if (i_generator < size_select_max) then if (i_generator < size_select_max) then
if (select_max(i_generator) < selection_criterion_min*selection_criterion_factor) then if (select_max(i_generator) < selection_criterion_min*selection_criterion_factor) then
!$ call omp_set_lock(lck) ! OMP CRITICAL
do k=1,N_st do k=1,N_st
norm_psi(k) = norm_psi(k) + psi_coef_generators(i_generator,k)*psi_coef_generators(i_generator,k) norm_psi(k) = norm_psi(k) + psi_coef_generators(i_generator,k)*psi_coef_generators(i_generator,k)
pt2_old(k) = 0.d0 pt2_old(k) = 0.d0
enddo enddo
!$ call omp_unset_lock(lck) ! OMP END CRITICAL
cycle cycle
endif endif
select_max(i_generator) = 0.d0 select_max(i_generator) = 0.d0
@ -401,7 +436,16 @@ class H_apply_zmq(H_apply):
H_pert_diag(k) = 0.d0 H_pert_diag(k) = 0.d0
norm_psi(k) = 0.d0 norm_psi(k) = 0.d0
enddo enddo
""" """
self.data["copy_buffer"] = """
do i=1,N_det_generators
do k=1,N_st
pt2(k) = pt2(k) + pt2_generators(k,i)
norm_pert(k) = norm_pert(k) + norm_pert_generators(k,i)
H_pert_diag(k) = H_pert_diag(k) + H_pert_diag_generators(k,i)
enddo
enddo
"""
def set_selection_pt2(self,pert): def set_selection_pt2(self,pert):
H_apply.set_selection_pt2(self,pert) H_apply.set_selection_pt2(self,pert)
@ -416,3 +460,4 @@ class H_apply_zmq(H_apply):
select_max(i_generator) = 0.d0 select_max(i_generator) = 0.d0
endif endif
""" """

View File

@ -25,7 +25,7 @@ END_PROVIDER
BEGIN_DOC BEGIN_DOC
! Coefficients including the AO normalization ! Coefficients including the AO normalization
END_DOC END_DOC
double precision :: norm, norm2,overlap_x,overlap_y,overlap_z,C_A(3), c double precision :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c
integer :: l, powA(3), nz integer :: l, powA(3), nz
integer :: i,j,k integer :: i,j,k
nz=100 nz=100
@ -34,9 +34,11 @@ END_PROVIDER
C_A(3) = 0.d0 C_A(3) = 0.d0
ao_coef_normalized = 0.d0 ao_coef_normalized = 0.d0
do i=1,ao_num do i=1,ao_num
powA(1) = ao_power(i,1) powA(1) = ao_power(i,1)
powA(2) = ao_power(i,2) powA(2) = ao_power(i,2)
powA(3) = ao_power(i,3) powA(3) = ao_power(i,3)
do j=1,ao_prim_num(i) 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) 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) ao_coef_normalized(i,j) = ao_coef(i,j)/sqrt(norm)
@ -51,8 +53,42 @@ END_PROVIDER
enddo enddo
ao_coef_normalization_factor(i) = 1.d0/sqrt(norm) ao_coef_normalization_factor(i) = 1.d0/sqrt(norm)
enddo enddo
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ double precision, ao_coef_normalization_libint_factor, (ao_num) ]
implicit none
BEGIN_DOC
! Coefficients including the AO normalization
END_DOC
double precision :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c
integer :: l, powA(3), nz
integer :: i,j,k
nz=100
C_A(1) = 0.d0
C_A(2) = 0.d0
C_A(3) = 0.d0
do i=1,ao_num
powA(1) = ao_l(i)
powA(2) = 0
powA(3) = 0
! 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_libint_factor(i) = ao_coef_normalization_factor(i) * sqrt(norm)
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, ao_coef_normalized_ordered, (ao_num_align,ao_prim_num_max) ] BEGIN_PROVIDER [ double precision, ao_coef_normalized_ordered, (ao_num_align,ao_prim_num_max) ]
&BEGIN_PROVIDER [ double precision, ao_expo_ordered, (ao_num_align,ao_prim_num_max) ] &BEGIN_PROVIDER [ double precision, ao_expo_ordered, (ao_num_align,ao_prim_num_max) ]
implicit none implicit none
@ -170,3 +206,176 @@ BEGIN_PROVIDER [ character*(128), l_to_charater, (0:4)]
l_to_charater(4)='G' l_to_charater(4)='G'
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ integer, Nucl_N_Aos, (nucl_num)]
&BEGIN_PROVIDER [ integer, N_AOs_max ]
implicit none
integer :: i
BEGIN_DOC
! Number of AOs per atom
END_DOC
Nucl_N_Aos = 0
do i = 1, ao_num
Nucl_N_Aos(ao_nucl(i)) +=1
enddo
N_AOs_max = maxval(Nucl_N_Aos)
END_PROVIDER
BEGIN_PROVIDER [ integer, Nucl_Aos, (nucl_num,N_AOs_max)]
implicit none
BEGIN_DOC
! List of AOs attached on each atom
END_DOC
integer :: i
integer, allocatable :: nucl_tmp(:)
allocate(nucl_tmp(nucl_num))
nucl_tmp = 0
Nucl_Aos = 0
do i = 1, ao_num
nucl_tmp(ao_nucl(i))+=1
Nucl_Aos(ao_nucl(i),nucl_tmp(ao_nucl(i))) = i
enddo
deallocate(nucl_tmp)
END_PROVIDER
BEGIN_PROVIDER [ integer, Nucl_list_shell_Aos, (nucl_num,N_AOs_max)]
&BEGIN_PROVIDER [ integer, Nucl_num_shell_Aos, (nucl_num)]
implicit none
integer :: i,j,k
BEGIN_DOC
! Index of the shell type Aos and of the corresponding Aos
! Per convention, for P,D,F and G AOs, we take the index
! of the AO with the the corresponding power in the "X" axis
END_DOC
do i = 1, nucl_num
Nucl_num_shell_Aos(i) = 0
do j = 1, Nucl_N_Aos(i)
if(ao_l(Nucl_Aos(i,j))==0)then
! S type function
Nucl_num_shell_Aos(i)+=1
Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j)
elseif(ao_l(Nucl_Aos(i,j))==1)then
! P type function
if(ao_power(Nucl_Aos(i,j),1)==1)then
Nucl_num_shell_Aos(i)+=1
Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j)
endif
elseif(ao_l(Nucl_Aos(i,j))==2)then
! D type function
if(ao_power(Nucl_Aos(i,j),1)==2)then
Nucl_num_shell_Aos(i)+=1
Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j)
endif
elseif(ao_l(Nucl_Aos(i,j))==3)then
! F type function
if(ao_power(Nucl_Aos(i,j),1)==3)then
Nucl_num_shell_Aos(i)+=1
Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j)
endif
elseif(ao_l(Nucl_Aos(i,j))==4)then
! G type function
if(ao_power(Nucl_Aos(i,j),1)==4)then
Nucl_num_shell_Aos(i)+=1
Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j)
endif
endif
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ character*(4), ao_l_char_space, (ao_num) ]
implicit none
integer :: i
character*(4) :: give_ao_character_space
do i=1,ao_num
if(ao_l(i)==0)then
! S type AO
give_ao_character_space = 'S '
elseif(ao_l(i) == 1)then
! P type AO
if(ao_power(i,1)==1)then
give_ao_character_space = 'X '
elseif(ao_power(i,2) == 1)then
give_ao_character_space = 'Y '
else
give_ao_character_space = 'Z '
endif
elseif(ao_l(i) == 2)then
! D type AO
if(ao_power(i,1)==2)then
give_ao_character_space = 'XX '
elseif(ao_power(i,2) == 2)then
give_ao_character_space = 'YY '
elseif(ao_power(i,3) == 2)then
give_ao_character_space = 'ZZ '
elseif(ao_power(i,1) == 1 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'XY '
elseif(ao_power(i,1) == 1 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'XZ '
else
give_ao_character_space = 'YZ '
endif
elseif(ao_l(i) == 3)then
! F type AO
if(ao_power(i,1)==3)then
give_ao_character_space = 'XXX '
elseif(ao_power(i,2) == 3)then
give_ao_character_space = 'YYY '
elseif(ao_power(i,3) == 3)then
give_ao_character_space = 'ZZZ '
elseif(ao_power(i,1) == 2 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'XXY '
elseif(ao_power(i,1) == 2 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'XXZ '
elseif(ao_power(i,2) == 2 .and. ao_power(i,1) == 1)then
give_ao_character_space = 'YYX '
elseif(ao_power(i,2) == 2 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'YYZ '
elseif(ao_power(i,3) == 2 .and. ao_power(i,1) == 1)then
give_ao_character_space = 'ZZX '
elseif(ao_power(i,3) == 2 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'ZZY '
elseif(ao_power(i,3) == 1 .and. ao_power(i,2) == 1 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'XYZ '
endif
elseif(ao_l(i) == 4)then
! G type AO
if(ao_power(i,1)==4)then
give_ao_character_space = 'XXXX'
elseif(ao_power(i,2) == 4)then
give_ao_character_space = 'YYYY'
elseif(ao_power(i,3) == 4)then
give_ao_character_space = 'ZZZZ'
elseif(ao_power(i,1) == 3 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'XXXY'
elseif(ao_power(i,1) == 3 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'XXXZ'
elseif(ao_power(i,2) == 3 .and. ao_power(i,1) == 1)then
give_ao_character_space = 'YYYX'
elseif(ao_power(i,2) == 3 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'YYYZ'
elseif(ao_power(i,3) == 3 .and. ao_power(i,1) == 1)then
give_ao_character_space = 'ZZZX'
elseif(ao_power(i,3) == 3 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'ZZZY'
elseif(ao_power(i,1) == 2 .and. ao_power(i,2) == 2)then
give_ao_character_space = 'XXYY'
elseif(ao_power(i,2) == 2 .and. ao_power(i,3) == 2)then
give_ao_character_space = 'YYZZ'
elseif(ao_power(i,1) == 2 .and. ao_power(i,2) == 1 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'XXYZ'
elseif(ao_power(i,2) == 2 .and. ao_power(i,1) == 1 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'YYXZ'
elseif(ao_power(i,3) == 2 .and. ao_power(i,1) == 1 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'ZZXY'
endif
endif
ao_l_char_space(i) = give_ao_character_space
enddo
END_PROVIDER

View File

@ -212,6 +212,12 @@ logical function is_a_two_holes_two_particles(key_in)
implicit none implicit none
integer(bit_kind), intent(in) :: key_in(N_int,2) integer(bit_kind), intent(in) :: key_in(N_int,2)
integer :: i,i_diff integer :: i,i_diff
integer :: number_of_holes, number_of_particles
is_a_two_holes_two_particles = .False.
if(number_of_holes(key_in) == 2 .and. number_of_particles(key_in) == 2)then
is_a_two_holes_two_particles = .True.
return
endif
i_diff = 0 i_diff = 0
if(N_int == 1)then if(N_int == 1)then
i_diff = i_diff & i_diff = i_diff &
@ -456,6 +462,17 @@ logical function is_a_1h1p(key_in)
end end
logical function is_a_1h2p(key_in)
implicit none
integer(bit_kind), intent(in) :: key_in(N_int,2)
integer :: number_of_particles, number_of_holes
is_a_1h2p = .False.
if(number_of_holes(key_in).eq.1 .and. number_of_particles(key_in).eq.2)then
is_a_1h2p = .True.
endif
end
logical function is_a_1h(key_in) logical function is_a_1h(key_in)
implicit none implicit none
integer(bit_kind), intent(in) :: key_in(N_int,2) integer(bit_kind), intent(in) :: key_in(N_int,2)

View File

@ -95,9 +95,40 @@ BEGIN_PROVIDER [ integer, N_generators_bitmask ]
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ integer, N_generators_bitmask_restart ]
implicit none
BEGIN_DOC
! Number of bitmasks for generators
END_DOC
logical :: exists
PROVIDE ezfio_filename
call ezfio_has_bitmasks_N_mask_gen(exists)
if (exists) then
call ezfio_get_bitmasks_N_mask_gen(N_generators_bitmask_restart)
integer :: N_int_check
integer :: bit_kind_check
call ezfio_get_bitmasks_bit_kind(bit_kind_check)
if (bit_kind_check /= bit_kind) then
print *, bit_kind_check, bit_kind
print *, 'Error: bit_kind is not correct in EZFIO file'
endif
call ezfio_get_bitmasks_N_int(N_int_check)
if (N_int_check /= N_int) then
print *, N_int_check, N_int
print *, 'Error: N_int is not correct in EZFIO file'
endif
else
N_generators_bitmask_restart = 1
endif
ASSERT (N_generators_bitmask_restart > 0)
END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask_restart, (N_int,2,6,N_generators_bitmask) ]
BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask_restart, (N_int,2,6,N_generators_bitmask_restart) ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Bitmasks for generator determinants. ! Bitmasks for generator determinants.
@ -306,7 +337,7 @@ END_PROVIDER
n_inact_orb = 0 n_inact_orb = 0
n_virt_orb = 0 n_virt_orb = 0
if(N_generators_bitmask == 1)then if(N_generators_bitmask_restart == 1)then
do j = 1, N_int do j = 1, N_int
inact_bitmask(j,1) = xor(generators_bitmask_restart(j,1,1,1),cas_bitmask(j,1,1)) inact_bitmask(j,1) = xor(generators_bitmask_restart(j,1,1,1),cas_bitmask(j,1,1))
inact_bitmask(j,2) = xor(generators_bitmask_restart(j,2,1,1),cas_bitmask(j,2,1)) inact_bitmask(j,2) = xor(generators_bitmask_restart(j,2,1,1),cas_bitmask(j,2,1))
@ -319,15 +350,15 @@ END_PROVIDER
i_hole = 1 i_hole = 1
i_gen = 1 i_gen = 1
do i = 1, N_int do i = 1, N_int
inact_bitmask(i,1) = generators_bitmask(i,1,i_hole,i_gen) inact_bitmask(i,1) = generators_bitmask_restart(i,1,i_hole,i_gen)
inact_bitmask(i,2) = generators_bitmask(i,2,i_hole,i_gen) inact_bitmask(i,2) = generators_bitmask_restart(i,2,i_hole,i_gen)
n_inact_orb += popcnt(inact_bitmask(i,1)) n_inact_orb += popcnt(inact_bitmask(i,1))
enddo enddo
i_part = 2 i_part = 2
i_gen = 3 i_gen = 3
do i = 1, N_int do i = 1, N_int
virt_bitmask(i,1) = generators_bitmask(i,1,i_part,i_gen) virt_bitmask(i,1) = generators_bitmask_restart(i,1,i_part,i_gen)
virt_bitmask(i,2) = generators_bitmask(i,2,i_part,i_gen) virt_bitmask(i,2) = generators_bitmask_restart(i,2,i_part,i_gen)
n_virt_orb += popcnt(virt_bitmask(i,1)) n_virt_orb += popcnt(virt_bitmask(i,1))
enddo enddo
endif endif

View File

@ -214,8 +214,13 @@ subroutine remove_duplicates_in_psi_det(found_duplicates)
duplicate(i) = .False. duplicate(i) = .False.
enddo enddo
do i=1,N_det-1 found_duplicates = .False.
i=0
j=0
do while (i<N_det-1)
i = max(i+1,j)
if (duplicate(i)) then if (duplicate(i)) then
found_duplicates = .True.
cycle cycle
endif endif
j = i+1 j = i+1
@ -239,14 +244,6 @@ subroutine remove_duplicates_in_psi_det(found_duplicates)
enddo enddo
enddo enddo
found_duplicates = .False.
do i=1,N_det
if (duplicate(i)) then
found_duplicates = .True.
exit
endif
enddo
if (found_duplicates) then if (found_duplicates) then
call write_bool(output_determinants,found_duplicates,'Found duplicate determinants') call write_bool(output_determinants,found_duplicates,'Found duplicate determinants')
k=0 k=0
@ -307,14 +304,14 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc)
end end
subroutine push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,N_st,task_id) subroutine push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,i_generator,N_st,task_id)
use f77_zmq use f77_zmq
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Push PT2 calculation to the collector ! Push PT2 calculation to the collector
END_DOC END_DOC
integer(ZMQ_PTR), intent(in) :: zmq_socket_push integer(ZMQ_PTR), intent(in) :: zmq_socket_push
integer, intent(in) :: N_st integer, intent(in) :: N_st, i_generator
double precision, intent(in) :: pt2(N_st), norm_pert(N_st), H_pert_diag(N_st) double precision, intent(in) :: pt2(N_st), norm_pert(N_st), H_pert_diag(N_st)
integer, intent(in) :: task_id integer, intent(in) :: task_id
integer :: rc integer :: rc
@ -343,6 +340,12 @@ subroutine push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,N_st,task_id)
stop 'error' stop 'error'
endif endif
rc = f77_zmq_send( zmq_socket_push, i_generator, 4, ZMQ_SNDMORE)
if (rc /= 4) then
print *, irp_here, 'f77_zmq_send( zmq_socket_push, i_generator, 4, 0)'
stop 'error'
endif
rc = f77_zmq_send( zmq_socket_push, task_id, 4, 0) rc = f77_zmq_send( zmq_socket_push, task_id, 4, 0)
if (rc /= 4) then if (rc /= 4) then
print *, irp_here, 'f77_zmq_send( zmq_socket_push, task_id, 4, 0)' print *, irp_here, 'f77_zmq_send( zmq_socket_push, task_id, 4, 0)'
@ -358,7 +361,7 @@ subroutine push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,N_st,task_id)
! endif ! endif
end end
subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,N_st,n,task_id) subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,i_generator,N_st,n,task_id)
use f77_zmq use f77_zmq
implicit none implicit none
BEGIN_DOC BEGIN_DOC
@ -368,7 +371,7 @@ subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,N_st,n,task_id)
integer, intent(in) :: N_st integer, intent(in) :: N_st
double precision, intent(out) :: pt2(N_st), norm_pert(N_st), H_pert_diag(N_st) double precision, intent(out) :: pt2(N_st), norm_pert(N_st), H_pert_diag(N_st)
integer, intent(out) :: task_id integer, intent(out) :: task_id
integer, intent(out) :: n integer, intent(out) :: n, i_generator
integer :: rc integer :: rc
n=0 n=0
@ -386,7 +389,11 @@ subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,N_st,n,task_id)
rc = f77_zmq_recv( zmq_socket_pull, pt2(1), 8*N_st, 0) rc = f77_zmq_recv( zmq_socket_pull, pt2(1), 8*N_st, 0)
if (rc /= 8*N_st) then if (rc /= 8*N_st) then
print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, pt2(1,1) , 8*N_st, 0)' print *, ''
print *, ''
print *, ''
print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, pt2(1) , 8*N_st, 0)'
print *, rc
stop 'error' stop 'error'
endif endif
@ -402,6 +409,12 @@ subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,N_st,n,task_id)
stop 'error' stop 'error'
endif endif
rc = f77_zmq_recv( zmq_socket_pull, i_generator, 4, 0)
if (rc /= 4) then
print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, i_generator, 4, 0)'
stop 'error'
endif
rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0) rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
if (rc /= 4) then if (rc /= 4) then
print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)' print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)'

View File

@ -167,14 +167,10 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl
double precision :: diag_H_mat_elem double precision :: diag_H_mat_elem
integer :: iproc integer :: iproc
integer :: jtest_vvvv integer :: jtest_vvvv
integer(omp_lock_kind), save :: lck, ifirst=0
if (ifirst == 0) then
!$ call omp_init_lock(lck)
ifirst=1
endif
logical :: check_double_excitation logical :: check_double_excitation
logical :: is_a_1h1p logical :: is_a_1h1p
logical :: is_a_1h2p
logical :: is_a_1h logical :: is_a_1h
logical :: is_a_1p logical :: is_a_1p
logical :: is_a_2p logical :: is_a_2p
@ -304,8 +300,10 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl
k = ishft(j_b-1,-bit_kind_shift)+1 k = ishft(j_b-1,-bit_kind_shift)+1
l = j_b-ishft(k-1,bit_kind_shift)-1 l = j_b-ishft(k-1,bit_kind_shift)-1
key(k,other_spin) = ibset(key(k,other_spin),l) key(k,other_spin) = ibset(key(k,other_spin),l)
$filter2h2p $filter2h2p_double
$filter_only_1h1p_double $filter_only_1h1p_double
$filter_only_1h2p_double
$filter_only_2h2p_double
$only_2p_double $only_2p_double
key_idx += 1 key_idx += 1
do k=1,N_int do k=1,N_int
@ -353,8 +351,10 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl
k = ishft(j_b-1,-bit_kind_shift)+1 k = ishft(j_b-1,-bit_kind_shift)+1
l = j_b-ishft(k-1,bit_kind_shift)-1 l = j_b-ishft(k-1,bit_kind_shift)-1
key(k,ispin) = ibset(key(k,ispin),l) key(k,ispin) = ibset(key(k,ispin),l)
$filter2h2p $filter2h2p_double
$filter_only_1h1p_double $filter_only_1h1p_double
$filter_only_1h2p_double
$filter_only_2h2p_double
$only_2p_double $only_2p_double
key_idx += 1 key_idx += 1
do k=1,N_int do k=1,N_int
@ -417,13 +417,13 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,fock_diag_tmp,i_generato
integer, allocatable :: ia_ja_pairs(:,:,:) integer, allocatable :: ia_ja_pairs(:,:,:)
logical, allocatable :: array_pairs(:,:) logical, allocatable :: array_pairs(:,:)
double precision :: diag_H_mat_elem double precision :: diag_H_mat_elem
integer(omp_lock_kind), save :: lck, ifirst=0
integer :: iproc integer :: iproc
integer(bit_kind) :: key_mask(N_int, 2) integer(bit_kind) :: key_mask(N_int, 2)
logical :: check_double_excitation logical :: check_double_excitation
logical :: is_a_1h1p logical :: is_a_1h1p
logical :: is_a_1h2p
logical :: is_a_1h logical :: is_a_1h
logical :: is_a_1p logical :: is_a_1p
logical :: is_a_2p logical :: is_a_2p
@ -439,11 +439,6 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,fock_diag_tmp,i_generato
$check_double_excitation $check_double_excitation
if (ifirst == 0) then
ifirst=1
!$ call omp_init_lock(lck)
endif
$initialization $initialization
$omp_parallel $omp_parallel
@ -505,8 +500,10 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,fock_diag_tmp,i_generato
$filter1h $filter1h
$filter1p $filter1p
$filter2p $filter2p
$filter2h2p $filter2h2p_single
$filter_only_1h1p_single $filter_only_1h1p_single
$filter_only_1h2p_single
$filter_only_2h2p_single
key_idx += 1 key_idx += 1
do k=1,N_int do k=1,N_int
keys_out(k,1,key_idx) = hole(k,1) keys_out(k,1,key_idx) = hole(k,1)
@ -532,4 +529,3 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,fock_diag_tmp,i_generato
end end

View File

@ -11,7 +11,6 @@ subroutine $subroutine($params_main)
integer :: i_generator, nmax integer :: i_generator, nmax
double precision :: wall_0, wall_1 double precision :: wall_0, wall_1
integer(omp_lock_kind) :: lck
integer(bit_kind), allocatable :: mask(:,:,:) integer(bit_kind), allocatable :: mask(:,:,:)
integer :: ispin, k integer :: ispin, k
integer :: iproc integer :: iproc
@ -23,8 +22,6 @@ subroutine $subroutine($params_main)
nmax = mod( N_det_generators,nproc ) nmax = mod( N_det_generators,nproc )
!$ call omp_init_lock(lck)
call wall_time(wall_0) call wall_time(wall_0)
iproc = 0 iproc = 0
@ -129,19 +126,18 @@ subroutine $subroutine($params_main)
mask(1,1,s_hole ), mask(1,1,s_part ), & mask(1,1,s_hole ), mask(1,1,s_part ), &
fock_diag_tmp, i_generator, iproc $params_post) fock_diag_tmp, i_generator, iproc $params_post)
endif endif
!$ call omp_set_lock(lck) !$OMP CRITICAL
call wall_time(wall_1) call wall_time(wall_1)
$printout_always $printout_always
if (wall_1 - wall_0 > 2.d0) then if (wall_1 - wall_0 > 2.d0) then
$printout_now $printout_now
wall_0 = wall_1 wall_0 = wall_1
endif endif
!$ call omp_unset_lock(lck) !$OMP END CRITICAL
enddo enddo
!$OMP END DO !$OMP END DO
deallocate( mask, fock_diag_tmp ) deallocate( mask, fock_diag_tmp )
!$OMP END PARALLEL !$OMP END PARALLEL
!$ call omp_destroy_lock(lck)
$copy_buffer $copy_buffer
$generate_psi_guess $generate_psi_guess

View File

@ -10,9 +10,9 @@ subroutine $subroutine($params_main)
$decls_main $decls_main
integer :: i
integer :: i_generator integer :: i_generator
double precision :: wall_0, wall_1 double precision :: wall_0, wall_1
integer(omp_lock_kind) :: lck
integer(bit_kind), allocatable :: mask(:,:,:) integer(bit_kind), allocatable :: mask(:,:,:)
integer :: ispin, k integer :: ispin, k
integer :: rc integer :: rc
@ -26,6 +26,9 @@ subroutine $subroutine($params_main)
integer(ZMQ_PTR) :: zmq_socket_pair integer(ZMQ_PTR) :: zmq_socket_pair
integer(ZMQ_PTR) :: zmq_to_qp_run_socket integer(ZMQ_PTR) :: zmq_to_qp_run_socket
double precision, allocatable :: pt2_generators(:,:), norm_pert_generators(:,:)
double precision, allocatable :: H_pert_diag_generators(:,:)
call new_parallel_job(zmq_to_qp_run_socket,'$subroutine') call new_parallel_job(zmq_to_qp_run_socket,'$subroutine')
zmq_socket_pair = new_zmq_pair_socket(.True.) zmq_socket_pair = new_zmq_pair_socket(.True.)
@ -37,24 +40,26 @@ subroutine $subroutine($params_main)
call add_task_to_taskserver(zmq_to_qp_run_socket,task) call add_task_to_taskserver(zmq_to_qp_run_socket,task)
enddo enddo
integer(ZMQ_PTR) :: collector_thread allocate ( pt2_generators(N_states,N_det_generators), &
external :: $subroutine_collector norm_pert_generators(N_states,N_det_generators), &
rc = pthread_create(collector_thread, $subroutine_collector) H_pert_diag_generators(N_states,N_det_generators) )
!$OMP PARALLEL DEFAULT(private) PROVIDE nproc N_states
!$OMP TASK PRIVATE(rc) !$OMP PARALLEL DEFAULT(NONE) &
rc = omp_get_thread_num() !$OMP PRIVATE(i) &
call $subroutine_slave_inproc(rc) !$OMP SHARED(zmq_socket_pair,N_states, pt2_generators, norm_pert_generators, H_pert_diag_generators, n, task_id, i_generator) &
!$OMP END TASK !$OMP num_threads(nproc+1)
!$OMP TASKWAIT i = omp_get_thread_num()
if (i == 0) then
call $subroutine_collector()
integer :: n, task_id
call pull_pt2(zmq_socket_pair, pt2_generators, norm_pert_generators, H_pert_diag_generators, i_generator, size(pt2_generators), n, task_id)
else
call $subroutine_slave_inproc(i)
endif
!$OMP END PARALLEL !$OMP END PARALLEL
integer :: n, task_id
call pull_pt2(zmq_socket_pair, pt2, norm_pert, H_pert_diag, N_st, n, task_id)
rc = pthread_join(collector_thread)
call end_zmq_pair_socket(zmq_socket_pair) call end_zmq_pair_socket(zmq_socket_pair)
call end_parallel_job(zmq_to_qp_run_socket,'$subroutine') call end_parallel_job(zmq_to_qp_run_socket,'$subroutine')
@ -62,6 +67,7 @@ subroutine $subroutine($params_main)
$copy_buffer $copy_buffer
$generate_psi_guess $generate_psi_guess
deallocate ( pt2_generators, norm_pert_generators, H_pert_diag_generators)
end end
subroutine $subroutine_slave_tcp(iproc) subroutine $subroutine_slave_tcp(iproc)
@ -169,7 +175,7 @@ subroutine $subroutine_slave(thread, iproc)
endif endif
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,1) call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,1)
call push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,N_st,task_id) call push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,i_generator,N_st,task_id)
enddo enddo
@ -186,7 +192,7 @@ subroutine $subroutine_collector
use f77_zmq use f77_zmq
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Collects results from the selection ! Collects results from the selection in an array of generators
END_DOC END_DOC
integer :: k, rc integer :: k, rc
@ -194,7 +200,7 @@ subroutine $subroutine_collector
integer(ZMQ_PTR), external :: new_zmq_pull_socket integer(ZMQ_PTR), external :: new_zmq_pull_socket
integer(ZMQ_PTR) :: zmq_socket_pull integer(ZMQ_PTR) :: zmq_socket_pull
integer*8 :: control, accu integer*8 :: control, accu
integer :: n, more, task_id integer :: n, more, task_id, i_generator
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket integer(ZMQ_PTR) :: zmq_to_qp_run_socket
@ -202,22 +208,25 @@ subroutine $subroutine_collector
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
zmq_socket_pull = new_zmq_pull_socket() zmq_socket_pull = new_zmq_pull_socket()
double precision, allocatable :: pt2(:,:), norm_pert(:,:), H_pert_diag(:,:) double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
allocate ( pt2(N_states,2), norm_pert(N_states,2), H_pert_diag(N_states,2)) double precision, allocatable :: pt2_result(:,:), norm_pert_result(:,:), H_pert_diag_result(:,:)
allocate (pt2(N_states), norm_pert(N_states), H_pert_diag(N_states))
allocate (pt2_result(N_states,N_det_generators), norm_pert_result(N_states,N_det_generators), &
H_pert_diag_result(N_states,N_det_generators))
pt2 = 0.d0 pt2_result = 0.d0
norm_pert = 0.d0 norm_pert_result = 0.d0
H_pert_diag = 0.d0 H_pert_diag_result = 0.d0
accu = 0_8 accu = 0_8
more = 1 more = 1
do while (more == 1) do while (more == 1)
call pull_pt2(zmq_socket_pull, pt2, norm_pert, H_pert_diag, N_states, n, task_id) call pull_pt2(zmq_socket_pull, pt2, norm_pert, H_pert_diag, i_generator, N_states, n, task_id)
if (n > 0) then if (n > 0) then
do k=1,N_states do k=1,N_states
pt2(k,2) = pt2(k,1) + pt2(k,2) pt2_result(k,i_generator) = pt2(k)
norm_pert(k,2) = norm_pert(k,1) + norm_pert(k,2) norm_pert_result(k,i_generator) = norm_pert(k)
H_pert_diag(k,2) = H_pert_diag(k,1) + H_pert_diag(k,2) H_pert_diag_result(k,i_generator) = H_pert_diag(k)
enddo enddo
accu = accu + 1_8 accu = accu + 1_8
call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more) call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more)
@ -234,9 +243,10 @@ subroutine $subroutine_collector
socket_result = new_zmq_pair_socket(.False.) socket_result = new_zmq_pair_socket(.False.)
call push_pt2(socket_result, pt2(1,2), norm_pert(1,2), H_pert_diag(1,2), N_states,0) call push_pt2(socket_result, pt2_result, norm_pert_result, H_pert_diag_result, i_generator, &
N_states*N_det_generators,0)
deallocate ( pt2, norm_pert, H_pert_diag) deallocate (pt2, norm_pert, H_pert_diag, pt2_result, norm_pert_result, H_pert_diag_result)
call end_zmq_pair_socket(socket_result) call end_zmq_pair_socket(socket_result)

View File

@ -1,4 +1,4 @@
subroutine CISD_SC2(dets_in,u_in,energies,dim_in,sze,N_st,Nint,convergence) subroutine CISD_SC2(dets_in,u_in,energies,diag_H_elements,dim_in,sze,N_st,Nint,convergence)
use bitmasks use bitmasks
implicit none implicit none
BEGIN_DOC BEGIN_DOC
@ -21,6 +21,7 @@ subroutine CISD_SC2(dets_in,u_in,energies,dim_in,sze,N_st,Nint,convergence)
integer(bit_kind), intent(in) :: dets_in(Nint,2,sze) integer(bit_kind), intent(in) :: dets_in(Nint,2,sze)
double precision, intent(inout) :: u_in(dim_in,N_st) double precision, intent(inout) :: u_in(dim_in,N_st)
double precision, intent(out) :: energies(N_st) double precision, intent(out) :: energies(N_st)
double precision, intent(out) :: diag_H_elements(dim_in)
double precision, intent(in) :: convergence double precision, intent(in) :: convergence
ASSERT (N_st > 0) ASSERT (N_st > 0)
ASSERT (sze > 0) ASSERT (sze > 0)
@ -197,6 +198,9 @@ subroutine CISD_SC2(dets_in,u_in,energies,dim_in,sze,N_st,Nint,convergence)
converged = dabs(e_corr_double - e_corr_double_before) < convergence converged = dabs(e_corr_double - e_corr_double_before) < convergence
converged = converged converged = converged
if (converged) then if (converged) then
do i = 1, dim_in
diag_H_elements(i) = H_jj_dressed(i) - H_jj_ref(i)
enddo
exit exit
endif endif
e_corr_double_before = e_corr_double e_corr_double_before = e_corr_double

View File

@ -386,39 +386,52 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nint,iun
! ============== ! ==============
k_pairs=0 if (N_st > 1) then
do l=1,N_st
do k=1,l k_pairs=0
k_pairs+=1 do l=1,N_st
kl_pairs(1,k_pairs) = k do k=1,l
kl_pairs(2,k_pairs) = l k_pairs+=1
kl_pairs(1,k_pairs) = k
kl_pairs(2,k_pairs) = l
enddo
enddo enddo
enddo
!$OMP PARALLEL DEFAULT(NONE) & !$OMP PARALLEL DEFAULT(NONE) &
!$OMP SHARED(U,sze,N_st,overlap,kl_pairs,k_pairs, & !$OMP SHARED(U,sze,N_st,overlap,kl_pairs,k_pairs, &
!$OMP Nint,dets_in,u_in) & !$OMP Nint,dets_in,u_in) &
!$OMP PRIVATE(k,l,kl,i) !$OMP PRIVATE(k,l,kl)
! Orthonormalize initial guess ! Orthonormalize initial guess
! ============================ ! ============================
!$OMP DO !$OMP DO
do kl=1,k_pairs do kl=1,k_pairs
k = kl_pairs(1,kl) k = kl_pairs(1,kl)
l = kl_pairs(2,kl) l = kl_pairs(2,kl)
if (k/=l) then if (k/=l) then
overlap(k,l) = u_dot_v(U_in(1,k),U_in(1,l),sze) overlap(k,l) = u_dot_v(U_in(1,k),U_in(1,l),sze)
overlap(l,k) = overlap(k,l) overlap(l,k) = overlap(k,l)
else else
overlap(k,k) = u_dot_u(U_in(1,k),sze) overlap(k,k) = u_dot_u(U_in(1,k),sze)
endif endif
enddo enddo
!$OMP END DO !$OMP END DO
!$OMP END PARALLEL !$OMP END PARALLEL
call ortho_lowdin(overlap,size(overlap,1),N_st,U_in,size(U_in,1),sze) call ortho_lowdin(overlap,size(overlap,1),N_st,U_in,size(U_in,1),sze)
else
overlap(1,1) = u_dot_u(U_in(1,1),sze)
double precision :: f
f = 1.d0 / dsqrt(overlap(1,1))
do i=1,sze
U_in(i,1) = U_in(i,1) * f
enddo
endif
! Davidson iterations ! Davidson iterations
! =================== ! ===================

View File

@ -58,7 +58,7 @@ BEGIN_PROVIDER [ integer, psi_det_size ]
else else
psi_det_size = 1 psi_det_size = 1
endif endif
psi_det_size = max(psi_det_size,10000) psi_det_size = max(psi_det_size,100000)
call write_int(output_determinants,psi_det_size,'Dimension of the psi arrays') call write_int(output_determinants,psi_det_size,'Dimension of the psi arrays')
END_PROVIDER END_PROVIDER

View File

@ -23,8 +23,10 @@ END_PROVIDER
threshold_convergence_SC2 = 1.d-10 threshold_convergence_SC2 = 1.d-10
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ double precision, CI_SC2_electronic_energy, (N_states_diag) ] BEGIN_PROVIDER [ double precision, CI_SC2_electronic_energy, (N_states_diag) ]
&BEGIN_PROVIDER [ double precision, CI_SC2_eigenvectors, (N_det,N_states_diag) ] &BEGIN_PROVIDER [ double precision, CI_SC2_eigenvectors, (N_det,N_states_diag) ]
&BEGIN_PROVIDER [ double precision, Diag_H_elements_SC2, (N_det) ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Eigenvectors/values of the CI matrix ! Eigenvectors/values of the CI matrix
@ -39,7 +41,8 @@ END_PROVIDER
enddo enddo
call CISD_SC2(psi_det,CI_SC2_eigenvectors,CI_SC2_electronic_energy, & call CISD_SC2(psi_det,CI_SC2_eigenvectors,CI_SC2_electronic_energy, &
size(CI_SC2_eigenvectors,1),N_det,N_states_diag,N_int,threshold_convergence_SC2) ! size(CI_SC2_eigenvectors,1),N_det,N_states_diag,N_int,threshold_convergence_SC2)
diag_H_elements_SC2,size(CI_SC2_eigenvectors,1),N_det,N_states_diag,N_int,threshold_convergence_SC2)
END_PROVIDER END_PROVIDER
subroutine diagonalize_CI_SC2 subroutine diagonalize_CI_SC2
@ -54,5 +57,6 @@ subroutine diagonalize_CI_SC2
psi_coef(i,j) = CI_SC2_eigenvectors(i,j) psi_coef(i,j) = CI_SC2_eigenvectors(i,j)
enddo enddo
enddo enddo
SOFT_TOUCH psi_coef CI_SC2_electronic_energy CI_SC2_energy CI_SC2_eigenvectors SOFT_TOUCH psi_coef CI_SC2_electronic_energy CI_SC2_energy CI_SC2_eigenvectors diag_h_elements_sc2
! SOFT_TOUCH psi_coef CI_SC2_electronic_energy CI_SC2_energy CI_SC2_eigenvectors
end end

View File

@ -301,13 +301,21 @@ subroutine diagonalize_s2_betweenstates(keys_tmp,psi_coefs_inout,n,nmax_keys,nma
print*,'' print*,''
print*,'nstates = ',nstates print*,'nstates = ',nstates
allocate(s2(nstates,nstates),overlap(nstates,nstates)) allocate(s2(nstates,nstates),overlap(nstates,nstates))
do i = 1, nstates !$OMP PARALLEL DO COLLAPSE(2) DEFAULT(NONE) SCHEDULE(dynamic) &
overlap(i,i) = u_dot_u(psi_coefs_inout(1,i),n) !$OMP PRIVATE(i,j) SHARED(overlap,psi_coefs_inout,nstates,n)
do j = i+1, nstates do i = 1, nstates
overlap(i,j) = u_dot_v(psi_coefs_inout(1,j),psi_coefs_inout(1,i),n) do j = 1, nstates
overlap(j,i) = overlap(i,j) if (i < j) then
enddo cycle
enddo else if (i == j) then
overlap(i,i) = u_dot_u(psi_coefs_inout(1,i),n)
else
overlap(i,j) = u_dot_v(psi_coefs_inout(1,j),psi_coefs_inout(1,i),n)
overlap(j,i) = overlap(i,j)
endif
enddo
enddo
!$OMP END PARALLEL DO
print*,'Overlap matrix in the basis of the states considered' print*,'Overlap matrix in the basis of the states considered'
do i = 1, nstates do i = 1, nstates
write(*,'(10(F16.10,X))')overlap(i,:) write(*,'(10(F16.10,X))')overlap(i,:)
@ -315,13 +323,21 @@ subroutine diagonalize_s2_betweenstates(keys_tmp,psi_coefs_inout,n,nmax_keys,nma
call ortho_lowdin(overlap,size(overlap,1),nstates,psi_coefs_inout,size(psi_coefs_inout,1),n) call ortho_lowdin(overlap,size(overlap,1),nstates,psi_coefs_inout,size(psi_coefs_inout,1),n)
print*,'passed ortho' print*,'passed ortho'
do i = 1, nstates !$OMP PARALLEL DO COLLAPSE(2) DEFAULT(NONE) SCHEDULE(dynamic) &
overlap(i,i) = u_dot_u(psi_coefs_inout(1,i),n) !$OMP PRIVATE(i,j) SHARED(overlap,psi_coefs_inout,nstates,n)
do j = i+1, nstates do i = 1, nstates
overlap(i,j) = u_dot_v(psi_coefs_inout(1,j),psi_coefs_inout(1,i),n) do j = 1, nstates
overlap(j,i) = overlap(i,j) if (i < j) then
enddo cycle
enddo else if (i == j) then
overlap(i,i) = u_dot_u(psi_coefs_inout(1,i),n)
else
overlap(i,j) = u_dot_v(psi_coefs_inout(1,j),psi_coefs_inout(1,i),n)
overlap(j,i) = overlap(i,j)
endif
enddo
enddo
!$OMP END PARALLEL DO
print*,'Overlap matrix in the basis of the Lowdin orthonormalized states ' print*,'Overlap matrix in the basis of the Lowdin orthonormalized states '
do i = 1, nstates do i = 1, nstates
write(*,'(10(F16.10,X))')overlap(i,:) write(*,'(10(F16.10,X))')overlap(i,:)

View File

@ -2,5 +2,6 @@ program save_natorb
read_wf = .True. read_wf = .True.
touch read_wf touch read_wf
call save_natural_mos call save_natural_mos
call save_ref_determinant
end end

View File

@ -970,12 +970,13 @@ subroutine create_minilist_find_previous(key_mask, fullList, miniList, N_fullLis
integer, intent(in) :: Nint integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: fullList(Nint, 2, N_fullList) integer(bit_kind), intent(in) :: fullList(Nint, 2, N_fullList)
integer(bit_kind),intent(out) :: miniList(Nint, 2, N_fullList) integer(bit_kind),intent(out) :: miniList(Nint, 2, N_fullList)
integer(bit_kind) :: subList(Nint, 2, N_fullList) integer(bit_kind), allocatable :: subList(:,:,:)
logical,intent(out) :: fullMatch logical,intent(out) :: fullMatch
integer,intent(out) :: N_miniList integer,intent(out) :: N_miniList
integer(bit_kind) :: key_mask(Nint, 2) integer(bit_kind) :: key_mask(Nint, 2)
integer :: ni, i, k, l, N_subList integer :: ni, i, k, l, N_subList
allocate (subList(Nint, 2, N_fullList))
fullMatch = .false. fullMatch = .false.
N_miniList = 0 N_miniList = 0
@ -1032,6 +1033,8 @@ subroutine create_minilist_find_previous(key_mask, fullList, miniList, N_fullLis
enddo enddo
N_minilist = N_minilist + N_subList N_minilist = N_minilist + N_subList
end if end if
deallocate(sublist)
end subroutine end subroutine

View File

@ -4,6 +4,7 @@ double precision function ao_bielec_integral(i,j,k,l)
! integral of the AO basis <ik|jl> or (ij|kl) ! integral of the AO basis <ik|jl> or (ij|kl)
! i(r1) j(r1) 1/r12 k(r2) l(r2) ! i(r1) j(r1) 1/r12 k(r2) l(r2)
END_DOC END_DOC
integer,intent(in) :: i,j,k,l integer,intent(in) :: i,j,k,l
integer :: p,q,r,s integer :: p,q,r,s
double precision :: I_center(3),J_center(3),K_center(3),L_center(3) double precision :: I_center(3),J_center(3),K_center(3),L_center(3)
@ -374,20 +375,16 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ]
call add_task_to_taskserver(zmq_to_qp_run_socket,task) call add_task_to_taskserver(zmq_to_qp_run_socket,task)
enddo enddo
integer(ZMQ_PTR) :: collector_thread PROVIDE nproc
external :: ao_bielec_integrals_in_map_collector !$OMP PARALLEL DEFAULT(private) num_threads(nproc+1)
rc = pthread_create(collector_thread, ao_bielec_integrals_in_map_collector)
!$OMP PARALLEL DEFAULT(private)
!$OMP TASK PRIVATE(i)
i = omp_get_thread_num() i = omp_get_thread_num()
call ao_bielec_integrals_in_map_slave_inproc(i) if (i==0) then
!$OMP END TASK call ao_bielec_integrals_in_map_collector(i)
!$OMP TASKWAIT else
call ao_bielec_integrals_in_map_slave_inproc(i)
endif
!$OMP END PARALLEL !$OMP END PARALLEL
rc = pthread_join(collector_thread)
call end_parallel_job(zmq_to_qp_run_socket, 'ao_integrals') call end_parallel_job(zmq_to_qp_run_socket, 'ao_integrals')

View File

@ -230,7 +230,6 @@ subroutine clear_ao_map
end end
!! MO Map !! MO Map
!! ====== !! ======

View File

@ -72,7 +72,7 @@ subroutine add_integrals_to_map(mask_ijkl)
integer :: i2,i3,i4 integer :: i2,i3,i4
double precision,parameter :: thr_coef = 1.d-10 double precision,parameter :: thr_coef = 1.d-10
PROVIDE ao_bielec_integrals_in_map PROVIDE ao_bielec_integrals_in_map mo_coef
!Get list of MOs for i,j,k and l !Get list of MOs for i,j,k and l
!------------------------------- !-------------------------------
@ -329,7 +329,7 @@ end
double precision, allocatable :: iqrs(:,:), iqsr(:,:), iqis(:), iqri(:) double precision, allocatable :: iqrs(:,:), iqsr(:,:), iqis(:), iqri(:)
if (.not.do_direct_integrals) then if (.not.do_direct_integrals) then
PROVIDE ao_bielec_integrals_in_map PROVIDE ao_bielec_integrals_in_map mo_coef
endif endif
mo_bielec_integral_jj_from_ao = 0.d0 mo_bielec_integral_jj_from_ao = 0.d0
@ -495,4 +495,13 @@ subroutine clear_mo_map
call map_deinit(mo_integrals_map) call map_deinit(mo_integrals_map)
FREE mo_integrals_map mo_bielec_integral_schwartz mo_bielec_integral_jj mo_bielec_integral_jj_anti FREE mo_integrals_map mo_bielec_integral_schwartz mo_bielec_integral_jj mo_bielec_integral_jj_anti
FREE mo_bielec_integral_jj_exchange mo_bielec_integrals_in_map FREE mo_bielec_integral_jj_exchange mo_bielec_integrals_in_map
end
subroutine provide_all_mo_integrals
implicit none
provide mo_integrals_map mo_bielec_integral_schwartz mo_bielec_integral_jj mo_bielec_integral_jj_anti
provide mo_bielec_integral_jj_exchange mo_bielec_integrals_in_map
end end

View File

@ -5,6 +5,7 @@ BEGIN_PROVIDER [ double precision, mo_mono_elec_integral,(mo_tot_num_align,mo_to
! array of the mono electronic hamiltonian on the MOs basis ! array of the mono electronic hamiltonian on the MOs basis
! : sum of the kinetic and nuclear electronic potential ! : sum of the kinetic and nuclear electronic potential
END_DOC END_DOC
print*,'Providing the mono electronic integrals'
do j = 1, mo_tot_num do j = 1, mo_tot_num
do i = 1, mo_tot_num do i = 1, mo_tot_num
mo_mono_elec_integral(i,j) = mo_nucl_elec_integral(i,j) + mo_kinetic_integral(i,j) + mo_pseudo_integral(i,j) mo_mono_elec_integral(i,j) = mo_nucl_elec_integral(i,j) + mo_kinetic_integral(i,j) + mo_pseudo_integral(i,j)

View File

@ -3,10 +3,14 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral, (ao_num_align,ao_num)]
BEGIN_DOC BEGIN_DOC
! Pseudo-potential ! Pseudo-potential
END_DOC END_DOC
ao_pseudo_integral = 0.d0
if (do_pseudo) then if (do_pseudo) then
ao_pseudo_integral = ao_pseudo_integral_local + ao_pseudo_integral_non_local if (pseudo_klocmax > 0) then
else ao_pseudo_integral += ao_pseudo_integral_local
ao_pseudo_integral = 0.d0 endif
if (pseudo_kmax > 0) then
ao_pseudo_integral += ao_pseudo_integral_non_local
endif
endif endif
END_PROVIDER END_PROVIDER

View File

@ -295,18 +295,6 @@ BEGIN_PROVIDER [ integer, nproc ]
!$OMP END PARALLEL !$OMP END PARALLEL
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ integer, iproc_save, (nproc) ]
implicit none
BEGIN_DOC
! iproc_save(i) = i-1. Used to start threads with pthreads.
END_DOC
integer :: i
do i=1,nproc
iproc_save(i) = i-1
enddo
END_PROVIDER
double precision function u_dot_v(u,v,sze) double precision function u_dot_v(u,v,sze)
implicit none implicit none

View File

@ -181,14 +181,14 @@ function new_zmq_pair_socket(bind)
endif endif
endif endif
rc = f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_SNDHWM, 0, 4) rc = f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_SNDHWM, 1, 4)
if (rc /= 0) then if (rc /= 0) then
stop 'f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_SNDHWM, 0, 4)' stop 'f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_SNDHWM, 1, 4)'
endif endif
rc = f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_RCVHWM, 0, 4) rc = f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_RCVHWM, 1, 4)
if (rc /= 0) then if (rc /= 0) then
stop 'f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_RCVHWM, 0, 4)' stop 'f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_RCVHWM, 1, 4)'
endif endif
rc = f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_IMMEDIATE, 1, 4) rc = f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_IMMEDIATE, 1, 4)
@ -229,16 +229,11 @@ function new_zmq_pull_socket()
stop 'Unable to set ZMQ_LINGER on pull socket' stop 'Unable to set ZMQ_LINGER on pull socket'
endif endif
rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_RCVHWM,100000,4) rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_RCVHWM,1000,4)
if (rc /= 0) then if (rc /= 0) then
stop 'Unable to set ZMQ_RCVHWM on pull socket' stop 'Unable to set ZMQ_RCVHWM on pull socket'
endif endif
rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_IMMEDIATE,1,4)
if (rc /= 0) then
stop 'Unable to set ZMQ_IMMEDIATE on pull socket'
endif
rc = f77_zmq_bind(new_zmq_pull_socket, zmq_socket_pull_tcp_address) rc = f77_zmq_bind(new_zmq_pull_socket, zmq_socket_pull_tcp_address)
if (rc /= 0) then if (rc /= 0) then
print *, 'Unable to bind new_zmq_pull_socket (tcp)', zmq_socket_pull_tcp_address print *, 'Unable to bind new_zmq_pull_socket (tcp)', zmq_socket_pull_tcp_address
@ -279,7 +274,7 @@ function new_zmq_push_socket(thread)
stop 'Unable to set ZMQ_LINGER on push socket' stop 'Unable to set ZMQ_LINGER on push socket'
endif endif
rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_SNDHWM,100,4) rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_SNDHWM,1000,4)
if (rc /= 0) then if (rc /= 0) then
stop 'Unable to set ZMQ_SNDHWM on push socket' stop 'Unable to set ZMQ_SNDHWM on push socket'
endif endif
@ -355,11 +350,11 @@ subroutine end_zmq_pull_socket(zmq_socket_pull)
! endif ! endif
rc = f77_zmq_unbind(zmq_socket_pull,zmq_socket_pull_tcp_address) rc = f77_zmq_unbind(zmq_socket_pull,zmq_socket_pull_tcp_address)
if (rc /= 0) then ! if (rc /= 0) then
print *, rc ! print *, rc
print *, irp_here, 'f77_zmq_unbind(zmq_socket_pull,zmq_socket_pull_tcp_address)' ! print *, irp_here, 'f77_zmq_unbind(zmq_socket_pull,zmq_socket_pull_tcp_address)'
stop 'error' ! stop 'error'
endif ! endif
call sleep(1) ! see https://github.com/zeromq/libzmq/issues/1922 call sleep(1) ! see https://github.com/zeromq/libzmq/issues/1922

View File

@ -155,7 +155,7 @@ function run_all_1h_1p() {
ezfio set determinants read_wf True ezfio set determinants read_wf True
qp_run mrcc_cassd $INPUT qp_run mrcc_cassd $INPUT
energy="$(ezfio get mrcc_cassd energy)" energy="$(ezfio get mrcc_cassd energy)"
eq $energy -76.2284994316618 1.e-4 eq $energy -76.2288648023833 1.e-4
} }
@ -166,7 +166,7 @@ function run_all_1h_1p() {
} }
@test "SCF H2O VDZ pseudo" { @test "SCF H2O VDZ pseudo" {
run_HF h2o_pseudo.ezfio -16.9483708495521 run_HF h2o_pseudo.ezfio -16.9483703905461
} }
@test "FCI H2O VDZ pseudo" { @test "FCI H2O VDZ pseudo" {