summaryrefslogtreecommitdiff
path: root/Dragon/src/SENDRV.f
diff options
context:
space:
mode:
Diffstat (limited to 'Dragon/src/SENDRV.f')
-rw-r--r--Dragon/src/SENDRV.f302
1 files changed, 302 insertions, 0 deletions
diff --git a/Dragon/src/SENDRV.f b/Dragon/src/SENDRV.f
new file mode 100644
index 0000000..1397332
--- /dev/null
+++ b/Dragon/src/SENDRV.f
@@ -0,0 +1,302 @@
+*DECK SENDRV
+ SUBROUTINE SENDRV(IPSENS,IPTRACK,IPLIB,IPFLUX,IPAFLUX,IPRINT,
+ > NR,NU,NI,NG,NANIS,NLTERM)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Creation of sensitivity profiles to
+* cross-section on the reactivity using first order perturbation
+* method using the adjoint calculation.
+*
+*Copyright:
+* Copyright (C) 2011 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): C. Laville, G. Marleau
+*
+*Parameters: input/output
+* IPSENS LCM Sensitivity object address.
+* IPTRACK LCM Tracking object address.
+* IPLIB LCM Library object address.
+* IPFLUX LCM Flux object address.
+* IPAFLUX LCM Adjoin flux object address.
+* IPRINT print level.
+* NR number of region in Tracking object.
+* NU number of unkwnow in Tracking/Flux objects.
+* NI number of isotopes in Library object.
+* NG number of energy group in Library object.
+* NANIS anisotropy order kept.
+* NLTERM total number of term of the flux.
+*
+*-----------------------------------------------------------------------
+*
+ USE GANLIB
+ IMPLICIT NONE
+*----
+* Suboutine arguements
+*----
+ TYPE(C_PTR) IPTRACK,IPLIB,IPFLUX,IPAFLUX
+ INTEGER IPSENS,NR,NU,NI,NG,IPRINT,NANIS,NLTERM
+*----
+* Local variables
+*----
+ TYPE(C_PTR) KPISO,JPFLUX,JPAFLUX
+ INTEGER IG,JG,IR,KL,KKEYL,IL,IM,II
+ INTEGER ILENG,ILON,ITYLCM,NSENI,NSENS,NIC
+ REAL KEFF,D
+ CHARACTER ISONAM*12,REV*48,DATE*64,HSMG*131
+*----
+* Allocatable arrays
+*----
+ INTEGER, ALLOCATABLE, DIMENSION(:) :: MAT,KEY,MELISO,ISOC
+ INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NAMISO,NAMISC
+ REAL, ALLOCATABLE, DIMENSION(:) :: VOL,ENERG,DENISO,SOLFLU,NUSIGF,
+ > CHI
+ REAL, ALLOCATABLE, DIMENSION(:,:,:) :: FLUXI,AFLUX
+ REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: P
+ TYPE(C_PTR), ALLOCATABLE, DIMENSION(:) :: IPISO
+*----
+* Parameters
+*----
+ INTEGER IOUT
+ CHARACTER NAMSBR*6
+ PARAMETER (IOUT=6,NAMSBR='SENDRV')
+*----
+* Scratch storage allocation
+* MAT Mixture of each region in Tracking object.
+* KEY Localisation of the flux/aflux for each region in Tracking
+* object.
+* MELISO Mixture of each isotope/region in Library object.
+* NAMISO Alias of each isotope/region in Library object.
+* NAMISC Independent isotopes names.
+* ISOC Independent isotope number associated with isotope/mixture.
+* VOL Volume of each region in Tracking object.
+* ENERG Energy boundaries in Library object.
+* DENISO Density of each isotope/region in Library object.
+* SOLFLU Flux solution of each region in Flux object.
+* FLUXI Flux of each region multiplied by the volume of the region.
+* AFLUX Adjoint flux of each region.
+* P Matrix calcution for sensitivity analysis.
+* NUSIGF Vector for nubar multiplied by the fission cross-section
+* CHI Vector for fission spectra.
+*----
+ ALLOCATE(MAT(NR),KEY(NU),MELISO(NI),NAMISO(3,NI),NAMISC(2,NI),
+ > ISOC(NI))
+ ALLOCATE(VOL(NR),ENERG(NG+1),DENISO(NI),SOLFLU(NU),
+ > FLUXI(NR,NLTERM,NG),AFLUX(NR,NLTERM,NG),P(NR,NANIS,NG,NG),
+ > NUSIGF(NG),CHI(NG))
+*--------
+* Step 1:
+* Recover Tracking informations
+* a) VOLUME
+* b) MATCOL
+* c) KEYFLX
+*----
+ VOL(:NR)=0.0
+ CALL LCMGET(IPTRACK,'VOLUME',VOL)
+*----
+ MAT(:NR)=0
+ CALL LCMGET(IPTRACK,'MATCOD',MAT)
+*----
+ KEY(:NU)=0
+ CALL LCMGET(IPTRACK,'KEYFLX',KEY)
+*----
+* Print information if required
+*----
+ IF(IPRINT .GE. 5) THEN
+ WRITE(IOUT,'(3(A12,8X))') 'Region # ','VOLUMES ',
+ > 'MATCOD '
+ WRITE(IOUT,'(I10,10X,E16.7,4X,I8)')
+ > (IR,VOL(IR),MAT(IR),IR=1,NR)
+ ENDIF
+*--------
+* Step 2:
+* Recover library informations
+* a) ENERGY GROUP BOUNDARIES
+* b) MIXTURE ASSOCIATED WITH ISOTOPE
+* c) ISOTOPES ALIAS
+* d) ISOTOPES DENSITIES
+*----
+ ENERG(:NG+1)=0.0
+ CALL LCMGET(IPLIB,'ENERGY',ENERG)
+*----
+ MELISO(:NI)=0
+ CALL LCMGET(IPLIB,'ISOTOPESMIX',MELISO)
+*----
+ CALL LCMGET(IPLIB,'ISOTOPESUSED',NAMISO)
+*----
+ DENISO(:NI)=0.0
+ CALL LCMGET(IPLIB,'ISOTOPESDENS',DENISO)
+*----
+* Scan library to determine number of sensitivity profiles:
+* NIC is number of independent isotopes
+* ISOC is the independent isotope number associated with
+* each isotope/mixture
+* NAMISC is the independent isotope name
+*----
+ CALL SENCNT(IPLIB,NI,NAMISO,MELISO,
+ > NSENS,NSENI,NAMISC,ISOC,NIC)
+ IF(IPRINT.GE.1) THEN
+ WRITE(IOUT,6000) NSENS+NSENI,NSENI
+ ENDIF
+*----
+* Print information if required
+*----
+ IF(IPRINT .GE. 5) THEN
+ WRITE(IOUT,'(A12)') 'ENERGY '
+ WRITE(IOUT,'(5E14.6)') (ENERG(IG),IG=1,NG+1)
+ WRITE(IOUT,'(6(A12,8X))') 'Isotope # ','ISOTOPESMIX ',
+ > 'ISOTOPESUSED','ISOTOPESDENS',
+ > 'Name Int Sen','IsoComb '
+ WRITE(IOUT,'(I8,12X,I8,12X,3A4,8X,E16.7,4X,2A4,12X,I8)')
+ > (II,MELISO(II),NAMISO(1,II),NAMISO(2,II),NAMISO(3,II),
+ > DENISO(II),NAMISC(1,ABS(ISOC(II))),NAMISC(2,ABS(ISOC(II))),
+ > ISOC(II),II=1,NI)
+ ENDIF
+*--------
+* Step 3:
+* Recover K-effective, flux and adjoint,
+* and compute integrated flux.
+*----
+ KEFF=0
+ CALL LCMGET(IPFLUX,'K-EFFECTIVE',KEFF)
+*----
+ FLUXI(:NR,:NLTERM,:NG)=0.0
+ AFLUX(:NR,:NLTERM,:NG)=0.0
+ CALL LCMLEN(IPFLUX,'FLUX',ILON,ITYLCM)
+ IF(ILON.EQ.0) CALL XABORT(NAMSBR//': MISSING FLUX INFO.')
+ JPFLUX=LCMGID(IPFLUX,'FLUX')
+ DO IG=1,NG
+ CALL LCMGDL(JPFLUX,IG,SOLFLU)
+ KL=0
+ KKEYL=0
+ DO IL=1,NANIS
+ DO IM=1,IL ! 2*IL-1 in 3D
+ KL=KL+1
+ DO IR=1,NR
+ FLUXI(IR,KL,IG)=SOLFLU(KEY(IR+KKEYL))*VOL(IR)
+ ENDDO
+ KKEYL=KKEYL+NR
+ ENDDO
+ ENDDO
+ ENDDO
+ CALL LCMLEN(IPAFLUX,'AFLUX',ILON,ITYLCM)
+ IF(ILON.EQ.0) CALL XABORT(NAMSBR//': MISSING AFLUX INFO.')
+ JPAFLUX=LCMGID(IPAFLUX,'AFLUX')
+ DO IG=1,NG
+ CALL LCMGDL(JPAFLUX,IG,SOLFLU)
+ KL=0
+ KKEYL=0
+ DO IL=1,NANIS
+ DO IM=1,IL ! 2*IL-1 in 3D
+ KL=KL+1
+ DO IR=1,NR
+ AFLUX(IR,KL,IG)=SOLFLU(KEY(IR+KKEYL))
+ ENDDO
+ KKEYL=KKEYL+NR
+ ENDDO
+ ENDDO
+ ENDDO
+*--------
+* Step 4:
+* Computation of the P matrix used for sensitivity calculation
+*----
+ P(:NR,:NANIS,:NG,:NG)=0.0
+ DO IG=1,NG
+ DO JG=1,NG
+ KL=0
+ DO IL=1,NANIS
+ DO IM=1,IL ! 2*IL-1 en 3D
+ KL=KL+1
+ DO IR=1,NR
+ P(IR,IL,IG,JG)=P(IR,IL,IG,JG)+
+ > FLUXI(IR,KL,IG)*AFLUX(IR,KL,JG)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+*--------
+* Step 5:
+* Computation of the D factor
+*----
+ D=0
+ ALLOCATE(IPISO(NI))
+ CALL LIBIPS(IPLIB,NI,IPISO)
+ DO II=1,NI
+ KPISO=IPISO(II) ! set II-th isotope
+ IF(.NOT.C_ASSOCIATED(KPISO)) THEN
+ WRITE(ISONAM,'(3A4)') NAMISO(1,II),NAMISO(2,II),NAMISO(3,II)
+ WRITE(HSMG,'(17HSENDRV: ISOTOPE '',A12,7H'' (ISO=,I8,5H) IS ,
+ 1 30HNOT AVAILABLE IN THE MICROLIB.)') ISONAM,II
+ CALL XABORT(HSMG)
+ ENDIF
+ CALL LCMLEN(KPISO,'NUSIGF',ILENG,ITYLCM)
+ IF(ILENG.GT.0) THEN
+ NUSIGF(:NG)=0.0
+ CHI(:NG)=0.0
+ CALL LCMGET(KPISO,'NUSIGF',NUSIGF)
+ CALL LCMGET(KPISO,'CHI',CHI)
+ DO IR=1,NR
+ IF(MAT(IR).EQ.MELISO(II)) THEN
+ DO IG=1,NG
+ DO JG=1,NG
+ D=D+FLUXI(IR,1,IG)*DENISO(II)
+ > *NUSIGF(IG)*CHI(JG)*AFLUX(IR,1,JG)
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ DEALLOCATE(IPISO)
+*--------
+* Step 6:
+* Initialize the top of the .sdf file
+*----
+ WRITE(IPSENS,7000) NG,NSENS+NSENI,NSENI,KEFF
+ WRITE(IPSENS,7001)
+ WRITE(IPSENS,7002) (ENERG(IG),IG=1,NG+1)
+*--------
+* Step 7:
+* Sensitivity analysis for each isotope/mixture
+*----
+ CALL SENCAL(IPSENS,IPLIB,IPRINT,NR,NG,NI,NANIS,NAMISO,MELISO,
+ > MAT,DENISO,KEFF,P,D,NAMISC,ISOC,NIC)
+*--------
+* Step 9:
+* Finish the creation of the .sdf file
+*----
+ CALL KDRVER(REV,DATE)
+ WRITE(IPSENS,7010) REV,DATE
+*----
+* Scratch storage deallocation
+*----
+ DEALLOCATE(CHI,NUSIGF,P,AFLUX,FLUXI,SOLFLU,DENISO,ENERG,VOL)
+ DEALLOCATE(ISOC,NAMISC,NAMISO,MELISO,KEY,MAT)
+ RETURN
+*----
+* Formats
+*----
+ 6000 FORMAT('Total number of profils (reactions,isotopes,mixtures) :',
+ >5X,I10/'Total number of integrated profiles ',
+ >'(reactions,isotopes) :',3X,I10)
+ 7000 FORMAT(
+ >I10,3X,'number of neutron groups'/
+ >I10,3X,'number of sensitivity profiles ',
+ >I10,3X,'are region integrated'/
+ >F10.6,3X,'k-eff from the forward case')
+ 7001 FORMAT('energy boundaries:')
+ 7002 FORMAT(1P,5E14.6)
+ 7010 FORMAT(//1X,'file verification information'/
+ >1X,'code system: DRAGON'/
+ >1X,'Version: ',A48/
+ >1X,'program: SENS:'/
+ >3X,'creation date: ',A64/
+ >3X,'library: UNKWNOW'/
+ >3X,'this is not a scale configuration controlled code')
+ END
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 15:14:45 +0000