summaryrefslogtreecommitdiff
path: root/Dragon/src/MPOGEP.f
diff options
context:
space:
mode:
Diffstat (limited to 'Dragon/src/MPOGEP.f')
-rw-r--r--Dragon/src/MPOGEP.f256
1 files changed, 256 insertions, 0 deletions
diff --git a/Dragon/src/MPOGEP.f b/Dragon/src/MPOGEP.f
new file mode 100644
index 0000000..238b580
--- /dev/null
+++ b/Dragon/src/MPOGEP.f
@@ -0,0 +1,256 @@
+*DECK MPOGEP
+ SUBROUTINE MPOGEP(IPMPO,IPDEPL,IPLB1,IPLB2,IPEDIT,HEDIT,IMPX,
+ 1 ITIM,NPAR,NLOC,MUPLET,LGNEW,NMIL,NG,NCALAR)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* To recover remaining global parameters and local values. Update the
+* parameter tree for a new elementary calculation.
+*
+*Copyright:
+* Copyright (C) 2022 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
+* IPMPO pointer to the MPO file.
+* IPDEPL pointer to the burnup object.
+* IPLB1 pointer to the first microlib object.
+* IPLB2 pointer to the second (optional) microlib object.
+* IPEDIT pointer to the edition object.
+* HEDIT name of output group for a (multigroup mesh, output geometry)
+* couple (generally equal to 'output_0').
+* IMPX print parameter.
+* ITIM index of the current burnup step.
+* NPAR number of global parameters.
+* NLOC number of local parameters.
+* MUPLET tuple of indices associated to each global parameter of the
+* elementary calculation.
+* LGNEW parameter modification flag (.TRUE. only if the I-th global
+* parameter has changed in the new elementary calculation).
+* NMIL number of mixtures in the MPO file
+* NG number of energy groups.
+* NCALAR index of the new elementary calculation.
+*
+*-----------------------------------------------------------------------
+*
+ USE GANLIB
+ USE hdf5_wrap
+*----
+* SUBROUTINE ARGUMENTS
+*----
+ TYPE(C_PTR) IPMPO,IPDEPL,IPLB1,IPLB2,IPEDIT
+ INTEGER IMPX,ITIM,NPAR,NLOC,MUPLET(NPAR),NMIL,NG,NCALAR
+ LOGICAL LGNEW(NPAR)
+ CHARACTER(LEN=12) HEDIT
+*----
+* LOCAL VARIABLES
+*----
+ TYPE(C_PTR) IPLB3
+ PARAMETER (MAXPAR=50,NSTATE=40)
+ INTEGER ISTATE(NSTATE)
+ CHARACTER TEXT8*8,TEXT12*12,NAMLCM*12,NAMMY*12,HSMG*131,RECNAM*80
+ LOGICAL EMPTY,LCM
+*----
+* ALLOCATABLE ARRAYS
+*----
+ INTEGER, ALLOCATABLE, DIMENSION(:) :: PARADR,PARADL,LOCADR,
+ 1 DIMS_MPO
+ REAL, ALLOCATABLE, DIMENSION(:) :: RVALO
+ CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: PARFMT
+ CHARACTER(LEN=24), ALLOCATABLE, DIMENSION(:) :: PARTYP,PARKEY,
+ 1 PARCAD,PARTYL,PARKEL,PARCAL
+*----
+* VALIDATE NPAR
+*----
+ IF(NPAR.EQ.0) GO TO 45
+ CALL hdf5_get_shape(IPMPO,"/parameters/info/PARAMNAME",DIMS_MPO)
+ IF(NPAR.NE.DIMS_MPO(1)) CALL XABORT('MPOGEP: INVALID NPAR.')
+ DEALLOCATE(DIMS_MPO)
+*----
+* RECOVER INFORMATION FROM THE /parameters GROUP.
+*----
+ CALL hdf5_read_data(IPMPO,"/parameters/info/PARAMNAME",PARKEY)
+ CALL hdf5_read_data(IPMPO,"/parameters/info/PARAMFORM",PARFMT)
+ CALL hdf5_read_data(IPMPO,"/parameters/info/PARAMTYPE",PARTYP)
+ CALL hdf5_read_data(IPMPO,"/parameters/info/PARAMINFOADR",PARADR)
+ NPCHR=PARADR(NPAR+1)
+ IF(NPCHR.GT.0) THEN
+ CALL hdf5_read_data(IPMPO,"/parameters/info/PARAMINFO",PARCAD)
+ ENDIF
+*----
+* RECOVER REMAINING GLOBAL PARAMETERS.
+*----
+ DO 10 IPAR=1,NPAR
+ IF(PARTYP(IPAR).EQ.'VALU') THEN
+ GO TO 10
+ ELSE IF((PARTYP(IPAR).EQ.'BURNUP').OR.(PARTYP(IPAR).EQ.'TIME').OR.
+ 1 (PARTYP(IPAR).EQ.'PUIS').OR.(PARTYP(IPAR).EQ.'FLUB').OR.
+ 2 (PARTYP(IPAR).EQ.'FLUX').OR.(PARTYP(IPAR).EQ.'MASL')) THEN
+*
+* RECOVER GLOBAL PARAMETER VALUES FROM THE DEPLETION OBJECT.
+ IF(.NOT.C_ASSOCIATED(IPDEPL)) CALL XABORT('MPOGEP: NO DEPLETI'
+ 1 //'ON OBJECT AVAILABLE AMONG THE RHS LCM OBJECTS.')
+ CALL LCMGET(IPDEPL,'STATE-VECTOR',ISTATE)
+ NBURN=ISTATE(3)
+ NBISO=ISTATE(4)
+ NREAC=ISTATE(6)
+ NVAR=ISTATE(7)
+ NBMIX=ISTATE(8)
+ CALL COMGEM(IPDEPL,ITIM,PARTYP(IPAR),0,NBURN,NBMIX,NBISO,
+ 1 NREAC,NVAR,VALPAR)
+ ELSE IF((PARTYP(IPAR).EQ.'TEMP').OR.(PARTYP(IPAR).EQ.'CONC'))
+ 1 THEN
+*
+* RECOVER GLOBAL PARAMETER VALUES FROM A MICROLIB OBJECT.
+ IF(.NOT.C_ASSOCIATED(IPLB1)) CALL XABORT('MPOGEP: MICROLIB EX'
+ 1 //'PECTED AT RHS.')
+ IF(NPCHR.EQ.0) CALL XABORT('MPOGEP: MISSING PARAMINFO.')
+ TEXT8=' '
+ TEXT12=' '
+ IMILI=0
+ IPCHR=PARADR(IPAR)+1
+ IF(PARTYP(IPAR).EQ.'CONC') THEN
+ TEXT8=PARCAD(IPCHR)(:8)
+ IPCHR=IPCHR+1
+ ENDIF
+ TEXT12=PARCAD(IPCHR)(:8)
+ IPCHR=IPCHR+1
+ READ(PARCAD(IPCHR),'(3X,I9)') IMILI
+ CALL LCMGET(IPLB1,'STATE-VECTOR',ISTATE)
+ MAXNBI=ISTATE(2)
+ IF(C_ASSOCIATED(IPLB2)) THEN
+ CALL LCMGET(IPLB2,'STATE-VECTOR',ISTATE)
+ MAXNBI=MAX(MAXNBI,ISTATE(2))
+ ENDIF
+ CALL COMBIB(IPLB1,IPLB2,PARTYP(IPAR),IMILI,TEXT12,TEXT8,MAXNBI,
+ 1 VALPAR)
+ ELSE
+ CALL XABORT('MPOGEP: '//PARTYP(IPAR)//' IS AN UNKNOWN PARAM'//
+ 1 'ETER TYPE.')
+ ENDIF
+ IF(IMPX.GT.0) WRITE(6,100) PARKEY(IPAR),VALPAR
+*
+ CALL MPOPAV(IPMPO,HEDIT,IPAR,NPAR,PARFMT(IPAR),VALPAR,NITMA,
+ 1 TEXT12,MUPLET(IPAR),LGNEW(IPAR))
+ 10 CONTINUE
+ IF(IMPX.GT.2) THEN
+ WRITE(6,110) (MUPLET(I),I=1,NPAR)
+ WRITE(6,'(/)')
+ ENDIF
+ DO 15 I=1,NPAR
+ IF(MUPLET(I).EQ.-99) THEN
+ WRITE(HSMG,'(33HMPOGEP: UNDEFINED MUPLET ELEMENT=,I6)') I
+ CALL XABORT(HSMG)
+ ENDIF
+ 15 CONTINUE
+ WRITE(RECNAM,'(8H/output/,A,9H/statept_,I0)') TRIM(HEDIT),NCALAR-1
+ CALL hdf5_write_data(IPMPO,TRIM(RECNAM)//"/PARAMVALUEORD",MUPLET)
+ IF(NPCHR.GT.0) DEALLOCATE(PARCAD)
+ DEALLOCATE(PARADR,PARTYP,PARFMT,PARKEY)
+*----
+* RECOVER INFORMATION FROM THE 'varlocdescri' GROUP.
+*----
+ 45 IF(NLOC.EQ.0) RETURN
+ ALLOCATE(LOCADR(NLOC+1))
+ CALL hdf5_read_data(IPMPO,"/local_values/LOCVALNAME",PARKEL)
+ CALL hdf5_read_data(IPMPO,"/local_values/LOCVALTYPE",PARTYL)
+ CALL hdf5_read_data(IPMPO,"/local_values/LOCVALINFOADR",PARADL)
+ CALL hdf5_read_data(IPMPO,"/local_values/NLOCVALINFO",NPCHL)
+ IF(NPCHL.GT.0) THEN
+ CALL hdf5_read_data(IPMPO,"/local_values/LOCVALINFO",PARCAL)
+ ENDIF
+*
+ CALL LCMGTC(IPEDIT,'LAST-EDIT',12,TEXT12)
+*----
+* INITIALIZE LOCADR AND ALLOCATE RVALO.
+*----
+ IADR=0
+ LOCADR(1)=0
+ DO 50 IPAR=1,NLOC
+ IF((PARTYL(IPAR).EQ.'EQUI').OR.(PARTYL(IPAR).EQ.'VITE')) THEN
+ IADR=IADR+NG
+ ELSE IF(PARTYL(IPAR).EQ.'COUR') THEN
+ IADR=IADR+2*NG
+ ELSE
+ IADR=IADR+1
+ ENDIF
+ LOCADR(IPAR+1)=IADR
+ 50 CONTINUE
+ NVLC=LOCADR(NLOC+1)
+ ALLOCATE(RVALO(NVLC*NMIL))
+*----
+* RECOVER LOCAL VARIABLES.
+*----
+ DO 70 IPAR=1,NLOC
+ IF((PARTYL(IPAR).EQ.'BURNUP').OR.(PARTYL(IPAR).EQ.'TIME').OR.
+ 1 (PARTYL(IPAR).EQ.'PUIS').OR.(PARTYL(IPAR).EQ.'FLUG').OR.
+ 2 (PARTYL(IPAR).EQ.'FLUB').OR.(PARTYL(IPAR).EQ.'FLUX').OR.
+ 3 (PARTYL(IPAR).EQ.'MASL')) THEN
+*
+* RECOVER LOCAL VARIABLES FROM THE DEPLETION OBJECT.
+ IF(.NOT.C_ASSOCIATED(IPDEPL)) CALL XABORT('MPOGEP: NO DEPLET'
+ 1 //'ION OBJECT AVAILABLE AMONG THE RHS LCM OBJECTS.')
+ CALL LCMGET(IPDEPL,'STATE-VECTOR',ISTATE)
+ NBURN=ISTATE(3)
+ NBISO=ISTATE(4)
+ NREAC=ISTATE(6)
+ NVAR=ISTATE(7)
+ NBMIX=ISTATE(8)
+ CALL LCMGET(IPEDIT,'STATE-VECTOR',ISTATE)
+ NREG=ISTATE(17)
+ CALL COMGEN(IPDEPL,IPEDIT,NREG,NMIL,ITIM,PARTYL(IPAR),NBURN,
+ 1 NBMIX,NBISO,NREAC,NVAR,LOCADR(IPAR),NVLC,RVALO)
+ ELSE IF((PARTYL(IPAR).EQ.'TEMP').OR.(PARTYL(IPAR).EQ.'CONC'))
+ 1 THEN
+*
+* RECOVER LOCAL VARIABLES FROM THE MICROLIB IN EDIT OBJECT.
+ TEXT8=' '
+ IF(PARTYL(IPAR).EQ.'CONC') THEN
+ IF(NPCHL.EQ.0) CALL XABORT('MPOGEP: MISSING LOCVALINFO.')
+ IPCHL=PARADL(IPAR)+1
+ TEXT8=PARCAL(IPCHL)(:8)
+ ENDIF
+ CALL LCMSIX(IPEDIT,TEXT12,1)
+ CALL LCMGET(IPEDIT,'STATE-VECTOR',ISTATE)
+ MAXNBI=ISTATE(2)
+ CALL LCMINF(IPEDIT,NAMLCM,NAMMY,EMPTY,ILONG,LCM)
+ IPLB3=C_NULL_PTR
+ DO 60 IBM=1,NMIL
+ CALL COMBIB(IPEDIT,IPLB3,PARTYL(IPAR),IBM,NAMLCM,TEXT8,MAXNBI,
+ 1 VALPAR)
+ RVALO((IBM-1)*NVLC+LOCADR(IPAR))=VALPAR
+ 60 CONTINUE
+ CALL LCMSIX(IPEDIT,' ',2)
+ ELSE IF(PARTYL(IPAR).EQ.'EQUI') THEN
+* RECOVER A SET OF SPH EQUIVALENCE FACTORS.
+ CALL SAPSPH(IPEDIT,NG,NMIL,LOCADR(IPAR),NVLC,RVALO)
+ ELSE
+ CALL XABORT('MPOGEP: '//PARTYL(IPAR)//' IS AN UNKNOWN LOCAL'//
+ 1 ' VARIABLE TYPE.')
+ ENDIF
+ IF(IMPX.GT.1) WRITE(6,120) PARKEY(IPAR),
+ 1 (RVALO((IBM-1)*NVLC+LOCADR(IPAR)),IBM=1,NMIL)
+ 70 CONTINUE
+ DO 80 IBM=1,NMIL
+ WRITE(RECNAM,'(8H/output/,A,9H/statept_,I0,6H/zone_,I0,1H/)')
+ 1 TRIM(HEDIT),NCALAR-1,IBM-1
+ CALL hdf5_write_data(IPMPO,TRIM(RECNAM)//"LOCALVALUE",
+ 1 RVALO((IBM-1)*NVLC+1:IBM*NVLC))
+ CALL hdf5_write_data(IPMPO,TRIM(RECNAM)//"LOCALVALADDR",LOCADR)
+ 80 CONTINUE
+ DEALLOCATE(RVALO)
+ IF(NPCHL.GT.0) DEALLOCATE(PARCAL)
+ DEALLOCATE(PARADL,PARTYL,PARKEL,LOCADR)
+ RETURN
+*
+ 100 FORMAT(31H MPOGEP: SET GLOBAL PARAMETER ',A,3H' =,1P,E12.4)
+ 110 FORMAT(/16H MPOGEP: MUPLET=,10I6:/(16X,10I6))
+ 120 FORMAT(29H MPOGEP: SET LOCAL VARIABLE ',A,3H' =,1P,5E12.4/(36X,
+ 1 5E12.4))
+ END
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 22:52:11 +0000