diff options
Diffstat (limited to 'Donjon/src/D2PDRV.f')
| -rw-r--r-- | Donjon/src/D2PDRV.f | 419 |
1 files changed, 419 insertions, 0 deletions
diff --git a/Donjon/src/D2PDRV.f b/Donjon/src/D2PDRV.f new file mode 100644 index 0000000..fe41a0a --- /dev/null +++ b/Donjon/src/D2PDRV.f @@ -0,0 +1,419 @@ +*DECK D2PDRV + SUBROUTINE D2PDRV( NENTRY, HENTRY, IENTRY, JENTRY, KENTRY, NGP, + > NCRD, MIX, FA_K, IUPS, USRSTA, PHASE, + > IPRINT, STAVEC, CRDINF, USRVAL, VERS, SFAC, + > BFAC, FC1, FC2, FC3, FC4, XSC, + > USRVAPK, ADF, DER, JOBOPT, USRPAR, MESH, + > PKEY, FILNAM, ISOT, JOBTIT, COM, SAP, + > MIC, EXC, SCAT, LADD, LNEW, MIXDIR, + > CDF, GFF, ADFD, CDFD, YLD, YLDOPT, + > LOCYLD, XESM, ITEMP, OTHPK, OTHTYP, OTHVAL, + > HDET, LPRC, HEQUI, HMASL,ISOTOPT,ISOTVAL, + > LMEM,OTHVAR, THCK, HFLX, HCUR ) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Store an isotopic data recovered from a Saphyb into a Microlib. +* +*Copyright: +* Copyright (C) 2015 IRSN +* +*Author(s): +* J. Taforeau +* +*Parameters: input/output +* NENTRY number of data structures transfered to this module. +* HENTRY name of the data structures. +* IENTRY data structure type where: +* IENTRY=1 for LCM memory object; +* IENTRY=2 for XSM file; +* IENTRY=3 for sequential binary file; +* IENTRY=4 for sequential ASCII file. +* JENTRY access permission for the data structure where: +* JENTRY=0 for a data structure in creation mode; +* JENTRY=1 for a data structure in modifications mode; +* JENTRY=2 for a data structure in read-only mode. +* KENTRY data structure pointer. +* NGP number of energy groups recovered from D2P input user +* 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 +* IUPS treatment for upscattering +* =0 keep up scatter XS +* =1 remove up scatter XS, modify down scatter with DRAGON +* spectrum (not available in this version) +* =2 remove up scatter XS, modify down scatter with infinite +* medium spectrum +* USRSTA state variable names recovered from GLOBAL record in D2P: +* USRVAL number of value for state variables recovered from GLOBAL +* record in D2P: +* PHASE the current phase of D2P: +* IPRINT control the printing on screen +* STAVEC various parameters associated with the IPDAT structure +* CRDINF meaning of control rods in the IPSAP object +* VERS version of PARCS to be used +* SFAC the scattering cross section factor +* BFAC the multiplier for betas +* FC1 FILE_CONT_1 recovered from D2P: input +* FC2 FILE_CONT_2 recovered from D2P: input +* FC3 FILE_CONT_3 recovered from D2P: input +* FC4 FILE_CONT_4 recovered from D2P: input +* XSC XS_CONT recovered from D2P: input +* USRVAPK value of state prameter set by the user and recoverd from +* USER ADD option in D2P: +* ADF type of ADF to be selected +* DER partials derivative (T) or row cross section (F) to be stored +* in PMAXS +* 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: +* FILNAM name of IPINP +* ISOT name of isotopes in IPSAP for xenon samarium and promethium +* JOBTIT title of in header of PMAXS file +* COM comment to be printed in PMAXS file +* 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 +* 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 calcu +* YLDOPT option for fission yield calculation (DEF, MAN, FIX) +* XESM option for comparing k-inf in GenPMAX (1: using Pm/Sm data; +* 2: using I/Xe data; 3: using I/Xe/Pm/Sm data) +* ITEMP indicate if temperature is in C or in K in the SAP/MCO objec +* HDET name of isotope for the detector cross sections +* LMER ADF are merged in the 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 +* LPRC +* HEQUI +* HMASL +* ISOTOPT +* ISOTVAL +* LMEM +* OTHVAR +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY) + TYPE(C_PTR) KENTRY(NENTRY) + CHARACTER HENTRY(NENTRY)*12 + INTEGER NGP,NCRD,MIX,FA_K,IUPS,USRSTA,XESM + INTEGER PHASE,IPRINT,ITEMP + REAL THCK + INTEGER STAVEC(40),CRDINF(20),USRVAL(12) + REAL VERS,SFAC,BFAC,YLD(3),LOCYLD(5) + REAL FC1(5),FC2(8),FC3(7),FC4(3),XSC(3) + REAL USRVAPK(12,10),ISOTVAL,OTHVAR(12) + CHARACTER JOBOPT(16) + CHARACTER*12 OTHTYP(12),OTHPK(12),OTHVAL(12),HDET + CHARACTER*3 ADF,CDF,GFF,YLDOPT + CHARACTER*8 ADFD(4),CDFD(8) + CHARACTER*4 DER,HEQUI,HMASL,JOB(4) + CHARACTER*1 ISOTOPT + CHARACTER*5 MESH + CHARACTER*8 PKEY(6) + CHARACTER*12 FILNAM,ISOT(6),SIGNAT,MIXDIR,USRPAR(12) + CHARACTER*16 JOBTIT + CHARACTER*8 HCUR(2),HFLX(2) + CHARACTER*40 COM + LOGICAL SAP, MIC, EXC,SCAT,LADD,LNEW,LPRC,LMEM +*---- +* LOCAL VARIABLES +*---- + TYPE(C_PTR) IPSAP,IPDAT,IPMIC + INTEGER IPHEL,IPINP,IPPRC + INTEGER DEB,REW + CHARACTER TEXT12*12,HSIGN*12,HSMG*131 + + IF (IPRINT.EQ.-1) IPRINT = 0 +*---- +* PHASE 1 : SET HEADER OF GENPMAXS INPUT FILE (.inp) AND HELIOS LIKE FI +*---- + IF (PHASE.EQ.1) THEN + IF(NENTRY.NE.3) CALL XABORT('@D2PDRV: 3 PARAMETERS EXPECTED.') + IF((IENTRY(1).NE.4)) THEN + WRITE(HSMG,'(12H@D2P: ENTRY ,A12,24H IS NOT OF SEQUENTIAL AS, + > 9HNCII TYPE)') HENTRY(2) + CALL XABORT(HSMG) + ELSE IF(JENTRY(1).EQ.2) THEN + WRITE(HSMG,'(12H@D2P: ENTRY ,A12,24H IS NOT IN CREATION OR I, + > 19HN MODIFICATION MODE)') + > HENTRY(1) + CALL XABORT(HSMG) + ENDIF + IF(IENTRY(2).NE.1) THEN + WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,19H IS NOT OF LCM TYPE)') + > HENTRY(2) + CALL XABORT(HSMG) + ELSE IF(JENTRY(2).EQ.2) THEN + WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT IN CREATION OR I, + > 19HN MODIFICATION MODE)') + > HENTRY(2) + CALL XABORT(HSMG) + ENDIF + CALL LCMGTC(KENTRY(2),'SIGNATURE',12,HSIGN) + IF(HSIGN.NE.'L_INFO') THEN + TEXT12=HENTRY(2) + CALL XABORT('@D2P: SIGNATURE OF '//TEXT12//' IS '//HSIGN// + 1 '. L_INFO EXPECTED.') + ENDIF + IF(IENTRY(3).GT.2) THEN + WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,19H IS NOT OF LCM TYPE)') + > HENTRY(3) + CALL XABORT(HSMG) + ELSE IF(JENTRY(3).NE.2) THEN + WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,20H IS NOT IN READ ONLY, + > 5H MODE)') + > HENTRY(3) + CALL XABORT(HSMG) + ENDIF + CALL LCMGTC(KENTRY(3),'SIGNATURE',12,HSIGN) + SIGNAT=HSIGN + IF((HSIGN.NE.'L_SAPHYB')) THEN + IF(HSIGN.NE.'L_MULTICOMPO') THEN + TEXT12=HENTRY(3) + CALL XABORT('@D2PDRV: SIGNATURE OF '//TEXT12//' IS '//HSIGN// + 1 '. L_SAPHYB OR L_MULTICOMPO EXPECTED.') + ENDIF + ENDIF + + IPPRC=FILUNIT(KENTRY(1)) + IPDAT=KENTRY(2) ! output INFO address + IPSAP=KENTRY(3) ! input saphyb address +* + STAVEC(8)=INT(FC1(1)) + STAVEC(9)=INT(FC1(2)) + STAVEC(10)=INT(FC1(3)) + STAVEC(11)=INT(XSC(1)) + STAVEC(12)=INT(XSC(2)) + STAVEC(19)=ITEMP + IF ((XSC(1).GT.4).OR.(XSC(2).GT.8)) THEN + CALL XABORT ('@D2PDRV: CARD XS_CONT : NSIDE AND NCORNER' + 1 //' CANNOT EXCEED 4 AND 8 RESPECTIVELY.') + ENDIF + IF (MESH.EQ.'GLOB'.OR.MESH.EQ.'ADD') THEN + IF ((JOBOPT(1).EQ.'T').AND. (ADF .NE. 'DRA')) THEN + CALL XABORT('@D2PDRV: ADF OF TYPE (SEL/GET) CANNOT BE EXTRACT' + 1 //'ED WITH USER DEFINED BRANCHING CALCULATION') + ENDIF + ENDIF + WRITE(6,*) "****************************************************" + WRITE(6,*) "* DRAG2PARCS INPUT DATA RECOVERED *" + WRITE(6,*) "****************************************************" + IF(IPRINT > 0) THEN + WRITE(6,*) "****************************************************" + WRITE(6,*) "* PHASE 1 : RECOVER DATA AND CREATE INPUT FILES *" + WRITE(6,*) "****************************************************" + WRITE(6,*) + ENDIF +*---- + CALL 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) + + CALL D2PGEN ( IPINP, IPDAT, STAVEC, JOBTIT, FILNAM, DER, + > VERS, COM, JOBOPT, IUPS, FA_K, SFAC, + > BFAC, DEB, XESM, FC1 , FC2, FC3, + > FC4, XSC, IPRINT ) + + IF (LPRC) THEN + WRITE(6,*) "****************************************************" + WRITE(6,*) "* BUILDING PROCEDURE *" + WRITE(6,*) "****************************************************" + CALL D2PPRC( IPDAT, IPPRC,HEQUI, HMASL, ISOTVAL, ISOTOPT,LMEM, + > IPRINT,MIXDIR,JOBOPT ) + ENDIF + IF(IPRINT > 0) THEN + WRITE(6,*) "****************************************************" + WRITE(6,*) "* END OF PHASE 1 *" + WRITE(6,*) "****************************************************" + ENDIF +*---- +* PHASE 2 : BRANCHING CALCULATION +*---- + ELSE IF (PHASE.EQ.2) THEN + IF(NENTRY.NE.5) CALL XABORT('@D2PDRV: 5 PARAMETERS EXPECTED.') + IF(IENTRY(1).NE.4) THEN + WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT OF SEQUENTIAL AS, + > 9HNCII TYPE)') HENTRY(1) + CALL XABORT(HSMG) + ELSE IF(JENTRY(1).EQ.2) THEN + WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT IN CREATION OR I, + > 19HN MODIFICATION MODE)') + > HENTRY(1) + CALL XABORT(HSMG) + ENDIF + IF((IENTRY(5).GT.2)) THEN + WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,19H IS NOT OF XSM TYPE)') + > HENTRY(5) + CALL XABORT(HSMG) + ELSE IF(JENTRY(5).NE.2) THEN + WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT IN READ-ONLY MOD, + > 1HE)') + > HENTRY(5) + CALL XABORT(HSMG) + ENDIF + CALL LCMGTC(KENTRY(3),'SIGNATURE',12,HSIGN) + IF(HSIGN.NE.'L_INFO') THEN + TEXT12=HENTRY(3) + CALL XABORT('@D2PDRV: SIGNATURE OF '//TEXT12//' IS '//HSIGN// + 1 '. L_INFO EXPECTED.') + ENDIF + CALL LCMGTC(KENTRY(5),'SIGNATURE',12,SIGNAT) + IF((SIGNAT.NE.'L_SAPHYB')) THEN + IF(SIGNAT.NE.'L_MULTICOMPO') THEN + TEXT12=HENTRY(5) + CALL XABORT('@D2PDRV: SIGNATURE OF '//TEXT12//' IS '//SIGNAT// + 1 '. L_SAPHYB OR L_MULTICOMPO EXPECTED.') + ENDIF + ENDIF + IPHEL=FILUNIT(KENTRY(1)) + IPINP=FILUNIT(KENTRY(2)) ! input GENPMAXS file unit + IPDAT=KENTRY(3) ! input DATA vector address + IPMIC=KENTRY(4) ! input Microlib vector address + IPSAP=KENTRY(5) ! input SAPHYB OBJECT + IF(IPRINT > 0) THEN + WRITE(6,*) "****************************************************" + WRITE(6,*) "* PHASE 2 : RECOVER CROSS SECTIONS OF BRANCH *" + WRITE(6,*) "****************************************************" + ENDIF + CALL LCMSIX(IPDAT,' ',0) + + CALL LCMGET(IPDAT,'STATE-VECTOR',STAVEC) + IF (STAVEC(18).EQ.1) THEN + CALL LCMSIX(IPDAT,'SAPHYB_INFO',1) + CALL LCMGTC(IPDAT,'NAMDIR',12,MIXDIR) + CALL LCMSIX(IPDAT,' ',0) + ENDIF + CALL LCMSIX(IPDAT,'GENPMAXS_INP',1) + CALL LCMGTC(IPDAT,'JOB_OPT',4,4,JOB) + NGP = STAVEC(1) + i=1 + DO j=1,4 + DO k=1,4 + JOBOPT(i)= JOB(j)(k:k) + i=i+1 + ENDDO + ENDDO + CALL LCMGET(IPDAT,'FLAG',DEB) + CALL LCMSIX(IPDAT,' ',0) + CALL LCMSIX(IPDAT,'BRANCH_INFO',1) + CALL LCMGET(IPDAT,'REWIND',REW) + IF ((DEB.LE.0).AND.(REW.EQ.1))THEN + + WRITE(6,*)"******* CREATION OF HELIOS ANS GENPMAXS FILES *****" + CALL D2PHEL( IPHEL, IPDAT, IPMIC , IPINP, STAVEC, + > JOBOPT, IPRINT ) + + ENDIF + + CALL D2PXS(IPDAT,IPMIC,IPSAP,STAVEC,SIGNAT,MIXDIR,JOBOPT,IPRINT) + + CALL LCMSIX(IPDAT,' ',0) + + CALL LCMPUT(IPDAT,'STATE-VECTOR',40,1,STAVEC) + + IF(IPRINT > 0) THEN + WRITE(6,*) "****************************************************" + WRITE(6,*) "* END OF PHASE 2 *" + WRITE(6,*) "****************************************************" + ENDIF +*---- +* PHASE 3 : STORE BRANCHES IN HELIOS FILE +*---- + ELSE IF (PHASE.EQ.3) THEN + IF(NENTRY.GT.4) CALL XABORT('@D2PDRV: 3 PARAMETERS EXPECTED.') + IF((IENTRY(1).NE.4)) THEN + WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT OF SEQUENTIAL AS, + > 9HNCII TYPE)') HENTRY(1) + CALL XABORT(HSMG) + ELSE IF(JENTRY(1).EQ.2) THEN + WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT IN CREATION OR I, + > 19HN MODIFICATION MODE)') + > HENTRY(1) + CALL XABORT(HSMG) + ENDIF + IF(IENTRY(2).NE.4) THEN + WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT OF SEQUENTIAL AS, + > 9HNCII TYPE)') HENTRY(2) + CALL XABORT(HSMG) + ELSE IF(JENTRY(2).EQ.2) THEN + WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT IN CREATION OR I, + > 19HN MODIFICATION MODE)') + > HENTRY(2) + CALL XABORT(HSMG) + ENDIF + CALL LCMGTC(KENTRY(3),'SIGNATURE',12,HSIGN) + IF(HSIGN.NE.'L_INFO') THEN + TEXT12=HENTRY(2) + CALL XABORT('@D2PDRV: SIGNATURE OF '//TEXT12//' IS '//HSIGN// + > '. L_INFO EXPECTED.') + ENDIF + IPHEL=FILUNIT(KENTRY(1)) ! dragon file unit + IPINP=FILUNIT(KENTRY(2)) ! GENPMAXS file unit + IPDAT=KENTRY(3) ! DATA vector address + CALL LCMSIX(IPDAT,'GENPMAXS_INP',1) + CALL LCMGET(IPDAT,'FLAG',DEB) + IF (DEB<0) THEN + DEB=1 + WRITE(6,*) "****************************************************" + WRITE(6,*) "* END OF FISSION YIELD BRANCH *" + WRITE(6,*) "****************************************************" + CALL LCMPUT(IPDAT,'FLAG',1,1,DEB) + ELSE + IF(IPRINT > 0) THEN + WRITE(6,*) "****************************************************" + WRITE(6,*) "* PHASE 3 : STORE BRANCHES IN HELIOS FILE *" + WRITE(6,*) "****************************************************" + ENDIF + WRITE(6,*) "***** STORE CURRENT BRANCH IN HELIOS LIKE FILE *****" + DEB=1 + + CALL LCMSIX(IPDAT,' ',0) + CALL LCMGET(IPDAT,"STATE-VECTOR",STAVEC) + CALL D2PBRA( IPDAT,IPINP,IPHEL,STAVEC,DEB,SIGNAT,IPRINT) + + IF(IPRINT > 0) THEN + WRITE(6,*) "****************************************************" + WRITE(6,*) "* END OF PHASE 3 *" + WRITE(6,*) "****************************************************" + ENDIF + ENDIF + ENDIF + END |