g2grids.f

Go to the documentation of this file.

 
 
 
      module g2grids
 
      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)
           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
           integer count
 
           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,stat=iom)
             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       readgrids=count
           return
 
         end function
 
 
         subroutine getgridbynum(lunit,number,igdtn,igdtmpl,iret)
 
           integer,intent(in) :: lunit,number
           integer,intent(out) :: igdtn,igdtmpl(*),iret
 
           type(g2grid),pointer :: tempgrid
 
           iret=0
           igdtn=-1
           !igdtmpl=0
 
           !
           !  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
 
 
         subroutine getgridbyname(lunit,name,igdtn,igdtmpl,iret)
 
           integer,intent(in) :: lunit
           character(len=8),intent(in) :: name
           integer,intent(out) :: igdtn,igdtmpl(*),iret
 
           type(g2grid),pointer :: tempgrid
 
           iret=0
           igdtn=-1
           !igdtmpl=0
 
           !
           !  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
 
 
      end