1c $Id$ 2cccc subroutine prepint2(bl,eps,inuc,ibas,na,nbf,nsh,ncf,ncs,inx, 3 subroutine prepint2(bl, inuc,ibas,na,nbf,nsh,ncf,ncs,inx, 4 * lcore,maxprice,scftype) 5c--------------------------------------------------------------- 6c EPS is not used here, threshold is now set by calling 7c texas_set_accy before texas_init is called. 8c--------------------------------------------------------------- 9c dimensions for logical matrices in commons logicd,logic1-11 : 10c 11c up to ff,ff : 12c parameter (lpar1=14,lpar2= 455,lpar3= 364,lpar4=5,lpar5=13) 13c up to gg,gg : 14c parameter (lpar1=18,lpar2= 969,lpar3= 816,lpar4=6,lpar5=17) 15c up to hh,hh : 16c parameter (lpar1=22,lpar2=1771,lpar3=1540,lpar4=7,lpar5=21) 17c up to ii,ii : 18c parameter (lpar1=26,lpar2=2925,lpar3=2600,lpar4=8,lpar5=25) 19c up to jj,jj : 20c parameter (lpar1=30,lpar2=4495,lpar3=4060,lpar4=9,lpar5=29) 21c up to kk,kk (which is ii,ii + 2 ) 22cold parameter (lpar1=34,lpar2=6545,lpar3=5984,lpar4=10,lpar5=33) 23c up to ll,ll : 24c parameter (lpar1=38,lpar2=9139,lpar3=8436,lpar4=11,lpar5=37) 25c up to mm,mm : 26c parameter (lpar1=42,lpar2=12341,lpar3=11480,lpar4=12,lpar5=41) 27c--------------------------------------------------------------- 28c 29 implicit real*8 (a-h,o-z) 30 logical firstd 31 character*11 scftype 32c 33#include "texas_lpar.fh" 34cxx 35 common /cpu/ intsize,iacc,icache,memreal 36 common /infor/ icheck,firstd,ndirect,nprint,iblok,nbeg,nend 37 common /infob/ inucx,ibasx,nax,nbfx,nshx,ncfx,ncsx 38c 39 common /memor1b/ nbl2 40 common /memor2/ nqrtd, nibld,nkbld, nijbd,nijed, nklbd,nkled 41c 42 common /memors/ nsymx,ijshp,isymm 43c---------------------------------------------------------------- 44c 45 dimension bl(*) 46 dimension inx(12,*) 47c 48c---------------------------------------------------------- 49c 50 call txs_second(tim1) 51c 52c---------------------------------------------------------- 53c set up integral threshold : 54c 55c call setup_thres(eps) 56c now done in texas_set_accy which calls setup_thresh() routine 57c---------------------------------------------------------- 58c setup the infob common : 59c 60 inucx=inuc 61 ibasx=ibas 62 nax =na 63 nbfx =nbf 64 nshx =nsh 65 ncfx =ncf 66 ncsx =ncs 67c 68cnew nsymx=nsym 69 nsymx=0 70c---------------------------------------------------------- 71 call fprep 72c 73c---------------------------------------------------------- 74c setup logical matrices - old logobsa; common /logicd/, logic1-11/ 75c 76 call datlog(inx,ncs,lpar1,lpar2,lpar3,lpar4,lpar5) 77c 78c---------------------------------------------------------- 79c blocking procedure for pairs of contracted shells 80c 81 call txs_second(tim3) 82 call blockin2(bl,lcore,inx,nbl2) 83c 84 call txs_second(tim4) 85 timblok2=tim4-tim3 86c 87c---------------------------------------------------------- 88c 89 call txs_second(tim2) 90 timprep2=tim2-tim1 91c 92 end 93c================================================================ 94c 95 subroutine timepr(tblock) 96 implicit real*8 (a-h,o-z) 97c 98 common /timex/ tconv1,tconv2,ttrobs 99 common /time0/ tprec2 100 common /time1/ tpre4n,txwpq ,tassem,tamshf,tdesti 101 common /time2/ terint,ttrans 102 common /time3/ tzeroi,tspeci 103 common /time4/ tderiv 104 common /time5/ tcheck,tuniq2,tmap4u 105c 106 if(tblock.eq.0.0d0) then 107ctime 108 tprec2=0.0d0 109 tconv1=0.0d0 110 tconv2=0.0d0 111 ttrobs=0.0d0 112 tpre4n=0.0d0 113 txwpq =0.0d0 114 tassem=0.0d0 115 tamshf=0.0d0 116 tdesti=0.0d0 117 terint=0.0d0 118 tzeroi=0.0d0 119 tspeci=0.0d0 120 ttrans=0.0d0 121 tderiv=0.0d0 122c 123 tcheck=0.0d0 124 tuniq2=0.0d0 125 tmap4u=0.0d0 126ctime 127 else 128c 129 write(8,120) tblock,tprec2, 130 * tpre4n,tzeroi,txwpq,tconv1,tconv2, 131 * ttrobs,tassem,tderiv,tamshf,ttrans, 132 * terint,tspeci, 133 * tblock+tprec2+terint+tspeci, ! calculation 134 * tuniq2,tmap4u,tcheck,tdesti, 135 * tuniq2+tmap4u+tcheck+tdesti, ! interface 136 * tblock+tprec2+terint+tspeci + tuniq2+tmap4u+tcheck+tdesti 137c call util_flush(8) 138 120 format( 139 * '========================================================'/ 140 * ' '/ 141 * 'T I M I N G O F T E X A S S U B R O U T I N E S (sec)'/ 142 * ' '/ 143 * '========================================================'/ 144 * 'time for BLOCKIN=',f10.1/ 145 * '--------------------------------------------------------'/ 146 * 'time for PRECALC=',f10.1/ 147 * '--------------------------------------------------------'/ 148 * ' time for prec4n =',f10.1/ 149 * ' time for zeroin =',f10.1/ 150 * ' time for xwpq =',f10.1/ 151 * ' time for conv1x =',f10.1/ 152 * ' time for conv2x =',f10.1/ 153 * ' time for trobsa =',f10.1/ 154 * ' time for assemb =',f10.1/ 155 * ' time for derivx =',f10.1/ 156 * ' time for amshif =',f10.1/ 157 * ' time for transf =',f10.1/ 158 * ' ---------------------------'/ 159 * 'time for ERINTEG=',f10.1/ 160 * '--------------------------------------------------------'/ 161 * 'time for ERINTSP=',f10.1/ 162 * '========================================================'/ 163 * 'CALCULATION TIME=',f10.1,' (pure texas calculations) '/ 164 * '========================================================'/ 165 * ' time for uniq_pa=',f10.1/ 166 * ' time for map2uni=',f10.1/ 167 * ' time for checkio=',f10.1/ 168 * ' time for destiny=',f10.1/ 169 * ' ---------------------------'/ 170 * 'INTERFACE TIME=',f10.1,' (internal interface) '/ 171 * '========================================================'/ 172 * 'TOTAL TEXAS TIME=',f10.1/ 173 * '========================================================') 174c 175 endif 176c 177 end 178c================================================================ 179 subroutine setup_thresh(thres) 180 implicit real*8 (a-h,o-z) 181c---------------------------------------------------------------- 182c Set up the integral threshold : 183c---------------------------------------------------------------- 184c Estimator1=16/(pi)**1/2 * Sab*Scd * 1/(a+b+c+d)**1/2 185c 186c where Sab=(a+b)**-1 * (a*b)**+3/4 *exp(-ab/(a+b) * Rab**2 ) 187c 188c 189c Estimator1 > eps do integrals . 190c 191c It is done in a quadratic form by Es1*Es1> eps**2 192c 193c Sab**2 * Scd**2 > pi/256 * eps**2 * (a+b+c+d) 194c 195c epsr= pi/256 * eps**2 196c 197c eps =eps -original thresh. for integrals, 198c eps1=1/eps used to rescale integr. in precalc2a subroutine 199c epsr=pi/256 *eps**2-used in prec4neg and precspec subroutines. 200c---------------------------------------------------------------- 201c pi256=pi/256 202c 203 common /neglect/ eps,eps1,epsr 204 data pi256 / 0.012271846d0 / 205c 206 eps =thres 207 eps1=1.0d0/eps 208 epsr=pi256*eps*eps 209c 210ccc write(6,*)' integ thresh from setup_thresh()=',eps 211c---------------------------------------------------------- 212 end 213