



      SUBROUTINE DGM000



























      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IERR, IAA, IFT1, IFT2
      LOGICAL       WIFROK, INTERRUPTED







      CALL WIFPUSHPPP (715,1)
      CALL WIFPUSHPPP (725,1)
      IF (NUMAAF.LT.5) THEN
         CALL GVSTTE ('?>5AA')
         GOTO 998
      END IF
      IF (WIFPAR(84).NE.0) CALL SHOWTEXT ('?M2397A')



      CALL WIF019 (5)



      CALL WIFGRN (IFT1,IFT2,' ')
      IF (IFT1.EQ.0) GOTO 998



      DO 10 IAA=IFT1,IFT2
         IF (INTERRUPTED()) GOTO 998



         IF (.NOT.WIFROK(IAA)) THEN
            CALL DIF008 ('?M0950',IAA)
            GOTO 10
         END IF
         CALL WIF432 (IAA,IERR)
         IF (IERR.NE.0) GOTO 10



         PRINT*,'DGM000:'
         CALL SHOIAA (IAA)
         CALL WIFPUSHPPP (592,0)
         CALL DGM001 (IAA)
         CALL WIFPOPPPP (592)
   10 CONTINUE



      CALL GVSFMT ('?FMT058')
      CALL GVSSTX (LINE,'?DGM-DGMUT')
      WRITE (LINE(40:80),FMT,ERR=999) IFT1,ONESA3(IFT1),NUMNAM(IFT1),
     + IFT2,ONESA3(IFT2),NUMNAM(IFT2)
      CALL SETHIS (LINE)
      GOTO 998



  999 CONTINUE
      CALL GVSTTB ('?DGMB01')



  998 CONTINUE
      CALL WIFPOPPPP (725)
      CALL WIFPOPPPP (715)


      RETURN
      END
      SUBROUTINE DGM001 (IAA)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAATYP, OLDTYP, IERR
      LOGICAL       WIFIRA, INTERRUPTED







      IF (.NOT.WIFIRA(IAA)) THEN
         CALL GVSTTE ('?RNGNAA')
         GOTO 998
      END IF



      CALL WIFPUSHRES (IAA,IERR)



      CALL DIF028 (6,IAA)
      OLDTYP=RESTYP(IAA)



      DO 10 IAATYP=1,20
         IF (INTERRUPTED()) GOTO 11
         CALL DGM002 (IAA,IAATYP,OLDTYP)
 10   CONTINUE
 11   CONTINUE



      CALL WIFPOPRES (IERR)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE DGM002 (IAA,IAATYP,OLDTYP)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAATYP, OLDTYP
      LOGICAL       GVFIBN







      IF (.NOT.GVFIBN(IAATYP,1,20)) THEN
         CALL GVSTTB ('?DGMB02')
         GOTO 998
      END IF



      CALL GVSBTF (LOCPAA,NUMUA)
      LOCPAA(IAATYP)=.TRUE.



      CALL WIFPUSHPPP (564,1)
      CALL DGM003 (IAA,LOCPAA)
      CALL WIFPOPPPP (564)
      IF (WIFPAR(54).LE.0) THEN
         CALL SHOWTEXT ('?M0855')
         GOTO 998
      END IF
      CALL WIF415



      CALL DGM004 (IAA,IAATYP,OLDTYP)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE DGM003 (IAA,BOOLS)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'DGLOOP.INC'
      INCLUDE       'GRPINC.INC'
      INTEGER       IAA, GVFCBT, IR, IWF54
      LOGICAL       GVFIBN, BOOLS(NUMUA)







      WIFPAR(54)=0
      IF (.NOT.GVFIBN(GVFCBT(BOOLS,20),1,20)) THEN
         CALL GVSTTB ('?DGMB03')
         GOTO 998
      END IF





      WIFPAR(524)=1
      CALL WIF019 (5)
      CALL GVSRTC (DGWVAL,1.0,WIFPAR(51))



      IF (GVFIBN(IAA,WIFPAR(51)/2+1,NUMAAF-WIFPAR(51)/2)) THEN
         CALL WIF425 (IAA,BOOLS)
      END IF



      IWF54=WIFPAR(54)
      IF (WIFPAR(54).LE.20.AND.WIFPAR(279).LE.0.AND.
     +    WIFPAR(196).EQ.0) THEN
         IF (SETROT(RESTYP(IAA)).GE.1) THEN
            DO 10 IR=1,SETROT(RESTYP(IAA))
               WIFPAR(54)=WIFPAR(54)+1
               GRPNTR(1,WIFPAR(54))=0
               GRPNTR(2,WIFPAR(54))=10000+IR
               QFACTS(WIFPAR(54))=0.5
 10         CONTINUE
         END IF
      END IF



  998 CONTINUE


      RETURN
      END
      SUBROUTINE DGM004 (IAA,IAATYP,OLDTYP)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'DGLOOP.INC'
      INCLUDE       'HSTINC.INC'
      INTEGER       ITAG(MAXDG), IHIT, I, IAA, IAATYP, OLDTYP, ILOOP







      IF (.NOT.HSTDON) CALL DSP001 (.TRUE.)



      CALL WIFPUSHPPP (384,1)
      CALL GVSRTC (SCORES, -99.9,MAXDG)
      CALL GVSRTC (QUASCO, -99.9,MAXDG)
      CALL GVSRTC (BUMPVAL,-99.9,MAXDG)
      CALL GVSRTC (TSC,    -99.9,MAXDG)
      CALL GVSRTC (QFLOC,  -99.9,MAXDG)
      CALL WIF080



      CALL WIF330 (IAA,IAATYP)



      DO 10 IHIT=1,WIFPAR(54)
         CALL DGM102 (IAA,IHIT)
   10 CONTINUE



      CALL DGM005 (IAA)



      CALL DGM007 (IAA)



      IF (WIFPAR(825).EQ.0.OR.WIFPAR(930).EQ.0) CALL NQA041

         CALL DGM006 (IAA,QUASCO,WIFPAR(54))




      DO 20 IHIT=1,WIFPAR(54)
         QFLOC(IHIT)=QFCSTR(IHIT,1)
   20 CONTINUE



      CALL GVSITI (ITAG,MAXDG)
      DO 40 I=1,WIFPAR(54)
         TSC(I)=SCORES(I)-BUMPVAL(I)+QUASCO(I)
   40 CONTINUE
      CALL GVSDRT (TSC,WIFPAR(54),ITAG)
      DO 41 I=1,WIFPAR(54)
         TSC(I)=SCORES(I)-BUMPVAL(I)+QUASCO(I)
   41 CONTINUE



      CALL GVSNL6 (2)
      CALL GVSFMT ('?FMT020')
      CALL GVSSTX (LINE,'?DGMTTY')
      WRITE (LINE(60:80),FMT,ERR=999) ONESA3(IAA)
      CALL GVSRDB (LINE)
      CALL GVSTT6 (LINE)
      CALL GVSSTX (LINE,'?DGMHED')
      CALL GVSTT6 (LINE)



      DO 50 ILOOP=1,MIN(10,WIFPAR(54))
         I=ITAG(ILOOP)
         CALL GVSFMT ('?FMT054')
         CALL GVSCTB (LINE,80)
         WRITE (LINE,FMT,ERR=999) I,TSC(I),QFLOC(I),SCORES(I),
     +    QUASCO(I),BUMPVAL(I)
         CALL GVSTT6 (LINE)
   50 CONTINUE



      IF (TSC(ITAG(10)).GT.2.5) THEN
         CALL GVSTT6 ('?M0917')
         IF (ATPRAA(IAATYP).GT.ATPRAA(OLDTYP)) CALL GVSTT6 ('?M0911')
         IF (IAATYP.EQ.16) CALL GVSTT6 ('?M0912')
      ELSE IF (TSC(ITAG(10)).GT.1.0) THEN
         CALL GVSTT6 ('?M0913')
      ELSE IF (TSC(ITAG(5)).GT.2.5) THEN
         CALL GVSTT6 ('?M0914')
         GOTO 998
      ELSE
         CALL GVSTT6 ('?M0915')
         IF (IAATYP.EQ.OLDTYP) CALL GVSTT6 ('?M0916')
         GOTO 998
      END IF
      IF (ATPRAA(IAATYP).LT.ATPRAA(OLDTYP)) CALL GVSTT6 ('?M0918')
      IF (IAATYP.EQ.13) CALL GVSTT6 ('?M0919')
      IF (IAATYP.EQ.OLDTYP) CALL GVSTT6 ('?M0920')
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('DGM004')



  998 CONTINUE
      CALL WIFPOPPPP (384)


      RETURN
      END
      SUBROUTINE DGM004A (IAA,IAATYP,QFINAL)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'DGLOOP.INC'
      INCLUDE       'GRPINC.INC'
      INCLUDE       'HSTINC.INC'
      INCLUDE       'MAPINC.INC'
      INCLUDE       'DATBAS.INC'
      INTEGER       ITAG(MAXDG), ILOOP, IAA, IAATYP, IHIT, I, IERR
      REAL          QFINAL
      LOGICAL       BOOLS(NUMUA), GVFIBN, INTERRUPTED, WIFIRR







      IERR=0
      QFINAL=-99.9
      CALL WIFPUSHRES (IAA,IERR)
      CALL WIFPUSHPPP (384,1)
      IF (WIFPAR(1428).EQ.0) THEN
         CALL WIFPUSHPPP (55,40)
      ELSE
         CALL WIFPUSHPPP (55,WIFPAR(1428))
      END IF
      IF (.NOT.HSTDON) CALL DSP001 (.TRUE.)
      IF (.NOT.WIFIRR(IAA)) THEN
         CALL GVSTTI ('?DGMB07',IAA)
         GOTO 998
      END IF
      IF (.NOT.GVFIBN(IAATYP,1,20)) THEN
         CALL GVSTTI ('?DGMB06',IAATYP)
         CALL GVSKIL
         GOTO 998
      END IF



      CALL GVSRTC (SCORES, -99.9,MAXDG)
      CALL GVSRTC (QUASCO, -99.9,MAXDG)
      CALL GVSRTC (HBOVAL,   0.0,MAXDG)
      CALL GVSRTC (BUMPVAL,-99.9,MAXDG)
      CALL GVSRTC (TSC,    -99.9,MAXDG)
      CALL GVSRTC (QFLOC,  -99.9,MAXDG)
      CALL CHI012 (IAA)
      CALL WIF080



      CALL GVSBTF (BOOLS,NUMUA)
      BOOLS(IAATYP)=.TRUE.
      CALL WIFPUSHPPP (564,1)
      CALL DGM003 (IAA,BOOLS)
      CALL WIFPOPPPP (564)
      IF (WIFPAR(54).LT.1) THEN
         IF (WIFPAR(609).EQ.0.AND.WIFPAR(493).EQ.0) THEN
            CALL GVSTT6 ('?DGMLHT')
            CALL SHOIAA (IAA)
         END IF
         GOTO 998
      END IF
      WIFPAR(54)=MIN(MAXDG,WIFPAR(54))



      IF (WIFPAR(609).EQ.0.AND.WIFPAR(493).EQ.0) THEN
         CALL GVSFMT ('?FMT055')
         CALL GVSSTX (LINE,'?DGMTRY')
         WRITE (LINE,FMT,ERR=999) IAA,NUMNAM(IAA),AANAME(IAATYP)
         CALL GVSRDB (LINE)
         CALL GVSBOX (LINE)
      END IF



      IF (RESTYP(IAA).NE.IAATYP) CALL WIF330 (IAA,IAATYP)
      NOBOND(IAA)=.TRUE.



      DO 10 IHIT=1,WIFPAR(54)
         CALL WIFPUSHPPP (384,1)
         CALL DGM102 (IAA,IHIT)
         CALL WIFPOPPPP (384)
   10 CONTINUE
      CALL DGM005 (IAA)



      IF (FLOAT(WIFPAR(383))/100.0.GT.0.001) THEN
         CALL DGM007 (IAA)
      ELSE
         CALL GVSRT0 (BUMPVAL,WIFPAR(54))
      END IF
      IF (INTERRUPTED()) GOTO 998



      IF (WIFPAR(825).EQ.0.OR.WIFPAR(930).EQ.0) CALL NQA041

         IF (FLOAT(WIFPAR(382))/100.0.GT.0.001) THEN
            CALL DGM006 (IAA,QUASCO,WIFPAR(54))
         ELSE
            CALL GVSRT0 (QUASCO,WIFPAR(54))
         END IF





      CALL HBO010
      IF (FLOAT(WIFPAR(388))/100.0.GT.0.001) THEN
         CALL DGM008 (IAA,HBOVAL,BUMPVAL,WIFPAR(54))
      ELSE
         CALL GVSRT0 (HBOVAL,WIFPAR(54))
      END IF



      DO 30 ILOOP=1,WIFPAR(54)
         IHIT=ILOOP
         QFLOC(ILOOP)=QFCSTR(IHIT,1)
   30 CONTINUE




      CALL GVSVXC (SCORES, FLOAT(WIFPAR(381))/100.0,WIFPAR(54))
      CALL GVSVXC (BUMPVAL,FLOAT(-WIFPAR(383))/100.0,WIFPAR(54))
      CALL GVSVXC (QUASCO, FLOAT(WIFPAR(382))/100.0,WIFPAR(54))
      CALL GVSVXC (QFLOC,  FLOAT(-WIFPAR(380))/100.0,WIFPAR(54))
      CALL GVSVXC (HBOVAL, FLOAT(WIFPAR(388))/100.0,WIFPAR(54))
      IF (WIFPAR(1907).NE.0) THEN
         CALL GVSVXC (SCORES, FLOAT(WIFPAR(1902))/100.0,WIFPAR(54))
         CALL GVSVXC (BUMPVAL,FLOAT(WIFPAR(1904))/100.0,WIFPAR(54))
         CALL GVSVXC (QUASCO, FLOAT(WIFPAR(1903))/100.0,WIFPAR(54))
         CALL GVSVXC (QFLOC,  FLOAT(WIFPAR(1901))/100.0,WIFPAR(54))
         CALL GVSVXC (HBOVAL, FLOAT(WIFPAR(1905))/100.0,WIFPAR(54))
      END IF
      CALL GVSITI (ITAG,MAXDG)
      DO 50 I=1,WIFPAR(54)
         IF (WIFPAR(1213).LE.0) THEN
            TSC(I)=SCORES(I)+QUASCO(I)+BUMPVAL(I)+QFLOC(I)+HBOVAL(I)
         ELSE
            TSC(I)=SCORES(I)+QUASCO(I)+QFLOC(I)+HBOVAL(I)+0.1*BUMPVAL(I)
         END IF
   50 CONTINUE
      CALL GVSDRT (TSC,WIFPAR(54),ITAG)
      IF (WIFPAR(609).EQ.0.AND.WIFPAR(493).EQ.0) THEN



         CALL GVSTT6 ('?DGMHD2')
         CALL GVSFMT ('?FMT057')
         CALL GVSCTB (LINE,80)
         WRITE (LINE,FMT,ERR=999)
     +    FLOAT(WIFPAR(380))/100.0,
     +    FLOAT(WIFPAR(381))/100.0,
     +    FLOAT(WIFPAR(382))/100.0,
     +    FLOAT(WIFPAR(383))/100.0,
     +    FLOAT(WIFPAR(388))/100.0
         CALL GVSTT6 (LINE)



         DO 60 ILOOP=1,MIN(10,WIFPAR(54))
            IHIT=ILOOP
            I=ITAG(ILOOP)
            IF (.NOT.GVFIBN(I,1,MAXDG)) GOTO 60
            IF (.NOT.GVFIBN(ILOOP,1,MAXDG)) GOTO 60
            CALL GVSFMT ('?FMT830')
            WRITE (BIGLIN,FMT,ERR=999) TSC(ILOOP),QFLOC(I),SCORES(I),
     +       QUASCO(I),BUMPVAL(I),HBOVAL(I)
            CALL GVSTT6 (BIGLIN)
   60    CONTINUE
      END IF
      MUTSCO(1)=QFLOC(ITAG(1))
      MUTSCO(2)=SCORES(ITAG(1))
      MUTSCO(3)=QUASCO(ITAG(1))
      MUTSCO(4)=BUMPVAL(ITAG(1))
      MUTSCO(5)=HBOVAL(ITAG(1))



      QFINAL=TSC(1)
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('DGM004A')



  998 CONTINUE
      CALL WIFPOPPPP (55)
      CALL WIFPOPPPP (384)
      CALL WIFPOPRES (IERR)



      RETURN
      END
      SUBROUTINE DGM004C (IAA,IAATYP,QFINAL)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'GRPINC.INC'
      INCLUDE       'DATBAS.INC'
      INTEGER       IAA, IHIT, IAATYP, ISEQ, IAAS, IM60, IERR, 
     +              IP60, I180, P, PTOT
      REAL          QFINAL, ANGLE, FACTOR
      LOGICAL       WIFIRR, GVFRIN







      IF (.NOT.WIFIRR(IAA)) THEN
         CALL GVSTTB ('?NEWB10')
         GOTO 998
      END IF
      IF (IAATYP.GT.20) THEN
         CALL GVSTTB ('?R00009')
         GOTO 998
      END IF
      CALL DSP001 (.FALSE.)



      WIFPAR(54)=0
      WIFPAR(524)=1
      QFINAL=0.0
      IM60=0
      IP60=0
      I180=0



      CALL GVSBTF (LOCPAA,NUMUA)
      LOCPAA(IAATYP)=.TRUE.
      CALL WIFPUSHPPP (564,1)
      CALL DGM003 (IAA,LOCPAA)
      CALL WIFPOPPPP (564)
      IF (WIFPAR(54).LT.3) GOTO 998



      DO 10 IHIT=1,WIFPAR(54)
         ISEQ=GRPNTR(1,IHIT)
         IAAS=GRPNTR(2,IHIT)
         IF (IAAS.LE.10000) THEN
            CALL REC006 (ANGLE,INDPNT(ISEQ)+IAAS+WIFPAR(51)/2,IERR)
            IF (IERR.NE.0) GOTO 10
            IF (GVFRIN(ANGLE,5.0,115.0)) IP60=IP60+1
            IF (GVFRIN(ANGLE,-5.0,-115.0)) IM60=IM60+1
            IF (.NOT.GVFRIN(ANGLE,-125.0,125.0)) I180=I180+1
         END IF
   10 CONTINUE



      IF (IAATYP.EQ.1.OR.IAATYP.EQ.6.OR.IAATYP.EQ.13) THEN
         QFINAL=1.0
      ELSE
         P=MAX(MAX(MAX(IM60,IP60),I180),1)
         PTOT=MAX(IM60+IP60+I180,1)
         IF (ABS(FLOAT(WIFPAR(54))).LT.0.00001.OR.
     +       ABS(FLOAT(PTOT)).LT.0.00001) THEN
            QFINAL=0.0
            GOTO 998
         END IF
         FACTOR=FLOAT(WIFPAR(54))/FLOAT(WIFPAR(55))
         QFINAL=(FLOAT(P)/FLOAT(PTOT))*FACTOR
      END IF



  998 CONTINUE


      RETURN
      END

      SUBROUTINE DGM005 (IAA)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'DGLOOP.INC'
      INTEGER       IAA, IHIT
      REAL          AVE, ADEV, SDEV, VAR, SKEW, CURT







      IF (WIFPAR(54).LE.5) THEN
         CALL GVSRT0 (SCORES,MAXDG)
         GOTO 998
      END IF



      DO 10 IHIT=1,WIFPAR(54)
         CALL DGM103 (IAA,IHIT,SCORES(IHIT))
   10 CONTINUE



      CALL GVSRAV (SCORES,WIFPAR(54),AVE,ADEV,SDEV,VAR,SKEW,CURT)
      DO 20 IHIT=1,WIFPAR(54)
         IF (SDEV.GE.0.1) THEN
            SCORES(IHIT)=0.5*(SCORES(IHIT)-AVE)/SDEV
         ELSE
            SCORES(IHIT)=0.0
         END IF
   20 CONTINUE



 998  CONTINUE


      RETURN
      END
      SUBROUTINE DGM006 (IAA,QUASCO,NUM)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IHIT, NUM
      REAL          QUASCO(NUM)







      CALL GVSRT0 (QUASCO,NUM)



      DO 10 IHIT=1,WIFPAR(54)
         CALL DGM104 (IAA,IHIT,QUASCO(IHIT))
   10 CONTINUE





      RETURN
      END
      SUBROUTINE DGM007 (IAA)

















      IMPLICIT      NONE

         INTEGER    IAA


      RETURN
      END
      SUBROUTINE DGM008 (IAA,HBOVAL,BUMPVAL,NUM)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IHIT, IERR, NUM
      REAL          HBOVAL(NUM), BUMPVAL(NUM)







      IERR=0
      CALL GVSRT0 (HBOVAL,NUM)



      DO 10 IHIT=1,WIFPAR(54)
         IF (BUMPVAL(IHIT).GT.2.5) THEN
            HBOVAL(IHIT)=0.0
         ELSE



            CALL WIF424B (1,IHIT,IAA,IERR)






         END IF
   10 CONTINUE





      RETURN
      END
      SUBROUTINE DGM009 (IAA,SCORE)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA
      REAL          SCORE







      IF (RESTYP(IAA).EQ.1.OR.RESTYP(IAA).EQ.6.OR.RESTYP(IAA).EQ.13)THEN
         SCORE=0.0
         GOTO 998
      END IF



      SCORE=0.0



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE DGM102 (IAA,IHIT)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'DGMUT.INC'
      INCLUDE       'MAPINC.INC'
      REAL          XM, YM, ZM, RAD2, REX2, XG, YG, ZG, XMDX2
      REAL          YMDY2, ZMDZ2, FU
      INTEGER       IERR, IX, IY, IZ, IAA, IHIT, IAT
      LOGICAL       MPP023







      IERR=0
      IF (HATPRA(RESTYP(IAA)).LE.4) GOTO 998



      CALL WIF424B (1,-IHIT,IAA,IERR)
      IF (IERR.NE.0) PRINT*,'IERR FROM 424B IN 102=',IERR



      IF (IHIT.EQ.1) THEN
         CALL DGM110 (IAA,IERR)      
         IF (IERR.NE.0) GOTO 998



         DO 50 IZ=1,NW(MAPNOW)+2
            DO 40 IY=1,NV(MAPNOW)+2
               DO 30 IX=1,NU(MAPNOW)+2
                  GRID(IX,IY,IZ)=0
   30          CONTINUE
   40       CONTINUE
   50    CONTINUE
      END IF



      DO 60 IAT=PNTAAS(IAA)+4,PNTAAE(IAA)
         IF (.NOT.ISATOK(IAT).OR.PROTON(IAT)) GOTO 60
         XM=XCOORD(IAT)
         YM=YCOORD(IAT)
         ZM=ZCOORD(IAT)
         RAD2=(VDWRAD(IAT)-0.5)**2
         REX2=(VDWRAD(IAT)+PRBRAD-0.5)**2
         IX=NINT((XM-XMIN)/DX)
         IY=NINT((YM-YMIN)/DY)
         IZ=NINT((ZM-ZMIN)/DZ)
         XG=XMIN+IX*DX
         YG=YMIN+IY*DY
         ZG=ZMIN+IZ*DZ
         XMDX2=2*XM*DX
         YMDY2=2*YM*DY
         ZMDZ2=2*ZM*DZ



         IF (.NOT.MPP023(IX+1,IY+1,IZ+1)) GOTO 60



         FU=(XM-XG)**2+(YM-YG)**2+(ZM-ZG)**2
         IF (FU.LE.RAD2) THEN
            GRID(IX+1,IY+1,IZ+1)=GRID(IX+1,IY+1,IZ+1)+10
         ELSE
            GRID(IX+1,IY+1,IZ+1)=GRID(IX+1,IY+1,IZ+1)+
     +       NINT(10*(REX2-FU)/(REX2-RAD2))
         END IF




         CALL DGM171 (FU,XG,IX,IY,IZ,XMDX2,DX,DX2,REX2,RAD2)
         CALL DGM172 (FU,XG,IX,IY,IZ,XMDX2,DX,DX2,REX2,RAD2)
         CALL DGM173 (FU,XG,YG,IX,IY,IZ,XMDX2,YMDY2,DX,DY,
     +    DX2,DY2,REX2,RAD2)
         CALL DGM174 (FU,XG,YG,IX,IY,IZ,XMDX2,YMDY2,DX,DY,
     +    DX2,DY2,REX2,RAD2)
         CALL DGM175 (FU,XG,YG,ZG,IX,IY,IZ,XMDX2,YMDY2,ZMDZ2,
     +    DX,DY,DZ,DX2,DY2,DZ2,REX2,RAD2)
         CALL DGM176 (FU,XG,YG,ZG,IX,IY,IZ,XMDX2,YMDY2,ZMDZ2,
     +    DX,DY,DZ,DX2,DY2,DZ2,REX2,RAD2)
   60 CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE DGM103 (IAA,IHIT,SCORE)


















      IMPLICIT      NONE
      INTEGER       IAA, IHIT, IERR
      REAL          SCORE







      IERR=0
      SCORE=0.0



      CALL WIF424B (1,IHIT,IAA,IERR)



      CALL DGM103A (IAA,SCORE) 





      RETURN
      END
      SUBROUTINE DGM103A (IAA,SCORE)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'   
      INCLUDE       'DGMUT.INC'
      INCLUDE       'MAPINC.INC'
      INTEGER       IAA, IAT, IX, IY, IZ
      REAL          SCORE, FU, XG, YG, ZG, XMDX2, YMDY2, ZMDZ2,
     +              REX2, XM, YM, ZM
      LOGICAL       MPP023







      SCORE=0.0
      IF (HATPRA(RESTYP(IAA)).LE.4) GOTO 998



      DO 60 IAT=PNTAAS(IAA)+4,PNTAAE(IAA)
         IF (.NOT.ISATOK(IAT).OR.PROTON(IAT)) GOTO 60
         XM=XCOORD(IAT)
         YM=YCOORD(IAT)
         ZM=ZCOORD(IAT)
         REX2=(VDWRAD(IAT)+PRBRAD-0.5)**2         
         IX=NINT((XM-XMIN)/DX)
         IY=NINT((YM-YMIN)/DY)
         IZ=NINT((ZM-ZMIN)/DZ)
         XG=XMIN+IX*DX
         YG=YMIN+IY*DY
         ZG=ZMIN+IZ*DZ
         XMDX2=2*XM*DX
         YMDY2=2*YM*DY
         ZMDZ2=2*ZM*DZ



         IF (.NOT.MPP023(IX+1,IY+1,IZ+1)) GOTO 60



         FU=(XM-XG)**2+(YM-YG)**2+(ZM-ZG)**2
         SCORE=SCORE+GRID(IX+1,IY+1,IZ+1)




         CALL DGM271 (SCORE,FU,XG,IX,IY,IZ,XMDX2,DX,DX2,REX2)
         CALL DGM272 (SCORE,FU,XG,IX,IY,IZ,XMDX2,DX,DX2,REX2)
         CALL DGM273 (SCORE,FU,XG,YG,IX,IY,IZ,XMDX2,YMDY2,DX,DY,
     +    DX2,DY2,REX2)
         CALL DGM274 (SCORE,FU,XG,YG,IX,IY,IZ,XMDX2,YMDY2,DX,DY,
     +    DX2,DY2,REX2)
         CALL DGM275 (SCORE,FU,XG,YG,ZG,IX,IY,IZ,XMDX2,YMDY2,ZMDZ2,
     +    DX,DY,DZ,DX2,DY2,DZ2,REX2)
         CALL DGM276 (SCORE,FU,XG,YG,ZG,IX,IY,IZ,XMDX2,YMDY2,ZMDZ2,
     +    DX,DY,DZ,DX2,DY2,DZ2,REX2)
   60 CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE DGM104 (IAA,IHIT,SCORE)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IHIT, IERR
      REAL          SCORE







      IERR=0
      SCORE=0.0
      WIFPAR(285)=0



      CALL WIF424B (1,IHIT,IAA,IERR)
      IF (IERR.EQ.1) THEN
         SCORE=-2.5
         GOTO 998
      END IF



      ACCDON(IAA)=.FALSE.
      SUMACC(IAA)=0.0
      CALL ENVNOWAT
      CALL WIF041 (IAA)




         CALL QUA028A (IAA,SCORE)






  998 CONTINUE


      RETURN
      END
      SUBROUTINE DGM106 (IAA,IHIT,SCORE)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IHIT, IERR
      REAL          SCORE


      RETURN
      END
      SUBROUTINE DGM110 (IAA,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'DGMUT.INC'
      INCLUDE       'MAPINC.INC'
      INTEGER       IAA, IERR, IAT
      REAL          XMAX, YMAX, ZMAX, FACTOR







      IF (NUMAAT.LT.1) THEN
         CALL GVSTTE ('?NEWE14')
         IERR=1
         GOTO 998
      END IF



      IF (MAPNUM.EQ.0) MAPNUM=1
      MAPNOW=1
      IERR=0
      PROD(MAPNOW)=1.0
      IPLUS(MAPNOW)=0
      PRBRAD=0.25
      FACTOR=0.5
    5 CONTINUE



      MAPNAM(MAPNOW)='DGMUT'
      MAPTXT(MAPNOW)='DGMUT MAP'






      XMIN=XCOORD(PNTAAC(IAA))
      YMIN=YCOORD(PNTAAC(IAA))
      ZMIN=ZCOORD(PNTAAC(IAA))
      XMAX=XCOORD(PNTAAC(IAA))
      YMAX=YCOORD(PNTAAC(IAA))
      ZMAX=ZCOORD(PNTAAC(IAA))
      DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
         XMIN=MIN(XMIN,XCOORD(IAT))
         YMIN=MIN(YMIN,YCOORD(IAT))
         ZMIN=MIN(ZMIN,ZCOORD(IAT))
         XMAX=MAX(XMAX,XCOORD(IAT))
         YMAX=MAX(YMAX,YCOORD(IAT))
         ZMAX=MAX(ZMAX,ZCOORD(IAT))
   10 CONTINUE
      XMIN=XMIN-10.0
      YMIN=YMIN-10.0
      ZMIN=ZMIN-10.0
      XMAX=XMAX+10.0
      YMAX=YMAX+10.0
      ZMAX=ZMAX+10.0



      ACELLM(MAPNOW)=XMAX-XMIN
      BCELLM(MAPNOW)=YMAX-YMIN
      CCELLM(MAPNOW)=ZMAX-ZMIN



      RESOLU=MAX(FACTOR,ACELLM(MAPNOW)/FLOAT(MAXGRD-10))
      RESOLU=MAX(RESOLU,BCELLM(MAPNOW)/FLOAT(MAXGRD-10))
      RESOLU=MAX(RESOLU,CCELLM(MAPNOW)/FLOAT(MAXGRD-10))



      ALPHAM(MAPNOW)=90.0
      BETAM(MAPNOW)=90.0
      GAMMAM(MAPNOW)=90.0



      NDIVA(MAPNOW)=NINT(ACELLM(MAPNOW)/RESOLU)+2
      NDIVB(MAPNOW)=NINT(BCELLM(MAPNOW)/RESOLU)+2
      NDIVC(MAPNOW)=NINT(CCELLM(MAPNOW)/RESOLU)+2



      NU(MAPNOW)=NDIVA(MAPNOW)
      NV(MAPNOW)=NDIVB(MAPNOW)
      NW(MAPNOW)=NDIVC(MAPNOW)
      IF (NU(MAPNOW).GT.MAXGRD.OR.NV(MAPNOW).GT.MAXGRD.OR.
     +    NW(MAPNOW).GT.MAXGRD) THEN
         FACTOR=FACTOR+0.1
         GOTO 5
      END IF



      STEPU(MAPNOW)=ACELLM(MAPNOW)/NDIVA(MAPNOW)
      STEPV(MAPNOW)=BCELLM(MAPNOW)/NDIVB(MAPNOW)
      STEPW(MAPNOW)=CCELLM(MAPNOW)/NDIVC(MAPNOW)



      UVWORG(1,MAPNOW)=XMIN/ACELLM(MAPNOW)
      UVWORG(2,MAPNOW)=YMIN/BCELLM(MAPNOW)
      UVWORG(3,MAPNOW)=ZMIN/CCELLM(MAPNOW)
      UVWMAT(1,1,MAPNOW)=STEPU(MAPNOW)/ACELLM(MAPNOW)
      UVWMAT(1,2,MAPNOW)=0.0
      UVWMAT(1,3,MAPNOW)=0.0
      UVWMAT(2,1,MAPNOW)=0.0
      UVWMAT(2,2,MAPNOW)=STEPV(MAPNOW)/BCELLM(MAPNOW)
      UVWMAT(2,3,MAPNOW)=0.0
      UVWMAT(3,1,MAPNOW)=0.0
      UVWMAT(3,2,MAPNOW)=0.0
      UVWMAT(3,3,MAPNOW)=STEPW(MAPNOW)/CCELLM(MAPNOW)




      DX2=STEPU(MAPNOW)**2
      DY2=STEPV(MAPNOW)**2
      DZ2=STEPW(MAPNOW)**2
      DX=STEPU(MAPNOW)
      DY=STEPV(MAPNOW)
      DZ=STEPW(MAPNOW)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE DGM111 (IX,IY,IZ,F,REX2,RAD2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'MAPINC.INC'
      INTEGER       IX, IY, IZ
      REAL          F, REX2, RAD2







      IF (IX+1.LT.1.OR.IY+1.LT.1.OR.IZ+1.LT.1.OR.IX+1.GT.
     +    NU(MAPNOW).OR.IY+1.GT.NV(MAPNOW).OR.IZ+1.GT.NW(MAPNOW)) THEN
         GOTO 998
      END IF



      IF (F.LE.RAD2) THEN
         GRID(IX+1,IY+1,IZ+1)=GRID(IX+1,IY+1,IZ+1)+10
      ELSE
         GRID(IX+1,IY+1,IZ+1)=GRID(IX+1,IY+1,IZ+1)+
     +    NINT(10*(REX2-F)/(REX2-RAD2))
      END IF



  998 CONTINUE


      RETURN
      END   
      REAL FUNCTION DGM112(IX,IY,IZ)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'MAPINC.INC'
      INTEGER       IX, IY, IZ







      DGM112=0.0
      IF (IX+1.LT.1.OR.IY+1.LT.1.OR.IZ+1.LT.1.OR.IX+1.GT.NU(MAPNOW).OR.
     +    IY+1.GT.NV(MAPNOW).OR.IZ+1.GT.NW(MAPNOW)) THEN
         GOTO 998
      END IF



      DGM112=GRID(IX+1,IY+1,IZ+1)



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE DGM171 (FU,XG,IX,IY,IZ,XMDX2,DX,DX2,REX2,RAD2)



















      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, IIX
      REAL          FU, XG, XMDX2, DX, DX2, REX2, RAD2, FFX, XR





      FFX=FU-XMDX2+DX2+2*DX*XG
      XR=XG+DX
      IIX=IX+1
   10 CONTINUE
      IF (FFX.LT.REX2) THEN



         CALL DGM111 (IIX+1,IY+1,IZ+1,FFX,REX2,RAD2)
         FFX=FFX-XMDX2+DX2+2*DX*XR
         XR=XR+DX
         IIX=IIX+1
         GOTO 10
      END IF





      RETURN
      END
      SUBROUTINE DGM172 (FU,XG,IX,IY,IZ,XMDX2,DX,DX2,REX2,RAD2)



















      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, IIX
      REAL          FU, XG, XMDX2, DX, DX2, REX2, RAD2, FFX, XR





      FFX=FU+XMDX2+DX2-2*DX*XG
      XR=XG-DX
      IIX=IX-1
   10 CONTINUE
      IF (FFX.LT.REX2) THEN
         CALL DGM111 (IIX+1,IY+1,IZ+1,FFX,REX2,RAD2)
         FFX=FFX+XMDX2+DX2-2*DX*XR
         XR=XR-DX
         IIX=IIX-1
         GOTO 10
      END IF





      RETURN
      END
      SUBROUTINE DGM173 (FU,XG,YG,IX,IY,IZ,XMDX2,YMDY2,
     +    DX,DY,DX2,DY2,REX2,RAD2)



















      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, IIX, I
      REAL          FU, XG, YG, XMDX2, YMDY2, 
     +              DX, DY, DX2, DY2, REX2, RAD2, 
     +              FFX, XR, F, YR





      F=FU-YMDY2+DY2+2*DY*YG
      YR=YG+DY
      I=IY+1
   10 CONTINUE
      IF (F.LT.REX2) THEN
         CALL DGM111 (IX+1,I+1,IZ+1,F,REX2,RAD2)






         FFX=F-XMDX2+DX2+2*DX*XG
         XR=XG+DX
         IIX=IX+1
   20    CONTINUE
         IF (FFX.LT.REX2) THEN
            CALL DGM111 (IIX+1,I+1,IZ+1,FFX,REX2,RAD2)
            FFX=FFX-XMDX2+DX2+2*DX*XR
            XR=XR+DX
            IIX=IIX+1
            GOTO 20
         END IF






         FFX=F+XMDX2+DX2-2*DX*XG
         XR=XG-DX
         IIX=IX-1
   30    CONTINUE
         IF (FFX.LT.REX2) THEN
            CALL DGM111 (IIX+1,I+1,IZ+1,FFX,REX2,RAD2)
            FFX=FFX+XMDX2+DX2-2*DX*XR
            XR=XR-DX
            IIX=IIX-1
            GOTO 30
         END IF
         F=F-YMDY2+DY2+2*DY*YR
         YR=YR+DY
         I=I+1
         GOTO 10
      END IF





      RETURN
      END
      SUBROUTINE DGM174 (FU,XG,YG,IX,IY,IZ,XMDX2,YMDY2,
     +    DX,DY,DX2,DY2,REX2,RAD2)



















      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, IIX, I
      REAL          FU, XG, YG, XMDX2, YMDY2, DX, DY, DX2, 
     +              DY2, REX2, RAD2, FFX, XR, F, YR





      F=FU+YMDY2+DY2-2*DY*YG
      YR=YG-DY
      I=IY-1
   10 CONTINUE
      IF (F.LT.REX2) THEN
         CALL DGM111 (IX+1,I+1,IZ+1,F,REX2,RAD2)






         FFX=F-XMDX2+DX2+2*DX*XG
         XR=XG+DX
         IIX=IX+1
   20    CONTINUE
         IF (FFX.LT.REX2) THEN
            CALL DGM111 (IIX+1,I+1,IZ+1,FFX,REX2,RAD2)
            FFX=FFX-XMDX2+DX2+2*DX*XR
            XR=XR+DX
            IIX=IIX+1
            GOTO 20
         END IF






         FFX=F+XMDX2+DX2-2*DX*XG
         XR=XG-DX
         IIX=IX-1
   30    CONTINUE
         IF (FFX.LT.REX2) THEN
            CALL DGM111 (IIX+1,I+1,IZ+1,FFX,REX2,RAD2)
            FFX=FFX+XMDX2+DX2-2*DX*XR
            XR=XR-DX
            IIX=IIX-1
            GOTO 30
         END IF
         F=F+YMDY2+DY2-2*DY*YR
         YR=YR-DY
         I=I-1
         GOTO 10
      END IF





      RETURN
      END
      SUBROUTINE DGM175 (FU,XG,YG,ZG,IX,IY,IZ,XMDX2,YMDY2,ZMDZ2,
     +    DX,DY,DZ,DX2,DY2,DZ2,REX2,RAD2)



















      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, I
      REAL          FU, XG, YG, ZG, XMDX2, YMDY2, ZMDZ2,
     +              DX, DY, DZ, DX2, DY2, DZ2, REX2, RAD2, 
     +              ZR, F
      SAVE          F,ZR,I





      F=FU-ZMDZ2+DZ2+2*DZ*ZG
      ZR=ZG+DZ
      I=IZ+1
   10 CONTINUE
      IF (F.LT.REX2) THEN
         CALL DGM111 (IX+1,IY+1,I+1,F,REX2,RAD2)




         CALL DGM171 (F,XG,IX,IY,I,XMDX2,DX,DX2,REX2,RAD2)
         CALL DGM172 (F,XG,IX,IY,I,XMDX2,DX,DX2,REX2,RAD2)
         CALL DGM173 (F,XG,YG,IX,IY,I,XMDX2,YMDY2,DX,DY,DX2,DY2,
     +    REX2,RAD2)
         CALL DGM174 (F,XG,YG,IX,IY,I,XMDX2,YMDY2,DX,DY,DX2,DY2,
     +    REX2,RAD2)
         F=F-ZMDZ2+DZ2+2*DZ*ZR
         ZR=ZR+DZ
         I=I+1
         GOTO 10
      END IF





      RETURN
      END
      SUBROUTINE DGM176 (FU,XG,YG,ZG,IX,IY,IZ,XMDX2,YMDY2,ZMDZ2,
     +    DX,DY,DZ,DX2,DY2,DZ2,REX2,RAD2)



















      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, I
      REAL          FU, XG, YG, ZG, XMDX2, YMDY2, ZMDZ2,
     +              DX, DY, DZ, DX2, DY2, DZ2, REX2, RAD2, 
     +              ZR, F
      SAVE          F, ZR, I





      F=FU+ZMDZ2+DZ2-2*DZ*ZG
      ZR=ZG-DZ
      I=IZ-1
   10 CONTINUE
      IF (F.LT.REX2) THEN
         CALL DGM111 (IX+1,IY+1,I+1,F,REX2,RAD2)




         CALL DGM171 (F,XG,IX,IY,I,XMDX2,DX,DX2,REX2,RAD2)
         CALL DGM172 (F,XG,IX,IY,I,XMDX2,DX,DX2,REX2,RAD2)
         CALL DGM173 (F,XG,YG,IX,IY,I,XMDX2,YMDY2,DX,DY,DX2,DY2,
     +    REX2,RAD2)
         CALL DGM174 (F,XG,YG,IX,IY,I,XMDX2,YMDY2,DX,DY,DX2,DY2,
     +    REX2,RAD2)
         F=F+ZMDZ2+DZ2-2*DZ*ZR
         ZR=ZR-DZ
         I=I-1
         GOTO 10
      END IF





      RETURN
      END
      SUBROUTINE DGM271 (SCORE,FU,XG,IX,IY,IZ,XMDX2,DX,DX2,REX2)



















      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, IIX
      REAL          SCORE, FU, XG, XMDX2, DX, DX2, REX2,  
     +              FFX, XR, DGM112





      FFX=FU-XMDX2+DX2+2*DX*XG
      XR=XG+DX
      IIX=IX+1
   10 CONTINUE
      IF (FFX.LT.REX2) THEN
         SCORE=SCORE+DGM112(IIX+1,IY+1,IZ+1)
         FFX=FFX-XMDX2+DX2+2*DX*XR
         XR=XR+DX
         IIX=IIX+1
         GOTO 10
      END IF





      RETURN
      END
      SUBROUTINE DGM272 (SCORE,FU,XG,IX,IY,IZ,XMDX2,DX,DX2,REX2)



















      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, IIX
      REAL          SCORE, FU, XG, XMDX2, DX, DX2, REX2,  
     +              FFX, XR, DGM112





      FFX=FU+XMDX2+DX2-2*DX*XG
      XR=XG-DX
      IIX=IX-1
   10 CONTINUE
      IF (FFX.LT.REX2) THEN
         SCORE=SCORE+DGM112(IIX+1,IY+1,IZ+1)
         FFX=FFX+XMDX2+DX2-2*DX*XR
         XR=XR-DX
         IIX=IIX-1
         GOTO 10
      END IF





      RETURN
      END
      SUBROUTINE DGM273 (SCORE,FU,XG,YG,IX,IY,IZ,XMDX2,YMDY2,
     +    DX,DY,DX2,DY2,REX2)



















      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, IIX, I
      REAL          SCORE, FU, XG, YG, XMDX2, YMDY2, DX, DY, DX2, DY2, 
     +              REX2, XR, FFX, YR, F, DGM112





      F=FU-YMDY2+DY2+2*DY*YG
      YR=YG+DY
      I=IY+1
   10 CONTINUE
      IF (F.LT.REX2) THEN
         SCORE=SCORE+DGM112(IX+1,I+1,IZ+1)






         FFX=F-XMDX2+DX2+2*DX*XG
         XR=XG+DX
         IIX=IX+1
   20    CONTINUE
         IF (FFX.LT.REX2) THEN
            SCORE=SCORE+DGM112(IIX+1,I+1,IZ+1)
            FFX=FFX-XMDX2+DX2+2*DX*XR
            XR=XR+DX
            IIX=IIX+1
            GOTO 20
         END IF






         FFX=F+XMDX2+DX2-2*DX*XG
         XR=XG-DX
         IIX=IX-1
   30    CONTINUE
         IF (FFX.LT.REX2) THEN
            SCORE=SCORE+DGM112(IIX+1,I+1,IZ+1)
            FFX=FFX+XMDX2+DX2-2*DX*XR
            XR=XR-DX
            IIX=IIX-1
            GOTO 30
         END IF
         F=F-YMDY2+DY2+2*DY*YR
         YR=YR+DY
         I=I+1
         GOTO 10
      END IF





      RETURN
      END
      SUBROUTINE DGM274 (SCORE,FU,XG,YG,IX,IY,IZ,XMDX2,YMDY2,
     +    DX,DY,DX2,DY2,REX2)



















      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, IIX, I
      REAL          SCORE, FU, XG, YG, XMDX2, YMDY2, DX, DY, DX2, 
     +              DY2, REX2, XR, FFX, YR, F, DGM112





      F=FU+YMDY2+DY2-2*DY*YG
      YR=YG-DY
      I=IY-1
   10 CONTINUE
      IF (F.LT.REX2) THEN
         SCORE=SCORE+DGM112(IX+1,I+1,IZ+1)






         FFX=F-XMDX2+DX2+2*DX*XG
         XR=XG+DX
         IIX=IX+1
   20    CONTINUE
         IF (FFX.LT.REX2) THEN
            SCORE=SCORE+DGM112(IIX+1,I+1,IZ+1)
            FFX=FFX-XMDX2+DX2+2*DX*XR
            XR=XR+DX
            IIX=IIX+1
            GOTO 20
         END IF






         FFX=F+XMDX2+DX2-2*DX*XG
         XR=XG-DX
         IIX=IX-1
   30    CONTINUE
         IF (FFX.LT.REX2) THEN
            SCORE=SCORE+DGM112(IIX+1,I+1,IZ+1) 
            FFX=FFX+XMDX2+DX2-2*DX*XR
            XR=XR-DX
            IIX=IIX-1
            GOTO 30
         END IF
         F=F+YMDY2+DY2-2*DY*YR
         YR=YR-DY
         I=I-1
         GOTO 10
      END IF





      RETURN
      END
      SUBROUTINE DGM275 (SCORE,FU,XG,YG,ZG,IX,IY,IZ,XMDX2,YMDY2,ZMDZ2,
     +    DX,DY,DZ,DX2,DY2,DZ2,REX2)



















      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, I
      REAL          SCORE, FU, XG, YG, ZG, XMDX2, YMDY2, ZMDZ2,
     +              DX, DY, DZ, DX2, DY2, DZ2, REX2, ZR, F, DGM112
      SAVE          F,ZR,I





      F=FU-ZMDZ2+DZ2+2*DZ*ZG
      ZR=ZG+DZ
      I=IZ+1
   10 CONTINUE
      IF (F.LT.REX2) THEN
         SCORE=SCORE+DGM112(IX+1,IY+1,I+1)




         CALL DGM271 (SCORE,F,XG,IX,IY,I,XMDX2,DX,DX2,REX2)
         CALL DGM272 (SCORE,F,XG,IX,IY,I,XMDX2,DX,DX2,REX2)
         CALL DGM273 (SCORE,F,XG,YG,IX,IY,I,XMDX2,YMDY2,DX,DY,DX2,DY2,
     +    REX2)
         CALL DGM274 (SCORE,F,XG,YG,IX,IY,I,XMDX2,YMDY2,DX,DY,DX2,DY2
     +    ,REX2)
         F=F-ZMDZ2+DZ2+2*DZ*ZR
         ZR=ZR+DZ
         I=I+1
         GOTO 10
      END IF





      RETURN
      END
      SUBROUTINE DGM276 (SCORE,FU,XG,YG,ZG,IX,IY,IZ,XMDX2,YMDY2,ZMDZ2,
     +    DX,DY,DZ,DX2,DY2,DZ2,REX2)



















      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, I
      REAL          SCORE, FU, XG, YG, ZG, XMDX2, YMDY2, ZMDZ2,
     +              DX, DY, DZ, DX2, DY2, DZ2, REX2, ZR, F, DGM112
      SAVE          F,ZR,I





      F=FU+ZMDZ2+DZ2-2*DZ*ZG
      ZR=ZG-DZ
      I=IZ-1
   10 CONTINUE
      IF (F.LT.REX2) THEN
         SCORE=SCORE+DGM112(IX+1,IY+1,I+1)




         CALL DGM271 (SCORE,F,XG,IX,IY,I,XMDX2,DX,DX2,REX2)
         CALL DGM272 (SCORE,F,XG,IX,IY,I,XMDX2,DX,DX2,REX2)
         CALL DGM273 (SCORE,F,XG,YG,IX,IY,I,XMDX2,YMDY2,DX,DY,DX2,DY2,
     +    REX2)
         CALL DGM274 (SCORE,F,XG,YG,IX,IY,I,XMDX2,YMDY2,DX,DY,DX2,DY2,
     +    REX2)
         F=F+ZMDZ2+DZ2-2*DZ*ZR
         ZR=ZR-DZ
         I=I-1
         GOTO 10
      END IF





      RETURN
      END
      SUBROUTINE DGM107_OLD (IAA,IHIT,SCORE)


















      IMPLICIT      NONE
      INTEGER       IAA, IHIT, IERR
      REAL          SCORE







      IERR=0
      SCORE=0.0



      CALL WIF424B (1,IHIT,IAA,IERR)



      CALL DGM107A_OLD (IAA,SCORE)





      RETURN
      END
      SUBROUTINE DGM107A_OLD (IAA,SCORE)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'DGMUT.INC'
      INCLUDE       'MAPINC.INC'
      INTEGER       IAA, IAT, IX, IY, IZ
      REAL          SCORE, FU, XG, YG, ZG, XMDX2, YMDY2, ZMDZ2,
     +              REX2, XM, YM, ZM
      LOGICAL       MPP023







      SCORE=0.0
      IF (HATPRA(RESTYP(IAA)).LE.4) GOTO 998



      DO 60 IAT=PNTAAS(IAA)+3,PNTAAS(IAA)+3
         IF (.NOT.ISATOK(IAT).OR.PROTON(IAT)) GOTO 60
         XM=XCOORD(IAT)
         YM=YCOORD(IAT)
         ZM=ZCOORD(IAT)
         REX2=(VDWRAD(IAT)+PRBRAD-0.5)**2
         IX=NINT((XM-XMIN)/DX)
         IY=NINT((YM-YMIN)/DY)
         IZ=NINT((ZM-ZMIN)/DZ)
         XG=XMIN+IX*DX
         YG=YMIN+IY*DY
         ZG=ZMIN+IZ*DZ
         XMDX2=2*XM*DX
         YMDY2=2*YM*DY
         ZMDZ2=2*ZM*DZ



         FU=(XM-XG)**2+(YM-YG)**2+(ZM-ZG)**2
         IF (MPP023(IX+1,IY+1,IZ+1)) THEN
            SCORE=SCORE+GRID(IX+1,IY+1,IZ+1)
         END IF




         CALL DGM271 (SCORE,FU,XG,IX,IY,IZ,XMDX2,DX,DX2,REX2)
         CALL DGM272 (SCORE,FU,XG,IX,IY,IZ,XMDX2,DX,DX2,REX2)
         CALL DGM273 (SCORE,FU,XG,YG,IX,IY,IZ,XMDX2,YMDY2,DX,DY,
     +    DX2,DY2,REX2)
         CALL DGM274 (SCORE,FU,XG,YG,IX,IY,IZ,XMDX2,YMDY2,DX,DY,
     +    DX2,DY2,REX2)
         CALL DGM275 (SCORE,FU,XG,YG,ZG,IX,IY,IZ,XMDX2,YMDY2,ZMDZ2,
     +    DX,DY,DZ,DX2,DY2,DZ2,REX2)
         CALL DGM276 (SCORE,FU,XG,YG,ZG,IX,IY,IZ,XMDX2,YMDY2,ZMDZ2,
     +    DX,DY,DZ,DX2,DY2,DZ2,REX2)
   60 CONTINUE



  998 CONTINUE


      RETURN
      END
