source: trunk/WRF.COMMON/WRFV3/external/io_grib2/g2lib/getdim.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: 3.3 KB
Line 
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
Note: See TracBrowser for help on using the repository browser.