i ask error occurred fortran code. since i'm new fortran can't handle after 2 days, searched around still don't know how fix it.
program subdem implicit real*8(a-h,o-z) real*8 ntet,nptk integer*4 na,nc,ne,nband,ntmax,idef c call setk08(na,nc, a,c, ptk,nptk, idef,ntet, nkmax,ntmax) c call dostet(ener,idime,nband,idef,ntet,xe,ne,y,z) print *,'test print' c dimension ptk(4,nkmax),idef(5,ntmax) c na,nc 2 k-mesh discretization parameters, c a,c 2 parameters "a","c" of direct lattice. c ptk real*8 array , idef integer*4 array na=3 nc=3 a=1.67 c=2.1 nkmax=550 ntmax=50.d3 call setk08(na,nc,a,c,ptk,nptk,idef,ntet,nkmax,ntmax) ne = 20 idime = 5.0 nband = 5 xe = 4 ne = 15 c call dostet(ener,idime,nband,idef,ntet,xe,ne,y,z) c ener (real*8 two-dimensional array, input) c ener(nu,ik) energy of band nu, computed k-point ik, defined setk** routine c idime (integer*4, input) c first dimension of array ener, defined in calling program. idime must @ least equal nband c nband (integer*4, input) c number of energy bands included in summation c idef (integer*4 two-dimensional array,input) c table defining tetrahedron corners, obtained setk** routines. first dimension 5. c ntet (integer*4, input) c number of tetrahedra filling volume v (provided setk** routine) c xe (real*8 one-dimensional array, input) c contains values of energies e density of states , integrated density of states computed. c dimension @ least ne. c ne (integer*4, input) c number of energy points density of states , integrated density of states computed. first ne locations of xe used dostet. c y (real*8 one-dimensional array, output) c ne first components of vector contain, on return, density of states evaluated @ energy points corresponding ne first components of xe. c z (real*8 one-dimensional array, output) c ne first components of vector contain, on return, integrated density of states evaluated @ energy points corresponding ne first components of xe. end subroutine setk08(na,nc,a,c,ptk,nptk,idef,ntet,nkmax,ntmax) c set k-points in 1/16th of brillouin zone c simple tetragonal lattice parameters a, c c symmetry d4h implicit real*8(a-h,o-z) real*4 avol dimension ptk(4,nkmax),idef(5,ntmax) equivalence (ivol,avol) pi = 3.141592653589793238d0 if(na.le.0.or.nc.le.0) goto 97 if(a.le.0.0d0 .or. c.le.0.0d0) goto 98 nptk = (na+1)*(na+2)*(nc+1)/2 if(nptk.gt.nkmax) stop '*** <setk08> nptk exceeds nkmax ***' ntet = 3*nc*na**2 if(ntet.gt.ntmax) stop '*** <setk08> ntet exceeds ntmax ***' c *** set k-points ak=pi/a/na ck=pi/c/nc write(6,100) nptk,ntet,na*ak,na*ak,nc*ck w = 2.0d0/(na*na*nc) nptk=0 1 i=0,na,1 1 j=0,i,1 1 k=0,nc,1 c nptk = i*(i+1)/2*nz1 + j*nz1 + k+1 wk = w if(i.eq.0) wk = wk/2.0d0 if(j.eq.0) wk = wk/2.0d0 if(j.eq.i) wk = wk/2.0d0 if(i.eq.na) wk = wk/2.0d0 if(j.eq.na) wk = wk/2.0d0 if(k.eq.0 .or. k.eq.nc) wk = wk/2.0d0 nptk=nptk+1 ptk(1,nptk)=i*ak ptk(2,nptk)=j*ak ptk(3,nptk)=k*ck ptk(4,nptk)=wk 1 continue c *** define tetrahedra nz1=nc+1 ntet=0 i7=0 i=0 4 ix=(i+1)*nz1 j = 0 5 k=0 i7=i*ix/2+j*nz1 6 i7=i7+1 i6=i7+ix i2=i6+nz1 i1=i2+1 ntet=ntet+1 idef(1,ntet)=i7 idef(2,ntet)=i6 idef(3,ntet)=i2 idef(4,ntet)=i1 i8=i7+1 i5=i6+1 ntet=ntet+1 idef(1,ntet)=i7 idef(2,ntet)=i6 idef(3,ntet)=i5 idef(4,ntet)=i1 ntet=ntet+1 idef(1,ntet)=i7 idef(2,ntet)=i8 idef(3,ntet)=i5 idef(4,ntet)=i1 if(j.eq.i) goto 7 i3=i7+nz1 i4=i3+1 ntet=ntet+1 idef(1,ntet)=i7 idef(2,ntet)=i3 idef(3,ntet)=i2 idef(4,ntet)=i1 ntet=ntet+1 idef(1,ntet)=i7 idef(2,ntet)=i3 idef(3,ntet)=i4 idef(4,ntet)=i1 ntet=ntet+1 idef(1,ntet)=i7 idef(2,ntet)=i8 idef(3,ntet)=i4 idef(4,ntet)=i1 7 k=k+1 if(k.lt.nc) goto 6 j=j+1 if(j.le.i) goto 5 i=i+1 if(i.lt.na) goto 4 avol=1.d0/dfloat(ntet) 15 it=1,ntet 15 idef(5,it)=ivol print *,ntet,nptk return 97 write(6,101) goto 99 98 write(6,102) 99 stop 100 format(' sampling 16th part of square-based prism'/ .1x,i5,' k-points',i7,' tetrahedra'/ .' kxmax =',d11.4,' kymax =',d11.4,' kzmax =',d11.4) 101 format(' *** <setk08> na or nc not positive integer ***') 102 format(' *** <setk08> , c must positive ***') end subroutine dostet(ener,idime,nband,idef,ntet,xe,ne,y,z) c compute density of states using tetrahedrons method. c xe contains energies, y , z return related density of c states , integrated density of states, respectively. implicit real*8(a-h,o-z) real*4 avol dimension ener(idime,1),xe(1),y(1),z(1),idef(5,1),c(4) equivalence (ivol,avol),(c(1),e1),(c(2),e2),(c(3),e3),(c(4),e4) data eps/1.0d-05/ 6 ix=1,ne y(ix)=0.d0 6 z(ix)=0.d0 c c loop on tetrahedrons 9 itet=1,ntet c ia=idef(1,itet) ib=idef(2,itet) ic=idef(3,itet) id=idef(4,itet) ivol=idef(5,itet) c c loop on bands 9 nb=1,nband c c *** define e1, e2, e3, e4, corner energies ordered c *** decreasing size c(1)=ener(nb,ia) c(2)=ener(nb,ib) c(3)=ener(nb,ic) c(4)=ener(nb,id) 2 i=1,4 cc=c(i) j=i 1 j=j+1 if(j.gt.4) goto 2 if(cc.ge.c(j)) goto 1 c(i)=c(j) c(j)=cc cc=c(i) goto 1 2 continue unite=1.0d0 if(e1.gt.e4) unite=e1-e4 e12=(e1-e2)/unite e13=(e1-e3)/unite e14=(e1-e4)/unite e23=(e2-e3)/unite e24=(e2-e4)/unite e34=(e3-e4)/unite facy=3.d0*dble(avol)/unite 9 ix=1,ne e=xe(ix) surfac=0.d0 volume=1.d0 if(e.gt.e1) goto 8 volume=0.d0 if(e.lt.e4) goto 8 ee1=(e-e1)/unite if(dabs(ee1).lt.eps) ee1=0.d0 ee2=(e-e2)/unite if(dabs(ee2).lt.eps) ee2=0.d0 ee3=(e-e3)/unite if(dabs(ee3).lt.eps) ee3=0.d0 ee4=(e-e4)/unite if(dabs(ee4).lt.eps) ee4=0.d0 if(e.gt.e3) goto 5 c *** e4.le.e.and.e.le.e3 if(e4.eq.e3) goto 3 surfac=(ee4/e34)*(ee4/e24) volume=surfac*ee4 goto 8 3 if(e3.lt.e2) goto 8 if(e2.eq.e1) goto 4 surfac=1.d0/e12 goto 8 4 surfac=1.0d+15 volume=0.5d0 goto 8 5 if(e.gt.e2) goto 7 c *** e3.lt.e.and.e.le.e2 surfac=-(ee3*ee2/e23+ee4*ee1)/e13/e24 volume=(0.5d0*ee3*(2.d0*e13*e34+e13*ee4-e34*ee1-2.d0*ee1*ee4+ + ee3*(ee3-3.d0*ee2)/e23)/e13+e34*e34)/e24 goto 8 c *** e2.lt.e.and.e.le.e1 7 surfac=(ee1/e12)*(ee1/e13) volume=1.d0+surfac*ee1 8 y(ix)=y(ix)+facy*surfac z(ix)=z(ix)+dble(avol)*volume 9 continue return end seems code broke @ line 82:
ptk(1,nptk)=dfloat(i)*dk
you forgot declare ptk in main program. due implicit statement interpreted scalar real*8. subroutine setk08, however, expects ptk dimension ptk(4,nkmax). same holds true idef.
nptk , ntet expected integers in setk08 declared real*8 in main program!
please don't use implicit declaration! always use implicit none , declare variables.
fixing these points removes segfault , produces
stop *** <setk08> ntet exceeds ntmax ***
Comments
Post a Comment