From afdc9df4e6b2ae4eb54b23990c120640babf477f Mon Sep 17 00:00:00 2001 From: MiKyung Lee <58964324+mlee03@users.noreply.github.com> Date: Fri, 8 Sep 2023 13:36:16 -0400 Subject: [PATCH] mixed precision column_diagnostics (#1076) --- CMakeLists.txt | 5 +- column_diagnostics/Makefile.am | 12 +- column_diagnostics/column_diagnostics.F90 | 403 +----------------- .../include/column_diagnostics.inc | 301 +++---------- .../include/column_diagnostics_r4.fh | 34 ++ .../include/column_diagnostics_r8.fh | 34 ++ configure.ac | 1 + test_fms/Makefile.am | 2 +- test_fms/column_diagnostics/Makefile.am | 50 +++ .../test_column_diagnostics.F90 | 191 +++++++++ .../test_column_diagnostics.sh | 29 ++ 11 files changed, 422 insertions(+), 640 deletions(-) create mode 100644 column_diagnostics/include/column_diagnostics_r4.fh create mode 100644 column_diagnostics/include/column_diagnostics_r8.fh create mode 100644 test_fms/column_diagnostics/Makefile.am create mode 100644 test_fms/column_diagnostics/test_column_diagnostics.F90 create mode 100755 test_fms/column_diagnostics/test_column_diagnostics.sh diff --git a/CMakeLists.txt b/CMakeLists.txt index 04635e784c..8d1c24bd0c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -305,6 +305,7 @@ foreach(kind ${kinds}) fms2_io/include string_utils/include mpp/include + column_diagnostics/include monin_obukhov/include sat_vapor_pres/include horiz_interp/include @@ -358,6 +359,7 @@ foreach(kind ${kinds}) $ $ $ + $ $ $ $ @@ -365,6 +367,8 @@ foreach(kind ${kinds}) $ $ $ + $ + $ $ $ $ @@ -374,7 +378,6 @@ foreach(kind ${kinds}) $ $) - target_include_directories(${libTgt} INTERFACE $ $) diff --git a/column_diagnostics/Makefile.am b/column_diagnostics/Makefile.am index af368bc14f..c205abbb4d 100644 --- a/column_diagnostics/Makefile.am +++ b/column_diagnostics/Makefile.am @@ -23,14 +23,22 @@ # Ed Hartnett 2/22/19 # Include .h and .mod files. -AM_CPPFLAGS = -I$(top_srcdir)/include +AM_CPPFLAGS = -I$(top_srcdir)/include -I$(top_srcdir)/column_diagnostics/include AM_FCFLAGS = $(FC_MODINC). $(FC_MODOUT)$(MODDIR) # Build this uninstalled convenience library. noinst_LTLIBRARIES = libcolumn_diagnostics.la # The convenience library depends on its source. -libcolumn_diagnostics_la_SOURCES = column_diagnostics.F90 +libcolumn_diagnostics_la_SOURCES = column_diagnostics.F90 \ +include/column_diagnostics.inc \ +include/column_diagnostics_r4.fh \ +include/column_diagnostics_r8.fh + +column_diagnostics.$(FC_MOD_EXT):\ +include/column_diagnostics.inc \ +include/column_diagnostics_r4.fh \ +include/column_diagnostics_r8.fh BUILT_SOURCES = column_diagnostics_mod.$(FC_MODEXT) nodist_include_HEADERS = column_diagnostics_mod.$(FC_MODEXT) diff --git a/column_diagnostics/column_diagnostics.F90 b/column_diagnostics/column_diagnostics.F90 index 2254f32b6a..b75ffd3698 100644 --- a/column_diagnostics/column_diagnostics.F90 +++ b/column_diagnostics/column_diagnostics.F90 @@ -32,7 +32,7 @@ module column_diagnostics_mod get_date, time_type use constants_mod, only: constants_init, PI, RADIAN use mpp_mod, only: input_nml_file - +use platform_mod, only: r4_kind, r8_kind !------------------------------------------------------------------- implicit none @@ -64,23 +64,34 @@ module column_diagnostics_mod column_diagnostics_header, & close_column_diagnostics_units + +interface initialize_diagnostic_columns + module procedure initialize_diagnostic_columns_r4 + module procedure initialize_diagnostic_columns_r8 +end interface initialize_diagnostic_columns + +interface column_diagnostics_header + module procedure column_diagnostics_header_r4 + module procedure column_diagnostics_header_r8 +end interface column_diagnostics_header + !private !-------------------------------------------------------------------- !---- namelist ----- -real :: crit_xdistance = 4.0 !< model grid points must be within crit_xdistance in +real(kind=r8_kind) :: crit_xdistance = 4.0_r8_kind !< model grid points must be within crit_xdistance in !! longitude of the requested diagnostics point !! coordinates in order to be flagged as the desired !! point !! [ degrees ] -real :: crit_ydistance = 4.0 !< model grid points must be within crit_ydistance in +real(kind=r8_kind) :: crit_ydistance = 4.0_r8_kind !< model grid points must be within crit_ydistance in !! latitude of the requested diagnostics point !! coordinates in order to be flagged as the desired !! point !! [ degrees ] -namelist / column_diagnostics_nml / & +namelist / column_diagnostics_nml / & crit_xdistance, & crit_ydistance @@ -163,387 +174,6 @@ subroutine column_diagnostics_init end subroutine column_diagnostics_init - -!#################################################################### - -!> @brief initialize_diagnostic_columns returns the (i, j, lat, lon) coord- -!! inates of any diagnostic columns that are located on the current -!! processor. -subroutine initialize_diagnostic_columns & - (module, num_diag_pts_latlon, num_diag_pts_ij, & - global_i , global_j , global_lat_latlon, & - global_lon_latlon, lonb_in, latb_in, & - do_column_diagnostics, & - diag_lon, diag_lat, diag_i, diag_j, diag_units) - -!--------------------------------------------------------------------- -! initialize_diagnostic_columns returns the (i, j, lat, lon) coord- -! inates of any diagnostic columns that are located on the current -! processor. -!---------------------------------------------------------------------- - -!--------------------------------------------------------------------- -character(len=*), intent(in) :: module !< module calling this subroutine -integer, intent(in) :: num_diag_pts_latlon !< number of diagnostic columns specified - !! by lat-lon coordinates -integer, intent(in) :: num_diag_pts_ij !< number of diagnostic columns specified - !! by global (i,j) coordinates -integer, dimension(:), intent(in) :: global_i !< specified global i coordinates -integer, dimension(:), intent(in) :: global_j !< specified global j coordinates -real , dimension(:), intent(in) :: global_lat_latlon !< specified global lat coordinates -real , dimension(:), intent(in) :: global_lon_latlon !< specified global lon coordinates -real, dimension(:,:), intent(in) :: lonb_in, latb_in -logical, dimension(:,:), intent(out) :: do_column_diagnostics !< is a diagnostic column in this jrow ? -integer, dimension(:), intent(inout) :: diag_i !< processor i indices of diagnstic columns -integer, dimension(:), intent(inout) :: diag_j !< processor j indices of diagnstic columns -real , dimension(:), intent(out) :: diag_lat !< latitudes of diagnostic columns [ degrees ] -real , dimension(:), intent(out) :: diag_lon !< longitudes of diagnostic columns [ degrees ] -integer, dimension(:), intent(out) :: diag_units !< unit number for each diagnostic column -!--------------------------------------------------------------------- - -!--------------------------------------------------------------------- -! intent(in) variables: -! -! module module calling this subroutine -! num_diag_pts_latlon number of diagnostic columns specified -! by lat-lon coordinates -! num_diag_pts_ij number of diagnostic columns specified -! by global (i,j) coordinates -! global_i specified global i coordinates -! global_j specified global j coordinates -! global_lat_latlon specified global lat coordinates -! global_lon_latlon specified global lon coordinates -! -! intent(out) variables: -! -! do_column_diagnostics is a diagnostic column in this jrow ? -! diag_i processor i indices of diagnstic columns -! diag_j processor j indices of diagnstic columns -! diag_lat latitudes of diagnostic columns -! [ degrees ] -! diag_lon longitudes of diagnostic columns -! [ degrees ] -! diag_units unit number for each diagnostic column -! -!--------------------------------------------------------------------- - -!-------------------------------------------------------------------- -! local variables: - - real, dimension(size(diag_i,1)) :: global_lat !< latitudes for all diagnostic columns [ degrees ] - real, dimension(size(diag_i,1)) :: global_lon !< longitudes for all diagnostic columns [ degrees ] - real, dimension(size(latb_in,1)-1, size(latb_in,2)-1) :: & - distance, distance_x, distance_y, & - distance_x2, distance2 - real, dimension(size(latb_in,1), size(latb_in,2)) :: latb_deg - real, dimension(size(lonb_in,1), size(lonb_in,2)) :: lonb_deg - real :: dellat, dellon - real :: latb_max, latb_min, lonb_max, lonb_min - - integer :: num_diag_pts !< total number of diagnostic columns - integer :: i !< do loop indices - integer :: j !< do loop indices - integer :: nn !< do loop indices - real :: ref_lat - real :: current_distance - character(len=8) :: char !< character string for diaganostic column index - character(len=32) :: filename !< filename for output file for diagnostic column - logical :: allow_ij_input - logical :: open_file - integer :: io -!-------------------------------------------------------------------- -! local variables: -! -! global_lat latitudes for all diagnostic columns [ degrees ] -! global_lon longitudes for all diagnostic columns -! [ degrees ] -! num_diag_pts total number of diagnostic columns -! i, j, nn do loop indices -! char character string for diaganostic column index -! filename filename for output file for diagnostic column -! -!--------------------------------------------------------------------- - - if (.not. module_is_initialized) call column_diagnostics_init - -!-------------------------------------------------------------------- -! save the input lat and lon fields. define the delta of latitude -! and longitude. -!-------------------------------------------------------------------- - latb_deg = latb_in*RADIAN - lonb_deg = lonb_in*RADIAN - dellat = latb_in(1,2) - latb_in(1,1) - dellon = lonb_in(2,1) - lonb_in(1,1) - latb_max = MAXVAL (latb_deg(:,:)) - latb_min = MINVAL (latb_deg(:,:)) - lonb_max = MAXVAL (lonb_deg(:,:)) - lonb_min = MINVAL (lonb_deg(:,:)) - if (lonb_min < 10.0 .or. lonb_max > 350.) then - lonb_min = 0. - lonb_max = 360.0 - endif - - allow_ij_input = .true. - ref_lat = latb_in(1,1) - do i =2,size(latb_in,1) - if (latb_in(i,1) /= ref_lat) then - allow_ij_input = .false. - exit - endif - end do - - if ( .not. allow_ij_input .and. num_diag_pts_ij /= 0) then - call error_mesg ('column_diagnostics_mod', & - 'cannot specify column diagnostics column with (i,j) & - &coordinates when using cubed sphere -- must specify & - & lat/lon coordinates', FATAL) - endif - -!---------------------------------------------------------------------- -! initialize column_diagnostics flag and diag unit numbers. define -! total number of diagnostic columns. -!---------------------------------------------------------------------- - do_column_diagnostics = .false. - diag_units(:) = -1 - diag_i(:) = -99 - diag_j(:) = -99 - diag_lat(:) = -999. - diag_lon(:) = -999. - num_diag_pts = size(diag_i(:)) - -!-------------------------------------------------------------------- -! define an array of lat-lon values for all diagnostic columns. -!-------------------------------------------------------------------- - do nn = 1, num_diag_pts_latlon - global_lat(nn) = global_lat_latlon(nn) - global_lon(nn) = global_lon_latlon(nn) - end do - - do nn = 1, num_diag_pts_ij - global_lat(nn+num_diag_pts_latlon) = & - ((-0.5*acos(-1.0) + 0.5*dellat) + & - (global_j (nn)-1) *dellat)*RADIAN - global_lon(nn+num_diag_pts_latlon) = (0.5*dellon + & - (global_i (nn)-1)*dellon)*RADIAN - end do - -!---------------------------------------------------------------------- -! loop over all diagnostic points to check for their presence on -! this processor. -!---------------------------------------------------------------------- - do nn=1,num_diag_pts - open_file = .false. - -!---------------------------------------------------------------------- -! verify that the values of lat and lon are valid. -!---------------------------------------------------------------------- - if (global_lon(nn) >= 0. .and. global_lon(nn) <= 360.0) then - else - call error_mesg ('column_diagnostics_mod', & - ' invalid longitude', FATAL) - endif - if (global_lat(nn) >= -90.0 .and. global_lat(nn) <= 90.0) then - else - call error_mesg ('column_diagnostics_mod', & - ' invalid latitude', FATAL) - endif - -!-------------------------------------------------------------------- -! if the desired diagnostics column is within the current -! processor's domain, define the total and coordinate distances from -! each of the processor's grid points to the diagnostics point. -!-------------------------------------------------------------------- - - if (global_lat(nn) .ge. latb_min .and. & - global_lat(nn) .le. latb_max) then - if (global_lon(nn) .ge. lonb_min .and.& - global_lon(nn) .le. lonb_max) then - do j=1,size(latb_deg,2) - 1 - do i=1,size(lonb_deg,1) - 1 - distance_y(i,j) = ABS(global_lat(nn) - latb_deg(i,j)) - distance_x(i,j) = ABS(global_lon(nn) - lonb_deg(i,j)) - distance_x2(i,j) = ABS((global_lon(nn)-360.) - & - lonb_deg(i,j)) - distance(i,j) = (global_lat(nn) - latb_deg(i,j))**2 + & - (global_lon(nn) - lonb_deg(i,j))**2 - distance2(i,j) = (global_lat(nn) - latb_deg(i,j))**2 + & - ((global_lon(nn)-360.) - & - lonb_deg(i,j))**2 - end do - end do - -!-------------------------------------------------------------------- -! find the grid point on the processor that is within the specified -! critical distance and also closest to the requested diagnostics -! column. save the (i,j) coordinates and (lon,lat) of this model -! grid point. set a flag indicating that a disgnostics file should -! be opened on this processor for this diagnostic point. -!-------------------------------------------------------------------- - current_distance = distance(1,1) - do j=1,size(latb_deg,2) - 1 - do i=1,size(lonb_deg,1) - 1 - if (distance_x(i,j) <= crit_xdistance .and. & - distance_y(i,j) <= crit_ydistance ) then - if (distance(i,j) < current_distance) then - current_distance = distance(i,j) - do_column_diagnostics(i,j) = .true. - diag_j(nn) = j - diag_i(nn) = i - diag_lon(nn) = lonb_deg(i,j) - diag_lat(nn) = latb_deg(i,j) - open_file = .true. - endif - endif - -!--------------------------------------------------------------------- -! check needed because of the 0.0 / 360.0 longitude periodicity. -!--------------------------------------------------------------------- - if (distance_x2(i,j) <= crit_xdistance .and. & - distance_y(i,j) <= crit_ydistance ) then - if (distance2(i,j) < current_distance) then - current_distance = distance2(i,j) - do_column_diagnostics(i,j) = .true. - diag_j(nn) = j - diag_i(nn) = i - diag_lon(nn) = lonb_deg(i,j) - diag_lat(nn) = latb_deg(i,j) - open_file = .true. - endif - endif - end do - end do - -!-------------------------------------------------------------------- -! if the point has been found on this processor, open a diagnostics -! file. -!-------------------------------------------------------------------- - if (open_file) then - write (char, '(i2)') nn - filename = trim(module) // '_point' // & - trim(adjustl(char)) // '.out' - if(mpp_npes() > 10000) then - write( filename,'(a,i6.6)' )trim(filename)//'.', mpp_pe()-mpp_root_pe() - else - write( filename,'(a,i4.4)' )trim(filename)//'.', mpp_pe()-mpp_root_pe() - endif - open(newunit=diag_units(nn), file=trim(filename), action='WRITE', position='rewind', iostat=io) - if(io/=0) call error_mesg ('column_diagnostics_mod', 'Error in opening file '//trim(filename), FATAL) - endif ! (open_file) - endif - endif - end do - -!--------------------------------------------------------------------- - - -end subroutine initialize_diagnostic_columns - - - - -!#################################################################### -!> @brief column_diagnostics_header writes out information concerning -!! time and location of following data into the column_diagnostics -!! output file. -subroutine column_diagnostics_header & - (module, diag_unit, Time, nn, diag_lon, & - diag_lat, diag_i, diag_j) - -!-------------------------------------------------------------------- -! column_diagnostics_header writes out information concerning -! time and location of following data into the column_diagnostics -! output file. -!-------------------------------------------------------------------- - -!-------------------------------------------------------------------- -character(len=*), intent(in) :: module !< module name calling this subroutine -type(time_type), intent(in) :: Time !< current model time [ time_type ] -integer, intent(in) :: diag_unit !< unit number for column_diagnostics output -integer, intent(in) :: nn !< index of diagnostic column currently active -real, dimension(:), intent(in) :: diag_lon !< longitude of current diagnostic column [ degrees ] -real, dimension(:), intent(in) :: diag_lat !< latitude of current diagnostic column [ degrees ] -integer, dimension(:), intent(in) :: diag_i !< i coordinate of current diagnostic column -integer, dimension(:), intent(in) :: diag_j !< j coordinate of current diagnostic column - -!-------------------------------------------------------------------- -! intent(in) variables -! -! module module name calling this subroutine -! Time current model time [ time_type ] -! diag_unit unit number for column_diagnostics output -! nn index of diagnostic column currently active -! diag_lon longitude of current diagnostic column [ degrees ] -! diag_lat latitude of current diagnostic column [ degrees ] -! diag_i i coordinate of current diagnostic column -! diag_j j coordinate of current diagnostic column -! -!--------------------------------------------------------------------- - -!-------------------------------------------------------------------- -! local variables: - - integer :: year !< integers defining the current time - integer :: month !< integers defining the current time - integer :: day !< integers defining the current time - integer :: hour !< integers defining the current time - integer :: minute !< integers defining the current time - integer :: second !< integers defining the current time - character(len=9) :: mon !< character string for the current month - character(len=64) :: header !< title for the output - -!-------------------------------------------------------------------- -! local variables: -! -! year, month, day, hour, minute, seconds -! integers defining the current time -! mon character string for the current month -! header title for the output -! -!-------------------------------------------------------------------- - - if (.not. module_is_initialized) call column_diagnostics_init - -!-------------------------------------------------------------------- -! convert the time type to a date and time for printing. convert -! month to a character string. -!-------------------------------------------------------------------- - call get_date (Time, year, month, day, hour, minute, second) - mon = month_name(month) - -!--------------------------------------------------------------------- -! write timestamp and column location information to the diagnostic -! columns output unit. -!--------------------------------------------------------------------- - write (diag_unit,'(a)') ' ' - write (diag_unit,'(a)') ' ' - write (diag_unit,'(a)') & - '======================================================' - write (diag_unit,'(a)') ' ' - header = ' PRINTING ' // module // ' DIAGNOSTICS' - write (diag_unit,'(a)') header - write (diag_unit,'(a)') ' ' - write (diag_unit,'(a, i6,2x, a,i4,i4,i4,i4)') ' time stamp:', & - year, trim(mon), day, & - hour, minute, second - write (diag_unit,'(a, i4)') & - ' DIAGNOSTIC POINT COORDINATES, point #', nn - write (diag_unit,'(a)') ' ' - write (diag_unit,'(a,f8.3,a,f8.3)') ' longitude = ', & - diag_lon(nn), ' latitude = ', diag_lat(nn) - write (diag_unit,'(a, i6, a,i6,a,i6)') & - ' on processor # ', mpp_pe(), & - ' : processor i =', diag_i(nn), & - ' , processor j =', diag_j(nn) - write (diag_unit,'(a)') ' ' - -!--------------------------------------------------------------------- - - - -end subroutine column_diagnostics_header - - - !###################################################################### !> @brief close_column_diagnostics_units closes any open column_diagnostics !! files associated with the calling module. @@ -588,7 +218,8 @@ end subroutine close_column_diagnostics_units !##################################################################### - +#include "column_diagnostics_r4.fh" +#include "column_diagnostics_r8.fh" end module column_diagnostics_mod diff --git a/column_diagnostics/include/column_diagnostics.inc b/column_diagnostics/include/column_diagnostics.inc index 2254f32b6a..c2e18f2a7d 100644 --- a/column_diagnostics/include/column_diagnostics.inc +++ b/column_diagnostics/include/column_diagnostics.inc @@ -16,160 +16,12 @@ !* You should have received a copy of the GNU Lesser General Public !* License along with FMS. If not, see . !*********************************************************************** -!> @defgroup column_diagnostics_mod column_diagnostics_mod -!> @ingroup column_diagnostics -!! @brief Module to locate and mark desired diagnostic columns - -!> @addtogroup column_diagnostics_mod -!> @{ -module column_diagnostics_mod - -use fms_mod, only: fms_init, mpp_pe, mpp_root_pe, & - mpp_npes, check_nml_error, & - error_mesg, FATAL, NOTE, WARNING, & - stdlog, write_version_number -use time_manager_mod, only: time_manager_init, month_name, & - get_date, time_type -use constants_mod, only: constants_init, PI, RADIAN -use mpp_mod, only: input_nml_file - -!------------------------------------------------------------------- - -implicit none -private - -!--------------------------------------------------------------------- -! module to locate and mark desired diagnostic columns -! -! -!-------------------------------------------------------------------- - - - - -!--------------------------------------------------------------------- -!----------- ****** VERSION NUMBER ******* --------------------------- - - -! Include variable "version" to be written to log file. -#include - - - -!--------------------------------------------------------------------- -!------- interfaces -------- - -public column_diagnostics_init, & - initialize_diagnostic_columns, & - column_diagnostics_header, & - close_column_diagnostics_units - -!private - -!-------------------------------------------------------------------- -!---- namelist ----- - -real :: crit_xdistance = 4.0 !< model grid points must be within crit_xdistance in - !! longitude of the requested diagnostics point - !! coordinates in order to be flagged as the desired - !! point - !! [ degrees ] -real :: crit_ydistance = 4.0 !< model grid points must be within crit_ydistance in - !! latitude of the requested diagnostics point - !! coordinates in order to be flagged as the desired - !! point - !! [ degrees ] - -namelist / column_diagnostics_nml / & - crit_xdistance, & - crit_ydistance - -!-------------------------------------------------------------------- -!-------- public data ----- - - -!-------------------------------------------------------------------- -!------ private data ------ - - -logical :: module_is_initialized = .false. - -!------------------------------------------------------------------- -!------------------------------------------------------------------- - - - - contains - - - -!#################################################################### - -!> @brief Initialization routine for column_diagnostics_mod. -!! -!> Reads namelist and writes to log. -subroutine column_diagnostics_init - -!-------------------------------------------------------------------- -! column_diagnostics_init is the constructor for -! column_diagnostics_mod. -!-------------------------------------------------------------------- - -!-------------------------------------------------------------------- -! local variables: -! - integer :: unit !< unit number for nml file - integer :: ierr !< error return flag - integer :: io !< error return code - -!-------------------------------------------------------------------- -! local variables: -! -! unit unit number for nml file -! ierr error return flag -! io error return code -! -!--------------------------------------------------------------------- - -!-------------------------------------------------------------------- -! if routine has already been executed, return. -!-------------------------------------------------------------------- - if (module_is_initialized) return - -!--------------------------------------------------------------------- -! verify that all modules used by this module have been initialized. -!---------------------------------------------------------------------- - call fms_init - call time_manager_init - call constants_init - -!--------------------------------------------------------------------- -! read namelist. -!--------------------------------------------------------------------- - read (input_nml_file, column_diagnostics_nml, iostat=io) - ierr = check_nml_error (io, 'column_diagnostics_nml') -!--------------------------------------------------------------------- -! write version number and namelist to logfile. -!--------------------------------------------------------------------- - call write_version_number("COLUMN_DIAGNOSTICS_MOD", version) - if (mpp_pe() == mpp_root_pe()) then - unit = stdlog() - write (unit, nml=column_diagnostics_nml) - endif -!-------------------------------------------------------------------- - module_is_initialized = .true. - - -end subroutine column_diagnostics_init - - - -!#################################################################### +!> @file !> @brief initialize_diagnostic_columns returns the (i, j, lat, lon) coord- !! inates of any diagnostic columns that are located on the current !! processor. -subroutine initialize_diagnostic_columns & +subroutine INITIALIZE_DIAGNOSTIC_COLUMNS_ & (module, num_diag_pts_latlon, num_diag_pts_ij, & global_i , global_j , global_lat_latlon, & global_lon_latlon, lonb_in, latb_in, & @@ -190,14 +42,14 @@ integer, intent(in) :: num_diag_pts_ij !< number of diagn !! by global (i,j) coordinates integer, dimension(:), intent(in) :: global_i !< specified global i coordinates integer, dimension(:), intent(in) :: global_j !< specified global j coordinates -real , dimension(:), intent(in) :: global_lat_latlon !< specified global lat coordinates -real , dimension(:), intent(in) :: global_lon_latlon !< specified global lon coordinates -real, dimension(:,:), intent(in) :: lonb_in, latb_in +real(FMS_CD_KIND_), dimension(:), intent(in) :: global_lat_latlon !< specified global lat coordinates +real(FMS_CD_KIND_), dimension(:), intent(in) :: global_lon_latlon !< specified global lon coordinates +real(FMS_CD_KIND_), dimension(:,:), intent(in) :: lonb_in, latb_in logical, dimension(:,:), intent(out) :: do_column_diagnostics !< is a diagnostic column in this jrow ? integer, dimension(:), intent(inout) :: diag_i !< processor i indices of diagnstic columns integer, dimension(:), intent(inout) :: diag_j !< processor j indices of diagnstic columns -real , dimension(:), intent(out) :: diag_lat !< latitudes of diagnostic columns [ degrees ] -real , dimension(:), intent(out) :: diag_lon !< longitudes of diagnostic columns [ degrees ] +real(FMS_CD_KIND_), dimension(:), intent(out) :: diag_lat !< latitudes of diagnostic columns [ degrees ] +real(FMS_CD_KIND_), dimension(:), intent(out) :: diag_lon !< longitudes of diagnostic columns [ degrees ] integer, dimension(:), intent(out) :: diag_units !< unit number for each diagnostic column !--------------------------------------------------------------------- @@ -230,27 +82,30 @@ integer, dimension(:), intent(out) :: diag_units !< unit number for !-------------------------------------------------------------------- ! local variables: - real, dimension(size(diag_i,1)) :: global_lat !< latitudes for all diagnostic columns [ degrees ] - real, dimension(size(diag_i,1)) :: global_lon !< longitudes for all diagnostic columns [ degrees ] - real, dimension(size(latb_in,1)-1, size(latb_in,2)-1) :: & + real(FMS_CD_KIND_), dimension(size(diag_i,1)) :: global_lat !< latitudes for all diagnostic columns [ degrees ] + real(FMS_CD_KIND_), dimension(size(diag_i,1)) :: global_lon !< longitudes for all diagnostic columns [ degrees ] + real(FMS_CD_KIND_), dimension(size(latb_in,1)-1, size(latb_in,2)-1) :: & distance, distance_x, distance_y, & - distance_x2, distance2 - real, dimension(size(latb_in,1), size(latb_in,2)) :: latb_deg - real, dimension(size(lonb_in,1), size(lonb_in,2)) :: lonb_deg - real :: dellat, dellon - real :: latb_max, latb_min, lonb_max, lonb_min + distance_x2, distance2 + real(FMS_CD_KIND_), dimension(size(latb_in,1), size(latb_in,2)) :: latb_deg + real(FMS_CD_KIND_), dimension(size(lonb_in,1), size(lonb_in,2)) :: lonb_deg + real(FMS_CD_KIND_) :: dellat, dellon + real(FMS_CD_KIND_) :: latb_max, latb_min, lonb_max, lonb_min integer :: num_diag_pts !< total number of diagnostic columns integer :: i !< do loop indices integer :: j !< do loop indices integer :: nn !< do loop indices - real :: ref_lat - real :: current_distance + real(FMS_CD_KIND_) :: ref_lat + real(FMS_CD_KIND_) :: current_distance character(len=8) :: char !< character string for diaganostic column index character(len=32) :: filename !< filename for output file for diagnostic column logical :: allow_ij_input logical :: open_file integer :: io + + integer, parameter :: lkind=FMS_CD_KIND_ + real(FMS_CD_KIND_) :: tmp !-------------------------------------------------------------------- ! local variables: ! @@ -270,17 +125,17 @@ integer, dimension(:), intent(out) :: diag_units !< unit number for ! save the input lat and lon fields. define the delta of latitude ! and longitude. !-------------------------------------------------------------------- - latb_deg = latb_in*RADIAN - lonb_deg = lonb_in*RADIAN + latb_deg = real( real(latb_in,r8_kind)*RADIAN, FMS_CD_KIND_) !< unit conversion in r8_kind + lonb_deg = real( real(lonb_in,r8_kind)*RADIAN, FMS_CD_KIND_ ) !< unit conversion in r8_kind dellat = latb_in(1,2) - latb_in(1,1) dellon = lonb_in(2,1) - lonb_in(1,1) latb_max = MAXVAL (latb_deg(:,:)) latb_min = MINVAL (latb_deg(:,:)) lonb_max = MAXVAL (lonb_deg(:,:)) lonb_min = MINVAL (lonb_deg(:,:)) - if (lonb_min < 10.0 .or. lonb_max > 350.) then - lonb_min = 0. - lonb_max = 360.0 + if (lonb_min < 10.0_lkind .or. lonb_max > 350.0_lkind) then + lonb_min = 0.0_lkind + lonb_max = 360.0_lkind endif allow_ij_input = .true. @@ -299,6 +154,8 @@ integer, dimension(:), intent(out) :: diag_units !< unit number for & lat/lon coordinates', FATAL) endif +!---------------------------------------------------------------------- + !---------------------------------------------------------------------- ! initialize column_diagnostics flag and diag unit numbers. define ! total number of diagnostic columns. @@ -307,8 +164,8 @@ integer, dimension(:), intent(out) :: diag_units !< unit number for diag_units(:) = -1 diag_i(:) = -99 diag_j(:) = -99 - diag_lat(:) = -999. - diag_lon(:) = -999. + diag_lat(:) = -999.0_lkind + diag_lon(:) = -999.0_lkind num_diag_pts = size(diag_i(:)) !-------------------------------------------------------------------- @@ -320,12 +177,11 @@ integer, dimension(:), intent(out) :: diag_units !< unit number for end do do nn = 1, num_diag_pts_ij - global_lat(nn+num_diag_pts_latlon) = & - ((-0.5*acos(-1.0) + 0.5*dellat) + & - (global_j (nn)-1) *dellat)*RADIAN - global_lon(nn+num_diag_pts_latlon) = (0.5*dellon + & - (global_i (nn)-1)*dellon)*RADIAN - end do + tmp = (-0.5_lkind*acos(-1.0_lkind) + 0.5_lkind*dellat) + real(global_j(nn)-1,FMS_CD_KIND_)*dellat + global_lat(nn+num_diag_pts_latlon) = real( real(tmp,r8_kind)*RADIAN, FMS_CD_KIND_ ) + tmp = 0.5_lkind*dellon + real(global_i(nn)-1,FMS_CD_KIND_)*dellon + global_lon(nn+num_diag_pts_latlon) = real( real(tmp,r8_kind)*RADIAN, FMS_CD_KIND_ ) + end do !---------------------------------------------------------------------- ! loop over all diagnostic points to check for their presence on @@ -337,12 +193,14 @@ integer, dimension(:), intent(out) :: diag_units !< unit number for !---------------------------------------------------------------------- ! verify that the values of lat and lon are valid. !---------------------------------------------------------------------- - if (global_lon(nn) >= 0. .and. global_lon(nn) <= 360.0) then + if (global_lon(nn) >= 0.0_lkind .and. & + global_lon(nn) <= 360.0_lkind) then else call error_mesg ('column_diagnostics_mod', & ' invalid longitude', FATAL) endif - if (global_lat(nn) >= -90.0 .and. global_lat(nn) <= 90.0) then + if (global_lat(nn) >= -90.0_lkind .and. & + global_lat(nn) <= 90.0_lkind) then else call error_mesg ('column_diagnostics_mod', & ' invalid latitude', FATAL) @@ -362,13 +220,9 @@ integer, dimension(:), intent(out) :: diag_units !< unit number for do i=1,size(lonb_deg,1) - 1 distance_y(i,j) = ABS(global_lat(nn) - latb_deg(i,j)) distance_x(i,j) = ABS(global_lon(nn) - lonb_deg(i,j)) - distance_x2(i,j) = ABS((global_lon(nn)-360.) - & - lonb_deg(i,j)) - distance(i,j) = (global_lat(nn) - latb_deg(i,j))**2 + & - (global_lon(nn) - lonb_deg(i,j))**2 - distance2(i,j) = (global_lat(nn) - latb_deg(i,j))**2 + & - ((global_lon(nn)-360.) - & - lonb_deg(i,j))**2 + distance_x2(i,j) = ABS((global_lon(nn)-360.0_lkind) - lonb_deg(i,j)) + distance(i,j) = (global_lat(nn)-latb_deg(i,j))**2 + (global_lon(nn)-lonb_deg(i,j))**2 + distance2(i,j) = (global_lat(nn)-latb_deg(i,j))**2 + ((global_lon(nn)-360.0_lkind) - lonb_deg(i,j))**2 end do end do @@ -382,8 +236,8 @@ integer, dimension(:), intent(out) :: diag_units !< unit number for current_distance = distance(1,1) do j=1,size(latb_deg,2) - 1 do i=1,size(lonb_deg,1) - 1 - if (distance_x(i,j) <= crit_xdistance .and. & - distance_y(i,j) <= crit_ydistance ) then + if (distance_x(i,j) <= real(crit_xdistance,FMS_CD_KIND_) .and. & + distance_y(i,j) <= real(crit_ydistance,FMS_CD_KIND_)) then if (distance(i,j) < current_distance) then current_distance = distance(i,j) do_column_diagnostics(i,j) = .true. @@ -398,8 +252,8 @@ integer, dimension(:), intent(out) :: diag_units !< unit number for !--------------------------------------------------------------------- ! check needed because of the 0.0 / 360.0 longitude periodicity. !--------------------------------------------------------------------- - if (distance_x2(i,j) <= crit_xdistance .and. & - distance_y(i,j) <= crit_ydistance ) then + if (distance_x2(i,j)<= real(crit_xdistance,FMS_CD_KIND_) .and. & + distance_y(i,j) <= real(crit_ydistance,FMS_CD_KIND_)) then if (distance2(i,j) < current_distance) then current_distance = distance2(i,j) do_column_diagnostics(i,j) = .true. @@ -436,7 +290,7 @@ integer, dimension(:), intent(out) :: diag_units !< unit number for !--------------------------------------------------------------------- -end subroutine initialize_diagnostic_columns +end subroutine INITIALIZE_DIAGNOSTIC_COLUMNS_ @@ -445,7 +299,7 @@ end subroutine initialize_diagnostic_columns !> @brief column_diagnostics_header writes out information concerning !! time and location of following data into the column_diagnostics !! output file. -subroutine column_diagnostics_header & +subroutine COLUMN_DIAGNOSTICS_HEADER_ & (module, diag_unit, Time, nn, diag_lon, & diag_lat, diag_i, diag_j) @@ -460,8 +314,8 @@ character(len=*), intent(in) :: module !< module name calling this subr type(time_type), intent(in) :: Time !< current model time [ time_type ] integer, intent(in) :: diag_unit !< unit number for column_diagnostics output integer, intent(in) :: nn !< index of diagnostic column currently active -real, dimension(:), intent(in) :: diag_lon !< longitude of current diagnostic column [ degrees ] -real, dimension(:), intent(in) :: diag_lat !< latitude of current diagnostic column [ degrees ] +real(FMS_CD_KIND_), dimension(:), intent(in) :: diag_lon !< longitude of current diagnostic column [ degrees ] +real(FMS_CD_KIND_), dimension(:), intent(in) :: diag_lat !< latitude of current diagnostic column [ degrees ] integer, dimension(:), intent(in) :: diag_i !< i coordinate of current diagnostic column integer, dimension(:), intent(in) :: diag_j !< j coordinate of current diagnostic column @@ -479,6 +333,7 @@ integer, dimension(:), intent(in) :: diag_j !< j coordinate of current diagn ! !--------------------------------------------------------------------- + !-------------------------------------------------------------------- ! local variables: @@ -538,59 +393,5 @@ integer, dimension(:), intent(in) :: diag_j !< j coordinate of current diagn !--------------------------------------------------------------------- - - -end subroutine column_diagnostics_header - - - -!###################################################################### -!> @brief close_column_diagnostics_units closes any open column_diagnostics -!! files associated with the calling module. -subroutine close_column_diagnostics_units (diag_units) - -!--------------------------------------------------------------------- -! close_column_diagnostics_units closes any open column_diagnostics -! files associated with the calling module. -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- -integer, dimension(:), intent(in) :: diag_units !< array of column diagnostic unit numbers -!---------------------------------------------------------------------- - -!-------------------------------------------------------------------- -! intent(in) variable: -! -! diag_units array of column diagnostic unit numbers -! -!-------------------------------------------------------------------- - -!-------------------------------------------------------------------- -! local variable - - integer :: nn !< do loop index - integer :: io -!-------------------------------------------------------------------- -! close the unit associated with each diagnostic column. -!-------------------------------------------------------------------- - do nn=1, size(diag_units(:)) - if (diag_units(nn) /= -1) then - close(diag_units(nn), iostat=io ) - if(io/=0) call error_mesg('column_diagnostics_mod', 'Error in closing file ', FATAL) - endif - end do - -!--------------------------------------------------------------------- - - -end subroutine close_column_diagnostics_units - - -!##################################################################### - - - - - end module column_diagnostics_mod +end subroutine COLUMN_DIAGNOSTICS_HEADER_ !@} -! close documentation grouping diff --git a/column_diagnostics/include/column_diagnostics_r4.fh b/column_diagnostics/include/column_diagnostics_r4.fh new file mode 100644 index 0000000000..f8cdb30d9f --- /dev/null +++ b/column_diagnostics/include/column_diagnostics_r4.fh @@ -0,0 +1,34 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** +!> @file +!> @brief include file for column_diagnostics_mod to generate subroutine/functions +!! for r4_kind arguments + +#undef FMS_CD_KIND_ +#define FMS_CD_KIND_ r4_kind + +#undef INITIALIZE_DIAGNOSTIC_COLUMNS_ +#define INITIALIZE_DIAGNOSTIC_COLUMNS_ initialize_diagnostic_columns_r4 + +#undef COLUMN_DIAGNOSTICS_HEADER_ +#define COLUMN_DIAGNOSTICS_HEADER_ column_diagnostics_header_r4 + +#include "column_diagnostics.inc" + +!> @} diff --git a/column_diagnostics/include/column_diagnostics_r8.fh b/column_diagnostics/include/column_diagnostics_r8.fh new file mode 100644 index 0000000000..df0b4e2cf0 --- /dev/null +++ b/column_diagnostics/include/column_diagnostics_r8.fh @@ -0,0 +1,34 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** +!> @file +!> @brief include file for column_diagnostics_mod to generate subroutine/functions +!! for r8_kind arguments + +#undef FMS_CD_KIND_ +#define FMS_CD_KIND_ r8_kind + +#undef INITIALIZE_DIAGNOSTIC_COLUMNS_ +#define INITIALIZE_DIAGNOSTIC_COLUMNS_ initialize_diagnostic_columns_r8 + +#undef COLUMN_DIAGNOSTICS_HEADER_ +#define COLUMN_DIAGNOSTICS_HEADER_ column_diagnostics_header_r8 + +#include "column_diagnostics.inc" + +!> @} diff --git a/configure.ac b/configure.ac index d37a1a091d..f9617257cd 100644 --- a/configure.ac +++ b/configure.ac @@ -500,6 +500,7 @@ AC_CONFIG_FILES([ test_fms/diag_integral/Makefile test_fms/tracer_manager/Makefile test_fms/random_numbers/Makefile + test_fms/column_diagnostics/Makefile FMS.pc ]) diff --git a/test_fms/Makefile.am b/test_fms/Makefile.am index 31bf51999a..5fb203a3e5 100644 --- a/test_fms/Makefile.am +++ b/test_fms/Makefile.am @@ -28,7 +28,7 @@ ACLOCAL_AMFLAGS = -I m4 SUBDIRS = astronomy coupler diag_manager data_override exchange monin_obukhov drifters \ mosaic interpolator fms mpp mpp_io time_interp time_manager horiz_interp \ field_manager axis_utils affinity fms2_io parser string_utils sat_vapor_pres tracer_manager \ -random_numbers diag_integral +random_numbers diag_integral column_diagnostics # testing utility scripts to distribute diff --git a/test_fms/column_diagnostics/Makefile.am b/test_fms/column_diagnostics/Makefile.am new file mode 100644 index 0000000000..8c9f9b6d5a --- /dev/null +++ b/test_fms/column_diagnostics/Makefile.am @@ -0,0 +1,50 @@ +#*********************************************************************** +#* GNU Lesser General Public License +#* +#* This file is part of the GFDL Flexible Modeling System (FMS). +#* +#* FMS is free software: you can redistribute it and/or modify it under +#* the terms of the GNU Lesser General Public License as published by +#* the Free Software Foundation, either version 3 of the License, or (at +#* your option) any later version. +#* +#* FMS is distributed in the hope that it will be useful, but WITHOUT +#* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +#* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +#* for more details. +#* +#* You should have received a copy of the GNU Lesser General Public +#* License along with FMS. If not, see . +#*********************************************************************** + +# This is an automake file for the test_fms/time_manager directory of the FMS +# package. + + +# Find the fms_mod.mod file. +AM_CPPFLAGS = -I$(top_srcdir)/include -I$(MODDIR) + +# Link to the FMS library. +LDADD = $(top_builddir)/libFMS/libFMS.la + +# Build this test program. +check_PROGRAMS = test_column_diagnostics_r4 test_column_diagnostics_r8 + +# This is the source code for the test. +test_column_diagnostics_r4_SOURCES = test_column_diagnostics.F90 +test_column_diagnostics_r8_SOURCES = test_column_diagnostics.F90 + +test_column_diagnostics_r4_CPPFLAGS=-DTEST_CD_KIND_=4 -I$(AM_CPPFLAGS) +test_column_diagnostics_r8_CPPFLAGS=-DTEST_CD_KIND_=8 -I$(AM_CPPFLAGS) + +TEST_EXTENSIONS = .sh +SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) $(abs_top_srcdir)/test_fms/tap-driver.sh + +# Run the test program. +TESTS = test_column_diagnostics.sh + +# These files will be included in the distribution. +EXTRA_DIST = test_column_diagnostics.sh + +# Clean up +CLEANFILES = *.nml *.out* *.dpi *.spi *.dyn *.spl fort.* diff --git a/test_fms/column_diagnostics/test_column_diagnostics.F90 b/test_fms/column_diagnostics/test_column_diagnostics.F90 new file mode 100644 index 0000000000..cde97faa6f --- /dev/null +++ b/test_fms/column_diagnostics/test_column_diagnostics.F90 @@ -0,0 +1,191 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** +!> @file +!! @brief unit test for column_diagnostics_mod +!! @author MiKyung Lee +!! @email gfdl.climate.model.info@noaa.gov +!! @description This program mainly tests initialize_diagnostics_columns. +!! TODO: The current test only tests with 1 processor. A test that uses +!! domain decomposition is needed. +program test_column_diagnostics + + use column_diagnostics_mod + use fms_mod, only: fms_init + use mpp_mod, only: FATAL, mpp_error + use time_manager_mod, only: time_manager_init, time_type, set_time, set_calendar_type + use constants_mod, only : PI, DEG_TO_RAD + use platform_mod, only: r4_kind, r8_kind + + implicit none + + character(13), parameter :: mod_name='pemberley_mod' !< made up module name; Mr. Darcy's estate + integer, parameter :: num_diag_pts_latlon=2 !< number of diagnostics column described in terms of latlon coordinates + integer, parameter :: num_diag_pts_ij=2 !< number of diagnostics column describes in terms of i/j indices + integer :: global_i(num_diag_pts_ij) ! global i coordinates of the diagnostic column + integer :: global_j(num_diag_pts_ij) ! global j coordinates of the diagnostic column + real(TEST_CD_KIND_) :: global_lat_latlon(num_diag_pts_latlon)!< latitude value for the diagnostic column + real(TEST_CD_KIND_) :: global_lon_latlon(num_diag_pts_latlon)!< longitude value for the diagnostic columns + + integer, parameter :: nlatlon=6 !< number of latlon grid points + real(TEST_CD_KIND_) :: lonb_in(nlatlon,nlatlon) !< model longitude grid point + real(TEST_CD_KIND_) :: latb_in(nlatlon,nlatlon) !< model latitude point + logical :: do_column_diagnostics(nlatlon,nlatlon) !< out + + integer, parameter :: num_diag_pts=num_diag_pts_latlon + num_diag_pts_ij !< total number of diagnostics column + integer :: diag_i(num_diag_pts) !< out + integer :: diag_j(num_diag_pts) !< out + real(TEST_CD_KIND_) :: diag_lat(num_diag_pts) !< out + real(TEST_CD_KIND_) :: diag_lon(num_diag_pts) !< out + integer :: diag_units(num_diag_pts) + + integer, parameter :: lkind=TEST_CD_KIND_ !< local kind; either r4_kind or r8_kind + + call fms_init() + call time_manager_init() + call initialize_variables(0.0_lkind) !< set up input arrays + call column_diagnostics_init() !< initialize diagnostics column + call initialize_variables(0.01_lkind) !< set up input arrays; + call test_initialize_diagnostic_columns !< initialize diagnostics column + call test_column_diagnostics_header + +contains + !------------------------------------------! + subroutine initialize_variables(dlatlon) + + !> This subroutine initializes all the input arrays for intialize_diagnostic_columns + + implicit none + + real(lkind), intent(in) :: dlatlon !< in degrees; displace lat/lon grid by dlatlon + real(lkind) :: dlat, dlon + integer :: i + + !> lat lon coordinates in degrees; made up to match the diagnostic column coordinates +/- dlatlon + !! see initialize_diagnostic_columns. A-Grid coordinates + dlat=15.0_lkind !< randomly chosen value + dlon=15.0_lkind !< randomly chosen value + do i=1, nlatlon + lonb_in(i,:)=real(i,lkind)*dlat - 0.5_lkind*dlat + latb_in(:,i)=-90._lkind + real(i,lkind)*dlon -0.5_lkind*dlat + end do + + !> initialize_diagnostic_columns coordinates expects these values to be in degrees + global_lon_latlon(1)=lonb_in(2,1) + global_lon_latlon(2)=lonb_in(3,1) + global_lat_latlon(1)=latb_in(1,2) + global_lat_latlon(2)=latb_in(1,3) + global_i(1)=4 ; global_i(2)=5 + global_j(1)=4 ; global_j(2)=5 + + !> intialize_diagnostic_columns expects these values to be in radians + lonb_in=(lonb_in+dlatlon)*DEG_TO_RAD + latb_in=(latb_in+dlatlon)*DEG_TO_RAD + + + end subroutine initialize_variables + !------------------------------------------! + subroutine test_initialize_diagnostic_columns + + !> this subroutine tests intialize_diagnostics_columns + + implicit none + integer :: i + + integer :: i_answers(num_diag_pts), j_answers(num_diag_pts) + real(TEST_CD_KIND_) :: lon_answers(num_diag_pts), lat_answers(num_diag_pts) + + call initialize_diagnostic_columns(mod_name, num_diag_pts_latlon, num_diag_pts_ij, & + global_i, global_j, global_lat_latlon, global_lon_latlon, & + lonb_in, latb_in, do_column_diagnostics, & + diag_lon, diag_lat, diag_i, diag_j, diag_units) + + !> the edge points do not count + i_answers=(/2,3,4,5/) + j_answers=(/2,3,4,5/) + lon_answers=lonb_in(2:5,1)/DEG_TO_RAD + lat_answers=latb_in(1,2:5)/DEG_TO_RAD + + do i=1, num_diag_pts + call check_answers(i_answers(i), diag_i(i), 'test_initialize_diagnostics_column diag_i') + call check_answers(j_answers(i), diag_j(i), 'test_initialize_diagnostics_column diag_j') + call check_answers(lon_answers(i), diag_lon(i), 'test_initialize_diagnostics_column diag_lon') + call check_answers(lat_answers(i), diag_lat(i), 'test_initialize_diagnostics_column diag_lon') + end do + + end subroutine test_initialize_diagnostic_columns + !------------------------------------------! + subroutine test_column_diagnostics_header + + !> This subroutine only tests that column_diagnostics_header works + + implicit none + integer :: nn, diag_unit + type(time_type) :: Time + + diag_unit=45 !< will produce fort.45 file + call set_calendar_type(2) + Time=set_time(12,14,1) + do nn=1, num_diag_pts + call column_diagnostics_header(mod_name, diag_unit, Time, nn, diag_lon, diag_lat, diag_i, diag_j) + end do + + end subroutine test_column_diagnostics_header + !------------------------------------------! + subroutine check_answers(answer, myvalue, whoami) + + implicit none + class(*) :: answer + class(*) :: myvalue + character(*) :: whoami + + select type(answer) + type is ( integer ) + select type(myvalue) + type is( integer ) + if( answer .ne. myvalue ) then + write(*,*) '*************************************' + write(*,*) 'EXPECTED ', answer, 'but got ', myvalue + call mpp_error( FATAL,'failed '//trim(whoami) ) + end if + end select + type is( real(r4_kind) ) + select type( myvalue) + type is(real(r4_kind) ) + if( answer .ne. myvalue ) then + write(*,*) '*************************************' + write(*,*) 'EXPECTED ', answer, 'but got ', myvalue + write(*,*) 'difference of', abs(answer-myvalue) + call mpp_error( FATAL,'failed '//trim(whoami) ) + end if + end select + type is( real(r8_kind) ) + select type( myvalue) + type is(real(r4_kind) ) + if( answer .ne. myvalue ) then + write(*,*) '*************************************' + write(*,*) 'EXPECTED ', answer, 'but got ', myvalue + write(*,*) 'difference of', abs(answer-myvalue) + call mpp_error( FATAL,'failed '//trim(whoami) ) + end if + end select + end select + + end subroutine check_answers + !------------------------------------------! +end program test_column_diagnostics diff --git a/test_fms/column_diagnostics/test_column_diagnostics.sh b/test_fms/column_diagnostics/test_column_diagnostics.sh new file mode 100755 index 0000000000..909a539bfb --- /dev/null +++ b/test_fms/column_diagnostics/test_column_diagnostics.sh @@ -0,0 +1,29 @@ +#* the Free Software Foundation, either version 3 of the License, or (at +#* your option) any later version. +#* +#* FMS is distributed in the hope that it will be useful, but WITHOUT +#* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +#* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +#* for more details. +#* +#* You should have received a copy of the GNU Lesser General Public +#* License along with FMS. If not, see . +#*********************************************************************** + +# This is part of the GFDL FMS package. This is a shell script to +# execute tests in the test_fms/horiz_interp directory. + +# Copyright 2021 Seth Underwood + +# Set common test settings. +. ../test-lib.sh + +# Prepare the directory to run the tests. +cat << EOF > input.nml +EOF + + +##### +test_expect_success "test_column_diagnostics r4" 'mpirun -n 1 ./test_column_diagnostics_r4' +test_expect_success "test_column_diagnostics r8" 'mpirun -n 1 ./test_column_diagnostics_r8' +test_done