FMS  2024.03
Flexible Modeling System
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
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 
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
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
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
subroutine, public error_mesg(routine, message, level)
Print notes, warnings and error messages; terminates program for warning and error messages....
Definition: fms.F90:498