diff options
Diffstat (limited to 'Dragon/src/USSIT3.f')
| -rw-r--r-- | Dragon/src/USSIT3.f | 466 |
1 files changed, 466 insertions, 0 deletions
diff --git a/Dragon/src/USSIT3.f b/Dragon/src/USSIT3.f new file mode 100644 index 0000000..32c1e41 --- /dev/null +++ b/Dragon/src/USSIT3.f @@ -0,0 +1,466 @@ +*DECK USSIT3 + SUBROUTINE USSIT3(MAXNOR,NGRP,MASKG,IRES,IPLI0,IPTRK,IFTRAK,CDOOR, + 1 IMPX,NBMIX,NREG,NUN,IPHASE,MAXST,MAT,VOL,KEYFLX,LEAKSW,IREX, + 2 SIGGAR,TITR,ICORR,NIRES,NBNRS,CONR,GOLD,IPPT1,IPPT2,VOLMER, + 3 UNGAR) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Compute the snapshot weights as required by the resonance spectrum +* expansion (RSE) method: +* a) assume a single resonant isotope; +* b) use the standard solution doors of Dragon. +* +*Copyright: +* Copyright (C) 2023 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): A. Hebert +* +*Parameters: input +* MAXNOR maximum number of base points. +* NGRP number of energy group. +* MASKG energy group mask pointing on self-shielded groups. +* IRES index of the resonant isotope. +* IPLI0 pointer to the internal microscopic cross section library +* builded by the self-shielding module. +* IPTRK pointer to the tracking (L_TRACK signature). +* IFTRAK file unit number used to store the tracks. +* CDOOR name of the geometry/solution operator. +* IMPX print flag (equal to zero for no print). +* NBMIX number of mixtures in the internal library. +* NREG number of regions. +* NUN number of unknowns in the flux or source vector in one +* energy group and one band. +* IPHASE type of flux solution (=1 use a native flux solution door; +* =2 use collision probabilities). +* MAXST maximum number of fixed point iterations for the ST scattering +* source. +* MAT index-number of the mixture type assigned to each volume. +* VOL volumes. +* KEYFLX pointers of fluxes in unknown vector. +* LEAKSW leakage switch (LEAKSW=.TRUE. if neutron leakage through +* external boundary is present). +* IREX fuel region index assigned to each mixture. Equal to zero +* in non-resonant mixtures or in mixtures not used. +* SIGGAR macroscopic x-s of the non-resonant isotopes in each mixture: +* (*,*,*,1) total; (*,*,*,2) transport correction; +* (*,*,*,3) P0 scattering. +* TITR title. +* ICORR mutual resonance shielding flag (=1 to suppress the model +* in cases it is required in LIB operator). +* NIRES exact number of correlated resonant isotopes. +* NBNRS number of correlated fuel regions. +* CONR number density of the resonant isotopes. +* GOLD type of self-shielding model (=1.0 physical probability +* tables; =-1001.0 resonance spectrum expansion method). +* IPPT1 pointer to LCM directory of each resonant isotope. +* IPPT2 information related to each resonant isotope: +* IPPT2(:,1) index of a resonant region (used with infinite +* dilution case); +* IPPT2(:,2:4) alias name of resonant isotope. +* VOLMER volumes of the resonant regions. +* +*Parameters: output +* UNGAR averaged flux unknowns. +* +*----------------------------------------------------------------------- +* + USE GANLIB + USE DOORS_MOD +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPLI0,IPTRK,IPPT1(NIRES) + INTEGER MAXNOR,NGRP,IRES,IFTRAK,IMPX,NBMIX,NREG,NUN,IPHASE, + 1 MAXST,MAT(NREG),KEYFLX(NREG),IREX(NBMIX),ICORR,NIRES,NBNRS, + 2 IPPT2(NIRES,4) + REAL VOL(NREG),SIGGAR(NBMIX,0:NIRES,NGRP,3),CONR(NBNRS,NIRES), + 1 GOLD(NIRES,NGRP),VOLMER(0:NBNRS),UNGAR(NUN,NIRES,NGRP) + CHARACTER CDOOR*12,TITR*72 + LOGICAL LEAKSW,MASKG(NGRP) +*---- +* LOCAL VARIABLES +*---- + REAL ERR1,ERR2 + DOUBLE PRECISION T1 + CHARACTER CBDPNM*12,TEXT12*12 + LOGICAL LEXAC,REBFLG,LSOUR + TYPE(C_PTR) IPLIB,JPLI0,JPLIB1,KPLIB,IPSYS,KPSYS,IOFSET, + 1 IPMACR,IPSOU +*---- +* ALLOCATABLE ARRAYS +*---- + TYPE(C_PTR), ALLOCATABLE, DIMENSION(:) :: JPLIB2,JPLIB3 + INTEGER, ALLOCATABLE, DIMENSION(:) :: NPSYS,MRANK + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NJJ + REAL, ALLOCATABLE, DIMENSION(:) :: SIGTXS,SIGS0X,SIGG + REAL, ALLOCATABLE, DIMENSION(:,:) :: FUN,SUN + REAL, ALLOCATABLE, DIMENSION(:,:,:) :: XFLUX2 + TYPE VECTOR_ARRAY + DOUBLE PRECISION, POINTER, DIMENSION(:) :: VECTOR + END TYPE VECTOR_ARRAY + TYPE MATRIX_ARRAY + DOUBLE PRECISION, POINTER, DIMENSION(:,:) :: MATRIX + END TYPE MATRIX_ARRAY + TYPE(VECTOR_ARRAY), ALLOCATABLE, DIMENSION(:) :: SIGT_V,WEIGHT_V, + 1 GAMMA_V + TYPE(MATRIX_ARRAY), ALLOCATABLE, DIMENSION(:,:) :: SIGT_M + TYPE(MATRIX_ARRAY), ALLOCATABLE, DIMENSION(:,:,:) :: SCAT_M + TYPE MATRIX_ARRAY_SP + REAL, POINTER, DIMENSION(:,:) :: MATRIX + END TYPE MATRIX_ARRAY_SP + TYPE(MATRIX_ARRAY_SP), ALLOCATABLE, DIMENSION(:) :: PSI_M +*---- +* SCRATCH STORAGE ALLOCATION +*---- + ALLOCATE(JPLIB2(NIRES),JPLIB3(NIRES)) + ALLOCATE(NJJ(NGRP,NIRES),NPSYS(MAXNOR*NGRP),MRANK(NGRP)) + ALLOCATE(SIGT_V(NGRP),SIGT_M(NGRP,NIRES),SCAT_M(NGRP,NGRP,NIRES), + 1 WEIGHT_V(NGRP),GAMMA_V(NGRP),PSI_M(NGRP)) +*---- +* FIND THE NUMBER OF COMPONENTS REQUIRED AND ALLOCATE THE LIST OF +* ASSEMBLY MATRICES. +*---- + IPLIB=IPPT1(IRES) + CALL LCMLEN(IPLIB,'NOR',ILONG,ITYLCM) + IF(ILONG.NE.NGRP) THEN + CALL LCMLIB(IPLIB) + CALL XABORT('USSIT3: RANK ARRAY MISSING.') + ENDIF + CALL LCMGET(IPLIB,'NOR',MRANK) + NASM=0 + DO IG=1,NGRP + IF(MASKG(IG).AND.(GOLD(IRES,IG).EQ.-1001.)) THEN + NASM=NASM+MRANK(IG) + ENDIF + ENDDO + IF(NASM.EQ.0) GO TO 50 + DO JRES=1,NIRES + DO JG=1,NGRP + DO IG=1,NGRP + NULLIFY(SCAT_M(IG,JG,JRES)%MATRIX) + ENDDO + ENDDO + ENDDO +*---- +* CREATE A SPECIFIC DIRECTORY FOR IRES-TH RESONANT ISOTOPE. +*---- + WRITE(CBDPNM,'(3HCOR,I4.4,1H/,I4.4)') IRES,NIRES + CALL LCMSIX(IPLI0,CBDPNM,1) + JPLI0=LCMGID(IPLI0,'NWT0-PT') + IPSYS=LCMLID(IPLI0,'ASSEMB-RSE',NASM) + CALL LCMSIX(IPLI0,' ',2) +*---- +* RECOVER RSE INFORMATION FROM MICROLIB (PART 1) +*---- + JPLIB1=LCMGID(IPLIB,'GROUP-RSE') + DO JRES=1,NIRES + WRITE(TEXT12,'(3A4)') (IPPT2(JRES,I),I=2,4) + CALL LCMSIX(IPLIB,TEXT12,1) + IF(JRES.NE.IRES) THEN + JPLIB2(JRES)=LCMGID(IPLIB,'SIGT_M') ! holds SIGT_M information + ELSE + JPLIB2(JRES)=C_NULL_PTR + ENDIF + JPLIB3(JRES)=LCMGID(IPLIB,'SCAT_M') ! holds SCAT_M information + CALL LCMGET(IPLIB,'NJJS00',NJJ(:NGRP,JRES)) + CALL LCMSIX(IPLIB,' ',2) + ENDDO + IPOS=1 + DO IG=1,NGRP + IF(.NOT.MASKG(IG).OR.(GOLD(IRES,IG).NE.-1001.)) CYCLE + IF(IMPX.GE.9) WRITE(6,'(22H USSIT3: energy group=,I8)') IG +*---- +* RECOVER RSE INFORMATION FROM MICROLIB (PART 2) +*---- + MI=MRANK(IG) + KPLIB=LCMGIL(JPLIB1,IG) + CALL LCMLEN(KPLIB,'SIGT_V',ILONG,ITYLCM) + IF(ILONG.GT.MAXNOR) CALL XABORT('USSIT3: MAXNOR OVERFLOW.') + CALL LCMGPD(KPLIB,'SIGT_V',IOFSET) + CALL C_F_POINTER(IOFSET,SIGT_V(IG)%VECTOR,(/MI/)) + CALL LCMGPD(KPLIB,'WEIGHT_V',IOFSET) + CALL C_F_POINTER(IOFSET,WEIGHT_V(IG)%VECTOR,(/MI/)) + CALL LCMGPD(KPLIB,'GAMMA_V',IOFSET) + CALL C_F_POINTER(IOFSET,GAMMA_V(IG)%VECTOR,(/MI/)) + DO JRES=1,NIRES + IF(JRES.NE.IRES) THEN + CALL LCMGPL(JPLIB2(JRES),IG,IOFSET) + CALL C_F_POINTER(IOFSET,SIGT_M(IG,JRES)%MATRIX,(/MI,MI/)) + ENDIF + IPOS=1 + DO JG=1,IG-1 + IPOS=IPOS+NJJ(JG,JRES) + ENDDO + DO JG=IG-NJJ(IG,JRES)+1,IG + MJ=MRANK(JG) + CALL LCMGPL(JPLIB3(JRES),IPOS+IG-JG,IOFSET) + CALL C_F_POINTER(IOFSET,SCAT_M(IG,JG,JRES)%MATRIX,(/MI,MJ/)) + ENDDO + ENDDO + ENDDO +*---- +* INITIALIZE THE SUBGROUP FLUX WITH FUNKNO$USS INFORMATION +*---- + IASM=0 + DO IG=1,NGRP + IF(.NOT.MASKG(IG).OR.(GOLD(IRES,IG).NE.-1001.)) CYCLE + MI=MRANK(IG) + ALLOCATE(PSI_M(IG)%MATRIX(NUN,MI)) + DO IM=1,MI + CALL LCMLEL(IPSYS,IASM+IM,ILONG,ITYLCM) + IF(ILONG.EQ.-1) THEN + KPSYS=LCMGIL(IPSYS,IASM+IM) + CALL LCMGET(KPSYS,'FUNKNO$USS',PSI_M(IG)%MATRIX(:NUN,IM)) + ELSE + PSI_M(IG)%MATRIX(:NUN,IM)=REAL(GAMMA_V(IG)%VECTOR(IM)) + ENDIF + ENDDO +*---- +* COMPUTE GROUPWISE MACROSCOPIC CROSS SECTIONS. +*---- + ALLOCATE(SIGTXS(0:NBMIX),SIGS0X(0:NBMIX)) + DO IM=1,MI + SIGTXS(0:NBMIX)=0.0 + SIGS0X(0:NBMIX)=0.0 + DO IBM=1,NBMIX + IND=IREX(IBM) + DO 10 JRES=0,NIRES + IF(JRES.EQ.0) THEN +* ADMIXED NON-RESONANT ISOTOPES. + SIGTXS(IBM)=SIGTXS(IBM)+(SIGGAR(IBM,0,IG,1)- + 1 SIGGAR(IBM,0,IG,2)) + SIGS0X(IBM)=SIGS0X(IBM)-SIGGAR(IBM,0,IG,2) + ELSE IF((JRES.NE.IRES).AND.(IND.GT.0).AND.(ICORR.EQ.1)) THEN +* ECCO CORRELATION MODEL. + IF((IPPT2(IRES,2).EQ.IPPT2(JRES,2)).AND. + 1 (IPPT2(IRES,3).EQ.IPPT2(JRES,3))) THEN + DENSIT=CONR(IND,JRES) + SIGTXS(IBM)=SIGTXS(IBM)+DENSIT* + 1 REAL(SIGT_V(IG)%VECTOR(IM)) + SIGS0X(IBM)=SIGS0X(IBM)+DENSIT* + 1 REAL(SCAT_M(IG,IG,JRES)%MATRIX(IM,IM)) + ELSE + DENSIT=CONR(IND,JRES) + SIGS0X(IBM)=SIGS0X(IBM)+DENSIT* + 1 REAL(SCAT_M(IG,IG,JRES)%MATRIX(IM,IM)) + ENDIF + ELSE IF((JRES.NE.IRES).AND.(IND.GT.0).AND.(ICORR.EQ.0)) THEN +* MUTUAL SHIELDING MODEL OF CORRELATED RESONANT ISOTOPES. + DENSIT=CONR(IND,JRES) + SIGTXS(IBM)=SIGTXS(IBM)+DENSIT* + 1 REAL(SIGT_M(IG,JRES)%MATRIX(IM,IM)) + SIGS0X(IBM)=SIGS0X(IBM)+DENSIT* + 1 REAL(SCAT_M(IG,IG,JRES)%MATRIX(IM,IM)) + ENDIF + 10 CONTINUE + IF(IND.GT.0) THEN + DENSIT=CONR(IND,IRES) + SIGTXS(IBM)=SIGTXS(IBM)+DENSIT*REAL(SIGT_V(IG)%VECTOR(IM)) + SIGS0X(IBM)=SIGS0X(IBM)+DENSIT* + 1 REAL(SCAT_M(IG,IG,IRES)%MATRIX(IM,IM)) + ENDIF + ENDDO + NPSYS(IASM+IM)=IASM+IM + KPSYS=LCMDIL(IPSYS,IASM+IM) + CALL LCMPUT(KPSYS,'DRAGON-TXSC',NBMIX+1,2,SIGTXS(0)) + CALL LCMPUT(KPSYS,'DRAGON-S0XSC',NBMIX+1,2,SIGS0X(0)) + ENDDO + IASM=IASM+MI + DEALLOCATE(SIGS0X,SIGTXS) + ENDDO +*---- +* ASSEMBLY MATRIX OR REDUCED COLLISION PROBABILITIES CALCULATION. +*---- + NANI=1 + KNORM=1 + NALBP=0 + IMPY=MAX(0,IMPX-3) + IF(IPHASE.EQ.1) THEN +* USE A NATIVE DOOR. + ISTRM=1 + NW=0 + CALL DOORAV(CDOOR,IPSYS,NPSYS,IPTRK,IFTRAK,IMPY,NASM,NREG, + 1 NBMIX,NANI,NW,MAT,VOL,KNORM,LEAKSW,TITR,NALBP,ISTRM) + ELSE IF(IPHASE.EQ.2) THEN +* USE A COLLISION PROBABILITY DOOR. + IPIJK=1 + ITPIJ=1 + CALL DOORPV(CDOOR,IPSYS,NPSYS,IPTRK,IFTRAK,IMPY,NASM,NREG, + 1 NBMIX,NANI,MAT,VOL,KNORM,IPIJK,LEAKSW,ITPIJ,.FALSE.,TITR, + 2 NALBP) + ENDIF +*---- +* LOOP OVER ENERGY GROUPS FOR THE FLUX CALCULATION. +*---- + ALLOCATE(XFLUX2(NBNRS,MAXNOR,NGRP)) + XFLUX2(:NBNRS,:MAXNOR,:NGRP)=0.0 + IASM=0 + DO IG=1,NGRP + MI=MRANK(IG) + IF(.NOT.MASKG(IG).OR.(GOLD(IRES,IG).NE.-1001.)) CYCLE + ITER=0 + 20 ITER=ITER+1 + IF(ITER.GT.MAXST) GO TO 30 + ERR1=0.0 + ERR2=0.0 +*---- +* COMPUTE THE AVERAGED SOURCE TAKING INTO ACCOUNT CORRELATION EFFECTS. +*---- + ALLOCATE(FUN(NUN,MI),SUN(NUN,MI),SIGG(0:NBMIX)) + SUN(:NUN,:MI)=0.0 + DO IM=1,MI + FUN(:NUN,IM)=PSI_M(IG)%MATRIX(:NUN,IM) + NPSYS(IM)=IASM+IM + SIGG(0)=0.0 + DO IBM=1,NBMIX + SIGG(IBM)=REAL(SIGGAR(IBM,0,IG,3)*GAMMA_V(IG)%VECTOR(IM),4) + ENDDO + CALL DOORS(CDOOR,IPTRK,NBMIX,0,NUN,SIGG,SUN(1,IM)) + DO JG=1,IG + DO JM=1,MRANK(JG) + IF((JG.EQ.IG).AND.(JM.EQ.IM)) CYCLE + SIGG(0:NBMIX)=0.0 + LSOUR=.FALSE. + DO IBM=1,NBMIX + IND=IREX(IBM) + IF(IND.LE.0) CYCLE + DO JRES=1,NIRES + DENSIT=CONR(IND,JRES) + IF((JG.EQ.IG).AND.(JRES.NE.IRES)) THEN + ! process off-diagonal terms in SIGT_M(IG,JRES)%MATRIX + LSOUR=.TRUE. + SIGG(IBM)=SIGG(IBM)-REAL(DENSIT* + 1 SIGT_M(IG,JRES)%MATRIX(IM,JM),4) + ENDIF + IF(JG.LT.IG-NJJ(IG,JRES)+1) CYCLE + IF(GOLD(IRES,JG).NE.-1001.) CYCLE + LSOUR=.TRUE. + SIGG(IBM)=SIGG(IBM)+DENSIT*REAL( + 1 SCAT_M(IG,JG,JRES)%MATRIX(IM,JM),4) + ENDDO ! JRES + ENDDO ! IBM + IF(LSOUR) CALL DOORS(CDOOR,IPTRK,NBMIX,0,NUN,SIGG, + 1 SUN(1,IM),PSI_M(JG)%MATRIX(:,JM)) + ENDDO ! JM + ENDDO ! JG + ENDDO ! IM + DEALLOCATE(SIGG) +*---- +* SOLVE FOR THE MULTIBAND FLUX. +*---- + IDIR=0 + LEXAC=.FALSE. + IPMACR=C_NULL_PTR + IPSOU=C_NULL_PTR + REBFLG=.FALSE. + CALL DOORFV(CDOOR,IPSYS,NPSYS,IPTRK,IFTRAK,IMPX,MI,NBMIX,IDIR, + 1 NREG,NUN,IPHASE,LEXAC,MAT,VOL,KEYFLX,TITR,SUN,FUN,IPMACR,IPSOU, + 2 REBFLG) +*---- +* CONVERGENCE CONTROL. +*---- + DO IM=1,MI + KPSYS=LCMGIL(IPSYS,IASM+IM) + CALL LCMPUT(KPSYS,'FUNKNO$USS',NUN,2,FUN(1,IM)) + DO I=1,NREG + IUN=KEYFLX(I) + DELTA=FUN(IUN,IM)-PSI_M(IG)%MATRIX(IUN,IM) + ERR1=MAX(ERR1,ABS(DELTA)) + ERR2=MAX(ERR2,ABS(FUN(IUN,IM))) + ENDDO + PSI_M(IG)%MATRIX(:NUN,IM)=FUN(:NUN,IM) + ENDDO + DEALLOCATE(SUN,FUN) + IF(IMPX.GT.2) THEN + WRITE(TEXT12,'(3A4)') (IPPT2(IRES,I),I=2,4) + WRITE(6,'(15H USSIT3: GROUP=,I5,15H. RSE ITERATION,I4, + 1 11H. ISOTOPE='',A12,9H''. ERROR=,1P,E11.4,1H.)') IG, + 2 ITER,TEXT12,ERR1 + ENDIF + IF(ERR1.GT.1.0E5) GO TO 30 + IF(ERR1.GT.1.0E-4*ERR2) GO TO 20 + IF(IMPX.GT.1) THEN + WRITE(TEXT12,'(3A4)') (IPPT2(IRES,I),I=2,4) + WRITE(6,'(15H USSIT3: GROUP=,I5,24H. RSE ITERATION CONVERGE, + 1 6HNCE IN,I4,22H ITERATIONS. ISOTOPE='',A12,2H''.)') IG, + 2 ITER,TEXT12 + ENDIF +*---- +* COMPUTE XFLUX2 FOR IRES IN GROUP IG. +*---- + XFLUX2(:NBNRS,:MI,IG)=0.0 + DO I=1,NREG + IF(MAT(I).EQ.0) CYCLE + IND=IREX(MAT(I)) + IF(IND.EQ.0) CYCLE + IUN=KEYFLX(I) + DO IM=1,MI + XFLUX2(IND,IM,IG)=XFLUX2(IND,IM,IG)+VOL(I)* + 1 PSI_M(IG)%MATRIX(IUN,IM) + ENDDO + ENDDO + DO IM=1,MI + DO IND=1,NBNRS + XFLUX2(IND,IM,IG)=XFLUX2(IND,IM,IG)/VOLMER(IND) + ENDDO + ENDDO +*---- +* USE SNAPSHOT WEIGHTS TO AVERAGE SUBGROUP FLUX UNKNOWNS. +*---- + UNGAR(:NUN,IRES,IG)=0.0 + DO IUN=1,NUN + DO IM=1,MI + UNGAR(IUN,IRES,IG)=UNGAR(IUN,IRES,IG)+ + 1 REAL(WEIGHT_V(IG)%VECTOR(IM)*PSI_M(IG)%MATRIX(IUN,IM),4) + ENDDO + ENDDO + GO TO 40 +*---- +* ALTERNATIVE TREATMENT IN CASE OF FAILURE OF FIXED POINT ITERATIONS. +* USE A NON-ITERATIVE RESPONSE MATRIX APPROACH. +*---- + 30 IF(IMPX.GT.0) THEN + WRITE(TEXT12,'(3A4)') (IPPT2(IRES,I),I=2,4) + WRITE(6,'(15H USSIT3: GROUP=,I5,24H. SUBGROUP ITERATION FAI, + 1 16HLED FOR ISOTOPE ,A12,32H. USE AN ALTERNATIVE RESPONSE MA, + 2 14HTRIX APPROACH.)') IG,TEXT12 + ENDIF + CALL USSEXD(MAXNOR,CDOOR,IPLI0,IPTRK,IFTRAK,IMPX,NGRP,IG,IASM, + 1 NBMIX,NREG,NUN,IPHASE,MAT,VOL,KEYFLX,IREX,SIGGAR,TITR,NIRES, + 2 IRES,NBNRS,MRANK,CONR,GOLD,IPPT1,IPPT2,VOLMER,XFLUX2,UNGAR) +*---- +* SAVE XFLUX2 FOR IRES IN GROUP IG. +*---- + 40 CALL LCMPDL(JPLI0,IG,NBNRS*MI,2,XFLUX2(1,1,IG)) + IF(IMPX.GT.2) THEN + DO IND=1,NBNRS + T1=0.0D0 + DO IM=1,MI + T1=T1+WEIGHT_V(IG)%VECTOR(IM)*XFLUX2(IND,IM,IG) + ENDDO + WRITE(6,'(31H USSIT3: AVERAGED FLUX IN GROUP,I4,9H AND RESO, + 1 11HNANT REGION,I4,21H FOR RESONANT ISOTOPE,I4,2H =,F9.5)') + 2 IG,IND,IRES,T1 + ENDDO + ENDIF + IASM=IASM+MI + ENDDO +*---- +* SCRATCH STORAGE DEALLOCATION. +*---- + DEALLOCATE(XFLUX2) + DO IG=1,NGRP + IF(.NOT.MASKG(IG).OR.(GOLD(IRES,IG).NE.-1001.)) CYCLE + DEALLOCATE(PSI_M(IG)%MATRIX) + ENDDO + 50 DEALLOCATE(PSI_M,GAMMA_V,WEIGHT_V,SCAT_M,SIGT_M,SIGT_V) + DEALLOCATE(MRANK,NPSYS,NJJ) + DEALLOCATE(JPLIB3,JPLIB2) + RETURN + END |