*DECK NCR SUBROUTINE NCR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY) * *----------------------------------------------------------------------- * *Purpose: * Recover and interpolate microlib and macrolib information from one * or many multicompo database objects. * *Copyright: * Copyright (C) 2007 Ecole Polytechnique de Montreal * *Author(s): * A. Hebert and R. Chambon * *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 NCR: calling specifications are: * MLIB := NCR: [ { MLIB | MLIB2 } ] CPONAM1 [[ CPONAM2 ]] [ MAPFL ] * :: (ncr\_data) ; * where * MLIB : name of a \emph{microlib} (type L\_LIBRARY) or \emph{macrolib} * (type L\_MACROLIB) containing the interpolated data. If this object also * appears on the RHS of structure (NCR:, it is open in modification mode * and updated. * MLIB2 : name of an optional \emph{microlib} object whose content is copied * on MLIB. * CPONAM1 : name of the \emph{multicompo} data structure (L\_MULTICOMPO * signature). * CPONAM2 : name of an additional \emph{multicompo} data structure * (L\_MULTICOMPO signature). This object is optional. * MAPFL : name of the \emph{map} object containing fuel regions description, * global and local parameter information (burnup, fuel/coolant temperatures, * coolant density, etc). Keyword TABLE is expected in (ncr\_data). * ncr\_data : input data structure containing interpolation information. * *----------------------------------------------------------------------- * USE GANLIB IMPLICIT NONE *---- * SUBROUTINE ARGUMENTS *---- INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY) TYPE(C_PTR) KENTRY(NENTRY) CHARACTER HENTRY(NENTRY)*12 *---- * LOCAL VARIABLES *---- INTEGER, PARAMETER::IOUT=6 INTEGER, PARAMETER::MAXISD=200 INTEGER, PARAMETER::NSTATE=40 REAL B2, FLOTT INTEGER I, I0, IACCS, ILENG, IMPX, INDIC, ITER, ITH, ITYLCM, ITYP, & MAXFEL, MAXISO, MAXNIS, NB, NCAL, NCH, NCOMB, NFUEL, NGFF, NALBP, & IDF, NGRP, NITMA, NMIL, NMIX, NPARM CHARACTER TEXT12*12,HSMG*131,HSIGN*12,NAMDIR*12 LOGICAL LMACRO,LCUBIC,LXS,LRES,LPURE DOUBLE PRECISION DFLOTT INTEGER ISTATE(NSTATE) TYPE(C_PTR) IPLIB,IPLIB2,IPMAP,IPCPO,JPCPO INTEGER, ALLOCATABLE, DIMENSION(:) :: MIXC,NISO INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: HISO REAL, ALLOCATABLE, DIMENSION(:,:) :: TERP,CONC LOGICAL, ALLOCATABLE, DIMENSION(:) :: LISO *---- * PARAMETER VALIDATION *---- IF(NENTRY.LE.1) CALL XABORT('NCR: MINIMUM OF 2 OBJECTS EXPECTED.') IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('NCR: MICRO' 1 //'LIB LCM OBJECT EXPECTED AT LHS.') IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('NCR: MICRO' 1 //'LIB IN CREATE OR MODIFICATION MODE EXPECTED.') IACCS=JENTRY(1) IPLIB=KENTRY(1) IPLIB2=C_NULL_PTR IPMAP=C_NULL_PTR NGRP=0 NMIX=0 IF(IACCS.EQ.1) THEN CALL LCMGTC(IPLIB,'SIGNATURE',12,HSIGN) IF(HSIGN.EQ.'L_LIBRARY') THEN CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE) NGRP=ISTATE(3) NMIX=ISTATE(1) ELSE IF(HSIGN.EQ.'L_MACROLIB') THEN CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE) NGRP=ISTATE(1) NMIX=ISTATE(2) ELSE TEXT12=HENTRY(1) CALL XABORT('NCR: SIGNATURE OF '//TEXT12//' IS '//HSIGN// 1 '. L_LIBRARY OR L_MACROLIB EXPECTED.') ENDIF ENDIF DO 10 I=2,NENTRY IF((IENTRY(I).NE.1).AND.(IENTRY(I).NE.2)) CALL XABORT('NCR: ' 1 //'LCM OBJECTS EXPECTED AT RHS.') IF(JENTRY(I).NE.2) CALL XABORT('NCR: LCM OBJECTS IN READ-ONLY ' 1 //'MODE EXPECTED AT RHS.') CALL LCMGTC(KENTRY(I),'SIGNATURE',12,HSIGN) IF(HSIGN.EQ.'L_LIBRARY') THEN IF(C_ASSOCIATED(IPLIB2)) CALL XABORT('NCR: ONLY ONE MICROLIB' 1 //' EXPECTED AT RHS.') IPLIB2=KENTRY(I) GO TO 10 ELSE IF(HSIGN.EQ.'L_MACROLIB') THEN CALL XABORT('NCR: ANOTHER MACROLIB NOT EXPECTED AT RHS.') ELSE IF(HSIGN.EQ.'L_MAP') THEN IF(I.NE.NENTRY) CALL XABORT('NCR: FUEL-MAP EXPECTED TO BE TH' 1 //'E LAST OBJECT.') IF(NENTRY.LT.3) CALL XABORT('NCR: MISSING MULTICOMPO OBJECT.') IPMAP=KENTRY(NENTRY) CALL LCMLEN(IPMAP,'FLMIX',NMIX,ITYP) ELSE IF(HSIGN.NE.'L_MULTICOMPO') THEN TEXT12=HENTRY(I) CALL XABORT('NCR: SIGNATURE OF '//TEXT12//' IS '//HSIGN// 1 '. L_MULTICOMPO EXPECTED.') ENDIF 10 CONTINUE *---- * READ THE INPUT DATA *---- LMACRO=.FALSE. LXS=.FALSE. LCUBIC=.FALSE. LRES=.FALSE. LPURE=.FALSE. B2=0.0 MAXFEL=0 ITER=-1 IPCPO=C_NULL_PTR IMPX=1 20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.3) CALL XABORT('NCR: CHARACTER DATA EXPECTED(1).') 30 IF(TEXT12.EQ.'EDIT') THEN * READ THE PRINT INDEX. CALL REDGET(INDIC,IMPX,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.1) CALL XABORT('NCR: INTEGER DATA EXPECTED(1).') ELSE IF(TEXT12.EQ.'NMIX') THEN * READ THE MAXIMUM NUMBER OF MATERIAL MIXTURES. CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.1) CALL XABORT('NCR: INTEGER DATA EXPECTED(2).') IF(NITMA.LT.NMIX) THEN WRITE(HSMG,'(20HNCR: NMIX MUST BE >=,I8)') NMIX CALL XABORT(HSMG) ENDIF NMIX=NITMA ELSE IF(TEXT12.EQ.'MACRO') THEN IF(LMACRO) CALL XABORT('NCR: ONLY ONE MACRO KEYWORD EXPECTED.') LMACRO=.TRUE. ELSE IF(TEXT12.EQ.'MICRO') THEN LMACRO=.FALSE. ELSE IF(TEXT12.EQ.'LINEAR') THEN LCUBIC=.FALSE. ELSE IF(TEXT12.EQ.'CUBIC') THEN LCUBIC=.TRUE. ELSE IF(TEXT12.EQ.'ALLX') THEN LXS=.TRUE. CALL REDGET(INDIC,MAXFEL,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.1) CALL XABORT('NCR: INTEGER DATA EXPECTED(3).') ELSE IF(TEXT12.EQ.'RES') THEN IF((IACCS.EQ.0).AND.(.NOT.C_ASSOCIATED(IPLIB2))) THEN CALL XABORT('NCR: RHS MICROLIB EXPECTED WITH RES OPTION.') ENDIF LRES=.TRUE. ELSE IF(TEXT12.EQ.'PURE') THEN LPURE=.TRUE. ELSE IF(TEXT12.EQ.'COMPO') THEN IF(NMIX.EQ.0) CALL XABORT('NCR: ZERO NUMBER OF MIXTURES.') IF(C_ASSOCIATED(IPMAP)) THEN WRITE(IOUT,'(/43H NCR: ***WARNING*** A FUEL MAP IS SET AT RH, 1 26HS; KEYWORD TABLE EXPECTED.)') ENDIF IF((IACCS.EQ.0).AND.(C_ASSOCIATED(IPLIB2))) THEN CALL LCMEQU(IPLIB2,IPLIB) IACCS=1 ENDIF CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.3) CALL XABORT('NCR: CHARACTER DATA EXPECTED(2).') CALL REDGET(INDIC,NITMA,FLOTT,NAMDIR,DFLOTT) IF(INDIC.NE.3) CALL XABORT('NCR: CHARACTER DATA EXPECTED(3).') I0=0 DO 50 I=2,NENTRY IF(C_ASSOCIATED(KENTRY(I),IPLIB2)) GO TO 50 IF(TEXT12.EQ.HENTRY(I)) THEN CALL LCMGTC(KENTRY(I),'SIGNATURE',12,TEXT12) IF(TEXT12.EQ.'L_MULTICOMPO') THEN IPCPO=KENTRY(I) ELSE CALL XABORT('NCR: WRONG SIGNATURE ('//TEXT12//').') ENDIF ITH=I GO TO 60 ENDIF 50 CONTINUE CALL XABORT('NCR: MULTICOMPO '//TEXT12//' NOT FOUND.') 60 IF(IMPX.GT.0) WRITE(IOUT,320) HENTRY(I),NAMDIR CALL LCMLEN(IPCPO,NAMDIR,ILENG,ITYLCM) IF((ILENG.EQ.0).OR.(ITYLCM.NE.0)) THEN CALL LCMLIB(IPCPO) CALL XABORT('NCR: NO '//NAMDIR//' DIRECTORY TO STEP.') ENDIF JPCPO=LCMGID(IPCPO,NAMDIR) CALL LCMGET(JPCPO,'STATE-VECTOR',ISTATE) IF(NGRP.EQ.0) THEN NGRP=ISTATE(2) ELSE IF(NGRP.NE.ISTATE(2)) THEN WRITE(HSMG,'(9H NCR: THE,I4,29H-TH MULTICOMPO HAS AN INVALID, 1 25H NUMBER OF ENERGY GROUPS.)') ITH CALL XABORT(HSMG) ENDIF IF(ISTATE(12).NE.2006) CALL XABORT('NCR: 2006 MULTICOMPO SPECI' 1 //'F EXPECTED.') NMIL=ISTATE(1) NCAL=ISTATE(3) NGFF=ISTATE(14) NALBP=ISTATE(15) IDF=ISTATE(16) IF(NGFF.EQ.-1) CALL XABORT('NCR: GFF INFO MISSING.') IF(NALBP.EQ.-1) CALL XABORT('NCR: PHYSICAL ALBEDO MISSING.') IF(IDF.EQ.-1) CALL XABORT('NCR: SURF-CURRENT INFO MISSING.') ALLOCATE(MIXC(NMIX),TERP(NCAL,NMIX),NISO(NMIX),LISO(NMIX), 1 HISO(2,NMIX,MAXISD),CONC(NMIX,MAXISD)) * CALL NCRDRV(JPCPO,LCUBIC,NMIX,IMPX,NMIL,NCAL,ITER,MAXNIS,MIXC, 1 TERP,NISO,LISO,HISO,CONC) GO TO 100 ELSE IF(TEXT12.EQ.'TABLE') THEN IF(.NOT.C_ASSOCIATED(IPMAP)) CALL XABORT('NCR: MISSING FUEL-MA' 1 //'P OBJECT.') ISTATE(:NSTATE)=0 CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE) NB=ISTATE(1) NCH=ISTATE(2) NCOMB=ISTATE(3) NGRP=ISTATE(4) NFUEL=ISTATE(7) NPARM=ISTATE(8) IF(NCOMB.EQ.0)CALL XABORT('NCR: NUMBER OF COMBUSTION ZONES NO' 1 //'T YET DEFINED IN THE FUEL MAP NCOMB=0.') IF((IACCS.EQ.0).AND.(C_ASSOCIATED(IPLIB2))) THEN CALL LCMEQU(IPLIB2,IPLIB) IACCS=1 ENDIF CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.3) CALL XABORT('NCR: CHARACTER DATA EXPECTED(2).') CALL REDGET(INDIC,NITMA,FLOTT,NAMDIR,DFLOTT) IF(INDIC.NE.3) CALL XABORT('NCR: CHARACTER DATA EXPECTED(3).') I0=0 DO 80 I=2,NENTRY IF((C_ASSOCIATED(KENTRY(I),IPLIB2)).OR. 1 (C_ASSOCIATED(KENTRY(I),IPMAP))) GO TO 80 IF(TEXT12.EQ.HENTRY(I)) THEN CALL LCMGTC(KENTRY(I),'SIGNATURE',12,TEXT12) IF(TEXT12.EQ.'L_MULTICOMPO') THEN IPCPO=KENTRY(I) ELSE CALL XABORT('NCR: WRONG SIGNATURE ('//TEXT12//').') ENDIF ITH=I GO TO 90 ENDIF 80 CONTINUE CALL XABORT('NCR: MULTICOMPO '//TEXT12//' NOT FOUND.') 90 IF(IMPX.GT.0) WRITE(IOUT,320) HENTRY(I),NAMDIR CALL LCMLEN(IPCPO,NAMDIR,ILENG,ITYLCM) IF((ILENG.EQ.0).OR.(ITYLCM.NE.0)) THEN CALL LCMLIB(IPCPO) CALL XABORT('NCR: NO '//NAMDIR//' DIRECTORY TO STEP.') ENDIF JPCPO=LCMGID(IPCPO,NAMDIR) ISTATE(:NSTATE)=0 CALL LCMGET(JPCPO,'STATE-VECTOR',ISTATE) IF(ISTATE(12).NE.2006) CALL XABORT('NCR: 2006 MULTICOMPO SPECI' 1 //'F EXPECTED.') IF(NGRP.NE.ISTATE(2)) THEN WRITE(HSMG,'(9H NCR: THE,I4,29H-TH MULTICOMPO HAS AN INVALID, 1 25H NUMBER OF ENERGY GROUPS.)') ITH CALL XABORT(HSMG) ENDIF NMIL=ISTATE(1) NCAL=ISTATE(3) NGFF=ISTATE(14) NALBP=ISTATE(15) IDF=ISTATE(16) IF(NGFF.EQ.-1) CALL XABORT('NCR: GFF INFO MISSING.') IF(NALBP.EQ.-1) CALL XABORT('NCR: PHYSICAL ALBEDO MISSING.') ALLOCATE(MIXC(NMIX),TERP(NCAL,NMIX),NISO(NMIX),LISO(NMIX), 1 HISO(2,NMIX,MAXISD),CONC(NMIX,MAXISD)) * CALL NCRRGR(JPCPO,IPMAP,LCUBIC,NMIX,IMPX,NMIL,NCAL,NCH, 1 NB,NFUEL,NPARM,ITER,MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC) GO TO 100 ELSE IF(TEXT12.EQ.'LEAK') THEN CALL REDGET(INDIC,NITMA,B2,TEXT12,DFLOTT) IF(INDIC.NE.2) CALL XABORT('NCR: REAL DATA EXPECTED.') ELSE CALL XABORT('NCR: '//TEXT12//' IS AN INVALID KEYWORD.') ENDIF GO TO 20 *---- * BUILD THE INTERPOLATED MACROLIB OR MICROLIB *---- 100 IF(LMACRO) THEN * build a macrolib CALL NCRMAC(MAXNIS,IPLIB,JPCPO,IACCS,NMIL,NMIX,NGRP,NGFF,NALBP, 1 IDF,IMPX,NCAL,TERP,NISO,LISO,HISO,CONC,MIXC,LRES,LPURE,B2) IF(IMPX.GT.0) THEN CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE) WRITE(IOUT,290) IMPX,(ISTATE(I),I=1,9),ISTATE(12),ISTATE(16) ENDIF ELSE * build a microlib IF(IACCS.EQ.0)THEN MAXISO=MAXISD*NMIX ELSE CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE) MAXISO=MAX(MAXISD*NMIX,ISTATE(2)) ENDIF CALL NCRLIB(MAXNIS,MAXISO,MAXFEL,IPLIB,JPCPO,IACCS,NMIL,NMIX, 1 NGRP,NGFF,NALBP,IDF,IMPX,NCAL,TERP,NISO,LISO,HISO,CONC,MIXC, 2 LXS,LRES,LPURE,B2) IF(IMPX.GT.0) THEN CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE) WRITE(IOUT,300) IMPX,(ISTATE(I),I=1,12) WRITE(IOUT,310) (ISTATE(I),I=13,15),(ISTATE(I),I=17,24) ENDIF ENDIF * DEALLOCATE(CONC,HISO,LISO,NISO,TERP,MIXC) *---- * CONTINUE DATA PROCESSING *---- IF(ITER.EQ.0) THEN GO TO 200 ELSE IF(ITER.EQ.1) THEN TEXT12='COMPO' GO TO 30 ELSE IF(ITER.EQ.2) THEN TEXT12='TABLE' GO TO 30 ENDIF *---- * LEAVE NCR: *---- 200 IF(IMPX.GT.2) CALL LCMLIB(IPLIB) RETURN * 290 FORMAT(/8H OPTIONS/8H -------/ 1 7H IMPX ,I6,30H (0=NO PRINT/1=SHORT/2=MORE)/ 2 7H NGROUP,I6,28H (NUMBER OF ENERGY GROUPS)/ 3 7H NBMIX ,I6,39H (NUMBER OF MIXTURES IN THE MACROLIB)/ 4 7H NANISO,I6,34H (MAXIMUM SCATTERING ANISOTROPY)/ 5 7H NIFISS,I6,47H (MAXIMUM NUMBER OF FISSILE ISOTOPES IN A MIX, 6 5HTURE)/ 7 7H NEDMAC,I6,34H (NUMBER OF CROSS SECTION EDITS)/ 8 7H ITRANC,I6,45H (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2, 9 43H=RECOVER FROM LIBRARY/4=LEAKAGE CORRECTION)/ 1 7H NLG ,I6,39H (NUMBER OF DELAYED PRECURSOR GROUPS)/ 2 7H NALBP ,I6,31H (0: NO PHYSICAL ALBEDO INFO)/ 3 7H ILEAK ,I6,40H (1=DIFF AVAILABLE; 2=DIFFX AVAILABLE)/ 4 7H IDF ,I6,47H (0=NO INFO/1=ALBS INFO/2=FLUX GAP INFO/3=ADF, 5 10H GAP INFO)/ 6 7H NGFF ,I6,39H (0: NO GENERALIZED FORM FACTOR INFO)) 300 FORMAT(/8H OPTIONS/8H -------/ 1 7H IMPX ,I6,30H (0=NO PRINT/1=SHORT/2=MORE)/ 2 7H MAXMIX,I6,31H (MAXIMUM NUMBER OF MIXTURES)/ 3 7H NBISO ,I6,36H (NUMBER OF ISOTOPES OR MATERIALS)/ 4 7H NGRP ,I6,28H (NUMBER OF ENERGY GROUPS)/ 5 7H NL ,I6,30H (NUMBER OF LEGENDRE ORDERS)/ 6 7H ITRANC,I6,45H (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2, 7 57H=RECOVER FROM LIBRARY/3=WIMS-D TYPE/4=LEAKAGE CORRECTION)/ 8 7H IPROB ,I6,23H (0=DIRECT/1=ADJOINT)/ 9 7H ITIME ,I6,28H (1=STEADY-STATE/2=PROMPT)/ 1 7H NLIB ,I6,32H (NUMBER OF SETS OF LIBRARIES)/ 2 7H NGF ,I6,48H (NUMBER OF FAST GROUP WITHOUT SELF-SHIELDING)/ 3 7H IGRMAX,I6,41H (LAST GROUP INDEX WITH SELF-SHIELDING)/ 4 7H NDEPL ,I6,33H (NUMBER OF DEPLETING ISOTOPES)/ 5 7H NCOMB ,I6,33H (NUMBER OF DEPLETING MIXTURES)) 310 FORMAT(7H NEDMAC,I6,34H (NUMBER OF CROSS SECTION EDITS)/ 1 7H NBMIX ,I6,23H (NUMBER OF MIXTURES)/ 2 7H NRES ,I6,40H (NUMBER OF SETS OF RESONANT MIXTURES)/ 3 7H IPROC ,I6,48H (-1=SKIP LIBRARY PROCESSING/0=DILUTION INTERP, 4 48HOLATION/1=USE PHYSICAL TABLES/2=BUILD A DRAGLIB/, 5 55H3=COMPUTE CALENDF TABLES/4=COMPUTE SLOWING-DOWN TABLES)/ 6 7H IMAC ,I6,45H (0=DO NOT/1=DO BUILD AN EMBEDDED MACROLIB)/ 7 7H NDEL ,I6,31H (NUMBER OF PRECURSOR GROUPS)/ 8 7H NFISS ,I6,31H (NUMBER OF FISSILE ISOTOPES)/ 9 7H ISOADD,I6,37H (0=COMPLETE BURNUP CHAIN/1=DO NOT)/ 1 7H MAXISM,I6,40H (MAX. NUMBER OF ISOTOPES PER MIXTURE)/ 2 7H IPRECI,I6,34H (CALENDF ACCURACY FLAG:1/2/3/4)/ 3 7H IDF ,I6,47H (0=NO INFO/1=ALBS INFO/2=FLUX GAP INFO/3=ADF, 4 10H GAP INFO)) 320 FORMAT(/32H NCR: INTERPOLATING MULTICOMPO ',A12,13H' FROM DIRECT, 1 5HORY ',A12,2H'.) END