#include "cosp_defs.H" #ifdef COSP_GFDL !--------------------------------------------------------------------- !------------ FMS version number and tagname for this file ----------- ! $Id: gases.F90,v 20.0 2013/12/13 23:16:45 fms Exp $ ! $Name: tikal $ ! cosp_version = 1.3.2 #endif 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