
      SUBROUTINE mlvmkl(ear, ne, param, ifl, photar, photer)

      INTEGER ne, ifl
      REAL ear(0:ne), param(18), photar(ne), photer(ne)

c
c XSPEC model subroutine to calculate a MEKAL model with multiple temperatures
c according to Mike L's models for A496.
c
c This program calls 'vmekal' thus allowing one to vary the elemental
c abundances.
c 
c Parameters:
c    param(1) = option (1,2,3)
c    param(2) = nH (cm^-3)  Fixed at 1 for most applications
c    param(3) = He abundance
c    param(4) = C   "
c    param(5) = N   "
c    param(6) = O   "
c    param(7) = Ne  "
c    param(8) = Na  "
c    param(9) = Mg  "
c    param(10)= Al  "
c    param(11)= Si  "
c    param(12)= S   "
c    param(13)= Ar  "
c    param(14)= Ca  "
c    param(15)= Fe  "
c    param(16)= Ni  " 
c    param(17) = redshift used in the Mewe-Kaastra plasma model
c    param(18) = switch(0=calculate MEKAL model, 1=interpolate MEKAL model)


      INCLUDE 'xspec.h'

      INTEGER itarr, idem


      INTEGER switch, i, nt, ntsave, ierr, iopt

      CHARACTER contxt*127

      SAVE itarr, idem, ntsave

      DATA itarr, idem, ntsave/0, 0, -1/

      ierr = 0

      iopt = NINT(param(1))

      IF ( iopt .EQ. 1 .OR. iopt .EQ. 2 ) THEN
         nt = 4
      ELSEIF ( iopt .EQ. 3 ) THEN
         nt = 5
      ELSE
         CALL xwrite('Illegal value of option', 10)
         RETURN
      ENDIF

c Get the memory for the temperature and relative emissivity arrays

      IF ( nt .NE. ntsave ) THEN
         CALL udmget(nt, 6, itarr, ierr)
         contxt = 'MLVMKL: Failed to get memory for tarr'
         IF ( ierr .NE. 0 ) GOTO 999
         CALL udmget(nt, 6, idem, ierr)
         contxt = 'MLVMKL: Failed to get memory for dem'
         IF ( ierr .NE. 0 ) GOTO 999
         ntsave = nt
      ENDIF

c Set the temperature and relative emissivity arrays

      IF ( iopt .EQ. 1 ) THEN
         MEMR(itarr)   = 5.6
         MEMR(itarr+1) = 4.7
         MEMR(itarr+2) = 3.7
         MEMR(itarr+3) = 3.0
         MEMR(idem)    = 0.18
         MEMR(idem+1)  = 0.27
         MEMR(idem+2)  = 0.42
         MEMR(idem+3)  = 0.13
      ELSEIF ( iopt .EQ. 2 ) THEN
         MEMR(itarr)   = 5.6
         MEMR(itarr+1) = 4.7
         MEMR(itarr+2) = 3.7
         MEMR(itarr+3) = 3.0
         MEMR(idem)    = 0.10
         MEMR(idem+1)  = 0.18
         MEMR(idem+2)  = 0.22
         MEMR(idem+3)  = 0.50
      ELSEIF ( iopt .EQ. 3 ) THEN
         MEMR(itarr)   = 5.6
         MEMR(itarr+1) = 4.7
         MEMR(itarr+2) = 3.7
         MEMR(itarr+3) = 2.7
         MEMR(itarr+4) = 2.0
         MEMR(idem)    = 0.10
         MEMR(idem+1)  = 0.18
         MEMR(idem+2)  = 0.22
         MEMR(idem+3)  = 0.30
         MEMR(idem+4)  = 0.20
      ENDIF

      switch = NINT(param(18))

      CALL sumdem(2, switch, ear, ne, param(4), param(5), param(17),
     &            nt, MEMR(itarr), MEMR(idem), ifl, photar, ierr)
      contxt = 'MLVMKL: failure in SUMDEM'

 999  CONTINUE
      IF ( ierr .NE. 0 ) THEN
         CALL xwrite(contxt, 10)
         WRITE(contxt, '(a,i5)') 'Error number = ', ierr
         CALL xwrite(contxt, 10)
      ENDIF

      return
      end 












