C
C	$Id: dashdc.f,v 1.7 2008-07-27 00:23:03 haley Exp $
C                                                                      
C                Copyright (C)  2000
C        University Corporation for Atmospheric Research
C                All Rights Reserved
C
C The use of this Software is governed by a License Agreement.
C
      SUBROUTINE DASHDC (IPAT,JCRT,JSIZE)
C
C
C
C
C
C
      COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE,
     1    ICLOSE
C
C USER ENTRY POINT.
C DASHDC GIVES AN INTERNAL REPRESENTATION TO THE DASH PATTERN WHICH IS
C SPECIFIED IN ITS ARGUMENTS. THIS INTERNAL REPRESENTATION IS PASSED
C TO ROUTINE CFVLD IN THE COMMON-BLOCK DASHD1.
C
      CHARACTER*(*) IPAT
      CHARACTER*1   ICR
      CHARACTER*16  IPC(100)
C
C DASHD1 AND DASHD2 ARE USED
C FOR COMMUNICATION BETWEEN THE ROUTINES DASHDB, DASHDC AND CFVLD.
C ISL, MNCSTR AND IGP ARE INITIALIZED IN DASHBDX.
C
      COMMON /DASHD1/  ISL,  L,  ISIZE,  IP(100),  NWDSM1,  IPFLAG(100)
     1                 ,MNCSTR, IGP
      COMMON /DASHD2/  IPC
C
C IFCFLG IS THE FIRST CALL FLAG FOR DASHDB AND DASHDC.
C IT IS INITIALIZED IN DASHBDX.
C
      COMMON /DDFLAG/ IFCFLG
C
C IFSTFL CONTROLS THAT FRSTD IS CALLED BEFORE VECTD IS CALLED (IN CFVLD)
C WHENEVER DASHDB OR DASHDC HAVE BEEN CALLED.
C IT IS INITIALIZED IN DASHBDX AND REFERENCED IN CFVLD.
C
      COMMON /DCFLAG/ IFSTFL
C
C IFSTF2 CONTROLS THAT THE FRSTD ENTRY IS CALLED IN FDVDLD BEFORE THE
C VECTD ENTRY IS CALLED WHENEVER DASHDB OR DASHDC HAVE BEEN CALLED.
C IT IS INITIALIZED IN DASHBDX AND REFERENCED IN FDVDLD.
C
      COMMON /DFFLAG/ IFSTF2
C
C LOCAL VARIABLES TO DASHDB AND DASHDC ARE SAVED IN DSAVE6
C FOR THE NEXT CALL
C
      COMMON /DSAVE6/ MASK, NCHRWD, NBWD, MNCST1
C
C Make definitions of a blank, a gap, and a solid externally visible.
C
      COMMON /BLGASO/ IBLK,IGAP,ISOL
      CHARACTER*1     IBLK,IGAP,ISOL
C
C SAVE ALL VARIABLES
C
      SAVE
C
C NPD IS THE NUMBER OF WORDS IN IP
C
      DATA NPD/100/
C
C Do a call forcing a BLOCKDATA to be loaded from a binary library.
C
      CALL DASHBD
C
C THE FOLLOWING CALL IS FOR LIBRARY STATISTICS GATHERING AT NCAR
C
      CALL Q8QST4 ('GRAPHX', 'DASHSMTH', 'DASHDC', 'VERSION  1')
C
C     NC IS THE NUMBER OF CHARACTERS IN IPAT
C
      NC = LEN(IPAT)
      IF (IFCFLG .EQ. 2) GOTO 10
C
C CHECK IF THE CONSTANTS IN THE BLOCKDATA DASHBDX ARE LOADED CORRECTLY
C
      IF (MNCSTR .EQ. 15) GOTO 6
      CALL SETER('DASHDC -- BLOCKDATA DASHBDX APPARENTLY NOT LOADED CORR
     1ECTLY',1,2)
    6 CONTINUE
C
C INITIALIZATION
C
      MNCST1 = MNCSTR + 1
C
C MASK IS AN ALL SOLID PATTERN TO BE PASSED TO OPTN (65535=177777B).
C
      MASK=IOR(ISHIFT(32767,1),1)
C
C
      IFCFLG = 2
C
C NCHRTS - NUMBER OF CHARS IN THIS HOLLERITH STRING.
C L      - NUMBER OF WORDS IN THE FINAL PATTERN, POINTER TO IP ARRAY.
C ISL    - FLAG FOR ALL SOLID PATTERN (1) OR ALL GAP PATTERN (-1).
C IFSTFL - FLAG TO CONTROL THAT FRSTD IS CALLED IN CFVLD BEFORE VECTD IS
C          CALLED, WHENEVER DASHDB OR DASHDC HAVE BEEN CALLED.
C IFSTF2 - FLAG TO CONTROL THAT FRSTD IS CALLED IN FDVDLD BEFORE VECTD
C          IS CALLED, WHENEVER DASHDB OR DASHDC HAVE BEEN CALLED.
C
   10 CONTINUE
      NCHRTS = 0
      L = 0
      ISL = 0
      IFSTFL = 1
      IFSTF2 = 1
C
C RETRIEVE THE RESOLUTION AS SET BY THE USER.
C
      CALL GETUSV('XF',LXSAVE)
      CALL GETUSV('YF',LYSAVE)
C
C IADJUS - TO ADJUST NUMBERS TO THE GIVEN RESOLUTION.
C
      IADJUS = ISHIFT(1,15-LXSAVE)
      ICRT = JCRT*IADJUS
      ISIZE = JSIZE
      CHARW = REAL(ISIZE*IADJUS)
      IF (ISIZE .GT. 3) GO TO 30
      CHARW = 256. + REAL(ISIZE)*128.
      IF (ISIZE .EQ. 3) CHARW = 768.
C
   30 CONTINUE
      IF (ICRT .LT. 1) GO TO 230
      MODE = 2
C
C START MAIN LOOP
C
C THIS LOOP GENERATES THE IP ARRAY (NEEDED BY CURVED,VECTD,ETC.) FROM
C THE CHARACTER STRING IN IPAT.  EACH ITERATION OF THE LOOP PROCESSES
C ONE CHAR OF IPAT.  A SOLID OR GAP IS CONSIDERED TO BE A TYPE 1 ENTRY,
C AND A LABEL CHARACTER IS CONSIDERED TO BE A TYPE 2 ENTRY.
C
C IN THE CODE, L IS THE NUMBER OF CHANGES IN THE LINESTYLE (FROM GAP
C TO SOLID, SOLID TO CHARACTER, ETC.)  THE IP AND IPFLAG ARRAYS DESCRIBE
C THE LINE TO BE DRAWN, AND THESE ARRAYS ARE INDEXED FROM 1 TO L.  THE
C RELATIONSHIP BETWEEN IP AND IPFLAG IS:
C
C      IPFLAG(N)    IP(N)
C      ---------    -----
C          1        LENGTH (IN PLOTTER ADDRESS UNITS) OF SOLID LINE TO
C                   BE DRAWN.
C          0        NUMBER OF CHARACTERS TO BE PLOTTED.
C         -1        LENGTH (IN PLOTTER ADDRESS UNITS) OF GAP.
C
C THE 160 LOOP HANDLES 5 CASES:
C
C    1.)  CONTINUE TYPE 2 ENTRY (60-80)
C    2.)  START TYPE 2 ENTRY (80-90)
C    3.)  END TYPE 2 ENTRY AND START TYPE 1 ENTRY (90-160)
C    4.)  START TYPE 1 ENTRY, OR SWITCH TYPE 1 ENTRY FROM SOLID TO
C         GAP OR FROM GAP TO SOLID (140-160)
C    5.)  CONTINUE TYPE 1 ENTRY (150-160)
C
      DO 160 J=1,NC
C
C GET NEXT CHAR INTO ICR, RIGHT JUSTIFIED ZERO FILLED.
C
            ICR = IPAT(J:J)
C
C MODE SPECIFIES WHAT THE LAST CHARACTER PROCESSED WAS:
C
C    LAST ICR WAS $ (SOLID),      MODE IS 8
C    LAST ICR WAS ' (GAP),        MODE IS 2
C    LAST ICR WAS HOLLERITH CHAR, MODE IS 5
C
C NMODE SPECIFIES WHAT THE CURRENT CHARACTER TO BE PROCESSED IS:
C
C      ICR     NMODE
C      ---     -----
C       $        1
C       CHAR     0
C       '       -1
C
            NMODE = 0
            IF (ICR .EQ. IBLK) GO TO 160
            IF (ICR .EQ. IGAP) NMODE = -1
            IF (ICR .EQ. ISOL) NMODE = 1
            IF (L.EQ.0 .AND. NMODE.EQ.-1) MODE = 8
C
C NGO DETERMINES WHERE TO BRANCH BASED ON CASE TO BE PROCESSED.
C COMPUTE MODE FOR NEXT ITERATION.
C
            NGO = NMODE+MODE
            MODE = NMODE*3+5
            GO TO (150,80,140,90,60,90,140,80,150),NGO
C
C CHAR TO CHAR
C
C CASE 1) - CONTINUE TYPE 2 ENTRY.
C
   60      IF (NCHRTS .EQ. MNCSTR) GO TO 160
           NCHRTS = NCHRTS + 1
           IP(L) = NCHRTS
           IPC(L)(NCHRTS:NCHRTS) = ICR
           GO TO 160
C
C BLANK OR SOLID TO CHAR
C
C CASE 2) - START STRING ENTRY.  LGBSTR POINTS TO THE GAP WHICH
C           WILL CONTAIN THE STRING.
C
   80      LGBSTR = MIN(L+1,NPD)
           L = MIN(LGBSTR+1,NPD)
           IPFLAG(L) = 0
           NCHRTS    = 1
           IP(L)     = 1
           IPC(L)(NCHRTS:NCHRTS) = ICR
           GO TO 160
C
C CHAR TO SOLID OR GAP
C
C CASE 3) - END STRING ENTRY.  ICR IS A $ OR '.
C
   90      CONTINUE
           IP(LGBSTR) = CHARW*(REAL(NCHRTS) + .5)
           IPFLAG(LGBSTR) = -1
           IF (IGP .EQ. 0) IPFLAG(LGBSTR) = 1
C
C BLANK TO SOLID OR SOLID TO BLANK
C
C CASE 4) - START TYPE 1 ENTRY.
C
  140       L = MIN(L+1,NPD)
            IP(L) = 0
C
C ADD TO A BLANK OR SOLID LINE
C
C CASE 5) - CONTINUE TYPE 1 ENTRY.  ICR IS A $ OR '.
C ADD ICRT UNITS TO THE PLOTTER ADDRESS UNITS IN IP(L).
C NMODE INDICATES IF IT IS A GAP OR A SOLID.
C
  150       IP(L) = IP(L) + ICRT
            IPFLAG(L) = NMODE
  160    CONTINUE
C
C IF LAST ICR PROCESSED WAS A LABEL CHARACTER, MUST END STRING
C ENTRY.
C
      IF (NGO.NE.2 .AND. NGO.NE.5 .AND. NGO.NE.8) GO TO 220
      IP(LGBSTR) = CHARW*(REAL(NCHRTS)+.5)
      IPFLAG(LGBSTR) = -1
      IF (IGP .EQ. 0) IPFLAG(LGBSTR) = 1
C
C IF IP ARRAY HAS ONLY ONE TYPE 1 ENTRY, SET ISL FLAG.
C
  220 IF (L .GT. 1) RETURN
      IBIG = ISHIFT(1,MAX(LXSAVE,LYSAVE))
      IF (IP(L) .GE. IBIG) GO TO 230
      IF (IPFLAG(L)) 240,240,230
  230 ISL = 1
      RETURN
  240 ISL = -1
      RETURN
      END
