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

---
 Donjon/src/TINSTB.f | 152 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 152 insertions(+)
 create mode 100644 Donjon/src/TINSTB.f

(limited to 'Donjon/src/TINSTB.f')

diff --git a/Donjon/src/TINSTB.f b/Donjon/src/TINSTB.f
new file mode 100644
index 0000000..48c54db
--- /dev/null
+++ b/Donjon/src/TINSTB.f
@@ -0,0 +1,152 @@
+*DECK TINSTB
+      SUBROUTINE TINSTB(IPMAP,TIME,BURNSTP,NCH,NB,NF,BUNDPOW,BURNAVG,
+     1 BURNINS,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute new burnup for each bundle given either an average burnup step
+* or a burning time
+*
+*Copyright:
+* Copyright (C) 2009 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* B. Toueg
+*
+*Parameters: input/output
+* IPMAP   pointer to fuel-map information.
+* TIME    time to burn
+* BURNSTP average burnup step
+* NCH     number of reactor channels.
+* NB      number of fuel bundles.
+* NF      number of fuel types.
+* BUNDPOW bundle powers.
+* BURNAVG average burnup.
+* BURNINS instantaneous burnups.
+* IMPX    printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER NCH,NB,NF,IMPX
+      REAL BUNDPOW(NCH,NB), BURNINS(NCH,NB)
+      REAL TIME,BURNSTP, BURNAVG, PTOT, MASSTOT, WEIGHT
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,IOUT=6)
+      TYPE(C_PTR) JPMAP,KPMAP
+      CHARACTER HSMG*131
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: FLMIX,IFLRANK
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: BUNDMIX
+      REAL, ALLOCATABLE, DIMENSION(:) :: FLWEIGHT
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(BUNDMIX(NCH,NB),FLMIX(NF),FLWEIGHT(NF))
+*----
+*  RECOVER INFORMATION
+*----
+      CALL LCMLIB(IPMAP)
+*     FUEL MIX
+      BUNDMIX(:NCH,:NB)=0
+      CALL LCMGET(IPMAP,'FLMIX',BUNDMIX)
+*     BURN-INST
+      BURNINS(:NCH,:NB)=0.0
+      CALL LCMGET(IPMAP,'BURN-INST',BURNINS)
+*     FUEL INFORMATION (WEIGHT & MIX)
+      JPMAP=LCMGID(IPMAP,'FUEL')
+      MAXFL=0 ! maximum fuel mix number
+      DO IFL=1,NF
+        KPMAP=LCMGIL(JPMAP,IFL)
+        CALL LCMGET(KPMAP,'MIX',FLMIX(IFL))
+        MAXFL=MAX(MAXFL,FLMIX(IFL))
+        CALL LCMGET(KPMAP,'WEIGHT',FLWEIGHT(IFL))
+      ENDDO
+      IF(MAXFL.LT.NF)THEN
+        WRITE(HSMG,'(38H@TINSTB: FOUND MAX FUEL MIX NUMBER : (,I6,
+     1  8H) THOUGH,I7,23H FUEL MIXES ARE DEFINED)')
+        CALL XABORT(HSMG)
+      ENDIF
+* the mix stored in FLMIX field of /FMAP/
+* is not the rank of the fuel in FUEL Dir list of /FMAP/
+      ALLOCATE(IFLRANK(MAXFL))
+      IFLRANK(:MAXFL)=0
+      DO IFL=1,NF
+        IFLRANK(FLMIX(IFL))=IFL
+      ENDDO
+*----
+*  COMPUTE BURNAVG, PTOT, MASSTOT, ( TIME if BURNSTEP is specified)
+*----
+      BURNAVG=0.
+      PTOT=0.
+      MASSTOT=0.
+      NTOT=0
+      DO ICH=1,NCH
+        DO IB=1,NB
+          IBD=BUNDMIX(ICH,IB)
+          IF(IBD.EQ.0) CYCLE
+          IFL=IFLRANK(IBD)
+          IF(IFL.EQ.0) CYCLE
+          NTOT=NTOT+1
+          WEIGHT = FLWEIGHT(IFL)
+          BURNAVG=BURNAVG+BURNINS(ICH,IB)
+          PTOT=PTOT+BUNDPOW(ICH,IB)
+          MASSTOT=MASSTOT+WEIGHT
+        ENDDO
+      ENDDO
+      BURNAVG=BURNAVG/REAL(NTOT)
+      IF(TIME.EQ.0.)THEN
+        TIME = BURNSTP*MASSTOT/PTOT
+      ENDIF
+      IF(IMPX.GT.0)THEN
+        WRITE(IOUT,*)'@TINSTB: TOTAL POWER = ',PTOT,' kW'
+        WRITE(IOUT,*)'@TINSTB: TOTAL FUEL MASS = ',MASSTOT,' kg'
+        WRITE(IOUT,*)'@TINSTB: AVERAGE BURN UP BEFORE = ',
+     1  BURNAVG,'MWd/t'
+      ENDIF
+*----
+*  COMPUTE NEW BURN-INST GIVEN TIME
+*----
+      BURNAVG=0.
+      NTOT=0
+      DO ICH=1,NCH
+        DO IB=1,NB
+          IBD=BUNDMIX(ICH,IB)
+          IF(IBD.EQ.0) CYCLE
+          IFL=IFLRANK(IBD)
+          IF(IFL.EQ.0) CYCLE
+          NTOT=NTOT+1
+          WEIGHT = FLWEIGHT(IFL)
+          IF(WEIGHT.GT.0.)THEN
+            BURNINS(ICH,IB)=BURNINS(ICH,IB)
+     1      +(BUNDPOW(ICH,IB)/WEIGHT)*TIME
+            BURNAVG=BURNAVG+BURNINS(ICH,IB)
+          ELSE
+            IF(IMPX.GT.0)THEN
+              WRITE(IOUT,*)'@TINSTB: WARNING MIX ',
+     1        BUNDMIX(ICH,IB),' WEIGHS ',WEIGHT,'kg'
+            ENDIF
+          ENDIF
+        ENDDO
+      ENDDO
+      BURNAVG=BURNAVG/REAL(NTOT)
+      IF(IMPX.GT.0)THEN
+        WRITE(IOUT,*)'@TINSTB: AVERAGE BURN UP AFTER = ',BURNAVG,'MWd/t'
+      ENDIF
+      CALL LCMPUT(IPMAP,'BURN-INST',NCH*NB,2,BURNINS)
+*----
+*  RELEASE MEMORY AND RETURN
+*----
+      DEALLOCATE(IFLRANK)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(FLWEIGHT,FLMIX,BUNDMIX)
+      RETURN
+      END
-- 
cgit v1.2.3