C*********************************************************************** C*********************************************************************** C GBLEVN03 - INTERPOLATE MODEL DATA (FIRST GUESS OR ANALYSIS) TO OB C LOCATIONS C----------------------------------------------------------------------- SUBROUTINE GBLEVN35(SUBSET) ! FORMERLY SUBROUTINE GETFC USE GBLEVN_MODULE USE READSF_MODULE COMMON /GBEVAA/ SID,OBS(15,255),QMS(12,255),BAK(12,255),XOB, $ YOB,DHR,TYP,NLEV COMMON /GBEVEE/PSG01,ZSG01,THE_REST(500,9) CHARACTER*8 SUBSET,CID real(4) plev(kmax),zlev(kmax),prof(kmax) REAL(8) SID,OBS,QMS,BAK equivalence (sid,cid) logical newxyt,windp,windz,geomz DATA TZERO / 273.15 / DATA BETAP / .0552 / DATA BETA / .00650 / DATA ROG / 29.261 / C----------------------------------------------------------------------- C----------------------------------------------------------------------- C SETUP FOR INTERPOLATING TO THIS OBSERVATION C ------------------------------------------- CALL HTERPS(xob,yob,dhr,iarps,psi);psg01=psi ! bmiss is defined in gblevn00 BAK = BMISS OBX = BMISS; OBL = .false. S10 = 1. ! default value xdx=bmiss; ydx=bmiss; tdx=bmiss C INTERPOLATE GUESS PROFILES TO OB PRESSURES C ------------------------------------------ IF(NLEV.GT.0) THEN DO 10 L=1,NLEV POB = OBS( 1,L) QOB = OBS( 2,L) TOB = OBS( 3,L) ZOB = OBS( 4,L) UOB = OBS( 5,L) VOB = OBS( 6,L) PWO = OBS( 7,L) PW1O = OBS( 8,L) PW2O = OBS( 9,L) PW3O = OBS(10,L) PW4O = OBS(11,L) CAT = OBS(12,L) TVO = OBS(14,L) pfc=bmiss;qfc=bmiss;tfc=bmiss;zfc=bmiss;ufc=bmiss;vfc=bmiss c x,y,t may be stored as profile values, or not IF(POB.LE.0. .OR. POB.GE.BMISS) GOTO 10 xdr=xyt(1,l); ydr=xyt(2,l); tdr=xyt(3,l) if(max(xdr,ydr,tdr)>=bmiss) then xdr=xob;ydr=yob;tdr=dhr endif newxyt=xdr/=xdx.or.ydr/=ydx.or.tdr/=tdx xdx=xdr; ydx=ydr; tdx=tdr c given x,y,t generate some interpolated coordinates needed for the process if(newxyt) then CALL HTERPT(xdr,ydr,tdr,iarpl,kmax,plev) ! interpolated mid layer pressures CALL HTERPS(xdr,ydr,tdr,iarps,ps) ! interpolated surface pressure CALL HTERPS(xdr,ydr,tdr,iarzs,zs) ! interpolated surface height CALL HTERPT(xdr,ydr,tdr,iartt,1,t1) ! interpolated sigma 1 temperature P1 = PLEV(1) TM = T1+(PS-P1)*BETAP*.5 ! mid layer temp between sigma1 and surface Z1 = ZS-ROG*TM*LOG(P1/PS) ! height of sigma 1 (lowest sigma level) TS = T1+(Z1-ZS)*BETA ! surface temperature lapsed from sigma 1 P10 = PS*EXP(-10./((TS-(5.*beta))*ROG)) ! 10 meter pressure if(rsfc) CALL HTERPSF(xdr,ydr,tdr,f10,s10) ! 10 meter wind factor endif C SURFACE PRESSURE IF(CAT.EQ.0 .AND. ZOB.LT.BMISS) THEN DZ = ZOB-ZS TO = TS-DZ*BETA IF(TOBp1)tfc=tfc+(pob-p1)*betap ! lapse temp below sigma 1 if need be if(tob/=tvo.and.fits) then ! convert background tv >> ts for ts ob ! call hterptz(xdr,ydr,tdr,pwt,iarqq,qft) p=pob; e=esph(p,qft*1.e-6); tfc=sent(p,e,tfc) endif ENDIF C U AND V COMPONENTS IF(max(uob,vob)= 280.and.kx < 300 )then oelev=10+selev if (kx == 280) oelev=20+selev if (kx == 282) oelev=20+selev if (kx == 285 .or. kx == 289 .or. kx == 290) then oelev=selev selev=0.0 endif else if(kx >= 221.and.kx <= 229) then if(selev >= oelev) oelev=10+selev end if; zow=oelev ! decide whether to interpolate in height (geop or geom) or pressure windz = (typ>=221.and.typ<=229).or.(typ>=280.and.typ<300) geomz = (typ>=223.and.typ<=228).or.(typ>=280.and.typ<300) windz = windz .and. zowplev(1))then ! interpolate between sig01 and the surface if need be !print*,pob,ps,t1,p1,s10 P10 = PS*EXP(-10./(T1*ROG)) ! 10 meter pressure po=min(pob,p10); swt=log(po/p1)/log(p10/p1) swt=1.+(s10-1.)*swt endif ELSEIF(max(uob,vob) 10.)then if(zow-selev > 1000)then fact = 1.0 else fact=(zow-selev)*.001 end if end if zow=zow-(selev+fact*(zs-selev)) ! zow and zlev are now height above the surface zwt=zilnlnpw(zow,zlev,kmax) CALL HTERPTZ(xdr,ydr,tdr,zwt,iaruu,ufc) CALL HTERPTZ(xdr,ydr,tdr,zwt,iarvv,vfc) !!CALL HTERPZ(zow,zwt,zlev,ps,plev,pob) ! store any pressure adjustments !!obx(1,l)=pob;obx(2,l)=qms(1,l) ! to write into the output file !!obl=.true. if(zow