> From haley Tue Feb 4 09:10:48 1997
> From: haley (Mary Haley)
> Message-Id: <199702041610.JAA28024 AT unknown>
> Received: by niwot.scd.ucar.EDU (NCAR 12/5/96/ NCAR Mail Server 04/10/90)
> id JAA28024; Tue, 4 Feb 1997 09:10:46 -0700 (MST)
> Subject: Re: Skew-T
> To: hansen AT unknown (Ken Hansen)
> Date: Tue, 4 Feb 1997 09:10:46 -0700 (MST)
> In-Reply-To: <199702041608.JAA01534 AT unknown> from "Ken Hansen" at Feb 4, 97 09:08:47 am
> X-Mailer: ELM [version 2.4 PL24]
> MIME-Version: 1.0
> Content-Type: text/plain; charset=US-ASCII
> Content-Transfer-Encoding: 7bit
> Status: R
>
> >
> >
> > Mary,
> > I don't like to reply to these ncarg-talk questions because I don't
> > want to get on the damn list, but I have one if you want to pass it
> > on.
> > Ken
> >
>
> Do you mean you have an answer? Everybody in our group is subscribed
> to this email list so they see all the questions (if what you were
> doing was just forwarding the question onto us).
>
> Thanks,
>
> Mary
>
Actually I was just trying to save you folks some time. I have a routine
that was used to plot an aircraft data sounding. It's not generalized and
the user will need to carefully check the arguments list.
Ken
SUBROUTINE PLTSND(ACFLG,DTYPE,DWPT,DEWPAR,IPLTYP,NAMEAC,NSEC,
* PRES,PRESPAR,PDLC,PTLC,TEMP,TEMPPAR,TITLEC)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C
C INPUT:
C ACFLG - tells which ac plotted an how many per plot,
C one=one ac, first=first of 2ac, second=second of 2ac
C DTYPE - type of data used for sounding (RAW or FILT)
C DWPT - dew point array (CELSIUS)
C DEWPAR - the tape parameter name for the dew point measurement
C IPLTYP = 1 if pressure range is 1050-100 mb
C = 2 if pressure range is 1050-300 mb
C NAMEAC - the name of the aircraft
C NSEC - number of seconds of data
C PTLC - color of the pressure/temperature line
C PDLC - color of the pressure/dwpt line
C PRES - pressure array for thermodynamic data (MB)
C PRESPAR- the tape parameter name for the pressure measurement
C TEMP - temperature array (CELSIUS)
C TEMPPAR- the tape parameter name for the temperature measurement
C TITLEC - color of the title
C
C COMMONS:
C DATNOW contains LABDAT which contains today's date in a string
C VECPAR contains the vector length and scale for wind flags
C
C ASSUMPTIONS: a call to set with the following parameters
C DATA DEVRNG(4,2)/.05,.95,.05,.95, !boundaries in NDC
C .10,.95,.05,.90/
C DATA YTOP(2) /44.061,23.038/ !top of plot in world coord
C CALL SET(DEVRNG(1,IPLTYP),DEVRNG(2,IPLTYP),
C X DEVRNG(3,IPLTYP),DEVRNG(4,IPLTYP),
C X -19.0,27.1,-.9346217,YTOP(IPLTYP),1)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C input parameters
DIMENSION DWPT(*),PRES(*),TEMP(*)
CHARACTER*8 ACFLG
CHARACTER*4 DTYPE
CHARACTER*8 NAMEAC(*)
CHARACTER*8 PDLC,PTLC,TITLEC
CHARACTER*8 DEWPAR
CHARACTER*8 PRESPAR
CHARACTER*8 TEMPPAR
C common parameters
CHARACTER*16 LABDAT
COMMON /DATNOW/ LABDAT
C local parameters
DIMENSION IDASH(4)
C DASH LINE TYPES-SOLID M.R. SAT DRY
DATA IDASH/ 65535, 3855, 31710, 21845 /
DATA PMAX /1050./ !max pressure
DIMENSION PTOP(2)
DATA PTOP/ 100.,300. / !top of pressure plot
CHARACTER*50 PARAMS
CHARACTER*50 TITL
DATA TMIN,TMAX /-100.,100./ !min and max temperatures
DIMENSION YBOT(2),YDIST(2)
DATA YBOT/ -1.70,-1.45 /
DATA YDIST/ .80,.50 /
DIMENSION XLAB(2),XDIST(2) !x positon of sounding label
DATA XLAB/ -21.0,-23.25 /
DATA XDIST/ 26.0,28.00 /
C MAPPINGS FROM (P,T) TO CM ON SKEWT
FY(P)=132.182-44.061*ALOG10(P)
FX(T,Y)=0.54*T+0.90692*Y
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C get and set the color of the title
CALL CHNGCLR(TITLEC)
C write date,times and aircraft id on the plot
Y=YBOT(IPLTYP)
WRITE(TITL,106) NAMEAC(8),NAMEAC(1),NAMEAC(2),NAMEAC(3),
* NAMEAC(4)
106 FORMAT(5A8)
IF (ACFLG .NE. 'SECOND') THEN
CALL PLCHMQ(XLAB(IPLTYP),Y,TITL,13.,0.,-1.) !ac info
WRITE(TITL,107) DTYPE
107 FORMAT('DATA = ',A4)
CALL PLCHMQ(XLAB(IPLTYP)+XDIST(IPLTYP),Y,TITL,11.,0.,-1.)
Y=YBOT(IPLTYP)-YDIST(IPLTYP)
WRITE(TITL,108) LABDAT
108 FORMAT(A16)
CALL PLCHMQ(XLAB(IPLTYP)+XDIST(IPLTYP),Y,TITL,10.,0.,-1.)
ENDIF
IF (ACFLG .EQ. 'ONE') THEN
C write parameter names
WRITE(PARAMS,109) TEMPPAR,PRESPAR,DEWPAR
109 FORMAT('TEMP= ',A8,' PRES=',A8,' DEW=',A8)
CALL PLCHMQ(XLAB(IPLTYP),Y,PARAMS,10.,0.,-1.)
ELSEIF (ACFLG .EQ. 'SECOND') THEN
WRITE(TITL,106) '------ ',NAMEAC(1),NAMEAC(2),NAMEAC(3),
* NAMEAC(4)
Y=YBOT(IPLTYP)-YDIST(IPLTYP)
CALL PLCHMQ(XLAB(IPLTYP),Y,TITL,13.,0.,-1.)
ENDIF !only one ac per plot
c-----------------------------------------------------------------------
C set line styles
CALL GETUSV('LW',ISNORM) !default line size
CALL SETUSV('LW',4*ISNORM) !increased line size
IF (ACFLG .EQ. 'SECOND') THEN
CALL DASHDB(6342) !dotted dash pattern
ELSE
CALL DASHDB(IDASH(1)) !solid dash pattern
ENDIF
C get and set the text and lines to the color of the pres/temp line
CALL CHNGCLR(PTLC)
C draw presure/temperature lines
DO 60 I=1,NSEC
IF(PRES(I).LT.PTOP(IPLTYP).OR.PRES(I).GT.PMAX) THEN
IGOOD = 0
GOTO 60 !skip this point
ENDIF
IF(TEMP(I).GT.TMAX.OR.TEMP(I).LT.TMIN) THEN
C PRINT*,'PLTSND: TEMPERATURE VALUE OUT OF RANGE'
IGOOD = 0
GOTO 60 !skip this point
ENDIF
Y=FY(PRES(I))
X=FX(TEMP(I),Y)
IF(I.EQ.1.OR.IGOOD .EQ. 0) THEN
CALL FRSTD(X,Y)
IGOOD = 1
ELSE
CALL VECTD(X,Y)
ENDIF
60 CONTINUE
C get and set the text and lines to the color of the pres/dwpt line
CALL CHNGCLR(PDLC)
C draw presure/dwpt lines
DO 70 I=1,NSEC
IF(PRES(I).LT.PTOP(IPLTYP).OR.PRES(I).GT.PMAX) THEN
IGOOD = 0
GOTO 70 !skip this point
ENDIF
IF(DWPT(I).GT.TMAX .OR. DWPT(I).LT.TMIN) THEN
C PRINT*,'PLTSND: DEW POINT OUT OF RANGE'
IGOOD = 0
GO TO 70 !skip this point
ENDIF
Y=FY(PRES(I))
X=FX(DWPT(I),Y)
IF(I.EQ.1.OR.IGOOD .EQ. 0) THEN
CALL FRSTD(X,Y)
IGOOD = 1
ELSE
CALL VECTD(X,Y)
ENDIF
70 CONTINUE
C reset to normal line size
CALL SETUSV('LW',ISNORM)
CALL SFLUSH
RETURN
END
This archive was generated by hypermail 2b29 : Wed Jun 28 2000 - 09:40:31 MDT