编辑代码

        implicit real*8(a-h,o-z)
        integer,parameter::natom=3
        character fn*50,fn2*50,fre*80,ft*50,fn0*50,ft2*50,fr2*200,frt*200,filename*50
        logical Lex
        real*8 Q(3,natom)
        character*260 fin(500),fw,symbol(natom)

        open(28,file='bat',status='unknown')
        open(2,file='model-input',status='old')
        n=0
        do i=1,500
        read(2,'(A)',end=100)fin(i)
        n=n+1
        enddo
100     close(2)
        print*,'input the name of geometry file:'
        read*,filename
        inquire(file=filename,exist=Lex)
        if (.not. Lex) then  
            stop 'File not found! Please try again.'  
        end if
        open(29,file=filename,status='old')
        ifile=0
200     read(29,*,end=20)
        read(29,*)r1,t1,p1
        do i=1,natom
        read(29,*)symbol(i),q(:,i)
        enddo
        ifile=ifile+1
        write(ft,'(f8.2,A,f8.2A,f8.2)')r1,'-',t1,'-',p1
        write(ft2,'(f8.2,A,f8.2)')1.00,'-',t2

!        endif
        fn='';fn2='';ik=0;ik2=0;fn0=''
        do i=1,50
        if(ft(i:i).ne.'')then
        ik=ik+1
        fn(ik:ik)=ft(i:i)
        fn2(ik:ik)=ft(i:i)
        endif
        if(ft2(i:i).ne.'')then
        ik2=ik2+1
        fn0(ik2:ik2)=ft2(i:i)
        endif
        fn(ik+1:ik+4)='.in'
        fn2(ik+1:ik+4)='.wfu'
        fn0(ik2+1:ik2+4)='.wfu'
        enddo
!
!        write(28,'(A,3A)')'cp ',fn0,'/tmp/tengchunlei/',fn2
       write(28,'(A,3A)')'cp 1.41-1.42-121.00.wfu ','/tmp/tengchunlei/',fn2
       write(28,'(A,A)')'/home/tengchunlei/molpro2019.2/bin/molpro --no-xml-output -n 8 -W  /tmp/tengchunlei ',fn
        write(28,'(A,2A)')'cp /tmp/tengchunlei/',fn2,' .'
        write(28,'(A,A)')'rm /tmp/tengchunlei/*'

!        fn0=fn2
        open(1,file=fn,status='unknown')

        do i=1,n
        if(i.eq.4)then
        write(1,'(2A)')'file,2,',fn2
        elseif(i.ge.9.and.i.le.8+natom)then
        write(1,'(A3,3X,3f15.8)')symbol(i-8),Q(:,i-8)
        else
        fw=fin(i)
        nx=len_trim(fw)
        write(1,'(A)')fw(1:nx)
        endif
        enddo
        close(1)
        goto 200
20      close(29)
        print*,'number of input files generated:',ifile
        end