Видимо, набрал текст всей программы cin1 icon

Видимо, набрал текст всей программы cin1




НазваниеВидимо, набрал текст всей программы cin1
Дата конвертации05.05.2016
Размер76.68 Kb.
ТипДокументы
источник

Computer code:

Created: Dec 03, 03; 13:34 (probably)

Printed out on August 28, 2004 in Sydney, Australia.

Method which is implemented by this computer code: Configuration interaction for n electrons (CIN).

Name of the file: cin1.f

----

___________

* Physics:

Видимо, набрал текст всей программы cin1.f

cin1.f

Dec 03, 03 13:34, Printed: August 28, 2004 (Saturday).

pages 4, 5, 6/42 (2, 3/21):

c..............

SUBROUTINE FORMJ(iwr)

implicit doubleprecision(a-h,o-z)

INCLUDE "cin.h"

COMMON /NC/NC/NE/NE/ND/ND/MJ/MJ

common/nnn/ee(NVM) ,nnn(NVM) ,kkk(NVM) ,ll(NVM) ,jj(NVM) ,nlist

COMMON /JZ/JZ(NJZMAX) /NH/NH(NJZMAX) /NDC/NDC(NJZMAX)

COMMON/NCJ/NCJ(NCMAX) /COEF/COEF(NCOEF) /NV/NV

DIMENSION IDET(128) , IDET1(128) , IDET2(128) , NSTATES(50)

real *8, allocatable :: aa(: , :) , ev(:) , dd(:)

REAL COEF

character jobs/'V'/ , uplo/'U'/

NSTATES=0

----

N=0

IV=0

IVV=0

NDNM=0

DO IC1=1,NC

NDNM=MAX0(NDNM,NDC(IC1))

END DO

allocate (aa(NDNM,NDNM) ,ev(NDNM) ,dd(3*NDNM))

if(allocated(aa) .and.allocated(ev) .and.

. allocated(dd))then

c print *,' OK'

else

stop 'allocation failed'

end if

izer=0

DO 100 IC1=1,NC

NDN=NDC(IC1)

c print 25,ic1,nc,ndn,ndnm

c 25 format('formj:' ,4i5)

N0=N

C CALL PCONFW(6,IC1)

aa=0.0

DO 10 NN=1,NDN

N=N+1

Call Gdet (N, IDET1)

K=N0

DO 20 KK=1,NN

K=K+1

IF (K.EQ.N) THEN

T=MJ*MJ

DO 30 IQ=1,NE

IA=IDET1(IQ)

NA=NH(IA)

JA=JJ(NA)

MA=JZ(IA)

T=T+JA*(JA+2)-MA**2

DO 40 JQ=IQ+1,NE

IB=IDET1(JQ)

T=T-PLJ(IA,IB)**2-PLJ(IB,IA)**2

40 CONTINUE

30 CONTINUE

c IF (T.EQ.0.d0) GOTO 20

ELSE

Call Gdet (K, IDET2)

DO 50 I=1,NE

IDET(I)=IDET2(I)

50 CONTINUE

CALL RSPQ1(NE,IDET1,IDET,IS,NF,I,J)

IF (NF.NE.2) GOTO 20

C determinanty otli~a'tsq dwumq funkciqmi

IA=IDET1 (I)

IB=IDET1 (J)

IC=IDET (I)

ID=IDET (J)

T=PLJ(IA, IC)*PLJ(ID,IB)+PLJ(IC,IA)*PLJ(IB,ID)-

1 PLJ(IA, ID)*PLJ(IC,IB)-PLJ(ID,IA)*PLJ(IB,IC)

T=T*IS

END IF

AA(NN,KK)=T/4

AA(KK,NN)=T/4

20 CONTINUE

10 CONTINUE

--

c lwork = 3*LIMP

c call dsyev(jpbs,uplo,NDN,AA,LIMP,ev,dd,iwork,info)

lwork = 3*NDNM

call dsyev(jpbs,uplo,NDN,AA,NDNM,ev,dd,iwork,info)

c print 11,NDN,NDNM,info

c 11 format('dsyev: n=',i3,' nmax=',i3,' info=',i3)

IF(INFO.NE.0)THEN

PRINT 12, IC1,NDN,INFO

12 FORMAT('DSYEV FAILED: IC=',I3,' NDN=',I3,' INFO=',I2)

STOP

END IF

do ie=1,NDN

AJ=DSQRT(EV(IE)+0.25D0)-0.5D0

J2=2*AJ+0.01

c print 19,ie,aj

c 19 format('formj:',i4,' j=',f6.2)

IF(J2.EQ.MJ)THEN

IV=IV+1

IF(IV.GT.NCMAX)THEN

PRINT 202,IV,NCMAX

202 FORMAT(' IV=',I6,' greater than NCMAX=', i6)

STOP

END IF

NCJ(IV)=IC1

sn=0.

IF(IVV+NDN.GT.NCOEF)THEN

PRINT 201,IC1,IVV+NDN,NCOEF

201 FORMAT('Failed on configuration #',i4,/

/ ' Index for COEF=',i7,' greater then(than?) NCOEF=',

/ i8)

stop

end if

do i=1,NDN

sn=sn+AA(i,ie)**2

COEF(IVV+I)=AA(I,IE)

c if(abs(coef(ivv+i)).lt.1.d-10)izer=izer+1

if(coef(ivv+i).eq.1.d0)izer=izer+1

end do

IVV=IVV+NDN

IF(ABS(SN-1.D0).GT.1.D-6)THEN

print 13,ie,AJ,sn

13 format(i3,')J=',F5.2,' sn=',f10.6$)

PRINT 14,(aa(i,ie),i=1,NDN

14 FORMAT(5F10.6)

STOP

END IF

END IF

J=2*AJ+1.01

NSTATES(J)=NSTATES(J)+1

end do

100 CONTINUE

print *,' IVV=',IVV

c print *,' izer=',izer

if(iwr.eq.1)then

DO J=1,50

IF(NSTATES(J).GT.0)THEN

AJ=0.5D0*(J-1.D0)

PRINT 15,AJ,NSTATES(J)

15 FORMAT(' J=',F5.2,' Number of states=',i5)

END IF

END DO

AJ=0.5*MJ

----

PRINT 16,AJ,IV

end if

NV=IV

16 FORMAT(' Number of states with J=',f5.2,' is ', i5)

c , ' Corresponding configurations are:')

c print 17,(NCJ(I),I=1,IV)

c 17 FORMAT(10I5)

deallocate(aa,ev,dd)

RETURN

END

c

_______________

----

Implicit doubleprecision(a-h, o-z)

INCLUDE “cin.h”

Common /ne/ ne /nd/nd /mj/mje /nc/nc, ncr /nv/nv

/ /Nlev/Nlev /ER0/ ER0 fk/fk(9) /nso/nlist0

/ /ENERGY/EN0, ICUT, ESIGMA(9) /vsc/vsc(9) /DE/ICUTQ, DE

C common /work/work(IWK)

Dimension nlmax1(5, 5), nlmax2(5, 5), nlmax(9)

Dimension ev(NT1)

Real *8, allocatable :: work(:)

REAL *8 er0, ev, ee

CHARACTER integral1 *20, integral2 *20, integrale *20, LET(6)

Open(unit=1, file=’cin1.dat’,STATUS=’OLD’, form=’formatted’)

READ(1, 12) integral1

READ(1, 12) integral2

READ(1, 12) integrale

12 FORMAT(A20)

PRINT *, ‘File for one-electron integrals-’, integral1

PRINT *, ‘File for two-electron integrals-’, integral2

READ(1, *) ER0

READ(1, *) EN0, ICUT, ICUTQ

READ(1, *) (vsc(I), I=1,9)

READ(1, *)(fk(I), I=1,9)

READ(1, *)(ESIGMA(I), I=1,9)

READ(1, *) amj

READ(1, *) Nlev

READ(1, *) iconf1, lmax1

Do j=1, iconf1

Read(1, *) (nlmax1(i,j), i=1, lmax1+1)

End do

Call readint1(integral1, integral2, integrale, lmax, nlmax)

Call makegaunt(2*lmax+1)

MJe = 2.*ABS(amj)+0.01

Call dinit(nlist0)

Call donrl(nlist0)

Call rnrc(ne, lp)

Call config(ne, lp, iconf1, lmax1, nlmax1)

C call outcnr(ne)

Call mackerel(ne)

C call outcrel(ne)

Call jterm(1)

C call outdets(ne)

Call formj(1)

CALL FORMH

C IWK=2*NXX*LIM+LIM*LIM+(NUME+11)*LIM+2*NUME

IWK=2*NV*LIM+LIM*LIM+(NUME+11)*LIM+2*NUME

C limi=nlev+2

C IWK=2*NV*limi+ limi**2+(NUME+11)* limi+2*NUME+NBLOCK

Allocate(work(IWK))

If Allocate(work(IWK)) then

Print *, ‘work - ok’

Else ‘allocation of work failed’

End if

Print *, ‘work:’, size(work)

Call DODAVE(NV, NLEV, EV, WORK(1), iwk)

Call OUTP(NV, NLEV, EV, WORK(1))

STOP

END

Code (additional(2-d part)):

Subroutine readint1(integral1, integral2, integrale, lmax1, nlmax)

Implicit doubleprecision(a-h,o-z)

Include “cin.h”

Common/some/jmin, jmax, nhint /NSO/NSO

Common/nnn/ee(NVM), nnn(NVM), kk(NVM), ll(NVM), jj(NVM), nlist

Common/rint1/rint1(NRI1), rsig(NRI1), rdsig(NRI1), iint1(NRI1)

Common/qqq/qq(NIMAX2), nad(NIMAX2), kat(NKAT2), ngint, katomax

Common/qpar/nvl(NVM), nvlist

Common/qqqe/qe(NIMAX1), qqe(NIMAX1), nade(NIMAX1),

. kate(NKAT1), ngintq, katomq /fk/fk(9), fkk(9)

Common/val/nlistq, nnv(NVM), kapv(NVM) /ns/ns /de/icutq

Dimension nlmax(9)

Real qq, qe, qqe

CHARACTER integral1 *20, integral2 *20, integrale *20

OPEN(UNIT=13, FILE= integral1, STATUS =’old’,

, FORM=’UNFORMATTED’)

Do i=1,9

Nmax(i)=0

End do

Read(13) jmin, jmax, jmax, nlist

Jmin=jmin

Jminq= jmin

NSO= jmin

Ns=nlist

If(nlist.gt.NVM) then

Write(6, 106) nlist, NVM

106 format(‘Too many basis states: nlist=’,i4, ‘while NVM=’, i4)

Stop

End if

Read(13)(nnn(I), kk(I), LL(I), JJ(I), EE(I), I=1, nlist)

Lmax1=0

Do i=1, nlist

Write(6,6)i, nnn(i), kk(i), ll(i), jj(i), ee(i)

C Write(10,6)i, nnn(i), kk(i), ll(i), jj(i), ee(i)

6 format(i4,’)n=,i2, ‘kap=’,i2,’l=’,i2, ‘j=’,i2,’/2en’,

, f12.6)

If(i.eq.nso) write(6,7)

C If(i.eq.nso) write(10,7)

7 format(‘______________’)

If(kk(i).lt.0.and.i.gt.jmin) then

Nlmax(ll(i)+1)= Nlmax(ll(i)+1)+1

Lmax1=max0(lmax1,ll(i))

End if

End do

Print 5, lmax1, (nlmax(l), l=1, lmax1+1)

5 format(/’Number of basis functions for l=0 to’,i3,’:’/

/ 10i4)

Read(13) NHINT, NLIST11

If(nhint.gt.NRI1) then

Write(6, 107) nhint, NRT1

107 format(‘Too many integrals: nhint=’, i6, ‘’,i6)

Stop

End if

Read(13)(RINT1(I), I=1,NHINT)

Read(13)(IINT1(I), I=1,NHINT)

Read(13)(RSIG(I), I=1,NHINT)

Read(13)(RDSIG(I), I=1,NHINT)

Close(13)

*****************************

OPEN(UNIT=13, FILE=integral2, STATUS=’old’,

, FORM=’UNFORMATTED’)

Read(13) jmin, nlist, ngint, katom

If(ngint.gt.NIMAX2.or.katom.gt.NKAT2) then

Print 110, ngint, NIMAX2, katom, NKAT2

110 format(‘Too much date to read:’,/’ngint=’,i7,

, ‘NIMAX2=’,i7, ‘katom=’,i6, ‘NKAT2=’,i6)

Stop

End if

Read(13)

Print *, ngint, NIMAX2, katom, NKAT2

Read(13)(kat(i), i=1,katom)

Read(13)(nad(i), i=1,ngint)

Read(13)(qq(i), i=1, ngint)

Close(13)

*****************************

If(icut.eq.0) then

Nvl=0

Nvlist=0

Fkk=1.

Else

OPEN(UNIT=13, FILE=integrale, STATUS=’old’,

, FORM=’UNFORMATTED’)

Read(13)nlistq,ngintq,katomq

Read(13)(nnv(i), kapv(i), i=1, nlistq)

Read(13)(qqe(i), i=1, ngintq)

Read(13)(nade(i), i=1, ngintq)

Read(13)(kate(i), i=1, katomq)

Read(13)(fkk(i), i=1, 9)

Close(13)

Nvlist=nlistq

C print *, ‘nlistq=’, nlistq

C print 117,(nnv(i), kapv(i), i=1, nlistq)

C 117 format(‘nnv=’,i4,’kapv=’,i4)

Do in=jmin+1, nlist

Do iv=1, nlistq

If(kk(in).eq.kapv(iv).and.nnn(in).eq.nnv(iv))nvl(iv)=in

End do

End do

Print 17, (fkk(i), i=1,9)

17 format(‘fk:’,5f10.5)

Return

901 stop

end

(part 3 of the code:)

Subroutine RSPQ1(N, IDET1, IDET2, IS, NF, I1, I2)

DIMENSION IDET1(128), IDET2(128)

c-----------------------------

c write(*, 5)(idet1(i), i=1,n)

c write(*, 5)(idet2(i), i=1,n)

5 format(15x, 10I3)

IS=1

Ni=0

Nj=0

I2=0

J2=0

Nf=3

I=1

J=1

L0=0

200 l1=idet1(i)

L2= idet2(j)

If(l1.LT.l0) Goto 1100

L0=l1

If(l1.NE.l2) Goto 210

I=i+1

J=j+1

If(i.LE.n.and.j.LE.n) Goto 200

Goto 230

210 if(l1.GT.l2) Goto 220

Ni=ni+1

If(ni.GT.2) return

I1=i2

I2=i

I=i+1

If(i.LE.n) Goto 200

Goto 230

220 nj=nj+1

If(nj.GT.2) return

J1=j2

J2=j

J=j+1

If(j.LE.n) Goto 200

230 nf=ni

If(i.LE.j) Goto 240

Do 10 k=j,n

J1=j2

J2=k

10 continue

Goto 250

240 if(i.EQ.j) Goto 250

Nf=nj

Do 20 k=I,n

I1=i2

I2=k

20 continue

250 if(nf.EQ.0) return

If(j2.EQ.i2) Goto 260

K=iabs(j2-i2)

If(k.NE.2*(k/2)) is=-is

K2=idet2(j2)

260 if(nf.EQ.1) Goto 1000

If(j1.EQ.i1) Goto 1000

K=iabs(j1-i1)

If(k.NE.2*(k/2)) is=-is

K=idet2(j1)

C

C ????? error ???!!!

Idet2(j1)= Idet2(j1)

C ????? error ???!!!

C

Idet2(i1)=k

1000 if(j2.ne.i2) idet2(i2)=k2

Return

1100 write(*, 15) l0, l1

15 format(1x, ‘Rspq: wrong order of positions’,

! I3, ‘and’, I3, ‘in one of configurations’)

Stop

end

Здесь в набранном мной тексте программы возможна путаница буквы l и цифры 1, а так же буквы о и цифры 0.

______

в файле cin.h видимо заданы максимальные границы изменения ряда параметров компьютерной программы, таких например, как максимальный размер матрицы (NXX) для диагонализации методом Давидсона.

_____________

--

Here:

NV - полное количество базисных функций.

DETS - указывает пределы списка (какие номера детерминантов соответствуют каким базисным функциям).

DODAVE - реализует диагонализацию матрицы методом Давидсона.

MATRIJ - вычисляет многоэлектронный матричный элемент для двух детерминантов.

Gdet(N, IDET1): N- номер детерминанта;

IDET1 - список одноэлектронных состояний, соответствующих данному детерминанту.

RSPQ1 - сравнивает детерминанты на предмет того, каким количеством функций они отличаются.

I1, I2, J1, J2 - номера одноэлектронных состояний.

______



Похожие:

Видимо, набрал текст всей программы cin1 iconДокументы
1. /Рок-текст 1/PROROCK.DOC
2. /Рок-текст...

Видимо, набрал текст всей программы cin1 iconДокументы
1. /Исходный текст/ПЖ1.doc
2. /Исходный...

Видимо, набрал текст всей программы cin1 iconПримерная рабочая программа составлена на основе «Программы по русскому языку 10 11 класс общеобразовательных учреждений»
Охватывает и лексику текстов по разным предметам и сам текст – его строение применительно к разным учебным предметам
Видимо, набрал текст всей программы cin1 iconВидимо, "ВС" в регистрационном номере автомобиля одного из моих врагов, человек Арсения Я, нужно заменить на "СВ"

Видимо, набрал текст всей программы cin1 iconДокументы
1. /Текст проекта акта 00-04-19918-10-14-58-21-5-ver2-13854-numb-57727.doc
2.
Видимо, набрал текст всей программы cin1 iconДокументы
1. /Текст Конституции СССР 1918 года.txt
2. /Текст...

Видимо, набрал текст всей программы cin1 iconС гранатой против
Наш взвод противотанковых ружей занимал оборону на высотке за одним населённым пунктом. Мы прекрасно видели находившиеся в деревне...
Видимо, набрал текст всей программы cin1 iconБизнес пособие для Гениев 
Как это, видимо, обычно и бывает, я пишу введение после того, как книга закончена. Что же важного я хочу сообщить читателю?
Видимо, набрал текст всей программы cin1 iconСаша сказала, что папа стал всем недоволен в последнее время, возможно, из-за того, что бабушка заставляет папу копать помойную яму. Видимо, папе тяжело выполнять такую примитивную, грязную работу

Видимо, набрал текст всей программы cin1 iconВалтер Комарек Рядом с Че Геварой
Видимо, я произвел на них впечатление, так как после возвращения домой и анализа собранной во всех странах информации, они обратились...
Разместите кнопку на своём сайте:
Документы


База данных защищена авторским правом ©ex.kabobo.ru 2000-2014
При копировании материала обязательно указание активной ссылки открытой для индексации.
обратиться к администрации