C
C       $Id: drwstr.f,v 1.6 2008-07-27 00:17:27 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 DRWSTR  (U,V,UX,VY,IMAX,JPTSY)
C
      PARAMETER (NCHK=750)
C
C THIS ROUTINE DRAWS THE STREAMLINES.
C .   THE XCHK AND YCHK ARRAYS SERVE AS A CIRCULAR LIST. THEY
C .   ARE USED TO PREVENT LINES FROM CROSSING ONE ANOTHER.
C
C THE WORK ARRAY HAS BEEN BROKEN UP INTO TWO ARRAYS FOR CLARITY.  THE
C .   TOP HALF OF WORK (CALLED UX) WILL HAVE THE NORMALIZED (AND
C .   POSSIBLY TRANSFORMED) U COMPONENTS AND WILL BE USED FOR BOOK
C .   KEEPING.  THE LOWER HALF OF THE WORK ARRAY (CALLED VY) WILL
C .   CONTAIN THE NORMALIZED (AND POSSIBLY TRANSFORMED) V COMPONENTS.
C
      DIMENSION       U(IMAX,JPTSY)         ,V(IMAX,JPTSY)
     1             ,  UX(IMAX,JPTSY)        ,VY(IMAX,JPTSY)
      COMMON /STR01/  IS         ,IEND      ,JS        ,JEND
     1             ,  IEND1      ,JEND1     ,I         ,J
     2             ,  X          ,Y         ,DELX      ,DELY
     3             ,  ICYC1      ,IMSG1     ,IGFL1
      COMMON /STR03/  INITA , INITB , AROWL , ITERP , ITERC , IGFLG
     1             ,  IMSG , UVMSG , ICYC , DISPL , DISPC , CSTOP
      COMMON /STR04/  XCHK(NCHK) ,YCHK(NCHK) , NUMCHK , UXSML
C
C
        SAVE
C
C STATEMENT FUNCTIONS FOR SPATIAL AND VELOCITY TRANSFORMATIONS.
C .   (IF THE USER WISHES OTHER TRANSFORMATIONS  REPLACE THESE STATEMENT
C .   FUNCTIONS WITH THE APPROPRIATE NEW ONES, OR , IF THE TRANSFORMA-
C .   TIONS ARE COMPLICATED DELETE THESE STATEMENT FUNCTIONS
C .   AND ADD EXTERNAL ROUTINES WITH THE SAME NAMES TO DO THE TRANS-
C .   FORMING.)
C
C     FX(X,Y) = X
C     FY(X,Y) = Y
      FU(X,Y) = X
      FV(X,Y) = Y
C
C INITIALIZE
C
      ISKIP    = I1MACH(5) - 2
      ISKIP1   = ISKIP + 1
      UXSML    = R1MACH(3) * DISPL
C
C
      NUMCHK   = NCHK
      LCHK = 1
      ICHK = 1
      XCHK(1) = 0.
      YCHK(1) = 0.
      KFLAG = 0
      IZERO = 0
      IONE = 1
      ITWO = 2
C
C
C COMPUTE THE X AND Y NORMALIZED (AND POSSIBLY TRANSFORMED)
C .   DISPLACEMENT COMPONENTS (UX AND VY).
C
      DO  40 J=JS,JEND
      DO  30 I=IS,IEND
      UX(I,J) = FU(U(I,J),V(I,J))
      VY(I,J) = FV(U(I,J),V(I,J))
      IF (UX(I,J).NE.0. .OR. VY(I,J).NE.0.) THEN
        CON = DISPL/SQRT(UX(I,J)*UX(I,J) + VY(I,J)*VY(I,J))
        UX(I,J) = CON*UX(I,J)
        VY(I,J) = CON*VY(I,J)
      END IF
C
C BOOKKEEPING IS DONE IN THE LEAST SIGNIFICANT BITS OF THE UX ARRAY.
C .   WHEN UX(I,J) IS EXACTLY ZERO THIS CAN PRESENT SOME PROBLEMS.
C .   TO GET AROUND THIS PROBLEM, SET IT TO A RELATIVELY SMALL NUMBER.
C
      IF(UX(I,J) .EQ. 0.) UX(I,J) = UXSML
C
C MASK OUT THE LEAST SIGNIFICANT TWO BITS AS FLAGS FOR EACH GRID BOX
C .   A GRID BOX IS ANY REGION SURROUNDED BY FOUR GRID POINTS.
C .   FLAG 1 INDICATES WHETHER ANY STREAMLINE HAS PREVIOUSLY PASSED
C .          THROUGH THIS BOX.
C .   FLAG 2 INDICATES WHETHER ANY DIRECTIONAL ARROW HAS ALREADY
C .          APPEARED IN THIS BOX.
C .   JUDICIOUS USE OF THESE FLAGS PREVENTS OVERCROWDING OF
C .   STREAMLINES AND DIRECTIONAL ARROWS.
C
      CALL SBYTES( UX(I,J) , IZERO , ISKIP , 2 , 0 , 1 )
C
      IF (MOD(I,INITA).NE.0 .OR. MOD(J,INITA).NE.0)
     1    CALL SBYTES( UX(I,J) , IONE , ISKIP1, 1 , 0 , 1 )
      IF (MOD(I,INITB).NE.0 .OR. MOD(J,INITB).NE.0)
     1    CALL SBYTES( UX(I,J) , IONE , ISKIP , 1 , 0 , 1 )
C
   30 CONTINUE
   40 CONTINUE
C
   50 CONTINUE
C
C START A STREAMLINE. EXPERIENCE HAS SHOWN THAT A PLEASING PICTURE
C .   WILL BE PRODUCED IF NEW STREAMLINES ARE STARTED ONLY IN GRID
C .   BOXES THAT PREVIOUSLY HAVE NOT HAD OTHER STREAMLINES PASS THROUGH
C .   THEM. AS LONG AS A REASONABLY DENSE PATTERN OF AVAILABLE BOXES
C .   IS INITIALLY PRESCRIBED, THE ORDER OF SCANNING THE GRID PTS. FOR
C .   AVAILABLE BOXES IS IMMATERIAL
C
C FIND AN AVAILABLE BOX FOR STARTING A STREAMLINE
C
      IF (KFLAG.NE.0) GO TO  90
      DO  70 J=JS,JEND1
      DO  60 I=IS,IEND1
      CALL GBYTES( UX(I,J) , IUX , ISKIP , 2 , 0 , 1 )
      IF ( IAND( IUX , IONE ) .EQ. IZERO ) GO TO 80
   60 CONTINUE
   70 CONTINUE
C
C MUST BE NO AVAILABLE BOXES FOR STARTING A STREAMLINE
C
      GO TO 190
   80 CONTINUE
C
C INITILIZE PARAMETERS FOR STARTING A STREAMLINE
C .   TURN THE BOX OFF FOR STARTING A STREAMLINE
C .   CHECK TO SEE IF THIS BOX HAS MISSING DATA (IMSG.NE.0). IF SO ,
C .      FIND A NEW STARTING BOX
C
      CALL SBYTES( UX(I,J) , IONE , ISKIP1 , 1 , 0 , 1 )
      IF ( IMSG.EQ.0) GO TO 85
      IF (U(I,J).EQ.UVMSG .OR. U(I,J+1).EQ.UVMSG .OR.
     1    U(I+1,J).EQ.UVMSG .OR. U(I+1,J+1).EQ.UVMSG) GO TO 50
C
   85 ISAV = I
      JSAV = J
      KFLAG = 1
      PLMN1 = +1.
      GO TO 100
   90 CONTINUE
C
C COME TO HERE TO DRAW IN THE OPPOSITE DIRECTION
C
      KFLAG = 0
      PLMN1 = -1.
      I = ISAV
      J = JSAV
  100 CONTINUE
C
C INITIATE THE DRAWING SEQUENCE
C .   START ALL STREAMLINES IN THE CENTER OF A BOX
C
      NBOX = 0
      ITER = 0
      IF (KFLAG.NE.0) ICHKB = ICHK+1
      IF (ICHKB.GT.NUMCHK) ICHKB = 1
      X = REAL(I)+0.5
      Y = REAL(J)+0.5
      XBASE = X
      YBASE = Y
      CALL FL2INT (FX(X,Y),FY(X,Y),IFX,IFY)
      CALL PLOTIT (IFX,IFY,0)
      CALL GBYTES( UX(I,J) , IUX , ISKIP , 2 , 0 , 1 )
      IF ( (KFLAG.EQ.0) .OR. (IAND( IUX , ITWO ) .NE. 0 ) ) GO TO 110
C
C GRID BOX MUST BE ELIGIBLE FOR A DIRECTIONAL ARROW
C
      CALL GNEWPT (UX,VY,IMAX,JPTSY)
      MFLAG = 1
      GO TO 160
C
  110 CONTINUE
C
C PLOT LOOP
C .   CHECK TO SEE IF THE STREAMLINE HAS ENTERED A NEW GRID BOX
C
      IF (I.NE.INT(X) .OR. J.NE.INT(Y)) GO TO 120
C
C MUST BE IN SAME BOX CALCULATE THE DISPLACEMENT COMPONENTS
C
      CALL GNEWPT (UX,VY,IMAX,JPTSY)
C
C UPDATE THE POSITION AND DRAW THE VECTOR
C
      X = X+PLMN1*DELX
      Y = Y+PLMN1*DELY
      CALL FL2INT (FX(X,Y),FY(X,Y),IFX,IFY)
      CALL PLOTIT (IFX,IFY,1)
      ITER = ITER+1
C
C CHECK STREAMLINE PROGRESS EVERY 'ITERP' OR SO ITERATIONS
C
      IF (MOD(ITER,ITERP).NE.0) GO TO 115
      IF (ABS(X-XBASE).LT.DISPC  .AND. ABS(Y-YBASE).LT.DISPC ) GO TO  50
      XBASE = X
      YBASE = Y
      GO TO 110
  115 CONTINUE
C
C SHOULD THE CIRCULAR LISTS BE CHECKED FOR STREAMLINE CROSSOVER
C
      IF ( (ITERC.LT.0) .OR. (MOD(ITER,ITERC).NE.0) ) GO TO 110
C
C MUST WANT THE CIRCULAR LIST CHECKED
C
      GO TO 130
  120 CONTINUE
C
C MUST HAVE ENTERED A NEW GRID BOX  CHECK FOR THE FOLLOWING :
C .   (1) ARE THE NEW POINTS ON THE GRID
C .   (2) CHECK FOR MISSING DATA IF MSG  DATA FLAG (IMSG) HAS BEEN SET.
C .   (3) IS THIS BOX ELIGIBLE FOR A DIRECTIONAL ARROW
C .   (4) LOCATION OF THIS ENTRY VERSUS OTHER STREAMLINE ENTRIES
C
      NBOX = NBOX+1
C
C CHECK (1)
C
      IF (INT(X).LT.IS .OR. INT(X).GT.IEND1) GO TO  50
      IF (INT(Y).LT.JS .OR. INT(Y).GT.JEND1) GO TO  50
C
C CHECK (2)
C
      IF ( IMSG.EQ.0) GO TO 125
      II = INT(X)
      JJ = INT(Y)
      IF (U(II,JJ).EQ.UVMSG .OR. U(II,JJ+1).EQ.UVMSG .OR.
     1    U(II+1,JJ).EQ.UVMSG .OR. U(II+1,JJ+1).EQ.UVMSG) GO TO 50
  125 CONTINUE
C
C CHECK (3)
C
      CALL GBYTES( UX(I,J) , IUX , ISKIP , 2 , 0 , 1 )
      IF ( IAND( IUX , ITWO )  .NE. 0) GO TO 130
      MFLAG = 2
      GO TO 160
  130 CONTINUE
C
C CHECK (4)
C
      DO 140 LOC=1,LCHK
      IF (ABS( X-XCHK(LOC) ).GT.CSTOP .OR.
     1    ABS( Y-YCHK(LOC) ).GT.CSTOP) GO TO 140
      LFLAG = 1
      IF (ICHKB.LE.ICHK .AND. LOC.GE.ICHKB .AND. LOC.LE.ICHK) LFLAG = 2
      IF (ICHKB.GE.ICHK .AND. (LOC.GE.ICHKB .OR. LOC.LE.ICHK)) LFLAG = 2
      IF (LFLAG.EQ.1) GO TO  50
  140 CONTINUE
      LCHK = MIN(LCHK+1,NUMCHK)
      ICHK = ICHK+1
      IF (ICHK.GT.NUMCHK) ICHK = 1
      XCHK(ICHK) = X
      YCHK(ICHK) = Y
      I = INT(X)
      J = INT(Y)
      CALL SBYTES( UX(I,J) , IONE , ISKIP1 , 1 , 0 , 1 )
      IF (NBOX.LT.5) GO TO 150
      ICHKB = ICHKB+1
      IF (ICHKB.GT.NUMCHK) ICHKB = 1
  150 CONTINUE
      GO TO 110
C
  160 CONTINUE
C
C THIS SECTION DRAWS A DIRECTIONAL ARROW BASED ON THE MOST RECENT DIS-
C .   PLACEMENT COMPONENTS ,DELX AND DELY, RETURNED BY GNEWPT. IN EARLIE
C .   VERSIONS THIS WAS A SEPARATE SUBROUTINE (CALLED DRWDAR). IN THAT
C .   CASE ,HOWEVER, FX AND FY WERE DEFINED EXTERNAL SINCE THESE
C .   FUNCTIONS WERE USED BY BOTH DRWSTR AND DRWDAR. IN ORDER TO
C .   MAKE ALL DEFAULT TRANSFORMATIONS STATEMENT FUNCTIONS I HAVE
C .   PUT DRWDAR  HERE AND I WILL USE MFLAG TO RETURN  TO THE CORRECT
C .   LOCATION IN THE CODE.
C
      IF ( (DELX.EQ.0.) .AND. (DELY.EQ.0.) ) GO TO 50
C
      CALL SBYTES( UX(I,J) ,IONE , ISKIP , 1 ,0 , 1 )
      D = ATAN2(-DELX,DELY)
      D30 = D+0.5
  170 YY = -AROWL*COS(D30)+Y
      XX = +AROWL*SIN(D30)+X
      CALL FL2INT (FX(XX,YY),FY(XX,YY),IFXX,IFYY)
      CALL PLOTIT (IFXX,IFYY,1)
      CALL FL2INT (FX(X,Y),FY(X,Y),IFX,IFY)
      CALL PLOTIT (IFX,IFY,0)
      IF (D30.LT.D) GO TO 180
      D30 = D-0.5
      GO TO 170
  180 IF (MFLAG.EQ.1) GO TO 110
      IF (MFLAG.EQ.2) GO TO 130
C
  190 CONTINUE
C
C     FLUSH PLOTIT BUFFER
C
      CALL PLOTIT(0,0,0)
      RETURN
      END
