Initial commit from Polytechnique Montreal

1 files changed, 478 insertions, 0 deletions

diff --git a/Dragon/src/EDIGEO.f b/Dragon/src/EDIGEO.f
new file mode 100644
index 0000000..a91923e
--- /dev/null
+++ b/Dragon/src/EDIGEO.f
@@ -0,0 +1,478 @@
+*DECK EDIGEO
+      SUBROUTINE EDIGEO(MAXPTS,MAXMER,IPGEO1,IPGEO2,IPRINT,NREGIO,IEUR,
+     1 NMERGE,IMERGE)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover the geometry information from LCM (stored by operator GEO) and
+* compute a corresponding macro-geometry (i.e. a pure geometry that can
+* be treated by Bivac or Trivac or a two-level Eurydice geometry)
+* together with NMERGE and array IMERGE.
+*
+*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
+* MAXPTS  allocated storage for arrays of dimension NMCEL.
+* MAXMER  allocated storage for arrays of dimension NMERGE.
+* IPGEO1  pointer to the original geometry (L_GEOM signature).
+* IPGEO2  pointer to the macro-geometry (L_GEOM signature).
+* IPRINT  print flag (equal to 0 for no print).
+* NREGIO  number of regions.
+* IEUR    type of tracking operator for the macro-geometry:
+*         =1: 2-level macro-geometry with MERGE;
+*         =2: 2-level NXT-type macro-geometry without MERGE;
+*         =3: 1-level TRIVAC-type macro-geometry without MERGE;
+*         =4: 2-level macro-geometry with MERGE and unfolding.
+*
+*Parameters: input/output
+* NMERGE  macro-calculation merging flag (=1 to indicate a homogeneous
+*         macro-calculation) on input and.
+*         number of merged regions (equal to the number of physical
+*         cells in Eurydice) at output.
+*
+*Parameters: output
+* IMERGE  index of merged regions.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR), TARGET :: IPGEO1
+      TYPE(C_PTR)  IPGEO2
+      INTEGER      MAXPTS,MAXMER,IPRINT,NREGIO,IEUR,NMERGE,
+     >             IMERGE(NREGIO)
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER   (NSTATE=40)
+      CHARACTER    HSMG*131,TYPE(0:9)*16,HSIGN*12,TEXT12*12
+      LOGICAL      ILK,LL1,LL2,LHOM,LBIHET
+      INTEGER      NCODE(6),ICODE(6),ISTATE(NSTATE),JSTATE(NSTATE)
+      REAL         ZCODE(6),ALBEDO(6),XXX(2),YYY(2)
+      LOGICAL      LDIAG,LSYMX,LSYMY
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: INUM,IGEN,IORI,IMAT,NMC,IBI,
+     1 LSECT,NMCR,NRINFO,NRODS,KEYMRG,MATALB,NRODR,NXRS,NXRI,NS,IMILIE,
+     2 IHCEL
+      REAL, ALLOCATABLE, DIMENSION(:) :: XX,YY,RAYRE,RAN,VS,RODS,RODR,
+     1 MESHX,MESHY
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: FRACT
+      TYPE(C_PTR), POINTER :: IPGEOD,IPGEOX,IPGEOY
+*----
+*  DATA STATEMENTS
+*----
+      DATA TYPE/'VIRTUAL','HOMOGENEOUS','CARTESIAN 1-D','TUBE 1-D',
+     1 'SPHERE 1-D','CARTESIAN 2-D','TUBE 2-D','CARTESIAN 3-D',
+     2 'HEXAGONAL 2-D','HEXAGONAL 3-D'/
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(INUM(2*MAXPTS),IGEN(MAXPTS),IORI(2*MAXPTS),
+     1 IMAT(2*MAXPTS),NMC(MAXPTS+1),IBI(NREGIO))
+      ALLOCATE(XX(MAXPTS),YY(MAXPTS))
+*----
+*  RECOVER STATE VECTOR
+*----
+      ICLS=-99
+      LR=-99
+      LHOM=(NMERGE.EQ.1)
+      CALL LCMGET(IPGEO1,'STATE-VECTOR',ISTATE)
+      LBIHET=(ISTATE(12).EQ.1)
+*----
+*  UNFOLD GEOMETRY
+*----
+      IF(IEUR.EQ.4) THEN
+         IF((ISTATE(1).NE.5).OR.(ISTATE(8).NE.1)) THEN
+            CALL XABORT('EDIGEO: UNFOLDING NOT IMPLEMENTED FOR THIS TY'
+     1      //'PE OF GEOMETRY.')
+         ENDIF
+         CALL LCMGET(IPGEO1,'NCODE',NCODE)
+         LDIAG=(NCODE(1).EQ.3).AND.(NCODE(4).EQ.3)
+         IF(LDIAG) THEN
+            ALLOCATE(IPGEOD)
+            CALL LCMOP(IPGEOD,'GEOM_DIAG',0,1,0)
+            CALL EDIUNF(IPGEO1,IPGEOD,'DIAG')
+         ELSE
+            IPGEOD=>IPGEO1
+         ENDIF
+         CALL LCMGET(IPGEOD,'NCODE',NCODE)
+         LSYMX=(NCODE(3).EQ.5).AND.(NCODE(1).NE.3)
+         IF(LSYMX) THEN
+            ALLOCATE(IPGEOX)
+            CALL LCMOP(IPGEOX,'GEOM_SYMX',0,1,0)
+            CALL EDIUNF(IPGEOD,IPGEOX,'SYMX')
+         ELSE
+            IPGEOX=>IPGEOD
+         ENDIF
+         CALL LCMGET(IPGEOX,'NCODE',NCODE)
+         LSYMY=(NCODE(1).EQ.5).AND.(NCODE(4).NE.3)
+         IF(LSYMY) THEN
+            ALLOCATE(IPGEOY)
+            CALL LCMOP(IPGEOY,'GEOM_SYMY',0,1,0)
+            CALL EDIUNF(IPGEOX,IPGEOY,'SYMY')
+         ELSE
+            IPGEOY=>IPGEOX
+         ENDIF
+         ICLS=0
+         LR=0
+         ALLOCATE(RAYRE(MAXPTS),LSECT(MAXPTS),NMCR(MAXPTS))
+         CALL READEU(MAXPTS,MAXPTS,IPGEOY,IR2,IBI,ILK,NMCEL,NMERGE,
+     1   NGEN,INUM,IGEN,IPAS,LX,LY,XX,YY,LSECT,RAYRE,NMC,NMCR,IORI,
+     2   NCODE,ZCODE,IHEX,IPRINT-5)
+         DEALLOCATE(RAYRE,LSECT,NMCR)
+         IF(LDIAG) THEN
+            CALL LCMCL(IPGEOD,2)
+            DEALLOCATE(IPGEOD)
+         ENDIF
+         IF(LSYMX) THEN
+            CALL LCMCL(IPGEOX,2)
+            DEALLOCATE(IPGEOX)
+         ENDIF
+         IF(LSYMY) THEN
+            CALL LCMCL(IPGEOY,2)
+            DEALLOCATE(IPGEOY)
+         ENDIF
+         IEUR=3
+         GO TO 25
+      ENDIF
+*----
+*  RECOVER ASSEMBLY INFORMATION FROM THE ORIGINAL GEOMETRY
+*----
+      IF( ((ISTATE(1).EQ.5).AND.(ISTATE(8).EQ.1)).OR.
+     1     ((ISTATE(1).EQ.8).AND.(ISTATE(8).EQ.1)).OR.
+     2     ((ISTATE(1).EQ.20).AND.(ISTATE(13).EQ.0)).OR.
+     3     ((ISTATE(1).EQ.24).AND.(ISTATE(13).EQ.0)) ) THEN
+         ICLS=0
+         LR=0
+         ALLOCATE(RAYRE(MAXPTS),LSECT(MAXPTS),NMCR(MAXPTS))
+         CALL READEU(MAXPTS,MAXPTS,IPGEO1,IR2,IBI,ILK,NMCEL,NMERGE,
+     1   NGEN,INUM,IGEN,IPAS,LX,LY,XX,YY,LSECT,RAYRE,NMC,NMCR,IORI,
+     2   NCODE,ZCODE,IHEX,IPRINT-5)
+         DEALLOCATE(RAYRE,LSECT,NMCR)
+      ELSE IF( ((ISTATE(1).EQ.3).OR.(ISTATE(1).EQ.20).OR.
+     1          (ISTATE(1).EQ.24)).AND.(ISTATE(13).GE.1)) THEN
+        IROT=3
+        LX=0
+        LY=0
+        IF(ISTATE(1).EQ.3) THEN
+          NSURW=1
+          ICLS=1
+        ELSE IF(ISTATE(1).EQ.20) THEN
+          NSURW=4
+          ICLS=2
+          LX=1
+          LY=1
+        ELSE IF(ISTATE(1).EQ.24) THEN
+          NSURW=6
+          ICLS=3
+        ENDIF
+        IAPP=1
+        MAXJ=1
+        CALL XCGDIM(IPGEO1,MAXPTS,NSURW,IROT,IAPP,MAXJ,NVOLW,
+     1              NANW,MNANW,NRTW,MSRODW,MARODW,NSURFW)
+*----
+*  ALLOCATE BLOCK FOR READING GEOMETRY INFORMATION
+*----
+        ALLOCATE(NRINFO(2*NANW),NRODS(3*NRTW),KEYMRG(NSURW+NVOLW+1),
+     1  MATALB(NSURW+NVOLW+1),NRODR(NRTW),NXRS(NRTW),NXRI(NRTW*NANW))
+        ALLOCATE(RAN(NANW),VS(NSURW+NVOLW+1),RODS(2*NRTW),
+     1  RODR(MSRODW*NRTW))
+*
+        CALL XCGGEO(IPGEO1,IROT,NSURW,NVOLW,NANW,MNANW,NRTW,MSRODW,
+     1  IPRINT,ILK,NMATW,RAN,NRODS,RODS,NRODR,RODR,NRINFO,MATALB,VS,
+     2  COTE,RADMIN,NCODE,ICODE,ZCODE,ALBEDO,KEYMRG,NXRS,NXRI)
+*
+        IR2=0
+        DO 10 I=1,NVOLW
+        IBI(I)=MATALB((NSURW+1)+I)
+        IR2=MAX(IR2,IBI(I))
+   10   CONTINUE
+        DEALLOCATE(RODR,RODS,VS)
+        DEALLOCATE(NXRI,NXRS,NRODR,MATALB,KEYMRG,NRODS)
+*----
+*  STORE INFORMATION FOR NEW GEOMETRY
+*----
+        IPAS=NVOLW
+        NMCEL=NANW
+        NMERGE=NANW
+        IHEX=0
+        XX(1)=0.0
+        NMC(1)=0
+        DO 20 II=1,NANW
+          XX(II+1)=RAN(II)
+          INUM(II)=II
+          IGEN(II)=II
+          NMC(II+1)=NRINFO(2*(II-1)+1)
+   20   CONTINUE
+        IF(NSURW.EQ.1) THEN
+          LR=NANW
+        ELSE IF(NSURW.EQ.4) THEN
+          LR=NANW-1
+          XXX(1)=0.0
+          XXX(2)=XX(NANW+1)
+          YYY(1)=0.0
+          YYY(2)=COTE
+        ELSE
+          LR=NANW-1
+          SIDE=XX(NANW+1)
+        ENDIF
+*
+        DEALLOCATE(RAN,NRINFO)
+      ELSE
+         CALL XABORT('EDIGEO: INVALID TYPE OF INPUT GEOMETRY.')
+      ENDIF
+*----
+*  COMPUTE IMERGE ARRAY
+*----
+   25 IF(LHOM) THEN
+*        HOMOGENEOUS MACRO-CALCULATION.
+         DO 30 I=1,NREGIO
+         IMERGE(I)=1
+   30    CONTINUE
+         NMERGE=1
+         DO 40 I=1,NMCEL
+         IMAT(I)=1
+   40    CONTINUE
+      ELSE
+*        CELL-WISE HETEROGENEOUS MACRO-CALCULATION.
+         IPAS2=0
+         DO 60 IKK=1,NMERGE
+         IKG=IGEN(IKK)
+         I2=NMC(IKG+1)-NMC(IKG)
+         DO 50 I=1,I2
+         IMERGE(IPAS2+I)=IKK
+   50    CONTINUE
+         IPAS2=IPAS2+I2
+   60    CONTINUE
+         IF(IPAS2.NE.IPAS) THEN
+            CALL XABORT('EDIGEO: INCONSISTENT ARRAY NMC.')
+         ENDIF
+         DO 70 I=1,NMCEL
+         IMAT(I)=INUM(I)
+   70    CONTINUE
+      ENDIF
+*----
+*  IF DOUBLE HETEROGENEITY IS PRESENT IN THE REFERENCE GEOMETRY
+*----
+      IF(LBIHET) THEN
+         CALL LCMSIX(IPGEO1,'BIHET',1)
+         CALL LCMGET(IPGEO1,'STATE-VECTOR',ISTATE)
+         NG=ISTATE(1)
+         NMILG=ISTATE(3)
+         ALLOCATE(NS(NG),IMILIE(NMILG),FRACT(NG,NMILG))
+         CALL LCMGET(IPGEO1,'NS',NS)
+         CALL LCMGET(IPGEO1,'MILIE',IMILIE)
+         CALL LCMGET(IPGEO1,'FRACT',FRACT)
+         CALL LCMSIX(IPGEO1,' ',2)
+         IND1=IR2
+         DO 75 I=1,NMILG
+         IF(IMILIE(I).GT.IR2) THEN
+            WRITE (HSMG,500) IMILIE(I),IR2
+            CALL XABORT(HSMG)
+         ENDIF
+         IND1=MIN(IND1,IMILIE(I))
+   75    CONTINUE
+         IPAS2=IPAS
+         DO 110 IKK=1,IPAS2
+         IF(IBI(IKK).GE.IND1) THEN
+            IND=0
+            DO 80 I=1,NMILG
+            IF(IMILIE(I).EQ.IBI(IKK)) IND=I
+   80       CONTINUE
+            IF(IND.EQ.0) THEN
+               WRITE(HSMG,'(29HEDIGEO: A COMPOSITE MIXTURE (,I5,4H) IS,
+     1         13H NOT DEFINED.)') IBI(IKK)
+               CALL XABORT(HSMG)
+            ENDIF
+            DO 100 J=1,NG
+            IF(FRACT(J,IND).GT.0.00001) THEN
+               DO 90 K=1,NS(J)
+               IPAS=IPAS+1
+               IMERGE(IPAS)=IMERGE(IKK)
+   90          CONTINUE
+             ENDIF
+  100        CONTINUE
+         ENDIF
+  110    CONTINUE
+         DEALLOCATE(FRACT,IMILIE,NS)
+      ENDIF
+      IF(IPAS.NE.NREGIO) THEN
+         WRITE(HSMG,'(45HEDIGEO: INCONSISTENT NUMBER OF REGIONS. IPAS=,
+     1   I6,8H NREGIO=,I6)') IPAS,NREGIO
+         CALL XABORT(HSMG)
+      ELSE IF(NMERGE.GT.MAXMER) THEN
+         WRITE(HSMG,'(37HEDIGEO: INSUFFICIENT STORAGE (MAXMER=,I5,
+     1   47H). THE MERGE OPTION SHOULD NOT BE USED IN EDI:.)') MAXMER
+         CALL XABORT(HSMG)
+      ENDIF
+      IF(IPRINT.GT.0) THEN
+         WRITE (6,'(/23H EDIGEO: MERGING INDEX:/(1X,14I5))') (IMERGE(I),
+     1   I=1,NREGIO)
+      ENDIF
+*----
+*  COMPUTE THE MACRO-GEOMETRY
+*----
+      ISTATE(:NSTATE)=0
+      ICODE(:6)=0
+      CALL LCMPUT(IPGEO2,'NCODE',6,1,NCODE)
+      CALL LCMPUT(IPGEO2,'ZCODE',6,2,ZCODE)
+      CALL LCMPUT(IPGEO2,'ICODE',6,1,ICODE)
+      IF((ICLS.EQ.0).AND.(IEUR.LE.2)) THEN
+*       TWO-LEVEL MACRO-GEOMETRY.
+        ALLOCATE(IHCEL(3*NMERGE))
+        JSTATE(:NSTATE)=0
+        JSTATE(6)=1
+        HSIGN='L_GEOM'
+        CALL LCMPTC(IPGEO2,'SIGNATURE',12,HSIGN)
+        IF(IHEX.EQ.0) THEN
+          ISTATE(1)=5
+          JSTATE(1)=20
+          JSTATE(3)=1
+          JSTATE(4)=1
+          DO 120 IKK=1,NMERGE
+          WRITE(TEXT12,'(4HCELL,I8.8)') IKK
+          READ(TEXT12,'(3A4)') (IHCEL((IKK-1)*3+I0),I0=1,3)
+          CALL LCMSIX(IPGEO2,TEXT12,1)
+          CALL LCMPUT(IPGEO2,'MIX',1,1,IKK)
+          XXX(1)=0.0
+          XXX(2)=XX(IGEN(IKK))
+          YYY(1)=0.0
+          YYY(2)=YY(IGEN(IKK))
+          CALL LCMPUT(IPGEO2,'MESHX',2,2,XXX)
+          CALL LCMPUT(IPGEO2,'MESHY',2,2,YYY)
+          JSTATE(7)=IKK
+          CALL LCMPUT(IPGEO2,'STATE-VECTOR',NSTATE,1,JSTATE)
+          CALL LCMSIX(IPGEO2,' ',2)
+  120     CONTINUE
+        ELSE
+          ISTATE(1)=8
+          JSTATE(1)=24
+          JSTATE(3)=1
+          DO 130 IKK=1,NMERGE
+          WRITE(TEXT12,'(4HCELL,I8.8)') IKK
+          READ(TEXT12,'(3A4)') (IHCEL((IKK-1)*3+I0),I0=1,3)
+          CALL LCMSIX(IPGEO2,TEXT12,1)
+          CALL LCMPUT(IPGEO2,'MIX',1,1,IKK)
+          CALL LCMPUT(IPGEO2,'SIDE',1,2,XX(1))
+          JSTATE(7)=IKK
+          CALL LCMPUT(IPGEO2,'STATE-VECTOR',NSTATE,1,JSTATE)
+          CALL LCMSIX(IPGEO2,' ',2)
+  130     CONTINUE
+          CALL LCMPUT(IPGEO2,'IHEX',1,1,IHEX)
+        ENDIF
+        CALL LCMPUT(IPGEO2,'CELL',3*NMERGE,3,IHCEL)
+        IF(IEUR.EQ.1) CALL LCMPUT(IPGEO2,'MERGE',NMCEL,1,INUM)
+        CALL LCMPUT(IPGEO2,'TURN',NMCEL,1,IORI)
+        DO 140 IBLK=1,NMCEL
+        INUM(IBLK)=-INUM(IBLK)
+  140   CONTINUE
+        CALL LCMPUT(IPGEO2,'MIX',NMCEL,1,INUM)
+        DEALLOCATE(IHCEL)
+        ISTATE(8)=1
+        ISTATE(9)=NMERGE
+        ISTATE(10)=1
+      ELSE IF(ICLS.EQ.0) THEN
+*       ONE-LEVEL (TRIVAC-TYPE) MACRO-GEOMETRY.
+        CALL LCMPUT(IPGEO2,'MIX',NMCEL,1,IMAT)
+        IF(IHEX.EQ.0) THEN
+          ISTATE(1)=5
+          ALLOCATE(MESHX(LX+1),MESHY(LY+1))
+          MESHX(1)=0.0
+          MESHY(1)=0.0
+          LL1=((NCODE(2).EQ.3).AND.(NCODE(3).EQ.3))
+          LL2=((NCODE(1).EQ.3).AND.(NCODE(4).EQ.3))
+          IBLK=0
+          DO 155 K1=1,LY
+            LXM=1
+            LXP=LX
+            IF(LL1) LXP=K1
+            IF(LL2) LXM=K1
+            DO 150 K2=LXM,LXP
+              IBLK=IBLK+1
+              IKK=INUM(IBLK)
+              IF(IKK.EQ.0) GO TO 150
+              IF(MOD(IORI(IBLK)-1,2).EQ.0) THEN
+                MESHX(K2+1)=MESHX(K2)+XX(IGEN(IKK))
+                MESHY(K1+1)=MESHY(K1)+YY(IGEN(IKK))
+              ELSE
+                MESHX(K2+1)=MESHX(K2)+YY(IGEN(IKK))
+                MESHY(K1+1)=MESHY(K1)+XX(IGEN(IKK))
+              ENDIF
+  150       CONTINUE
+  155     CONTINUE
+          CALL LCMPUT(IPGEO2,'MESHX',LX+1,2,MESHX)
+          CALL LCMPUT(IPGEO2,'MESHY',LY+1,2,MESHY)
+          DEALLOCATE(MESHY,MESHX)
+        ELSE
+          ISTATE(1)=8
+          IF(IHEX.EQ.10) THEN
+            IHEX=1
+          ELSE IF(IHEX.EQ.11) THEN
+            IHEX=2
+          ENDIF
+          CALL LCMPUT(IPGEO2,'IHEX',1,1,IHEX)
+          CALL LCMPUT(IPGEO2,'SIDE',1,2,XX(1))
+        ENDIF
+      ELSE
+        CALL LCMPUT(IPGEO2,'MIX',NMCEL,1,IMAT)
+        CALL LCMPUT(IPGEO2,'RADIUS',LR+1,2,XX)
+        IF(ICLS.EQ.1) THEN
+          ISTATE(1)=3
+        ELSE IF(ICLS.EQ.2) THEN
+          ISTATE(1)=20
+          CALL LCMPUT(IPGEO2,'MESHX',LX+1,2,XXX)
+          CALL LCMPUT(IPGEO2,'MESHY',LY+1,2,YYY)
+        ELSE
+          ISTATE(1)=24
+          IHEX=9
+          CALL LCMPUT(IPGEO2,'IHEX',1,1,IHEX)
+          CALL LCMPUT(IPGEO2,'SIDE',1,2,SIDE)
+        ENDIF
+      ENDIF
+      ISTATE(2)=LR
+      ISTATE(3)=LX
+      ISTATE(4)=LY
+      ISTATE(6)=NMCEL
+      ISTATE(7)=NMERGE
+      CALL LCMPUT(IPGEO2,'STATE-VECTOR',NSTATE,1,ISTATE)
+      HSIGN='L_GEOM'
+      CALL LCMPTC(IPGEO2,'SIGNATURE',12,HSIGN)
+      IF(IPRINT.GT.0) THEN
+         HSIGN='MACRO$GEO'
+         WRITE (6,510) HSIGN,1,TYPE(ISTATE(1))
+         IF(IPRINT.GT.1) THEN
+            WRITE (6,520) ISTATE(1),TYPE(ISTATE(1)),(ISTATE(I),I=2,7)
+         ENDIF
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(YY,XX)
+      DEALLOCATE(IBI,NMC,IMAT,IORI,IGEN,INUM)
+      RETURN
+*
+  500 FORMAT (34HEDIGEO: THE INPUT MIXTURE NUMBER (,I4,12H) IS GREATER,
+     1 10H THAN IR (,I4,2H ))
+  510 FORMAT(/39H EDIGEO: CREATION OF A GEOMETRY NAMED ',A12,7H' ON LE,
+     1 3HVEL,I3,11H WITH TYPE ,A16,1H.)
+  520 FORMAT(/31H STATE VECTOR (MACRO GEOMETRY):/
+     1 7H ITYPE ,I6, 4H   (,A16,1H)/
+     2 7H LR    ,I6,20H   (NUMBER OF TUBES)/
+     3 7H LX    ,I6,22H   (X-DIMENSION INDEX)/
+     4 7H LY    ,I6,22H   (Y-DIMENSION INDEX)/
+     5 7H LZ    ,I6,22H   (Z-DIMENSION INDEX)/
+     6 7H LREG  ,I6,22H   (NUMBER OF REGIONS)/
+     7 7H MAXMIX,I6,25H   (MAX. NB. OF MIXTURES)/1X,60(1H-)/)
+      END