Initial commit from Polytechnique Montreal

1 files changed, 241 insertions, 0 deletions

diff --git a/Donjon/src/D2PINP.f b/Donjon/src/D2PINP.f
new file mode 100644
index 0000000..2d7e44d
--- /dev/null
+++ b/Donjon/src/D2PINP.f
@@ -0,0 +1,241 @@
+*DECK D2PINP
+      SUBROUTINE  D2PINP( IPSAP, IPDAT , IPRINT, STAVEC, CRDINF,   NCRD,
+     >                     PKEY,   ISOT,   MESH, USRPAR, USRVAL, USRSTA,
+     >                  USRVAPK,    SAP,    MIC, EXC   ,   SCAT, ADF   ,
+     >                      DEB,   FA_K,   LADD,   LNEW,    MIX,    XSC,
+     >                   JOBOPT, SIGNAT, MIXDIR,    CDF,    GFF,   ADFD,
+     >                     CDFD,    YLD, YLDOPT, LOCYLD,  OTHPK, OTHTYP,
+     >                   OTHVAL,   HDET, OTHVAR,   THCK,   HFLX,   HCUR)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* 1) Recover data from saphyb or multicompo object.
+* 2) Build headers of GenPMAXS and Helios like file
+*
+*Copyright:
+* Copyright (C) 2015 IRSN
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input/output
+* IPSAP   address of saphyb or multicompo object
+* IPDAT   address of data structure INFO
+* NCRD    number of control rod composition recovered from D2P
+*         input user
+* MIX     index of mixture on which XS are to be extracted (only
+*         for reflector cases)
+* FA_K    assembly type
+*         =0 reflector
+*         =1 assembly
+* USRSTA  state variable names recovered from GLOBAL record in D2P:
+* USRVAL  number of value for state variables  recovered from GLOBAL
+*         record in D2P:
+* IPRINT  control the printing on screen
+* STAVEC  various parameters associated with the IPDAT structure
+* CRDINF  meaning of control rods in the IPSAP object
+* XSC     XS_CONT recovered from D2P: input
+* DEB     FLAG to indicate the first call to the D2PGEN subroutine
+* USRVAPK value of state prameter set by the user and recoverd from
+*         USER ADD option in D2P:
+* ADF     type of ADF to be selected
+* JOBOPT  flag for JOB_OPT record in IPINP object
+* USRPAR  name of state variables (sapnam) in IPSAP associated to
+*         DMOD TCOM etc. recovered from PKEY card in D2P:
+* MESH    type of meshing to be applied for the branching calculation
+* PKEY    name of state variable (refnam) recovered from PKEY card in
+*         D2P:
+* ISOT    name of isotopes in IPSAP for xenon samarium and promethium
+* SAP     flag to indicate that absorption cross section must be
+*         directly recovered from IPSAP
+* MIC     flag to indicate that absorption cross section must be
+*         directly recovered from IPMIC
+* EXC     flag to indicate that excess cross section is to be extracted
+*         from absoption xs (only if SAP)
+* SCAT    flag to indicate that scattering cross section must be
+*         directly reconstructed from IPSAP
+* LADD    flag to indicate that new points must be added to the IPSAP
+*         original meshing
+* LNEW    flag to indicate that only new points must be used during the
+*         branching calculation
+* SIGNAT  signature of the object containing cross sections
+* MIXDIR  directory that contains homogeneous mixture information
+* CDF     type of CDF to be selected
+* GFF     type of GFF to be selected
+* ADFD    name of record for 'DRA' type of ADF
+* CDFD    name of record for 'DRA' type of CDF
+* YLD     user defined values for fission yields (1:I, 2:XE, 3:PM)
+* LOCYLD  value for state parameter on which fission yield will be
+*         calculated
+* YLDOPT  option for fission yields calculation (DEF, MAN, FIX)
+* HDET    name of isotope for the detector cross sections
+* THCK    Thickness of reflector
+* HFLX    Name of the record for the flux
+* HCUR    Name of the record for the current
+*
+*Parameters: 
+* OTHPK   
+* OTHTYP  
+* OTHVAL  
+* OTHVAR  
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPSAP,IPDAT
+      INTEGER NCRD,MIX,FA_K,USRSTA
+      INTEGER IPRINT,DEB
+      REAL THCK
+      INTEGER STAVEC(40),CRDINF(20),USRVAL(12)
+      REAL YLD(3),LOCYLD(5)
+      REAL XSC(3)
+      REAL USRVAPK(12,10),OTHVAR(12)
+      CHARACTER JOBOPT(16)
+      CHARACTER*3 ADF,CDF,GFF,YLDOPT
+      CHARACTER*8 ADFD(4),CDFD(8)
+      CHARACTER*5 MESH
+      CHARACTER*8 PKEY(6),HFLX(2),HCUR(2)
+      CHARACTER*12 ISOT(8), SIGNAT,MIXDIR,USRPAR(12)
+      CHARACTER*12 OTHPK(12), OTHTYP(12), OTHVAL(12),HDET
+      LOGICAL SAP, MIC, EXC,SCAT,LADD,LNEW
+*----
+*  LOCAL VARIABLES
+*----
+      LOGICAL :: LADF=.FALSE.
+      LOGICAL :: LCDF=.FALSE.
+      LOGICAL :: LGFF=.FALSE.
+      LOGICAL :: LYLD=.FALSE.
+      INTEGER NADF,NCDF
+
+      IF (JOBOPT(1)=='T') THEN
+        NADF=STAVEC(13)
+        IF (NADF.NE.XSC(1)) THEN
+         WRITE(6,*)'@D2PINP: INCOHERENT NUMBER OF ADF (',NADF,
+     >   ')','AND NUMBER OF SIDES IN ASSEMBLY (',XSC(1),').'
+         CALL XABORT ("=> CHECK CARD 'ADF' AND 'XS_CONT'")
+        ENDIF
+        IF ((SIGNAT.EQ.'L_SAPHYB').and.(ADF.EQ.'DRA')) THEN
+          WRITE(6,*) "@D2PINP: ADF OF TYPE (",ADF,
+     1     ") NOT YET IMPLEMENTED WITH SAPHYB OBJECT"
+          WRITE(6,*)"=> WARNING :  ADF CALUCLATION IGNORED"
+          LADF = .FALSE.
+          JOBOPT(1)='F'
+        ELSE IF ((SIGNAT.EQ.'L_MULTICOMPO').and.
+     >     ((ADF.EQ.'SEL').OR.(ADF.EQ.'SEL'))) THEN
+          WRITE(6,*) "@D2PINP: ADF OF TYPE (",ADF,
+     1     " NOT YET IMPLEMENTED WITH MULTICOMPO OBJECT"
+          WRITE(6,*)"=> WARNING :  ADF CALUCLATION IGNORED"
+          LADF = .FALSE.
+          JOBOPT(1)='F'
+        ELSE
+          LADF = .TRUE.
+        ENDIF
+      ELSE
+        LADF = .FALSE.
+      ENDIF
+      IF (JOBOPT(10)=='T') THEN
+        NCDF=STAVEC(15)
+        IF (NCDF.NE.XSC(2)) THEN
+         WRITE(6,*)'@D2PINP: INCOHERENT NUMBER OF CDF (',NCDF,
+     >   ')','AND NUMBER OF CORNERS IN ASSEMBLY (',XSC(2),').'
+         CALL XABORT ("=> CHECK CARD 'CDF' AND 'XS_CONT'")
+        ENDIF
+        IF (SIGNAT.EQ.'L_SAPHYB') THEN
+          WRITE(6,*) "@D2PINP: CDF CALCULATION",
+     1     " NOT YET IMPLEMENTED WITH SAPHYB OBJECT"
+          WRITE(6,*)"=> WARNING :  CDF CALUCLATION IGNORED"
+          LCDF = .FALSE.
+          JOBOPT(10)='F'
+        ENDIF
+        IF (CDF.NE. 'DRA') THEN
+         CALL XABORT ("@D2PINP UNKNOW CDF TYPE : "//CDF//'.')
+        ENDIF
+        LCDF = .TRUE.
+      ELSE
+        LCDF = .FALSE.
+      ENDIF
+      IF (JOBOPT(11)=='T') THEN
+        IF (SIGNAT.EQ.'L_SAPHYB') THEN
+          WRITE(6,*) "@D2PINP: GFF CALCULATION",
+     1     " NOT YET IMPLEMENTED WITH SAPHYB OBJECT"
+          WRITE(6,*)"=> WARNING :  GFF CALUCLATION IGNORED"
+          LGFF = .FALSE.
+          JOBOPT(11)='F'
+        ENDIF
+        IF (GFF.NE. 'DRA') THEN
+         CALL XABORT ("@D2PINP UNKNOW GFF TYPE : '"//GFF//"'.")
+        ENDIF
+        LGFF = .TRUE.
+      ELSE
+        LGFF = .FALSE.
+      ENDIF
+
+      IF (JOBOPT(9)=='T') LYLD = .TRUE.
+      IF ((JOBOPT(2)=='T').and.(JOBOPT(9)=='F')) THEN
+          WRITE(6,*) "@D2PINP: JOB_OPT : XE/SM ARE REQUESTED (lxes=T) ",
+     1     "BUT FISSION YIELDS ARE NOT RECOVERED (lyld=F) "
+         WRITE(6,*) "=> THE lyld FLAG IS FORCED TO TRUE"
+         JOBOPT(9)='T'
+         LYLD = .TRUE.
+      ENDIF
+
+      IF((FA_K.EQ.1).OR.(FA_K.EQ.0)) THEN
+*       CASE FOR FUEL PMAXS
+        IF (SIGNAT.EQ.'L_SAPHYB') THEN
+        STAVEC(18)=0
+        WRITE(6,*) "*******    EXTRACTION OF DATA FROM SAPHYB      ****"
+        CALL    D2PSAP (  IPSAP,  IPDAT, STAVEC, CRDINF,   NCRD,   PKEY,
+     >                    ISOT ,   MESH, USRPAR, USRVAL, USRSTA,USRVAPK,
+     >                    SAP  ,    MIC,    EXC,   SCAT,    ADF,   LADD,
+     >                    LNEW ,   LADF, IPRINT,   LYLD,    YLD, YLDOPT,
+     >                    LOCYLD,  HDET                                )
+
+        ELSE  IF (SIGNAT.EQ.'L_MULTICOMPO') THEN
+        STAVEC(18)=1
+        WRITE(6,*) "*******    EXTRACTION OF DATA FROM MULTICOMPO  ****"
+        WRITE(6,*)
+        WRITE(6,*) "DIRECTORY:'",MIXDIR,"' AT MIXUTRE INDEX ",MIX,"."
+        WRITE(6,*) "=> WARNING: CHECK EXISTENCE OF ",MIXDIR,"DIRECTORY."
+        CALL LCMLIB(IPSAP)
+         IF (LADF) THEN
+          WRITE(6,*) "ADF CALCULATION REQUESTED:"
+          WRITE(6,*)"=> WARNING: CHECK EXISTENCE OF ADF RECORDS"
+         ENDIF
+         IF (LCDF) THEN
+          WRITE(6,*) "CDF CALCULATION REQUESTED:"
+          WRITE(6,*)"=> WARNING: CHECK EXISTENCE OF '",CDFD(1:NCDF),
+     >     "' RECORDS"
+         ENDIF
+
+        CALL  D2PMCO   (  IPSAP,  IPDAT, STAVEC, CRDINF,   NCRD,   PKEY,
+     >                    ISOT ,   MESH, USRPAR, USRVAL, USRSTA,USRVAPK,
+     >                    SAP  ,    MIC,    EXC,   SCAT,    ADF,   LADD,
+     >                    LNEW ,   LADF, IPRINT, MIXDIR,    MIX,   LCDF,
+     >                    LGFF ,    CDF,    GFF,   ADFD,   CDFD,  LYLD ,
+     >                      YLD, YLDOPT, LOCYLD,  OTHPK, OTHTYP, OTHVAL,
+     >                   OTHVAR,   THCK,   HFLX,   HCUR                )
+        ELSE
+         CALL XABORT ('@D2PINP: UNKNOWN SIGNATURE')
+        ENDIF
+      ELSE
+        CALL XABORT('@D2PINP: PHASE 1: FUEL OR REFLECTOR CARD EXPECTED')
+      ENDIF
+
+      IF (YLDOPT.EQ.'MAN') THEN
+       DEB = -1
+      ELSE
+       DEB = 0
+      ENDIF
+
+      IF (STAVEC(19).EQ.1) THEN
+       WRITE(6,*)"=> WARNING: THE TEMPERATURE ARE INDIACTED IN K"
+      ENDIF
+
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMPUT(IPDAT,'STATE-VECTOR',40,1,STAVEC)
+
+      END