summaryrefslogtreecommitdiff
path: root/Donjon/src/HSTGET.f
diff options
context:
space:
mode:
Diffstat (limited to 'Donjon/src/HSTGET.f')
-rw-r--r--Donjon/src/HSTGET.f398
1 files changed, 398 insertions, 0 deletions
diff --git a/Donjon/src/HSTGET.f b/Donjon/src/HSTGET.f
new file mode 100644
index 0000000..6a1238a
--- /dev/null
+++ b/Donjon/src/HSTGET.f
@@ -0,0 +1,398 @@
+*DECK HSTGET
+ SUBROUTINE HSTGET(IPHST, IPRINT, MAXG, MAXL, NCHA, NBUN,
+ > ITYPRO, ITYRED, CARRED, IUPDC, IUPDB,
+ > NAMG, PARAMG, NAML, PARAML, IDCELL, IDFUEL)
+*
+*----------
+*
+*Purpose:
+* To read from the input file or send to CLE-2000 variables the
+* local and burnup parameters associated with a fuel cell.
+*
+*Copyright:
+* Copyright (C) 2003 Ecole Polytechnique de Montreal.
+*
+*Author(s):
+* G. Marleau
+*
+*Parameters: input
+* IPHST address of the \dds{history} data structure.
+* IPRINT print level.
+* MAXG maximum number of global parameters.
+* MAXL maximum number of local parameters.
+* NCHA number of fuel channels.
+* NBUN number of bundles per channel.
+* ITYPRO type of processing where:
+* ITYPRO > 0 if history is in creation or update mode;
+* ITYPRO < 0 if history is in read-only mode.
+* ITYRED type of the last variable read.
+* CARRED last character string read.
+*
+*Parameters: input/output
+* NMAG global parameter names.
+* PARAMG values of the global parameters.
+* NMAL local parameter names.
+* PARAML values of the local parameters.
+* IDCELL cell identifier for each fuel bundle in each channel.
+* IDFUEL fuel type identifier for each fuel bundle in each channel.
+*
+*Parameters: output
+* IUPDC number of the channel to analyze.
+* IUPDB number of the bundle to analyze.
+*
+*----------
+*
+ USE GANLIB
+ IMPLICIT NONE
+*----
+* SUBROUTINE ARGUMENTS
+*----
+ TYPE(C_PTR) IPHST
+ INTEGER IPRINT,MAXG,MAXL,NCHA,NBUN,ITYPRO
+ INTEGER ITYRED,IUPDC,IUPDB
+ CHARACTER CARRED*12
+ INTEGER NAMG(3,0:MAXG),NAML(3,0:MAXL)
+ REAL PARAMG(0:MAXG),PARAML(0:MAXL,2)
+ INTEGER IDCELL(NBUN,NCHA),IDFUEL(NBUN,NCHA)
+*----
+* LOCAL PARAMETERS
+*----
+ INTEGER IOUT,NTC,ILCMUP,ILCMDN
+ CHARACTER NAMSBR*6
+ PARAMETER (IOUT=6,NTC=3,ILCMUP=1,ILCMDN=2,
+ > NAMSBR='HSTGET')
+*----
+* INPUT/OUTPUT VARIABLES
+* Input data is of the form
+* [ GET (hstpar) ] [ PUT (hstpar) ]
+* [ CELLID icha ibun [ idfuel ]
+* [ GET (hstpar) ]
+* [ PUT { BREFL (hsrbrn) (hstpar)
+* AREFL (hsrbrn) (hstpar) |
+* [ AREFL ] (hsrbrn) (hstpar) } ] ]
+*
+* HERE:
+* (hstpar) = NAMPAR valpar
+* where NAMPAR is the name of a local or global
+* parameter and valpar its value.
+* (hstbrn) = BURN period power
+* where period is the burnup time step
+* and power the burnup power density in kW/kg.
+* For global parameter:
+* GET = implies that (hstpar) is transfered to the
+* HISTORY file,
+* PUT = implies that (hstpar) is transfered to
+* CLE-2000 variables.
+* For local parameters:
+* GET = implies that (hstpar) is transfered to the
+* HISTORY file for the case before and
+* after refueling.
+* PUT = implies that (hstbrn) and (hstpar)
+* are transfered to CLE-2000 variables.
+* BREFL = Indicates that the information before
+* refueling is considered.
+* AREFL = Indicates that the information after
+* refueling is considered.
+* This is the default option is neither
+* BREFL nor AREFL is defined.
+*----
+ INTEGER ITYPLU,INTLIR
+ CHARACTER CARLIR*12
+ REAL REALIR
+ DOUBLE PRECISION DBLLIR
+ INTEGER ITYPUT,INTPUT
+ CHARACTER CARPUT*12
+ REAL REAPUT
+ DOUBLE PRECISION DBLPUT
+*----
+* LOCAL VARIABLES
+*----
+ INTEGER ICONTR,IGP,IFTN,ISREF,IUPDL,IUPDG,IUPDF
+ INTEGER ITC,INEXT,IB,IC,IPL,IP
+ INTEGER ICT,IOK
+ CHARACTER NAMP*12
+ REAL TIMPOW(2,2)
+*----
+* Initialize input vectors
+*----
+ PARAML(0:MAXL,:2)=0.0
+ TIMPOW(:2,:2)=0.0
+*----
+* Initialize variables
+* IUPDC -> channel number to process or update.
+* IUPDB -> bundle number to process or update.
+* ICONTR -> indicates processing of ITYRED and CARRED
+* = 0 processing required.
+* = 1 processing has been performed.
+* IGP -> indicate if a GET or PUT command is in effect.
+* =-1 PUT command in effect
+* = 0 no GET or PUT command in effect
+* = 1 GET command in effect
+* IFTN = new fuel type
+* ISREF -> indicate the REFUEL state
+* is to be processed
+* = 0 no processing
+* = 1 processing before refuel
+* = 2 processing after refuel
+* IUPDL -> indicates local parameters update
+* = 0 no update
+* > 0 updated
+* IUPDG -> indicates global parameters update
+* = 0 no update
+* > 0 updated
+* IUPDF -> Fuel type update
+* = 0 no update
+* > 0 updated
+*----
+ IUPDC=0
+ IUPDB=0
+ ICONTR=0
+ IGP =0
+ IFTN =0
+ ISREF =0
+ IUPDL =0
+ IUPDG =0
+ IUPDF =0
+ 100 CONTINUE
+ IF(ICONTR .EQ. 0) THEN
+ ITYPLU=ITYRED
+ CARLIR=CARRED
+ ICONTR=1
+ ELSE
+ CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+ ENDIF
+ 101 CONTINUE
+ IF(ITYPLU .EQ. 10) GO TO 105
+ IF(ITYPLU .NE. 3) CALL XABORT(NAMSBR//
+ >': Read error -- Character variable expected')
+ IF(CARLIR .EQ. ';') THEN
+ GO TO 105
+ ELSE IF(CARLIR .EQ. 'CELLID') THEN
+ IGP=0
+*----
+* Channel number
+*----
+ CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+ IF(ITYPLU .NE. 1) CALL XABORT(NAMSBR//
+ > ': Read error -- integer value for channel number expected.')
+ IF(INTLIR .LT. 0 ) CALL XABORT(NAMSBR//
+ > ': Read error -- value for channel number must be > 0.')
+ IF(IUPDC .NE. 0) CALL XABORT(NAMSBR//
+ > ': Only one channel can be updated for each call to HST.')
+ IUPDC=INTLIR
+*----
+* Bundle number
+*----
+ CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+ IF(ITYPLU .NE. 1) CALL XABORT(NAMSBR//
+ > ': Read error -- integer value for bundle number expected.')
+ IF(INTLIR .LT. 0 ) CALL XABORT(NAMSBR//
+ > ': Read error -- value for bundle number must be > 0')
+ IF(IUPDB .NE. 0) CALL XABORT(NAMSBR//
+ > ': Only one bundle can be updated for each call to HST.')
+ IUPDB=INTLIR
+*----
+* Fuel type (optional)
+*----
+ CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+ IFTN=-1
+ IF(ITYPLU .EQ. 1) THEN
+ IFTN=INTLIR
+ CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+ ENDIF
+*----
+* IF CELL IS NOT IDENTIFIED ASSOCIATE TO CELL NEXT
+* CELL NUMBER AVAILABLE AND TO FUEL TYPE
+* VALUE PROVIDED IN IFTN
+*----
+ IF(IDCELL(IUPDB,IUPDC) .LE. 0) THEN
+ DO 110 INEXT=1,NBUN*NCHA
+ DO 111 IB=1,NBUN
+ DO 112 IC=1,NCHA
+ IF(IDCELL(IB,IC) .EQ. INEXT) GO TO 115
+ 112 CONTINUE
+ 111 CONTINUE
+ IDCELL(IUPDB,IUPDC)=INEXT
+ GO TO 116
+ 115 CONTINUE
+ 110 CONTINUE
+ CALL XABORT(NAMSBR//': No cell id available')
+ 116 CONTINUE
+ IDFUEL(IUPDB,IUPDC)=ABS(IFTN)
+ ELSE
+*----
+* CELL EXIST, READ IF POSSIBLE EXISTING LOCAL
+* PARAMETERS VALUES
+*----
+ ICT=IDCELL(IUPDB,IUPDC)
+ WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
+ CALL LCMSIX(IPHST,NAMP,ILCMUP)
+*----
+* Get local parameters from cell before refueling
+*----
+ IOK=-1
+ CALL HSTGSL(IPHST ,MAXL ,IOK ,
+ > TIMPOW(1,1) ,PARAML(0,1))
+ IF((IPRINT.GT.0).AND.(IOK.NE.0)) THEN
+ WRITE(IOUT,7000) NAMSBR
+ WRITE(IOUT,7010) IUPDC,IUPDB,'BEFORE'
+ ENDIF
+*----
+* Get local parameters from cell after refueling
+*----
+ IOK=-2
+ CALL HSTGSL(IPHST ,MAXL ,IOK ,
+ > TIMPOW(1,2) ,PARAML(0,2))
+ IF((IPRINT.GT.0).AND.(IOK.NE.0)) THEN
+ WRITE(IOUT,7000) NAMSBR
+ WRITE(IOUT,7010) IUPDC,IUPDB,'AFTER '
+ ENDIF
+ CALL LCMSIX(IPHST,NAMP,ILCMDN)
+ ENDIF
+ GO TO 101
+ ELSE IF(CARLIR .EQ. 'GET') THEN
+ IF(ITYPRO .LT. 0) CALL XABORT(NAMSBR//
+ >': Option GET not permitted for history in read only mode')
+ IGP=1
+ ISREF=2
+ ELSE IF(CARLIR .EQ. 'PUT') THEN
+ IGP=-1
+ ISREF=2
+ ELSE IF(CARLIR .EQ. 'BREFL') THEN
+ IF(IGP .NE. -1) CALL XABORT(NAMSBR//
+ >': Option BREFL permitted for PUT only')
+ ISREF=1
+ ELSE IF(CARLIR .EQ. 'AREFL') THEN
+ IF(IGP .NE. -1) CALL XABORT(NAMSBR//
+ >': Option AREFL permitted for PUT only')
+ ISREF=2
+ ELSE
+ IF(IGP .EQ. 0) CALL XABORT(NAMSBR//
+ > ': GET or PUT must be specified ')
+ IF(IUPDC*IUPDB .GT. 0) THEN
+*----
+* CARLIR contains a local parameter
+*----
+ IF(CARLIR .EQ. 'BURN') THEN
+ IF(IGP .EQ. 1) CALL XABORT(NAMSBR//
+ >': Option GET not permitted for BURN keyword')
+ IF(ITYPRO .GT. 0) CALL XABORT(NAMSBR//
+ >': Option BURN permitted only for history in read only mode')
+ REAPUT=TIMPOW(1,ISREF)
+ ITYPUT=2
+ CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+ IF(ITYPLU .NE. -ITYPUT) CALL XABORT(NAMSBR//
+ >': Real output variable for burnup period expected')
+ CALL REDPUT(ITYPUT,INTPUT,REAPUT,CARPUT,DBLPUT)
+*----
+* The power density expected is in kW/kg.
+*----
+ REAPUT=TIMPOW(2,ISREF)
+ ITYPUT=2
+ CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+ IF(ITYPLU .NE. -ITYPUT) CALL XABORT(NAMSBR//
+ >': Real output variable for burnup power expected')
+ CALL REDPUT(ITYPUT,INTPUT,REAPUT,CARPUT,DBLPUT)
+ ELSE
+*----
+* Scan local parameters to see is CARLIR is one of them
+*----
+ IP=0
+ DO 120 IPL=1,MAXL
+ WRITE(NAMP,'(3A4)') (NAML(ITC,IPL),ITC=1,NTC)
+ IF(NAMP .EQ. CARLIR) THEN
+ IP=IPL
+ GO TO 125
+ ELSE IF(NAMP .EQ. ' ') THEN
+ IP=IPL
+ READ(CARLIR,'(3A4)') (NAML(ITC,IP),ITC=1,NTC)
+ GO TO 125
+ ENDIF
+ 120 CONTINUE
+ CALL XABORT(NAMSBR//': Number of local parameters '//
+ > 'provided larger than number permitted.')
+ 125 CONTINUE
+ IF(IGP .EQ. -1) THEN
+ REAPUT=PARAML(IP,ISREF)
+ ITYPUT=2
+ CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+ IF(ITYPLU .NE. -ITYPUT) CALL XABORT(NAMSBR//
+ >': Real output variable for local parameter expected')
+ CALL REDPUT(ITYPUT,INTPUT,REAPUT,CARPUT,DBLPUT)
+ ELSE IF(IGP .EQ. 1) THEN
+ IUPDL=IUPDL+1
+ CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+ IF(ITYPLU .NE. 2) CALL XABORT(NAMSBR//
+ > ': Real value for local parameter missing.')
+ PARAML(IP,ISREF)=REALIR
+ ENDIF
+ ENDIF
+ ELSE
+*----
+* CARLIR contains a global parameter
+*----
+ IF(CARLIR .EQ. 'POWER') THEN
+ CALL XABORT(NAMSBR//
+ > ': POWER is a local not global parameter')
+ ELSE
+ IP=0
+ DO 130 IPL=1,MAXG
+ WRITE(NAMP,'(3A4)') (NAMG(ITC,IPL),ITC=1,NTC)
+ IF(NAMP .EQ. CARLIR) THEN
+ IP=IPL
+ GO TO 135
+ ELSE IF(NAMP .EQ. ' ') THEN
+ IP=IPL
+ READ(CARLIR,'(3A4)') (NAMG(ITC,IP),ITC=1,NTC)
+ GO TO 135
+ ENDIF
+ 130 CONTINUE
+ CALL XABORT(NAMSBR//': Number of global parameters '//
+ > 'provided larger than number permitted.')
+ 135 CONTINUE
+ IF(IGP .EQ. -1) THEN
+ REAPUT=PARAMG(IP)
+ ITYPUT=2
+ CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+ IF(ITYPLU .NE. -ITYPUT) CALL XABORT(NAMSBR//
+ >': Real output variable for global parameter expected')
+ CALL REDPUT(ITYPUT,INTPUT,REAPUT,CARPUT,DBLPUT)
+ ELSE IF(IGP .EQ. 1) THEN
+ IUPDG=IUPDG+1
+ CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+ IF(ITYPLU .NE. 2) CALL XABORT(NAMSBR//
+ > ': Real value for global parameter missing.')
+ PARAMG(IP)=REALIR
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDIF
+ GO TO 100
+ 105 CONTINUE
+*----
+* Save global parameters if some are updated
+*----
+ IF(IUPDG .GT. 0) THEN
+ CALL LCMPUT(IPHST,'NAMEGLOBAL ',3*MAXG,3,NAMG(1,1))
+ CALL LCMPUT(IPHST,'PARAMGLOBAL ',MAXG,2,PARAMG(1))
+ ENDIF
+ IF(IUPDL .GT. 0) THEN
+ CALL LCMPUT(IPHST,'NAMELOCAL ',3*MAXL,3,NAML(1,1))
+ ICT=IDCELL(IUPDB,IUPDC)
+ WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
+ CALL LCMSIX(IPHST,NAMP,ILCMUP)
+ IOK=2
+ CALL HSTGSL(IPHST ,MAXL ,IOK ,
+ > TIMPOW(1,2) ,PARAML(0,2))
+ CALL LCMSIX(IPHST,NAMP,ILCMDN)
+ ENDIF
+ RETURN
+*----
+* Formats
+* WARNING
+*----
+ 7000 FORMAT(' ***** WARNING IN ',A6,' *****')
+ 7010 FORMAT(' Local parameters for channel ',I5,' bundle ',I5,
+ > ' not available for ',A6,' state'/
+ > ' Initialize to 0.0')
+ END
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 14:52:48 +0000