← Back to branch summary

~ubuntu-branches/debian/jessie/eso-midas/jessie

« back to all changes in this revision

Viewing changes to contrib/mva/src/plotree.for

  • Committer: Package Import Robot
  • Author(s): Ole Streicher
  • Date: 2014-04-22 14:44:58 UTC
  • Revision ID: package-import@ubuntu.com-20140422144458-okiwi1assxkkiz39
Tags: upstream-13.09pl1.2+dfsg
Import upstream version 13.09pl1.2+dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
contrib/mva/src/plotree.for
 
1
C @(#)plotree.for       19.1 (ES0-DMD) 02/25/03 13:27:33
 
2
C===========================================================================
 
3
C Copyright (C) 1995 European Southern Observatory (ESO)
 
4
C
 
5
C This program is free software; you can redistribute it and/or 
 
6
C modify it under the terms of the GNU General Public License as 
 
7
C published by the Free Software Foundation; either version 2 of 
 
8
C the License, or (at your option) any later version.
 
9
C
 
10
C This program is distributed in the hope that it will be useful,
 
11
C but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
13
C GNU General Public License for more details.
 
14
C
 
15
C You should have received a copy of the GNU General Public 
 
16
C License along with this program; if not, write to the Free 
 
17
C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
 
18
C MA 02139, USA.
 
19
C
 
20
C Corresponding concerning ESO-MIDAS should be addressed as follows:
 
21
C       Internet e-mail: midas@eso.org
 
22
C       Postal address: European Southern Observatory
 
23
C                       Data Management Division 
 
24
C                       Karl-Schwarzschild-Strasse 2
 
25
C                       D 85748 Garching bei Muenchen 
 
26
C                       GERMANY
 
27
C===========================================================================
 
28
C
 
29
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
30
C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory,TKLAB
 
31
C                                         all rights reserved
 
32
C.IDENTIFICATION: PLOTREE
 
33
C.VERSION: 1.0  ESO-FORTRAN Conversion, AA  12:54 - 16 NOV 1987
 
34
C.LANGUAGE: F77+ESOext
 
35
C.PURPOSE:  Plots table tree
 
36
C.AUTHOR:   J.D. Ponz, ESO Garching
 
37
C.NOTE:     PLOTTBL uses the plotting routines available in the plot library
 
38
C           which again uses the low level AGL routines.
 
39
C.VERSION:  860625 J.D. Ponz  creation
 
40
C.VERSION:  870515 R.H. Warmels  general update of code;  new plot library
 
41
C.VERSION:  880420 R.H. Warmels  addapted to portable version of MIDAS
 
42
C ---------------------------------------------------------------------
 
43
C
 
44
      PROGRAM      PLTTRE                   !  program PLTTRE   *** main body ***
 
45
C
 
46
      INTEGER      MADRID
 
47
      INTEGER      ILOG,PMODE,FMODE
 
48
      INTEGER      NCOLUM,NROW,INADD(5),COL(4),TID
 
49
      REAL         FRAME(8),SCALES(2)
 
50
      CHARACTER    XFRAME*4,YFRAME*4
 
51
      CHARACTER    TABLE*60,SEL*64
 
52
      CHARACTER    LABEL1*80,LABEL2*80,LABEL3*80,TEXT*80
 
53
      CHARACTER*16 LABEL(4),UNIT(4),OLAB
 
54
      CHARACTER*40 COLUMN(4)
 
55
C
 
56
      COMMON       /VMR/MADRID(1)
 
57
      INCLUDE      'MID_INCLUDE:PLTDEC.INC/NOLIST'
 
58
      INCLUDE      'MID_INCLUDE:TABLES.INC/NOLIST'
 
59
C
 
60
      INCLUDE      'MID_INCLUDE:PLTDAT.INC/NOLIST'
 
61
      INCLUDE      'MID_INCLUDE:TABLED.INC/NOLIST'
 
62
C
 
63
      DATA         SEL/' '/
 
64
      DATA         ILOG/0/
 
65
      DATA         NCOLUM/4/
 
66
      DATA         PMODE/0/
 
67
C
 
68
9000  FORMAT (I4)
 
69
C
 
70
C *** start executable code
 
71
      CALL STSPRO('PLOTTRE')                            !start comm. with MIDAS
 
72
      CALL STKRDI('PLISTAT',1,1,IAC,FMODE,KUN,KNUL,IST)      !get the plot mode
 
73
      CALL STKRDC('PLCSTAT',1,5,4,IAC,XFRAME,KUN,KNUL,IST)          !frame in x
 
74
      CALL STKRDC('PLCSTAT',1,9,4,IAC,YFRAME,KUN,KNUL,IST)          !frame in y
 
75
C
 
76
C *** read parameters
 
77
      CALL STKRDC('P1',1,1,60,ITBL,TABLE,KUN,KNUL,ISTAT)        !get table name
 
78
      IF (ISTAT.NE.0) THEN                    ! take action in case of trouble
 
79
          TEXT = '*** FATAL: Problems with table parameter '//TABLE
 
80
          CALL STTPUT(TEXT,ISTAT)
 
81
          CALL STSEPI                          !  stop communication with MIDAS
 
82
          STOP
 
83
      END IF
 
84
C
 
85
C *** read columns
 
86
      CALL STKRDC('P3',1,1,40,NCOL1,COLUMN(1),KUN,KNUL,ISTAT)   !  first column
 
87
      CALL STKRDC('P2',1,1,40,NCOL2,COLUMN(2),KUN,KNUL,ISTAT)  !  second column
 
88
      CALL STKRDC('P5',1,1,40,NCOL3,COLUMN(3),KUN,KNUL,ISTAT)   !  third column
 
89
      CALL STKRDC('P4',1,1,40,NCOL4,COLUMN(4),KUN,KNUL,ISTAT)   !  forth column
 
90
C
 
91
C *** this procedure read the table
 
92
      CALL TBTOPN(TABLE,F_I_MODE,TID,ISTAT)
 
93
      IF (ISTAT.NE.0) THEN                           ! problems during execution
 
94
          TEXT = '*** FATAL: Problems with opening table '//TABLE
 
95
          CALL STTPUT(TEXT,ISTAT)
 
96
          CALL STSEPI
 
97
          STOP
 
98
      END IF
 
99
C
 
100
      CALL TBIGET(TID,NCOL,NROW,NSC,NAC,NAR,ISTAT)      ! read table information
 
101
      IF (ISTAT.NE.0) THEN                           ! problems during execution
 
102
          TEXT = '*** FATAL: Problems with getting table info'
 
103
          CALL STTPUT(TEXT,ISTAT)
 
104
          CALL STSEPI
 
105
          STOP
 
106
      END IF
 
107
C
 
108
      IF (NROW.LE.0) THEN
 
109
          CALL STTPUT(' No points in the table ... ',ISTAT)
 
110
          CALL STSEPI
 
111
          STOP
 
112
      END IF
 
113
C
 
114
      CALL TDRSEL(TID,SEL,ISTAT)                            !  table selection
 
115
C
 
116
C *** get column adresses
 
117
      DO 10 I = 1,NCOLUM
 
118
          CALL TBCSER(TID,COLUMN(I),COL(I),ISTAT)              ! find column no.
 
119
          IF (ISTAT.NE.0) THEN                       ! problems during execution
 
120
             TEXT = '*** FATAL: Problems with finding column'
 
121
             CALL STTPUT(TEXT,ISTAT)
 
122
             CALL STSEPI
 
123
             STOP
 
124
          END IF
 
125
 
 
126
          IF (COL(I).EQ.-1) THEN                     ! problems during execution
 
127
             TEXT = '*** FATAL: Problems with finding column'
 
128
             CALL STTPUT(TEXT,ISTAT)
 
129
             CALL STSEPI
 
130
             STOP
 
131
          END IF
 
132
C
 
133
          CALL TBCMAP(TID,COL(I),INADD(I),ISTAT)             ! get column adress
 
134
          IF (ISTAT.NE.0) THEN                       ! problems during execution
 
135
             TEXT = '*** FATAL: Problems with mapping column'
 
136
             CALL STTPUT(TEXT,ISTAT)
 
137
             CALL STSEPI
 
138
             STOP
 
139
          END IF
 
140
 
 
141
          IF (COL(I).NE.0) THEN                                     ! read label
 
142
              CALL TBLGET(TID,COL(I),LABEL(I),ISTAT)
 
143
              IF (ISTAT.NE.0) THEN                   ! problems during execution
 
144
                 TEXT = '*** FATAL: Problems with reading column'
 
145
                 CALL STTPUT(TEXT,ISTAT)
 
146
                 CALL STSEPI
 
147
                 STOP
 
148
              END IF
 
149
C
 
150
              CALL TBUGET(TID,COL(I),UNIT(I),ISTAT)                !  read units
 
151
              IF (ISTAT.NE.0) THEN                   ! problems during execution
 
152
                 TEXT = '*** FATAL: Problems with reading units'
 
153
                 CALL STTPUT(TEXT,ISTAT)
 
154
                 CALL STSEPI
 
155
                 STOP
 
156
              END IF
 
157
          END IF
 
158
   10 CONTINUE
 
159
C
 
160
      CALL TBCMAP(TID,0,INADD(5),ISTAT)              !  select mask of the table
 
161
      IF (ISTAT.NE.0) THEN                           ! problems during execution
 
162
         TEXT = '*** FATAL: Problems with the table selection'
 
163
         CALL STTPUT(TEXT,ISTAT)
 
164
         CALL STSEPI
 
165
         STOP
 
166
      END IF
 
167
C
 
168
C ... set up labels
 
169
      OLAB   = 'COLUMN '
 
170
      IF (LABEL(1) (1:2).EQ.'  ') THEN
 
171
         WRITE (OLAB(7:10),9000) COL(1)
 
172
      ELSE
 
173
         OLAB   = LABEL(1)
 
174
      END IF
 
175
      LABEL1 = OLAB
 
176
      LABEL1(31:50) = ' ('//UNIT(1)//')'
 
177
C
 
178
C *** the y axis
 
179
      OLAB   = 'COLUMN '
 
180
      IF (LABEL(2) (1:2).EQ.'  ') THEN
 
181
         WRITE (OLAB(7:10),9000) COL(2)
 
182
      ELSE
 
183
         OLAB   = LABEL(2)
 
184
      END IF
 
185
      LABEL2 = OLAB
 
186
      LABEL2(31:50) = ' ('//UNIT(2)//')'
 
187
C
 
188
C *** get the scales
 
189
      CALL STKRDR('INPUTR',1,2,NVAL,SCALES,KUN,KNUL,ISTAT)
 
190
      SCALES(1) = ABS(SCALES(1))
 
191
      SCALES(2) = ABS(SCALES(2))
 
192
      CALL STKWRR('PLRSTAT',SCALES,19,2,KUN,ISTAT)
 
193
C
 
194
C *** calculate frame
 
195
      IF (XFRAME(1:4).EQ.'MANU') THEN                            !  man. scaling
 
196
         CALL STKRDR('PLRSTAT',11,4,NVAL,FRAME,KUN,KNUL,ISTAT) !  get frame par.
 
197
      ELSE                                                       !  auto scaling
 
198
         XFRAME = 'AUTO'
 
199
         CALL TDMXRS(NROW,MADRID(INADD(2)),MADRID(INADD(5)),  !  min and max
 
200
     +               ILOG,XMIN1,XMAX1)
 
201
         CALL TDMXRS(NROW,MADRID(INADD(4)),MADRID(INADD(5)),  !  min and max
 
202
     +               ILOG,XMIN2,XMAX2)
 
203
         FRAME(1) = MIN(XMIN1,XMIN2)
 
204
         FRAME(2) = MAX(XMAX1,XMAX2)
 
205
         IF (FRAME(1).EQ.FRAME(2)) THEN
 
206
            FRAME(2) = FRAME(1) + 1.
 
207
         END IF
 
208
      END IF
 
209
C
 
210
      IF (YFRAME(1:4).EQ.'MANU') THEN                            !  man. scaling
 
211
         CALL STKRDR('PLRSTAT',15,4,NVAL,FRAME(5),KUN,KNUL,ISTAT)   !  get frame
 
212
      ELSE                                                       !  auto scaling
 
213
         YFRAME = 'AUTO'
 
214
         CALL TDMXRS(NROW,MADRID(INADD(1)),MADRID(INADD(5)),  !  min and max
 
215
     +               ILOG,YMIN1,YMAX1)
 
216
         CALL TDMXRS(NROW,MADRID(INADD(3)),MADRID(INADD(5)),  !  min and max
 
217
     +               ILOG,YMIN2,YMAX2)
 
218
         FRAME(5) = MIN(YMIN1,YMIN2)
 
219
         FRAME(6) = MAX(YMAX1,YMAX2)
 
220
         IF (FRAME(5).EQ.FRAME(6)) THEN
 
221
             FRAME(6) = FRAME(5) + 1
 
222
         END IF
 
223
      END IF
 
224
C
 
225
C *** get the scales
 
226
      CALL GETFRM(FRAME(1),FRAME(2),FRAME(3),FRAME(4),XFRAME)
 
227
      CALL GETFRM(FRAME(5),FRAME(6),FRAME(7),FRAME(8),YFRAME)
 
228
      CALL STKWRR('PLRSTAT',FRAME,11,8,KUN,ISTAT)
 
229
C
 
230
C *** do the plot setup
 
231
      CALL PLOPN(TABLE,PMODE,FMODE)
 
232
C
 
233
C *** do the work
 
234
      CALL PLTRE(NCOLUM,MADRID(INADD(1)),MADRID(INADD(2)),
 
235
     2           MADRID(INADD(3)),MADRID(INADD(4)),MADRID(INADD(5)),
 
236
     3           NROW)
 
237
C
 
238
      IF (FMODE.GE.1) THEN
 
239
         CALL PLFRAM(FRAME(1),FRAME(2),FRAME(3),FRAME(4),
 
240
     2               FRAME(5),FRAME(6),FRAME(7),FRAME(8))
 
241
         IF (PMODE.EQ.1 .OR. PMODE.EQ.3) THEN
 
242
            LABEL3 = 'Table: '//TABLE
 
243
            CALL PLLABL(LABEL2,LABEL1,LABEL3,SEL)
 
244
 
 
245
          ELSE
 
246
            CALL PLLABL(LABEL1,LABEL2,' ',' ')
 
247
            CALL PLTREI(TABLE,COLUMN(2),COLUMN(1),COLUMN(4),
 
248
     2                  COLUMN(3),SEL)
 
249
         END IF
 
250
      END IF
 
251
C
 
252
C *** good bye and finish
 
253
      CALL TBTCLO(TID,ISTAT)
 
254
      CALL PLCLS
 
255
      CALL STSEPI                            !  stop communication with MIDAS
 
256
      END
 
257
 
 
258
 
 
259
      SUBROUTINE PLTRE(NCOLUM,V1,V2,V3,V4,V5,NROW)                              
 
260
C+++                                                                            
 
261
C.PURPOSE:        Low level routine to plot a table treee                       
 
262
C.AUTHOR:         Rein H. Warmels                                               
 
263
C.VERSION:        86???? JDP Creation                                           
 
264
C.VERSION:        860625 RHW new routine based on Daniel's work                 
 
265
C.VERSION:        861216 RHW inclusion of neg. increments                       
 
266
C.VERSION:        87???? RHW restructure of code
 
267
C.VERSION:        890118 RHW ST interfaces implemented
 
268
C.COMMENTS:       none                                                          
 
269
C---                                                                            
 
270
      INTEGER     NCOLUM            ! # of columns to be plotted                
 
271
      REAL        V1(NROW)          ! adress of first column to be plotted     
 
272
      REAL        V2(NROW)          ! adress of second column to be plotted    
 
273
      REAL        V3(NROW)          ! adress of third column to be plotted     
 
274
      REAL        V4(NROW)          ! adress of fourth column to be plotted    
 
275
      REAL        V5(NROW)          ! adress                                   
 
276
      INTEGER     NROW              ! number of row                             
 
277
C                                                                               
 
278
      INTEGER     TINULL                                                 
 
279
      REAL        XX(2),YY(2)                                                   
 
280
      REAL        TBLSEL, TRNULL                                                
 
281
      DOUBLE PRECISION TDNULL, TDTRUE, TDFALS                                   
 
282
      LOGICAL     IPLOT                                                         
 
283
C                                                                               
 
284
      INCLUDE     'MID_INCLUDE:TABLES.INC/NOLIST'                               
 
285
      INCLUDE     'MID_INCLUDE:PLTDEC.INC/NOLIST'                               
 
286
      COMMON      /VMR/MADRID(1)                                                
 
287
      INCLUDE     'MID_INCLUDE:TABLED.INC/NOLIST'                               
 
288
C                                                                               
 
289
C *** get machine constants                                                     
 
290
      CALL TBMNUL(TINULL, TRNULL, TDNULL)                                       
 
291
      CALL TBMCON(TBLSEL, TDTRUE, TDFALS)                                       
 
292
C                                                                               
 
293
C *** do the work
 
294
      DO 10 I = 1,NROW                                                          
 
295
         IPLOT  = .TRUE.                                                        
 
296
         IF (V5(I).EQ.TBLSEL) THEN                                              
 
297
            YY(1)  = V1(I)                                                     
 
298
            IF (YY(1).EQ.TRNULL) IPLOT  = .FALSE.                              
 
299
            XX(1)  = V2(I)                                                     
 
300
            IF (XX(1).EQ.TRNULL) IPLOT  = .FALSE.                              
 
301
            YY(2)  = V3(I)                                                     
 
302
            IF (YY(2).EQ.TRNULL) IPLOT  = .FALSE.                              
 
303
            XX(2)  = V4(I)                                                     
 
304
            IF (XX(2).EQ.TRNULL) IPLOT  = .FALSE.                              
 
305
            IF (IPLOT) THEN                                                    
 
306
               CALL PLLINW(XX,YY,2)                                      
 
307
            END IF                                                             
 
308
         END IF                                                                
 
309
   10 CONTINUE                                                                  
 
310
C                                                                               
 
311
      RETURN                                                                    
 
312
      END                                                                       
 
313
 
 
314
      SUBROUTINE PLTREI(FILE,COL1,COL2,COL3,COL4,SEL)                           
 
315
C+++                                                                            
 
316
C.PURPOSE:        Produce plot information for a table tree plot                
 
317
C.AUTHOR:         Rein H. Warmels                                               
 
318
C.COMMENTS:       none                                                          
 
319
C.VERSION:        880420  RHW  Update for portable MIDAS                        
 
320
C.VERSION:        890118  RHW  ST interfaces implemented
 
321
C.COMMENTS:       none
 
322
C---                                                                            
 
323
      CHARACTER*(*) FILE                             !name of the table         
 
324
      CHARACTER*(*) COL1                             !name of x column          
 
325
      CHARACTER*(*) COL2                             !name of x column          
 
326
      CHARACTER*(*) COL3                             !name of x column          
 
327
      CHARACTER*(*) COL4                             !name of y column          
 
328
      CHARACTER*(*) SEL                              !selection string          
 
329
C                                                                               
 
330
      CHARACTER     BUF*80                                                      
 
331
      CHARACTER     NUMB5*10,NUMB6*10                                           
 
332
      REAL          SCALES(2)                                                   
 
333
      REAL          XL(3),YL(3)
 
334
      INCLUDE       'MID_INCLUDE:PLTDEC.INC/NOLIST'                             
 
335
C                                                                              
 
336
 9010 FORMAT (G10.3)                                                            
 
337
C
 
338
C ***
 
339
      X1     = GX2 + 0.01                                                       
 
340
      X2     = 1.0                                                              
 
341
      Y1     = 0.0                                                              
 
342
      Y2     = GY2                                                              
 
343
      CALL AGSSET('LINX')                                                       
 
344
      CALL AGSSET('LINY')                                                       
 
345
      CALL AGCDEF(X1,X2,Y1,Y2)                                                  
 
346
      CALL AGWDEF(0.0,1.0,0.0,1.0)                                              
 
347
C                                                                               
 
348
      CALL PLLOGI(XT,YT)                                  ! plot the MIDAS LOGO
 
349
C
 
350
C *** get character size
 
351
      CALL AGTGET('M',XL,YL)
 
352
      YH = 2.0*YL(2)
 
353
C
 
354
C *** table name                                                                
 
355
      BUF    = 'Table:'                                                         
 
356
      CALL LENBUF(BUF,L)                                                        
 
357
      CALL AGGTXT(XT,YT,BUF(1:L),1)                                             
 
358
      YT  = YT - YH                                                            
 
359
      BUF    = FILE                                                             
 
360
      CALL LENBUF(BUF,L)                                                        
 
361
      CALL AGGTXT(XT,YT,BUF(1:L),1)                                             
 
362
C                                                                               
 
363
C *** columns                                                                   
 
364
      YT  = YT - 2*YH                                                          
 
365
      BUF    = 'Columns: '                                                      
 
366
      CALL LENBUF(BUF,L)                                                        
 
367
      CALL AGGTXT(XT,YT,BUF(1:L),1)                                             
 
368
      YT  = YT - YH                                                            
 
369
      BUF    = 'X1: '//COL1                                                     
 
370
      CALL LENBUF(BUF,L)                                                        
 
371
      CALL AGGTXT(XT,YT,BUF(1:L),1)                                             
 
372
      YT  = YT - YH                                                            
 
373
      BUF    = 'Y1: '//COL2                                                     
 
374
      CALL LENBUF(BUF,L)                                                        
 
375
      CALL AGGTXT(XT,YT,BUF(1:L),1)                                             
 
376
      YT  = YT - YH                                                            
 
377
      BUF    = 'X2: '//COL3                                                     
 
378
      CALL LENBUF(BUF,L)                                                        
 
379
      CALL AGGTXT(XT,YT,BUF(1:L),1)                                             
 
380
      YT  = YT - YH                                                            
 
381
      BUF    = 'Y2: '//COL4                                                     
 
382
      CALL LENBUF(BUF,L)                                                        
 
383
      CALL AGGTXT(XT,YT,BUF(1:L),1)                                             
 
384
C                                                                               
 
385
C *** scales                                                                    
 
386
      YT  = YT - 2*YH                                                          
 
387
      BUF    = 'Scales: '                                                       
 
388
      CALL LENBUF(BUF,L)                                                        
 
389
      CALL AGGTXT(XT,YT,BUF(1:L),1)                                             
 
390
      YT  = YT - YH                                                            
 
391
      NUMB5  = '          '                                                     
 
392
      NUMB6  = '          '                                                     
 
393
      CALL STKRDR('PLRSTAT',19,2,IAC,SCALES,KUN,KNUL,IST)
 
394
      WRITE (NUMB5(1:10),9010) SCALES(1)                                        
 
395
      WRITE (NUMB6(1:10),9010) SCALES(2)                                        
 
396
      BUF    = 'X: '//NUMB5                                                     
 
397
      CALL LENBUF(BUF,L)                                                        
 
398
      CALL AGGTXT(XT,YT,BUF(1:L),1)                                             
 
399
      YT  = YT - YH                                                            
 
400
      BUF    = 'Y: '//NUMB6                                                     
 
401
      CALL LENBUF(BUF,L)                                                        
 
402
      CALL AGGTXT(XT,YT,BUF(1:L),1)                                             
 
403
C                                                                               
 
404
C *** selection                                                                 
 
405
      YT  = YT - 2*YH                                                          
 
406
      BUF    = 'Selection:'                                                     
 
407
      CALL LENBUF(BUF,L)                                                        
 
408
      CALL AGGTXT(XT,YT,BUF(1:L),1)                                             
 
409
C                                                                               
 
410
      IF ((SEL(1:1).EQ.'-') .OR. (SEL(1:1).EQ.' ')) THEN         !  no selection
 
411
         BUF    = 'all'                                                         
 
412
         CALL LENBUF(BUF,L)                                                     
 
413
         YT  = YT - YH                                                         
 
414
         CALL AGGTXT(XT,YT,BUF(1:L),1)                                          
 
415
                                                                                
 
416
      ELSE                                                                      
 
417
         ISTART = 1                                                             
 
418
   10    CONTINUE                                          !  check for logicals
 
419
         IDXOR  = INDEX(SEL(ISTART:),'.OR.')                                    
 
420
         IF (IDXOR.NE.0) THEN                                                   
 
421
            IDXOR  = ISTART + IDXOR + 2                                         
 
422
         ELSE                                                                   
 
423
            IDXOR  = 999                                                        
 
424
         END IF                                                                 
 
425
                                                                                
 
426
         IDXAND = INDEX(SEL(ISTART:),'.AND.')                                   
 
427
         IF (IDXAND.NE.0) THEN                                                  
 
428
            IDXAND = ISTART + IDXAND + 3                                        
 
429
         ELSE                                                                   
 
430
            IDXAND = 999                                                        
 
431
         END IF                                                                 
 
432
                                                                                
 
433
         IEND   = MIN(IDXOR,IDXAND)                                             
 
434
         IF (IEND.EQ.999) THEN                       !  no logicals in selection
 
435
            CALL LENBUF(SEL(ISTART:),LSEL)         !  length of the whole string
 
436
            NLINE  = LSEL/20                           !  number of lines needed
 
437
            NREST  = LSEL - NLINE*20           !  number of remaining characters
 
438
            DO 20 I = 1,NLINE                              !  loop through lines
 
439
               IS     = ISTART + (I-1)*20                         !  start index
 
440
               IE     = IS + 19                                     !  end index
 
441
               BUF    = SEL(IS:IE)                            !  store in buffer
 
442
               CALL LENBUF(BUF,L)                  !  length of string in buffer
 
443
               YT  = YT - YH                                                   
 
444
               CALL AGGTXT(XT,YT,BUF(1:L),1)                         !  put text
 
445
   20       CONTINUE                                                 !  end loop
 
446
                                                                                
 
447
            BUF    = SEL(ISTART+NLINE*20:)                                      
 
448
            CALL LENBUF(BUF,L)                               !  length of buffer
 
449
            YT  = YT - YH                                                      
 
450
            CALL AGGTXT(XT,YT,BUF(1:L),1)                        !  put the text
 
451
            GO TO 40                                                            
 
452
                                                                                
 
453
         ELSE                                     !  selection includes logicals
 
454
            CALL LENBUF(SEL(ISTART:IEND),L)              !  length of the buffer
 
455
            NLINE  = L/20                                !  number of full lines
 
456
            NREST  = L - NLINE*20              !  number of remaining characters
 
457
            DO 30 I = 1,NLINE                              !  loop through lines
 
458
               IS     = ISTART + (I-1)*20                         !  start index
 
459
               IE     = IS + 19                                     !  end index
 
460
               BUF    = SEL(IS:IE)                                !  fill buffer
 
461
               CALL LENBUF(BUF,L)                            !  length of buffer
 
462
               YT  = YT - YH                                                   
 
463
               CALL AGGTXT(XT,YT,BUF(1:L),1)                     !  put the text
 
464
   30       CONTINUE                                              !  end of loop
 
465
                                                                                
 
466
            BUF    = SEL(ISTART+NLINE*20:IEND)                                  
 
467
            CALL LENBUF(BUF,L)                               !  length of buffer
 
468
            YT  = YT - YH                                                      
 
469
            CALL AGGTXT(XT,YT,BUF(1:L),1)                        !  put the text
 
470
            ISTART = IEND + 1                           !  determine next string
 
471
            GO TO 10                                                            
 
472
         END IF                                                                 
 
473
      END IF                                                                    
 
474
                                                                                
 
475
   40 CONTINUE 
 
476
C
 
477
      YT = YT - 2.0*YH
 
478
      CALL PLDATI(XT,YT)                                          
 
479
      RETURN                                                                    
 
480
      END