C   21/01/83 403132002  MEMBER NAME  GPHMAINX (JADEGS)      FORTRAN
      IMPLICIT INTEGER*2 (H)
C---
C---   SUMMER 1982 VERSION, SPECIAL VERSION FOR PUBLIC RELATIONS
C---
      REAL*8 DATE,TIME,DDN
      INTEGER*4 BINTIM
      COMMON/CBSTR/MODE
#include "cgraph.for"
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 --------------------------
#include "ciouni.for"
      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,3)
      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*'    ',
     $           'F11L','HO.A','UPDA','T1  ','    ','    ',5*'    '/
C---
C---     MAIN ROUTINE FOR CONDENSED JADE GRAPHICS PROGRAM.
C---     STARTED WEDNESDAY, MAY 17, 1978.
C---     LAST CHANGE 13.3.84   C.BOWDERY,S.CARTWRIGHT
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
      CALL TRMOUT(80,'  ---> ALLOCATION READY. ENTER FOR FIRST EVENT:^')
      CALL TRMIN(2,HDUM)
      GO TO 802
801   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)
C SET SOME CONVENIENT DEFAULTS FOR PUBLIC RELATION DISPLAYS
      DSPDTL(13) = .FALSE.
      DSPDTL(17) = .TRUE.
      DSPDTL(15) = .TRUE.
      DSPDTL(12) = .FALSE.
      DSPDTL(23) = .TRUE.
      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
C-----------------------------------------------------------------------
      BLOCK DATA
C-----------------------------------------------------------------------
      IMPLICIT INTEGER*2 (H)
      LOGICAL FL18,FL22,FL24,DSPDTM
      COMMON/CPROJ/XMINR,XMAXR,YMINR,YMAXR,IPRJC,FL18,FL22,FL24,KPROJ
#include "chsym.for"
      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 /2*.TRUE., 5*.FALSE.,.TRUE.,22*.FALSE./
      DATA ISTVW  / 0 /, JTVW   / 0 /
#include "cgeo2.for"
#include "cgeo2com.for"
      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
