g2grids.F90

Go to the documentation of this file.

 
 
module g2grids
  implicit none
  integer, parameter :: maxtemp = 200
 
  type,private :: g2grid
     integer :: grid_num
     integer :: gdt_num
     integer :: gdt_len
     integer, dimension(MAXTEMP) :: gridtmpl
     character(len = 8) :: cdesc
     type(g2grid), pointer :: next
  end type g2grid
 
  type(g2grid), pointer, private :: gridlist
  integer :: num_grids = 0
 
contains
 
  integer function readgrids(lunit)
    implicit none
 
    integer, intent(in) :: lunit
 
    integer, parameter :: linelen = 1280
    character(len = 8) :: desc
    character(len = linelen) :: cline
    integer :: ient, igdtn, igdtmpl(200), igdtlen
    integer :: pos1, pos2, pos3, pos4
    type(g2grid), pointer :: gtemp
    type(g2grid), pointer :: prev => null()
    integer :: count
 
    integer :: j
 
    count = 0
 
    ! For each line in the file....
    do
       ! Read line into buffer.
       cline(1 : linelen) = ' '
       read(lunit, end = 999, fmt = '(a)') cline
 
       ! Skip line if commented out.
       if (cline(1 : 1) .eq. '#') cycle
 
       ! Find positions of delimiters, ":".
       pos1 = index(cline, ':')
       cline(pos1 : pos1) = ';'
       pos2 = index(cline, ':')
       cline(pos2 : pos2) = ';'
       pos3 = index(cline, ':')
       cline(pos3 : pos3) = ';'
       pos4 = index(cline, ':')
       if ( pos1 .eq. 0 .or. pos2 .eq. 0 .or. pos3 .eq. 0 .or.  &
            pos4 .eq. 0) cycle
 
       ! Read each of the five fields.
       read(cline(1 : pos1 - 1), *) ient
       read(cline(pos1 + 1 : pos2 - 1), *) desc
       read(cline(pos2 + 1 : pos3 - 1), *) igdtn
       read(cline(pos3 + 1 : pos4 - 1), *) igdtlen
       read(cline(pos4 + 1 : linelen), *) (igdtmpl(j), j = 1, igdtlen)
 
       ! Allocate new type(g2grid) variable to store the GDT.
       allocate(gtemp)
       count = count + 1
       gtemp%grid_num = ient
       gtemp%gdt_num = igdtn
       gtemp%gdt_len = igdtlen
       gtemp%gridtmpl = igdtmpl
       gtemp%cdesc = desc
       nullify(gtemp%next)              ! defines end of linked list.
       if ( count .eq. 1 ) then
          gridlist => gtemp
       else                       ! make sure previous entry in list
          prev%next => gtemp      ! points to the new entry,
       endif
       prev => gtemp
    enddo
999 backspace(lunit)
    readgrids = count
    return
 
  end function readgrids
 
  subroutine getgridbynum(lunit, number, igdtn, igdtmpl, iret)
    implicit none
    integer, intent(in) :: lunit, number
    integer, intent(out) :: igdtn, igdtmpl(*), iret
    type(g2grid), pointer :: tempgrid
 
    iret = 0
    igdtn = -1
 
    ! If no grids in list, try reading them from the file.
    if (num_grids .eq. 0) then
       num_grids = readgrids(lunit)
    endif
 
    if (num_grids .eq. 0) then
       iret = 3                         ! problem reading file
       return
    endif
 
    tempgrid => gridlist
 
    ! Search through list.
    do while (associated(tempgrid))
       if (number .eq. tempgrid%grid_num) then
          igdtn = tempgrid%gdt_num
          igdtmpl(1 : tempgrid%gdt_len) = tempgrid%gridtmpl(1 : tempgrid%gdt_len)
          return
       else
          tempgrid => tempgrid%next
       endif
    enddo
 
    iret = -1
    return
 
  end subroutine getgridbynum
 
  subroutine getgridbyname(lunit, name, igdtn, igdtmpl, iret)
    implicit none
    integer, intent(in) :: lunit
    character(len = 8), intent(in) :: name
    integer, intent(out) :: igdtn, igdtmpl(*), iret
    type(g2grid), pointer :: tempgrid
 
    iret = 0
    igdtn = -1
 
    ! If no grids in list, try reading them from the file.
    if (num_grids .eq. 0) then
       num_grids = readgrids(lunit)
    endif
 
    if (num_grids .eq. 0) then
       iret = 3                         ! problem reading file
       return
    endif
 
    tempgrid => gridlist
 
    ! Search through list.
    do while (associated(tempgrid))
       if (name .eq. tempgrid%cdesc) then
          igdtn = tempgrid%gdt_num
          igdtmpl(1:tempgrid%gdt_len) = tempgrid%gridtmpl(1:tempgrid%gdt_len)
          return
       else
          tempgrid => tempgrid%next
       endif
    enddo
 
    iret = -1
    return
  end subroutine getgridbyname
 
  subroutine freegridlist()
    implicit none
    integer :: i
    type(g2grid), pointer :: gridnext
 
    do i = 1, num_grids
       gridnext => gridlist%next
       deallocate(gridlist)
       gridlist => gridnext
    end do
  end subroutine freegridlist
end module g2grids