source: trunk/WRF.COMMON/WRFV3/external/io_grib2/g2lib/gribcreate.F @ 2759

Last change on this file since 2759 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size

File size: 4.7 KB
Line 
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 g2lib_sbyte(cgrib,zero,32,16)           ! reserved for future use
90      call g2lib_sbyte(cgrib,listsec0(1),48,8)     ! Discipline
91      call g2lib_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 g2lib_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 g2lib_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 g2lib_sbyte(cgrib,lensec1,ibeg,32)
116!
117!  Put current byte total of message into Section 0
118!
119      call g2lib_sbyte(cgrib,zero,64,32)
120      call g2lib_sbyte(cgrib,lensec0+lensec1,96,32)
121
122      return
123      end
Note: See TracBrowser for help on using the repository browser.