diff options
Diffstat (limited to 'Donjon/src/T16WDS.f')
| -rw-r--r-- | Donjon/src/T16WDS.f | 157 |
1 files changed, 157 insertions, 0 deletions
diff --git a/Donjon/src/T16WDS.f b/Donjon/src/T16WDS.f new file mode 100644 index 0000000..537e547 --- /dev/null +++ b/Donjon/src/T16WDS.f @@ -0,0 +1,157 @@ +*DECK T16WDS + SUBROUTINE T16WDS(IPCPO ,NGCCPO,NVXSR ,NMXSR ,IBURN ,EFJ , + > NAMDXS,ITYXS ,FLXINT,FLXDIS,OVERV ,RECXSV, + > IDRXSM,RECXSM,RECSCA) +* +*---- +* +*Purpose: +* Write properties to CPO data structure. +* +*Author(s): +* G. Marleau +* +*Parameters: input +* IPCPO pointer to CPO data structure. +* NGCCPO number of edit groups. +* NVXSR number of vector cross sections. +* NMXSR number of matrix cross sections. +* IBURN burnup step. +* EFJ energy of fission in joules. +* NAMDXS name of vector cross sections. +* ITYXS types of cross sections saved. +* FLXINT volume integrated fluxes. +* FLXDIS flux disadvantage factor. +* OVERV 1/V cross sections. +* RECXSV vector cross sections. +* IDRXSM compression vector for matrix cross sections. +* RECXSM matrix cross sections. +* RECSCA dummy matrix cross sections. +* +*---- +* + USE GANLIB + IMPLICIT NONE + TYPE(C_PTR) IPCPO + INTEGER NGCCPO,NVXSR,NMXSR,IBURN + CHARACTER NAMDXS(NVXSR+NMXSR)*12 + INTEGER IDRXSM(NGCCPO,2),ITYXS(NVXSR+NMXSR) + REAL EFJ,FLXINT(NGCCPO), + > FLXDIS(NGCCPO),OVERV(NGCCPO), + > RECXSV(NGCCPO,NVXSR+NMXSR), + > RECXSM(NGCCPO,NGCCPO,NMXSR), + > RECSCA(NGCCPO*NGCCPO) +*---- +* LOCAL VARIABLES +*---- + INTEGER IOUT,ILCMUP,ILCMDN + CHARACTER NAMSBR*6 + PARAMETER (IOUT=6,ILCMUP=1,ILCMDN=2,NAMSBR='T16WDS') + CHARACTER NAMBRN*12,NAMMAC*12,NAMLEG*2 + INTEGER IVXS,IMXS,IGTO,IGFROM,IGMIN,IGMAX,NXSCMP + REAL DENMAC +*---- +* SET UP BURUP DIRECTORY +*---- + WRITE(NAMBRN,'(A8,I4)') 'BURN ',IBURN + CALL LCMSIX(IPCPO ,NAMBRN,ILCMUP) +*---- +* SAVE ISOTOPES DENSITY, ENERGY, INTEGRATED FLUX, +* DISADVANTAGE FACTOR AND OVERV ON MAIN DIRECTORY +*---- + DENMAC=1.0 + CALL LCMPUT(IPCPO ,'ISOTOPESDENS', 1,2,DENMAC) + CALL LCMPUT(IPCPO ,'ISOTOPES-EFJ', 1,2,EFJ) + CALL LCMPUT(IPCPO ,'FLUX-INTG ',NGCCPO,2,FLXINT) + CALL LCMPUT(IPCPO ,'FLUXDISAFACT',NGCCPO,2,FLXDIS) + CALL LCMPUT(IPCPO ,'OVERV ',NGCCPO,2,OVERV) + NAMMAC='MACR ' + CALL LCMSIX(IPCPO ,NAMMAC,ILCMUP) +*---- +* FIND IF VECTOR XS NOT ALL 0.0 +* AND INITIALIZE ITYXS ACCORDINGLY +* SAVE XS +*---- + DO IVXS=1,NVXSR + ITYXS(IVXS)=0 + DO IGFROM=1,NGCCPO + IF(RECXSV(IGFROM,IVXS) .NE. 0.0) THEN + ITYXS(IVXS)=1 + CALL LCMPUT(IPCPO ,NAMDXS(IVXS), + > NGCCPO,2,RECXSV(1,IVXS)) + ENDIF + ENDDO + ENDDO +*---- +* FIND IF SCATTERING XS NOT ALL 0.0 +* AND INITIALIZE ITYXS ACCORDINGLY +*---- + DO IMXS=1,NMXSR + ITYXS(IMXS+NVXSR)=0 + DO IGTO=1,NGCCPO + DO IGFROM=1,NGCCPO + IF(RECXSM(IGTO,IGFROM,IMXS) .NE. 0.0) THEN + ITYXS(IMXS+NVXSR)=1 + CALL LCMPUT(IPCPO ,NAMDXS(IMXS+NVXSR), + > NGCCPO,2,RECXSV(1,IMXS+NVXSR)) + GO TO 105 + ENDIF + ENDDO + ENDDO + 105 CONTINUE + ENDDO +*---- +* SAVE ITYXS +*---- + CALL LCMPUT(IPCPO ,'XS-SAVED ',NVXSR+NMXSR,1,ITYXS) +*---- +* COMPRESS SCATTERING MATRIX +* RECXSM(IGTO,IGFROM,IMXS) REPRESENT SCATTERING CROSS SECTION +* FROM GROUP "IGFROM" TO GROUP "IGTO" +* IDRXSM(IGTO,1) IS MAXIMUM GROUP NUMBER +* WITH SCATTERING TO "IGTO" GROUP +* IDRXSM(IGTO,2) IS NUMBER OF GROUPS +* WITH SCATTERING TO "IGTO" GROUP +* RECSCA(IX) IS COMPRESSED SCATTERING MATRIX +* IX CAN BE LOCALIZED IN RECXSM(IGTO,IGFROM) USING +* IF(IGTO=1) THEN +* IPOSD=1 +* ELSE +* IPOSD=1+SUM( IDRXSM(IGF,2) , IGF=1,IGTO-1) +* ENDIF +* IF(IGFROM.GT.IDRXSM(IGTO,1)) THEN +* XSSCMP NOT STORED +* ELSE IF(IGFROM.LT.IDRXSM(IGTO,1)-IDRXSM(IGTO,2)+1) THEN +* XSSCMP NOT STORED +* ELSE +* IX=IPOSD+IDRXSM(IGTO,1)-IGFROM +* RECSCA(IX)=RECXSM(IGTO,IGFROM) +* ENDIF +*---- + DO IMXS=1,NMXSR + NXSCMP=0 + DO IGTO=1,NGCCPO + IGMIN=IGTO + IGMAX=IGTO + DO IGFROM=1,NGCCPO + IF(RECXSM(IGTO,IGFROM,IMXS) .NE. 0.0) THEN + IGMIN=MIN(IGMIN,IGFROM) + IGMAX=MAX(IGMAX,IGFROM) + ENDIF + ENDDO + IDRXSM(IGTO,1)=IGMAX + IDRXSM(IGTO,2)=IGMAX-IGMIN+1 + DO IGFROM=IGMAX,IGMIN,-1 + NXSCMP=NXSCMP+1 + RECSCA(NXSCMP)=RECXSM(IGTO,IGFROM,IMXS) + ENDDO + ENDDO + WRITE(NAMLEG,'(I2)') IMXS-1 + CALL LCMPUT(IPCPO,'NJJ '//NAMLEG//' ',NGCCPO,1,IDRXSM(1,1)) + CALL LCMPUT(IPCPO,'IJJ '//NAMLEG//' ',NGCCPO,1,IDRXSM(1,2)) + CALL LCMPUT(IPCPO,'SCAT'//NAMLEG//' ',NXSCMP,2,RECSCA) + ENDDO + CALL LCMSIX(IPCPO ,NAMMAC,ILCMDN) + CALL LCMSIX(IPCPO ,NAMBRN,ILCMDN) + RETURN + END |