Initial commit from Polytechnique Montreal

1 files changed, 320 insertions, 0 deletions

diff --git a/Donjon/src/T16CPO.f b/Donjon/src/T16CPO.f
new file mode 100644
index 0000000..58fedc5
--- /dev/null
+++ b/Donjon/src/T16CPO.f
@@ -0,0 +1,320 @@
+*DECK T16CPO
+      SUBROUTINE T16CPO(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*----
+*
+*Purpose:
+*  Transfer a WIMS-AECL 3.1 tape16 file to a Donjon/Dragon CPO data
+*  structure.
+*
+*Author(s): 
+* G. Marleau
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The T16CPO: module specifications  are:
+*   DONCPO :=  T16CPO: [ DONCPO ] WIMS16 :: (desct16cpo)  ; 
+* where
+*   DONCPO       : name of data structure where the output COP is 
+*                  stored. This can be a new data structure or an old 
+*                  data structure that will be updated. 
+*   (desct16cpo] : input specifications for the execution
+*                  of the T16CPO: module.  
+*
+*----
+*
+      USE GANLIB
+      IMPLICIT         NONE
+      INTEGER          NENTRY
+      CHARACTER        HENTRY(NENTRY)*12
+      INTEGER          IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)      KENTRY(NENTRY)
+*----
+*  MEMORY ALLOCATION
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IFGCND,IFGMTR,IFGEDI,
+     >                                      NAMMIX,MIXRCI,MIXPER,MIXREG
+      REAL, ALLOCATABLE, DIMENSION(:) :: ENET16,ENECPO,VELMTR,
+     >                                   PARRCI,PARPER
+*----
+*  READ VARIABLES
+*----
+      CHARACTER        TEXT12*12
+      INTEGER          ITYPE,NITMA
+      REAL             FLOTT
+      DOUBLE PRECISION DFLOTT
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER          IFT16,IOUT,NSTATE,MXGRP,MNLOCP,MNCPLP,MNPERT
+      CHARACTER        NAMSBR*6,NAMVER*12,NAMDAT*12,NAMMOD*12
+      PARAMETER       (IOUT=6,NSTATE=40,MXGRP=89,MNLOCP=11,
+     >                 MNCPLP=1,MNPERT=10,NAMSBR='T16CPO',
+     >                 NAMVER='VERSION 2.0 ',NAMDAT='2012/07/09  ',
+     >                 NAMMOD='T16CPO:     ')
+      CHARACTER        TEXT4*4,HSIGN*12,TITLE*72,SUBTIT*240
+      INTEGER          ISTATE(NSTATE),
+     >                 MAXMIX,MNBURN,
+     >                 ITEXT4,ITCPO,NCMIXS,
+     >                 IPRINT,ILIST,IMIXT,NMIXT,NEL,NG,NGMTR,
+     >                 NMATZ,MTRMSH,NZONE,NGREAC,
+     >                 NRCELA,NRREGI,NGCOND,NGCCPO,IGC,ILASTG
+      TYPE(C_PTR)      IPCPO
+*----
+*  DATA
+*----
+      CHARACTER        NALOCP(MNLOCP+MNCPLP)*4
+      INTEGER          IDLCPL(2,MNLOCP+MNCPLP)
+      SAVE             NALOCP,IDLCPL
+      DATA             NALOCP /'FT  ','MT  ','MD  ','MP  ',
+     >                         'MB  ','CT  ','CD  ','CP  ',
+     >                         'RT  ','RD  ','RP  ','MTMD'/
+      DATA             IDLCPL /  1, 0,  2, 0,  3, 0,  4, 0,
+     >                           5, 0,  6, 0,  7, 0,  8, 0,
+     >                           9, 0, 10, 0, 11, 0,  2, 3/
+*----
+*  PRINT CREDITS
+*----
+      WRITE(IOUT,6900) NAMMOD
+      WRITE(IOUT,6910)
+*----
+*  SET TITLE
+*----
+      TEXT4='    '
+      READ(TEXT4,'(A4)') ITEXT4
+      TITLE=' '
+      TITLE(1:6)=NAMSBR
+      TITLE(9:20)=NAMVER
+      TITLE(21:32)=NAMDAT
+*----
+*  ALLOCATE MEMORY FOR ENERGY
+*----
+      ALLOCATE(IFGCND(MXGRP),IFGMTR(MXGRP),IFGEDI(MXGRP))
+      ALLOCATE(ENET16(MXGRP+1),ENECPO(MXGRP+1),VELMTR(MXGRP))
+*----
+*  NUMBER OF DATA STRUCTURES
+*----
+      IF(NENTRY .LT. 2) THEN
+        CALL XABORT(NAMSBR//
+     >  ': AT LEAST TWO DATA STRUCTURES EXPECTED.')
+      ENDIF
+*----
+*  FIRST DATA STRUCTURE IS CPO
+*----
+      IF(IENTRY(1) .NE. 1 .AND. IENTRY(1) .NE. 2 ) THEN
+        CALL XABORT(NAMSBR//
+     >  ': LINKED LIST OR XSM FILE EXPECTED FOR CPO.')
+      ENDIF
+      IPCPO=KENTRY(1)
+      ITCPO=0
+      IF(JENTRY(1) .EQ. 0) THEN
+*----
+* New CPO
+*----
+        HSIGN='L_COMPO'
+        CALL LCMPTC(IPCPO,'SIGNATURE',12,HSIGN)
+        ISTATE(:NSTATE)=0
+        ISTATE(3)=1
+        ISTATE(4)=2
+        ISTATE(6)=1
+        ISTATE(7)=MNLOCP+MNCPLP
+        ISTATE(8)=MNLOCP
+        ISTATE(9)=72
+      ELSE IF(JENTRY(1) .EQ. 1) THEN
+*----
+* Update CPO
+*----
+        CALL LCMGTC(IPCPO,'SIGNATURE',12,HSIGN)
+        IF(HSIGN .NE. 'L_COMPO') THEN
+          CALL XABORT(NAMSBR//': SIGNATURE OF '//HENTRY(1)//
+     >      ' IS '//HSIGN//'. L_COMPO EXPECTED.')
+        ENDIF
+        CALL LCMGET(IPCPO,'STATE-VECTOR',ISTATE)
+        IF(ISTATE(3) .NE. 1) CALL XABORT(NAMSBR//
+     >  ': INVALID NUMBER OF ISOTOPES ON UPDATE CPO')
+        IF(ISTATE(4) .NE. 2) CALL XABORT(NAMSBR//
+     >  ': INVALID SCATTERING ANISOTROPY ON UPDATE CPO')
+        IF(ISTATE(5) .LE. 1) CALL XABORT(NAMSBR//
+     >  ': INVALID NUMBER OF BURNUP STEP ON UPDATE CPO')
+        IF(ISTATE(6) .NE. 1) CALL XABORT(NAMSBR//
+     >  ': UPDATE CPO DOES NOT MATCH TAPE16 FORMAT')
+        IF(ISTATE(7) .NE. MNLOCP+MNCPLP) CALL XABORT(NAMSBR//
+     >  ': INVALID NUMBER OF PERTURBATION TYPES ON UPDATE CPO')
+        IF(ISTATE(8) .NE. MNLOCP) CALL XABORT(NAMSBR//
+     >  ': INVALID NUMBER OF LOCAL PARAMETERS ON UPDATE CPO')
+        IF(ISTATE(9) .NE. 72 ) CALL XABORT(NAMSBR//
+     >  ': INVALID LENGTH OF SUBTITLE ON UPDATE CPO')
+        ITCPO=1
+        IF(ISTATE(2) .GT. 0) THEN
+          CALL LCMGET(IPCPO,'T16CPOENERGY',ENECPO)
+        ENDIF
+      ELSE
+*----
+* Read-only CPO
+*----
+        CALL XABORT(NAMSBR//': READONLY MODE FOR '//HENTRY(1)//
+     >      ' IS ILLEGAL.')
+      ENDIF
+      NCMIXS=ISTATE(1)
+      NGCCPO=ISTATE(2)
+*----
+*  SECOND DATA STRUCTURE IS TAPE16 FILE
+*----
+      IF(IENTRY(2) .NE. 3) THEN
+        CALL XABORT(NAMSBR//
+     >  ': SEQUENTIAL BINARY FILE EXPECTED FOR TAPE16.')
+      ENDIF
+      IF(JENTRY(2) .NE. 2) THEN
+        CALL XABORT(NAMSBR//': READONLY MODE FOR '//HENTRY(2)//
+     >      ' IS REQUIRED.')
+      ENDIF
+      IFT16=FILUNIT(KENTRY(2))
+*----
+*  INITIALIZE DEFAULT INPUT OPTIONS
+*  AND READ DATA UNTIL KEYWORD MIX IS REACHED
+*----
+      IPRINT=1
+      ILIST=0
+      IMIXT=0
+      NMIXT=1
+      NGCOND=0
+ 100  CONTINUE
+      CALL REDGET(ITYPE,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(ITYPE.NE.3) CALL XABORT(NAMSBR//
+     >  ' KEYWORD EXPECTED')
+      IF(TEXT12.EQ.';') THEN
+        GO TO 105
+      ELSE IF(TEXT12.EQ.'EDIT') THEN      
+        CALL REDGET(ITYPE,IPRINT,FLOTT,TEXT12,DFLOTT)
+        IF(ITYPE.NE.1) CALL XABORT(NAMSBR//
+     >    ': EDIT LEVEL EXPECTED')
+      ELSE IF(TEXT12.EQ.'NMIX') THEN
+        CALL REDGET(ITYPE,NMIXT,FLOTT,TEXT12,DFLOTT)
+        IF(ITYPE.NE.1) CALL XABORT(NAMSBR//
+     >    ': NUMBER OF MIXTURE EXPECTED')
+      ELSE IF(TEXT12.EQ.'CONDG') THEN
+        CALL REDGET(ITYPE,NGCOND,FLOTT,TEXT12,DFLOTT)
+        IF(ITYPE.NE.1) CALL XABORT(NAMSBR//
+     >    ': NUMBER OF CONDENSATION GROUP EXPECTED')
+        ILASTG=0
+        DO 101 IGC=1,NGCOND
+          CALL REDGET(ITYPE,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(ITYPE.NE.1) CALL XABORT(NAMSBR//
+     >      ': GROUP NUMBER REQUIRED')
+          IF( NITMA .GT. MXGRP .OR. NITMA .LT. ILASTG) THEN
+            CALL XABORT(NAMSBR//
+     >      ': INVALID GROUP SEQUENCE PROVIDED')
+          ENDIF
+          IFGCND(IGC)=NITMA
+ 101    CONTINUE
+      ELSE IF(TEXT12.EQ.'LIST') THEN
+        ILIST=1
+      ELSE IF(TEXT12.EQ.'MIX') THEN
+        IMIXT=1
+        GO TO 105
+      ENDIF
+      GO TO 100
+105   CONTINUE
+      IF(ILIST .EQ. 1) THEN
+        CALL T16LST(IFT16)
+      ENDIF
+*----
+*  SCAN T16 FOR DIMENSIONING DATA
+*----
+      CALL T16DIM(IFT16 ,IPRINT,MXGRP ,SUBTIT,NEL   ,NG    ,
+     >            NGMTR ,NMATZ ,MTRMSH,NZONE ,NGREAC,NRCELA,
+     >            NRREGI,IFGMTR,IFGEDI)
+*----
+*  ANALYZE CONDENSED GROUP STRUCTURE
+*----
+      CALL T16ENE(IPRINT,MXGRP ,NG    ,NGCOND,NGMTR ,NGREAC,
+     >            NGCCPO,IFGCND,IFGMTR,IFGEDI,ENECPO,ENET16,
+     >            VELMTR)
+      MNBURN=ISTATE(5)
+*----
+*  DEFINE DIMENSIONS ADEQUATELY, ALLOCATE MEMORY AND
+*  INITIALIZE
+*----
+      MAXMIX=NCMIXS+NMIXT
+      ALLOCATE(NAMMIX(2*MAXMIX),MIXRCI((2+MNLOCP+MNCPLP)*MAXMIX),
+     > MIXPER(MNPERT*(MNLOCP+MNCPLP)*MAXMIX),MIXREG(MAXMIX))
+      ALLOCATE(PARRCI(MNLOCP*MAXMIX),
+     > PARPER(MNPERT*2*(MNLOCP+MNCPLP)*MAXMIX))
+      NAMMIX(:2*MAXMIX)=ITEXT4
+      MIXRCI(:(2+MNLOCP+MNCPLP)*MAXMIX)=0
+      MIXPER(:MNPERT*(MNLOCP+MNCPLP)*MAXMIX)=0
+      MIXREG(:MAXMIX)=0
+      PARRCI(:MNLOCP*MAXMIX)=0.0
+      PARPER(:MNPERT*2*(MNLOCP+MNCPLP)*MAXMIX)=0.0
+*----
+*  INITIALIZE DEFAULT VALUES FOR ABOVE MIXTURE PARAMETERS
+*  VECTORS
+*----
+      IF(ITCPO .EQ. 1) THEN
+        CALL T16MPI(IPCPO ,IPRINT,MAXMIX,MNLOCP,MNCPLP,MNPERT,
+     >              NALOCP,IDLCPL,NCMIXS,NGCCPO,ENECPO,NAMMIX,
+     >              MIXRCI,PARRCI,PARPER)
+      ENDIF
+*----
+*  MODIFIFY VALUES FOR ABOVE VECTORS AS SPECIFIED ON INPUT FILE
+*----
+      IF(IMIXT .EQ. 1) THEN
+        CALL T16GET(MAXMIX,MNLOCP,MNCPLP,MNPERT,NALOCP,IDLCPL,
+     >              NCMIXS,MNBURN,NAMMIX,MIXRCI,PARRCI,MIXPER,
+     >              PARPER,MIXREG)
+*----
+*  SAVE MODIFIED VALUES FOR ABOVE MIXTURE PARAMETERS
+*  VECTORS
+*----
+        CALL T16MPS(IPCPO ,IPRINT,MAXMIX,MNLOCP,MNCPLP,MNPERT,
+     >              NALOCP,IDLCPL,NCMIXS,NGCCPO,TITLE ,SUBTIT ,
+     >              ENECPO,NAMMIX,MIXRCI,PARRCI,PARPER)
+      ENDIF
+      DEALLOCATE(PARPER,PARRCI)
+*----
+*  SAVE UPDATED STATE-VECTOR
+*----
+      ISTATE(1)=NCMIXS
+      ISTATE(2)=NGCCPO
+      ISTATE(5)=MNBURN
+      CALL LCMPUT(IPCPO,'T16CPOENERGY',NGCCPO+1,2,ENECPO)
+      CALL LCMPUT(IPCPO,'STATE-VECTOR',NSTATE,1,ISTATE)
+*----
+*  CALL MAIN T16 CROSS SECTION DRIVER
+*----
+      CALL T16DRV(IPCPO ,IFT16 ,IPRINT,MNLOCP,MNCPLP,MNPERT,
+     >            NALOCP,NCMIXS,NGCCPO,MNBURN,NG    ,NGMTR ,
+     >            NMATZ ,MTRMSH,NZONE ,IFGMTR,VELMTR,NAMMIX,
+     >            MIXRCI,MIXPER,MIXREG)
+*----
+*  RELEASE MEMORY
+*----
+      DEALLOCATE(MIXREG,MIXPER,MIXRCI,NAMMIX)
+      DEALLOCATE(VELMTR,ENECPO,ENET16)
+      DEALLOCATE(IFGEDI,IFGMTR,IFGCND)
+      WRITE(IOUT,6901) NAMMOD
+      RETURN
+*----
+*  PRINT FORMAT
+*----
+ 6900 FORMAT('->@BEGIN MODULE : ',A12)
+ 6901 FORMAT('->@END MODULE   : ',A12)
+ 6910 FORMAT('->@DESCRIPTION  : CONVERT WIMS-TAPE16 TO DRAGON-CPO'/
+     >       '->@CREDITS      : G. MARLEAU'/
+     >       '->@COPYRIGHTS   : ECOLE POLYTECHNIQUE DE MONTREAL'/
+     >       '                  ATOMIC ENERGY OF CANADA LIMITED')
+      
+      END