!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! !! !! GNU General Public License !! !! !! !! This file is part of the Flexible Modeling System (FMS). !! !! !! !! FMS is free software; you can redistribute it and/or modify !! !! it and are expected to follow the terms of the GNU General Public !! !! License as published by the Free Software Foundation. !! !! !! !! FMS is distributed in the hope that it will be useful, !! !! but WITHOUT ANY WARRANTY; without even the implied warranty of !! !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !! !! GNU General Public License for more details. !! !! !! !! You should have received a copy of the GNU General Public License !! !! along with FMS; if not, write to: !! !! Free Software Foundation, Inc. !! !! 59 Temple Place, Suite 330 !! !! Boston, MA 02111-1307 USA !! !! or see: !! !! http://www.gnu.org/licenses/gpl.txt !! !! !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !--------------------------------------------------------------------- !------------ FMS version number and tagname for this file ----------- ! $Id: gases.f90,v 1.1.2.1.2.1 2009/08/10 10:48:14 rsh Exp $ ! $Name: mom4p1_pubrel_dec2009_nnz $ function gases(PRES_mb,T,RH,f) implicit none ! Purpose: ! Compute 2-way gaseous attenuation through a volume in microwave ! ! Inputs: ! [PRES_mb] pressure (mb) (hPa) ! [T] temperature (K) ! [RH] relative humidity (%) ! [f] frequency (GHz), < 300 GHz ! ! Returns: ! 2-way gaseous attenuation (dB/km) ! ! Reference: ! Uses method of Liebe (1985) ! ! Created: ! 12/09/05 John Haynes (haynes@atmos.colostate.edu) ! Modified: ! 01/31/06 Port from IDL to Fortran 90 integer, parameter :: & nbands_o2 = 48 ,& nbands_h2o = 30 real*8, intent(in) :: PRES_mb, T, RH, f real*8 :: gases, th, e, p, sumo, gm0, a0, ap, term1, term2, term3, & bf, be, term4, npp real*8, dimension(nbands_o2) :: v0, a1, a2, a3, a4, a5, a6 real*8, dimension(nbands_h2o) :: v1, b1, b2, b3 integer :: i ! // table1 parameters v0, a1, a2, a3, a4, a5, a6 data v0/49.4523790,49.9622570,50.4742380,50.9877480,51.5033500, & 52.0214090,52.5423930,53.0669060,53.5957480,54.1299999,54.6711570, & 55.2213650,55.7838000,56.2647770,56.3378700,56.9681000,57.6124810, & 58.3238740,58.4465890,59.1642040,59.5909820,60.3060570,60.4347750, & 61.1505580,61.8001520,62.4112120,62.4862530,62.9979740,63.5685150, & 64.1277640,64.6789000,65.2240670,65.7647690,66.3020880,66.8368270, & 67.3695950,67.9008620,68.4310010,68.9603060,69.4890210,70.0173420, & 118.7503410,368.4983500,424.7631200,487.2493700,715.3931500, & 773.8387300, 834.1453300/ data a1/0.0000001,0.0000003,0.0000009,0.0000025,0.0000061,0.0000141, & 0.0000310,0.0000641,0.0001247,0.0002280,0.0003918,0.0006316,0.0009535, & 0.0005489,0.0013440,0.0017630,0.0000213,0.0000239,0.0000146,0.0000240, & 0.0000211,0.0000212,0.0000246,0.0000250,0.0000230,0.0000193,0.0000152, & 0.0000150,0.0000109,0.0007335,0.0004635,0.0002748,0.0001530,0.0000801, & 0.0000395,0.0000183,0.0000080,0.0000033,0.0000013,0.0000005,0.0000002, & 0.0000094,0.0000679,0.0006380,0.0002350,0.0000996,0.0006710,0.0001800/ data a2/11.8300000,10.7200000,9.6900000,8.8900000,7.7400000,6.8400000, & 6.0000000,5.2200000,4.4800000,3.8100000,3.1900000,2.6200000,2.1150000, & 0.0100000,1.6550000,1.2550000,0.9100000,0.6210000,0.0790000,0.3860000, & 0.2070000,0.2070000,0.3860000,0.6210000,0.9100000,1.2550000,0.0780000, & 1.6600000,2.1100000,2.6200000,3.1900000,3.8100000,4.4800000,5.2200000, & 6.0000000,6.8400000,7.7400000,8.6900000,9.6900000,10.7200000,11.8300000, & 0.0000000,0.0200000,0.0110000,0.0110000,0.0890000,0.0790000,0.0790000/ data a3/0.0083000,0.0085000,0.0086000,0.0087000,0.0089000,0.0092000, & 0.0094000,0.0097000,0.0100000,0.0102000,0.0105000,0.0107900,0.0111000, & 0.0164600,0.0114400,0.0118100,0.0122100,0.0126600,0.0144900,0.0131900, & 0.0136000,0.0138200,0.0129700,0.0124800,0.0120700,0.0117100,0.0146800, & 0.0113900,0.0110800,0.0107800,0.0105000,0.0102000,0.0100000,0.0097000, & 0.0094000,0.0092000,0.0089000,0.0087000,0.0086000,0.0085000,0.0084000, & 0.0159200,0.0192000,0.0191600,0.0192000,0.0181000,0.0181000,0.0181000/ data a4/0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, & 0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, & 0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, & 0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, & 0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, & 0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, & 0.0000000,0.6000000,0.6000000,0.6000000,0.6000000,0.6000000,0.6000000/ data a5/0.0056000,0.0056000,0.0056000,0.0055000,0.0056000,0.0055000, & 0.0057000,0.0053000,0.0054000,0.0048000,0.0048000,0.0041700,0.0037500, & 0.0077400,0.0029700,0.0021200,0.0009400,-0.0005500,0.0059700,-0.0024400, & 0.0034400,-0.0041300,0.0013200,-0.0003600,-0.0015900,-0.0026600, & -0.0047700,-0.0033400,-0.0041700,-0.0044800,-0.0051000,-0.0051000, & -0.0057000,-0.0055000,-0.0059000,-0.0056000,-0.0058000,-0.0057000, & -0.0056000,-0.0056000,-0.0056000,-0.0004400,0.0000000,0.0000000, & 0.0000000,0.0000000,0.0000000,0.0000000/ data a6/1.7000000,1.7000000,1.7000000,1.7000000,1.8000000,1.8000000,& 1.8000000,1.9000000,1.8000000,2.0000000,1.9000000,2.1000000,2.1000000, & 0.9000000,2.3000000,2.5000000,3.7000000,-3.1000000,0.8000000,0.1000000, & 0.5000000,0.7000000,-1.0000000,5.8000000,2.9000000,2.3000000,0.9000000, & 2.2000000,2.0000000,2.0000000,1.8000000,1.9000000,1.8000000,1.8000000, & 1.7000000,1.8000000,1.7000000,1.7000000,1.7000000,1.7000000,1.7000000, & 0.9000000,1.0000000,1.0000000,1.0000000,1.0000000,1.0000000,1.0000000/ ! // table2 parameters v1, b1, b2, b3 data v1/22.2350800,67.8139600,119.9959400,183.3101170,321.2256440, & 325.1529190,336.1870000,380.1973720,390.1345080,437.3466670,439.1508120, & 443.0182950,448.0010750,470.8889740,474.6891270,488.4911330,503.5685320, & 504.4826920,556.9360020,620.7008070,658.0065000,752.0332270,841.0735950, & 859.8650000,899.4070000,902.5550000,906.2055240,916.1715820,970.3150220, & 987.9267640/ data b1/0.1090000,0.0011000,0.0007000,2.3000000,0.0464000,1.5400000, & 0.0010000,11.9000000,0.0044000,0.0637000,0.9210000,0.1940000,10.6000000, & 0.3300000,1.2800000,0.2530000,0.0374000,0.0125000,510.0000000,5.0900000, & 0.2740000,250.0000000,0.0130000,0.1330000,0.0550000,0.0380000,0.1830000, & 8.5600000,9.1600000,138.0000000/ data b2/2.1430000,8.7300000,8.3470000,0.6530000,6.1560000,1.5150000, & 9.8020000,1.0180000,7.3180000,5.0150000,3.5610000,5.0150000,1.3700000, & 3.5610000,2.3420000,2.8140000,6.6930000,6.6930000,0.1140000,2.1500000, & 7.7670000,0.3360000,8.1130000,7.9890000,7.8450000,8.3600000,5.0390000, & 1.3690000,1.8420000,0.1780000/ data b3/0.0278400,0.0276000,0.0270000,0.0283500,0.0214000,0.0270000, & 0.0265000,0.0276000,0.0190000,0.0137000,0.0164000,0.0144000,0.0238000, & 0.0182000,0.0198000,0.0249000,0.0115000,0.0119000,0.0300000,0.0223000, & 0.0300000,0.0286000,0.0141000,0.0286000,0.0286000,0.0264000,0.0234000, & 0.0253000,0.0240000,0.0286000/ ! // conversions th = 300./T ! unitless e = (RH*th**5)/(41.45*10**(9.834*th-10)) ! kPa p = PRES_mb/10.-e ! kPa ! // term1 sumo = 0. do i=1,nbands_o2 sumo = sumo + fpp_o2(p,th,e,a3(i),a4(i),a5(i),a6(i),f,v0(i)) & * s_o2(p,th,a1(i),a2(i)) enddo term1 = sumo ! // term2 gm0 = 5.6E-3*(p+1.1*e)*th**(0.8) a0 = 3.07E-4 ap = 1.4*(1-1.2*f**(1.5)*1E-5)*1E-10 term2 = (2*a0*(gm0*(1+(f/gm0)**2)*(1+(f/60.)**2))**(-1) + ap*p*th**(2.5)) & * f*p*th**2 ! // term3 sumo = 0. do i=1,nbands_h2o sumo = sumo + fpp_h2o(p,th,e,b3(i),f,v1(i)) & * s_h2o(th,e,b1(i),b2(i)) enddo term3 = sumo ! // term4 bf = 1.4E-6 be = 5.41E-5 term4 = (bf*p+be*e*th**3)*f*e*th**(2.5) ! // summation and result npp = term1 + term2 + term3 + term4 gases = 0.182*f*npp ! ----- SUB FUNCTIONS ----- contains function fpp_o2(p,th,e,a3,a4,a5,a6,f,v0) real*8 :: fpp_o2,p,th,e,a3,a4,a5,a6,f,v0 real*8 :: gm, delt, x, y gm = a3*(p*th**(0.8-a4)+1.1*e*th) delt = a5*p*th**(a6) x = (v0-f)**2+gm**2 y = (v0+f)**2+gm**2 fpp_o2 = ((1./x)+(1./y))*(gm*f/v0) - (delt*f/v0)*(((v0-f)/(x))-((v0+f)/(x))) end function fpp_o2 function fpp_h2o(p,th,e,b3,f,v0) real*8 :: fpp_h2o,p,th,e,b3,f,v0 real*8 :: gm, delt, x, y gm = b3*(p*th**(0.8)+4.8*e*th) delt = 0. x = (v0-f)**2+gm**2 y = (v0+f)**2+gm**2 fpp_h2o = ((1./x)+(1./y))*(gm*f/v0) - (delt*f/v0)*(((v0-f)/(x))-((v0+f)/(x))) end function fpp_h2o function s_o2(p,th,a1,a2) real*8 :: s_o2,p,th,a1,a2 s_o2 = a1*p*th**(3)*exp(a2*(1-th)) end function s_o2 function s_h2o(th,e,b1,b2) real*8 :: s_h2o,th,e,b1,b2 s_h2o = b1*e*th**(3.5)*exp(b2*(1-th)) end function s_h2o end function gases