!**************************************************************** !**************************************************************** subroutine get_stndewpt_r4(p,q,t,td,lboundtd) !*********************************************************************** ! abstract: compute the bckg (or anl) dewpoint temp at a ststion * ! location given the values of psfc, spfhum, and temp * ! * ! program history log: * ! 2005-10-08 pondeca * !*********************************************************************** ! !==> input variables ! q-specific humidity ; p-pressure in Pa !==> output variable ! td-dewpoint in K ! implicit none ! Declare local parameters real(4),parameter::eps=0.62197 !=Rd/Rv real(4),parameter::a=243.5 real(4),parameter::b=440.8 real(4),parameter::c=19.48 real(4),parameter::c2k=273.15 real(4),parameter:: r100=100.0 ! Declare passed variables real(4),intent(in):: p,q,t real(4),intent(out):: td logical,intent(in):: lboundtd ! Declare local variables real(4) e, qv, eln qv=q/(1.-q) e=p/r100*qv/(eps+qv) eln=log(e) td = (a*eln-b)/(c-eln)+c2k if (lboundtd) td = min(t,td) end subroutine get_stndewpt_r4 !************************************************************ subroutine getguess_or_anal(vartype,gesoranl,field,nx,ny) !************************************************ ! vartype: psfc ! temp ! moisture ! uwind ! vwind !************************************************ implicit none !==>passed varaibles character(*),intent(in):: vartype character(3),intent(in):: gesoranl integer(4),intent(in):: nx,ny real(4),intent(out):: field(nx,ny) !==>local varibales integer(4) rtime(6),nlon,nlat,nsig integer(4) n,nt print*,'in getguess_or_anal: nx,ny=',nx,ny print*,'in getguess_or_anal: vartype,gesoranl=', & trim(vartype),trim(gesoranl) if (trim(gesoranl)=='ges') then open (52,file='sigges',form='unformatted') elseif (trim(gesoranl)=='anl') then open (52,file='siganl',form='unformatted') else print*,'gesoranl must be either ges or anl' print*,'in getguess_or_anal: ... aborting' call abort endif read(52) rtime,nlon,nlat,nsig print*,'in getguess_or_anal/ rtime=',rtime print*,'in getguess_or_anal/ nlon,nlat,nsig=',nlon,nlat,nsig print*,'**********************************************' !records contain: !glat,dx !glon,dy !psfc !fis !t !q !u !v if (trim(vartype).eq.'psfc') nt=3 if (trim(vartype).eq.'temp') nt=5 if (trim(vartype).eq.'moisture') nt=6 if (trim(vartype).eq.'uwind') nt=7 if (trim(vartype).eq.'vwind') nt=8 do n=1,nt read(52) field enddo print*,'in getguess_or_anal: vartype=',trim(vartype) print*,'in getguess_or_anal: field,max,min=',minval(field),maxval(field) close(52) end subroutine getguess_or_anal !------------------------------------------------------ !------------------------------------------------------ subroutine bilinear_2d0(rffcst,ix,jx,rfobs,xx,yy) !$$$ subprogram documentation block ! . . . . ! subprogram: bilinear_2d0 ! prgmmr: ! ! abstract: ! ! ! input argument list: ! rffcst - model grid value ! ix,jx ! xx,yy - define coordinates in grid units ! of point for which interpolation is ! performed ! ! output argument list: ! rfobs - interpolated value ! ! notes: ! ! i+1,j | | i+1,j+1 ! --+----------+--- ! | | dym ! | * + - ! | x,y | dy ! | | ! --+----+-----+--- ! i,j||| i,j+1 ! ! attributes: ! language: f90 ! machine: ! !$$$ end documentation block implicit none !declare passed variables integer(4),intent(in ) :: ix,jx real(4) ,intent(in ) :: rffcst(ix,jx) real(4) ,intent(in ) :: xx,yy real(4) ,intent( out) :: rfobs !declare local variables integer(4) i,j,ip,jp real(4) dx,dy,dxm,dym i = ifix(yy) j = ifix(xx) dx = xx - float(j) dy = yy - float(i) dxm= 1.0-dx dym= 1.0-dy i=min(max(1,i),ix) ; j=min(max(1,j),jx) ip=min(ix,i+1) ; jp=min(jx,j+1) rfobs=dxm*(dym*rffcst(i,j)+dy*rffcst(ip,j)) & + dx *(dym*rffcst(i,jp)+dy*rffcst(ip,jp)) return end subroutine bilinear_2d0