!  
!  Written by Leandro Martínez, 2009-2011.
!  Copyright (c) 2009-2018, Leandro Martínez, Jose Mario Martinez,
!  Ernesto G. Birgin.
!  
! Subroutine output: Subroutine that writes the output file
!

subroutine output(n, x, output_file_name)

  use exit_codes
  use sizes
  use compute_data
  use input

  implicit none
  integer :: n, k, i, ilugan, ilubar, itype, imol, idatom,&
             irest, iimol, ichain, iatom, irec, ilres, ifres,&
             iires, ciires, irescount,&
             icart, i_ref_atom, ioerr, ifirst_mol
  integer :: nr, nres, imark  
  integer :: i_fixed, i_not_fixed
  
  double precision :: x(n)
  double precision :: tens(4,4), v(4,4), dv(4)
  double precision :: v1(3), v2(3), v3(3)
  double precision :: xbar, ybar, zbar, beta, gama, teta, xcm, ycm, zcm
  double precision :: xlength, ylength, zlength
  double precision :: xxyx, xxyy, xxyz, xyyz, xyyy, xzyx,&
                      xzyy, xzyz, xyyx, xq, yq, zq, q0, q1, q2, q3
  double precision :: xtemp, ytemp, ztemp
  double precision :: sxmin, symin, szmin, sxmax, symax, szmax

  character :: write_chain, even_chain, odd_chain
  character(len=64) :: title
  character(len=strl) :: pdb_atom_line, tinker_atom_line, crd_format
  character(len=8) :: crdires,crdresn,crdsegi,atmname
  character(len=strl) :: record
  character(len=strl) :: output_file_name
  character(len=5) :: i5hex, tmp_i5hex

  ! Job title

  title = ' Built with Packmol '

  !
  ! Write restart files, if required
  !
  
  ! Restart file for all system

  if ( restart_to(0) /= 'none' ) then
    record = restart_to(0)
    open(10,file=restart_to(0),iostat=ioerr)
    if ( ioerr /= 0 ) then
      write(*,*) ' ERROR: Could not open restart_to file: ', trim(adjustl(record))
      stop exit_code_open_file
    end if
    ilubar = 0
    ilugan = ntotmol*3
    do i = 1, ntotmol
      write(10,"(6(tr1,es23.16))") x(ilubar+1), x(ilubar+2), x(ilubar+3), &
                                   x(ilugan+1), x(ilugan+2), x(ilugan+3)
      ilubar = ilubar + 3
      ilugan = ilugan + 3
    end do
    close(10)
    write(*,*) ' Wrote restart file for all system: ', trim(adjustl(record))
  end if

  ! Restart files for specific molecule types

  ilubar = 0
  ilugan = ntotmol*3
  do itype = 1, ntype
    if ( restart_to(itype) /= 'none' ) then
      record = restart_to(itype)
      open(10,file=record,iostat=ioerr)
      if ( ioerr /= 0 ) then
        write(*,*) ' ERROR: Could not open restart_to file: ', trim(adjustl(record))
        stop exit_code_open_file
      end if
      do i = 1, nmols(itype)
        write(10,"(6(tr1,es23.16))") x(ilubar+1), x(ilubar+2), x(ilubar+3), &
                                     x(ilugan+1), x(ilugan+2), x(ilugan+3)
        ilubar = ilubar + 3
        ilugan = ilugan + 3
      end do
      close(10)
      write(*,*) ' Wrote restart file: ', trim(adjustl(record))
    else
      ilubar = ilubar + nmols(itype)*3
      ilugan = ilugan + nmols(itype)*3
    end if
  end do

  ! Write the output (xyz file)

  if(xyz) then
    open(30,file=output_file_name,status='unknown') 
    write(30,*) ntotat
    write(30,*) title 
    ilubar = 0 
    ilugan = ntotmol*3 
    icart = 0
    i_not_fixed = 0
    i_fixed = ntype
    do itype = 1, ntfix
      if ( .not. fixedoninput(itype) ) then
        i_not_fixed = i_not_fixed + 1
        do imol = 1, nmols(i_not_fixed)
          xbar = x(ilubar+1) 
          ybar = x(ilubar+2) 
          zbar = x(ilubar+3)
          beta = x(ilugan+1)
          gama = x(ilugan+2)
          teta = x(ilugan+3)
          call eulerrmat(beta,gama,teta,v1,v2,v3)   
          idatom = idfirst(i_not_fixed) - 1      
          do iatom = 1, natoms(i_not_fixed) 
            icart = icart + 1
            idatom = idatom + 1
            call compcart(icart,xbar,ybar,zbar,&
                          coor(idatom,1),coor(idatom,2),&
                          coor(idatom,3),&
                          v1,v2,v3) 
            write(30,"( tr2,a3,tr2,3(tr2,f14.6) )") ele(idatom), (xcart(icart, k), k = 1, 3)
          end do 
          ilugan = ilugan + 3 
          ilubar = ilubar + 3 
        end do
      else
        i_fixed = i_fixed + 1
        idatom = idfirst(i_fixed) - 1
        do iatom = 1, natoms(i_fixed)
          idatom = idatom + 1
          write(30,"( tr2,a3,tr2,3(tr2,f14.6) )") ele(idatom), (coor(idatom,k),k=1,3)
        end do
      end if
    end do
    close(30)
  end if

  ! write the output as a MOLDY file

  if(moldy) then
    open(30,file=output_file_name,status='unknown') 
    ! For square moldy boxes, this must be the side dimensions of the box 
    sxmin = 1.d30
    symin = 1.d30
    szmin = 1.d30
    sxmax = -1.d30
    symax = -1.d30
    szmax = -1.d30
    do irest = 1, nrest 
      if(ityperest(irest).eq.2) then
        sxmin = dmin1(restpars(irest,1),sxmin)
        symin = dmin1(restpars(irest,2),symin)
        szmin = dmin1(restpars(irest,3),szmin)
        sxmax = dmax1(restpars(irest,4)+restpars(irest,1),sxmax)
        symax = dmax1(restpars(irest,4)+restpars(irest,2),symax)
        szmax = dmax1(restpars(irest,4)+restpars(irest,3),szmax)
      else if(ityperest(irest).eq.3) then
        sxmin = dmin1(restpars(irest,1),sxmin)
        symin = dmin1(restpars(irest,2),symin)
        szmin = dmin1(restpars(irest,3),szmin)
        sxmax = dmax1(restpars(irest,4),sxmax)
        symax = dmax1(restpars(irest,5),symax)
        szmax = dmax1(restpars(irest,6),szmax)
      else
        write(*,*) ' WARNING: The first line of the moldy output'
        write(*,*) ' file contains the size of the sides of the'
        write(*,*) ' paralelogram that defines the system. '
        write(*,*) ' The numbers printed may not be correct in '
        write(*,*) ' this case because regions other than cubes '
        write(*,*) ' or boxes were used. '
        sxmin = dmin1(sxmin,sizemin(1))
        symin = dmin1(symin,sizemin(2))
        szmin = dmin1(szmin,sizemin(3))
        sxmax = dmax1(sxmax,sizemax(1))
        symax = dmax1(symax,sizemax(2))
        szmax = dmax1(szmax,sizemax(3))
      end if
    end do
    xlength = sxmax - sxmin
    ylength = symax - symin
    zlength = szmax - szmin
    write(30,"( 3(tr1,f12.6),' 90 90 90 1 1 1 ' )") xlength, ylength, zlength
    ilubar = 0 
    ilugan = ntotmol*3 
    i_not_fixed = 0
    i_fixed = ntype
    do itype = 1, ntfix
      if ( .not. fixedoninput(itype) ) then
        i_not_fixed = i_not_fixed + 1
        record = name(i_not_fixed)
        do imol = 1, nmols(i_not_fixed) 
          xbar = (x(ilubar+1) - sxmin) / xlength
          ybar = (x(ilubar+2) - symin) / ylength
          zbar = (x(ilubar+3) - szmin) / zlength
          beta = x(ilugan+1)
          gama = x(ilugan+2)
          teta = x(ilugan+3)
          call eulerrmat(beta,gama,teta,v1,v2,v3)  
 
          ! Computing cartesian coordinates and quaternions 
 
          xxyx = 0.d0
          xxyy = 0.d0
          xxyz = 0.d0
          xyyx = 0.d0
          xyyy = 0.d0
          xyyz = 0.d0
          xzyx = 0.d0
          xzyy = 0.d0
          xzyz = 0.d0 
          idatom = idfirst(i_not_fixed) - 1      
          do iatom = 1, natoms(i_not_fixed) 
            idatom = idatom + 1
            xq =   coor(idatom, 1)*v1(1) &
                 + coor(idatom, 2)*v2(1) &
                 + coor(idatom, 3)*v3(1)    
            yq =   coor(idatom, 1)*v1(2) &
                 + coor(idatom, 2)*v2(2) &
                 + coor(idatom, 3)*v3(2)    
            zq =   coor(idatom, 1)*v1(3) &
                 + coor(idatom, 2)*v2(3) &
                 + coor(idatom, 3)*v3(3)   

            ! Recovering quaternions for molecule imol

            xxyx = xxyx + xq * coor(idatom,1) * amass(idatom)
            xxyy = xxyy + xq * coor(idatom,2) * amass(idatom)
            xxyz = xxyz + xq * coor(idatom,3) * amass(idatom)
            xyyx = xyyx + yq * coor(idatom,1) * amass(idatom)
            xyyy = xyyy + yq * coor(idatom,2) * amass(idatom)
            xyyz = xyyz + yq * coor(idatom,3) * amass(idatom)
            xzyx = xzyx + zq * coor(idatom,1) * amass(idatom)
            xzyy = xzyy + zq * coor(idatom,2) * amass(idatom)
            xzyz = xzyz + zq * coor(idatom,3) * amass(idatom) 
          end do

          tens(1,1) = xxyx + xyyy + xzyz
          tens(1,2) = xzyy - xyyz
          tens(2,2) = xxyx - xyyy - xzyz
          tens(1,3) = xxyz - xzyx
          tens(2,3) = xxyy + xyyx
          tens(3,3) = xyyy - xzyz - xxyx
          tens(1,4) = xyyx - xxyy
          tens(2,4) = xzyx + xxyz
          tens(3,4) = xyyz + xzyy
          tens(4,4) = xzyz - xxyx - xyyy
          nr = 16
          call jacobi (tens, 4, 4, dv, v, nr)
          q0 = v(1,4)
          q1 = v(2,4)
          q2 = v(3,4)
          q3 = v(4,4)
          record = name(i_not_fixed) 
          xbar = dmin1(0.999999d0,xbar)     
          ybar = dmin1(0.999999d0,ybar)     
          zbar = dmin1(0.999999d0,zbar)     
          write(30,"( a10,tr1,7(f12.6) )") trim(adjustl(record)), xbar, ybar, zbar, &
                         q0, q1, q2, q3
          ilugan = ilugan + 3 
          ilubar = ilubar + 3 
        end do
      else
        i_fixed = i_fixed + 1
        idatom = idfirst(i_fixed) - 1

        ! Getting the specified position of the molecule

        do irest = 1, nrest
          if(irestline(irest).gt.linestrut(i_fixed,1).and.&
             irestline(irest).lt.linestrut(i_fixed,2)) then
             xcm = restpars(irest,1) - sxmin
             ycm = restpars(irest,2) - symin
             zcm = restpars(irest,3) - szmin
             beta = -restpars(irest,4)
             gama = -restpars(irest,5)
             teta = -restpars(irest,6)
          end if
        end do
        call eulerrmat(beta,gama,teta,v1,v2,v3) 
  
        ! Computing cartesian coordinates and quaternions 
 
        xxyx = 0.d0
        xxyy = 0.d0
        xxyz = 0.d0
        xyyx = 0.d0
        xyyy = 0.d0
        xyyz = 0.d0
        xzyx = 0.d0
        xzyy = 0.d0
        xzyz = 0.d0 
        idatom = idfirst(i_fixed) - 1      
        do iatom = 1, natoms(i_fixed) 
          idatom = idatom + 1
          xtemp = coor(idatom,1) - xcm
          ytemp = coor(idatom,2) - ycm
          ztemp = coor(idatom,3) - zcm
          xq =   xtemp*v1(1) + ytemp*v2(1) + ztemp*v3(1)    
          yq =   xtemp*v1(2) + ytemp*v2(2) + ztemp*v3(2)    
          zq =   xtemp*v1(3) + ytemp*v2(3) + ztemp*v3(3)   
          xxyx = xxyx + xtemp * xq * amass(idatom)
          xxyy = xxyy + xtemp * yq * amass(idatom)
          xxyz = xxyz + xtemp * zq * amass(idatom)
          xyyx = xyyx + ytemp * xq * amass(idatom)
          xyyy = xyyy + ytemp * yq * amass(idatom)
          xyyz = xyyz + ytemp * zq * amass(idatom)
          xzyx = xzyx + ztemp * xq * amass(idatom)
          xzyy = xzyy + ztemp * yq * amass(idatom)
          xzyz = xzyz + ztemp * zq * amass(idatom)
        end do
        tens(1,1) = xxyx + xyyy + xzyz
        tens(1,2) = xzyy - xyyz
        tens(2,2) = xxyx - xyyy - xzyz
        tens(1,3) = xxyz - xzyx
        tens(2,3) = xxyy + xyyx
        tens(3,3) = xyyy - xzyz - xxyx
        tens(1,4) = xyyx - xxyy
        tens(2,4) = xzyx + xxyz
        tens(3,4) = xyyz + xzyy
        tens(4,4) = xzyz - xxyx - xyyy
        nr = 16
        call jacobi (tens, 4, 4, dv, v, nr)
        q0 = v(1,4)
        q1 = v(2,4)
        q2 = v(3,4)
        q3 = v(4,4)
        xcm = xcm / xlength
        ycm = ycm / ylength
        zcm = zcm / zlength
        record = name(itype)
        xcm = dmin1(0.999999d0,xcm)     
        ycm = dmin1(0.999999d0,ycm)     
        zcm = dmin1(0.999999d0,zcm)     
        write(30,"( a10,tr1,7(f12.6) )") trim(adjustl(record)),&
                       xcm, ycm, zcm, q0, q1, q2, q3
      end if
    end do
    close(30) 
  end if 

  ! write the output as pdb file

  if(pdb) then
    pdb_atom_line = "( t1,a6,t7,a5,t12,a10,t22,a1,t23,&
                      &i4,t27,a1,t31,f8.3,t39,f8.3,t47,&
                      &f8.3,t55,a26 )"
    crd_format='(2I10,2X,A8,2X,A8,3F20.10,2X,A8,2X,A8,F20.10)'

    open(30,file=output_file_name,status='unknown') 
    if ( crd ) then
      open(40,file=crdfile,status='unknown')
      write(40,'("* TITLE ", a64,/&
                &"* Packmol generated CHARMM CRD File",/&
                &"* Home-Page:",/&
                &"* http://m3g.iqm.unicamp.br/packmol",/&
                &"* ")') title
      write(40,'(i10,2x,a)') ntotat,'EXT'
    end if
 
    write(30,"( & 
            &'HEADER ',/&
            &'TITLE    ', a64,/&
            &'REMARK   Packmol generated pdb file ',/&
            &'REMARK   Home-Page: ',&
            &'http://m3g.iqm.unicamp.br/packmol',/,&
            &'REMARK' )" ) title

    if(add_box_sides) then
      write(30,"( 'CRYST1',t7,f9.2,t16,f9.2,t25,f9.2,&
                     &t34,f7.2,t41,f7.2,t48,f7.2,&
                     &t56,'P 1           1' )") &
            sizemax(1)-sizemin(1) + add_sides_fix,&
            sizemax(2)-sizemin(2) + add_sides_fix,& 
            sizemax(3)-sizemin(3) + add_sides_fix,&
            90., 90., 90.
    end if
      
    ilubar = 0 
    ilugan = ntotmol*3 
    icart = 0
    i_ref_atom = 0
    iimol = 0
    ichain = 0
    i_not_fixed = 0
    i_fixed = ntype
    irescount = 1
    do itype = 1, ntfix 
      if ( .not. fixedoninput(itype) ) then
        i_not_fixed = i_not_fixed + 1

        ! Counting the number of residues of this molecule

        open(15,file=pdbfile(i_not_fixed),status='old')
        ifres = 0
        do
          read(15,str_format,iostat=ioerr) record
          if ( ioerr /= 0 ) exit
          if ( record(1:4).eq.'ATOM'.or.record(1:6).eq.'HETATM' ) then
            read(record(23:26),*,iostat=ioerr) imark
            if ( ioerr /= 0 ) then
              record = pdbfile(i_not_fixed)
              write(*,*) ' ERROR: Failed reading residue number ',&
                         ' from PDB file: ', trim(adjustl(record))
              write(*,*) ' Residue numbers are integers that must',&
                         ' be between columns 23 and 26. '
              write(*,*) ' Other characters within these columns',&
                         ' will cause input/output errors. '
              write(*,*) ' Standard PDB format specifications can',&
                         ' be found at: '
              write(*,*) ' www.rcsb.org/pdb '
              stop exit_code_input_error
            end if
            if ( ifres .eq. 0 ) ifres = imark
            ilres = imark
          end if
        end do
        nres = ilres - ifres + 1

        do irec = 1, strl
          record(irec:irec) = ' '
        end do

        mol: do imol = 1, nmols(i_not_fixed) 
          iimol = iimol + 1

          if( chain(i_not_fixed) == "#" ) then
            if(imol.eq.1.or.mod(imol,9999).eq.1) then
              ichain = ichain + 1
              if( changechains(i_not_fixed) ) then
                call chainc(ichain,odd_chain)
                ichain = ichain + 1
                call chainc(ichain,even_chain)
              else 
                call chainc(ichain,even_chain)
                odd_chain = even_chain
              end if
            end if
            if ( mod(imol,2) == 0 ) write_chain = even_chain
            if ( mod(imol,2) /= 0 ) write_chain = odd_chain
          else
            write_chain = chain(i_not_fixed)
          end if

          xbar = x(ilubar+1) 
          ybar = x(ilubar+2) 
          zbar = x(ilubar+3) 
          beta = x(ilugan+1)
          gama = x(ilugan+2)
          teta = x(ilugan+3)

          call eulerrmat(beta,gama,teta,v1,v2,v3)
           
          rewind(15)
          idatom = idfirst(i_not_fixed) - 1     
          iatom = 0
          do while(iatom.lt.natoms(i_not_fixed))

            read(15,str_format,iostat=ioerr) record
            if ( ioerr /= 0 ) exit mol
            if(record(1:4).ne.'ATOM'.and.record(1:6).ne.'HETATM') then
              if(amber_ter_preserve .and. record(1:3).eq.'TER') then
                write(30,"('TER')") 
              end if
              cycle
            end if

            iatom = iatom + 1 
            icart = icart + 1
            idatom = idatom + 1
            i_ref_atom = i_ref_atom + 1
            call compcart(icart,xbar,ybar,zbar,&
                          coor(idatom,1),coor(idatom,2),&
                          coor(idatom,3),v1,v2,v3)

            ! Setting residue numbers for this molecule

            imark = 0
            read(record(23:26),*,iostat=ioerr) imark
            if ( ioerr /= 0 ) imark = 1
            if(resnumbers(i_not_fixed).eq.0) then
              iires = mod(imol,9999)
              ciires = mod(imol,99999999)
            else if(resnumbers(i_not_fixed).eq.1) then
              iires = imark
              ciires = imark
            else if(resnumbers(i_not_fixed).eq.2) then
              iires = mod(imark-ifres+irescount,9999)
              ciires = mod(imark-ifres+irescount,99999999)
            else if(resnumbers(i_not_fixed).eq.3) then
              iires = mod(iimol,9999)
              ciires = mod(iimol,99999999)
            end if
            if(iires.eq.0) iires = 9999
            if(ciires.eq.0) ciires = 99999999

            ! Writing output line

            if(record(1:4).eq.'ATOM') then
              tmp_i5hex = i5hex(i_ref_atom)
              write(30,pdb_atom_line) "ATOM  ", tmp_i5hex,&
                                      record(12:21), write_chain, iires,&
                                      record(27:27),&
                                      (xcart(icart,k), k = 1, 3),&
                                      record(55:80)
            end if
            if(record(1:6).eq.'HETATM') then
              tmp_i5hex = i5hex(i_ref_atom)
              write(30,pdb_atom_line) "HETATM", tmp_i5hex,&
                                       record(12:21), write_chain, iires,&
                                       record(27:27),&
                                       (xcart(icart,k), k = 1, 3),&
                                       record(55:80)
            end if

            if ( crd ) then
              write(crdires,'(I8)') ciires 
              crdires = adjustl(crdires)
              crdresn = trim(adjustl(record(18:21)))
              crdsegi = crdresn
              if (len(trim(adjustl(segid(i_not_fixed))))/=0) crdsegi = trim(adjustl(segid(i_not_fixed)))
              atmname = adjustl(record(13:16))
              write(40,crd_format) i_ref_atom, ciires,crdresn, atmname, &
                                   (xcart(icart,k), k = 1, 3), crdsegi,&
                                   crdires, 0.
            end if

          end do
          irescount = irescount + nres
          ilugan = ilugan + 3 
          ilubar = ilubar + 3 
 
          if(add_amber_ter) write(30,"('TER')") 
        end do mol
        close(15)

      ! If fixed molecule on input:
      else
        i_fixed = i_fixed + 1

        ! Counting the number of residues of this molecule

        open(15,file=pdbfile(i_fixed),status='old')
        ifres = 0
        do
          read(15,str_format,iostat=ioerr) record
          if ( ioerr /= 0 ) exit
          if ( record(1:4).eq.'ATOM'.or.record(1:6).eq.'HETATM' ) then
            read(record(23:26),*,iostat=ioerr) imark
            if ( ioerr /= 0 ) then
              record = pdbfile(i_not_fixed)
              write(*,*) ' ERROR: Failed reading residue number ',&
                         ' from PDB file: ', trim(adjustl(record))
              write(*,*) ' Residue numbers are integers that must',&
                         ' be between columns 23 and 26. ' 
              write(*,*) ' Other characters within these columns',&
                         ' will cause input/output errors. ' 
              write(*,*) ' Standard PDB format specifications can',&
                         ' be found at: '
              write(*,*) ' www.rcsb.org/pdb '
              stop exit_code_input_error
            end if
            if ( ifres .eq. 0 ) ifres = imark
            ilres = imark
          end if
        end do
        nres = ilres - ifres + 1

        iimol = iimol + 1
        idatom = idfirst(i_fixed) - 1

        rewind(15)
        iatom = 0
        do while(iatom.lt.natoms(i_fixed))

          read(15,str_format,iostat=ioerr) record
          if ( ioerr /= 0 ) exit
          if(record(1:4).ne.'ATOM'.and.record(1:6).ne.'HETATM') then
            if(amber_ter_preserve .and. record(1:3).eq.'TER') then
              write(30,"('TER')") 
            end if
            !write(30,"( a80 )") record(1:80)
            cycle
          end if

          iatom = iatom + 1
          idatom = idatom + 1
          i_ref_atom = i_ref_atom + 1

          read(record(23:26),*) imark
          if(resnumbers(i_fixed).eq.0) then
            iires = 1
            ciires = 1
          else if(resnumbers(i_fixed).eq.1) then
            iires = imark
            ciires = imark
          else if(resnumbers(i_fixed).eq.2) then
            iires = mod(imark-ifres+irescount,9999) 
            ciires = mod(imark-ifres+irescount,99999999) 
          else if(resnumbers(i_fixed).eq.3) then
            iires = mod(iimol,9999)
            ciires = mod(iimol,99999999)
          end if

          if ( chain(i_fixed) == "#" ) then
            write_chain = record(22:22)
          else
            write_chain = chain(i_fixed)
          end if

          if(record(1:4).eq.'ATOM') then
            tmp_i5hex = i5hex(i_ref_atom)
            write(30,pdb_atom_line) "ATOM  ", tmp_i5hex,&
                                    record(12:21), write_chain, iires,&
                                    record(27:27),&
                                    (coor(idatom,k), k = 1, 3),&
                                    record(55:80)
          end if
          if(record(1:6).eq.'HETATM') then
            tmp_i5hex = i5hex(i_ref_atom)
            write(30,pdb_atom_line) "HETATM", tmp_i5hex,&
                                    record(12:21), write_chain, iires,&
                                    record(27:27),&
                                    (coor(idatom,k), k = 1, 3),&
                                    record(55:80)
          end if

          if ( crd ) then
              write(crdires,'(I8)') ciires 
              crdires = adjustl(crdires)
              crdresn = trim(adjustl(record(18:21)))
              crdsegi = crdresn
              if (len(trim(adjustl(segid(i_fixed))))/=0) crdsegi = trim(adjustl(segid(i_fixed)))
              atmname = adjustl(record(13:16))
              write(40,crd_format) i_ref_atom, iires,crdresn, atmname, &
                                   (xcart(icart,k), k = 1, 3), crdsegi,&
                                   crdires, 0.
          end if

        end do
        irescount = irescount + nres
        close(15)
        if(add_amber_ter) write(30,"('TER')") 
      end if
    end do
    ! 
    ! Write connectivity if available
    !
    i_ref_atom = 0
    i_not_fixed = 0
    i_fixed = ntype
    do itype = 1, ntfix 
      if ( .not. fixedoninput(itype) ) then
        i_not_fixed = i_not_fixed + 1
        idatom = idfirst(i_not_fixed) - 1     
        do imol = 1, nmols(i_not_fixed) 
          iatom = 0
          ifirst_mol = i_ref_atom + 1
          do while(iatom.lt.natoms(i_not_fixed))
            iatom = iatom + 1 
            i_ref_atom = i_ref_atom + 1
            if(connect(itype)) then
              call write_connect(30,idatom,iatom,ifirst_mol)
            end if
          end do
        end do
        close(15)
      ! If fixed molecule on input:
      else
        i_fixed = i_fixed + 1
        idatom = idfirst(i_fixed) - 1
        iatom = 0
        ifirst_mol = i_ref_atom + 1
        idatom = idfirst(i_fixed) - 1
        do while(iatom.lt.natoms(i_fixed))
          iatom = iatom + 1
          i_ref_atom = i_ref_atom + 1
          if(connect(itype)) then
            call write_connect(30,idatom,iatom,ifirst_mol)
          end if
        end do
      end if
    end do             
    write(30,"('END')")
    close(30) 
    if ( crd ) close(40)
  end if 
 
  ! Write the output (tinker xyz file)

  if(tinker) then

    tinker_atom_line = "( i7,tr2,a3,3(tr2,f10.6),9(tr2,i7) )"

    open(30, file = output_file_name,status='unknown') 
 
    write(30,"( i6,tr2,a64 )") ntotat, title 

    ilubar = 0 
    ilugan = ntotmol*3 
    icart = 0
    i_ref_atom = 0
    i_not_fixed = 0
    i_fixed = ntype

    do itype = 1, ntfix

      if ( .not. fixedoninput(itype) ) then
        i_not_fixed = i_not_fixed + 1
  
        do imol = 1, nmols(i_not_fixed) 
 
          xbar = x(ilubar+1) 
          ybar = x(ilubar+2) 
          zbar = x(ilubar+3) 
          beta = x(ilugan+1)
          gama = x(ilugan+2)
          teta = x(ilugan+3)

          call eulerrmat(beta,gama,teta,v1,v2,v3) 

          idatom = idfirst(i_not_fixed) - 1      
          do iatom = 1, natoms(i_not_fixed) 
            icart = icart + 1
            idatom = idatom + 1
            call compcart(icart,xbar,ybar,zbar,&
                          coor(idatom,1),coor(idatom,2),&
                          coor(idatom,3),&
                          v1,v2,v3)    

            ntcon(1) = nconnect(idatom,1)
            do k = 2, maxcon(idatom)
              ntcon(k) = nconnect(idatom,k) + i_ref_atom
            end do
            write(30,tinker_atom_line) i_ref_atom+iatom,&
                                       ele(idatom), (xcart(icart, k), k = 1, 3),&
                                       (ntcon(k), k = 1, maxcon(idatom))
          end do 
          i_ref_atom = i_ref_atom + natoms(i_not_fixed)
 
          ilugan = ilugan + 3 
          ilubar = ilubar + 3 
 
        end do 

      else 

        i_fixed = i_fixed + 1
        idatom = idfirst(i_fixed) - 1
        do iatom = 1, natoms(i_fixed)
          idatom = idatom + 1
          ntcon(1) = nconnect(idatom,1)
          do k = 2, maxcon(idatom)
            ntcon(k) = nconnect(idatom,k) + i_ref_atom
          end do
          write(30,tinker_atom_line) i_ref_atom+iatom, ele(idatom),&
                                     (coor(idatom,k), k = 1, 3),&
                                     (ntcon(k), k = 1, maxcon(idatom))
        end do
        i_ref_atom = i_ref_atom + natoms(i_fixed)

      end if

    end do             
    close(30) 
  end if   

  return
end subroutine output

function i5hex(i)
  implicit none
  integer :: i
  character(len=5) i5hex
  if(i <= 99999) then
    write(i5hex,"(i5)") i
  else
    write(i5hex,"(z5)") i
  end if
end

subroutine write_connect(iostream,idatom,iatom,ifirst)
  use sizes
  use input
  implicit none
  integer :: i, j, iostream, iatom, idatom, ifirst
  character(len=5) :: i5hex, tmp_i5hex
  character(len=strl) :: str
  if(maxcon(iatom+idatom) == 0) return
  str = "CONECT"
  j=7
  tmp_i5hex = i5hex(iatom+ifirst-1)
  write(str(j:j+4),"(a5)") tmp_i5hex
  do i = 1, maxcon(iatom+idatom)
    j = j + 5
    tmp_i5hex = i5hex(nconnect(iatom+idatom,i)+ifirst-1)
    write(str(j:j+4),"(a5)") tmp_i5hex
  end do
  write(iostream,"(a)") trim(adjustl(str))
end subroutine write_connect






