1 ! Colarco, May 24, 2007 2 ! sed command to replace F77 comments with F90: sed 's/^c/\!/g' 3 ! F90-version of original CARMA vaporp.f routine (see comments below from 4 ! original routine header). 5 6 subroutine vaporp ( ix, iy, iz, carma, rc ) 7 8 ! types 9 use carma_types_mod 10 11 implicit none 12 13 ! Inputs 14 integer :: ix, iy, iz 15 16 ! Outputs 17 integer, intent(out) :: rc 18 19 ! Local declarations 20 integer :: igas 21 real(kind=f) :: tt 22 real(kind=f), parameter :: BAI = 6.1115e2_f, & 23 BBI = 23.036_f, & 24 BCI = 279.82_f, & 25 BDI = 333.7_f, & 26 BAL = 6.1121e2_f, & 27 BBL = 18.729_f, & 28 BCL = 257.87_f, & 29 BDL = 227.3_f 30 31 #include "carma_globaer.h" 32 33 rc = 0 34 35 #ifdef DEBUG 36 ! write(*,*) '+ vaporp' 37 #endif 38 39 ! subroutine vaporp 40 ! 41 ! 42 ! @(#) vaporp.f Ackerman Dec-1995 43 ! This routine calculates the vapor pressure for all gases 44 ! over the entire spatial grid: 45 ! 46 ! <pvapl> and <pvapi> are vapor pressures in units of [dyne/cm^2] 47 ! 48 ! Uses temperature <t> as input. 49 ! 50 ! Modified Sep-1997 (McKie) 51 ! To calculate at one spatial point per call. 52 ! Globals <ix>, <iy>, <iz>, <ixy>, <ixyz> specify current spatial pt's indices. 53 ! (actually, only <ixyz> is defined -- the others are meaningless) 54 ! 55 ! Argument list input: 56 ! None. 57 ! 58 ! Argument list output: 59 ! None. 60 ! 61 ! 62 ! Include global constants and variables 63 ! 64 ! include 'globaer.h' 65 ! 66 ! 67 ! Define coefficients in Buck's formulation for saturation vapor pressures 68 ! Table 2 69 ! 70 ! Ice: valid temperature interval -80 - 0 C 71 ! parameter( BAI = 6.1115_f ) 72 ! parameter( BBI = 23.036_f ) 73 ! parameter( BCI = 279.82_f ) 74 ! parameter( BDI = 333.7_f ) 75 76 ! Liquid: valid temperature interval -40 - +50 C 77 ! parameter( BAL = 6.1121_f ) 78 ! parameter( BBL = 18.729_f ) 79 ! parameter( BCL = 257.87_f ) 80 ! parameter( BDL = 227.3_f ) 81 ! 82 ! 83 ! Define formats 84 ! 85 1 format('T = ',1pe12.3,a,3(i6,2x),a,1pe11.3) 86 ! 87 !------------------------------------------------------------------------------- 88 ! 89 ! Announce entry to this routine 90 ! 91 ! if( DEBUG ) write(LUNOPRT,'(/,a)') 'Enter vaporp' 92 ! 93 !------------------------------------------------------------------------------- 94 ! 95 ! 96 ! Loop over all gases. 97 ! 98 do igas = 1, NGAS 99 ! 100 ! 101 ! Check for expected gas index 102 ! 103 if( igas .eq. 1 )then 104 ! 105 ! 106 ! Saturation vapor pressure over liquid water and water ice 107 ! (from Buck [J. Atmos. Sci., 20, 1527, 1981]) 108 ! 109 tt = t(ix,iy,iz) - 273.16_f 110 111 pvapl(ix,iy,iz,igas) = BAL * & 112 exp( (BBL - tt/BDL)*tt / (tt + BCL) ) 113 114 pvapi(ix,iy,iz,igas) = BAI * & 115 exp( (BBI - tt/BDI)*tt / (tt + BCI) ) 116 ! 117 ! Check to see whether temperature is ouside range of validity 118 ! for parameterizations 119 ! 120 if( pvapl(ix,iy,iz,igas) .le. 1.e-13_f ) then 121 write(LUNOPRT,1) t(ix,iy,iz), ' too small for ix,iy,iz = ', & 122 ix,iy,iz, ' time = ',time 123 stop 1 124 endif 125 ! 126 ! 127 ! Report unexpected gas index 128 ! 129 else 130 write(LUNOPRT,'(/,a)') 'invalid <igas> in vaporp.f' 131 stop 1 132 endif 133 134 enddo 135 ! 136 ! 137 ! Return to caller with vapor pressures evaluated. 138 ! 139 return 140 end 141