[2759] | 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 |
---|