diff options
Diffstat (limited to 'Dragon/src/SEN.f')
| -rw-r--r-- | Dragon/src/SEN.f | 206 |
1 files changed, 206 insertions, 0 deletions
diff --git a/Dragon/src/SEN.f b/Dragon/src/SEN.f new file mode 100644 index 0000000..8c93411 --- /dev/null +++ b/Dragon/src/SEN.f @@ -0,0 +1,206 @@ +*DECK SEN + SUBROUTINE SEN(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY) +* +*----------------------------------------------------------------------- +* +*Purpose: +* To create sensitivity profiles to cross-section on the reactivity +* using first order perturbation method based on 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 +* NENTRY number of LCM objects or files used by the operator. +* HENTRY name of each LCM object or file: +* HENTRY(1) create or modification type(L_SENS); +* HENTRY(2) read-only type(L_MACROLIB or L_LIBRARY); +* HENTRY(3) read-only type(L_TRACK); +* HENTRY(4) read-only type(L_FLUX); +* HENTRY(5) read only type(L_AFLUX). +* IENTRY type of each LCM object or file: +* =1 LCM memory object; =2 XSM file; =3 sequential binary file; +* =4 sequential ascii file. +* JENTRY access of each LCM object or file: +* =0 the LCM object or file is created; +* =1 the LCM object or file is open for modifications; +* =2 the LCM object or file is open in read-only mode. +* KENTRY LCM object address or file unit number. +* +*Comments: +* Call format: +* File.sdf := SENS: Flux Adjoint Biblio Track +* :: [ EDIT iprint ANIS nanis ] ; +* with +* File.sdf = sdf (SEQ_ASCII) file in creation mode +* Flux = Flux (LINKED_LIST or XSM_FILE) in read only mode +* Adjoint = Adjoint (LINKED_LIST or XSM_FILE) in read only mode +* Biblio = Biblio (LINKED_LIST or XSM_FILE) in read only mode +* Track = Track (LINKED_LIST or XSM_FILE) in read only mode +* +*----------------------------------------------------------------------- +* + USE GANLIB + IMPLICIT NONE +*---- +* Routine arguments +*---- + INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY) + TYPE(C_PTR) KENTRY(NENTRY) + CHARACTER HENTRY(NENTRY)*12 +*---- +* Parameters +*---- + INTEGER NCAR,NSTATE,IOUT + CHARACTER NAMSBR*6,HSIGN*12,SDF*12 + PARAMETER (NSTATE=40,IOUT=6,NAMSBR='SEN ') + PARAMETER (NCAR=3) +*---- +* Local variables +*---- + TYPE(C_PTR) IPLIB,IPTRACK,IPFLUX,IPAFLUX + INTEGER IPSENS,NR,NU,NM,NI,NG,NGD,NGA,NUD,NUA,NMT,NL,IFMT + INTEGER I,IEN,ISDF,IADJ,ITYPE,ISTATE(NSTATE),IPRINT, + > NANIS,NLTERM +*---- +* Verify if call format is adequate +*---- + IF(NENTRY .NE. 5) CALL XABORT(NAMSBR// + > ': FIVE data structure EXPECTED.') +*---- +* First data structure .sdf file +*---- + IEN=1 + IF(IENTRY(IEN) .NE. 4 ) CALL XABORT(NAMSBR// + > ': SEQ_ASCII format expected for .sdf file') + IF(JENTRY(IEN) .NE. 0 ) CALL XABORT(NAMSBR// + > ': .sdf file must be in creation mode') + SDF=HENTRY(IEN) + ISDF=0 + DO I=1,9 + IF(SDF(I:I+3).EQ.'.sdf') ISDF=1 + ENDDO + IF(ISDF.NE.1) CALL XABORT(NAMSBR// + > ': The extension of the first structure has be ".sdf"') + IPSENS=FILUNIT(KENTRY(IEN)) +*---- +* Process the other 4 data structures (arbitrary order) +*---- + IPLIB=C_NULL_PTR + IPTRACK=C_NULL_PTR + IPFLUX=C_NULL_PTR + IPAFLUX=C_NULL_PTR + NUD=0 + NUA=0 + NMT=0 + NGD=0 + NGA=0 + DO IEN=2,5 + IF((IENTRY(IEN).NE.1).AND.(IENTRY(IEN).NE.2)) + > CALL XABORT(NAMSBR// + > ': LINKED_LIST or XSM_FILE expected') + IF(JENTRY(IEN).NE.2) CALL XABORT(NAMSBR// + > ': data structure must be in READ_ONLY mode') + CALL LCMGTC(KENTRY(IEN),'SIGNATURE',12,HSIGN) + IF(HSIGN.EQ.'L_FLUX') THEN + CALL LCMGET(KENTRY(IEN),'STATE-VECTOR',ISTATE) + ITYPE=ISTATE(3) + IF((ITYPE.NE.1).AND.(ITYPE.NE.10)) CALL XABORT(NAMSBR// + > ': Keff problem required') + IADJ=MOD(ISTATE(3)/10,10) + IF(IADJ .EQ. 1) THEN + IPAFLUX=KENTRY(IEN) + NGA=ISTATE(1) + NUA=ISTATE(2) + ELSE + IPFLUX=KENTRY(IEN) + NGD=ISTATE(1) + NUD=ISTATE(2) + ENDIF + ELSE IF(HSIGN.EQ.'L_TRACK') THEN + CALL LCMGET(KENTRY(IEN),'STATE-VECTOR',ISTATE) + IPTRACK=KENTRY(IEN) + NR=ISTATE(1) + NU=ISTATE(2) + NMT=ISTATE(4) + ELSE IF(HSIGN.EQ.'L_LIBRARY') THEN + CALL LCMGET(KENTRY(IEN),'STATE-VECTOR',ISTATE) + IPLIB=KENTRY(IEN) + NM=ISTATE(1) + NI=ISTATE(2) + NG=ISTATE(3) + NL=ISTATE(4) + IFMT=ISTATE(5) + ELSE + CALL XABORT(NAMSBR//': '//HSIGN//' is an invalid signature ') + ENDIF + ENDDO +*---- +* Test if all data structures required are available +*---- + IF(.NOT.C_ASSOCIATED(IPLIB)) CALL XABORT(NAMSBR// + > ': No microlib data structure found') + IF(.NOT.C_ASSOCIATED(IPTRACK)) CALL XABORT(NAMSBR// + > ': No tracking data structure found') + IF(.NOT.C_ASSOCIATED(IPFLUX)) CALL XABORT(NAMSBR// + > ': No direct flux data structure found') + IF(.NOT.C_ASSOCIATED(IPAFLUX)) CALL XABORT(NAMSBR// + > ': No adjoint flux data structure found') +*---- +* Test if parameters are compatibles +* NR Number of region in Tracking object. +* NU Number of unkwnow in Tracking/Flux objects. +* NM Number of mixture in Library object. +* NI Number of isotopes in Library object. +* NG Number of energy group in Library object. +*---- + IF(NGD .NE. NG) CALL XABORT(NAMSBR// + > ': Number of groups in flux and microlib not identical') + IF(NGA .NE. NG) CALL XABORT(NAMSBR// + > ': Number of groups in adjoint and microlib not identical') + IF(NUD .NE. NU) CALL XABORT(NAMSBR// + > ': Number of unknowns in flux and tracking not identical') + IF(NUA .NE. NU) CALL XABORT(NAMSBR// + > ': Number of unknowns in adjoint and tracking not identical') + IF(NMT .GT. NM) CALL XABORT(NAMSBR// + > ': Number of mixtures in tracking larger that microlib') +*---- +* Read input parameters +*---- + NANIS=1 + CALL SENGET(IPRINT,NL,NANIS) + IF(IPRINT .GE. 1) THEN + WRITE(IOUT,6000) NG,NR,NU,NM,NI,NL,NANIS + ENDIF +*---- +* Launch sensitivity analysis main routine. +*---- +* ! A 1D calculation have to use NANIS=1 +* IF(NDIM .EQ. 3) THEN ! It is necessary to introduce the parameter NDIM +* NLTERM=NANIS*NANIS ! 3D calculation +* ELSEIF(NDIM .EQ. 2) THEN + NLTERM=(NANIS*(NANIS+1))/2 ! 2D calculation +* ELSE +* NLTERM=NANIS ! 1D calculation +* ENDIF + CALL SENDRV(IPSENS,IPTRACK,IPLIB,IPFLUX,IPAFLUX,IPRINT, + > NR,NU,NI,NG,NANIS,NLTERM) + RETURN +*---- +* Format +*---- + 6000 FORMAT(' Number of groups =',I10/ + > ' Number of regions =',I10/ + > ' Number of unknowns =',I10/ + > ' Maximum number of mixtures =',I10/ + > ' Number of isotopes =',I10/ + > ' Number anisotropy order =',I10/ + > ' Anisotropy order kept =',I10) + END |