Re: Skew-T

From: Ken Hansen (hansen@XXXXXX)
Date: Tue Feb 04 1997 - 09:51:31 MST


> From haley Tue Feb 4 09:10:48 1997
> From: haley (Mary Haley)
> Message-Id: <199702041610.JAA28024@niwot.scd.ucar.EDU>
> 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@niwot.scd.ucar.EDU (Ken Hansen)
> Date: Tue, 4 Feb 1997 09:10:46 -0700 (MST)
> In-Reply-To: <199702041608.JAA01534@precarious.scd.ucar.edu> 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:45:38 MDT