134 use fms_mod,
only: write_version_number, stdout, stdlog, mpp_pe, mpp_root_pe, &
512 #include<file_version.h> 559 real,
intent(in) :: temp
560 real,
intent(out) :: esat
561 character(len=*),
intent(out),
optional :: err_msg
564 character(len=128) :: err_msg_local
567 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 572 if ( nbad == 0 )
then 573 if(
present(err_msg)) err_msg =
'' 576 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
591 real,
intent(in) :: temp(:)
592 real,
intent(out) :: esat(:)
593 character(len=*),
intent(out),
optional :: err_msg
595 character(len=54) :: err_msg_local
600 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 605 if ( nbad == 0 )
then 606 if(
present(err_msg)) err_msg =
'' 610 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
627 real,
intent(in) :: temp(:,:)
628 real,
intent(out) :: esat(:,:)
629 character(len=*),
intent(out),
optional :: err_msg
631 character(len=54) :: err_msg_local
636 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 641 if ( nbad == 0 )
then 642 if(
present(err_msg)) err_msg =
'' 646 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
663 real,
intent(in) :: temp(:,:,:)
664 real,
intent(out) :: esat(:,:,:)
665 character(len=*),
intent(out),
optional :: err_msg
668 character(len=128) :: err_msg_tmp
671 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 676 if ( nbad == 0 )
then 677 if(
present(err_msg)) err_msg =
'' 681 write(err_msg_tmp,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
696 real,
intent(in) :: temp
697 real,
intent(out) :: esat
698 character(len=*),
intent(out),
optional :: err_msg
701 character(len=128) :: err_msg_local
704 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 709 if ( nbad == 0 )
then 710 if(
present(err_msg)) err_msg =
'' 713 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
728 real,
intent(in) :: temp(:)
729 real,
intent(out) :: esat(:)
730 character(len=*),
intent(out),
optional :: err_msg
732 character(len=54) :: err_msg_local
737 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 742 if ( nbad == 0 )
then 743 if(
present(err_msg)) err_msg =
'' 747 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
764 real,
intent(in) :: temp(:,:)
765 real,
intent(out) :: esat(:,:)
766 character(len=*),
intent(out),
optional :: err_msg
768 character(len=54) :: err_msg_local
773 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 778 if ( nbad == 0 )
then 779 if(
present(err_msg)) err_msg =
'' 783 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
800 real,
intent(in) :: temp(:,:,:)
801 real,
intent(out) :: esat(:,:,:)
802 character(len=*),
intent(out),
optional :: err_msg
805 character(len=128) :: err_msg_tmp
808 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 813 if ( nbad == 0 )
then 814 if(
present(err_msg)) err_msg =
'' 818 write(err_msg_tmp,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
833 real,
intent(in) :: temp
834 real,
intent(out) :: esat
835 character(len=*),
intent(out),
optional :: err_msg
838 character(len=128) :: err_msg_local
841 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 846 if ( nbad == 0 )
then 847 if(
present(err_msg)) err_msg =
'' 850 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
865 real,
intent(in) :: temp(:)
866 real,
intent(out) :: esat(:)
867 character(len=*),
intent(out),
optional :: err_msg
869 character(len=54) :: err_msg_local
874 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 879 if ( nbad == 0 )
then 880 if(
present(err_msg)) err_msg =
'' 884 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
901 real,
intent(in) :: temp(:,:)
902 real,
intent(out) :: esat(:,:)
903 character(len=*),
intent(out),
optional :: err_msg
905 character(len=54) :: err_msg_local
910 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 915 if ( nbad == 0 )
then 916 if(
present(err_msg)) err_msg =
'' 920 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
937 real,
intent(in) :: temp(:,:,:)
938 real,
intent(out) :: esat(:,:,:)
939 character(len=*),
intent(out),
optional :: err_msg
942 character(len=128) :: err_msg_tmp
945 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 950 if ( nbad == 0 )
then 951 if(
present(err_msg)) err_msg =
'' 955 write(err_msg_tmp,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
973 real,
intent(in) :: temp
974 real,
intent(out) :: desat
975 character(len=*),
intent(out),
optional :: err_msg
978 character(len=128) :: err_msg_local
981 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 986 if ( nbad == 0 )
then 987 if(
present(err_msg)) err_msg =
'' 990 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1005 real,
intent(in) :: temp (:)
1006 real,
intent(out) :: desat(:)
1007 character(len=*),
intent(out),
optional :: err_msg
1009 character(len=54) :: err_msg_local
1014 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1017 if(
present(err_msg)) err_msg=
'' 1021 if ( nbad == 0 )
then 1022 if(
present(err_msg)) err_msg =
'' 1026 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1042 real,
intent(in) :: temp (:,:)
1043 real,
intent(out) :: desat(:,:)
1044 character(len=*),
intent(out),
optional :: err_msg
1046 character(len=54) :: err_msg_local
1051 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1056 if ( nbad == 0 )
then 1057 if(
present(err_msg)) err_msg =
'' 1061 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1076 real,
intent(in) :: temp (:,:,:)
1077 real,
intent(out) :: desat(:,:,:)
1078 character(len=*),
intent(out),
optional :: err_msg
1081 character(len=128) :: err_msg_tmp
1084 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1089 if ( nbad == 0 )
then 1090 if(
present(err_msg)) err_msg=
'' 1094 write(err_msg_tmp,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1108 real,
intent(in) :: temp
1109 real,
intent(out) :: desat
1110 character(len=*),
intent(out),
optional :: err_msg
1113 character(len=128) :: err_msg_local
1116 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1121 if ( nbad == 0 )
then 1122 if(
present(err_msg)) err_msg =
'' 1125 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1140 real,
intent(in) :: temp (:)
1141 real,
intent(out) :: desat(:)
1142 character(len=*),
intent(out),
optional :: err_msg
1144 character(len=54) :: err_msg_local
1149 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1152 if(
present(err_msg)) err_msg=
'' 1156 if ( nbad == 0 )
then 1157 if(
present(err_msg)) err_msg =
'' 1161 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1177 real,
intent(in) :: temp (:,:)
1178 real,
intent(out) :: desat(:,:)
1179 character(len=*),
intent(out),
optional :: err_msg
1181 character(len=54) :: err_msg_local
1186 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1191 if ( nbad == 0 )
then 1192 if(
present(err_msg)) err_msg =
'' 1196 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1211 real,
intent(in) :: temp (:,:,:)
1212 real,
intent(out) :: desat(:,:,:)
1213 character(len=*),
intent(out),
optional :: err_msg
1216 character(len=128) :: err_msg_tmp
1219 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1224 if ( nbad == 0 )
then 1225 if(
present(err_msg)) err_msg=
'' 1229 write(err_msg_tmp,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1243 real,
intent(in) :: temp
1244 real,
intent(out) :: desat
1245 character(len=*),
intent(out),
optional :: err_msg
1248 character(len=128) :: err_msg_local
1251 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1256 if ( nbad == 0 )
then 1257 if(
present(err_msg)) err_msg =
'' 1260 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1275 real,
intent(in) :: temp (:)
1276 real,
intent(out) :: desat(:)
1277 character(len=*),
intent(out),
optional :: err_msg
1279 character(len=54) :: err_msg_local
1284 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1287 if(
present(err_msg)) err_msg=
'' 1291 if ( nbad == 0 )
then 1292 if(
present(err_msg)) err_msg =
'' 1296 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1312 real,
intent(in) :: temp (:,:)
1313 real,
intent(out) :: desat(:,:)
1314 character(len=*),
intent(out),
optional :: err_msg
1316 character(len=54) :: err_msg_local
1321 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1326 if ( nbad == 0 )
then 1327 if(
present(err_msg)) err_msg =
'' 1331 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1346 real,
intent(in) :: temp (:,:,:)
1347 real,
intent(out) :: desat(:,:,:)
1348 character(len=*),
intent(out),
optional :: err_msg
1351 character(len=128) :: err_msg_tmp
1354 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1359 if ( nbad == 0 )
then 1360 if(
present(err_msg)) err_msg=
'' 1364 write(err_msg_tmp,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1382 real,
intent(in) :: temp
1383 real,
intent(out) :: esat, desat
1384 character(len=*),
intent(out),
optional :: err_msg
1387 character(len=128) :: err_msg_local
1390 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1395 if ( nbad == 0 )
then 1396 if(
present(err_msg)) err_msg =
'' 1399 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1415 real,
dimension(:),
intent(in) :: temp
1416 real,
dimension(:),
intent(out) :: esat, desat
1417 character(len=*),
intent(out),
optional :: err_msg
1420 character(len=128) :: err_msg_local
1423 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1428 if ( nbad == 0 )
then 1429 if(
present(err_msg)) err_msg =
'' 1433 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1449 real,
dimension(:,:),
intent(in) :: temp
1450 real,
dimension(:,:),
intent(out) :: esat, desat
1451 character(len=*),
intent(out),
optional :: err_msg
1454 character(len=128) :: err_msg_local
1457 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1462 if ( nbad == 0 )
then 1463 if(
present(err_msg)) err_msg =
'' 1467 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1483 real,
dimension(:,:,:),
intent(in) :: temp
1484 real,
dimension(:,:,:),
intent(out) :: esat, desat
1485 character(len=*),
intent(out),
optional :: err_msg
1488 character(len=128) :: err_msg_local
1491 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1496 if ( nbad == 0 )
then 1497 if(
present(err_msg)) err_msg =
'' 1501 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1518 real,
intent(in) :: temp
1519 real,
intent(out) :: esat, desat
1520 character(len=*),
intent(out),
optional :: err_msg
1523 character(len=128) :: err_msg_local
1526 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1531 if ( nbad == 0 )
then 1532 if(
present(err_msg)) err_msg =
'' 1535 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1551 real,
dimension(:),
intent(in) :: temp
1552 real,
dimension(:),
intent(out) :: esat, desat
1553 character(len=*),
intent(out),
optional :: err_msg
1556 character(len=128) :: err_msg_local
1559 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1564 if ( nbad == 0 )
then 1565 if(
present(err_msg)) err_msg =
'' 1569 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1585 real,
dimension(:,:),
intent(in) :: temp
1586 real,
dimension(:,:),
intent(out) :: esat, desat
1587 character(len=*),
intent(out),
optional :: err_msg
1590 character(len=128) :: err_msg_local
1593 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1598 if ( nbad == 0 )
then 1599 if(
present(err_msg)) err_msg =
'' 1603 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1619 real,
dimension(:,:,:),
intent(in) :: temp
1620 real,
dimension(:,:,:),
intent(out) :: esat, desat
1621 character(len=*),
intent(out),
optional :: err_msg
1624 character(len=128) :: err_msg_local
1627 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1632 if ( nbad == 0 )
then 1633 if(
present(err_msg)) err_msg =
'' 1637 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1655 real,
intent(in) :: temp
1656 real,
intent(out) :: esat, desat
1657 character(len=*),
intent(out),
optional :: err_msg
1660 character(len=128) :: err_msg_local
1663 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1668 if ( nbad == 0 )
then 1669 if(
present(err_msg)) err_msg =
'' 1672 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1688 real,
dimension(:),
intent(in) :: temp
1689 real,
dimension(:),
intent(out) :: esat, desat
1690 character(len=*),
intent(out),
optional :: err_msg
1693 character(len=128) :: err_msg_local
1696 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1701 if ( nbad == 0 )
then 1702 if(
present(err_msg)) err_msg =
'' 1706 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1722 real,
dimension(:,:),
intent(in) :: temp
1723 real,
dimension(:,:),
intent(out) :: esat, desat
1724 character(len=*),
intent(out),
optional :: err_msg
1727 character(len=128) :: err_msg_local
1730 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1735 if ( nbad == 0 )
then 1736 if(
present(err_msg)) err_msg =
'' 1740 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1756 real,
dimension(:,:,:),
intent(in) :: temp
1757 real,
dimension(:,:,:),
intent(out) :: esat, desat
1758 character(len=*),
intent(out),
optional :: err_msg
1761 character(len=128) :: err_msg_local
1764 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1769 if ( nbad == 0 )
then 1770 if(
present(err_msg)) err_msg =
'' 1774 write(err_msg_local,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1792 subroutine compute_qs_0d ( temp, press, qsat, q, hc, dqsdT, esat, &
1793 err_msg, es_over_liq, es_over_liq_and_ice )
1795 real,
intent(in) :: temp, press
1796 real,
intent(out) :: qsat
1797 real,
intent(in),
optional :: q, hc
1798 real,
intent(out),
optional :: dqsdT, esat
1799 character(len=*),
intent(out),
optional :: err_msg
1800 logical,
intent(in),
optional :: es_over_liq
1801 logical,
intent(in),
optional :: es_over_liq_and_ice
1804 character(len=128) :: err_msg_tmp
1807 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1810 if (
present(es_over_liq))
then 1813 'requesting es wrt liq, but that table not constructed', &
1817 if (
present(es_over_liq_and_ice))
then 1820 'requesting es wrt liq and ice, but that table not constructed', &
1826 dqsdt, esat, es_over_liq, es_over_liq_and_ice)
1828 if ( nbad == 0 )
then 1829 if(
present(err_msg)) err_msg =
'' 1832 write(err_msg_tmp,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1850 subroutine compute_qs_1d ( temp, press, qsat, q, hc, dqsdT, esat, &
1851 err_msg, es_over_liq, es_over_liq_and_ice )
1853 real,
intent(in) :: temp(:), press(:)
1854 real,
intent(out) :: qsat(:)
1855 real,
intent(in),
optional :: q(:)
1856 real,
intent(in),
optional :: hc
1857 real,
intent(out),
optional :: dqsdT(:), esat(:)
1858 character(len=*),
intent(out),
optional :: err_msg
1859 logical,
intent(in),
optional :: es_over_liq
1860 logical,
intent(in),
optional :: es_over_liq_and_ice
1863 character(len=128) :: err_msg_tmp
1866 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1869 if (
present(es_over_liq))
then 1872 'requesting es wrt liq, but that table not constructed', &
1876 if (
present(es_over_liq_and_ice))
then 1879 'requesting es wrt liq and ice, but that table not constructed', &
1886 dqsdt, esat, es_over_liq, es_over_liq_and_ice)
1888 if ( nbad == 0 )
then 1889 if(
present(err_msg)) err_msg =
'' 1893 write(err_msg_tmp,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1912 subroutine compute_qs_2d ( temp, press, qsat, q, hc, dqsdT, esat, &
1913 err_msg, es_over_liq, es_over_liq_and_ice )
1915 real,
intent(in) :: temp(:,:), press(:,:)
1916 real,
intent(out) :: qsat(:,:)
1917 real,
intent(in),
optional :: q(:,:)
1918 real,
intent(in),
optional :: hc
1919 real,
intent(out),
optional :: dqsdT(:,:), esat(:,:)
1920 character(len=*),
intent(out),
optional :: err_msg
1921 logical,
intent(in),
optional :: es_over_liq
1922 logical,
intent(in),
optional :: es_over_liq_and_ice
1925 character(len=128) :: err_msg_tmp
1928 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1931 if (
present(es_over_liq))
then 1934 'requesting es wrt liq, but that table not constructed', &
1938 if (
present(es_over_liq_and_ice))
then 1941 'requesting es wrt liq and ice, but that table not constructed', &
1948 dqsdt, esat, es_over_liq, es_over_liq_and_ice)
1950 if ( nbad == 0 )
then 1951 if(
present(err_msg)) err_msg =
'' 1955 write(err_msg_tmp,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
1973 subroutine compute_qs_3d ( temp, press, qsat, q, hc, dqsdT, esat, &
1974 err_msg, es_over_liq, es_over_liq_and_ice )
1976 real,
intent(in) :: temp(:,:,:), press(:,:,:)
1977 real,
intent(out) :: qsat(:,:,:)
1978 real,
intent(in),
optional :: q(:,:,:)
1979 real,
intent(in),
optional :: hc
1980 real,
intent(out),
optional :: dqsdT(:,:,:), esat(:,:,:)
1981 character(len=*),
intent(out),
optional :: err_msg
1982 logical,
intent(in),
optional :: es_over_liq
1983 logical,
intent(in),
optional :: es_over_liq_and_ice
1986 character(len=128) :: err_msg_tmp
1989 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 1992 if (
present(es_over_liq))
then 1995 'requesting es wrt liq, but that table not constructed', &
1999 if (
present(es_over_liq_and_ice))
then 2002 'requesting es wrt liq and ice, but that table not constructed', &
2009 dqsdt, esat, es_over_liq, es_over_liq_and_ice)
2012 if ( nbad == 0 )
then 2013 if(
present(err_msg)) err_msg =
'' 2017 write(err_msg_tmp,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
2036 subroutine compute_mrs_0d ( temp, press, mrsat, mr, hc, dmrsdT, esat, &
2037 err_msg, es_over_liq, es_over_liq_and_ice )
2039 real,
intent(in) :: temp, press
2040 real,
intent(out) :: mrsat
2041 real,
intent(in),
optional :: mr, hc
2042 real,
intent(out),
optional :: dmrsdT, esat
2043 character(len=*),
intent(out),
optional :: err_msg
2044 logical,
intent(in),
optional :: es_over_liq
2045 logical,
intent(in),
optional :: es_over_liq_and_ice
2048 character(len=128) :: err_msg_tmp
2051 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 2054 if (
present(es_over_liq))
then 2057 'requesting es wrt liq, but that table not constructed', &
2061 if (
present(es_over_liq_and_ice))
then 2064 'requesting es wrt liq and ice, but that table not constructed', &
2070 hc, dmrsdt, esat, es_over_liq, es_over_liq_and_ice)
2072 if ( nbad == 0 )
then 2073 if(
present(err_msg)) err_msg =
'' 2076 write(err_msg_tmp,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
2095 subroutine compute_mrs_1d ( temp, press, mrsat, mr, hc, dmrsdT, esat,&
2096 err_msg, es_over_liq, es_over_liq_and_ice )
2098 real,
intent(in) :: temp(:), press(:)
2099 real,
intent(out) :: mrsat(:)
2100 real,
intent(in),
optional :: mr(:)
2101 real,
intent(in),
optional :: hc
2102 real,
intent(out),
optional :: dmrsdT(:), esat(:)
2103 character(len=*),
intent(out),
optional :: err_msg
2104 logical,
intent(in),
optional :: es_over_liq
2105 logical,
intent(in),
optional :: es_over_liq_and_ice
2108 character(len=128) :: err_msg_tmp
2111 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 2114 if (
present(es_over_liq))
then 2117 'requesting es wrt liq, but that table not constructed', &
2121 if (
present(es_over_liq_and_ice))
then 2124 'requesting es wrt liq and ice, but that table not constructed', &
2132 hc, dmrsdt, esat, es_over_liq, es_over_liq_and_ice)
2134 if ( nbad == 0 )
then 2135 if(
present(err_msg)) err_msg =
'' 2139 write(err_msg_tmp,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
2157 subroutine compute_mrs_2d ( temp, press, mrsat, mr, hc, dmrsdT, esat,&
2158 err_msg, es_over_liq, es_over_liq_and_ice )
2160 real,
intent(in) :: temp(:,:), press(:,:)
2161 real,
intent(out) :: mrsat(:,:)
2162 real,
intent(in),
optional :: mr(:,:)
2163 real,
intent(in),
optional :: hc
2164 real,
intent(out),
optional :: dmrsdT(:,:), esat(:,:)
2165 character(len=*),
intent(out),
optional :: err_msg
2166 logical,
intent(in),
optional :: es_over_liq
2167 logical,
intent(in),
optional :: es_over_liq_and_ice
2170 character(len=128) :: err_msg_tmp
2173 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 2176 if (
present(es_over_liq))
then 2179 'requesting es wrt liq, but that table not constructed', &
2183 if (
present(es_over_liq_and_ice))
then 2186 'requesting es wrt liq and ice, but that table not constructed', &
2194 hc, dmrsdt, esat, es_over_liq, es_over_liq_and_ice)
2196 if ( nbad == 0 )
then 2197 if(
present(err_msg)) err_msg =
'' 2201 write(err_msg_tmp,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
2219 subroutine compute_mrs_3d ( temp, press, mrsat, mr, hc, dmrsdT, esat,&
2220 err_msg, es_over_liq, es_over_liq_and_ice )
2222 real,
intent(in) :: temp(:,:,:), press(:,:,:)
2223 real,
intent(out) :: mrsat(:,:,:)
2224 real,
intent(in),
optional :: mr(:,:,:)
2225 real,
intent(in),
optional :: hc
2226 real,
intent(out),
optional :: dmrsdT(:,:,:), esat(:,:,:)
2227 character(len=*),
intent(out),
optional :: err_msg
2228 logical,
intent(in),
optional :: es_over_liq
2229 logical,
intent(in),
optional :: es_over_liq_and_ice
2232 character(len=128) :: err_msg_tmp
2235 if(
fms_error_handler(
'lookup_es',
'sat_vapor_pres_init is not called' ,err_msg))
return 2238 if (
present(es_over_liq))
then 2241 'requesting es wrt liq, but that table not constructed', &
2245 if (
present(es_over_liq_and_ice))
then 2248 'requesting es wrt liq and ice, but that table not constructed', &
2256 hc, dmrsdt, esat, es_over_liq, es_over_liq_and_ice)
2258 if ( nbad == 0 )
then 2259 if(
present(err_msg)) err_msg =
'' 2263 write(err_msg_tmp,
'(a47,i7)')
'saturation vapor pressure table overflow, nbad=', nbad
2309 character(len=*),
intent(out),
optional :: err_msg
2310 character(len=128) :: err_msg_local
2311 integer :: unit, ierr, io
2317 #ifdef INTERNAL_FILE_NML 2321 if (file_exist(
'input.nml'))
then 2322 unit = open_namelist_file( )
2323 ierr=1;
do while (ierr /= 0)
2324 read (unit, nml=sat_vapor_pres_nml, iostat=io, end=10)
2327 10
call mpp_close (unit)
2332 call write_version_number(
"SAT_VAPOR_PRES_MOD", version)
2335 if (mpp_pe() == mpp_root_pe())
write (unit, nml=sat_vapor_pres_nml)
2348 if ( err_msg_local ==
'' )
then 2349 if(
present(err_msg)) err_msg =
'' 2438 function check_1d ( temp )
result ( nbad )
2439 real ,
intent(in) :: temp(:)
2440 integer :: nbad, ind, i
2443 do i = 1,
size(temp,1)
2445 if (ind < 0 .or. ind >
nlim) nbad = nbad+1
2452 function check_2d ( temp )
result ( nbad )
2453 real ,
intent(in) :: temp(:,:)
2458 do j = 1,
size(temp,2)
2459 nbad = nbad +
check_1d( temp(:,j) )
2466 real ,
intent(in) :: temp(:)
2470 write(unit,*)
'Bad temperatures (dimension 1): ', (
check_1d(temp(i:i)),i=1,
size(temp,1))
2477 real ,
intent(in) :: temp(:,:)
2478 integer :: i, j, unit
2481 write(unit,*)
'Bad temperatures (dimension 1): ', (
check_1d(temp(i,:)),i=1,
size(temp,1))
2482 write(unit,*)
'Bad temperatures (dimension 2): ', (
check_1d(temp(:,j)),j=1,
size(temp,2))
2489 real,
intent(in) :: temp(:,:,:)
2490 integer :: i, j, k, unit
2493 write(unit,*)
'Bad temperatures (dimension 1): ', (
check_2d(temp(i,:,:)),i=1,
size(temp,1))
2494 write(unit,*)
'Bad temperatures (dimension 2): ', (
check_2d(temp(:,j,:)),j=1,
size(temp,2))
2495 write(unit,*)
'Bad temperatures (dimension 3): ', (
check_2d(temp(:,:,k)),k=1,
size(temp,3))
2502 real ,
intent(in) :: temp
2503 integer :: ind, unit
2507 if (ind < 0 .or. ind >
nlim)
then 2508 write(unit,
'(a,e10.3,a,i6)')
'Bad temperature=',temp,
' pe=',mpp_pe()
2516 real ,
intent(in) :: temp(:)
2517 integer :: i, ind, unit
2522 if (ind < 0 .or. ind >
nlim)
then 2523 write(unit,
'(a,e10.3,a,i4,a,i6)')
'Bad temperature=',temp(i),
' at i=',i,
' pe=',mpp_pe()
2532 real ,
intent(in) :: temp(:,:)
2533 integer :: i, j, ind, unit
2539 if (ind < 0 .or. ind >
nlim)
then 2540 write(unit,
'(a,e10.3,a,i4,a,i4,a,i6)')
'Bad temperature=',temp(i,j),
' at i=',i,
' j=',j,
' pe=',mpp_pe()
2550 real,
intent(in) :: temp(:,:,:)
2551 integer :: i, j, k, ind, unit
2558 if (ind < 0 .or. ind >
nlim)
then 2559 write(unit,
'(a,e10.3,a,i4,a,i4,a,i4,a,i6)')
'Bad temperature=',temp(i,j,k),
' at i=',i,
' j=',j,
' k=',k,
' pe=',mpp_pe()
subroutine lookup_es_des_3d(temp, esat, desat, err_msg)
subroutine lookup_es_2d(temp, esat, err_msg)
subroutine lookup_des3_0d(temp, desat, err_msg)
subroutine lookup_es2_3d(temp, esat, err_msg)
subroutine lookup_des_0d(temp, desat, err_msg)
subroutine lookup_es2_1d(temp, esat, err_msg)
subroutine lookup_es2_des2_2d(temp, esat, desat, err_msg)
subroutine lookup_es3_des3_2d(temp, esat, desat, err_msg)
subroutine show_all_bad_0d(temp)
logical show_bad_value_count_by_slice
real, parameter, public hlv
Latent heat of evaporation [J/kg].
subroutine lookup_es3_2d(temp, esat, err_msg)
subroutine lookup_des2_2d(temp, desat, err_msg)
subroutine lookup_es_3d(temp, esat, err_msg)
subroutine lookup_es3_3d(temp, esat, err_msg)
logical function, public fms_error_handler(routine, message, err_msg)
real, parameter, public rdgas
Gas constant for dry air [J/kg/deg].
subroutine show_all_bad_2d(temp)
subroutine lookup_es_des_0d(temp, esat, desat, err_msg)
subroutine lookup_es3_des3_1d(temp, esat, desat, err_msg)
integer function check_2d(temp)
subroutine lookup_es3_des3_3d(temp, esat, desat, err_msg)
subroutine, public sat_vapor_pres_init_k(table_size, tcmin, tcmax, TFREEZE, HLV, RVGAS, ES0, err_msg, use_exact_qs_input, do_simple, construct_table_wrt_liq, construct_table_wrt_liq_and_ice, teps, tmin, dtinv)
subroutine compute_qs_2d(temp, press, qsat, q, hc, dqsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
subroutine compute_mrs_2d(temp, press, mrsat, mr, hc, dmrsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
integer function, public check_nml_error(IOSTAT, NML_NAME)
subroutine compute_qs_3d(temp, press, qsat, q, hc, dqsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
subroutine lookup_es3_0d(temp, esat, err_msg)
character(len=input_str_length), dimension(:), allocatable, target, public input_nml_file
subroutine compute_mrs_1d(temp, press, mrsat, mr, hc, dmrsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
subroutine lookup_es3_des3_0d(temp, esat, desat, err_msg)
subroutine lookup_des3_1d(temp, desat, err_msg)
subroutine temp_check_1d(temp)
subroutine compute_mrs_0d(temp, press, mrsat, mr, hc, dmrsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
real, parameter, public rvgas
Gas constant for water vapor [J/kg/deg].
subroutine lookup_es2_des2_3d(temp, esat, desat, err_msg)
subroutine lookup_des3_2d(temp, desat, err_msg)
real, parameter, public tfreeze
Freezing temperature of fresh water [K].
subroutine lookup_des2_1d(temp, desat, err_msg)
subroutine lookup_es2_2d(temp, esat, err_msg)
subroutine lookup_es2_des2_1d(temp, esat, desat, err_msg)
subroutine compute_qs_1d(temp, press, qsat, q, hc, dqsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
subroutine lookup_es2_des2_0d(temp, esat, desat, err_msg)
subroutine lookup_es_0d(temp, esat, err_msg)
logical show_all_bad_values
logical module_is_initialized
real, parameter, public es0
Humidity factor. Controls the humidity content of the atmosphere through the Saturation Vapour Pressu...
subroutine lookup_es_des_1d(temp, esat, desat, err_msg)
subroutine temp_check_3d(temp)
subroutine lookup_des_1d(temp, desat, err_msg)
subroutine lookup_des2_0d(temp, desat, err_msg)
subroutine lookup_es3_1d(temp, esat, err_msg)
subroutine show_all_bad_1d(temp)
subroutine lookup_es_1d(temp, esat, err_msg)
subroutine lookup_des2_3d(temp, desat, err_msg)
subroutine lookup_es_des_2d(temp, esat, desat, err_msg)
subroutine lookup_des_2d(temp, desat, err_msg)
subroutine show_all_bad_3d(temp)
subroutine, public sat_vapor_pres_init(err_msg)
subroutine compute_mrs_3d(temp, press, mrsat, mr, hc, dmrsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
subroutine lookup_des_3d(temp, desat, err_msg)
subroutine lookup_des3_3d(temp, desat, err_msg)
logical construct_table_wrt_liq
subroutine compute_qs_0d(temp, press, qsat, q, hc, dqsdT, esat, err_msg, es_over_liq, es_over_liq_and_ice)
subroutine, public error_mesg(routine, message, level)
integer function check_1d(temp)
logical construct_table_wrt_liq_and_ice
subroutine temp_check_2d(temp)
subroutine lookup_es2_0d(temp, esat, err_msg)