FMS  2024.03
Flexible Modeling System
sat_vapor_pres.inc
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 !> @addtogroup sat_vapor_pres_mod
20 !> @{
21 
22 !#######################################################################
23 ! <SUBROUTINE NAME="lookup_es_0d" INTERFACE="lookup_es">
24 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
25 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
26 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
27 ! </SUBROUTINE>
28  subroutine lookup_es_0d_ ( temp, esat, err_msg )
29 
30  real(kind=fms_svp_kind_), intent(in) :: temp !< temperature in degrees Kelvin (K)
31  real(kind=fms_svp_kind_), intent(out) :: esat !< saturation vapor pressure
32  character(len=*), intent(out), optional :: err_msg
33 
34  integer :: nbad !< if temperature is out of range
35  character(len=128) :: err_msg_local
36 
37  if (.not.module_is_initialized) then
38  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
39  endif
40 
41  call lookup_es_k(temp, esat, nbad)
42 
43  if ( nbad == 0 ) then
44  if(present(err_msg)) err_msg = ''
45  else
46  if(show_all_bad_values) call show_all_bad ( temp )
47  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
48  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
49  endif
50 
51  end subroutine lookup_es_0d_
52 
53 !#######################################################################
54 
55 ! <SUBROUTINE NAME="lookup_es_1d" INTERFACE="lookup_es">
56 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
57 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
58 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
59 ! </SUBROUTINE>
60  subroutine lookup_es_1d_ ( temp, esat, err_msg )
61 
62  real(kind=fms_svp_kind_), intent(in) :: temp(:) !< temperature in degrees Kelvin (K)
63  real(kind=fms_svp_kind_), intent(out) :: esat(:) !< saturation vapor pressure
64  character(len=*), intent(out), optional :: err_msg
65 
66  character(len=54) :: err_msg_local
67  integer :: nbad !< if temperature is out of range
68 !-----------------------------------------------
69 
70  if (.not.module_is_initialized) then
71  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
72  endif
73 
74  call lookup_es_k(temp, esat, nbad)
75 
76  if ( nbad == 0 ) then
77  if(present(err_msg)) err_msg = ''
78  else
79  if(show_bad_value_count_by_slice) call temp_check ( temp )
80  if(show_all_bad_values) call show_all_bad ( temp )
81  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
82  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
83  endif
84 
85 !-----------------------------------------------
86 
87  end subroutine lookup_es_1d_
88 
89 !#######################################################################
90 
91 ! <SUBROUTINE NAME="lookup_es_2d" INTERFACE="lookup_es">
92 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
93 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
94 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
95 ! </SUBROUTINE>
96  subroutine lookup_es_2d_ ( temp, esat, err_msg )
97 
98  real(kind=fms_svp_kind_), intent(in) :: temp(:,:) !< temperature in degrees Kelvin (K)
99  real(kind=fms_svp_kind_), intent(out) :: esat(:,:) !< saturation vapor pressure
100  character(len=*), intent(out), optional :: err_msg
101 
102  character(len=54) :: err_msg_local
103  integer :: nbad !< if temperature is out of range
104 !-----------------------------------------------
105 
106  if (.not.module_is_initialized) then
107  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
108  endif
109 
110  call lookup_es_k(temp, esat, nbad)
111 
112  if ( nbad == 0 ) then
113  if(present(err_msg)) err_msg = ''
114  else
115  if(show_bad_value_count_by_slice) call temp_check ( temp )
116  if(show_all_bad_values) call show_all_bad ( temp )
117  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
118  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
119  endif
120 
121 !-----------------------------------------------
122 
123  end subroutine lookup_es_2d_
124 
125 !#######################################################################
126 
127 ! <SUBROUTINE NAME="lookup_es_3d" INTERFACE="lookup_es">
128 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
129 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
130 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
131 ! </SUBROUTINE>
132  subroutine lookup_es_3d_ ( temp, esat, err_msg )
133 
134  real(kind=fms_svp_kind_), intent(in) :: temp(:,:,:) !< temperature in degrees Kelvin (K)
135  real(kind=fms_svp_kind_), intent(out) :: esat(:,:,:) !< saturation vapor pressure
136  character(len=*), intent(out), optional :: err_msg
137 
138  integer :: nbad !< if temperature is out of range
139  character(len=128) :: err_msg_tmp
140 
141  if (.not.module_is_initialized) then
142  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
143  endif
144 
145  call lookup_es_k(temp, esat, nbad)
146 
147  if ( nbad == 0 ) then
148  if(present(err_msg)) err_msg = ''
149  else
150  if(show_bad_value_count_by_slice) call temp_check ( temp )
151  if(show_all_bad_values) call show_all_bad ( temp )
152  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
153  if(fms_error_handler('lookup_es',err_msg_tmp,err_msg)) return
154  endif
155 
156  end subroutine lookup_es_3d_
157 
158 
159 !#######################################################################
160 ! <SUBROUTINE NAME="lookup_es2_0d" INTERFACE="lookup_es2">
161 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
162 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
163 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
164 ! </SUBROUTINE>
165  subroutine lookup_es2_0d_ ( temp, esat, err_msg )
166 
167  real(kind=fms_svp_kind_), intent(in) :: temp !< temperature in degrees Kelvin (K)
168  real(kind=fms_svp_kind_), intent(out) :: esat !< saturation vapor pressure
169  character(len=*), intent(out), optional :: err_msg
170 
171  integer :: nbad !< if temperature is out of range
172  character(len=128) :: err_msg_local
173 
174  if (.not.module_is_initialized) then
175  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
176  endif
177 
178  call lookup_es2_k(temp, esat, nbad)
179 
180  if ( nbad == 0 ) then
181  if(present(err_msg)) err_msg = ''
182  else
183  if(show_all_bad_values) call show_all_bad ( temp )
184  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
185  if(fms_error_handler('lookup_es2',err_msg_local,err_msg)) return
186  endif
187 
188  end subroutine lookup_es2_0d_
189 
190 !#######################################################################
191 
192 ! <SUBROUTINE NAME="lookup_es2_1d" INTERFACE="lookup_es2">
193 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
194 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
195 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
196 ! </SUBROUTINE>
197  subroutine lookup_es2_1d_ ( temp, esat, err_msg )
198 
199  real(kind=fms_svp_kind_), intent(in) :: temp(:) !< temperature in degrees Kelvin (K)
200  real(kind=fms_svp_kind_), intent(out) :: esat(:) !< saturation vapor pressure
201  character(len=*), intent(out), optional :: err_msg
202 
203  character(len=54) :: err_msg_local
204  integer :: nbad !< if temperature is out of range
205 !-----------------------------------------------
206 
207  if (.not.module_is_initialized) then
208  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
209  endif
210 
211  call lookup_es2_k(temp, esat, nbad)
212 
213  if ( nbad == 0 ) then
214  if(present(err_msg)) err_msg = ''
215  else
216  if(show_bad_value_count_by_slice) call temp_check ( temp )
217  if(show_all_bad_values) call show_all_bad ( temp )
218  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
219  if(fms_error_handler('lookup_es2',err_msg_local,err_msg)) return
220  endif
221 
222 !-----------------------------------------------
223 
224  end subroutine lookup_es2_1d_
225 
226 !#######################################################################
227 
228 ! <SUBROUTINE NAME="lookup_es2_2d" INTERFACE="lookup_es2">
229 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
230 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
231 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
232 ! </SUBROUTINE>
233  subroutine lookup_es2_2d_ ( temp, esat, err_msg )
234 
235  real(kind=fms_svp_kind_), intent(in) :: temp(:,:) !< temperature in degrees Kelvin (K)
236  real(kind=fms_svp_kind_), intent(out) :: esat(:,:) !< saturation vapor pressure
237  character(len=*), intent(out), optional :: err_msg
238 
239  character(len=54) :: err_msg_local
240  integer :: nbad !< if temperature is out of range
241 !-----------------------------------------------
242 
243  if (.not.module_is_initialized) then
244  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
245  endif
246 
247  call lookup_es2_k(temp, esat, nbad)
248 
249  if ( nbad == 0 ) then
250  if(present(err_msg)) err_msg = ''
251  else
252  if(show_bad_value_count_by_slice) call temp_check ( temp )
253  if(show_all_bad_values) call show_all_bad ( temp )
254  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
255  if(fms_error_handler('lookup_es2',err_msg_local,err_msg)) return
256  endif
257 
258 !-----------------------------------------------
259 
260  end subroutine lookup_es2_2d_
261 
262 !#######################################################################
263 
264 ! <SUBROUTINE NAME="lookup_es2_3d" INTERFACE="lookup_es2">
265 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
266 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
267 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
268 ! </SUBROUTINE>
269  subroutine lookup_es2_3d_ ( temp, esat, err_msg )
270 
271  real(kind=fms_svp_kind_), intent(in) :: temp(:,:,:) !< temperature in degrees Kelvin (K)
272  real(kind=fms_svp_kind_), intent(out) :: esat(:,:,:) !< saturation vapor pressure
273  character(len=*), intent(out), optional :: err_msg
274 
275  integer :: nbad !< if temperature is out of range
276  character(len=128) :: err_msg_tmp
277 
278  if (.not.module_is_initialized) then
279  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
280  endif
281 
282  call lookup_es2_k(temp, esat, nbad)
283 
284  if ( nbad == 0 ) then
285  if(present(err_msg)) err_msg = ''
286  else
287  if(show_bad_value_count_by_slice) call temp_check ( temp )
288  if(show_all_bad_values) call show_all_bad ( temp )
289  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
290  if(fms_error_handler('lookup_es2',err_msg_tmp,err_msg)) return
291  endif
292 
293  end subroutine lookup_es2_3d_
294 
295 
296 !#######################################################################
297 ! <SUBROUTINE NAME="lookup_es3_0d" INTERFACE="lookup_es3">
298 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
299 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
300 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
301 ! </SUBROUTINE>
302  subroutine lookup_es3_0d_ ( temp, esat, err_msg )
303 
304  real(kind=fms_svp_kind_), intent(in) :: temp !< temperature in degrees Kelvin (K)
305  real(kind=fms_svp_kind_), intent(out) :: esat !< saturation vapor pressure
306  character(len=*), intent(out), optional :: err_msg
307 
308  integer :: nbad !< if temperature is out of range
309  character(len=128) :: err_msg_local
310 
311  if (.not.module_is_initialized) then
312  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
313  endif
314 
315  call lookup_es3_k(temp, esat, nbad)
316 
317  if ( nbad == 0 ) then
318  if(present(err_msg)) err_msg = ''
319  else
320  if(show_all_bad_values) call show_all_bad ( temp )
321  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
322  if(fms_error_handler('lookup_es3',err_msg_local,err_msg)) return
323  endif
324 
325  end subroutine lookup_es3_0d_
326 
327 !#######################################################################
328 
329 ! <SUBROUTINE NAME="lookup_es3_1d" INTERFACE="lookup_es3">
330 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
331 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
332 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
333 ! </SUBROUTINE>
334  subroutine lookup_es3_1d_ ( temp, esat, err_msg )
335 
336  real(kind=fms_svp_kind_), intent(in) :: temp(:) !< temperature in degrees Kelvin (K)
337  real(kind=fms_svp_kind_), intent(out) :: esat(:) !< saturation vapor pressure
338  character(len=*), intent(out), optional :: err_msg
339 
340  character(len=54) :: err_msg_local
341  integer :: nbad !< if temperature is out of range
342 !-----------------------------------------------
343 
344  if (.not.module_is_initialized) then
345  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
346  endif
347 
348  call lookup_es3_k(temp, esat, nbad)
349 
350  if ( nbad == 0 ) then
351  if(present(err_msg)) err_msg = ''
352  else
353  if(show_bad_value_count_by_slice) call temp_check ( temp )
354  if(show_all_bad_values) call show_all_bad ( temp )
355  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
356  if(fms_error_handler('lookup_es3',err_msg_local,err_msg)) return
357  endif
358 
359 !-----------------------------------------------
360 
361  end subroutine lookup_es3_1d_
362 
363 !#######################################################################
364 
365 ! <SUBROUTINE NAME="lookup_es3_2d" INTERFACE="lookup_es3">
366 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
367 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
368 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
369 ! </SUBROUTINE>
370  subroutine lookup_es3_2d_ ( temp, esat, err_msg )
371 
372  real(kind=fms_svp_kind_), intent(in) :: temp(:,:) !< temperature in degrees Kelvin (K)
373  real(kind=fms_svp_kind_), intent(out) :: esat(:,:) !< saturation vapor pressure
374  character(len=*), intent(out), optional :: err_msg
375 
376  character(len=54) :: err_msg_local
377  integer :: nbad !< if temperature is out of range
378 !-----------------------------------------------
379 
380  if (.not.module_is_initialized) then
381  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
382  endif
383 
384  call lookup_es3_k(temp, esat, nbad)
385 
386  if ( nbad == 0 ) then
387  if(present(err_msg)) err_msg = ''
388  else
389  if(show_bad_value_count_by_slice) call temp_check ( temp )
390  if(show_all_bad_values) call show_all_bad ( temp )
391  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
392  if(fms_error_handler('lookup_es3',err_msg_local,err_msg)) return
393  endif
394 
395 !-----------------------------------------------
396 
397  end subroutine lookup_es3_2d_
398 
399 !#######################################################################
400 
401 ! <SUBROUTINE NAME="lookup_es3_3d" INTERFACE="lookup_es3">
402 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
403 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
404 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
405 ! </SUBROUTINE>
406  subroutine lookup_es3_3d_ ( temp, esat, err_msg )
407 
408  real(kind=fms_svp_kind_), intent(in) :: temp(:,:,:) !< temperature in degrees Kelvin (K)
409  real(kind=fms_svp_kind_), intent(out) :: esat(:,:,:) !< saturation vapor pressure
410  character(len=*), intent(out), optional :: err_msg
411 
412  integer :: nbad !< if temperature is out of range
413  character(len=128) :: err_msg_tmp
414 
415  if (.not.module_is_initialized) then
416  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
417  endif
418 
419  call lookup_es3_k(temp, esat, nbad)
420 
421  if ( nbad == 0 ) then
422  if(present(err_msg)) err_msg = ''
423  else
424  if(show_bad_value_count_by_slice) call temp_check ( temp )
425  if(show_all_bad_values) call show_all_bad ( temp )
426  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
427  if(fms_error_handler('lookup_es3',err_msg_tmp,err_msg)) return
428  endif
429 
430  end subroutine lookup_es3_3d_
431 
432 
433 !#######################################################################
434 ! routines for computing derivative of es
435 !#######################################################################
436 
437 ! <SUBROUTINE NAME="lookup_des_0d" INTERFACE="lookup_des">
438 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
439 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
440 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
441 ! </SUBROUTINE>
442  subroutine lookup_des_0d_ ( temp, desat, err_msg )
443 
444  real(kind=fms_svp_kind_), intent(in) :: temp !< temperature in degrees Kelvin (K)
445  real(kind=fms_svp_kind_), intent(out) :: desat !< derivative of saturation vapor pressure
446  character(len=*), intent(out), optional :: err_msg
447 
448  integer :: nbad !< if temperature is out of range
449  character(len=128) :: err_msg_local
450 
451  if (.not.module_is_initialized) then
452  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
453  endif
454 
455  call lookup_des_k( temp, desat, nbad)
456 
457  if ( nbad == 0 ) then
458  if(present(err_msg)) err_msg = ''
459  else
460  if(show_all_bad_values) call show_all_bad ( temp )
461  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
462  if(fms_error_handler('lookup_des',err_msg_local,err_msg)) return
463  endif
464 
465  end subroutine lookup_des_0d_
466 
467 !#######################################################################
468 
469 ! <SUBROUTINE NAME="lookup_des_1d" INTERFACE="lookup_des">
470 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
471 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
472 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
473 ! </SUBROUTINE>
474  subroutine lookup_des_1d_ ( temp, desat, err_msg )
475 
476  real(kind=fms_svp_kind_), intent(in) :: temp(:) !< temperature in degrees Kelvin (K)
477  real(kind=fms_svp_kind_), intent(out) :: desat(:) !< derivative of saturation vapor pressure
478  character(len=*), intent(out), optional :: err_msg
479 
480  character(len=54) :: err_msg_local
481  integer :: nbad !< if temperature is out of range
482 !-----------------------------------------------
483 
484  if (.not.module_is_initialized) then
485  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
486  endif
487 
488  if(present(err_msg)) err_msg=''
489 
490  call lookup_des_k(temp, desat, nbad)
491 
492  if ( nbad == 0 ) then
493  if(present(err_msg)) err_msg = ''
494  else
495  if(show_bad_value_count_by_slice) call temp_check ( temp )
496  if(show_all_bad_values) call show_all_bad ( temp )
497  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
498  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
499  endif
500 !-----------------------------------------------
501 
502  end subroutine lookup_des_1d_
503 
504 !#######################################################################
505 
506 ! <SUBROUTINE NAME="lookup_des_2d" INTERFACE="lookup_des">
507 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
508 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
509 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
510 ! </SUBROUTINE>
511  subroutine lookup_des_2d_ ( temp, desat, err_msg )
512 
513  real(kind=fms_svp_kind_), intent(in) :: temp(:,:) !< temperature in degrees Kelvin (K)
514  real(kind=fms_svp_kind_), intent(out) :: desat(:,:) !< derivative of saturation vapor pressure
515  character(len=*), intent(out), optional :: err_msg
516 
517  character(len=54) :: err_msg_local
518  integer :: nbad !< if temperature is out of range
519 !-----------------------------------------------
520 
521  if (.not.module_is_initialized) then
522  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
523  endif
524 
525  call lookup_des_k(temp, desat, nbad)
526 
527  if ( nbad == 0 ) then
528  if(present(err_msg)) err_msg = ''
529  else
530  if(show_bad_value_count_by_slice) call temp_check ( temp )
531  if(show_all_bad_values) call show_all_bad ( temp )
532  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
533  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
534  endif
535 !-----------------------------------------------
536 
537  end subroutine lookup_des_2d_
538 
539 !#######################################################################
540 ! <SUBROUTINE NAME="lookup_des_3d" INTERFACE="lookup_des">
541 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
542 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
543 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
544 ! </SUBROUTINE>
545  subroutine lookup_des_3d_ ( temp, desat, err_msg )
546 
547  real(kind=fms_svp_kind_), intent(in) :: temp(:,:,:) !< temperature in degrees Kelvin (K)
548  real(kind=fms_svp_kind_), intent(out) :: desat(:,:,:) !< derivative of saturation vapor pressure
549  character(len=*), intent(out), optional :: err_msg
550 
551  integer :: nbad !< if temperature is out of range
552  character(len=128) :: err_msg_tmp
553 
554  if (.not.module_is_initialized) then
555  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
556  endif
557 
558  call lookup_des_k( temp, desat, nbad )
559 
560  if ( nbad == 0 ) then
561  if(present(err_msg)) err_msg=''
562  else
563  if(show_bad_value_count_by_slice) call temp_check ( temp )
564  if(show_all_bad_values) call show_all_bad ( temp )
565  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
566  if(fms_error_handler('lookup_des',err_msg_tmp,err_msg)) return
567  endif
568 
569  end subroutine lookup_des_3d_
570 
571 
572 ! <SUBROUTINE NAME="lookup_des2_0d" INTERFACE="lookup_des2">
573 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
574 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
575 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
576 ! </SUBROUTINE>
577  subroutine lookup_des2_0d_ ( temp, desat, err_msg )
578 
579  real(kind=fms_svp_kind_), intent(in) :: temp !< temperature in degrees Kelvin (K)
580  real(kind=fms_svp_kind_), intent(out) :: desat !< derivative of saturation vapor pressure
581  character(len=*), intent(out), optional :: err_msg
582 
583  integer :: nbad !< if temperature is out of range
584  character(len=128) :: err_msg_local
585 
586  if (.not.module_is_initialized) then
587  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
588  endif
589 
590  call lookup_des2_k( temp, desat, nbad)
591 
592  if ( nbad == 0 ) then
593  if(present(err_msg)) err_msg = ''
594  else
595  if(show_all_bad_values) call show_all_bad ( temp )
596  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
597  if(fms_error_handler('lookup_des2',err_msg_local,err_msg)) return
598  endif
599 
600  end subroutine lookup_des2_0d_
601 
602 !#######################################################################
603 
604 ! <SUBROUTINE NAME="lookup_des2_1d" INTERFACE="lookup_des2">
605 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
606 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
607 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
608 ! </SUBROUTINE>
609  subroutine lookup_des2_1d_ ( temp, desat, err_msg )
610 
611  real(kind=fms_svp_kind_), intent(in) :: temp(:) !< temperature in degrees Kelvin (K)
612  real(kind=fms_svp_kind_), intent(out) :: desat(:) !< derivative of saturation vapor pressure
613  character(len=*), intent(out), optional :: err_msg
614 
615  character(len=54) :: err_msg_local
616  integer :: nbad !< if temperature is out of range
617 !-----------------------------------------------
618 
619  if (.not.module_is_initialized) then
620  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
621  endif
622 
623  if(present(err_msg)) err_msg=''
624 
625  call lookup_des2_k(temp, desat, nbad)
626 
627  if ( nbad == 0 ) then
628  if(present(err_msg)) err_msg = ''
629  else
630  if(show_bad_value_count_by_slice) call temp_check ( temp )
631  if(show_all_bad_values) call show_all_bad ( temp )
632  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
633  if(fms_error_handler('lookup_des2',err_msg_local,err_msg)) return
634  endif
635 !-----------------------------------------------
636 
637  end subroutine lookup_des2_1d_
638 
639 !#######################################################################
640 
641 ! <SUBROUTINE NAME="lookup_des2_2d" INTERFACE="lookup_des2">
642 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
643 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
644 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
645 ! </SUBROUTINE>
646  subroutine lookup_des2_2d_ ( temp, desat, err_msg )
647 
648  real(kind=fms_svp_kind_), intent(in) :: temp(:,:) !< temperature in degrees Kelvin (K)
649  real(kind=fms_svp_kind_), intent(out) :: desat(:,:) !< derivative of saturation vapor pressure
650  character(len=*), intent(out), optional :: err_msg
651 
652  character(len=54) :: err_msg_local
653  integer :: nbad !< if temperature is out of range
654 !-----------------------------------------------
655 
656  if (.not.module_is_initialized) then
657  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
658  endif
659 
660  call lookup_des2_k(temp, desat, nbad)
661 
662  if ( nbad == 0 ) then
663  if(present(err_msg)) err_msg = ''
664  else
665  if(show_bad_value_count_by_slice) call temp_check ( temp )
666  if(show_all_bad_values) call show_all_bad ( temp )
667  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
668  if(fms_error_handler('lookup_des2',err_msg_local,err_msg)) return
669  endif
670 !-----------------------------------------------
671 
672  end subroutine lookup_des2_2d_
673 
674 !#######################################################################
675 ! <SUBROUTINE NAME="lookup_des2_3d" INTERFACE="lookup_des2">
676 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
677 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
678 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
679 ! </SUBROUTINE>
680  subroutine lookup_des2_3d_ ( temp, desat, err_msg )
681 
682  real(kind=fms_svp_kind_), intent(in) :: temp(:,:,:) !< temperature in degrees Kelvin (K)
683  real(kind=fms_svp_kind_), intent(out) :: desat(:,:,:) !< derivative of saturation vapor pressure
684  character(len=*), intent(out), optional :: err_msg
685 
686  integer :: nbad !< if temperature is out of range
687  character(len=128) :: err_msg_tmp
688 
689  if (.not.module_is_initialized) then
690  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
691  endif
692 
693  call lookup_des2_k( temp, desat, nbad )
694 
695  if ( nbad == 0 ) then
696  if(present(err_msg)) err_msg=''
697  else
698  if(show_bad_value_count_by_slice) call temp_check ( temp )
699  if(show_all_bad_values) call show_all_bad ( temp )
700  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
701  if(fms_error_handler('lookup_des2',err_msg_tmp,err_msg)) return
702  endif
703 
704  end subroutine lookup_des2_3d_
705 
706 
707 ! <SUBROUTINE NAME="lookup_des3_0d" INTERFACE="lookup_des3">
708 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
709 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
710 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
711 ! </SUBROUTINE>
712  subroutine lookup_des3_0d_ ( temp, desat, err_msg )
713 
714  real(kind=fms_svp_kind_), intent(in) :: temp !< temperature in degrees Kelvin (K)
715  real(kind=fms_svp_kind_), intent(out) :: desat !< derivative of saturation vapor pressure
716  character(len=*), intent(out), optional :: err_msg
717 
718  integer :: nbad !< if temperature is out of range
719  character(len=128) :: err_msg_local
720 
721  if (.not.module_is_initialized) then
722  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
723  endif
724 
725  call lookup_des3_k( temp, desat, nbad)
726 
727  if ( nbad == 0 ) then
728  if(present(err_msg)) err_msg = ''
729  else
730  if(show_all_bad_values) call show_all_bad ( temp )
731  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
732  if(fms_error_handler('lookup_des3',err_msg_local,err_msg)) return
733  endif
734 
735  end subroutine lookup_des3_0d_
736 
737 !#######################################################################
738 
739 ! <SUBROUTINE NAME="lookup_des3_1d" INTERFACE="lookup_des3">
740 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
741 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
742 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
743 ! </SUBROUTINE>
744  subroutine lookup_des3_1d_ ( temp, desat, err_msg )
745 
746  real(kind=fms_svp_kind_), intent(in) :: temp(:) !< temperature in degrees Kelvin (K)
747  real(kind=fms_svp_kind_), intent(out) :: desat(:) !< derivative of saturation vapor pressure
748  character(len=*), intent(out), optional :: err_msg
749 
750  character(len=54) :: err_msg_local
751  integer :: nbad !< if temperature is out of range
752 !-----------------------------------------------
753 
754  if (.not.module_is_initialized) then
755  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
756  endif
757 
758  if(present(err_msg)) err_msg=''
759 
760  call lookup_des3_k(temp, desat, nbad)
761 
762  if ( nbad == 0 ) then
763  if(present(err_msg)) err_msg = ''
764  else
765  if(show_bad_value_count_by_slice) call temp_check ( temp )
766  if(show_all_bad_values) call show_all_bad ( temp )
767  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
768  if(fms_error_handler('lookup_des3',err_msg_local,err_msg)) return
769  endif
770 !-----------------------------------------------
771 
772  end subroutine lookup_des3_1d_
773 
774 !#######################################################################
775 
776 ! <SUBROUTINE NAME="lookup_des3_2d" INTERFACE="lookup_des3">
777 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
778 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
779 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
780 ! </SUBROUTINE>
781  subroutine lookup_des3_2d_ ( temp, desat, err_msg )
782 
783  real(kind=fms_svp_kind_), intent(in) :: temp(:,:) !< temperature in degrees Kelvin (K)
784  real(kind=fms_svp_kind_), intent(out) :: desat(:,:) !< derivative of saturation vapor pressure
785  character(len=*), intent(out), optional :: err_msg
786 
787  character(len=54) :: err_msg_local
788  integer :: nbad !< if temperature is out of range
789 !-----------------------------------------------
790 
791  if (.not.module_is_initialized) then
792  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
793  endif
794 
795  call lookup_des3_k(temp, desat, nbad)
796 
797  if ( nbad == 0 ) then
798  if(present(err_msg)) err_msg = ''
799  else
800  if(show_bad_value_count_by_slice) call temp_check ( temp )
801  if(show_all_bad_values) call show_all_bad ( temp )
802  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
803  if(fms_error_handler('lookup_des3',err_msg_local,err_msg)) return
804  endif
805 !-----------------------------------------------
806 
807  end subroutine lookup_des3_2d_
808 
809 !#######################################################################
810 ! <SUBROUTINE NAME="lookup_des3_3d" INTERFACE="lookup_des3">
811 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
812 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
813 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
814 ! </SUBROUTINE>
815  subroutine lookup_des3_3d_ ( temp, desat, err_msg )
816 
817  real(kind=fms_svp_kind_), intent(in) :: temp(:,:,:) !< temperature in degrees Kelvin (K)
818  real(kind=fms_svp_kind_), intent(out) :: desat(:,:,:) !< derivative of saturation vapor pressure
819  character(len=*), intent(out), optional :: err_msg
820 
821  integer :: nbad !< if temperature is out of range
822  character(len=128) :: err_msg_tmp
823 
824  if (.not.module_is_initialized) then
825  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
826  endif
827 
828  call lookup_des3_k( temp, desat, nbad )
829 
830  if ( nbad == 0 ) then
831  if(present(err_msg)) err_msg=''
832  else
833  if(show_bad_value_count_by_slice) call temp_check ( temp )
834  if(show_all_bad_values) call show_all_bad ( temp )
835  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
836  if(fms_error_handler('lookup_des3',err_msg_tmp,err_msg)) return
837  endif
838 
839  end subroutine lookup_des3_3d_
840 
841 !========================================================================================================
842 
843 !#######################################################################
844 
845 ! <SUBROUTINE NAME="lookup_es_des_0d" INTERFACE="lookup_es_des">
846 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
847 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
848 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(scalar)"></OUT>
849 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
850 ! </SUBROUTINE>
851  subroutine lookup_es_des_0d_ ( temp, esat, desat, err_msg )
852 
853  real(kind=fms_svp_kind_), intent(in) :: temp !< temperature in degrees Kelvin (K)
854  real(kind=fms_svp_kind_), intent(out) :: esat !< saturation vapor pressure
855  real(kind=fms_svp_kind_), intent(out) :: desat !< derivative of saturation vapor pressure
856  character(len=*), intent(out), optional :: err_msg
857 
858  integer :: nbad !< if temperature is out of range
859  character(len=128) :: err_msg_local
860 
861  if (.not.module_is_initialized) then
862  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
863  endif
864 
865  call lookup_es_des_k(temp, esat, desat, nbad)
866 
867  if ( nbad == 0 ) then
868  if(present(err_msg)) err_msg = ''
869  else
870  if(show_all_bad_values) call show_all_bad ( temp )
871  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
872  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
873  endif
874 
875  end subroutine lookup_es_des_0d_
876 
877 !#######################################################################
878 
879 ! <SUBROUTINE NAME="lookup_es_des_1d" INTERFACE="lookup_es_des">
880 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
881 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
882 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:)"></OUT>
883 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
884 ! </SUBROUTINE>
885  subroutine lookup_es_des_1d_ ( temp, esat, desat, err_msg )
886 
887  real(kind=fms_svp_kind_), dimension(:), intent(in) :: temp !< temperature in degrees Kelvin (K)
888  real(kind=fms_svp_kind_), dimension(:), intent(out) :: esat !< saturation vapor pressure
889  real(kind=fms_svp_kind_), dimension(:), intent(out) :: desat !< derivative of saturation vapor pressure
890  character(len=*), intent(out), optional :: err_msg
891 
892  integer :: nbad !< if temperature is out of range
893  character(len=128) :: err_msg_local
894 
895  if (.not.module_is_initialized) then
896  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
897  endif
898 
899  call lookup_es_des_k(temp, esat, desat, nbad)
900 
901  if ( nbad == 0 ) then
902  if(present(err_msg)) err_msg = ''
903  else
904  if(show_bad_value_count_by_slice) call temp_check ( temp )
905  if(show_all_bad_values) call show_all_bad ( temp )
906  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
907  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
908  endif
909 
910  end subroutine lookup_es_des_1d_
911 
912 !#######################################################################
913 
914 ! <SUBROUTINE NAME="lookup_es_des_2d" INTERFACE="lookup_es_des">
915 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
916 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
917 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:,:)"></OUT>
918 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
919 ! </SUBROUTINE>
920  subroutine lookup_es_des_2d_ ( temp, esat, desat, err_msg )
921 
922  real(kind=fms_svp_kind_), dimension(:,:), intent(in) :: temp !< temperature in degrees Kelvin (K)
923  real(kind=fms_svp_kind_), dimension(:,:), intent(out) :: esat !< saturation vapor pressure
924  real(kind=fms_svp_kind_), dimension(:,:), intent(out) :: desat !< derivative of saturation vapor pressure
925  character(len=*), intent(out), optional :: err_msg
926 
927  integer :: nbad !< if temperature is out of range
928  character(len=128) :: err_msg_local
929 
930  if (.not.module_is_initialized) then
931  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
932  endif
933 
934  call lookup_es_des_k(temp, esat, desat, nbad)
935 
936  if ( nbad == 0 ) then
937  if(present(err_msg)) err_msg = ''
938  else
939  if(show_bad_value_count_by_slice) call temp_check ( temp )
940  if(show_all_bad_values) call show_all_bad ( temp )
941  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
942  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
943  endif
944 
945  end subroutine lookup_es_des_2d_
946 
947 !#######################################################################
948 
949 ! <SUBROUTINE NAME="lookup_es_des_3d" INTERFACE="lookup_es_des">
950 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
951 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
952 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:,:,:)"></OUT>
953 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
954 ! </SUBROUTINE>
955  subroutine lookup_es_des_3d_ ( temp, esat, desat, err_msg )
956 
957  real(kind=fms_svp_kind_), dimension(:,:,:), intent(in) :: temp !< temperature in degrees Kelvin (K)
958  real(kind=fms_svp_kind_), dimension(:,:,:), intent(out) :: esat !< saturation vapor pressure
959  real(kind=fms_svp_kind_), dimension(:,:,:), intent(out) :: desat !< derivative of saturation vapor pressure
960  character(len=*), intent(out), optional :: err_msg
961 
962  integer :: nbad !< if temperature is out of range
963  character(len=128) :: err_msg_local
964 
965  if (.not.module_is_initialized) then
966  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
967  endif
968 
969  call lookup_es_des_k(temp, esat, desat, nbad)
970 
971  if ( nbad == 0 ) then
972  if(present(err_msg)) err_msg = ''
973  else
974  if(show_bad_value_count_by_slice) call temp_check ( temp )
975  if(show_all_bad_values) call show_all_bad ( temp )
976  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
977  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
978  endif
979 
980  end subroutine lookup_es_des_3d_
981 
982 !#######################################################################
983 !#######################################################################
984 
985 ! <SUBROUTINE NAME="lookup_es2_des2_0d" INTERFACE="lookup_es2_des2">
986 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
987 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
988 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(scalar)"></OUT>
989 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
990 ! </SUBROUTINE>
991  subroutine lookup_es2_des2_0d_ ( temp, esat, desat, err_msg )
992 
993  real(kind=fms_svp_kind_), intent(in) :: temp !< temperature in degrees Kelvin (K)
994  real(kind=fms_svp_kind_), intent(out) :: esat !< saturation vapor pressure
995  real(kind=fms_svp_kind_), intent(out) :: desat !< derivative of saturation vapor pressure
996  character(len=*), intent(out), optional :: err_msg
997 
998  integer :: nbad !< if temperature is out of range
999  character(len=128) :: err_msg_local
1000 
1001  if (.not.module_is_initialized) then
1002  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1003  endif
1004 
1005  call lookup_es2_des2_k(temp, esat, desat, nbad)
1006 
1007  if ( nbad == 0 ) then
1008  if(present(err_msg)) err_msg = ''
1009  else
1010  if(show_all_bad_values) call show_all_bad ( temp )
1011  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1012  if(fms_error_handler('lookup_es2_des2',err_msg_local,err_msg)) return
1013  endif
1014 
1015  end subroutine lookup_es2_des2_0d_
1016 
1017 !#######################################################################
1018 
1019 ! <SUBROUTINE NAME="lookup_es2_des2_1d" INTERFACE="lookup_es2_des2">
1020 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
1021 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
1022 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:)"></OUT>
1023 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1024 ! </SUBROUTINE>
1025  subroutine lookup_es2_des2_1d_ ( temp, esat, desat, err_msg )
1026 
1027  real(kind=fms_svp_kind_), dimension(:), intent(in) :: temp !< temperature in degrees Kelvin (K)
1028  real(kind=fms_svp_kind_), dimension(:), intent(out) :: esat !< saturation vapor pressure
1029  real(kind=fms_svp_kind_), dimension(:), intent(out) :: desat !< derivative of saturation vapor pressure
1030  character(len=*), intent(out), optional :: err_msg
1031 
1032  integer :: nbad !< if temperature is out of range
1033  character(len=128) :: err_msg_local
1034 
1035  if (.not.module_is_initialized) then
1036  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1037  endif
1038 
1039  call lookup_es2_des2_k(temp, esat, desat, nbad)
1040 
1041  if ( nbad == 0 ) then
1042  if(present(err_msg)) err_msg = ''
1043  else
1044  if(show_bad_value_count_by_slice) call temp_check ( temp )
1045  if(show_all_bad_values) call show_all_bad ( temp )
1046  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1047  if(fms_error_handler('lookup_es2_des2',err_msg_local,err_msg)) return
1048  endif
1049 
1050  end subroutine lookup_es2_des2_1d_
1051 
1052 !#######################################################################
1053 
1054 ! <SUBROUTINE NAME="lookup_es2_des2_2d" INTERFACE="lookup_es2_des2">
1055 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
1056 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
1057 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:,:)"></OUT>
1058 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1059 ! </SUBROUTINE>
1060  subroutine lookup_es2_des2_2d_ ( temp, esat, desat, err_msg )
1061 
1062  real(kind=fms_svp_kind_), dimension(:,:), intent(in) :: temp !< temperature in degrees Kelvin (K)
1063  real(kind=fms_svp_kind_), dimension(:,:), intent(out) :: esat !< saturation vapor pressure
1064  real(kind=fms_svp_kind_), dimension(:,:), intent(out) :: desat !< derivative of saturation vapor pressure
1065  character(len=*), intent(out), optional :: err_msg
1066 
1067  integer :: nbad !< if temperature is out of range
1068  character(len=128) :: err_msg_local
1069 
1070  if (.not.module_is_initialized) then
1071  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1072  endif
1073 
1074  call lookup_es2_des2_k(temp, esat, desat, nbad)
1075 
1076  if ( nbad == 0 ) then
1077  if(present(err_msg)) err_msg = ''
1078  else
1079  if(show_bad_value_count_by_slice) call temp_check ( temp )
1080  if(show_all_bad_values) call show_all_bad ( temp )
1081  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1082  if(fms_error_handler('lookup_es2_des2',err_msg_local,err_msg)) return
1083  endif
1084 
1085  end subroutine lookup_es2_des2_2d_
1086 
1087 !#######################################################################
1088 
1089 ! <SUBROUTINE NAME="lookup_es2_des2_3d" INTERFACE="lookup_es2_des2">
1090 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
1091 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
1092 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:,:,:)"></OUT>
1093 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1094 ! </SUBROUTINE>
1095  subroutine lookup_es2_des2_3d_ ( temp, esat, desat, err_msg )
1096 
1097  real(kind=fms_svp_kind_), dimension(:,:,:), intent(in) :: temp !< temperature in degrees Kelvin (K)
1098  real(kind=fms_svp_kind_), dimension(:,:,:), intent(out) :: esat !< saturation vapor pressure
1099  real(kind=fms_svp_kind_), dimension(:,:,:), intent(out) :: desat !< derivative of saturation vapor pressure
1100  character(len=*), intent(out), optional :: err_msg
1101 
1102  integer :: nbad !< if temperature is out of range
1103  character(len=128) :: err_msg_local
1104 
1105  if (.not.module_is_initialized) then
1106  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1107  endif
1108 
1109  call lookup_es2_des2_k(temp, esat, desat, nbad)
1110 
1111  if ( nbad == 0 ) then
1112  if(present(err_msg)) err_msg = ''
1113  else
1114  if(show_bad_value_count_by_slice) call temp_check ( temp )
1115  if(show_all_bad_values) call show_all_bad ( temp )
1116  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1117  if(fms_error_handler('lookup_es2_des2',err_msg_local,err_msg)) return
1118  endif
1119 
1120  end subroutine lookup_es2_des2_3d_
1121 
1122 
1123 !#######################################################################
1124 !#######################################################################
1125 
1126 ! <SUBROUTINE NAME="lookup_es3_des3_0d" INTERFACE="lookup_es3_des3">
1127 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
1128 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
1129 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(scalar)"></OUT>
1130 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1131 ! </SUBROUTINE>
1132  subroutine lookup_es3_des3_0d_ ( temp, esat, desat, err_msg )
1133 
1134  real(kind=fms_svp_kind_), intent(in) :: temp !< temperature in degrees Kelvin (K)
1135  real(kind=fms_svp_kind_), intent(out) :: esat !< saturation vapor pressure
1136  real(kind=fms_svp_kind_), intent(out) :: desat !< derivative of saturation vapor pressure
1137  character(len=*), intent(out), optional :: err_msg
1138 
1139  integer :: nbad !< if temperature is out of range
1140  character(len=128) :: err_msg_local
1141 
1142  if (.not.module_is_initialized) then
1143  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1144  endif
1145 
1146  call lookup_es3_des3_k(temp, esat, desat, nbad)
1147 
1148  if ( nbad == 0 ) then
1149  if(present(err_msg)) err_msg = ''
1150  else
1151  if(show_all_bad_values) call show_all_bad ( temp )
1152  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1153  if(fms_error_handler('lookup_es3_des3',err_msg_local,err_msg)) return
1154  endif
1155 
1156  end subroutine lookup_es3_des3_0d_
1157 
1158 !#######################################################################
1159 
1160 ! <SUBROUTINE NAME="lookup_es3_des3_1d" INTERFACE="lookup_es3_des3">
1161 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
1162 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
1163 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:)"></OUT>
1164 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1165 ! </SUBROUTINE>
1166  subroutine lookup_es3_des3_1d_ ( temp, esat, desat, err_msg )
1167 
1168  real(kind=fms_svp_kind_), dimension(:), intent(in) :: temp !< temperature in degrees Kelvin (K)
1169  real(kind=fms_svp_kind_), dimension(:), intent(out) :: esat !< saturation vapor pressure
1170  real(kind=fms_svp_kind_), dimension(:), intent(out) :: desat !< derivative of saturation vapor pressure
1171  character(len=*), intent(out), optional :: err_msg
1172 
1173  integer :: nbad !< if temperature is out of range
1174  character(len=128) :: err_msg_local
1175 
1176  if (.not.module_is_initialized) then
1177  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1178  endif
1179 
1180  call lookup_es3_des3_k(temp, esat, desat, nbad)
1181 
1182  if ( nbad == 0 ) then
1183  if(present(err_msg)) err_msg = ''
1184  else
1185  if(show_bad_value_count_by_slice) call temp_check ( temp )
1186  if(show_all_bad_values) call show_all_bad ( temp )
1187  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1188  if(fms_error_handler('lookup_es3_des3',err_msg_local,err_msg)) return
1189  endif
1190 
1191  end subroutine lookup_es3_des3_1d_
1192 
1193 !#######################################################################
1194 
1195 ! <SUBROUTINE NAME="lookup_es3_des3_2d" INTERFACE="lookup_es3_des3">
1196 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
1197 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
1198 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:,:)"></OUT>
1199 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1200 ! </SUBROUTINE>
1201  subroutine lookup_es3_des3_2d_ ( temp, esat, desat, err_msg )
1202 
1203  real(kind=fms_svp_kind_), dimension(:,:), intent(in) :: temp !< temperature in degrees Kelvin (K)
1204  real(kind=fms_svp_kind_), dimension(:,:), intent(out) :: esat !< saturation vapor pressure
1205  real(kind=fms_svp_kind_), dimension(:,:), intent(out) :: desat !< derivative of saturation vapor pressure
1206  character(len=*), intent(out), optional :: err_msg
1207 
1208  integer :: nbad !< if temperature is out of range
1209  character(len=128) :: err_msg_local
1210 
1211  if (.not.module_is_initialized) then
1212  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1213  endif
1214 
1215  call lookup_es3_des3_k(temp, esat, desat, nbad)
1216 
1217  if ( nbad == 0 ) then
1218  if(present(err_msg)) err_msg = ''
1219  else
1220  if(show_bad_value_count_by_slice) call temp_check ( temp )
1221  if(show_all_bad_values) call show_all_bad ( temp )
1222  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1223  if(fms_error_handler('lookup_es3_des3',err_msg_local,err_msg)) return
1224  endif
1225 
1226  end subroutine lookup_es3_des3_2d_
1227 
1228 !#######################################################################
1229 
1230 ! <SUBROUTINE NAME="lookup_es3_des3_3d" INTERFACE="lookup_es3_des3">
1231 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
1232 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
1233 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:,:,:)"></OUT>
1234 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1235 ! </SUBROUTINE>
1236  subroutine lookup_es3_des3_3d_ ( temp, esat, desat, err_msg )
1237 
1238  real(kind=fms_svp_kind_), dimension(:,:,:), intent(in) :: temp !< temperature in degrees Kelvin (K)
1239  real(kind=fms_svp_kind_), dimension(:,:,:), intent(out) :: esat !< saturation vapor pressure
1240  real(kind=fms_svp_kind_), dimension(:,:,:), intent(out) :: desat !< derivative of saturation vapor pressure
1241  character(len=*), intent(out), optional :: err_msg
1242 
1243  integer :: nbad !< if temperature is out of range
1244  character(len=128) :: err_msg_local
1245 
1246  if (.not.module_is_initialized) then
1247  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1248  endif
1249 
1250  call lookup_es3_des3_k(temp, esat, desat, nbad)
1251 
1252  if ( nbad == 0 ) then
1253  if(present(err_msg)) err_msg = ''
1254  else
1255  if(show_bad_value_count_by_slice) call temp_check ( temp )
1256  if(show_all_bad_values) call show_all_bad ( temp )
1257  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1258  if(fms_error_handler('lookup_es3_des3',err_msg_local,err_msg)) return
1259  endif
1260 
1261  end subroutine lookup_es3_des3_3d_
1262 
1263 !#######################################################################
1264 
1265 ! <SUBROUTINE NAME="compute_qs_0d" INTERFACE="compute_qs">
1266 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(SCALAR)"></IN>
1267 ! <IN NAME="press UNIT="Pascals" TYPE="real" DIM="(SCALAR)"></IN>
1268 ! <OUT NAME="qsat" UNITS="kg(vapor)/kg(moist air)" TYPE="real" DIM="(SCALAR)"></OUT>
1269 ! <IN NAME="q" UNIT="kg(vapor)/kg(moistair)" TYPE="real" DIM="(SCALAR)"></IN>
1270 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)"></IN>
1271 ! <OUT NAME="dqsdT" UNIT="kg(vapor)/kg(moistair)/ degree Kelvin" TYPE="real" DIM="(SCALAR)"></OUT>
1272 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(scalar)"> </OUT>
1273 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1274 ! </SUBROUTINE>
1275  subroutine compute_qs_0d_ ( temp, press, qsat, q, hc, dqsdT, esat, &
1276  err_msg, es_over_liq, es_over_liq_and_ice )
1277 
1278  real(kind=fms_svp_kind_), intent(in) :: temp !< temperature in degrees Kelvin (K)
1279  real(kind=fms_svp_kind_), intent(in) :: press !< pressure
1280  real(kind=fms_svp_kind_), intent(out) :: qsat !< saturation vapor pressure
1281  real(kind=fms_svp_kind_), intent(in), optional :: q !< vapor relative humidity
1282  real(kind=fms_svp_kind_), intent(in), optional :: hc !< relative humidity
1283  real(kind=fms_svp_kind_), intent(out), optional :: dqsdt !< d(qsat)/dT
1284  real(kind=fms_svp_kind_), intent(out), optional :: esat !< saturation vapor pressure
1285  character(len=*), intent(out), optional :: err_msg
1286  logical,intent(in), optional :: es_over_liq
1287  logical,intent(in), optional :: es_over_liq_and_ice
1288 
1289  integer :: nbad !< if temperature is out of range
1290  character(len=128) :: err_msg_tmp
1291 
1292  !> EPSILO and ZVIR are module level variables that are declared in r8_kind.
1293  !! Thus they need to be converted to FMS_SVP_KIND_
1294  real(kind=fms_svp_kind_), parameter :: epsilo_loc=real(epsilo,fms_svp_kind_)
1295  real(kind=fms_svp_kind_), parameter :: zvirl=real(zvir,fms_svp_kind_)
1296 
1297  if (.not.module_is_initialized) then
1298  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1299  endif
1300 
1301  if (present(es_over_liq)) then
1302  if (.not. (construct_table_wrt_liq)) then
1303  call error_mesg ('compute_qs', &
1304  'requesting es wrt liq, but that table not constructed', &
1305  fatal)
1306  endif
1307  endif
1308  if (present(es_over_liq_and_ice)) then
1309  if (.not. (construct_table_wrt_liq_and_ice)) then
1310  call error_mesg ('compute_qs', &
1311  'requesting es wrt liq and ice, but that table not constructed', &
1312  fatal)
1313  endif
1314  endif
1315 
1316  call compute_qs_k (temp, press, epsilo_loc, zvirl, qsat, nbad, q, hc, &
1317  dqsdt, esat, es_over_liq, es_over_liq_and_ice)
1318 
1319  if ( nbad == 0 ) then
1320  if(present(err_msg)) err_msg = ''
1321  else
1322  if(show_all_bad_values) call show_all_bad ( temp )
1323  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1324  if(fms_error_handler('compute_qs',err_msg_tmp,err_msg)) return
1325  endif
1326 
1327  end subroutine compute_qs_0d_
1328 
1329 !#######################################################################
1330 
1331 ! <SUBROUTINE NAME="compute_qs_1d" INTERFACE="compute_qs">
1332 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
1333 ! <IN NAME="press UNIT="Pascals" TYPE="real" DIM="(:)"></IN>
1334 ! <OUT NAME="qsat" UNITS="kg(vapor)/kg(moist air)" TYPE="real" DIM="(:)"></OUT>
1335 ! <IN NAME="q" UNIT="kg(vapor)/kg(moistair)" TYPE="real" DIM="(:)"></IN>
1336 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)"></IN>
1337 ! <OUT NAME="dqsdT" UNIT="kg(vapor)/kg(moistair)/ degree Kelvin" TYPE="real" DIM="(:)"></OUT>
1338 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(:)"> </OUT>
1339 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1340 ! </SUBROUTINE>
1341  subroutine compute_qs_1d_ ( temp, press, qsat, q, hc, dqsdT, esat, &
1342  err_msg, es_over_liq, es_over_liq_and_ice )
1343 
1344  real(kind=fms_svp_kind_), intent(in) :: temp(:) !< temperature in degrees Kelvin (K)
1345  real(kind=fms_svp_kind_), intent(in) :: press(:) !< pressure
1346  real(kind=fms_svp_kind_), intent(out) :: qsat(:) !< specific humidity
1347  real(kind=fms_svp_kind_), intent(in), optional :: q(:) !< vapor relative humidity
1348  real(kind=fms_svp_kind_), intent(in), optional :: hc !< relative humidity
1349  real(kind=fms_svp_kind_), intent(out), optional :: dqsdt(:) !< d(qsat)/dT
1350  real(kind=fms_svp_kind_),intent(out), optional :: esat(:) !< saturation vapor pressure
1351  character(len=*), intent(out), optional :: err_msg
1352  logical,intent(in), optional :: es_over_liq
1353  logical,intent(in), optional :: es_over_liq_and_ice
1354 
1355  integer :: nbad !< if temperature is out of range
1356  character(len=128) :: err_msg_tmp
1357  !> EPSILO and ZVIR are module level variables that are declared in r8_kind.
1358  !! Thus they need to be converted to FMS_SVP_KIND_
1359  real(kind=fms_svp_kind_), parameter :: epsilol=real(epsilo,fms_svp_kind_)
1360  real(kind=fms_svp_kind_), parameter :: zvirl=real(zvir,fms_svp_kind_)
1361 
1362  if (.not.module_is_initialized) then
1363  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1364  endif
1365 
1366  if (present(es_over_liq)) then
1367  if (.not. (construct_table_wrt_liq)) then
1368  call error_mesg ('compute_qs', &
1369  'requesting es wrt liq, but that table not constructed', &
1370  fatal)
1371  endif
1372  endif
1373  if (present(es_over_liq_and_ice)) then
1374  if (.not. (construct_table_wrt_liq_and_ice)) then
1375  call error_mesg ('compute_qs', &
1376  'requesting es wrt liq and ice, but that table not constructed', &
1377  fatal)
1378  endif
1379  endif
1380 
1381 ! call compute_qs_k (temp, press, EPSILO, ZVIR, qsat, nbad, q, dqsdT)
1382  call compute_qs_k (temp, press, epsilol, zvirl, qsat, nbad, q, hc, &
1383  dqsdt, esat, es_over_liq, es_over_liq_and_ice)
1384 
1385  if ( nbad == 0 ) then
1386  if(present(err_msg)) err_msg = ''
1387  else
1388  if(show_bad_value_count_by_slice) call temp_check ( temp )
1389  if(show_all_bad_values) call show_all_bad ( temp )
1390  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1391  if(fms_error_handler('compute_qs',err_msg_tmp,err_msg)) return
1392  endif
1393 
1394  end subroutine compute_qs_1d_
1395 
1396 
1397 !#######################################################################
1398 
1399 ! <SUBROUTINE NAME="compute_qs_2d" INTERFACE="compute_qs">
1400 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
1401 ! <IN NAME="press UNIT="Pascals" TYPE="real" DIM="(:,:)"></IN>
1402 ! <OUT NAME="qsat" UNITS="kg(vapor)/kg(moist air)" TYPE="real" DIM="(;,:)"></OUT>
1403 ! <IN NAME="q" UNIT="kg(vapor)/kg(moistair)" TYPE="real" DIM="(:,:)"></IN>
1404 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)"></IN>
1405 ! <OUT NAME="dqsdT" UNIT="kg(vapor)/kg(moistair)/ degree Kelvin" TYPE="real" DIM="(:,:)"></OUT>
1406 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(:,:)"> </OUT>
1407 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1408 ! </SUBROUTINE>
1409  subroutine compute_qs_2d_ ( temp, press, qsat, q, hc, dqsdT, esat, &
1410  err_msg, es_over_liq, es_over_liq_and_ice )
1411 
1412  real(kind=fms_svp_kind_), intent(in) :: temp(:,:) !< temperature in degrees Kelvin (K)
1413  real(kind=fms_svp_kind_), intent(in) :: press(:,:) !< pressure
1414  real(kind=fms_svp_kind_), intent(out) :: qsat(:,:) !< specific humidity
1415  real(kind=fms_svp_kind_), intent(in), optional :: q(:,:) !< vapor relative humidity
1416  real(kind=fms_svp_kind_), intent(in), optional :: hc !< relative humidity
1417  real(kind=fms_svp_kind_), intent(out), optional :: dqsdt(:,:) !< d(qsat)/dT
1418  real(kind=fms_svp_kind_), intent(out), optional :: esat(:,:) !< saturation vapor pressure
1419  character(len=*), intent(out), optional :: err_msg
1420  logical,intent(in), optional :: es_over_liq
1421  logical,intent(in), optional :: es_over_liq_and_ice
1422 
1423  integer :: nbad !< if temperature is out of range
1424  character(len=128) :: err_msg_tmp
1425  !> EPSILO and ZVIR are module level variables that are declared in r8_kind.
1426  !! Thus they need to be converted to FMS_SVP_KIND_
1427  real(kind=fms_svp_kind_), parameter :: epsilol=real(epsilo,fms_svp_kind_)
1428  real(kind=fms_svp_kind_), parameter :: zvirl=real(zvir,fms_svp_kind_)
1429 
1430  if (.not.module_is_initialized) then
1431  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1432  endif
1433 
1434  if (present(es_over_liq)) then
1435  if (.not. (construct_table_wrt_liq)) then
1436  call error_mesg ('compute_qs', &
1437  'requesting es wrt liq, but that table not constructed', &
1438  fatal)
1439  endif
1440  endif
1441  if (present(es_over_liq_and_ice)) then
1442  if (.not. (construct_table_wrt_liq_and_ice)) then
1443  call error_mesg ('compute_qs', &
1444  'requesting es wrt liq and ice, but that table not constructed', &
1445  fatal)
1446  endif
1447  endif
1448 
1449 ! call compute_qs_k (temp, press, EPSILO, ZVIR, qsat, nbad, q, dqsdT)
1450  call compute_qs_k (temp, press, epsilol, zvirl, qsat, nbad, q, hc, &
1451  dqsdt, esat, es_over_liq, es_over_liq_and_ice)
1452 
1453  if ( nbad == 0 ) then
1454  if(present(err_msg)) err_msg = ''
1455  else
1456  if(show_bad_value_count_by_slice) call temp_check ( temp )
1457  if(show_all_bad_values) call show_all_bad ( temp )
1458  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1459  if(fms_error_handler('compute_qs',err_msg_tmp,err_msg)) return
1460  endif
1461 
1462  end subroutine compute_qs_2d_
1463 
1464 !#######################################################################
1465 
1466 ! <SUBROUTINE NAME="compute_qs_3d" INTERFACE="compute_qs">
1467 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
1468 ! <IN NAME="press UNIT="Pascals" TYPE="real" DIM="(:,:,:)"></IN>
1469 ! <OUT NAME="qsat" UNITS="kg(vapor)/kg(moist air)" TYPE="real" DIM="(;,:,:)"></OUT>
1470 ! <IN NAME="q" UNIT="kg(vapor)/kg(moistair)" TYPE="real" DIM="(:,:,:)"></IN>
1471 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)"></IN>
1472 ! <OUT NAME="dqsdT" UNIT="kg(vapor)/kg(moistair)/ degree Kelvin" TYPE="real" DIM="(:,:,:)"></OUT>
1473 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(:,:,:)"> </OUT>
1474 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1475 ! </SUBROUTINE>
1476  subroutine compute_qs_3d_ ( temp, press, qsat, q, hc, dqsdT, esat, &
1477  err_msg, es_over_liq, es_over_liq_and_ice )
1478 
1479  real(kind=fms_svp_kind_), intent(in) :: temp(:,:,:) !< temperature in degrees Kelvin (K)
1480  real(kind=fms_svp_kind_), intent(in) :: press(:,:,:) !< pressure
1481  real(kind=fms_svp_kind_), intent(out) :: qsat(:,:,:) !< specific humidity
1482  real(kind=fms_svp_kind_), intent(in), optional :: q(:,:,:) !< vapor relative humidity
1483  real(kind=fms_svp_kind_), intent(in), optional :: hc !< relative humidity
1484  real(kind=fms_svp_kind_), intent(out), optional :: dqsdt(:,:,:) !< d(qsat)/dT
1485  real(kind=fms_svp_kind_), intent(out), optional :: esat(:,:,:) !< saturation vapor pressure
1486  character(len=*), intent(out), optional :: err_msg
1487  logical,intent(in), optional :: es_over_liq
1488  logical,intent(in), optional :: es_over_liq_and_ice
1489 
1490  integer :: nbad !< if temperature is out of range
1491  character(len=128) :: err_msg_tmp
1492  !> EPSILO and ZVIR are module level variables that are declared in r8_kind.
1493  !! Thus they need to be converted to FMS_SVP_KIND_
1494  real(kind=fms_svp_kind_), parameter :: epsilol=real(epsilo,fms_svp_kind_)
1495  real(kind=fms_svp_kind_), parameter :: zvirl=real(zvir,fms_svp_kind_)
1496 
1497  if (.not.module_is_initialized) then
1498  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1499  endif
1500 
1501  if (present(es_over_liq)) then
1502  if (.not. (construct_table_wrt_liq)) then
1503  call error_mesg ('compute_qs', &
1504  'requesting es wrt liq, but that table not constructed', &
1505  fatal)
1506  endif
1507  endif
1508  if (present(es_over_liq_and_ice)) then
1509  if (.not. (construct_table_wrt_liq_and_ice)) then
1510  call error_mesg ('compute_qs', &
1511  'requesting es wrt liq and ice, but that table not constructed', &
1512  fatal)
1513  endif
1514  endif
1515 
1516 ! call compute_qs_k (temp, press, EPSILO, ZVIR, qsat, nbad, q, dqsdT)
1517  call compute_qs_k (temp, press, epsilol, zvirl, qsat, nbad, q, hc, &
1518  dqsdt, esat, es_over_liq, es_over_liq_and_ice)
1519 
1520 
1521  if ( nbad == 0 ) then
1522  if(present(err_msg)) err_msg = ''
1523  else
1524  if(show_bad_value_count_by_slice) call temp_check ( temp )
1525  if(show_all_bad_values) call show_all_bad ( temp )
1526  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1527  if(fms_error_handler('compute_qs',err_msg_tmp,err_msg)) return
1528  endif
1529 
1530  end subroutine compute_qs_3d_
1531 
1532 !#######################################################################
1533 !#######################################################################
1534 
1535 ! <SUBROUTINE NAME="compute_mrs_0d" INTERFACE="compute_mrs">
1536 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(SCALAR)"></IN>
1537 ! <IN NAME="press" UNIT="Pascals" TYPE="real" DIM="(SCALAR)"></IN>
1538 ! <OUT NAME="mrsat" UNITS="kg(vapor)/kg(dry air)" TYPE="real" DIM="(SCALAR</OUT>
1539 ! <IN NAME="mr" UNIT="kg(vapor)/kg(dry air)" TYPE="real" DIM="(SCALAR)"></IN>
1540 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)"></IN>
1541 ! <OUT NAME="dmrsdT" UNIT="kg(vapor)/kg(dry air)/ degree Kelvin" TYPE="real" DIM="(SCALAR)"></OUT>
1542 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(scalar)"> </OUT>
1543 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1544 ! </SUBROUTINE>
1545  subroutine compute_mrs_0d_ ( temp, press, mrsat, mr, hc, dmrsdT, esat, &
1546  err_msg, es_over_liq, es_over_liq_and_ice )
1547 
1548  real(kind=fms_svp_kind_), intent(in) :: temp !< temperature in degrees Kelvin (K)
1549  real(kind=fms_svp_kind_), intent(in) :: press !< pressure
1550  real(kind=fms_svp_kind_), intent(out) :: mrsat !< mixing ratio at relative humidity
1551  real(kind=fms_svp_kind_), intent(in), optional :: mr !< vapor mixing ratio
1552  real(kind=fms_svp_kind_), intent(in), optional :: hc !< relative humidity
1553  real(kind=fms_svp_kind_), intent(out), optional :: dmrsdt !< d(mrsat)/dT
1554  real(kind=fms_svp_kind_), intent(out), optional :: esat !< saturation vapor pressure
1555  character(len=*), intent(out), optional :: err_msg
1556  logical,intent(in), optional :: es_over_liq
1557  logical,intent(in), optional :: es_over_liq_and_ice
1558 
1559  integer :: nbad !< if temperature is out of range
1560  character(len=128) :: err_msg_tmp
1561  !> EPSILO and ZVIR are module level variables that are declared in r8_kind.
1562  !! Thus they need to be converted to FMS_SVP_KIND_
1563  real(kind=fms_svp_kind_), parameter :: epsilol=real(epsilo,fms_svp_kind_)
1564  real(kind=fms_svp_kind_), parameter :: zvirl=real(zvir,fms_svp_kind_)
1565 
1566  if (.not.module_is_initialized) then
1567  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1568  endif
1569 
1570  if (present(es_over_liq)) then
1571  if (.not. (construct_table_wrt_liq)) then
1572  call error_mesg ('compute_mrs', &
1573  'requesting es wrt liq, but that table not constructed', &
1574  fatal)
1575  endif
1576  endif
1577  if (present(es_over_liq_and_ice)) then
1578  if (.not. (construct_table_wrt_liq_and_ice)) then
1579  call error_mesg ('compute_qs', &
1580  'requesting es wrt liq and ice, but that table not constructed', &
1581  fatal)
1582  endif
1583  endif
1584 
1585  call compute_mrs_k (temp, press, epsilol, zvirl, mrsat, nbad, mr, &
1586  hc, dmrsdt, esat, es_over_liq, es_over_liq_and_ice)
1587 
1588  if ( nbad == 0 ) then
1589  if(present(err_msg)) err_msg = ''
1590  else
1591  if(show_all_bad_values) call show_all_bad ( temp )
1592  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1593  if(fms_error_handler('compute_mrs',err_msg_tmp,err_msg)) return
1594  endif
1595 
1596  end subroutine compute_mrs_0d_
1597 
1598 !#######################################################################
1599 !#######################################################################
1600 
1601 ! <SUBROUTINE NAME="compute_mrs_1d" INTERFACE="compute_mrs">
1602 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
1603 ! <IN NAME="press" UNIT="Pascals" TYPE="real" DIM="(:)"></IN>
1604 ! <OUT NAME="mrsat" UNITS="kg(vapor)/kg(dry air)" TYPE="real" DIM="(:)"></OUT>
1605 ! <IN NAME="mr" UNIT="kg(vapor)/kg(dry air)" TYPE="real" DIM="(:)"></IN>
1606 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)"></IN>
1607 ! <OUT NAME="dmrsdT" UNIT="kg(vapor)/kg(dry air)/ degree Kelvin" TYPE="real" DIM="(:)"></OUT>
1608 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(:)"> </OUT>
1609 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1610 ! </SUBROUTINE>
1611  subroutine compute_mrs_1d_ ( temp, press, mrsat, mr, hc, dmrsdT, esat,&
1612  err_msg, es_over_liq, es_over_liq_and_ice )
1613 
1614  real(kind=fms_svp_kind_), intent(in) :: temp(:) !< temperature in degrees Kelvin (K)
1615  real(kind=fms_svp_kind_), intent(in) :: press(:) !< pressure
1616  real(kind=fms_svp_kind_), intent(out) :: mrsat(:) !< mixing ratio at relative humidity
1617  real(kind=fms_svp_kind_), intent(in), optional :: mr(:) !< vapor mixing ratio
1618  real(kind=fms_svp_kind_), intent(in), optional :: hc !< relative humidity
1619  real(kind=fms_svp_kind_), intent(out), optional :: dmrsdt(:) !< d(mrsat)/dT
1620  real(kind=fms_svp_kind_), intent(out), optional :: esat(:) !< saturation vapor pressure
1621  character(len=*), intent(out), optional :: err_msg
1622  logical,intent(in), optional :: es_over_liq
1623  logical,intent(in), optional :: es_over_liq_and_ice
1624 
1625  integer :: nbad !< if temperature is out of range
1626  character(len=128) :: err_msg_tmp
1627  !> EPSILO and ZVIR are module level variables that are declared in r8_kind.
1628  !! Thus they need to be converted to FMS_SVP_KIND_
1629  real(kind=fms_svp_kind_), parameter :: epsilol=real(epsilo,fms_svp_kind_)
1630  real(kind=fms_svp_kind_), parameter :: zvirl=real(zvir,fms_svp_kind_)
1631 
1632  if (.not.module_is_initialized) then
1633  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1634  endif
1635 
1636  if (present(es_over_liq)) then
1637  if (.not. (construct_table_wrt_liq)) then
1638  call error_mesg ('compute_mrs', &
1639  'requesting es wrt liq, but that table not constructed', &
1640  fatal)
1641  endif
1642  endif
1643  if (present(es_over_liq_and_ice)) then
1644  if (.not. (construct_table_wrt_liq_and_ice)) then
1645  call error_mesg ('compute_qs', &
1646  'requesting es wrt liq and ice, but that table not constructed', &
1647  fatal)
1648  endif
1649  endif
1650 
1651 ! call compute_mrs_k (temp, press, EPSILO, ZVIR, mrsat, &
1652 ! nbad, mr, dmrsdT)
1653  call compute_mrs_k (temp, press, epsilol, zvirl, mrsat, nbad, mr, &
1654  hc, dmrsdt, esat, es_over_liq, es_over_liq_and_ice)
1655 
1656  if ( nbad == 0 ) then
1657  if(present(err_msg)) err_msg = ''
1658  else
1659  if(show_bad_value_count_by_slice) call temp_check ( temp )
1660  if(show_all_bad_values) call show_all_bad ( temp )
1661  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1662  if(fms_error_handler('compute_mrs',err_msg_tmp,err_msg)) return
1663  endif
1664 
1665  end subroutine compute_mrs_1d_
1666 
1667 !#######################################################################
1668 
1669 ! <SUBROUTINE NAME="compute_mrs_2d" INTERFACE="compute_mrs">
1670 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
1671 ! <IN NAME="press" UNIT="Pascals" TYPE="real" DIM="(:,:)"></IN>
1672 ! <OUT NAME="mrsat" UNITS="kg(vapor)/kg(dry air)" TYPE="real" DIM="(:,:)"></OUT>
1673 ! <IN NAME="mr" UNIT="kg(vapor)/kg(dry air)" TYPE="real" DIM="(:,:)"></IN>
1674 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)"></IN>
1675 ! <OUT NAME="dmrsdT" UNIT="kg(vapor)/kg(dry air)/ degree Kelvin" TYPE="real" DIM="(:,:)"></OUT>
1676 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(:,:)"> </OUT>
1677 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1678 ! </SUBROUTINE>
1679  subroutine compute_mrs_2d_ ( temp, press, mrsat, mr, hc, dmrsdT, esat,&
1680  err_msg, es_over_liq, es_over_liq_and_ice )
1681 
1682  real(kind=fms_svp_kind_), intent(in) :: temp(:,:) !< temperature in degrees Kelvin (K)
1683  real(kind=fms_svp_kind_), intent(in) :: press(:,:) !< pressure
1684  real(kind=fms_svp_kind_), intent(out) :: mrsat(:,:) !< mixing ratio at relative humidity
1685  real(kind=fms_svp_kind_), intent(in), optional :: mr(:,:) !< vapor mixing ratio
1686  real(kind=fms_svp_kind_), intent(in), optional :: hc !< relative humidity
1687  real(kind=fms_svp_kind_), intent(out), optional :: dmrsdt(:,:) !< d(mrsat)/dT
1688  real(kind=fms_svp_kind_), intent(out), optional :: esat(:,:) !< saturation vapor pressure
1689  character(len=*), intent(out), optional :: err_msg
1690  logical,intent(in), optional :: es_over_liq
1691  logical,intent(in), optional :: es_over_liq_and_ice
1692 
1693  integer :: nbad !< if temperature is out of range
1694  character(len=128) :: err_msg_tmp
1695  !> EPSILO and ZVIR are module level variables that are declared in r8_kind.
1696  !! Thus they need to be converted to FMS_SVP_KIND_
1697  real(kind=fms_svp_kind_), parameter :: epsilol=real(epsilo,fms_svp_kind_)
1698  real(kind=fms_svp_kind_), parameter :: zvirl=real(zvir,fms_svp_kind_)
1699 
1700  if (.not.module_is_initialized) then
1701  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1702  endif
1703 
1704  if (present(es_over_liq)) then
1705  if (.not. (construct_table_wrt_liq)) then
1706  call error_mesg ('compute_mrs', &
1707  'requesting es wrt liq, but that table not constructed', &
1708  fatal)
1709  endif
1710  endif
1711  if (present(es_over_liq_and_ice)) then
1712  if (.not. (construct_table_wrt_liq_and_ice)) then
1713  call error_mesg ('compute_qs', &
1714  'requesting es wrt liq and ice, but that table not constructed', &
1715  fatal)
1716  endif
1717  endif
1718 
1719 ! call compute_mrs_k (temp, press, EPSILO, ZVIR, mrsat, &
1720 ! nbad, mr, dmrsdT)
1721  call compute_mrs_k (temp, press, epsilol, zvirl, mrsat, nbad, mr, &
1722  hc, dmrsdt, esat, es_over_liq, es_over_liq_and_ice)
1723 
1724  if ( nbad == 0 ) then
1725  if(present(err_msg)) err_msg = ''
1726  else
1727  if(show_bad_value_count_by_slice) call temp_check ( temp )
1728  if(show_all_bad_values) call show_all_bad ( temp )
1729  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1730  if(fms_error_handler('compute_mrs',err_msg_tmp,err_msg)) return
1731  endif
1732 
1733  end subroutine compute_mrs_2d_
1734 
1735 !#######################################################################
1736 
1737 ! <SUBROUTINE NAME="compute_mrs_3d" INTERFACE="compute_mrs">
1738 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
1739 ! <IN NAME="press" UNIT="Pascals" TYPE="real" DIM="(:,:,:)"></IN>
1740 ! <OUT NAME="mrsat" UNITS="kg(vapor)/kg(dry air)" TYPE="real" DIM="(:,:,:)"></OUT>
1741 ! <IN NAME="mr" UNIT="kg(vapor)/kg(dry air)" TYPE="real" DIM="(:,:,:)"></IN>
1742 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)"></IN>
1743 ! <OUT NAME="dmrsdT" UNIT="kg(vapor)/kg(dry air)/ degree Kelvin" TYPE="real" DIM="(:,:,:)"></OUT>
1744 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(:,:,:)"> </OUT>
1745 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1746 ! </SUBROUTINE>
1747  subroutine compute_mrs_3d_ ( temp, press, mrsat, mr, hc, dmrsdT, esat,&
1748  err_msg, es_over_liq, es_over_liq_and_ice )
1749 
1750  real(kind=fms_svp_kind_), intent(in) :: temp(:,:,:) !< temperature in degrees Kelvin (K)
1751  real(kind=fms_svp_kind_), intent(in) :: press(:,:,:) !< pressure
1752  real(kind=fms_svp_kind_), intent(out) :: mrsat(:,:,:) !< mixing ratio at relative humidity
1753  real(kind=fms_svp_kind_), intent(in), optional :: mr(:,:,:) !< vapor mixing ratio
1754  real(kind=fms_svp_kind_), intent(in), optional :: hc !< relative humidity
1755  real(kind=fms_svp_kind_), intent(out), optional :: dmrsdt(:,:,:) !< d(mrsat)/dT
1756  real(kind=fms_svp_kind_), intent(out), optional :: esat(:,:,:) !< saturation vapor pressure
1757  character(len=*), intent(out), optional :: err_msg
1758  logical,intent(in), optional :: es_over_liq
1759  logical,intent(in), optional :: es_over_liq_and_ice
1760 
1761  integer :: nbad !< if temperature is out of range
1762  character(len=128) :: err_msg_tmp
1763  !> EPSILO and ZVIR are module level variables that are declared in r8_kind.
1764  !! Thus they need to be converted to FMS_SVP_KIND_
1765  real(kind=fms_svp_kind_), parameter :: epsilol=real(epsilo,fms_svp_kind_)
1766  real(kind=fms_svp_kind_), parameter :: zvirl=real(zvir,fms_svp_kind_)
1767 
1768  if (.not.module_is_initialized) then
1769  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1770  endif
1771 
1772  if (present(es_over_liq)) then
1773  if (.not. (construct_table_wrt_liq)) then
1774  call error_mesg ('compute_mrs', &
1775  'requesting es wrt liq, but that table not constructed', &
1776  fatal)
1777  endif
1778  endif
1779  if (present(es_over_liq_and_ice)) then
1780  if (.not. (construct_table_wrt_liq_and_ice)) then
1781  call error_mesg ('compute_qs', &
1782  'requesting es wrt liq and ice, but that table not constructed', &
1783  fatal)
1784  endif
1785  endif
1786 
1787 ! call compute_mrs_k (temp, press, EPSILO, ZVIR, mrsat, &
1788 ! nbad, mr, dmrsdT)
1789  call compute_mrs_k (temp, press, epsilol, zvirl, mrsat, nbad, mr, &
1790  hc, dmrsdt, esat, es_over_liq, es_over_liq_and_ice)
1791 
1792  if ( nbad == 0 ) then
1793  if(present(err_msg)) err_msg = ''
1794  else
1795  if(show_bad_value_count_by_slice) call temp_check ( temp )
1796  if(show_all_bad_values) call show_all_bad ( temp )
1797  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1798  if(fms_error_handler('compute_mrs',err_msg_tmp,err_msg)) return
1799  endif
1800 
1801  end subroutine compute_mrs_3d_
1802 
1803 
1804 !#######################################################################
1805 
1806  function check_1d_ ( temp ) result ( nbad )
1807  real(kind=fms_svp_kind_) , intent(in) :: temp(:) !< temperature in degrees Kelvin (K)
1808  integer :: nbad, ind, i
1809 
1810  !> DTINV, TMIN, TEPS are module level variables declared in r8_kind
1811  !! Thus they need to be converted to FMS_SVP_KIND_
1812  real(fms_svp_kind_) :: dtinvll !< local version of module variable dtinvl
1813  real(fms_svp_kind_) :: tminll !< local version of module variable tminl
1814  real(fms_svp_kind_) :: tepsll !< local version of module variable tepsl
1815 
1816  dtinvll=real(dtinv,fms_svp_kind_)
1817  tminll=real(tmin,fms_svp_kind_)
1818  tepsll=real(teps,fms_svp_kind_)
1819 
1820  nbad = 0
1821  do i = 1, size(temp,1)
1822  ind = int( dtinvll*(temp(i)-tminll + tepsll) )
1823  if (ind < 0 .or. ind > nlim) nbad = nbad+1
1824  enddo
1825 
1826  end function check_1d_
1827 
1828 !------------------------------------------------
1829 
1830  function check_2d_ ( temp ) result ( nbad )
1831  real(kind=fms_svp_kind_) , intent(in) :: temp(:,:) !< temperature in degrees Kelvin (K)
1832  integer :: nbad
1833  integer :: j
1834 
1835  nbad = 0
1836  do j = 1, size(temp,2)
1837  nbad = nbad + check_1d( temp(:,j) )
1838  enddo
1839  end function check_2d_
1840 
1841 !#######################################################################
1842 
1843  subroutine temp_check_1d_ ( temp )
1844  real(kind=fms_svp_kind_) , intent(in) :: temp(:) !< temperature in degrees Kelvin (K)
1845  integer :: i, iunit
1846 
1847  iunit = stdoutunit
1848  write(iunit,*) 'Bad temperatures (dimension 1): ', (check_1d(temp(i:i)),i=1,size(temp,1))
1849 
1850  end subroutine temp_check_1d_
1851 
1852 !--------------------------------------------------------------
1853 
1854  subroutine temp_check_2d_ ( temp )
1855  real(kind=fms_svp_kind_) , intent(in) :: temp(:,:) !< temperature in degrees Kelvin (K)
1856  integer :: i, j, iunit
1857 
1858  iunit = stdoutunit
1859  write(iunit,*) 'Bad temperatures (dimension 1): ', (check_1d(temp(i,:)),i=1,size(temp,1))
1860  write(iunit,*) 'Bad temperatures (dimension 2): ', (check_1d(temp(:,j)),j=1,size(temp,2))
1861 
1862  end subroutine temp_check_2d_
1863 
1864 !--------------------------------------------------------------
1865 
1866  subroutine temp_check_3d_ ( temp )
1867  real(kind=fms_svp_kind_), intent(in) :: temp(:,:,:) !< temperature in degrees Kelvin (K)
1868  integer :: i, j, k, iunit
1869 
1870  iunit = stdoutunit
1871  write(iunit,*) 'Bad temperatures (dimension 1): ', (check_2d(temp(i,:,:)),i=1,size(temp,1))
1872  write(iunit,*) 'Bad temperatures (dimension 2): ', (check_2d(temp(:,j,:)),j=1,size(temp,2))
1873  write(iunit,*) 'Bad temperatures (dimension 3): ', (check_2d(temp(:,:,k)),k=1,size(temp,3))
1874 
1875  end subroutine temp_check_3d_
1876 
1877 !#######################################################################
1878 
1879  subroutine show_all_bad_0d_ ( temp )
1880  real(kind=fms_svp_kind_) , intent(in) :: temp !< temperature in degrees Kelvin (K)
1881  integer :: ind, iunit
1882  !> DTINV, TMIN, TEPS are module level variables declared in r8_kind
1883  !! Thus they need to be converted to FMS_SVP_KIND_
1884  real(FMS_SVP_KIND_) :: dtinvll !< local version of module variable dtinvl
1885  real(FMS_SVP_KIND_) :: tminll !< local version of module variable tminl
1886  real(FMS_SVP_KIND_) :: tepsll !< local version of module variable tepsl
1887 
1888  dtinvll=real(dtinv,fms_svp_kind_)
1889  tminll=real(tmin,fms_svp_kind_)
1890  tepsll=real(teps,fms_svp_kind_)
1891 
1892  iunit = stdoutunit
1893  ind = int( dtinvll*(temp-tminll+tepsll) )
1894  if (ind < 0 .or. ind > nlim) then
1895  write(iunit,'(a,e10.3,a,i6)') 'Bad temperature=',temp,' pe=',mpp_pe()
1896  endif
1897 
1898  end subroutine show_all_bad_0d_
1899 
1900 !--------------------------------------------------------------
1901 
1902  subroutine show_all_bad_1d_ ( temp )
1903  real(kind=fms_svp_kind_) , intent(in) :: temp(:) !< temperature in degrees Kelvin (K)
1904  integer :: i, ind, iunit
1905  !> DTINV, TMIN, TEPS are module level variables declared in r8_kind
1906  !! Thus they need to be converted to FMS_SVP_KIND_
1907  real(FMS_SVP_KIND_) :: dtinvll !< local version of module variable dtinvl
1908  real(FMS_SVP_KIND_) :: tminll !< local version of module variable tminl
1909  real(FMS_SVP_KIND_) :: tepsll !< local version of module variable tepsl
1910 
1911  dtinvll=real(dtinv,fms_svp_kind_)
1912  tminll=real(tmin,fms_svp_kind_)
1913  tepsll=real(teps,fms_svp_kind_)
1914 
1915  iunit = stdoutunit
1916  do i=1,size(temp)
1917  ind = int( dtinvll*(temp(i)-tminll+tepsll) )
1918  if (ind < 0 .or. ind > nlim) then
1919  write(iunit,'(a,e10.3,a,i4,a,i6)') 'Bad temperature=',temp(i),' at i=',i,' pe=',mpp_pe()
1920  endif
1921  enddo
1922 
1923  end subroutine show_all_bad_1d_
1924 
1925 !--------------------------------------------------------------
1926 
1927  subroutine show_all_bad_2d_ ( temp )
1928  real(kind=fms_svp_kind_) , intent(in) :: temp(:,:) !< temperature in degrees Kelvin (K)
1929  integer :: i, j, ind, iunit
1930  !> DTINV, TMIN, TEPS are module level variables declared in r8_kind
1931  !! Thus they need to be converted to FMS_SVP_KIND_
1932  real(FMS_SVP_KIND_) :: dtinvll !< local version of module variable dtinvl
1933  real(FMS_SVP_KIND_) :: tminll !< local version of module variable tminl
1934  real(FMS_SVP_KIND_) :: tepsll !< local version of module variable tepsl
1935 
1936  dtinvll=real(dtinv,fms_svp_kind_)
1937  tminll=real(tmin,fms_svp_kind_)
1938  tepsll=real(teps,fms_svp_kind_)
1939 
1940  iunit = stdoutunit
1941  do j=1,size(temp,2)
1942  do i=1,size(temp,1)
1943  ind = int( dtinvll*(temp(i,j)-tminll+tepsll) )
1944  if (ind < 0 .or. ind > nlim) then
1945  write(iunit,'(a,e10.3,a,i4,a,i4,a,i6)') 'Bad temperature=',temp(i,j),' at i=',i,' j=',j,' pe=',mpp_pe()
1946  endif
1947  enddo
1948  enddo
1949 
1950  end subroutine show_all_bad_2d_
1951 
1952 !--------------------------------------------------------------
1953 
1954  subroutine show_all_bad_3d_ ( temp )
1955  real(kind=fms_svp_kind_), intent(in) :: temp(:,:,:) !< temperature in degrees Kelvin (K)
1956  integer :: i, j, k, ind, iunit
1957  !> DTINV, TMIN, TEPS are module level variables declared in r8_kind
1958  !! Thus they need to be converted to FMS_SVP_KIND_
1959  real(FMS_SVP_KIND_) :: dtinvll !< local version of module variable dtinvl
1960  real(FMS_SVP_KIND_) :: tminll !< local version of module variable tminl
1961  real(FMS_SVP_KIND_) :: tepsll !< local version of module variable tepsl
1962 
1963  dtinvll=real(dtinv,fms_svp_kind_)
1964  tminll=real(tmin,fms_svp_kind_)
1965  tepsll=real(teps,fms_svp_kind_)
1966 
1967  iunit = stdoutunit
1968  do k=1,size(temp,3)
1969  do j=1,size(temp,2)
1970  do i=1,size(temp,1)
1971  ind = int( dtinvll*(temp(i,j,k)-tminll+tepsll) )
1972  if (ind < 0 .or. ind > nlim) then
1973  write(iunit,'(a,e10.3,a,i4,a,i4,a,i4,a,i6)') 'Bad temperature=',temp(i,j,k),' at i=',i,' j=',j,' k=',k, &
1974  & ' pe=',mpp_pe()
1975  endif
1976  enddo
1977  enddo
1978  enddo
1979 
1980  end subroutine show_all_bad_3d_
1981 
1982 !--------------------------------------------------------------
1983 
1984 !> @}
mpp_pe
integer function mpp_pe()
Returns processor ID.
Definition: mpp_util.inc:407
lookup_es_3d_
subroutine lookup_es_3d_(temp, esat, err_msg)
Definition: sat_vapor_pres.inc:133
lookup_des_2d_
subroutine lookup_des_2d_(temp, desat, err_msg)
Definition: sat_vapor_pres.inc:512
lookup_des_1d_
subroutine lookup_des_1d_(temp, desat, err_msg)
Definition: sat_vapor_pres.inc:475
lookup_es3_des3_0d_
subroutine lookup_es3_des3_0d_(temp, esat, desat, err_msg)
Definition: sat_vapor_pres.inc:1133
lookup_des3_1d_
subroutine lookup_des3_1d_(temp, desat, err_msg)
Definition: sat_vapor_pres.inc:745
lookup_es2_3d_
subroutine lookup_es2_3d_(temp, esat, err_msg)
Definition: sat_vapor_pres.inc:270
lookup_es2_des2_1d_
subroutine lookup_es2_des2_1d_(temp, esat, desat, err_msg)
Definition: sat_vapor_pres.inc:1026
temp_check_2d_
subroutine temp_check_2d_(temp)
Definition: sat_vapor_pres.inc:1855
compute_qs_2d_
subroutine compute_qs_2d_(temp, press, qsat, q, hc, dqsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
Definition: sat_vapor_pres.inc:1411
lookup_es_des_1d_
subroutine lookup_es_des_1d_(temp, esat, desat, err_msg)
Definition: sat_vapor_pres.inc:886
lookup_es_des_3d_
subroutine lookup_es_des_3d_(temp, esat, desat, err_msg)
Definition: sat_vapor_pres.inc:956
lookup_des3_2d_
subroutine lookup_des3_2d_(temp, desat, err_msg)
Definition: sat_vapor_pres.inc:782
compute_qs_1d_
subroutine compute_qs_1d_(temp, press, qsat, q, hc, dqsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
Definition: sat_vapor_pres.inc:1343
lookup_des3_0d_
subroutine lookup_des3_0d_(temp, desat, err_msg)
Definition: sat_vapor_pres.inc:713
lookup_es2_1d_
subroutine lookup_es2_1d_(temp, esat, err_msg)
Definition: sat_vapor_pres.inc:198
compute_mrs_3d_
subroutine compute_mrs_3d_(temp, press, mrsat, mr, hc, dmrsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
Definition: sat_vapor_pres.inc:1749
lookup_des_3d_
subroutine lookup_des_3d_(temp, desat, err_msg)
Definition: sat_vapor_pres.inc:546
lookup_es3_1d_
subroutine lookup_es3_1d_(temp, esat, err_msg)
Definition: sat_vapor_pres.inc:335
lookup_es_2d_
subroutine lookup_es_2d_(temp, esat, err_msg)
Definition: sat_vapor_pres.inc:97
lookup_es2_des2_3d_
subroutine lookup_es2_des2_3d_(temp, esat, desat, err_msg)
Definition: sat_vapor_pres.inc:1096
temp_check_3d_
subroutine temp_check_3d_(temp)
Definition: sat_vapor_pres.inc:1867
lookup_des3_3d_
subroutine lookup_des3_3d_(temp, desat, err_msg)
Definition: sat_vapor_pres.inc:816
lookup_es3_des3_3d_
subroutine lookup_es3_des3_3d_(temp, esat, desat, err_msg)
Definition: sat_vapor_pres.inc:1237
lookup_es3_3d_
subroutine lookup_es3_3d_(temp, esat, err_msg)
Definition: sat_vapor_pres.inc:407
compute_qs_3d_
subroutine compute_qs_3d_(temp, press, qsat, q, hc, dqsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
Definition: sat_vapor_pres.inc:1478
lookup_es_des_0d_
subroutine lookup_es_des_0d_(temp, esat, desat, err_msg)
Definition: sat_vapor_pres.inc:852
lookup_es_des_2d_
subroutine lookup_es_des_2d_(temp, esat, desat, err_msg)
Definition: sat_vapor_pres.inc:921
compute_mrs_0d_
subroutine compute_mrs_0d_(temp, press, mrsat, mr, hc, dmrsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
Definition: sat_vapor_pres.inc:1547
lookup_es2_0d_
subroutine lookup_es2_0d_(temp, esat, err_msg)
Definition: sat_vapor_pres.inc:166
lookup_es2_2d_
subroutine lookup_es2_2d_(temp, esat, err_msg)
Definition: sat_vapor_pres.inc:234
lookup_des2_0d_
subroutine lookup_des2_0d_(temp, desat, err_msg)
Definition: sat_vapor_pres.inc:578
lookup_es_1d_
subroutine lookup_es_1d_(temp, esat, err_msg)
Definition: sat_vapor_pres.inc:61
show_all_bad_2d_
subroutine show_all_bad_2d_(temp)
Definition: sat_vapor_pres.inc:1928
show_all_bad_1d_
subroutine show_all_bad_1d_(temp)
Definition: sat_vapor_pres.inc:1903
lookup_es3_des3_2d_
subroutine lookup_es3_des3_2d_(temp, esat, desat, err_msg)
Definition: sat_vapor_pres.inc:1202
compute_mrs_2d_
subroutine compute_mrs_2d_(temp, press, mrsat, mr, hc, dmrsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
Definition: sat_vapor_pres.inc:1681
temp_check_1d_
subroutine temp_check_1d_(temp)
Definition: sat_vapor_pres.inc:1844
compute_mrs_1d_
subroutine compute_mrs_1d_(temp, press, mrsat, mr, hc, dmrsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
Definition: sat_vapor_pres.inc:1613
lookup_des2_3d_
subroutine lookup_des2_3d_(temp, desat, err_msg)
Definition: sat_vapor_pres.inc:681
lookup_es3_2d_
subroutine lookup_es3_2d_(temp, esat, err_msg)
Definition: sat_vapor_pres.inc:371
lookup_des2_1d_
subroutine lookup_des2_1d_(temp, desat, err_msg)
Definition: sat_vapor_pres.inc:610
lookup_es_0d_
subroutine lookup_es_0d_(temp, esat, err_msg)
Definition: sat_vapor_pres.inc:29
lookup_es2_des2_0d_
subroutine lookup_es2_des2_0d_(temp, esat, desat, err_msg)
Definition: sat_vapor_pres.inc:992
check_2d_
integer function check_2d_(temp)
Definition: sat_vapor_pres.inc:1831
lookup_es2_des2_2d_
subroutine lookup_es2_des2_2d_(temp, esat, desat, err_msg)
Definition: sat_vapor_pres.inc:1061
lookup_des_0d_
subroutine lookup_des_0d_(temp, desat, err_msg)
Definition: sat_vapor_pres.inc:443
show_all_bad_0d_
subroutine show_all_bad_0d_(temp)
Definition: sat_vapor_pres.inc:1880
lookup_des2_2d_
subroutine lookup_des2_2d_(temp, desat, err_msg)
Definition: sat_vapor_pres.inc:647
check_1d_
integer function check_1d_(temp)
Definition: sat_vapor_pres.inc:1807
compute_qs_0d_
subroutine compute_qs_0d_(temp, press, qsat, q, hc, dqsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
Definition: sat_vapor_pres.inc:1277
lookup_es3_des3_1d_
subroutine lookup_es3_des3_1d_(temp, esat, desat, err_msg)
Definition: sat_vapor_pres.inc:1167
show_all_bad_3d_
subroutine show_all_bad_3d_(temp)
Definition: sat_vapor_pres.inc:1955
lookup_es3_0d_
subroutine lookup_es3_0d_(temp, esat, err_msg)
Definition: sat_vapor_pres.inc:303