*DECK CFCDRV SUBROUTINE CFCDRV (IPRINT,NENTRY,KENTRY,HENTRY,NBURN,NGRP,NISO, 1 NL,CTITRE,TEX,NXS,NBPARA,DBPARA) * *----------------------------------------------------------------------- * *Purpose: * Driver for the construction of a feedback database. * *Copyright: * Copyright (C) 1996 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): M. T. Sissaoui * *Parameters: input * IPRINT print level. * NENTRY number of LCM objects. * KENTRY address of the LCM objects. * HENTRY name of the LCM objects. * NBURN number of burnup steps. * NGRP number of energy groups. * NISO 1+number of extracted isotopes. * NL number of Legendre orders. * CTITRE execution title. * TEX database name. * NXS number of reactions (equal to 21+NL). * NBPARA number of parameters for FBM. * DBPARA values of parameters for FBM. * *----------------------------------------------------------------------- * USE GANLIB *---- * SUBROUTINE ARGUMENTS *---- TYPE(C_PTR) KENTRY(NENTRY) INTEGER IPRINT,NENTRY,NBURN,NGRP,NISO,NL,NXS,NBPARA CHARACTER HENTRY(NENTRY)*12,TEX*9 REAL DBPARA(NBPARA) *---- * LOCAL PARAMETERS *---- TYPE(C_PTR) IPLISU,IPLISD,IPFBM,IPLIST,IPHISU,IPHISD,IPHIST INTEGER IOUT,NSTATE PARAMETER (IOUT=6,NSTATE=40) CHARACTER TEXT1*8,CM*2,TEXT2*8,HMICRO*12, 1 TEXTB*12,TEXT(2)*12,TEXTR*12,TEXT12*12,CTITRE*72 INTEGER ISTATE(NSTATE),IPAR(5),HTITLE(18) REAL XP(7) *---- * ALLOCATABLE STATEMENTS *---- INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,MIJ,MNJ,HISO,JTAB, 1 IXS REAL, ALLOCATABLE, DIMENSION(:) :: WORK3,DENSIT,EFJ,KBUR,KB REAL, ALLOCATABLE, DIMENSION(:) :: TOT2,ZN2,DXF2,DYF2,DZF2,HF2, 1 SCA2,MIRCT2,MIRCS2,MICDX2,MICDY2,MICDZ2,V2,MIRCF2,MIRCH2 REAL, ALLOCATABLE, DIMENSION(:) :: FLUI3,FLDIS3,OV3,DIFD3,NF3, 1 CHI3,MCHI3 REAL, ALLOCATABLE, DIMENSION(:,:) :: TOTAL,ZNUG,DIFFX,DIFFY,DIFFZ, 1 H,REFC,DELTA REAL, ALLOCATABLE, DIMENSION(:,:,:) :: TMREF,DMRFX,DMRFY,DMRFZ, 1 FMREF,HMREF REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: SCAT REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:) :: SMREF *---- * SCRATCH STORAGE ALLOCATION *---- ALLOCATE(IJJ(NL*NGRP),NJJ(NL*NGRP),MIJ(NL*NGRP),MNJ(NL*NGRP), 1 HISO(3*NISO),JTAB(NISO),IXS(NXS)) ALLOCATE(TOTAL(NGRP,NBURN),ZNUG(NGRP,NBURN),DIFFX(NGRP,NBURN), 1 DIFFY(NGRP,NBURN),DIFFZ(NGRP,NBURN),H(NGRP,NBURN), 2 SCAT(NBURN,NL,NGRP,NGRP),WORK3(NGRP*(NGRP+1)),DENSIT(NISO), 3 EFJ(NISO),TMREF(NGRP,NBURN,NISO),SMREF(NISO,NBURN,NL,NGRP,NGRP), 4 DMRFX(NGRP,NBURN,NISO),DMRFY(NGRP,NBURN,NISO), 5 DMRFZ(NGRP,NBURN,NISO),REFC(NBURN,NISO),FMREF(NGRP,NBURN,NISO), 6 HMREF(NGRP,NBURN,NISO),DELTA(NBURN,2)) *----- * REFERENCE(NOMINAL) LOCAL PARAMETER *----- PWR=DBPARA(1) TCR=DBPARA(2) TMR=DBPARA(3) TFR=DBPARA(4) RHOM=DBPARA(5) RHOC=DBPARA(6) XIR=DBPARA(7) TFU=DBPARA(8) TCU=DBPARA(9) PWUL=DBPARA(10) PWDL=DBPARA(11) PWU=DBPARA(12) PWD=DBPARA(13) XI=DBPARA(14) C C FLAG FOR COLLISION PROBABILITY CALCULATION C IXYZ=0 PIJ CALCULATION C IXYZ=1 PIJK CALCULATION C IXYZ=0 C----- C CHECK NGRP AND NBURN C----- IF(NBURN.EQ.0) CALL XABORT('CFCDRV: ZERO NUMBER OF MIXTURES.') IF(NGRP.EQ.0) CALL XABORT('CFCDRV: ZERO NUMBER OF GROUPS.') C C ONLY THE FIRST ORDER IS CONSIDERED IN FBM C C----------------------------------------------------------------------C C----- C DYNAMIC MEMORY ALLOCATION C----- ALLOCATE(TOT2(2*NBURN*NGRP),ZN2(2*NBURN*NGRP),DXF2(2*NBURN*NGRP), 1 DYF2(2*NBURN*NGRP),DZF2(2*NBURN*NGRP),HF2(2*NBURN*NGRP), 2 SCA2(2*NBURN*NL*NGRP*NGRP),MIRCT2(2*NBURN*NISO*NGRP), 3 MIRCS2(2*NBURN*NL*NGRP*NGRP*NISO),MICDX2(2*NBURN*NISO*NGRP), 4 MICDY2(2*NBURN*NISO*NGRP),MICDZ2(2*NBURN*NISO*NGRP),V2(16*NBURN), 5 MIRCF2(2*NBURN*NISO*NGRP),MIRCH2(2*NBURN*NISO*NGRP)) C C----- C DATABASE FILE UNIT NUMBER C----- IPFBM=KENTRY(1) C----- C STOTRE THE NOMINAL LOCAL PARAMETER IN THE DATABASE C IP=1 FOR THE FUEL C IP=2 FOR THE REFLECTOR C----- DO 801 IP=1,2 C C INITIALIZATION OF THE MATRICES. C JTAB(:NISO)=0 TOTAL(:NGRP,:NBURN)=0.0 ZNUG(:NGRP,:NBURN)=0.0 DIFFX(:NGRP,:NBURN)=0.0 DIFFY(:NGRP,:NBURN)=0.0 DIFFZ(:NGRP,:NBURN)=0.0 H(:NGRP,:NBURN)=0.0 TMREF(:NGRP,:NBURN,:NISO)=0.0 DMRFX(:NGRP,:NBURN,:NISO)=0.0 DMRFY(:NGRP,:NBURN,:NISO)=0.0 DMRFZ(:NGRP,:NBURN,:NISO)=0.0 FMREF(:NGRP,:NBURN,:NISO)=0.0 HMREF(:NGRP,:NBURN,:NISO)=0.0 SCAT(:NBURN,:NL,:NGRP,:NGRP)=0.0 SMREF(:NISO,:NBURN,:NL,:NGRP,:NGRP)=0.0 DO 10 IGR=1,NGRP IJJ(IGR)=IGR NJJ(IGR)=1 MIJ(IGR)=IGR MNJ(IGR)=1 10 CONTINUE C DO 44 ILOC=1,7 IF(ILOC.EQ.1) THEN HMICRO='PW' XP(ILOC)=PWR ELSE IF(ILOC.EQ.2) THEN HMICRO='TCOOL' XP(ILOC)=TCR ELSE IF(ILOC.EQ.3) THEN HMICRO='TMOD' XP(ILOC)=TMR ELSE IF(ILOC.EQ.4) THEN HMICRO='TFUEL' XP(ILOC)=TFR ELSE IF(ILOC.EQ.5) THEN HMICRO='RHOC' XP(ILOC)=RHOC ELSE IF(ILOC.EQ.6) THEN HMICRO='RHOM' XP(ILOC)=RHOM ELSE IF(ILOC.EQ.7) THEN HMICRO='PUR' XP(ILOC)=XIR ENDIF READ(HMICRO,'(3A4)') (HISO((ILOC-1)*3+IH),IH=1,3) 44 CONTINUE C----- C TYPE OF PROPERTIES C----- IF(IP.EQ.1) THEN IPLIST=KENTRY(2) TEXTR='FUL'//TEX ELSE IPLIST=KENTRY(23) TEXTR='MOD'//TEX ENDIF C----------------------------------------------------------------------C C----- C RECOVER AND STORE NEUTRONICS PARAMETRES C----- IF(IP.EQ.1) THEN CALL LCMSIX(IPFBM,TEXTR,1) CALL LCMSIX(IPFBM,'INFO-NOMINA',1) CALL LCMPUT(IPFBM,'NOMINALN',3*7,3,HISO) CALL LCMPUT(IPFBM,'NOMINALP',7,2,XP) CALL LCMSIX(IPFBM,' ',2) READ(CTITRE,'(18A4)') (HTITLE(I),I=1,18) CALL LCMPUT(IPFBM,'TITLE',18,3,HTITLE) IPAR(1)=NGRP IPAR(2)=NISO IPAR(3)=NL IPAR(4)=NBURN NBUM=NBURN NISM=NISO CALL LCMPUT(IPFBM,'PARAM',4,1,IPAR) CALL LCMSIX(IPFBM,' ',2) ELSE TEXT12='SIGNATURE' CALL LCMNXT(IPLIST,TEXT12) C IF(TEXT12.EQ.'SIGNATURE') CALL XABORT('CFCDRV: ' 1 //'INVALID INPUT COMPO.') CALL LCMGET(IPLIST,'STATE-VECTOR',ISTATE) CALL LCMSIX(IPLIST,TEXT12,1) CALL LCMSIX(IPLIST,' ',2) NGRP=ISTATE(2) NISO=ISTATE(3) NL=ISTATE(4) NBURN=ISTATE(5) C CALL LCMSIX(IPFBM,TEXTR,1) CALL LCMSIX(IPFBM,'INFO-NOMINA',1) CALL LCMPUT(IPFBM,'NOMINALN',3*7,3,HISO) CALL LCMPUT(IPFBM,'NOMINALP',7,2,XP) CALL LCMSIX(IPFBM,' ',2) READ(CTITRE,'(18A4)') (HTITLE(I),I=1,18) CALL LCMPUT(IPFBM,'TITLE',18,3,HTITLE) CALL LCMSIX(IPFBM,' ',2) ENDIF C C RECOVER INFORMATION FROM CPO FILE(NOMINAL) C ALLOCATE(KB(NBURN),KBUR(NBURN)) IF(IP.EQ.1) THEN CALL LCMSIX(IPLIST,'REF 1',1) ELSE CALL LCMSIX(IPLIST,'MODREF 1',1) ENDIF CALL LCMGET(IPLIST,'ISOTOPESNAME',HISO) CALL LCMGET(IPLIST,'VOLUME',VOL) CALL LCMGET(IPLIST,'ENERGY',WORK3) CALL LCMGET(IPLIST,'BURNUP',KBUR) CALL LCMGET(IPLIST,'N/KB',KB) CALL LCMSIX(IPLIST,' ',2) C C STORE INFORMATION IN THE DATABASE C CALL LCMSIX(IPFBM,TEXTR,1) CALL LCMPUT(IPFBM,'HITAB',3*NISO,3,HISO) CALL LCMPUT(IPFBM,'VOLUME',1,2,VOL) CALL LCMPUT(IPFBM,'ENERGY',NGRP+1,2,WORK3) CALL LCMPUT(IPFBM,'BURNUP',NBURN,2,KBUR) CALL LCMPUT(IPFBM,'N/KB',NBURN,2,KB) CALL LCMSIX(IPFBM,' ',2) C DEALLOCATE(KBUR,KB) C----- C GOING DOWN TO THE MACR AND MICR SUB-DIRECTORIES C----- C C DYNAMIC ALLOCATION MEMORY C ALLOCATE(FLUI3(NGRP),FLDIS3(NGRP),OV3(NGRP),DIFD3(3*NGRP), 1 NF3(NGRP),CHI3(NGRP),MCHI3(NGRP)) C DO 20 I=1,NBURN WRITE(TEXTB,'(4HBURN,4X,I4)') I IF(IP.EQ.1) THEN CALL LCMSIX(IPLIST,'REF 1',1) ELSE CALL LCMSIX(IPLIST,'MODREF 1',1) ENDIF CALL LCMSIX(IPLIST,TEXTB,1) CALL LCMGET(IPLIST,'ISOTOPESDENS',DENSIT) CALL LCMGET(IPLIST,'ISOTOPES-EFJ',EFJ) IF(DENSIT(1).NE.1.0) CALL XABORT('FBM: DENSIT(1).NE.1.') CALL LCMGET(IPLIST,'FLUX-INTG',FLUI3) CALL LCMGET(IPLIST,'FLUXDISAFACT',FLDIS3) CALL LCMGET(IPLIST,'OVERV',OV3) C----- C RECOVER MACROSCOPIC X-SECTIONS. C----- CALL LCMSIX(IPLIST,'MACR',1) IXS(:NXS)=0 CALL LCMGET(IPLIST,'XS-SAVED',IXS) CALL LCMGET(IPLIST,'SCAT-SAVED',IXS(21)) IF(IXS(18).EQ.1) IXYZ=1 IF(IXS(3).EQ.1) JTAB(1)=1 C IF(IXS(1).EQ.1) CALL LCMGET(IPLIST,'TOTAL',TOTAL(1,I)) IF(IXS(3).EQ.1) CALL LCMGET(IPLIST,'NUSIGF',ZNUG(1,I)) IF(IXS(4).EQ.1) THEN CALL LCMGET(IPLIST,'NFTOT',NF3) CALL LCMGET(IPLIST,'NFTOT',H(1,I)) DO 11 IGR=1,NGRP H(IGR,I)=H(IGR,I)*EFJ(1) 11 CONTINUE ENDIF IF(IXS(5).EQ.1) CALL LCMGET(IPLIST,'CHI',CHI3) IF(IXS(17).EQ.1) CALL LCMGET(IPLIST,'STRD ',DIFFX(1,I)) IF(IXS(18).EQ.1) CALL LCMGET(IPLIST,'STRD X',DIFFX(1,I)) IF(IXS(19).EQ.1) CALL LCMGET(IPLIST,'STRD Y',DIFFY(1,I)) IF(IXS(20).EQ.1) CALL LCMGET(IPLIST,'STRD Z',DIFFZ(1,I)) CALL LCMLEN(IPLIST,'NUSIGF',ILENGF,ITYLCM) C C RECOVER SCATTERING X-SECTIONS. C IL=1 WRITE (CM,'(I2.2)') IL-1 IF(IXS(20+IL).EQ.1) THEN CALL LCMGET(IPLIST,'SIGS'//CM,WORK3) DO 110 IGR=1,NGRP TOTAL(IGR,I)= TOTAL(IGR,I)-WORK3(IGR) 110 CONTINUE C CALL LCMLEN(IPLIST,'SCAT'//CM,LENGT,ITYLCM) CALL LCMGET(IPLIST,'SCAT'//CM,WORK3) CALL LCMGET(IPLIST,'NJJS'//CM,NJJ) CALL LCMGET(IPLIST,'IJJS'//CM,IJJ) IGAR=0 DO 125 JGR=1,NGRP DO 120 IGR=IJJ(JGR),IJJ(JGR)-NJJ(JGR)+1,-1 IGAR=IGAR+1 SCAT(I,IL,IGR,JGR)=WORK3(IGAR) 120 CONTINUE 125 CONTINUE ENDIF C CALL LCMSIX(IPLIST,' ',2) C----- C RECOVER MICROSCOPIC X-SECTIONS. C----- DO 40 ISO=2,NISO IF(DENSIT(ISO).EQ.0.0) GO TO 40 WRITE(HMICRO,'(3A4)') (HISO((ISO-1)*3+IH),IH=1,3) REFC(I,ISO)=DENSIT(ISO) CALL LCMSIX(IPLIST,HMICRO,1) CALL LCMGET(IPLIST,'XS-SAVED',IXS) CALL LCMGET(IPLIST,'SCAT-SAVED',IXS(21)) IF(IXS(3).EQ.1) JTAB(ISO)=1 IF(IXS(1).EQ.1) CALL LCMGET(IPLIST,'TOTAL',TMREF(1,I,ISO)) C C COMPUTE THE ABSORPTION XS C IL=1 WRITE (CM,'(I2.2)') IL-1 IF(IXS(20+IL).EQ.1) THEN CALL LCMGET(IPLIST,'SIGS'//CM,WORK3) DO 231 IGR=1,NGRP TMREF(IGR,I,ISO)= TMREF(IGR,I,ISO)-WORK3(IGR) 231 CONTINUE ENDIF C IF(IXS(17).EQ.1) CALL LCMGET(IPLIST,'STRD ',DMRFX(1,I,ISO)) IF(IXS(18).EQ.1) CALL LCMGET(IPLIST,'STRD X',DMRFX(1,I,ISO)) IF(IXS(19).EQ.1) CALL LCMGET(IPLIST,'STRD Y',DMRFY(1,I,ISO)) IF(IXS(20).EQ.1) CALL LCMGET(IPLIST,'STRD Z',DMRFZ(1,I,ISO)) C C ADD THE CONTRIBURTION OF THE MICR. X-SECTIONS C DO 721 IGR=1,NGRP TOTAL(IGR,I)=TOTAL(IGR,I) + DENSIT(ISO)*TMREF(IGR,I,ISO) DIFFX(IGR,I)=DIFFX(IGR,I) + DENSIT(ISO)*DMRFX(IGR,I,ISO) DIFFY(IGR,I)=DIFFY(IGR,I) + DENSIT(ISO)*DMRFY(IGR,I,ISO) DIFFZ(IGR,I)=DIFFZ(IGR,I) + DENSIT(ISO)*DMRFZ(IGR,I,ISO) 721 CONTINUE C IF(IXS(3).EQ.1) THEN CALL LCMGET(IPLIST,'NUSIGF',FMREF(1,I,ISO)) DO 30 IGR=1,NGRP ZNUG(IGR,I)=ZNUG(IGR,I) + DENSIT(ISO)*FMREF(IGR,I,ISO) 30 CONTINUE ENDIF IF(IXS(4).EQ.1) THEN CALL LCMGET(IPLIST,'NFTOT',WORK3) CALL LCMGET(IPLIST,'NFTOT',HMREF(1,I,ISO)) DO 31 IGR=1,NGRP HMREF(IGR,I,ISO)=HMREF(IGR,I,ISO)*EFJ(ISO) NF3(IGR)=NF3(IGR)+DENSIT(ISO)*WORK3(IGR) H(IGR,I)=H(IGR,I) + DENSIT(ISO)*HMREF(IGR,I,ISO) 31 CONTINUE ENDIF IF(IXS(5).EQ.1) CALL LCMGET(IPLIST,'CHI',MCHI3) CALL LCMSIX(IPLIST,' ',2) 40 CONTINUE CALL LCMSIX(IPLIST,' ',2) CALL LCMSIX(IPLIST,' ',2) C----------------------------------------------------------------------C C----- C STORE PROPERTIES C----- CALL LCMSIX(IPFBM,TEXTR,1) C CALL LCMPUT(IPFBM,'JTAB',NISO,1,JTAB) C CALL LCMSIX(IPFBM,TEXTB,1) CALL LCMPUT(IPFBM,'ISOTOPESDENS',NISO,2,DENSIT) CALL LCMPUT(IPFBM,'FLUX-INTG',NGRP,2,FLUI3) CALL LCMPUT(IPFBM,'OVERV',NGRP,2,OV3) CALL LCMPUT(IPFBM,'FLUXDISAFACT',NGRP,2,FLDIS3) C C STORE MACROSCOPIC X-SECTIONS C CALL LCMSIX(IPFBM,'MACR',1) CALL LCMSIX(IPFBM,'ABS',1) CALL LCMPUT(IPFBM,'REF',NGRP,2,TOTAL(1,I)) CALL LCMSIX(IPFBM,' ',2) IF(IXYZ.EQ.0) THEN CALL LCMSIX(IPFBM,'STRD',1) CALL LCMPUT(IPFBM,'REF',NGRP,2,DIFFX(1,I)) CALL LCMSIX(IPFBM,' ',2) ELSE IF(IXYZ.EQ.1) THEN CALL LCMSIX(IPFBM,'STRD X',1) CALL LCMPUT(IPFBM,'REF',NGRP,2,DIFFX(1,I)) CALL LCMSIX(IPFBM,' ',2) CALL LCMSIX(IPFBM,'STRD Y',1) CALL LCMPUT(IPFBM,'REF',NGRP,2,DIFFY(1,I)) CALL LCMSIX(IPFBM,' ',2) CALL LCMSIX(IPFBM,'STRD Z',1) CALL LCMPUT(IPFBM,'REF',NGRP,2,DIFFZ(1,I)) CALL LCMSIX(IPFBM,' ',2) ENDIF IF(JTAB(1).EQ.1) THEN CALL LCMSIX(IPFBM,'NUSIGF',1) CALL LCMPUT(IPFBM,'REF',NGRP,2,ZNUG(1,I)) CALL LCMSIX(IPFBM,' ',2) CALL LCMSIX(IPFBM,'H-FACTORS',1) CALL LCMPUT(IPFBM,'REF',NGRP,2,H(1,I)) CALL LCMSIX(IPFBM,' ',2) CALL LCMPUT(IPFBM,'CHI',NGRP,2,CHI3) CALL LCMPUT(IPFBM,'NFTOT',NGRP,2,NF3) ENDIF CALL LCMSIX(IPFBM,' ',2) C C STORE MICROSCOPIC X-SECTIONS C DO 49 ISO=2,NISO IF(DENSIT(ISO).EQ.0.0) GO TO 49 WRITE(HMICRO,'(3A4)') (HISO((ISO-1)*3+IH),IH=1,3) CALL LCMSIX(IPFBM,HMICRO,1) CALL LCMSIX(IPFBM,'ABS',1) CALL LCMPUT(IPFBM,'REF',NGRP,2,TMREF(1,I,ISO)) CALL LCMSIX(IPFBM,' ',2) IF(IXYZ.EQ.0) THEN CALL LCMSIX(IPFBM,'STRD',1) CALL LCMPUT(IPFBM,'REF',NGRP,2,DMRFX(1,I,ISO)) CALL LCMSIX(IPFBM,' ',2) ELSE IF(IXYZ.EQ.1) THEN CALL LCMSIX(IPFBM,'STRD X',1) CALL LCMPUT(IPFBM,'REF',NGRP,2,DMRFX(1,I,ISO)) CALL LCMSIX(IPFBM,' ',2) CALL LCMSIX(IPFBM,'STRD Y',1) CALL LCMPUT(IPFBM,'REF',NGRP,2,DMRFY(1,I,ISO)) CALL LCMSIX(IPFBM,' ',2) CALL LCMSIX(IPFBM,'STRD Z',1) CALL LCMPUT(IPFBM,'REF',NGRP,2,DMRFZ(1,I,ISO)) CALL LCMSIX(IPFBM,' ',2) ENDIF IF(JTAB(ISO).EQ.1) THEN CALL LCMSIX(IPFBM,'NUSIGF',1) CALL LCMPUT(IPFBM,'REF',NGRP,2,FMREF(1,I,ISO)) CALL LCMSIX(IPFBM,' ',2) CALL LCMSIX(IPFBM,'H-FACTORS',1) CALL LCMPUT(IPFBM,'REF',NGRP,2,HMREF(1,I,ISO)) CALL LCMSIX(IPFBM,' ',2) CALL LCMPUT(IPFBM,'CHI',NGRP,2,MCHI3) ENDIF CALL LCMSIX(IPFBM,' ',2) 49 CONTINUE CALL LCMSIX(IPFBM,' ',2) CALL LCMSIX(IPFBM,' ',2) C----- C RECOVER MICROSCOPIC CONTRIBUTIONS OF SCATTERING X-SECTIONS. C----- DO 160 ISO=2,NISO IF(DENSIT(ISO).EQ.0.0) GO TO 160 WRITE(HMICRO,'(3A4)') (HISO((ISO-1)*3+IH),IH=1,3) IF(IP.EQ.1) THEN CALL LCMSIX(IPLIST,'REF 1',1) ELSE CALL LCMSIX(IPLIST,'MODREF 1',1) ENDIF CALL LCMSIX(IPLIST,TEXTB,1) CALL LCMLEN(IPLIST,HMICRO,ILENG,ITYLCM) IF(ILENG.NE.0) THEN CALL LCMSIX(IPLIST,HMICRO,1) CALL LCMGET(IPLIST,'XS-SAVED',IXS) CALL LCMGET(IPLIST,'SCAT-SAVED',IXS(21)) C IL=1 WRITE (CM,'(I2.2)') IL-1 IF(IXS(20+IL).EQ.1) THEN CALL LCMGET(IPLIST,'SCAT'//CM,WORK3) CALL LCMGET(IPLIST,'NJJS'//CM,NJJ) CALL LCMGET(IPLIST,'IJJS'//CM,IJJ) IGAR=0 DO 150 JGR=1,NGRP DO 140 IGR=IJJ(JGR),IJJ(JGR)-NJJ(JGR)+1,-1 IGAR=IGAR+1 SMREF(ISO,I,IL,IGR,JGR)=WORK3(IGAR) SCAT(I,IL,IGR,JGR)=SCAT(I,IL,IGR,JGR)+DENSIT(ISO)*WORK3(IGAR) 140 CONTINUE 150 CONTINUE ENDIF C CALL LCMSIX(IPLIST,' ',2) ENDIF CALL LCMSIX(IPLIST,' ',2) CALL LCMSIX(IPLIST,' ',2) 160 CONTINUE C----------------------------------------------------------------------C C C STORE MACROSCOPIC SCATTERING X-SECTIONS C CALL LCMSIX(IPFBM,TEXTR,1) CALL LCMSIX(IPFBM,TEXTB,1) C CALL LCMSIX(IPFBM,'MACR',1) IL=1 WRITE (CM,'(I2)') IL-1 CALL LCMSIX(IPFBM,'SCAT'//CM,1) IGARM=0 DO 799 JGR=1,NGRP IGRMIN=JGR IGRMAX=JGR DO 899 IGR=1,NGRP IF(SCAT(I,IL,IGR,JGR).NE.0.0) THEN IGRMIN=MIN(IGRMIN,IGR) IGRMAX=MAX(IGRMAX,IGR) ENDIF 899 CONTINUE MIJ(JGR)=IGRMAX MNJ(JGR)=IGRMAX-IGRMIN+1 DO 795 IGR=MIJ(JGR),MIJ(JGR)-MNJ(JGR)+1,-1 IGARM=IGARM+1 WORK3(IGARM)=SCAT(I,IL,IGR,JGR) 795 CONTINUE 799 CONTINUE CALL LCMPUT(IPFBM,'NJJ',NGRP,1,MNJ) CALL LCMPUT(IPFBM,'IJJ',NGRP,1,MIJ) CALL LCMPUT(IPFBM,'REF',IGARM,2,WORK3) CALL LCMSIX(IPFBM,' ',2) C C CALL LCMSIX(IPFBM,' ',2) C C C STORE THE SCATTERING X-SECTIONS C DO 860 ISO=2,NISO IF(DENSIT(ISO).EQ.0.0) GO TO 860 WRITE(HMICRO,'(3A4)') (HISO((ISO-1)*3+IH),IH=1,3) CALL LCMSIX(IPFBM,HMICRO,1) IL=1 WRITE (CM,'(I2)') IL-1 CALL LCMSIX(IPFBM,'SCAT'//CM,1) IGARM=0 DO 105 JGR=1,NGRP DO 100 IGR=MIJ(JGR),MIJ(JGR)-MNJ(JGR)+1,-1 IGARM=IGARM+1 WORK3(IGARM)=SMREF(ISO,I,IL,IGR,JGR) 100 CONTINUE 105 CONTINUE CALL LCMPUT(IPFBM,'REF',IGARM,2,WORK3) CALL LCMPUT(IPFBM,'NJJ',NGRP,1,MNJ) CALL LCMPUT(IPFBM,'IJJ',NGRP,1,MIJ) CALL LCMSIX(IPFBM,' ',2) C CALL LCMSIX(IPFBM,' ',2) 860 CONTINUE CALL LCMSIX(IPFBM,' ',2) CALL LCMSIX(IPFBM,' ',2) 20 CONTINUE C DEALLOCATE(MCHI3,CHI3,NF3,DIFD3,OV3,FLDIS3,FLUI3) WRITE(IOUT,9000) C----------------------------------------------------------------------C C C C FUEL COEFFICIENTS CALCULATIONS C C C C----------------------------------------------------------------------C C MIXP =0 : INDIVIDUAL LOCAL PARAMETER C C MIXP =1 : MIXDED LOCAL PARAMETER C C NB =1 : THE COEFFICIENTS CALCULATION REQUIRE ONE L_COMPO C C NB =2 : THE COEFFICIENTS CALCULATION REQUIRE TWO L_COMPO C C TEXT1 : FIRST RECORD ON WHICH THE COEFF. ARE STORED (NB=1) C C TEXT2 : SECOND RECORD ON WHICH THE COEFF. ARE STORED (NB=2) C C----------------------------------------------------------------------C C IF(IP.EQ.1) THEN DO 111 J=1,5 JJU=2*J+1 JJD=2*J+2 IPLISU=KENTRY(JJU) IPLISD=KENTRY(JJD) IF(ABS(IPRINT) .GT. 5) THEN WRITE(IOUT,6000) JJU,HENTRY(JJU),JJD,HENTRY(JJD) ENDIF NB=2 MIXP=0 C----- C COMPUTE FUEL TEMPERATURE COEFFICIENTS (TWO L_COMPO) C----- IF(J.EQ.1) THEN TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'FTEMP-UP 1') THEN CALL XABORT('CFCDRV: FTEMP-UP COMPO EXPECTED.') ENDIF TEXT(2)='SIGNATURE' CALL LCMNXT(IPLISD,TEXT(2)) IF(TEXT(2).NE.'FTEMP-D 1') CALL XABORT('CFCDRV: ' 1 //' FTEMP-D COMPO EXPECTED.') TEXT1='T1F' TEXT2='T2F' C----- C COMPUTE COOLANT TEMPERATURE COEFFICIENTS (TWO L_COMPO) C----- ELSE IF(J.EQ.2) THEN TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'CTEMP-UP 1') THEN CALL XABORT('CFCDRV: CTEMP-UP COMPO EXPECTED.') ENDIF TEXT(2)='SIGNATURE' CALL LCMNXT(IPLISD,TEXT(2)) IF(TEXT(2).NE.'CTEMP-D 1') CALL XABORT('CFCDRV:' 1 //' CTEMP-D COMPO EXPECTED.') TEXT1='T1C' TEXT2='T2C' C----- C COMPUTE MODERATOR TEMPERATURE COEFFICIENTS (TWO L_COMPO) C----- ELSE IF(J.EQ.3) THEN TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'MTEMP-UP 1') THEN CALL XABORT('CFCDRV: MTEMP-UP COMPO EXPECTED.') ENDIF TEXT(2)='SIGNATURE' CALL LCMNXT(IPLISD,TEXT(2)) IF(TEXT(2).NE.'MTEMP-D 1') CALL XABORT('CFCDRV:' 1 //' MTEMP-D COMPO EXPECTED.') TEXT1='T1M' TEXT2='T2M' C----- C COMPUTE COOLANT DENSITY COEFFICIENTS (TWO L_COMPO) C----- ELSE IF(J.EQ.4) THEN TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'CDEN-UP 1') THEN CALL XABORT('CFCDRV: CDEN-UP COMPO EXPECTED.') ENDIF TEXT(2)='SIGNATURE' CALL LCMNXT(IPLISD,TEXT(2)) IF(TEXT(2).NE.'CDEN-D 1') CALL XABORT('CFCDRV:' 1 //' CDEN-D COMPO EXPECTED.') TEXT1='D1C' TEXT2='D2C' C----- C COMPUTE MODERATOR DENSITY COEFFICIENTS (TWO L_COMPO) C----- ELSE IF(J.EQ.5) THEN TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'MDEN-UP 1') THEN CALL XABORT('CFCDRV: MDEN-UP COMPO EXPECTED.') ENDIF TEXT(2)='SIGNATURE' CALL LCMNXT(IPLISD,TEXT(2)) IF(TEXT(2).NE.'MDEN-D 1') CALL XABORT('CFCDRV:' 1//' MDEN-D COMPO EXPECTED.') TEXT1='D1M' TEXT2='D2M' ENDIF C CALL CFCFBM(TEXT1,TEXT2,IPLISU,IPLISD,IPFBM,NGRP,NBUM,NISM, 1 NBURN,NISO,HISO,NL,IPRINT,TOTAL,ZNUG,DIFFX,DIFFY,DIFFZ, 1 H,SCAT,MIJ,MNJ,TMREF,SMREF,DMRFX,DMRFY,DMRFZ,TOT2,ZN2,DXF2, 1 DYF2,DZF2,HF2,SCA2,WORK3,REFC,MIRCT2,MIRCS2,MICDX2,MICDY2, 1 MICDZ2,DELTA,DENSIT,TFR,TCR,TMR,XIR,TEXT,TEXTR,NB,MIRCF2, 1 MIRCH2,FMREF,HMREF,JTAB,MIXP,V2,EFJ,NXS,IXYZ,NBPARA,DBPARA) 111 CONTINUE WRITE(IOUT,9001) C----------------------------------------------------------------------C C C C C C----------------------------------------------------------------------C DO 112 J=13,21 IPLISU=KENTRY(J) IPLISD=IPLISU NB=1 MIXP=0 IF(ABS(IPRINT) .GT. 5) THEN WRITE(IOUT,6001) J,HENTRY(J) ENDIF C----- C COMPUTE BORON COEFFICIENTS (ONE L_COMPO) C----- IF(J.EQ.13) THEN TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'BORON 1') THEN CALL XABORT('CFCDRV: BORON COMPO EXPECTED.') ENDIF TEXT1='BOR' TEXT2='BOR' TEXT(2)=TEXT(1) C----- C COMPUTE PURITY COEFFICIENTS (ONE L_COMPO) C----- ELSE IF(J.EQ.14) THEN TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'PURITY 1') THEN CALL XABORT('CFCDRV: BORON COMPO EXPECTED.') ENDIF TEXT1='PUR' TEXT2='PUR' TEXT(2)=TEXT(1) C----- C COMPUTE XENON COEFFICIENTS (ONE L_COMPO) C----- ELSE IF(J.EQ.15) THEN TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'XENON 1') THEN CALL XABORT('CFCDRV: XENON COMPO EXPECTED.') ENDIF TEXT1='XEN' TEXT2='XEN' TEXT(2)=TEXT(1) C----- C COMPUTE SAMARIUM COEFFICIENTS (ONE L_COMPO) C----- ELSE IF(J.EQ.16) THEN TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'SM149 1') THEN CALL XABORT('CFCDRV: SM149 COMPO EXPECTED.') ENDIF TEXT1='SM149' TEXT2='SM149' TEXT(2)=TEXT(1) C----- C COMPUTE NP239 COEFFICIENTS (ONE L_COMPO) C----- ELSE IF(J.EQ.17) THEN TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'NP239 1') THEN CALL XABORT('CFCDRV: NP239 COMPO EXPECTED.') ENDIF TEXT1='NP239' TEXT2='NP239' TEXT(2)=TEXT(1) C----- C COMPUTE MIXED FUEL AND DENSITY COEFFICIENTS (ONE L_COMPO) C----- ELSE IF(J.EQ.18) THEN TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'MIXFD 1') THEN CALL XABORT('CFCDRV: MIXFD COMPO EXPECTED.') ENDIF MIXP=1 TEXT1='MIXFD' TEXT2='MIXFD' TEXT(2)=TEXT(1) C----- C COMPUTE MIXED COLLANT AND DENSITY COEFFICIENTS (ONE L_COMPO) C----- ELSE IF(J.EQ.19) THEN TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'MIXMD 1') THEN CALL XABORT('CFCDRV: MIXMD COMPO EXPECTED.') ENDIF MIXP=1 TEXT1='MIXMD' TEXT2='MIXMD' TEXT(2)=TEXT(1) C----- C COMPUTE (HIGH)FISSION ISOTOPES COEFFICIENTS (TWO L_COMPO) C----- ELSE IF(J.EQ.20) THEN TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'POWER-UP 1') THEN CALL XABORT('CFCDRV: POWER-UP COMPO EXPECTED.') ENDIF IPLISD=KENTRY(J+1) TEXT(2)='SIGNATURE' CALL LCMNXT(IPLISD,TEXT(2)) IF(TEXT(2).NE.'POWER-IN 1') CALL XABORT('CFCDRV:' 1 //' POWER-D COMPO EXPECTED.') MIXP=1 NB=2 TEXT1='FPCH1' TEXT2='FPCH2' C----- C COMPUTE LOW FISSION ISOTOPES COEFFICIENTS (TWO L_COMPO) C----- ELSE IF(J.EQ.21) THEN TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'POWER-IN 1') THEN CALL XABORT('CFCDRV: POWER-UP COMPO EXPECTED.') ENDIF IPLISD=KENTRY(J+1) TEXT(2)='SIGNATURE' CALL LCMNXT(IPLISD,TEXT(2)) IF(TEXT(2).NE.'POWER-D 1') CALL XABORT('CFCDRV:' 1 //' POWER-D COMPO EXPECTED.') MIXP=1 NB=2 TEXT1='FPCL1' TEXT2='FPCL2' ENDIF IF(ABS(IPRINT) .GT. 5) THEN WRITE(IOUT,6002) TEXT1,TEXT2 ENDIF C CALL CFCFBM(TEXT1,TEXT2,IPLISU,IPLISD,IPFBM,NGRP,NBUM,NISM, 1 NBURN,NISO,HISO,NL,IPRINT,TOTAL,ZNUG,DIFFX,DIFFY,DIFFZ, 1 H,SCAT,MIJ,MNJ,TMREF,SMREF,DMRFX,DMRFY,DMRFZ,TOT2,ZN2, 1 DXF2, DYF2,DZF2,HF2,SCA2,WORK3,REFC,MIRCT2,MIRCS2,MICDX2, 1 MICDY2,MICDZ2,DELTA,DENSIT,TFR,TCR,TMR,XIR,TEXT,TEXTR,NB, 1 MIRCF2,MIRCH2,FMREF,HMREF,JTAB,MIXP,V2,EFJ,NXS,IXYZ,NBPARA, 1 DBPARA) 112 CONTINUE WRITE(IOUT,9002) C----------------------------------------------------------------------C C C C C C----------------------------------------------------------------------C C----- C COMPUTE THE HISTORY CONCENTRATION C----- DO 650 JJ=1,2 IF(JJ.EQ.1) THEN IPHISU=KENTRY(21) IPHISD=KENTRY(22) TEXT(1)='SIGNATURE' CALL LCMNXT(IPHISU,TEXT(1)) IF(TEXT(1).NE.'POWER-IN 1') THEN CALL XABORT('CFCDRV: POWER-IN COMPO EXPECTED.') ENDIF TEXT(2)='SIGNATURE' CALL LCMNXT(IPHISD,TEXT(2)) IF(TEXT(2).NE.'POWER-D 1') CALL XABORT('CFCDRV:' 1 //' POWER-D COMPO EXPECTED.') NB=2 C TEXT1='PHIS1' C TEXT2='PHIS2' ELSE IF(JJ.EQ.2) THEN IPHISU=KENTRY(20) IPHISD=KENTRY(21) TEXT(1)='SIGNATURE' CALL LCMNXT(IPHISU,TEXT(1)) IF(TEXT(1).NE.'POWER-UP 1') THEN CALL XABORT('CFCDRV: POWER-UP COMPO EXPECTED.') ENDIF TEXT(2)='SIGNATURE' CALL LCMNXT(IPHISD,TEXT(2)) IF(TEXT(2).NE.'POWER-IN 1') CALL XABORT('CFCDRV:' 1 //' POWER-D COMPO EXPECTED.') NB=2 C TEXT1='PHIL1' C TEXT2='PHIL2' ENDIF C----- C STORE THE HISTORY COEFFICIENTS C----- DO 730 JP=1,4 IF(JP.EQ.1) THEN TEXT12='FPC' IF(JJ.EQ.1) THEN TEXT1='PHIS1' TEXT2='PHIS2' ELSE TEXT1='PHIL1' TEXT2='PHIL2' ENDIF ELSE IF(JP.EQ.2) THEN TEXT12='XE135' IF(JJ.EQ.1) THEN TEXT1='PHISX1' TEXT2='PHISX2' ELSE TEXT1='PHILX1' TEXT2='PHILX2' ENDIF ELSE IF(JP.EQ.3) THEN TEXT12='SM149' IF(JJ.EQ.1) THEN TEXT1='PHISS1' TEXT2='PHISS2' ELSE TEXT1='PHILS1' TEXT2='PHILS2' ENDIF ELSE IF(JP.EQ.4) THEN TEXT12='NP239' IF(JJ.EQ.1) THEN TEXT1='PHISN1' TEXT2='PHISN2' ELSE TEXT1='PHILN1' TEXT2='PHILN2' ENDIF ENDIF DO 630 JB=1,NB IF(JB.EQ.1) IPHIST=IPHISU IF(JB.EQ.2) IPHIST=IPHISD CALL LCMSIX(IPHIST,TEXT(JB),1) CALL LCMGET(IPHIST,'ISOTOPESNAME',HISO) DO 621 I=1,NBURN WRITE(TEXTB,'(4HBURN,4X,I4)') I CALL LCMSIX(IPHIST,TEXTB,1) CALL LCMGET(IPHIST,'ISOTOPESDENS',DENSIT) IF(DENSIT(1).NE.1.0) CALL XABORT('FBM: DENSIT(1).NE.1.') DO 649 ISO=2,NISO WRITE(HMICRO,'(3A4)') (HISO((ISO-1)*3+IH),IH=1,3) IF(HMICRO.EQ.TEXT12) DELTA(I,JB)=DENSIT(ISO)- REFC(I,ISO) 649 CONTINUE CALL LCMSIX(IPHIST,' ',2) 621 CONTINUE CALL LCMSIX(IPHIST,' ',2) 630 CONTINUE DO 622 I=1,NBURN IF(NB.EQ.2) THEN PV1U=0.0 PV2U=0.0 PV1D=0.0 PV2D=0.0 IF(JJ.EQ.1) THEN PV1U=PWU-PWR PV2U=PV1U*PV1U PV1D=PWD-PWR PV2D=PV1D*PV1D ELSE IF(JJ.EQ.2) THEN PV1U=ALOG(PWUL/PWR) PV2U=1.0/PWUL - 1.0/PWR PV1D=ALOG(PWDL/PWR) PV2D=1.0/PWDL - 1.0/PWR ENDIF TX=PV2U*PV1D - PV2D*PV1U DELTA(I,2)=(DELTA(I,1)*PV1D-DELTA(I,2)*PV1U)/TX DELTA(I,1)=(DELTA(I,1) - DELTA(I,2)*PV2U)/PV1U C ENDIF C CALL LCMSIX(IPFBM,TEXTR,1) WRITE(TEXTB,'(4HBURN,4X,I4)') I CALL LCMSIX(IPFBM,TEXTB,1) CALL LCMSIX(IPFBM,'HISTORY',1) CALL LCMPUT(IPFBM,TEXT1,1,2,DELTA(I,1)) IF(NB.EQ.2) THEN CALL LCMPUT(IPFBM,TEXT2,1,2,DELTA(I,2)) ENDIF CALL LCMSIX(IPFBM,' ',2) CALL LCMSIX(IPFBM,' ',2) CALL LCMSIX(IPFBM,' ',2) 622 CONTINUE 730 CONTINUE 650 CONTINUE WRITE(IOUT,9003) ELSE C----------------------------------------------------------------------C C C C MODERATOR CALCULATIONS C C C C----------------------------------------------------------------------C DO 811 J=1,4 NB=2 MIXP=0 C----- C COMPUTE MODERATOR TEMPERATURE COEFFICIENTS C----- IF(J.EQ.1) THEN IPLISU=KENTRY(24) IPLISD=KENTRY(25) TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'MODTP-UP 1') THEN CALL XABORT('CFCDRV: MTEMP-UP COMPO EXPECTED.') ENDIF TEXT(2)='SIGNATURE' CALL LCMNXT(IPLISD,TEXT(2)) IF(TEXT(2).NE.'MODTP-D 1') CALL XABORT('CFCDRV:' 1 //' MTEMP-D COMPO EXPECTED.') TEXT1='T1M' TEXT2='T2M' C----- C COMPUTE MODERATOR DENSITY COEFFICIENTS C----- ELSE IF(J.EQ.2) THEN IPLISU=KENTRY(26) IPLISD=KENTRY(27) TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'MODDEN-U 1') THEN CALL XABORT('CFCDRV: MDEN-UP COMPO EXPECTED.') ENDIF TEXT(2)='SIGNATURE' CALL LCMNXT(IPLISD,TEXT(2)) IF(TEXT(2).NE.'MODDEN-D 1') CALL XABORT('CFCDRV:' 1 //' MDEN-D COMPO EXPECTED.') TEXT1='D1M' TEXT2='D2M' C----- C COMPUTE BORON COEFFICIENTS C----- ELSE IF(J.EQ.3) THEN NB=1 MIXP=0 IPLISU=KENTRY(28) TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'MODBOR 1') THEN CALL XABORT('CFCDRV: BORON COMPO EXPECTED.') ENDIF TEXT1='BOR' TEXT2='BOR' TEXT(2)=TEXT(1) C----- C COMPUTE PURITY COEFFICIENTS C----- ELSE IF(J.EQ.4) THEN NB=1 MIXP=0 IPLISU=KENTRY(29) TEXT(1)='SIGNATURE' CALL LCMNXT(IPLISU,TEXT(1)) IF(TEXT(1).NE.'MODPUR 1') THEN CALL XABORT('CFCDRV: BORON COMPO EXPECTED.') ENDIF TEXT1='PUR' TEXT2='PUR' TEXT(2)=TEXT(1) ENDIF C CALL CFCFBM(TEXT1,TEXT2,IPLISU,IPLISD,IPFBM,NGRP,NBUM,NISM, 1 NBURN,NISO,HISO,NL,IPRINT,TOTAL,ZNUG,DIFFX,DIFFY,DIFFZ, 1 H,SCAT,MIJ,MNJ,TMREF,SMREF,DMRFX,DMRFY,DMRFZ,TOT2,ZN2, 1 DXF2, DYF2,DZF2,HF2,SCA2,WORK3,REFC,MIRCT2,MIRCS2,MICDX2, 1 MICDY2,MICDZ2,DELTA,DENSIT,TFR,TCR,TMR,XIR,TEXT,TEXTR,NB, 1 MIRCF2,MIRCH2,FMREF,HMREF,JTAB,MIXP,V2,EFJ,NXS,IXYZ,NBPARA, 1 DBPARA) C 811 CONTINUE WRITE(IOUT,9004) ENDIF C----- C STORE PARAM INFORMATION C----- CALL LCMSIX(IPFBM,TEXTR,1) IPAR(1)=NGRP IPAR(2)=NISO IPAR(3)=NL IPAR(4)=NBURN IPAR(5)=IXYZ CALL LCMPUT(IPFBM,'PARAM',5,1,IPAR) CALL LCMSIX(IPFBM,' ',2) 801 CONTINUE C----------------------------------------------------------------------C C RELEASE MEMORY C C----------------------------------------------------------------------C DEALLOCATE(MIRCH2,MIRCF2,V2,MICDZ2,MICDY2,MICDX2,MIRCS2, > MIRCT2,SCA2,HF2,DZF2,DYF2,DXF2,ZN2,TOT2) *---- * SCRATCH STORAGE DEALLOCATION *---- DEALLOCATE(DELTA,HMREF,FMREF,REFC,DMRFZ,DMRFY,DMRFX,SMREF,TMREF, > EFJ,DENSIT,WORK3,SCAT,H,DIFFZ,DIFFY,DIFFX,ZNUG,TOTAL) DEALLOCATE(IXS,JTAB,HISO,MNJ,MIJ,NJJ,IJJ) * RETURN 6000 FORMAT(' CPO ',I4,' for up parameter named = ',A12/ > ' CPO ',I4,' for down parameter named = ',A12) 6001 FORMAT(' CPO ',I4,' with name ',A12) 6002 FORMAT(' Records ',2(A8,4X)) 9000 FORMAT(' CELL REFERENCE (NOMINAL) PARAMETER ARE STORED') 9001 FORMAT(' CELL FEEDBACK COEFFICIENTS CORRESPONDING TO:'/ > ' FUEL TEMPERATURE,'/ > ' COOLANT TEMPERATURE,'/ > ' MODERATOR TEMPERATURE,'/ > ' COOLANT DENSITY ,'/ > ' MODERATOR DENSITY ,') 9002 FORMAT(' CELL FEEDBACK COEFFICIENTS CORRESPONDING TO:'/ > ' BORON CONCENTRATION,'/ > ' MODERATOR PURITY ,'/ > ' XENON CONCENTRATION,'/ > ' SAMARIUM CONCENTRATION,'/ > ' NEPTUNIUM CONCENTRATION,'/ > ' ************************,'/ > ' MIXED FUEL TEMPERATURE AND COOLANT DENSITY,'/ > ' MIXED COOLANT TEMPERATURE AND COOLANT DENSITY,'/ > ' *********************************************,'/ > ' THE POWER HISTORY,'/) 9003 FORMAT(' POWER HISTORY COEFFICIENTS FOR THE CONCENTRATION '/ > ' ARE STORED') 9004 FORMAT(' REFLECTOR FEEDBACK COEFFICIENTS CORRESPONDING TO:'/ > ' MODERATOR TEMPERATURE ,'/ > ' MODERATOR DENSITY ,'/ > ' BORON CONCENTRATION,'/ > ' MODERATOR PURITY ,'/) END