*DECK VDG
      SUBROUTINE VDG(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
* Reaction rate comparison operator for Van Der Gucht benchmarks.
*
*Copyright:
* Copyright (C) 2002 Ecole Polytechnique de Montreal
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version
*
*Author(s): A. Hebert
*
*Parameters: input/output
* NENTRY  number of LCM objects or files used by the operator.
* HENTRY  name of each LCM object or file:
*         HENTRY(1): read-only reference type(L_EDIT);
*         HENTRY(2): read-only type(L_EDIT).
* IENTRY  type of each LCM object or file:
*         =1 LCM memory object; =2 XSM file; =3 sequential binary file;
*         =4 sequential ascii file.
* JENTRY  access of each LCM object or file:
*         =0 the LCM object or file is created;
*         =1 the LCM object or file is open for modifications;
*         =2 the LCM object or file is open in read-only mode.
* KENTRY  LCM object address or file unit number.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
      TYPE(C_PTR)  KENTRY(NENTRY)
      CHARACTER    HENTRY(NENTRY)*12
*----
*  LOCAL VARIABLES
*----
      PARAMETER (MAXGRO=500,MAXISO=100)
      CHARACTER TEXT4*4,TITLE*72,TEXT12*12,HSIGN*12,HSMG*131
      DOUBLE PRECISION DFLOTT
      TYPE(C_PTR) IPLIB,JPLIB,IPEDI,JPEDI
*----
*  ALLOCATABLE ARRAYS
*----
      REAL, ALLOCATABLE, DIMENSION(:) :: SIGA2,DELTA2,SIGA1,ERR,FLUX,
     1 SIGS,SIGA,DEN2,VOLU2,DEN1,VOLU1,SIGA3,SIGA4,DELTA1
      REAL, ALLOCATABLE, DIMENSION(:,:) :: SIGA3I,SIGA4I
      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: NAMES1,NAMES2
      TYPE(C_PTR), ALLOCATABLE, DIMENSION(:) :: IPISO1,IPISO2
*----
*  SCRATCH STORAGE ALLOCATION
*----
      ALLOCATE(DELTA2(MAXGRO),ERR(MAXGRO),NAMES2(MAXISO),FLUX(MAXGRO),
     1 SIGS(MAXGRO),SIGA(MAXGRO),DEN2(MAXISO),VOLU2(MAXISO),
     2 DEN1(MAXISO),VOLU1(MAXISO),NAMES1(MAXISO),DELTA1(MAXGRO))
*----
*  PARAMETER VALIDATION.
*----
      IF(NENTRY.LE.1) CALL XABORT('VDG: TWO PARAMETERS EXPECTED.')
      IF((JENTRY(1).NE.2).OR.(IENTRY(1).LT.1).OR.(IENTRY(1).GT.4))
     1 CALL XABORT('VDG: LINKED LIST OR FILE IN READ-ONLY MODE EXPEC'
     2 //'TED AT FIRST RHS.')
      IF((JENTRY(2).NE.2).OR.(IENTRY(2).LT.1).OR.(IENTRY(2).GT.4))
     1 CALL XABORT('VDG: LINKED LIST OR FILE IN READ-ONLY MODE EXPEC'
     2 //'TED AT SECOND RHS.')
*----
*  READ INPUT DATA.
*----
      IMPX=1
      IG1=1
      IG2=9999999
      IPICK=0
   10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
      IF(INDIC.EQ.10) GO TO 20
      IF(INDIC.NE.3) CALL XABORT('VDG: CHARACTER DATA EXPECTED(1).')
      IF(TEXT4.EQ.'EDIT') THEN
         CALL REDGET(INDIC,IMPX,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.1) CALL XABORT('VDG: INTEGER DATA EXPECTED(1).')
      ELSE IF(TEXT4.EQ.'GRMI') THEN
         CALL REDGET(INDIC,IG1,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.1) CALL XABORT('VDG: INTEGER DATA EXPECTED(3).')
      ELSE IF(TEXT4.EQ.'GRMA') THEN
         CALL REDGET(INDIC,IG2,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.1) CALL XABORT('VDG: INTEGER DATA EXPECTED(4).')
      ELSE IF(TEXT4.EQ.';') THEN
         GO TO 20
      ELSE IF(TEXT4.EQ.'PICK') THEN
         IPICK=1
         GO TO 20
      ELSE
         CALL XABORT('VDG: '//TEXT4//' IS AN INVALID KEY WORD.')
      ENDIF
      GO TO 10
*----
*  PROCESS FIRST AND SECOND RHS.
*----
   20 IF(IENTRY(1).GE.3) THEN
         CALL LCMOP(IPLIB,'COPY1',0,1,0)
         IFILE=FILUNIT(KENTRY(1))
         CALL LCMEXP(IPLIB,0,IFILE,IENTRY(1)-2,2)
      ELSE
         IPLIB=KENTRY(1)
      ENDIF
      CALL LCMGTC(IPLIB,'SIGNATURE',12,HSIGN)
      IF(HSIGN.NE.'L_EDIT') THEN
         TEXT12=HENTRY(1)
         CALL XABORT('VDG: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     1   '. L_EDIT EXPECTED.')
      ENDIF
      IF(IENTRY(2).GE.3) THEN
         CALL LCMOP(IPEDI,'COPY2',0,1,0)
         IFILE=FILUNIT(KENTRY(2))
         CALL LCMEXP(IPEDI,0,IFILE,IENTRY(2)-2,2)
      ELSE
         IPEDI=KENTRY(2)
      ENDIF
      CALL LCMGTC(IPEDI,'SIGNATURE',12,HSIGN)
      IF(HSIGN.NE.'L_EDIT') THEN
         TEXT12=HENTRY(2)
         CALL XABORT('VDG: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     1   '. L_EDIT EXPECTED.')
      ENDIF
      CALL LCMLEN(IPEDI,'TITLE',LENGT,ITYLCM)
      IF(LENGT.GT.0) THEN
         CALL LCMGTC(IPEDI,'TITLE',72,TITLE)
      ELSE
         TITLE='*** NO TITLE PROVIDED ***'
      ENDIF
      WRITE(6,'(/1X,A72)') TITLE
*----
*  RECOVER GENERAL INFORMATION FROM THE APPROXIMATE RUN.
*----
      CALL LCMSIX(IPEDI,'REF-CASE0001',1)
      CALL LCMLEN(IPEDI,'ISOTOPESDENS',NISOT1,ITYLCM)
      WRITE(6,*) 'VDG: DRAGON NISOT(APPROX)=',NISOT1
      IF(NISOT1.GT.MAXISO) CALL XABORT('VDG: INSUFFICIENT MAXISO(1).')
      CALL LCMGTC(IPEDI,'ISOTOPESUSED',12,NISOT1,NAMES1)
      IF(IMPX.GT.1)  THEN
        WRITE(6,'(/24H VDG: APPROXIMATE OUTPUT)')
        CALL LCMLIB(IPEDI)
        WRITE(6,'(9H ISOTOPES/(2H '',A12,1H'',:,2X,1H'',A12,1H'',:,2X,
     1  1H'',A12,1H'',:,2X,1H'',A12,1H''))') NAMES1(:NISOT1)
      ENDIF
      CALL LCMLEN(IPEDI,'DELTAU',LGRP1,ITYLCM)
      IF(LGRP1.GT.MAXGRO) CALL XABORT('VDG: INSUFFICIENT MAXGRO(1).')
      CALL LCMGET(IPEDI,'DELTAU',DELTA1)
      CALL LCMGET(IPEDI,'ISOTOPESVOL',VOLU1)
      CALL LCMGET(IPEDI,'ISOTOPESDENS',DEN1)
*----
*  SET THE LCM MICROLIB ISOTOPEWISE DIRECTORIES.
*----
      ALLOCATE(IPISO1(NISOT1))
      CALL LIBIPS(IPEDI,NISOT1,IPISO1)
*----
*  RECOVER GENERAL INFORMATION FROM THE AUTOSECOL RUN.
*----
      CALL LCMSIX(IPLIB,'REF-CASE0001',1)
      CALL LCMLEN(IPLIB,'ISOTOPESDENS',NISOT2,ITYLCM)
      IF(NISOT2.NE.NISOT1) CALL XABORT('VDG: INVALIB NISOT.')
      WRITE(6,*) 'VDG: DRAGON NISOT(APPROX)=',NISOT2
      CALL LCMGTC(IPLIB,'ISOTOPESUSED',12,NISOT2,NAMES2)
      IF(IMPX.GT.1)  THEN
        WRITE(6,'(/22H VDG: AUTOSECOL OUTPUT)')
        CALL LCMLIB(IPLIB)
        WRITE(6,'(9H ISOTOPES/(2H '',A12,1H'',:,2X,1H'',A12,1H'',:,2X,
     1  1H'',A12,1H'',:,2X,1H'',A12,1H''))') NAMES2(:NISOT2)
      ENDIF
      CALL LCMLEN(IPLIB,'DELTAU',LGRP2,ITYLCM)
      IF(LGRP2.GT.MAXGRO) CALL XABORT('VDG: INSUFFICIENT MAXGRO(2).')
      CALL LCMGET(IPLIB,'DELTAU',DELTA2)
      LGRMIN=LGRP2+1
      LGRMAX=0
      IG2=MIN(LGRP2,IG2)
      DO 30 I=IG1,IG2
      IF(DELTA2(I).NE.0.0) THEN
         LGRMIN=MIN(LGRMIN,I)
         LGRMAX=MAX(LGRMAX,I)
      ENDIF
   30 CONTINUE
      CALL LCMGET(IPLIB,'ISOTOPESVOL',VOLU2)
      CALL LCMGET(IPLIB,'ISOTOPESDENS',DEN2)
*----
*  SET THE LCM MICROLIB ISOTOPEWISE DIRECTORIES.
*----
      ALLOCATE(IPISO2(NISOT2))
      CALL LIBIPS(IPLIB,NISOT2,IPISO2)
*----
*  LOOP OVER THE ISOTOPES OF THE APPROXIMATE RUN.
*----
      ALLOCATE(SIGA1(LGRP1),SIGA2(LGRP2),SIGA3(LGRP1),SIGA4(LGRP2))
      ALLOCATE(SIGA3I(LGRP1,NISOT1),SIGA4I(LGRP2,NISOT2))
      SIGA3(:LGRP1)=0.0
      SIGA4(:LGRP2)=0.0
      SIGA3I(:LGRP1,:NISOT1)=0.0
      SIGA4I(:LGRP2,:NISOT2)=0.0
      NRES=0
      DO 170 ISOT=1,NISOT1
      TEXT12=NAMES1(ISOT)
      IF(TEXT12(:8).EQ.'*MAC*RES') THEN
        NRES=NRES+1
        GO TO 170
      ENDIF
      SIGA1(:LGRP1)=0.0
      SIGA2(:LGRP2)=0.0
      NAMES1(ISOT)=TEXT12
      WRITE(6,'(/26H VDG: PROCESSING ISOTOPE '',A12,2H''.)') TEXT12
      IF(NAMES1(ISOT).NE.NAMES2(ISOT)) THEN
        WRITE(HSMG,'(28H VDG: INVALID ISOTOPE NAMES=,A12,4H VS ,A12,
     1  1H.)') NAMES1(ISOT),NAMES2(ISOT)
        CALL XABORT(HSMG)
      ENDIF
      JPEDI=IPISO1(ISOT)
      IF(.NOT.C_ASSOCIATED(JPEDI)) CALL XABORT('VDG: ERROR NB 210')
      CALL LCMGET(JPEDI,'NTOT0',SIGA)
      CALL LCMGET(JPEDI,'SIGS00',SIGS)
      CALL LCMGET(JPEDI,'NWT0',FLUX)
      DO 100 I=1,LGRP1
      SIGGG=(SIGA(I)-SIGS(I))*FLUX(I)*VOLU1(ISOT)*DEN1(ISOT)
      SIGA1(I)=SIGA1(I)+SIGGG
      SIGA3(I)=SIGA3(I)+SIGGG
      SIGA3I(I,ISOT)=SIGA3I(I,ISOT)+SIGGG
  100 CONTINUE
      IF(IMPX.NE.0) THEN
         WRITE (6,'(/27H DRAGON VOLUME OF THE FUEL=,1P,E12.4)')
     1   VOLU1(ISOT)
         WRITE (6,'(/27H CONDENSED LETHARGY WIDTHS:/(1X,1P,10E12.4))')
     1   (DELTA1(I),I=1,LGRP2)
         WRITE (6,'(/23H CONDENSED DRAGON FLUX:/(1X,1P,10E12.4))')
     1   (FLUX(I),I=1,LGRP2)
         WRITE (6,'(/35H CONDENSED DRAGON ABSORPTION RATES:/
     1   (1X,1P,10E12.4))') (SIGA1(I),I=1,LGRP2)
      ENDIF
*----
*  RECOVER INFORMATION FROM AUTOSECOL RUN.
*----
      IF(IMPX.NE.0) THEN
         WRITE (6,'(/35H AUTOSECOL VOLUME OF THE FUEL ISOT=,I4,1H=,1P,
     1   E12.4)') ISOT,VOLU2(ISOT)
      ENDIF
      JPLIB=IPISO2(ISOT)
      IF(.NOT.C_ASSOCIATED(JPLIB)) CALL XABORT('VDG: ERROR NB 211')
      CALL LCMGET(JPLIB,'NTOT0',SIGA)
      CALL LCMGET(JPLIB,'SIGS00',SIGS)
      CALL LCMGET(JPLIB,'NWT0',FLUX)
      CALL LCMSIX(JPLIB,' ',2)
      DO 130 I=LGRMIN,LGRMAX
      SIGGG=(SIGA(I)-SIGS(I))*FLUX(I)*VOLU2(ISOT)*DEN2(ISOT)
      SIGA2(I)=SIGA2(I)+SIGGG
      SIGA4(I)=SIGA4(I)+SIGGG
      SIGA4I(I,ISOT)=SIGA4I(I,ISOT)+SIGGG
  130 CONTINUE
      IF(ABS(VOLU1(ISOT)-VOLU2(ISOT)).GT.1.0E-4*VOLU1(ISOT)) THEN
        WRITE(HSMG,'(46HVDG: INVALID INTEGRATED VOLUME IN DRAGON. ISOT,
     1  5HOPE='',A12,16H'' DRAGON VOLUME=,1P,E12.4,16H. AUTOSECOL VOLU,
     2  3HME=,E12.4,1H.)') NAMES1(ISOT),VOLU1(ISOT),VOLU2(ISOT)
        CALL XABORT(HSMG)
      ENDIF
      IF(IMPX.NE.0) THEN
         WRITE (6,'(/30H AUTOSECOL VOLUME OF THE FUEL=,1P,E12.4)')
     1   VOLU2(ISOT)
         WRITE (6,'(/23H ENERGY DOMAIN INDICES=,I5,5H --->,I5)')
     1   LGRMIN,LGRMAX
         WRITE (6,'(/27H CONDENSED LETHARGY WIDTHS:/(1X,1P,10E12.4))')
     1   (DELTA2(I),I=LGRMIN,LGRMAX)
         WRITE (6,'(/26H CONDENSED AUTOSECOL FLUX:/(1X,1P,10E12.4))')
     1   (FLUX(I),I=LGRMIN,LGRMAX)
         WRITE (6,'(/38H CONDENSED AUTOSECOL ABSORPTION RATES:/
     1   (1X,1P,10E12.4))') (SIGA2(I),I=LGRMIN,LGRMAX)
      ENDIF
*----
*  PERFORM STATISTICS ON A PARTICULAR ISOTOPE.
*----
      SUMREF=0.0
      ZMAX=0.0
      ZAVER=0.0
      SUM=0.0
      IMAX=0
      DO 150 I=LGRMIN,LGRMAX
      ERR(I)=100.0*(SIGA1(I)-SIGA2(I))/SIGA2(I)
      IF(I-LGRMIN+1.GE.3) ZAVER=ZAVER+ABS(ERR(I))
      EPSD=ABS(DELTA2(I)-DELTA1(I))/DELTA2(I)
      IF(EPSD.GT.1.0E-3) CALL XABORT('VDG: INVALID DELTA1.(1)')
      IF((I-LGRMIN+1.GE.3).AND.(ABS(ERR(I)).GT.ZMAX)) THEN
         ZMAX=ABS(ERR(I))
         IMAX=I
      ENDIF
      SUMREF=SUMREF+SIGA2(I)
      SUM=SUM+SIGA1(I)
  150 CONTINUE
      ZAVER=ZAVER/REAL(LGRP2-2)
      SUMERR=100.0*(SUM-SUMREF)/SUMREF
      WRITE (6,'(1H1/11H ISOTOPE ='',A12,1H''//10X,9HAUTOSECOL,3X,
     1 6HDRAGON,8X,5HERROR)') NAMES1(ISOT)
      DO 160 I=LGRMIN,LGRMAX
      WRITE (6,'(1X,I5,3X,1P,2E12.5,0P,F9.3,2H %)') I,SIGA2(I),
     1 SIGA1(I),ERR(I)
  160 CONTINUE
      WRITE (6,'(10X,11(1H-),1X,11(1H-)/3X,3HSUM,3X,1P,2E12.5,0P,F9.3,
     1 2H %)') SUMREF,SUM,SUMERR
      WRITE (6,'(/10X,14HMAXIMUM ERROR=,F9.3,2H %,9H IN GROUP,I4)')
     1 ZMAX,IMAX
      WRITE (6,'(10X,14HAVERAGE ERROR=,F9.3,2H %)') ZAVER
      WRITE (6,'(7X,17HINTEGRATED ERROR=,F9.3,2H %/)') SUMERR
  170 CONTINUE
      DEALLOCATE(IPISO2,IPISO1)
*----
*  PERFORM STATISTICS ON EACH TYPE OF ISOTOPE.
*----
      IF(NISOT1-NRES.GT.2) THEN
         DO 200 ISOT=1,NISOT1
         IF(NAMES1(ISOT)(:8).EQ.'*MAC*RES') GO TO 200
         SUMREF=0.0
         ZMAX=0.0
         ZAVER=0.0
         SUM=0.0
         IMAX=0
         DO 180 I=LGRMIN,LGRMAX
         ERR(I)=100.0*(SIGA3I(I,ISOT)-SIGA4I(I,ISOT))/SIGA4I(I,ISOT)
         IF(I-LGRMIN+1.GE.3) ZAVER=ZAVER+ABS(ERR(I))
         EPSD=ABS(DELTA2(I)-DELTA1(I))/DELTA2(I)
         IF(EPSD.GT.1.0E-3) CALL XABORT('VDG: INVALID DELTA1.(2)')
         IF((I-LGRMIN+1.GE.3).AND.(ABS(ERR(I)).GT.ZMAX)) THEN
            ZMAX=ABS(ERR(I))
            IMAX=I
         ENDIF
         SUMREF=SUMREF+SIGA4I(I,ISOT)
         SUM=SUM+SIGA3I(I,ISOT)
  180    CONTINUE
         ZAVER=ZAVER/REAL(LGRMAX-LGRMIN-1)
         SUMERR=100.0*(SUM-SUMREF)/SUMREF
         WRITE (6,'(1H1/12H SUM OF ALL ,A8//10X,9HAUTOSECOL,3X,
     1   6HDRAGON,8X,5HERROR)') NAMES1(ISOT)
         DO 190 I=LGRMIN,LGRMAX
         WRITE (6,'(1X,I5,3X,1P,2E12.5,0P,F9.3,2H %)') I,SIGA4I(I,ISOT),
     1   SIGA3I(I,ISOT),ERR(I)
  190    CONTINUE
         WRITE (6,'(10X,11(1H-),1X,11(1H-)/3X,3HSUM,3X,1P,2E12.5,0P,
     1   F9.3,2H %)') SUMREF,SUM,SUMERR
         WRITE (6,'(/10X,14HMAXIMUM ERROR=,F9.3,2H %,9H IN GROUP,I4)')
     1   ZMAX,IMAX
         WRITE (6,'(10X,14HAVERAGE ERROR=,F9.3,2H %)') ZAVER
         WRITE (6,'(7X,17HINTEGRATED ERROR=,F9.3,2H %/)') SUMERR
  200    CONTINUE
      ENDIF
*----
*  PERFORM STATISTICS ON ALL ISOTOPES.
*----
      SUMREF=0.0
      ZMAX=0.0
      ZAVER=0.0
      SUM=0.0
      IMAX=0
      DO 210 I=LGRMIN,LGRMAX
      ERR(I)=100.0*(SIGA3(I)-SIGA4(I))/SIGA4(I)
      IF(I-LGRMIN+1.GE.3) ZAVER=ZAVER+ABS(ERR(I))
      EPSD=ABS(DELTA2(I)-DELTA1(I))/DELTA2(I)
      IF(EPSD.GT.1.0E-3) CALL XABORT('VDG: INVALID DELTA1.(3)')
      IF((I-LGRMIN+1.GE.3).AND.(ABS(ERR(I)).GT.ZMAX)) THEN
         ZMAX=ABS(ERR(I))
         IMAX=I
      ENDIF
      SUMREF=SUMREF+SIGA4(I)
      SUM=SUM+SIGA3(I)
  210 CONTINUE
      ZAVER=ZAVER/REAL(LGRMAX-LGRMIN-1)
      SUMERR=100.0*(SUM-SUMREF)/SUMREF
      WRITE (6,'(1H1/20H SUM OF ALL ISOTOPES//10X,9HAUTOSECOL,3X,
     1 6HDRAGON,8X,5HERROR)')
      DO 220 I=LGRMIN,LGRMAX
      WRITE (6,'(1X,I5,3X,1P,2E12.5,0P,F9.3,2H %)') I,SIGA4(I),
     1 SIGA3(I),ERR(I)
  220 CONTINUE
      WRITE (6,'(10X,11(1H-),1X,11(1H-)/3X,3HSUM,3X,1P,2E12.5,0P,F9.3,
     1 2H %)') SUMREF,SUM,SUMERR
      WRITE (6,'(/10X,14HMAXIMUM ERROR=,F9.3,2H %,9H IN GROUP,I4)')
     1 ZMAX,IMAX
      WRITE (6,'(10X,14HAVERAGE ERROR=,F9.3,2H %)') ZAVER
      WRITE (6,'(7X,17HINTEGRATED ERROR=,F9.3,2H %/)') SUMERR
      IF(IMPX.GT.50) THEN
        WRITE(6,'(1P,E12.5,1H,,E12.5,1H,,E12.5,1H,,E12.5,1H,,E12.5,1H,,
     1  E12.5,1H,,E12.5,1H,,E12.5,1H,,E12.5,1H,,E12.5,1H,)')
     2  (ERR(I),I=LGRMIN,LGRMAX)
      ENDIF
*----
*  RECOVER THE FINAL POWER AND SAVE IT IN A CLE-2000 VARIABLE
*----
      IF(IPICK.EQ.1) THEN
        CALL REDGET(ITYP,NITMA,FLOTT,TEXT4,DFLOTT)
        IF(INDIC.NE.3) CALL XABORT('VDG: CHARACTER DATA EXPECTED(2).')
        IF(TEXT4.EQ.'MAXV') THEN
          VAL=ZMAX
        ELSE IF(TEXT4.EQ.'AVER') THEN
          VAL=ZAVER
        ELSE IF(TEXT4.EQ.'INTG') THEN
          VAL=SUMERR
        ELSE
          CALL XABORT('VDG: MAXV/AVER/INTG KEYWORD EXPECTED.')
        ENDIF
        CALL REDGET(ITYP,NITMA,FLOTT,TEXT4,DFLOTT)
        IF(ITYP.NE.-2) CALL XABORT('VDG: OUTPUT REAL EXPECTED.')
        ITYP=2
        CALL REDPUT(ITYP,NITMA,VAL,TEXT4,DFLOTT)
        CALL REDGET(ITYP,NITMA,FLOTT,TEXT4,DFLOTT)
        IF((ITYP.NE.3).OR.(TEXT4.NE.';')) THEN
          CALL XABORT('VDG: ; CHARACTER EXPECTED.')
        ENDIF
      ENDIF
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(SIGA4I,SIGA3I,SIGA4,SIGA3,SIGA2,SIGA1)
      DEALLOCATE(DELTA1,NAMES1,VOLU1,DEN1,VOLU2,DEN2,SIGA,SIGS,FLUX,
     1 NAMES2,ERR,DELTA2)
      RETURN
      END