diff options
Diffstat (limited to 'Donjon/src/D2P.f')
| -rw-r--r-- | Donjon/src/D2P.f | 1155 |
1 files changed, 1155 insertions, 0 deletions
diff --git a/Donjon/src/D2P.f b/Donjon/src/D2P.f new file mode 100644 index 0000000..96b1ccf --- /dev/null +++ b/Donjon/src/D2P.f @@ -0,0 +1,1155 @@ +*DECK PMAXS + SUBROUTINE D2P(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY) +* +*----------------------------------------------------------------------- +* +*Purpose: +* PMAXS interface file generation. +* +*Copyright: +* Copyright (C) 2015 IRSN +* +*Author(s): +* J. Taforeau +* +*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: +* None +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY) + TYPE(C_PTR) KENTRY(NENTRY) + CHARACTER HENTRY(NENTRY)*12 +*---- +* LOCAL VARIABLES +*---- + INTEGER :: STAVEC(40) = 0 + CHARACTER TEXT*72 + INTEGER UV + INTEGER :: NFC1 = 0 + INTEGER :: NFC2 = 0 + INTEGER :: NFC3 = 0 + INTEGER :: NFC4 = 0 + INTEGER :: NXC = 0 + INTEGER :: JOBT = 0 + INTEGER :: NGP = 2 + INTEGER :: NCRD = 0 + INTEGER :: MIX = 1 + INTEGER :: FA_K = -1 + INTEGER :: IUPS = 0 + INTEGER :: USRSTA = 0 + INTEGER :: XESM = 3 + INTEGER :: ITEMP = 0 + INTEGER :: NOTHPK = 0 + INTEGER :: IOTHPK = 0 + REAL :: VERS = 3.0 + REAL :: SFAC = 1.0 + REAL :: BFAC = 1.0 + REAL :: THCK = -1. + REAL FLOTT + INTEGER PHASE, ITYPLIR, NITMA + DOUBLE PRECISION DFLOT + INTEGER :: IPRINT = -1 + INTEGER,DIMENSION(20) :: CRDINF = -1 + INTEGER,DIMENSION(12) :: USRVAL = 0 + INTEGER ,DIMENSION(12) :: OTHTYP = 2 + REAL,DIMENSION(5) :: LOCYLD = (/0.,-1.,-1.,-1.,-1. /) + REAL,DIMENSION(5)::FC1=(/17.0,17.0,3.0,0.0,0.73659 /) + REAL,DIMENSION(8)::FC2 + DATA FC2/6.2506E-01,1E-04,6*0.0/ + REAL,DIMENSION(7)::FC3 + DATA FC3/2.4921E+02, 2.4921E+02, 2.4921E+02, 2.3020E+01, + 1 1.4407E+02, 4.5099E+01, 4.5099E+01/ + REAL,DIMENSION(3)::FC4 + DATA FC4/1.44270E+00, 7.21350E-01, 7.21350E-01/ + REAL,DIMENSION(3)::XSC + DATA XSC/ 1.0, 1.0, 5.32151E-01/ + REAL,DIMENSION(3)::YLD + DATA YLD/ 0.06386, 0.00228, 0.0113/ + CHARACTER*16 :: JOBTIT = 'D2P.PMAXS' + CHARACTER*40 :: COM = 'PWR CASE : UOX/MOX CORE FUEL' + CHARACTER*12 :: FILNAM = 'HELIOS.dra' + CHARACTER*12 :: MIXDIR = 'default ' + CHARACTER*12 :: HDET = 'NULL ' + CHARACTER*4 :: DER = 'T' + CHARACTER*1 :: JOBOPT(16) + CHARACTER*5 :: MESH = 'SAP' + CHARACTER*12 :: USRPAR(12) = ' ' + CHARACTER*12 :: OTHPK(12) = ' ' + CHARACTER*8 :: HCUR(2)= 'NUL' + CHARACTER*8 :: HFLX(2)= 'NUL' + + CHARACTER*12,DIMENSION(12) :: OTHVAL = ' ' + REAL :: OTHVAR(12) + + REAL USRVAPK(12,10) + CHARACTER*4 :: CRDMOD = ' ' + CHARACTER*3 :: ADF = 'NUL' + CHARACTER*3 :: CDF = 'NUL' + CHARACTER*8,DIMENSION(4) :: ADFD = 'FD_B ' + CHARACTER*8,DIMENSION(8) :: CDFD = 'FD_C ' + CHARACTER*3 :: GFF = 'NUL' + CHARACTER*12,DIMENSION(6) :: PKEY + DATA PKEY/ "BARR","DMOD","CBOR","TCOM","TMOD","BURN"/ + CHARACTER*12,DIMENSION(6) :: REFNAM + DATA REFNAM/ "BARR","DMOD","CBOR","TCOM","TMOD","BURN"/ + CHARACTER*12,DIMENSION(8) :: ISOT + DATA ISOT/ "XE135PF","SM149PF","I135PF","PM149PF","PM148PF", + > "PM148MPF","ND147PF","PM147PF"/ + DATA JOBOPT/14*'F',"",""/ + CHARACTER*3 :: YLDOPT = 'REF' + CHARACTER*4 :: OPT = 'NONE' + CHARACTER*4 :: HEQUI = 'NONE' + CHARACTER*4 :: HMASL = 'NONE' + CHARACTER*1 :: ISOTOPT = '*' + REAL :: ISOTVAL = 0. + LOGICAL :: SAP=.FALSE. + LOGICAL :: MIC=.TRUE. + LOGICAL :: EXCESS=.FALSE. + LOGICAL :: SCAT=.FALSE. + LOGICAL :: LADD=.FALSE. + LOGICAL :: LNEW=.FALSE. + LOGICAL :: LPRC=.FALSE. + LOGICAL :: LMEM=.FALSE. + LOGICAL :: LCOR=.FALSE. + OTHVAR(:) = -1 +*---- +* parameters VALIDATION +*---- +*---- +* RECOVER iPHASE AND iPRINT INDICES +*---- + WRITE(6,*) "****************************************************" + WRITE(6,*) "* RECOVERING D2P: DATA INPUT *" + WRITE(6,*) "****************************************************" + + 100 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.NE.3) THEN + CALL XABORT ('@D2P: KEYWORD EXPECTED AS INPUT OF D2P: MODULE') + ELSE IF (ITYPLIR.EQ.3) THEN + IF (TEXT.EQ.'PHASE' ) THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.EQ.1) THEN + PHASE=NITMA + GO TO 100 + ELSE + CALL XABORT('@D2P: INTEGER EXPECTED AFTER PHASE KEYWORD') + ENDIF + ELSE IF (TEXT.EQ.'EDIT' ) THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.EQ.1) THEN + IPRINT=NITMA + GO TO 100 + ELSE + CALL XABORT('@D2P: INTEGER EXPECTED AFTER EDIT KEYWORD') + ENDIF + ELSE IF (TEXT.EQ.'MIX') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.EQ.1) THEN + MIX = NITMA + GO TO 100 + ELSE + CALL XABORT('@D2P: INTEGER EXPECTED AFTER MIX KEYWORD') + ENDIF + ELSE IF (TEXT.EQ.'NAMDIR' ) THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.EQ.3) THEN + MIXDIR=TEXT(1:12) + IF(NITMA.GT.12) CALL XABORT('@D2P: C*12 EXPECTED FOR NAMDIR') + GO TO 100 + ELSE + CALL XABORT('@D2P: CHARACTER EXPECTED AFTER NAMDIR') + ENDIF + ELSE IF (TEXT.EQ. 'TEMP') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.EQ.3) THEN + IF (NITMA.NE.1) THEN + CALL XABORT('@D2P: "C" or "K" EXPECTED AFTER TEMP KEYWORD') + ELSE + IF (TEXT.EQ. 'C') THEN + ITEMP=0 + GO TO 100 + ELSE IF (TEXT.EQ. 'K') THEN + ITEMP=1 + GO TO 100 + ELSE + CALL XABORT('@D2P: "C" or "K" EXPECTED AFTER TEMP KEYWORD') + ENDIF + ENDIF + ELSE + CALL XABORT('@D2P: CHARACTER EXPECTED AFTER TEMP KEYWORD') + ENDIF + ELSE IF (TEXT .EQ. 'PKEY') THEN + 15 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.NE.3) THEN + CALL XABORT('@D2P: CHARACTER EXPECTED AFTER PKEY KEYWORD') + ELSE + IF (TEXT.EQ.REFNAM(1)) THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + PKEY(1)=TEXT(:12) + GO TO 15 + ELSE IF (TEXT.EQ.REFNAM(2)) THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + PKEY(2)=TEXT(:12) + GO TO 15 + ELSE IF (TEXT.EQ.REFNAM(3)) THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + PKEY(3)=TEXT(:12) + GO TO 15 + ELSE IF (TEXT.EQ.REFNAM(4)) THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + PKEY(4)=TEXT(:12) + GO TO 15 + ELSE IF (TEXT.EQ.REFNAM(5)) THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + PKEY(5)=TEXT(:12) + GO TO 15 + ELSE IF (TEXT.EQ.REFNAM(6)) THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + PKEY(6)=TEXT(:12) + GO TO 15 + ELSE IF (TEXT.EQ.'ENDPKEY') THEN + GO TO 100 + ELSE + CALL XABORT('@D2P: UNKNOWN PKEY NAME : '//TEXT//'.') + ENDIF + ENDIF + ELSE IF (TEXT .EQ. 'OTHER') THEN + IOTHPK=0 + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF(ITYPLIR.NE.1)THEN + CALL XABORT('@D2P: INTEGER EXPECTED AFTER OTHPK CARD') + ENDIF + NOTHPK=NITMA + STAVEC(20)=NOTHPK + DO WHILE (IOTHPK.LT.NOTHPK) + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF(ITYPLIR.NE.3)THEN + CALL XABORT('@D2P: C*12 (othnam) EXPECTED AFTER OTHPK CARD') + ELSE + IF(NITMA.GT.12)THEN + CALL XABORT('@D2P: C*12 EXPECTED AFTER OTHPK CARD') + ELSE + IOTHPK=IOTHPK+1 + OTHPK(IOTHPK)=TEXT(:12) + ENDIF + ENDIF + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF(ITYPLIR.NE.3)THEN + CALL XABORT('@D2P: C*1 ((othtyp) EXPECTED AFTER OTHPK CARD') + ELSE + IF(NITMA.GT.1)THEN + CALL XABORT('@D2P: C*1 (othtyp) EXPECTED AFTER OTHPK CARD') + ELSE + IF (TEXT.EQ.'R') THEN + OTHTYP(IOTHPK)=2 + ELSE IF (TEXT.EQ.'I') THEN + OTHTYP(IOTHPK)=1 + ELSE IF (TEXT.EQ.'S') THEN + OTHTYP(IOTHPK)=3 + ELSE + WRITE(6,*) '@D2P: UNKNOWN TYPE (',TEXT(:1),') FOR (', + > OTHPK(IOTHPK),') PKEY.' + CALL XABORT('@D2P: PLEASE USE I/R or S') + ENDIF + ENDIF + ENDIF + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF(ITYPLIR.EQ.OTHTYP(IOTHPK))THEN + IF (ITYPLIR.EQ.1) THEN + WRITE(OTHVAL(IOTHPK),*)NITMA + OTHVAR(IOTHPK)=NITMA + ENDIF + IF (ITYPLIR.EQ.2) THEN + WRITE(OTHVAL(IOTHPK),'(f12.5)')FLOTT + OTHVAR(IOTHPK)=FLOTT + ENDIF + IF (ITYPLIR.EQ.3) OTHVAL(IOTHPK)=TEXT(:12) + ELSE + CALL XABORT('@D2P: INCONSISTENT VALUE (othval)') + ENDIF + ENDDO + GO TO 100 + ELSE IF (TEXT .EQ. 'ADF') THEN + 17 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF(ITYPLIR.NE.3)THEN + CALL XABORT('@D2P: C*3 EXPECTED AFTER ADF CARD') + ENDIF + IF(NITMA.GT.5) THEN + CALL XABORT('@D2P: C*3 OR C*5 EXPECTED AFTER ADF CARD') + ENDIF + ADF=TEXT(:3) + IF (TEXT(:5).EQ.'MERGE') THEN + STAVEC(21)=1 + GO TO 17 + ELSE IF ((ADF.NE.'SEL') .AND. (ADF .NE.'GET') + > .AND. (ADF .NE.'DRA').AND. (ADF .NE.'GEN')) THEN + WRITE(6,*) "@D2P: UNKNOWN KEYWORD :", ADF + CALL XABORT('@D2P: DRA, SEL OR GET EXPECTED AFTER ADF CARD') + ENDIF + IF (ADF.EQ.'DRA') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF(ITYPLIR.NE.1) THEN + CALL XABORT('@D2P: INTEGER EXPECTED AFTER ADF DRA CARD') + ENDIF + STAVEC(13)=NITMA !NADF + IF((NITMA.NE.1).AND.(NITMA.NE.4)) THEN + CALL XABORT('@D2P: 1 or 4 EXPECTED AFTER ADF DRA CARD') + ENDIF + DO I=1,STAVEC(13) + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF(ITYPLIR.NE.3) THEN + CALL XABORT('@D2P: NADF STRING EXPECTED AFTER ADF DRA' + > //' CARD') + ENDIF + ADFD(I)=TEXT(:8) + ENDDO + GO TO 100 + ELSEIF (ADF .EQ. 'GEN') THEN + STAVEC(13)= 1 !NADF + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF((ITYPLIR.NE.3).AND.(TEXT(:5).NE.'THICK')) THEN + CALL XABORT('@D2P: REFLECTOR THICKNESS (THICK) EXPECTED') + ELSE + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.NE.2) THEN + CALL XABORT('@D2P: REAL EXPECTED FOR REFLECTOR THICKNESS') + ELSE + THCK=FLOTT + ENDIF + ENDIF + DO J=1,2 + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF(ITYPLIR.NE.3) THEN + CALL XABORT('@D2P: CHARACTER EXPECTED AFTER ADF GEN CARD') + ENDIF + IF ((TEXT(:4).NE.'FLUX').AND.(TEXT.NE.'CURR'))THEN + CALL XABORT('@D2P: FLUX OR CURR KEYWORD EXPECTED AFTER GEN') + ELSE + DO I=1,2 + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF(ITYPLIR.NE.3) THEN + CALL XABORT('@D2P: CHARACTER EXPECTED CURR OR FLUX') + ENDIF + IF (J.EQ.1)HFLX(I)=TEXT(:8) + IF (J.EQ.2)HCUR(I)=TEXT(:8) + ENDDO + ENDIF + ENDDO + GO TO 100 + ENDIF + ELSE IF (TEXT .EQ. 'CDF') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF(ITYPLIR.NE.3)THEN + CALL XABORT('@D2P: C*3 EXPECTED AFTER CDF CARD') + ENDIF + IF(NITMA.NE.3) THEN + CALL XABORT('@D2P: C*3 EXPECTED AFTER CDF CARD') + ENDIF + CDF=TEXT(:3) + IF ((CDF .NE.'DRA')) THEN + WRITE(6,*) "@D2P: UNKNOWN KEYWORD :", CDF + CALL XABORT('@D2P: DRA EXPECTED AFTER CDF CARD') + ENDIF + IF (CDF.EQ.'DRA') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF(ITYPLIR.NE.1) THEN + CALL XABORT('@D2P: Integer EXPECTED AFTER CDF DRA CARD') + ENDIF + STAVEC(15)=NITMA !NCDF + IF((NITMA.NE.1).AND.(NITMA.NE.2).AND.(NITMA.NE.3).AND. + > (NITMA.NE.4).AND.(NITMA.NE.5).AND.(NITMA.NE.8)) THEN + CALL XABORT('@D2P: 1 to 5 or 8 EXPECTED AFTER CDF DRA' + > //' CARD') + ENDIF + DO I=1,STAVEC(15) + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF(ITYPLIR.NE.3) THEN + CALL XABORT('@D2P: NCDF String EXPECTED AFTER CDF DRA' + > //' CARD') + ENDIF + CDFD(I)=TEXT(:8) + ENDDO + ENDIF + GO TO 100 + ELSE IF (TEXT .EQ. 'GFF') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF(ITYPLIR.NE.3)THEN + CALL XABORT('@D2P: C*3 EXPECTED AFTER GFF CARD') + ENDIF + IF(NITMA.NE.3) THEN + CALL XABORT('@D2P: C*3 EXPECTED AFTER GFF CARD') + ENDIF + GFF=TEXT(:3) + IF ((GFF .NE.'DRA')) THEN + WRITE(6,*) "@D2P: UNKNOWN KEYWORD :", GFF + CALL XABORT('@D2P: DRA EXPECTED AFTER GFF CARD') + ENDIF + GO TO 100 + ELSE IF (TEXT.EQ.'FUEL' ) THEN + FA_K=1 + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.NE.3) THEN + CALL XABORT ('@D2P: KEYWORD BARR EXPECTED AFTER FUEL CARD') + ELSE IF (TEXT.EQ.'BARR') THEN + 10 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.EQ.1 .AND. TEXT .NE.'ENDBARR') THEN + IF (TEXT .EQ. 'DEF' .OR. TEXT .EQ. 'USER') THEN + NCRD = NCRD + 1 + IF (NCRD <= 20) THEN + CRDINF(NCRD)=NITMA + GO TO 10 + ELSE + CALL XABORT('@D2P: NUMBER OF BARR COMPOSITIONS EXCEED 20') + ENDIF + ELSE + CALL XABORT('@D2P: DEF OR USER KEYWORD EXPECTED AFTER BARR' + 1 //' KEYWORD') + ENDIF + ELSE IF (ITYPLIR.EQ.3) THEN + IF (TEXT .NE. ';' ) THEN + 11 IF (TEXT .EQ. 'GRID') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.NE.3) THEN + CALL XABORT('@D2P: CHARACTER EXPECTED AFTER GRID KEYWORD') + ELSE + IF((TEXT.EQ.'SAP').OR.(TEXT.EQ.'DEF').OR. + 1 (TEXT.EQ.'USER')) THEN + IF (TEXT.EQ.'SAP') THEN + MESH=TEXT(:5) + GO TO 10 + ELSE IF (TEXT.EQ.'DEF') THEN + MESH=TEXT(:5) + GO TO 10 + ELSE IF (TEXT.EQ.'USER') THEN + 12 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.NE.3) THEN + CALL XABORT('@D2P: KEYWORD EXPECTED AFTER USER KEYWORD') + ELSE IF (TEXT.EQ.'NEW') THEN + LNEW=.TRUE. + GO TO 12 + ELSE IF (TEXT.EQ.'GLOBAL') THEN + IF (LNEW) THEN + CALL XABORT('@D2P: INCOMPATIBLE OPT GLOBAL WITH NEW') + ENDIF + MESH='GLOB' + 90 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.NE.3) THEN + CALL XABORT('@D2P: PKEY NAME EXPECTED IN GLOBAL OPT') + ELSE + IF (TEXT.EQ.'ENDGLOBAL') GO TO 10 + IF(NITMA > 12) THEN + CALL XABORT('@D2P: PKEY NAME IN GLOBAL MUST BE C*12') + ELSE + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + USRSTA = USRSTA+1 + USRPAR(USRSTA)=TEXT(:12) + IF (ITYPLIR.NE.1) THEN + CALL XABORT ('@D2P: NB OF VALUES FOR STATE '//TEXT// + 1 ' EXPECTED') + ELSE + USRVAL(USRSTA)=NITMA + GO TO 90 + ENDIF + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'ADD') THEN + MESH='ADD' + LADD=.TRUE. + 95 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.NE.3) THEN + CALL XABORT('@D2P: PKEY NAME EXPECTED IN USER ADD OPT') + ELSE + IF (TEXT.EQ.'ENDADD') GO TO 10 + IF(NITMA.GE.12) THEN + CALL XABORT('@D2P: STATE NAME IN ADD MUST BE C*12') + ELSE + USRSTA = USRSTA+1 + USRPAR(USRSTA)=TEXT(:12) + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.NE.1) THEN + CALL XABORT('@D2P: NB OF VALUES FOR STATE '//TEXT// + 1 'EXPECTED') + ELSE + USRVAL(USRSTA)=NITMA + DO UV=1,USRVAL(USRSTA) + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR .NE. 2) THEN + CALL XABORT ('@D2P: REAL EXPECTED IN USER ADD OPT') + ELSE + USRVAPK(USRSTA,UV)=FLOTT + ENDIF + ENDDO + UV=1 + GO TO 95 + ENDIF + ENDIF + ENDIF + ELSE + CALL XABORT('@D2P: UNKNOWN OPTION '//TEXT// + 1 'FOR USER OPT') + ENDIF + ENDIF + ELSE + CALL XABORT('@D2P: UNKNOWN OPTION FOR GRID KEYWORD') + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'DEF' .OR. TEXT.EQ.'USER') THEN + CRDMOD=TEXT(:4) + GO TO 10 + ELSE IF (TEXT.EQ.'ENDBARR') THEN + IF (CRDMOD=='DEF') THEN + CALL XABORT('@D2P: ENDBARR KEYWORD IS EXPECTED ONLY FOR' + 1 //' USER BARR COMPOSITION') + ELSE + GO TO 10 + ENDIF + ELSE IF (TEXT .EQ. 'SCATTERING') THEN + SCAT=.TRUE. + GO TO 10 + ELSE IF (TEXT .EQ. 'DET') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF(ITYPLIR.NE.3)THEN + CALL XABORT('@D2P: C*12 EXPECTED AFTER DET CARD') + ENDIF + IF(NITMA.GT.12) THEN + CALL XABORT('@D2P: C*12 EXPECTED AFTER GFF CARD') + ENDIF + HDET=TEXT(:12) + GO TO 10 + ELSE IF (TEXT .EQ. 'ABSORPTION') THEN + 5 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.NE.3) THEN + CALL XABORT('@D2P: C*6 EXPECTED AFTER ABSORPTION KEYWORD') + ELSE IF (TEXT .EQ. 'MIC') THEN + MIC =.TRUE. + GO TO 10 + ELSE IF (TEXT .EQ. 'SAP') THEN + SAP =.TRUE. + MIC =.FALSE. + GO TO 5 + ELSE IF (TEXT .EQ. 'EXCESS') THEN + IF (SAP .EQV. .FALSE.) THEN + CALL XABORT('@D2P: SAP KEYWORD EXPECTED BEFORE EXCESS') + ELSE + EXCESS = .TRUE. + GO TO 10 + ENDIF + ELSE + GO TO 11 + ENDIF + ELSE IF (TEXT .EQ. 'ISOTOPES') THEN + 25 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.NE.3) THEN + CALL XABORT('@D2P: CHARACTER EXPECTED AFTER PKEY KEYWORD') + ELSE + IF (TEXT.EQ.'XE135') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + ISOT(1)=TEXT(:12) + GO TO 25 + ELSE IF (TEXT.EQ.'SM149') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + ISOT(2)=TEXT(:12) + GO TO 25 + ELSE IF (TEXT.EQ.'I135') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + ISOT(3)=TEXT(:12) + GO TO 25 + ELSE IF (TEXT.EQ.'PM149') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + ISOT(4)=TEXT(:12) + GO TO 25 + ELSE IF (TEXT.EQ.'PM148') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + ISOT(5)=TEXT(:12) + GO TO 25 + ELSE IF (TEXT.EQ.'PM148M') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + ISOT(6)=TEXT(:12) + GO TO 25 + ELSE IF (TEXT.EQ.'PM147') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + ISOT(8)=TEXT(:12) + GO TO 25 + ELSE IF (TEXT.EQ.'ND147') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + ISOT(7)=TEXT(:12) + GO TO 25 + ELSE IF (TEXT.EQ.'ENDISOTOPES') THEN + GO TO 10 + ELSE + CALL XABORT('@D2P: UNKNOWN NAME OF ISOTOPE: '//TEXT//'.') + ENDIF + ENDIF + ELSE IF (TEXT .EQ. 'YLD') THEN + 37 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.NE.3) THEN + CALL XABORT('@D2P: CHARACTER EXPECTED AFTER YLD KEYWORD') + ELSE + IF (TEXT(:3).EQ.'COR') THEN + LCOR=.TRUE. + GO TO 37 + ELSE + IF (.NOT.LCOR) STAVEC(22)=0 + YLDOPT=TEXT(:3) + IF (YLDOPT.EQ.'REF') THEN + IF (LCOR) STAVEC(22)=1 + GO TO 10 + ELSE IF (YLDOPT.EQ.'FIX') THEN + IF (LCOR) THEN + WRITE (6,*) '@D2P : NO CORRECTION POSSIBLE OF FISSION' + CALL XABORT ('YIELDS WITH THE FIX OPTION') + ENDIF + DO I=1, 3 + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR==2) THEN + YLD(I)=FLOTT + ELSE + CALL XABORT('REAL EXPECTED FOR YIELD VALUES') + ENDIF + ENDDO + GO TO 10 + ELSE IF (YLDOPT.EQ.'MAN') THEN + IF (LCOR) STAVEC(22)=2 + 35 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + I=1 + DO WHILE (TEXT.NE.REFNAM(I).AND.(I.LE.5)) + I=I+1 + ENDDO + IF (I.GT.5) THEN + IF (TEXT.EQ.'ENDMAN') GO TO 10 + CALL XABORT('@D2P: PKEY NAME ('//TEXT(:12)//') NOT ' + > //'ALLOWED IN YIELD CARD') + ELSE + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + + IF (ITYPLIR.EQ.2) THEN + LOCYLD(I)=FLOTT + GO TO 35 + ELSE + CALL XABORT('@D2P: SOMETHING WRONG OCCURS IN YLD CARD') + ENDIF + ENDIF + ELSE + CALL XABORT('@D2P: UNKNOWN OPTION FOR YLD: '//TEXT//'.') + ENDIF + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'GENPMAXS') THEN + GO TO 120 + ELSE IF (TEXT.EQ.'HELIOS') THEN + GO TO 21 + ELSE IF (TEXT.EQ.'PROC') THEN + GO TO 220 + ELSE + CALL XABORT('@D2P: SOMETHING WRONG OCCURS IN INPUT DATA') + ENDIF + ELSE + GOTO 200 + ENDIF + ENDIF + ELSE + CALL XABORT('@D2P: UNKNOWN KEYWORD '//TEXT//', BARR EXPECTED') + ENDIF + ELSE IF (TEXT .EQ. 'REFLECTOR') THEN + FA_K=0 + NCRD=1 + CRDINF(1)=1 + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.NE.3) THEN + CALL XABORT('@D2P: SOMETHING WRONG OCCURS IN REFLECTOR DATA') + ELSE IF (ITYPLIR.EQ.3) THEN + IF ((TEXT.NE.';'))THEN + IF (TEXT.EQ.'GENPMAXS') THEN + GO TO 120 + ELSE IF (TEXT.EQ.'HELIOS') THEN + GO TO 21 + ELSE IF (TEXT.EQ.'PROC') THEN + GO TO 220 + ELSE + CALL XABORT('@D2P: SOMETHING WRONG OCCURS IN INPUT DATA') + ENDIF + ELSE + GOTO 200 + ENDIF + ELSE + CALL XABORT('@D2P: UNKNOWN KEYWORD'//TEXT//', IN INPUT DATA') + ENDIF + ENDIF + + 21 IF (TEXT .EQ. 'HELIOS') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + 30 IF (ITYPLIR.NE.3) THEN + CALL XABORT ('@D2P: KEYWORD EXPECTED AFTER HELIOS CARD') + ELSE IF (TEXT.EQ.'FILE_CONT_1') THEN + 40 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF ((ITYPLIR.EQ.1).OR.(ITYPLIR.EQ.2)) THEN + NFC1 = NFC1 +1 + IF (NFC1 <= 5) THEN + IF (ITYPLIR.EQ.1) FC1(NFC1) = NITMA + IF (ITYPLIR.EQ.2) FC1(NFC1) = FLOTT + GO TO 40 + ELSE + CALL XABORT('@D2P: FIVE VALUES FOR FILE_CONT_1 ARE EXPECTED') + ENDIF + ELSE IF (ITYPLIR.EQ.3) THEN + IF (NFC1.NE.5) THEN + CALL XABORT('@D2P: FIVE VALUES FOR FILE_CONT_1 ARE EXPECTED') + ENDIF + IF (TEXT .NE. ';' ) THEN + GO TO 30 + ELSE + GOTO 200 + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'FILE_CONT_2') THEN + + 50 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + + IF (ITYPLIR.EQ.2) THEN + NFC2 = NFC2 +1 + IF (NFC2 <= 8) THEN + FC2(NFC2) = FLOTT + GO TO 50 + ELSE + CALL XABORT('@D2P: 8 VALUES AT MOST IN FILE_CONT_2') + ENDIF + ELSE IF (ITYPLIR.EQ.1) THEN + CALL XABORT('@D2P: REAL VALUES EXPECTED IN FILE_CONT_2') + ELSE IF (ITYPLIR.EQ.3) THEN + IF (NFC2<2) THEN + CALL XABORT('@D2P: 2 VALUES AT LEAST IN FILE_CONT_2') + ENDIF + IF (TEXT .NE. ';' ) THEN + GO TO 30 + ELSE + GOTO 200 + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'FILE_CONT_3') THEN + + 60 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + + IF (ITYPLIR.EQ.2) THEN + NFC3 = NFC3 +1 + IF (NFC3 <= 7) THEN + FC3(NFC3) = FLOTT + GO TO 60 + ELSE + CALL XABORT('@D2P: 7 VALUES IN FILE_CONT_3 EXPECTED') + ENDIF + ELSE IF (ITYPLIR.EQ.1) THEN + CALL XABORT('@D2P: REAL VALUES EXPECTED IN FILE_CONT_3 ') + ELSE IF (ITYPLIR.EQ.3) THEN + IF (NFC3<7) THEN + CALL XABORT('@D2P: 7 VALUES FOR FILE_CONT_3 EXPECTED') + ENDIF + IF (TEXT .NE. ';' ) THEN + GO TO 30 + ELSE + GOTO 200 + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'FILE_CONT_4') THEN + + 70 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + + IF (ITYPLIR.EQ.2) THEN + NFC4 = NFC4 +1 + IF (NFC4 <= 3) THEN + FC4(NFC4) = FLOTT + GO TO 70 + ELSE + CALL XABORT('@D2P: 3 VALUES IN FILE_CONT_4 EXPECTED') + ENDIF + ELSE IF (ITYPLIR.EQ.1) THEN + CALL XABORT('@D2P: REAL VALUES EXPECTED IN FILE_CONT_4') + ELSE IF (ITYPLIR.EQ.3) THEN + IF (NFC4<3) THEN + CALL XABORT('@D2P: 3 VALUES IN FILE_CONT_4 EXPECTED') + ENDIF + IF (TEXT .NE. ';' ) THEN + GO TO 30 + ELSE + GOTO 200 + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'XS_CONT') THEN + + 80 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + + IF ((ITYPLIR.EQ.1).OR.(ITYPLIR.EQ.2)) THEN + NXC = NXC +1 + IF (NXC <= 3) THEN + IF (ITYPLIR.EQ.1) XSC(NXC) = NITMA + IF (ITYPLIR.EQ.2) XSC(NXC) = FLOTT + GO TO 80 + ELSE + CALL XABORT('@D2P: 3 VALUES IN XS_CONT ARE EXPECTED') + ENDIF + ELSE IF (ITYPLIR.EQ.3) THEN + IF (NXC<3) THEN + CALL XABORT('@D2P: 3 VALUES FOR XS_CONT ARE EXPECTED') + ENDIF + IF (TEXT .NE. ';' ) THEN + GO TO 30 + ELSE + GOTO 200 + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'GENPMAXS')THEN + GO TO 120 + ELSE IF (TEXT.EQ.'PROC')THEN + GO TO 220 + ELSE + CALL XABORT ('@D2P: UNKNOWN KEYWORD: '//TEXT//'.') + ENDIF + ENDIF + + + + 120 IF (TEXT .EQ. 'GENPMAXS') THEN + + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + 130 IF (ITYPLIR.NE.3) THEN + CALL XABORT ('@D2P: KEYWORD EXPECTED AFTER GENPMAXS CARD') + ELSE IF (TEXT.EQ.'JOB_TIT') THEN + + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + + IF ((ITYPLIR.NE.3)) THEN + CALL XABORT('@D2P: CHARACTER EXPECTED AFTER JOB_TIT CARD') + ELSE IF (ITYPLIR.EQ.3) THEN + IF (TEXT .NE. ';' ) THEN + JOBTIT=TEXT(:16) + IF (NITMA>16) THEN + CALL XABORT('@D2P: JOB_TIT NAME TOO LONG (>C*16)') + ENDIF + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + GO TO 130 + ELSE + CALL XABORT('@D2P: CHARACTER EXPECTED AFTER JOB_TIT CARD') + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'FILE_NAME') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF ((ITYPLIR.NE.3)) THEN + CALL XABORT('CHARACTER EXPECTED AFTER JOB_TIT CARD') + ELSE IF (ITYPLIR.EQ.3) THEN + IF (TEXT .NE. ';' ) THEN + FILNAM=TEXT(:12) + IF (NITMA>12) THEN + CALL XABORT('FILE_NAME NAME TOO LONG (>C*12)') + ENDIF + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + GO TO 130 + ELSE + CALL XABORT('@D2P: CHARACTER EXPECTED AFTER FILE_NAME CARD') + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'DERIVATIVE') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF ((ITYPLIR.NE.3)) THEN + CALL XABORT('@D2P: CHARACTER EXPECTED AFTER DERIVATIVE CARD') + ELSE IF (ITYPLIR.EQ.3) THEN + IF (TEXT .NE. ';' ) THEN + IF ((TEXT.EQ.'T').OR.(TEXT.EQ.'F')) THEN + DER=TEXT(:4) + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + GO TO 130 + ELSE + CALL XABORT('@D2P: (T/F) EXECTED AFTER DERIVATIVE CARD') + ENDIF + ELSE + CALL XABORT('@D2P: (T/F) EXPECTED AFTER DERIVATIVE CARD') + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'COMMENT') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF ((ITYPLIR.NE.3)) THEN + CALL XABORT('@D2P: CHARACTER EXPECTED AFTER COMMENT CARD') + ELSE IF (ITYPLIR.EQ.3) THEN + IF (TEXT .NE. ';' ) THEN + COM=TEXT(:40) + IF (NITMA>40)THEN + CALL XABORT('@D2P: COMMENT NAME TOO LONG (>C*40)') + ENDIF + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + GO TO 130 + ELSE + CALL XABORT('@D2P: CHARACTER EXPECTED AFTER COMMENT CARD') + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'JOB_OPT') THEN + 140 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + + IF ((ITYPLIR.NE.3)) THEN + CALL XABORT('@D2P: CHARACTER EXPECTED AFTER JOB_OPT CARD') + ELSE IF (ITYPLIR.EQ.3) THEN + IF (TEXT .NE. ';' ) THEN + JOBT=JOBT+1 + + IF ((TEXT.EQ.'T').OR.(TEXT.EQ.'F')) THEN + IF (JOBT<=14) THEN + JOBOPT(JOBT)=TEXT(:1) + GO TO 140 + ELSE + WRITE (6,*) '@D2P: LAST JOB_OPT VALUE :', TEXT + CALL XABORT('@D2P: 14 VALUES EXPECTED FOR JOB_OPT CARD') + ENDIF + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + GO TO 130 + ELSE + IF (JOBT<=14) THEN + WRITE (6,*)'@D2P: ',JOBT,'th JOB_OPT VALUE :', TEXT + CALL XABORT('@D2P: (T/F) VALUES EXPECTED FOR JOB_OPT CARD') + ELSE + GO TO 130 + ENDIF + ENDIF + ELSE IF (JOBT==14 .and. TEXT==';') THEN + GO TO 190 + ELSE IF (JOBT==15) THEN + GO TO 130 + ELSE + CALL XABORT('@D2P: CHARACTER EXPECTED AFTER JOB_OPT CARD') + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'IUPS') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF ((ITYPLIR.NE.1)) THEN + CALL XABORT('@D2P: INTEGER EXPECTED AFTER IUPS CARD') + ELSE IF (ITYPLIR.EQ.1) THEN + IF ((NITMA>2).OR.(NITMA<0)) THEN + CALL XABORT ('@D2P: IUPS INTEGER MUST BE 0,1 or 2') + ELSE + IUPS=NITMA + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.EQ.3) THEN + GO TO 130 + ELSE + CALL XABORT('@D2P: ONLY 1 VALUE IS EXPECTED FOR IUPS') + ENDIF + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'XESM') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF ((ITYPLIR.NE.1)) THEN + CALL XABORT('@D2P: INTEGER EXPECTED AFTER XESM CARD') + ELSE IF (ITYPLIR.EQ.1) THEN + IF ((NITMA>3).OR.(NITMA<1)) THEN + CALL XABORT ('@D2P: XESM CARD INTEGER MUST BE 1,2 or 3') + ELSE + XESM=NITMA + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.EQ.3) THEN + GO TO 130 + ELSE + CALL XABORT('@D2P: ONLY 1 VALUE IS EXPECTED FOR XESM') + ENDIF + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'VERSION') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF ((ITYPLIR.NE.2)) THEN + CALL XABORT('@D2P: REAL EXPECTED AFTER VERSION CARD') + ELSE IF (ITYPLIR.EQ.2) THEN + IF ((FLOTT<0)) THEN + CALL XABORT ('@D2P: VERSION NUMBER MUST BE POSITIVE') + ELSE + VERS=FLOTT + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.EQ.3) THEN + GO TO 130 + ELSE + CALL XABORT('@D2P: ONLY ONE VALUE IS EXPECTED FOR VERSION') + ENDIF + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'SFAC') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF ((ITYPLIR.NE.2)) THEN + CALL XABORT('@D2P: REAL EXPECTED AFTER SFAC CARD') + ELSE IF (ITYPLIR.EQ.2) THEN + IF ((FLOTT<0)) THEN + CALL XABORT ('@D2P: SFAC FACTOR MUST BE POSITIVE') + ELSE + SFAC=FLOTT + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.EQ.3) THEN + GO TO 130 + ELSE + CALL XABORT('@D2P: ONLY ONE VALUE IS EXPECTED FOR SFAC ') + ENDIF + ENDIF + ENDIF + ELSE IF (TEXT.EQ.'BFAC') THEN + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF ((ITYPLIR.NE.2)) THEN + CALL XABORT('@D2P: REAL EXPECTED AFTER BFAC CARD') + ELSE IF (ITYPLIR.EQ.2) THEN + IF ((FLOTT<0)) THEN + CALL XABORT ('@D2P: BFAC FACTOR MUST BE POSITIVE') + ELSE + BFAC=FLOTT + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + IF (ITYPLIR.EQ.3) THEN + GO TO 130 + ELSE + CALL XABORT('@D2P: ONLY 1 VALUE IS EXPETCTED FOR BFAC') + ENDIF + ENDIF + ENDIF + ELSE IF (TEXT .EQ. ';' ) THEN + GO TO 190 + ELSE IF (TEXT .EQ. 'PROC') THEN + GO TO 220 + ELSE + CALL XABORT ('@D2P: UNKNOWN KEYWORD: '//TEXT//'.') + ENDIF + ENDIF + + 220 IF (TEXT .EQ. 'PROC') THEN + LPRC=.TRUE. + 221 CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + + IF (ITYPLIR.NE.3) THEN + CALL XABORT ('@D2P: C*4 EXPECTED AFTER PROC CARD') + ELSE IF (TEXT.EQ.';') THEN + GO TO 190 + ELSE IF (TEXT.EQ.'MEMO')THEN + LMEM=.TRUE. + GO TO 221 + ELSE IF ((NITMA .NE. 4)) THEN + CALL XABORT ('@D2P: C*4 EXPECTED AFTER PROC CARD') + ELSE + OPT=TEXT(:4) + CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT) + SELECT CASE (OPT) + CASE ('ISOT') + IF (TEXT.EQ."*") THEN + ISOTOPT=TEXT(:1) + ELSE IF(ITYPLIR.NE.2) THEN + CALL XABORT('@D2P: * OR REAL EXPECTED AFTER ISOT CARD') + ELSE + ISOTOPT='R' + ISOTVAL=FLOTT + ENDIF + CASE ('EQUI') + IF(ITYPLIR.NE.3) THEN + CALL XABORT('@D2P: HEQUI (C*4) EXPECTED AFTER EQUI CARD') + ELSE + IF (NITMA.NE.4) THEN + CALL XABORT('@D2P: HEQUI (C*4) EXPECTED AFTER EQUI CARD') + ELSE + HEQUI=TEXT(:4) + ENDIF + ENDIF + CASE ('MASL') + IF(ITYPLIR.NE.3) THEN + CALL XABORT('@D2P: HMASL (C*4) EXPECTED AFTER MASL CARD') + ELSE + IF (NITMA.NE.4) THEN + CALL XABORT('@D2P: HMASL (C*4) EXPECTED AFTER MASL CARD') + ELSE + HMASL=TEXT(:4) + ENDIF + ENDIF + + CASE DEFAULT + CALL XABORT('@D2P: UNKNOWN OPTION ('//OPT//') IN PROC CARD') + END SELECT + GO TO 221 + ENDIF + + + ENDIF + + 190 IF (TEXT(:1) .EQ. ';' ) THEN + IF (NFC2.NE.0) NGP = NFC2 + IF (JOBT.NE.14) THEN + IF (JOBT.NE.15) THEN + IF (JOBT.NE.0)THEN + CALL XABORT('@D2P: 14 VALUES EXPECTED FOR JOB_OPT') + ENDIF + ENDIF + ENDIF + GO TO 200 + ELSE + CALL XABORT('@D2P: UNKNOWN KEYWORD:'//TEXT//'.') + ENDIF + ENDIF + + + + 200 IF (PHASE.EQ.1) THEN + IF ((ADF.EQ.'NUL') .and. (JOBOPT(1).EQ.'T')) THEN + WRITE(6,*)"@D2P: ADF CALCULATION REQUIRED, PLEASE USE THE 'ADF'", + > " CARD." + CALL XABORT("") + ELSE IF ((ADF.NE.'NUL') .and. (JOBOPT(1).EQ.'F')) THEN + WRITE(6,*)"@D2P: ADF CALCULATION REQUIRED, PLEASE TURN ON THE ", + > "'ladf' FLAG IN JOB_OPT CARD." + CALL XABORT("") + ENDIF + IF ((CDF.EQ.'NUL') .and. (JOBOPT(10).EQ.'T')) THEN + WRITE(6,*)"@D2P: CDF CALCULATION REQUIRED, PLEASE USE THE 'CDF'", + > " CARD." + CALL XABORT("") + ELSE IF ((CDF.NE.'NUL') .and. (JOBOPT(10).EQ.'F')) THEN + WRITE(6,*)"@D2P: CDF CALCULATION REQUIRED, PLEASE TURN ON THE ", + > "'lcdf' FLAG IN JOB_OPT CARD." + CALL XABORT("") + ENDIF + IF ((GFF.EQ.'NUL') .and. (JOBOPT(11).EQ.'T')) THEN + WRITE(6,*)"@D2P: GFF CALCULATION REQUIRED, PLEASE USE THE 'GFF'", + > " CARD." + CALL XABORT("") + ELSE IF ((CDF.NE.'NUL') .and. (JOBOPT(10).EQ.'F')) THEN + WRITE(6,*)"@D2P: GFF CALCULATION REQUIRED, PLEASE TURN ON THE ", + > "'lgff' FLAG IN JOB_OPT CARD." + CALL XABORT("") + ENDIF + IF (FA_K==0) THEN + IF ((ADF.EQ.'SEL').OR.(ADF.EQ.'GET')) THEN + CALL XABORT('@D2P: ADF OF TYPE DRA EXPECTED FOR REFLECTOR CASE') + ENDIF + DO I=2, 16 + IF (JOBOPT(I).EQ.'T') THEN + JOBOPT(I)='F' + WRITE(6,*)"@D2P: JOB_OPT(",I,") SET TO 'F' FOR RELFECTOR CASE" + ENDIF + ENDDO + ENDIF + ENDIF + CALL D2PDRV( NENTRY, HENTRY, IENTRY, JENTRY, KENTRY, NGP, + > NCRD, MIX, FA_K, IUPS, USRSTA, PHASE, + > IPRINT, STAVEC, CRDINF, USRVAL, VERS, SFAC, + > BFAC, FC1, FC2, FC3, FC4, XSC, + > USRVAPK, ADF, DER, JOBOPT, USRPAR, MESH, + > PKEY, FILNAM, ISOT, JOBTIT, COM, SAP, + > MIC, EXC, SCAT, LADD, LNEW, MIXDIR, + > CDF, GFF, ADFD, CDFD, YLD, YLDOPT, + > LOCYLD, XESM, ITEMP, OTHPK, OTHTYP, OTHVAL, + > HDET, LPRC, HEQUI, HMASL ,ISOTOPT,ISOTVAL, + > LMEM, OTHVAR, THCK, HFLX, HCUR ) + + END |