SUBROUTINE DPDDS2(Y1,N1,IORDAR,IORDMA,DELTAT,NUMVAR,ILOCV, CCCCC1XTEMP1,XTEMP2,MAXNXT,PRED2,RES2,RESSD,RESDF,IBUGA3,IERROR) CCCCC APRIL 1996. ADD XDDS, YDDS, AT, Y2 TO ARGUMENT LIST 1XTEMP1,XTEMP2,XDDS,YDDS,AT,Y2,MAXNXT,PRED2,RES2,RESSD,RESDF, 1IBUGA3,IERROR) C C PURPOSE--THIS ROUTINE CARRIES OUT A DDS ANALYSIS C (1-SAMPLE OR 2-SAMPLE) C EXAMPLE--DDS Y 6 5 DELT C DDS Y 6 5 (== DDS Y 6 5 1) C DDS Y (== DDS Y 6 5 1) C SAMPLE 1 IS IN INPUT VECTOR Y1 C (WITH N1 OBSERVATIONS). C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--MAY 1984. C UPDATED --APRIL 1987. (LARRY KNAB CORRECTION-- C BROWNLEE, P. 225) C UPDATED --FEBRUARY 1994. REFORMAT OUTPUT C UPDATED --FEBRUARY 1994. DPWRST: 'BUG ' => 'WRIT' C UPDATED --APRIL 1996. DDS CODE MODIFIED (ALAN): C A) SOME DIMENSIONS TO DPDDS, USE C EQUIVALENCE C B) I/O CONSISTENT WITH DATAPLOT C C) USE IERROR RATHER THAN STOP C D) INCLUDE FILE FOR DDS COMMON C BLOCKS AND PARAMETER STATEMENTS C THESE CHANGES PROPOGATE TO LOWER C LEVEL DDS ROUTINES C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGA3 CHARACTER*4 IERROR C CCCCC CHARACTER*4 IWRITE C CCCCC THE FOLLOWING 3 LINES WERE ADDED FEBRUARY 1994 CCCCC CHARACTER*6 ICONC1 CCCCC CHARACTER*6 ICONC2 CCCCC CHARACTER*6 ICONC3 C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C--------------------------------------------------------------------- C DIMENSION Y1(*) CCCCC FUTURE--Y2 NEEDS TO BE MADE AN INPUT ARGUMENT CCCCC APRIL 1996. MAKE Y2 AN INPUT ARGUMENT, ALSO ADD XDDS, YDDS CCCCC DIMENSION Y2(100) DIMENSION Y2(*) CCCCC APRIL 1996. ADD FOLLOWING LINES INCLUDE 'DPCOPA.INC' INCLUDE 'DPCODD.INC' DIMENSION AT(MXNOB1,MXSER) C DIMENSION XTEMP1(*) DIMENSION XTEMP2(*) C DIMENSION PRED2(*) DIMENSION RES2(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ISUBN1='DPCO' ISUBN2='F2 ' C IERROR='NO' C N=(-99) C IF(IBUGA3.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,51) 51 FORMAT('**** AT THE BEGINNING OF DPDDS2--') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,52)IBUGA3 52 FORMAT('IBUGA3 = ',A4) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,53)DELTAT,NUMVAR,ILOCV 53 FORMAT('DELTAT,NUMVAR,ILOCV = ',E15.7,I8,I8) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,55)N1 55 FORMAT('N1 = ',I8) CALL DPWRST('XXX','WRIT') DO56I=1,N1 WRITE(ICOUT,57)I,Y1(I) 57 FORMAT('I,Y1(I) = ',I8,E15.7) CALL DPWRST('XXX','WRIT') 56 CONTINUE WRITE(ICOUT,65)IORDMA 65 FORMAT('IORDMA = ',I8) CALL DPWRST('XXX','WRIT') DO66I=1,IORDMA WRITE(ICOUT,67)I,Y2(I) 67 FORMAT('I,Y2(I) = ',I8,E15.7) CALL DPWRST('XXX','WRIT') 66 CONTINUE 90 CONTINUE C C ******************************************** C ** STEP 11-- ** C ** CHECK THE INPUT ARGUMENTS FOR ERRORS ** C ******************************************** C ISTEPN='11' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(N1.GE.1)GOTO1119 WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1111) 1111 FORMAT('***** ERROR IN DPDDS2--THE NUMBER OF OBSERVATIONS ', 1'FOR VARIABLE 1 IS NON-POSITIVE') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1112)N1 1112 FORMAT('SAMPLE SIZE = ',I8) CALL DPWRST('XXX','WRIT') IERROR='YES' GOTO9000 1119 CONTINUE C IF(N1.EQ.1)GOTO1120 GOTO1129 1120 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1121) 1121 FORMAT('***** NOTE FROM DPDDS2--VARIABLE 1 ', 1'HAS ONLY 1 ELEMENT') CALL DPWRST('XXX','WRIT') GOTO9000 1129 CONTINUE C HOLD=Y1(1) DO1135I=2,N1 IF(Y1(I).NE.HOLD)GOTO1139 1135 CONTINUE 1130 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1131)HOLD 1131 FORMAT('***** NOTE FROM DPDDS2--VARIABLE 1 ', 1'HAS ALL ELEMENTS = ',E15.7) CALL DPWRST('XXX','WRIT') GOTO9000 1139 CONTINUE C IF(NUMVAR.LE.1)GOTO1290 C IF(IORDMA.GE.1)GOTO1219 WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1211) 1211 FORMAT('***** ERROR IN DPDDS2--THE NUMBER OF OBSERVATIONS ', 1'FOR VARIABLE 2 IS NON-POSITIVE') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1212)IORDMA 1212 FORMAT('SAMPLE SIZE = ',I8) CALL DPWRST('XXX','WRIT') IERROR='YES' GOTO9000 1219 CONTINUE C IF(IORDMA.EQ.1)GOTO1220 GOTO1229 1220 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1221) 1221 FORMAT('***** NOTE FROM DPDDS2--VARIABLE 2 ', 1'HAS ONLY 1 ELEMENT') CALL DPWRST('XXX','WRIT') GOTO9000 1229 CONTINUE C HOLD=Y2(1) DO1235I=2,IORDMA IF(Y2(I).NE.HOLD)GOTO1239 1235 CONTINUE 1230 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1231)HOLD 1231 FORMAT('***** NOTE FROM DPDDS2--VARIABLE 2 ', 1'HAS ALL ELEMENTS = ',E15.7) CALL DPWRST('XXX','WRIT') GOTO9000 1239 CONTINUE C 1290 CONTINUE C C ************************************ C ** STEP 21-- ** C ** BRANCH DEPENDING ON WHETHER ** C ** 1-SAMPLE DDS ANALYSIS OR ** C ** 2-SAMPLE DDS ANALYSIS. ** C ************************************ C ISTEPN='21' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMVAR.EQ.1)GOTO3100 GOTO4100 C C *********************************** C ** STEP 31-- ** C ** CARRY OUT CALCULATIONS ** C ** FOR A 1-SAMPLE DDS ANALYSIS ** C *********************************** C 3100 CONTINUE C ISTEPN='31' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CCCCC APRIL 1996. ADD XDDS, YDDS, AT TO ARGUMENT LIST. CALL DPDDS3(Y1,N1,IORDAR,IORDMA,DELTAT,NUMVAR,ILOCV, CCCCC1XTEMP1,XTEMP2,MAXNXT,PRED2,RES2,RESSD,RESDF,IBUGA3,IERROR) 1XTEMP1,XTEMP2,XDDS,YDDS,AT,MAXNXT,PRED2,RES2,RESSD,RESDF, 1IBUGA3,IERROR) C 4100 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGA3.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPDDS2--') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,9012)N,IBUGA3,IERROR 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,9013)DELTAT,NUMVAR,ILOCV 9013 FORMAT('DELTAT,NUMVAR,ILOCV = ',E15.7,I8,I8) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,9015)N1 9015 FORMAT('N1 = ',I8) CALL DPWRST('XXX','WRIT') DO9016I=1,N1 WRITE(ICOUT,9017)I,Y1(I) 9017 FORMAT('I,Y1(I) = ',I8,E15.7) CALL DPWRST('XXX','WRIT') 9016 CONTINUE WRITE(ICOUT,9025)IORDMA 9025 FORMAT('IORDMA = ',I8) CALL DPWRST('XXX','WRIT') DO9026I=1,IORDMA WRITE(ICOUT,9027)I,Y2(I) 9027 FORMAT('I,Y2(I) = ',I8,E15.7) CALL DPWRST('XXX','WRIT') 9026 CONTINUE 9090 CONTINUE C RETURN END