FV3 Bundle
sat_vapor_pres.F90
Go to the documentation of this file.
1 !***********************************************************************
2 !* GNU Lesser General Public License
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* FMS is free software: you can redistribute it and/or modify it under
7 !* the terms of the GNU Lesser General Public License as published by
8 !* the Free Software Foundation, either version 3 of the License, or (at
9 !* your option) any later version.
10 !*
11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 !* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 !* for more details.
15 !*
16 !* You should have received a copy of the GNU Lesser General Public
17 !* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18 !***********************************************************************
19 
21 
22 !-----------------------------------------------------------------------
23 !
24 ! saturation vapor pressure lookup
25 ! saturation vapor specific humidity calculation
26 ! saturation vapor mixing ratio calculation
27 !
28 ! routines for computing the saturation vapor pressure (es),
29 ! the specific humidity (qs) and vapor mixing ratio (mrs) at
30 ! a specified relative humidity, the derivatives of es, qs and mrs
31 ! with respect to temperature, and initialization of the
32 ! look-up table.
33 !
34 !-----------------------------------------------------------------------
35 !
36 ! usage
37 ! -----
38 !
39 ! call lookup_es (temp, es, err_msg)
40 !
41 ! call lookup_des (temp, des, err_msg)
42 !
43 ! call lookup_es_des (temp, es, des, err_msg)
44 !
45 ! call lookup_es2 (temp, es, err_msg)
46 !
47 ! call lookup_des2 (temp, des, err_msg)
48 !
49 ! call lookup_es2_des2 (temp, es, des, err_msg)
50 !
51 ! call compute_qs (temp, press, qs, q, hc, dqsdT, esat,
52 ! err_msg, es_over_liq)
53 !
54 ! call compute_mrs (temp, press, mrs, mr, hc, dmrsdT, esat,
55 ! err_msg, es_over_liq)
56 !
57 ! arguments
58 ! ---------
59 ! temp intent in temperature in degrees kelvin
60 ! es intent out saturation vapor pressure in Pascals
61 ! des intent out derivative of saturation vapor pressure
62 ! with respect to temperature
63 ! (Pascals/degree)
64 ! press intent in atmospheric pressure in Pascals
65 ! qs intent out specific humidity at relative humidity hc
66 ! (kg(vapor) / kg(moist air)
67 ! mrs intent out mixing ratio at relative humidity hc
68 ! (kg(vapor) / kg(dry air)
69 !
70 ! optional arguments
71 ! ------------------
72 ! q intent in vapor specific humidity
73 ! (kg(vapor) / kg(moist air)
74 ! hc intent in relative humidity at which output
75 ! fields are desired: default is 100 %
76 ! dqsdT intent out derivative of saturation specific
77 ! humidity with respect to temperature
78 ! (kg(vapor) / kg(moist air) /degree)
79 ! mr intent in vapor mixing ratio
80 ! (kg(vapor) / kg(dry air)
81 ! dmrsdT intent out derivative of saturation mixing ratio
82 ! with respect to temperature
83 ! (kg(vapor) / kg(dry air) /degree)
84 ! esat intent out saturation vapor pressure
85 ! (Pascals)
86 ! err_msg intent out character string to hold error message
87 ! es_over_liq
88 ! intent in use es table wrt liquid only
89 !
90 !-----------------------------------------------------------------------
91 
92 ! <CONTACT EMAIL="Bruce.Wyman@noaa.gov">
93 ! Bruce Wyman
94 ! </CONTACT>
95 
96 ! <HISTORY SRC="http://www.gfdl.noaa.gov/fms-cgi-bin/cvsweb.cgi/FMS/"/>
97 
98 ! <OVERVIEW>
99 ! Routines for determining the saturation vapor pressure
100 ! (<TT>ES</TT>), saturation vapor specific humidity and saturation
101 ! vapor mixing ratio, and their derivatives with respect to
102 ! temperature.
103 ! </OVERVIEW>
104 
105 ! <DESCRIPTION>
106 ! This module contains routines for determining the saturation vapor
107 ! pressure (<TT>ES</TT>) from lookup tables constructed using equations given
108 ! in the Smithsonian tables. The <TT>ES</TT> lookup tables are valid between
109 ! -160C and +100C (approx 113K to 373K).
110 
111 ! The values of <TT>ES</TT> are computed over ice from -160C to -20C,
112 ! over water from 0C to 100C, and a blended value (over water and ice)
113 ! from -20C to 0C.
114 
115 ! Routines are also included to calculate the saturation specific
116 ! humidity and saturation mixing ratio for vapor, and their deriv-
117 ! atives with respect to temperature. By default, the values returned
118 ! are those at saturation; optionally, values of q and mr at a spec-
119 ! ified relative humidity may instead be returned. Two forms are
120 ! available; the approximate form that has been traditionally used in
121 ! GCMs, and an exact form provided by SJ Lin in which saturation is
122 ! reached while maintaining constant pressure and temperature.
123 
124 ! This version was written for non-vector machines.
125 ! See the <LINK SRC="#NOTES">notes</LINK> section for details on vectorization.
126 
127 ! </DESCRIPTION>
128 
129 ! <PUBLIC>
130 ! Description summarizing public interface.
131 ! </PUBLIC>
132 
133  use constants_mod, only: tfreeze, rdgas, rvgas, hlv, es0
134  use fms_mod, only: write_version_number, stdout, stdlog, mpp_pe, mpp_root_pe, &
135  mpp_error, fatal, fms_error_handler, open_namelist_file, &
136  error_mesg, &
137  file_exist, check_nml_error
138  use mpp_io_mod, only: mpp_close
139  use mpp_mod, only: input_nml_file
142  lookup_es2_k, &
144  lookup_es3_k, &
147 
148 implicit none
149 private
150 
155 !public :: compute_es
156  public :: escomp, descomp ! for backward compatibility
157  ! use lookup_es, lookup_des instead
158 
159 !-----------------------------------------------------------------------
160 
161 ! <INTERFACE NAME="lookup_es">
162 
163 ! <OVERVIEW>
164 ! For the given temperatures, returns the saturation vapor pressures.
165 ! </OVERVIEW>
166 ! <DESCRIPTION>
167 ! For the given temperatures these routines return the
168 ! saturation vapor pressure (esat). The return values are derived from
169 ! lookup tables (see notes below).
170 ! </DESCRIPTION>
171 ! <TEMPLATE>
172 ! call lookup_es( temp, esat, err_msg )
173 ! </TEMPLATE>
174 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
175 ! Temperature in degrees Kelvin.
176 ! </IN>
177 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
178 ! Saturation vapor pressure in pascals.
179 ! May be a scalar, 1d, 2d, or 3d array.
180 ! Must have the same order and size as temp.
181 ! </OUT>
182 ! <OUT NAME="err_msg" UNITS=" " TYPE="character">
183 ! Character string containing error message to be returned to
184 ! calling routine.
185 ! </OUT>
186 ! <ERROR MSG="table overflow, nbad=##" STATUS="FATAL">
187 ! Temperature(s) provided to the saturation vapor pressure lookup
188 ! are outside the valid range of the lookup table (-160 to 100 deg C).
189 ! This may be due to a numerical instability in the model.
190 ! Information should have been printed to standard output to help
191 ! determine where the instability may have occurred.
192 ! If the lookup table needs a larger temperature range,
193 ! then parameters in the module header must be modified.
194 ! </ERROR> *
195 
196  interface lookup_es
198  end interface
199 ! for backward compatibility (to be removed soon)
200  interface escomp
202  end interface
203 ! </INTERFACE>
204 !-----------------------------------------------------------------------
205 ! <INTERFACE NAME="lookup_des">
206 
207 ! <OVERVIEW>
208 ! For the given temperatures, returns the derivative of saturation vapor pressure
209 ! with respect to temperature.
210 ! </OVERVIEW>
211 ! <DESCRIPTION>
212 ! For the given temperatures these routines return the derivative of esat w.r.t.
213 ! temperature (desat). The return values are derived from
214 ! lookup tables (see notes below).
215 ! </DESCRIPTION>
216 ! <TEMPLATE>
217 ! call lookup_des( temp, desat )
218 ! </TEMPLATE>
219 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
220 ! Temperature in degrees Kelvin.
221 ! </IN>
222 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
223 ! Derivative of saturation vapor pressure w.r.t. temperature
224 ! in pascals/degree. May be a scalar, 1d, 2d, or 3d array.
225 ! Must have the same order and size as temp.
226 ! </OUT>
227 ! <OUT NAME="err_msg" UNITS=" " TYPE="character">
228 ! Character string containing error message to be returned to
229 ! calling routine.
230 ! </OUT>
231 ! <ERROR MSG="table overflow, nbad=##" STATUS="FATAL">
232 ! Temperature(s) provided to the saturation vapor pressure lookup
233 ! are outside the valid range of the lookup table (-160 to 100 deg C).
234 ! This may be due to a numerical instability in the model.
235 ! Information should have been printed to standard output to help
236 ! determine where the instability may have occurred.
237 ! If the lookup table needs a larger temperature range,
238 ! then parameters in the module header must be modified.
239 ! </ERROR> *
240 
241  interface lookup_des
243  end interface
244 ! </INTERFACE>
245 ! for backward compatibility (to be removed soon)
246  interface descomp
248  end interface
249 
250 !-----------------------------------------------------------------------
251 
252 ! <INTERFACE NAME="lookup_es_des">
253 
254 ! <OVERVIEW>
255 ! For the given temperatures, returns the saturation vapor pressure
256 ! and the derivative of saturation vapor pressure with respect to
257 ! temperature.
258 ! </OVERVIEW>
259 ! <DESCRIPTION>
260 ! For the given temperatures these routines return the
261 ! saturation vapor pressure (esat) and the derivative of esat w.r.t
262 ! temperature (desat). The return values are derived from
263 ! lookup tables (see notes below).
264 ! </DESCRIPTION>
265 ! <TEMPLATE>
266 ! call lookup_es_des( temp, esat, desat, err_msg )
267 ! </TEMPLATE>
268 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
269 ! Temperature in degrees Kelvin.
270 ! </IN>
271 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
272 ! Saturation vapor pressure in pascals.
273 ! May be a scalar, 1d, 2d, or 3d array.
274 ! Must have the same order and size as temp.
275 ! </OUT>
276 ! <OUT NAME="desat" UNITS="pascal/ degree" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
277 ! Derivative of saturation vapor pressure w.r.t. temperature
278 ! in pascals/degree. May be a scalar, 1d, 2d, or 3d array.
279 ! Must have the same order and size as temp.
280 ! </OUT>
281 ! <OUT NAME="err_msg" UNITS=" " TYPE="character">
282 ! Character string containing error message to be returned to
283 ! calling routine.
284 ! </OUT>
285 ! <ERROR MSG="table overflow, nbad=##" STATUS="FATAL">
286 ! Temperature(s) provided to the saturation vapor pressure lookup
287 ! are outside the valid range of the lookup table (-160 to 100 deg C).
288 ! This may be due to a numerical instability in the model.
289 ! Information should have been printed to standard output to help
290 ! determine where the instability may have occurred.
291 ! If the lookup table needs a larger temperature range,
292 ! then parameters in the module header must be modified.
293 ! </ERROR> *
294 
295  interface lookup_es_des
297  end interface
298 
299  interface lookup_es2
301  end interface
302 
303  interface lookup_des2
305  end interface
306 
307  interface lookup_es2_des2
309  end interface
310 
311 
312  interface lookup_es3
314  end interface
315 
316  interface lookup_des3
318  end interface
319 
320  interface lookup_es3_des3
322  end interface
323 
324 !-----------------------------------------------------------------------
325 
326 ! <INTERFACE NAME="compute_qs">
327 
328 ! <OVERVIEW>
329 ! For the given temperatures, pressures and optionally vapor
330 ! specific humidity, returns the specific humidity at saturation
331 ! (optionally at relative humidity hc instead of at saturation) and
332 ! optionally the derivative of saturation specific humidity w.r.t.
333 ! temperature, and the saturation vapor pressure.
334 ! </OVERVIEW>
335 ! <DESCRIPTION>
336 ! For the input temperature and pressure these routines return the
337 ! specific humidity (qsat) at saturation (unless optional argument
338 ! hc is used to specify the relative humidity at which qsat should
339 ! apply) and, if desired, the derivative of qsat w.r.t temperature
340 ! (dqsdT) and / or the saturation vapor pressure (esat). If the
341 ! optional input argument specific humidity (q) is present, the
342 ! exact expression for qs is used; if q is not present the tradit-
343 ! ional form (valid at saturation) is used. if the optional qsat
344 ! derivative argument is present, the derivative of qsat w.r.t.
345 ! temperature will also be returned, defined consistent with the
346 ! expression used for qsat. The return values are derived from
347 ! lookup tables (see notes below).
348 ! </DESCRIPTION>
349 ! <TEMPLATE>
350 ! call compute_qs( temp, press, qsat, q, hc, dqsdT, esat, err_msg )
351 ! </TEMPLATE>
352 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
353 ! Temperature in degrees Kelvin.
354 ! </IN>
355 ! <IN NAME="press" UNIT="Pascals" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
356 ! Air pressure in Pascals.
357 ! </IN>
358 ! <OUT NAME="qsat" UNITS="kg(vapor) / kg(moist air)" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
359 ! Specific humidity in kg (vapor) / kg (moist air)
360 ! May be a scalar, 1d, 2d, or 3d array.
361 ! Must have the same order and size as temp.
362 ! </OUT>
363 ! <IN NAME="q" UNIT="kg(vapor) / kg (moist air)" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
364 ! Vapor specific humidity in kg (vapor) / kg (moist air).
365 ! If present, exact formulation for qsat and dqsdT will be used.
366 ! </IN>
367 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)">
368 ! Relative humidity at which output variables are desired.
369 ! If not present, values will apply at saturation.
370 ! </IN>
371 ! <OUT NAME="dqsdT" UNITS="kg(vapor) / kg(moist air) / degree" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
372 ! Derivative of saturation specific humidity w.r.t. temperature
373 ! in kg(vapor) / kg(moist air) / degree. May be a
374 ! scalar, 1d, 2d, or 3d array.
375 ! Must have the same order and size as temp.
376 ! </OUT>
377 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
378 ! Saturation vapor pressure. May be a scalar, 1d, 2d, or 3d array.
379 ! Must have the same order and size as temp.
380 ! </OUT>
381 ! <OUT NAME="err_msg" UNITS=" " TYPE="character">
382 ! Character string containing error message to be returned to
383 ! calling routine.
384 ! </OUT>
385 ! <ERROR MSG="table overflow, nbad=##" STATUS="FATAL">
386 ! Temperature(s) provided to the saturation vapor pressure lookup
387 ! are outside the valid range of the lookup table (-160 to 100 deg C).
388 ! This may be due to a numerical instability in the model.
389 ! Information should have been printed to standard output to help
390 ! determine where the instability may have occurred.
391 ! If the lookup table needs a larger temperature range,
392 ! then parameters in the module header must be modified.
393 ! </ERROR> *
394 
395  interface compute_qs
397  end interface
398 
399 !-----------------------------------------------------------------------
400 
401 ! <INTERFACE NAME="compute_mrs">
402 
403 ! <OVERVIEW>
404 ! For the given temperatures, pressures and optionally vapor
405 ! mixing ratio, returns the vapor mixing ratio at saturation
406 ! (optionally at relative humidity hc instead of at saturation) and
407 ! optionally the derivative of saturation vapor mixing ratio w.r.t.
408 ! temperature, and the saturation vapor pressure.
409 ! </OVERVIEW>
410 ! <DESCRIPTION>
411 ! For the input temperature and pressure these routines return the
412 ! vapor mixing ratio (mrsat) at saturation (unless optional argument
413 ! hc is used to specify the relative humidity at which mrsat should
414 ! apply) and, if desired, the derivative of mrsat w.r.t temperature
415 ! (dmrsdT) and / or the saturation vapor pressure (esat). If the
416 ! optional input argument specific humidity (mr) is present, the
417 ! exact expression for mrs is used; if qr is not present the tradit-
418 ! ional form (valid at saturation) is used. if the optional mrsat
419 ! derivative argument is present, the derivative of mrsat w.r.t.
420 ! temperature will also be returned, defined consistent with the
421 ! expression used for mrsat. The return values are derived from
422 ! lookup tables (see notes below).
423 ! </DESCRIPTION>
424 ! <TEMPLATE>
425 ! call compute_mrs( temp, press, mrsat, mr, hc, dmrsdT, esat,
426 ! err_msg )
427 ! </TEMPLATE>
428 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
429 ! Temperature in degrees Kelvin.
430 ! </IN>
431 ! <IN NAME="press" UNIT="Pascals" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
432 ! Air pressure in Pascals.
433 ! </IN>
434 ! <OUT NAME="mrsat" UNITS="kg(vapor) / kg (dry air)" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
435 ! Vapor mixing ratio in kg (vapor) / kg (dry air)
436 ! May be a scalar, 1d, 2d, or 3d array.
437 ! Must have the same order and size as temp.
438 ! </OUT>
439 ! <IN NAME="mr" UNIT="kg(vapor) / kg (dry air)" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
440 ! Vapor mixing ratio in kg (vapor) / kg (dry air).
441 ! If present, exact formulation for mrsat and dmrsdT will be used.
442 ! </IN>
443 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)">
444 ! Relative humidity at which output variables are desired.
445 ! If not present, values will apply at saturation.
446 ! </IN>
447 ! <OUT NAME="dmrsdT" UNITS="kg(vapor) / kg(dry air) / degree" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
448 ! Derivative of saturation vapor mixing ratio w.r.t. temperature
449 ! in kg(vapor) / kg(dry air) / degree. May be a
450 ! scalar, 1d, 2d, or 3d array.
451 ! Must have the same order and size as temp.
452 ! </OUT>
453 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
454 ! Saturation vapor pressure. May be a scalar, 1d, 2d, or 3d array.
455 ! Must have the same order and size as temp.
456 ! </OUT>
457 ! <OUT NAME="err_msg" UNITS=" " TYPE="character">
458 ! Character string containing error message to be returned to
459 ! calling routine.
460 ! </OUT>
461 ! <ERROR MSG="table overflow, nbad=##" STATUS="FATAL">
462 ! Temperature(s) provided to the saturation vapor pressure lookup
463 ! are outside the valid range of the lookup table (-160 to 100 deg C).
464 ! This may be due to a numerical instability in the model.
465 ! Information should have been printed to standard output to help
466 ! determine where the instability may have occurred.
467 ! If the lookup table needs a larger temperature range,
468 ! then parameters in the module header must be modified.
469 ! </ERROR> *
470 
471  interface compute_mrs
473  end interface
474 
475 !-----------------------------------------------------------------------
476 ! <INTERFACE NAME="compute_es">
477 
478 ! <OVERVIEW>
479 ! For the given temperatures, computes the saturation vapor pressures.
480 ! </OVERVIEW>
481 ! <DESCRIPTION>
482 ! Computes saturation vapor pressure for the given temperature using
483 ! the equations given in the Smithsonian Meteorological Tables.
484 ! Between -20C and 0C a blended value over ice and water is returned.
485 ! </DESCRIPTION>
486 ! <TEMPLATE>
487 ! es = compute_es ( temp )
488 ! </TEMPLATE>
489 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
490 ! Temperature in degrees Kelvin.
491 ! </IN>
492 ! <OUT NAME="es" UNITS="pascal" TYPE="real" DIM="(scalar),(:),(:,:),(:,:,:)">
493 ! Saturation vapor pressure in pascals.
494 ! May be a scalar, 1d, 2d, or 3d array.
495 ! Must have the same order and size as temp.
496 ! </OUT>
497 
498 !interface compute_es
499 ! module procedure compute_es_0d, compute_es_1d, compute_es_2d, compute_es_3d
500 !end interface
501 ! </INTERFACE>
502 !-----------------------------------------------------------------------
503  interface temp_check
504  module procedure temp_check_1d, temp_check_2d, temp_check_3d
505  end interface
506 
507  interface show_all_bad
509  end interface
510 !-----------------------------------------------------------------------
511 ! Include variable "version" to be written to log file.
512 #include<file_version.h>
513 
514  logical :: module_is_initialized = .false.
515 
516 !-----------------------------------------------------------------------
517 ! parameters for use in computing qs and mrs
518 
519  real, parameter :: epsilo = rdgas/rvgas
520  real, parameter :: zvir = rvgas/rdgas - 1.0
521 
522 !-----------------------------------------------------------------------
523 ! parameters for table size and resolution
524 
525  integer :: tcmin = -160 ! minimum temperature (degC) in lookup table
526  integer :: tcmax = 100 ! maximum temperature (degC) in lookup table
527  integer :: esres = 10 ! table resolution (increments per degree)
528  integer :: nsize ! (tcmax-tcmin)*esres+1 ! lookup table size
529  integer :: nlim ! nsize-1
530 
531  integer :: stdoutunit=0
532 !-----------------------------------------------------------------------
533 ! variables needed by temp_check
534  real :: tmin, dtinv, teps
535 
536 ! The default values below preserve the behavior of omsk and earlier revisions.
538  logical :: show_all_bad_values=.false.
539  logical :: use_exact_qs = .false.
540  logical :: do_simple =.false.
541  logical :: construct_table_wrt_liq = .false.
542  logical :: construct_table_wrt_liq_and_ice = .false.
543 
544  namelist / sat_vapor_pres_nml / show_bad_value_count_by_slice, show_all_bad_values, &
548 
549 contains
550 
551 !#######################################################################
552 ! <SUBROUTINE NAME="lookup_es_0d" INTERFACE="lookup_es">
553 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
554 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
555 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
556 ! </SUBROUTINE>
557  subroutine lookup_es_0d ( temp, esat, err_msg )
559  real, intent(in) :: temp
560  real, intent(out) :: esat
561  character(len=*), intent(out), optional :: err_msg
562 
563  integer :: nbad
564  character(len=128) :: err_msg_local
565 
566  if (.not.module_is_initialized) then
567  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
568  endif
569 
570  call lookup_es_k(temp, esat, nbad)
571 
572  if ( nbad == 0 ) then
573  if(present(err_msg)) err_msg = ''
574  else
575  if(show_all_bad_values) call show_all_bad ( temp )
576  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
577  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
578  endif
579 
580  end subroutine lookup_es_0d
581 
582 !#######################################################################
583 
584 ! <SUBROUTINE NAME="lookup_es_1d" INTERFACE="lookup_es">
585 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
586 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
587 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
588 ! </SUBROUTINE>
589  subroutine lookup_es_1d ( temp, esat, err_msg )
591  real, intent(in) :: temp(:)
592  real, intent(out) :: esat(:)
593  character(len=*), intent(out), optional :: err_msg
594 
595  character(len=54) :: err_msg_local
596  integer :: nbad
597 !-----------------------------------------------
598 
599  if (.not.module_is_initialized) then
600  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
601  endif
602 
603  call lookup_es_k(temp, esat, nbad)
604 
605  if ( nbad == 0 ) then
606  if(present(err_msg)) err_msg = ''
607  else
608  if(show_bad_value_count_by_slice) call temp_check ( temp )
609  if(show_all_bad_values) call show_all_bad ( temp )
610  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
611  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
612  endif
613 
614 !-----------------------------------------------
615 
616  end subroutine lookup_es_1d
617 
618 !#######################################################################
619 
620 ! <SUBROUTINE NAME="lookup_es_2d" INTERFACE="lookup_es">
621 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
622 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
623 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
624 ! </SUBROUTINE>
625  subroutine lookup_es_2d ( temp, esat, err_msg )
627  real, intent(in) :: temp(:,:)
628  real, intent(out) :: esat(:,:)
629  character(len=*), intent(out), optional :: err_msg
630 
631  character(len=54) :: err_msg_local
632  integer :: nbad
633 !-----------------------------------------------
634 
635  if (.not.module_is_initialized) then
636  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
637  endif
638 
639  call lookup_es_k(temp, esat, nbad)
640 
641  if ( nbad == 0 ) then
642  if(present(err_msg)) err_msg = ''
643  else
644  if(show_bad_value_count_by_slice) call temp_check ( temp )
645  if(show_all_bad_values) call show_all_bad ( temp )
646  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
647  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
648  endif
649 
650 !-----------------------------------------------
651 
652  end subroutine lookup_es_2d
653 
654 !#######################################################################
655 
656 ! <SUBROUTINE NAME="lookup_es_3d" INTERFACE="lookup_es">
657 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
658 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
659 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
660 ! </SUBROUTINE>
661  subroutine lookup_es_3d ( temp, esat, err_msg )
663  real, intent(in) :: temp(:,:,:)
664  real, intent(out) :: esat(:,:,:)
665  character(len=*), intent(out), optional :: err_msg
666 
667  integer :: nbad
668  character(len=128) :: err_msg_tmp
669 
670  if (.not.module_is_initialized) then
671  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
672  endif
673 
674  call lookup_es_k(temp, esat, nbad)
675 
676  if ( nbad == 0 ) then
677  if(present(err_msg)) err_msg = ''
678  else
679  if(show_bad_value_count_by_slice) call temp_check ( temp )
680  if(show_all_bad_values) call show_all_bad ( temp )
681  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
682  if(fms_error_handler('lookup_es',err_msg_tmp,err_msg)) return
683  endif
684 
685  end subroutine lookup_es_3d
686 
687 
688 !#######################################################################
689 ! <SUBROUTINE NAME="lookup_es2_0d" INTERFACE="lookup_es2">
690 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
691 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
692 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
693 ! </SUBROUTINE>
694  subroutine lookup_es2_0d ( temp, esat, err_msg )
696  real, intent(in) :: temp
697  real, intent(out) :: esat
698  character(len=*), intent(out), optional :: err_msg
699 
700  integer :: nbad
701  character(len=128) :: err_msg_local
702 
703  if (.not.module_is_initialized) then
704  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
705  endif
706 
707  call lookup_es2_k(temp, esat, nbad)
708 
709  if ( nbad == 0 ) then
710  if(present(err_msg)) err_msg = ''
711  else
712  if(show_all_bad_values) call show_all_bad ( temp )
713  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
714  if(fms_error_handler('lookup_es2',err_msg_local,err_msg)) return
715  endif
716 
717  end subroutine lookup_es2_0d
718 
719 !#######################################################################
720 
721 ! <SUBROUTINE NAME="lookup_es2_1d" INTERFACE="lookup_es2">
722 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
723 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
724 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
725 ! </SUBROUTINE>
726  subroutine lookup_es2_1d ( temp, esat, err_msg )
728  real, intent(in) :: temp(:)
729  real, intent(out) :: esat(:)
730  character(len=*), intent(out), optional :: err_msg
731 
732  character(len=54) :: err_msg_local
733  integer :: nbad
734 !-----------------------------------------------
735 
736  if (.not.module_is_initialized) then
737  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
738  endif
739 
740  call lookup_es2_k(temp, esat, nbad)
741 
742  if ( nbad == 0 ) then
743  if(present(err_msg)) err_msg = ''
744  else
745  if(show_bad_value_count_by_slice) call temp_check ( temp )
746  if(show_all_bad_values) call show_all_bad ( temp )
747  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
748  if(fms_error_handler('lookup_es2',err_msg_local,err_msg)) return
749  endif
750 
751 !-----------------------------------------------
752 
753  end subroutine lookup_es2_1d
754 
755 !#######################################################################
756 
757 ! <SUBROUTINE NAME="lookup_es2_2d" INTERFACE="lookup_es2">
758 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
759 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
760 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
761 ! </SUBROUTINE>
762  subroutine lookup_es2_2d ( temp, esat, err_msg )
764  real, intent(in) :: temp(:,:)
765  real, intent(out) :: esat(:,:)
766  character(len=*), intent(out), optional :: err_msg
767 
768  character(len=54) :: err_msg_local
769  integer :: nbad
770 !-----------------------------------------------
771 
772  if (.not.module_is_initialized) then
773  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
774  endif
775 
776  call lookup_es2_k(temp, esat, nbad)
777 
778  if ( nbad == 0 ) then
779  if(present(err_msg)) err_msg = ''
780  else
781  if(show_bad_value_count_by_slice) call temp_check ( temp )
782  if(show_all_bad_values) call show_all_bad ( temp )
783  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
784  if(fms_error_handler('lookup_es2',err_msg_local,err_msg)) return
785  endif
786 
787 !-----------------------------------------------
788 
789  end subroutine lookup_es2_2d
790 
791 !#######################################################################
792 
793 ! <SUBROUTINE NAME="lookup_es2_3d" INTERFACE="lookup_es2">
794 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
795 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
796 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
797 ! </SUBROUTINE>
798  subroutine lookup_es2_3d ( temp, esat, err_msg )
800  real, intent(in) :: temp(:,:,:)
801  real, intent(out) :: esat(:,:,:)
802  character(len=*), intent(out), optional :: err_msg
803 
804  integer :: nbad
805  character(len=128) :: err_msg_tmp
806 
807  if (.not.module_is_initialized) then
808  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
809  endif
810 
811  call lookup_es2_k(temp, esat, nbad)
812 
813  if ( nbad == 0 ) then
814  if(present(err_msg)) err_msg = ''
815  else
816  if(show_bad_value_count_by_slice) call temp_check ( temp )
817  if(show_all_bad_values) call show_all_bad ( temp )
818  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
819  if(fms_error_handler('lookup_es2',err_msg_tmp,err_msg)) return
820  endif
821 
822  end subroutine lookup_es2_3d
823 
824 
825 !#######################################################################
826 ! <SUBROUTINE NAME="lookup_es3_0d" INTERFACE="lookup_es3">
827 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
828 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
829 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
830 ! </SUBROUTINE>
831  subroutine lookup_es3_0d ( temp, esat, err_msg )
833  real, intent(in) :: temp
834  real, intent(out) :: esat
835  character(len=*), intent(out), optional :: err_msg
836 
837  integer :: nbad
838  character(len=128) :: err_msg_local
839 
840  if (.not.module_is_initialized) then
841  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
842  endif
843 
844  call lookup_es3_k(temp, esat, nbad)
845 
846  if ( nbad == 0 ) then
847  if(present(err_msg)) err_msg = ''
848  else
849  if(show_all_bad_values) call show_all_bad ( temp )
850  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
851  if(fms_error_handler('lookup_es3',err_msg_local,err_msg)) return
852  endif
853 
854  end subroutine lookup_es3_0d
855 
856 !#######################################################################
857 
858 ! <SUBROUTINE NAME="lookup_es3_1d" INTERFACE="lookup_es3">
859 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
860 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
861 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
862 ! </SUBROUTINE>
863  subroutine lookup_es3_1d ( temp, esat, err_msg )
865  real, intent(in) :: temp(:)
866  real, intent(out) :: esat(:)
867  character(len=*), intent(out), optional :: err_msg
868 
869  character(len=54) :: err_msg_local
870  integer :: nbad
871 !-----------------------------------------------
872 
873  if (.not.module_is_initialized) then
874  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
875  endif
876 
877  call lookup_es3_k(temp, esat, nbad)
878 
879  if ( nbad == 0 ) then
880  if(present(err_msg)) err_msg = ''
881  else
882  if(show_bad_value_count_by_slice) call temp_check ( temp )
883  if(show_all_bad_values) call show_all_bad ( temp )
884  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
885  if(fms_error_handler('lookup_es3',err_msg_local,err_msg)) return
886  endif
887 
888 !-----------------------------------------------
889 
890  end subroutine lookup_es3_1d
891 
892 !#######################################################################
893 
894 ! <SUBROUTINE NAME="lookup_es3_2d" INTERFACE="lookup_es3">
895 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
896 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
897 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
898 ! </SUBROUTINE>
899  subroutine lookup_es3_2d ( temp, esat, err_msg )
901  real, intent(in) :: temp(:,:)
902  real, intent(out) :: esat(:,:)
903  character(len=*), intent(out), optional :: err_msg
904 
905  character(len=54) :: err_msg_local
906  integer :: nbad
907 !-----------------------------------------------
908 
909  if (.not.module_is_initialized) then
910  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
911  endif
912 
913  call lookup_es3_k(temp, esat, nbad)
914 
915  if ( nbad == 0 ) then
916  if(present(err_msg)) err_msg = ''
917  else
918  if(show_bad_value_count_by_slice) call temp_check ( temp )
919  if(show_all_bad_values) call show_all_bad ( temp )
920  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
921  if(fms_error_handler('lookup_es3',err_msg_local,err_msg)) return
922  endif
923 
924 !-----------------------------------------------
925 
926  end subroutine lookup_es3_2d
927 
928 !#######################################################################
929 
930 ! <SUBROUTINE NAME="lookup_es3_3d" INTERFACE="lookup_es3">
931 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
932 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
933 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
934 ! </SUBROUTINE>
935  subroutine lookup_es3_3d ( temp, esat, err_msg )
937  real, intent(in) :: temp(:,:,:)
938  real, intent(out) :: esat(:,:,:)
939  character(len=*), intent(out), optional :: err_msg
940 
941  integer :: nbad
942  character(len=128) :: err_msg_tmp
943 
944  if (.not.module_is_initialized) then
945  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
946  endif
947 
948  call lookup_es3_k(temp, esat, nbad)
949 
950  if ( nbad == 0 ) then
951  if(present(err_msg)) err_msg = ''
952  else
953  if(show_bad_value_count_by_slice) call temp_check ( temp )
954  if(show_all_bad_values) call show_all_bad ( temp )
955  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
956  if(fms_error_handler('lookup_es3',err_msg_tmp,err_msg)) return
957  endif
958 
959  end subroutine lookup_es3_3d
960 
961 
962 !#######################################################################
963 ! routines for computing derivative of es
964 !#######################################################################
965 
966 ! <SUBROUTINE NAME="lookup_des_0d" INTERFACE="lookup_des">
967 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
968 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
969 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
970 ! </SUBROUTINE>
971  subroutine lookup_des_0d ( temp, desat, err_msg )
973  real, intent(in) :: temp
974  real, intent(out) :: desat
975  character(len=*), intent(out), optional :: err_msg
976 
977  integer :: nbad
978  character(len=128) :: err_msg_local
979 
980  if (.not.module_is_initialized) then
981  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
982  endif
983 
984  call lookup_des_k( temp, desat, nbad)
985 
986  if ( nbad == 0 ) then
987  if(present(err_msg)) err_msg = ''
988  else
989  if(show_all_bad_values) call show_all_bad ( temp )
990  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
991  if(fms_error_handler('lookup_des',err_msg_local,err_msg)) return
992  endif
993 
994  end subroutine lookup_des_0d
995 
996 !#######################################################################
997 
998 ! <SUBROUTINE NAME="lookup_des_1d" INTERFACE="lookup_des">
999 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
1000 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
1001 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1002 ! </SUBROUTINE>
1003  subroutine lookup_des_1d ( temp, desat, err_msg )
1005  real, intent(in) :: temp (:)
1006  real, intent(out) :: desat(:)
1007  character(len=*), intent(out), optional :: err_msg
1008 
1009  character(len=54) :: err_msg_local
1010  integer :: nbad
1011 !-----------------------------------------------
1012 
1013  if (.not.module_is_initialized) then
1014  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1015  endif
1016 
1017  if(present(err_msg)) err_msg=''
1018 
1019  call lookup_des_k(temp, desat, nbad)
1020 
1021  if ( nbad == 0 ) then
1022  if(present(err_msg)) err_msg = ''
1023  else
1024  if(show_bad_value_count_by_slice) call temp_check ( temp )
1025  if(show_all_bad_values) call show_all_bad ( temp )
1026  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1027  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
1028  endif
1029 !-----------------------------------------------
1030 
1031  end subroutine lookup_des_1d
1032 
1033 !#######################################################################
1034 
1035 ! <SUBROUTINE NAME="lookup_des_2d" INTERFACE="lookup_des">
1036 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
1037 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
1038 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1039 ! </SUBROUTINE>
1040  subroutine lookup_des_2d ( temp, desat, err_msg )
1042  real, intent(in) :: temp (:,:)
1043  real, intent(out) :: desat(:,:)
1044  character(len=*), intent(out), optional :: err_msg
1045 
1046  character(len=54) :: err_msg_local
1047  integer :: nbad
1048 !-----------------------------------------------
1049 
1050  if (.not.module_is_initialized) then
1051  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1052  endif
1053 
1054  call lookup_des_k(temp, desat, nbad)
1055 
1056  if ( nbad == 0 ) then
1057  if(present(err_msg)) err_msg = ''
1058  else
1059  if(show_bad_value_count_by_slice) call temp_check ( temp )
1060  if(show_all_bad_values) call show_all_bad ( temp )
1061  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1062  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
1063  endif
1064 !-----------------------------------------------
1065 
1066  end subroutine lookup_des_2d
1067 
1068 !#######################################################################
1069 ! <SUBROUTINE NAME="lookup_des_3d" INTERFACE="lookup_des">
1070 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
1071 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
1072 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1073 ! </SUBROUTINE>
1074  subroutine lookup_des_3d ( temp, desat, err_msg )
1076  real, intent(in) :: temp (:,:,:)
1077  real, intent(out) :: desat(:,:,:)
1078  character(len=*), intent(out), optional :: err_msg
1079 
1080  integer :: nbad
1081  character(len=128) :: err_msg_tmp
1082 
1083  if (.not.module_is_initialized) then
1084  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1085  endif
1086 
1087  call lookup_des_k( temp, desat, nbad )
1088 
1089  if ( nbad == 0 ) then
1090  if(present(err_msg)) err_msg=''
1091  else
1092  if(show_bad_value_count_by_slice) call temp_check ( temp )
1093  if(show_all_bad_values) call show_all_bad ( temp )
1094  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1095  if(fms_error_handler('lookup_des',err_msg_tmp,err_msg)) return
1096  endif
1097 
1098  end subroutine lookup_des_3d
1099 
1100 
1101 ! <SUBROUTINE NAME="lookup_des2_0d" INTERFACE="lookup_des2">
1102 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
1103 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
1104 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1105 ! </SUBROUTINE>
1106  subroutine lookup_des2_0d ( temp, desat, err_msg )
1108  real, intent(in) :: temp
1109  real, intent(out) :: desat
1110  character(len=*), intent(out), optional :: err_msg
1111 
1112  integer :: nbad
1113  character(len=128) :: err_msg_local
1114 
1115  if (.not.module_is_initialized) then
1116  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1117  endif
1118 
1119  call lookup_des2_k( temp, desat, nbad)
1120 
1121  if ( nbad == 0 ) then
1122  if(present(err_msg)) err_msg = ''
1123  else
1124  if(show_all_bad_values) call show_all_bad ( temp )
1125  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1126  if(fms_error_handler('lookup_des2',err_msg_local,err_msg)) return
1127  endif
1128 
1129  end subroutine lookup_des2_0d
1130 
1131 !#######################################################################
1132 
1133 ! <SUBROUTINE NAME="lookup_des2_1d" INTERFACE="lookup_des2">
1134 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
1135 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
1136 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1137 ! </SUBROUTINE>
1138  subroutine lookup_des2_1d ( temp, desat, err_msg )
1140  real, intent(in) :: temp (:)
1141  real, intent(out) :: desat(:)
1142  character(len=*), intent(out), optional :: err_msg
1143 
1144  character(len=54) :: err_msg_local
1145  integer :: nbad
1146 !-----------------------------------------------
1147 
1148  if (.not.module_is_initialized) then
1149  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1150  endif
1151 
1152  if(present(err_msg)) err_msg=''
1153 
1154  call lookup_des2_k(temp, desat, nbad)
1155 
1156  if ( nbad == 0 ) then
1157  if(present(err_msg)) err_msg = ''
1158  else
1159  if(show_bad_value_count_by_slice) call temp_check ( temp )
1160  if(show_all_bad_values) call show_all_bad ( temp )
1161  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1162  if(fms_error_handler('lookup_des2',err_msg_local,err_msg)) return
1163  endif
1164 !-----------------------------------------------
1165 
1166  end subroutine lookup_des2_1d
1167 
1168 !#######################################################################
1169 
1170 ! <SUBROUTINE NAME="lookup_des2_2d" INTERFACE="lookup_des2">
1171 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
1172 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
1173 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1174 ! </SUBROUTINE>
1175  subroutine lookup_des2_2d ( temp, desat, err_msg )
1177  real, intent(in) :: temp (:,:)
1178  real, intent(out) :: desat(:,:)
1179  character(len=*), intent(out), optional :: err_msg
1180 
1181  character(len=54) :: err_msg_local
1182  integer :: nbad
1183 !-----------------------------------------------
1184 
1185  if (.not.module_is_initialized) then
1186  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1187  endif
1188 
1189  call lookup_des2_k(temp, desat, nbad)
1190 
1191  if ( nbad == 0 ) then
1192  if(present(err_msg)) err_msg = ''
1193  else
1194  if(show_bad_value_count_by_slice) call temp_check ( temp )
1195  if(show_all_bad_values) call show_all_bad ( temp )
1196  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1197  if(fms_error_handler('lookup_des2',err_msg_local,err_msg)) return
1198  endif
1199 !-----------------------------------------------
1200 
1201  end subroutine lookup_des2_2d
1202 
1203 !#######################################################################
1204 ! <SUBROUTINE NAME="lookup_des2_3d" INTERFACE="lookup_des2">
1205 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
1206 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
1207 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1208 ! </SUBROUTINE>
1209  subroutine lookup_des2_3d ( temp, desat, err_msg )
1211  real, intent(in) :: temp (:,:,:)
1212  real, intent(out) :: desat(:,:,:)
1213  character(len=*), intent(out), optional :: err_msg
1214 
1215  integer :: nbad
1216  character(len=128) :: err_msg_tmp
1217 
1218  if (.not.module_is_initialized) then
1219  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1220  endif
1221 
1222  call lookup_des2_k( temp, desat, nbad )
1223 
1224  if ( nbad == 0 ) then
1225  if(present(err_msg)) err_msg=''
1226  else
1227  if(show_bad_value_count_by_slice) call temp_check ( temp )
1228  if(show_all_bad_values) call show_all_bad ( temp )
1229  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1230  if(fms_error_handler('lookup_des2',err_msg_tmp,err_msg)) return
1231  endif
1232 
1233  end subroutine lookup_des2_3d
1234 
1235 
1236 ! <SUBROUTINE NAME="lookup_des3_0d" INTERFACE="lookup_des3">
1237 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
1238 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
1239 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1240 ! </SUBROUTINE>
1241  subroutine lookup_des3_0d ( temp, desat, err_msg )
1243  real, intent(in) :: temp
1244  real, intent(out) :: desat
1245  character(len=*), intent(out), optional :: err_msg
1246 
1247  integer :: nbad
1248  character(len=128) :: err_msg_local
1249 
1250  if (.not.module_is_initialized) then
1251  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1252  endif
1253 
1254  call lookup_des3_k( temp, desat, nbad)
1255 
1256  if ( nbad == 0 ) then
1257  if(present(err_msg)) err_msg = ''
1258  else
1259  if(show_all_bad_values) call show_all_bad ( temp )
1260  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1261  if(fms_error_handler('lookup_des3',err_msg_local,err_msg)) return
1262  endif
1263 
1264  end subroutine lookup_des3_0d
1265 
1266 !#######################################################################
1267 
1268 ! <SUBROUTINE NAME="lookup_des3_1d" INTERFACE="lookup_des3">
1269 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
1270 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
1271 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1272 ! </SUBROUTINE>
1273  subroutine lookup_des3_1d ( temp, desat, err_msg )
1275  real, intent(in) :: temp (:)
1276  real, intent(out) :: desat(:)
1277  character(len=*), intent(out), optional :: err_msg
1278 
1279  character(len=54) :: err_msg_local
1280  integer :: nbad
1281 !-----------------------------------------------
1282 
1283  if (.not.module_is_initialized) then
1284  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1285  endif
1286 
1287  if(present(err_msg)) err_msg=''
1288 
1289  call lookup_des3_k(temp, desat, nbad)
1290 
1291  if ( nbad == 0 ) then
1292  if(present(err_msg)) err_msg = ''
1293  else
1294  if(show_bad_value_count_by_slice) call temp_check ( temp )
1295  if(show_all_bad_values) call show_all_bad ( temp )
1296  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1297  if(fms_error_handler('lookup_des3',err_msg_local,err_msg)) return
1298  endif
1299 !-----------------------------------------------
1300 
1301  end subroutine lookup_des3_1d
1302 
1303 !#######################################################################
1304 
1305 ! <SUBROUTINE NAME="lookup_des3_2d" INTERFACE="lookup_des3">
1306 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
1307 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
1308 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1309 ! </SUBROUTINE>
1310  subroutine lookup_des3_2d ( temp, desat, err_msg )
1312  real, intent(in) :: temp (:,:)
1313  real, intent(out) :: desat(:,:)
1314  character(len=*), intent(out), optional :: err_msg
1315 
1316  character(len=54) :: err_msg_local
1317  integer :: nbad
1318 !-----------------------------------------------
1319 
1320  if (.not.module_is_initialized) then
1321  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1322  endif
1323 
1324  call lookup_des3_k(temp, desat, nbad)
1325 
1326  if ( nbad == 0 ) then
1327  if(present(err_msg)) err_msg = ''
1328  else
1329  if(show_bad_value_count_by_slice) call temp_check ( temp )
1330  if(show_all_bad_values) call show_all_bad ( temp )
1331  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1332  if(fms_error_handler('lookup_des3',err_msg_local,err_msg)) return
1333  endif
1334 !-----------------------------------------------
1335 
1336  end subroutine lookup_des3_2d
1337 
1338 !#######################################################################
1339 ! <SUBROUTINE NAME="lookup_des3_3d" INTERFACE="lookup_des3">
1340 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
1341 ! <OUT NAME="desat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
1342 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1343 ! </SUBROUTINE>
1344  subroutine lookup_des3_3d ( temp, desat, err_msg )
1346  real, intent(in) :: temp (:,:,:)
1347  real, intent(out) :: desat(:,:,:)
1348  character(len=*), intent(out), optional :: err_msg
1349 
1350  integer :: nbad
1351  character(len=128) :: err_msg_tmp
1352 
1353  if (.not.module_is_initialized) then
1354  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1355  endif
1356 
1357  call lookup_des3_k( temp, desat, nbad )
1358 
1359  if ( nbad == 0 ) then
1360  if(present(err_msg)) err_msg=''
1361  else
1362  if(show_bad_value_count_by_slice) call temp_check ( temp )
1363  if(show_all_bad_values) call show_all_bad ( temp )
1364  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1365  if(fms_error_handler('lookup_des3',err_msg_tmp,err_msg)) return
1366  endif
1367 
1368  end subroutine lookup_des3_3d
1369 
1370 !========================================================================================================
1371 
1372 !#######################################################################
1373 
1374 ! <SUBROUTINE NAME="lookup_es_des_0d" INTERFACE="lookup_es_des">
1375 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
1376 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
1377 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(scalar)"></OUT>
1378 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1379 ! </SUBROUTINE>
1380  subroutine lookup_es_des_0d ( temp, esat, desat, err_msg )
1382  real, intent(in) :: temp
1383  real, intent(out) :: esat, desat
1384  character(len=*), intent(out), optional :: err_msg
1385 
1386  integer :: nbad
1387  character(len=128) :: err_msg_local
1388 
1389  if (.not.module_is_initialized) then
1390  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1391  endif
1392 
1393  call lookup_es_des_k(temp, esat, desat, nbad)
1394 
1395  if ( nbad == 0 ) then
1396  if(present(err_msg)) err_msg = ''
1397  else
1398  if(show_all_bad_values) call show_all_bad ( temp )
1399  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1400  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
1401  endif
1402 
1403  end subroutine lookup_es_des_0d
1404 
1405 !#######################################################################
1406 
1407 ! <SUBROUTINE NAME="lookup_es_des_1d" INTERFACE="lookup_es_des">
1408 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
1409 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
1410 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:)"></OUT>
1411 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1412 ! </SUBROUTINE>
1413  subroutine lookup_es_des_1d ( temp, esat, desat, err_msg )
1415  real, dimension(:), intent(in) :: temp
1416  real, dimension(:), intent(out) :: esat, desat
1417  character(len=*), intent(out), optional :: err_msg
1418 
1419  integer :: nbad
1420  character(len=128) :: err_msg_local
1421 
1422  if (.not.module_is_initialized) then
1423  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1424  endif
1425 
1426  call lookup_es_des_k(temp, esat, desat, nbad)
1427 
1428  if ( nbad == 0 ) then
1429  if(present(err_msg)) err_msg = ''
1430  else
1431  if(show_bad_value_count_by_slice) call temp_check ( temp )
1432  if(show_all_bad_values) call show_all_bad ( temp )
1433  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1434  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
1435  endif
1436 
1437  end subroutine lookup_es_des_1d
1438 
1439 !#######################################################################
1440 
1441 ! <SUBROUTINE NAME="lookup_es_des_2d" INTERFACE="lookup_es_des">
1442 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
1443 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
1444 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:,:)"></OUT>
1445 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1446 ! </SUBROUTINE>
1447  subroutine lookup_es_des_2d ( temp, esat, desat, err_msg )
1449  real, dimension(:,:), intent(in) :: temp
1450  real, dimension(:,:), intent(out) :: esat, desat
1451  character(len=*), intent(out), optional :: err_msg
1452 
1453  integer :: nbad
1454  character(len=128) :: err_msg_local
1455 
1456  if (.not.module_is_initialized) then
1457  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1458  endif
1459 
1460  call lookup_es_des_k(temp, esat, desat, nbad)
1461 
1462  if ( nbad == 0 ) then
1463  if(present(err_msg)) err_msg = ''
1464  else
1465  if(show_bad_value_count_by_slice) call temp_check ( temp )
1466  if(show_all_bad_values) call show_all_bad ( temp )
1467  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1468  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
1469  endif
1470 
1471  end subroutine lookup_es_des_2d
1472 
1473 !#######################################################################
1474 
1475 ! <SUBROUTINE NAME="lookup_es_des_3d" INTERFACE="lookup_es_des">
1476 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
1477 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
1478 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:,:,:)"></OUT>
1479 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1480 ! </SUBROUTINE>
1481  subroutine lookup_es_des_3d ( temp, esat, desat, err_msg )
1483  real, dimension(:,:,:), intent(in) :: temp
1484  real, dimension(:,:,:), intent(out) :: esat, desat
1485  character(len=*), intent(out), optional :: err_msg
1486 
1487  integer :: nbad
1488  character(len=128) :: err_msg_local
1489 
1490  if (.not.module_is_initialized) then
1491  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1492  endif
1493 
1494  call lookup_es_des_k(temp, esat, desat, nbad)
1495 
1496  if ( nbad == 0 ) then
1497  if(present(err_msg)) err_msg = ''
1498  else
1499  if(show_bad_value_count_by_slice) call temp_check ( temp )
1500  if(show_all_bad_values) call show_all_bad ( temp )
1501  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1502  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
1503  endif
1504 
1505  end subroutine lookup_es_des_3d
1506 
1507 !#######################################################################
1508 !#######################################################################
1509 
1510 ! <SUBROUTINE NAME="lookup_es2_des2_0d" INTERFACE="lookup_es2_des2">
1511 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
1512 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
1513 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(scalar)"></OUT>
1514 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1515 ! </SUBROUTINE>
1516  subroutine lookup_es2_des2_0d ( temp, esat, desat, err_msg )
1518  real, intent(in) :: temp
1519  real, intent(out) :: esat, desat
1520  character(len=*), intent(out), optional :: err_msg
1521 
1522  integer :: nbad
1523  character(len=128) :: err_msg_local
1524 
1525  if (.not.module_is_initialized) then
1526  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1527  endif
1528 
1529  call lookup_es2_des2_k(temp, esat, desat, nbad)
1530 
1531  if ( nbad == 0 ) then
1532  if(present(err_msg)) err_msg = ''
1533  else
1534  if(show_all_bad_values) call show_all_bad ( temp )
1535  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1536  if(fms_error_handler('lookup_es2_des2',err_msg_local,err_msg)) return
1537  endif
1538 
1539  end subroutine lookup_es2_des2_0d
1540 
1541 !#######################################################################
1542 
1543 ! <SUBROUTINE NAME="lookup_es2_des2_1d" INTERFACE="lookup_es2_des2">
1544 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
1545 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
1546 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:)"></OUT>
1547 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1548 ! </SUBROUTINE>
1549  subroutine lookup_es2_des2_1d ( temp, esat, desat, err_msg )
1551  real, dimension(:), intent(in) :: temp
1552  real, dimension(:), intent(out) :: esat, desat
1553  character(len=*), intent(out), optional :: err_msg
1554 
1555  integer :: nbad
1556  character(len=128) :: err_msg_local
1557 
1558  if (.not.module_is_initialized) then
1559  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1560  endif
1561 
1562  call lookup_es2_des2_k(temp, esat, desat, nbad)
1563 
1564  if ( nbad == 0 ) then
1565  if(present(err_msg)) err_msg = ''
1566  else
1567  if(show_bad_value_count_by_slice) call temp_check ( temp )
1568  if(show_all_bad_values) call show_all_bad ( temp )
1569  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1570  if(fms_error_handler('lookup_es2_des2',err_msg_local,err_msg)) return
1571  endif
1572 
1573  end subroutine lookup_es2_des2_1d
1574 
1575 !#######################################################################
1576 
1577 ! <SUBROUTINE NAME="lookup_es2_des2_2d" INTERFACE="lookup_es2_des2">
1578 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
1579 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
1580 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:,:)"></OUT>
1581 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1582 ! </SUBROUTINE>
1583  subroutine lookup_es2_des2_2d ( temp, esat, desat, err_msg )
1585  real, dimension(:,:), intent(in) :: temp
1586  real, dimension(:,:), intent(out) :: esat, desat
1587  character(len=*), intent(out), optional :: err_msg
1588 
1589  integer :: nbad
1590  character(len=128) :: err_msg_local
1591 
1592  if (.not.module_is_initialized) then
1593  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1594  endif
1595 
1596  call lookup_es2_des2_k(temp, esat, desat, nbad)
1597 
1598  if ( nbad == 0 ) then
1599  if(present(err_msg)) err_msg = ''
1600  else
1601  if(show_bad_value_count_by_slice) call temp_check ( temp )
1602  if(show_all_bad_values) call show_all_bad ( temp )
1603  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1604  if(fms_error_handler('lookup_es2_des2',err_msg_local,err_msg)) return
1605  endif
1606 
1607  end subroutine lookup_es2_des2_2d
1608 
1609 !#######################################################################
1610 
1611 ! <SUBROUTINE NAME="lookup_es2_des2_3d" INTERFACE="lookup_es2_des2">
1612 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
1613 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
1614 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:,:,:)"></OUT>
1615 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1616 ! </SUBROUTINE>
1617  subroutine lookup_es2_des2_3d ( temp, esat, desat, err_msg )
1619  real, dimension(:,:,:), intent(in) :: temp
1620  real, dimension(:,:,:), intent(out) :: esat, desat
1621  character(len=*), intent(out), optional :: err_msg
1622 
1623  integer :: nbad
1624  character(len=128) :: err_msg_local
1625 
1626  if (.not.module_is_initialized) then
1627  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1628  endif
1629 
1630  call lookup_es2_des2_k(temp, esat, desat, nbad)
1631 
1632  if ( nbad == 0 ) then
1633  if(present(err_msg)) err_msg = ''
1634  else
1635  if(show_bad_value_count_by_slice) call temp_check ( temp )
1636  if(show_all_bad_values) call show_all_bad ( temp )
1637  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1638  if(fms_error_handler('lookup_es2_des2',err_msg_local,err_msg)) return
1639  endif
1640 
1641  end subroutine lookup_es2_des2_3d
1642 
1643 
1644 !#######################################################################
1645 !#######################################################################
1646 
1647 ! <SUBROUTINE NAME="lookup_es3_des3_0d" INTERFACE="lookup_es3_des3">
1648 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
1649 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
1650 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(scalar)"></OUT>
1651 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1652 ! </SUBROUTINE>
1653  subroutine lookup_es3_des3_0d ( temp, esat, desat, err_msg )
1655  real, intent(in) :: temp
1656  real, intent(out) :: esat, desat
1657  character(len=*), intent(out), optional :: err_msg
1658 
1659  integer :: nbad
1660  character(len=128) :: err_msg_local
1661 
1662  if (.not.module_is_initialized) then
1663  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1664  endif
1665 
1666  call lookup_es3_des3_k(temp, esat, desat, nbad)
1667 
1668  if ( nbad == 0 ) then
1669  if(present(err_msg)) err_msg = ''
1670  else
1671  if(show_all_bad_values) call show_all_bad ( temp )
1672  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1673  if(fms_error_handler('lookup_es3_des3',err_msg_local,err_msg)) return
1674  endif
1675 
1676  end subroutine lookup_es3_des3_0d
1677 
1678 !#######################################################################
1679 
1680 ! <SUBROUTINE NAME="lookup_es3_des3_1d" INTERFACE="lookup_es3_des3">
1681 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
1682 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
1683 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:)"></OUT>
1684 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1685 ! </SUBROUTINE>
1686  subroutine lookup_es3_des3_1d ( temp, esat, desat, err_msg )
1688  real, dimension(:), intent(in) :: temp
1689  real, dimension(:), intent(out) :: esat, desat
1690  character(len=*), intent(out), optional :: err_msg
1691 
1692  integer :: nbad
1693  character(len=128) :: err_msg_local
1694 
1695  if (.not.module_is_initialized) then
1696  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1697  endif
1698 
1699  call lookup_es3_des3_k(temp, esat, desat, nbad)
1700 
1701  if ( nbad == 0 ) then
1702  if(present(err_msg)) err_msg = ''
1703  else
1704  if(show_bad_value_count_by_slice) call temp_check ( temp )
1705  if(show_all_bad_values) call show_all_bad ( temp )
1706  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1707  if(fms_error_handler('lookup_es3_des3',err_msg_local,err_msg)) return
1708  endif
1709 
1710  end subroutine lookup_es3_des3_1d
1711 
1712 !#######################################################################
1713 
1714 ! <SUBROUTINE NAME="lookup_es3_des3_2d" INTERFACE="lookup_es3_des3">
1715 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
1716 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
1717 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:,:)"></OUT>
1718 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1719 ! </SUBROUTINE>
1720  subroutine lookup_es3_des3_2d ( temp, esat, desat, err_msg )
1722  real, dimension(:,:), intent(in) :: temp
1723  real, dimension(:,:), intent(out) :: esat, desat
1724  character(len=*), intent(out), optional :: err_msg
1725 
1726  integer :: nbad
1727  character(len=128) :: err_msg_local
1728 
1729  if (.not.module_is_initialized) then
1730  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1731  endif
1732 
1733  call lookup_es3_des3_k(temp, esat, desat, nbad)
1734 
1735  if ( nbad == 0 ) then
1736  if(present(err_msg)) err_msg = ''
1737  else
1738  if(show_bad_value_count_by_slice) call temp_check ( temp )
1739  if(show_all_bad_values) call show_all_bad ( temp )
1740  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1741  if(fms_error_handler('lookup_es3_des3',err_msg_local,err_msg)) return
1742  endif
1743 
1744  end subroutine lookup_es3_des3_2d
1745 
1746 !#######################################################################
1747 
1748 ! <SUBROUTINE NAME="lookup_es3_des3_3d" INTERFACE="lookup_es3_des3">
1749 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
1750 ! <OUT NAME="esat" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
1751 ! <OUT NAME="desat" UNITS="pascal / degree" TYPE="real" DIM="(:,:,:)"></OUT>
1752 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1753 ! </SUBROUTINE>
1754  subroutine lookup_es3_des3_3d ( temp, esat, desat, err_msg )
1756  real, dimension(:,:,:), intent(in) :: temp
1757  real, dimension(:,:,:), intent(out) :: esat, desat
1758  character(len=*), intent(out), optional :: err_msg
1759 
1760  integer :: nbad
1761  character(len=128) :: err_msg_local
1762 
1763  if (.not.module_is_initialized) then
1764  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1765  endif
1766 
1767  call lookup_es3_des3_k(temp, esat, desat, nbad)
1768 
1769  if ( nbad == 0 ) then
1770  if(present(err_msg)) err_msg = ''
1771  else
1772  if(show_bad_value_count_by_slice) call temp_check ( temp )
1773  if(show_all_bad_values) call show_all_bad ( temp )
1774  write(err_msg_local,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1775  if(fms_error_handler('lookup_es3_des3',err_msg_local,err_msg)) return
1776  endif
1777 
1778  end subroutine lookup_es3_des3_3d
1779 
1780 !#######################################################################
1781 
1782 ! <SUBROUTINE NAME="compute_qs_0d" INTERFACE="compute_qs">
1783 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(SCALAR)"></IN>
1784 ! <IN NAME="press UNIT="Pascals" TYPE="real" DIM="(SCALAR)"></IN>
1785 ! <OUT NAME="qsat" UNITS="kg(vapor)/kg(moist air)" TYPE="real" DIM="(SCALAR)"></OUT>
1786 ! <IN NAME="q" UNIT="kg(vapor)/kg(moistair)" TYPE="real" DIM="(SCALAR)"></IN>
1787 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)"></IN>
1788 ! <OUT NAME="dqsdT" UNIT="kg(vapor)/kg(moistair)/ degree Kelvin" TYPE="real" DIM="(SCALAR)"></OUT>
1789 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(scalar)"> </OUT>
1790 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1791 ! </SUBROUTINE>
1792  subroutine compute_qs_0d ( temp, press, qsat, q, hc, dqsdT, esat, &
1793  err_msg, es_over_liq, es_over_liq_and_ice )
1795  real, intent(in) :: temp, press
1796  real, intent(out) :: qsat
1797  real, intent(in), optional :: q, hc
1798  real, intent(out), optional :: dqsdT, esat
1799  character(len=*), intent(out), optional :: err_msg
1800  logical,intent(in), optional :: es_over_liq
1801  logical,intent(in), optional :: es_over_liq_and_ice
1802 
1803  integer :: nbad
1804  character(len=128) :: err_msg_tmp
1805 
1806  if (.not.module_is_initialized) then
1807  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1808  endif
1809 
1810  if (present(es_over_liq)) then
1811  if (.not. (construct_table_wrt_liq)) then
1812  call error_mesg ('compute_qs', &
1813  'requesting es wrt liq, but that table not constructed', &
1814  fatal)
1815  endif
1816  endif
1817  if (present(es_over_liq_and_ice)) then
1818  if (.not. (construct_table_wrt_liq_and_ice)) then
1819  call error_mesg ('compute_qs', &
1820  'requesting es wrt liq and ice, but that table not constructed', &
1821  fatal)
1822  endif
1823  endif
1824 
1825  call compute_qs_k (temp, press, epsilo, zvir, qsat, nbad, q, hc, &
1826  dqsdt, esat, es_over_liq, es_over_liq_and_ice)
1827 
1828  if ( nbad == 0 ) then
1829  if(present(err_msg)) err_msg = ''
1830  else
1831  if(show_all_bad_values) call show_all_bad ( temp )
1832  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1833  if(fms_error_handler('compute_qs',err_msg_tmp,err_msg)) return
1834  endif
1835 
1836  end subroutine compute_qs_0d
1837 
1838 !#######################################################################
1839 
1840 ! <SUBROUTINE NAME="compute_qs_1d" INTERFACE="compute_qs">
1841 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
1842 ! <IN NAME="press UNIT="Pascals" TYPE="real" DIM="(:)"></IN>
1843 ! <OUT NAME="qsat" UNITS="kg(vapor)/kg(moist air)" TYPE="real" DIM="(:)"></OUT>
1844 ! <IN NAME="q" UNIT="kg(vapor)/kg(moistair)" TYPE="real" DIM="(:)"></IN>
1845 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)"></IN>
1846 ! <OUT NAME="dqsdT" UNIT="kg(vapor)/kg(moistair)/ degree Kelvin" TYPE="real" DIM="(:)"></OUT>
1847 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(:)"> </OUT>
1848 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1849 ! </SUBROUTINE>
1850  subroutine compute_qs_1d ( temp, press, qsat, q, hc, dqsdT, esat, &
1851  err_msg, es_over_liq, es_over_liq_and_ice )
1853  real, intent(in) :: temp(:), press(:)
1854  real, intent(out) :: qsat(:)
1855  real, intent(in), optional :: q(:)
1856 real, intent(in), optional :: hc
1857  real, intent(out), optional :: dqsdT(:), esat(:)
1858  character(len=*), intent(out), optional :: err_msg
1859  logical,intent(in), optional :: es_over_liq
1860  logical,intent(in), optional :: es_over_liq_and_ice
1861 
1862  integer :: nbad
1863  character(len=128) :: err_msg_tmp
1864 
1865  if (.not.module_is_initialized) then
1866  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1867  endif
1868 
1869  if (present(es_over_liq)) then
1870  if (.not. (construct_table_wrt_liq)) then
1871  call error_mesg ('compute_qs', &
1872  'requesting es wrt liq, but that table not constructed', &
1873  fatal)
1874  endif
1875  endif
1876  if (present(es_over_liq_and_ice)) then
1877  if (.not. (construct_table_wrt_liq_and_ice)) then
1878  call error_mesg ('compute_qs', &
1879  'requesting es wrt liq and ice, but that table not constructed', &
1880  fatal)
1881  endif
1882  endif
1883 
1884 ! call compute_qs_k (temp, press, EPSILO, ZVIR, qsat, nbad, q, dqsdT)
1885  call compute_qs_k (temp, press, epsilo, zvir, qsat, nbad, q, hc, &
1886  dqsdt, esat, es_over_liq, es_over_liq_and_ice)
1887 
1888  if ( nbad == 0 ) then
1889  if(present(err_msg)) err_msg = ''
1890  else
1891  if(show_bad_value_count_by_slice) call temp_check ( temp )
1892  if(show_all_bad_values) call show_all_bad ( temp )
1893  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1894  if(fms_error_handler('compute_qs',err_msg_tmp,err_msg)) return
1895  endif
1896 
1897  end subroutine compute_qs_1d
1898 
1899 
1900 !#######################################################################
1901 
1902 ! <SUBROUTINE NAME="compute_qs_2d" INTERFACE="compute_qs">
1903 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
1904 ! <IN NAME="press UNIT="Pascals" TYPE="real" DIM="(:,:)"></IN>
1905 ! <OUT NAME="qsat" UNITS="kg(vapor)/kg(moist air)" TYPE="real" DIM="(;,:)"></OUT>
1906 ! <IN NAME="q" UNIT="kg(vapor)/kg(moistair)" TYPE="real" DIM="(:,:)"></IN>
1907 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)"></IN>
1908 ! <OUT NAME="dqsdT" UNIT="kg(vapor)/kg(moistair)/ degree Kelvin" TYPE="real" DIM="(:,:)"></OUT>
1909 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(:,:)"> </OUT>
1910 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1911 ! </SUBROUTINE>
1912  subroutine compute_qs_2d ( temp, press, qsat, q, hc, dqsdT, esat, &
1913  err_msg, es_over_liq, es_over_liq_and_ice )
1915  real, intent(in) :: temp(:,:), press(:,:)
1916  real, intent(out) :: qsat(:,:)
1917  real, intent(in), optional :: q(:,:)
1918  real, intent(in), optional :: hc
1919  real, intent(out), optional :: dqsdT(:,:), esat(:,:)
1920  character(len=*), intent(out), optional :: err_msg
1921  logical,intent(in), optional :: es_over_liq
1922  logical,intent(in), optional :: es_over_liq_and_ice
1923 
1924  integer :: nbad
1925  character(len=128) :: err_msg_tmp
1926 
1927  if (.not.module_is_initialized) then
1928  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1929  endif
1930 
1931  if (present(es_over_liq)) then
1932  if (.not. (construct_table_wrt_liq)) then
1933  call error_mesg ('compute_qs', &
1934  'requesting es wrt liq, but that table not constructed', &
1935  fatal)
1936  endif
1937  endif
1938  if (present(es_over_liq_and_ice)) then
1939  if (.not. (construct_table_wrt_liq_and_ice)) then
1940  call error_mesg ('compute_qs', &
1941  'requesting es wrt liq and ice, but that table not constructed', &
1942  fatal)
1943  endif
1944  endif
1945 
1946 ! call compute_qs_k (temp, press, EPSILO, ZVIR, qsat, nbad, q, dqsdT)
1947  call compute_qs_k (temp, press, epsilo, zvir, qsat, nbad, q, hc, &
1948  dqsdt, esat, es_over_liq, es_over_liq_and_ice)
1949 
1950  if ( nbad == 0 ) then
1951  if(present(err_msg)) err_msg = ''
1952  else
1953  if(show_bad_value_count_by_slice) call temp_check ( temp )
1954  if(show_all_bad_values) call show_all_bad ( temp )
1955  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
1956  if(fms_error_handler('compute_qs',err_msg_tmp,err_msg)) return
1957  endif
1958 
1959  end subroutine compute_qs_2d
1960 
1961 !#######################################################################
1962 
1963 ! <SUBROUTINE NAME="compute_qs_3d" INTERFACE="compute_qs">
1964 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
1965 ! <IN NAME="press UNIT="Pascals" TYPE="real" DIM="(:,:,:)"></IN>
1966 ! <OUT NAME="qsat" UNITS="kg(vapor)/kg(moist air)" TYPE="real" DIM="(;,:,:)"></OUT>
1967 ! <IN NAME="q" UNIT="kg(vapor)/kg(moistair)" TYPE="real" DIM="(:,:,:)"></IN>
1968 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)"></IN>
1969 ! <OUT NAME="dqsdT" UNIT="kg(vapor)/kg(moistair)/ degree Kelvin" TYPE="real" DIM="(:,:,:)"></OUT>
1970 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(:,:,:)"> </OUT>
1971 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
1972 ! </SUBROUTINE>
1973  subroutine compute_qs_3d ( temp, press, qsat, q, hc, dqsdT, esat, &
1974  err_msg, es_over_liq, es_over_liq_and_ice )
1976  real, intent(in) :: temp(:,:,:), press(:,:,:)
1977  real, intent(out) :: qsat(:,:,:)
1978  real, intent(in), optional :: q(:,:,:)
1979  real, intent(in), optional :: hc
1980  real, intent(out), optional :: dqsdT(:,:,:), esat(:,:,:)
1981  character(len=*), intent(out), optional :: err_msg
1982  logical,intent(in), optional :: es_over_liq
1983  logical,intent(in), optional :: es_over_liq_and_ice
1984 
1985  integer :: nbad
1986  character(len=128) :: err_msg_tmp
1987 
1988  if (.not.module_is_initialized) then
1989  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
1990  endif
1991 
1992  if (present(es_over_liq)) then
1993  if (.not. (construct_table_wrt_liq)) then
1994  call error_mesg ('compute_qs', &
1995  'requesting es wrt liq, but that table not constructed', &
1996  fatal)
1997  endif
1998  endif
1999  if (present(es_over_liq_and_ice)) then
2000  if (.not. (construct_table_wrt_liq_and_ice)) then
2001  call error_mesg ('compute_qs', &
2002  'requesting es wrt liq and ice, but that table not constructed', &
2003  fatal)
2004  endif
2005  endif
2006 
2007 ! call compute_qs_k (temp, press, EPSILO, ZVIR, qsat, nbad, q, dqsdT)
2008  call compute_qs_k (temp, press, epsilo, zvir, qsat, nbad, q, hc, &
2009  dqsdt, esat, es_over_liq, es_over_liq_and_ice)
2010 
2011 
2012  if ( nbad == 0 ) then
2013  if(present(err_msg)) err_msg = ''
2014  else
2015  if(show_bad_value_count_by_slice) call temp_check ( temp )
2016  if(show_all_bad_values) call show_all_bad ( temp )
2017  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
2018  if(fms_error_handler('compute_qs',err_msg_tmp,err_msg)) return
2019  endif
2020 
2021  end subroutine compute_qs_3d
2022 
2023 !#######################################################################
2024 !#######################################################################
2025 
2026 ! <SUBROUTINE NAME="compute_mrs_0d" INTERFACE="compute_mrs">
2027 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(SCALAR)"></IN>
2028 ! <IN NAME="press" UNIT="Pascals" TYPE="real" DIM="(SCALAR)"></IN>
2029 ! <OUT NAME="mrsat" UNITS="kg(vapor)/kg(dry air)" TYPE="real" DIM="(SCALAR</OUT>
2030 ! <IN NAME="mr" UNIT="kg(vapor)/kg(dry air)" TYPE="real" DIM="(SCALAR)"></IN>
2031 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)"></IN>
2032 ! <OUT NAME="dmrsdT" UNIT="kg(vapor)/kg(dry air)/ degree Kelvin" TYPE="real" DIM="(SCALAR)"></OUT>
2033 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(scalar)"> </OUT>
2034 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
2035 ! </SUBROUTINE>
2036  subroutine compute_mrs_0d ( temp, press, mrsat, mr, hc, dmrsdT, esat, &
2037  err_msg, es_over_liq, es_over_liq_and_ice )
2039  real, intent(in) :: temp, press
2040  real, intent(out) :: mrsat
2041  real, intent(in), optional :: mr, hc
2042  real, intent(out), optional :: dmrsdT, esat
2043  character(len=*), intent(out), optional :: err_msg
2044  logical,intent(in), optional :: es_over_liq
2045  logical,intent(in), optional :: es_over_liq_and_ice
2046 
2047  integer :: nbad
2048  character(len=128) :: err_msg_tmp
2049 
2050  if (.not.module_is_initialized) then
2051  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
2052  endif
2053 
2054  if (present(es_over_liq)) then
2055  if (.not. (construct_table_wrt_liq)) then
2056  call error_mesg ('compute_mrs', &
2057  'requesting es wrt liq, but that table not constructed', &
2058  fatal)
2059  endif
2060  endif
2061  if (present(es_over_liq_and_ice)) then
2062  if (.not. (construct_table_wrt_liq_and_ice)) then
2063  call error_mesg ('compute_qs', &
2064  'requesting es wrt liq and ice, but that table not constructed', &
2065  fatal)
2066  endif
2067  endif
2068 
2069  call compute_mrs_k (temp, press, epsilo, zvir, mrsat, nbad, mr, &
2070  hc, dmrsdt, esat, es_over_liq, es_over_liq_and_ice)
2071 
2072  if ( nbad == 0 ) then
2073  if(present(err_msg)) err_msg = ''
2074  else
2075  if(show_all_bad_values) call show_all_bad ( temp )
2076  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
2077  if(fms_error_handler('compute_mrs',err_msg_tmp,err_msg)) return
2078  endif
2079 
2080  end subroutine compute_mrs_0d
2081 
2082 !#######################################################################
2083 !#######################################################################
2084 
2085 ! <SUBROUTINE NAME="compute_mrs_1d" INTERFACE="compute_mrs">
2086 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
2087 ! <IN NAME="press" UNIT="Pascals" TYPE="real" DIM="(:)"></IN>
2088 ! <OUT NAME="mrsat" UNITS="kg(vapor)/kg(dry air)" TYPE="real" DIM="(:)"></OUT>
2089 ! <IN NAME="mr" UNIT="kg(vapor)/kg(dry air)" TYPE="real" DIM="(:)"></IN>
2090 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)"></IN>
2091 ! <OUT NAME="dmrsdT" UNIT="kg(vapor)/kg(dry air)/ degree Kelvin" TYPE="real" DIM="(:)"></OUT>
2092 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(:)"> </OUT>
2093 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
2094 ! </SUBROUTINE>
2095  subroutine compute_mrs_1d ( temp, press, mrsat, mr, hc, dmrsdT, esat,&
2096  err_msg, es_over_liq, es_over_liq_and_ice )
2098  real, intent(in) :: temp(:), press(:)
2099  real, intent(out) :: mrsat(:)
2100  real, intent(in), optional :: mr(:)
2101  real, intent(in), optional :: hc
2102  real, intent(out), optional :: dmrsdT(:), esat(:)
2103  character(len=*), intent(out), optional :: err_msg
2104  logical,intent(in), optional :: es_over_liq
2105  logical,intent(in), optional :: es_over_liq_and_ice
2106 
2107  integer :: nbad
2108  character(len=128) :: err_msg_tmp
2109 
2110  if (.not.module_is_initialized) then
2111  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
2112  endif
2113 
2114  if (present(es_over_liq)) then
2115  if (.not. (construct_table_wrt_liq)) then
2116  call error_mesg ('compute_mrs', &
2117  'requesting es wrt liq, but that table not constructed', &
2118  fatal)
2119  endif
2120  endif
2121  if (present(es_over_liq_and_ice)) then
2122  if (.not. (construct_table_wrt_liq_and_ice)) then
2123  call error_mesg ('compute_qs', &
2124  'requesting es wrt liq and ice, but that table not constructed', &
2125  fatal)
2126  endif
2127  endif
2128 
2129 ! call compute_mrs_k (temp, press, EPSILO, ZVIR, mrsat, &
2130 ! nbad, mr, dmrsdT)
2131  call compute_mrs_k (temp, press, epsilo, zvir, mrsat, nbad, mr, &
2132  hc, dmrsdt, esat, es_over_liq, es_over_liq_and_ice)
2133 
2134  if ( nbad == 0 ) then
2135  if(present(err_msg)) err_msg = ''
2136  else
2137  if(show_bad_value_count_by_slice) call temp_check ( temp )
2138  if(show_all_bad_values) call show_all_bad ( temp )
2139  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
2140  if(fms_error_handler('compute_mrs',err_msg_tmp,err_msg)) return
2141  endif
2142 
2143  end subroutine compute_mrs_1d
2144 
2145 !#######################################################################
2146 
2147 ! <SUBROUTINE NAME="compute_mrs_2d" INTERFACE="compute_mrs">
2148 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
2149 ! <IN NAME="press" UNIT="Pascals" TYPE="real" DIM="(:,:)"></IN>
2150 ! <OUT NAME="mrsat" UNITS="kg(vapor)/kg(dry air)" TYPE="real" DIM="(:,:)"></OUT>
2151 ! <IN NAME="mr" UNIT="kg(vapor)/kg(dry air)" TYPE="real" DIM="(:,:)"></IN>
2152 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)"></IN>
2153 ! <OUT NAME="dmrsdT" UNIT="kg(vapor)/kg(dry air)/ degree Kelvin" TYPE="real" DIM="(:,:)"></OUT>
2154 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(:,:)"> </OUT>
2155 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
2156 ! </SUBROUTINE>
2157  subroutine compute_mrs_2d ( temp, press, mrsat, mr, hc, dmrsdT, esat,&
2158  err_msg, es_over_liq, es_over_liq_and_ice )
2160  real, intent(in) :: temp(:,:), press(:,:)
2161  real, intent(out) :: mrsat(:,:)
2162  real, intent(in), optional :: mr(:,:)
2163  real, intent(in), optional :: hc
2164  real, intent(out), optional :: dmrsdT(:,:), esat(:,:)
2165  character(len=*), intent(out), optional :: err_msg
2166  logical,intent(in), optional :: es_over_liq
2167  logical,intent(in), optional :: es_over_liq_and_ice
2168 
2169  integer :: nbad
2170  character(len=128) :: err_msg_tmp
2171 
2172  if (.not.module_is_initialized) then
2173  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
2174  endif
2175 
2176  if (present(es_over_liq)) then
2177  if (.not. (construct_table_wrt_liq)) then
2178  call error_mesg ('compute_mrs', &
2179  'requesting es wrt liq, but that table not constructed', &
2180  fatal)
2181  endif
2182  endif
2183  if (present(es_over_liq_and_ice)) then
2184  if (.not. (construct_table_wrt_liq_and_ice)) then
2185  call error_mesg ('compute_qs', &
2186  'requesting es wrt liq and ice, but that table not constructed', &
2187  fatal)
2188  endif
2189  endif
2190 
2191 ! call compute_mrs_k (temp, press, EPSILO, ZVIR, mrsat, &
2192 ! nbad, mr, dmrsdT)
2193  call compute_mrs_k (temp, press, epsilo, zvir, mrsat, nbad, mr, &
2194  hc, dmrsdt, esat, es_over_liq, es_over_liq_and_ice)
2195 
2196  if ( nbad == 0 ) then
2197  if(present(err_msg)) err_msg = ''
2198  else
2199  if(show_bad_value_count_by_slice) call temp_check ( temp )
2200  if(show_all_bad_values) call show_all_bad ( temp )
2201  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
2202  if(fms_error_handler('compute_mrs',err_msg_tmp,err_msg)) return
2203  endif
2204 
2205  end subroutine compute_mrs_2d
2206 
2207 !#######################################################################
2208 
2209 ! <SUBROUTINE NAME="compute_mrs_3d" INTERFACE="compute_mrs">
2210 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
2211 ! <IN NAME="press" UNIT="Pascals" TYPE="real" DIM="(:,:,:)"></IN>
2212 ! <OUT NAME="mrsat" UNITS="kg(vapor)/kg(dry air)" TYPE="real" DIM="(:,:,:)"></OUT>
2213 ! <IN NAME="mr" UNIT="kg(vapor)/kg(dry air)" TYPE="real" DIM="(:,:,:)"></IN>
2214 ! <IN NAME="hc" UNIT="fraction" TYPE="real" DIM="(scalar)"></IN>
2215 ! <OUT NAME="dmrsdT" UNIT="kg(vapor)/kg(dry air)/ degree Kelvin" TYPE="real" DIM="(:,:,:)"></OUT>
2216 ! <OUT NAME="esat" UNITS="Pascals" TYPE="real" DIM="(:,:,:)"> </OUT>
2217 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
2218 ! </SUBROUTINE>
2219  subroutine compute_mrs_3d ( temp, press, mrsat, mr, hc, dmrsdT, esat,&
2220  err_msg, es_over_liq, es_over_liq_and_ice )
2222  real, intent(in) :: temp(:,:,:), press(:,:,:)
2223  real, intent(out) :: mrsat(:,:,:)
2224  real, intent(in), optional :: mr(:,:,:)
2225  real, intent(in), optional :: hc
2226  real, intent(out), optional :: dmrsdT(:,:,:), esat(:,:,:)
2227  character(len=*), intent(out), optional :: err_msg
2228  logical,intent(in), optional :: es_over_liq
2229  logical,intent(in), optional :: es_over_liq_and_ice
2230 
2231  integer :: nbad
2232  character(len=128) :: err_msg_tmp
2233 
2234  if (.not.module_is_initialized) then
2235  if(fms_error_handler('lookup_es','sat_vapor_pres_init is not called' ,err_msg)) return
2236  endif
2237 
2238  if (present(es_over_liq)) then
2239  if (.not. (construct_table_wrt_liq)) then
2240  call error_mesg ('compute_mrs', &
2241  'requesting es wrt liq, but that table not constructed', &
2242  fatal)
2243  endif
2244  endif
2245  if (present(es_over_liq_and_ice)) then
2246  if (.not. (construct_table_wrt_liq_and_ice)) then
2247  call error_mesg ('compute_qs', &
2248  'requesting es wrt liq and ice, but that table not constructed', &
2249  fatal)
2250  endif
2251  endif
2252 
2253 ! call compute_mrs_k (temp, press, EPSILO, ZVIR, mrsat, &
2254 ! nbad, mr, dmrsdT)
2255  call compute_mrs_k (temp, press, epsilo, zvir, mrsat, nbad, mr, &
2256  hc, dmrsdt, esat, es_over_liq, es_over_liq_and_ice)
2257 
2258  if ( nbad == 0 ) then
2259  if(present(err_msg)) err_msg = ''
2260  else
2261  if(show_bad_value_count_by_slice) call temp_check ( temp )
2262  if(show_all_bad_values) call show_all_bad ( temp )
2263  write(err_msg_tmp,'(a47,i7)') 'saturation vapor pressure table overflow, nbad=', nbad
2264  if(fms_error_handler('compute_mrs',err_msg_tmp,err_msg)) return
2265  endif
2266 
2267  end subroutine compute_mrs_3d
2268 
2269 
2270 !#######################################################################
2271 
2272 !#######################################################################
2273 
2274 ! <SUBROUTINE NAME="sat_vapor_pres_init">
2275 
2276 ! <OVERVIEW>
2277 ! Initializes the lookup tables for saturation vapor pressure.
2278 ! </OVERVIEW>
2279 ! <DESCRIPTION>
2280 ! Initializes the lookup tables for saturation vapor pressure.
2281 ! This routine will be called automatically the first time
2282 ! <B>lookup_es</B> or <B>lookup_des</B> is called,
2283 ! the user does not need to call this routine.
2284 ! There are no arguments.
2285 ! </DESCRIPTION>
2286 ! <TEMPLATE>
2287 ! call sat_vapor_pres_init
2288 ! </TEMPLATE>
2289 ! <OUT NAME="err_msg" TYPE="character"> </OUT>
2290 
2291 ! </SUBROUTINE>
2292  subroutine sat_vapor_pres_init(err_msg)
2294 ! =================================================================
2295 ! + +
2296 ! + construction of the es table +
2297 ! + +
2298 ! + this table is constructed from es equations from the +
2299 ! + smithsonian tables. the es input is computed from values +
2300 ! + (in one-tenth of a degree increments) of es over ice +
2301 ! + from -153c to 0c and values of es over water from 0c to 102c. +
2302 ! + output table contains these data interleaved with their +
2303 ! + derivatives with respect to temperature except between -20c +
2304 ! + and 0c where blended (over water and over ice) es values and +
2305 ! + derivatives are calculated. +
2306 ! + note: all es computation is done in pascals +
2307 ! =================================================================
2308 
2309  character(len=*), intent(out), optional :: err_msg
2310  character(len=128) :: err_msg_local
2311  integer :: unit, ierr, io
2312 
2313 ! return silently if this routine has already been called
2314  if (module_is_initialized) return
2315 
2316 !---- read namelist input ----
2317 #ifdef INTERNAL_FILE_NML
2318  read (input_nml_file, sat_vapor_pres_nml, iostat=io)
2319  ierr = check_nml_error(io,'sat_vapor_pres_nml')
2320 #else
2321  if (file_exist('input.nml')) then
2322  unit = open_namelist_file( )
2323  ierr=1; do while (ierr /= 0)
2324  read (unit, nml=sat_vapor_pres_nml, iostat=io, end=10)
2325  ierr = check_nml_error(io,'sat_vapor_pres_nml')
2326  enddo
2327 10 call mpp_close (unit)
2328  endif
2329 #endif
2330 
2331 ! write version number and namelist to log file
2332  call write_version_number("SAT_VAPOR_PRES_MOD", version)
2333  unit = stdlog()
2334  stdoutunit = stdout()
2335  if (mpp_pe() == mpp_root_pe()) write (unit, nml=sat_vapor_pres_nml)
2336 
2337  if(do_simple) then
2338  tcmin = -173
2339  tcmax = 350
2340  endif
2341  nsize = (tcmax-tcmin)*esres+1
2342  nlim = nsize-1
2343  call sat_vapor_pres_init_k(nsize, real(tcmin), real(tcmax), tfreeze, hlv, &
2344  rvgas, es0, err_msg_local, use_exact_qs, do_simple, &
2347  teps, tmin, dtinv)
2348  if ( err_msg_local == '' ) then
2349  if(present(err_msg)) err_msg = ''
2350  else
2351  if(fms_error_handler('lookup_es',err_msg_local,err_msg)) return
2352  endif
2353 
2354  module_is_initialized = .true.
2355 
2356 end subroutine sat_vapor_pres_init
2357 
2358 !#######################################################################
2359 !#######################################################################
2360 !-------------------------------------------------------------------
2361 ! Computation of the es values
2362 !
2363 ! Saturation vapor pressure (es) values are computed from
2364 ! equations in the Smithsonian meteorological tables page 350.
2365 ! For temperatures < 0C, sat vapor pres is computed over ice.
2366 ! For temperatures > -20C, sat vapor pres is computed over water.
2367 ! Between -20C and 0C the returned value is blended (over water
2368 ! and over ice). All sat vapor pres values are returned in pascals.
2369 !
2370 ! Reference: Smithsonian meteorological tables, page 350.
2371 !-------------------------------------------------------------------
2372 
2373 ! <FUNCTION NAME="compute_es_1d" INTERFACE="compute_es">
2374 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:)"></IN>
2375 ! <OUT NAME="es" UNITS="pascal" TYPE="real" DIM="(:)"></OUT>
2376 ! </FUNCTION>
2377 !function compute_es_1d (tem) result (es)
2378 !real, intent(in) :: tem(:)
2379 !real :: es(size(tem,1))
2380 
2381 !es = compute_es_k(tem, TFREEZE)
2382 
2383 !end function compute_es_1d
2384 !--------------------------------------------------------
2385 
2386 ! <FUNCTION NAME="compute_es_0d" INTERFACE="compute_es">
2387 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(scalar)"></IN>
2388 ! <OUT NAME="es" UNITS="pascal" TYPE="real" DIM="(scalar)"></OUT>
2389 ! </FUNCTION>
2390 !function compute_es_0d (tem) result (es)
2391 !real, intent(in) :: tem
2392 !real :: es
2393 !real, dimension(1) :: tem1, es1
2394 
2395 ! tem1(1) = tem
2396 ! es1 = compute_es_1d (tem1)
2397 ! es = es1(1)
2398 
2399 !end function compute_es_0d
2400 
2401 !--------------------------
2402 
2403 ! <FUNCTION NAME="compute_es_2d" INTERFACE="compute_es">
2404 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:)"></IN>
2405 ! <OUT NAME="es" UNITS="pascal" TYPE="real" DIM="(:,:)"></OUT>
2406 ! </FUNCTION>
2407 !function compute_es_2d (tem) result (es)
2408 !real, intent(in) :: tem(:,:)
2409 !real, dimension(size(tem,1),size(tem,2)) :: es
2410 !integer :: j
2411 
2412 ! do j = 1, size(tem,2)
2413 ! es(:,j) = compute_es_1d (tem(:,j))
2414 ! enddo
2415 
2416 !end function compute_es_2d
2417 
2418 !--------------------------
2419 ! <FUNCTION NAME="compute_es_3d" INTERFACE="compute_es">
2420 ! <IN NAME="temp" UNIT="degrees Kelvin" TYPE="real" DIM="(:,:,:)"></IN>
2421 ! <OUT NAME="es" UNITS="pascal" TYPE="real" DIM="(:,:,:)"></OUT>
2422 ! </FUNCTION>
2423 !function compute_es_3d (tem) result (es)
2424 !real, intent(in) :: tem(:,:,:)
2425 !real, dimension(size(tem,1),size(tem,2),size(tem,3)) :: es
2426 !integer :: j, k
2427 
2428 ! do k = 1, size(tem,3)
2429 ! do j = 1, size(tem,2)
2430 ! es(:,j,k) = compute_es_1d (tem(:,j,k))
2431 ! enddo
2432 ! enddo
2433 
2434 !end function compute_es_3d
2435 
2436 !#######################################################################
2437 
2438  function check_1d ( temp ) result ( nbad )
2439  real , intent(in) :: temp(:)
2440  integer :: nbad, ind, i
2441 
2442  nbad = 0
2443  do i = 1, size(temp,1)
2444  ind = int(dtinv*(temp(i)-tmin+teps))
2445  if (ind < 0 .or. ind > nlim) nbad = nbad+1
2446  enddo
2447 
2448  end function check_1d
2449 
2450 !------------------------------------------------
2451 
2452  function check_2d ( temp ) result ( nbad )
2453  real , intent(in) :: temp(:,:)
2454  integer :: nbad
2455  integer :: j
2456 
2457  nbad = 0
2458  do j = 1, size(temp,2)
2459  nbad = nbad + check_1d( temp(:,j) )
2460  enddo
2461  end function check_2d
2462 
2463 !#######################################################################
2464 
2465  subroutine temp_check_1d ( temp )
2466  real , intent(in) :: temp(:)
2467  integer :: i, unit
2468 
2469  unit = stdoutunit
2470  write(unit,*) 'Bad temperatures (dimension 1): ', (check_1d(temp(i:i)),i=1,size(temp,1))
2471 
2472  end subroutine temp_check_1d
2473 
2474 !--------------------------------------------------------------
2475 
2476  subroutine temp_check_2d ( temp )
2477  real , intent(in) :: temp(:,:)
2478  integer :: i, j, unit
2479 
2480  unit = stdoutunit
2481  write(unit,*) 'Bad temperatures (dimension 1): ', (check_1d(temp(i,:)),i=1,size(temp,1))
2482  write(unit,*) 'Bad temperatures (dimension 2): ', (check_1d(temp(:,j)),j=1,size(temp,2))
2483 
2484  end subroutine temp_check_2d
2485 
2486 !--------------------------------------------------------------
2487 
2488  subroutine temp_check_3d ( temp )
2489  real, intent(in) :: temp(:,:,:)
2490  integer :: i, j, k, unit
2491 
2492  unit = stdoutunit
2493  write(unit,*) 'Bad temperatures (dimension 1): ', (check_2d(temp(i,:,:)),i=1,size(temp,1))
2494  write(unit,*) 'Bad temperatures (dimension 2): ', (check_2d(temp(:,j,:)),j=1,size(temp,2))
2495  write(unit,*) 'Bad temperatures (dimension 3): ', (check_2d(temp(:,:,k)),k=1,size(temp,3))
2496 
2497  end subroutine temp_check_3d
2498 
2499 !#######################################################################
2500 
2501 subroutine show_all_bad_0d ( temp )
2502  real , intent(in) :: temp
2503  integer :: ind, unit
2504 
2505  unit = stdoutunit
2506  ind = int(dtinv*(temp-tmin+teps))
2507  if (ind < 0 .or. ind > nlim) then
2508  write(unit,'(a,e10.3,a,i6)') 'Bad temperature=',temp,' pe=',mpp_pe()
2509  endif
2510 
2511  end subroutine show_all_bad_0d
2512 
2513 !--------------------------------------------------------------
2514 
2515  subroutine show_all_bad_1d ( temp )
2516  real , intent(in) :: temp(:)
2517  integer :: i, ind, unit
2518 
2519  unit = stdoutunit
2520  do i=1,size(temp)
2521  ind = int(dtinv*(temp(i)-tmin+teps))
2522  if (ind < 0 .or. ind > nlim) then
2523  write(unit,'(a,e10.3,a,i4,a,i6)') 'Bad temperature=',temp(i),' at i=',i,' pe=',mpp_pe()
2524  endif
2525  enddo
2526 
2527  end subroutine show_all_bad_1d
2528 
2529 !--------------------------------------------------------------
2530 
2531  subroutine show_all_bad_2d ( temp )
2532  real , intent(in) :: temp(:,:)
2533  integer :: i, j, ind, unit
2534 
2535  unit = stdoutunit
2536  do j=1,size(temp,2)
2537  do i=1,size(temp,1)
2538  ind = int(dtinv*(temp(i,j)-tmin+teps))
2539  if (ind < 0 .or. ind > nlim) then
2540  write(unit,'(a,e10.3,a,i4,a,i4,a,i6)') 'Bad temperature=',temp(i,j),' at i=',i,' j=',j,' pe=',mpp_pe()
2541  endif
2542  enddo
2543  enddo
2544 
2545  end subroutine show_all_bad_2d
2546 
2547 !--------------------------------------------------------------
2548 
2549  subroutine show_all_bad_3d ( temp )
2550  real, intent(in) :: temp(:,:,:)
2551  integer :: i, j, k, ind, unit
2552 
2553  unit = stdoutunit
2554  do k=1,size(temp,3)
2555  do j=1,size(temp,2)
2556  do i=1,size(temp,1)
2557  ind = int(dtinv*(temp(i,j,k)-tmin+teps))
2558  if (ind < 0 .or. ind > nlim) then
2559  write(unit,'(a,e10.3,a,i4,a,i4,a,i4,a,i6)') 'Bad temperature=',temp(i,j,k),' at i=',i,' j=',j,' k=',k,' pe=',mpp_pe()
2560  endif
2561  enddo
2562  enddo
2563  enddo
2564 
2565  end subroutine show_all_bad_3d
2566 
2567 !#######################################################################
2568 end module sat_vapor_pres_mod
2569 !#######################################################################
2570 
2571 ! <INFO>
2572 
2573 ! <REFERENCE>
2574 ! Smithsonian Meteorological Tables Page 350.
2575 ! </REFERENCE>
2576 
2577 ! <BUG>
2578 ! No error checking is done to make sure that the size of the
2579 ! input and output fields match.
2580 ! </BUG>
2581 
2582 ! <NOTE>
2583 ! 1. <B>Vectorization</B><BR/>
2584 ! To create a vector version the lookup routines need to be modified.
2585 ! The local variables: tmp, del, ind, should be changed to arrays
2586 ! with the same size and order as input array temp.
2587 !
2588 ! 2. <B>Construction of the <TT>ES</TT> tables</B><BR/>
2589 ! The tables are constructed using the saturation vapor pressure (<TT>ES</TT>)
2590 ! equations in the Smithsonian tables. The tables are valid between
2591 ! -160C to +100C with increments at 1/10 degree. Between -160C and -20C
2592 ! values of <TT>ES</TT> over ice are used, between 0C and 100C values of<TT> ES</TT>
2593 ! over water are used, between -20C and 0C blended values of <TT>ES</TT>
2594 ! (over water and over ice) are used.
2595 !
2596 ! There are three tables constructed: <TT>ES</TT>, first derivative
2597 ! (<TT>ES'</TT>), and
2598 ! second derivative (<TT>ES</TT>''). The ES table is constructed directly from
2599 ! the equations in the Smithsonian tables. The <TT>ES</TT>' table is constructed
2600 ! by bracketing temperature values at +/- 0.01 degrees. The <TT>ES</TT>'' table
2601 ! is estimated by using centered differencing of the <TT>ES</TT>' table.
2602 !
2603 ! 3. <B>Determination of <TT>es</TT> and <TT>es'</TT> from lookup tables</B><BR/>
2604 ! Values of the saturation vapor pressure (<TT>es</TT>) and the
2605 ! derivative (<TT>es'</TT>) are determined at temperature (T) from the lookup
2606 ! tables (<TT>ES</TT>, <TT>ES'</TT>, <TT>ES''</TT>)
2607 ! using the following formula.
2608 !<PRE>
2609 ! es (T) = ES(t) + ES'(t) * dt + 0.5 * ES''(t) * dt**2
2610 ! es'(T) = ES'(t) + ES''(t) * dt
2611 !
2612 ! where t = lookup table temperature closest to T
2613 ! dt = T - t
2614 !</PRE>
2615 !
2616 ! 4. Internal (private) parameters<BR/>
2617 ! These parameters can be modified to increase/decrease the size/range
2618 ! of the lookup tables.
2619 !<PRE>
2620 !! tcmin The minimum temperature (in deg C) in the lookup tables.
2621 !! [integer, default: tcmin = -160]
2622 !!
2623 !! tcmax The maximum temperature (in deg C) in the lookup tables.
2624 !! [integer, default: tcmin = +100]
2625 !!</PRE>
2626 !! </NOTE>
2627 !
2628 !! <TESTPROGRAM NAME="test_sat_vapor_pres">
2629 !<PRE>
2630 !use sat_vapor_pres_mod
2631 !implicit none
2632 !
2633 !integer, parameter :: ipts=500, jpts=100, kpts=50, nloop=1
2634 !real, dimension(ipts,jpts,kpts) :: t,es,esn,des,desn
2635 !integer :: n
2636 !
2637 !! generate temperatures between 120K and 340K
2638 ! call random_number (t)
2639 ! t = 130. + t * 200.
2640 !
2641 !! initialize the tables (optional)
2642 ! call sat_vapor_pres_init
2643 !
2644 !! compute actual es and "almost" actual des
2645 ! es = compute_es (t)
2646 ! des = compute_des (t)
2647 !
2648 !do n = 1, nloop
2649 !! es and des
2650 ! call lookup_es (t, esn)
2651 ! call lookup_des (t,desn)
2652 !enddo
2653 !
2654 !! terminate, print deviation from actual
2655 ! print *, 'size=',ipts,jpts,kpts,nloop
2656 ! print *, 'err es = ', sum((esn-es)**2)
2657 ! print *, 'err des = ', sum((desn-des)**2)
2658 !
2659 !contains
2660 !
2661 !!----------------------------------
2662 !! routine to estimate derivative
2663 !
2664 ! function compute_des (tem) result (des)
2665 ! real, intent(in) :: tem(:,:,:)
2666 ! real, dimension(size(tem,1),size(tem,2),size(tem,3)) :: des,esp,esm
2667 ! real, parameter :: tdel = .01
2668 ! esp = compute_es (tem+tdel)
2669 ! esm = compute_es (tem-tdel)
2670 ! des = (esp-esm)/(2*tdel)
2671 ! end function compute_des
2672 !!----------------------------------
2673 !
2674 !end program test_sat_vapor_pres
2675 !</PRE>
2676 ! </TESTPROGRAM>
2677 ! </INFO>
Definition: fms.F90:20
subroutine lookup_es_des_3d(temp, esat, desat, err_msg)
subroutine lookup_es_2d(temp, esat, err_msg)
subroutine lookup_des3_0d(temp, desat, err_msg)
subroutine lookup_es2_3d(temp, esat, err_msg)
subroutine lookup_des_0d(temp, desat, err_msg)
subroutine lookup_es2_1d(temp, esat, err_msg)
subroutine lookup_es2_des2_2d(temp, esat, desat, err_msg)
subroutine lookup_es3_des3_2d(temp, esat, desat, err_msg)
subroutine show_all_bad_0d(temp)
logical show_bad_value_count_by_slice
real, parameter, public hlv
Latent heat of evaporation [J/kg].
Definition: constants.F90:80
subroutine lookup_es3_2d(temp, esat, err_msg)
subroutine lookup_des2_2d(temp, desat, err_msg)
subroutine lookup_es_3d(temp, esat, err_msg)
subroutine lookup_es3_3d(temp, esat, err_msg)
logical function, public fms_error_handler(routine, message, err_msg)
Definition: fms.F90:573
real, parameter, public rdgas
Gas constant for dry air [J/kg/deg].
Definition: constants.F90:77
subroutine show_all_bad_2d(temp)
subroutine lookup_es_des_0d(temp, esat, desat, err_msg)
subroutine lookup_es3_des3_1d(temp, esat, desat, err_msg)
integer function check_2d(temp)
real, parameter epsilo
subroutine lookup_es3_des3_3d(temp, esat, desat, err_msg)
subroutine, public sat_vapor_pres_init_k(table_size, tcmin, tcmax, TFREEZE, HLV, RVGAS, ES0, err_msg, use_exact_qs_input, do_simple, construct_table_wrt_liq, construct_table_wrt_liq_and_ice, teps, tmin, dtinv)
subroutine compute_qs_2d(temp, press, qsat, q, hc, dqsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
Definition: mpp.F90:39
subroutine compute_mrs_2d(temp, press, mrsat, mr, hc, dmrsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
integer function, public check_nml_error(IOSTAT, NML_NAME)
Definition: fms.F90:658
subroutine compute_qs_3d(temp, press, qsat, q, hc, dqsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
subroutine lookup_es3_0d(temp, esat, err_msg)
character(len=input_str_length), dimension(:), allocatable, target, public input_nml_file
Definition: mpp.F90:1378
subroutine compute_mrs_1d(temp, press, mrsat, mr, hc, dmrsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
subroutine lookup_es3_des3_0d(temp, esat, desat, err_msg)
subroutine lookup_des3_1d(temp, desat, err_msg)
subroutine temp_check_1d(temp)
subroutine compute_mrs_0d(temp, press, mrsat, mr, hc, dmrsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
real, parameter, public rvgas
Gas constant for water vapor [J/kg/deg].
Definition: constants.F90:78
subroutine lookup_es2_des2_3d(temp, esat, desat, err_msg)
subroutine lookup_des3_2d(temp, desat, err_msg)
real, parameter, public tfreeze
Freezing temperature of fresh water [K].
Definition: constants.F90:84
subroutine lookup_des2_1d(temp, desat, err_msg)
subroutine lookup_es2_2d(temp, esat, err_msg)
subroutine lookup_es2_des2_1d(temp, esat, desat, err_msg)
subroutine compute_qs_1d(temp, press, qsat, q, hc, dqsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
subroutine lookup_es2_des2_0d(temp, esat, desat, err_msg)
subroutine lookup_es_0d(temp, esat, err_msg)
real, parameter, public es0
Humidity factor. Controls the humidity content of the atmosphere through the Saturation Vapour Pressu...
Definition: constants.F90:96
subroutine lookup_es_des_1d(temp, esat, desat, err_msg)
subroutine temp_check_3d(temp)
subroutine lookup_des_1d(temp, desat, err_msg)
subroutine lookup_des2_0d(temp, desat, err_msg)
subroutine lookup_es3_1d(temp, esat, err_msg)
subroutine show_all_bad_1d(temp)
subroutine lookup_es_1d(temp, esat, err_msg)
subroutine lookup_des2_3d(temp, desat, err_msg)
subroutine lookup_es_des_2d(temp, esat, desat, err_msg)
subroutine lookup_des_2d(temp, desat, err_msg)
subroutine show_all_bad_3d(temp)
subroutine, public sat_vapor_pres_init(err_msg)
subroutine compute_mrs_3d(temp, press, mrsat, mr, hc, dmrsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
subroutine lookup_des_3d(temp, desat, err_msg)
subroutine lookup_des3_3d(temp, desat, err_msg)
subroutine compute_qs_0d(temp, press, qsat, q, hc, dqsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
subroutine, public error_mesg(routine, message, level)
Definition: fms.F90:529
real, parameter zvir
integer function check_1d(temp)
logical construct_table_wrt_liq_and_ice
subroutine temp_check_2d(temp)
subroutine lookup_es2_0d(temp, esat, err_msg)