hwrf-baseline-20120103-1354/ungrib/src/ngl/g2/getdim.f

   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