From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001
From: stainer_t <thomas.stainer@oecd-nea.org>
Date: Mon, 8 Sep 2025 13:48:49 +0200
Subject: Initial commit from Polytechnique Montreal

---
 Dragon/src/MCGTRK.f | 72 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 72 insertions(+)
 create mode 100644 Dragon/src/MCGTRK.f

(limited to 'Dragon/src/MCGTRK.f')

diff --git a/Dragon/src/MCGTRK.f b/Dragon/src/MCGTRK.f
new file mode 100644
index 0000000..5a0d57a
--- /dev/null
+++ b/Dragon/src/MCGTRK.f
@@ -0,0 +1,72 @@
+*DECK MCGTRK
+      SUBROUTINE MCGTRK(NFI,NZON,NSEG,NOM,H)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose: 
+* Unfold a tracking line (MOCC) for connection matrices.
+*
+*Copyright:
+* Copyright (C) 2002 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): R. Le Tellier
+*
+*Parameters: output
+* NFI     number of regions (volumes and surfaces).
+* NZON    index-number of the mixture type assigned to each volume.
+*Parameters: input/output
+* NSEG    number of segment of this track folded/unfolded.
+* NOM     segment index array of this track folded/unfolded.
+* H       segment length array of this track folded/unfolded.
+*
+*Comments:
+*   Preconditioner calculation.
+*   ex: -5 2 3 1 -4 -4 2 1 -1 -1 1 -5
+*        r        v  v      r  r    r
+*   -->    2 3 1 -4    2 1
+*   where r stands for reflective boundary condition,
+*         v     \\     void             \\          .
+* 
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER NFI,NZON(NFI),NSEG,NOM(NSEG)
+      DOUBLE PRECISION H(NSEG)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER IBCV
+      PARAMETER(IBCV=-7)
+      INTEGER I,IP,NOMI,NZI
+*----
+      I=1
+      IP=0
+      DO WHILE (I.LE.NSEG)
+         NOMI=NOM(I)
+         NZI=NZON(NOMI)
+         IF ((NZI.GE.0).OR.(NZI.EQ.IBCV)) THEN
+*        this cell is a volume or a voided boundary
+            IF ((IP.GE.1).AND.(NOM(IP).EQ.NOMI)) THEN
+               H(IP)=H(IP)+H(I)
+            ELSE
+               IP=IP+1
+               NOM(IP)=NOM(I)
+               H(IP)=H(I)
+            ENDIF
+         ENDIF
+         I=I+1
+      ENDDO
+      IF ((NOM(IP).EQ.NOM(1)).AND.(IP.GT.1)) THEN
+         H(1)=H(1)+H(IP)
+         IP=IP-1
+      ENDIF
+      NSEG=IP
+*     
+      RETURN
+      END
-- 
cgit v1.2.3