PROGRAM GARTTT IMPLICIT INTEGER*4 (I-N) IMPLICIT REAL*8(A-H,O-Z) PARAMETER (NT0=500,MX3=3*NT0,nw0=10) DIMENSION ALPHA(3,3,MX3),GTENS(3,3,MX3),ATENS(3,3,3,MX3), 1w(nw0),ALPHA0(3,3),GTENS0(3,3),ATENS0(3,3,3),wnm(nw0), 2iaa(6),jaa(6) CHARACTER*80 filename,s80,st data iaa/1,2,3,1,1,2/ data jaa/1,2,3,2,3,3/ c write(6,600) 600 format(/,' This program reads frequency-dependent tensors',/, 1 ' from verbose Gaussian output for ROA',/,/, 1 ' (symmetry not implemented!)',/,/, 1 ' Input Filename: ',$) READ(5,401)filename iw=0 nat=0 snt=0.0d0 open(4,file=filename) 1 read(4,401,err=44,end=44)s80 401 format(a80) if(s80(2:13).eq.'Nuclear step')read(s80,890)snt 890 format(14x,f9.6) if(s80(1:26).eq.' Number Number Ty')then read(4,*) nat=0 2 read(4,401)st if(st(2:3).ne.'--')then nat=nat+1 goto 2 endif endif if(s80(2:27).eq.'Property number 1 -- Alpha')then backspace 4 6 read(4,401)st if(st(2:27).eq.'Property number 1 -- Alpha')then iw=iw+1 read(st,800)iw,w(iw) 800 format(43x,i3,f12.6) if(w(iw).eq.0.0d0)then wnm(iw)=0.0d0 else wnm(iw)=1.0d7/(w(iw)*219470.0d0) endif do 5 ii=1,4 5 read(4,*) goto 6 else goto 44 endif endif goto 1 44 close(4) write(6,6001)snt,nat,iw 6001 format(' Step : ',f12.6,' A',/,i4,' atoms, ',i2,' frequencies') write(6,6003)(w(ii),ii=1,iw) 6003 format(f12.6,$) write(6,6004) 6004 format(' hartree') write(6,6003)(wnm(ii),ii=1,iw) write(6,6005) 6005 format(' nm') write(6,6002) 6002 format(' Input Number of the Desired Frequency: ',$) read(5,*)iwd N=3*NAT if(NAT.gt.NT0)then write(6,*)' Too many atoms' stop endif do 101 i=1,N do 101 ix=1,3 do 101 iy=1,3 ALPHA(ix,iy,i)=0.0d0 GTENS(ix,iy,i)=0.0d0 do 101 iz=1,3 101 ATENS(ix,iy,iz,i)=0.0d0 ida=-2 idg=-2 idaa=-2 il=6*nat open(4,file=filename) 11 read(4,401,err=444,end=444)s80 if(s80(2:27).eq.'Property number 1 -- Alpha'.and.ida.lt.il)then read(s80,800)iw if(iw.eq.iwd)then ida=ida+1 if(ida.gt.0)then read(4,*) do 1001 ixx=1,3 1001 read(4,4007)(ALPHA0(ixx,iy),iy=1,3) 4007 format(7x,3d13.6) ia=(ida-1)/6+1 ix=(ida-6*(ia-1)+1)/2 idiff=ida-6*(ia-1)-2*ix+2 c idiff=1 ..forward c idiff=2 ..backward if(idiff.eq.1)then sig=1.0d0 else sig=-1.0d0 endif i=ix+3*(ia-1) c write(6,6009)ia,ix,idiff,ALPHA0(1,1) 6009 format(3i4,f12.6) do 1002 ixx=1,3 do 1002 iy=1,3 1002 ALPHA(ixx,iy,i)=ALPHA(ixx,iy,i)+sig*ALPHA0(ixx,iy) endif endif endif c goto 9000 if(s80(2:27).eq.'Property number 2 -- FD Op'.and.idg.lt.il)then read(s80,801)iw 801 format(58x,i3,f12.6) if(iw.eq.iwd)then idg=idg+1 if(idg.gt.0)then read(4,*) do 2001 ix=1,3 2001 read(4,4007)(GTENS0(iy,ix),iy=1,3) ia=(idg-1)/6+1 ix=(idg-6*(ia-1)+1)/2 idiff=idg-6*(ia-1)-2*ix+2 if(idiff.eq.1)then sig=1.0d0 else sig=-1.0d0 endif i=ix+3*(ia-1) c write(6,6009)ia,ix,idiff,GTENS0(1,1) do 2002 ixx=1,3 do 2002 iy=1,3 2002 GTENS(ixx,iy,i)=GTENS(ixx,iy,i)+sig*GTENS0(ixx,iy) endif endif endif if(s80(2:27).eq.'Property number 4 -- D-Q p'.and.idaa.lt.il)then read(s80,802)iw 802 format(50x,i3,f12.6) if(iw.eq.iwd)then idaa=idaa+1 if(idaa.gt.0)then read(4,*) do 4001 I6=1,6 ix=iaa(I6) iy=jaa(I6) read(4,4007)(ATENS0(ix,iy,iz),iz=1,3) do 4001 iz=1,3 4001 ATENS0(iy,ix,iz)=ATENS0(ix,iy,iz) ia=(idaa-1)/6+1 ix=(idaa-6*(ia-1)+1)/2 idiff=idaa-6*(ia-1)-2*ix+2 c idiff=1 ..forward c idiff=2 ..backward if(idiff.eq.1)then sig=1.0d0 else sig=-1.0d0 endif i=ix+3*(ia-1) c write(6,6009)ia,ix,idiff,ATENS0(1,1,1) do 4002 ixx=1,3 do 4002 iy=1,3 do 4002 iz=1,3 4002 ATENS(ixx,iy,iz,i)=ATENS(ixx,iy,iz,i)+sig*ATENS0(ixx,iy,iz) endif endif endif c000 continue goto 11 444 close(4) sf=0.529177d0/2.0/snt write(6,6006) 6006 format(' G',1h','/w recorded') do 102 i=1,N do 102 ix=1,3 do 102 iy=1,3 ALPHA(ix,iy,i)=ALPHA(ix,iy,i)*sf GTENS(ix,iy,i)=GTENS(ix,iy,i)*sf do 102 iz=1,3 102 ATENS(ix,iy,iz,i)=ATENS(ix,iy,iz,i)*sf CALL WRITETTT(NAT,ALPHA,GTENS,ATENS,MX3) STOP END C ======================================= SUBROUTINE WRITETTT(NAT,ALPHA,GTENS,ATENS,MX3) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*4 (I-N) DIMENSION ALPHA(3,3,MX3),GTENS(3,3,MX3),ATENS(3,3,3,MX3) OPEN(2,FILE='FILE.TTT') WRITE(2,2000)NAT 2000 FORMAT(' ROA tensors, cartesian derivatives',/,I4,' atoms',/, 1' The electric-dipolar electric-dipolar polarizability:',/, 2' Atom/x jx jy jz') DO 1 I=1,3 WRITE(2,2002)I 2002 FORMAT(' Alpha(',I1,',J):') DO 1 L=1,NAT DO 1 IX=1,3 IIND=3*(L-1)+IX 1 WRITE(2,2001)L,IX,(ALPHA(I,J,IIND),J=1,3) 2001 FORMAT(I5,1H ,I1,3F15.7) WRITE(2,2004) 2004 FORMAT(' The electric dipole magnetic dipole polarizability:',/, 1 ' Atom/x jx(Bx) jy(By) jz(Bz)') DO 2 I=1,3 WRITE(2,2003)I 2003 FORMAT(' G(',I1,',J):') DO 2 L=1,NAT DO 2 K=1,3 2 WRITE(2,2001)L,K,(GTENS(I,J,3*(L-1)+K),J=1,3) WRITE(2,2005) 2005 FORMAT(' The electric dipole electric quadrupole polarizability:', 2/, ' Atom/x kx ky kz') DO 3 I=1,3 DO 3 J=1,3 WRITE(2,2006)I,J 2006 FORMAT(' A(',I1,',',I1,',K):') th=1.5d0 DO 3 L=1,NAT DO 3 M=1,3 3 WRITE(2,2007)L,M,(ATENS(K,J,I,3*(L-1)+M)*th,K=1,3),L,M,I,J 2007 FORMAT(I5,1H ,I1,3F15.7,' ',4i3) write(2,*) write(2,*)'dummy alpha v:' DO 4 I=1,3 WRITE(2,2002)I DO 4 L=1,NAT DO 4 IX=1,3 IIND=3*(L-1)+IX 4 WRITE(2,2001)L,IX,(ALPHA(I,J,IIND),J=1,3) CLOSE(2) WRITE(*,*)' Tensors written FILE.TTT' RETURN END