diff options
Diffstat (limited to 'Donjon/src/D2PHEL.f')
| -rw-r--r-- | Donjon/src/D2PHEL.f | 363 |
1 files changed, 363 insertions, 0 deletions
diff --git a/Donjon/src/D2PHEL.f b/Donjon/src/D2PHEL.f new file mode 100644 index 0000000..3360d32 --- /dev/null +++ b/Donjon/src/D2PHEL.f @@ -0,0 +1,363 @@ + SUBROUTINE D2PHEL ( IPHEL, IPDAT, IPMIC , IPINP, STAVEC, + > JOBOPT, IPRINT ) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Store the header of HELIOS.dra file - (independant data compared with +* branching calculation) at phase 1 +* WARNING: 04/2014 : the format of this file respect the HELIOS format +* (it cannot be changed) +* The information is recovered from the input file (.x2m) and stored in +* the INFO DATA block. The user can change any values in the input file +* +*Author(s): +* J. Taforeau +* +*Parameters: input +* IPHEL file unit of HELIOS like file +* IPDAT adress of info data block +* STAVEC various parameters associated with the IPDAT structure +* FC1 FILE_CONT_1 recovered from D2P: input +* FC2 FILE_CONT_2 recovered from D2P: input +* FC3 FILE_CONT_3 recovered from D2P: input +* FC4 FILE_CONT_4 recovered from D2P: input +* XSC XS_CONT recovered from D2P: input +* IPRINT control the printing on screen +* +*Parameters: +* IPMIC +* IPINP +* JOBOPT +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPDAT,IPMIC + INTEGER IPHEL + INTEGER STAVEC(40) + ! FILE_CONT DATA BLOC ( CF D2P: DOCUMENTATION) + REAL FC1(2) + REAL FC2(8) + REAL FC3(7) + REAL FC4(3) + REAL XSC(3) + REAL DATSRC(5) +*---- +* LOCAL VARIABLES +*---- + INTEGER NBU,FA_K + CHARACTER*16 JOBTIT + CHARACTER*12 FILNAM + CHARACTER*1 DER + CHARACTER*40 COM + CHARACTER*1 JOBOPT(16) + REAL HISTORY(STAVEC(2)-1) + CHARACTER*4 STAVAR(STAVEC(2)) + INTEGER IUPS,XESM + REAL VERS + + + NBU=STAVEC(4) + NPAR=STAVEC(2) + NVAR=NPAR-1 + + ! RECOVER INFORMATION FROM INFO/HELIOS_HEAD DATA BLOCK + CALL LCMSIX(IPDAT,' ',0) + CALL LCMSIX(IPDAT,'SAPHYB_INFO',1) + + CALL LCMGTC(IPDAT,'IDEVAR',4,NPAR,STAVAR) + CALL LCMSIX(IPDAT,' ',0) + CALL LCMSIX(IPDAT,'GENPMAXS_INP',1) + CALL LCMGET(IPDAT,'DAT_SRC',DATSRC) + CALL LCMGTC(IPDAT,'JOB_TIT',16,JOBTIT) + CALL LCMGTC(IPDAT,'DERIVATIVE',1,DER) + CALL LCMGET(IPDAT,'IUPS',IUPS) + CALL LCMGET(IPDAT,'XESMOPT',XESM) + CALL LCMGTC(IPDAT,'COMMENT',40,COM) + CALL LCMGET(IPDAT,'VERSION',VERS) + CALL LCMGTC(IPDAT,'FILE_NAME',12,FILNAM) + CALL LCMSIX(IPDAT,' ',0) + CALL LCMSIX(IPDAT,'HELIOS_HEAD',1) + CALL LCMGET(IPDAT,'FILE_CONT_1',FC1) + CALL LCMGET(IPDAT,'FILE_CONT_2',FC2) + CALL LCMGET(IPDAT,'FILE_CONT_3',FC3) + CALL LCMGET(IPDAT,'FILE_CONT_4',FC4) + CALL LCMGET(IPDAT,'XS_CONT',XSC) + CALL LCMSIX(IPDAT,' ',0) + CALL LCMSIX(IPDAT,'BRANCH_INFO',1) + !RECOVER HISTORY STATE AND number of branches + CALL LCMGET(IPDAT,'HST_STATE',HISTORY) + CALL LCMGET(IPDAT,'BRANCH_NB',NBR) + + IF (IUPS.EQ.2) IUPS=0 + FA_K=INT(DATSRC(3)) + IF ((STAVEC(21).EQ.1) .and. (JOBOPT(1).EQ.'T') )THEN + JOBOPT(1)='F' + ENDIF + IF (STAVEC(19).EQ.0) THEN + DO I=1,NVAR + IF (STAVAR(I).EQ.'TF ') THEN + + HISTORY(I)=HISTORY(I)+273.15 + ENDIF + IF (STAVAR(I).EQ.'TC ') THEN + HISTORY(I)=HISTORY(I)+273.15 + ENDIF + ENDDO + ENDIF + + CALL LCMSIX(IPDAT,' ',0) + CALL LCMSIX(IPDAT,'BRANCH_INFO',1) + CALL LCMPUT(IPDAT,'HST_STATE',NVAR,2,HISTORY) + ! WRITING JOBTIT CARD + WRITE (IPINP,*) '%JOB_TIT' + WRITE (IPINP,'(A,A,A,1X,A,1X,F3.1,1X,A,A,A)') + 1'"',JOBTIT,'"',DER, VERS, '"',COM,'"' + + ! WRITING JOB_OPT CARD + WRITE (IPINP,*) '%JOB_OPT' + WRITE (IPINP,'(14(A,1X),2(I1,1X))',advance="no") + 1 JOBOPT(1:14),IUPS,XESM + WRITE (IPINP,'(/A)') + 1'!ad,xe,de,j1,ch,Xd,iv,dt,yl,cd,gf,be,lb,dc,ups' + + ! WRITING DAT_SRC CARD + WRITE (IPINP,*) '%DAT_SRC' + WRITE(IPINP,'(I2,1X,I2,1X,I2,1X,F3.1,1X,F3.1)')INT(DATSRC(1)), + 1INT(DATSRC(2)),INT(DATSRC(3)),DATSRC(4),DATSRC(5) + + ! WRITING STA_VAR CARD + WRITE (IPINP,*) '%STA_VAR' + WRITE (IPINP,'(I2/,3(A,1X,A))') NVAR,(STAVAR(I), I=1,NVAR) + + ! WRITING HISTORY CARD + ! CONCERN THE CONTROL ROD COMPOSITION + IF(HISTORY(1)==0) THEN + HISTORY(1)=1 + ELSE IF(HISTORY(1)==1) THEN + HISTORY(1)=0 + ELSE IF(HISTORY(1)==2) THEN + HISTORY(1)=2 + ENDIF + + WRITE (IPINP,*) '%HISTORY' + WRITE (IPINP,'(I1,1X,I1,/,A,1X,3(F11.5,1X,F11.5,1X))') 1,1, + 1'HIST01',(HISTORY(I), I=1,NVAR) + + ! WRITING BRANCH CARD + WRITE (IPINP,*) '%BRANCH' + WRITE (IPINP,'(I4,1X,I1)') NBR, 1 + + + ! WRITE FILE_CONT DATA in HELIOS.dra file + IF(IPRINT > 0) WRITE(6,*) "STEP 1 : EDIT THE HEADER " + CALL SET_INFO(IPHEL) + IF(IPRINT > 0) WRITE(6,*) "STEP 2 : EDIT THE CONT1 BLOCK " + IF (FA_K.EQ.0) THEN + FC1(1)=0. + ELSE + IF (FC1(1).EQ.0.) THEN + + CALL LCMSIX(IPMIC,'',0) + CALL LCMSIX(IPMIC,'MACROLIB',1) + CALL LCMLEN(IPMIC,'MASL',ILONG,ITYLCM) + IF (ILONG.GT.1) THEN + CALL XABORT("@D2PHEL: MORE THAN 1 METAL DENS. IN THE MICROLIB") + ELSE IF (ILONG.EQ.0) THEN + WRITE(6,*)"@D2PHEL: RECORD MASL NOT FOUND IN MICROLIB" + WRITE(6,*)"=> PLEASE USE THE FILE_CONT_1 CARD IN D2P:" + CALL XABORT(" OR USE THE 'REFLECTOR' KEYWORD") + ELSE + CALL LCMGET(IPMIC,'MASL',FC1(1)) + ENDIF + ELSE IF (FC1(1).LE.0.) THEN + CALL XABORT('@D2PHEL: NEGATIVE VALUE FOR HEAVY METAL DENSITY') + ENDIF + ENDIF + CALL LCMPUT(IPDAT,'FILE_CONT_1',2,2,FC1) + CALL SET_CONT1(IPHEL,STAVEC,FC1,IPRINT) + ! IF(IPRINT > 0) WRITE(6,*) "STEP 3 : EDIT THE CONT2 BLOCK " + ! CALL SET_CONT2(IPHEL,FC2,NGP,IPRINT) + IF(IPRINT > 0) WRITE(6,*) "STEP 4 : EDIT THE CONT3 BLOCK " + CALL SET_CONT3(IPHEL,FC3,IPRINT) + IF(IPRINT > 0) WRITE(6,*) "STEP 5 : EDIT THE CONT4 BLOCK " + CALL SET_CONT4(IPHEL,FC4,IPRINT) + + ! MOVE TO GENPMAXS_INP DIRECTORY + CALL LCMSIX(IPDAT,' ',0) + CALL LCMSIX(IPDAT,'GENPMAXS_INP',1) + IF ((STAVEC(21).EQ.1) .and. (JOBOPT(1).EQ.'F') )THEN + JOBOPT(1)='T' + ENDIF + END + + SUBROUTINE SET_CONT1(IPHEL,STAVEC,FILE_CONT_1,IPRINT) + INTEGER STAVEC(40) + REAL FILE_CONT_1(2) + + WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' + WRITE(IPHEL,*) 'Labels Array : KINF' + WRITE(IPHEL,*) 'List Title(s) 1) ===========================' + WRITE(IPHEL,*) ' 2) %FILE_CONT 1' + WRITE(IPHEL,*) ' 3) ===========================' + WRITE(IPHEL,*) ' 4) Meaning : NGROUP, NCOLS, NR' + 1 //'OWS, PART,' + WRITE(IPHEL,*) ' HM Density, Bypass Density ' + CALL SET_RIEGO(IPHEL) + WRITE(IPHEL,120) 'NGROUP','NCOLS','NROWS','PART', + 1 'DenHM','DenByp' + WRITE(IPHEL,125) 'Label E','.-.-E-.-.','.-.-E-.-.','.-.-E-.-.', + 1 '.-.-E-.-.','1-.-E-.-.','.-.-E-.-.' + WRITE(IPHEL,130) ' 1 HST 1 HST : 0',STAVEC(1), + 1 STAVEC(8),STAVEC(9), STAVEC(10), + 2 FILE_CONT_1(1),FILE_CONT_1(2) + WRITE(IPHEL,'()') + IF(IPRINT > 1) THEN + WRITE(6,*) + WRITE(6,*) "CONTENT : NGROUP, NCOLS, NROWS, PART,", + 1 " HM Density, Bypass Density " + WRITE(6,*) "VALUES :",STAVEC(1),STAVEC(8:10),FILE_CONT_1 + WRITE(6,*) + ENDIF + 120 FORMAT(27X,A,9X,A,9X,A,10X,A,9X,A,8X,A) + 125 FORMAT(6X,A,12X,A,3X,A,3X,A,3X,A,3X,A,3X,A) + 130 FORMAT(A,10X,I2,10X,I2,10X,I2,10X,I2,5X,F7.5,5X,F7.5) + END + + SUBROUTINE SET_CONT2(IPHEL,FILE_CONT_2,NGROUP,IPRINT) + INTEGER NGROUP + CHARACTER*9 LABEL + REAL FILE_CONT_2(NGROUP) + + WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' + WRITE(IPHEL,*) 'Labels Array : KINF' + WRITE(IPHEL,*) 'List Title(s) 1) ===========================' + WRITE(IPHEL,*) ' 2) %FILE_CONT 2' + WRITE(IPHEL,*) ' 3) ===========================' + WRITE(IPHEL,*) ' 4)Meaning : Lower Energy of Neu' + 1 //'tron Groups' + CALL SET_RIEGO(IPHEL) + + IF(NGROUP .EQ. 8) THEN + WRITE(IPHEL,220) 'EMIN','EMIN' + WRITE(IPHEL,225) 'Label E' + DO I=1, NGROUP + WRITE(LABEL,'(A,I1,A)')".-.-E-",I,"-." + PRINT*,"LABEL",LABEL + WRITE(IPHEL,'(A9,5X)',advance='no')LABEL + ENDDO + WRITE(IPHEL,230) ' 1 HST 1 HST : 0',FILE_CONT_2(1), + 1 FILE_CONT_2(2) + ELSE + CALL XABORT ("@D2PHEL: NUMBER OF ENERGY GROUPS MUST BE 2") + ENDIF + + IF(IPRINT > 1) THEN + WRITE(6,*) + WRITE(6,*) "CONTENT : Lower Energy of Neutron Groups" + WRITE(6,*) "VALUES :",FILE_CONT_2 (1:NGROUP) + WRITE(6,*) + ENDIF + + 220 FORMAT(32X,A,10X,A) + 225 FORMAT(6X,A,17X) + 230 FORMAT(A,ES12.5E2,ES12.5E2) + END + + SUBROUTINE SET_CONT3(IPHEL,FILE_CONT_3,IPRINT) + REAL FILE_CONT_3(7) + + WRITE(IPHEL,'()') + WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' + WRITE(IPHEL,*) 'Labels Array : KINF' + WRITE(IPHEL,*) 'List Title(s) 1) ===========================' + WRITE(IPHEL,*) ' 2) %FILE_CONT 3' + WRITE(IPHEL,*) ' 3) ===========================' + WRITE(IPHEL,*) ' 4)Meaning : Regions Volume' + + CALL SET_RIEGO(IPHEL) + + WRITE(IPHEL,320) 'VCool','VWatR','VModr','VCnRd','VFuel', + 1 'VClad','VChan' + WRITE(IPHEL,310) 'Label E','1-.-E-.-.','.-.-E-.-.','1-.-E-.-.', + 1 '1-.-E-.-.','1-.-E-.-.','1-.-E-.-.','1-.-E-.-.' + WRITE(IPHEL,390) ' 1 HST 1 HST : 0',FILE_CONT_3(1), + 1 FILE_CONT_3(2),FILE_CONT_3(3),FILE_CONT_3(4),FILE_CONT_3(5), + 2 FILE_CONT_3(6),FILE_CONT_3(7) + + + IF(IPRINT > 1) THEN + WRITE(6,*) + WRITE(6,*) "CONTENT : VCool, VWatR, VModr, VCnRd, VFuel,", + 1 " VClad, VChan" + WRITE(6,*) "VALUES :",FILE_CONT_3 + WRITE(6,*) + ENDIF + + 310 FORMAT(6X,A,12X,A,3X,A,3X,A,3X,A,3X,A,3X,A,3X,A) + 320 FORMAT(27X,A,2X,A,9X,A,9X,A,9X,A,9X,A,9X,A,9X,A) + 390 FORMAT(A,ES12.5E2,ES12.5E2,ES12.5E2,ES12.5E2, + 1 ES12.5E2,ES12.5E2,ES12.5E2,ES12.5E2) + END + + SUBROUTINE SET_CONT4(IPHEL,FILE_CONT_4,IPRINT) + REAL FILE_CONT_4(3) + + WRITE(IPHEL,'()') + WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' + WRITE(IPHEL,*) 'Labels Array : KINF' + WRITE(IPHEL,*) 'List Title(s) 1) ===========================' + WRITE(IPHEL,*) ' 2) %FILE_CONT 4' + WRITE(IPHEL,*) ' 3) ===========================' + WRITE(IPHEL,*) ' 4) Cell Pitch and X,Y Pos of F' + 1 //'irst Cell' + + CALL SET_RIEGO(IPHEL) + + WRITE(IPHEL,320) 'PITCH','XBE','YBE' + WRITE(IPHEL,410) 'Label E','.-.-E-.-.','.-.-E-.-.','.-.-E-.-.' + WRITE(IPHEL,390) ' 1 HST 1 HST : 0',FILE_CONT_4(1), + 1 FILE_CONT_4(2),FILE_CONT_4(3) + + IF(IPRINT > 1) THEN + WRITE(6,*) + WRITE(6,*) "CONTENT : PITCH ,XBE , YBE" + WRITE(6,*) "VALUES :", FILE_CONT_4 + WRITE(6,*) + ENDIF + + 320 FORMAT(24X,A,11X,A,11X,A) + 390 FORMAT(A,ES12.5E2,ES12.5E2,ES12.5E2) + 410 FORMAT(6X,A,12X,A,5X,A,5X,A) + END + + SUBROUTINE SET_INFO(IPHEL) + WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' + WRITE(IPHEL,*) 'Pre-processing for PMAXS Generation' + DO I=1, 18 + WRITE(IPHEL,*) '*' + ENDDO + WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' + WRITE(IPHEL,*) 'DRAGON CALCULATION BY J.TAFOREAU' + + WRITE(IPHEL,*) 'HELIOS Cases Used:' + WRITE(IPHEL,'()') + WRITE(IPHEL,*) ' 1) IMP-operator name : kkk' + WRITE(IPHEL,*) ' DRAGON case : kkk' + WRITE(IPHEL,*) ' Title(s) 1 : kkk' + WRITE(IPHEL,'()') + END + + SUBROUTINE SET_RIEGO(IPDRA) + WRITE(IPDRA,'()') + WRITE(IPDRA,*) '(R) Area/Face names : unlabeled' + WRITE(IPDRA,*) '(I) Isotope Identifiers : unlabeled' + WRITE(IPDRA,*) '(E) Path (STATE) idents : * ' + WRITE(IPDRA,*) '(G) Group name : unlabeled' + WRITE(IPDRA,*) '(O) Originating Group : unlabeled' + WRITE(IPDRA,'()') + END |