source: trunk/WRF.COMMON/WRFV3/external/io_grib2/g2lib/addlocal.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.6 KB
Line 
1      subroutine addlocal(cgrib,lcgrib,csec2,lcsec2,ierr)
2!$$$  SUBPROGRAM DOCUMENTATION BLOCK
3!                .      .    .                                       .
4! SUBPROGRAM:    addlocal
5!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-01
6!
7! ABSTRACT: This subroutine adds a Local Use Section (Section 2) to
8!   a GRIB2 message.
9!   This routine is used with routines "gribcreate", "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!
13! PROGRAM HISTORY LOG:
14! 2000-05-01  Gilbert
15!
16! USAGE:    CALL addlocal(cgrib,lcgrib,csec2,lcsec2,ierr)
17!   INPUT ARGUMENT LIST:
18!     cgrib    - Character array to contain the GRIB2 message
19!     lcgrib   - Maximum length (bytes) of array cgrib.
20!     csec2    - Character array containing information to be added to
21!                Section 2.
22!     lcsec2   - Number of bytes of character array csec2 to be added to
23!                Section 2.
24!
25!   OUTPUT ARGUMENT LIST:     
26!     cgrib    - Character array to contain the GRIB2 message
27!     ierr     - Error return code.
28!                0 = no error
29!                1 = GRIB message was not initialized.  Need to call
30!                    routine gribcreate first.
31!                2 = GRIB message already complete.  Cannot add new section.
32!                3 = Sum of Section byte counts doesn't add to total byte count.
33!                4 = Previous Section was not 1 or 7.
34!
35! REMARKS: Note that the Local Use Section ( Section 2 ) can only follow
36!          Section 1 or Section 7 in a GRIB2 message.
37!
38! ATTRIBUTES:
39!   LANGUAGE: Fortran 90
40!   MACHINE:  IBM SP
41!
42!$$$
43
44      character(len=1),intent(inout) :: cgrib(lcgrib)
45      character(len=1),intent(in) :: csec2(lcsec2)
46      integer,intent(in) :: lcgrib,lcsec2
47      integer,intent(out) :: ierr
48     
49      character(len=4),parameter :: grib='GRIB',c7777='7777'
50      character(len=4):: ctemp
51      integer,parameter :: two=2
52      integer lensec2,iofst,ibeg,lencurr,len
53 
54      ierr=0
55!
56!  Check to see if beginning of GRIB message exists
57!
58      ctemp=cgrib(1)//cgrib(2)//cgrib(3)//cgrib(4)
59      if ( ctemp.ne.grib ) then
60        print *,'addlocal: GRIB not found in given message.'
61        print *,'addlocal: Call to routine gribcreate required',
62     &          ' to initialize GRIB messge.'
63        ierr=1
64        return
65      endif
66!
67!  Get current length of GRIB message
68
69      call g2lib_gbyte(cgrib,lencurr,96,32)
70!
71!  Check to see if GRIB message is already complete
72
73      ctemp=cgrib(lencurr-3)//cgrib(lencurr-2)//cgrib(lencurr-1)
74     &      //cgrib(lencurr)
75      if ( ctemp.eq.c7777 ) then
76        print *,'addlocal: GRIB message already complete.  Cannot',
77     &          ' add new section.'
78        ierr=2
79        return
80      endif
81!
82!  Loop through all current sections of the GRIB message to
83!  find the last section number.
84!
85      len=16    ! length of Section 0
86      do
87      !    Get section number and length of next section
88        iofst=len*8
89        call g2lib_gbyte(cgrib,ilen,iofst,32)
90        iofst=iofst+32
91        call g2lib_gbyte(cgrib,isecnum,iofst,8)
92        len=len+ilen
93      !    Exit loop if last section reached
94        if ( len.eq.lencurr ) exit
95      !    If byte count for each section doesn't match current
96      !    total length, then there is a problem.
97        if ( len.gt.lencurr ) then
98          print *,'addlocal: Section byte counts don''t add to total.'
99          print *,'addlocal: Sum of section byte counts = ',len
100          print *,'addlocal: Total byte count in Section 0 = ',lencurr
101          ierr=3
102          return
103        endif
104      enddo
105!
106!  Section 2 can only be added after sections 1 and 7.
107!
108      if ( (isecnum.ne.1) .and. (isecnum.ne.7) ) then
109        print *,'addlocal: Section 2 can only be added after Section',
110     &          ' 1 or Section 7.'
111        print *,'addlocal: Section ',isecnum,' was the last found in',
112     &          ' given GRIB message.'
113        ierr=4
114        return
115      endif
116!
117!  Add Section 2  - Local Use Section
118!
119      ibeg=lencurr*8        !   Calculate offset for beginning of section 2
120      iofst=ibeg+32         !   leave space for length of section
121      call g2lib_sbyte(cgrib,two,iofst,8)     ! Store section number ( 2 )
122      istart=lencurr+5
123      cgrib(istart+1:istart+lcsec2)=csec2(1:lcsec2)
124      !
125      !   Calculate length of section 2 and store it in octets
126      !   1-4 of section 2.
127      !
128      lensec2=lcsec2+5      ! bytes
129      call g2lib_sbyte(cgrib,lensec2,ibeg,32)
130
131!
132!  Update current byte total of message in Section 0
133!
134      call g2lib_sbyte(cgrib,lencurr+lensec2,96,32)
135
136      return
137      end
138
Note: See TracBrowser for help on using the repository browser.