subroutine marine_locld_retrieval(debug, rlat, met_month, isp, * psfc, ltrp, ttpp, z, tp, tw, lwin, ecawin, pct, tct, * ip, lmlc, ecamlc) c!F77------------------------------------------------------------------- c!Description: Calculate marine low cloud height using a lapse rate c method. c c!Input parameters: c debug Debug write flag c rlat Latitude c met_month Month c isp Level of surface pressure (1-101) c psfc Surface pressure c ltrp Level of tropopause (1-101) c ttpp Brightness temperatures for each profile level c z Geopotential height profile c tp Atm. temperature profile c tw Observed 11 micron brightness temperature c lwin IRW cloud top pressure level c ecawin Cloud amount from IRW retrieval c c!Output parameters: c pct Retrieved cloud top pressure c tct Retrieved cloud top temperature c ip Index of band pair chosen for final result c lmlc Level of cloud top pressure retrieval (1-101) c ecamlc Cloud amount from collocated AVHRR cloud fraction c c!Revision history: c 07/10 R. Frey c Original version c 11/10 R. Frey c Added 'ecawin', changed 'eca' to 'ecamlc'. c 02/12 R. Frey c Added 'psfc' and 'pwin_init'; check on surface c pressure c c!Calls: c None c c!End------------------------------------------------------------------- implicit none save integer plev parameter (plev = 101) c Scalar arguments. integer debug, met_month, isp, ltrp, lwin, ip, lmlc real rlat, tw, pct, tct, psfc c Array arguments. real ttpp(plev), z(plev), tp(plev) c Local scalars. double precision dplat, c0, c1, c2, c3, c4 real lapse_rate, dt, zcld, ecamlc, ecawin, pwin_init integer llwin, k, zpl, zph, jm c Local arrays. real pp(plev) double precision a0(12), a1(12), a2(12) double precision month_coeffs(5,12,3), breakpts(2,12) c----------------------------------------------------------------------- c Define 101 pressure levels. data pp / 0.0050, 0.0161, 0.0384, 0.0769, 0.1370, + 0.2244, 0.3454, 0.5064, 0.7140, 0.9753, 1.2972, + 1.6872, 2.1526, 2.7009, 3.3398, 4.0770, 4.9204, + 5.8776, 6.9567, 8.1655, 9.5119, 11.0038, 12.6492, + 14.4559, 16.4318, 18.5847, 20.9224, 23.4526, 26.1829, + 29.1210, 32.2744, 35.6505, 39.2566, 43.1001, 47.1882, + 51.5278, 56.1260, 60.9895, 66.1253, 71.5398, 77.2396, + 83.2310, 89.5204, 96.1138, 103.0172, 110.2366, 117.7775, + 125.6456, 133.8462, 142.3848, 151.2664, 160.4959, 170.0784, + 180.0183, 190.3203, 200.9887, 212.0277, 223.4415, 235.2338, + 247.4085, 259.9691, 272.9191, 286.2617, 300.0000, 314.1369, + 328.6753, 343.6176, 358.9665, 374.7241, 390.8926, 407.4738, + 424.4698, 441.8819, 459.7118, 477.9607, 496.6298, 515.7200, + 535.2322, 555.1669, 575.5248, 596.3062, 617.5112, 639.1398, + 661.1920, 683.6673, 706.5654, 729.8857, 753.6275, 777.7897, + 802.3714, 827.3713, 852.7880, 878.6201, 904.8659, 931.5236, + 958.5911, 986.0666, 1013.9476, 1042.2319, 1070.9170, 1100.0000/ c Lapse rate coefficients, by month of year. data a0 /3.9345, 3.7507, 3.7440, 3.7810, 3.7956, 3.9949, * 4.0161, 4.1329, 3.9528, 4.0972, 3.9939, 4.1510/ data a1 / 0.0104, 0.0099, 0.0066, -0.0004, -0.0093, -0.0144, * -0.0185, -0.0225, -0.0189, -0.0081, 0.0003, 0.0080/ data a2 /0.0008, 0.0008, 0.0009, 0.0009, 0.0008, 0.0007, * 0.0006, 0.0005, 0.0007, 0.0008, 0.0008, 0.0008/ c Lapse rate coefficients, by month of year. data month_coeffs / * 2.9769800876, -0.0515871084, 0.0027409105, 0.0001135740, 0.00000113040, * 3.3483238557, 0.1372575458, 0.0133258850, 0.0003043608, 0.00000218650, * 2.4060295675, 0.0372001609, 0.0096472724, 0.0002334206, 0.00000165450, * 2.6522386726, 0.0325728824, 0.0100892620, 0.0002601226, 0.00000198560, * 1.9578262599, -0.2112028966, -0.0057943564, -0.0001050464, -0.00000074313, * 2.7659753980, -0.1186500984, 0.0011626989, 0.0000936998, 0.00000101060, * 2.1106811602, -0.3073665907, -0.0090862456, -0.0000889596, 0.00000003552, * 3.0982173723, -0.1629588435, -0.0020384299, 0.0000286274, 0.00000060283, * 3.0760551826, -0.2043463270, -0.0053969994, -0.0000541329, -0.00000001768, * 3.6377215316, -0.0857783614, 0.0024313179, 0.0001495010, 0.00000170850, * 3.3206165420, -0.1411094234, -0.0026068389, 0.0000057937, 0.00000042113, * 3.0526632533, -0.1121521836, -0.0009912556, 0.0000179690, 0.00000027070, * 2.9426577089, -0.0510674066, 0.0052420293, 0.0001097927, -0.00000372380, * 2.6499605646, -0.0105152229, 0.0042895903, 0.0000719741, -0.00000066735, * 2.3652046763, 0.0141129341, 0.0059242144, -0.0000158816, -0.00000265790, * 2.5433158163, -0.0046876415, 0.0059325140, 0.0000143938, -0.00000346360, * 2.4994027830, -0.0364706332, 0.0082001522, 0.0000843577, -0.00000768780, * 2.7641495752, -0.0728625243, 0.0088877822, 0.0001767765, -0.00001168390, * 3.1202042743, -0.1002374752, 0.0064054059, 0.0002620230, -0.00001078950, * 3.4331195144, -0.1021765880, 0.0010498850, 0.0001614861, 0.00000510150, * 3.4539389485, -0.1158261776, 0.0015449592, 0.0001711651, 0.00000248080, * 3.6013336912, -0.0775800028, 0.0041940388, 0.0000941307, -0.00000408720, * 3.1947419143, -0.1045316345, 0.0049986486, 0.0001910731, -0.00000505500, * 3.1276377012, -0.0707628268, 0.0055532926, 0.0001549833, -0.00000570980, * 1.9009562748, 0.0236905223, 0.0086504022, -0.0002167013, 0.00000151230, * 2.4878735828, -0.0076514110, 0.0079443995, -0.0001773726, 0.00000114730, * 3.1251275103, -0.1214572133, 0.0146488407, -0.0003187508, 0.00000210290, * 13.3931706579, -1.2206947755, 0.0560380539, -0.0009873591, 0.00000598210, * 1.6432070460, 0.1151206937, 0.0033130967, -0.0001458434, 0.00000128610, * -5.2366360253, 1.0105574562, -0.0355440449, 0.0005187964, -0.00000262410, * -4.7396480830, 0.9625734101, -0.0355846807, 0.0005522497, -0.00000299860, * -1.4424842734, 0.4769307320, -0.0139027010, 0.0001758823, -0.00000079846, * -3.7140186247, 0.6720953861, -0.0210548327, 0.0002974491, -0.00000149380, * 8.2237401369, -0.5127532741, 0.0205285436, -0.0003015662, 0.00000157680, * -0.4502046794, 0.2629679617, -0.0018419395, -0.0000368887, 0.00000048223, * 9.3930897423, -0.8836682302, 0.0460453172, -0.0008450362, 0.00000517810/ data breakpts / * - 3.8, 22.1, * -21.5, 12.8, * - 2.8, 10.7, * -23.4, 29.4, * -12.3, 14.9, * - 7.0, 16.8, * -10.5, 15.0, * - 7.8, 19.5, * - 8.6, 17.4, * - 7.0, 27.0, * - 9.2, 22.0, * - 3.7, 19.0/ c----------------------------------------------------------------------- c Set retrieval index. ip = 6 c----------------------------------------------------------------------- c Define month of year as an index, jm = met_month c Get monthly mean lapse rates. There are three separate sets of c coefficients, delineated by 'breakpts' (latitudes). c Determine which coefficients to use based on latitude. if(rlat .lt. breakpts(1,jm)) then c0 = month_coeffs(1,jm,1) c1 = month_coeffs(2,jm,1) c2 = month_coeffs(3,jm,1) c3 = month_coeffs(4,jm,1) c4 = month_coeffs(5,jm,1) else if(rlat .ge. breakpts(1,jm) .and. rlat .le. breakpts(2,jm)) then c0 = month_coeffs(1,jm,2) c1 = month_coeffs(2,jm,2) c2 = month_coeffs(3,jm,2) c3 = month_coeffs(4,jm,2) c4 = month_coeffs(5,jm,2) else c0 = month_coeffs(1,jm,3) c1 = month_coeffs(2,jm,3) c2 = month_coeffs(3,jm,3) c3 = month_coeffs(4,jm,3) c4 = month_coeffs(5,jm,3) end if dplat = dble(rlat) c lapse_rate = sngl ( a0(met_month) + (a1(met_month) * dplat) + c * (a2(met_month) * dplat**2.d0) ) lapse_rate = sngl (c0 + c1*rlat + c2*rlat**2 + c3*rlat**3 + c4*rlat**4) if(lapse_rate .lt. 2.0) lapse_rate = 2.0 if(lapse_rate .gt. 10.0) lapse_rate = 10.0 c Get temperature difference between surface (calculated) and cloud c (observed). dt = ttpp(isp) - tw c Calculate cloud height. if(dt .gt. 0.0) then zcld = dt / lapse_rate else zcld = 0.0 end if c Find closest z-level. if(zcld .eq. 0.0) then llwin = isp else c Initialize. Sometimes 'zcld' < 'z(isp)'. zpl = isp zph = isp - 1 do k = isp, ltrp, -1 if (zcld .gt. z(k)) then zpl = k zph = k - 1 end if enddo if( (abs(zcld-z(zph))) .le. (abs(zcld-z(zpl))) ) then llwin = zph else llwin = zpl end if end if lmlc = llwin pwin_init = pp(lmlc) if(pwin_init .ge. psfc) pwin_init = psfc pct = (nint(pwin_init / 5.0)) * 5.0 tct = tp(lmlc) ecamlc = ecawin c----------------------------------------------------------------------- if(debug .gt. 1) then write(*,'(''Ocean low cloud algorithm data:'')') write(*,'(''Calc. sfc. BT, Obs. BT, dt, lat, lapse rate, '', * ''cld hgt, z(sfc)'')') write(*,'(7f10.3)') ttpp(isp),tw,dt,rlat,lapse_rate,zcld, * z(isp) write(*,'(1x)') write(*,'(''Interpolation:'')') write(*,'(''trop and sfc levels, zph, zpl, cld lev, month'')') write(*,'(7i10)') ltrp,isp,zph,zpl,lmlc,met_month write(*,'(''zlo, zhi, z, pres cld, pres IRW, final cld p, t'')') write(*,'(7f10.3)') z(zpl),z(zph),z(lmlc),pp(lmlc), * pp(lwin),pct,tct write(*,'(1x)') end if c----------------------------------------------------------------------- return end