ungrib/src/ngl/g2/addlocal.f

   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 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 gbyte(cgrib,ilen,iofst,32)
  90         iofst=iofst+32
  91         call 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 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 sbyte(cgrib,lensec2,ibeg,32)
 130
 131 !
 132 !  Update current byte total of message in Section 0
 133 !
 134       call sbyte(cgrib,lencurr+lensec2,96,32)
 135
 136       return
 137       end
 138