      SUBROUTINE COMPO(N, IDX, Z, IMW, IMF, IMP, IMC, IMA,
     *     IIMW, IIMF, IIMP, IIMC, IIMA,
     *     WC, FC, PC, CC, AC,
     *     MWW, MWF, MWP, MWC, MWA, IER)
      IMPLICIT NONE
      INTEGER N, IDX(*), IMW, IMF, IMP, IMC, IMA
      INTEGER IIMW, IIMF, IIMP, IIMC, IIMA
      REAL*8 WC, FC, PC, CC, AC
      REAL*8 MWW, MWF, MWP, MWC, MWA
      REAL*8 Z(*)

      INTEGER IER
      
      INTEGER I, II, IOFF

      REAL*8 B(1)
      EQUIVALENCE (B(1), IB(1))
      INTEGER DMS_KCCIDC
      INTEGER DMS_IFCMNC

#include "dms_ncomp.cmn"
#include "ppexec_user.cmn"
#include "pputl_ppglob.cmn"
#include "dms_ppwork.cmn"
#include "dms_ipwork.cmn"
#include "dms_plex.cmn"
#include "dms_maxwrt.cmn"

      IER = 0
      ! Retrieving components index:
      ! first set the index to 0
      IMW = 0
      IMF = 0
      IMP = 0
      IMC = 0
      IMA = 0 
      ! find the component index
      IMW = DMS_KCCIDC('H2O')
      IMF = DMS_KCCIDC('MILKFAT')
      IMP = DMS_KCCIDC('MILKPROT')
      IMC = DMS_KCCIDC('MILKCARB')
      IMA = DMS_KCCIDC('MILKASH')

C     Locate PLEX offset for MW
      IOFF = DMS_IFCMNC('MW')

      ! check that all index are non-zero and get MW 
      IF(IMW.EQ.0)THEN
        IER = 1
        write(user_nhstry,*) ' water is missing!'
      ELSE
        MWW = B(IOFF+IMW)
      ENDIF
      IF(IMF.EQ.0)THEN
        IER = 1
        write(user_nhstry,*) ' milkfat is missing'
      ELSE
        MWF = B(IOFF+IMF)
      ENDIF
      IF(IMP.EQ.0)THEN
        IER = 1
        write(user_nhstry,*) ' milkprot is missing'
      ELSE
        MWP = B(IOFF+IMP)
      ENDIF
      IF(IMC.EQ.0)THEN
        IER = 1
        write(user_nhstry,*) ' milkcarb is missing'
      ELSE
        MWC = B(IOFF+IMC)
      ENDIF
      IF(IMA.EQ.0)THEN
        IER = 1
        write(user_nhstry,*) ' milkash is missing'
      ELSE
        MWA = B(IOFF+IMA)
      ENDIF

C     quit if any component is missing
      IF(IER.NE.0) GOTO 999

!     Looking for components index in the IDX vector
!     first set the packed index to 0
      IIMW = 0
      IIMF = 0
      IIMP = 0
      IIMC = 0
      IIMA = 0
      DO I=1,N
        II = IDX(I)
        IF (II.EQ.IMW) IIMW = I
        IF (II.EQ.IMF) IIMF = I
        IF (II.EQ.IMP) IIMP = I
        IF (II.EQ.IMC) IIMC = I
        IF (II.EQ.IMA) IIMA = I
      ENDDO

!     Accessing molar fractions if component is present, otherwise
!     set to zero
      IF(IIMW.gt.0)THEN
        WC = Z(IIMW)
      ELSE
        WC = 0d0
      ENDIF
      IF(IIMF.gt.0)THEN
        FC = Z(IIMF)
      ELSE
        FC = 0d0
      ENDIF
      IF(IIMP.gt.0)THEN
        PC = Z(IIMP)
      ELSE
        PC = 0d0
      ENDIF
      IF(IIMC.gt.0)THEN
        CC = Z(IIMC)
      ELSE
        CC = 0d0
      ENDIF
      IF(IIMA.gt.0)THEN
        AC = Z(IIMA)
      ELSE
        AC = 0d0
      ENDIF

 999  CONTINUE
!     check for IER to write to control panel
      IF(IER.NE.0)THEN
        WRITE (MAXWRT_MAXBUF, 1000)
        CALL DMS_WRTTRM(1)
      ENDIF

      RETURN
 1000 FORMAT(' Error in COMPO - check history file')

      END
