c $Header: /usr/people/flittner/radtran/tomrad/pv2.2/src/RCS/relayr.f,v 2.22 2000/08/30 16:38:09 flittner Exp $ subroutine relayr(pnot,xpnot) c ---------------------------------------------------------------- c subroutine relayr c c c version 2.0 june 1984 c algorithm designed by dr. p.k. bhartia ; coded by david lee ,sasc c c purpose - c c find the cumulative ozone amount and ozone-weighted average c temperatures at 101 levels from input values for 10 umkehr c layers using a spline fit. c c c method / procedures c c 1) define input and output pressure levels c 2) compute accumulated ozone amounts at input levels c 3) compute ozone weighted average temperatures above input c pressure levels c 4) perform a spline fit to temperatures and accumulated c ozones at input levels c 5) evaluate spline fit at the lowest 61 pressure levels c 6) find slope for the accumulated ozone at the 41st. level c 7) evaluaate accumulated ozone amounts for the top 40 levels c from the slope computed from the 41st level c 8) compute pressures for altitudes at 1 km intervals c c c calling sequence - call relayr(h,ps) c c c variable type i/o description c -------- ---- --- ----------- c via common input.cmn c xprf(11) r*8 i layer ozone amount (d.u) for c input layers. (layer c 1 being the top of the atmos- c phere). indexing of the layers are c described in the table below c via common input.cmn c tmpprf(11) r*8 i average temperatures (degrees kelvin) c for input layers c c p11(11) r*8 pressure levels (atm.) defining the 10 c umkehr layers. indexing of the pressure c levels are described in the table c below c c x11(11) r*8 cumulative ozone amount (m-atm-cm) c at pressure levels described above c for p11 c c pnot r*8 i pressure of reflecting surface c c xpnot r*8 o cumulative ozone at pnot c c p101(101) r*8 pressure (atm.) at 101 atmospheric c levels that define the output layer c ozone amounts and temperatures c c x_101(101) r*8 o output cumulative ozone amounts c (atm-cm) at levels corresponding c to p101. c c c t_101(101) r*8 o output ozone weighted temperatures c (deg-kelvin) for atmospheres above c each of the 101 pressure levels. c c z11(11) r*8 altitude (km) corresponding to p11 c defining the umkehr layers c c hhold(82) r*8 o through contrl.cmn: altitude array at 1 km c interval from ground to 82 km c c pshold(82) r*8 o through contrl.cmn: pressures corresponding c to the height at the h array c c c----------------------------------------------------------------------- c c----------------------------------------------------------------------- c c the table below describes the order of indices for variables c in this subroutine c c pressure umkehr indices indices index c (atm.) layer # for p11,x11 for xprf for c & t11ave & tmpprf z11 c 1 c 1/1024 -------------------------1--------------------------11 c 9 2 c 1/512---------------------------2--------------------------10 c 8 3 c 1/256---------------------------3---------------------------9 c 7 4 c 1/128---------------------------4---------------------------8 c 6 5 c 1/64 ---------------------------5---------------------------7 c 5 6 c 1/32 ---------------------------6---------------------------6 c 4 7 c 1/16 ---------------------------7---------------------------5 c 3 8 c 1/8 ---------------------------8---------------------------4 c 2 9 c 1/4 ---------------------------9---------------------------3 c 1 10 c 1/2 --------------------------10---------------------------2 c 0 11 c 1 --------------------------11---------------------------1 c c c last modified 03/10/95...dave flittner c purpose: set earth radius equal to value in common block consts c c last modified 03/14/95...dave flittner c purpose: set pressure scale height used in gravity correction c to rayleigh scattering od. Create new variable pscaleforg and c pass in common block consts. c c last modified July, 1998...def c purpose: allow for use of input profile with elevated surface. c This was used in the flux intercomparison. c c last mod. Sep. 6, 1998...def c purpose: combine several commons into switches.cmn. c c last mod. Oct. 19, 1998...def c purpose: tidy-up user input profile option. Use us76 atm c for t-p-z above and below the input profile with adjustments c at boundaries to match input profile. Will not use o3 weighted c temperatures. Instead will use average of input temps for c temp. to use for the abs coe calc. c c last mod. Oct. 19, 1998...def c purpose: also save cumo3 so don't have to read the user profile c each time. c c last mod. Nov. 20, 1998...def c purpose: fix use of us76 atmo for user profile. Limit surface c pressure to be no greater than 1.0 atm. c c last mod. Nov. 23, 1998...def c purpose: check to see that the cumulative ozone decreases with altitude. c c last mod. May 6, 1999...def c purpose: pass pshold and hhold through contrl.cmn instead of command line. c c last mod. Nov. 2, 1999...def c purpose: use .not. instead of .eqv. in logical testing c c last mod. Nov. 12, 1999...def c purpose: use isothermal atmo. below the lowest point in the user profile c and not the standard atmo table. c c last mod. May 16, 2000...def c purpose: add switch for using ozone weighted temperatures with the c user profile. c c-------------------------------------------------------------------- implicit none c passed in real*8 pnot c passed out real*8 xpnot include 'switches.cmn' include 'atm_101.cmn' c local real*8 y21,y2n integer mode c if((prf_type.eq.0).or.(prf_type.eq.1))then call std_relayr(pnot,xpnot) else call user_relayr(pnot,xpnot) endif c c now interpolate the surface altitude given the surface pressure c y21=1.0e30 y2n=1.0e30 mode=0 call spline(p_101lg,alt_101,n_101,y21,y2n,y2_101,mode) call splint(p_101lg,alt_101,y2_101,n_101,pnot,alt_sfc,mode) c 900 continue return 1000 format('relayr. debugging output--------') 2000 format(1x,'xpnot=',f10.5//) 3000 format(1x,'relayr. The user profile must be adjusted by a', &' factor of ',1PE14.6,/,' to match the input total column', &' ozone amount of ',0Pf8.6) 6200 format(//' ozone,temperature & other variables in umkehr layers:'/ 1 /t28,'weighted',t51,'layer',t61,'layer'/1x,'index',t13,'p11',t23, 2 'x11',t32,'temp',t43,'z11',t52,'temp',t61,'ozone' 3 /t46,2f10.2/10(i3,2x,e10.4,f10.3,2f10.2/t46,2f10.2/), 4 i3,2x,e10.4,f10.3,2f10.2) 6210 format(/' pressures for first 82 km altitude :'/5(8x,'h',9x, 1 'ps',2x)/17(5(f10.1,e12.4)/)) end