C path: /home/rc1/aer_lblrtm/src/SCCS/s.ncargks.f
C revision: 5.1
C created: 05/12/98 08:23:58
C presently: 05/12/98 09:11:47
C
SUBROUTINE PLTID3 (PROGID,XSIZ,YSIZ,FAC) 1
C
C----------------------------------------------------------------------
C
C THE PURPOSE OF THIS SUBROUTINE PACKAGE IS TO PROVIDE
C AN INTERFACE FROM THE CALCOMP PEN ROUTINES CURRENTLY
C ON THE AFGL CYBER TO THE NCAR GKS PLOTTING PACKAGE.
C
C NOTE: THESE ROUTINES WERE WRITTEN TO INTERFACE THE
C CALCOMP CALLS USED BY LBLRTM, AND DO NOT
C PROVIDE A COMPLETE CALCOMP TO NCAR INTERFACE.
C
C (COMPATIBLE WITH VERSION 2.00 OF NCAR GKS)
C
C A.E.R. (DECEMBER 1989)
C
C----------------------------------------------------------------------
C
C SUBROUTINE PLTID3(PROGID,XMAX,YMAX,FACTOR) // AFGL //
C
C SUBROUTINE PLTID3 IS USED IN PEN MODE ONLY. THIS SUBROUTINE
C MUST BE THE FIRST ROUTINE CALLED AS IT INITIALIZES THE PLOT.
C
C PROGID = AN ARRAY OF ALPHANUMERIC CHARACTERS (HOLLERITH)
C DIMENSIONED BY THREE, TO BE USED AS IDENTIFICATION
C FOR THE PLOT.
C XMAX = MAXIMUM LENGTH OF X (REAL) IN INCHES.
C YMAX = MAXIMUM LENGTH OF Y (REAL) IN INCHES.
C FACTOR = A MULTIPLICATIVE FACTOR TO CHANGE SIZE OT PLOTTING.
C
C----------------------------------------------------------------------
C
IMPLICIT REAL*8 (V)
C
COMMON /HVERSN/ HVRLBL,HVRCNT,HVRFFT,HVRATM,HVRLOW,HVRNCG,
* HVROPR,HVRPST,HVRPLT,HVRTST,HVRUTL,HVRXMR
COMMON /AXISXY/ V1,V2,XSIZE,YMIN,YMAX,YSIZE,IDEC,JEMIT,JPLOT,
* LOGPLT,NUMDVX,NUMSBX,DIVLNX,DELV,NUMDVY,NUMSBY,
* DIVLNY,DELY,HGT,YPL,DX,DY,NOENDX,NOENDY,IXDEC,
* JOUT,JPLTFL,JHDR,IFUNCT,NODUM
C
COMMON /NCARID/ IFIRST
C
CHARACTER*8 HVRLBL,HVRCNT,HVRFFT,HVRATM,HVRLOW,HVRNCG,HVROPR,
* HVRPLT,HVRPST,HVRTST,HVRUTL,HVRXMR
C
LOGICAL IFIRST
DIMENSION PROGID(*)
C
C ASSIGN SCCS VERSION NUMBER TO MODULE
C
HVRNCG = '5.1'
C
C THIS ROUTINE DOES THE INITIALIZATION FOR THE NCAR ROUTINES.
C
C NOTE: ALL FOUR PASSED QUANTITIES ARE IGNORED.
C
IF (IFIRST) THEN
CALL GOPKS (6,IDUM)
CALL GOPWK (1,2,1)
CALL GACWK (1)
CALL GSCLIP (0)
IFIRST = .FALSE.
ELSE
CALL FRAME
ENDIF
IF (JHDR.EQ.0) CALL SET (0.1,0.9,0.1,0.65,0.,10.,0.,10.,1)
C
RETURN
C
END
SUBROUTINE ENDPLT 2
C
C----------------------------------------------------------------------
C
C SUBROUTINE ENDPLT // AFGL //
C
C SUBROUTINE ENDPLT MUST BE THE LAST SUBROUTINE
C TO BE CALLED IN ALL PLOTTING JOBS.
C
C----------------------------------------------------------------------
C
C THIS SUBROUTINE CALLS THE NCAR CLOSING ROUTINES
C
C----------------------------------------------------------------------
C
CALL GDAWK (1)
CALL GCLWK (1)
CALL GCLKS
C
RETURN
C
END
SUBROUTINE PLOT (X,Y,IPEN) 24
C
IMPLICIT REAL*8 (V)
C
C----------------------------------------------------------------------
C
C SUBROUTINE PLOT(X,Y,IC) // AFGL //
C
C SUBROUTINE PLOT IS USED TO MOVE THE PEN
C AND TO REDEFINE A NEW ORIGIN.
C
C X = X COORDINATE, IN INCHES. (REAL)
C Y = Y COORDINATE, IN INCHES. (REAL)
C IC = IF IC=2, PEN DOWN AS PEN MOVES TO (X,Y). (INTEGER)
C IF IC=3, PEN UP AS PEN MOVES TO (X,Y).
C IF IC=-2 OR -3, A NEW ORIGIN IS DEFINED AT (X,Y).
C
C----------------------------------------------------------------------
C
COMMON /AXISXY/ V1,V2,XSIZE,YMIN,YMAX,YSIZE,IDEC,JEMIT,JPLOT,
* LOGPLT,NUMDVX,NUMSBX,DIVLNX,DELV,NUMDVY,NUMSBY,
* DIVLNY,DELY,HGT,YPL,DX,DY,NOENDX,NOENDY,IXDEC,
* JOUT,JPLTFL,JHDR,IFUNCT,NODUM
C
FAC = 0.141176471
IF (IPEN.LT.0) THEN
IF (X.NE.1.) GO TO 10
IF (JHDR.EQ.0) CALL FRAME
FL = 0.175
FR = XSIZE*FAC+FL
FB = 0.175
FT = YSIZE*FAC+FB
C
C IF FR > .85 ADJUST SCALE ON BOTH X AND Y TO RESET
C
IF (FR.GT.0.85) THEN
SX = FR/0.85
FR = 0.85
FT = FT/SX
ENDIF
C
C IF FT > .65 ADJUST SCALE ON BOTH X AND Y TO RESET
C
IF (FT.GT.0.65) THEN
SY = FT/0.65
FT = 0.65
FR = FR/SY
ENDIF
C
UL = 0.
UR = XSIZE
UB = 0.
UT = YSIZE
L = 1
CALL SET (FL,FR,FB,FT,UL,UR,UB,UT,L)
ELSE
RX = CUFX(X)
RY = CUFY(Y)
IF (IPEN.EQ.2) THEN
CALL PLOTIF (RX,RY,1)
ELSE
CALL PLOTIF (RX,RY,0)
ENDIF
ENDIF
C
10 RETURN
C
END
SUBROUTINE LINE (X,Y,N,K,J) 1
C
IMPLICIT REAL*8 (V)
C
C----------------------------------------------------------------------
C
C SUBROUTINE LINE(X,Y,N,K,J,L) // AFGL //
C
C SUBROUTINE LINE PRODUCES A SINGLE LINE BY CONNECTING THE POINTS
C DEFINED IN THE DIMENSION VARIABLES X AND Y.
C
C X = ARRAY OF X COORDINATES. (REAL)
C Y = ARRAY OF Y COORDINATES. (REAL)
C N = ACTUAL NUMBER OF POINTS TO BE PLOTTED. (INTEGER)
C K = REPEAT CYCLE. (INTEGER, USUALLY K=1)
C J = CONTROL FOR USING SYMBOLS. (INTEGER)
C J = 0 WILL PRODUCE A LINE PLOT WITHOUT SYMBOLS.
C J > 0 WILL PRODUCE A LINE PLOT WITH A SYMBOL
C AT EVERY JTH POINT.
C J < 0 WILL SUPPRESS THE LINE BETWEEN POINTS.
C L = A NUMBER DESCRIBING THE SYMBOL TO BE USED.
C
C----------------------------------------------------------------------
C
COMMON /AXISXY/ V1,V2,XSIZE,YMIN,YMAX,YSIZE,IDEC,JEMIT,JPLOT,
* LOGPLT,NUMDVX,NUMSBX,DIVLNX,DELV,NUMDVY,NUMSBY,
* DIVLNY,DELY,HGT,YPL,DX,DY,NOENDX,NOENDY,IXDEC,
* JOUT,JPLTFL,JHDR,IFUNCT,NODUM
C
DIMENSION X(*),Y(*)
C
CALL GETSET (FL,FR,FB,FT,UL,UR,UB,UT,LL)
UL = V1
UR = V2
UB = YMIN
UT = YMAX
CALL SET (FL,FR,FB,FT,UL,UR,UB,UT,LL)
CALL CURVE (X,Y,N)
C
RETURN
C
END
SUBROUTINE SYMBOL (X,Y,H,BCD,T,N) 34
C
C----------------------------------------------------------------------
C
C SUBROUTINE SYMBOL (X,Y,H,BCD,T,N) // AFGL //
C
C SUBROUTINE SYMBOL WILL DRAW A SERIES OF SYMBOLS.
C
C X = X COORDINATE OF THE LOWER LEFT CORNER OF THE FIRST CHARACTE
C IN INCHES, RELATIVE TO THE CURRENT DEFINED ORIGIN. (REAL)
C Y = Y COORDINATE OF THE LOWER LEFT CORNER OF THE FIRST CHARACTE
C IN INCHES, RELATIVE TO THE CURRENT DEFINED ORIGIN. (REAL)
C H = THE HEIGHT PF THE CHARACTERS, IN INCHES. (REAL)
C BCD = THIS PARAMETER AND THE PARAMETER N DETERMINE THE TYPE OF
C ANNOTATION THE ROUTINE PRODUCES. BCD CONTAINS EITHER A
C STRING OF CHARACTERS OR THE INTEGER EQUIVALENT OF A
C DESIRED SYMBOL. (SEE N BELOW)
C T = THE ANGULAR ORIENTATION WITH RESPECT TO THE X AXIS,
C COUNTER-CLOCKWISE IN DEGREES. (REAL)
C N = THIS PARAMETER AND PARAMETER BCD DETERMINE TYPE OF
C LETTERING OR SYMBOLS PRODUCED BY ROUTINE SYMBOL.
C N > 0 - DEFINES CHARACTER COUNT IN BCD, LEFT JUSTIFIED.
C N = 0 - DEFINES SINGLE CHARACTER TO BE PLOTTED,
C RIGHT JUSTIFIED.
C N < 0 - DEFINES BCD TO BE THE INTEGER EQUIVALENT OF A
C SYMBOL. FOR N = -1, THE PEN IS UP DURING THE
C MOVE, FOR N = -2, THE PEN IS DOWN DURING THE
C MOVE, AFTER WHICH A SYMBOL IS PRODUCED.
C
C (NOTE: BCD = '3' CORRESPONDS TO A '+' SYMBOL.)
C
C----------------------------------------------------------------------
C
CHARACTER BCD*(*),PLUS*1,COLON*1,POINT*1,BCDC(43)*1,BCDA*43
C
EQUIVALENCE (BCDC(1),BCDA)
C
DATA PLUS / '+'/,COLON / ':'/,POINT / '.'/
C
CALL PWRITX (1.,1.,'''KRU''',5,1,0,0)
IS = KUPX(H)/11
IF (H.EQ.0.1) IS = (IS*3)/5
IF (N.EQ.43) THEN
READ (BCD,'(A43)') BCDA
DO 10 JJ = 1, 43
IF (BCDC(JJ).EQ.COLON) BCDC(JJ) = POINT
10 CONTINUE
READ (BCDA,'(A43)') BCD
ENDIF
IO = T
IF (N.GT.0) THEN
CALL PWRITX (X,Y,BCD,N,IS,IO,-1)
ELSE
CALL PWRITX (X,Y,PLUS,1,IS,IO,0)
ENDIF
C
RETURN
C
END
C
SUBROUTINE NUMBER (X,Y,H,F,T,N) 20
C
C----------------------------------------------------------------------
C
C SUBROUTINE NUMBER(X,Y,HGHT,FPN,THETA,N) // AFGL //
C
C SUBROUTINE NUMBER WILL INTERPRET AND PLOT A REAL (FLOATING POINT)
C OR INTEGER NUMBER
C
C X = X COORDINATE OF LOWER LEFT HAND CORNER OF THE HIGH ORDER
C DIGIT, IN INCHES, RELATIVE TO THE CURRENT ORIGIN. (REAL)
C Y = Y COORDINATE OF LOWER LEFT HAND CORNER OF THE HIGH ORDER
C DIGIT, IN INCHES, RELATIVE TO THE CURRENT ORIGIN. (REAL)
C HGHT = HEIGHT OF NUMBERS TO BE PLOTTED, IN INCHES. (REAL)
C FPN = NUMBER TO BE PLOTTED. (REAL)
C THETA = ORIENTATION OF THE NUMBER WITH RESPECT TO THE X AXIS,
C COUNTER-CLOCKWISE IN DEGREES. (REAL)
C N = NUMBER OF DIGITS AFTER THE DECIMAL POINT. (INTEGER)
C N = -1 WILL SUPPRESS THE DECIMAL POINT.
C
C----------------------------------------------------------------------
C
CHARACTER CHAR(30)*1,CHAR30*30,BLNK*1,POINT*1
C
EQUIVALENCE (CHAR(1),CHAR30)
C
LOGICAL IFIRST
C
DATA BLNK / ' '/,POINT / '.'/
C
IFIRST = .TRUE.
C
DO 10 , I = 1, 30
CHAR(I) = BLNK
10 CONTINUE
C
CALL PWRITX (1.,1.,'''KRU''',5,1,0,0)
C
IS = KUPX(H)/12
IO = T
IF (N.EQ.-1) THEN
INUM = NINT(F)
WRITE (CHAR30,'(I30)') INUM
ELSE
INUM = NINT(F*(10.**N))
IF (INUM.GE.0) THEN
RNUM = (FLOAT(INUM)+0.001)/(10.**N)
ELSE
RNUM = (FLOAT(INUM)-0.001)/(10.**N)
ENDIF
WRITE (CHAR30,'(F30.15)') RNUM
ENDIF
IBEG = 0
ICOUNT = 0
DO 20 , I = 1, 30
IF (CHAR(I).EQ.BLNK) THEN
GO TO 20
ELSE
ICOUNT = ICOUNT+1
IF (IFIRST) THEN
IBEG = I
IFIRST = .FALSE.
ENDIF
IF (CHAR(I).EQ.POINT) THEN
ICOUNT = ICOUNT+N
GO TO 30
ENDIF
ENDIF
20 CONTINUE
30 IEND = IBEG+ICOUNT-1
CALL PWRITX (X,Y,CHAR30(IBEG:IEND),ICOUNT,IS,IO,-1)
C
RETURN
C
END
C
C ****************************************************
BLOCK DATA NCARGKS
C
LOGICAL IFIRST
COMMON /NCARID/ IFIRST
C
DATA IFIRST / .TRUE. /
C
END
C ****************************************************