module_nwp_base.f90

Go to the documentation of this file.

module module_nwp_base

   use kinds, only: r_kind, r_single, rmissing

   implicit none

   public :: nwpbase
   public :: nwplocation

   private

!  Define a nwp observation type.

   type nwplocation
      real(r_single) :: lon
      real(r_single) :: lat
   end type nwplocation

!  Define a nwp observation type to contain actual data.

   type, extends(nwplocation) :: nwpbase
!  HOW DOES THIS POINTER THING WORK?
      type(nwpbase), pointer :: next => NULL()
      real(r_single) :: time
      integer :: numvar
!      real(r_single), allocatable :: obs(:)  !< observation value (# numvar).
      real(r_kind), allocatable :: obs(:)
      logical :: ifquality
      integer, allocatable :: quality(:)
      contains
         procedure :: list => list_obsbase 
         procedure :: alloc => alloc_obsbase 
         procedure :: destroy => destroy_obsbase  
   end type nwpbase

   contains

      subroutine list_obsbase(this)
         class(nwpbase) :: this

         integer :: i, numvar

!        Write out the lon, lat, and time of the ob

         write(6,'(a,3f10.3)') 'LIGHTNING OB: longitude, latitude, time =', &
            this%lon, this%lat, this%time

!        Loop through all variables and print out obs and quality

         numvar = this%numvar
         if (numvar >= 1) then
! MULTI-DIMENSIONAL EXAMPLE IN  module_obs_base.f90
            write(6,'(a4,10F12.2)') 'obs=', (this%obs(i),i=1,numvar)
            if(this%ifquality) &
            write(6,'(a4,10I12)') 'qul=', (this%quality(i),i=1,numvar)
         else
            write(6,*) 'No obs for this location'
         endif

      end subroutine list_obsbase

      subroutine alloc_obsbase(this,numvar,ifquality)


         class(nwpbase) :: this

         integer, intent(in) :: numvar

         logical, intent(in), optional :: ifquality

         if (numvar >= 1) then
            this%numvar = numvar

            if(allocated(this%obs)) deallocate(this%obs)
            allocate(this%obs(numvar))

            this%ifquality=.false.
            if(present(ifquality)) this%ifquality = ifquality
            if(this%ifquality) allocate(this%quality(numvar))

         else
            write(6,*) 'alloc_obsbase Error: dimension must be larger than 0:', numvar
            stop 1234
         endif

      end subroutine alloc_obsbase

      subroutine destroy_obsbase(this)

         class(nwpbase) :: this

         this%numvar = 0
         this%time = 0

         if(allocated(this%obs)) deallocate(this%obs)

         this%ifquality=.false.
         if(allocated(this%quality)) deallocate(this%quality)

         this%next => null()

      end subroutine destroy_obsbase

end module module_nwp_base