c
c Sort the set of couples in page mode , call print for every page
c   and prepare average computation
c
c		input arguments
c
c	a      : atomic weight
c	idx    : application {l1,..,l(nel-1)} -> {1,..,nel-1}
c		 according to D-H-Z sorting
c	naem   : end member names
c	ncp    : number of couples in computing an average
c       nv     : valence
c       oxcpd  : chemical formula
c       sym    : atom symbol
c	cptox  : switch for WT % oxide calculation
c	igr    : species group number
c	imod   : resume mode
c	isw    : analysis mode
c	isws   : number of negative valence(s)
c       mato   : number of cations ( geo )
c	mnel   : loop parameter
c	na     : number of measured elements
c	nbh2o  : number of water mol.
c	nel    : total number of elements in the unknown
c	npol   : number of poles
c       LEG    : maximum number of elements
c
c		output arguments
c
c	ato    : atom% or number of cations
c	c      : W% concentration or W% of oxide
c	pole   : end member contribution
c	sigsk  : sigma/k
c       CW    : W% concentration or oxyde  |
c
c		CWOUT = 0 normal exit
c		CWOUT = 1 error exit
c
      function CWOUT(a,ato,c,idx,naem,NR39,nv,oxcpd,pole,XYCRD,TARG0
     &,sigsk,sym,CW,cptox,igr,imod,isw,isws,mato,mnel,na,nbh2o,nel
     &,npol,LEG,LPO)
      CHARACTER*1 NUM(10)
      character*23 LABFMT
      character*17 DATFMT
      character*80 bla
      character*2 sym(LEG)
      character*10 oxcpd(LEG)
      logical cptox, XYCRD
      character*2 LL
      character*4 naem(6)
      dimension a(LEG),ato(LEG),c(LEG),idx(LEG)
     &,nv(LEG),pole(LPO),sigsk(LEG),CW(LEG)
      common/lui/lu5,lu6,lu7,lu2,lu3,lu9,LU4
C
      DATA LL(1:2) /'  '/
      DATA LABFMT(1:1) /'('/,LABFMT(23:23)/')'/
      DATA LABFMT(2:4) /'1x,'/
      DATA LABFMT(7:22) /'('','',''"'',A7,''"'')'/
      DATA LABFMT(5:6) /'00'/
      DATA DATFMT(1:1) /'('/,DATFMT(17:17)/')'/
      DATA DATFMT(2:4) /'1X,'/
      DATA DATFMT(7:16) /'('','',F8.3)'/
      DATA DATFMT(5:6) /'00'/
      DATA NUM /'0','1','2','3','4','5','6','7','8','9'/
C
904   format(10(1x,f7.3))
905   format(10(1x,f8.5))
906   format(10(5x,f4.1))
907   format(a80)
c
      CWOUT=0
c
C
C	Print labels: elements analyzed & error
C
      WRITE(LU2,6668)
6668  FORMAT(/1x,'"Weight %"')
      IF(ISW.EQ.7) GO TO 750		! go to GEO MODE
      FLD=(NEL-MNEL)                    ! CATIONS REMOVED
      KK=FLD/10
      LL(1:1)=NUM(KK+1)
      LL(2:2)=NUM(FLD-KK*10+1)
      LABFMT(5:6)=LL(1:2)
      IF(MNEL.EQ.0) GO TO 740           ! print symbols, not oxides
c
      WRITE(LU2,LABFMT) 
     &(OXCPD(IDX(I)),I=1,NEL-MNEL)	! oxide labels
C
740   WRITE(LU2,LABFMT) 
     &(SYM(IDX(I)),I=1,NEL-MNEL)	! element labels
      go to 799
C
750   H2O=0
      EMBR=0
      IF(NBH20.GT.0) H20=1
      IF(NPOL.GT.0) EMBR=NPOL
      FLD=(MATO+H2O+ISWS)            ! CATS & ENDMBRS REMOVED
      KK=FLD/10
      LL(1:1)=NUM(KK+1)
      LL(2:2)=NUM(FLD-KK*10+1)
      LABFMT(5:6)=LL(1:2)
C
      WRITE(LU2,LABFMT) (OXCPD(IDX(I)),I=1,MATO),  ! OXIDES
     &(OXCPD(NEL-1),I=1,H2O),                      ! WATERS
     &(SYM(IDX(I)),I=MATO+1,MATO+ISWS)             ! ANIONS
C
799   CONTINUE
C
C Read data from label.cor and label.kex
C
      do 1 icp=1,NR39
C
6     read(lu9,907,end=99) bla
      if(isw.ne.7) go to 666
      read(lu9,904,end=99)(c(i),i=1,nel-1)
      read(lu9,904,end=99)(ato(i),i=1,nel-1)
      read(lu9,904,end=99) (pole(i),i=1,LPO)
      go to 667
666   read(lu9,904,end=99)(c(i),i=1,nel)
      read(lu9,904,end=99)(ato(i),i=1,nel)
667   continue
c
30    do 51 i=1,nel-mnel
c calculate WT % or oxide WT %
      fac=1.
      if(cptox) fac=((nv(i)*a(nel))/nv(nel)+a(i))/a(i)
      CW(i)=c(i)*fac
51    continue
c
c	print a line of data
c
      DATFMT(5:6)=LL(1:2)
c
      IF (ISW.EQ.7) GO TO 9
c
C
      WRITE(LU2,DATFMT) 
     &(CW(IDX(I)),I=1,NEL-MNEL)              	! WEIGHT %
      GO TO 1
c
9     WRITE(LU2,DATFMT) 
     &(CW(IDX(I)),I=1,MATO),                      ! OXIDES
     &(CW(NEL-1),I=1,H2O),                        ! WATERS
     &(CW(IDX(I)),I=MATO+1,MATO+ISWS)             ! EXTRA ANIONS
c
c
1     continue
      write(lu5,6663)
6663  format(/1x,'finished writing weight % ...')
      return
c
c error handling
c
99    CWOUT=-1
      write(lu7,314)
314   format(/1X,' error during read of  .cor file')
      return
      end