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		ATMOUT = 0 normal exit
c		ATMOUT = 1 error exit
c
      function ATMOUT(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
      ATMOUT=0
c
C
C	Print labels: cations, endmembers
C
      IF(ISW.EQ.7) GO TO 6665		! go to GEO MODE
      WRITE(LU2,6667)
6667  FORMAT(/1x,'Atomic %')
      go to 6664
6665  WRITE(LU2,6668)
6668  FORMAT(/1x,'"Cations and Endmembers"')
c
6664  IF(ISW.EQ.7) GO TO 750		! go to GEO MODE
      FLD=NEL              
      KK=FLD/10
      LL(1:1)=NUM(KK+1)
      LL(2:2)=NUM(FLD-KK*10+1)
      LABFMT(5:6)=LL(1:2)
      WRITE(LU2,LABFMT) (SYM(IDX(I)),I=1,NEL)
C
      go to 799
C
750   H2O=0
      EMBR=0
      IF(NBH20.GT.0) H20=1
      IF(NPOL.GT.0) EMBR=NPOL
      FLD=(MATO+EMBR)  ! number of fields
      KK=FLD/10
      LL(1:1)=NUM(KK+1)
      LL(2:2)=NUM(FLD-KK*10+1)
      LABFMT(5:6)=LL(1:2)
      WRITE(LU2,LABFMT) 
     &(SYM(IDX(I)),I=1,MATO),                      ! CATIONS
     &(NAEM(I),I=1,EMBR)                           ! ENDMEMBERS
C
C
799   CONTINUE
C
C Read data from label.cor and label.kex (and from xyzpos.dat)
C
2     continue
      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
c
c	print a line of data
c
      DATFMT(5:6)=LL(1:2)
c
      IF (ISW.EQ.7) GO TO 9
c
      WRITE(LU2,DATFMT) 
     &(ATO(IDX(I)),I=1,NEL)                      ! ATOM %
C
      GO TO 1
c
9     WRITE(LU2,DATFMT) 
     &(ATO(IDX(I)),I=1,MATO),                     ! CATIONS
     &(POLE(I),I=1,EMBR)                          ! ENDMEMBERS
c
c
1     continue
      write(lu5,6663)
6663  format(/1x,'finished writing atomic fractions...')
      return
c
c error handling
c
99    ATMOUT=-1
      write(lu7,314)
314   format(/1X,' error during read of  .cor file')
      return
      end