CDECK ID>, ZPCOM. CDECK ID>, ZPCOM. C------------------------COMMON BLOCKS--------------------- CDECK ID>, ZPDF. CDECK ID>, LZ_PASS. C ============================== LOGICAL FUNCTION LZ_PASS(X,Q2) C ============================== COMMON /ZPCUTS/ XMIN,XMAX,QMIN,QMAX,WMIN,ROOTS DATA PMASS /0.9383/ XW = X*PMASS*PMASS + Q2*(1.-X) SS = ROOTS*ROOTS IF (X. LT.XMIN) THEN LZ_PASS = .FALSE. ELSEIF(X. GT.XMAX) THEN LZ_PASS = .FALSE. ELSEIF(Q2.LT.QMIN) THEN LZ_PASS = .FALSE. ELSEIF(Q2.GT.QMAX) THEN LZ_PASS = .FALSE. ELSEIF(XW.LT.X*WMIN) THEN LZ_PASS = .FALSE. ELSEIF(Q2.GT.X*SS) THEN LZ_PASS = .FALSE. ELSE LZ_PASS = .TRUE. ENDIF RETURN END CDECK ID>, ZP_EDEF. C =========================== SUBROUTINE ZP_EDEF(LISTU,N) C =========================== DIMENSION LISTU(*) INCLUDE 'zpdflib.inc' COMMON /ZPBUFF/ + FFPAR(MPA), + XXTAB(MXX),QQTAB(MQ2), + ZPBUF(MXX,MQ2,-MER:MER,MPD),IMARK(MER),ITYPE(MER), + NPARS,NXTAB,NQTAB,NERRS,NPDFS,I_BUFSET CHARACTER*45 FFCOM CHARACTER*10 PNAM1,PNAM2,ENAME CHARACTER*24 PCOMM,ECOMM COMMON /ZPBUFC/ + FFCOM(MPA),PNAM1(MPD),PNAM2(MPD),PCOMM(MPD), + ENAME(MER),ECOMM(MER) C-- Check if distribution read in IF(I_BUFSET.NE.123456) THEN WRITE(6,'(/'' ZP_EDEF: no distribution read in ---> STOP'')') IERR = -1 STOP ENDIF C-- Mark all errors to be ignored CALL VZERO(IMARK,MER) C-- Loop over input list DO I = 1,N J = LISTU(I) C-- Check if J is a valid adress IF(J.LT.1.OR.J.GT.MER) THEN WRITE(6,'(/'' ZP_EDEF: J='',I3,'' outside allowed range'', + '' 1 -'',I3,'' ---> STOP'')') J,MER STOP ENDIF C-- Mark error J to be added to total error IMARK(J) = 1 ENDDO RETURN END CDECK ID>, ZP_VALU. C ============================================ SUBROUTINE ZP_VALU(ID,X,Q2,VAL,EDN,EUP,IERR) C ============================================ LOGICAL LZ_PASS COMMON /ELEVEL/ I_LEVSET,ILEVEL INCLUDE 'zpdflib.inc' COMMON /ZPBUFF/ + FFPAR(MPA), + XXTAB(MXX),QQTAB(MQ2), + ZPBUF(MXX,MQ2,-MER:MER,MPD),IMARK(MER),ITYPE(MER), + NPARS,NXTAB,NQTAB,NERRS,NPDFS,I_BUFSET CHARACTER*45 FFCOM CHARACTER*10 PNAM1,PNAM2,ENAME CHARACTER*24 PCOMM,ECOMM COMMON /ZPBUFC/ + FFCOM(MPA),PNAM1(MPD),PNAM2(MPD),PCOMM(MPD), + ENAME(MER),ECOMM(MER) IERR = 0 C-- Check if distribution read in IF(I_BUFSET.NE.123456) THEN WRITE(6,'(/'' ZP_VALU: no distribution read in ---> STOP'')') IERR = -1 STOP ENDIF C-- Check ID is in range IF(ID.LT.1.OR.ID.GT.NPDFS) THEN WRITE(6,'(/'' ZP_VALU: I='',I3,'' outside allowed range'', + '' 1 -'',I3,'' ---> STOP'')') ID,NPDFS IERR = -2 STOP ENDIF C-- Get value VAL = ZP_VAL(X,Q2,0,ID,IERR) C-- Get error EDN = 0. EUP = 0. DO IE = 1,NERRS IF(IMARK(IE).EQ.1) THEN ERD = ZP_VAL(X,Q2,-IE,ID,IERR) EDN = EDN + ERD*ERD ERU = ZP_VAL(X,Q2, IE,ID,IERR) EUP = EUP + ERU*ERU ENDIF ENDDO EDN = SQRT(EDN) EUP = SQRT(EUP) IF(.NOT.LZ_PASS(X,Q2)) IERR = MAX(IERR,1) C-- x, Q2 outside fitted range IF(IERR.GE.ILEVEL.AND.IERR.EQ.1) THEN WRITE(6,'(/'' ZP_VALU: x,Q2 ='',2E12.5,'' outside fitted range'', + '' ---> STOP'')') X,Q2 STOP ENDIF C-- x, Q2 outside table range IF(IERR.GE.ILEVEL.AND.IERR.EQ.2) THEN WRITE(6,'(/'' ZP_VALU: x,Q2 ='',2E12.5,'' outside table range'', + '' ---> STOP'')') X,Q2 STOP ENDIF RETURN END CDECK ID>, ZP_VAL. C =============================== FUNCTION ZP_VAL(X,Q,IE,ID,IERR) C =============================== INCLUDE 'zpdflib.inc' COMMON /ZPBUFF/ + FFPAR(MPA), + XXTAB(MXX),QQTAB(MQ2), + ZPBUF(MXX,MQ2,-MER:MER,MPD),IMARK(MER),ITYPE(MER), + NPARS,NXTAB,NQTAB,NERRS,NPDFS,I_BUFSET CHARACTER*45 FFCOM CHARACTER*10 PNAM1,PNAM2,ENAME CHARACTER*24 PCOMM,ECOMM COMMON /ZPBUFC/ + FFCOM(MPA),PNAM1(MPD),PNAM2(MPD),PCOMM(MPD), + ENAME(MER),ECOMM(MER) IERR = 0 ZP_VAL = 0. C-- Check if x,q2 outside boundaries IF(X.LT.XXTAB(1).OR.X.GT.XXTAB(NXTAB) .OR. + Q.LT.QQTAB(1).OR.Q.GT.QQTAB(NQTAB) ) THEN IERR = 2 RETURN ENDIF C-- Find x-Q2 bin IX = 0 DO I = 1,NXTAB IF(XXTAB(I).LE.X) IX = I ENDDO IQ = 0 DO I = 1,NQTAB IF(QQTAB(I).LE.Q) IQ = I ENDDO IF(IX.EQ.0.OR.IQ.EQ.0) THEN IERR = 2 RETURN ENDIF C-- Interpolate IX = MIN(IX,NXTAB-1) IQ = MIN(IQ,NQTAB-1) F11 = ZPBUF(IX ,IQ ,IE,ID) F12 = ZPBUF(IX ,IQ+1,IE,ID) F21 = ZPBUF(IX+1,IQ ,IE,ID) F22 = ZPBUF(IX+1,IQ+1,IE,ID) TX = (X-XXTAB(IX))/(XXTAB(IX+1)-XXTAB(IX)) TQ = (Q-QQTAB(IQ))/(QQTAB(IQ+1)-QQTAB(IQ)) F1 = (1.-TQ)*F11 + TQ*F12 F2 = (1.-TQ)*F21 + TQ*F22 ZP_VAL = (1.-TX)*F1 + TX*F2 RETURN END CDECK ID>, ID_ZPDF. C ===================================== INTEGER FUNCTION ID_ZPDF(UNAM1,UNAM2) C ===================================== INCLUDE 'zpdflib.inc' COMMON /ZPBUFF/ + FFPAR(MPA), + XXTAB(MXX),QQTAB(MQ2), + ZPBUF(MXX,MQ2,-MER:MER,MPD),IMARK(MER),ITYPE(MER), + NPARS,NXTAB,NQTAB,NERRS,NPDFS,I_BUFSET CHARACTER*45 FFCOM CHARACTER*10 PNAM1,PNAM2,ENAME CHARACTER*24 PCOMM,ECOMM COMMON /ZPBUFC/ + FFCOM(MPA),PNAM1(MPD),PNAM2(MPD),PCOMM(MPD), + ENAME(MER),ECOMM(MER) CHARACTER*(*) UNAM1,UNAM2 CHARACTER*10 NAM1,NAM2 NAM1 = ' ' LEN = MIN(LENOCC(UNAM1),10) NAM1(1:LEN) = UNAM1(1:LEN) CALL CLTOU(NAM1) NAM2 = ' ' LEN = MIN(LENOCC(UNAM2),10) NAM2(1:LEN) = UNAM2(1:LEN) CALL CLTOU(NAM2) ID = 0 IF(NAM1(1:5).EQ.'ERROR') THEN IF(NERRS.EQ.0) THEN ID_ZPDF = 1 RETURN ENDIF DO I = 1,NERRS IF(NAM2.EQ.ENAME(I)) ID = I ENDDO ELSE DO I = 1,NPDFS IF(NAM1.EQ.PNAM1(I).AND.NAM2.EQ.PNAM2(I)) ID = I ENDDO ENDIF IF(ID.EQ.0) THEN WRITE(6,'(/'' ID_ZPDF: '',2A10,'' not found'', + '' ---> STOP'')') NAM1,NAM2 STOP ENDIF ID_ZPDF = ID RETURN END CDECK ID>, ZP_GETP. C ========================= FUNCTION ZP_GETP(IP,IERR) C ========================= COMMON /ELEVEL/ I_LEVSET,ILEVEL INCLUDE 'zpdflib.inc' COMMON /ZPBUFF/ + FFPAR(MPA), + XXTAB(MXX),QQTAB(MQ2), + ZPBUF(MXX,MQ2,-MER:MER,MPD),IMARK(MER),ITYPE(MER), + NPARS,NXTAB,NQTAB,NERRS,NPDFS,I_BUFSET CHARACTER*45 FFCOM CHARACTER*10 PNAM1,PNAM2,ENAME CHARACTER*24 PCOMM,ECOMM COMMON /ZPBUFC/ + FFCOM(MPA),PNAM1(MPD),PNAM2(MPD),PCOMM(MPD), + ENAME(MER),ECOMM(MER) IERR = 0 C-- Check if file read in IF(I_BUFSET.NE.123456) THEN IERR = -2 WRITE(6,'(/'' ZP_GETP: no parameters read in ---> STOP'')') STOP ENDIF C-- Check IP is in range IF(IP.LT.1.OR.IP.GT.MPA) THEN IERR = -1 WRITE(6,'(/'' ZP_GETP: IP='',I3,'' outside allowed range'', + '' 1 -'',I3,'' ---> STOP'')') IP,MPA STOP ENDIF ZP_GETP = FFPAR(IP) IF(IP.GT.NPARS) THEN IERR = 2 ZP_GETP = 0. ENDIF RETURN END CDECK ID>, ZP_XTAB. C ==================================== SUBROUTINE ZP_XTAB(UXTAB,N_IN,N_OUT) C ==================================== INCLUDE 'zpdflib.inc' COMMON /ZPBUFF/ + FFPAR(MPA), + XXTAB(MXX),QQTAB(MQ2), + ZPBUF(MXX,MQ2,-MER:MER,MPD),IMARK(MER),ITYPE(MER), + NPARS,NXTAB,NQTAB,NERRS,NPDFS,I_BUFSET CHARACTER*45 FFCOM CHARACTER*10 PNAM1,PNAM2,ENAME CHARACTER*24 PCOMM,ECOMM COMMON /ZPBUFC/ + FFCOM(MPA),PNAM1(MPD),PNAM2(MPD),PCOMM(MPD), + ENAME(MER),ECOMM(MER) DIMENSION UXTAB(*) C-- Check if distributions read in IF(I_BUFSET.NE.123456) THEN WRITE(6,'(/'' ZP_XTAB: no distribution read in ---> STOP'')') STOP ENDIF N_OUT = MIN(N_IN,NXTAB) DO IX = 1,N_OUT UXTAB(IX) = XXTAB(IX) ENDDO RETURN END CDECK ID>, ZP_QTAB. C ==================================== SUBROUTINE ZP_QTAB(UQTAB,N_IN,N_OUT) C ==================================== INCLUDE 'zpdflib.inc' COMMON /ZPBUFF/ + FFPAR(MPA), + XXTAB(MXX),QQTAB(MQ2), + ZPBUF(MXX,MQ2,-MER:MER,MPD),IMARK(MER),ITYPE(MER), + NPARS,NXTAB,NQTAB,NERRS,NPDFS,I_BUFSET CHARACTER*45 FFCOM CHARACTER*10 PNAM1,PNAM2,ENAME CHARACTER*24 PCOMM,ECOMM COMMON /ZPBUFC/ + FFCOM(MPA),PNAM1(MPD),PNAM2(MPD),PCOMM(MPD), + ENAME(MER),ECOMM(MER) DIMENSION UQTAB(*) C-- Check if distributions read in IF(I_BUFSET.NE.123456) THEN WRITE(6,'(/'' ZP_QTAB: no distribution read in ---> STOP'')') STOP ENDIF N_OUT = MIN(N_IN,NQTAB) DO IQ = 1,N_OUT UQTAB(IQ) = QQTAB(IQ) ENDDO RETURN END CDECK ID>, ZP_GIVE. C ===================================================== SUBROUTINE ZP_GIVE(NX,XMI,XMA,NQ,QMI,QMA,NPD,NER,NPA) C ===================================================== INCLUDE 'zpdflib.inc' COMMON /ZPBUFF/ + FFPAR(MPA), + XXTAB(MXX),QQTAB(MQ2), + ZPBUF(MXX,MQ2,-MER:MER,MPD),IMARK(MER),ITYPE(MER), + NPARS,NXTAB,NQTAB,NERRS,NPDFS,I_BUFSET CHARACTER*45 FFCOM CHARACTER*10 PNAM1,PNAM2,ENAME CHARACTER*24 PCOMM,ECOMM COMMON /ZPBUFC/ + FFCOM(MPA),PNAM1(MPD),PNAM2(MPD),PCOMM(MPD), + ENAME(MER),ECOMM(MER) C-- Check if distributions read in IF(I_BUFSET.NE.123456) THEN WRITE(6,'(/'' ZP_GIVE: no distribution read in ---> STOP'')') STOP ENDIF XMI = 0. XMA = 0. QMI = 0. QMA = 0. NX = NXTAB NQ = NQTAB IF(NX.NE.0) THEN XMI = XXTAB(1) XMA = XXTAB(NXTAB) ENDIF IF(NQ.NE.0) THEN QMI = QQTAB(1) QMA = QQTAB(NQTAB) ENDIF NPD = NPDFS NER = NERRS NPA = NPARS RETURN END CDECK ID>, ZP_INDX. C ============================= SUBROUTINE ZP_INDX(LUN,IFLAG) C ============================= C-- IFLAG = 1 print fit parameters C-- 2 print available pdfs C-- 3 print available errors C-- other print all INCLUDE 'zpdflib.inc' COMMON /ZPBUFF/ + FFPAR(MPA), + XXTAB(MXX),QQTAB(MQ2), + ZPBUF(MXX,MQ2,-MER:MER,MPD),IMARK(MER),ITYPE(MER), + NPARS,NXTAB,NQTAB,NERRS,NPDFS,I_BUFSET CHARACTER*45 FFCOM CHARACTER*10 PNAM1,PNAM2,ENAME CHARACTER*24 PCOMM,ECOMM COMMON /ZPBUFC/ + FFCOM(MPA),PNAM1(MPD),PNAM2(MPD),PCOMM(MPD), + ENAME(MER),ECOMM(MER) CHARACTER*1 CHAR(-1:1) DATA CHAR /'A','S','A'/ C-- Check if distributions read in IF(I_BUFSET.NE.123456) THEN WRITE(6,'(/'' ZP_INDX: no distribution read in ---> STOP'')') STOP ENDIF C-- Print fit parameters IF(IFLAG.NE.2.AND.IFLAG.NE.3) THEN WRITE(LUN,'(/'' ZP_INDX: # available parameters ='',I4/)') NPARS DO I = 1,NPARS WRITE(LUN,'(I3,E15.5,5X,A45)') I,FFPAR(I),FFCOM(I) ENDDO ENDIF C-- Available PDFs IF(IFLAG.NE.1.AND.IFLAG.NE.3) THEN WRITE(LUN,'(/'' ZP_INDX: # available PDFs ='',I4/)') NPDFS DO I = 1,NPDFS WRITE(LUN,'(I3,4X,A6,A10,A24)') I,PNAM1(I), + PNAM2(I),PCOMM(I) ENDDO ENDIF C-- Available error sources IF(IFLAG.NE.1.AND.IFLAG.NE.2) THEN WRITE(LUN,'(/'' ZP_INDX: # available errors'' + '' (S=symmetric A=asym 0=exclude'', + '' 1=include) ='',I4/)') NERRS DO I = 1,NERRS WRITE(LUN,'(I3,4X,A10,A1,I3,2X,A24)') + I,ENAME(I),CHAR(ITYPE(I)),IMARK(I),ECOMM(I) ENDDO ENDIF RETURN END CDECK ID>, ZP_DLUN. C ============================ SUBROUTINE ZP_DLUN(LUN_USER) C ============================ COMMON /LUNZPD/ I_LUNSET,LUNZP LUNZP = LUN_USER I_LUNSET = 123456 RETURN END CDECK ID>, ZP_STOP. C ============================ SUBROUTINE ZP_STOP(LEV_USER) C ============================ COMMON /ELEVEL/ I_LEVSET,ILEVEL ILEVEL = LEV_USER I_LEVSET = 123456 RETURN END CDECK ID>, ZP_READ. C ============================= SUBROUTINE ZP_READ(FNAM,IERR) C ============================= CHARACTER*(*) FNAM CHARACTER*80 STRING CHARACTER*10 NAME INCLUDE 'zpdflib.inc' COMMON /LUNZPD/ I_LUNSET,LUNZP COMMON /ELEVEL/ I_LEVSET,ILEVEL COMMON /ZPBUFF/ + FFPAR(MPA), + XXTAB(MXX),QQTAB(MQ2), + ZPBUF(MXX,MQ2,-MER:MER,MPD),IMARK(MER),ITYPE(MER), + NPARS,NXTAB,NQTAB,NERRS,NPDFS,I_BUFSET CHARACTER*45 FFCOM CHARACTER*10 PNAM1,PNAM2,ENAME CHARACTER*24 PCOMM,ECOMM COMMON /ZPBUFC/ + FFCOM(MPA),PNAM1(MPD),PNAM2(MPD),PCOMM(MPD), + ENAME(MER),ECOMM(MER) COMMON /ZPCUTS/ XMIN,XMAX,QMIN,QMAX,WMIN,ROOTS IERR = 0 LUN = 55 IF(I_LUNSET.EQ.123456) LUN = LUNZP IF(I_LEVSET.NE.123456) ILEVEL = 2 LEN = LENOCC(FNAM) OPEN(UNIT=LUN,FILE=FNAM(1:LEN),STATUS='OLD',ERR=500) C-- Initialise I_BUFSET = 0 IERR = 0 NPARS = 0 NXTAB = 0 NQTAB = 0 NERRS = 0 NPDFS = 0 CALL VZERO(FFPAR,MPA) CALL VZERO(XXTAB,MXX) CALL VZERO(QQTAB,MQ2) CALL VZERO(ZPBUF,MXX*MQ2*(2*MER+1)*MPD) CALL VZERO(IMARK,MER) CALL VZERO(ITYPE,MER) REWIND(LUN) C-- Reading loop 10 CONTINUE READ(LUN,'(A80)',ERR=510,END=520) STRING IF(STRING(3:8).EQ.'params') THEN C -------------------------------- READ(LUN,'(I5)',ERR=510,END=515) NPARS IF(NPARS.LT.1.OR.NPARS.GT.MPA) THEN WRITE(6,'(/'' ZP_READ: too many parameters on file'',I5, + '' ---> STOP'')') NPARS STOP ENDIF DO I = 1,NPARS READ(LUN,'(I3,E15.5,5X,A45)',ERR=510,END=515) + J,FFPAR(I),FFCOM(I) ENDDO GOTO 10 ELSEIF(STRING(3:5).EQ.'nxt') THEN C --------------------------------- READ(LUN,'(2I5)',ERR=510,END=515) NXTAB,NQTAB IF(NXTAB.GT.MXX.OR.NQTAB.GT.MQ2) THEN WRITE(6,'(/'' ZP_READ: too many x,Q2 points on file'',2I5, + '' ---> STOP'')') NXTAB,NQTAB STOP ENDIF GOTO 10 ELSEIF(STRING(1:5).EQ.'XGRID') THEN C ----------------------------------- READ(LUN,'(6E12.5)',ERR=510,END=515) + (XXTAB(I),I=1,NXTAB) GOTO 10 ELSEIF(STRING(1:5).EQ.'QGRID') THEN C ----------------------------------- READ(LUN,'(6E12.5)',ERR=510,END=515) + (QQTAB(J),J=1,NQTAB) GOTO 10 ELSEIF(STRING(1:5 ).EQ.'DIST') THEN C ----------------------------------- C-- Read values IF(STRING(31:35).EQ.'VALUE') THEN NPDFS = NPDFS+1 NERRS = 0 IF(NPDFS.GT.MPD) THEN WRITE(6,'(/'' ZP_READ: too many pdfs on file'',I5, + '' ---> STOP'')') MPD STOP ENDIF PNAM1(NPDFS) = STRING(11:20) PNAM2(NPDFS) = STRING(21:30) PCOMM(NPDFS) = STRING(56:79) READ(LUN,'(6E12.5)',ERR=510,END=515) + ((ZPBUF(I,J,0,NPDFS),I=1,NXTAB),J=1,NQTAB) C-- Read errors ELSEIF(STRING(31:33).NE.'DER') THEN READ(STRING(41:45),'(I5)') MARK READ(STRING(46:50),'(I5)') ITYP CALL ZPSTRIP(STRING(31:40),NAME) C-- Look if this error has been read in already KK = 0 DO K = 1,NERRS IF(NAME.EQ.ENAME(K)) KK = K ENDDO C-- No, this error has not yet been read in IF(KK.EQ.0) THEN NERRS = NERRS + 1 IF(NERRS.GT.MER) THEN WRITE(6,'(/'' ZP_READ: too many evalues on file'',I5, + '' ---> STOP'')') MER STOP ENDIF ENAME(NERRS) = NAME ECOMM(NERRS) = STRING(56:79) IMARK(NERRS) = MARK ITYPE(NERRS) = ITYP ENDIF IF(ITYP.EQ.0) THEN C-- Symmetric errors READ(LUN,'(6E12.5)',ERR=510,END=515) + ((ZPBUF(I,J,NERRS,NPDFS),I=1,NXTAB),J=1,NQTAB) DO I = 1,NXTAB DO J = 1,NQTAB ZPBUF(I,J,-NERRS,NPDFS) = ZPBUF(I,J,NERRS,NPDFS) ENDDO ENDDO ELSE C-- Asymmetric error (ityp = +1 or -1) READ(LUN,'(6E12.5)',ERR=510,END=515) + ((ZPBUF(I,J,ITYP*NERRS,NPDFS),I=1,NXTAB),J=1,NQTAB) ENDIF ENDIF GOTO 10 ELSE C ---- GOTO 10 ENDIF RETURN 500 CONTINUE IERR = 1 WRITE(6,'(/'' ZP_READ: cannot open '',A, + '' on LUN = '',I4,'' ---> STOP'')') + FNAM(1:LEN),LUN STOP 510 CONTINUE IERR = 2 WRITE(6,'(/'' ZP_READ: error reading file '',A, + '' ---> STOP'')') FNAM(1:LEN) STOP 515 CONTINUE IERR = 3 WRITE(6,'(/'' ZP_READ: e-o-f reading file '',A, + '' ---> STOP'')') FNAM(1:LEN) STOP 520 CONTINUE CLOSE(LUN) C-- Setflag if something has been read in IF(NXTAB.EQ.0) THEN I_BUFSET = 0 ELSEIF(NQTAB.EQ.0) THEN I_BUFSET = 0 ELSEIF(NPDFS.EQ.0) THEN I_BUFSET = 0 ELSE I_BUFSET = 123456 ENDIF IF(I_BUFSET.NE.123456) THEN IERR = 4 WRITE(6,'(/'' ZP_READ: suspect file empty '',A, + '' ---> STOP'')') FNAM(1:LEN) STOP ELSE WRITE(6,'(/'' ZP_READ: read pdfs from file '',A)') + FNAM(1:LEN) ENDIF C-- Set cuts XMIN = XXTAB(1) XMAX = XXTAB(NXTAB) QMIN = QQTAB(1) QMAX = QQTAB(NQTAB) WMIN = 0. ROOTS = SQRT(QMAX/XMIN) DO I = 1,NPARS IF(FFCOM(I)(1:5).EQ.'x_min') XMIN = FFPAR(I) IF(FFCOM(I)(1:5).EQ.'x_max') XMAX = FFPAR(I) IF(FFCOM(I)(1:5).EQ.'Q2_mi') QMIN = FFPAR(I) IF(FFCOM(I)(1:5).EQ.'Q2_ma') QMAX = FFPAR(I) IF(FFCOM(I)(1:5).EQ.'W2_mi') WMIN = FFPAR(I) IF(FFCOM(I)(1:4).EQ.'sqrt') ROOTS = FFPAR(I) ENDDO END CDECK ID>, ZPSTRIP. C ================================ SUBROUTINE ZPSTRIP(NAMIN,NAMOUT) C ================================ C-- Remove trailing 'UP' or 'DN' from namin. C-- Truncate to 10 chars and return the result in namout. CHARACTER*(*) NAMIN CHARACTER*10 NAMOUT LEN = LENOCC(NAMIN) IF(LEN.GT.2.AND.NAMIN(LEN-1:LEN).EQ.'UP') LEN = LEN-2 IF(LEN.GT.2.AND.NAMIN(LEN-1:LEN).EQ.'Up') LEN = LEN-2 IF(LEN.GT.2.AND.NAMIN(LEN-1:LEN).EQ.'uP') LEN = LEN-2 IF(LEN.GT.2.AND.NAMIN(LEN-1:LEN).EQ.'up') LEN = LEN-2 IF(LEN.GT.2.AND.NAMIN(LEN-1:LEN).EQ.'DN') LEN = LEN-2 IF(LEN.GT.2.AND.NAMIN(LEN-1:LEN).EQ.'Dn') LEN = LEN-2 IF(LEN.GT.2.AND.NAMIN(LEN-1:LEN).EQ.'dN') LEN = LEN-2 IF(LEN.GT.2.AND.NAMIN(LEN-1:LEN).EQ.'dn') LEN = LEN-2 LEN = MIN(LEN,10) NAMOUT = ' ' NAMOUT(1:LEN) = NAMIN(1:LEN) RETURN END