1 SUBROUTINE DPDDS2(Y1,N1,IORDAR,IORDMA,DELTAT,NUMVAR,ILOCV, 2 1 XDDS,YDDS,AT,Y2,MAXNXT,PRED2,RES2,RESSD,RESDF, 3 1 IBUGA3,ISUBRO,IERROR) 4C 5C PURPOSE--THIS ROUTINE CARRIES OUT A DDS ANALYSIS 6C (1-SAMPLE OR 2-SAMPLE) 7C EXAMPLE--DDS Y 6 5 DELT 8C DDS Y 6 5 (== DDS Y 6 5 1) 9C DDS Y (== DDS Y 6 5 1) 10C SAMPLE 1 IS IN INPUT VECTOR Y1 11C (WITH N1 OBSERVATIONS). 12C WRITTEN BY--JAMES J. FILLIBEN 13C STATISTICAL ENGINEERING DIVISION 14C CENTER FOR APPLIED MATHEMATICS 15C NATIONAL BUREAU OF STANDARDS 16C WASHINGTON, D. C. 20234 17C PHONE--301-921-3651 18C NOTE--DATAPLOT IS A REGISTERED TRADEMARK 19C OF THE NATIONAL BUREAU OF STANDARDS. 20C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, 21C MODIFIED, OR OTHERWISE USED IN A CONTEXT 22C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. 23C LANGUAGE--ANSI FORTRAN (1977) 24C VERSION NUMBER--82/7 25C ORIGINAL VERSION--MAY 1984. 26C UPDATED --APRIL 1987. (LARRY KNAB CORRECTION-- 27C BROWNLEE, P. 225) 28C UPDATED --FEBRUARY 1994. REFORMAT OUTPUT 29C UPDATED --FEBRUARY 1994. DPWRST: 'BUG ' => 'WRIT' 30C UPDATED --APRIL 1996. DDS CODE MODIFIED (ALAN): 31C A) SOME DIMENSIONS TO DPDDS, USE 32C EQUIVALENCE 33C B) I/O CONSISTENT WITH DATAPLOT 34C C) USE IERROR RATHER THAN STOP 35C D) INCLUDE FILE FOR DDS COMMON 36C BLOCKS AND PARAMETER STATEMENTS 37C THESE CHANGES PROPOGATE TO LOWER 38C LEVEL DDS ROUTINES 39C 40C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- 41C 42 CHARACTER*4 ISUBRO 43 CHARACTER*4 IBUGA3 44 CHARACTER*4 IERROR 45C 46CCCCC CHARACTER*4 IWRITE 47C 48CCCCC THE FOLLOWING 3 LINES WERE ADDED FEBRUARY 1994 49CCCCC CHARACTER*6 ICONC1 50CCCCC CHARACTER*6 ICONC2 51CCCCC CHARACTER*6 ICONC3 52C 53 CHARACTER*4 ISUBN1 54 CHARACTER*4 ISUBN2 55 CHARACTER*4 ISTEPN 56C 57C--------------------------------------------------------------------- 58C 59 DIMENSION Y1(*) 60CCCCC FUTURE--Y2 NEEDS TO BE MADE AN INPUT ARGUMENT 61CCCCC APRIL 1996. MAKE Y2 AN INPUT ARGUMENT, ALSO ADD XDDS, YDDS 62CCCCC DIMENSION Y2(100) 63 DIMENSION Y2(*) 64CCCCC APRIL 1996. ADD FOLLOWING LINES 65 INCLUDE 'DPCOPA.INC' 66 INCLUDE 'DPCODD.INC' 67 DIMENSION AT(MXNOB1,MXSER) 68C 69 DIMENSION PRED2(*) 70 DIMENSION RES2(*) 71C 72 DIMENSION XDDS(MAXOBV,MXSER) 73 DIMENSION YDDS(MAXOBV,MXSER) 74C 75C--------------------------------------------------------------------- 76C 77 INCLUDE 'DPCOP2.INC' 78C 79C-----START POINT----------------------------------------------------- 80C 81 ISUBN1='DPCO' 82 ISUBN2='F2 ' 83 IERROR='NO' 84C 85 N=(-99) 86C 87 IF(IBUGA3.EQ.'OFF')GOTO90 88 WRITE(ICOUT,999) 89 999 FORMAT(1X) 90 CALL DPWRST('XXX','WRIT') 91 WRITE(ICOUT,51) 92 51 FORMAT('**** AT THE BEGINNING OF DPDDS2--') 93 CALL DPWRST('XXX','WRIT') 94 WRITE(ICOUT,52)IBUGA3 95 52 FORMAT('IBUGA3 = ',A4) 96 CALL DPWRST('XXX','WRIT') 97 WRITE(ICOUT,53)DELTAT,NUMVAR,ILOCV 98 53 FORMAT('DELTAT,NUMVAR,ILOCV = ',E15.7,I8,I8) 99 CALL DPWRST('XXX','WRIT') 100 WRITE(ICOUT,55)N1 101 55 FORMAT('N1 = ',I8) 102 CALL DPWRST('XXX','WRIT') 103 DO56I=1,N1 104 WRITE(ICOUT,57)I,Y1(I) 105 57 FORMAT('I,Y1(I) = ',I8,E15.7) 106 CALL DPWRST('XXX','WRIT') 107 56 CONTINUE 108 WRITE(ICOUT,65)IORDMA 109 65 FORMAT('IORDMA = ',I8) 110 CALL DPWRST('XXX','WRIT') 111 DO66I=1,IORDMA 112 WRITE(ICOUT,67)I,Y2(I) 113 67 FORMAT('I,Y2(I) = ',I8,E15.7) 114 CALL DPWRST('XXX','WRIT') 115 66 CONTINUE 116 90 CONTINUE 117C 118C ******************************************** 119C ** STEP 11-- ** 120C ** CHECK THE INPUT ARGUMENTS FOR ERRORS ** 121C ******************************************** 122C 123 ISTEPN='11' 124 IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 125C 126 IF(N1.GE.1)GOTO1119 127 WRITE(ICOUT,999) 128 CALL DPWRST('XXX','WRIT') 129 WRITE(ICOUT,1111) 130 1111 FORMAT('***** ERROR IN DPDDS2--THE NUMBER OF OBSERVATIONS ', 131 1'FOR VARIABLE 1 IS NON-POSITIVE') 132 CALL DPWRST('XXX','WRIT') 133 WRITE(ICOUT,1112)N1 134 1112 FORMAT('SAMPLE SIZE = ',I8) 135 CALL DPWRST('XXX','WRIT') 136 IERROR='YES' 137 GOTO9000 138 1119 CONTINUE 139C 140 IF(N1.EQ.1)GOTO1120 141 GOTO1129 142 1120 CONTINUE 143 WRITE(ICOUT,999) 144 CALL DPWRST('XXX','WRIT') 145 WRITE(ICOUT,1121) 146 1121 FORMAT('***** NOTE FROM DPDDS2--VARIABLE 1 ', 147 1'HAS ONLY 1 ELEMENT') 148 CALL DPWRST('XXX','WRIT') 149 GOTO9000 150 1129 CONTINUE 151C 152 HOLD=Y1(1) 153 DO1135I=2,N1 154 IF(Y1(I).NE.HOLD)GOTO1139 155 1135 CONTINUE 156 WRITE(ICOUT,999) 157 CALL DPWRST('XXX','WRIT') 158 WRITE(ICOUT,1131)HOLD 159 1131 FORMAT('***** NOTE FROM DPDDS2--VARIABLE 1 ', 160 1'HAS ALL ELEMENTS = ',E15.7) 161 CALL DPWRST('XXX','WRIT') 162 GOTO9000 163 1139 CONTINUE 164C 165 IF(NUMVAR.LE.1)GOTO1290 166C 167 IF(IORDMA.GE.1)GOTO1219 168 WRITE(ICOUT,999) 169 CALL DPWRST('XXX','WRIT') 170 WRITE(ICOUT,1211) 171 1211 FORMAT('***** ERROR IN DPDDS2--THE NUMBER OF OBSERVATIONS ', 172 1'FOR VARIABLE 2 IS NON-POSITIVE') 173 CALL DPWRST('XXX','WRIT') 174 WRITE(ICOUT,1212)IORDMA 175 1212 FORMAT('SAMPLE SIZE = ',I8) 176 CALL DPWRST('XXX','WRIT') 177 IERROR='YES' 178 GOTO9000 179 1219 CONTINUE 180C 181 IF(IORDMA.EQ.1)GOTO1220 182 GOTO1229 183 1220 CONTINUE 184 WRITE(ICOUT,999) 185 CALL DPWRST('XXX','WRIT') 186 WRITE(ICOUT,1221) 187 1221 FORMAT('***** NOTE FROM DPDDS2--VARIABLE 2 ', 188 1'HAS ONLY 1 ELEMENT') 189 CALL DPWRST('XXX','WRIT') 190 GOTO9000 191 1229 CONTINUE 192C 193 HOLD=Y2(1) 194 DO1235I=2,IORDMA 195 IF(Y2(I).NE.HOLD)GOTO1239 196 1235 CONTINUE 197 WRITE(ICOUT,999) 198 CALL DPWRST('XXX','WRIT') 199 WRITE(ICOUT,1231)HOLD 200 1231 FORMAT('***** NOTE FROM DPDDS2--VARIABLE 2 ', 201 1'HAS ALL ELEMENTS = ',E15.7) 202 CALL DPWRST('XXX','WRIT') 203 GOTO9000 204 1239 CONTINUE 205C 206 1290 CONTINUE 207C 208C ************************************ 209C ** STEP 21-- ** 210C ** BRANCH DEPENDING ON WHETHER ** 211C ** 1-SAMPLE DDS ANALYSIS OR ** 212C ** 2-SAMPLE DDS ANALYSIS. ** 213C ************************************ 214C 215 ISTEPN='21' 216 IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 217C 218 IF(NUMVAR.EQ.1)GOTO3100 219 GOTO4100 220C 221C *********************************** 222C ** STEP 31-- ** 223C ** CARRY OUT CALCULATIONS ** 224C ** FOR A 1-SAMPLE DDS ANALYSIS ** 225C *********************************** 226C 227 3100 CONTINUE 228C 229 ISTEPN='31' 230 IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 231C 232CCCCC APRIL 1996. ADD XDDS, YDDS, AT TO ARGUMENT LIST. 233 CALL DPDDS3(Y1,N1,IORDAR,IORDMA,DELTAT,NUMVAR,ILOCV, 234 1 XDDS,YDDS,AT,MAXNXT,PRED2,RES2,RESSD,RESDF, 235 1 IBUGA3,ISUBRO,IERROR) 236C 237 4100 CONTINUE 238C 239C ***************** 240C ** STEP 90-- ** 241C ** EXIT ** 242C ***************** 243C 244 9000 CONTINUE 245 IF(IBUGA3.EQ.'OFF')GOTO9090 246 WRITE(ICOUT,999) 247 CALL DPWRST('XXX','WRIT') 248 WRITE(ICOUT,9011) 249 9011 FORMAT('***** AT THE END OF DPDDS2--') 250 CALL DPWRST('XXX','WRIT') 251 WRITE(ICOUT,9012)N,IBUGA3,IERROR 252 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4) 253 CALL DPWRST('XXX','WRIT') 254 WRITE(ICOUT,9013)DELTAT,NUMVAR,ILOCV 255 9013 FORMAT('DELTAT,NUMVAR,ILOCV = ',E15.7,I8,I8) 256 CALL DPWRST('XXX','WRIT') 257 WRITE(ICOUT,9015)N1 258 9015 FORMAT('N1 = ',I8) 259 CALL DPWRST('XXX','WRIT') 260 DO9016I=1,N1 261 WRITE(ICOUT,9017)I,Y1(I) 262 9017 FORMAT('I,Y1(I) = ',I8,E15.7) 263 CALL DPWRST('XXX','WRIT') 264 9016 CONTINUE 265 WRITE(ICOUT,9025)IORDMA 266 9025 FORMAT('IORDMA = ',I8) 267 CALL DPWRST('XXX','WRIT') 268 DO9026I=1,IORDMA 269 WRITE(ICOUT,9027)I,Y2(I) 270 9027 FORMAT('I,Y2(I) = ',I8,E15.7) 271 CALL DPWRST('XXX','WRIT') 272 9026 CONTINUE 273 9090 CONTINUE 274C 275 RETURN 276 END 277