      module mod_licost
      parameter (maxsym=8)
      integer,save :: norb,icpu,its(maxsym,maxsym),nsym,natom
     *,jtsr(maxsym,maxsym),isym(maxsym),noc,frozen(maxsym)
     *,delete(maxsym),n_ijcl
      character(4),allocatable,dimension(:) :: atom
      real(8) enuc
      real(8),allocatable,dimension(:,:) :: coor
      character(8),allocatable,dimension(:) :: label
      integer(4),allocatable,dimension(:) :: itsym
      logical(1) ycl
      contains
       subroutine licost_ao(ifil,itest)
      character(10000) namel
      call LECNAM('&COST_AO ',namel,ifil,ierr,itest)
      call nameli(namel,NATOM,'NATOM',4)
      allocate(atom(natom))
      call namela(namel,ATOM,'ATOM')
      call nameli(namel,nsym,'NSYM',4)
      call nameli(namel,isym,'ISYM',4)
      call nameli(namel,NORB,'NORB',4)
      call nameld(namel,ENUC,'ENUC',8)
      allocate(coor(3,natom))
      call nameld(namel,COOR,'COOR',8)
      allocate(label(norb))
      call namela(namel,LABEL,'LABEL')
      call nameli(namel,ITS,'ITS',4)
      call nameli(namel,JTSR,'JTSR',4)
      return
      end subroutine
       subroutine licost_mo(ifil,itest,ierr)
      character(10000) namel
      call LECNAM('&COST_MO ',namel,ifil,ierr,itest)
      call nameli(namel,nsym,'NSYM',4)
      call nameli(namel,NORB,'NORB',4)
      call nameli(namel,NOC,'NOC',4)
      call nameli(namel,ITSYM,'ITSYM',4)
      call nameli(namel,ISYM,'ISYM',4)
      call nameli(namel,FROZEN,'FROZEN',4)
      call nameli(namel,DELETE,'DELETE',4)
      call nameld(namel,ENUC,'ENUC',8)
      call namell(namel,YCL,'YCL',1)
      call nameli(namel,N_IJCL,'N_IJCL',4)
      return
      end subroutine
       subroutine ecricost_ao(ifil,itest,file,prog)
      character(1) cote
      character(*) file,prog
      character(21) cdate
      call cost_date(cdate)
      write(ifil,'(a)')'============================================='
      write(ifil,'(2a)') 'File: ',trim(file)
      write(ifil,'(2a)')'created by ',trim(prog)
      write(ifil,'(2a)')'date:',cdate
      write(ifil,'(a)')'============================================='
      cote=''''
      write(ifil,'(a)') ' &cost_AO'
      write(ifil,'(a,i4)')' natom=',natom
      write(ifil,'(a)') ' atom='
      write(ifil,1003) (cote,atom(k),cote,k=1,natom)
      write(ifil,'(a,i1)')' nsym=',nsym
      write(ifil,'(a,8(i4,","))')' isym=',(isym(1:nsym))
      write(ifil,1001) ' norb=',norb
      write(ifil,'(a,f20.12)') ' enuc=',enuc
      write(ifil,'(a)')' coor='
      do k=1,natom
         write(ifil,'(3(f20.10,'',''))') coor(:,k)
      enddo
      write(ifil,'(a)')' label='
      write(ifil,1002) (cote,label(k),cote,k=1,norb)
      write(ifil,'(a5)')' its='
      do j=1,nsym
         write(ifil,'(6x,8(i1,'',''))') (its(i,j),i=1,nsym),(0,i=nsym+1
     &   ,8)
      enddo
      write(ifil,'(a6)')' jtsr='
      do j=1,nsym
         write(ifil,'(6x,8(i2,'',''))') (jtsr(i,j),i=1,nsym),(0,i=nsym+1
     *   ,8)
      enddo
      write(ifil,'(a)')' /'
 1001 format(a,8(i4,','))
 1002 format(100(1x,5(a1,a8,a1,','),/))
 1003 format(100(1x,5(a1,a4,a1,','),/))
      if(itest>0) then
         write(6,'(a)') ' &cost_AO'
         write(6,'(a,i4)')' natom=',natom
         write(6,'(a)') ' atom='
         write(6,1003) (cote,atom(k),cote,k=1,natom)
         write(6,'(a,i1)')' nsym=',nsym
         write(6,'(a,8(i4,","))')' isym=',(isym(1:nsym))
         write(6,1001) ' norb=',norb
         write(6,'(a,f20.12)') ' enuc=',enuc
         write(6,'(a)')' coor='
         do k=1,natom
            write(6,'(3(f20.10,'',''))') coor(:,k)
         enddo
         if(itest>1) then
            write(6,'(a)')' label='
            write(6,1002) (cote,label(k),cote,k=1,norb)
            write(6,'(a5)')' its='
            do j=1,nsym
               write(6,'(6x,8(i1,'',''))') 
     *         (its(i,j),i=1,nsym),(0,i=nsym+1,8)
            enddo
            write(6,'(a6)')' jtsr='
            do j=1,nsym
               write(6,'(6x,8(i2,'',''))') 
     *         (jtsr(i,j),i=1,nsym),(0,i=nsym+1,8)
            enddo
         endif
         write(6,'(a)')' /'
         write(6,'(a)')' '
      endif
      return
      end subroutine
       subroutine ecricost_mo(ifil,itest)
      character(1) cote
      cote=''''
      write(ifil,'(a)') ' &cost_MO'
      write(ifil,'(a,i1)')' nsym=',nsym
      write(ifil,1001) ' norb=',norb
      write(ifil,1001) ' noc=',noc
      write(ifil,'(a7)') ' itsym='
      write(ifil,'(1x,20(20(i1,'',''),/,1x))')(itsym(i),i=1,norb)
      write(ifil,'(a6,8(i3,'',''))') ' isym=',isym(1:nsym)
      write(ifil,'(a8,8(i3,'',''))') ' frozen=',frozen(1:nsym)
      write(ifil,'(a8,8(i3,'',''))') ' delete=',delete(1:nsym)
      write(ifil,'(a,f20.12)') ' enuc=',enuc
      write(ifil,'(a5,l1)')' ycl=',ycl
      write(ifil,'(a8,i7)')' n_ijcl=',n_ijcl
      write(ifil,'(a)')' /'
      if(itest>0) then
         write(6,'(a)') ' &cost_MO'
         write(6,1001) ' norb=',norb
         write(6,1001) ' noc=',noc
         write(6,'(a6,8(i3,'',''))') ' isym=',isym(1:nsym)
         write(6,'(a8,8(i3,'',''))') ' frozen=',frozen(1:nsym)
         write(6,'(a8,8(i3,'',''))') ' delete=',delete(1:nsym)
         write(6,'(a,f20.12)') ' enuc=',enuc
         if(itest>1) then
            write(6,'(a,i1)')' nsym=',nsym
            write(6,'(a7)') ' itsym='
            write(6,'(1x,20(20(i1,'',''),/,1x))')(itsym(i),i=1,norb)
            write(6,'(a5,l1)')' ycl=',ycl
            write(6,'(a8,i7)')' n_ijcl=',n_ijcl
         endif
         write(6,'(a)')' /'
         write(6,'(a)')' '
      endif
 1001 format(a,8(i4,','))
      return
      end subroutine
      end module
