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