module ncatt_mod

use ncd_define_mod

implicit none
private

public :: get_ncatt, put_ncatt, read_ncatt, write_ncatt
public :: copy_ncatt, remove_ncatt
public :: ncatt_type

   type ncatt_type
      character(len=maxn) :: name
      integer             :: datatype, len
      character(len=1)   , pointer :: batt(:)
      character(len=maxc), pointer :: catt(:)
      integer(short_type), pointer :: satt(:)
      integer( long_type), pointer :: latt(:)
      real   (float_type), pointer :: fatt(:)
      real  (double_type), pointer :: datt(:)
   end type ncatt_type

   integer, parameter :: FATAL = 2

!-----------------------------------------------------------------------

   interface get_ncatt
      module procedure  get_ncatt_byte
      module procedure  get_ncatt_short_0d, get_ncatt_short_1d
      module procedure  get_ncatt_float_0d, get_ncatt_float_1d
   end interface

   interface put_ncatt
      module procedure  put_ncatt_byte
      module procedure  put_ncatt_short_0d, put_ncatt_short_1d
      module procedure  put_ncatt_float_0d, put_ncatt_float_1d
   end interface

contains

!-----------------------------------------------------------------------

   subroutine alloc_ncatt_data (type, len, Att)

   integer,          intent(in)    :: type, len
   type(ncatt_type), intent(inout) :: Att

!  allocates space in appropriate data type
!  assumes that Att has not been allocated

      select case (type)
         case (NCBYTE:NCCHAR)
            allocate (Att%batt(len))
!!       case (NCCHAR)
!!          allocate (Att%catt(len))
         case (NCSHORT)
            allocate (Att%satt(len))
         case (NCLONG)
            allocate (Att%latt(len))
         case (NCFLOAT)
            allocate (Att%fatt(len))
         case (NCDOUBLE)
            allocate (Att%datt(len))
         case default
            call error_handler ('alloc_ncatt_data',                 &
                                'unknown attribute data type', FATAL)
      end select

      Att%datatype = type
      Att%len      = len

   end subroutine alloc_ncatt_data

!-----------------------------------------------------------------------

   subroutine remove_ncatt (Att)

   type(ncatt_type), intent(inout) :: Att

!  deallocates space in Att
!  assumes that Att has been allocated

      select case (Att%datatype)
         case (NCBYTE:NCCHAR)
            deallocate (Att%batt)
!!       case (NCCHAR)
!!          deallocate (Att%catt)
         case (NCSHORT)
            deallocate (Att%satt)
         case (NCLONG)
            deallocate (Att%latt)
         case (NCFLOAT)
            deallocate (Att%fatt)
         case (NCDOUBLE)
            deallocate (Att%datt)
         case default
            call error_handler ('dealloc_ncatt_data',               &
                                'unknown attribute data type', FATAL)
      end select

      Att%name     = ' '
      Att%datatype = 0
      Att%len      = 0

   end subroutine remove_ncatt

!-----------------------------------------------------------------------

   function read_ncatt (fid, varid, attid) result (Att)

      integer,        intent(in)  :: fid, varid, attid
      type(ncatt_type)            :: Att
      integer :: n, ierr, type, len

        call ncanam (fid, varid, attid, Att%name, ierr)
        call ncainq (fid, varid, Att%name, type, len, ierr)

        call alloc_ncatt_data (type, len, Att)

        select case (Att%datatype)
           case (NCBYTE:NCCHAR)
              call ncagtc (fid, varid, Att%name, Att%batt, Att%len,ierr)
!!         case (NCCHAR)
!!            n = Att%len * maxc
!!            call ncagtc (fid, varid, Att%name, Att%catt, n, ierr)
           case (NCSHORT)
              call ncagt  (fid, varid, Att%name, Att%satt, ierr)
           case (NCLONG)
              call ncagt  (fid, varid, Att%name, Att%latt, ierr)
           case (NCFLOAT)
              call ncagt  (fid, varid, Att%name, Att%fatt, ierr)
           case (NCDOUBLE)
              call ncagt  (fid, varid, Att%name, Att%datt, ierr)
!!         case default
!!            print *, 'invalid attribute data type'
!!            stop 111
        end select

   end function read_ncatt

!-----------------------------------------------------------------------

   subroutine write_ncatt (fid, varid, Att)

      integer,          intent(in) :: fid, varid
      type(ncatt_type), intent(in) :: Att
      integer  i, n, nc, ncx, ierr

        nc = len_trim(Att%name)

        select case (Att%datatype)
           case (NCBYTE:NCCHAR)
              call ncaptc (fid, varid, Att%name(1:nc), Att%datatype,  &
                           Att%len, Att%batt, ierr)
!!         case (NCCHAR)
!!            ncx = 0
!!            do i=1,Att%len
!!               ncx = max(ncx, len_trim(Att%catt(i)))
!!            enddo
!!            n = Att%len * ncx
!!            call ncaptc (fid, varid, Att%name(1:nc), Att%datatype,  &
!!                         n, Att%catt(:)(1:ncx), ierr)
           case (NCSHORT)
              call ncapt  (fid, varid, Att%name(1:nc), Att%datatype,  &
                           Att%len, Att%satt, ierr)
           case (NCLONG)
              call ncapt  (fid, varid, Att%name(1:nc), Att%datatype,  &
                           Att%len, Att%latt, ierr)
           case (NCFLOAT)
              call ncapt  (fid, varid, Att%name(1:nc), Att%datatype,  &
                           Att%len, Att%fatt, ierr)
           case (NCDOUBLE)
              call ncapt  (fid, varid, Att%name(1:nc), Att%datatype,  &
                           Att%len, Att%datt, ierr)
           case default
              print *, 'invalid attribute data type'
              stop 111
        end select

   end subroutine write_ncatt

!-----------------------------------------------------------------------

   function get_ncatt_no (Att, name) result (no)

      type(ncatt_type),  intent(in), dimension(:)  :: Att
      character(len=*),  intent(in)                :: name
      integer                                      :: no
      integer  i, nc

        nc = len_trim(name)
        no = 0

        do i = 1, size(Att)
          if (Att(i)%name(1:len_trim(Att(i)%name)) == name(1:nc)) then
              no = i
              exit
          endif
        enddo

   end function get_ncatt_no

!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------

   subroutine get_ncatt_byte (Att, natt, name, string, id)

      type(ncatt_type),  intent(in), dimension(:) :: Att
      integer,           intent(in)               :: natt
      character(len=*),  intent(in)               :: name
      character(len=*),  intent(out)              :: string
      integer,           intent(out)              :: id
      integer  k, n, na

         na = min(size(Att), natt)

         id = get_ncatt_no (Att(1:na), name)

         if (id > 0) then
             if (Att(id)%datatype == NCBYTE .or.  &
                 Att(id)%datatype == NCCHAR) then
                      n = min(Att(id)%len, len(string))
                      do k=1,n
                         string(k:k) = Att(id)%batt(k)
                      enddo
                      do k=n+1,len(string)
                         string(k:k) = ' '
                      enddo
             endif
         endif

   end subroutine get_ncatt_byte

!-----------------------------------------------------------------------

   subroutine get_ncatt_short_1d (Att, natt, name, data, id)

      type(ncatt_type),    intent(in), dimension(:)  :: Att
      integer,             intent(in)                :: natt
      character(len=*),    intent(in)                :: name
      integer(short_type), intent(out), dimension(:) :: data
      integer,             intent(out)               :: id
      integer  k, n, na

         na = min(size(Att), natt)

         id = get_ncatt_no (Att(1:na), name)

         if (id > 0) then
             if (Att(id)%datatype == NCSHORT) then
                     n = min(Att(id)%len, size(data))
                     data(1:n) = Att(id)%satt(1:n)
             endif
         endif

   end subroutine get_ncatt_short_1d

!-----------------------------------------------------------------------

   subroutine get_ncatt_float_1d (Att, natt, name, data, id)

      type(ncatt_type),  intent(in), dimension(:)  :: Att
      integer,           intent(in)                :: natt
      character(len=*),  intent(in)                :: name
      real (float_type), intent(out), dimension(:) :: data
      integer,           intent(out)               :: id
      integer  k, n, na

         na = min(size(Att), natt)

         id = get_ncatt_no (Att(1:na), name)

         if (id > 0) then
             if (Att(id)%datatype == NCFLOAT) then
                     n = min(Att(id)%len, size(data))
                     data(1:n) = Att(id)%fatt(1:n)
             endif
         endif

   end subroutine get_ncatt_float_1d

!-----------------------------------------------------------------------

   subroutine get_ncatt_short_0d (Att, natt, name, data, id)

      type(ncatt_type),    intent(in), dimension(:) :: Att
      integer,             intent(in)               :: natt
      character(len=*),    intent(in)               :: name
      integer(short_type), intent(out)              :: data
      integer,             intent(out)              :: id
      integer(short_type)            , dimension(1) :: data_1d

        call get_ncatt_short_1d (Att, natt, name, data_1d, id)
        if (id > 0) data = data_1d(1)

   end subroutine get_ncatt_short_0d

!-----------------------------------------------------------------------

   subroutine get_ncatt_float_0d (Att, natt, name, data, id)

      type(ncatt_type),  intent(in), dimension(:) :: Att
      integer,           intent(in)               :: natt
      character(len=*),  intent(in)               :: name
      real (float_type), intent(out)              :: data
      integer,           intent(out)              :: id
      real (float_type)            , dimension(1) :: data_1d

        call get_ncatt_float_1d (Att, natt, name, data_1d, id)
        if (id > 0) data = data_1d(1)

   end subroutine get_ncatt_float_0d

!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------

   subroutine put_ncatt_byte (Att, natt, name, string, id)

      type(ncatt_type),  intent(inout), dimension(:) :: Att
      integer,           intent(inout)               :: natt
      character(len=*),  intent(in)                  :: name
      character(len=*),  intent(in)                  :: string
      integer,           intent(out)                 :: id
      integer  k, n, na

         na = min(size(Att), natt)

         id = get_ncatt_no (Att(1:na), name)

!        ------ replace string -----

         if (id > 0) then
             if (Att(id)%datatype == NCBYTE .or.  &
                 Att(id)%datatype == NCCHAR) then
                     n = len(string)
                     if (Att(id)%len /= n) then
                        deallocate (Att(id)%batt)
                          allocate (Att(id)%batt(n))
                          Att(id)%len = n
                     endif
                     do k=1,n
                       Att(id)%batt(k) = string(k:k)
                     enddo
                     return
             endif
         endif

!        ------ append string -----

         if (natt+1 > max_natt) return
         natt = natt + 1
         id   = natt
         n = len(string)
         Att(id)%name     = name
         Att(id)%datatype = NCCHAR
         Att(id)%len      = n
         allocate (Att(id)%batt(n))
         do k=1,n
            Att(id)%batt(k) = string(k:k)
         enddo

   end subroutine put_ncatt_byte

!-----------------------------------------------------------------------

   subroutine put_ncatt_short_1d (Att, natt, name, data, id)

      type(ncatt_type),    intent(inout), dimension(:) :: Att
      integer,             intent(inout)               :: natt
      character(len=*),    intent(in)                  :: name
      integer(short_type), intent(in)   , dimension(:) :: data
      integer,             intent(out)                 :: id
      integer  k, n, na

         na = min(size(Att), natt)

         id = get_ncatt_no (Att(1:na), name)

!        ------ replace data -----

         if (id > 0) then
             if (Att(id)%datatype == NCSHORT) then
                     n = size(data)
                     if (Att(id)%len /= n) then
                        deallocate (Att(id)%satt)
                          allocate (Att(id)%satt(n))
                          Att(id)%len = n
                     endif
                     Att(id)%satt(1:n) = data(1:n)
                     return
             endif
         endif

!        ------ append string -----

         if (natt+1 > max_natt) return
         natt = natt + 1
         id   = natt
         n = size(data)
         Att(id)%name     = name
         Att(id)%datatype = NCSHORT
         Att(id)%len      = n
         allocate (Att(id)%satt(n))
         Att(id)%satt(1:n) = data(1:n)

   end subroutine put_ncatt_short_1d

!-----------------------------------------------------------------------

   subroutine put_ncatt_float_1d (Att, natt, name, data, id)

      type(ncatt_type),  intent(inout), dimension(:) :: Att
      integer,           intent(inout)               :: natt
      character(len=*),  intent(in)                  :: name
      real (float_type), intent(in)   , dimension(:) :: data
      integer,           intent(out)                 :: id
      integer  k, n, na

         na = min(size(Att), natt)

         id = get_ncatt_no (Att(1:na), name)

!        ------ replace data -----

         if (id > 0) then
             if (Att(id)%datatype == NCFLOAT) then
                     n = size(data)
                     if (Att(id)%len /= n) then
                        deallocate (Att(id)%fatt)
                          allocate (Att(id)%fatt(n))
                          Att(id)%len = n
                     endif
                     Att(id)%fatt(1:n) = data(1:n)
                     return
             endif
         endif

!        ------ append string -----

         if (natt+1 > max_natt) return
         natt = natt + 1
         id   = natt
         n = size(data)
         Att(id)%name     = name
         Att(id)%datatype = NCFLOAT
         Att(id)%len      = n
         allocate (Att(id)%fatt(n))
         Att(id)%fatt(1:n) = data(1:n)

   end subroutine put_ncatt_float_1d

!-----------------------------------------------------------------------

   subroutine put_ncatt_short_0d (Att, natt, name, data, id)

      type(ncatt_type),    intent(inout), dimension(:) :: Att
      integer,             intent(inout)               :: natt
      character(len=*),    intent(in)                  :: name
      integer(short_type), intent(in)                  :: data
      integer,             intent(out)                 :: id
      integer(short_type),                dimension(1) :: data_1d

         data_1d(1) = data
         call put_ncatt_short_1d (Att, natt, name, data_1d, id)

   end subroutine put_ncatt_short_0d

!-----------------------------------------------------------------------

   subroutine put_ncatt_float_0d (Att, natt, name, data, id)

      type(ncatt_type),  intent(inout), dimension(:) :: Att
      integer,           intent(inout)               :: natt
      character(len=*),  intent(in)                  :: name
      real (float_type), intent(in)                  :: data
      integer,           intent(out)                 :: id
      real (float_type),                dimension(1) :: data_1d

         data_1d(1) = data
         call put_ncatt_float_1d (Att, natt, name, data_1d, id)

   end subroutine put_ncatt_float_0d

!-----------------------------------------------------------------------

   subroutine copy_ncatt (Att_in, Att_out)

      type(ncatt_type), intent(in)  :: Att_in
      type(ncatt_type), intent(out) :: Att_out

      Att_out%name = Att_in%name

      call alloc_ncatt_data (Att_in%datatype, Att_in%len, Att_out)

      select case (Att_out%datatype)
         case (NCBYTE:NCCHAR)
            Att_out%batt = Att_in%batt
!!       case (NCCHAR)
!!          n = Att%len * maxc
!!          Att_out%catt = Att_in%catt
         case (NCSHORT)
            Att_out%satt = Att_in%satt
         case (NCLONG)
            Att_out%latt = Att_in%latt
         case (NCFLOAT)
            Att_out%fatt = Att_in%fatt
         case (NCDOUBLE)
            Att_out%datt = Att_in%datt
      end select

   end subroutine copy_ncatt

!-----------------------------------------------------------------------

   subroutine error_handler (routine, message, level)

   character(len=*), intent(in) :: routine, message
   integer         , intent(in) :: level

      print *, 'ERROR in ' // trim(routine)
      print *, trim(message)

      call abort

   end subroutine error_handler

!-----------------------------------------------------------------------

end module ncatt_mod


text:
! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
! See https://llvm.org/LICENSE.txt for license information.
! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
!

module mod
logical expect(9), rslt(9)
type :: objects(k1,k2,l1)
integer, kind :: k2 = selected_char_kind("ASCII")
integer, kind :: k1 = selected_int_kind(4)
integer,len :: l1
integer(k1) :: p(l1)
end type
contains
subroutine foo(n)
integer n
type(objects(l1=n)) :: x

rslt(5) = x%k1 .eq. selected_int_kind(4)
rslt(6) = x%k2 .eq. selected_char_kind("ASCII")
rslt(7) = x%l1 .eq. n
rslt(8) = size(x%p) .eq. x%l1

do i=1,n
x%p(i) = i
enddo

rslt(9) = .true.
do i=1,n
if (x%p(i) .ne. i) rslt(9) = .false.
enddo

end subroutine

end module

program p
use mod
integer y
type(objects(1,20,30)) :: x

rslt(1) = x%k1 .eq. 1
rslt(2) = x%k2 .eq. 20
rslt(3) = x%l1 .eq. 30
rslt(4) = size(x%p) .eq. x%l1

call foo(1000)

expect = .true.
call check(rslt,expect,9)

end

max_stars_repo_name: abrahamtovarmob/flang

max_issues_repo_name: abrahamtovarmob/flang

max_forks_repo_name: abrahamtovarmob/flang


text:
Joy and Taylors Raw Chocolates makes agavesweetened raw food chocolate, using cocoa from Ecuador and cocoa butter from Bali.  The ingredients are characterized with happy adjectives: raw, organic, fair trade, vegan, and glutenfree.  users/joy&taylor Joy and users/taylorpope Taylor aim to promote cacao as a superfood, focusing their manufacturing process towards retention of the antioxidant qualities in the cocoa powder by using low temperatures during production.  Cocoa butter melts below 101°F, keeping it under the 104115°F limit of raw as defined by the other Wiki on raw foodism.

The company is willing to barter their raw ingredients and finished products with local businesses and community members in exchange for products or services.  Contact the company directly for a free sample, to place an order, or to make barter arrangements.  Phone/email are above; order forms are forthcoming.  They say, If you have only money to give that is fine too, our landlord doesnt accept chocolate... YET!

Raw Ingredients: Goji Berries, Golden Berries (Cape Gooseberry), Maca powder, Coconut Palm Sugar, Coconut Oil, Cacao Beans, Cacao Butter, Cacao Powder, Cacao Nibs, Hemp Protein powder made from cold milled hemp seeds, Agave Nectar, Lucuma Powder, and Vanilla beans whole and ground.

Partial Flavor List:

  Almond Sea Salt
  Cacao Nibs
  Mint
  Nibsy Mint
  Espresso
  Vanilla Hazelnut
  Vanilla Hazelnut Mocha
  Vanilla Chai
  Cayenne Delight
  Calming Chamomile
  Smooth Cacao (Just Chocolate)
  Lovely Lavender
  Agave Toffee
  Perfect Pecan
  Very Vanilla
  Orange Spice
  Maca
  MacaDamia
  Sea Salt Cayenne
  Goji Goodness
  Goji Coconut Almond Cayenne
  Orange Spice (new!)
  Bacon Bit Bites (by popular demand)

A website is in process; friend them on Facebook to leave feedback on trades/products and get perks in exchange.

Local companies who already trade with Joy and Taylors Raw Chocolates: you could ask these folks for flavor reviews.

  The Laundry Lounge  we love you Dina and Max!  Thank you for buying new machines that use less water!
  Generations Family Footwear  we love you Steve, Taytay loves the Naots, Steve LOVES our Chocolates!
  Just Kidding  Diane hooks our little kids up with awesome second hand gear and she loves the Almond Seasalt!

They LOVE to trade for Massage and Body Work   acupuncture, cranial sacral, NMT, Deep Tissue  you name it, they need it.
This Business also accepts Davis Dollars community currency.

Make some bacon chocolate like http://www.vosgeschocolate.com/product/bacon_exotic_candy_bar/exotic_candy_bars and I will buy some  Users/StevenDaubert

 {{{^}}}Steven, would you like your Bacon Crispy or Chewy?  I personally like it a bit chewy but I think that crisp would be better suited for in the chocolate.  How much would you be willing to buy?  I have a batch of chocolate going right now, I could make some bacon for you.

 {{{}}}Stevens Chocolate order WILL NOT be Vegan, my appologies to the Vegan community.  Dont worry though the Bacon will not get anywhere near the rest of the batch I promise!
Im still down for this, I just need to get some really good bacon, I would start small as it would be something of a treat, or something to share with friends... Anyways I havent forgotten Daubert

20091204 22:01:25 nbsp What is goji goodness?  Im a big fan of the goji bar made by vosges which is berries and salt.  Its amazing!

Also do you prepare any sugar free bars (made with say maltose or agave nectar)?  I have some family/friends on restrictive diets for health reasons (no vitamin D enriched milk for example) and it would be great to know if you have any specialty bars I could get them as a Christmas treat. Users/OliviaY

20091205 13:48:02 nbsp So Joy and Taylors Raw Chocolates are currently sweetened Exclusively with Raw Organic Agave Nectar.  That means All of the chocolates are low glycemic, though people are always shocked when they find this out after eating them. The Goji Goodness flavor is an Organic Himalayan Goji with Pink Himalayan Seasalt, so surely OliviaY will be in love when she tries it. Users/Joy&Taylor

20110228 23:43:20 nbsp Their products are available for sale in retail stores  the Davis Food Coop is where Ive bought it. Their dark chocolate is considerably different from other, more conventional ones — its so different, many are willing to pay what it costs to get a pure, fairtraded, raw product. Users/DougWalter

20110505 21:47:17 nbsp Monticello, Joy & Taylors Raw Chocolate WWWWWWhttp://daviswiki.org/Joy_and_Taylor%27s_Raw_Chocolates & Pachamama Coffee WWWWWWhttp://www.pachamama.coop have teamed up to create the Whole Earth Festivals first local food booth, dubbed YoLoCa!

We will be on the east quad across the street from North and South Hall under the cork oak selling Monticellos market salads, veggie sandwiches, adult Smores with housemade Pachamama coffee marshmallows & graham crackers & Joy & Taylors chocolate, Terra Firma strawberry shortcake with fresh whipped cream, & lavender lemonade. Joy & Taylors Raw Chocolates will be serving frozen organic bananas with chocolate sauce, Terra Firma strawberries with chocolate sauce, chocolate shots, & truffles. Pachamama will serve fresh brewed hot & iced coffee & mochas.

If you are going to the festival, please stop by to say hello and support the first Whole Earth Festival local food booth. If you arent going to the festival, support our local businesses by patronizing Monticello restaurant & Davis Farmers Market Picnic in the Park Food Booth; purchasing Joy & Taylors Raw Chocolates in the chocolate aisle and/or the living foods section at the Davis Food Coop; and purchasing Pachamama coffee at the Davis Food Coop and at their booth at the Davis Farmers Market.  Users/RhondaGruska

ext: f

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
!====================================================================
!-----------------------------------------------------------------------
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-----------------------------------------------------------------------
!BOI
! !MODULE: m_humidity -- Humidity conversion routines
!
! !DESCRIPTION:
!     This module contains routines that convert humidity values.
!     The function from Magnus (1844), with various coefficients, is
!     used in this module to determine the saturation vapor pressure
!     (SVP) as a function of temperature.  The equations and/or
!     coefficient sets are identified by an integer code.  (Note: An
!     invalid code is reset to default.)
!
! !REFERENCES:
!     Alduchov, Oleg. A. and Robert E. Eskridge, 1996: Improved Magnus
!          form apporiximations of saturation vapor pressure.  Journal of
!          Applied Meteorology, 35, 601-609.
!
!     Magnus, G., 1844: Versuche uber die Spannkrafte des Wasserdampfes.
!          Ann. Phys. Chem., 61, 225.
!
!     Rogers, R. R., 1979: A Short Course in Cloud Physics, 2nd. Ed.,
!          Pergamon Press, Oxford. 235pp.
!
!     Tetens, O., 1930: Uber einige meteorologisch1 Begriffe., Z. Geophys.,
!          6, 297-309.
!
! !INTERFACE:
!
      module      m_humidity
      implicit    NONE
      private	! except

      public ::           ! Routine to convert from vapor pressure (VP) to ...
     .   VPtoDP,  VP2DP,  ! ... dew point (DP)
     .   VPtoFP,  VP2FP,  ! ... frost point (FP)
     .   VPtoSH,  VP2SH,  ! ... specific humidity (SH)
     .   VPtoMR,  VP2MR,  ! ... mixing ratio (MR)
     .   VPtoRH,  VP2RH   ! ... relative humidity (RH)

      public ::           ! Routines to convert from ...
     .   DPtoVP,  DP2VP,  ! ... dew point (DP)
     .   FPtoVP,  FP2VP,  ! ... frost point (FP)
     .   SHtoVP,  SH2VP,  ! ... specific humidity (SH)
     .   MRtoVP,  MR2VP,  ! ... mixing ratio (MR)
     .   RHtoVP,  RH2VP   ! ... relative humidity (RH)
      public ::           ! Routines to convert from
     .   VPTtoRH, VPT2RH, ! ... VP and air temperature to RH
     .   RHTtoVP, RHT2VP  ! ... RH and air temperature to VP

!
!     Note: Routine names of the form xxtoxx and xx2xx implies a
!           subroutine and function, respectively.
!
      public ::           ! Routine to check ...
     .   CheckMR          ! ... mixing ratio (should not increase with
                          !   height the strotophere.)

      public ::           ! Equation code for determining the SVP
     .   wEqtn_AE96,      ! ... over water from AE96
     .   wEqtn_NCEP,      ! ... over water from NCEP
     .   iEqtn_AE96       ! ... over ice   from AE96

      interface DPtoVP
         module procedure
     .      DPtoVP_pure,  ! Convert for pure water vapor or ...
     .      DPtoVP_moist  ! ... moist air (AE96 only)
      end interface

      interface VPtoDP
         module procedure
     .      VPtoDP_pure,  ! Convert for pure water vapor or ...
     .      VPtoDP_moist  ! ... moist air (AE96 only)
      end interface

      interface FPtoVP
         module procedure
     .      FPtoVP_pure,  ! Convert for pure water vapor or ...
     .      FPtoVP_moist  ! ... moist air (AE96 only)
      end interface

      interface VPtoFP
         module procedure
     .      VPtoFP_pure,  ! Convert for pure water vapor or ...
     .      VPtoFP_moist  ! ... moist air (AE96 only)
      end interface

      interface VPtoRH
         module procedure
     .      VPtoRH_wnp,   ! Convert by neglecting ...
     .      VPtoRH_wp     ! ... and without neglecting air pressure data
      end interface

      interface RHtoVP
         module procedure
     .      RHtoVP_wnp,   ! Convert by neglecting ...
     .      RHtoVP_wp     ! ... and without neglecting air pressure data
      end interface

      interface VPTtoRH
         module procedure
     .      VPTtoRH_wnp,  ! Convert by neglecting ...
     .      VPTtoRH_wp    ! ... and without neglecting air pressure data
      end interface

      interface RHTtoVP
         module procedure
     .      RHTtoVP_wnp,  ! Convert by neglecting ...
     .      RHTtoVP_wp    ! ... and without neglecting air pressure data
      end interface

!
! !REVISION HISTORY:
!     29Oct2001  C. Redder  Original code
!      ~   2003  C. Redder  Added the generic interfaces, VPTtoRH, and
!                           RHTtoVP.
!     02Apr2004  C. Redder  Added the routine CheckMR.  Generalized
!                           computation of Ew and Ei to include other
!                           coefficients using the Magnus formuation.
!
!EOI
!-----------------------------------------------------------------

      real,    parameter ::
     .   Ra   =  287.0,      ! The individual gas constant for dry air and ...
     .   Rv   =  461.0,      ! ... water vapor (j/(kg-deg K, from Rogers, 1979)
     .   RaRv =  Ra / Rv,
     .   SHUnit   = 1000.0,  ! Factors that set the unit of specific humidity
     .   MRUnit   = 1000.0,  ! ... and mixing ratios to g/kg.
     .   PctF     =  100.0,  ! ... and the relative humidity to %
     .   T0       =  273.16  ! ... at the reference temperature (deg K)
      integer, parameter ::
     .   ScrSz  = 1000       ! Scratch size

      integer, parameter ::  ! Equation codes for determining the SVP
     .   wEqtn_AE96 = 0,     ! ... over water from AE96
     .   wEqtn_NCEP = 1,     ! ... over water from NCEP
     .   iEqtn_AE96 = 0      ! ... over ice   from AE96

      contains

!....................................................................

!-------------------------------------------------------------------------
!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
!BOP
!
! !IROUTINE:  Get_wMagnus --- Get coefficients for Magnus formulation over water
!
! !INTERFACE:
      pure subroutine  Get_wMagnus ( Ew0, aw, bw, Eqtn )
!
! !USES
      implicit NONE
!
! !INPUT PARAMETERS:
      integer,       intent (in), optional ::
     .   Eqtn      ! Equation code for coefficient sets (see prologue,
                   !   default: 0)
!
! !INPUT/OUTPUT PARAMETERS:
      real,          intent (out) ::
     .   Ew0,      ! Saturation vapor pressure at temperature, T0
     .   aw,       ! coefficent a
     .   bw        ! ... and b (Equation 6 in AE96)
!
! !DESCRIPTION:
!
! !REVISION HISTORY:
!     03Apr2004  C. Redder  Original code
!EOP
!-------------------------------------------------------------------------

      integer :: Code_
      Code_ = wEqtn_AE96
      if ( present ( Eqtn )) Code_ = Eqtn

!     Set coefficients from ...
!     -------------------------
      if ( Code_ .eq. wEqtn_NCEP ) then ! ... from ncep (or Tetens, 1930)
         Ew0 =    6.1078
         aw  =   17.269
         bw  =  237.3

      else                              ! ... from AE96 (Eq. 21 in AE96,
         Ew0 =    6.1094                !                default)
         aw  =   17.625
         bw  =  243.04

      end if

      return
      end subroutine Get_wMagnus

!....................................................................

!-------------------------------------------------------------------------
!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
!BOP
!
! !IROUTINE:  Get_iMagnus --- Get coefficients for Magnus formulation over ice
!
! !INTERFACE:
      pure subroutine  Get_iMagnus ( Ei0, ai, bi, Eqtn )
!
! !USES
      implicit NONE
!
! !INPUT PARAMETERS:
      integer,       intent (in), optional ::
     .   Eqtn      ! Equation code for coefficient sets (see prologue,
                   !   default: 0)
!
! !INPUT/OUTPUT PARAMETERS:
      real,          intent (out) ::
     .   Ei0,      ! Saturation vapor pressure at temperature, T0
     .   ai,       ! coefficent a
     .   bi        ! ... and b (Equation 6 in AE96)
!
! !DESCRIPTION:
!
! !REVISION HISTORY:
!     03Apr2004  C. Redder  Original code
!EOP
!-------------------------------------------------------------------------
      integer :: Code_

      Code_ = iEqtn_AE96
      if ( present ( Eqtn )) Code_ = Eqtn

!     Set coefficients from ...
!     -------------------------
         Ei0 =    6.1121 ! ... AE96 (Eq. 21 in AE96, default)
         ai  =   22.587
         bi  =  273.86

      return
      end subroutine Get_iMagnus

!....................................................................

!-------------------------------------------------------------------------
!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
!BOP
!
! !IROUTINE:  CheckMR --- Edit stratospheric values of mixing ratio
!
! !INTERFACE:
      subroutine  CheckMR ( T, P, MR )
!
! !USES
      implicit NONE
!
! !INPUT PARAMETERS:
      real,          intent (in)    ::
     .   T  (:),   ! Temperature (K)
     .   P  (:)    ! Pressure (hPa)
!
! !INPUT/OUTPUT PARAMETERS:
      real,          intent (inout) ::
     .   MR (:)    ! Mixing ratio (g/kg)
!
! !DESCRIPTION:
!     This routine insures that the mixing ratio in the stratosphere
!     does not increase with height.
!
! !REVISION HISTORY:
!     23Mar2004  C. Redder  Original code
!EOP
!-------------------------------------------------------------------------
      real, parameter ::
     .   TP_Bottom  = 299.0,
     .   TP_Top     =  90.0
      real    :: TP_Temp, Ti, Pi, MRi, MR_Max
      integer :: iLev, NLev, iTP_Bottom, iTP_Top, iTPause

      NLev = min ( size ( T ), size ( P ), size ( MR ))
      if ( NLev       .le. 0 ) return

!     If all data is well within the troposphere,
!     then there is nothing more to do
!     ------------------------------------------
      if ( P ( NLev ) .ge. TP_Bottom ) return

!     Locate the tropause or the lowest layer above the tropause
!     ----------------------------------------------------------
      iTPause = 1
      if ( P ( 1 ) .gt. TP_Top ) then
         iTPause = NLev
         TP_Temp = 2.0 * T ( 1 )
         do iLev = NLev - 1, 1, -1
            Ti = T ( iLev )
            Pi = P ( iLev )
            if      ( Ti .lt. TP_Temp .and.
     .                Pi .gt. TP_Top ) then
               iTPause = iLev
               TP_Temp = Ti
            else if ( Pi .le. TP_Top ) then
               iTPause = iLev
            end if
            if ( Pi .ge. TP_Bottom ) exit
         end do
      end if

!     Ensure that mixing ratio does not increase in the stratophere
!     -------------------------------------------------------------
      MR_Max = MR ( iTPause )
      do iLev = iTPause + 1, NLev
         MRi         = MR ( iLev )
         MR_Max      = min ( MRi, MR_Max )
         MR ( iLev ) = MR_Max

      end do

      return
      end subroutine CheckMR

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: DPtoVP_pure () --- Dew point to vapor pressure for pure water vapor
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from dew point
!     temperature to vapor pressure for pure water vapor.
!
! !INTERFACE:
      pure subroutine DPtoVP_pure ( DP, VP, Eqtn )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,    intent (in)           :: DP (:) ! dew point (deg K)
      integer, intent (in), optional :: Eqtn   ! equation code (default: 0)
!
! !OUTPUT PARAMETERS:
      real,    intent (out)          :: VP (:) ! vapor pressure (mb or hPa)
!
!     Note: The minimum size of the arrays determines the number of values
!           to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!     18Apr2002  C. Redder   Modified the way the number of values are
!                            determined.
!     03Apr2004  C. Redder   Added the optional argument, Eqtn
! EOP
!-------------------------------------------------------------------------

      real    :: TC, Ew0, aw, bw
      integer :: iHum, NHum

      call Get_wMagnus ( Ew0, aw, bw, Eqtn = Eqtn )

      NHum = min ( size ( DP ), size ( VP ))
      do iHum = 1, NHum
         TC          = DP ( iHum ) - T0             ! from deg K to deg C
         VP ( iHum ) = Ew0 * exp ( aw * TC / ( bw + TC ))
      end do

      return
      end subroutine DPtoVP_pure

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: DPtoVP_moist () --- Dew point to vapor pressure for moist air
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from dew point
!     temperature to vapor pressure for moist air.
!
! !INTERFACE:
      pure subroutine DPtoVP_moist ( DP, P, VP )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,      intent (in)  ::
     .   DP (:), ! dew point (deg K)
     .   P  (:)  ! air pressure (mb or hPa)
!
! !OUTPUT PARAMETERS:
      real,      intent (out) ::
     .   VP (:)  ! vapor pressure (mb or hPa)
!
!     Note: The minimum size of the input arrays DP and VP determine
!           the number of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!     18Apr2002  C. Redder   Modified the way the number of values are
!                            determined.
!
! EOP
!-------------------------------------------------------------------------

      real, parameter :: a = 4.5e-6, c = 1.00071
      real    :: PP
      integer :: iHum, NHum, NP

!     Calculate vapor pressure for pure water vapor
!     ---------------------------------------------
      call DPtoVP_pure ( DP, VP )

!     ... and then add the enhancement factor
!     ---------------------------------------
      NP   = size ( P )
      NHum = min  ( size ( DP ), size ( VP ))
      if ( NP .eq. 0 ) NHum = 0
      do iHum = 1, NHum
         PP = P ( min ( iHum, NP ))
         VP ( iHum ) = c * exp ( a * PP ) * VP ( iHum )
      end do

      return
      end subroutine DPtoVP_moist

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: DP2VP () --- Dew point to vapor pressure
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from dew point
!     temperature to vapor pressure for moist air (AE96 only) or pure
!     water vapor.
!
! !INTERFACE:
      pure function DP2VP ( DP, P, Eqtn )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,    intent (in)           :: DP    ! dew point (deg K)
      real,    intent (in), optional :: P     ! air pressure (mb or hPa) if
                                              !   moist air is assumed
      integer, intent (in), optional :: Eqtn  ! equation code (default: 0)
!
! !OUTPUT PARAMETERS:
      real                           :: DP2VP ! vapor pressure (mb or hPa)
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!     03Apr2004  C. Redder   Added the optional argument, Eqtn
!
! EOP
!-------------------------------------------------------------------------
      real :: VP (1)

!     Convert for ...
!     ---------------
      if ( present ( P ) ) then
         call DPtoVP_moist ( (/DP/), (/P/), VP ) ! ... moist air
      else
         call DPtoVP_pure  ( (/DP/),        VP, Eqtn = Eqtn )
     .                                           ! ... pure water vapor
      end if
      DP2VP = VP (1)

      return
      end function DP2VP

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: VPtoDP_pure () --- Vapor pressure to dew point for pure water vapor
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from vapor pressure
!     to dew point temperature for pure water vapor.
!
! !INTERFACE:
      pure subroutine VPtoDP_pure ( VP, DP, Eqtn )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,    intent (in)           :: VP (:) ! vapor pressure (mb or hPa)
      integer, intent (in), optional :: Eqtn   ! equation code (default: 0)
!
! !OUTPUT PARAMETERS:
      real,    intent (out)          :: DP (:) ! dew point (deg K)
!
!     Note: The minimum size of the arrays determines the number of values
!           to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!     18Apr2002  C. Redder   Modified the way the number of values are
!                            determined.
!     03Apr2004  C. Redder   Added the optional argument, Eqtn
!
! EOP
!-------------------------------------------------------------------------

      real    :: TC, x, Ew0, aw, bw
      integer :: iHum, NHum

      call Get_wMagnus ( Ew0, aw, bw, Eqtn = Eqtn )

      NHum = min ( size ( VP ), size ( DP ))
      do iHum = 1, NHum
         x  = log ( VP ( iHum ) / Ew0 )
         TC = bw * x / ( aw - x )
         DP ( iHum ) = TC + T0         ! from deg C to deg K
      end do

      return
      end subroutine VPtoDP_pure

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: VPtoDP_moist () --- Vapor pressure to dew point for moist air
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from vapor pressure
!     to dew point temperature for moist air.
!
! !INTERFACE:
      pure subroutine VPtoDP_moist ( VP, P, DP )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,      intent (in)  ::
     .   VP (:), ! vapor pressure (mb or hPa)
     .   P  (:)  ! air pressure (mb or hPa)
!
! !OUTPUT PARAMETERS:
      real,      intent (out) ::
     .   DP (:)  ! dew point (deg K)
!
!     Note: The minimum size of the arrays VP and DP determines the number
!           of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!     18Apr2002  C. Redder   Modified the way the number of values are
!                            determined.
!     21Feb2003  C. Redder   Added temporary storage for intermediate
!                            calculations.
!     28Oct2003  C. Redder   Revised management of scratch space
! EOP
!-------------------------------------------------------------------------

      real, parameter :: a = 4.5e-6, c = 1.00071
      real    :: PP
      integer :: iHum, NHum, NP, iSeg, NSeg,
     .           iSegHum, iSegBeg, iSegEnd, SegSz
      real, dimension ( ScrSz ) :: Tmp

!     Remove enhancement factor
!     -------------------------
      NP   = size ( P )
      NHum = min  ( size ( VP ), size ( DP ))
      if ( NP .eq. 0 ) NHum = 0
      do iHum = 1, NHum
         PP = P ( min ( iHum, NP ))
         DP ( iHum ) = VP ( iHum ) / ( c * exp ( a * PP ))
      end do

!     ... before calculating the vapor pressure
!     -----------------------------------------
      NSeg    = ( NHum - 1 ) / ScrSz + 1
      iSegBeg =   1
      do iSeg = 1, NSeg
         iSegEnd = min ( iSegBeg + ScrSz - 1, NHum )
         SegSz   = iSegEnd - iSegBeg + 1

         do iSegHum = 1, SegSz
            iHum            = iSegBeg + iSegHum - 1
            Tmp ( iSegHum ) = DP ( iHum )
         end do
         call VPtoDP_pure ( Tmp ( : SegSz ), DP ( iSegBeg : iSegEnd ))
         iSegBeg = iSegEnd + 1
      end do

      return
      end subroutine VPtoDP_moist

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: VP2DP () --- Vapor pressure to dew point
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from vapor pressure
!     to dew point temperature for moist air (AE96) or pure water vapor.
!
! !INTERFACE:
      pure function VP2DP ( VP, P, Eqtn )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,    intent (in)           :: VP    ! vapor pressure (mb or hPa)
      real,    intent (in), optional :: P     ! air pressure (mb or hPa) if
                                              !   moist air is assumed
      integer, intent (in), optional :: Eqtn  ! Equation code (default: 0)
!
! !OUTPUT PARAMETERS:
      real                           :: VP2DP ! dew point (deg K)
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!     03Apr2004  C. Redder   Added the optional argument, Eqtn
!
! EOP
!-------------------------------------------------------------------------

      real :: DP (1)

!     Convert for ...
!     ---------------
      if ( present ( P ) ) then
         call VPtoDP_moist ( (/VP/), (/P/), DP ) ! ... moist air
      else
         call VPtoDP_pure  ( (/VP/),        DP, Eqtn = Eqtn )
     .                                           ! ... pure water vapor
      end if
      VP2DP = DP (1)

      return
      end function VP2DP
!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: FPtoVP_pure () --- Frost point to vapor pressure for pure water vapor
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from frost point
!     temperature to vapor pressure for pure water vapor.
!
! !INTERFACE:
      pure subroutine FPtoVP_pure ( FP, VP, Eqtn )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,    intent (in)           :: FP (:) ! frost point (deg K)
      integer, intent (in), optional :: Eqtn   ! equation code (default: 0)
!
! !OUTPUT PARAMETERS:
      real,    intent (out)          :: VP (:) ! vapor pressure (mb or hPa)
!
!     Note: The minimum size of the arrays determines the number of values
!           to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!     18Apr2002  C. Redder   Modified the way the number of values are
!                            determined.
!     03Apr2004  C. Redder   Added the optional argument, Eqtn
!
! EOP
!-------------------------------------------------------------------------

      real    :: TC, Ei0, ai, bi
      integer :: iHum, NHum

      call Get_iMagnus ( Ei0, ai, bi, Eqtn = Eqtn )

      NHum = min ( size ( FP ), size ( VP ))
      do iHum = 1, NHum
         TC          = FP ( iHum ) - T0             ! from deg K to deg C
         VP ( iHum ) = Ei0 * exp ( ai * TC / ( bi + TC ))
      end do

      return
      end subroutine FPtoVP_pure

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: FPtoVP_moist () --- Frost point to vapor pressure for moist air
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from frost point
!     temperature to vapor pressure for moist air.
!
! !INTERFACE:
      pure subroutine FPtoVP_moist ( FP, P, VP )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,      intent (in)  ::
     .   FP (:), ! frost point (deg K)
     .   P  (:)  ! air pressure (mb or hPa)
!
! !OUTPUT PARAMETERS:
      real,      intent (out) ::
     .   VP (:)  ! vapor pressure (mb or hPa)
!
!     Note: The minimum size of the arrays FP and VP determines the number
!           of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!     18Apr2002  C. Redder   Modified the way the number of values are
!                            determined.
!
! EOP
!-------------------------------------------------------------------------

      real, parameter :: a = 8.0e-6, c = 0.99882
      real    :: PP
      integer :: iHum, NHum, NP

!     Calculated vapor pressure for pure water vapor
!     ----------------------------------------------
      call FPtoVP_pure ( FP, VP )

!     ... and then add enhancement factor
!     -----------------------------------
      NP   = size ( P )
      NHum = min  ( size ( FP ), size ( VP ))
      if ( NP .eq. 0 ) NHum = 0
      do iHum = 1, NHum
         PP = P ( min ( iHum, NP ))
         VP ( iHum ) = c * exp ( a * PP ) * VP ( iHum )
      end do

      return
      end subroutine FPtoVP_moist

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: FP2VP () --- Frost point to vapor pressure
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from frost point to
!     temperature to vapor pressure for moist air (AE96 only) or pure
!     water vapor.
!
! !INTERFACE:
      pure function FP2VP ( FP, P, Eqtn )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,    intent (in)           :: FP    ! frost point (deg K)
      real,    intent (in), optional :: P     ! air pressure (mb or hPa) if
                                              !   moist air is assumed
      integer, intent (in), optional :: Eqtn  ! equation code (default: 0)
!
! !OUTPUT PARAMETERS:
      real                           :: FP2VP ! vapor pressure (mb or hPa)
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!     03Apr2004  C. Redder   Added the optional argument, Eqtn
!
! EOP
!-------------------------------------------------------------------------
      real :: VP (1)

!     Convert for ...
!     ---------------
      if ( present ( P ) ) then
         call FPtoVP_moist ( (/FP/), (/P/), VP ) ! ... moist air
      else
         call FPtoVP_pure  ( (/FP/),        VP, Eqtn = Eqtn )
     .                                           ! ... pure water vapor
      end if
      FP2VP = VP (1)

      return
      end function FP2VP

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: VPtoFP_pure () --- Vapor pressure to frost point for pure water vapor
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from vapor pressure
!     to frost point temperature for pure water vapor.
!
! !INTERFACE:
      pure subroutine VPtoFP_pure ( VP, FP, Eqtn )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,    intent (in)           :: VP (:) ! vapor pressure (mb or hPa)
      integer, intent (in), optional :: Eqtn   ! equation code (default: 0)
!
! !OUTPUT PARAMETERS:
      real,    intent (out)          :: FP (:) ! frost point (deg K)
!
!     Note: The minimum size of the arrays determines the number
!           of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!     18Apr2002  C. Redder   Modified the way the number of values are
!                            determined.
!     03Apr2004  C. Redder   Added the optional argument, Eqtn
!
! EOP
!-------------------------------------------------------------------------

      real    :: TC, x, Ei0, ai, bi
      integer :: iHum, NHum

      call Get_iMagnus ( Ei0, ai, bi, Eqtn = Eqtn )

      NHum = min ( size ( VP ), size ( FP ))
      do iHum = 1, NHum
         x  = log ( VP ( iHum ) / Ei0 )
         TC = bi * x / ( ai - x )
         FP ( iHum ) = TC + T0         ! from deg C to deg K
      end do

      return
      end subroutine VPtoFP_pure

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: VPtoFP_moist () --- Vapor pressure to frost point with moist air
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from vapor pressure
!     to frost point temperature for moist air.
!
! !INTERFACE:
      pure subroutine VPtoFP_moist ( VP, P, FP )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,      intent (in)  ::
     .   VP (:), ! vapor pressure (mb or hPa)
     .   P  (:)  ! air pressure (mb or hPa)
! !OUTPUT PARAMETERS:
      real,      intent (out) ::
     .   FP (:)  ! frost point (deg K)
!
!     Note: The minimum size of the arrays VP and FP determines the number
!           of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!     18Apr2002  C. Redder   Modified the way the number of values are
!                            determined.
!     21Feb2003  C. Redder   Added temporary storage for intermediate
!                            calculations.
!     28Oct2003  C. Redder   Revised management of scratch space
! EOP
!-------------------------------------------------------------------------

      real, parameter :: a = 8.0e-6, c = 0.99882
      real    :: PP
      integer :: iHum, NHum, NP, iSeg, NSeg,
     .           iSegHum, iSegBeg, iSegEnd, SegSz
      real, dimension ( ScrSz ) :: Tmp

!     Remove enhancement factor
!     -------------------------
      NP   = size ( P )
      NHum = min  ( size ( VP ), size ( FP ))
      if ( NP .eq. 0 ) NHum = 0
      do iHum = 1, NHum
         PP = P ( min ( iHum, NP ))
         FP ( iHum ) = VP ( iHum ) / ( c * exp ( a * PP ))
      end do

!     ... before calculating the vapor pressure
!     -----------------------------------------
      NSeg    = ( NHum - 1 ) / ScrSz + 1
      iSegBeg =   1
      do iSeg = 1, NSeg
         iSegEnd = min ( iSegBeg + ScrSz - 1, NHum )
         SegSz   = iSegEnd - iSegBeg + 1

         do iSegHum = 1, SegSz
            iHum            = iSegBeg + iSegHum - 1
            Tmp ( iSegHum ) = FP ( iHum )
         end do

         call VPtoFP_pure ( Tmp ( : SegSz ), FP ( iSegBeg : iSegEnd ))
         iSegBeg = iSegEnd + 1
      end do

      return
      end subroutine VPtoFP_moist

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: VP2FP () --- Vapor pressure to frost point
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from vapor pressure to
!     frost point temperature for moist air (AE96 only) or pure water vapor.
!
! !INTERFACE:
      pure function VP2FP ( VP, P, Eqtn )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,    intent (in)           :: VP    ! vapor pressure (mb or hPa)
      real,    intent (in), optional :: P     ! air pressure (mb or hPa) if
                                              !   moist air is assumed
      integer, intent (in), optional :: Eqtn  ! equation code (default: 0)
!
! !OUTPUT PARAMETERS:
      real                           :: VP2FP ! frost point (deg K)
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!     03Apr2004  C. Redder   Added the optional argument, Eqtn
!
! EOP
!-------------------------------------------------------------------------

      real :: FP (1)

!     Convert for ...
!     ---------------
      if ( present ( P ) ) then
         call VPtoFP_moist ( (/VP/), (/P/), FP ) ! ... moist air
      else
         call VPtoFP_pure  ( (/VP/),        FP, Eqtn = Eqtn )
     .                                           ! ... pure water vapor
      end if
      VP2FP = FP (1)

      return
      end function VP2FP

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: VPtoSH () --- Vapor pressure to specific humidity
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from vapor pressure
!     to specific humidity.
!
! !INTERFACE:
      pure subroutine VPtoSH ( VP, P, SH )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,      intent (in) ::
     .   VP (:), ! vapor pressure (mb or hPa)
     .   P  (:)  ! air pressure (mb or hPa)
! !OUTPUT PARAMETERS:
      real,      intent (out) ::
     .   SH (:)  ! specific humidity (g/kg)
!
!     Note: The minimum size of the arrays VP and SH determines the number
!           of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!     18Apr2002  C. Redder   Modified the way the number of values are
!                            determined.
! EOP
!-------------------------------------------------------------------------

      real    :: E, PP
      integer :: iHum, NHum, NP

      NP   = size ( P )
      NHum = min  ( size ( VP ), size ( SH ))
      if ( NP .eq. 0 ) NHum = 0
      do iHum = 1, NHum
         E  = VP ( iHum )
         PP = P  ( min ( iHum, NP ))
         SH ( iHum ) = SHUnit * RaRv * E / ( PP - ( 1.0 - RaRv ) * E )
      end do

      return
      end subroutine VPtoSH

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: VP2SH () --- vapor pressure to specific humidity
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from vapor pressure
!     to specific humidity.
!
! !INTERFACE:
      pure function VP2SH ( VP, P )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,    intent (in) :: VP    ! vapor pressure (mb or hPa)
      real,    intent (in) :: P     ! air pressure (mb or hPa)
! !OUTPUT PARAMETERS:
      real                 :: VP2SH ! specific humidity (g/kg)
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!
! EOP
!-------------------------------------------------------------------------

      real :: SH (1)

      call VPtoSH ( (/VP/), (/P/), SH )
      VP2SH = SH (1)

      return
      end function VP2SH

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: SHtoVP () --- Specific humidity to vapor pressure
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from specific
!     humidity to vapor pressure.
!
! !INTERFACE:
      pure subroutine SHtoVP ( SH, P, VP )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,      intent (in) ::
     .   SH (:), ! specific humidity (g/kg)
     .   P  (:)  ! air pressure (mb or hPa)
! !OUTPUT PARAMETERS:
      real,      intent (out) ::
     .   VP (:)  ! vapor pressure (mb or hPa)
!
!     Note: The minimum size of the arrays SH and BP determines the number
!           of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!     18Apr2002  C. Redder   Modified the way the number of values are
!                            determined.
! EOP
!-------------------------------------------------------------------------

      real    :: Q, PP
      integer :: iHum, NHum, NP

      NP   =        size (  P )
      NHum = min  ( size ( SH ), size ( VP ))
      if ( NP .eq. 0 ) NHum = 0
      do iHum = 1, NHum
         Q  = SH ( iHum ) / SHUnit
         PP = P  ( min ( iHum, NP ))
         VP ( iHum ) = Q * PP / ( RaRv + Q * ( 1.0 - RaRv ))
      end do

      return
      end subroutine SHtoVP

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: SH2VP () --- Vapor pressure to specific humidity
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from specific humidity
!     to vapor pressure.
!
! !INTERFACE:
      pure function SH2VP ( SH, P )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,    intent (in) :: SH    ! specific humidity (g/kg)
      real,    intent (in) :: P     ! air pressure (mb or hPa)
! !OUTPUT PARAMETERS:
      real                 :: SH2VP ! vapor pressure (mb or hPa)
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!
! EOP
!-------------------------------------------------------------------------

      real :: VP (1)

      call SHtoVP ( (/SH/), (/P/), VP )
      SH2VP = VP (1)

      return
      end function SH2VP

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: VPtoMR () --- Vapor pressure to mixing ratio
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from vapor pressure
!     to mixing ratio.
!
! !INTERFACE:
      pure subroutine VPtoMR ( VP, P, MR )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,      intent (in) ::
     .   VP (:), ! vapor pressure (mb or hPa)
     .   P  (:)  ! air pressure (mb or hPa)
! !OUTPUT PARAMETERS:
      real,      intent (out) ::
     .   MR (:)  ! mixing ratio (g/kg)
!
!     Note: The minimum size of the array VP and MR determines the number
!           of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!     18Apr2002  C. Redder   Modified the way the number of values are
!                            determined.
!
! EOP
!-------------------------------------------------------------------------

      real    :: E, PP
      integer :: iHum, NHum, NP

      NP   = size ( P )
      NHum = min  ( size ( VP ), size ( MR ))
      if ( NP .eq. 0 ) NHum = 0
      do iHum = 1, NHum
         E  = VP ( iHum )
         PP = P  ( min ( iHum, NP ))
         MR ( iHum ) = MRUnit * RaRv * E / ( PP - E )
      end do

      return
      end subroutine VPtoMR

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: VP2MR () --- Vapor pressure to mixing ratio
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from vapor pressure
!     to mixing ratio.
!
! !INTERFACE:
      pure function VP2MR ( VP, P )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,    intent (in) :: VP    ! vapor pressure (mb or hPa)
      real,    intent (in) :: P     ! air pressure (mb or hPa)
! !OUTPUT PARAMETERS:
      real                 :: VP2MR ! mixing ratio (g/kg)
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!
! EOP
!-------------------------------------------------------------------------

      real :: MR (1)

      call VPtoMR ( (/VP/), (/P/), MR )
      VP2MR = MR (1)

      return
      end function VP2MR

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: MRtoVP () --- Mixing ratio to vapor pressure
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from specific
!     humidity to vapor pressure.
!
! !INTERFACE:
      pure subroutine MRtoVP ( MR, P, VP )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,      intent (in) ::
     .   MR (:), ! mixing ratio (g/kg)
     .   P  (:)  ! air pressure (mb or hPa)
! !OUTPUT PARAMETERS:
      real,      intent (out) ::
     .   VP (:)  ! vapor pressure (mb or hPa)
!
!     Note: The minimum size of the array MR and VP determines the number
!           of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!     18Apr2002  C. Redder   Modified the way the number of values are
!                            determined.
! EOP
!-------------------------------------------------------------------------

      real    :: W, PP
      integer :: iHum, NHum, NP

      NP   = size ( P )
      NHum = min  ( size ( MR ), size ( VP ))
      if ( NP .eq. 0 ) NHum = 0
      do iHum = 1, NHum
         W  = MR ( iHum ) / MRUnit
         PP = P  ( min ( iHum, NP ))
         VP ( iHum ) = W * PP / ( RaRv + W )
      end do

      return
      end subroutine MRtoVP

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: MR2VP () --- Vapor pressure to mixing ratio
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from mixing ratio
!     to vapor pressure.
!
! !INTERFACE:
      pure function MR2VP ( MR, P )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,    intent (in) :: MR    ! mixing ratio (g/kg)
      real,    intent (in) :: P     ! air pressure (mb or hPa)
! !OUTPUT PARAMETERS:
      real                 :: MR2VP ! vapor pressure (mb or hPa)
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     19Oct2001  C. Redder   Original code.
!
! EOP
!-------------------------------------------------------------------------

      real :: VP (1)

      call MRtoVP ( (/MR/), (/P/), VP )
      MR2VP = VP (1)

      return
      end function MR2VP

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: VPtoRH_wnp () --- Vapor pressure to relative humidity by neglecting air pressure
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from vapor pressure
!     to relative humidity by neglecting air pressure
!
! !INTERFACE:
      pure subroutine VPtoRH_wnp ( VP, SVP, RH )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,      intent (in) ::
     .   VP (:), ! vapor pressure (mb or hPa)
     .  SVP (:)  ! saturation vapor pressure (mb or hPa)
!
! !OUTPUT PARAMETERS:
      real,      intent (out) ::
     .   RH (:)  ! relative humidity (%)
!
!     Note: The minimum size of the arrays determines the number
!           of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     29Oct2001  C. Redder   Original code.
!     18Apr2002  C. Redder   Modified the way the number of values are
!                            determined.
! EOP
!-------------------------------------------------------------------------

      real    :: EE, EW
      integer :: iHum, NHum

      NHum = min ( size ( VP ), size ( SVP ), size ( RH ))
      do iHum = 1, NHum
         EE =  VP ( iHum )
         EW = SVP ( iHum )
         RH ( iHum ) = PctF * EE / EW
      end do

      return
      end subroutine VPtoRH_wnp

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: VPtoRH_wp () --- Vapor pressure to relative humidity without neglecting air pressure
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from vapor pressure
!     to relative humidity without neglecting air pressure.
!
! !INTERFACE:
      pure subroutine VPtoRH_wp ( VP, SVP, P, RH )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,      intent (in) ::
     .   VP (:), ! vapor pressure (mb or hPa)
     .  SVP (:), ! saturation vapor pressure (mb or hPa)
     .   P  (:)  ! ... and pressure (mb or hPa)
!
! !OUTPUT PARAMETERS:
      real,      intent (out) ::
     .   RH (:)  ! relative humidity (%)
!
!     Note: The minimum size of the arrays VP, SVP and RH determines the
!           number of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     29Oct2001  C. Redder   Original code.
!     18Apr2002  C. Redder   Modified the way the number of values are
!                            determined.
!
! EOP
!-------------------------------------------------------------------------

      real    :: EE, EW, PP
      integer :: iHum, NHum, NP

      NP   = size ( P  )
      NHum = min  ( size ( VP ), size ( SVP ), size ( RH ))
      if ( NP .eq. 0 ) NHum = 0
      do iHum = 1, NHum
         EE =  VP ( iHum )
         EW = SVP ( iHum )
         PP =   P ( min ( iHum, NP ))
         RH ( iHum ) = PctF * EE * ( PP - EW ) / ( EW * ( PP - EE ))
      end do

      return
      end subroutine VPtoRH_wp

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: VP2RH () --- Vapor pressure to relative humidity
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from vapor pressure to
!     relative humdity.
!
! !INTERFACE:
      pure function VP2RH ( VP, SVP, P )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,    intent (in) ::
     .   VP,   ! vapor pressure (mb or hPa)
     .  SVP    ! saturation vapor pressure (mb or hPa)
      real,    intent (in), optional ::
     .    P    ! air pressure (mb or hPa)
!
! !OUTPUT PARAMETERS:
      real ::
     .   VP2RH ! relative humidity (%)
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     29Oct2001  C. Redder   Original code.
!
! EOP
!-------------------------------------------------------------------------

      real :: RH (1)

!     Convert for ...
!     ---------------
      if ( present ( P ) ) then
         call VPtoRH_wp  ((/VP/), (/SVP/), (/P/), RH )
      else
         call VPtoRH_wnp ((/VP/), (/SVP/),        RH )
      end if
      VP2RH = RH (1)

      return
      end function VP2RH
!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: RHtoVP_wnp () --- Relative humidity to vapor pressure by neglecting air pressure
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from relative humidity
!     to vapor pressure by neglecting air pressure.
!
! !INTERFACE:
      pure subroutine RHtoVP_wnp ( RH, SVP, VP )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,       intent (in) ::
     .   RH  (:), ! relative humidity (%)
     .   SVP (:)  ! saturation vapor pressure (mb or hPa)
!
! !OUTPUT PARAMETERS:
      real,       intent (out) ::
     .   VP  (:)  ! vapor pressure (mb or hPa)
!
!     Note: The minimum size of the arrays determines the
!           number of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     29Oct2001  C. Redder   Original code.
!     18Apr2002  C. Redder   Modified the way the number of values are
!                            determined.
!
! EOP
!-------------------------------------------------------------------------

      real    :: EW
      integer :: iHum, NHum

      NHum = min ( size ( RH ), size ( SVP ), size ( VP ))
      do iHum = 1, NHum
         EW = SVP ( iHum )
         VP ( iHum ) = RH ( iHum ) * EW / PctF
      end do

      return
      end subroutine RHtoVP_wnp

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: RHtoVP_wp () --- Relative humidity to vapor pressure without neglecting air pressure
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from relative
!     humidity to vapor pressure without neglecting air pressure.
!
! !INTERFACE:
      pure subroutine RHtoVP_wp ( RH, SVP, P, VP )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,       intent (in) ::
     .   RH  (:), ! relative humidity (%)
     .   SVP (:), ! air pressure (mb or hPa)
     .   P   (:)  ! ... and pressure (mb or hPa)
!
! !OUTPUT PARAMETERS:
      real,      intent (out) ::
     .   VP  (:)  ! vapor pressure (mb or hPa)
!
!     Note: The minimum size of the arrays RH, SVP and VP determines the
!           number of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     29Oct2001  C. Redder   Original code.
!     18Apr2002  C. Redder   Modified the way the number of values are
!                            determined.
!
! EOP
!-------------------------------------------------------------------------

      real    :: f, EW, PP
      integer :: iHum, NHum, NP

      NP   = size ( P  )
      NHum = min  ( size ( RH ), size ( SVP ), size ( VP ))
      if ( NP .eq. 0 ) NHum = 0
      do iHum = 1, NHum
         f  = RH ( iHum ) / PctF
         EW = SVP ( iHum )
         PP = P  ( min ( iHum, NP ))
         VP ( iHum ) = f * EW * PP / ( PP - EW * ( 1.0 - f ))
      end do

      return
      end subroutine RHtoVP_wp

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: RH2VP () --- Relative humidity to vapor pressure.
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from relative
!     humidity to vapor pressure
!
! !INTERFACE:
      pure function RH2VP ( RH, SVP, P )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,    intent (in) ::
     .   RH,   ! relative humidity (%)
     .   SVP   ! saturation vapor pressure (mb or hPa)
      real,    intent (in), optional ::
     .   P     ! air pressure (mb or hPa)
!
! !OUTPUT PARAMETERS:
      real ::
     .   RH2VP ! vapor pressure (mb or hPa)
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     29Oct2001  C. Redder   Original code.
!
! EOP
!-------------------------------------------------------------------------

      real :: VP (1)

!     Convert for ...
!     ---------------
      if ( present ( P ) ) then
         call RHtoVP_wp  ((/RH/), (/SVP/), (/P/), VP )
      else
         call RHtoVP_wnp ((/RH/), (/SVP/),        VP )
      end if
      RH2VP = VP (1)

      return
      end function RH2VP
!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: VPTtoRH_wnp () --- Vapor pressure and air temperature to relative humidity by neglecting air pressure
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from vapor pressure
!     and air temperature to relative humidity by neglecting air pressure
!     The routine determines the saturation vapor pressure (for pure water
!     vapor) from temperature before converting to relative humidity.!
!
! !INTERFACE:
      pure subroutine VPTtoRH_wnp ( VP, T, RH )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,      intent (in) ::
     .   VP (:), ! vapor pressure (mb or hPa)
     .   T  (:)  ! air temperature (deg K)
!
! !OUTPUT PARAMETERS:
      real,      intent (out) ::
     .   RH (:)  ! relative humidity (%)
!
!     Note: The minimum size of the arrays determines the number
!           of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     28Oct2003  C. Redder   Original code.
!
! EOP
!-------------------------------------------------------------------------

      real, dimension ( ScrSz ) :: SVP
      integer :: iHum, NHum, iSeg, NSeg, iSegBeg, iSegEnd, SegSz

      NHum = min ( size ( VP ), size ( T ), size ( RH ))

      NSeg    = ( NHum - 1 ) / ScrSz + 1
      iSegBeg =   1
      do iSeg = 1, NSeg
         iSegEnd = min ( iSegBeg + ScrSz - 1, NHum )
         SegSz   = iSegEnd - iSegBeg + 1

         call DPtoVP_pure ( T  ( iSegBeg : iSegEnd ), SVP )
         call VPtoRH_wnp  ( VP ( iSegBeg : iSegEnd ), SVP,
     .                      RH ( iSegBeg : iSegEnd ))
         iSegBeg = iSegEnd + 1
      end do

      return
      end subroutine VPTtoRH_wnp

!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: VPTtoRH_wp () --- Vapor pressure and air temperature to relative humidity without neglecting air pressure
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from vapor pressure
!     and air temperature to relative humidity without neglecting air
!     pressure.  The routine determines the saturation vapor pressure (for
!     pure water vapor) from temperature before converting to relative
!     humidity.
!
! !INTERFACE:
      pure subroutine VPTtoRH_wp ( VP, T, P, RH )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,      intent (in) ::
     .   VP (:), ! vapor pressure (mb or hPa)
     .   T  (:), ! temperature (deg K)
     .   P  (:)  ! ... and pressure (mb or hPa)
!
! !OUTPUT PARAMETERS:
      real,      intent (out) ::
     .   RH (:)  ! relative humidity (%)
!
!     Note: The minimum size of the arrays VP, T and RH determines the
!           number of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     28Oct2003  C. Redder   Original code.
!
! EOP
!-------------------------------------------------------------------------

      real, dimension ( ScrSz ) :: SVP, PP
      integer :: iHum, NHum, NP, iSeg, NSeg,
     .           iSegHum, iSegBeg, iSegEnd, SegSz

      NP   = size ( P  )
      NHum = min  ( size ( VP ), size ( T ), size ( RH ))
      if ( NP .eq. 0 ) NHum = 0

      NSeg    = ( NHum - 1 ) / ScrSz + 1
      iSegBeg =   1
      do iSeg = 1, NSeg
         iSegEnd = min ( iSegBeg + ScrSz - 1, NHum )
         SegSz   = iSegEnd - iSegBeg + 1

         call DPtoVP_pure ( T  ( iSegBeg : iSegEnd ), SVP )
         do iSegHum = 1, SegSz
            iHum           = iSegBeg + iSegHum - 1
            PP ( iSegHum ) = P ( min ( iHum, NP ))
         end do
         call VPtoRH_wp   ( VP ( iSegBeg : iSegEnd ), SVP, PP,
     .                      RH ( iSegBeg : iSegEnd ))
         iSegBeg = iSegEnd + 1
      end do
      return
      end subroutine VPTtoRH_wp
!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: VPT2RH () --- Vapor pressure and air temperature to relative humidity
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from vapor pressure
!     and air temperature to relative humdity.  The routine determines the
!     saturation vapor pressure (for pure water vapor) from temperature
!     before converting to relative humidity
!
! !INTERFACE:
      pure function VPT2RH ( VP, T, P )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,     intent (in) ::
     .   VP,    ! vapor pressure (mb or hPa)
     .   T      ! air temperature (deg K)
      real,     intent (in), optional ::
     .   P      ! air pressure (mb or hPa)
!
! !OUTPUT PARAMETERS:
      real ::
     .   VPT2RH ! relative humidity (%)
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     28Oct2003  C. Redder   Original code.
!
! EOP
!-------------------------------------------------------------------------

      real :: RH (1)

!     Convert for ...
!     ---------------
      if ( present ( P )) then
         call VPTtoRH_wp  ((/VP/), (/T/), (/P/), RH )
      else
         call VPTtoRH_wnp ((/VP/), (/T/),        RH )
      end if
      VPT2RH = RH (1)

      return
      end function VPT2RH
!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: RHTtoVP_wnp () --- Relative humidity and air temperature to vapor pressure by neglecting air pressure
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from relative humidity
!     and air temperature to vapor pressure by neglecting air pressure.
!     The routine determines the saturation vapor pressure (for pure water
!     vapor) from temperature before converting to relative humidity
!
! !INTERFACE:
      pure subroutine RHTtoVP_wnp ( RH, T, VP )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,       intent (in) ::
     .   RH  (:), ! relative humidity (%)
     .   T   (:)  ! air temperature (deg K)
!
! !OUTPUT PARAMETERS:
      real,       intent (out) ::
     .   VP  (:)  ! vapor pressure (mb or hPa)
!
!     Note: The minimum size of the arrays determines the
!           number of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     28Oct2003  C. Redder   Original code.
!
! EOP
!-------------------------------------------------------------------------

      real, dimension ( ScrSz ) :: SVP
      integer :: iHum, NHum, iSeg, NSeg, iSegBeg, iSegEnd, SegSz

      NHum    = min ( size ( RH ), size ( T ), size ( VP ))

      NSeg    = ( NHum - 1 ) / ScrSz + 1
      iSegBeg =   1
      do iSeg = 1, NSeg
         iSegEnd = min ( iSegBeg + ScrSz - 1, NHum )
         SegSz   = iSegEnd - iSegBeg + 1

         call DPtoVP_pure ( T  ( iSegBeg : iSegEnd ), SVP )
         call RHtoVP_wnp  ( RH ( iSegBeg : iSegEnd ), SVP,
     .                      VP ( iSegBeg : iSegEnd ))
         iSegBeg = iSegEnd + 1
      end do

      return
      end subroutine RHTtoVP_wnp
!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: RHTtoVP_wp () --- Vapor pressure and air temperature to relative humidity without neglecting air pressure
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from relative humidity
!     and air temperature to vapor pressure without neglecting air pressure.
!     The routine determines the saturation vapor pressure (for pure water
!     vapor) from temperature before converting to temperature.
!
! !INTERFACE:
      pure subroutine RHTtoVP_wp ( RH, T, P, VP )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,       intent (in) ::
     .   RH  (:), ! relative humidity (%)
     .   T   (:), ! air temperature (deg K)
     .   P   (:)  ! ... and pressure (mb or hPa)
!
! !OUTPUT PARAMETERS:
      real,       intent (out) ::
     .   VP  (:)  ! vapor pressure (mb or hPa)
!
!     Note: The minimum size of the arrays RH, T and VP determines the
!           number of values to convert.
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     28Oct2003  C. Redder   Original code.
!
! EOP
!-------------------------------------------------------------------------

      real, dimension ( ScrSz ) :: SVP, PP
      integer :: iHum, NHum, NP, iSeg, NSeg,
     .           iSegHum, iSegBeg, iSegEnd, SegSz

      NP   = size ( P  )
      NHum = min  ( size ( RH ), size ( T ), size ( VP ))
      if ( NP .eq. 0 ) NHum = 0

      NSeg    = ( NHum - 1 ) / ScrSz + 1
      iSegBeg =   1
      do iSeg = 1, NSeg
         iSegEnd = min ( iSegBeg + ScrSz - 1, NHum )
         SegSz   = iSegEnd - iSegBeg + 1

         call DPtoVP_pure ( T  ( iSegBeg : iSegEnd ), SVP )
         do iSegHum = 1, SegSz
            iHum           = iSegBeg + iSegHum - 1
            PP ( iSegHum ) = P  ( min ( iHum, NP ))
         end do
         call RHtoVP_wp ( RH ( iSegBeg : iSegEnd ), SVP, PP,
     .                    VP ( iSegBeg : iSegEnd ))
         iSegBeg = iSegEnd + 1
      end do

      return
      end subroutine RHTtoVP_wp
!......................................................................

!-------------------------------------------------------------------------
!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! BOP
!
! !ROUTINE: RHT2VP () --- Relative humidity and air temperature to vapor pressure.
!
! !DESCRIPTION:
!     This routine converts a set of humidity values from relative humidity
!     and air temperature to vapor pressure.  The routine determines the
!     saturation vapor pressure (for pure water vapor) from temperature
!     before converting to temperature.
!
! !INTERFACE:
      pure function RHT2VP ( RH, T, P )
      implicit NONE
!
! !INPUT PARAMETERS:
      real,     intent (in) ::
     .   RH,    ! relative humidity (%)
     .   T      ! air temperature (deg K)
      real,     intent (in), optional ::
     .   P      ! air pressure (mb or hPa)
!
! !OUTPUT PARAMETERS:
      real ::
     .   RHT2VP ! vapor pressure (mb or hPa)
!
! !SEE ALSO:
!
! !REVISION HISTORY:
!     28Oct2003  C. Redder   Original code.
!
! EOP
!-------------------------------------------------------------------------

      real :: VP (1)

!     Convert for ...
!     ---------------
      if ( present ( P ) ) then
         call RHTtoVP_wp  ((/RH/), (/T/), (/P/), VP )
      else
         call RHTtoVP_wnp ((/RH/), (/T/),        VP )
      end if
      RHT2VP = VP (1)

      return
      end function RHT2VP
!......................................................................

      end module m_humidity
!====================================================================

max_stars_repo_name: GEOS-ESM/GEOSadas

max_issues_repo_name: GEOS-ESM/GEOSadas

max_forks_repo_name: GEOS-ESM/GEOSadas


text:
	SUBROUTINE LC_UARE ( area, newfil, iflno, arecur, stn, iret )
C************************************************************************
C* LC_UARE								*
C*									*
C* This subroutine updates and processes the user input for AREA.	*
C* It calls LC_SARE only if the area name has changed or a new file	*
C* has been opened.  This subroutine is useful if AREA is to be		*
C* defined repeatedly.  ARECUR is the current active area whose		*
C* value is set in this subroutine and which should not be changed	*
C* in the application program.						*
C*									*
C* LC_UARE ( AREA, NEWFIL, IFLNO, ARECUR, STN, IRET )			*
C*									*
C* Input parameters:							*
C*	AREA		CHAR*		Input for area			*
C*	NEWFIL		LOGICAL		New file flag			*
C*	IFLNO		INTEGER		File number			*
C*									*
C* Input and output parameters:						*
C*	ARECUR		CHAR*		Current area name		*
C*									*
C* Output parameters:							*
C*	STN		CHAR*		Station at center of area	*
C*	IRET		INTEGER		Return code			*
C*					  0 = normal return		*
C*					 -1 = invalid area name		*
C**									*
C* Log:									*
C* I. Graffman/RDS	 7/87	GEMPAK4					*
C* M. desJardins/GSFC	 6/88	Cleaned up				*
C* K. Tyle/GSC		 7/96	Added check for AREA = GAREA		*
C* M. Linda/GSC		10/97	Corrected the prologue format		*
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
C*
	CHARACTER*(*)	stn, area, arecur
	LOGICAL		newfil
C------------------------------------------------------------------------
	iret = 0
C
C*	Check if the area has not changed or is equal to GAREA.
C
	CALL ST_LCUC ( area, area, ier )
	IF (( area .ne. arecur ) .or. newfil .or. ( area .eq. ' ' )
     +	   .or. ( area .eq. 'GAREA' )) THEN
C
C*	    Set up the search area.
C
	    CALL LC_SARE  ( area, iflno, stn, iret )
C
C*	    Return errors.
C
	    IF  ( iret .ne. 0 )  THEN
	        arecur = ' '
	      ELSE
		arecur = area
	    END IF
	END IF
C*
	RETURN
	END

max_stars_repo_name: oxelson/gempak

max_issues_repo_name: oxelson/gempak

max_forks_repo_name: oxelson/gempak


text:
c     ============================
      subroutine dt4(v1, v2, ans)
c     ============================
c Multiply two 4-vectors or the form (E - px - py - pz)
c
      implicit none

      real v1(4), v2(4)
      real ans

      ans =((v1(1)*v2(1))-(v1(2)*v2(2))-(v1(3)*v2(3))-(v1(4)*v2(4)))

      return
      end

ext: fpp


text:
      SUBROUTINE SCE1
C
C     MODULE 2.6 SCE PARTITIONS KNN,MNN,BNN,AND K4NN
C
C     TO ELIMINATE THE EFFECTS OF SINGLE POINT CONSTRAINTS IF US IS NOT
C     NULL
C
      INTEGER        US,USET,BNN,BFF,UN,UF,PVECT
      COMMON /PATX / N(2),N3,NN(3)
      DATA    UN,UF, US /
     1        27,26, 31 /
      DATA    USET , KNN,MNN,BNN,K4NN,KFF,KFS,KSS,MFF,BFF,K4FF,PVECT /
     1        101  , 102,103,104,105 ,201,202,203,204,205,206 ,301   /
C
      CALL UPART (USET,PVECT,UN,UF,US)
      CALL MPART (KNN,KFF,0,KFS,KSS)
      CALL MPART (MNN,MFF,0,0,0)
      CALL MPART (BNN,BFF,0,0,0)
      CALL MPART (K4NN,K4FF,0,0,0)
      RETURN
      END


text:
A & B Taxi is one of the many taxi services in town.  Relatively new, they appear to have started service in Davis in 2011.   There are four drivers: Fan, the owner (who is deaf) and three others. Flat rate fares can be quoted over the phone or before the ride starts. There is no meter in the cab.  Signs on the cab have A&B written on both sides of the car and the back ground of the sign features a High Wheel Bicycle.

  Davis Business License Not on registry of Davis Businesses.
  Sac Airport Permits Unknown at this time
  Yolo County Business License As of http://www.yolocounty.org/Modules/ShowDocument.aspx?documentid1538 Mar. 31, 2010 No License on record with Yolo County, possibly restricting transportation outside of Davis, if not within the Davis city Limits.

  Need to get somewhere in a hurry?  Davis has many taxi services for your transportation needs!

20120611 13:47:04 nbsp I searched Yelp for taxi services in Davis when I needed someone reliable to pick up two outofstate guests for a conference at UC Davis, and read good reviews of A&B.  I wanted to reiterate how great they are on the Davis Wiki, since they dont seem to have any comments yet.  They were really wonderful to deal with and went above and beyond.
I dealt mainly with Chris, one of the drivers, who was very helpful and kind. I made the reservation a week ahead and he followed up the day before (just before I was planning to call him) to confirm.  He arrived in good time for both pick up and delivery back to the airport, made name signs, and also dealt beautifully with an unexpected complication on the arrival of one of our guests. Our guests didnt tip them because they werent sure if it was needed (sorry guys! we wish we could arrange this after the fact), but this had no effect on how helpful and pleasant Chris and others were to work with. I will definitely be using A&B for any future needs and highly recommend them!  Users/Victrola

20131210 18:23:00 nbsp I used this taxi service a few days ago after seeking it on the wiki. My husband dislocated his shoulder and couldnt drive his car to the doctor and I didnt know how to use a stick shift. We used another service to get to the hospital, but that taxi service was all booked up by the time we needed to return home. A and B were very fast to pick me, my son (in car seat), and my husband up (under 5 minutes). The driver was courteous and professional. He helped to load my sons stroller and diaper bag in the trunk and didnt start the meter until we were all in the car. While the wiki states they dont have a meter, the car that was used to transport us did have one. A and B was 15% less  expensive than the first company that we used, though, to be fair, we may have taken a minute or two longer to get into the first vehicle on the ride there. A and B was able to process my payment via credit card, which was a definite relief. I dont think I could have gotten from point A to point B more pleasantly, quickly, and cheaply. Thank you so much! Users/ClaireMacy

20131220 18:39:04 nbsp My ride to the airport got stuck at work and I needed a ride at the last minute.  A&B taxi was able to get a car to my house in under 10 minutes.  The driver loaded my heavy luggage in the trunk for me and was super friendly.  When I went to get on my flight I realized I had left my phone in the back of the cab.  A&B took my phone over to fedex right away and overnighted my phone (with Saturday delivery) for me!   Thank you so much!  Users/kaylajoy


text:
Mahmoudrezanaemeh can edit this entry to tell the wiki about themselves.

Hey, Mahmoud.  Im all in support of your opposition to Occupy Davis, but please dont just delete the Featured Page.  The front page looks odd without it, and youre damaging the wiki by doing so, not the Occupy people.  Is there any group or movement opposed to Occupy in Davis?  If so, Id love to see a writeup about it on the wiki.  Thats what the wiki is for: to document all viewpoints in Davis. Users/JabberWokky Evan JabberWokky Edwards, jw.dw@timewarp.org

20111101 18:51:54 nbsp Im going to offer a less patient perspective than JabberWokky. Your OBNOXIOUS AND AGGRESSIVE ALL CAPS COMMENT (see what I mean?) on the featured page and your subsequent deletion of the whole page are considered vandalism. It might make some people think twice about frequenting your Fara (Threading and Hair) place of business. If you dont want to damage your reputation I would suggest you conduct yourself in a more mature manner from now on. Users/MeggoWaffle

20111207 22:15:04 nbsp Looking back at your edits to the page, I see that you added the slogan, Threading Better Than Waxing.  Threading started by Persians, Get it done by a Persian. You then noted that she has 15 years of experience and told people To make an appointment please call this number only.  You then deleted the price list.  You then updated the hours of the salon and gave its new address.  You clarified that a special was for first time customers only.  You then added a cell phone number.  You then deleted a discount.  The edits continue, but Ill stop there.  Clearly, you are either associated with the business or a personal friend of the owner.  So, that means you should not leave a comment like you are just another client.  If your comment at least indicated what your relationship is to the owner/business, then the reader could judge for themselves how to take your comment.

(By the way, if youre wondering where I got all of that info, the wiki records every edit made:  http://daviswiki.org/Fara_%28Threading_and_Hair%29?actioninfo ). Users/CovertProfessor