Initial commit from Polytechnique Montreal

1 files changed, 452 insertions, 0 deletions

diff --git a/Dragon/src/FLU.f b/Dragon/src/FLU.f
new file mode 100644
index 0000000..31c14ec
--- /dev/null
+++ b/Dragon/src/FLU.f
@@ -0,0 +1,452 @@
+*DECK FLU
+      SUBROUTINE FLU(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Multigroup flux solution in a lattice.
+*
+*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) create or modification type(L_FLUX).
+*         HENTRY(I) for I>1:
+*         read-only type(L_MACROLIB or L_LIBRARY);
+*         read-only type(L_TRACK);
+*         read-only sequential binary tracking file;
+*         read-only type(L_PIJ);
+*         optional read-only type(L_FLUX) for unperturbed solution;
+*         optional read-only type(L_SOURCE) for fixed sources.
+* 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(IOUT=6,NSTATE=40,NLEAK=7,NSDIR=6)
+      TYPE(C_PTR) IPFLUX,IPTRK,IPMACR,IPSYS,IPFLUP,IPSOU
+      CHARACTER TEXT12*12,TITLE*72,CMODUL*12,HSIGN*12,COPTIO*4,
+     1 CXDOOR*12,TYPE10*10,HISO10*10,CREBAL*3,CHLEAK*3,HTYPE(0:5)*8,
+     2 CLEAK(NLEAK)*6,CSDIR(NSDIR)*1,HPTRK*12,HPMACR*12,HPSYS*12,
+     3 HPFLUP*12,HPGPT*12,HSMG*131,REDUC(4)*3
+      LOGICAL LTABLE,REC,LEAKSW,LFORW
+      DOUBLE PRECISION REFKEF
+      INTEGER ISTATE(NSTATE)
+      REAL B2(4)
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MATCOD,KEYFLX,IMERG
+      REAL, ALLOCATABLE, DIMENSION(:) :: VOL
+*----
+*  DATA STATEMENTS
+*----
+      SAVE        HTYPE,CLEAK,CSDIR
+      DATA       (HTYPE(JJ),JJ=0,5)/'  SOURCE','     GPT','   K-INF',
+     >            '   K-EFF','BUCKLING',' LEAKAGE'/
+      DATA       (CLEAK(JJ),JJ=1,NLEAK)
+     >           /'PNLR',' PNL','SIGS','ALBS','HETE','ECCO','TIBERE'/
+      DATA       (CSDIR(III),III=1,NSDIR)
+     >           /'-','X','Y','Z','R','G'/
+      DATA       (REDUC(JJ),JJ=1,4)
+     >           /'ON ','OFF','ON ','OFF'/
+*----
+*  BICKLEY FLAG
+*----
+      SAVE IBICKL
+      DATA IBICKL/0/
+*----
+*  PARAMETER VALIDATION.
+*----
+      IF(NENTRY.LE.1) CALL XABORT('FLU: TWO PARAMETERS EXPECTED.')
+      IPFLUX=KENTRY(1)
+      REC=(JENTRY(1).EQ.1)
+      IF(REC) THEN
+         CALL LCMGTC(IPFLUX,'SIGNATURE',12,HSIGN)
+         IF(HSIGN.NE.'L_FLUX') THEN
+            TEXT12=HENTRY(1)
+            CALL XABORT('FLU: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1      '. L_FLUX EXPECTED.')
+         ENDIF
+      ELSE
+         HSIGN='L_FLUX'
+         CALL LCMPTC(IPFLUX,'SIGNATURE',12,HSIGN)
+      ENDIF
+      IFTRAK=0
+      IPMACR=C_NULL_PTR
+      IPTRK=C_NULL_PTR
+      IPSYS=C_NULL_PTR
+      IPSOU=C_NULL_PTR
+      IPFLUP=C_NULL_PTR
+      HPTRK=' '
+      HPMACR=' '
+      HPSYS=' '
+      DO 10 I1=2,NENTRY
+      LTABLE=(IENTRY(I1).EQ.1).OR.(IENTRY(I1).EQ.2)
+      IF((IENTRY(I1).EQ.3).AND.(JENTRY(I1).EQ.2)) THEN
+        IFTRAK=FILUNIT(KENTRY(I1))
+      ELSE IF(LTABLE.AND.(JENTRY(I1).EQ.2)) THEN
+        CALL LCMGTC(KENTRY(I1),'SIGNATURE',12,HSIGN)
+        IF((HSIGN.EQ.'L_TRACK').AND.(.NOT.C_ASSOCIATED(IPTRK))) THEN
+          IPTRK=KENTRY(I1)
+          HPTRK=HENTRY(I1)
+        ELSE IF((HSIGN.EQ.'L_MACROLIB').AND.(.NOT.C_ASSOCIATED(IPMACR)))
+     1  THEN
+          IPMACR=KENTRY(I1)
+          HPMACR=HENTRY(I1)
+        ELSE IF((HSIGN.EQ.'L_LIBRARY').AND.(.NOT.C_ASSOCIATED(IPMACR)))
+     1  THEN
+          CALL LCMLEN(KENTRY(I1),'MACROLIB',ILONG,ITYLCM)
+          IF(ILONG.NE.0) THEN
+            IPMACR=KENTRY(I1)
+            HPMACR=HENTRY(I1)
+            CALL LCMSIX(IPMACR,'MACROLIB',1)
+          ENDIF
+        ELSE IF((HSIGN.EQ.'L_PIJ').AND.(.NOT.C_ASSOCIATED(IPSYS))) THEN
+          IPSYS=KENTRY(I1)
+          HPSYS=HENTRY(I1)
+        ELSE IF((HSIGN.EQ.'L_FLUX').AND.(.NOT.C_ASSOCIATED(IPFLUP)))
+     1  THEN
+          IPFLUP=KENTRY(I1)
+          HPFLUP=HENTRY(I1)
+        ELSE IF((HSIGN.EQ.'L_SOURCE').AND.(.NOT.C_ASSOCIATED(IPSOU)))
+     1  THEN
+          IPSOU=KENTRY(I1)
+          HPGPT=HENTRY(I1)
+        ELSE
+          WRITE(HSMG,'(20HFLU: UNKNOWN OBJECT ,A,14H OF SIGNATURE ,A,
+     1    5H (1).)') TRIM(HENTRY(I1)),TRIM(HSIGN)
+          CALL XABORT(HSMG)
+        ENDIF
+      ELSE
+        WRITE(HSMG,'(20HFLU: UNKNOWN OBJECT ,A,1H.)') TRIM(HENTRY(I1))
+        CALL XABORT(HSMG)
+      ENDIF
+   10 CONTINUE
+      IF(.NOT.C_ASSOCIATED(IPTRK)) THEN
+         CALL XABORT('FLU: NO TRACKING OBJECT AT RHS.')
+      ELSE IF(.NOT.C_ASSOCIATED(IPMACR)) THEN
+         CALL XABORT('FLU: NO MACROLIB OBJECT AT RHS.')
+      ELSE IF(.NOT.C_ASSOCIATED(IPSYS)) THEN
+         CALL XABORT('FLU: NO SYSTEM OBJECT AT RHS.')
+      ENDIF
+*----
+*  RECOVER GENERAL TRACKING INFORMATION.
+*----
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE)
+      NREG=   ISTATE(1)
+      NUN=    ISTATE(2)
+      LEAKSW= ISTATE(3).EQ.0
+      IGP4=   ISTATE(4)
+      NSOUT=  ISTATE(5)
+*----
+*  RECOVER MACROLIB PARAMETERS.
+*----
+      CALL LCMPTC(IPFLUX,'LINK.MACRO',12,HPMACR)
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(IPMACR,'STATE-VECTOR',ISTATE)
+      NGRP=   ISTATE(1)
+      NMAT=   ISTATE(2)
+      NANIS=  ISTATE(3)-1
+      NIFIS=  ISTATE(4)
+      ITRANC= ISTATE(6)
+      LFORW = (ISTATE(13).EQ.0)
+      IF(IGP4.GT.NMAT) THEN
+         WRITE(HSMG,'(45HFLU: THE NUMBER OF MIXTURES IN THE TRACKING (,
+     1   I5,55H) IS GREATER THAN THE NUMBER OF MIXTURES IN THE MACROLI,
+     2   3HB (,I5,2H).)') IGP4,NMAT
+         CALL XABORT(HSMG)
+      ENDIF
+*----
+*  RECOVER INFORMATION FROM L_PIJ OBJECT.
+*----
+      ITPIJ=2
+      IPHASE=1
+      IF(C_ASSOCIATED(IPSYS)) THEN
+         CALL LCMGTC(IPSYS,'LINK.MACRO',12,TEXT12)
+         IF(HPMACR.NE.TEXT12) THEN
+            WRITE(HSMG,'(37H FLU: INVALID MACROLIB OBJECT NAME ='',A12,
+     1      18H'', EXPECTED NAME='',A12,2H''.)') HPMACR,TEXT12
+            CALL XABORT(HSMG)
+         ENDIF
+         CALL LCMGTC(IPSYS,'LINK.TRACK',12,TEXT12)
+         IF(HPTRK.NE.TEXT12) THEN
+            WRITE(HSMG,'(37H FLU: INVALID TRACKING OBJECT NAME ='',A12,
+     1      18H'', EXPECTED NAME='',A12,2H''.)') HPTRK,TEXT12
+            CALL XABORT(HSMG)
+         ENDIF
+         CALL LCMPTC(IPFLUX,'LINK.TRACK',12,HPTRK)
+         CALL LCMPTC(IPFLUX,'LINK.SYSTEM',12,HPSYS)
+         CALL LCMGET(IPSYS,'STATE-VECTOR',ISTATE)
+         ITPIJ=ISTATE(1)
+         IPHASE=ISTATE(5)
+         IF(ISTATE(8).NE.NGRP) CALL XABORT('FLU: INVALID NUMBER OF ENE'
+     1   //'RGY GROUPS.')
+         IF(ISTATE(10).GT.NMAT) CALL XABORT('FLU: INVALID NUMBER OF MI'
+     1   //'XTURES.')
+         IF(LEAKSW) THEN
+            IF((ISTATE(2).EQ.0).OR.(ISTATE(3).EQ.0)) LEAKSW=.FALSE.
+         ENDIF
+      ELSE
+         CALL LCMPTC(IPFLUX,'LINK.TRACK',12,HPTRK)
+      ENDIF
+*----
+*  INITIALISE/READ ITERATIONS PARAMETERS
+*----
+      IF(NREG.EQ.0) CALL XABORT('FLU: NREG = 0')
+      ALLOCATE(IMERG(NMAT))
+      CALL FLUGPI(IPFLUX,IPMACR,ITYPEC,MAXOUT,MAXINR,EPSOUT,EPSUNK,
+     1 EPSINR,IREBAL,IFRITR,IACITR,COPTIO,ILEAK,B2,NGRP,NREG,NMAT,
+     2 NIFIS,LEAKSW,REFKEF,ITPIJ,IPRINT,REC,INITFL,NMERG,IMERG)
+      IF(IPHASE.EQ.2) THEN
+        IF((ILEAK.GE.7).AND.(ITPIJ.LT.3)) CALL XABORT('FLU: HETEROGE'//
+     >  'NEOUS BUCKLING CALCULATIONS REQUIRE PIJK EVALUATION IN ASM:')
+      ENDIF 
+*----
+*  RECOVER TRACKING FILE INFORMATION.
+*----
+      CALL LCMGTC(IPTRK,'TRACK-TYPE',12,CMODUL)
+      CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE)
+      IF(IPHASE.EQ.1) THEN
+        CXDOOR=CMODUL
+      ELSE
+        CXDOOR='TRAFIC'
+        IF(.NOT.C_ASSOCIATED(IPSYS)) CALL XABORT('FLU: NO PIJ OBJECT A'
+     1  //'T RHS.')
+      ENDIF
+      IF(CXDOOR.EQ.'MCCG') THEN
+         NLF=ISTATE(6)
+         NANI=ISTATE(6)
+      ELSE IF(CXDOOR.EQ.'BIVAC')  THEN
+         NLF=MAX(1,ISTATE(14))
+         NANI=MAX(1,ISTATE(16))
+      ELSE IF(CXDOOR.EQ.'TRIVAC') THEN
+         NLF=MAX(1,ISTATE(30))
+         NANI=MAX(1,ISTATE(32))
+      ELSE IF(CXDOOR.EQ.'SN') THEN
+         NLF=ISTATE(15)
+         NANI=MAX(1,ISTATE(16))
+      ELSE
+         NLF=1
+         NANI=1
+      ENDIF
+      IF(ITYPEC.EQ.1) THEN
+        IF(.NOT.C_ASSOCIATED(IPFLUP)) CALL XABORT('FLU: NO UNPERTURBED'
+     1  //'FLUX OBJECT AT RHS.')
+        CALL LCMGTC(IPFLUP,'TRACK-TYPE',12,TEXT12)
+        IF(TEXT12.NE.CMODUL) THEN
+          WRITE(HSMG,'(44HFLU: INCONSISTENT UNPERTURBED FLUX TRACK-TYP,
+     1    10HE AT RHS (,A,3H). ,A,10H EXPECTED.)') TRIM(TEXT12),
+     2    TRIM(CMODUL)
+          CALL XABORT(HSMG)
+        ENDIF
+        IF(.NOT.C_ASSOCIATED(IPSOU)) CALL XABORT('FLU: NO SOURCE OBJEC'
+     1  //'T AT RHS.')
+        CALL LCMGTC(IPSOU,'TRACK-TYPE',12,TEXT12)
+        IF(TEXT12.NE.CMODUL) THEN
+          WRITE(HSMG,'(44HFLU: INCONSISTENT SOURCE OBJECT TRACK-TYPE A,
+     1    7HT RHS (,A,3H). ,A,10H EXPECTED.)') TRIM(TEXT12),TRIM(CMODUL)
+          CALL XABORT(HSMG)
+        ENDIF
+      ENDIF
+      IF(REC) THEN
+        CALL LCMGTC(IPFLUX,'TRACK-TYPE',12,TEXT12)
+        IF(TEXT12.NE.CMODUL) THEN
+          WRITE(HSMG,'(44HFLU: INCONSISTENT FLUX OBJECT TRACK-TYPE AT ,
+     1    5HRHS (,A,3H). ,A,10H EXPECTED.)') TRIM(TEXT12),TRIM(CMODUL)
+          CALL XABORT(HSMG)
+        ENDIF
+      ENDIF
+      CALL LCMPTC(IPFLUX,'TRACK-TYPE',12,CMODUL)
+*----
+*  CHECK FOR THE ANISOTROPY SETTINGS COHERENCE
+*----
+      IF((ITRANC.NE.0).AND.(NANI.GT.1)) THEN
+         WRITE(IOUT,6400) CXDOOR,NANI
+         ITRANC=0
+      ENDIF
+*----
+*  RECOVER TABULATED FUNCTIONS FOR THE METHOD OF CHARACTERISTICS.
+*----
+      IF((CXDOOR.EQ.'MCCG').AND.(IBICKL.EQ.0)) THEN
+        CALL XDRTA2
+        IBICKL=1
+      ENDIF
+*----
+*  THE NUMBER OF UNKNOWNS OF A CURRENT-BASED MULTICELL ITERATION IS
+*  INCREASED TO HOLD INTERFACE CURRENT COMPONENTS.
+*----
+      IF(IPHASE.EQ.1) THEN
+        IF(CXDOOR.EQ.'SYBIL') NUN=NUN+ISTATE(9)
+        IF((CXDOOR.EQ.'EXCELL').AND.(ISTATE(7).EQ.5)) NUN=NUN+ISTATE(28)
+      ENDIF
+*----
+*  THE NUMBER OF UNKNOWNS IS MULTIPLIED BY 2 WITH THE ECCO-TYPE
+*  ISOTROPIC STREAMING MODEL AND BY 4 FOR PIJ AND 8 FOR MOC WITH THE
+*  TIBERE ANISOTROPIC STREAMING MODEL. THE EXTRA-LOCATIONS ARE USED TO
+*  STORE THE HETEROGENEOUS FUNDAMENTAL CURRENT VALUES.
+*----
+      IF(ILEAK.EQ.6) NUN=NUN*2
+      IF(ILEAK.GE.7) THEN
+        IF (CXDOOR.EQ.'MCCG')THEN
+          NUN=NUN*8
+        ELSE
+          NUN=NUN*4
+        ENDIF
+      ENDIF  
+*----
+*  PRINT REQUIRED INFORMATION
+*----
+      IF(IPRINT.GE.1) THEN
+        IF(LFORW) THEN
+          TYPE10='    DIRECT'
+        ELSE
+          TYPE10='   ADJOINT'
+        ENDIF
+        IF(NLF.EQ.1 ) THEN
+          HISO10=' ISOTROPIC'
+        ELSE
+          HISO10=' ANISOTROP'
+        ENDIF
+        WRITE(IOUT,6010) HTYPE(ITYPEC),TYPE10,HISO10
+        IF(ITYPEC.EQ.3) THEN
+            WRITE(IOUT,6011) COPTIO,CLEAK(MOD(ILEAK,10)),' IMPOSED'
+            IF(ILEAK.LT.7) THEN
+              WRITE(IOUT,6012) B2(4)
+            ELSE
+              WRITE(IOUT,6013) B2(1),B2(2),B2(3)
+            ENDIF
+        ELSE IF(ITYPEC.GT.3) THEN
+          IF(ILEAK.LT.7) THEN
+            WRITE(IOUT,6011) COPTIO,CLEAK(ILEAK),'G SEARCH'
+            WRITE(IOUT,6012) B2(4)
+          ELSE
+            WRITE(IOUT,6011) COPTIO,CLEAK(7),CSDIR(ILEAK/10)//' SEARCH'
+            WRITE(IOUT,6013) B2(1),B2(2),B2(3)
+          ENDIF
+        ENDIF
+        CREBAL='ON '
+        IF(IREBAL.EQ.0) CREBAL='OFF'
+        CHLEAK='ON '
+        IF(LEAKSW) CHLEAK='OFF'
+        WRITE(IOUT,6000) CXDOOR,NGRP,NREG,NUN,NMERG,MAXOUT,MAXINR,
+     >                   IFRITR,IACITR,CREBAL,REDUC(ITPIJ),CHLEAK,
+     >                   EPSOUT,EPSUNK,EPSINR
+        IF(ITRANC.GT.0) WRITE(IOUT,6100)
+      ENDIF
+*----
+*  RECOVER SPECIFIC TRACKING INFORMATION.
+*----
+      IF(CXDOOR.EQ.'MCCG') THEN
+         CALL LCMGET(IPTRK,'MCCG-STATE',ISTATE)
+         NFUNL=ISTATE(19)
+         NLIN=ISTATE(20)
+      ELSE IF(CXDOOR.EQ.'SN') THEN
+         CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE)
+         NFUNL=ISTATE(7)
+         NLIN=ISTATE(8)
+         NDIM=ISTATE(9)
+         NLIN=NLIN**NDIM
+         NLIN=NLIN*ISTATE(35)
+      ELSE
+         NFUNL=1
+         NLIN=1
+      ENDIF
+      ALLOCATE(MATCOD(NREG),VOL(NREG),KEYFLX(NREG*NLIN*NFUNL))
+      KEYFLX(:NREG*NLIN*NFUNL)=0
+      CALL LCMLEN(IPTRK,'MATCOD',ILNLCM,ITYLCM)
+      IF(ILNLCM.NE.NREG) 
+     1   CALL XABORT( 'FLU: INCOMPATIBLE NUMBER OF REGIONS.')
+      CALL LCMGET(IPTRK,'MATCOD',MATCOD)
+      CALL LCMGET(IPTRK,'VOLUME',VOL)
+      IF((CXDOOR.EQ.'MCCG').OR.(CXDOOR.EQ.'SN')) THEN
+         CALL LCMGET(IPTRK,'KEYFLX$ANIS',KEYFLX)
+      ELSE
+         CALL LCMGET(IPTRK,'KEYFLX',KEYFLX)
+      ENDIF
+      CALL LCMLEN(IPTRK,'TITLE',ILNLCM,ITYLCM)
+      IF( ILNLCM.GT.0 )THEN
+         CALL LCMGTC(IPTRK,'TITLE',72,TITLE)
+      ELSE
+         TITLE='*** NO TITLE PROVIDED ***'
+      ENDIF
+*----
+*  COMPUTE THE FLUX.
+*----
+      IF(ITYPEC.EQ.1) THEN
+*       FIXED SOURCE EIGENVALUE PROBLEM
+        CALL FLUGPT(IPRINT,IPFLUX,IPTRK,IPMACR,IPFLUP,IPSOU,IFTRAK,
+     1  IPSYS,IPHASE,ITPIJ,CXDOOR,TITLE,INITFL,LFORW,LEAKSW,IREBAL,
+     2  NGRP,NMAT,NIFIS,NANIS,NLF,NLIN,NFUNL,COPTIO,NUN,MAXINR,EPSINR,
+     3  MAXOUT,EPSUNK,EPSOUT,IFRITR,IACITR,ILEAK,NREG,NSOUT,MATCOD,
+     4  KEYFLX,VOL,REFKEF,NMERG,IMERG)
+      ELSE
+        CALL FLUDRV(IPRINT,IPFLUX,IPTRK,IPMACR,IPSOU,IFTRAK,IPSYS,
+     1  IPHASE,ITPIJ,CXDOOR,ITRANC,TITLE,B2,INITFL,LFORW,LEAKSW,IREBAL,
+     2  NGRP,NMAT,NIFIS,NANIS,NLF,NLIN,NFUNL,COPTIO,NUN,MAXINR,EPSINR,
+     3  MAXOUT,EPSUNK,EPSOUT,IFRITR,IACITR,ITYPEC,ILEAK,NREG,NSOUT,
+     4  MATCOD,KEYFLX,VOL,REFKEF,NMERG,IMERG)
+      ENDIF
+*----
+*  RELEASE GENERAL TRACKING INFORMATION.
+*----
+      DEALLOCATE(IMERG)
+      DEALLOCATE(KEYFLX,VOL,MATCOD)
+      CALL LCMSIX(IPMACR,' ',0)
+      RETURN
+*
+6000  FORMAT(' FLUX SOLUTION DOOR          = ** ',A6,' **'/
+     > ' NB. OF GROUPS               =',I10/
+     > ' NB. OF REGIONS              =',I10/
+     > ' NB. OF UNKNOWNS PER GROUP   =',I10/
+     > ' NB. OF LEAKAGE ZONES        =',I10/
+     > ' MAX. OUTER ITERATIONS       =',I10/
+     > ' MAX. THERMAL ITERATIONS     =',I10/
+     > ' ACCELERATION SCHEME         =(',I2,' FREE,',I2,' ACCELERATED)'/
+     > ' REBALANCING OPTION          = ',A3/
+     > ' SELF-SCATTERING REDUCTION   = ',A3/
+     > ' FUNDAMENTAL MODE            = ',A3/
+     > ' EIGENVALUE TOLERANCE        = ',1P,E10.3/
+     > ' UNKNOWN OUTER TOLERANCE     = ',E10.3/
+     > ' UNKNOWN INNER TOLERANCE     = ',E10.3/)
+6010  FORMAT(////' P. I. M.    SOLUTION TO TRANSPORT EQUATION',//
+     > ' CALCULATION TYPE            =',2X,A8/
+     > ' FORWARD/BACKWARD OPTION     =',A10/
+     > ' (AN)ISOTROPY OPTION         =',A10)
+6011  FORMAT(' LEAKAGE TYPE                =',6X,A4/
+     > ' LEAKAGE OPTION              =',6X,A6/
+     > ' BUCKLING                    =',2X,A8)
+6012  FORMAT(' INITIAL TOTAL BUCKLING      =',1P,E13.5)
+6013  FORMAT(' INITIAL BUCKLING - X        =',1P,E13.5/
+     >       ' INITIAL BUCKLING - Y        =',1P,E13.5/
+     >       ' INITIAL BUCKLING - Z        =',1P,E13.5)
+6100  FORMAT(/' USE TRANSPORT CORRECTED CROSS-SECTIONS')
+6400  FORMAT(//' *** WARNING:  DOOR ',A12,'IS USED WITH AN ANISOTROPY',
+     > ' LEVEL FROM L_TRACK =',I2,' AND WITH A TRANSPORT CORRECTION S',
+     > 'ET IN LIB:.'/15X,'--> THE TRANSPORT CORRECTION IS DISABLED.'/)
+      END