SUBROUTINE wrtpro(string, iparse)

      IMPLICIT NONE

      CHARACTER*(*) string
      INTEGER iparse

c **	** 	fwj haberl 	28 oct 1986
c **	**	kaa		26 dec 1989
c **	** 	fwj haberl 	26 apr 1991
c               adjusted to XSPEC 7.1 with more than 1 data group
c
c	subroutine to write out profile
c	string	c*(*)		i: the command string
c	iparse	i		i: the parser position

      INCLUDE '../../inc/xspec.inc'

      INTEGER MAXSCM
      PARAMETER (MAXSCM=3)
      INTEGER profunit, icom, iflag, nret, idelim
      INTEGER ierrsf

      LOGICAL qall

      CHARACTER*255 filnam, ctmp
      CHARACTER*8   subcom(MAXSCM)

      REAL csmgH0, csmgq0, csmgl0, xgmsys
      CHARACTER xgstat*11, fgsolr*4, fgxsct*4, fgslfn*255
      LOGICAL xgfclc
      EXTERNAL  xgstat, fgsolr, fgxsct, xgfclc, csmgH0, csmgq0, csmgl0
      EXTERNAL xgmsys, fgslfn

      SAVE filnam, icom, subcom

      DATA filnam/'savexspec.xcm'/
      DATA icom/1/
      DATA subcom/'files', 'model', 'all'/

c  find the option requested

      CALL xgtmch(string, iparse, subcom, MAXSCM,
     &            '`save'' sub-commands', icom, iflag, idelim)
      IF (iflag.LT.0) RETURN

c  set the filename
      ctmp = filnam
      CALL xgtstr(string, iparse, 1, 'XSPEC profile file name', 1,
     &            ctmp, nret, iflag, -1)
      IF (iflag.LT.0) RETURN
      CALL xtend(ctmp, 'xcm')
      IF ( ctmp(1:1) .NE. char(92) ) THEN
         filnam = char(92)//ctmp
      ELSE
         filnam = ctmp
      ENDIF

c  open the output command file

      CALL getlun(profunit)
      CALL openwr(profunit, filnam, 'new', ' ', 'l', 256, 0, ierrsf)
      IF (ierrsf.NE.0) THEN
         CALL xwrite('Unable to open file', 5)
         RETURN
      ENDIF

      qall = .FALSE.
      GOTO (100, 200, 50), icom

c  all

 50   CONTINUE
      qall = .TRUE.

c  files

 100  CONTINUE
      CALL prfile(profunit)
      CALL prchns(profunit)
      CALL prrsp(profunit)
      IF (qall) THEN
         GOTO 200
      ENDIF
      GOTO 999

c  model

 200  CONTINUE
      IF ( xgstat() .EQ. 'Chi-Squared' ) THEN
         WRITE(profunit, '(1x,a)') 'statistic chi'
      ELSEIF ( xgstat() .EQ. 'C-statistic' ) THEN
         WRITE(profunit, '(1x,a)') 'statistic cstat'
      ELSEIF ( xgstat() .EQ. 'L-statistic' ) THEN
         WRITE(profunit, '(1x,a)') 'statistic lstat'
      ENDIF
      IF ( fgsolr() .EQ. 'file') THEN
         WRITE(profunit, '(1x,a,a,1x,a)') 'abund ', fgsolr(), fgslfn()
      ELSE
         WRITE(profunit, '(1x,a,a)') 'abund ', fgsolr()
      ENDIF
      WRITE(profunit, '(1x,a,a)') 'xsect ', fgxsct()
      IF ( xgfclc() ) THEN
         WRITE(profunit, '(1x,a,a)') 'xset forcecalc on'
      ELSE
         WRITE(profunit, '(1x,a,a)') 'xset forcecalc off'
      ENDIF
      WRITE(profunit, '(1x,a,3(1x,f7.3))') 'cosmo ', csmgH0(), 
     &                                     csmgq0(), csmgl0()
      IF ( xgmsys() .NE. 0.0 ) THEN
         WRITE(profunit, '(1x,a,1pg12.5)') 'systematic ', xgmsys()
      ENDIF

      CALL prmodl(profunit)

      GOTO 999

 999  CONTINUE

      CLOSE (profunit)
      CALL frelun(profunit)

      RETURN
      END