*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