diff options
Diffstat (limited to 'Donjon/src/DETINI.f')
| -rw-r--r-- | Donjon/src/DETINI.f | 130 |
1 files changed, 130 insertions, 0 deletions
diff --git a/Donjon/src/DETINI.f b/Donjon/src/DETINI.f new file mode 100644 index 0000000..395ab02 --- /dev/null +++ b/Donjon/src/DETINI.f @@ -0,0 +1,130 @@ +*DECK DETINI + SUBROUTINE DETINI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Reads detector information and stores them +* +*Copyright: +* Copyright (C) 2010 Ecole Polytechnique de Montreal. +* +*Author(s): +* J. Koclas, E. Varin, M. Guyot +* +*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 DETINI: module specification is: +* DETECT := DETINI: [ DETECT ] :: (descdet) ; +* where +* DETECT : name of the \emph{detect} object that will be created by the +* module; it will contain the detector informations. If \emph{detect} +* appear on RHS, it is updated, otherwise, it is created. +* (descdev) : structure describing the input data to the DETINI: module. +* +*----------------------------------------------------------------------- +* + USE GANLIB + IMPLICIT NONE +*---- +* SUBROUTINE ARGUMENTS +*---- + INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY) + TYPE(C_PTR) KENTRY(NENTRY) + CHARACTER HENTRY(NENTRY)*12 +*---- +* LOCAL VARIABLES +*---- + INTEGER NSTATE + PARAMETER (NSTATE=40) + CHARACTER TEXT*12,HSIGN*12 + INTEGER ISTATE(NSTATE),NGRP,NDETOT,IPRT,IHEX,ITYP,NITMA + REAL FLOT + DOUBLE PRECISION DFLOT + LOGICAL LHEX,LDET,LENTRY + TYPE(C_PTR) IPDET +*---- +* PARAMETER VALIDATION +*---- + NDETOT = 0 + NGRP = 0 + LENTRY=.FALSE. + ISTATE(:NSTATE)=0 +* + IF(NENTRY.NE.1) CALL XABORT('@DETINI: PARAMETER EXPECTED.') + IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('@D' + + //'ETINI: LINKED LIST OR XSM FILE EXPECTED AT LHS.') + IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('@D' + + //'ETINI: CREATE OR MODIFICATION MODE EXPECTED.') +* + IPDET=KENTRY(1) + IF(JENTRY(1).EQ.1) THEN + TEXT=HENTRY(1) + LENTRY=.TRUE. + CALL LCMGTC(KENTRY(1),'SIGNATURE',12,HSIGN) + IF(HSIGN.NE.'L_DETECT')CALL XABORT('@DETINI: L_DETECT' + + //' OBJECT IS EXPECTED (OBJECT='//TEXT//')') + CALL LCMGET(IPDET,'STATE-VECTOR',ISTATE) + NGRP = ISTATE(1) + NDETOT = ISTATE(2) + ENDIF +*---- +* READ INPUT DATA +*---- + IPRT = 0 + LHEX = .FALSE. + LDET= .FALSE. + IHEX = 0 + 10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.3) CALL XABORT('@DETINI: CHARACTER DATA' + + //' EXPECTED(1).') + IF(TEXT.EQ.'EDIT') THEN + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.1)CALL XABORT('@DETINI: INTEGER DATA EXPECTED(1).') + IPRT=MAX(0,NITMA) + ELSEIF(TEXT.EQ.'HEXZ')THEN + LHEX=.TRUE. + ELSEIF(TEXT.EQ.'NGRP')THEN + CALL REDGET(ITYP,NGRP,FLOT,TEXT,DFLOT) + IF(ITYP.NE.1)CALL XABORT('@DETINI: INTEGER DATA EXPECTED(2).') + IF(JENTRY(1).EQ.1) THEN + CALL XABORT('@DETINI: ENERGY GROUP NUMBER REQUIRED ONLY AT' + + //' CREATION OF L_DETECT OBJECT') + ENDIF + ELSEIF(TEXT.EQ.'TYPE')THEN + CALL DETDRV(IPDET,NGRP,IPRT,LHEX,NDETOT,LENTRY) + ELSEIF(TEXT.EQ.';')THEN + LDET=.TRUE. + ELSE + CALL XABORT('@DETINI: INVALID KEYWORD '//TEXT) + ENDIF + IF(.NOT.LDET) GOTO 10 +*---- +* STATE-VECTOR STORAGE +*---- + IF(JENTRY(1).EQ.0) THEN + HSIGN='L_DETECT' + CALL LCMSIX(IPDET,' ',0) + CALL LCMPTC(IPDET,'SIGNATURE',12,HSIGN) + ENDIF + ISTATE(:NSTATE)=0 + ISTATE(1)=NGRP + ISTATE(2)=NDETOT + IF(LHEX) ISTATE(3)=1 + CALL LCMPUT(IPDET,'STATE-VECTOR',NSTATE,1,ISTATE) + IF(IPRT.GT.2) CALL LCMLIB(IPDET) + RETURN + END |