From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001 From: stainer_t Date: Mon, 8 Sep 2025 13:48:49 +0200 Subject: Initial commit from Polytechnique Montreal --- Dragon/src/COMISO.f | 103 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 103 insertions(+) create mode 100644 Dragon/src/COMISO.f (limited to 'Dragon/src/COMISO.f') diff --git a/Dragon/src/COMISO.f b/Dragon/src/COMISO.f new file mode 100644 index 0000000..b308b4c --- /dev/null +++ b/Dragon/src/COMISO.f @@ -0,0 +1,103 @@ +*DECK COMISO + SUBROUTINE COMISO(ITYP,MAXISO,IPLIB,NISO,NOMISO,NOMEVO,TYPISO) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Recover the names of the isotopes stored in a microlib. +* +*Copyright: +* Copyright (C) 2007 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 +* ITYP type of operation: +* =0: check the values of the isotope names and types; +* =-1: recover all isotopes; +* =-2: recover fissiles isotopes; +* =-3: recover fission products; +* >0: recover all isotopes in mixture ITYP. +* MAXISO dimension of arrays NOMISO and TYPISO. +* IPLIB pointer to the microlib (L_LIBRARY signature). +* +*Parameters: input/output +* NISO number of particularized isotopes. +* NOMISO alias names of the particularized isotopes. +* +*Parameters: output +* NOMEVO library names of the particularized isotopes. +* TYPISO type of each isotope: +* =1: the isotope is not fissile and not a fission product; +* =2: the isotope is fissile; +* =3: the isotope is a fission product. +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPLIB + INTEGER ITYP,MAXISO,NISO,TYPISO(MAXISO) + CHARACTER NOMISO(MAXISO)*(*),NOMEVO(MAXISO)*12 +*---- +* LOCAL VARIABLES +*---- + PARAMETER (NSTATE=40) + CHARACTER HNAME*20 + INTEGER ISTATE(NSTATE) +*---- +* ALLOCATABLE ARRAYS +*---- + INTEGER, ALLOCATABLE, DIMENSION(:) :: ISUSED,ISNEVO,ISMIX,ISTYP +* + IF(.NOT.C_ASSOCIATED(IPLIB)) RETURN + CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE) + NBISOT=ISTATE(2) + ALLOCATE(ISUSED(3*NBISOT),ISNEVO(3*NBISOT),ISMIX(NBISOT), + 1 ISTYP(NBISOT)) + CALL LCMGET(IPLIB,'ISOTOPESUSED',ISUSED) + CALL LCMGET(IPLIB,'ISOTOPERNAME',ISNEVO) + CALL LCMGET(IPLIB,'ISOTOPESMIX',ISMIX) + CALL LCMGET(IPLIB,'ISOTOPESTYPE',ISTYP) + IF(ITYP.EQ.0) THEN + DO 15 ISOT=1,NBISOT + WRITE(HNAME,'(2A4)') (ISUSED((ISOT-1)*3+I0),I0=1,2) + DO 10 I=1,NISO + IF(NOMISO(I).EQ.HNAME) THEN + TYPISO(I)=MAX(TYPISO(I),ISTYP(ISOT)) + WRITE(NOMEVO(I),'(3A4)') (ISNEVO((ISOT-1)*3+I0),I0=1,3) + ENDIF + 10 CONTINUE + 15 CONTINUE + DO 20 I=1,NISO + IF(TYPISO(I).EQ.0) THEN + HNAME=NOMISO(I) + CALL XABORT('COMISO: UNABLE TO FIND ISOTOPE '//TRIM(HNAME)// + 1 ' IN THE MICROLIB.') + ENDIF + 20 CONTINUE + ELSE + DO 40 ISOT=1,NBISOT + WRITE(HNAME,'(2A4)') (ISUSED((ISOT-1)*3+I0),I0=1,2) + DO 30 I=1,NISO + IF(NOMISO(I).EQ.HNAME) GO TO 40 + 30 CONTINUE + IMIX=ISMIX(ISOT) + JTYP=ISTYP(ISOT) + IF((ITYP.EQ.-1).OR.(ITYP.EQ.-JTYP).OR.(ITYP.EQ.IMIX)) THEN + NISO=NISO+1 + NOMISO(NISO)=HNAME + WRITE(NOMEVO(NISO),'(3A4)') (ISNEVO((ISOT-1)*3+I0),I0=1,3) + TYPISO(NISO)=0 + ENDIF + 40 CONTINUE + ENDIF + DEALLOCATE(ISTYP,ISMIX,ISNEVO,ISUSED) + RETURN + END -- cgit v1.2.3