C   12/05/80 307101616  MEMBER NAME  GPHNAR   (S)           FORTRAN
      IMPLICIT INTEGER*2 (H)
C---
C---   SUMMER 1982 VERSION
C---
      REAL*8 DATE,TIME,DDN
      INTEGER*4 BINTIM
      COMMON/CBSTR/MODE
#include "cgraph.for"
#include "ciouni.for"
      COMMON /CNAROS/ IUNN1,IUNN2
C----------------------------------------------------------------------
C             MACRO CDATA .... BOS COMMON.
C----------------------------------------------------------------------
      COMMON /BCS/ IDATA(33000)
      DIMENSION HDATA(10),IPNT(50),ADATA(1)
      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
      EQUIVALENCE (NWORD,IPNT(50))
C------------------------ END OF MACRO CDATA --------------------------
      COMMON/CSVCW1/NDDSVE,NRWR
      DIMENSION HTM1(4),HTM2(4)
       EQUIVALENCE (DATE,HTM1(1)),(TIME,HTM2(1))
      DIMENSION IDATAL(11),HVOLSR(4),HELP(10),IMUC(11,5)
      DIMENSION HNAM(8),HNAME(4)
      DATA HBLANK/'  '/
      COMMON/CWORK/DATE,TIME,DDN,
     1             IDATAL,DUMMY,ITIME,KNTERR,JUMPBK,IANSW,INDEX0,
     1             NUMEVN,HVOLSR,HERR,HWORK(40)
      EQUIVALENCE (HELP(1),DATE),(HNAM(1),HNAME(1))
      DATA IMUC /'F11L','HO.B','UPDA','T0  ','    ','    ',5*'    ',
     $           'F11L','HO.B','UPDA','T1  ','    ','    ',5*'    ',
     $           'F11P','ST.C','UPDA','T1  ','    ','    ',5*'    ',
     $           'F22N','AR.T','OFCA','L2.R','1354','2   ',5*'    ',
     $           'F22N','AR.T','OFCA','L2.R','1300','0   ',5*'    '/
C---
C---     MAIN ROUTINE FOR CONDENSED JADE GRAPHICS PROGRAM.
C---     STARTED WEDNESDAY, MAY 17, 1978.
C---     LAST CHANGE 28.8.82   J.OLSSON
C---
C---     INITIALIZE PLOT10, SEND OPENING MESSAGES TO SCREEN AND ALLOCATE
C---     FORTRAN REFERENCE NUMBERS FOR INPUT AND CALIBRATION DATA SETS.
C---
      CALL INITT(DUMMY)
      CALL TWINDO(0,4095,0,4095)
C---
      DO 1244 I = 1,8
1244  HNAM(I) = HBLANK
      CALL IDFUN(HNAME,NBOK)
      ITIME=BINTIM(DUMMY)/360000
      IF(ITIME.LT.12) WRITE(6,1237) (HNAM(IS),IS=1,5)
1237  FORMAT('           GOOD MORNING, ',4A2,'  NICE TO SEE YOU AGAIN ',
     $A2)
1238  FORMAT('         GOOD AFTERNOON, ',4A2,'  NICE TO SEE YOU AGAIN ',
     $A2)
1239  FORMAT('           GOOD EVENING, ',4A2,'   WORKING LATE AGAIN ? ',
     $A2)
      IF(ITIME.GE.12.AND.ITIME.LT.18) WRITE(6,1238) (HNAM(I),I=1,5)
      IF(ITIME.GE.18) WRITE(6,1239) (HNAM(IS),IS=1,5)
C---
      CALL TRMOUT(80,'JADE INTERACTIVE GRAPHICS PROGRAM.  ******* VERSIO
     1N FROM SUMMER 1982 ****^')
      CALL NOTICE
      CALL DAY(DATE,TIME)
      DO 4987  I = 1,4
4987  HWORK(I) = HTM1(I)
      HWORK(5) = HBLANK
      DO 4986  I = 1,4
4986  HWORK(I+5) = HTM2(I)
      WRITE(6,6033) (HWORK(I),I=1,9)
6033  FORMAT(' SCAN SESSION BEGINNING AT DATE AND TIME: ',9A2)
    1 CONTINUE
      CALL TRMOUT(80,'PLEASE ENTER FULL NAME OF THE CATALOGUED DATA SET
     $WITH THE EVENTS^')
      CALL TRMIN(44,IDATAL)
      CALL TRMOUT(80,'  ^')
C---
C---     ALLOCATE FORTRAN REFERENCE NUMBER TO INPUT DATA SET.
C---
      DO 8 I=1,11
    8 IDATSV(I)=IDATAL(I)
   16 CONTINUE
      DO 3 I=1,4
    3 HVOLSR(I)=HBLANK
      NDDINN=0
      CALL GETPDD(IDATAL,HVOLSR,DDN,NDDINN,HERR)
      IF(HERR.EQ.0) GO TO 5
C---
C---     ERROR HAS OCCURRED ON ALLOCATION.
C---
      CALL TRMOUT(80,'AN ERROR HAS OCCURED IN ALLOCATING THE REQUESTED D
     $ATA SET.^')
      CALL TRMOUT(80,'THE NAME IS INCORRECT OR HMS/MSS IS JAMMED.^')
      CALL TRMOUT(80,'PLEASE TRY AGAIN OR CLOSE THE SESSION WITH CONTROL
     $/G.^')
      GO TO 1
C---
C---     SUCCESSFULLY ALLOCATED DATA SET.
C---
    5 CONTINUE
      MAXREC=0
C---
C---     NDDOUT WILL NORMALLY CONTAIN THE FORTRAN REFERENCE
C---     NUMBER OF THE OUTPUT DATA SET WITH WRITTEN EVENTS. IT IS HERE
C---     SET TO 0. FIRST CALL TO COMMAND WRIT WILL CALL FOR ALLOCATION
C---     OF THE OUTPUT DATA SET.
C---
      NDDOUT=0
      NDDSVE=0
      NRWR = 0
C=======================================================================
C---
C---     STANDARD VIEW, USER LEVEL STOP SETTING ETC.
C---
      ISTANV=2
      LASTVW=ISTANV
      CALL SETSCL(ISTANV)
      SXIN=XMIN
      SXAX=XMAX
      SYIN=YMIN
      SYAX=YMAX
C---
      DO 62 I=1,10
      SSTPS(I)=.FALSE.
62    LSTPS(I)=0
      SSTPS(2)=.TRUE.
      SSTPS(6)=.TRUE.
C---
      CALL TRMOUT(80,'DEFAULT STANDARD VIEW "RB" AND USER LEVELS 2 AND 600012400
     $ HAVE BEEN SET.    ^')
      CALL TRMOUT(80,'THEY CAN BE CHANGED AT ANY TIME BY THE COMMANDS CS
     $TV 1  AND CSTL.^')
      CALL TRMOUT(80,'USE COMMAND "C" FOR GOING FROM LEVEL 2 TO LEVEL 6^
     $')
      CALL TRMOUT(80,'  ^')
C---
      CALL TRMOUT(80,'NAME OF  OUTPUT DATA SET / EDIT BACKUP FILE  WILL
     $BE ASKED FOR ^')
      CALL TRMOUT(80,'AT THE FIRST COMMAND  "WRIT" OR "EDIT (SAVE)"^')
      CALL TRMOUT(80,'  ^')
C---
      CALL TRMOUT(80,'THE DEFAULT CALIBRATION DATA SET F11LHO.AUPDAT1 WI
     $LL NOW BE ALLOCATED.^')
      CALL TRMOUT(80,'IF YOU WISH THE BUPDAT0/BUPDAT1 FILES FOR LEAD GLA
     $SS CALIBR. (REFORM DATA),^')
      CALL TRMOUT(80,'THEN PRESS ANY CHARACTER+RETURN, ELSE PRESS RETURN
     $ FOR THE FIRST EVENT^')
      CALL TRMOUT(80,'  --->     PLEASE WAIT A LITTLE...^')
C---
C---       ALLOCATE THE CALIBRATION DATA SETS
C---
      NCALI = 1
      DO 898 I=1,11
  898 IDATAL(I)=IMUC(I,3)
      DO 893 I=1,4
  893 HVOLSR(I)=HBLANK
      LUNNNN=0
      CALL GETPDD(IDATAL,HVOLSR,DDN,LUNNNN,HERR)
      IF(HERR.NE.0) GO TO 795
      LUNITA(1)=LUNNNN
      GO TO 801
C---     ERROR HAS OCCURRED ON ALLOCATION.
  795 CALL TRMOUT(80,'ERROR IN ALLOCATING CALIBRATION FILE.  THE SESSION
     $ IS STOPPED ...^')
      STOP
803   NCALI = 2
      DO 797  II = 1,2
      DO 798 I=1,11
  798 IDATAL(I)=IMUC(I,II)
      DO 793 I=1,4
  793 HVOLSR(I)=HBLANK
      LUNNNN=0
      CALL GETPDD(IDATAL,HVOLSR,DDN,LUNNNN,HERR)
      IF(HERR.NE.0) GO TO 795
      LUNITA(II)=LUNNNN
  797 CONTINUE
C
C  HERE ALLOCATION OF PRIVATE FILES
C
  801 DO 197  II = 4,5
      DO 198 I=1,11
  198 IDATAL(I)=IMUC(I,II)
      DO 193 I=1,4
  193 HVOLSR(I)=HBLANK
      LUNNNN=0
      CALL GETPDD(IDATAL,HVOLSR,DDN,LUNNNN,HERR)
      IF(HERR.NE.0) GO TO 195
      IF(II.EQ.4) IUNN1 = LUNNNN
      IF(II.EQ.5) IUNN2 = LUNNNN
  197 CONTINUE
      GO TO 196
  195 CALL TRMOUT(80,'ERROR IN ALLOCATING PRIVATE FILES.  THE SESSION CO
     $NTINUES ...^')
196   CALL TRMOUT(80,'  ---> ALLOCATION READY. ENTER FOR FIRST EVENT:^')
      CALL TRMIN(2,HDUM)
      CALL TRMOUT(80,'  ---> ALLOCATION READY.  ENTER ?^')
      CALL TRMIN(2,HDUM)
      IF(HDUM.EQ.HBLANK) GO TO 802
      GO TO 803
C---
C---     INITIALIZE BOS.
C---     CALL MAIN ANALYSIS SUPERVISOR ROUTINE.
C---
802   CALL BINT(33000,10000,200,1)
      CALL SUPERV
C---
C---     END SCAN SESSION AND TERMINATE PLOT10.
C---
      IF(NDDOUT.EQ.0) GO TO 9866
      WRITE(JUSCRN,9865) NRWR
9865  FORMAT(' THE NEWLY WRITTEN RECORDS ARE PRECEDED BY ',I5,' RECORDS
     $ON THE OUTPUT FILE')
9866  CALL DAY(DATE,TIME)
      DO 5087  I = 1,4
5087  HWORK(I) = HTM1(I)
      HWORK(5) = HBLANK
      DO 5086  I = 1,4
5086  HWORK(I+5) = HTM2(I)
      WRITE(6,5033) (HWORK(I),I=1,9)
5033  FORMAT(' SCAN SESSION ENDING AT DATE AND TIME: ',9A2)
      ITIME=BINTIM(DUMMY)/360000
      IF(ITIME.GT.4.AND.ITIME.LE.9) WRITE(6,1246) (HNAM(I),I=1,5)
      IF(ITIME.GT.9.AND.ITIME.LE.16) WRITE(6,1247) (HNAM(I),I=1,5)
      IF(ITIME.GT.16.AND.ITIME.LE.21) WRITE(6,1248) (HNAM(I),I=1,5)
      IF(ITIME.GT.21.OR.ITIME.LE.4) WRITE(6,1249) (HNAM(I),I=1,5)
1246  FORMAT('         HAVE A PLEASANT MORNING, ',4A2,'  ',A2)
1247  FORMAT('          A VERY GOOD DAY TO YOU, ',4A2,'  ',A2)
1248  FORMAT('         HAVE AN ENJOYABLE EVENING, ',4A2,'  ',A2)
1249  FORMAT('         GOOD NIGHT AND SLEEP WELL, ',4A2,'  ',A2)
      CALL FINITT(0,0)
      STOP
      END
      BLOCK DATA
      IMPLICIT INTEGER*2 (H)
#include "chsym.for"
#include "cgeo2.for"
#include "cgeo2com.for"
      LOGICAL FL18,FL22,FL24,DSPDTM
      COMMON/CPROJ/XMINR,XMAXR,YMINR,YMAXR,IPRJC,FL18,FL22,FL24,KPROJ
      DATA HSYM /'0 ','1 ','2 ','3 ','4 ','5 ','6 ','7 ','8 ','9 ','A ',
     $'B ','C ','D ','E ','F ','G ','H ','I ','J ','K ','L ','M ','N ',
     $'O ','P ','Q ','R ','S ','T ','U ','V ','W ','X ','Y ','Z '/
      DATA FL18,FL22,FL24  /3*.FALSE./,KPROJ/0/
      COMMON /CGRAP2/ BCMD,DSPDTM(30),ISTVW,JTVW
      DATA DSPDTM /7*.FALSE.,.TRUE.,22*.FALSE./,ISTVW/0/,JTVW/0/
      DATA FENDC/81./,XYHOL1,XYHOL2/141.,151.5/,BLDPFW/400./,
     1 ZMINBL,ZPLUBL /-5250.,5250./,
     2 XSC /230.,150./, YSC /150.,70./, RSC /152.48,192.48/,
     3 ZMISC/-4235.,-4135./, ZPLSC/4235.,4135./, DZSC/6./,
     4 CHX/-140.,-400.,140.,-140.,-400.,140.,
     5 -140.,-400.,140.,-140.,-400.,140./,
     6 CHY /-400.,140.,-400.,-400.,140.,-400.,
     7 -400.,140.,-400.,-400.,140.,-400./,
     8 CHZ /-4770.,-4720.,-4770.,-4020.,-4070.,-4020.,
     9 4020.,4070.,4020.,4770.,4720.,4770./,
     A WLEN/800./, PITCH /25./, WZDIS/10./
C    8 CHZ /-4770.,-4720.,-4770.,-4020.,-3970.,-4020.,
C    9 4020.,3970.,4020.,4770.,4720.,4770./,
      COMMON /CZGEO/ RZCHI,RZCHA,NZRPSI,NZZ,Z1ZCH,Z2ZCH,ZCHA,ZCHB,ZCHSS,
     $               ZCHDL,ZCHDLL,DLZZ,DLZPHI,DLZW1,DLZW2
      DATA RZCHI,RZCHA /864.5, 884.5/
      DATA NZRPSI,NZZ /24,16/
      DATA Z1ZCH,Z2ZCH /-1200.,1200./
      DATA ZCHA,ZCHB,ZCHSS /5.,15.,1./
      DATA ZCHDL,ZCHDLL /100.,20./, DLZZ,DLZPHI /150.,227.63/
      DATA DLZW1,DLZW2 /228.94,231.58/
      COMMON /CZKON/ ZCVDR,ZCXCH,ZCTZER,ZCAPED,XL1,XL2
      DATA ZCVDR/0.34/, ZCXCH/1.0/, ZCTZER/0.0/, ZCAPED/0.0/
      DATA XL1,XL2 /2547.28, 2578.96/
      END
      END
