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