sat_vapor_pres/sat_vapor_pres_k.F90

   1 !***********************************************************************
   2 !*                   GNU Lesser General Public License
   3 !*
   4 !* This file is part of the GFDL Flexible Modeling System (FMS).
   5 !*
   6 !* FMS is free software: you can redistribute it and/or modify it under
   7 !* the terms of the GNU Lesser General Public License as published by
   8 !* the Free Software Foundation, either version 3 of the License, or (at
   9 !* your option) any later version.
  10 !*
  11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
  12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 !* FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 !* for more details.
  15 !*
  16 !* You should have received a copy of the GNU Lesser General Public
  17 !* License along with FMS.  If not, see <http://www.gnu.org/licenses/>.
  18 !***********************************************************************
  19 !> @defgroup sat_vapor_pres_k_mod sat_vapor_pres_k_mod
  20 !> @ingroup sat_vapor_pres
  21 !> @brief Kernel module to be used by @ref sat_vapor_pres_mod for
  22 !! table lookups and calculations
  23
  24  module sat_vapor_pres_k_mod
  25
  26 ! This module is what I (pjp) think a kernel should be.
  27 ! There have been many proposals as to what a kernel should look like.
  28 ! If fact, so many different ideas have been expressed that the lack
  29 ! of agreement has greatly hampered progress.
  30 ! The only way to move forward is to limit the requirments for a kernel
  31 ! to only what is widely agreeded upon.
  32 ! I believe that there are only two things widely agreeded upon.
  33
  34 ! 1) A kernel should be independent of the rest of FMS so that it can
  35 !    easily be ported into another programming system.
  36 !    This requires that a kernel does not access anything by use association.
  37 !    The one exception is this kernel, because it is not practical for physics
  38 !    modules to avoid using a module that computes the saturation vapor
  39 !    pressure of water vapor.
  40
  41 ! 2) For the sake of thread safety, module globals should be written only at initialization.
  42 !    In this case, the module globals are the tables and a handful of scalars.
  43
  44 ! 3) A kernel should not read from an external file.
  45
  46 ! One of the things that was not widely agreeded upon is that a kernel should
  47 ! not be a fortran module. This complicates things greatly for questionable
  48 ! benefit and could be done as a second step anyway, if necessary.
  49
  50  use fms_mod, only: error_mesg, FATAL
  51  use platform_mod, only : r4_kind, r8_kind
  52
  53  implicit none
  54  private
  55
  56 ! Include variable "version" to be written to log file.
  57 #include<file_version.h>
  58
  59  public :: sat_vapor_pres_init_k
  60  public :: lookup_es_k
  61  public :: lookup_des_k
  62  public :: lookup_es_des_k
  63  public :: lookup_es2_k
  64  public :: lookup_des2_k
  65  public :: lookup_es2_des2_k
  66  public :: lookup_es3_k
  67  public :: lookup_des3_k
  68  public :: lookup_es3_des3_k
  69  public :: compute_qs_k
  70  public :: compute_mrs_k
  71
  72  !> @ingroup sat_vapor_pres_k_mod
  73  interface sat_vapor_pres_init_k
  74     module procedure sat_vapor_pres_init_k_r4
  75     module procedure sat_vapor_pres_init_k_r8
  76  end interface sat_vapor_pres_init_k
  77
  78  !> @ingroup sat_vapor_pres_k_mod
  79  interface compute_es_k
  80     module procedure compute_es_k_r4
  81     module procedure compute_es_k_r8
  82  end interface compute_es_k
  83
  84  interface compute_es_liq_k
  85     module procedure compute_es_liq_k_r4
  86     module procedure compute_es_liq_k_r8
  87  end interface compute_es_liq_k
  88
  89  interface compute_es_liq_ice_k
  90     module procedure compute_es_liq_ice_k_r4
  91     module procedure compute_es_liq_ice_k_r8
  92  end interface compute_es_liq_ice_k
  93
  94  !> @ingroup sat_vapor_pres_k_mod
  95  interface lookup_es_k
  96    module procedure lookup_es_k_0d_r4
  97    module procedure lookup_es_k_0d_r8
  98    module procedure lookup_es_k_1d_r4
  99    module procedure lookup_es_k_1d_r8
 100    module procedure lookup_es_k_2d_r4
 101    module procedure lookup_es_k_2d_r8
 102    module procedure lookup_es_k_3d_r4
 103    module procedure lookup_es_k_3d_r8
 104  end interface
 105
 106  !> @ingroup sat_vapor_pres_k_mod
 107  interface lookup_des_k
 108    module procedure lookup_des_k_0d_r4
 109    module procedure lookup_des_k_0d_r8
 110    module procedure lookup_des_k_1d_r4
 111    module procedure lookup_des_k_1d_r8
 112    module procedure lookup_des_k_2d_r4
 113    module procedure lookup_des_k_2d_r8
 114    module procedure lookup_des_k_3d_r4
 115    module procedure lookup_des_k_3d_r8
 116  end interface
 117
 118  !> @ingroup sat_vapor_pres_k_mod
 119  interface lookup_es_des_k
 120    module procedure lookup_es_des_k_0d_r4
 121    module procedure lookup_es_des_k_0d_r8
 122    module procedure lookup_es_des_k_1d_r4
 123    module procedure lookup_es_des_k_1d_r8
 124    module procedure lookup_es_des_k_2d_r4
 125    module procedure lookup_es_des_k_2d_r8
 126    module procedure lookup_es_des_k_3d_r4
 127    module procedure lookup_es_des_k_3d_r8
 128  end interface
 129
 130  !> @ingroup sat_vapor_pres_k_mod
 131  interface lookup_es2_k
 132    module procedure lookup_es2_k_0d_r4
 133    module procedure lookup_es2_k_0d_r8
 134    module procedure lookup_es2_k_1d_r4
 135    module procedure lookup_es2_k_1d_r8
 136    module procedure lookup_es2_k_2d_r4
 137    module procedure lookup_es2_k_2d_r8
 138    module procedure lookup_es2_k_3d_r4
 139    module procedure lookup_es2_k_3d_r8
 140  end interface
 141
 142  !> @ingroup sat_vapor_pres_k_mod
 143  interface lookup_des2_k
 144    module procedure lookup_des2_k_0d_r4
 145    module procedure lookup_des2_k_0d_r8
 146    module procedure lookup_des2_k_1d_r4
 147    module procedure lookup_des2_k_1d_r8
 148    module procedure lookup_des2_k_2d_r4
 149    module procedure lookup_des2_k_2d_r8
 150    module procedure lookup_des2_k_3d_r4
 151    module procedure lookup_des2_k_3d_r8
 152  end interface
 153
 154  !> @ingroup sat_vapor_pres_k_mod
 155  interface lookup_es2_des2_k
 156    module procedure lookup_es2_des2_k_0d_r4
 157    module procedure lookup_es2_des2_k_0d_r8
 158    module procedure lookup_es2_des2_k_1d_r4
 159    module procedure lookup_es2_des2_k_1d_r8
 160    module procedure lookup_es2_des2_k_2d_r4
 161    module procedure lookup_es2_des2_k_2d_r8
 162    module procedure lookup_es2_des2_k_3d_r4
 163    module procedure lookup_es2_des2_k_3d_r8
 164  end interface
 165
 166  !> @ingroup sat_vapor_pres_k_mod
 167  interface lookup_es3_k
 168    module procedure lookup_es3_k_0d_r4
 169    module procedure lookup_es3_k_0d_r8
 170    module procedure lookup_es3_k_1d_r4
 171    module procedure lookup_es3_k_1d_r8
 172    module procedure lookup_es3_k_2d_r4
 173    module procedure lookup_es3_k_2d_r8
 174    module procedure lookup_es3_k_3d_r4
 175    module procedure lookup_es3_k_3d_r8
 176  end interface
 177
 178  !> @ingroup sat_vapor_pres_k_mod
 179  interface lookup_des3_k
 180    module procedure lookup_des3_k_0d_r4
 181    module procedure lookup_des3_k_0d_r8
 182    module procedure lookup_des3_k_1d_r4
 183    module procedure lookup_des3_k_1d_r8
 184    module procedure lookup_des3_k_2d_r4
 185    module procedure lookup_des3_k_2d_r8
 186    module procedure lookup_des3_k_3d_r4
 187    module procedure lookup_des3_k_3d_r8
 188  end interface
 189
 190  !> @ingroup sat_vapor_pres_k_mod
 191  interface lookup_es3_des3_k
 192    module procedure lookup_es3_des3_k_0d_r4
 193    module procedure lookup_es3_des3_k_0d_r8
 194    module procedure lookup_es3_des3_k_1d_r4
 195    module procedure lookup_es3_des3_k_1d_r8
 196    module procedure lookup_es3_des3_k_2d_r4
 197    module procedure lookup_es3_des3_k_2d_r8
 198    module procedure lookup_es3_des3_k_3d_r4
 199    module procedure lookup_es3_des3_k_3d_r8
 200  end interface
 201
 202  !> @ingroup sat_vapor_pres_k_mod
 203  interface compute_qs_k
 204    module procedure compute_qs_k_0d_r4
 205    module procedure compute_qs_k_0d_r8
 206    module procedure compute_qs_k_1d_r4
 207    module procedure compute_qs_k_1d_r8
 208    module procedure compute_qs_k_2d_r4
 209    module procedure compute_qs_k_2d_r8
 210    module procedure compute_qs_k_3d_r4
 211    module procedure compute_qs_k_3d_r8
 212  end interface
 213  !> @ingroup sat_vapor_pres_k_mod
 214  interface compute_mrs_k
 215    module procedure compute_mrs_k_0d_r4
 216    module procedure compute_mrs_k_0d_r8
 217    module procedure compute_mrs_k_1d_r4
 218    module procedure compute_mrs_k_1d_r8
 219    module procedure compute_mrs_k_2d_r4
 220    module procedure compute_mrs_k_2d_r8
 221    module procedure compute_mrs_k_3d_r4
 222    module procedure compute_mrs_k_3d_r8
 223  end interface compute_mrs_k
 224
 225 !> @addtogroup sat_vapor_pres_k_mod
 226 !> @{
 227
 228  real(kind=r8_kind) :: dtres, tepsl, tminl, dtinvl
 229  integer :: table_siz
 230  real(kind=r8_kind), dimension(:), allocatable :: TABLE   !  sat vapor pres (es)
 231  real(kind=r8_kind), dimension(:), allocatable :: DTABLE  !  first derivative of es
 232  real(kind=r8_kind), dimension(:), allocatable :: D2TABLE ! second derivative of es
 233  real(kind=r8_kind), dimension(:), allocatable :: TABLE2  !  sat vapor pres (es)
 234  real(kind=r8_kind), dimension(:), allocatable :: DTABLE2 !  first derivative of es
 235  real(kind=r8_kind), dimension(:), allocatable :: D2TABLE2 ! second derivative of es
 236  real(kind=r8_kind), dimension(:), allocatable :: TABLE3  !  sat vapor pres (es)
 237  real(kind=r8_kind), dimension(:), allocatable :: DTABLE3 !  first derivative of es
 238  real(kind=r8_kind), dimension(:), allocatable :: D2TABLE3 ! second derivative of es
 239
 240  logical  :: use_exact_qs
 241  logical  :: module_is_initialized = .false.
 242
 243  contains
 244
 245 !#######################################################################
 246 !#######################################################################
 247
 248 #include "sat_vapor_pres_k_r4.fh"
 249 #include "sat_vapor_pres_k_r8.fh"
 250
 251  end module sat_vapor_pres_k_mod
 252 !> @}
 253 ! close documentation grouping