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