external/io_grib2/g2lib/g2grids.F

   1       module g2grids
   2 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
   3 !                .      .    .                                       .
   4 ! MODULE:    g2grids
   5 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2004-04-27
   6 !
   7 ! ABSTRACT: This Fortran Module allows access to predefined GRIB2 Grid
   8 !   Definition Templates stored in a file.  The GDTs are represented by
   9 !   a predefined number or a character abbreviation.
  10 !
  11 !   At the first request, all the grid GDT entries in the file associated
  12 !   with input Fortran file unit number, lunit, are read into a linked list
  13 !   named gridlist.  This list is searched for the requested entry.
  14 !
  15 !   Users of this Fortran module should only call routines getgridbynum
  16 !   and getgridbyname.
  17 !
  18 !   The format of the file scanned by routines in this module is as follows.
  19 !   Each line contains one Grid entry containing five fields, each separated
  20 !   by a colon, ":".  The fields are:
  21 !      1) - predefined grid number
  22 !      2) - Up to an 8 character abbreviation
  23 !      3) - Grid Definition Template number
  24 !      4) - Number of entries in the Grid Definition Template
  25 !      5) - A list of values for each entry in the Grid Definition Template.
  26 !
  27 !   As an example, this is the entry for the 1x1 GFS global grid
  28 !   3:gbl_1deg:  0:19: 0 0 0 0 0 0 0 360 181 0 0 90000000 0 48 -90000000 359000000 1000000 1000000 0
  29 !
  30 !   Comments can be included in the file by specifying the symbol "#" as the
  31 !   first character on the line.  These lines are ignored.
  32 !
  33 !
  34 ! PROGRAM HISTORY LOG:
  35 ! 2004-04-27  Gilbert
  36 !
  37 ! USAGE:    use g2grids
  38 !
  39 ! ATTRIBUTES:
  40 !   LANGUAGE: Fortran 90
  41 !   MACHINE:  IBM SP
  42 !
  43 !$$$
  44
  45       integer,parameter :: MAXTEMP=200
  46
  47       type,private :: g2grid
  48           integer :: grid_num
  49           integer :: gdt_num
  50           integer :: gdt_len
  51           integer,dimension(MAXTEMP) :: gridtmpl
  52           character(len=8) :: cdesc
  53           type(g2grid),pointer :: next
  54       end type g2grid
  55
  56       type(g2grid),pointer,private :: gridlist
  57       integer :: num_grids=0
  58
  59       contains
  60
  61
  62          integer function readgrids(lunit)
  63 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
  64 !                .      .    .                                       .
  65 ! SUBPROGRAM:    readgrids
  66 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2001-06-28
  67 !
  68 ! ABSTRACT: This function reads the list of GDT entries in the file
  69 !   associated with fortran unit, lunit.  All the entries are stored in a
  70 !   linked list called gridlist.
  71 !
  72 ! PROGRAM HISTORY LOG:
  73 ! 2001-06-28  Gilbert
  74 !
  75 ! USAGE:    number=readgrids(lunit)
  76 !   INPUT ARGUMENT LIST:
  77 !     lunit   - Fortran unit number associated the the GDT file.
  78 !
  79 ! RETURNS:  The number of Grid Definition Templates read in.
  80 !
  81 ! REMARKS: None
  82 !
  83 ! ATTRIBUTES:
  84 !   LANGUAGE: Fortran 90
  85 !   MACHINE:  IBM SP
  86 !
  87 !$$$
  88            integer,intent(in) :: lunit
  89
  90            integer,parameter :: linelen=1280
  91            character(len=8) :: desc
  92            character(len=linelen) :: cline
  93            integer  ient,igdtn,igdtmpl(200),igdtlen
  94            integer :: pos1,pos2,pos3,pos4
  95
  96            type(g2grid),pointer :: gtemp
  97            type(g2grid),pointer :: prev
  98            integer count
  99
 100            count=0
 101
 102            !   For each line in the file....
 103            DO
 104              !  Read line into buffer
 105              !
 106              cline(1:linelen)=' '
 107              read(lunit,end=999,fmt='(a)') cline
 108
 109              !
 110              !  Skip line if commented out
 111              !
 112              if (cline(1:1).eq.'#') cycle
 113
 114              !
 115              !  find positions of delimiters, ":"
 116              !
 117              pos1=index(cline,':')
 118              cline(pos1:pos1)=';'
 119              pos2=index(cline,':')
 120              cline(pos2:pos2)=';'
 121              pos3=index(cline,':')
 122              cline(pos3:pos3)=';'
 123              pos4=index(cline,':')
 124              if ( pos1.eq.0 .or. pos2.eq.0 .or. pos3.eq.0 .or.
 125      &            pos4.eq.0) cycle
 126
 127              !
 128              !  Read each of the five fields.
 129              !
 130              read(cline(1:pos1-1),*) ient
 131              read(cline(pos1+1:pos2-1),*) desc
 132              read(cline(pos2+1:pos3-1),*) igdtn
 133              read(cline(pos3+1:pos4-1),*) igdtlen
 134              read(cline(pos4+1:linelen),*) (igdtmpl(j),j=1,igdtlen)
 135
 136              !
 137              !  Allocate new type(g2grid) variable to store the GDT
 138              !
 139              allocate(gtemp,stat=iom)
 140              count=count+1
 141              gtemp%grid_num=ient
 142              gtemp%gdt_num=igdtn
 143              gtemp%gdt_len=igdtlen
 144              gtemp%gridtmpl=igdtmpl
 145              gtemp%cdesc=desc
 146              nullify(gtemp%next)              ! defines end of linked list.
 147              if ( count .eq. 1 ) then
 148                 gridlist => gtemp
 149              else                       ! make sure previous entry in list
 150                 prev%next => gtemp      ! points to the new entry,
 151              endif
 152              prev => gtemp
 153
 154            enddo
 155
 156  999       readgrids=count
 157            return
 158
 159          end function
 160
 161
 162          subroutine getgridbynum(lunit,number,igdtn,igdtmpl,iret)
 163 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
 164 !                .      .    .                                       .
 165 ! SUBPROGRAM:    getgridbynum
 166 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2004-04-26
 167 !
 168 ! ABSTRACT: This subroutine searches a file referenced by fortran unit lunit
 169 !   for a Grid Definition Template assigned to the requested number.
 170 !   The input file format is described at the top of this module.
 171 !
 172 ! PROGRAM HISTORY LOG:
 173 ! 2004-04-26  Gilbert
 174 !
 175 ! USAGE:    CALL getgridbynum(lunit,number,igdtn,igdtmpl,iret)
 176 !   INPUT ARGUMENT LIST:
 177 !     lunit    - Unit number of file containing Grid definitions
 178 !     number   - Grid number of the requested Grid definition
 179 !
 180 !   OUTPUT ARGUMENT LIST:
 181 !     igdtn    - NN, indicating the number of the Grid Definition
 182 !                Template 3.NN
 183 !     igdtmpl()- An array containing the values of each entry in
 184 !                the Grid Definition Template.
 185 !     iret     - Error return code.
 186 !                0 = no error
 187 !               -1 = Undefined Grid number.
 188 !                3 = Could not read any grids from file.
 189 !
 190 ! REMARKS: None
 191 !
 192 ! ATTRIBUTES:
 193 !   LANGUAGE: Fortran 90
 194 !   MACHINE:  IBM SP
 195 !
 196 !$$$
 197            integer,intent(in) :: lunit,number
 198            integer,intent(out) :: igdtn,igdtmpl(*),iret
 199
 200            type(g2grid),pointer :: tempgrid
 201
 202            iret=0
 203            igdtn=-1
 204            !igdtmpl=0
 205
 206            !
 207            !  If no grids in list, try reading them from the file.
 208            !
 209            if ( num_grids .eq. 0 ) then
 210               num_grids=readgrids(lunit)
 211            endif
 212
 213            if ( num_grids .eq. 0 ) then
 214               iret=3                         ! problem reading file
 215               return
 216            endif
 217
 218            tempgrid => gridlist
 219
 220            !
 221            !  Search through list
 222            !
 223            do while ( associated(tempgrid) )
 224                if ( number .eq. tempgrid%grid_num ) then
 225                   igdtn=tempgrid%gdt_num
 226                   igdtmpl(1:tempgrid%gdt_len)=
 227      &                        tempgrid%gridtmpl(1:tempgrid%gdt_len)
 228                   return
 229                else
 230                   tempgrid => tempgrid%next
 231                endif
 232            enddo
 233
 234            iret=-1
 235            return
 236
 237          end subroutine
 238
 239
 240          subroutine getgridbyname(lunit,name,igdtn,igdtmpl,iret)
 241 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
 242 !                .      .    .                                       .
 243 ! SUBPROGRAM:    getgridbyname
 244 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2004-04-26
 245 !
 246 ! ABSTRACT: This subroutine searches a file referenced by fortran unit lunit
 247 !   for a Grid Definition Template assigned to the requested name.
 248 !   The input file format is described at the top of this module.
 249 !
 250 ! PROGRAM HISTORY LOG:
 251 ! 2004-04-26  Gilbert
 252 !
 253 ! USAGE:    CALL getgridbyname(lunit,name,igdtn,igdtmpl,iret)
 254 !   INPUT ARGUMENT LIST:
 255 !     lunit    - Unit number of file containing Grid definitions
 256 !     name     - Grid name of the requested Grid definition
 257 !
 258 !   OUTPUT ARGUMENT LIST:
 259 !     igdtn    - NN, indicating the number of the Grid Definition
 260 !                Template 3.NN
 261 !     igdtmpl()- An array containing the values of each entry in
 262 !                the Grid Definition Template.
 263 !     iret     - Error return code.
 264 !                0 = no error
 265 !               -1 = Undefined Grid number.
 266 !                3 = Could not read any grids from file.
 267 !
 268 ! REMARKS: None
 269 !
 270 ! ATTRIBUTES:
 271 !   LANGUAGE: Fortran 90
 272 !   MACHINE:  IBM SP
 273 !
 274 !$$$
 275            integer,intent(in) :: lunit
 276            character(len=8),intent(in) :: name
 277            integer,intent(out) :: igdtn,igdtmpl(*),iret
 278
 279            type(g2grid),pointer :: tempgrid
 280
 281            iret=0
 282            igdtn=-1
 283            !igdtmpl=0
 284
 285            !
 286            !  If no grids in list, try reading them from the file.
 287            !
 288            if ( num_grids .eq. 0 ) then
 289               num_grids=readgrids(lunit)
 290            endif
 291
 292            if ( num_grids .eq. 0 ) then
 293               iret=3                         ! problem reading file
 294               return
 295            endif
 296
 297            tempgrid => gridlist
 298
 299            !
 300            !  Search through list
 301            !
 302            do while ( associated(tempgrid) )
 303                if ( name .eq. tempgrid%cdesc ) then
 304                   igdtn=tempgrid%gdt_num
 305                   igdtmpl(1:tempgrid%gdt_len)=
 306      &                     tempgrid%gridtmpl(1:tempgrid%gdt_len)
 307                   return
 308                else
 309                   tempgrid => tempgrid%next
 310                endif
 311            enddo
 312
 313            iret=-1
 314            return
 315
 316          end subroutine
 317
 318
 319       end
 320