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 --- Donjon/src/T16DRV.f | 230 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 230 insertions(+) create mode 100644 Donjon/src/T16DRV.f (limited to 'Donjon/src/T16DRV.f') diff --git a/Donjon/src/T16DRV.f b/Donjon/src/T16DRV.f new file mode 100644 index 0000000..c9ff36f --- /dev/null +++ b/Donjon/src/T16DRV.f @@ -0,0 +1,230 @@ +*DECK T16DRV + SUBROUTINE T16DRV(IPCPO ,IFT16 ,IPRINT,MNLOCP,MNCPLP,MNPERT, + > NALOCP,NCMIXS,NGCCPO,MNBURN,NG ,NGMTR , + > NMATZ ,MTRMSH,NZONE ,IFGMTR,VELMTR,NAMMIX, + > MIXRCI,MIXPER,MIXREG) +* +*---- +* +*Purpose: +* Main driver for the transfer of cross sections from tape16 to CPO. +* +*Author(s): +* G. Marleau +* +*Parameters: input +* IPCPO pointer to CPO data structure. +* IFT16 tape16 file unit. +* IPRINT print level where: +* =0 for no print; >= 1 print processing option. +* MNLOCP maximum number of local parameters. +* MNCPLP maximum number of coupled parameters. +* MNPERT maximum number of perturbations per local parameter. +* NALOCP local parameter names allowed. +* NCMIXS number of current mixtures. +* NGCCPO number of edit groups. +* MNBURN maximum number or burnup steps. +* NG number of groups on X-S library. +* NGMTR number of main transport groups. +* NMATZ number of mixtures. +* MTRMSH number of main transport mesh points. +* NZONE number of zones. +* IFGMTR fewgroups for main transport. +* VELMTR velocity for main transport. +* NAMMIX names of mixtures. +* MIXRCI reference information for mixtures where: +* =0 no information for mixture; +* >0 information not updated; +* <0 information to be updated. +* MIXPER perturbation information for mixtures. +* =0 no information for mixture; +* >0 information not updated; +* <0 information to be updated. +* MIXREG mixture update identifier where: +* =0 do not update; +* =-1 update using CELLAV information; +* > 0 update using specified region number. +* +*---- +* + USE GANLIB + IMPLICIT NONE + TYPE(C_PTR) IPCPO + INTEGER IFT16,IPRINT,MNLOCP,MNCPLP,MNPERT, + > NCMIXS,NGCCPO,MNBURN,NG,NGMTR,NMATZ, + > MTRMSH,NZONE + CHARACTER NALOCP(MNLOCP+MNCPLP)*4 + INTEGER IFGMTR(NGCCPO),NAMMIX(2,NCMIXS), + > MIXRCI(2+MNLOCP+MNCPLP,NCMIXS), + > MIXPER(MNPERT,MNLOCP+MNCPLP,NCMIXS), + > MIXREG(NCMIXS) + REAL VELMTR(NGMTR) +*---- +* MEMORY ALLOCATION +*---- + REAL, ALLOCATABLE, DIMENSION(:) :: BURNUP,WNKB + INTEGER, ALLOCATABLE, DIMENSION(:) :: KMSPEC,MATMSH,IDRXSM + REAL, ALLOCATABLE, DIMENSION(:) :: VQLE,FLXINT,FLXDIS, + > OVERV,RECXSV,RECXSM, + > RECTMP,RECSCA,ZONVOL,ZONRAD +*---- +* T16 PARAMETERS +*---- + INTEGER MAXKEY + PARAMETER (MAXKEY=2) + CHARACTER TKEY1(MAXKEY)*10,TKEY2(MAXKEY)*10, + > RKEY1*10,RKEY2*10 + INTEGER NKEY,IOPT,NBE,IR,ZONNUM +*---- +* LOCAL VARIABLES +*---- + INTEGER IOUT,ILCMUP,ILCMDN,NVXSR,NMXSR + CHARACTER NAMSBR*6 + PARAMETER (IOUT=6,ILCMUP=1,ILCMDN=2,NVXSR=20,NMXSR=2, + > NAMSBR='T16DRV') + CHARACTER NAMDIR*12 + INTEGER IMIX,ILOCP,NBPERP,IPER,NBURN,IBURN,NPERTN, + > INEXTR,ITYXS(NVXSR+NMXSR),IMIREG, + > MMXM + REAL VOLUME,B2CRI(3),BRNIRR(3),EFJ +*---- +* DATA +*---- + CHARACTER NAMDXS(NVXSR+NMXSR)*12 + SAVE NAMDXS + DATA NAMDXS + > /'TOTAL ','TRANC ','NUSIGF ','NFTOT ', + > 'CHI ','NU ','NG ','NHEAT ', + > 'N2N ','N3N ','N4N ','NP ', + > 'NA ','GOLD ','ABS ','NWT0 ', + > 'STRD ','STRD X ','STRD Y ','STRD Z ', + > 'SIGS 0 ','SIGS 1 '/ +*---- +* ALLOCATE MEMORY +*---- + MMXM=MAX(NZONE,MTRMSH) + NPERTN=MNLOCP+MNCPLP + ALLOCATE(BURNUP(MNBURN),WNKB(MNBURN)) + ALLOCATE(KMSPEC(NMATZ),MATMSH(MMXM),IDRXSM(NGCCPO*2)) + ALLOCATE(VQLE(MMXM),FLXINT(NGCCPO),FLXDIS(NGCCPO), + > OVERV(NGCCPO),RECXSV(NGCCPO*(NVXSR+NMXSR)), + > RECXSM(NGCCPO*NGCCPO*NMXSR),RECTMP(4*NGMTR), + > RECSCA(NGMTR*NGMTR)) + ALLOCATE(ZONVOL(NZONE),ZONRAD(NZONE)) +*---- +* FIND MATERIAL SPECTRUM +* REQUIRED FOR FLUX DISADVANTAGE FACTOR +*---- + IOPT=1 + TKEY1(1)='MATERIAL ' + TKEY2(1)='SPECTRUM ' + NKEY=1 + CALL T16FND(IFT16 ,IPRINT,IOPT ,NKEY ,TKEY1 ,TKEY2 , + > NBE ) + IF( NBE .NE. NMATZ ) THEN + WRITE(6,'(128A1)') 'PLEASE RE-RUN WIMS-AECL BECAUSE '// + > 'T16CPO UTILITY NEEDS A RECORD: '//TKEY1(1)//TKEY1(2) + CALL XABORT(NAMSBR// + > ': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1)) + ELSE + READ(IFT16) RKEY1,RKEY2,NBE,(KMSPEC(IR),IR=1,NMATZ) + ENDIF +*---- +* SCAN OVER MIXTURES +*---- + DO IMIX=1,NCMIXS +*---- +* MIXTURE TO UPDATE +*---- + BRNIRR(:3)=0.0 + IMIREG=MIXREG(IMIX) + WRITE(NAMDIR,'(A4,A2,A6)') + > NAMMIX(1,IMIX),NAMMIX(2,IMIX),'RC ' + NBURN=ABS(MIXRCI(2,IMIX)) + IF(MIXRCI(2,IMIX) .LT. 0) THEN + CALL LCMSIX(IPCPO,NAMDIR,ILCMUP) + INEXTR=MIXRCI(1,IMIX) + DO IBURN=1,NBURN +*---- +* BURNUP STEP TO UPDATE +*---- + CALL T16REC(IFT16 ,IPRINT,INEXTR) + CALL T16FLX(IFT16 ,IPRINT,NGCCPO,NG ,NGMTR ,NMATZ , + > MMXM ,MTRMSH,NZONE ,IFGMTR,VELMTR,IMIREG, + > VOLUME,B2CRI ,FLXINT,FLXDIS,OVERV ,KMSPEC, + > MATMSH,VQLE ,ZONNUM, ZONRAD,ZONVOL) + IF(IMIREG .GT. 0) THEN + CALL T16REC(IFT16 ,IPRINT,INEXTR) + CALL T16RRE(IFT16 ,IPRINT,NGCCPO,NGMTR ,IFGMTR,NVXSR , + > NMXSR ,IMIREG,VELMTR,B2CRI ,BRNIRR,FLXINT, + > OVERV ,RECXSV,RECXSM,RECTMP,RECSCA) + ELSE + CALL T16REC(IFT16 ,IPRINT,INEXTR) + CALL T16RCA(IFT16 ,IPRINT,NGCCPO,NGMTR ,IFGMTR,NVXSR , + > NMXSR ,B2CRI ,BRNIRR,NZONE ,RECXSV,RECXSM, + > RECTMP,RECSCA,ZONVOL) + ENDIF + BURNUP(IBURN)=BRNIRR(1) + WNKB(IBURN)=BRNIRR(2) + EFJ=BRNIRR(3) + CALL T16WDS(IPCPO ,NGCCPO,NVXSR ,NMXSR ,IBURN ,EFJ , + > NAMDXS,ITYXS ,FLXINT,FLXDIS,OVERV ,RECXSV, + > IDRXSM,RECXSM,RECSCA) + INEXTR=INEXTR+1 + ENDDO + CALL LCMPUT(IPCPO ,'BURNUP ',NBURN,2,BURNUP) + CALL LCMPUT(IPCPO ,'N/KB ',NBURN,2,WNKB) + CALL LCMSIX(IPCPO,NAMDIR,ILCMDN) + ENDIF +*---- +* PERTURBATIONS TO UPDATE +*---- + DO ILOCP=1,NPERTN + NBPERP=ABS(MIXRCI(2+ILOCP,IMIX)) + IF(MIXRCI(2+ILOCP,IMIX) .LT. 0) THEN + DO IPER=1,NBPERP + INEXTR=MIXPER(IPER,ILOCP,IMIX) + WRITE(NAMDIR,'(A4,A2,A4,I2)') + > NAMMIX(1,IMIX),NAMMIX(2,IMIX),NALOCP(ILOCP),IPER + CALL LCMSIX(IPCPO,NAMDIR,ILCMUP) + DO IBURN=1,NBURN + CALL T16REC(IFT16 ,IPRINT,INEXTR) + CALL T16FLX(IFT16 ,IPRINT,NGCCPO,NG ,NGMTR ,NMATZ , + > MMXM ,MTRMSH,NZONE ,IFGMTR,VELMTR,IMIREG, + > VOLUME,B2CRI ,FLXINT,FLXDIS,OVERV ,KMSPEC, + > MATMSH,VQLE ,ZONNUM, ZONRAD,ZONVOL) + IF(IMIREG .GT. 0) THEN + CALL T16REC(IFT16 ,IPRINT,INEXTR) + CALL T16RRE(IFT16 ,IPRINT,NGCCPO,NGMTR ,IFGMTR,NVXSR , + > NMXSR ,IMIREG,VELMTR,B2CRI ,BRNIRR,FLXINT, + > OVERV,RECXSV,RECXSM,RECTMP,RECSCA) + ELSE + CALL T16REC(IFT16 ,IPRINT,INEXTR) + CALL T16RCA(IFT16 ,IPRINT,NGCCPO,NGMTR ,IFGMTR,NVXSR , + > NMXSR ,B2CRI ,BRNIRR,NZONE ,RECXSV,RECXSM, + > RECTMP,RECSCA,ZONVOL) + ENDIF + BURNUP(IBURN)=BRNIRR(1) + WNKB(IBURN)=BRNIRR(2) + EFJ=BRNIRR(3) + CALL T16WDS(IPCPO ,NGCCPO,NVXSR ,NMXSR ,IBURN ,EFJ , + > NAMDXS,ITYXS ,FLXINT,FLXDIS,OVERV ,RECXSV, + > IDRXSM,RECXSM,RECSCA) + INEXTR=INEXTR+1 + ENDDO + CALL LCMPUT(IPCPO ,'BURNUP ',NBURN,2,BURNUP) + CALL LCMPUT(IPCPO ,'N/KB ',NBURN,2,WNKB) + CALL LCMSIX(IPCPO,NAMDIR,ILCMDN) + ENDDO + ENDIF + ENDDO + ENDDO +*---- +* RELEASE MEMORY +*---- + DEALLOCATE(ZONRAD,ZONVOL) + DEALLOCATE(RECSCA,RECTMP,RECXSM,RECXSV,OVERV,FLXDIS,FLXINT,VQLE) + DEALLOCATE(IDRXSM,MATMSH,KMSPEC) + DEALLOCATE(WNKB,BURNUP) + RETURN + END -- cgit v1.2.3