*CMZ :          06/01/95  12.39.51  by   E.Boehm
*-- Author :
      DOUBLE PRECISION FUNCTION HMIMSS (Xdd)
      DOUBLE PRECISION COEFF,P,P0,P1,P2,HELEFT,HBASFT
c
      REAL
     +ID      ,IND     ,DEPTH   ,COINC   ,ASEG    ,BSEG    ,
     +APHA    ,ACHN    ,BPHA    ,BCHN    ,CPHA    ,CCHN    ,
     +DPHA    ,DCHN    ,EPHA    ,ECHN
*
      LOGICAL         CHAIN
      CHARACTER*128   CFILE
*
      COMMON /PAWCHN/ CHAIN, NCHEVT, ICHEVT
      COMMON /PAWCHC/ CFILE
*
      COMMON/PAWIDN/IDNEVT,VIDN1,VIDN2,VIDN3,VIDN(10),
     +ID      ,IND     ,DEPTH   ,COINC   ,ASEG    ,BSEG    ,
     +APHA    ,ACHN    ,BPHA    ,BCHN    ,CPHA    ,CCHN    ,
     +DPHA    ,DCHN    ,EPHA    ,ECHN
*
      DIMENSION X(1),COEFF( 4),IBASFT( 1, 4)
      DATA COEFF/ 0.11838374D+01, 0.63187752D+00, 0.16133151D+00,
     + 0.48443597D-01
     +/
      DATA IBASFT/  0, 10, 20, 30
     +/

	hmimss=-10.
	adx=ade(xd)
	if(adx.le.0.)return
c	
	adl=log10(adx)
	x(1)=log10(adx/tote(xd))
c
      FPARAM=0.
      DO 25 K=1, 4
      P=1.
      DO 15 I=1, 1
      NUM=IBASFT(I,K)/10
      ITYP=IBASFT(I,K)-NUM*10
      IF (NUM.NE.0) THEN
      IF (ITYP.EQ.0) THEN
      P0=1.
      P1=X (I)
      DO 10 J=2,NUM
      P2=P1*X (I)
      P0=P1
   10 P1=P2
      P=P*P1
      END IF
      IF (ITYP.EQ.1) P=P*HELEFT(NUM,X (I))
      IF (ITYP.EQ.2) THEN
      P=HBASFT(NUM,X )
      GOTO 20
      END IF
      END IF
   15 CONTINUE
   20 FPARAM=FPARAM+COEFF(K)*P
   25 CONTINUE
	hmimss=adl-fparam
      RETURN
      END
