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 |
---|