100module sat_vapor_pres_mod
181 use constants_mod,
only: tfreeze, rdgas, rvgas, hlv, es0
182 use fms_mod,
only: write_version_number, stdout, stdlog, mpp_pe, mpp_root_pe, &
183 mpp_error, fatal, warning, fms_error_handler, &
184 error_mesg, check_nml_error
185 use mpp_mod,
only: input_nml_file
193 use platform_mod,
only: r4_kind, r8_kind
198 public :: lookup_es, lookup_des, sat_vapor_pres_init
199 public :: lookup_es2, lookup_des2, lookup_es2_des2
200 public :: lookup_es3, lookup_des3, lookup_es3_des3
201 public :: lookup_es_des, compute_qs, compute_mrs
203 public :: escomp, descomp
266 module procedure lookup_es_0d_r4, lookup_es_0d_r8
267 module procedure lookup_es_1d_r4, lookup_es_1d_r8
268 module procedure lookup_es_2d_r4, lookup_es_2d_r8
269 module procedure lookup_es_3d_r4, lookup_es_3d_r8
270 end interface lookup_es
274 module procedure lookup_es_0d_r4, lookup_es_0d_r8
275 module procedure lookup_es_1d_r4, lookup_es_1d_r8
276 module procedure lookup_es_2d_r4, lookup_es_2d_r8
277 module procedure lookup_es_3d_r4, lookup_es_3d_r8
343 module procedure lookup_des_0d_r4, lookup_des_0d_r8
344 module procedure lookup_des_1d_r4, lookup_des_1d_r8
345 module procedure lookup_des_2d_r4, lookup_des_2d_r8
346 module procedure lookup_des_3d_r4, lookup_des_3d_r8
347 end interface lookup_des
352 module procedure lookup_des_0d_r4, lookup_des_0d_r8
353 module procedure lookup_des_1d_r4, lookup_des_1d_r8
354 module procedure lookup_des_2d_r4, lookup_des_2d_r8
355 module procedure lookup_des_3d_r4, lookup_des_3d_r8
356 end interface descomp
432 interface lookup_es_des
433 module procedure lookup_es_des_0d_r4, lookup_es_des_0d_r8
434 module procedure lookup_es_des_1d_r4, lookup_es_des_1d_r8
435 module procedure lookup_es_des_2d_r4, lookup_es_des_2d_r8
436 module procedure lookup_es_des_3d_r4, lookup_es_des_3d_r8
437 end interface lookup_es_des
441 module procedure lookup_es2_0d_r4, lookup_es2_0d_r8
442 module procedure lookup_es2_1d_r4, lookup_es2_1d_r8
443 module procedure lookup_es2_2d_r4, lookup_es2_2d_r8
444 module procedure lookup_es2_3d_r4, lookup_es2_3d_r8
445 end interface lookup_es2
448 interface lookup_des2
449 module procedure lookup_des2_0d_r4, lookup_des2_0d_r8
450 module procedure lookup_des2_1d_r4, lookup_des2_1d_r8
451 module procedure lookup_des2_2d_r4, lookup_des2_2d_r8
452 module procedure lookup_des2_3d_r4, lookup_des2_3d_r8
453 end interface lookup_des2
456 interface lookup_es2_des2
457 module procedure lookup_es2_des2_0d_r4, lookup_es2_des2_0d_r8
458 module procedure lookup_es2_des2_1d_r4, lookup_es2_des2_1d_r8
459 module procedure lookup_es2_des2_2d_r4, lookup_es2_des2_2d_r8
460 module procedure lookup_es2_des2_3d_r4, lookup_es2_des2_3d_r8
461 end interface lookup_es2_des2
465 module procedure lookup_es3_0d_r4, lookup_es3_0d_r8
466 module procedure lookup_es3_1d_r4, lookup_es3_1d_r8
467 module procedure lookup_es3_2d_r4, lookup_es3_2d_r8
468 module procedure lookup_es3_3d_r4, lookup_es3_3d_r8
469 end interface lookup_es3
472 interface lookup_des3
473 module procedure lookup_des3_0d_r4, lookup_des3_0d_r8
474 module procedure lookup_des3_1d_r4, lookup_des3_1d_r8
475 module procedure lookup_des3_2d_r4, lookup_des3_2d_r8
476 module procedure lookup_des3_3d_r4, lookup_des3_3d_r8
477 end interface lookup_des3
480 interface lookup_es3_des3
481 module procedure lookup_es3_des3_0d_r4, lookup_es3_des3_0d_r8
482 module procedure lookup_es3_des3_1d_r4, lookup_es3_des3_1d_r8
483 module procedure lookup_es3_des3_2d_r4, lookup_es3_des3_2d_r8
484 module procedure lookup_es3_des3_3d_r4, lookup_es3_des3_3d_r8
485 end interface lookup_es3_des3
582 module procedure compute_qs_0d_r4, compute_qs_0d_r8
583 module procedure compute_qs_1d_r4, compute_qs_1d_r8
584 module procedure compute_qs_2d_r4, compute_qs_2d_r8
585 module procedure compute_qs_3d_r4, compute_qs_3d_r8
586 end interface compute_qs
683 interface compute_mrs
684 module procedure compute_mrs_0d_r4, compute_mrs_0d_r8
685 module procedure compute_mrs_1d_r4, compute_mrs_1d_r8
686 module procedure compute_mrs_2d_r4, compute_mrs_2d_r8
687 module procedure compute_mrs_3d_r4, compute_mrs_3d_r8
688 end interface compute_mrs
720 module procedure check_1d_r4, check_1d_r8
721 end interface check_1d
724 module procedure check_2d_r4, check_2d_r8
725 end interface check_2d
729 module procedure temp_check_1d_r4, temp_check_1d_r8
730 module procedure temp_check_2d_r4, temp_check_2d_r8
731 module procedure temp_check_3d_r4, temp_check_3d_r8
732 end interface temp_check
735 interface show_all_bad
736 module procedure show_all_bad_0d_r4, show_all_bad_0d_r8
737 module procedure show_all_bad_1d_r4, show_all_bad_1d_r8
738 module procedure show_all_bad_2d_r4, show_all_bad_2d_r8
739 module procedure show_all_bad_3d_r4, show_all_bad_3d_r8
740 end interface show_all_bad
746#include<file_version.h>
748 logical :: module_is_initialized = .false.
753 real(r8_kind),
parameter :: EPSILO = real(rdgas,r8_kind)/real(rvgas, r8_kind)
754 real(r8_kind),
parameter :: ZVIR = real(rvgas,r8_kind)/real(rdgas,r8_kind) - 1.0_r8_kind
759 integer,
public :: tcmin = -160
760 integer,
public :: tcmax = 100
761 integer :: esres = 10
765 integer :: stdoutunit=0
768 real(r8_kind) :: tmin, dtinv, teps
771 logical :: show_bad_value_count_by_slice=.true.
772 logical :: show_all_bad_values=.false.
773 logical :: use_exact_qs = .false.
774 logical :: do_simple =.false.
775 logical :: construct_table_wrt_liq = .false.
776 logical :: construct_table_wrt_liq_and_ice = .false.
778 namelist / sat_vapor_pres_nml / show_bad_value_count_by_slice, show_all_bad_values, &
779 use_exact_qs, do_simple, &
780 construct_table_wrt_liq, &
781 construct_table_wrt_liq_and_ice
785 subroutine sat_vapor_pres_init(err_msg)
802 character(len=*),
intent(out),
optional :: err_msg
803 character(len=128) :: err_msg_local
804 integer :: iunit, ierr, io
807 if (module_is_initialized)
return
810 read (input_nml_file, sat_vapor_pres_nml, iostat=io)
811 ierr = check_nml_error(io,
'sat_vapor_pres_nml')
814 call write_version_number(
"SAT_VAPOR_PRES_MOD", version)
816 stdoutunit = stdout()
817 if (mpp_pe() == mpp_root_pe())
write (iunit, nml=sat_vapor_pres_nml)
823 nsize = (tcmax-tcmin)*esres+1
826 real(TFREEZE,r8_kind),
real(HLV,r8_kind),&
827 real(RVGAS,r8_kind),
real(ES0,r8_kind), err_msg_local, use_exact_qs, do_simple,&
828 construct_table_wrt_liq, &
829 construct_table_wrt_liq_and_ice, &
831 if ( err_msg_local ==
'' )
then
832 if(
present(err_msg)) err_msg =
''
834 if(fms_error_handler(
'lookup_es',err_msg_local,err_msg))
return
837 module_is_initialized = .true.
839end subroutine sat_vapor_pres_init
841#include "sat_vapor_pres_r4.fh"
842#include "sat_vapor_pres_r8.fh"
923end module sat_vapor_pres_mod