      SUBROUTINE WRTARG(ITAPE,TITLE,NTATOM,NSYT,NGEN,IAORDS,
     1                JJCH,IBF,NNSTV,IGR,NSTV,
     2                RR,IATM,ATNM,LOGO,IMAGE,NEQ,ICCN,
     3                NGENG,IATN)
C
C     ACTUAL WRITING OF FILE ARGOS
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER (MAXSHL = 20)
      PARAMETER (NPRIMAX = 1000)
      PARAMETER (NCNTMAX = 10)
      CHARACTER*(*) TITLE,IBF
      DOUBLE PRECISION EXP(NPRIMAX),COEFF(NCNTMAX),RR(3,200),ATNM(1),ONE
      DIMENSION IATN(2),ICL(NCNTMAX)
      COMMON/WORK/ IDUM(10000),INFO(100,3)
      COMMON/IRD/ IRD(5),IFL1(100)
      DIMENSION NSYT(1),IBF(1),NNSTV(1),NSTV(3,7),ICCN(1)
      DIMENSION IATM(1),LOGO(1),IMAGE(200,3),NEQ(200)
      CHARACTER*60 IATM
      LOGICAL LOGO
      COMMON /FLAGS/ IFLAGS(100),IFLAGS2(500)
      INTEGER SHELLLOC,SHELLSIZ
      COMMON /MOLSTR1/ LMNP1(100),SHELLLOC(100),SHELLSIZ(100),
     &                 ICONU(100),BASISEXP(10000),BASISCNT(10000)
      COMMON /MOLSTR2/ NTOTPRIM,NTOTSHEL,IOFFPRIM,IOFFSHEL,IATOM
      DATA ONE/1.0D0/
      DATA IONE/1/
      DATA IZER/0/
C
C     SET DEFAULTS
C
      ITOL=20
      ICUT=9
      NSUPP=0
      NTAPE=4
      INRM=0
      NCRS=0
      NS=NTATOM
C      
      ICX=0
      INP=ITAPE
CW      NITER=1
CW      INP2=31
CW      REWIND INP2
CW      IF(ITGEOM.EQ.1) WRITE(INP2,995) NITER
CW      IF(ITGEOM.EQ.1) INP=INP2
CW  995 FORMAT(20I4)
C
      REWIND ITAPE
      WRITE(ITAPE,101) TITLE
  101 FORMAT(A)
CW      WRITE(ITAPE,101) (LFMT(I),I=1,2)
C
CW      WRITE(ITAPE,103) NGEN,NS,IAORDS,NTOTSHEL,IAORDS,ITOL,ICUT,NTAPE,
CW     1NSUPP,ITGEOM,IZER,IZER,IZER
      WRITE(ITAPE,103) NGEN,NS,IAORDS,NTOTSHEL,IAORDS,ITOL,ICUT,NTAPE,
     1   NSUPP,INRM,NCRS,IZER,IZER,IZER,IZER,IZER
 103  FORMAT(26I3)
C
      IDEG=1
      WRITE(ITAPE,104) JJCH,(IDEG,IBF(I),I=1,JJCH)
 104  FORMAT(I3,8(I3,A3))
C
      NNNSTV=NNSTV(IGR)
      WRITE(ITAPE,103) NNNSTV
      IF(NNNSTV.EQ.0) GO TO 106
      WRITE(ITAPE,105) ((NSTV(I,J),I=1,3),J=1,NNNSTV)
 105  FORMAT(3I3)
 106  CONTINUE
C
      DO 108 I=1,IAORDS
         INF2=INFO(I,2)
         IAD=INFO(I,1)
         WRITE(ITAPE,103) INF2,(IDUM(IAD+L),L=1,INF2)
 108  CONTINUE
C
      DO 110 I=1,IAORDS
         INF1=INFO(I,1)
         INF2=INFO(I,2)
         INF3=INFO(I,3)
         WRITE(ITAPE,103) INF2,INF3,I
         INF1=INF1+INF2
         DO 110 J=1,INF2
            KKLL=INF1+(J-1)*INF3
            WRITE(ITAPE,107) (IDUM(KKLL+K),K=1,INF3)
 107        FORMAT(15I5)
 110  CONTINUE
      IOFFPR=1
C
      DO 112 I=1,NTOTSHEL
         ICNN=ICONU(I)
         NCONT=SHELLSIZ(I)
         CALL IZERO(ICL,ICNN)
         IF(IFLAGS(59).EQ.0) THEN
C
C   IF SEGMENTED CONTRACTION IS REQUIRED, GET RID OF ZERO COEFFICIENTS
C
            IF(NCONT.NE.1) STOP ' FATAL ERROR IN WRTARG'
            IOFF=IOFFPR
            ICLNUM=0
            DO 313 J=1,ICNN
               IF(DABS(BASISCNT(IOFF)).LT.1.D-8)THEN
                  ICL(J)=1
                  ICLNUM=ICLNUM+1
               ENDIF
               IOFF=IOFF+1
 313        CONTINUE
            WRITE(ITAPE,103) ICNN-ICLNUM,LMNP1(I)+1,NCONT
         ELSE
            WRITE(ITAPE,103) ICNN,LMNP1(I)+1,NCONT
         ENDIF
         CALL SCOPY(ICNN,BASISEXP(IOFFPR),1,EXP,1)
         IOFF=IOFFPR
         DO 111 J=1,ICNN
            CALL SCOPY(NCONT,BASISCNT(IOFF),ICNN,COEFF,1)
            IOFF=IOFF+1
            IF(ICL(J).NE.1) WRITE(ITAPE,113) EXP(J),(COEFF(K),K=1,NCONT)
 111     CONTINUE
         IOFFPR=IOFFPR+ICNN*NCONT
 112  CONTINUE
      IF(IOFFPR.NE.IOFFPRIM) STOP ' FATAL ERROR IN WRTARG'
 113  FORMAT(5F14.8)
C
      KK=0
      LL=0
      IFLW=0
      DO 120 I=1,NTATOM
         IXX=NSYT(I)
         ICY=ICCN(I)
         LL=LL+1
         NQQ=NEQ(LL)
         WRITE(INP,114) IATM(I),IXX,NQQ,ATNM(I),IATN(I)
 114     FORMAT(1X,A2,2I3,F3.0,I3)
         DO 115 J=1,NQQ
            KK=KK+1
            WRITE(INP,116) RR(1,KK),RR(2,KK),RR(3,KK),ONE
 115     CONTINUE
 116     FORMAT(4F14.8)
         IF(NGEN.EQ.0) GO TO 119
         IF(NQQ.EQ.1) GO TO 129
         DO 118 K=1,NGENG
            IF(LOGO(K)) GO TO 118
            WRITE(ITAPE,103) (IMAGE(IFLW+MM,K),MM=1,NQQ)
 118     CONTINUE
 129     IFLW=IFLW+NQQ
 119     CONTINUE
         DO 200 IL=1,IXX
            ICX=ICX+1
            ICY=ICY+1
            WRITE(ITAPE,103) ICY,IFL1(ICX)
 200     CONTINUE
 120  CONTINUE
C
      RETURN
      END
