var/external/bufr/blocks.f

   1       SUBROUTINE BLOCKS(MBAY,MWRD)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM: BLOCKS
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 2012-09-15
   7 C
   8 C ABSTRACT: BLOCKS WILL ADD IEEE FORTRAN TYPE RECORD CONTROL
   9 C           WORDS TO A PURE BUFR RECORD PASSED FROM MSGWRT, IN
  10 C           PREPARATION FOR OUTPUTING THE RECORD TO DISK.  THE
  11 C           DEFAULT OUTPUT TYPE IS PURE (NO CONTROL WORDS), IN
  12 C           WHICH CASE THIS ROUTINE DOES NOTHING.  AN APPLICATION
  13 C           CAN SPECIFY THAT EITHER BIG OR LITTLE ENDIAN RECORD
  14 C           CONTROL WORDS ARE TO BE APPENDED TO PURE BUFR RECORDS
  15 C           VIA A PREVIOUS CALL TO SUBROUTINE SETBLOCK.
  16 C
  17 C THE FOLLOWING DIAGRAM ILLUSTRATES IEEE CONTROL WORDS FOUND
  18 C IN AN UNFORMATTED FORTRAN RECORD CONRTAINING FOUR 4-BYTE WORDS
  19 C
  20 C     ctw1-wrd1-wrd2-wrd3-wrd4-ctw2
  21 C     |    |    |    |    |    |
  22 C     0016-aaaa-bbbb-cccc-dddd-0016
  23 C
  24 C CTW1 AND CTW2 CONTAIN A BYTE COUNT FOR THE DATA RECORD THAT
  25 C THEY ENCLOSE. THEY CAN BE STORED IN EITHER BIG OR LITTLE
  26 C ENDIAN BYTE ORDERING (NOTE: CTWS ARE ALWAYS 4-BYTE WORDS)
  27 C
  28 C PROGRAM HISTORY LOG:
  29 C 2012-09-15  J. WOOLLEN -- ORIGINAL AUTHOR
  30 C
  31 C USAGE:    CALL BLOCKS(MBAY,MWRD)
  32 C   INPUT ARGUMENTS:
  33 c     MBAY - INTEGER ARRAY CONTAINING PURE BUFR MESSAGE
  34 c     MWRD - INTEGER WORD COUNT FOR MBAY
  35 C
  36 C   OUTPUT ARGUMENTS:
  37 c     MBAY - INTEGER ARRAY CONTAINING INPUT BUFR MESSAGE, POSSIBLY
  38 c            WITH CONTROL WORDS ADDED DEPENDING ON WHETHER SUBROUTINE
  39 c            SETBLOCK WAS PREVIOUSLY CALLED
  40 c     MWRD - INTEGER WORD COUNT FOR MBAY
  41 C
  42 C REMARKS:
  43 C    THIS ROUTINE CALLS:   None
  44 C
  45 C    THIS ROUTINE IS CALLED BY:  MSGWRT
  46 C
  47 C ATTRIBUTES:
  48 C   LANGUAGE: FORTRAN 77
  49 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  50 C
  51 C$$$
  52
  53       COMMON /HRDWRD/ NBYTW,NBITW,IORD(8)
  54       COMMON /ENDORD/ IBLOCK,IORDBE(4),IORDLE(4)
  55
  56       INTEGER(4) MBAY(MWRD),IINT,JINT
  57
  58       CHARACTER*1 CINT(4),DINT(4)
  59       EQUIVALENCE(CINT,IINT)
  60       EQUIVALENCE(DINT,JINT)
  61
  62       DATA IFIRST/0/
  63       SAVE IFIRST
  64
  65 c----------------------------------------------------------------------
  66 c----------------------------------------------------------------------
  67
  68       if(iblock.eq.0) return
  69
  70       if(ifirst.eq.0) then
  71
  72 c        Initialize some arrays for later use.  Note that Fortran
  73 c        record control words are always 4 bytes.
  74
  75          iint=0; cint(1)=char(1)
  76          do i=1,4
  77          if(cint(1).eq.char(01)) then
  78             iordbe(i)=4-i+1
  79             iordle(i)=i
  80          else
  81             iordle(i)=4-i+1
  82             iordbe(i)=i
  83          endif
  84          enddo
  85          ifirst=1
  86       endif
  87
  88 c  make room in mbay for control words - one at each end of the record
  89 c  -------------------------------------------------------------------
  90
  91       if(nbytw.eq.8) mwrd=mwrd*2
  92
  93       do m=mwrd,1,-1
  94       mbay(m+1) = mbay(m)
  95       enddo
  96
  97 c  store the endianized control word in bytes in dint/jint
  98 c  -------------------------------------------------------
  99
 100       iint=mwrd*4
 101
 102       do i=1,4
 103       if(iblock.eq.+1) dint(i)=cint(iordbe(i))
 104       if(iblock.eq.-1) dint(i)=cint(iordle(i))
 105       enddo
 106
 107 c  increment mrwd and install the control words in their proper places
 108 c  -------------------------------------------------------------------
 109
 110       mwrd = mwrd+2
 111       mbay(1) = jint
 112       mbay(mwrd) = jint
 113
 114       if(nbytw.eq.8) mwrd=mwrd/2
 115
 116       return
 117       end