text:
C    Copyright(C) 1999-2020 National Technology & Engineering Solutions
C    of Sandia, LLC (NTESS).  Under the terms of Contract DE-NA0003525 with
C    NTESS, the U.S. Government retains certain rights in this software.
C
C    See packages/seacas/LICENSE for details

      SUBROUTINE GETTRN (ML, MS, MNNPS, NS, ISLIST, NINT, IFLINE, NLPS,
     &   ILLIST, LINKL, LINKS, X, Y, NID, NNPS, ANGLE, NPER, I1, I2,
     &   I3, I4, I5, I6, I7, I8, XCEN1, YCEN1, XCEN2, YCEN2, XMID1,
     &   YMID1, XMID2, YMID2, CCW, HALFC, ERR)
C***********************************************************************

C  SUBROUTINE GETTRN = GETS THE APPROPRIATE SIDES,  CORNERS,  AND MIDPOINT
C                      VALUES FOR A TRANSITION REGION

C***********************************************************************

C  SUBROUTINE CALLED BY:
C     QMESH = GENERATES QUAD ELEMENTS

C***********************************************************************

C  VARIABLES USED:
C     NNPS  = ARRAY OF NUMBER OF NODES PER SIDE
C     CCW   = .TRUE. IF THE SIDE IS ORIENTED CCW
C     NORM  = .TRUE. IF THE FIRST SIDE IS TO BE TRIED AS THE BASE

C***********************************************************************

      DIMENSION NNPS(MNNPS), ISLIST(NS), LINKL(2, ML), LINKS(MS * 2)
      DIMENSION NINT (ML), NLPS (MS), IFLINE (MS), ILLIST (MS * 3)
      DIMENSION X (NPER), Y (NPER), NID (NPER), ANGLE (NPER)

      LOGICAL CCW, ERR, HALFC

C  CALCULATE THE NUMBER OF NODES PER SIDE

      CALL NPS (ML, MS, MNNPS, NS, ISLIST, NINT, IFLINE, NLPS, ILLIST,
     &   LINKL, LINKS, NNPS, ERR)
      IF (ERR) RETURN
      IF (.NOT.CCW)CALL IREVER (NNPS, NS)

C  FIND THE BEST CORNER NODES IN THE LIST

      CALL PICKTR (NPER, X, Y, NID, ANGLE, HALFC, I1, I2, I3, I4, I5,
     &   I6, I7, I8)

C  DEFINE THE MIDDLE POINT OF BOTH TRIANGLES AS THE AVERAGE
C  OF PROPORIONAL DIVISIONS OF SIDE DIVISION POINT TO OPPOSITE
C  TRIANGLE CORNER LINES
C  FOR THE FIRST TRIANGLE,
C  FIND DISTANCES FROM CORNER TO CORNER,  AND CORNERS TO SIDE DIVISIONS

      INT = I6 - I4
      PROP = DBLE(I6 - I5) / DBLE(INT)
      XMID1 = X (I3) +  (PROP *  (X (I7) - X (I3)))
      YMID1 = Y (I3) +  (PROP *  (Y (I7) - Y (I3)))
      D1 = SQRT ( (X (I5) - X (I3)) **2 +  (Y (I5) - Y (I3)) **2)
      D2 = SQRT ( (X (I7) - X (I5)) **2 +  (Y (I7) - Y (I5)) **2)
      D3 = SQRT ( (X (I3) - X (I7)) **2 +  (Y (I3) - Y (I7)) **2)
      D1A = SQRT ( (X (I4) - X (I3)) **2 +  (Y (I4) - Y (I3)) **2)
      D1B = SQRT ( (X (I5) - X (I4)) **2 +  (Y (I5) - Y (I4)) **2)
      D2A = SQRT ( (X (I6) - X (I5)) **2 +  (Y (I6) - Y (I5)) **2)
      D2B = SQRT ( (X (I7) - X (I6)) **2 +  (Y (I7) - Y (I6)) **2)
      D3A = SQRT ( (XMID1 - X (I7)) **2 +  (YMID1 - Y (I7)) **2)
      D3B = SQRT ( (X (I3) - XMID1) **2 +  (Y (I3) - YMID1) **2)

C  GET MIDPOINT TRIALS 1,  2,  AND 3 AS PROPORTIONS

      PRO1 = .5 *  ( (D3A / D3) +  (D1B / D1))
      X1 = X (I6) -  (PRO1 *  (X (I6) - X (I3)))
      Y1 = Y (I6) -  (PRO1 *  (Y (I6) - Y (I3)))
      PRO2 = .5 *  ( (D2B / D2) +  (D1A / D1))
      X2 = XMID1 -  (PRO2 *  (XMID1 - X (I5)))
      Y2 = YMID1 -  (PRO2 *  (YMID1 - Y (I5)))
      PRO3 = .5 *  ( (D2A / D2) +  (D3B / D3))
      X3 = X (I4) -  (PRO3 *  (X (I4) - X (I7)))
      Y3 = Y (I4) -  (PRO3 *  (Y (I4) - Y (I7)))

C  AVERAGE POINTS TO GET THE FIRST CENTER

      XCEN1 =  (X1 + X2 + X3) / 3.
      YCEN1 =  (Y1 + Y2 + Y3) / 3.

C  FOR THE SECOND TRIANGLE,
C  FIND DISTANCES FROM CORNER TO CORNER,  AND CORNERS TO SIDE DIVISIONS

      INT = I6 - I4
      PROP = DBLE(NPER + 1 - I8) / DBLE(INT)
      XMID2 = X (I3) +  (PROP *  (X (I7) - X (I3)))
      YMID2 = Y (I3) +  (PROP *  (Y (I7) - Y (I3)))
      D1 = SQRT ( (X (I3) - X (I1)) **2 +  (Y (I3) - Y (I1)) **2)
      D2 = SQRT ( (X (I7) - X (I3)) **2 +  (Y (I7) - Y (I3)) **2)
      D3 = SQRT ( (X (I1) - X (I7)) **2 +  (Y (I1) - Y (I7)) **2)
      D1A = SQRT ( (X (I2) - X (I1)) **2 +  (Y (I2) - Y (I1)) **2)
      D1B = SQRT ( (X (I3) - X (I2)) **2 +  (Y (I3) - Y (I2)) **2)
      D2A = SQRT ( (XMID2 - X (I3)) **2 +  (YMID2 - Y (I3)) **2)
      D2B = SQRT ( (X (I7) - XMID2) **2 +  (Y (I7) - YMID2) **2)
      D3A = SQRT ( (X (I8) - X (I7)) **2 +  (Y (I8) - Y (I7)) **2)
      D3B = SQRT ( (X (I1) - X (I8)) **2 +  (Y (I1) - Y (I8)) **2)

C  GET MIDPOINT TRIALS 1,  2,  AND 3 AS PROPORTIONS

      PRO1 = .5 *  ((D3A / D3) +  (D1B / D1))
      X1 = XMID2 -  (PRO1 *  (XMID2 - X (I1)))
      Y1 = YMID2 -  (PRO1 *  (YMID2 - Y (I1)))
      PRO2 = .5 *  ((D2B / D2) +  (D1A / D1))
      X2 = X (I8) -  (PRO2 *  (X (I8) - X (I3)))
      Y2 = Y (I8) -  (PRO2 *  (Y (I8) - Y (I3)))
      PRO3 = .5 *  ((D2A / D2) +  (D3B / D3))
      X3 = X (I2) -  (PRO3 *  (X (I2) - X (I7)))
      Y3 = Y (I2) -  (PRO3 *  (Y (I2) - Y (I7)))

C  AVERAGE POINTS TO GET THE CENTER

      XCEN2 =  (X1 + X2 + X3) / 3.
      YCEN2 =  (Y1 + Y2 + Y3) / 3.

      ERR = .FALSE.
      RETURN

      END

max_stars_repo_name: jschueller/seacas

max_issues_repo_name: jschueller/seacas

max_forks_repo_name: jschueller/seacas


text:
MODULE fields
!
!   Module for fields parameters
!
  IMPLICIT none
!
  ! ratio Bvertical/Btoroidal, radius of curvature
  DOUBLE PRECISION  :: Bratio=0., Rcurv=1., Bx=0.,By=0.,Bz=0.,B_t=1.
  DOUBLE PRECISION  :: theta=0.,sineoftheta=0.,cosineoftheta=1.! Angle between the B field and the floor
  DOUBLE PRECISION  :: Lr=0.,Lz=0.,kr,kz,dr,dz, sinmoder,sinmodez1, sinmodet1,sinmodez2, sinmodet2, sinmodet3
  INTEGER, DIMENSION(1000,323) :: kicksteps
  INTEGER           :: numrpts=128, numzpts=128
  INTEGER           :: numtpts,staglength,stagdist,tA,tB
  LOGICAL           :: periodic_field=.FALSE., vert_reverse=.FALSE., static_field=.FALSE., sinecentdiff=.TRUE.
  CHARACTER(LEN=10) :: E_basis='tilt', Efield_type='sinusoid', E_dir='r', Bfield_type='torpex', rot_type, B_dir
  CHARACTER(LEN=20) :: interpolate_type='bilinear', radialbc='loss'
  DOUBLE PRECISION  :: rscale=0., E_max=0., E_max2=0., E_mag1=0., E_mag2=0., es_pot=0., E_kick1a=0., E_kick1b=0., &
                       E_kick2a=0., E_kick2b=0., old_Ex_cart=0., old_Ez_cart=0.,   old_Er_tilt=0., old_Ez_tilt=0.
  ! The sign is reversed on the electric field magnitude E_mag
  DOUBLE PRECISION  :: deltarmod0=0., deltarmod=0., deltazmod0=0., deltazmod=0., rmin=0., rmax=100.
  DOUBLE PRECISION  :: fieldtimestep, phibeamnorm=0.00235, GBS_factor=1., GBS_mag=1., GBS_bg=1.
  CHARACTER(len=64) :: avgpotefile, kickrphfile, GBSfile ! results file from GBS - this should be user specified
  INTEGER           :: fidavgpote,fidkickrph, fidGBS, strmfstart=0, taumax=7500, kickstep1=1, kickfreq1=0, kickstep2=1, kickfreq2=0
  LOGICAL           :: firstframeout=.FALSE., kickrph=.TRUE., readkicks=.FALSE.
  !fidGBS is a placeholder, strmfstart is the last 3 digits of the starting strmf file
  DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE     :: tracer_es_pot, es_pot_old, dphidt
  DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE     :: rtiltgrid, ztiltgrid
  DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE   :: es_potgrid, dpotdrtiltgrid, dpotdztiltgrid, d2potdrdztiltgrid
  DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: es_potgrid_t, es_potgrid_fluct, &
                                                     dpotdrtiltgrid_t, dpotdztiltgrid_t, d2potdrdztiltgrid_t
  ! These are the fields at the tracer positions in various coordinate systems
  DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE   :: tracer_E_cyl, tracer_E_cart, tracer_E_tilt
  ! Use same perturbation for all bins or not
  LOGICAL :: all_bins_same_pot = .FALSE.
!
END MODULE fields

!

max_stars_repo_name: alexbovet/fastpart

max_issues_repo_name: alexbovet/fastpart

max_forks_repo_name: alexbovet/fastpart


text:
C
C	$Id: wmfpts.f,v 1.4 2008-07-27 00:17:36 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 WMFPTS(M,X,Y,N,XT,YT)
C
C  Filter out N points from the coordinates (X(I),Y(I),I=1,M) and
C  store them in (XT(I),YT(I),I=1,N).  It is assumed that M > N.
C
      DIMENSION X(M),Y(M),XT(N),YT(N)
C
      SCL = REAL(N-1)/REAL(M-1)
      OFF = REAL(M-N)/REAL(M-1)
C
      IX = 1
      XT(1) = X(1)
      YT(1) = Y(1)
      DO 100 I=2,M
        STMP = SCL*REAL(I)+OFF
        IT = MIN(INT(STMP),N)
        IF (IT .EQ. IX) GO TO 100
        IX = IT
        XT(IX) = X(I)
        YT(IX) = Y(I)
  100 CONTINUE
      XT(N) = X(M)
      YT(N) = Y(M)
C
      RETURN
      END

ext: f

max_stars_repo_name: tenomoto/ncl

max_issues_repo_name: tenomoto/ncl

max_forks_repo_name: tenomoto/ncl


text:
      subroutine skipbl(lin, i)
      integer lin(100)
      integer i
23000 if (.not.(lin (i) .eq. 32 .or. lin (i) .eq. 9))goto 23001
      i = i + 1
      goto 23000
23001 continue
      return
      end

max_stars_repo_name: ysBach/irafdocgen

max_issues_repo_name: kirxkirx/iraf

max_forks_repo_name: kirxkirx/iraf


!
! AntCorr_Application
!
! Module containing routines to apply/remove antenna corrections to/from
! supported microwave sensor observations.
!
!
! CREATION HISTORY:
!       Written by:     Paul van Delst, CIMSS/SSEC 11-Aug-2008
!                       paul.vandelst@noaa.gov
!
!   2011-04-25   A.Collard   Modified to be consistent with CRTM 2.1
!

MODULE AntCorr_Application

  ! ------------------
  ! Environment set up
  ! ------------------
  ! Module use statements
  USE Type_Kinds       , ONLY: fp
  USE Message_Handler  , ONLY: Display_Message, FAILURE
  USE ACCoeff_Define   , ONLY: ACCoeff_type
  ! Disable all implicit typing
  IMPLICIT NONE

  ! --------------------
  ! Default visibilities
  ! --------------------
  ! Everything private by default
  PRIVATE
  ! Inherited procedures from definition module
  ! -------------------------------------------
  ! The AntCorr structure definition
  PUBLIC :: ACCoeff_type
  PUBLIC :: Remove_AntCorr

  ! -----------------
  ! Module parameters
  ! -----------------
  ! Invalid result
  REAL(fp), PARAMETER :: INVALID = -1.0_fp

  ! Cosmic background temperature. Taken from
  ! Mather,J.C. et. al., 1999, "Calibrator Design for the COBE
  !    Far-Infrared Absolute Spectrophotometer (FIRAS)"
  !    Astrophysical Journal, vol 512, pp 511-520
  REAL(fp), PARAMETER :: TSPACE = 2.7253_fp

CONTAINS

!##################################################################################
!##################################################################################
!##                                                                              ##
!##                           ## PUBLIC MODULE ROUTINES ##                       ##
!##                                                                              ##
!##################################################################################
!##################################################################################

!--------------------------------------------------------------------------------
!
! NAME:
!       Remove_AntCorr
!
! PURPOSE:
!       Subroutine to remove an antenna correction to microwave instrument
!       brightness temperatures, Tb, to produce antenna temperatures, Ta.
!
! CALLING SEQUENCE:
!       CALL Remove_AntCorr( AC  , &  ! Input
!                            iFOV, &  ! Input
!                            T     )  ! In/Output
!
! INPUT ARGUMENTS:
!       AC:             Structure containing the antenna correction coefficients
!                       for the sensor of interest.
!                       UNITS:      N/A
!                       TYPE:       TYPE(ACCoeff_type)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       iFOV:           The FOV index for a scanline of the sensor of interest.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       T:              On input, this argument contains the brightness
!                       temperatures for the sensor channels.
!                       UNITS:      Kelvin
!                       TYPE:       REAL(fp)
!                       DIMENSION:  Rank-1 (n_Channels)
!                       ATTRIBUTES: INTENT(IN OUT)
!
! OUTPUT ARGUMENTS:
!       T:              On output, this argument contains the antenna
!                       temperatures for the sensor channels.
!                       If an error occurs, the return values are all -1.
!                       UNITS:      Kelvin
!                       TYPE:       REAL(fp)
!                       DIMENSION:  Rank-1 (n_Channels)
!                       ATTRIBUTES: INTENT(IN OUT)
!
! SIDE EFFECTS:
!       The temperature array argument, T, is modified.
!
! PROCEDURE:
!       For every FOV and channel, the brightness temperature, Tb, is converted
!       to antenna temperature, Ta, using,
!
!         Ta = Ae.Tb + Ap.Tb + As.Ts
!
!       where Ae == antenna efficiency for the Earth view
!             Ap == antenna efficiency for satellite platform view
!             As == antenna efficiency for cold space view
!             Ts == cosmic background temperature.
!
!       Note that the observed earth view brightness temperature is used as a
!       proxy for the platform temperature for the (Ap.Tb) component since
!       there is no measurement of the platform temperature in-flight.
!
!--------------------------------------------------------------------------------

  SUBROUTINE Remove_AntCorr( AC  , &  ! Input
                             iFOV, &  ! Input
                             T     )  ! In/Output
    implicit none

    ! Arguments
    TYPE(ACCoeff_type), INTENT(IN)     :: AC
    INTEGER           , INTENT(IN)     :: iFOV
    REAL(fp)          , INTENT(IN OUT) :: T(:)
    ! Local parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Remove_AntCorr'
    ! Local variables
    INTEGER :: l
    ! Check input
    IF ( iFOV < 1 .OR. iFOV > AC%n_FOVS ) THEN
      CALL Display_Message( ROUTINE_NAME, 'Input iFOV inconsistent with AC data', FAILURE )
      T = INVALID
      RETURN
    END IF
    IF ( SIZE(T) /= AC%n_Channels ) THEN
      CALL Display_Message( ROUTINE_NAME, 'Size of T() inconsistent with AC data', FAILURE )
      T = INVALID
      RETURN
    END IF
    ! Compute the antenna temperature
    DO l = 1, AC%n_Channels
      T(l) = AC%A_earth(iFOV,l)*T(l) + AC%A_platform(iFOV,l)*T(l) + AC%A_space(iFOV,l)*TSPACE
    END DO
  END SUBROUTINE Remove_AntCorr

END MODULE AntCorr_Application


text:
+incdir+../src
../deps/async_fifo/src/vlog/async_fifo.v
../deps/async_fifo/src/vlog/fifo_2mem.v
../deps/async_fifo/src/vlog/fifomem_dp.v
../deps/async_fifo/src/vlog/rptr_empty.v
../deps/async_fifo/src/vlog/sync_ptr.v
../deps/async_fifo/src/vlog/sync_r2w.v
../deps/async_fifo/src/vlog/sync_w2r.v
../deps/async_fifo/src/vlog/wptr_full.v
../src/bster.sv
../src/bst_engine.sv
../src/insert_engine.sv
../src/search_engine.sv
../src/delete_engine.sv
../src/csr.sv
../src/csr_reg.sv
../src/interface_handler.sv
../src/tree_space_manager.sv
../src/memory_driver.sv
../src/axi_ram.sv
../src/scfifo.sv
../src/scfifo_ram.sv
+define+VERBOSE
+define+BSTER_LOGGER
+define+TIMEOUT=1000

max_stars_repo_name: dpretet/bster

max_issues_repo_name: dpretet/bster

max_forks_repo_name: dpretet/bster


text:
C    @(#)gtbase.f	20.7 3/29/99
      subroutine gtbase (obname, caseid, baseok)
      character obname *(*), caseid *(*)
      logical baseok
C ***                                                                  *
C *** OPEN OLD-BASE FILE OBNAME: (CALL OPNFIL)                         *
C ***    IF NOT "PF DATA" THEN                                         *
C ***       PRINT ERROR                                                *
C ***    ELSE                                                          *
C ***       SEARCH FOR CASEID AND LOAD IT                              *
C ***       IF CASE LOADED THEN                                        *
C ***          BASEOK = .TRUE.                                         *
C ***       ELSE                                                       *
C ***          BASEOK = .FALSE.                                        *
C ***       ENDIF                                                      *
C ***    ENDIF                                                         *
C *** CLOSE OLD-BASE FILE OBNAME:                                      *
C ***                                                                  *

      include 'ipfinc/blank.inc'
      include 'ipfinc/dtaiop.inc'
      include 'ipfinc/jobctl.inc'
      include 'ipfinc/lfiles.inc'
      include 'ipfinc/prt.inc'

      common /basnam/ basnam
      character basnam * 60

      common /is_batch / is_batch

      integer status

      call close_file (datai)
      ierro = 99
      call opnfil(datai,obname,ierro)
      if (ierro .eq. 0) then
         inquire (unit=datai,name=basnam)
         rewind datai
         call rddtai(caseid,status)
         call close_file (datai)
      else
         status = -1
      endif
      if ( status .eq. 1 ) then
         baseok = .true.
         if (count(1) .eq. 0) then
            write ( errbuf(1),100) caseid
  100       format ('0 Case ', a, ' had a failed solution')
            call prterx ('W',1)
            kspare(1) = 1
         endif
C ***                                                                  *
         if (kspare(22) .lt. kspare(33)) then
C ***                                                                  *
C ***       DATAI FILE HAS NOT BEEN CONVERTED TO CURRENT DATAO FORMAT. *
C ***       FORCE UPDATE.                                              *
C ***                                                                  *
            write (errbuf(1),110) caseid, kspare(22), kspare(33)
  110       format ('0 CASE ', a, ' IS OLD VERSION "', i3, '" AND IS ',
     1          'CONVERTED TO NEW VERSION "', i3, '".')
            call prterx ('W',1)
            if (kspare(22) .eq. 8 .and. kspare(33) .eq. 9) then
            else
              kspare(1) = 1
            endif
C ***                                                                  *
         else if (kspare(22) .gt. kspare(33)) then
C ***                                                                  *
C ***       DATAI FILE HAS NOT BEEN CONVERTED TO CURRENT DATAO FORMAT. *
C ***       FORCE UPDATE.                                              *
C ***                                                                  *
            write (errbuf(1),112) caseid, kspare(22), kspare(33)
  112       format ('0 CASE ', a, ' IS NEW VERSION "', i3,
     1              '" WHICH MAY NOT BE DOWNWARDS COMPATIBLE ',
     2              'WITH OLD PF VERSION "', i3, '".')
            call prterx ('W',1)
            kspare(1) = 1
C ***                                                                  *
         endif
         oldcse = caseid
C ***                                                                  *
      else if( status .eq. 0 ) then
         baseok = .false.
         write (errbuf(1),120) caseid
  120    format ('CASE "', a, '" IS NOT ON OLD-BASE FILE!')
         if (is_batch .eq. 0) then
            call prterx ('E',1)
         else
            call prterx ('F',1)
         endif
C ***                                                                  *
      else if( status .eq. 2 ) then
         baseok = .false.
         i = lastch( obname )
         write (errbuf(1),130) obname(1:i)
  130    format ('FILE "', a, '" IS NOT "PF DATA" ON OLD-BASE FILE.')
         if (is_batch .eq. 0) then
            call prterx ('E',1)
         else
            call prterx ('F',1)
         endif
C ***                                                                  *
      else
         i = lastch( obname )
         write (errbuf(1),150) obname(1:i)
  150    format ('FILE "', a, '" COULD NOT BE OPENED.......')
         baseok = .false.
         if (is_batch .eq. 0) then
            call prterx ('E',1)
         else
            call prterx ('F',1)
         endif
C ***                                                                  *
      endif
      call close_file (datai)
      jobreq(2) = ' '
C ***                                                                  *
      return
      end

max_stars_repo_name: mbheinen/bpa-ipf-tsp

max_issues_repo_name: cuihantao/bpa-ipf-tsp

max_forks_repo_name: mbheinen/bpa-ipf-tsp


text:
program test
  integer                               :: iostat1 = -1

  print *, "Before ", iostat1
  open(unit=10, file = "1.in", iostat=iostat1)
  print *, "After ", iostat1
  close(10)

end program test

max_stars_repo_name: clementval/fc

max_issues_repo_name: clementval/fc

max_forks_repo_name: clementval/fc


text:
C
C	$Id: gzw2gk.f,v 1.5 2008-07-27 00:21:04 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 GZW2GK(WKID,CONID,IER)
C
C  Copy the segment which has been attached to Fortran unit
C  CONID to the workstation WKID by way of parsing the CGM
C  elements in the segment and making the appropriate GKS
C  calls.
C
      include 'gkscom.h'
C
      INTEGER WKID,CONID
      INTEGER IOS,STATUS
      REAL TWIND(4),TVIEW(4)
C
      include 'trbufr.h'
C
C Do a call forcing a BLOCKDATA to be loaded from a binary library.
C
      CALL GSEGDT
C
C  Use normalization transformation 1 set to the identity (we use 1
C  so that the window can be changed for clipping).
C
      CALL GQCNTN(IER,NTOLD)
      CALL GQNT(NTOLD,IER,TWIND,TVIEW)
      CALL GSWN(1,0.,1.,0.,1.)
      CALL GSVP(1,0.,1.,0.,1.)
      CALL GSELNT(1)
C
C  Read in the first record.
C
      MCONID = CONID
      METREC = 1
      CALL GSEGRD(IOS,STATUS)
      IF (STATUS .NE. 0) THEN
        IER = 302
        RETURN
      ENDIF
C
C  Set the default operand lengths before reading any instructions.
C
      CALL GXOPDF
C
C  Set defaults.
C
      CALL GXMDEF
C
C  Loop until we run out of data, or error.
C
      CALL GXLATE(WKID,IOS,STATUS)
      IF (STATUS .EQ. -1) THEN
C
C  Normal exit, restore normalization transformation.
C
        IF (NTOLD .NE. 0) THEN
          CALL GSWN(NTOLD,TWIND(1),TWIND(2),TWIND(3),TWIND(4))
          CALL GSVP(NTOLD,TVIEW(1),TVIEW(2),TVIEW(3),TVIEW(4))
        ENDIF
        CALL GSELNT(NTOLD)
        IER = 0
      ELSE
        IER = STATUS
      ENDIF
C
      RETURN
      END