ungrib/src/ngl/g2/gribcreate.f

   1       subroutine gribcreate(cgrib,lcgrib,listsec0,listsec1,ierr)
   2 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
   3 !                .      .    .                                       .
   4 ! SUBPROGRAM:    gribcreate
   5 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-04-28
   6 !
   7 ! ABSTRACT: This subroutine initializes a new GRIB2 message and packs
   8 !   GRIB2 sections 0 (Indicator Section) and 1 (Identification Section).
   9 !   This routine is used with routines "addlocal", "addgrid", "addfield",
  10 !   and "gribend" to create a complete GRIB2 message.  Subroutine
  11 !   gribcreate must be called first to initialize a new GRIB2 message.
  12 !   Also, a call to gribend is required to complete GRIB2 message
  13 !   after all fields have been added.
  14 !
  15 ! PROGRAM HISTORY LOG:
  16 ! 2000-04-28  Gilbert
  17 !
  18 ! USAGE:    CALL gribcreate(cgrib,lcgrib,listsec0,listsec1,ierr)
  19 !   INPUT ARGUMENT LIST:
  20 !     cgrib    - Character array to contain the GRIB2 message
  21 !     lcgrib   - Maximum length (bytes) of array cgrib.
  22 !     listsec0 - Contains information needed for GRIB Indicator Section 0.
  23 !                Must be dimensioned >= 2.
  24 !                listsec0(1)=Discipline-GRIB Master Table Number
  25 !                            (see Code Table 0.0)
  26 !                listsec0(2)=GRIB Edition Number (currently 2)
  27 !     listsec1 - Contains information needed for GRIB Identification Section 1.
  28 !                Must be dimensioned >= 13.
  29 !                listsec1(1)=Id of orginating centre (Common Code Table C-1)
  30 !                listsec1(2)=Id of orginating sub-centre (local table)
  31 !                listsec1(3)=GRIB Master Tables Version Number (Code Table 1.0)
  32 !                listsec1(4)=GRIB Local Tables Version Number (Code Table 1.1)
  33 !                listsec1(5)=Significance of Reference Time (Code Table 1.2)
  34 !                listsec1(6)=Reference Time - Year (4 digits)
  35 !                listsec1(7)=Reference Time - Month
  36 !                listsec1(8)=Reference Time - Day
  37 !                listsec1(9)=Reference Time - Hour
  38 !                listsec1(10)=Reference Time - Minute
  39 !                listsec1(11)=Reference Time - Second
  40 !                listsec1(12)=Production status of data (Code Table 1.3)
  41 !                listsec1(13)=Type of processed data (Code Table 1.4)
  42 !
  43 !   OUTPUT ARGUMENT LIST:
  44 !     cgrib    - Character array to contain the GRIB2 message
  45 !     ierr     - Error return code.
  46 !                0 = no error
  47 !                1 = Tried to use for version other than GRIB Edition 2
  48 !
  49 ! REMARKS: This routine is intended for use with routines "addlocal",
  50 !          "addgrid", "addfield", and "gribend" to create a complete
  51 !          GRIB2 message.
  52 !
  53 ! ATTRIBUTES:
  54 !   LANGUAGE: Fortran 90
  55 !   MACHINE:  IBM SP
  56 !
  57 !$$$
  58
  59       character(len=1),intent(inout) :: cgrib(lcgrib)
  60       integer,intent(in) :: listsec0(*),listsec1(*)
  61       integer,intent(in) :: lcgrib
  62       integer,intent(out) :: ierr
  63
  64       character(len=4),parameter :: grib='GRIB'
  65       integer,parameter :: zero=0,one=1
  66       integer,parameter :: mapsec1len=13
  67       integer,parameter ::
  68      &        mapsec1(mapsec1len)=(/ 2,2,1,1,1,2,1,1,1,1,1,1,1 /)
  69       integer lensec0,iofst,ibeg
  70
  71       ierr=0
  72 !
  73 !  Currently handles only GRIB Edition 2.
  74 !
  75       if (listsec0(2).ne.2) then
  76         print *,'gribcreate: can only code GRIB edition 2.'
  77         ierr=1
  78         return
  79       endif
  80 !
  81 !  Pack Section 0 - Indicator Section
  82 !  ( except for total length of GRIB message )
  83 !
  84 !      cgrib=' '
  85       cgrib(1)=grib(1:1)                     ! Beginning of GRIB message
  86       cgrib(2)=grib(2:2)
  87       cgrib(3)=grib(3:3)
  88       cgrib(4)=grib(4:4)
  89       call sbyte(cgrib,zero,32,16)           ! reserved for future use
  90       call sbyte(cgrib,listsec0(1),48,8)     ! Discipline
  91       call sbyte(cgrib,listsec0(2),56,8)     ! GRIB edition number
  92       lensec0=16      ! bytes (octets)
  93 !
  94 !  Pack Section 1 - Identification Section
  95 !
  96       ibeg=lensec0*8        !   Calculate offset for beginning of section 1
  97       iofst=ibeg+32         !   leave space for length of section
  98       call sbyte(cgrib,one,iofst,8)     ! Store section number ( 1 )
  99       iofst=iofst+8
 100       !
 101       !   Pack up each input value in array listsec1 into the
 102       !   the appropriate number of octets, which are specified in
 103       !   corresponding entries in array mapsec1.
 104       !
 105       do i=1,mapsec1len
 106         nbits=mapsec1(i)*8
 107         call sbyte(cgrib,listsec1(i),iofst,nbits)
 108         iofst=iofst+nbits
 109       enddo
 110       !
 111       !   Calculate length of section 1 and store it in octets
 112       !   1-4 of section 1.
 113       !
 114       lensec1=(iofst-ibeg)/8
 115       call sbyte(cgrib,lensec1,ibeg,32)
 116 !
 117 !  Put current byte total of message into Section 0
 118 !
 119       call sbyte(cgrib,zero,64,32)
 120       call sbyte(cgrib,lensec0+lensec1,96,32)
 121
 122       return
 123       end