| 1 | subroutine getdim(csec3,lcsec3,width,height,iscan) |
|---|
| 2 | !$$$ SUBPROGRAM DOCUMENTATION BLOCK |
|---|
| 3 | ! . . . . |
|---|
| 4 | ! SUBPROGRAM: getdim |
|---|
| 5 | ! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-11 |
|---|
| 6 | ! |
|---|
| 7 | ! ABSTRACT: This subroutine returns the dimensions and scanning mode of |
|---|
| 8 | ! a grid definition packed in GRIB2 Grid Definition Section 3 format. |
|---|
| 9 | ! |
|---|
| 10 | ! PROGRAM HISTORY LOG: |
|---|
| 11 | ! 2002-12-11 Gilbert |
|---|
| 12 | ! |
|---|
| 13 | ! USAGE: CALL getdim(csec3,lcsec3,width,height,iscan) |
|---|
| 14 | ! INPUT ARGUMENT LIST: |
|---|
| 15 | ! csec3 - Character array that contains the packed GRIB2 GDS |
|---|
| 16 | ! lcsec3 - Length (in octets) of section 3 |
|---|
| 17 | ! |
|---|
| 18 | ! OUTPUT ARGUMENT LIST: |
|---|
| 19 | ! width - x (or i) dimension of the grid. |
|---|
| 20 | ! height - y (or j) dimension of the grid. |
|---|
| 21 | ! iscan - Scanning mode ( see Code Table 3.4 ) |
|---|
| 22 | ! |
|---|
| 23 | ! REMARKS: Returns width and height set to zero, if grid template |
|---|
| 24 | ! not recognized. |
|---|
| 25 | ! |
|---|
| 26 | ! ATTRIBUTES: |
|---|
| 27 | ! LANGUAGE: Fortran 90 |
|---|
| 28 | ! MACHINE: IBM SP |
|---|
| 29 | ! |
|---|
| 30 | !$$$ |
|---|
| 31 | ! use grib_mod |
|---|
| 32 | |
|---|
| 33 | character(len=1),intent(in) :: csec3(*) |
|---|
| 34 | integer,intent(in) :: lcsec3 |
|---|
| 35 | integer,intent(out) :: width,height,iscan |
|---|
| 36 | |
|---|
| 37 | integer,pointer,dimension(:) :: igdstmpl,list_opt |
|---|
| 38 | integer :: igds(5) |
|---|
| 39 | integer iofst,igdtlen,num_opt,jerr |
|---|
| 40 | |
|---|
| 41 | interface |
|---|
| 42 | subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl, |
|---|
| 43 | & mapgridlen,ideflist,idefnum,ierr) |
|---|
| 44 | character(len=1),intent(in) :: cgrib(lcgrib) |
|---|
| 45 | integer,intent(in) :: lcgrib |
|---|
| 46 | integer,intent(inout) :: iofst |
|---|
| 47 | integer,pointer,dimension(:) :: igdstmpl,ideflist |
|---|
| 48 | integer,intent(out) :: igds(5) |
|---|
| 49 | integer,intent(out) :: ierr,idefnum |
|---|
| 50 | end subroutine gf_unpack3 |
|---|
| 51 | end interface |
|---|
| 52 | |
|---|
| 53 | nullify(igdstmpl,list_opt) |
|---|
| 54 | ! |
|---|
| 55 | iofst=0 ! set offset to beginning of section |
|---|
| 56 | call gf_unpack3(csec3,lcsec3,iofst,igds,igdstmpl, |
|---|
| 57 | & igdtlen,list_opt,num_opt,jerr) |
|---|
| 58 | if (jerr.eq.0) then |
|---|
| 59 | selectcase( igds(5) ) ! Template number |
|---|
| 60 | case (0:3) ! Lat/Lon |
|---|
| 61 | width=igdstmpl(8) |
|---|
| 62 | height=igdstmpl(9) |
|---|
| 63 | iscan=igdstmpl(19) |
|---|
| 64 | case (10) ! Mercator |
|---|
| 65 | width=igdstmpl(8) |
|---|
| 66 | height=igdstmpl(9) |
|---|
| 67 | iscan=igdstmpl(16) |
|---|
| 68 | case (20) ! Polar Stereographic |
|---|
| 69 | width=igdstmpl(8) |
|---|
| 70 | height=igdstmpl(9) |
|---|
| 71 | iscan=igdstmpl(18) |
|---|
| 72 | case (30) ! Lambert Conformal |
|---|
| 73 | width=igdstmpl(8) |
|---|
| 74 | height=igdstmpl(9) |
|---|
| 75 | iscan=igdstmpl(18) |
|---|
| 76 | case (40:43) ! Gaussian |
|---|
| 77 | width=igdstmpl(8) |
|---|
| 78 | height=igdstmpl(9) |
|---|
| 79 | iscan=igdstmpl(19) |
|---|
| 80 | case (90) ! Space View/Orthographic |
|---|
| 81 | width=igdstmpl(8) |
|---|
| 82 | height=igdstmpl(9) |
|---|
| 83 | iscan=igdstmpl(17) |
|---|
| 84 | case (110) ! Equatorial Azimuthal |
|---|
| 85 | width=igdstmpl(8) |
|---|
| 86 | height=igdstmpl(9) |
|---|
| 87 | iscan=igdstmpl(16) |
|---|
| 88 | case default |
|---|
| 89 | width=0 |
|---|
| 90 | height=0 |
|---|
| 91 | iscan=0 |
|---|
| 92 | end select |
|---|
| 93 | else |
|---|
| 94 | width=0 |
|---|
| 95 | height=0 |
|---|
| 96 | endif |
|---|
| 97 | ! |
|---|
| 98 | if (associated(igdstmpl)) deallocate(igdstmpl) |
|---|
| 99 | if (associated(list_opt)) deallocate(list_opt) |
|---|
| 100 | |
|---|
| 101 | return |
|---|
| 102 | end |
|---|
