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