From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001 From: stainer_t Date: Mon, 8 Sep 2025 13:48:49 +0200 Subject: Initial commit from Polytechnique Montreal --- Donjon/src/T16CPO.f | 320 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 320 insertions(+) create mode 100644 Donjon/src/T16CPO.f (limited to 'Donjon/src/T16CPO.f') 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 -- cgit v1.2.3