diff options
Diffstat (limited to 'Donjon/src/MCRDRV.f')
| -rw-r--r-- | Donjon/src/MCRDRV.f | 433 |
1 files changed, 433 insertions, 0 deletions
diff --git a/Donjon/src/MCRDRV.f b/Donjon/src/MCRDRV.f new file mode 100644 index 0000000..d9c4c55 --- /dev/null +++ b/Donjon/src/MCRDRV.f @@ -0,0 +1,433 @@ +*DECK MCRDRV + SUBROUTINE MCRDRV(IPMPO,LCUBIC,NMIX,IMPX,NMIL,NCAL,NBISO,NPAR, + 1 HEDIT,ITER,MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC,ITODO) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Compute TERP factors for MPO file interpolation. Use user-defined +* global parameters. +* +*Copyright: +* Copyright (C) 2022 Ecole Polytechnique de Montreal +* +*Author(s): +* A. Hebert +* +*Parameters: input +* IPMPO address of the MPO file. +* LCUBIC =.TRUE.: cubic Ceschino interpolation; =.FALSE: linear +* Lagrange interpolation. +* NMIX maximum number of material mixtures in the microlib. +* IMPX print parameter (equal to zero for no print). +* NMIL number of material mixtures in the MPO file. +* NCAL number of elementary calculations in the MPO file. +* NBISO number of particularized isotopes in the MPO file. +* NPAR number of parameters +* HEDIT name of output group for a (multigroup mesh, output geometry) +* couple (generally equal to 'output_0'). +* +*Parameters: output +* ITER completion flag (=0: all over; =1: use another MPO file; +* =2 use another L_MAP + MPO file). +* MAXNIS maximum value of NISO(I) in user data. +* MIXC mixture index in the MPO file corresponding to each microlib +* mixture. +* TERP interpolation factors. +* NISO number of user-selected isotopes. +* LISO type of treatment (=.true.: ALL; =.false.: ONLY). +* HISO name of the user-selected isotopes. +* CONC user-defined number density of the user-selected isotopes. A +* value of -99.99 is set to indicate that the compo value is +* used. +* ITODO non-depletion mask (=1 to force a user-selected isotope to be +* non-depleting) +* +*----------------------------------------------------------------------- +* + USE GANLIB + USE hdf5_wrap + IMPLICIT NONE +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPMPO + INTEGER NMIX,IMPX,NMIL,NCAL,NBISO,NPAR,ITER,MAXNIS,MIXC(NMIX), + 1 NISO(NMIX),ITODO(NMIX,NBISO) + REAL TERP(NCAL,NMIX),CONC(NMIX,NBISO) + LOGICAL LCUBIC,LISO(NMIX) + CHARACTER(LEN=8) HISO(NMIX,NBISO) + CHARACTER(LEN=12) HEDIT +*---- +* LOCAL VARIABLES +*---- + INTEGER, PARAMETER::IOUT=6 + INTEGER, PARAMETER::MAXLIN=132 + INTEGER, PARAMETER::MAXPAR=50 + INTEGER, PARAMETER::MAXVAL=200 + REAL, PARAMETER::REPS=1.0E-4 + INTEGER I, J, IBM, IBMOLD, ICAL, INDIC, IPAR, ITYPE, JBM, NITMA + REAL SUM, FLOTT + CHARACTER TEXT72*72,HSMG*131,TEXT132*132,VALH(MAXPAR)*12, + 1 RECNAM*80,HCUBIC*12 + INTEGER VALI(MAXPAR) + INTEGER RANK,TYPE,NBYTE,DIMSR(5) + DOUBLE PRECISION DFLOTT + REAL VALR(2*MAXPAR,2) + LOGICAL LCUB2(MAXPAR) +*---- +* ALLOCATABLE ARRAYS +*---- + LOGICAL, ALLOCATABLE, DIMENSION(:) :: LDELTA + INTEGER, ALLOCATABLE, DIMENSION(:) :: MUPLET,MUTYPE,NVALUE,VINTE + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: MUBASE + REAL, ALLOCATABLE, DIMENSION(:) :: VREAL + CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: PARFMT + CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: VCHAR + CHARACTER(LEN=24), ALLOCATABLE, DIMENSION(:) :: PARTYP,PARKEY + CHARACTER(LEN=132), ALLOCATABLE, DIMENSION(:) :: TEXT132V1 +*---- +* SCRATCH STORAGE ALLOCATION +*---- + ALLOCATE(MUPLET(NPAR),MUTYPE(NPAR),LDELTA(NMIX),MUBASE(NPAR,NCAL)) +*---- +* RECOVER INFORMATION FOR THE MPO FILE. +*---- + CALL hdf5_info(IPMPO,"/info/MPO_CREATION_INFO",RANK,TYPE,NBYTE, + 1 DIMSR) + IF(RANK.GT.MAXLIN) CALL XABORT('MCRDRV: MAXLIN OVERFLOW.') + IF(NPAR.GT.MAXPAR) CALL XABORT('MCRDRV: MAXPAR OVERFLOW.') + IF((RANK.EQ.1).AND.(DIMSR(1).EQ.1)) THEN + CALL hdf5_read_data(IPMPO,"/info/MPO_CREATION_INFO",TEXT132) + IF(IMPX.GT.0) WRITE(IOUT,'(1X,A)') TEXT132 + ELSE IF(RANK.EQ.1) THEN + CALL hdf5_read_data(IPMPO,"/info/MPO_CREATION_INFO",TEXT132V1) + IF(IMPX.GT.0) THEN + DO I=1,DIMSR(1) + WRITE(IOUT,'(1X,A)') TEXT132V1(I) + ENDDO + ENDIF + DEALLOCATE(TEXT132V1) + ENDIF + IF(NPAR.GT.0) THEN + CALL hdf5_read_data(IPMPO,"/parameters/info/PARAMTYPE",PARTYP) + CALL hdf5_read_data(IPMPO,"/parameters/info/PARAMNAME",PARKEY) + CALL hdf5_read_data(IPMPO,"/parameters/info/PARAMFORM",PARFMT) + IF(IMPX.GT.1) THEN + WRITE(IOUT,*) 'NPAR=',NPAR,SIZE(PARKEY,1) + DO I=1,NPAR + WRITE(IOUT,*)'PARKEY(',I,')=',PARKEY(I),' PARFMT=',PARFMT(I) + ENDDO + ENDIF + ENDIF + TERP(:NCAL,:NMIX)=0.0 + MIXC(:NMIX)=0 +*---- +* SCAN THE MPO FILE INFORMATION TO RECOVER THE MUPLET DATABASE +*---- + IF(IMPX.GT.5) THEN + WRITE(IOUT,'(24H MCRDRV: MUPLET DATABASE/12H CALCULATION,5X, + 1 10HMUPLET....)') + ENDIF + IF(NPAR.GT.0) THEN + DO ICAL=1,NCAL + WRITE(RECNAM,'(8H/output/,A,9H/statept_,I0)') TRIM(HEDIT), + 1 ICAL-1 + CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"/PARAMVALUEORD", + 1 VINTE) + IF(SIZE(VINTE).NE.NPAR) THEN + WRITE(HSMG,'(41HMCRDRV: INCONSISTENT PARAMVALUEORD LENGTH, + 1 2H (,I5,3H VS,I5,2H).)') SIZE(VINTE),NPAR + CALL XABORT(HSMG) + ENDIF + DO IPAR=1,NPAR + MUBASE(IPAR,ICAL)=VINTE(IPAR)+1 + ENDDO + IF(IMPX.GT.5) THEN + WRITE(IOUT,'(I8,6X,20I4/(14X,20I4))') ICAL, + 1 MUBASE(:,ICAL) + ENDIF + DEALLOCATE(VINTE) + ENDDO + ENDIF +*---- +* READ (INTERP_DATA) AND SET VALI, VALR AND VALH PARAMETERS +* CORRESPONDING TO THE INTERPOLATION POINT. FILL MUPLET FOR +* PARAMETERS SET WITHOUT INTERPOLATION. +*---- + IBM=0 + MAXNIS=0 + NISO(:NMIX)=0 + LISO(:NMIX)=.TRUE. + LDELTA(:NMIX)=.FALSE. + ITODO(:NMIX,:NBISO)=0 + 10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT) + IF(INDIC.NE.3) CALL XABORT('MCRDRV: CHARACTER DATA EXPECTED.') + 20 IF(TEXT72.EQ.'MIX') THEN + MUPLET(:NPAR)=0 + MUTYPE(:NPAR)=0 + VALI(:NPAR)=0 + VALR(:NPAR,1)=0.0 + VALR(:NPAR,2)=0.0 + DO 30 I=1,NPAR + VALH(I)=' ' + 30 CONTINUE + LCUB2(:NPAR)=LCUBIC + CALL REDGET(INDIC,IBM,FLOTT,TEXT72,DFLOTT) + IF(INDIC.NE.1) CALL XABORT('MCRDRV: INTEGER DATA EXPECTED.') + IF(IBM.GT.NMIX) THEN + WRITE(HSMG,'(27HMCRDRV: NMIX OVERFLOW (IBM=,I8,6H NMIX=,I8, + 1 2H).)') IBM,NMIX + CALL XABORT(HSMG) + ENDIF + IBMOLD=1 + CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT) + IF(INDIC.NE.3) CALL XABORT('MCRDRV: CHARACTER DATA EXPECTED.') + IF(TEXT72.EQ.'FROM') THEN + CALL REDGET(INDIC,IBMOLD,FLOTT,TEXT72,DFLOTT) + IF(INDIC.NE.1) CALL XABORT('MCRDRV: INTEGER DATA EXPECTED.') + IF(IBMOLD.GT.NMIL) CALL XABORT('MCRDRV: MPO MIX OVERFLOW' + 1 //'(1).') + MIXC(IBM)=IBMOLD + GO TO 10 + ELSE IF(TEXT72.EQ.'USE') THEN + IF(IBM.GT.NMIL) CALL XABORT('MCRDRV: MPO MIX OVERFLOW(2).') + MIXC(IBM)=IBM + GO TO 10 + ENDIF + MIXC(IBM)=IBMOLD + GO TO 20 + ELSE IF(TEXT72.EQ.'MICRO') THEN + IF(IBM.EQ.0) CALL XABORT('MCRDRV: MIX NOT SET (1).') + CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT) + IF(INDIC.NE.3) CALL XABORT('MCRDRV: CHARACTER DATA EXPECTED.') + IF(TEXT72.EQ.'ALL') THEN + LISO(IBM)=.TRUE. + ELSE IF(TEXT72.EQ.'ONLY') THEN + LISO(IBM)=.FALSE. + ENDIF + CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT) + IF(INDIC.NE.3) CALL XABORT('MCRDRV: CHARACTER DATA EXPECTED.') + 40 IF(TEXT72.EQ.'ENDMIX') THEN + GO TO 20 + ELSE IF(TEXT72.EQ.'NOEV') THEN + IF(NISO(IBM).EQ.0) CALL XABORT('MCRDRV: MISPLACED NOEV.') + ITODO(IBM,NISO(IBM))=1 + ELSE + NISO(IBM)=NISO(IBM)+1 + IF(NISO(IBM).GT.NBISO) CALL XABORT('MCRDRV: NBISO OVERFLOW.') + MAXNIS=MAX(MAXNIS,NISO(IBM)) + HISO(IBM,NISO(IBM))=TEXT72(:8) + CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT) + IF(INDIC.EQ.2) THEN + CONC(IBM,NISO(IBM))=FLOTT + ELSE IF((INDIC.EQ.3).AND.(TEXT72.EQ.'*')) THEN + CONC(IBM,NISO(IBM))=-99.99 + ELSE + CALL XABORT('MCRDRV: INVALID HISO DATA.') + ENDIF + ENDIF + CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT) + IF(INDIC.NE.3) CALL XABORT('MCRDRV: CHARACTER DATA EXPECTED.') + GO TO 40 + ELSE IF((TEXT72.EQ.'SET').OR.(TEXT72.EQ.'DELTA')) THEN + IF(IBM.EQ.0) CALL XABORT('MCRDRV: MIX NOT SET (2).') + ITYPE=0 + IF(TEXT72.EQ.'SET') THEN + ITYPE=1 + ELSE IF(TEXT72.EQ.'DELTA') THEN + ITYPE=2 + LDELTA(IBM)=.TRUE. + ENDIF + CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT) + IF(INDIC.NE.3) CALL XABORT('MCRDRV: CHARACTER DATA EXPECTED.') + IF((TEXT72.EQ.'LINEAR').OR.(TEXT72.EQ.'CUBIC')) THEN + HCUBIC=TEXT72(:12) + CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT) + ELSE + HCUBIC=' ' + ENDIF + IF(INDIC.NE.3) CALL XABORT('MCRDRV: CHARACTER DATA EXPECTED.') + IPAR=0 + DO 50 I=1,NPAR + IF(TEXT72.EQ.PARKEY(I)) THEN + IPAR=I + GO TO 60 + ENDIF + 50 CONTINUE + CALL XABORT('MCRDRV: PARAMETER '//TEXT72//' NOT FOUND.') + 60 IF(HCUBIC.EQ.'LINEAR') THEN + LCUB2(IPAR)=.FALSE. + ELSE IF(HCUBIC.EQ.'CUBIC') THEN + LCUB2(IPAR)=.TRUE. + ENDIF + CALL hdf5_read_data(IPMPO,"/parameters/info/NVALUE",NVALUE) + IF(NVALUE(IPAR).GT.MAXVAL) CALL XABORT('MCRDRV: MAXVAL OVERFL' + 1 //'OW.') + WRITE(RECNAM,'(25H/parameters/values/PARAM_,I0)') IPAR-1 + CALL hdf5_info(IPMPO,RECNAM,RANK,TYPE,NBYTE,DIMSR) + IF(TYPE.EQ.99) THEN + WRITE(HSMG,'(25HMCRDRV: GLOBAL PARAMETER ,A,9H NOT SET.)') + 1 TRIM(PARKEY(IPAR)) + CALL XABORT(HSMG) + ENDIF + IF(PARFMT(IPAR).EQ.'INTEGER') THEN + IF(ITYPE.NE.1) CALL XABORT('MCRDRV: SET MANDATORY WITH INT' + 1 //'EGER PARAMETERS.') + CALL REDGET(INDIC,VALI(IPAR),FLOTT,TEXT72,DFLOTT) + IF(INDIC.NE.1) CALL XABORT('MCRDRV: INTEGER DATA EXPECTED.') + CALL hdf5_read_data(IPMPO,RECNAM,VINTE) + DO 70 J=1,NVALUE(IPAR) + IF(VALI(IPAR).EQ.VINTE(J)) THEN + MUPLET(IPAR)=J + MUTYPE(IPAR)=ITYPE + DEALLOCATE(NVALUE,VINTE) + GO TO 10 + ENDIF + 70 CONTINUE + WRITE(HSMG,'(26HMCRDRV: INTEGER PARAMETER ,A,11H WITH VALUE, + 1 I5,32H NOT FOUND IN MPO FILE DATABASE.)') + 2 TRIM(PARKEY(IPAR)),VALI(IPAR) + CALL XABORT(HSMG) + ELSE IF(PARFMT(IPAR).EQ.'FLOAT') THEN + CALL REDGET(INDIC,NITMA,VALR(IPAR,1),TEXT72,DFLOTT) + IF(INDIC.NE.2) CALL XABORT('MCRDRV: REAL DATA EXPECTED.') + VALR(IPAR,2)=VALR(IPAR,1) + CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT) + IF(INDIC.EQ.2) THEN + VALR(IPAR,2)=FLOTT + CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT) + ENDIF + CALL hdf5_read_data(IPMPO,RECNAM,VREAL) + IF(VALR(IPAR,1).EQ.VALR(IPAR,2)) THEN + DO 80 J=1,NVALUE(IPAR) + IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J))) THEN + MUPLET(IPAR)=J + IF(ITYPE.NE.1) MUPLET(IPAR)=-1 + MUTYPE(IPAR)=ITYPE + DEALLOCATE(NVALUE,VREAL) + GO TO 20 + ENDIF + 80 CONTINUE + ENDIF + IF(VALR(IPAR,1).LT.VREAL(1)) THEN + WRITE(HSMG,'(23HMCRDRV: REAL PARAMETER ,A,10H WITH VALU, + 1 1HE,1P,E12.4,25H IS OUTSIDE THE DOMAIN (<,E12.4,1H))') + 2 TRIM(PARKEY(IPAR)),VALR(IPAR,1),VREAL(1) + CALL XABORT(HSMG) + ELSE IF(VALR(IPAR,2).GT.VREAL(NVALUE(IPAR))) THEN + WRITE(HSMG,'(23HMCRDRV: REAL PARAMETER ,A,10H WITH VALU, + 1 1HE,1P,E12.4,25H IS OUTSIDE THE DOMAIN (>,E12.4,1H))') + 2 TRIM(PARKEY(IPAR)),VALR(IPAR,1),VREAL(NVALUE(IPAR)) + CALL XABORT(HSMG) + ELSE IF(VALR(IPAR,1).GT.VALR(IPAR,2)) THEN + WRITE(HSMG,'(23HMCRDRV: REAL PARAMETER ,A,9H IS DEFIN, + 1 7HED WITH,1P,E12.4,2H >,E12.4,1H.)') TRIM(PARKEY(IPAR)), + 2 VALR(IPAR,1),VALR(IPAR,2) + CALL XABORT(HSMG) + ENDIF + MUPLET(IPAR)=-1 + MUTYPE(IPAR)=ITYPE + DEALLOCATE(NVALUE,VREAL) + GO TO 20 + ELSE IF(PARFMT(IPAR).EQ.'STRING') THEN + IF(ITYPE.NE.1) CALL XABORT('MCRDRV: SET MANDATORY WITH STR' + 1 //'ING PARAMETERS.') + CALL REDGET(INDIC,NITMA,FLOTT,VALH(IPAR),DFLOTT) + IF(INDIC.NE.3) CALL XABORT('MCRDRV: STRING DATA EXPECTED.') + CALL hdf5_read_data(IPMPO,RECNAM,VCHAR) + DO 90 J=1,NVALUE(IPAR) + IF(VALH(IPAR).EQ.VCHAR(J)) THEN + MUPLET(IPAR)=J + MUTYPE(IPAR)=ITYPE + DEALLOCATE(NVALUE,VCHAR) + GO TO 10 + ENDIF + 90 CONTINUE + WRITE(HSMG,'(25HMCRDRV: STRING PARAMETER ,A,10H WITH VALU, + 1 2HE ,A12,32H NOT FOUND IN MPO FILE DATABASE.)') + 2 TRIM(PARKEY(IPAR)), VALH(IPAR) + CALL XABORT(HSMG) + ELSE + CALL XABORT('MCRDRV: INVALID FORMAT='//PARFMT(IPAR)) + ENDIF + ELSE IF(TEXT72.EQ.'ENDMIX') THEN +*---- +* COMPUTE THE TERP FACTORS USING TABLE-OF-CONTENT INFORMATION. +*---- + IF(IMPX.GT.0) THEN + DO IPAR=1,NPAR + IF(PARFMT(IPAR).EQ.'FLOAT')THEN + IF(LCUB2(IPAR)) THEN + WRITE(IOUT,'(26H MCRDRV: GLOBAL PARAMETER:,A,7H ->CUBI, + 1 16HC INTERPOLATION.)') TRIM(PARKEY(IPAR)) + ELSE + WRITE(IOUT,'(26H MCRDRV: GLOBAL PARAMETER:,A,7H ->LINE, + 1 17HAR INTERPOLATION.)') TRIM(PARKEY(IPAR)) + ENDIF + ENDIF + ENDDO + ENDIF + IF(IBMOLD.GT.NMIL)CALL XABORT('MCRDRV: MPO MIX OVERFLOW(3).') + IF(IBM.GT.NMIX)CALL XABORT('MCRDRV: MIX OVERFLOW (MICROLIB).') + IF(NCAL.EQ.1) THEN + TERP(1,IBM)=1.0 + ELSE + CALL MCRTRP(IPMPO,LCUB2,IMPX,NPAR,NCAL,MUPLET,MUTYPE,PARTYP, + 1 VALR,0.0,MUBASE,TERP(1,IBM)) + ENDIF + IBM=0 + ELSE IF((TEXT72.EQ.'MPO').OR.(TEXT72.EQ.'TABLE').OR. + 1 (TEXT72.EQ.'CHAIN').OR.(TEXT72.EQ.';')) THEN +*---- +* CHECK TERP FACTORS AND RETURN +*---- + IF(TEXT72.EQ.';') ITER=0 + IF(TEXT72.EQ.'MPO') ITER=1 + IF(TEXT72.EQ.'TABLE') ITER=2 + IF(TEXT72.EQ.'CHAIN') ITER=3 + DO 150 IBM=1,NMIX + IBMOLD=MIXC(IBM) + IF(IBMOLD.EQ.0) GO TO 150 + IF(NISO(IBM).GT.MAXNIS) CALL XABORT('MCRDRV: MAXNIS OVERFLOW.') + IF(LDELTA(IBM)) THEN + SUM=0.0 + ELSE + SUM=1.0 + ENDIF + DO 140 ICAL=1,NCAL + SUM=SUM-TERP(ICAL,IBM) + 140 CONTINUE + IF(ABS(SUM).GT.1.0E-4) THEN + WRITE(HSMG,'(43HMCRDRV: INVALID INTERPOLATION FACTORS IN MI, + 1 5HXTURE,I4,1H.)') IBM + CALL XABORT(HSMG) + ENDIF + 150 CONTINUE + GO TO 160 + ELSE + CALL XABORT('MCRDRV: '//TEXT72//' IS AN INVALID KEYWORD.') + ENDIF + GO TO 10 +*---- +* PRINT INTERPOLATION (TERP) FACTORS +*---- + 160 IF(IMPX.GT.2) THEN + WRITE(IOUT,'(/30H MCRDRV: INTERPOLATION FACTORS)') + DO ICAL=1,NCAL + DO IBM=1,NMIX + IF(TERP(ICAL,IBM).NE.0.0) THEN + WRITE(IOUT,170) ICAL,(TERP(ICAL,JBM),JBM=1,NMIX) + EXIT + ENDIF + ENDDO + ENDDO + ENDIF +*---- +* SCRATCH STORAGE DEALLOCATION +*---- + IF(NPAR.GT.0) DEALLOCATE(PARFMT,PARKEY,PARTYP) + DEALLOCATE(MUBASE,LDELTA,MUTYPE,MUPLET) + RETURN + 170 FORMAT(6H CALC=,I8,6H TERP=,1P,8E13.5/(20X,8E13.5)) + END |
