C     make Topology Block File for idff_intra_link.f 
C      from original Topology File
C
C       maketopBlc_cp.f 
C
C       replace charge and polz data for Block model
C       no replace vdw!
C
C       2014  6. 6 
C       2018  4. 3 num_blc _xxx.inp Duplicate error check
C       2019  7.30 n13 --> n03  read iu3   write 10   minor change
C
C       read data  1. Replace charg   data      fort.1    Block molecules Numbering
C                  2. Replace polz    data      fort.2    Block molecules Numbering
C                  3. Original Topology file    fort.3
C                  4. Replace number for block  fort.4    Block --> Gaus 
C
C       write data 1. Replaced topology file    fort.10
C 
C       ex)
C       #
C       ln -s all_chg.dat     fort.1
C       ln -s all_plz.dat     fort.2
C       ln -s top_org_xxx.inp fort.3
C       ln -s num_blc.dat     fort.4
C       
C       ~/source/pol_src_12/maketopBlc_cp.exe
C       cp fort.10 top_xxx_p9l00111.inp
C       rm -fr fort.*
C       #
C
      IMPLICIT REAL*8 (A-H,O-Z)
      dimension chg(200),plz(200),numb(200),iatm(200)
      dimension emin(200),rmin(200)
      CHARACTER*8 title (10, 4)
      CHARACTER*2 atm(200),atom
      CHARACTER*18 tit18
      CHARACTER*10 tit10
      WRITE (6,*) '% start maketopBlc %' 
C
   10 FORMAT(9X,I4)
   11 FORMAT(I2,F16.10,2(2X,F16.10))
C
      iu1 = 1
      iu2 = 2
      iu3 = 3
      iu4 = 4
      iu10 = 10
      OPEN(IU1, FORM='FORMATTED', ACCESS='SEQUENTIAL')
      OPEN(IU2, FORM='FORMATTED', ACCESS='SEQUENTIAL')
      OPEN(IU3, FORM='FORMATTED', ACCESS='SEQUENTIAL')
      OPEN(IU4, FORM='FORMATTED', ACCESS='SEQUENTIAL') 
C     OPEN(IU7, FORM='FORMATTED', ACCESS='SEQUENTIAL') 
      OPEN(IU10, FORM='FORMATTED', ACCESS='SEQUENTIAL') 
C     
      k1 = 0 
      tchg = 0.0d0
      do i =1,300
        k1 = k1 + 1 
        read(iu1,'(20x,i3,53x,f15.7)',end=999) iatm(k1),chg(k1)
C       write(6,'(20x,i3,53x,f15.7)') iatm(k1),chg(k1)
        if(iatm(k1).eq.6)then
          atm(k1)='C '
        else if (iatm(k1).eq.8)then
          atm(k1)='O '
        else if (iatm(k1).eq.1)then
          atm(k1)='H '
        else if (iatm(k1).eq.7)then
          atm(k1)='N '
        else if (iatm(k1).eq.11)then
          atm(k1)='Na'
        else if (iatm(k1).eq.15)then
          atm(k1)='P '
        else if (iatm(k1).eq.16)then
          atm(k1)='S '
        else 
          atm(k1)='X '
        endif
        tchg = tchg + chg (k1) 
      enddo
  999 continue 
      k2 = 0
      do i = 1,300
        k2 = k2 + 1
        read(iu2,'(17x,i3,15x,f14.4)',end=997) jatm,plz(k2)
C       write (6,'(17x,i3,15x,f14.4)') jatm,plz(k2)
        if(iatm(k2).ne.jatm)then
          write(6,*) '!!! chg atom is not equal plz atom !!!'
          stop
        endif
      enddo
  997 continue
      write (6, *)'replace charge & polz data  atoms = ', 
     & k1-1, k2-1,
     & ' total charge = ', tchg
C
      k4 = 0
      kk = 0
      do i =1,300
        k4 = k4 + 1
        read(iu4,*,end=996) numb(k4)
C       write(6,*) numb(k4)
      enddo
  996 continue
C
C     number check
C
      kkk=0
      do i=1,k4-1
        do j=i+1,k4-1
          if(numb(i).eq.numb(j))then
          write(6,*) '!!!duplicate numb error ! i j',
     &  i,j,numb(i),numb(j)
          endif
        enddo
      enddo
C
      kk = 0
      do i =1,k4
        do j=1,k4
          if(numb(i).eq.j) then
            kk=kk+1
          endif
        enddo
      enddo
      if(kk.ne.k4-1) then
        write(6,*) '!!! number_blc.dat error !!!'
        stop
      endif
      if(k4.ne.k1)then
        write(6,*) '!!! chg-num error !!!'
        stop
      endif
      if(k4.ne.k2)then
        write(6,*) '!!! plz-num error !!!'
        stop
      endif
C
C%    k7 = 0
C%    do i = 1,300
C%      k7 = k7 + 1
C%      read(7,'(2f10.3)',end=995) rmin(k7),emin(k7)
CC%      write (6,'(2f10.3)') rmin(k7),emin(k7)
C%    enddo
C%995 continue
      write (6, *)'replace charge, polz & vdw data  atoms = ', 
     & k1-1, k2-1
C%    if(k7.ne.k2)then
C%      write(6,*) '!!! vdw-num error !!!'
C%      stop
C%    endif
C
C     Replace charge & polz of Block model
C
C     n13=13
      read(iu3,'(a18,i4,a10)') tit18,n03,tit10
      write(iu10,'(a18,i4,a10)') tit18,n03,tit10
      write(6,'(a18,i4,a10)') tit18,n13,tit10
      read(iu3,'(4i5)') n1,n2,n3,n4
      write(iu10,'(4i5)') n1,n2,n3,n4
      write(6,'(4i5)') n1,n2,n3,n4
      k = 0
      do i=1,k4-1
	read(iu3,'(a2,7f10.5,i3)') atom,d1,d2,d3,d4,d5,d6,d7,ib
	write(iu10,'(a2,7f10.5,i3)')
     & atm(numb(i)),chg(numb(i)),plz(numb(i)),
     & d3,d4,d5,d6,d7,ib
        k=k+1
      enddo
C
C     top residual
C
      do j=1,300
        read(iu3,'(10a8)',end=998) (title(i,1),i=1,10)
        write(iu10,'(10a8)') (title(i,1),i=1,10)
      enddo
C
  998 continue 
      write(6,*) ' replace data k=  ',k
C
      CLOSE(UNIT=IU1)
      CLOSE(UNIT=IU2)
      CLOSE(UNIT=IU3)
      CLOSE(UNIT=IU4)
      CLOSE(UNIT=IU7)
      CLOSE(UNIT=IU10)
      WRITE(6,*) '% stop maketopBlc_gvdw  %'
      STOP
      END