Initial commit from Polytechnique Montreal

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