*DECK IDET SUBROUTINE IDET(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY) * *----------------------------------------------------------------------- * *Purpose: * Detector integrated response evaluation * *Copyright: * Copyright (C) 2019 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 * 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. * *Comments: * The IDET: module specification is: * IDETEC := IDET: [ IDETEC ] TRKNAM FLUNAM LIBNAM [ FMAP ] :: (descidet) ; * where * IDETEC : name of a \emph{idetect} data structure, (L\_INTDETEC signature) * that will be created or updated by the IDET: module. * TRKNAM : name of the read-only \emph{tracking} data structure * (L\_TRACK signature) containing the finite-element tracking. * FLUNAM : name of the read-only \emph{fluxunk data structure * (L\_FLUX signature) containing the finite-element solution. * LIBNAM : name of the read-only \emph{macrolib} data structure * (L\_LIBRARY signature) that contains the interpolated microscopic * cross sections. * FMAP : name of the read-only \emph{fmap} data structure * (L\_MAP signature) containing renumbered mixture indices. This object * is optionnal. * (descidet) : structure describing the input data to the IDET: module. * *----------------------------------------------------------------------- * USE GANLIB *---- * SUBROUTINE ARGUMENTS *---- INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY) TYPE(C_PTR) KENTRY(NENTRY) CHARACTER HENTRY(NENTRY)*12 *---- * LOCAL VARIABLES *---- INTEGER MAXCO PARAMETER (MAXNI=10,NSTATE=40) INTEGER INDIC,NITMA,ISTATE(NSTATE) DOUBLE PRECISION DFLOT CHARACTER CMODUL*12,HSIGN*12,TEXT12*12,DETNAM*12,REANAM*12 REAL FLOT TYPE(C_PTR) IPIDET,IPTRK,IPFLU,IPLIB,IPMAP *---- * ALLOCATABLE ARRAYS *---- INTEGER, DIMENSION(:), POINTER :: NINX,NINY,NINZ INTEGER, DIMENSION(:), POINTER :: NINX_2,NINY_2,NINZ_2 REAL, DIMENSION(:), ALLOCATABLE :: DETECT REAL, DIMENSION(:,:), POINTER :: COORD1,COORD2,COORD3 REAL, DIMENSION(:,:), POINTER :: COORD1_2,COORD2_2, > COORD3_2 *---- * PARAMETER VALIDATION *---- IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('IDET: LCM' > //' object expected at LHS.') IF(JENTRY(1).EQ.2) CALL XABORT('IDET: L_INTDETEC entry in create' > //' or modification mode expected.') IPIDET=KENTRY(1) MAXCO=100 ! maximum number of detectors IF(JENTRY(1).EQ.0) THEN HSIGN='L_INTDETEC' CALL LCMPTC(IPIDET,'SIGNATURE',12,HSIGN) DETNAM='U235' REANAM='NFTOT' ALLOCATE(COORD1(MAXNI,MAXCO),COORD2(MAXNI,MAXCO), > COORD3(MAXNI,MAXCO),NINX(MAXCO),NINY(MAXCO),NINZ(MAXCO)) NDETC=0 ELSE CALL LCMGTC(IPIDET,'SIGNATURE',12,HSIGN) IF(HSIGN.NE.'L_INTDETEC') THEN TEXT12=HENTRY(3) CALL XABORT('IDET: signature of '//TEXT12//' IS '//HSIGN// > '. L_INTDETEC expected.') ENDIF CALL LCMGET(IPIDET,'STATE-VECTOR',ISTATE) IF(ISTATE(1).NE.MAXNI) CALL XABORT('IDET: invalid MAXNI.') NDETC=ISTATE(2) MAXCO=MAX(MAXCO,NDETC) ALLOCATE(COORD1(MAXNI,MAXCO),COORD2(MAXNI,MAXCO), > COORD3(MAXNI,MAXCO),NINX(MAXCO),NINY(MAXCO),NINZ(MAXCO)) CALL LCMGET(IPIDET,'NINX',NINX) CALL LCMGET(IPIDET,'NINY',NINY) CALL LCMGET(IPIDET,'NINZ',NINZ) CALL LCMGET(IPIDET,'COORD1',COORD1) CALL LCMGET(IPIDET,'COORD2',COORD2) CALL LCMGET(IPIDET,'COORD3',COORD3) CALL LCMGTC(IPIDET,'DETNAM',12,DETNAM) CALL LCMGTC(IPIDET,'REANAM',12,REANAM) ENDIF IPFLU=C_NULL_PTR IPTRK=C_NULL_PTR IPLIB=C_NULL_PTR IPMAP=C_NULL_PTR CMODUL=' ' DO I=2,NENTRY IF(IENTRY(I).GT.2) CALL XABORT('IDET: LCM object expected.') IF(JENTRY(I).NE.2) CALL XABORT('IDET: LCM object in read-only ' > //'MODE EXPECTED AT RHS.') CALL LCMGTC(KENTRY(I),'SIGNATURE',12,HSIGN) IF(HSIGN.EQ.'L_FLUX') THEN IPFLU=KENTRY(I) ELSEIF(HSIGN.EQ.'L_TRACK') THEN IPTRK=KENTRY(I) CALL LCMGTC(IPTRK,'TRACK-TYPE',12,CMODUL) ELSEIF(HSIGN.EQ.'L_LIBRARY') THEN IPLIB=KENTRY(I) ELSEIF(HSIGN.EQ.'L_MAP') THEN IPMAP=KENTRY(I) ELSE TEXT12=HENTRY(I) CALL XABORT('IDET: SIGNATURE OF '//TEXT12//' IS '//HSIGN// > '. L_FLUX, L_TRACK or L_LIBRARY expected.') ENDIF ENDDO IF(CMODUL.NE.'TRIVAC') CALL XABORT('IDET: TRIVAC tracking expect' > //'ed.') *---- * READ INPUTS *---- IMPX=1 ICORN=1 10 CALL REDGET(INDIC,NITMA,FLOT,TEXT12,DFLOT) IF(INDIC.NE.3) CALL XABORT('IDET: character data expected.') IF(TEXT12.EQ.'EDIT') THEN CALL REDGET(INDIC,IMPX,FLOT,TEXT12,DFLOT) IF(INDIC.NE.1) CALL XABORT('IDET: integer data expected.') ELSE IF(TEXT12.EQ.'DETNAME') THEN CALL REDGET(INDIC,NITMA,FLOT,DETNAM,DFLOT) IF(INDIC.NE.3) CALL XABORT('IDET: character data expected(1).') ELSE IF(TEXT12.EQ.'REANAME') THEN CALL REDGET(INDIC,NITMA,FLOT,REANAM,DFLOT) IF(INDIC.NE.3) CALL XABORT('IDET: character data expected(2).') ELSE IF(TEXT12.EQ.'DETECTOR') THEN 20 CALL REDGET(INDIC,NITMA,FLOT,TEXT12,DFLOT) IF(INDIC.NE.3) CALL XABORT('IDET: character data expected.') 30 IF(TEXT12.EQ.'POSITION') THEN * Cartesian position of a single detector NDETC=NDETC+1 IF(NDETC.GT.MAXCO) THEN * extend the allocated space to store detectors MAXCO_2=MAXCO+100 ALLOCATE(COORD1_2(MAXNI,MAXCO_2),COORD2_2(MAXNI,MAXCO_2), > COORD3_2(MAXNI,MAXCO_2),NINX_2(MAXCO_2),NINY_2(MAXCO_2), > NINZ_2(MAXCO_2)) COORD1_2(:MAXNI,:MAXCO)=COORD1(:MAXNI,:MAXCO) COORD2_2(:MAXNI,:MAXCO)=COORD2(:MAXNI,:MAXCO) COORD3_2(:MAXNI,:MAXCO)=COORD3(:MAXNI,:MAXCO) NINX_2(:MAXCO)=NINX(:MAXCO) NINY_2(:MAXCO)=NINY(:MAXCO) NINZ_2(:MAXCO)=NINZ(:MAXCO) DEALLOCATE(NINZ,NINY,NINX,COORD3,COORD2,COORD1) MAXCO=MAXCO_2 COORD1=>COORD1_2 COORD2=>COORD2_2 COORD3=>COORD3_2 NINX=>NINX_2 NINY=>NINY_2 NINZ=>NINZ_2 ENDIF NINX(NDETC)=1 NINY(NDETC)=1 NINZ(NDETC)=1 CALL REDGET(INDIC,NITMA,FLOT,TEXT12,DFLOT) IF(INDIC.EQ.2) THEN COORD1(1,NDETC)=FLOT ELSE IF((INDIC.EQ.3).AND.(TEXT12.EQ.'INTEG')) THEN NINX(NDETC)=MAXNI CALL REDGET(INDIC,NITMA,COO1,TEXT12,DFLOT) IF(INDIC.NE.2) CALL XABORT('IDET: COORD1 data1 expected.') CALL REDGET(INDIC,NITMA,COO2,TEXT12,DFLOT) IF(INDIC.NE.2) CALL XABORT('IDET: COORD1 data2 expected.') IF(COO2.LE.COO1) CALL XABORT('IDET: COORD1 data2<=data1.') DELTA=(COO2-COO1)/REAL(MAXNI-1) DO INX=1,MAXNI COORD1(INX,NDETC)=COO1+REAL(INX-1)*DELTA ENDDO ELSE CALL XABORT('IDET: COORD1 data or INTEG keyword expected.') ENDIF CALL REDGET(INDIC,NITMA,FLOT,TEXT12,DFLOT) IF(INDIC.EQ.2) THEN COORD2(1,NDETC)=FLOT ELSE IF((INDIC.EQ.3).AND.(TEXT12.EQ.'INTEG')) THEN NINY(NDETC)=MAXNI CALL REDGET(INDIC,NITMA,COO1,TEXT12,DFLOT) IF(INDIC.NE.2) CALL XABORT('IDET: COORD2 data1 expected.') CALL REDGET(INDIC,NITMA,COO2,TEXT12,DFLOT) IF(INDIC.NE.2) CALL XABORT('IDET: COORD2 data2 expected.') IF(COO2.LE.COO1) CALL XABORT('IDET: COORD2 data2<=data1.') DELTA=(COO2-COO1)/REAL(MAXNI-1) DO INY=1,MAXNI COORD2(INY,NDETC)=COO1+REAL(INY-1)*DELTA ENDDO ELSE CALL XABORT('IDET: COORD2 data or INTEG keyword expected.') ENDIF CALL REDGET(INDIC,NITMA,FLOT,TEXT12,DFLOT) IF(INDIC.EQ.2) THEN COORD3(1,NDETC)=FLOT GO TO 20 ELSE IF(INDIC.EQ.3) THEN IF(TEXT12.EQ.'INTEG') THEN NINZ(NDETC)=MAXNI CALL REDGET(INDIC,NITMA,COO1,TEXT12,DFLOT) IF(INDIC.NE.2) CALL XABORT('IDET: COORD3 data1 expected.') CALL REDGET(INDIC,NITMA,COO2,TEXT12,DFLOT) IF(INDIC.NE.2) CALL XABORT('IDET: COORD3 data2 expected.') IF(COO2.LE.COO1) CALL XABORT('IDET: COORD3 data2<=data1.') DELTA=(COO2-COO1)/REAL(MAXNI-1) DO INZ=1,MAXNI COORD3(INZ,NDETC)=COO1+REAL(INZ-1)*DELTA ENDDO GO TO 20 ELSE COORD3(1,NDETC)=1.0 GO TO 30 ENDIF ELSE CALL XABORT('IDET: real or character data expected.') ENDIF ELSE IF(TEXT12.EQ.'ENDD') THEN GO TO 10 ELSE CALL XABORT('IDET: POSITION, MIXTURE or ENDP keyword expec' > //'ted.') ENDIF GO TO 20 ELSE IF(TEXT12.EQ.'NOCCOR') THEN ICORN=0 ELSE IF(TEXT12.EQ.'CCOR') THEN ICORN=1 ELSE IF(TEXT12.EQ.';') THEN GO TO 40 ELSE CALL XABORT('IDET: unknownn keyword-->'//TEXT12) ENDIF GO TO 10 *---- * PERFORM FLUX INTERPOLATION OVER DETECTOR LOCATIONS *---- 40 IF(NDETC.EQ.0) CALL XABORT('IDET: no detector defined.') ALLOCATE(DETECT(NDETC)) CALL IDET01(IPTRK,IPFLU,IPLIB,IPMAP,IMPX,NDETC,MAXNI,NINX,NINY, > NINZ,COORD1,COORD2,COORD3,DETNAM,REANAM,ICORN,DETECT) *---- * PRINT DETECTOR RESPONSE *---- IF(IMPX.GT.0) THEN WRITE(6,'(/25H DET: DETECTOR READINGS (,2A12,1H))') DETNAM, > REANAM WRITE(6,'(10X,8HDETECTOR,5X,7HREADING)') DO I=1,NDETC WRITE(6,'(8X,I10,1P,E16.5)') I,DETECT(I) ENDDO ENDIF *---- * SAVE DETECTOR INFORMATION ON LCM *---- ISTATE(:NSTATE)=0 ISTATE(1)=MAXNI ISTATE(2)=NDETC CALL LCMPUT(IPIDET,'STATE-VECTOR',NSTATE,1,ISTATE) CALL LCMPUT(IPIDET,'NINX',NDETC,1,NINX) CALL LCMPUT(IPIDET,'NINY',NDETC,1,NINY) CALL LCMPUT(IPIDET,'NINZ',NDETC,1,NINZ) CALL LCMPUT(IPIDET,'COORD1',MAXNI*NDETC,2,COORD1) CALL LCMPUT(IPIDET,'COORD2',MAXNI*NDETC,2,COORD2) CALL LCMPUT(IPIDET,'COORD3',MAXNI*NDETC,2,COORD3) CALL LCMPTC(IPIDET,'DETNAM',12,DETNAM) CALL LCMPTC(IPIDET,'REANAM',12,DETNAM) CALL LCMPUT(IPIDET,'RESPON',NDETC,2,DETECT) *---- * RELEASE MEMORY *---- DEALLOCATE(DETECT,NINZ,NINY,NINX,COORD3,COORD2,COORD1) RETURN END