summaryrefslogtreecommitdiff
path: root/Dragon/src/COMMIC.f
diff options
context:
space:
mode:
Diffstat (limited to 'Dragon/src/COMMIC.f')
-rw-r--r--Dragon/src/COMMIC.f478
1 files changed, 478 insertions, 0 deletions
diff --git a/Dragon/src/COMMIC.f b/Dragon/src/COMMIC.f
new file mode 100644
index 0000000..746de08
--- /dev/null
+++ b/Dragon/src/COMMIC.f
@@ -0,0 +1,478 @@
+*DECK COMMIC
+ SUBROUTINE COMMIC(IMPX,IPCPO,IPEDIT,IPEDI2,LMACRO,ICAL,MAXCAL,
+ 1 NMIL,NISOTS,NG,NED,NW,FNORM,LISO,NISOP,NOMISP,NGFF,NALBP,IDF,
+ 2 ITRES)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover a microlib corresponding to a set of homogenized mixtures.
+*
+*Copyright:
+* Copyright (C) 2002 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
+* IMPX print parameter.
+* IPCPO pointer to the multicompo.
+* IPEDIT pointer to the edition object (L_EDIT signature).
+* IPEDI2 pointer to the edition object containing group form factor
+* information (L_EDIT signature).
+* LMACRO flag set to .TRUE. to recover cross sections from the
+* macrolib.
+* ICAL index of the elementary calculation.
+* MAXCAL maximum number of elementary calculations in the multicompo.
+* NMIL number of homogenized mixtures.
+* NISOTS number of isotopes in the microlib pointed by IPEDIT.
+* NG number of energy groups.
+* NED number of additional edits.
+* NW type of weighting for P1 cross section info (=0: P0 ; =1: P1).
+* FNORM flux normalization factor.
+* LISO =.true. if we want to register the region number of the
+* isotopes.
+* NISOP number of user-requested particularized isotopes. Equal to
+* zero if all EDI: isotopes are particularized.
+* NOMISP names of user-requested particularized isotopes.
+* NGFF number of form factors per energy group.
+* NALBP number of physical albedos per energy group.
+* IDF flag for ADF info (-1/0/1/2: candidate/absent/present).
+*
+*Parameters: output
+* ITRES creation index for the macroscopic residual (=0: not created;
+* =1: not a FP precursor; =2: is a FP precursor).
+*
+*-----------------------------------------------------------------------
+*
+ USE GANLIB
+*----
+* SUBROUTINE ARGUMENTS
+*----
+ TYPE(C_PTR) IPCPO,IPEDIT,IPEDI2
+ INTEGER IMPX,ICAL,MAXCAL,NMIL,NISOTS,NG,NED,NW,NISOP,NGFF,NALBP,
+ 1 IDF,ITRES
+ CHARACTER NOMISP(NISOP)*8
+ REAL FNORM
+ LOGICAL LMACRO,LISO
+*----
+* LOCAL VARIABLES
+*----
+ PARAMETER (NSTATE=40)
+ TYPE(C_PTR) JPCPO,KPCPO,LPCPO,MPCPO,NPCPO,OPCPO,IPWORK,JPEDIT,
+ 1 KPEDIT
+ CHARACTER TEXT4*4,TEXT8*8,TEXT12*12
+ INTEGER IPAR(NSTATE),ISTATE(NSTATE)
+ LOGICAL LRES
+*----
+* ALLOCATABLE ARRAYS
+*----
+ INTEGER, ALLOCATABLE, DIMENSION(:) :: IMIX1,ITYP1,ITOD1,ITYP2,
+ 1 ITOD2,IPIFI,IPIFI2,ISW
+ INTEGER, ALLOCATABLE, DIMENSION(:,:) :: HUSE1,HNAM1,HUSE2,HNAM2,
+ 1 HVECT
+ REAL, ALLOCATABLE, DIMENSION(:) :: DENS1,TEMP1,VOL1,DENS2,TEMP2,
+ 1 VOL2,WORK,ENER,ZLAMB,DELT,VOLMIX,PYIELD,PYIEL2,PYRES,ADF2
+ REAL, ALLOCATABLE, DIMENSION(:,:) :: ALBP,ADF,ADFM2
+ REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ALBP2,ADFM
+ CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HADF
+*----
+* SCRATCH STORAGE ALLOCATION
+*----
+ ALLOCATE(HUSE1(3,NISOTS),HNAM1(3,NISOTS),IMIX1(NISOTS),
+ 1 ITYP1(NISOTS),ITOD1(NISOTS),HUSE2(3,NISOTS),HNAM2(3,NISOTS),
+ 2 ITYP2(NISOTS),ITOD2(NISOTS),ISW(NISOTS),HVECT(2,NED+1))
+ ALLOCATE(DENS1(NISOTS),TEMP1(NISOTS),VOL1(NISOTS),DENS2(NISOTS),
+ 1 TEMP2(NISOTS),VOL2(NISOTS),WORK(NG),ENER(NG+1),DELT(NG),
+ 2 VOLMIX(NMIL))
+*----
+* RECOVER THE TOC RECORDS
+*----
+ IF(.NOT.LMACRO) THEN
+ CALL LCMGET(IPEDIT,'STATE-VECTOR',IPAR)
+ CALL LCMGET(IPEDIT,'ISOTOPESUSED',HUSE1)
+ CALL LCMGET(IPEDIT,'ISOTOPERNAME',HNAM1)
+ CALL LCMGET(IPEDIT,'ISOTOPESDENS',DENS1)
+ CALL LCMGET(IPEDIT,'ISOTOPESMIX',IMIX1)
+ CALL LCMGET(IPEDIT,'ISOTOPESTYPE',ITYP1)
+ CALL LCMGET(IPEDIT,'ISOTOPESTODO',ITOD1)
+ CALL LCMGET(IPEDIT,'ISOTOPESVOL',VOL1)
+ CALL LCMGET(IPEDIT,'ISOTOPESTEMP',TEMP1)
+ CALL LCMGET(IPEDIT,'MIXTURESVOL',VOLMIX)
+ CALL LCMLEN(IPEDIT,'K-EFFECTIVE',ILONG,ITYLCM)
+ IF(ILONG.EQ.1) THEN
+ CALL LCMGET(IPEDIT,'K-EFFECTIVE',EIGENK)
+ ELSE
+ EIGENK=0.0
+ ENDIF
+ CALL LCMLEN(IPEDIT,'K-INFINITY',ILONG,ITYLCM)
+ IF(ILONG.EQ.1) THEN
+ CALL LCMGET(IPEDIT,'K-INFINITY',EIGINF)
+ ELSE
+ EIGINF=EIGENK
+ ENDIF
+ CALL LCMLEN(IPEDIT,'B2 B1HOM',ILONG,ITYLCM)
+ IF(ILONG.EQ.1) THEN
+ CALL LCMGET(IPEDIT,'B2 B1HOM',B2)
+ ELSE
+ B2=0.0
+ ENDIF
+ IF(NED.GT.0) CALL LCMGET(IPEDIT,'ADDXSNAME-P0',HVECT)
+ CALL LCMGET(IPEDIT,'ENERGY',ENER)
+ CALL LCMGET(IPEDIT,'DELTAU',DELT)
+ NDEL=IPAR(19)
+ IF(IDF.NE.0) IDF=IPAR(24)
+ ENDIF
+*----
+* LOOP OVER HOMOGENIZED MIXTURES
+*----
+ TEXT4=' '
+ NSPH=0
+ READ(TEXT4,'(A4)') ITEXT
+ JPCPO=LCMLID(IPCPO,'MIXTURES',NMIL)
+ DO 130 IMIL=1,NMIL
+ KPCPO=LCMDIL(JPCPO,IMIL)
+ LPCPO=LCMLID(KPCPO,'CALCULATIONS',MAXCAL)
+ MPCPO=LCMDIL(LPCPO,ICAL)
+ ISO3=0
+ MAXIS2=1
+ IF(.NOT.LMACRO) THEN
+ ISW(:NISOTS)=0
+ DO 30 ISO1=1,NISOTS
+ IF(IMIX1(ISO1).EQ.IMIL) THEN
+ IF(NISOP.GT.0) THEN
+ WRITE(TEXT8,'(2A4)') (HUSE1(I0,ISO1),I0=1,2)
+ DO 10 JSO=1,NISOP
+ IF(NOMISP(JSO).EQ.TEXT8) GO TO 20
+ 10 CONTINUE
+ GO TO 30
+ ENDIF
+ 20 MAXIS2=MAXIS2+1
+ ENDIF
+ 30 CONTINUE
+ ENDIF
+ NPCPO=LCMLID(MPCPO,'ISOTOPESLIST',MAXIS2)
+ IF(LMACRO) THEN
+* RECOVER CROSS SECTIONS FROM THE MACROLIB.
+ CALL LCMSIX(IPEDIT,'MACROLIB',1)
+ CALL LCMGET(IPEDIT,'STATE-VECTOR',IPAR)
+ NL=IPAR(3)
+ NF=IPAR(4)
+ NDEL=IPAR(7)
+ IF(IDF.NE.0) IDF=IPAR(12)
+ NSPH=IPAR(14)
+ ALLOCATE(ZLAMB(NDEL))
+ OPCPO=LCMDIL(NPCPO,1) ! set first isotope
+ CALL COMACR(IPEDIT,IMPX,OPCPO,NG,NMIL,NED,NL,NF,NDEL,NW,IMIL,
+ 1 FNORM,NSPH,EIGENK,EIGINF,B2,VOLUME,ENER,DELT,HVECT,ZLAMB)
+ CALL LCMSIX(IPEDIT,' ',2)
+ NISO2=1
+ DENS2(NISO2)=1.0
+ ITYP2(NISO2)=1
+ IF(NF.GT.0) ITYP2(NISO2)=2
+ ITOD2(NISO2)=1
+ VOL2(NISO2)=VOLUME
+ VOLMIX(IMIL)=VOLUME
+ TEMP2(NISO2)=0.0
+ TEXT12='*MAC*RES'
+ CALL LCMPTC(OPCPO,'ALIAS',12,TEXT12)
+ READ(TEXT12,'(3A4)') (HUSE2(I0,NISO2),I0=1,3)
+ READ(TEXT12,'(3A4)') (HNAM2(I0,NISO2),I0=1,3)
+ IPAR(:NSTATE)=0
+ IPAR(3)=NG
+ IPAR(4)=NL
+ IPAR(13)=NED+NSPH
+ IPAR(19)=NDEL
+ IPAR(24)=IDF
+ ELSE
+* RECOVER CROSS SECTIONS FROM THE MICROLIB.
+ JPEDIT=LCMGID(IPEDIT,'ISOTOPESLIST')
+ NISO2=0
+ ISW(:NISOTS)=0
+ DO 100 ISO1=1,NISOTS
+ IF(IMIX1(ISO1).EQ.IMIL) THEN
+ IF(NISOP.GT.0) THEN
+ WRITE(TEXT8,'(2A4)') (HUSE1(I0,ISO1),I0=1,2)
+ DO 40 JSO=1,NISOP
+ IF(NOMISP(JSO).EQ.TEXT8) GO TO 50
+ 40 CONTINUE
+ ISO3=ISO3+1
+ ISW(ISO1)=-ISO3
+ GO TO 100
+ ENDIF
+ 50 NISO2=NISO2+1
+ IF(NISO2.GT.MAXIS2) CALL XABORT('COMMIC: MAXIS2 OVERFLOW.')
+ ISW(ISO1)=NISO2
+ DO 60 I0=1,2
+ HUSE2(I0,NISO2)=HUSE1(I0,ISO1)
+ 60 CONTINUE
+ HUSE2(3,NISO2)=ITEXT
+ IF(LISO) HUSE2(3,NISO2)=HUSE1(3,ISO1)
+ DO 70 I0=1,3
+ HNAM2(I0,NISO2)=HNAM1(I0,ISO1)
+ 70 CONTINUE
+ DENS2(NISO2)=DENS1(ISO1)
+ ITYP2(NISO2)=ITYP1(ISO1)
+ ITOD2(NISO2)=ITOD1(ISO1)
+ VOL2(NISO2)=VOL1(ISO1)
+ TEMP2(NISO2)=TEMP1(ISO1)
+ KPEDIT=LCMGIL(JPEDIT,ISO1) ! set ISO1-th isotope
+ OPCPO=LCMDIL(NPCPO,NISO2) ! set NISO2-th isotope
+ CALL LCMEQU(KPEDIT,OPCPO)
+*
+* FLUX NORMALIZATION:
+ DO 90 IW=1,MIN(NW+1,10)
+ WRITE(TEXT12,'(3HNWT,I1)') IW-1
+ CALL LCMLEN(OPCPO,TEXT12,ILONG,ITYLCM)
+ IF(ILONG.GT.0) THEN
+ CALL LCMGET(OPCPO,TEXT12,WORK)
+ DO 80 IG=1,NG
+ WORK(IG)=WORK(IG)*FNORM
+ 80 CONTINUE
+ CALL LCMPUT(OPCPO,TEXT12,NG,2,WORK)
+ ENDIF
+ 90 CONTINUE
+ ENDIF
+ 100 CONTINUE
+ ENDIF
+*----
+* CREATE A NEW MACROSCOPIC RESIDUAL ISOTOPE
+*----
+ ITRES=0
+ ALLOCATE(PYRES(NISO2+1))
+ IF(ISO3.GT.0) THEN
+ NISO2=NISO2+1
+ IF(NISO2.GT.MAXIS2) CALL XABORT('COMMIC: MAXIS2 OVERFLOW(2).')
+ CALL LCMOP(IPWORK,'*TEMPORARY*',0,1,0)
+ CALL COMRES(IMPX,IPWORK,IPEDIT,NISOTS,NISO2,ISW,FNORM,ITRES,
+ 1 PYRES)
+ OPCPO=LCMDIL(NPCPO,NISO2) ! set NISO2-th isotope
+ CALL LCMEQU(IPWORK,OPCPO)
+ CALL LCMCL(IPWORK,2)
+ TEXT12='*MAC*RES'
+ READ(TEXT12,'(3A4)') (HUSE2(I0,NISO2),I0=1,3)
+ READ(TEXT12,'(3A4)') (HNAM2(I0,NISO2),I0=1,3)
+ DENS2(NISO2)=1.0
+ ITYP2(NISO2)=ITRES
+ ITOD2(NISO2)=1
+ VOL2(NISO2)=VOL2(NISO2-1)
+ TEMP2(NISO2)=TEMP2(NISO2-1)
+ ENDIF
+ IF(NISO2.EQ.0) GO TO 125
+*----
+* COPY DISCONTINUITY FACTOR INFORMATION AND PERFORM NORMALIZATION
+* NOTE: THE NUMBER OF MIXTURES IS ALWAYS EQUAL TO 1 IN THE MULTICOMPO.
+*----
+ IF(IDF.NE.0) THEN
+ CALL LCMSIX(IPEDIT,'MACROLIB',1)
+ CALL LCMLEN(IPEDIT,'ADF',ILONG,ITYLCM)
+ IF(ILONG.EQ.0) THEN
+ CALL LCMLIB(IPEDIT)
+ CALL XABORT('COMMIC: MISSING ADF INFO IN EDITION OBJECT.')
+ ENDIF
+ CALL LCMSIX(IPEDIT,'ADF',1)
+ CALL LCMSIX(MPCPO,'MACROLIB',1)
+ CALL LCMSIX(MPCPO,'ADF',1)
+ IF(IDF.EQ.1)THEN
+ CALL LCMEQU(IPEDIT,MPCPO)
+ ALLOCATE(ADF(NG,2))
+ CALL LCMGET(MPCPO,'ALBS00',ADF)
+ DO IG=1,NG
+ ADF(IG,:2)=ADF(IG,:2)*FNORM
+ ENDDO
+ CALL LCMPUT(MPCPO,'ALBS00',NG*2,2,ADF)
+ DEALLOCATE(ADF)
+ ELSE IF((IDF.EQ.2).OR.(IDF.EQ.3)) THEN
+ CALL LCMLEN(IPEDIT,'HADF',NTYPE,ITYLCM)
+ NTYPE=NTYPE/2
+ IF(NTYPE.GT.0) THEN
+ ALLOCATE(ADF(NMIL,NG),ADF2(NG),HADF(NTYPE))
+ CALL LCMPUT(MPCPO,'NTYPE',1,1,NTYPE)
+ CALL LCMGTC(IPEDIT,'HADF',8,NTYPE,HADF)
+ CALL LCMPTC(MPCPO,'HADF',8,NTYPE,HADF)
+ DO ITYPE=1,NTYPE
+ CALL LCMLEN(IPEDIT,HADF(ITYPE),ILONG,ITYLCM)
+ IF(ILONG.NE.NMIL*NG) CALL XABORT('COMMIC: INVALID HADF '
+ 1 //'LENGTH(1).')
+ CALL LCMGET(IPEDIT,HADF(ITYPE),ADF)
+ DO IG=1,NG
+ ADF2(IG)=ADF(IMIL,IG)
+ ENDDO
+ IF(IDF.EQ.2) ADF2(:)=ADF2(:)*FNORM
+ CALL LCMPUT(MPCPO,HADF(ITYPE),NG,2,ADF2)
+ ENDDO
+ CALL LCMLEN(IPEDIT,'AVG_FLUX',ILONG,ITYLCM)
+ IF(ILONG.EQ.NMIL*NG) THEN
+ CALL LCMGET(IPEDIT,'AVG_FLUX',ADF)
+ DO IG=1,NG
+ ADF2(IG)=ADF(IMIL,IG)
+ ENDDO
+ IF(IDF.EQ.2) ADF2(:)=ADF2(:)*FNORM
+ CALL LCMPUT(MPCPO,'AVG_FLUX',NG,2,ADF2)
+ ENDIF
+ DEALLOCATE(HADF,ADF2,ADF)
+ ENDIF
+ ELSE IF(IDF.EQ.4) THEN
+ CALL LCMLEN(IPEDIT,'HADF',NTYPE,ITYLCM)
+ NTYPE=NTYPE/2
+ IF(NTYPE.GT.0) THEN
+ ALLOCATE(ADFM(NMIL,NG,NG),ADFM2(NG,NG),HADF(NTYPE))
+ CALL LCMPUT(MPCPO,'NTYPE',1,1,NTYPE)
+ CALL LCMGTC(IPEDIT,'HADF',8,NTYPE,HADF)
+ CALL LCMPTC(MPCPO,'HADF',8,NTYPE,HADF)
+ DO ITYPE=1,NTYPE
+ CALL LCMLEN(IPEDIT,HADF(ITYPE),ILONG,ITYLCM)
+ IF(ILONG.NE.NMIL*NG*NG) CALL XABORT('COMMIC: INVALID HA'
+ 1 //'DF LENGTH(2).')
+ CALL LCMGET(IPEDIT,HADF(ITYPE),ADFM)
+ DO JG=1,NG
+ DO IG=1,NG
+ ADFM2(IG,JG)=ADFM(IMIL,IG,JG)
+ ENDDO
+ ENDDO
+ CALL LCMPUT(MPCPO,HADF(ITYPE),NG*NG,2,ADFM2)
+ ENDDO
+ DEALLOCATE(HADF,ADFM2,ADFM)
+ ENDIF
+ ENDIF
+ CALL LCMSIX(MPCPO,' ',2)
+ CALL LCMSIX(MPCPO,' ',2)
+ CALL LCMSIX(IPEDIT,' ',2)
+ CALL LCMSIX(IPEDIT,' ',2)
+ ENDIF
+*----
+* RECOVER GROUP FORM FACTOR INFORMATION
+*----
+ IF(NGFF.NE.0) THEN
+ IF(.NOT.C_ASSOCIATED(IPEDI2)) THEN
+ CALL XABORT('COMMIC: MISSING EDITION OBJECT WITH GFF INFO.')
+ ENDIF
+ CALL COMGFF(MPCPO,IPEDI2,FNORM,NGFF)
+ ENDIF
+*----
+* RECOVER PHYSICAL ALBEDO INFORMATION
+*----
+ IF(NALBP.NE.0) THEN
+ CALL LCMSIX(IPEDIT,'MACROLIB',1)
+ CALL LCMGET(IPEDIT,'STATE-VECTOR',ISTATE)
+ IF(NG.NE.ISTATE(1)) CALL XABORT('COMMIC: INVALID NUMBER OF EN'
+ 1 //'ERGY GROUPS IN EDITION OBJECT.')
+ IF(NALBP.EQ.-1) THEN
+ NALBP=ISTATE(8)
+ ELSE IF(NALBP.NE.ISTATE(8)) THEN
+ CALL XABORT('COMMIC: INVALID NUMBER OF PHYSICAL ALBEDOS IN'
+ 1 //' EDITION OBJECT.')
+ ENDIF
+ IF(NALBP.NE.0) THEN
+ CALL LCMLEN(IPEDIT,'ALBEDO',ILONG,ITYLCM)
+ IF(ILONG.EQ.NALBP*NG) THEN
+* diagonal physical albedos
+ ALLOCATE(ALBP(NALBP,NG))
+ CALL LCMGET(IPEDIT,'ALBEDO',ALBP)
+ CALL LCMSIX(MPCPO,'MACROLIB',1)
+ CALL LCMPUT(MPCPO,'ALBEDO',NALBP*NG,2,ALBP)
+ CALL LCMSIX(MPCPO,' ',2)
+ DEALLOCATE(ALBP)
+ ELSE IF(ILONG.EQ.NALBP*NG*NG) THEN
+* matrix physical albedos
+ ALLOCATE(ALBP2(NALBP,NG,NG))
+ CALL LCMGET(IPEDIT,'ALBEDO',ALBP2)
+ CALL LCMSIX(MPCPO,'MACROLIB',1)
+ CALL LCMPUT(MPCPO,'ALBEDO',NALBP*NG*NG,2,ALBP2)
+ CALL LCMSIX(MPCPO,' ',2)
+ DEALLOCATE(ALBP2)
+ ELSE
+ CALL XABORT('COMMIC: INCONSISTENT ALBEDO INFORMATION.')
+ ENDIF
+ ENDIF
+ CALL LCMSIX(IPEDIT,' ',2)
+ ENDIF
+*----
+* RESET INFORMATION IN LAMBDA-D, PIFI AND PYIELD
+*----
+ NDFI2=0
+ DO 120 ISO=1,NISO2
+ IF(LMACRO.AND.(NDEL.GT.0).AND.(ITYP2(ISO).EQ.2)) THEN
+ OPCPO=LCMGIL(NPCPO,ISO) ! set ISO-th isotope
+ CALL LCMPUT (OPCPO,'LAMBDA-D',NDEL,2,ZLAMB)
+ ELSE IF(ITYP2(ISO).EQ.3) THEN
+ OPCPO=LCMGIL(NPCPO,ISO) ! set ISO-th isotope
+ CALL LCMLEN(OPCPO,'PIFI',NDFI,ITYLCM)
+ IF(NDFI.GT.0) THEN
+ ALLOCATE(IPIFI(NDFI),PYIELD(NDFI),IPIFI2(NDFI+1),
+ 1 PYIEL2(NDFI+1))
+ CALL LCMGET(OPCPO,'PIFI',IPIFI)
+ CALL LCMGET(OPCPO,'PYIELD',PYIELD)
+ NDFI2=0
+ LRES=.FALSE.
+ DO 110 I=1,NDFI
+ IFI=IPIFI(I)
+ IF(IFI.GT.NISOTS) CALL XABORT('COMMIC: NISOTS OVERFLOW.')
+ IF(ISW(IFI).GT.0) THEN
+ NDFI2=NDFI2+1
+ IPIFI2(NDFI2)=ISW(IFI)
+ PYIEL2(NDFI2)=PYIELD(I)
+ ELSE IF(ISW(IFI).LT.0) THEN
+ LRES=.TRUE.
+ ENDIF
+ 110 ENDDO
+ IF(LRES) THEN
+ NDFI2=NDFI2+1
+ IPIFI2(NDFI2)=NISO2
+ PYIEL2(NDFI2)=PYRES(ISO)
+ ENDIF
+ IF(NDFI2.GT.0) THEN
+ CALL LCMPUT(OPCPO,'PIFI',NDFI2,1,IPIFI2)
+ CALL LCMPUT(OPCPO,'PYIELD',NDFI2,2,PYIEL2)
+ ENDIF
+ DEALLOCATE(PYIEL2,IPIFI2,PYIELD,IPIFI)
+ ENDIF
+ ENDIF
+ 120 CONTINUE
+*
+ IPAR(1)=1
+ IPAR(2)=NISO2
+ IPAR(11)=0
+ IPAR(14)=1
+ IPAR(20)=NDFI2
+ IPAR(25)=NW
+ TEXT12='L_LIBRARY'
+ CALL LCMPTC(MPCPO,'SIGNATURE',12,TEXT12)
+ CALL LCMPUT(MPCPO,'STATE-VECTOR',NSTATE,1,IPAR)
+ ISW(:NISO2)=1
+ CALL LCMPUT(MPCPO,'ISOTOPESMIX',NISO2,1,ISW)
+ CALL LCMPUT(MPCPO,'ISOTOPESUSED',3*NISO2,3,HUSE2)
+ CALL LCMPUT(MPCPO,'ISOTOPERNAME',3*NISO2,3,HNAM2)
+ CALL LCMPUT(MPCPO,'ISOTOPESDENS',NISO2,2,DENS2)
+ CALL LCMPUT(MPCPO,'ISOTOPESTYPE',NISO2,1,ITYP2)
+ CALL LCMPUT(MPCPO,'ISOTOPESTODO',NISO2,1,ITOD2)
+ CALL LCMPUT(MPCPO,'ISOTOPESVOL',NISO2,2,VOL2)
+ CALL LCMPUT(MPCPO,'ISOTOPESTEMP',NISO2,2,TEMP2)
+ CALL LCMPUT(MPCPO,'MIXTURESVOL',1,2,VOLMIX(IMIL))
+ IF(EIGENK.NE.0.0) CALL LCMPUT(MPCPO,'K-EFFECTIVE',1,2,EIGENK)
+ IF(EIGINF.NE.0.0) CALL LCMPUT(MPCPO,'K-INFINITY',1,2,EIGINF)
+ IF(B2.NE.0.0) CALL LCMPUT(MPCPO,'B2 B1HOM',1,2,B2)
+ IF((NED+NSPH).GT.0) CALL LCMPUT(MPCPO,'ADDXSNAME-P0',2*(NED+NSPH),
+ 1 3,HVECT)
+ CALL LCMPUT(MPCPO,'ENERGY',NG+1,2,ENER)
+ CALL LCMPUT(MPCPO,'DELTAU',NG,2,DELT)
+ IF(IMPX.GT.2) WRITE(6,140) IMIL,NISO2
+ IF(IMPX.GT.5) CALL LCMLIB(MPCPO)
+ IF(LMACRO) DEALLOCATE(ZLAMB)
+ 125 DEALLOCATE(PYRES)
+ 130 CONTINUE
+*----
+* SCRATCH STORAGE DEALLOCATION
+*----
+ DEALLOCATE(VOLMIX,DELT,ENER,WORK,VOL2,TEMP2,DENS2,VOL1,TEMP1,
+ 1 DENS1)
+ DEALLOCATE(HVECT,ISW,ITOD2,ITYP2,HNAM2,HUSE2,ITOD1,ITYP1,IMIX1,
+ 1 HNAM1,HUSE1)
+ RETURN
+*
+ 140 FORMAT(39H COMMIC: PROCESSING HOMOGENIZED MIXTURE,I4,9H CONTAINI,
+ 1 2HNG,I5,10H ISOTOPES.)
+ END
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 19:23:15 +0000