C
C	$Id: mkmsk.f,v 1.4 2008-07-27 00:17:21 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 MKMSK
C
C  THIS ROUTINE GENERATES THE MACHINE-DEPENDENT DATA VALUES
C  USED BY XTCH.
C
C
      COMMON/PINIT/MASK(4),MASK6(64),MASK12(64),LAST6,LAST12,
     +     IBIT15,MASK14,NUM15U,NBWD
C
C  MASK FOR 15-BIT PARCELS(77777B)
C
      IMSK1 = 32767
C
C
C  FIND THE NUMBER OF BITS PER WORD
C
      NBWD = I1MACH(5)
C
C  COMPUTE THE NUMBER OF 15-BIT PARCELS
C
      NUM15U = NBWD/15
C
C  IPRCT AND IPRCT2 ARE USED TO PREVENT SIGN EXTENSION WHEN DOING LEFT
C  SHIFTS.
C
      ITEMP = ISHIFT(IMSK1,(NBWD-16))
      IPRCT = ITEMP
      IT1 = NUM15U-1
      DO 100 I = 1,IT1
      IPRCT = ISHIFT(IPRCT,-15)
      IPRCT = IOR(ITEMP,IPRCT)
  100 CONTINUE
      IPRCT = IOR(IPRCT,IMSK1)
C
      IPRCT2 = ISHIFT(IPRCT,-14)
C
C  LEFT JUSTIFY
C
      LEFTJS = NBWD-15
      IMSK1 = ISHIFT(IMSK1,LEFTJS)
C
C  GENERATE THE MASKS FOR THE 15 BIT PARCELS
C
C
      DO 10 I = 1 , NUM15U
      MASK(I) = IMSK1
C
C  SHIFT FOR NEXT PARCEL
C
      IMSK1 = ISHIFT(IMSK1,-15)
C
C  PROTECT FROM SIGN EXTENSION (RELEVANT ONLY ON FIRST PASS)
C
      IMSK1 = IAND(IMSK1,IPRCT2)
   10 CONTINUE
C
C
C  MASK FOR 6-BIT PARCELS (77B)
C
      IMSK2 = 63
C
C  MASK FOR 12-BIT PARCELS (7777B)
C
      IMSK3 = 4095
C
C  LEFT JUSTIFY
C
      LEFTJS = NBWD-6
      IMSK2 = ISHIFT(IMSK2,LEFTJS)
C
      LEFTJS = NBWD-12
      IMSK3 = ISHIFT(IMSK3,LEFTJS)
C
C  SET UP ALL POSSIBLE 6- AND 12-BIT UNITS
C  NOTE THAT MASKS WILL ALSO BE USED WHEN UNITS CROSS WORD BOUNDARIES
C
C
      DO 20 I = 1 , NBWD
C
C  6 BIT MASKS
C
      MASK6(I) = IMSK2
      IMSK2 = ISHIFT(IMSK2,-1)
C
C PROTECTION FROM SIGN EXTENSION (RELEVANT ONLY ON THE FIRST PASS)
C
      IMSK2 = IAND(IMSK2,IPRCT)
C
C  12 BIT MASKS
C
      MASK12(I) = IMSK3
      IMSK3 = ISHIFT(IMSK3,-1)
C
C  PROTECT FROM SIGN EXTENSION (RELEVANT ONLY ON THE FIRST PASS)
C
      IMSK3 = IAND(IMSK3,IPRCT)
   20 CONTINUE
C
C
C  MASK FOR 6-BIT RIGHT-JUSTIFIED UNIT (77B)
C
      LAST6 = 63
C
C  MASK FOR 12-BIT RIGHT-JUSTIFIED UNIT (7777B)
C
      LAST12 = 4095
C
C  MASK FOR 15-TH BIT FROM THE RIGHT (40000B)
C
      IBIT15 = 16384
C
C  MASK FOR 14-BIT RIGHT-JUSTIFIED UNIT (37777B)
C
      MASK14 = 16383
      RETURN
C
C REVISION HISTORY -----------------------------------------------------
C
C OCTOBER 1984     CONVERTED TO GKS AND FORTRAN 77.  REMOVED CDC7600
C                  CODE.
C
C SEPTEMBER 1980   CORRECTED ERRORS PREVENTING THE USE OF SUBSCRIPTS
C                  IN VERTICALLY-WRITTEN LABELS AND THE USE OF NUMERIC
C                  FUNCTION CODES IN GENERAL.  (DJK)
C
C JUNE 1988        CHANGED THE NAME OF A COMMON BLOCK TO GET RID OF A
C                  WARNING FROM SEGLDR.  (DJK)
C
C OCTOBER 1988     FIXED A PROBLEM IN THE SUBROUTINE HTABLE.  (DJK)
C
      END
