Fms mixedmode

CMakeLists.txt

@@ -100,6 +100,8 @@ list(APPEND fms_fortran_src_files
   column_diagnostics/column_diagnostics.F90
   constants/constants.F90
   constants/fmsconstants.F90
+  constants4/constants4.F90
+  constants4/fmsconstants4.F90
   coupler/atmos_ocean_fluxes.F90
   coupler/coupler_types.F90
   coupler/ensemble_manager.F90

constants4/constants4.F90

@@ -0,0 +1,176 @@
+!***********************************************************************
+!*                   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 <http://www.gnu.org/licenses/>.
+!***********************************************************************
+!> @defgroup constants_mod constants_mod
+!> @ingroup constants
+!> @brief Defines useful constants for Earth. Constants are defined as real
+!!   parameters. Constants are accessed through the "use" statement.
+!> @author Bin Li
+!!
+!>    Constants have been declared as type REAL, PARAMETER.
+!!
+!!    The value a constant can not be changed in a users program.
+!!    New constants can be defined in terms of values from the
+!!    constants module using a parameter statement.<br><br>
+!!
+!!    The name given to a particular constant may be changed.<br><br>
+!!
+!!    Constants can be used on the right side on an assignment statement
+!!    (their value can not be reassigned).
+!!
+!!    Example:
+!!
+!! @verbatim
+!!    use constants_mod, only:  TFREEZE, grav_new => GRAV
+!!    real, parameter :: grav_inv = 1.0 / grav_new
+!!    tempc(:,:,:) = tempk(:,:,:) - TFREEZE
+!!    geopotential(:,:) = height(:,:) * grav_new
+!! @endverbatim
+
+!> @file
+!> @brief File for @ref constants_mod
+
+!> @addtogroup constants_mod
+!> @{
+module constantsR4_mod
+
+!---variable for strong typing grid parameters
+use platform_mod, only: r8_kind, r4_kind
+implicit none
+private
+
+! Include variable "version" to be written to log file.
+#include<file_version.h>
+!-----------------------------------------------------------------------
+! version is public so that write_version_number can be called for constants_mod
+! by fms_init
+public :: version
+
+real(r4_kind) :: realnumber !< dummy variable to use in HUGE initializations
+
+!! The small_fac parameter is used to alter the radius of the earth to allow one to
+!! examine non-hydrostatic effects without the need to run full-earth high-resolution
+!! simulations (<13km) that will tax hardware resources.
+#ifdef SMALL_EARTH
+#if defined(DCMIP) || (defined(HIWPP) && defined(SUPER_K))
+ real(r4_kind), public, parameter :: small_fac =  1._r8_kind / 120._r8_kind !< Real(kind=4) variant of small_fac defined in constants/constants.F90
+#elif defined(HIWPP)
+ real(r4_kind), public, parameter :: small_fac = 1._r8_kind / 166.7_r8_kind !< Real(kind=4) variant of small_fac defined in constants/constants.F90
+#else
+ real(r4_kind), public, parameter :: small_fac = 1._r8_kind / 10._r8_kind   !< Real(kind=4) variant of small_fac defined in constants/constants.F90
+#endif
+#else
+ real(r4_kind), public, parameter :: small_fac = 1._r8_kind                 !< Real(kind=4) variant of small_fac defined in constants/constants.F90
+#endif
+
+#ifdef GFS_PHYS
+! SJL: the following are from fv3_gfsphysics/gfs_physics/physics/physcons.f90
+real(r4_kind),               public, parameter :: RADIUS = 6.3712e+6_r8_kind * small_fac !< Radius of the Earth [m]
+real(kind=r8_kind), public, parameter :: PI_8   = 3.1415926535897931_r8_kind    !< Ratio of circle circumference to diameter [N/A]
+real(r4_kind),               public, parameter :: PI     = 3.1415926535897931_r8_kind    !< Ratio of circle circumference to diameter [N/A]
+real(r4_kind),               public, parameter :: OMEGA  = 7.2921e-5_r8_kind / small_fac !< Rotation rate of the Earth [1/s]
+real(r4_kind),               public, parameter :: GRAV   = 9.80665_r8_kind     !< Acceleration due to gravity [m/s^2]
+real(kind=r8_kind), public, parameter :: GRAV_8 = 9.80665_r8_kind     !< Acceleration due to gravity [m/s^2] (REAL(KIND=8))
+real(r4_kind),               public, parameter :: RDGAS  = 287.05_r8_kind      !< Gas constant for dry air [J/kg/deg]
+real(r4_kind),               public, parameter :: RVGAS  = 461.50_r8_kind      !< Gas constant for water vapor [J/kg/deg]
+! Extra:
+real(r4_kind),              public, parameter :: HLV      = 2.5e6_r8_kind     !< Latent heat of evaporation [J/kg]
+real(r4_kind),               public, parameter :: HLF      = 3.3358e5_r8_kind  !< Latent heat of fusion [J/kg]
+real(r4_kind),               public, parameter :: con_cliq = 4.1855e+3_r8_kind !< spec heat H2O liq [J/kg/K]
+real(r4_kind),               public, parameter :: con_csol = 2.1060e+3_r8_kind !< spec heat H2O ice [J/kg/K]
+real(r4_kind),               public, parameter :: CP_AIR = 1004.6_r8_kind      !< Specific heat capacity of dry air at constant pressure [J/kg/deg]
+real(r4_kind),               public, parameter :: KAPPA  = RDGAS/CP_AIR        !< RDGAS / CP_AIR [dimensionless]
+real(r4_kind),               public, parameter :: TFREEZE = 273.15_r8_kind     !< Freezing temperature of fresh water [K]
+
+#else
+
+real(r4_kind),         public, parameter :: RADIUS = 6371.0e+3_r8_kind * small_fac   !< Radius of the Earth [m]
+real(kind=8), public, parameter :: PI_8   = 3.14159265358979323846_r8_kind  !< Ratio of circle circumference to diameter [N/A]
+real(r4_kind),         public, parameter :: PI     = 3.14159265358979323846_r8_kind  !< Ratio of circle circumference to diameter [N/A]
+real(r4_kind),         public, parameter :: OMEGA  = 7.292e-5_r8_kind / small_fac    !< Rotation rate of the Earth [1/s]
+real(r4_kind),         public, parameter :: GRAV   = 9.80_r8_kind             !< Acceleration due to gravity [m/s^2]
+real(r4_kind),         public, parameter :: RDGAS  = 287.04_r8_kind           !< Gas constant for dry air [J/kg/deg]
+real(r4_kind),         public, parameter :: RVGAS  = 461.50_r8_kind           !< Gas constant for water vapor [J/kg/deg]
+! Extra:
+real(r4_kind),         public, parameter :: HLV = 2.500e6_r8_kind             !< Latent heat of evaporation [J/kg]
+real(r4_kind),         public, parameter :: HLF = 3.34e5_r8_kind              !< Latent heat of fusion [J/kg]
+real(r4_kind),         public, parameter :: KAPPA  = 2.0_r8_kind/7.0_r8_kind  !< RDGAS / CP_AIR [dimensionless]
+real(r4_kind),         public, parameter :: CP_AIR = RDGAS/KAPPA              !< Specific heat capacity of dry air at constant pressure [J/kg/deg]
+real(r4_kind),         public, parameter :: TFREEZE = 273.16_r8_kind          !< Freezing temperature of fresh water [K]
+#endif
+
+real(r4_kind), public, parameter :: STEFAN  = 5.6734e-8_r8_kind !< Stefan-Boltzmann constant [W/m^2/deg^4]
+
+real(r4_kind), public, parameter :: CP_VAPOR = 4.0_r8_kind*RVGAS      !< Specific heat capacity of water vapor at constant pressure [J/kg/deg]
+real(r4_kind), public, parameter :: CP_OCEAN = 3989.24495292815_r8_kind !< Specific heat capacity taken from McDougall (2002)
+                                                               !! "Potential Enthalpy ..." [J/kg/deg]
+real(r4_kind), public, parameter :: RHO0    = 1.035e3_r8_kind  !< Average density of sea water [kg/m^3]
+real(r4_kind), public, parameter :: RHO0R   = 1.0_r8_kind/RHO0 !< Reciprocal of average density of sea water [m^3/kg]
+real(r4_kind), public, parameter :: RHO_CP  = RHO0*CP_OCEAN    !< (kg/m^3)*(cal/kg/deg C)(joules/cal) = (joules/m^3/deg C) [J/m^3/deg]
+
+real(r4_kind), public, parameter :: ES0 = 1.0_r8_kind        !< Humidity factor. Controls the humidity content of the atmosphere through
+                                                    !! the Saturation Vapour Pressure expression when using DO_SIMPLE. [dimensionless]
+real(r4_kind), public, parameter :: DENS_H2O = 1000._r8_kind !< Density of liquid water [kg/m^3]
+real(r4_kind), public, parameter :: HLS = HLV + HLF          !< Latent heat of sublimation [J/kg]
+
+real(r4_kind), public, parameter :: WTMAIR   = 2.896440E+01_r8_kind   !< Molecular weight of air [AMU]
+real(r4_kind), public, parameter :: WTMH2O   = WTMAIR*(RDGAS/RVGAS)   !< Molecular weight of water [AMU]
+real(r4_kind), public, parameter :: WTMOZONE =  47.99820_r8_kind      !< Molecular weight of ozone [AMU]
+real(r4_kind), public, parameter :: WTMC     =  12.00000_r8_kind      !< Molecular weight of carbon [AMU]
+real(r4_kind), public, parameter :: WTMCO2   =  44.00995_r8_kind      !< Molecular weight of carbon dioxide [AMU]
+real(r4_kind), public, parameter :: WTMCH4   =  16.0425_r8_kind       !< Molecular weight of methane [AMU]
+real(r4_kind), public, parameter :: WTMO2    =  31.9988_r8_kind       !< Molecular weight of molecular oxygen [AMU]
+real(r4_kind), public, parameter :: WTMCFC11 = 137.3681_r8_kind       !< Molecular weight of CFC-11 (CCl3F) [AMU]
+real(r4_kind), public, parameter :: WTMCFC12 = 120.9135_r8_kind       !< Molecular weight of CFC-21 (CCl2F2) [AMU]
+real(r4_kind), public, parameter :: WTMN     =  14.0067_r8_kind       !< Molecular weight of Nitrogen [AMU]
+real(r4_kind), public, parameter :: DIFFAC   = 1.660000E+00_r8_kind   !< Diffusivity factor [dimensionless]
+real(r4_kind), public, parameter :: AVOGNO   = 6.023000E+23_r8_kind   !< Avogadro's number [atoms/mole]
+real(r4_kind), public, parameter :: PSTD     = 1.013250E+06_r8_kind   !< Mean sea level pressure [dynes/cm^2]
+real(r4_kind), public, parameter :: PSTD_MKS = 101325.0_r8_kind       !< Mean sea level pressure [N/m^2]
+
+real(r4_kind), public, parameter :: SECONDS_PER_DAY    = 8.640000E+04_r8_kind !< Seconds in a day [s]
+real(r4_kind), public, parameter :: SECONDS_PER_HOUR   = 3600._r8_kind        !< Seconds in an hour [s]
+real(r4_kind), public, parameter :: SECONDS_PER_MINUTE = 60._r8_kind          !< Seconds in a minute [s]
+real(r4_kind), public, parameter :: RAD_TO_DEG         = 180._r8_kind/PI      !< Degrees per radian [deg/rad]
+real(r4_kind), public, parameter :: DEG_TO_RAD         = PI/180._r8_kind      !< Radians per degree [rad/deg]
+real(r4_kind), public, parameter :: RADIAN             = RAD_TO_DEG           !< Equal to RAD_TO_DEG for backward compatability. [rad/deg]
+real(r4_kind), public, parameter :: ALOGMIN            = -50.0_r8_kind        !< Minimum value allowed as argument to log function [N/A]
+real(r4_kind), public, parameter :: EPSLN              = 1.0e-40_r8_kind      !< A small number to prevent divide by zero exceptions [N/A]
+
+real(r4_kind), public, parameter :: RADCON = ((1.0E+02*GRAV)/(1.0E+04*CP_AIR))*SECONDS_PER_DAY !< Factor used to convert flux divergence to
+                                                                                      !! heating rate in degrees per day [deg sec/(cm day)]
+real(r4_kind), public, parameter :: RADCON_MKS  = (GRAV/CP_AIR)*SECONDS_PER_DAY !< Factor used to convert flux divergence to
+                                                                       !! heating rate in degrees per day [deg sec/(m day)]
+real(r4_kind), public, parameter :: O2MIXRAT    = 2.0953E-01_r8_kind !< Mixing ratio of molecular oxygen in air [dimensionless]
+real(r4_kind), public, parameter :: RHOAIR      = 1.292269_r8_kind   !< Reference atmospheric density [kg/m^3]
+real(r4_kind), public, parameter :: VONKARM     = 0.40_r8_kind       !< Von Karman constant [dimensionless]
+real(r4_kind), public, parameter :: C2DBARS     = 1.e-4_r8_kind      !< Converts rho*g*z (in mks) to dbars: 1dbar = 10^4 (kg/m^3)(m/s^2)m [dbars]
+real(r4_kind), public, parameter :: KELVIN      = 273.15_r8_kind     !< Degrees Kelvin at zero Celsius [K]
+
+public :: constants_init
+
+contains
+
+!> @brief dummy routine.
+subroutine constants_init
+
+end subroutine constants_init
+
+end module constantsR4_mod
+!> @}
+! close documentation grouping

constants4/fmsconstants4.F90

@@ -0,0 +1,32 @@
+!***********************************************************************
+!*                   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 <http://www.gnu.org/licenses/>.
+!***********************************************************************
+!> @defgroup fmsconstants FMSconstants
+!> @ingroup libfms
+!> @brief Essentially a copy of @ref constants_mod for external usage alongside
+!! @ref libfms.
+!!
+!> See @ref constants_mod for individual parameter information.
+module FMSconstantsR4
+
+  !> rename to not conflict with any other version vars
+  use constantsR4_mod, version_constants => version
+
+  implicit none
+
+end module FMSconstantsR4

diag_manager/diag_axis.F90

@@ -113,7 +113,7 @@ MODULE diag_axis_mod
   INTEGER FUNCTION diag_axis_init(name, DATA, units, cart_name, long_name, direction,&
        & set_name, edges, Domain, Domain2, DomainU, aux, req, tile_count, domain_position )
     CHARACTER(len=*), INTENT(in) :: name !< Short name for axis
-    REAL, DIMENSION(:), INTENT(in) :: DATA !< Array of coordinate values
+    CLASS(*), DIMENSION(:), INTENT(in) :: DATA !< Array of coordinate values
     CHARACTER(len=*), INTENT(in) :: units !< Units for the axis
     CHARACTER(len=*), INTENT(in) :: cart_name !< Cartesian axis ("X", "Y", "Z", "T")
     CHARACTER(len=*), INTENT(in), OPTIONAL :: long_name !< Long name for the axis.
@@ -231,7 +231,15 @@ INTEGER FUNCTION diag_axis_init(name, DATA, units, cart_name, long_name, directi
 
     ! Initialize Axes(diag_axis_init)
     Axes(diag_axis_init)%name   = TRIM(name)
-    Axes(diag_axis_init)%data   = DATA(1:axlen)
+    SELECT TYPE (DATA)
+    TYPE IS (real(kind=r4_kind))
+       Axes(diag_axis_init)%data = DATA(1:axlen)
+    TYPE IS (real(kind=r8_kind))
+       Axes(diag_axis_init)%data = real(DATA(1:axlen))
+    CLASS DEFAULT
+       CALL error_mesg('diag_axis_mod::diag_axis_init',&
+            & 'The axis data is not one of the supported types of real(kind=4) or real(kind=8)', FATAL)
+    END SELECT
     Axes(diag_axis_init)%units  = units
     Axes(diag_axis_init)%length = axlen
     Axes(diag_axis_init)%set    = set
@@ -460,7 +468,7 @@ SUBROUTINE get_diag_axis(id, name, units, long_name, cart_name,&
     INTEGER, INTENT(out) :: direction !< Direction of data. (See <TT>@ref diag_axis_init</TT> for a description of
                                       !! allowed values)
     INTEGER, INTENT(out) :: edges !< Axis ID for the previously defined "edges axis".
-    REAL, DIMENSION(:), INTENT(out) :: DATA !< Array of coordinate values for this axis.
+    CLASS(*), DIMENSION(:), INTENT(out) :: DATA !< Array of coordinate values for this axis.
     INTEGER, INTENT(out), OPTIONAL :: num_attributes
     TYPE(diag_atttype), ALLOCATABLE, DIMENSION(:), INTENT(out), OPTIONAL :: attributes
     INTEGER, INTENT(out), OPTIONAL :: domain_position
@@ -481,7 +489,15 @@ SUBROUTINE get_diag_axis(id, name, units, long_name, cart_name,&
        ! <ERROR STATUS="FATAL">array data is too small.</ERROR>
        CALL error_mesg('diag_axis_mod::get_diag_axis', 'array data is too small', FATAL)
     ELSE
-       DATA(1:Axes(id)%length) = Axes(id)%data(1:Axes(id)%length)
+       SELECT TYPE (DATA)
+       TYPE IS (real(kind=r4_kind))
+          DATA(1:Axes(id)%length) = real(Axes(id)%data(1:Axes(id)%length), kind=r4_kind)
+       TYPE IS (real(kind=r8_kind))
+          DATA(1:Axes(id)%length) = Axes(id)%data(1:Axes(id)%length)
+       CLASS DEFAULT
+          CALL error_mesg('diag_axis_mod::get_diag_axis',&
+               & 'The axis data is not one of the supported types of real(kind=4) or real(kind=8)', FATAL)
+       END SELECT
     END IF
     IF ( PRESENT(num_attributes) ) THEN
        num_attributes = Axes(id)%num_attributes