summaryrefslogtreecommitdiff
path: root/Trivac/src/FLDREL.f
diff options
context:
space:
mode:
Diffstat (limited to 'Trivac/src/FLDREL.f')
-rwxr-xr-xTrivac/src/FLDREL.f51
1 files changed, 51 insertions, 0 deletions
diff --git a/Trivac/src/FLDREL.f b/Trivac/src/FLDREL.f
new file mode 100755
index 0000000..b59dafd
--- /dev/null
+++ b/Trivac/src/FLDREL.f
@@ -0,0 +1,51 @@
+*DECK FLDREL
+ SUBROUTINE FLDREL(RELAX,IPLIST,NGRP,NUN,ARRAY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Relaxation procedure for flux distribution information.
+*
+*Copyright:
+* Copyright (C) 2014 Ecole Polytechnique de Montreal.
+*
+*Author(s): A. Hebert
+*
+*Parameters: input
+* RELAX relaxation factor
+* IPLIST pointer to object information.
+* NGRP number of energy groups
+* NUN number of unknowns per energy group
+* ARRAY real record to relax
+*
+*Parameters: output
+* ARRAY real record after relaxation
+*
+*-----------------------------------------------------------------------
+*
+ USE GANLIB
+*----
+* SUBROUTINE ARGUMENTS
+*----
+ TYPE(C_PTR) IPLIST
+ INTEGER NGRP,NUN
+ REAL RELAX,ARRAY(NUN,NGRP)
+*----
+* LOCAL VARIABLES
+*----
+ INTEGER IGR,IUN,ILONG,ITYLCM
+ REAL, ALLOCATABLE, DIMENSION(:) :: ARRAY0
+*
+ IF(RELAX.EQ.1.0) RETURN
+ ALLOCATE(ARRAY0(NUN))
+ DO IGR=1,NGRP
+ CALL LCMLEL(IPLIST,IGR,ILONG,ITYLCM)
+ IF(ILONG.NE.NUN) CALL XABORT('FLDREL: UNABLE TO RELAX.')
+ CALL LCMGDL(IPLIST,IGR,ARRAY0)
+ DO IUN=1,NUN
+ ARRAY(IUN,IGR)=RELAX*ARRAY(IUN,IGR)+(1.0-RELAX)*ARRAY0(IUN)
+ ENDDO
+ ENDDO
+ DEALLOCATE(ARRAY0)
+ RETURN
+ END