program cicond implicit none integer*4 nv,no,n,m,ie,vmax,omax,ii,io,iv,iw real*8,allocatable::c(:) real*8 e,cmax,tol,an character*80 s80 write(6,*)'Nocc, Nvirt, tolerance: ' read(5,*)no,nv,tol n=0 m=0 ie=0 open(9,file='ciss_a') open(19,file='ciss_a.co') 1 read(9,90,end=99,err=99)s80 90 format(a80) if(s80(2:23).eq.'tensor space dimension')then read(s80(24:len(s80)),*)n if(n.ne.no*nv)call report('NV X NO <> N') endif if(s80(2:27).eq.'current subspace dimension')then read(s80(28:len(s80)),*)m if(n.ne.no*nv)call report('NV X NO <> N') endif if(s80(13:24).eq.'eigenvalue =')then if(n.eq.0)call report('N undefined') if(m.eq.0)call report('M undefined') ie=ie+1 read(s80(25:len(s80)),*)e write(19,901)ie,e 901 format('e ',i10,' ',d20.14) if(ie.eq.1)allocate(c(n)) read(9,900)(c(ii),ii=1,n) 900 format(4D20.14) ii=0 iw=0 omax=0 vmax=0 cmax=abs(c(1)) an=0.0d0 do 2 io=1,no do 2 iv=1,nv ii=ii+1 if(abs(c(ii)).gt.cmax)then cmax=abs(c(ii)) omax=io vmax=iv+no endif if(dabs(c(ii)).gt.tol)then iw=iw+1 write(19,190)c(ii),io,iv+no 190 format(d20.14,2i7) endif an=an+c(ii)**2 2 continue write(6,700)ie,e*27.2114d0,cmax,omax,vmax,an 700 format(i9,f10.3,' eV,',f7.4,' of',i7,' ->',i7,' norm:',f10.5,$) write(6,*)iw,' written' endif goto 1 99 close(9) close(19) end subroutine report(o) character*(*) o write(6,*)o stop end