*DECK NCRRGR SUBROUTINE NCRRGR(IPCPO,IPMAP,LCUBIC,NMIX,IMPX,NMIL,NCAL,NCH,NB, 1 NFUEL,NPARM,ITER,MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC) * *----------------------------------------------------------------------- * *Purpose: * Compute TERP factors for multicompo interpolation. Use global and * local parameters from a fuel-map object and optional user-defined * values. * *Copyright: * Copyright (C) 2007 Ecole Polytechnique de Montreal * *Author(s): * A. Hebert, D. Sekki, R. Chambon * *Parameters: input * IPCPO address of the multicompo object. * IPMAP address of the fuel-map object. * LCUBIC =.TRUE.: cubic Ceschino interpolation; =.FALSE: linear * Lagrange interpolation. * NMIX number of material mixtures in the fuel-map macrolib. * IMPX printing index (=0 for no print). * NMIL number of material mixtures in the multicompo. * NCAL number of elementary calculations in the multicompo. * NCH number of reactor channels. * NB number of fuel bundles per channel. * NFUEL number of fuel types. * NPARM number of additional parameters (other than burnup) defined * in FMAP object * *Parameters: output * ITER completion flag (=0: all over; =1: use another multicompo; * =2 use another L_MAP + multicompo). * MAXNIS maximum value of NISO(I) in user data. * MIXC mixture index in the multicompo corresponding to each microlib * mixture. * TERP interpolation factors. * NISO number of user-selected isotopes. * LISO type of treatment (=.true.: ALL; =.false.: ONLY). * HISO name of the user-selected isotopes. * CONC user-defined number density of the user-selected isotopes. A * value of -99.99 is set to indicate that the multicompo value * is used. * *----------------------------------------------------------------------- * USE GANLIB IMPLICIT NONE *---- * SUBROUTINE ARGUMENTS *---- INTEGER, PARAMETER::MAXISD=200 TYPE(C_PTR) IPCPO,IPMAP INTEGER NMIX,IMPX,NMIL,NCAL,NFUEL,NCH,NB,ITER,MAXNIS, 1 MIXC(NMIX),NPARM,HISO(2,NMIX,MAXISD),NISO(NMIX) REAL TERP(NCAL,NMIX),CONC(NMIX,MAXISD) LOGICAL LCUBIC,LISO(NMIX) *---- * LOCAL VARIABLES *---- INTEGER, PARAMETER::IOUT=6 INTEGER, PARAMETER::MAXADD=10 INTEGER, PARAMETER::MAXLIN=50 INTEGER, PARAMETER::MAXPAR=50 INTEGER, PARAMETER::MAXVAL=200 INTEGER, PARAMETER::NSTATE=40 REAL, PARAMETER::REPS=1.0E-4 REAL BURN0, BURN1, FLOTT, SUM, VALR1, VALR2, VARVAL INTEGER I0, IBMB, IBME, IBMOLD, IBM, IBTYP, IB, ICAL, ICH, IFUEL, & ILONG, IMIX, IMPY, INDIC, IPARTM, IPAR, ISO, ITYLCM, ITYPE, ITYP, & IVARTY, I, JBM, JB, JCAL, JPARM, JPAR, J, LENGTH, NCOMLI, NISOMI, & NITMA, NLOC, NMIXA, NPARMP, NPAR, NTOT, N CHARACTER TEXT12*12,PARKEY(MAXPAR)*12,PARFMT(MAXPAR)*8, 1 PARKEL(MAXPAR)*12,HSMG*131,COMMEN(MAXLIN)*80,VALH(MAXPAR)*12, 2 RECNAM*12,VCHAR(MAXVAL)*12,PARNAM*12,HCUBIC*12,HNAVAL*12 INTEGER ISTATE(NSTATE),VALI(MAXPAR),NVALUE(MAXPAR),VINTE(MAXVAL), 1 MUPLET(2*MAXPAR),MUTYPE(2*MAXPAR),MAPLET(2*MAXPAR,MAXADD), 2 MATYPE(2*MAXPAR,MAXADD),IDLTA(2*MAXPAR,MAXADD),NDLTA(2*MAXPAR), 3 IDLTA1,MUPLT2(2*MAXPAR),MUTYP2(2*MAXPAR),HISOMI(2,MAXISD) DOUBLE PRECISION DFLOTT REAL VALR(2*MAXPAR,2),VREAL(MAXVAL),VALRA(2*MAXPAR,2,MAXADD), 1 CONCMI(MAXISD) LOGICAL LDELT(2*MAXPAR),LDELT1,LSET(2*MAXPAR),LADD(2*MAXPAR), 1 LSET1,LADD1,LDMAP(2*MAXPAR,2),LAMAP(2*MAXPAR,2,MAXADD), 2 LCUB2(2*MAXPAR),LTST,LISOMI,LASBLY TYPE(C_PTR) JPMAP,KPMAP,JPCPO,KPCPO,LPCPO INTEGER, ALLOCATABLE, DIMENSION(:) :: FMIX,ZONEC,MIXA INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ZONEDP REAL, ALLOCATABLE, DIMENSION(:) :: BRN0,BRN1,VARC,TERPA REAL, ALLOCATABLE, DIMENSION(:,:) :: WPAR LOGICAL, ALLOCATABLE, DIMENSION(:) :: LPARM,LDELTA CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: HPAR *---- * SCRATCH STORAGE ALLOCATION * FMIX fuel mixture indices per fuel bundle. * BRN0 contains either low burnup integration limits or * instantaneous burnups per fuel bundle. * BRN1 upper burnup integration limits per fuel bundle. * WPAR other parameter distributions. * HPAR 'PARKEY' name of the other parameters. *---- ALLOCATE(LPARM(NPARM+1),FMIX(NCH*NB),ZONEDP(NCH,NB),ZONEC(NCH), 1 BRN0(NCH*NB),BRN1(NCH*NB),WPAR(NCH*NB,NPARM),LDELTA(NMIX), 2 HPAR(NPARM+1)) *---- * RECOVER TABLE-OF-CONTENT INFORMATION FOR THE MULTICOMPO. *---- CALL LCMGET(IPCPO,'STATE-VECTOR',ISTATE) NPAR=ISTATE(5) NLOC=ISTATE(6) NCOMLI=ISTATE(10) * ASBLY : LASBLY=.FALSE. CALL LCMGTC(IPCPO,'COMMENT',80,NCOMLI,COMMEN) IF(NPAR.GT.0)THEN CALL LCMSIX(IPCPO,'GLOBAL',1) CALL LCMGTC(IPCPO,'PARKEY',12,NPAR,PARKEY) CALL LCMGTC(IPCPO,'PARFMT',8,NPAR,PARFMT) CALL LCMGET(IPCPO,'NVALUE',NVALUE) IF(IMPX.GT.0)THEN DO IPAR=1,NPAR WRITE(RECNAM,'(''pval'',I8.8)') IPAR IF(PARFMT(IPAR).EQ.'INTEGER') THEN CALL LCMGET(IPCPO,RECNAM,VINTE) WRITE(IOUT,'(13H NCRRGR: KEY=,A,18H TABULATED POINTS=, 1 1P,6I12/(43X,6I12))') PARKEY(IPAR),(VINTE(I),I=1, 2 NVALUE(IPAR)) ELSE IF(PARFMT(IPAR).EQ.'REAL') THEN CALL LCMGET(IPCPO,RECNAM,VREAL) WRITE(IOUT,'(13H NCRRGR: KEY=,A,18H TABULATED POINTS=, 1 1P,6E12.4/(43X,6E12.4))') PARKEY(IPAR),(VREAL(I),I=1, 2 NVALUE(IPAR)) ELSE IF(PARFMT(IPAR).EQ.'STRING') THEN CALL LCMGTC(IPCPO,RECNAM,12,NVALUE(IPAR),VCHAR) WRITE(IOUT,'(13H NCRRGR: KEY=,A,18H TABULATED POINTS=, 1 1P,6A12/(43X,6A12))') PARKEY(IPAR),(VCHAR(I),I=1, 2 NVALUE(IPAR)) ENDIF ENDDO ENDIF CALL LCMSIX(IPCPO,' ',2) ENDIF IF(NLOC.GT.0)THEN CALL LCMSIX(IPCPO,'LOCAL',1) CALL LCMGTC(IPCPO,'PARKEY',12,NLOC,PARKEL) CALL LCMSIX(IPCPO,' ',2) JPCPO=LCMGID(IPCPO,'MIXTURES') DO IBMOLD=1,NMIL KPCPO=LCMGIL(JPCPO,IBMOLD) LPCPO=LCMGID(KPCPO,'TREE') CALL LCMGET(LPCPO,'NVALUE',NVALUE) IF(IMPX.GT.0)THEN WRITE(IOUT,'(17H NCRRGR: MIXTURE=,I6)') IBMOLD DO IPAR=1,NLOC WRITE(RECNAM,'(''pval'',I8.8)') IPAR CALL LCMGET(LPCPO,RECNAM,VREAL) WRITE(IOUT,'(13H NCRRGR: KEY=,A,18H TABULATED POINTS=, 1 1P,6E12.4/(43X,6E12.4))') PARKEL(IPAR),(VREAL(I),I=1, 2 NVALUE(IPAR)) ENDDO ENDIF ENDDO ENDIF IF(IMPX.GT.0) THEN WRITE(IOUT,'(43H NCRRGR: NUMBER OF CALCULATIONS IN MULTICOM, 1 3HPO=,I5)') NCAL WRITE(IOUT,'(43H NCRRGR: NUMBER OF MATERIAL MIXTURES IN MUL, 1 8HTICOMPO=,I5)') NMIL WRITE(IOUT,'(43H NCRRGR: NUMBER OF MATERIAL MIXTURES IN FUE, 1 6HL MAP=,I6)') NMIX WRITE(IOUT,'(1X,A)') (COMMEN(I),I=1,NCOMLI) ENDIF TERP(:NCAL,:NMIX)=0.0 MIXC(:NMIX)=0 *---- * READ (INTERP_DATA) AND SET VALI, VALR AND VALH PARAMETERS * CORRESPONDING TO THE INTERPOLATION POINT. FILL MUPLET FOR * PARAMETERS SET WITHOUT INTERPOLATION. *---- IBM=0 IBMB=0 IBME=0 MAXNIS=0 NISOMI=0 LISOMI=.TRUE. LDELT1=.FALSE. LADD1=.FALSE. NISO(:NMIX)=0 LISO(:NMIX)=.TRUE. LDELTA(:NMIX)=.FALSE. IDLTA1=0 DO I=1,2*MAXPAR LSET(I)=.FALSE. LDELT(I)=.FALSE. LADD(I)=.FALSE. LDMAP(I,:2)=.FALSE. LAMAP(I,:2,:MAXADD)=.FALSE. NDLTA(I)=0 ENDDO *---- * READ THE PARKEY NAME OF THE BURNUP FOR THIS MULTICOMPO. *---- CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTED(1).') IF((TEXT12.EQ.'MIX').OR.(TEXT12.EQ.';')) THEN NPARMP=NPARM GO TO 30 ELSE * add burnup to parameters NPARMP=NPARM+1 HPAR(NPARMP)=TEXT12 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.3)CALL XABORT('MCRRGR: CHARACTER DATA EXPECTED(2).') IF((TEXT12.EQ.'MIX').OR.(TEXT12.EQ.';')) GO TO 30 HNAVAL=TEXT12 ENDIF *---- * MAIN LOOP OF THE SUBROUTINE (UNTIL THE END) *---- 20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTED(2).') 30 IF(TEXT12.EQ.'MIX')THEN NISOMI=0 LISOMI=.TRUE. IVARTY=0 IBTYP=0 HNAVAL=' ' MUPLET(:NPAR+NLOC)=0 MUTYPE(:NPAR+NLOC)=0 VALI(:NPAR)=0 VALR(:NPAR+NLOC,1)=0.0 VALR(:NPAR+NLOC,2)=0.0 DO 35 I=1,MAXADD MAPLET(:NPAR+NLOC,I)=0 MATYPE(:NPAR+NLOC,I)=0 VALRA(:NPAR+NLOC,1,I)=0.0 VALRA(:NPAR+NLOC,2,I)=0.0 35 CONTINUE DO I=1,2*MAXPAR LSET(I)=.FALSE. LDELT(I)=.FALSE. LADD(I)=.FALSE. LDMAP(I,:2)=.FALSE. LAMAP(I,:2,:MAXADD)=.FALSE. ENDDO DO 40 I=1,NPAR VALH(I)=' ' 40 CONTINUE LCUB2(:NPAR+NLOC)=LCUBIC CALL REDGET(INDIC,IBM,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.1)CALL XABORT('NCRRGR: INTEGER DATA EXPECTED.') * CHECK FUEL MIXTURE JPMAP=LCMGID(IPMAP,'FUEL') DO IFUEL=1,NFUEL KPMAP=LCMGIL(JPMAP,IFUEL) CALL LCMGET(KPMAP,'MIX',IMIX) IF(IMIX.EQ.IBM)GOTO 50 ENDDO WRITE(IOUT,*)'NCRRGR: UNABLE TO FIND FUEL MIXTURE ',IBM CALL XABORT('NCRRGR: WRONG MIXTURE NUMBER.') 50 IBMOLD=1 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTED(3).') IF(TEXT12.EQ.'FROM')THEN CALL REDGET(INDIC,IBMOLD,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.1)CALL XABORT('NCRRGR: INTEGER DATA EXPECTED.') CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTE' 1 //'D.') ELSE IF(TEXT12.EQ.'USE') THEN IBMOLD=IBM CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTE' 1 //'D.') * ASBLY: automatically assembly-wise unfolded geometry ELSE IF(TEXT12.EQ.'ASBLY') THEN IF(LASBLY) DEALLOCATE(MIXA) IBMOLD=1 LASBLY=.TRUE. JPMAP=LCMGID(IPMAP,'GEOMAP') CALL LCMGET(JPMAP,'STATE-VECTOR',ISTATE) CALL LCMLEN(JPMAP,'MIX-ASBLY',NITMA,INDIC) IF(NITMA.EQ.0)CALL XABORT('NCRRGR: No assembly defined') NMIXA=NITMA/2 * NMIXA=ISTATE(39) ALLOCATE(MIXA(2*NMIXA)) CALL LCMGET(JPMAP,'MIX-ASBLY',MIXA) DO I=1,NMIXA IF(IBM.EQ.MIXA(I)) THEN IBMB=MIXA(I+NMIXA) IBME=IBMB+NMIL-1 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTE' 1 //'D.') GOTO 30 ENDIF ENDDO CALL XABORT('NCRRGR: WRONG ASSEMBLY MIXTURE.') ENDIF * ASBLY: automatically assembly-wise unfolded geometry IBMB=IBM IBME=IBM GOTO 30 ELSEIF(TEXT12.EQ.'MICRO')THEN IF(IBM.EQ.0) CALL XABORT('NCRRGR: MIX NOT SET (1).') CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTED(4).') IF(TEXT12.EQ.'ALL')THEN LISOMI=.TRUE. ELSEIF(TEXT12.EQ.'ONLY')THEN LISOMI=.FALSE. ENDIF CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTED(5).') 60 IF(TEXT12.EQ.'ENDMIX')THEN GOTO 30 ELSE NISOMI=NISOMI+1 IF(NISOMI.GT.MAXISD) CALL XABORT('NCRRGR: MAXISD OVERFLOW.') MAXNIS=MAX(MAXNIS,NISOMI) READ(TEXT12,'(2A4)') (HISOMI(I0,NISOMI),I0=1,2) CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.EQ.2)THEN CONCMI(NISOMI)=FLOTT ELSEIF((INDIC.EQ.3).AND.(TEXT12.EQ.'*'))THEN CONCMI(NISOMI)=-99.99 ELSE CALL XABORT('NCRRGR: INVALID HISO DATA.') ENDIF CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTED.') GOTO 60 ENDIF ELSEIF((TEXT12.EQ.'SET').OR.(TEXT12.EQ.'DELTA').OR. 1 (TEXT12.EQ.'ADD'))THEN IF(IBM.EQ.0) CALL XABORT('NCRRGR: MIX NOT SET (2).') ITYPE=0 LSET1=.FALSE. LDELT1=.FALSE. LADD1=.FALSE. IF(TEXT12.EQ.'SET')THEN ITYPE=1 LSET1=.TRUE. ELSEIF(TEXT12.EQ.'DELTA')THEN ITYPE=2 LDELT1=.TRUE. ELSEIF(TEXT12.EQ.'ADD')THEN ITYPE=2 LADD1=.TRUE. IDLTA1=IDLTA1+1 DO 65 JPAR=1,NPAR+NLOC MAPLET(JPAR,IDLTA1)=MUPLET(JPAR) MATYPE(JPAR,IDLTA1)=MUTYPE(JPAR) 65 CONTINUE ENDIF CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTED(7).') IF((TEXT12.EQ.'LINEAR').OR.(TEXT12.EQ.'CUBIC')) THEN HCUBIC=TEXT12 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) ELSE HCUBIC=' ' ENDIF IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTED(8).') * check if parameter is global IPAR=-99 DO I=1,NPAR IF(TEXT12.EQ.PARKEY(I))THEN IPAR=I LPCPO=LCMGID(IPCPO,'GLOBAL') IPARTM=IPAR PARNAM=TEXT12 GOTO 70 ENDIF ENDDO * check if parameter is local DO I=1,NLOC IF(TEXT12.EQ.PARKEL(I))THEN IPAR=NPAR+I JPCPO=LCMGID(IPCPO,'MIXTURES') KPCPO=LCMGIL(JPCPO,IBMOLD) LPCPO=LCMGID(KPCPO,'TREE') IPARTM=IPAR-NPAR PARNAM=TEXT12 GOTO 70 ENDIF ENDDO WRITE(HSMG,'(18HNCRRGR: PARAMETER ,A,14H NOT FOUND(1).)') TEXT12 CALL XABORT(HSMG) * 70 IF(HCUBIC.EQ.'LINEAR') THEN LCUB2(IPAR)=.FALSE. ELSE IF(HCUBIC.EQ.'CUBIC') THEN LCUB2(IPAR)=.TRUE. ENDIF WRITE(RECNAM,'(''pval'',I8.8)') IPARTM CALL LCMGET(LPCPO,'NVALUE',NVALUE) IF(NVALUE(IPARTM).GT.MAXVAL)CALL XABORT('NCRRGR: MAXVAL OVERFL' 1 //'OW.') CALL LCMLEN(LPCPO,RECNAM,LENGTH,ITYLCM) IF(LENGTH.EQ.0)THEN WRITE(HSMG,'(25HNCRRGR: GLOBAL PARAMETER ,A,9H NOT SET.)') 1 PARNAM CALL XABORT(HSMG) ENDIF IF((IPAR.GT.NPAR).OR. 1 ((IPAR.LE.NPAR).AND.(PARFMT(IPAR).EQ.'REAL')))THEN VALR1=VREAL(1) VALR2=VREAL(NVALUE(IPAR)) CALL LCMGET(LPCPO,RECNAM,VREAL) CALL REDGET(INDIC,NITMA,VALR1,TEXT12,DFLOTT) IF(INDIC.EQ.2)THEN VALR2=VALR1 IF(LSET1) THEN LSET(IPAR)=.TRUE. VALR(IPAR,1)=VALR1 VALR(IPAR,2)=VALR1 ENDIF IF(LDELT1) THEN LDELT(IPAR)=.TRUE. VALR(IPAR,1)=VALR1 VALR(IPAR,2)=VALR1 ELSEIF(LADD1) THEN LADD(IPAR)=.TRUE. VALRA(IPAR,1,IDLTA1)=VALR1 VALRA(IPAR,2,IDLTA1)=VALR1 NDLTA(IPAR)=NDLTA(IPAR)+1 IF(NDLTA(IPAR).GT.MAXADD) CALL XABORT('NCRRGR: MAXADD OV' 1 //'ERFLOW.') IDLTA(IPAR,NDLTA(IPAR))=IDLTA1 ENDIF ELSEIF(TEXT12.EQ.'MAP')THEN IF(LDELT1)THEN LDELT(IPAR)=.TRUE. LDMAP(IPAR,1)=.TRUE. ELSEIF(LADD1)THEN LADD(IPAR)=.TRUE. NDLTA(IPAR)=NDLTA(IPAR)+1 IF(NDLTA(IPAR).GT.MAXADD) CALL XABORT('NCRRGR: MAXADD OV' 1 //'ERFLOW.') LAMAP(IPAR,1,NDLTA(IPAR))=.TRUE. IDLTA(IPAR,NDLTA(IPAR))=IDLTA1 ENDIF IF(LSET1.AND.(.NOT.LSET(IPAR))) GO TO 20 ELSE CALL XABORT('NCRRGR: real value or "MAP" expected(1).') ENDIF CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(ITYPE.GE.2)THEN IF(INDIC.EQ.2)THEN VALR2=FLOTT IF(LDELT1)THEN VALR(IPAR,2)=VALR2 ELSEIF(LADD1)THEN VALRA(IPAR,2,IDLTA1)=VALR2 ENDIF ELSEIF(TEXT12.EQ.'MAP')THEN IF(LDELT1)THEN LDMAP(IPAR,2)=.TRUE. ELSEIF(LADD1)THEN LAMAP(IPAR,2,IDLTA1)=.TRUE. ENDIF ELSE CALL XABORT('NCRRGR: real value or "MAP" expected(2).') ENDIF CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) ENDIF LTST=.FALSE. IF(.NOT.LADD1)THEN IF(VALR(IPAR,1).EQ.VALR(IPAR,2)) LTST=.TRUE. MUPLET(IPAR)=-1 MUTYPE(IPAR)=ITYPE ELSE MAPLET(IPAR,IDLTA1)=-1 MATYPE(IPAR,IDLTA1)=2 ENDIF IF((LTST).AND.(ITYPE.EQ.1))THEN DO J=1,NVALUE(IPARTM) IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J)))THEN MUPLET(IPAR)=J GOTO 30 ENDIF ENDDO ENDIF *---- * ERRORS HANDLING *---- IF(VALR1.LT.VREAL(1))THEN * OUTSIDE OF THE DOMAIN (1) WRITE(HSMG,'(23HNCRRGR: REAL PARAMETER ,A,10H WITH VALU, 1 1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN.(1))') PARNAM,VALR1 WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR)) CALL XABORT(HSMG) ELSEIF(VALR2.GT.VREAL(NVALUE(IPARTM)))THEN * OUTSIDE OF THE DOMAIN (2) WRITE(HSMG,'(23HNCRRGR: REAL PARAMETER ,A,10H WITH VALU, 1 1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN.(2))') PARNAM,VALR2 WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR)) CALL XABORT(HSMG) ELSEIF((VALR1.GT.VALR2).AND.(ITYPE.EQ.1))THEN * ITYPE=1 correspond to an integral between VALR1 and VALR2 * otherwise it is a simple difference WRITE(HSMG,'(23HNCRRGR: REAL PARAMETER ,A,9H IS DEFIN, 1 7HED WITH,1P,E12.4,2H >,E12.4,4H.(1))') PARNAM, 2 VALR1,VALR2 CALL XABORT(HSMG) ENDIF IF((LADD1).AND.(TEXT12.EQ.'REF'))THEN 120 IPAR=-99 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(TEXT12.EQ.'ENDREF') GOTO 140 DO I=1,NPAR IF(TEXT12.EQ.PARKEY(I))THEN IPAR=I GOTO 130 ENDIF ENDDO DO I=1,NLOC IF(TEXT12.EQ.PARKEL(I))THEN IPAR=NPAR+I GOTO 130 ENDIF ENDDO CALL XABORT('NCRRGR: PARAMETER '//TEXT12//' NOT FOUND(2).') 130 CONTINUE CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.EQ.2)THEN VALRA(IPAR,1,IDLTA1)=FLOTT VALRA(IPAR,2,IDLTA1)=FLOTT IF(IPAR.LE.NPAR)THEN LPCPO=LCMGID(IPCPO,'GLOBAL') IPARTM=IPAR ELSE JPCPO=LCMGID(IPCPO,'MIXTURES') KPCPO=LCMGIL(JPCPO,IBMOLD) LPCPO=LCMGID(KPCPO,'TREE') IPARTM=IPAR-NPAR ENDIF WRITE(RECNAM,'(''pval'',I8.8)') IPARTM CALL LCMGET(LPCPO,RECNAM,VREAL) CALL LCMGET(LPCPO,'NVALUE',NVALUE) MAPLET(IPAR,IDLTA1)=-1 MATYPE(IPAR,IDLTA1)=1 DO J=1,NVALUE(IPARTM) IF(ABS(VALRA(IPAR,1,IDLTA1)-VREAL(J)).LE. 1 REPS*ABS(VREAL(J)))THEN MAPLET(IPAR,IDLTA1)=J GOTO 120 ENDIF ENDDO ELSEIF(TEXT12.EQ.'SAMEASREF')THEN MAPLET(IPAR,IDLTA1)=-1 MATYPE(IPAR,IDLTA1)=-1 ELSE CALL XABORT('NCRRGR: REAL or "SAMEASREF" expected') ENDIF GOTO 120 140 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) ELSE IF((LDELT1).AND.(TEXT12.EQ.'REF'))THEN 150 IPAR=-99 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(TEXT12.EQ.'ENDREF') GOTO 170 DO I=1,NPAR IF(TEXT12.EQ.PARKEY(I))THEN IPAR=I GOTO 160 ENDIF ENDDO DO I=1,NLOC IF(TEXT12.EQ.PARKEL(I))THEN IPAR=NPAR+I GOTO 160 ENDIF ENDDO CALL XABORT('NCRRGR: PARAMETER '//TEXT12//' NOT FOUND(3).') 160 CONTINUE CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.EQ.2)THEN VALR(IPAR,1)=FLOTT VALR(IPAR,2)=FLOTT IF(IPAR.LE.NPAR)THEN LPCPO=LCMGID(IPCPO,'GLOBAL') IPARTM=IPAR ELSE JPCPO=LCMGID(IPCPO,'MIXTURES') KPCPO=LCMGIL(JPCPO,IBMOLD) LPCPO=LCMGID(KPCPO,'TREE') IPARTM=IPAR-NPAR ENDIF WRITE(RECNAM,'(''pval'',I8.8)') IPARTM CALL LCMGET(LPCPO,RECNAM,VREAL) CALL LCMGET(LPCPO,'NVALUE',NVALUE) MUPLET(IPAR)=-1 MUTYPE(IPAR)=1 DO J=1,NVALUE(IPARTM) IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J)))THEN MUPLET(IPAR)=J GOTO 150 ENDIF ENDDO ELSEIF(TEXT12.EQ.'SAMEASREF')THEN MUPLET(IPAR)=-1 MUTYPE(IPAR)=-1 ELSE CALL XABORT('NCRRGR: REAL or "SAMEASREF" expected') ENDIF GOTO 150 170 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) ENDIF GOTO 30 ELSEIF(PARFMT(IPAR).EQ.'INTEGER')THEN IF(ITYPE.NE.1)CALL XABORT('NCRRGR: SET MANDATORY WITH INT' 1 //'EGER PARAMETERS.') CALL REDGET(INDIC,VALI(IPAR),FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.1)CALL XABORT('NCRRGR: INTEGER DATA EXPECTED.') CALL LCMGET(LPCPO,RECNAM,VINTE) DO 175 J=1,NVALUE(IPAR) IF(VALI(IPAR).EQ.VINTE(J))THEN MUPLET(IPAR)=J MUTYPE(IPAR)=ITYPE GOTO 20 ENDIF 175 CONTINUE WRITE(HSMG,'(26HNCRRGR: INTEGER PARAMETER ,A,9H WITH VAL, 1 2HUE,I5,34H NOT FOUND IN MULTICOMPO DATABASE.)') 2 PARKEY(IPAR), VALI(IPAR) CALL XABORT(HSMG) ELSEIF(PARFMT(IPAR).EQ.'STRING')THEN IF(ITYPE.NE.1)CALL XABORT('NCRRGR: SET MANDATORY WITH STR' 1 //'ING PARAMETERS.') CALL REDGET(INDIC,NITMA,FLOTT,VALH(IPAR),DFLOTT) IF(INDIC.NE.3)CALL XABORT('NCRRGR: STRING DATA EXPECTED.') CALL LCMGTC(LPCPO,RECNAM,12,NVALUE(IPAR),VCHAR) DO 180 J=1,NVALUE(IPAR) IF(VALH(IPAR).EQ.VCHAR(J))THEN MUPLET(IPAR)=J MUTYPE(IPAR)=ITYPE GOTO 20 ENDIF 180 CONTINUE WRITE(HSMG,'(25HNCRRGR: STRING PARAMETER ,A,10H WITH VALU, 1 1HE,A12,34H NOT FOUND IN MULTICOMPO DATABASE.)') 2 PARKEY(IPAR), VALH(IPAR) CALL XABORT(HSMG) ENDIF ELSEIF(TEXT12.EQ.'TIMAV-BURN')THEN IF(IBM.EQ.0) CALL XABORT('NCRRGR: MIX NOT SET (3).') IBTYP=1 ELSEIF(TEXT12.EQ.'INST-BURN')THEN IF(IBM.EQ.0) CALL XABORT('NCRRGR: MIX NOT SET (4).') IBTYP=2 ELSEIF(TEXT12.EQ.'AVG-EX-BURN')THEN IF(IBM.EQ.0) CALL XABORT('NCRRGR: MIX NOT SET (5).') IBTYP=3 CALL REDGET(INDIC,IVARTY,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.1)CALL XABORT('NCRRGR: INTEGER DATA EXPECTED.') ELSEIF(TEXT12.EQ.'ENDMIX')THEN *---- * RECOVER FUEL-MAP INFORMATION. *---- IF(IMPX.GT.0) THEN DO IPAR=1,NPAR IF(PARFMT(IPAR).EQ.'REAL')THEN IF(LCUB2(IPAR)) THEN WRITE(IOUT,'(26H NCRRGR: GLOBAL PARAMETER:,A12,5H ->CU, 1 18HBIC INTERPOLATION.)') PARKEY(IPAR) ELSE WRITE(IOUT,'(26H NCRRGR: GLOBAL PARAMETER:,A12,5H ->LI, 1 19HNEAR INTERPOLATION.)') PARKEY(IPAR) ENDIF ENDIF ENDDO DO IPAR=1,NLOC IF(LCUB2(NPAR+IPAR)) THEN WRITE(IOUT,'(25H NCRRGR: LOCAL PARAMETER:,A12,8H ->CUBIC, 1 14HINTERPOLATION.)') PARKEL(IPAR) ELSE WRITE(IOUT,'(25H NCRRGR: LOCAL PARAMETER:,A12,8H ->LINEA, 1 16HR INTERPOLATION.)') PARKEL(IPAR) ENDIF ENDDO ENDIF FMIX(:NCH*NB)=0 CALL LCMGET(IPMAP,'FLMIX',FMIX) CALL NCRMAP(IPMAP,NPARM,HPAR,NCH,NB,IBTYP,HNAVAL,IMPX,BRN0,BRN1, 1 WPAR,LPARM) IF(IBTYP.EQ.3) THEN IF(IVARTY.EQ.0) CALL XABORT('NCRRGR: IVARTY NOT SET.') CALL LCMGET(IPMAP,'B-ZONE',ZONEC) DO ICH=1,NCH DO J=1,NB IF(ZONEC(ICH).EQ.IVARTY) THEN ZONEDP(ICH,J)=1 ELSE ZONEDP(ICH,J)=0 ENDIF ENDDO ENDDO CALL LCMLEN(IPMAP,'B-VALUE',ILONG,ITYP) IF (ILONG.EQ.0) CALL XABORT('NCRRGR: NO SAVED VALUES FOR ' 1 //'THIS TYPE OF VARIABLE IN L_MAP') ALLOCATE(VARC(ILONG)) CALL LCMGET(IPMAP,'B-VALUE',VARC) VARVAL=VARC(IVARTY) DEALLOCATE(VARC) ENDIF *---- * PERFORM INTERPOLATION OVER THE FUEL MAP. *---- DO 185 JPARM=1,NPARMP IPAR=-99 DO I=1,NPAR IF(HPAR(JPARM).EQ.PARKEY(I))THEN IPAR=I IF(LSET(IPAR)) THEN IF(IMPX.GT.0) WRITE(6,*) 'L_MAP values overwritten by ' 1 // 'the SET option for parameter '//HPAR(JPARM) IF(.NOT.LADD(IPAR)) LPARM(JPARM)=.FALSE. ENDIF GOTO 185 ENDIF ENDDO DO I=1,NLOC IF(HPAR(JPARM).EQ.PARKEL(I))THEN IPAR=NPAR+I IF(LSET(IPAR)) THEN IF(IMPX.GT.0) WRITE(6,*) 'L_MAP values overwritten by ' 1 // 'the SET option for parameter '//HPAR(JPARM) IF(.NOT.LADD(IPAR)) LPARM(JPARM)=.FALSE. ENDIF GOTO 185 ENDIF ENDDO LPARM(JPARM)=.FALSE. 185 CONTINUE *---- * COMPUTE ALL THE MUPLETS FOR EACH BUNDLE *---- IMPY=MAX(0,IMPX-1) NTOT=0 DO 281 JB=1,NB DO 280 ICH=1,NCH IB=(JB-1)*NCH+ICH IF(FMIX(IB).EQ.0) GO TO 280 NTOT=NTOT+1 * ASBLY: loop on multicompo mixtures DO 285 IBM=IBMB,IBME IF(LASBLY) IBMOLD=IBM-IBMB+1 * ASBLY: end IPAR=-99 IF(FMIX(IB).EQ.IBM)THEN IF(NTOT.GT.NMIX) CALL XABORT('NCRRGR: NMIX OVERFLOW.') DO 260 JPARM=1,NPARMP IF(.NOT.LPARM(JPARM))GOTO 260 * check if parameter is global DO I=1,NPAR IF(HPAR(JPARM).EQ.PARKEY(I))THEN IPAR=I LPCPO=LCMGID(IPCPO,'GLOBAL') IPARTM=IPAR PARNAM=HPAR(JPARM) GOTO 190 ENDIF ENDDO * check if parameter is local DO I=1,NLOC IF(HPAR(JPARM).EQ.PARKEL(I))THEN IPAR=NPAR+I JPCPO=LCMGID(IPCPO,'MIXTURES') KPCPO=LCMGIL(JPCPO,IBMOLD) LPCPO=LCMGID(KPCPO,'TREE') IPARTM=IPAR-NPAR PARNAM=HPAR(JPARM) GOTO 190 ENDIF ENDDO WRITE(HSMG,'(18HNCRRGR: PARAMETER ,A,14H NOT FOUND(4).)') 1 HPAR(JPARM) CALL XABORT(HSMG) 190 CONTINUE WRITE(RECNAM,'(''pval'',I8.8)') IPARTM CALL LCMGET(LPCPO,'NVALUE',NVALUE) IF(NVALUE(IPARTM).GT.MAXVAL)CALL XABORT('NCRRGR: MAXVAL OVERFL' 1 //'OW.') CALL LCMLEN(LPCPO,RECNAM,LENGTH,ITYLCM) IF(LENGTH.EQ.0)THEN WRITE(HSMG,'(25HNCRRGR: GLOBAL PARAMETER ,A,9H NOT SET.)') 1 PARNAM CALL XABORT(HSMG) ENDIF ITYPE=0 IF((JPARM.EQ.NPARMP).AND.(NPARMP.EQ.NPARM+1))THEN * parameter JPARAM is burnup IF(.NOT.LSET(IPAR))THEN MUTYPE(IPAR)=1 MUPLET(IPAR)=-1 BURN0=0.0 BURN1=0.0 IF(IBTYP.EQ.1)THEN * TIME-AVERAGE BURN0=BRN0(IB) BURN1=BRN1(IB) ELSEIF(IBTYP.EQ.2)THEN * INSTANTANEOUS BURN0=BRN0(IB) BURN1=BURN0 ELSEIF(IBTYP.EQ.3)THEN * DIFFERENCIATION RELATIVE TO EXIT BURNUP ITYPE=3 BURN0=BRN0(IB) BURN1=BRN1(IB) ENDIF VALR(IPAR,1)=BURN0 VALR(IPAR,2)=BURN1 VALR1=VALR(IPAR,1) VALR2=VALR(IPAR,2) ITYPE=1 ENDIF ELSE IF(.NOT.LSET(IPAR))THEN VALR(IPAR,1)=WPAR(IB,JPARM) VALR(IPAR,2)=WPAR(IB,JPARM) MUPLET(IPAR)=-1 MUTYPE(IPAR)=1 VALR1=VALR(IPAR,1) VALR2=VALR(IPAR,2) ITYPE=1 ENDIF IF(LDMAP(IPAR,1).OR.LDMAP(IPAR,2))THEN IF(LDMAP(IPAR,1)) VALR(IPAR,1)=WPAR(IB,JPARM) IF(LDMAP(IPAR,2)) VALR(IPAR,2)=WPAR(IB,JPARM) MUPLET(IPAR)=-1 MUTYPE(IPAR)=2 VALR1=VALR(IPAR,1) VALR2=VALR(IPAR,2) ITYPE=2 ELSE IF(LADD(IPAR))THEN DO N=1,NDLTA(IPAR) IDLTA1=IDLTA(IPAR,N) IF(LAMAP(IPAR,1,IDLTA1)) THEN VALRA(IPAR,1,IDLTA1)=WPAR(IB,JPARM) MAPLET(IPAR,IDLTA1)=-1 MATYPE(IPAR,IDLTA1)=2 ENDIF IF(LAMAP(IPAR,2,IDLTA1)) THEN VALRA(IPAR,2,IDLTA1)=WPAR(IB,JPARM) MAPLET(IPAR,IDLTA1)=-1 MATYPE(IPAR,IDLTA1)=2 ENDIF ENDDO VALR1=VALRA(IPAR,1,IDLTA(IPAR,1)) VALR2=VALRA(IPAR,2,IDLTA(IPAR,1)) ITYPE=2 ENDIF ENDIF LPCPO=LCMGID(IPCPO,'GLOBAL') CALL LCMGET(LPCPO,'NVALUE',NVALUE) IF(NVALUE(IPARTM).GT.MAXVAL) CALL XABORT('NCRRGR: MAXVAL OVE' 1 //'RFLOW.') WRITE(RECNAM,'(''pval'',I8.8)') IPARTM CALL LCMLEN(LPCPO,RECNAM,LENGTH,ITYLCM) IF(LENGTH.EQ.0)THEN WRITE(HSMG,'(25HNCRRGR: GLOBAL PARAMETER ,A,9H NOT SET.)') 1 PARNAM CALL XABORT(HSMG) ENDIF IF(LENGTH.GT.MAXVAL) CALL XABORT('NCRRGR: MAXVAL OVERFLOW.') CALL LCMGET(LPCPO,RECNAM,VREAL) IF(ITYPE.EQ.1)THEN IF(VALR1.EQ.VALR2)THEN DO J=1,NVALUE(IPARTM) IF(ABS(VALR1-VREAL(J)).LE.REPS*ABS(VREAL(J)))THEN MUPLET(IPAR)=J MUTYPE(IPAR)=ITYPE GOTO 260 ENDIF ENDDO ENDIF ENDIF *---- * ERRORS HANDLING *---- IF(VALR1.LT.VREAL(1))THEN * OUTSIDE OF THE DOMAIN (1) WRITE(HSMG,'(23HNCRRGR: REAL PARAMETER ,A,10H WITH VALU, 1 1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN(3).)') PARNAM,VALR1 WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR)) CALL XABORT(HSMG) ELSEIF(VALR2.GT.VREAL(NVALUE(IPAR)))THEN * OUTSIDE OF THE DOMAIN (2) WRITE(HSMG,'(23HNCRRGR: REAL PARAMETER ,A,10H WITH VALU, 1 1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN(4).)') PARNAM,VALR2 WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR)) CALL XABORT(HSMG) ELSEIF((ITYPE.EQ.1).AND.(VALR1.GT.VALR2))THEN * VALR1 > VALR2 WRITE(HSMG,'(23HNCRRGR: REAL PARAMETER ,A,9H IS DEFIN, 1 7HED WITH,1P,E12.4,2H >,E12.4,4H.(2))') PARNAM, 2 VALR1,VALR2 CALL XABORT(HSMG) ENDIF *---- * COMPUTE THE TERP FACTORS USING TABLE-OF-CONTENT INFORMATION. *---- 260 CONTINUE MIXC(NTOT)=IBMOLD IF(IBMOLD.GT.NMIL) 1 CALL XABORT('NCRRGR: MIX OVERFLOW (COMPO).') IF(IMPY.GT.2) WRITE(6,'(32H NCRRGR: COMPUTE TERP FACTORS IN, 1 12H NEW MIXTURE,I5,1H.)') NTOT NISO(NTOT)=NISOMI LISO(NTOT)=LISOMI LDELTA(NTOT)=LDELT1 DO ISO=1,NISOMI HISO(1,NTOT,ISO)=HISOMI(1,ISO) HISO(2,NTOT,ISO)=HISOMI(2,ISO) CONC(NTOT,ISO)=CONCMI(ISO) ENDDO DO JPAR=1,NPAR+NLOC MUPLT2(JPAR)=MUPLET(JPAR) ENDDO IF(IBTYP.EQ.3)THEN IF(ZONEDP(ICH,JB).NE.0) THEN CALL NCRTRP(IPCPO,LCUB2,IMPY,IBMOLD,NPAR,NLOC,NCAL, 1 MUPLT2,MUTYPE,VALR(1,1),VARVAL,TERP(1,NTOT)) ELSE TERP(:NCAL,NTOT)=0.0 ENDIF ELSE CALL NCRTRP(IPCPO,LCUB2,IMPY,IBMOLD,NPAR,NLOC,NCAL, 1 MUPLT2,MUTYPE,VALR(1,1),VARVAL,TERP(1,NTOT)) ENDIF * DELTA-ADD DO 270 IPAR=1,NPAR+NLOC IF(LADD(IPAR))THEN DO N=1,NDLTA(IPAR) IDLTA1=IDLTA(IPAR,N) DO JPAR=1,NPAR+NLOC MUPLT2(JPAR)=MAPLET(JPAR,IDLTA1) MUTYP2(JPAR)=MATYPE(JPAR,IDLTA1) ENDDO DO JPAR=1,NPAR+NLOC IF(MUTYP2(JPAR).LT.0)THEN MUPLT2(JPAR)=MUPLET(JPAR) MUTYP2(JPAR)=MUTYPE(JPAR) VALRA(JPAR,1,IDLTA1)=VALR(JPAR,1) VALRA(JPAR,2,IDLTA1)=VALR(JPAR,2) ENDIF ENDDO ALLOCATE(TERPA(NCAL)) CALL NCRTRP(IPCPO,LCUB2,IMPY,IBMOLD,NPAR,NLOC,NCAL, 1 MUPLT2,MUTYP2,VALRA(1,1,IDLTA1),VARVAL,TERPA(1)) DO 275 JCAL=1,NCAL TERP(JCAL,NTOT)=TERP(JCAL,NTOT)+TERPA(JCAL) 275 CONTINUE DEALLOCATE(TERPA) ENDDO ENDIF 270 CONTINUE ENDIF * ASBLY: next mixture 285 CONTINUE * ASBLY: end 280 CONTINUE 281 CONTINUE IF(NTOT.GT.NMIX) CALL XABORT('NCRRGR: ALGORITHM FAILURE.') IBM=0 IBMB=0 IBME=0 ELSEIF((TEXT12.EQ.'COMPO').OR.(TEXT12.EQ.'TABLE').OR. 1 (TEXT12.EQ.';')) THEN *---- * CHECK TERP FACTORS AND RETURN *---- IF(TEXT12.EQ.';') ITER=0 IF(TEXT12.EQ.'COMPO') ITER=1 IF(TEXT12.EQ.'TABLE') ITER=2 DO 300 IBM=1,NMIX IBMOLD=MIXC(IBM) IF(IBMOLD.EQ.0) GO TO 300 IF(NISO(IBM).GT.MAXNIS) CALL XABORT('NCRRGR: MAXNIS OVERFLOW.') IF(LDELTA(IBM)) THEN SUM=0.0 ELSE SUM=1.0 ENDIF DO 290 ICAL=1,NCAL SUM=SUM-TERP(ICAL,IBM) 290 CONTINUE IF(ABS(SUM).GT.1.0E-4) THEN WRITE(HSMG,'(43HNCRRGR: INVALID INTERPOLATION FACTORS IN MI, 1 5HXTURE,I4,1H.)') IBM CALL XABORT(HSMG) ENDIF 300 CONTINUE *---- * EXIT MAIN LOOP OF THE SUBROUTINE *---- GO TO 310 ELSE CALL XABORT('NCRRGR: '//TEXT12//' IS AN INVALID KEYWORD.') ENDIF GOTO 20 *---- * PRINT INTERPOLATION (TERP) FACTORS *---- 310 IF(IMPX.GT.2) THEN WRITE(IOUT,'(/30H NCRRGR: INTERPOLATION FACTORS)') DO ICAL=1,NCAL DO IBM=1,NMIX IF(TERP(ICAL,IBM).NE.0.0) THEN WRITE(IOUT,320) ICAL,(TERP(ICAL,JBM),JBM=1,NMIX) EXIT ENDIF ENDDO ENDDO ENDIF *---- * SCRATCH STORAGE DEALLOCATION *---- DEALLOCATE(HPAR,LDELTA,WPAR,BRN1,BRN0,ZONEC,ZONEDP,FMIX,LPARM) IF(LASBLY) DEALLOCATE(MIXA) RETURN 320 FORMAT(6H CALC=,I8,6H TERP=,1P,8E13.5/(20X,8E13.5)) END