pmsco-public/pmsco/calculators/phagen/phagen_scf.f.patch

103 lines
2.8 KiB
Diff

--- phagen_scf.orig.f 2019-06-05 16:45:52.977855859 +0200
+++ phagen_scf.f 2019-05-09 16:32:35.790286429 +0200
@@ -174,6 +174,99 @@
1100 format(//,1x,' ** phagen terminated normally ** ',//)
end
+
+c-----------------------------------------------------------------------
+ subroutine libmain(infile,outfile,etcfile)
+c main calculation routine
+c entry point for external callers
+c
+c infile: name of parameter input file
+c
+c outfile: base name of output files
+c output files with endings .list, .clu, .pha, .tl, .rad
+c will be created
+c-----------------------------------------------------------------------
+ implicit real*8 (a-h,o-z)
+c
+ include 'msxas3.inc'
+ include 'msxasc3.inc'
+
+ character*60 infile,outfile,etcfile
+ character*70 listfile,clufile,tlfile,radfile,phafile
+
+c
+c.. constants
+ antoau = 0.52917715d0
+ pi = 3.141592653589793d0
+ ev = 13.6058d0
+ zero = 0.d0
+c.. threshold for linearity
+ thresh = 1.d-4
+c.. fortran io units
+ idat = 5
+ iwr = 6
+ iphas = 30
+ iedl0 = 31
+ iwf = 32
+ iof = 17
+
+ iii=LnBlnk(outfile)+1
+ listfile=outfile
+ listfile(iii:)='.list'
+ clufile=outfile
+ clufile(iii:)='.clu'
+ phafile=outfile
+ phafile(iii:)='.pha'
+ tlfile=outfile
+ tlfile(iii:)='.tl'
+ radfile=outfile
+ radfile(iii:)='.rad'
+
+ open(idat,file=infile,form='formatted',status='old')
+ open(iwr,file=listfile,form='formatted',status='unknown')
+ open(10,file=clufile,form='formatted',status='unknown')
+ open(35,file=tlfile,form='formatted',status='unknown')
+ open(55,file=radfile,form='formatted',status='unknown')
+ open(iphas,file=phafile,form='formatted',status='unknown')
+
+ open(iedl0,form='unformatted',status='scratch')
+ open(iof,form='unformatted',status='scratch')
+ open(unit=21,form='unformatted',status='scratch')
+ open(60,form='formatted',status='scratch')
+ open(50,form='formatted',status='scratch')
+ open(unit=13,form='formatted',status='scratch')
+ open(unit=14,form='formatted',status='scratch')
+ open(unit=11,status='scratch')
+ open(unit=iwf,status='scratch')
+ open(unit=33,status='scratch')
+ open(unit=66,status='scratch')
+
+ call inctrl
+ call intit(iof)
+ call incoor
+ call calphas
+
+ close(idat)
+ close(iwr)
+ close(10)
+ close(35)
+ close(55)
+ close(iphas)
+ close(iedl0)
+ close(iof)
+ close(60)
+ close(50)
+ close(13)
+ close(14)
+ close(11)
+ close(iwf)
+ close(33)
+ close(66)
+ close(21)
+
+ endsubroutine
+
+
subroutine inctrl
implicit real*8 (a-h,o-z)
include 'msxas3.inc'