diff --git a/sorc/fvcom_tools.fd/CMakeLists.txt b/sorc/fvcom_tools.fd/CMakeLists.txt index 88d028b4a..97c66afff 100644 --- a/sorc/fvcom_tools.fd/CMakeLists.txt +++ b/sorc/fvcom_tools.fd/CMakeLists.txt @@ -6,9 +6,7 @@ set(fortran_src kinds.f90 module_ncio.f90 - module_nwp_base.f90 module_nwp.f90) -# process_FVCOM.f90) set(exe_src process_FVCOM.f90) diff --git a/sorc/fvcom_tools.fd/module_nwp.f90 b/sorc/fvcom_tools.fd/module_nwp.f90 index 19d8cd52f..878233112 100644 --- a/sorc/fvcom_tools.fd/module_nwp.f90 +++ b/sorc/fvcom_tools.fd/module_nwp.f90 @@ -15,17 +15,15 @@ module module_nwp use kinds, only: r_kind, r_single, i_short, rmissing - use module_nwp_base, only: nwpbase ! use module_map_utils, only: map_util use module_ncio, only: ncio implicit none public :: fcst_nwp - public :: nwp_type private - type :: nwp_type + type :: fcst_nwp character(len=6) :: datatype !< Data type. integer :: numvar !< Number of variabls. integer :: xlat !< Number of latitudes. @@ -66,15 +64,6 @@ module module_nwp real(r_kind), allocatable :: nwp_zorl_w(:,:) !< warm start surface roughness real(r_kind), allocatable :: nwp_hice_w(:,:) !< warm start ice thickness - end type nwp_type - - type, extends(nwp_type) :: fcst_nwp - ! The pointers are carryover from when I inherited the code from - ! GSL's work with HRRR for a similar use. I am not sure with - ! object based coding in Fortran if it needs to have parts - ! initialized to gain access to the procedures within it. - D. Wright. - type(nwpbase), pointer :: head => NULL() !< Pointer to head of list. - type(nwpbase), pointer :: tail => NULL() !< Pointer to tail of list. contains procedure :: initial => initial_nwp !< Defines vars and names. @return procedure :: list_initial => list_initial_nwp !< List the setup. @return @@ -212,9 +201,6 @@ subroutine initial_nwp(this,itype,wcstart) stop 1234 end if - this%head => NULL() - this%tail => NULL() - write(6,*) 'Finished initial_nwp' write(6,*) ' ' @@ -442,8 +428,6 @@ subroutine finish_nwp(this,itype,wcstart) character(len=6), intent(in) :: itype character(len=4), intent(in) :: wcstart - type(nwpbase), pointer :: thisobs,thisobsnext - deallocate(this%varnames) deallocate(this%latname) deallocate(this%lonname) @@ -472,18 +456,6 @@ subroutine finish_nwp(this,itype,wcstart) write(6,*) 'no deallocation' end if - thisobs => this%head - if(.NOT.associated(thisobs)) then - write(6,*) 'No memory to release' - return - endif - do while(associated(thisobs)) - - thisobsnext => thisobs%next - call thisobs%destroy() - thisobs => thisobsnext - enddo - write(6,*) 'Finished finish_nwp' write(6,*) ' ' diff --git a/sorc/fvcom_tools.fd/module_nwp_base.f90 b/sorc/fvcom_tools.fd/module_nwp_base.f90 deleted file mode 100644 index 42214f262..000000000 --- a/sorc/fvcom_tools.fd/module_nwp_base.f90 +++ /dev/null @@ -1,135 +0,0 @@ -!> @file -!! @brief Defines nwp observation data structure. -!! @author David Wright, University of Michigan and GLERL @date 17 Aug 2020 - -!> This module defines nwp observation data structure and the method -!! to read and write observations from and to those data -!! structures. It is used by ingest_FVCOM.f90. -!! -!! This script is strongly based upon Eric James' (ESRL/GSL) work with -!! HRRR/WRF. -!! -!! @author David Wright, University of Michigan and GLERL @date 17 Aug 2020 -!! -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 !< stroke longitude - real(r_single) :: lat !< stroke latitiude - 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() !< Pointer. - real(r_single) :: time !< observation time. - integer :: numvar !< number of variables in this obs type. -! real(r_single), allocatable :: obs(:) !< observation value (# numvar). - real(r_kind), allocatable :: obs(:) !< Observations. - logical :: ifquality !< do these obs include quality info? GLM has flash_quality_flag. - integer, allocatable :: quality(:) !< if so, quality flags. - contains - procedure :: list => list_obsbase !< List contents of obs. @return - procedure :: alloc => alloc_obsbase !< Allocate memory for observations. @return - procedure :: destroy => destroy_obsbase !< Release memory. @return - end type nwpbase - - contains - - !> This subroutine lists the contents of a base nwp observation. - !! - !! @param this the base nwp obervation - !! @author David Wright, University of Michigan and GLERL - !! @date 17 Aug 2020 - 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 - - !> This subroutine allocates memory for base nwp observation - !! variables. - !! - !! @param this the base nwp obervation - !! @param[in] numvar number of variables in this ob type - !! @param[in] ifquality does this observation include quality - !! information? - !! @author David Wright, University of Michigan and GLERL @date 17 Aug 2020 - 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 - - !> This subroutine releases memory associated with nwp - !! observations. - !! - !! @param this the base nwp obervation - !! @author David Wright, University of Michigan and GLERL @date 17 Aug 2020 - 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 diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index b76bc1477..327759b2e 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -33,9 +33,7 @@ function(PULL_DATA THE_URL THE_FILE) endif() endfunction() -# Add the test subdirecotries. -# fvcom test only works for Intel. Comment out for now. -#add_subdirectory(fvcom_tools) +add_subdirectory(fvcom_tools) add_subdirectory(filter_topo) add_subdirectory(chgres_cube) add_subdirectory(fre-nctools)