Initial commit

wrf_open/var/ncl_reference/WRF_contributed.ncl

@@ -0,0 +1,293 @@
+;*************************************************************************
+; Note: several of the functions/procedures are used
+;       to invoke old [ugly!] function names. 
+;*************************************************************************
+; D. Shea
+;
+;      convert WRF character variable "Times" to udunits
+;      2001-06-11_12:00:00
+;
+;      convert WRF character variable "Times" to a coordinate variable  "Time"
+;      opt can be "integer" or "string"
+;      .   integer:  opt = 0 : hours since initial time: Times(0,:)
+;      .             opt = 1 : hours since 1901-01-01 00:00:00
+;      .   string:   opt = 'any udunits compatible string'
+;
+undef ("WRF_Times2Udunits_c")
+function WRF_Times2Udunits_c(Times:character, opt)
+local dimT, rank, year, month, day, hour, minute, sec, units, time
+begin
+   
+  dimT   = dimsizes(Times)
+  rank   = dimsizes(dimT)
+  if (rank.ne.2) then
+      print("===> WRF_contributed.ncl: WRF_Times2Udunits_c expects 2D array: rank="+rank)
+      exit
+  end if
+
+  if (.not.(typeof(opt).eq."integer" .or. typeof(opt).eq."string")) then
+      print("===> WRF_contributed.ncl: opt must be integer or string: type="+typeof(opt))
+      exit
+  end if
+
+  year   = stringtointeger((/Times(:, 0:3) /))
+  month  = stringtointeger((/Times(:, 5:6) /))
+  day    = stringtointeger((/Times(:, 8:9) /))
+  hour   = stringtointeger((/Times(:,11:12)/))
+  minute = stringtointeger((/Times(:,14:15)/))
+  sec    = stringtointeger((/Times(:,17:18)/))
+
+  if (typeof(opt).eq."integer") then
+      if (opt.eq.0) then
+          units  = "hours since "+year(0)+"-" \
+                                 +sprinti("%0.2i",month(0)) +"-" \
+                                 +sprinti("%0.2i",day(0))   +" " \
+                                 +sprinti("%0.2i",hour(0))  +":" \
+                                 +sprinti("%0.2i",minute(0))+":" \
+                                 +sprinti("%0.2i",sec(0))       
+      else  
+          units  = "hours since 1901-01-01 00:00:00"
+      end if
+  else
+          units  = opt   ; opt is udunits compatible string
+  end if
+
+  Time   = ut_inv_calendar(year,month,day,hour,minute,sec, units, 0)
+
+  Time!0          = "Time"
+  Time@long_name  = "Time"
+  Time@description= "Time"
+  Time@units      =  units
+  Time&Time       =  Time        ; make coordinate variable
+  return (Time)
+end 
+;*************************************************************************
+; D. Shea
+;      interface to WRF_Times2Udunits_c
+undef ("WRF_Times_to_udunits")
+function WRF_Times_to_udunits(Times:character, opt)
+begin
+  return( WRF_Times2Udunits_c(Times, 0) )    ; old name 
+end
+
+;*************************************************************************
+; D. Shea
+;      convert WRF character variable "Times" to 
+;      a coordinate variable of type double 
+;      time(double) =              yyyymmddhhmnss
+;      2001-06-11_12:00:00     ==> 20010611120000
+;
+;      opt: currently not used [dummy]
+;
+undef ("WRF_Times2double_c")
+function WRF_Times2double_c(Times:character, opt)
+local dimT, rank, N, time, i, tmp_c
+begin
+  dimT   = dimsizes(Times)
+  rank   = dimsizes(dimT)
+  if (rank.ne.2) then
+      print("===> WRF_contributed.ncl: WRF_Times2Udunits_c expects 2D array: rank="+rank)
+      exit
+  end if
+
+  N      = dimT(0)
+
+  Time   = new( N ,"double") ; preset to "double"
+  delete(Time@_FillValue)    ; coord variables should not have a _FillValue
+
+  Time   = stringtointeger((/Times(:,0:3)/))  *1d10 + \  ; yyyy
+           stringtointeger((/Times(:,5:6)/))  *1d8  + \  ; mm
+           stringtointeger((/Times(:,8:9)/))  *1d6  + \  ; dd
+           stringtointeger((/Times(:,11:12)/))*1d4  + \  ; hh
+           stringtointeger((/Times(:,14:15)/))*1d2  + \  ; mn
+           stringtointeger((/Times(:,17:18)/))*1d0       ; ss
+
+  Time!0          = "Time"
+  Time@long_name  = "Time"
+  Time@description= "Time"
+  Time@units      = "yyyymmddhhmnss"
+  Time&Time       =  Time        ; make coordinate variable
+  return (Time)
+end 
+;*************************************************************************
+; D. Shea
+;      interface to WRF_Times2double_c
+;      more explicit function name
+undef ("WRF_Times_to_ymdhms")
+function WRF_Times_to_ymdhms(Times:character, opt)
+begin
+  return( WRF_Times2double_c(Times, 0) )    ; old name 
+end
+
+;*************************************************************************
+; D. Shea
+;      convert WRF character variable "Times" to 
+;      a coordinate variable of type integer 
+;      time(integer)=              yyyymmddhh   [->ymdh]
+;      2001-06-11_12:00:00     ==> 2001061112
+;
+;      Note: mminute and second are not part of the returned time
+;
+;      opt: currently not used [dummy]
+;
+undef ("WRF_Times_to_ymdh")
+function WRF_Times_to_ymdh(Times:character, opt)
+local dimT, rank, N, time, i, tmp_c
+begin
+  dimT   = dimsizes(Times)
+  rank   = dimsizes(dimT)
+  if (rank.ne.2) then
+      print("===> WRF_contributed.ncl: WRF_Times2yyyymmddhh expects 2D array: rank="+rank)
+      exit
+  end if
+
+  N      = dimT(0)
+
+  Time   = new( N ,"integer") 
+  delete(Time@_FillValue)    ; coord variables should not have a _FillValue
+
+  Time   = stringtointeger((/Times(:,0:3)/))  *1000000 + \  ; yyyy
+           stringtointeger((/Times(:,5:6)/))  *10000   + \  ; mm
+           stringtointeger((/Times(:,8:9)/))  *100     + \  ; dd
+           stringtointeger((/Times(:,11:12)/))              ; hh
+
+  Time!0          = "Time"
+  Time@long_name  = "Time"
+  Time@description= "Time"
+  Time@units      = "yyyymmddhh"
+  Time&Time       =  Time        ; make coordinate variable
+  return (Time)
+end 
+
+;*************************************************************************
+; D. Shea
+; This is a driver that selects the appropriate 
+; mapping function based upon the file attribute: MAP_PROJ
+; MAP_PROJ=1 [Lambert Conformal]; =2 [Stereographic]; =3 [Mercator]
+;
+; opt: currently not used [potentail use: time counter for XLAT/XLONG]
+;
+; Sample usage:
+;             ncdf = addfile("...", r")
+;             res  = True
+;             WRF_map_c (ncdf, res, 0)
+;             res  = ...
+;
+undef("WRF_map_c")
+procedure WRF_map_c (f:file, res:logical, opt)
+local rank, dimll, nlat, mlon, lat2d, lon2d
+begin
+  if (isatt(f,"MAP_PROJ")) then
+      if (f@MAP_PROJ.eq.1) then
+          res@mpProjection = "LambertConformal"
+      end if
+      if (f@MAP_PROJ.eq.2) then
+          res@mpProjection = "Stereographic"
+       end if
+      if (f@MAP_PROJ.eq.3) then
+          res@mpProjection = "Mercator"
+      end if
+  else
+      print ("WRF_mapProj: no MAP_PROJ attribute")
+  end if
+
+  rank  = dimsizes(filevardimsizes(f,"XLAT")) ; # of dimensions
+  if (rank.eq.3) then
+      lat2d = f->XLAT(0,:,:)       ; opt could bt "nt"  f->XLAT(opt,:,:)
+      lon2d = f->XLONG(0,:,:)
+  else
+    if (rank.eq.2) then
+        lat2d = f->XLAT
+        lon2d = f->XLONG
+    else
+        print ("WRF_resLamCon_c: unexpected lat/lon rank: rank="+rank)
+        exit
+    end if
+  end if
+
+  lat2d@units = "degrees_north"    ; not needed
+  lon2d@units = "degrees_east"
+
+  dimll = dimsizes(lat2d)
+  nlat  = dimll(0)
+  mlon  = dimll(1)
+
+  res@mpLimitMode            = "Corners"  
+  res@mpLeftCornerLatF       = lat2d(0,0)
+  res@mpLeftCornerLonF       = lon2d(0,0)
+  res@mpRightCornerLatF      = lat2d(nlat-1,mlon-1)
+  res@mpRightCornerLonF      = lon2d(nlat-1,mlon-1)
+
+  res@mpCenterLonF           = f@CEN_LON
+  res@mpCenterLatF           = f@CEN_LAT        ; default
+
+  if (res@mpProjection.eq."Mercator") then
+      res@mpCenterLatF = 0.0    ; Cindy Bruyere MMM/WRF 24 Mar 2006
+  end if
+
+  if (res@mpProjection.eq."LambertConformal") then
+      res@mpLambertParallel1F    = f@TRUELAT1
+      res@mpLambertParallel2F    = f@TRUELAT2
+      if (isatt(f, "STAND_LON") ) then
+          res@mpLambertMeridianF = f@STAND_LON  ; use if present
+                                                ; CB MMM/WRF 4 Aug 2006
+      else
+          if (isatt(f, "CEN_LON") ) then
+              res@mpLambertMeridianF    = f@CEN_LON
+          else
+              print("WRF_map_c: STAND_LON and CEN_LON missing")
+          end if
+      end if
+  end if
+
+  res@mpFillOn              = False            ; turn off map fill
+  res@mpOutlineDrawOrder    = "PostDraw"       ; draw continental outline last
+  res@mpOutlineBoundarySets = "GeophysicalAndUSStates" ; state boundaries
+  res@mpPerimDrawOrder      = "PostDraw"       ; force map perim
+                                               ; commented 5/17/2007 
+;;res@tfDoNDCOverlay        = True             ; True for 'native' grid
+                                               ; some WRF are not native
+  res@gsnAddCyclic          = False            ; data are not cyclic
+end 
+
+;*************************************************************************
+; D. Shea
+; interface for backward compatibility
+undef("WRF_resLamCon_c")
+procedure WRF_resLamCon_c (f:file, res:logical, opt)
+begin
+  WRF_map_c (f, res, opt)
+end
+
+;*************************************************************************
+; D. Shea
+; interface for newly named procedure
+undef("wrf_mapres_c")
+procedure wrf_mapres_c(f:file, res:logical, opt)
+begin
+  WRF_map_c (f, res, opt)
+end
+;************************************************************************* 
+; D. Shea                                                    
+; single interface to convert WRF character variable "Times"
+; to user specified numeric values               
+;
+; M. Haley
+; At some point we decided to rename this from WRF_Times to wrf_times_c
+; Also added error check for opt.
+;
+undef ("wrf_times_c")                             
+function wrf_times_c(Times:character, opt:integer)
+begin                                          
+   if (opt.ge.0 .and. opt.le.1) then 
+       return(WRF_Times2Udunits_c(Times, opt) ) 
+   end if
+
+   if (opt.eq.2) then
+       return(WRF_Times2double_c(Times, opt) )
+   end if                                    
+
+   if (opt.eq.3) then 
+       return(WRF_Times_to_ymdh(Times, opt) ) 
+   end if  
+end       

wrf_open/var/ncl_reference/calc_uh.f90

@@ -0,0 +1,158 @@
+! For NCL graphics:
+! WRAPIT -m64 calc_uh90.stub calc_uh.f90
+! This should create a shared library named "calc_uh90.so".
+
+!##################################################################
+!##################################################################
+!######                                                      ######
+!######                  SUBROUTINE CALC_UH                  ######
+!######                                                      ######
+!######                     Developed by                     ######
+!######     Center for Analysis and Prediction of Storms     ######
+!######                University of Oklahoma                ######
+!######                                                      ######
+!##################################################################
+!##################################################################
+!
+!  Calculates updraft helicity (UH) to detect rotating updrafts.
+!  Formula follows Kain et al, 2008, Wea. and Forecasting, 931-952,
+!  but this version has controls for the limits of integration
+!  uhminhgt to uhmxhgt, in m AGL.  Kain et al used 2000 to 5000 m.
+!  Units of UH are m^2/s^2.
+!
+!  Note here that us and vs are at ARPS scalar points.
+!  w is at w-point (scalar pt in horiz, staggered vertical)
+!
+!  Keith Brewster, CAPS/Univ. of Oklahoma
+!  March, 2010
+!
+!   uh = wrf_updraft_helicity(zp,us,vs,w, 
+SUBROUTINE dcalcuh(nx,ny,nz,nzp1,zp,mapfct,dx,dy,uhmnhgt,uhmxhgt,        &
+                   us,vs,w,uh,tem1,tem2)
+  IMPLICIT NONE
+  INTEGER, INTENT(IN) :: nx,ny,nz,nzp1
+  DOUBLE PRECISION, INTENT(IN)  :: zp(nx,ny,nzp1)
+  DOUBLE PRECISION, INTENT(IN)  :: mapfct(nx,ny)
+  DOUBLE PRECISION, INTENT(IN)  :: dx,dy
+  DOUBLE PRECISION, INTENT(IN)  :: uhmnhgt,uhmxhgt
+  DOUBLE PRECISION, INTENT(IN)  :: us(nx,ny,nz)
+  DOUBLE PRECISION, INTENT(IN)  :: vs(nx,ny,nz)
+  DOUBLE PRECISION, INTENT(IN)  :: w(nx,ny,nzp1)
+  DOUBLE PRECISION, INTENT(OUT) :: uh(nx,ny)
+  DOUBLE PRECISION, INTENT(OUT) :: tem1(nx,ny,nz)
+  DOUBLE PRECISION, INTENT(OUT) :: tem2(nx,ny,nz)
+!
+! Misc local variables
+!
+  INTEGER :: i,j,k,kbot,ktop
+  DOUBLE PRECISION    :: twodx,twody,wgtlw,sum,wmean,wsum,wavg
+  DOUBLE PRECISION    :: helbot,heltop,wbot,wtop
+  DOUBLE PRECISION    :: zbot,ztop
+!
+! Initialize arrays
+!
+  uh=0.0
+  tem1=0.0
+!
+! Calculate vertical component of helicity at scalar points
+!   us: u at scalar points
+!   vs: v at scalar points
+!
+  twodx=2.0*dx
+  twody=2.0*dy
+  DO k=2,nz-2
+    DO j=2,ny-1
+      DO i=2,nx-1
+        wavg=0.5*(w(i,j,k)+w(i,j,k+1))
+        tem1(i,j,k)=wavg *                                      &
+            ((vs(i+1,j,k)-vs(i-1,j,k))/(twodx*mapfct(i,j))  -   &
+             (us(i,j+1,k)-us(i,j-1,k))/(twody*mapfct(i,j)))
+        tem2(i,j,k)=0.5*(zp(i,j,k)+zp(i,j,k+1))
+      END DO
+    END DO
+  END DO
+!
+! Integrate over depth uhminhgt to uhmxhgt AGL
+!
+!  WRITE(6,'(a,f12.1,a,f12.1,a)') &
+!        'Calculating UH from ',uhmnhgt,' to ',uhmxhgt,' m AGL'
+  DO j=2,ny-2
+    DO i=2,nx-2
+      zbot=zp(i,j,2)+uhmnhgt
+      ztop=zp(i,j,2)+uhmxhgt
+!
+! Find wbar, weighted-mean vertical velocity in column
+! Find w at uhmnhgt AGL (bottom)
+!
+      DO k=2,nz-3
+        IF(zp(i,j,k) > zbot) EXIT
+      END DO
+      kbot=k
+      wgtlw=(zp(i,j,kbot)-zbot)/(zp(i,j,kbot)-zp(i,j,kbot-1))
+      wbot=(wgtlw*w(i,j,kbot-1))+((1.-wgtlw)*w(i,j,kbot))
+!
+! Find w at uhmxhgt AGL (top)
+!
+      DO k=2,nz-3
+        IF(zp(i,j,k) > ztop) EXIT
+      END DO
+      ktop=k
+      wgtlw=(zp(i,j,ktop)-ztop)/(zp(i,j,ktop)-zp(i,j,ktop-1))
+      wtop=(wgtlw*w(i,j,ktop-1))+((1.-wgtlw)*w(i,j,ktop))
+!
+! First part, uhmnhgt to kbot
+!
+      wsum=0.5*(w(i,j,kbot)+wbot)*(zp(i,j,kbot)-zbot)
+!
+! Integrate up through column
+!
+      DO k=(kbot+1),(ktop-1)
+        wsum=wsum+0.5*(w(i,j,k)+w(i,j,k-1))*(zp(i,j,k)-zp(i,j,k-1))
+      END DO
+!
+! Last part, ktop-1 to uhmxhgt
+!
+      wsum=wsum+0.5*(wtop+w(i,j,ktop-1))*(ztop-zp(i,j,ktop-1))
+      wmean=wsum/(uhmxhgt-uhmnhgt)
+
+      IF(wmean > 0.) THEN    ! column updraft, not downdraft
+!
+! Find helicity at uhmnhgt AGL (bottom)
+!
+        DO k=2,nz-3
+          IF(tem2(i,j,k) > zbot) EXIT
+        END DO
+        kbot=k
+        wgtlw=(tem2(i,j,kbot)-zbot)/(tem2(i,j,kbot)-tem2(i,j,kbot-1))
+        helbot=(wgtlw*tem1(i,j,kbot-1))+((1.-wgtlw)*tem1(i,j,kbot))
+!
+! Find helicity at uhmxhgt AGL (top)
+!
+        DO k=2,nz-3
+          IF(tem2(i,j,k) > ztop) EXIT
+        END DO
+        ktop=k
+        wgtlw=(tem2(i,j,ktop)-ztop)/(tem2(i,j,ktop)-tem2(i,j,ktop-1))
+        heltop=(wgtlw*tem1(i,j,ktop-1))+((1.-wgtlw)*tem1(i,j,ktop))
+!
+! First part, uhmnhgt to kbot
+!
+        sum=0.5*(tem1(i,j,kbot)+helbot)*(tem2(i,j,kbot)-zbot)
+!
+! Integrate up through column
+!
+        DO k=(kbot+1),(ktop-1)
+          sum=sum+0.5*(tem1(i,j,k)+tem1(i,j,k-1))*(tem2(i,j,k)-tem2(i,j,k-1))
+        END DO
+!
+! Last part, ktop-1 to uhmxhgt
+!
+        uh(i,j)=sum+0.5*(heltop+tem1(i,j,ktop-1))*(ztop-tem2(i,j,ktop-1))
+      END IF
+    END DO
+  END DO
+
+  uh = uh * 1000.   ! Scale according to Kain et al. (2008)
+
+  RETURN
+END SUBROUTINE dcalcuh

wrf_open/var/ncl_reference/eqthecalc.f

@@ -0,0 +1,72 @@
+      SUBROUTINE DEQTHECALC(QVP,TMK,PRS,ETH,MIY,MJX,MKZH)
+      DOUBLE PRECISION EPS
+      DOUBLE PRECISION RGAS
+      DOUBLE PRECISION RGASMD
+      DOUBLE PRECISION CP
+      DOUBLE PRECISION CPMD
+      DOUBLE PRECISION GAMMA
+      DOUBLE PRECISION GAMMAMD
+      DOUBLE PRECISION TLCLC1
+      DOUBLE PRECISION TLCLC2
+      DOUBLE PRECISION TLCLC3
+      DOUBLE PRECISION TLCLC4
+      DOUBLE PRECISION THTECON1
+      DOUBLE PRECISION THTECON2
+      DOUBLE PRECISION THTECON3
+      DOUBLE PRECISION Q
+      DOUBLE PRECISION T
+      DOUBLE PRECISION P
+      DOUBLE PRECISION E
+      DOUBLE PRECISION TLCL
+c
+c Input variables
+c Qvapor [g/kg]
+      DOUBLE PRECISION QVP(MIY,MJX,MKZH)
+c Temperature [K]
+      DOUBLE PRECISION TMK(MIY,MJX,MKZH)
+c full pressure (=P+PB) [hPa]
+      DOUBLE PRECISION PRS(MIY,MJX,MKZH)
+c
+c Output variable
+c equivalent potential temperature [K]
+      DOUBLE PRECISION ETH(MIY,MJX,MKZH)
+c
+c parameters
+      PARAMETER (EPS=0.622D0)
+
+c J/K/kg
+      RGAS = 287.04D0
+c rgas_moist=rgas*(1.+rgasmd*qvp)
+      RGASMD = .608D0
+c J/K/kg  Note: not using Bolton's value of 1005.7
+      CP = 1004.D0
+c cp_moist=cp*(1.+cpmd*qvp)
+      CPMD = .887D0
+      GAMMA = RGAS/CP
+c gamma_moist=gamma*(1.+gammamd*qvp)
+      GAMMAMD = RGASMD - CPMD
+
+      TLCLC1 = 2840.D0
+      TLCLC2 = 3.5D0
+      TLCLC3 = 4.805D0
+      TLCLC4 = 55.D0
+c K
+      THTECON1 = 3376.D0
+      THTECON2 = 2.54D0
+      THTECON3 = .81D0
+c
+      DO 1000 K = 1,MKZH
+          DO 1000 J = 1,MJX
+              DO 1000 I = 1,MIY
+                  Q = MAX(QVP(I,J,K),1.D-15)
+                  T = TMK(I,J,K)
+                  P = PRS(I,J,K)/100.
+                  E = Q*P/ (EPS+Q)
+                  TLCL = TLCLC1/ (LOG(T**TLCLC2/E)-TLCLC3) + TLCLC4
+                  ETH(I,J,K) = T* (1000.D0/P)**
+     +                         (GAMMA* (1.D0+GAMMAMD*Q))*
+     +                         EXP((THTECON1/TLCL-THTECON2)*Q*
+     +                         (1.D0+THTECON3*Q))
+ 1000 CONTINUE
+      RETURN
+      END

wrf_open/var/ncl_reference/rcm2points.f

@@ -0,0 +1,215 @@
+c ----------------------------------------------------------- 
+C NCLFORTSTART
+      SUBROUTINE DRCM2POINTS(NGRD,NYI,NXI,YI,XI,FI,NXYO,YO,XO,FO
+     +                      ,XMSG,OPT,NCRIT,KVAL,IER)
+      IMPLICIT NONE
+      INTEGER NGRD,NXI,NYI,NXYO,OPT,NCRIT,KVAL,IER
+      DOUBLE PRECISION XI(NXI,NYI),YI(NXI,NYI),FI(NXI,NYI,NGRD)
+      DOUBLE PRECISION XO(NXYO),YO(NXYO),FO(NXYO,NGRD),XMSG
+C NCLEND
+
+C This is written  with GNU f77 acceptable extensions
+c .   This could be improved considerably with f90
+
+c nomenclature:
+c .   nxi,nyi - lengths of xi,yi and dimensions of fi (must be >= 2)
+c .   xi      - coordinates of fi (eg, lon [2D] )
+c .   yi      - coordinates of fi (eg, lat [2D] )
+c .   fi      - functional input values [2D]
+c .   nxyo    - number of output points
+c .   xo      - lon coordinates of fo (eg, lon [1D])
+c .   yo      - lat coordinates of fo (eg, lat [1D])
+c .   fo      - functional output values [interpolated]
+c .   xmsg    - missing code
+c .   opt     - 0/1 = inv distance, 2 = bilinear
+c .   ier     - error code
+c .             =0;   no error
+c .             =1;   not enough points in input/output array
+c .             =2/3; xi or yi are not monotonically increasing
+c .             =4/5; xo or yo are not monotonically increasing
+c
+c                              local
+      INTEGER NG,NX,NY,NXY,NEXACT,IX,IY,M,N,NW,NER,K
+      DOUBLE PRECISION FW(2,2),W(2,2),SUMF,SUMW,CHKLAT(NYI),CHKLON(NXI)
+      DOUBLE PRECISION DGCDIST, WX, WY
+      DOUBLE PRECISION REARTH, DLAT, PI, RAD, DKM, DIST 
+c                              error checking
+      IER = 0
+      IF (NXI.LE.1 .OR. NYI.LE.1 .OR. NXYO.LE.0) THEN
+          IER = 1
+          RETURN
+      END IF
+      IF (IER.NE.0) RETURN
+
+      DO NY = 1,NYI
+          CHKLAT(NY) = YI(1,NY)
+c c c    print *,"chklat: ny=",ny,"  chklat=",chklat(ny)
+      END DO
+      CALL DMONOINC(CHKLAT,NYI,IER,NER)
+      IF (IER.NE.0) RETURN
+
+      DO NX = 1,NXI
+          CHKLON(NX) = XI(NX,1)
+c c c    print *,"chklon: nx=",nx,"  chklon=",chklon(nx)
+      END DO
+      CALL DMONOINC(CHKLAT,NYI,IER,NER)
+      IF (IER.NE.0) RETURN
+
+C ORIGINAL  (k = op, never implemented)
+      IF (KVAL.LE.0) THEN
+         K = 1
+      ELSE
+         K = KVAL
+      END IF
+      DO NG = 1,NGRD
+        DO NXY = 1,NXYO
+           FO(NXY,NG) = XMSG
+        END DO
+      END DO
+c                              main loop [exact matches]
+      NEXACT = 0
+      DO NXY = 1,NXYO
+
+          DO IY = 1,NYI
+              DO IX = 1,NXI
+                  IF (XO(NXY).EQ.XI(IX,IY) .AND.
+     +                YO(NXY).EQ.YI(IX,IY)) THEN
+                      DO NG = 1,NGRD
+                         FO(NXY,NG) = FI(IX,IY,NG)
+                         NEXACT     = NEXACT + 1
+                      END DO
+                      GO TO 10
+                  END IF
+              END DO
+          END DO
+
+   10     CONTINUE
+      END DO
+
+c c c print *, "nexact=",nexact
+c                              main loop [interpolation]
+      DO NXY = 1,NXYO
+
+              DO IY = 1,NYI - K
+                DO IX = 1,NXI - K
+                   IF (XO(NXY).GE.XI(IX,IY) .AND.
+     +                 XO(NXY).LE.XI(IX+K,IY) .AND.
+     +                 YO(NXY).GE.YI(IX,IY) .AND.
+     +                 YO(NXY).LE.YI(IX,IY+K)) THEN
+
+                   IF (ABS(OPT).EQ.2) THEN
+                       WX = (XO(NXY)-XI(IX,IY))/
+     +                      (XI(IX+K,IY)-XI(IX,IY))
+                       WY = (YO(NXY)-YI(IX,IY))/
+     +                      (YI(IX,IY+K)-YI(IX,IY))
+                       W(1,1) = (1.D0-WX)*(1.D0-WY)
+                       W(2,1) = WX*(1.D0-WY)
+                       W(1,2) = (1.D0-WX)*WY
+                       W(2,2) = WX*WY
+                   ELSE
+                       W(1,1) = (1.D0/DGCDIST(YO(NXY),XO(NXY),
+     +                           YI(IX,IY),XI(IX,IY),2))**2
+                       W(2,1) = (1.D0/DGCDIST(YO(NXY),XO(NXY),
+     +                           YI(IX+K,IY),XI(IX+K,IY),2))**2
+                       W(1,2) = (1.D0/DGCDIST(YO(NXY),XO(NXY),
+     +                           YI(IX,IY+K),XI(IX,IY+K),2))**2
+                       W(2,2) = (1.D0/DGCDIST(YO(NXY),XO(NXY),
+     +                           YI(IX+K,IY+K),XI(IX+K,IY+K),2))**2
+                   END IF
+
+                   DO NG = 1,NGRD
+                      IF (FO(NXY,NG).EQ.XMSG) THEN
+                          
+                          FW(1,1) = FI(IX,IY,NG)
+                          FW(2,1) = FI(IX+K,IY,NG)
+                          FW(1,2) = FI(IX,IY+K,NG)
+                          FW(2,2) = FI(IX+K,IY+K,NG)
+
+                          NW = 0
+                          SUMF = 0.0D0
+                          SUMW = 0.0D0
+                          DO N = 1,2
+                              DO M = 1,2
+                                  IF (FW(M,N).NE.XMSG) THEN
+                                      SUMF = SUMF + FW(M,N)*W(M,N)
+                                      SUMW = SUMW + W(M,N)
+                                      NW = NW + 1
+                                  END IF
+                              END DO
+                          END DO
+c                                             nw >=3 arbitrary
+                          IF (NW.GE.NCRIT .AND. SUMW.GT.0.D0) THEN
+                              FO(NXY,NG) = SUMF/SUMW
+                          END IF
+                      END IF
+                    END DO
+                    GO TO 20
+                  END IF
+                END DO
+              END DO
+
+   20         CONTINUE
+      END DO
+
+C Are all the output points filled in? Check the 1st grid
+C If so, return
+
+      DO NG = 1,NGRD   
+        DO NXY = 1,NXYO
+           IF (FO(NXY,NG).EQ.XMSG) GO TO 30
+        END DO
+      END DO
+      RETURN
+
+C only enter if some points are not interpolated to
+C DLAT is arbitrary.  It ould be made an option.
+C DLAT is expressed in terms of degrees of latitude.
+C DKM  is DLAT in KILOMETERS
+
+   30 REARTH= 6371D0
+      DLAT  = 5  
+      PI    = 4D0*ATAN(1.0D0)
+      RAD   = PI/180D0
+      DKM   = DLAT*(2D0*PI*REARTH)/360D0
+
+C LOOP OVER EACH GRID ... INEFFICIENT 
+C THE RUB IS THAT SOME LEVELS COULD HAVE XMSG.
+
+      DO NG = 1,NGRD   
+
+        DO NXY = 1,NXYO
+           IF(FO(NXY,NG).EQ.XMSG) THEN
+
+C FIND ALL GRID POINTS WITHIN 'DKM' KILOMETERS OF PT 
+
+              NW   = 0
+              SUMF = 0.0D0
+              SUMW = 0.0D0
+
+              DO IY = 1,NYI
+                DO IX = 1,NXI
+                   IF ((YI(IX,IY).GE.YO(NXY)-DLAT)  .AND.
+     +                 (YI(IX,IY).LE.YO(NXY)+DLAT)) THEN      
+                        DIST = DGCDIST(YO(NXY),XO(NXY) 
+     +                                ,YI(IX,IY),XI(IX,IY),2)
+                        IF (DIST.LE.DKM .AND. DIST.GT.0.0D0 .AND.
+     +                      FI(IX,IY,NG).NE.XMSG) THEN
+                            DIST = 1.0D0/DIST**2
+                            SUMF = SUMF + FI(IX,IY,NG)*DIST
+                            SUMW = SUMW + DIST
+                            NW   = NW + 1
+                        END IF
+                   END IF
+                END DO
+              END DO
+
+C C C         IF (NW.GE.NCRIT .AND. SUMW.GT. 0.0D0) THEN
+              IF (SUMW.GT.0.0D0) THEN
+                  FO(NXY,NG) = SUMF/SUMW
+              END IF
+           END IF
+        END DO
+      END DO
+
+      RETURN
+      END

wrf_open/var/ncl_reference/rcm2rgrid.f

@@ -0,0 +1,376 @@
+C NCLFORTSTART
+      SUBROUTINE DRCM2RGRID(NGRD,NYI,NXI,YI,XI,FI,NYO,YO,NXO,XO,FO
+     +                      ,XMSG,NCRIT,OPT,IER)
+      IMPLICIT NONE
+      INTEGER          NGRD,NXI,NYI,NXO,NYO,NCRIT,OPT,IER
+      DOUBLE PRECISION XI(NXI,NYI),YI(NXI,NYI),FI(NXI,NYI,NGRD)
+      DOUBLE PRECISION XO(NXO),YO(NYO),FO(NXO,NYO,NGRD),XMSG
+C NCLEND
+
+C This is written  with GNU f77 acceptable extensions
+c .   This could be improved considerably with f90
+
+c NCL:  fo = rcm2rgrid (lat2d,lon2d,fi, lat, lon iopt)
+c                        yi    xi   fi  yo   xo
+c
+c            fo is the same size xo, yo and same type as "fi"
+c            xmsg = fi@_FillValue
+c            opt unused option
+c
+c            The NCL wrapper should allow for multiple datasets
+c            so the user need only make one call to the function.
+
+c perform 2D interpolation allowing for missing data:  nothing fancy
+
+c nomenclature:
+c .   nxi,nyi - lengths of xi,yi and dimensions of fi (must be >= 2)
+c .   xi      - coordinates of fi (eg, lon [2D] )
+c .   yi      - coordinates of fi (eg, lat [2D] )
+c .   fi      - functional input values [2D]
+c .   nxo,nyo - lengths of xo,yo and dimensions of fo (must be >= 1)
+c .   xo      - coordinates of fo (eg, lon [1D])
+c .             must be monotonically increasing
+c .   yo      - coordinates of fo (eg, lat [1D])
+c .             must be monotonically increasing
+c .   fo      - functional output values [interpolated]
+c .   xmsg    - missing code
+c .   opt     - unused
+c .   ier     - error code
+c .             =0;   no error
+c .             =1;   not enough points in input/output array
+c .             =2/3; xi or yi are not monotonically increasing
+c .             =4/5; xo or yo are not monotonically increasing
+c
+c                              local
+      INTEGER          NG, NX,NY,NEXACT,IX,IY,M,N,NW,NER,K,NCRT
+      INTEGER          MFLAG, MPTCRT, MKNT
+      DOUBLE PRECISION FW(2,2),W(2,2),SUMF,SUMW,CHKLAT(NYI),CHKLON(NXI)
+      DOUBLE PRECISION EPS
+      DOUBLE PRECISION DGCDIST
+c                              error checking
+      IER = 0
+      IF (NXI.LE.1 .OR. NYI.LE.1 .OR. NXO.LE.1 .OR. NYO.LE.1) THEN
+          IER = 1
+          RETURN
+      END IF
+      IF (IER.NE.0) RETURN
+
+      CALL DMONOINC(YO,NYO,IER,NER)
+      IF (IER.NE.0) RETURN
+      CALL DMONOINC(XO,NXO,IER,NER)
+      IF (IER.NE.0) RETURN
+
+      DO NY = 1,NYI
+         CHKLAT(NY) = YI(1,NY)
+c c c    print *,"chklat: ny=",ny,"  chklat=",chklat(ny)
+      END DO
+      CALL DMONOINC(CHKLAT,NYI,IER,NER)
+      IF (IER.NE.0) RETURN
+
+      DO NX = 1,NXI
+         CHKLON(NX) = XI(NX,1)
+c c c    print *,"chklon: nx=",nx,"  chklon=",chklon(nx)
+      END DO
+      CALL DMONOINC(CHKLAT,NYI,IER,NER)
+      IF (IER.NE.0) RETURN
+
+      K = 2
+c c c k = opt
+
+      IF (NCRIT.LE.1) THEN
+          NCRT = 1
+      ELSE
+          NCRT = MIN(4,NCRIT)
+      END IF
+c                              initialize to xmsg
+      DO NG=1,NGRD      
+         DO NY = 1,NYO
+            DO NX = 1,NXO
+               FO(NX,NY,NG) = XMSG
+            END DO
+         END DO
+      END DO
+c                              main loop [exact matches]
+c                              people want bit-for-bit match
+      EPS    = 1.D-04
+      NEXACT = 0
+
+      DO NY = 1,NYO
+        DO NX = 1,NXO
+           DO IY = 1,NYI
+              DO IX = 1,NXI
+                 IF (XO(NX).GE.(XI(IX,IY)-EPS) .AND.
+     +                XO(NX).LE.(XI(IX,IY)+EPS) .AND.
+     +                YO(NY).GE.(YI(IX,IY)-EPS) .AND.
+     +                YO(NY).LE.(YI(IX,IY)+EPS) ) THEN
+                    
+                    DO NG=1,NGRD
+                       FO(NX,NY,NG) = FI(IX,IY,NG)
+                       NEXACT = NEXACT + 1
+                    END DO
+                    GO TO 10
+                 END IF
+              END DO
+           END DO
+           
+ 10        CONTINUE
+        END DO
+      END DO
+
+c c c print *, "nexact=",nexact
+c                              main loop [interpolation]
+      DO NY = 1,NYO
+        DO NX = 1,NXO
+
+               DO IY = 1,NYI-K
+                 DO IX = 1,NXI-K
+                    IF (XO(NX).GE.XI(IX,IY) .AND.
+     +                  XO(NX).LE.XI(IX+K,IY) .AND.
+     +                  YO(NY).GE.YI(IX,IY) .AND.
+     +                  YO(NY).LE.YI(IX,IY+K)) THEN
+
+
+                        W(1,1) = (1.D0/DGCDIST(YO(NY),XO(NX),
+     +                            YI(IX,IY),XI(IX,IY),2))**2
+                        W(2,1) = (1.D0/DGCDIST(YO(NY),XO(NX),
+     +                            YI(IX+K,IY),XI(IX+K,IY),2))**2
+                        W(1,2) = (1.D0/DGCDIST(YO(NY),XO(NX),
+     +                            YI(IX,IY+K),XI(IX,IY+K),2))**2
+                        W(2,2) = (1.D0/DGCDIST(YO(NY),XO(NX),
+     +                            YI(IX+K,IY+K),XI(IX+K,IY+K),2))**2
+                      DO NG=1,NGRD
+                        IF (FO(NX,NY,NG).EQ.XMSG) THEN
+                            FW(1,1) = FI(IX,IY,NG)
+                            FW(2,1) = FI(IX+K,IY,NG)
+                            FW(1,2) = FI(IX,IY+K,NG)
+                            FW(2,2) = FI(IX+K,IY+K,NG)
+
+                            NW   = 0
+                            SUMF = 0.0D0
+                            SUMW = 0.0D0
+                            DO N = 1,2
+                              DO M = 1,2
+                                 IF (FW(M,N).NE.XMSG) THEN
+                                     SUMF = SUMF + FW(M,N)*W(M,N)
+                                     SUMW = SUMW + W(M,N)
+                                     NW   = NW + 1
+                                 END IF
+                              END DO
+                            END DO
+c                                             nw >=3 arbitrary
+c c c                       IF (NW.GE.3 .AND. SUMW.GT.0.D0) THEN
+c                                             nw =1 nearest neighbor
+                            IF (NW.GE.NCRT .AND. SUMW.GT.0.D0) THEN
+                                FO(NX,NY,NG) = SUMF/SUMW
+                            END IF
+                        END IF
+                      END DO
+                      GO TO 20
+                   END IF
+                 END DO
+               END DO
+   20          CONTINUE
+       END DO
+      END DO
+
+C Since the RCM grid is curvilinear the above algorithm may not work 
+C .   for all of the locations on regular grid. Fill via linear interp.
+
+      MKNT   =  0
+      MFLAG  =  0
+      MPTCRT =  2
+      DO NG=1,NGRD
+        DO NY=1,NYO
+          DO NX=1,NXO
+             IF (FO(NX,NY,NG).EQ.XMSG) THEN
+                 CALL DLINMSG(FO(1,NY,NG),NXO,XMSG,MFLAG,MPTCRT)
+                 MKNT = MKNT + 1
+             END IF
+          END DO
+        END DO
+      END DO
+
+C C C PRINT *,"MKNT=",MKNT
+
+      RETURN
+      END
+c -----------------------------------------------------------
+C NCLFORTSTART
+      SUBROUTINE DRGRID2RCM(NGRD,NYI,NXI,YI,XI,FI,NYO,NXO,YO,XO,FO
+     +                     ,XMSG,NCRIT,OPT,IER)
+      IMPLICIT NONE
+      INTEGER          NGRD,NXI,NYI,NXO,NYO,OPT,NCRIT,IER
+      DOUBLE PRECISION XI(NXI),YI(NYI),FI(NXI,NYI,NGRD)
+      DOUBLE PRECISION XO(NXO,NYO),YO(NXO,NYO),FO(NXO,NYO,NGRD),XMSG
+C NCLEND
+
+C This is written  with GNU f77 acceptable extensions
+c .   This could be improved considerably with f90
+
+c            fo is the same size xo, yo and same type as "fi"
+c            xmsg = fi@_FillValue
+c            opt unused option
+c
+c            The NCL wrapper should allow for multiple datasets
+c            so the user need only make one call to the function.
+
+c perform 2D interpolation allowing for missing data:  nothing fancy
+
+c nomenclature:
+c .   nxi,nyi - lengths of xi,yi and dimensions of fi (must be >= 2)
+c .   xi      - coordinates of fi (eg, lon [1D])
+c .   yi      - coordinates of fi (eg, lat [1D])
+c .   fi      - functional input values [2D]
+c .   nxo,nyo - lengths of xo,yo and dimensions of fo (must be >= 1)
+c .   xo      - coordinates of fo (eg, lon [2D])
+c .             must be monotonically increasing
+c .   yo      - coordinates of fo (eg, lat [2D])
+c .             must be monotonically increasing
+c .   fo      - functional output values [interpolated]
+c .   xmsg    - missing code
+c .   opt     - unused
+c .   ier     - error code
+c .             =0;   no error
+c .             =1;   not enough points in input/output array
+c .             =2/3; xi or yi are not monotonically increasing
+c .             =4/5; xo or yo are not monotonically increasing
+c
+c                              local
+      INTEGER          NG,NX,NY,NEXACT,IX,IY,M,N,NW,NER,K
+      DOUBLE PRECISION FW(2,2),W(2,2),SUMF,SUMW,EPS
+      DOUBLE PRECISION DGCDIST
+
+c                              in-line functions (bilinear interp)
+      DOUBLE PRECISION Z1,Z2,Z3,Z4,SLOPE,SLPX,SLPY,FLI,FBLI
+
+      FLI(Z1,Z2,SLOPE) = Z1 + SLOPE* (Z2-Z1)
+      FBLI(Z1,Z2,Z3,Z4,SLPX,SLPY) = FLI(Z1,Z2,SLPX) +
+     +                              SLPY* (FLI(Z3,Z4,SLPX)-
+     +                              FLI(Z1,Z2,SLPX))
+
+c                              error checking
+      IER = 0
+      IF (NXI.LE.1 .OR. NYI.LE.1 .OR. NXO.LE.1 .OR. NYO.LE.1) THEN
+          IER = 1
+          RETURN
+      END IF
+      IF (IER.NE.0) RETURN
+
+      CALL DMONOINC(YI,NYI,IER,NER)
+      IF (IER.NE.0) RETURN
+      CALL DMONOINC(XI,NXI,IER,NER)
+      IF (IER.NE.0) RETURN
+c                              Init to missing
+      DO NG = 1,NGRD
+        DO NY = 1,NYO
+          DO NX = 1,NXO
+             FO(NX,NY,NG) = XMSG
+          END DO
+        END DO
+      END DO
+c                              main loop [exact matches]
+      EPS    = 1.D-03
+      NEXACT = 0
+
+      DO NY = 1,NYO
+        DO NX = 1,NXO
+
+          DO IY = 1,NYI
+            DO IX = 1,NXI
+               IF (XO(NX,NY).GE.(XI(IX)-EPS) .AND.
+     +             XO(NX,NY).LE.(XI(IX)+EPS) .AND.
+     +             YO(NX,NY).GE.(YI(IY)-EPS) .AND.
+     +             YO(NX,NY).LE.(YI(IY)+EPS) ) THEN
+
+                   DO NG=1,NGRD
+                      FO(NX,NY,NG) = FI(IX,IY,NG)
+                      NEXACT = NEXACT + 1
+                   END DO
+                   GO TO 10
+                END IF
+            END DO
+          END DO
+
+   10      CONTINUE
+          END DO
+        END DO
+
+
+c c c print *, "nexact=",nexact
+
+      K = 1
+c c c k = opt
+
+c                              main loop [interpolation]
+      DO NY = 1,NYO
+        DO NX = 1,NXO
+
+          DO IY = 1,NYI - K
+            DO IX = 1,NXI - K
+               IF (XO(NX,NY).GE.XI(IX) .AND.
+     +             XO(NX,NY).LT.XI(IX+K) .AND.
+     +             YO(NX,NY).GE.YI(IY) .AND.
+     +             YO(NX,NY).LT.YI(IY+K)) THEN
+
+               DO NG = 1,NGRD
+                 IF (FO(NX,NY,NG).EQ.XMSG) THEN
+                   IF (FI(IX,IY,NG).NE.XMSG .AND.
+     +                 FI(IX+K,IY,NG).NE.XMSG .AND.
+     +                 FI(IX,IY+K,NG).NE.XMSG .AND.
+     +                 FI(IX+K,IY+K,NG).NE.XMSG) THEN
+
+                       FO(NX,NY,NG) =FBLI(FI(IX,IY,NG),FI(IX+K,IY,NG),
+     +                                  FI(IX,IY+K,NG),FI(IX+K,IY+K,NG),
+     +                                  (XO(NX,NY)-XI(IX))/
+     +                                  (XI(IX+K)-XI(IX)),
+     +                                  (YO(NX,NY)-YI(IY))/
+     +                                  (YI(IY+K)-YI(IY)))
+
+                   ELSE
+c                                            OVERKILL
+                       FW(1,1) = FI(IX,IY,NG)
+                       FW(2,1) = FI(IX+K,IY,NG)
+                       FW(1,2) = FI(IX,IY+K,NG)
+                       FW(2,2) = FI(IX+K,IY+K,NG)
+
+                       W(1,1) = (1.D0/DGCDIST(YO(NX,NY),XO(NX,NY)
+     +                          ,YI(IY),XI(IX),2))**2
+                       W(2,1) = (1.D0/DGCDIST(YO(NX,NY),XO(NX,NY)
+     +                          ,YI(IY),XI(IX+K),2))**2
+                       W(1,2) = (1.D0/DGCDIST(YO(NX,NY),XO(NX,NY)
+     +                          ,YI(IY+K),XI(IX),2))**2
+                       W(2,2) = (1.D0/DGCDIST(YO(NX,NY),XO(NX,NY)
+     +                          ,YI(IY+K),XI(IX+K),2))**2
+
+                       NW = 0
+                       SUMF = 0.0D0
+                       SUMW = 0.0D0
+                       DO N = 1,2
+                         DO M = 1,2
+                            IF (FW(M,N).NE.XMSG) THEN
+                                SUMF = SUMF + FW(M,N)*W(M,N)
+                                SUMW = SUMW + W(M,N)
+                                NW = NW + 1
+                            END IF
+                         END DO
+                       END DO
+c                                             nw >=3 arbitrary
+c c c                  IF (NCRIT.GE.3 .AND. SUMW.GT.0.D0) THEN
+c                                             nw  =1 nearest neighbor
+                       IF (NCRIT.GE.1 .AND. SUMW.GT.0.D0) THEN
+                           FO(NX,NY,NG) = SUMF/SUMW
+                       END IF
+                   END IF
+                 END IF
+               END DO   
+               GO TO 20
+             END IF
+            END DO   
+          END DO    
+
+   20         CONTINUE
+        END DO  
+      END DO   
+
+      RETURN
+      END

wrf_open/var/ncl_reference/rcmW.c

@@ -0,0 +1,832 @@
+#include <stdio.h>
+#include "wrapper.h"
+
+extern void NGCALLF(drcm2rgrid,DRCM2RGRID)(int *,int *,int *,double *,double *,
+                                           double *,int *,double *,int*,
+                                           double *,double *,double*,
+                                           int *,int *,int *);
+
+extern void NGCALLF(drgrid2rcm,DRGRID2RCM)(int *,int *,int *,double *,double *,
+                                           double *,int *,int *,double *,
+                                           double *,double *,double*,
+                                           int *,int *,int *);
+
+extern void NGCALLF(drcm2points,DRCM2POINTS)(int *,int *,int *,double *,
+                                             double *,double *,int *,double *,
+                                             double *,double *,double*,
+                                             int *,int *,int *,int*);
+
+
+NhlErrorTypes rcm2rgrid_W( void )
+{
+/*
+ * Input variables
+ */
+  void *lat2d, *lon2d, *fi, *lat1d, *lon1d, *opt;
+  double *tmp_lat2d, *tmp_lon2d, *tmp_lat1d, *tmp_lon1d, *tmp_fi;
+  int tmp_opt, tmp_ncrit;
+  ng_size_t dsizes_lat2d[2];
+  ng_size_t dsizes_lon2d[2];
+  ng_size_t dsizes_lat1d[2];
+  ng_size_t dsizes_lon1d[1];
+  int ndims_fi;
+  ng_size_t size_fi;
+  ng_size_t dsizes_fi[NCL_MAX_DIMENSIONS];
+  int has_missing_fi;
+  NclScalar missing_fi, missing_dfi, missing_rfi;
+  NclBasicDataTypes type_lat2d, type_lon2d, type_lat1d, type_lon1d;
+  NclBasicDataTypes type_fi, type_opt;
+/*
+ * Output variables.
+ */
+  void *fo;
+  double *tmp_fo;
+  ng_size_t *dsizes_fo;
+  NclBasicDataTypes type_fo;
+  NclScalar missing_fo;
+/*
+ * Other variables
+ */
+  ng_size_t nlon2d, nlat2d, nfi, nlat1d, nlon1d, nfo, ngrid, size_fo;
+  ng_size_t i;
+  int ier, ret;
+  int inlon2d, inlat2d, ingrid, inlon1d, inlat1d;
+
+/*
+ * Retrieve parameters
+ *
+ * Note that any of the pointer parameters can be set to NULL,
+ * which implies you don't care about its value.
+ */
+  lat2d = (void*)NclGetArgValue(
+          0,
+          6,
+          NULL,
+          dsizes_lat2d,
+          NULL,
+          NULL,
+          &type_lat2d,
+          DONT_CARE);
+
+  lon2d = (void*)NclGetArgValue(
+          1,
+          6,
+          NULL,
+          dsizes_lon2d,
+          NULL,
+          NULL,
+          &type_lon2d,
+          DONT_CARE);
+
+  fi = (void*)NclGetArgValue(
+          2,
+          6,
+          &ndims_fi,
+          dsizes_fi,
+          &missing_fi,
+          &has_missing_fi,
+          &type_fi,
+          DONT_CARE);
+
+  lat1d = (void*)NclGetArgValue(
+          3,
+          6,
+          NULL,
+          dsizes_lat1d,
+          NULL,
+          NULL,
+          &type_lat1d,
+          DONT_CARE);
+
+  lon1d = (void*)NclGetArgValue(
+          4,
+          6,
+          NULL,
+          dsizes_lon1d,
+          NULL,
+          NULL,
+          &type_lon1d,
+          DONT_CARE);
+
+  opt = (void*)NclGetArgValue(
+          5,
+          6,
+          NULL,
+          NULL,
+          NULL,
+          NULL,
+          &type_opt,
+          DONT_CARE);
+/*
+ * Check the input lat/lon arrays. They must be the same size, and larger
+ * than one element.
+ */
+  if(dsizes_lat2d[0] != dsizes_lon2d[0] ||
+     dsizes_lat2d[1] != dsizes_lon2d[1]) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2rgrid: The input lat/lon grids must be the same size");
+    return(NhlFATAL);
+  }
+
+  nlat2d = dsizes_lat2d[0];
+  nlon2d = dsizes_lat2d[1];     /* same as dsizes_lon2d[1] */
+  nlat1d = dsizes_lat1d[0];
+  nlon1d = dsizes_lon1d[0];
+
+  if(nlon2d <= 1 || nlat2d <= 1 || nlat1d <= 1 || nlon1d <= 1) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2rgrid: The input/output lat/lon grids must have at least 2 elements");
+    return(NhlFATAL);
+  }
+
+/*
+ * Compute the total number of elements in our arrays.
+ */
+  nfi  = nlon2d * nlat2d;
+  nfo  = nlat1d * nlon1d;
+
+/*
+ * Check dimensions of fi.
+ */
+  if(ndims_fi < 2) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2rgrid: fi must be at least two dimensions");
+    return(NhlFATAL);
+  }
+  if(dsizes_fi[ndims_fi-2] != nlat2d || dsizes_fi[ndims_fi-1] != nlon2d) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2rgrid: The rightmost dimensions of fi must be nlat2d x nlon2d, where nlat2d and nlon2d are the dimensions of the lat2d/lon2d arrays");
+    return(NhlFATAL);
+  }
+/*
+ * Compute the total size of the input/output arrays.
+ */
+  ngrid = 1;
+  for( i = 0; i < ndims_fi-2; i++ ) ngrid *= dsizes_fi[i];
+  size_fi = ngrid * nfi;
+  size_fo = ngrid * nfo;
+
+/*
+ * Test input dimension sizes.
+ */
+  if((nlon2d > INT_MAX) || (nlat2d > INT_MAX) || (ngrid > INT_MAX) || 
+     (nlon1d > INT_MAX) || (nlat1d > INT_MAX)) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2rgrid: one or more input dimension sizes is greater than INT_MAX");
+    return(NhlFATAL);
+  }
+  inlon2d = (int) nlon2d;
+  inlat2d = (int) nlat2d;
+  ingrid = (int) ngrid;
+  inlon1d = (int) nlon1d;
+  inlat1d = (int) nlat1d;
+
+/*
+ * Coerce missing values.
+ */
+  coerce_missing(type_fi,has_missing_fi,&missing_fi,&missing_dfi,
+                 &missing_rfi);
+/*
+ * Allocate space for output array.
+ */
+  if(type_fi == NCL_double) {
+    fo      = (void*)calloc(size_fo,sizeof(double));
+    tmp_fo  = &((double*)fo)[0];
+    type_fo = NCL_double;
+    missing_fo.doubleval = missing_dfi.doubleval;
+  }
+  else {
+    fo      = (void*)calloc(size_fo,sizeof(float));
+    tmp_fo  = (double*)calloc(size_fo,sizeof(double));
+    type_fo = NCL_float;
+    missing_fo.floatval = missing_rfi.floatval;
+    if(tmp_fo == NULL) {
+      NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2rgrid: Unable to allocate memory for temporary array");
+      return(NhlFATAL);
+    }
+  }
+  dsizes_fo = (ng_size_t*)calloc(ndims_fi,sizeof(ng_size_t));
+  if(fo == NULL || dsizes_fo == NULL) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2rgrid: Unable to allocate memory for output array");
+    return(NhlFATAL);
+  }
+  for(i = 0; i < ndims_fi-2; i++) dsizes_fo[i] = dsizes_fi[i];
+  dsizes_fo[ndims_fi-2] = nlat1d;
+  dsizes_fo[ndims_fi-1] = nlon1d;
+
+/*
+ * Coerce input arrays to double if necessary.
+ */
+  tmp_lat2d = coerce_input_double(lat2d,type_lat2d,nfi,0,NULL,NULL);
+  tmp_lon2d = coerce_input_double(lon2d,type_lon2d,nfi,0,NULL,NULL);
+  tmp_lat1d = coerce_input_double(lat1d,type_lat1d,nlat1d,0,NULL,NULL);
+  tmp_lon1d = coerce_input_double(lon1d,type_lon1d,nlon1d,0,NULL,NULL); 
+  tmp_fi    = coerce_input_double(fi,type_fi,size_fi,has_missing_fi,
+                                  &missing_fi,&missing_dfi);
+
+  if(tmp_lat2d == NULL || tmp_lon2d == NULL ||
+     tmp_lat1d == NULL || tmp_lon1d == NULL || tmp_fi == NULL) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2rgrid: Unable to coerce input lat/lon arrays to double precision");
+    return(NhlFATAL);
+  }
+
+/*
+ * Force opt to zero and ncrit to 1, since they are not used yet.
+ */
+  tmp_opt   = 0;
+  tmp_ncrit = 1;
+
+  NGCALLF(drcm2rgrid,DRCM2RGRID)(&ingrid,&inlat2d,&inlon2d,tmp_lat2d,tmp_lon2d,
+                                 tmp_fi,&inlat1d,tmp_lat1d,&inlon1d,
+                                 tmp_lon1d,tmp_fo,&missing_dfi.doubleval,
+                                 &tmp_ncrit,&tmp_opt,&ier);
+
+  if(ier) {
+    if(ier == 1) {
+      NhlPError(NhlWARNING,NhlEUNKNOWN,"rcm2rgrid: not enough points in input/output array");
+    }
+    if(2 <= ier && ier <= 5) {
+      NhlPError(NhlWARNING,NhlEUNKNOWN,"rcm2rgrid: lat2d, lon2d, lat1d, lon1d must be monotonically increasing");
+    }
+    set_subset_output_missing(fo,0,type_fo,size_fo,missing_dfi.doubleval);
+  }
+  else {
+    if(type_fo != NCL_double) {
+      coerce_output_float_only(fo,tmp_fo,size_fo,0);
+    }
+  }
+/*
+ * Free temp arrays.
+ */
+  if(type_lat2d != NCL_double) NclFree(tmp_lat2d);
+  if(type_lon2d != NCL_double) NclFree(tmp_lon2d);
+  if(type_lat1d != NCL_double) NclFree(tmp_lat1d);
+  if(type_lon1d != NCL_double) NclFree(tmp_lon1d);
+  if(type_fi    != NCL_double) NclFree(tmp_fi);
+  if(type_fo    != NCL_double) NclFree(tmp_fo);
+
+/*
+ * Return.
+ */
+  ret = NclReturnValue(fo,ndims_fi,dsizes_fo,&missing_fo,type_fo,0);
+  NclFree(dsizes_fo);
+  return(ret);
+}
+
+
+NhlErrorTypes rgrid2rcm_W( void )
+{
+/*
+ * Input variables
+ */
+  void *lat2d, *lon2d, *fi, *lat1d, *lon1d, *opt;
+  double *tmp_lat2d, *tmp_lon2d, *tmp_lat1d, *tmp_lon1d, *tmp_fi;
+  int tmp_opt, tmp_ncrit;
+  ng_size_t dsizes_lat2d[2];
+  ng_size_t dsizes_lon2d[2];
+  ng_size_t dsizes_lat1d[2];
+  ng_size_t dsizes_lon1d[1];
+  int ndims_fi;
+  ng_size_t dsizes_fi[NCL_MAX_DIMENSIONS];
+  int has_missing_fi;
+  NclScalar missing_fi, missing_dfi, missing_rfi;
+  NclBasicDataTypes type_lat2d, type_lon2d, type_lat1d, type_lon1d;
+  NclBasicDataTypes type_fi, type_opt;
+/*
+ * Output variables.
+ */
+  void *fo;
+  double *tmp_fo;
+  ng_size_t *dsizes_fo;
+  NclBasicDataTypes type_fo;
+  NclScalar missing_fo;
+/*
+ * Other variables
+ */
+  ng_size_t nlon2d, nlat2d, nfi, nlat1d, nlon1d, nfo, ngrid, size_fi, size_fo;
+  ng_size_t i;
+  int ier, ret;
+  int inlon2d, inlat2d, ingrid, inlon1d, inlat1d;
+/*
+ * Retrieve parameters
+ *
+ * Note that any of the pointer parameters can be set to NULL,
+ * which implies you don't care about its value.
+ */
+  lat1d = (void*)NclGetArgValue(
+          0,
+          6,
+          NULL,
+          dsizes_lat1d,
+          NULL,
+          NULL,
+          &type_lat1d,
+          DONT_CARE);
+
+  lon1d = (void*)NclGetArgValue(
+          1,
+          6,
+          NULL,
+          dsizes_lon1d,
+          NULL,
+          NULL,
+          &type_lon1d,
+          DONT_CARE);
+
+  fi = (void*)NclGetArgValue(
+          2,
+          6,
+          &ndims_fi,
+          dsizes_fi,
+          &missing_fi,
+          &has_missing_fi,
+          &type_fi,
+          DONT_CARE);
+
+  lat2d = (void*)NclGetArgValue(
+          3,
+          6,
+          NULL,
+          dsizes_lat2d,
+          NULL,
+          NULL,
+          &type_lat2d,
+          DONT_CARE);
+
+  lon2d = (void*)NclGetArgValue(
+          4,
+          6,
+          NULL,
+          dsizes_lon2d,
+          NULL,
+          NULL,
+          &type_lon2d,
+          DONT_CARE);
+
+  opt = (void*)NclGetArgValue(
+          5,
+          6,
+          NULL,
+          NULL,
+          NULL,
+          NULL,
+          &type_opt,
+          DONT_CARE);
+/*
+ * Check the output lat/lon arrays. They must be the same size, and larger
+ * than one element.
+ */
+  if(dsizes_lat2d[0] != dsizes_lon2d[0] ||
+     dsizes_lat2d[1] != dsizes_lon2d[1]) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rgrid2rcm: The output lat/lon grids must be the same size");
+    return(NhlFATAL);
+  }
+
+  nlat2d = dsizes_lat2d[0];
+  nlon2d = dsizes_lat2d[1];     /* same as dsizes_lon2d[1] */
+  nlat1d = dsizes_lat1d[0];
+  nlon1d = dsizes_lon1d[0];
+
+  if(nlon2d <= 1 || nlat2d <= 1 || nlat1d <= 1 || nlon1d <= 1) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rgrid2rcm: The input/output lat/lon grids must have at least 2 elements");
+    return(NhlFATAL);
+  }
+
+/*
+ * Compute the total number of elements in our arrays.
+ */
+  nfi  = nlat1d * nlon1d;
+  nfo  = nlon2d * nlat2d;
+
+/*
+ * Check dimensions of fi.
+ */
+  if(ndims_fi < 2) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rgrid2rcm: fi must be at least two dimensions");
+    return(NhlFATAL);
+  }
+  if(dsizes_fi[ndims_fi-2] != nlat1d || dsizes_fi[ndims_fi-1] != nlon1d) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rgrid2rcm: The rightmost dimensions of fi must be nlat1d x nlon1d, where nlat1d and nlon1d are the dimensions of the lat1d/lon1d arrays");
+    return(NhlFATAL);
+  }
+/*
+ * Compute the total size of the input/output arrays.
+ */
+  ngrid = 1;
+  for( i = 0; i < ndims_fi-2; i++ ) ngrid *= dsizes_fi[i];
+  size_fi = ngrid * nfi;
+  size_fo = ngrid * nfo;
+/*
+ * Test input dimension sizes.
+ */
+  if((nlon2d > INT_MAX) || (nlat2d > INT_MAX) || (ngrid > INT_MAX) || 
+     (nlon1d > INT_MAX) || (nlat1d > INT_MAX)) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rgrid2rcm: one or more input dimension sizes is greater than INT_MAX");
+    return(NhlFATAL);
+  }
+  inlon2d = (int) nlon2d;
+  inlat2d = (int) nlat2d;
+  ingrid = (int) ngrid;
+  inlon1d = (int) nlon1d;
+  inlat1d = (int) nlat1d;
+
+/*
+ * Coerce missing values.
+ */
+  coerce_missing(type_fi,has_missing_fi,&missing_fi,&missing_dfi,
+                 &missing_rfi);
+/*
+ * Allocate space for output array.
+ */
+  if(type_fi == NCL_double) {
+    fo      = (void*)calloc(size_fo,sizeof(double));
+    tmp_fo  = &((double*)fo)[0];
+    type_fo = NCL_double;
+    missing_fo.doubleval = missing_dfi.doubleval;
+  }
+  else {
+    tmp_fo  = (double*)calloc(size_fo,sizeof(double));
+    fo      = (void*)calloc(size_fo,sizeof(float));
+    type_fo = NCL_float;
+    missing_fo.floatval = missing_rfi.floatval;
+    if(tmp_fo == NULL) {
+      NhlPError(NhlFATAL,NhlEUNKNOWN,"rgrid2rcm: Unable to allocate memory for temporary arrays");
+      return(NhlFATAL);
+    }
+  }
+  dsizes_fo = (ng_size_t*)calloc(ndims_fi,sizeof(ng_size_t));
+  if(fo == NULL || dsizes_fo == NULL) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rgrid2rcm: Unable to allocate memory for output array");
+    return(NhlFATAL);
+  }
+  for(i = 0; i < ndims_fi-2; i++) dsizes_fo[i] = dsizes_fi[i];
+  dsizes_fo[ndims_fi-2] = nlat2d;
+  dsizes_fo[ndims_fi-1] = nlon2d;
+
+/*
+ * Coerce input arrays to double if necessary.
+ */
+  tmp_lat2d = coerce_input_double(lat2d,type_lat2d,nfo,0,NULL,NULL);
+  tmp_lon2d = coerce_input_double(lon2d,type_lon2d,nfo,0,NULL,NULL);
+  tmp_lat1d = coerce_input_double(lat1d,type_lat1d,nlat1d,0,NULL,NULL);
+  tmp_lon1d = coerce_input_double(lon1d,type_lon1d,nlon1d,0,NULL,NULL);
+  tmp_fi    = coerce_input_double(fi,type_fi,size_fi,has_missing_fi,
+                                  &missing_fi,&missing_dfi);
+
+  if(tmp_lat2d == NULL || tmp_lon2d == NULL ||
+     tmp_lat1d == NULL || tmp_lon1d == NULL || tmp_fi == NULL) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rgrid2rcm: Unable to coerce input lat/lon arrays to double precision");
+    return(NhlFATAL);
+  }
+/*
+ * Force opt to zero and ncrit to 1, since they are not used yet.
+ */
+  tmp_opt   = 0;
+  tmp_ncrit = 1;
+
+  NGCALLF(drgrid2rcm,DRGRID2RCM)(&ingrid,&inlat1d,&inlon1d,tmp_lat1d,tmp_lon1d,
+                                 tmp_fi,&inlat2d,&inlon2d,tmp_lat2d,
+                                 tmp_lon2d,tmp_fo,&missing_dfi.doubleval,
+                                 &tmp_ncrit,&tmp_opt,&ier);
+  if(ier) {
+    if(ier == 1) {
+      NhlPError(NhlWARNING,NhlEUNKNOWN,"rgrid2rcm: not enough points in input/output array");
+    }
+    if(2 <= ier && ier <= 5) {
+      NhlPError(NhlWARNING,NhlEUNKNOWN,"rgrid2rcm: lat2d, lon2d, lat1d, lon1d must be monotonically increasing");
+    }
+    set_subset_output_missing(fo,0,type_fo,size_fo,missing_dfi.doubleval);
+  }
+  else {
+    if(type_fo != NCL_double) {
+      coerce_output_float_only(fo,tmp_fo,size_fo,0);
+    }
+  }
+/*
+ * Free temp arrays.
+ */
+  if(type_lat2d != NCL_double) NclFree(tmp_lat2d);
+  if(type_lon2d != NCL_double) NclFree(tmp_lon2d);
+  if(type_lat1d != NCL_double) NclFree(tmp_lat1d);
+  if(type_lon1d != NCL_double) NclFree(tmp_lon1d);
+  if(type_fi    != NCL_double) NclFree(tmp_fi);
+  if(type_fo    != NCL_double) NclFree(tmp_fo);
+
+  ret = NclReturnValue(fo,ndims_fi,dsizes_fo,&missing_fo,type_fo,0);
+  NclFree(dsizes_fo);
+  return(ret);
+}
+
+
+NhlErrorTypes rcm2points_W( void )
+{
+/*
+ * Input variables
+ */
+  void *lat2d, *lon2d, *fi, *lat1d, *lon1d;
+  double *tmp_lat2d, *tmp_lon2d, *tmp_lat1d, *tmp_lon1d, *tmp_fi;
+  int *opt, tmp_ncrit;
+  ng_size_t dsizes_lat2d[2];
+  ng_size_t dsizes_lon2d[2];
+  ng_size_t dsizes_lat1d[2];
+  ng_size_t dsizes_lon1d[1];
+  int ndims_fi;
+  ng_size_t dsizes_fi[NCL_MAX_DIMENSIONS];
+  int has_missing_fi;
+  NclScalar missing_fi, missing_dfi, missing_rfi;
+  NclBasicDataTypes type_lat2d, type_lon2d, type_lat1d, type_lon1d;
+  NclBasicDataTypes type_fi;
+/*
+ * Variables for retrieving attributes from "opt".
+ */
+  NclAttList  *attr_list;
+  NclAtt  attr_obj;
+  NclStackEntry   stack_entry;
+  logical set_search_width;
+/*
+ * Output variables.
+ */
+  void *fo;
+  double *tmp_fo;
+  int ndims_fo;
+  ng_size_t *dsizes_fo;
+  NclBasicDataTypes type_fo;
+  NclScalar missing_fo;
+/*
+ * Other variables
+ */
+  ng_size_t nlon2d, nlat2d, nfi, nlat1d, nfo, ngrid, size_fi, size_fo;
+  ng_size_t i;
+  int search_width, ier, ret;
+  int inlon2d, inlat2d, ingrid, inlat1d;
+/*
+ * Retrieve parameters
+ *
+ * Note that any of the pointer parameters can be set to NULL,
+ * which implies you don't care about its value.
+ */
+  lat2d = (void*)NclGetArgValue(
+          0,
+          6,
+          NULL,
+          dsizes_lat2d,
+          NULL,
+          NULL,
+          &type_lat2d,
+          DONT_CARE);
+
+  lon2d = (void*)NclGetArgValue(
+          1,
+          6,
+          NULL,
+          dsizes_lon2d,
+          NULL,
+          NULL,
+          &type_lon2d,
+          DONT_CARE);
+
+  fi = (void*)NclGetArgValue(
+          2,
+          6,
+          &ndims_fi,
+          dsizes_fi,
+          &missing_fi,
+          &has_missing_fi,
+          &type_fi,
+          DONT_CARE);
+
+  lat1d = (void*)NclGetArgValue(
+          3,
+          6,
+          NULL,
+          dsizes_lat1d,
+          NULL,
+          NULL,
+          &type_lat1d,
+          DONT_CARE);
+
+  lon1d = (void*)NclGetArgValue(
+          4,
+          6,
+          NULL,
+          dsizes_lon1d,
+          NULL,
+          NULL,
+          &type_lon1d,
+          DONT_CARE);
+
+  opt = (int*)NclGetArgValue(
+          5,
+          6,
+          NULL,
+          NULL,
+          NULL,
+          NULL,
+          NULL,
+          DONT_CARE);
+/*
+ * Check the input lat/lon arrays. They must be the same size, and larger
+ * than one element.
+ */
+  if(dsizes_lat2d[0] != dsizes_lon2d[0] ||
+     dsizes_lat2d[1] != dsizes_lon2d[1]) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2points: The input lat/lon grids must be the same size");
+    return(NhlFATAL);
+  }
+
+  nlat2d = dsizes_lat2d[0];
+  nlon2d = dsizes_lat2d[1];     /* same as dsizes_lon2d[1] */
+  nlat1d = dsizes_lat1d[0];
+
+  if(dsizes_lon1d[0] != nlat1d) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2points: The output lat/lon arrays must be the same length");
+    return(NhlFATAL);
+  }
+
+  if(nlon2d < 2 || nlat2d < 2 || nlat1d < 1) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2points: The input lat/lon grids must have at least 2 elements, and the output lat/lon arrays 1 element");
+    return(NhlFATAL);
+  }
+
+/*
+ * Compute the total number of elements in our arrays.
+ */
+  nfi  = nlon2d * nlat2d;
+  nfo  = nlat1d;
+
+/*
+ * Check dimensions of fi.
+ */
+  if(ndims_fi < 2) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2points: fi must be at least two dimensions");
+    return(NhlFATAL);
+  }
+  if(dsizes_fi[ndims_fi-2] != nlat2d || dsizes_fi[ndims_fi-1] != nlon2d) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2points: The rightmost dimensions of fi must be nlat2d x nlon2d, where nlat2d and nlon2d are the dimensions of the lat2d/lon2d arrays");
+    return(NhlFATAL);
+  }
+/*
+ * Compute the sizes of the input/output arrays.
+ */
+  ngrid = 1;
+  for( i = 0; i < ndims_fi-2; i++ ) ngrid *= dsizes_fi[i];
+  size_fi = ngrid * nfi;
+  size_fo = ngrid * nfo;
+
+/*
+ * Test input dimension sizes.
+ */
+  if((nlon2d > INT_MAX) || (nlat2d > INT_MAX) || (ngrid > INT_MAX) || (nlat1d > INT_MAX)) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2points: one or more input dimension sizes is greater than INT_MAX");
+    return(NhlFATAL);
+  }
+  inlon2d = (int) nlon2d;
+  inlat2d = (int) nlat2d;
+  ingrid = (int) ngrid;
+  inlat1d = (int) nlat1d;
+
+/*
+ * Coerce missing values.
+ */
+  coerce_missing(type_fi,has_missing_fi,&missing_fi,&missing_dfi,
+                 &missing_rfi);
+/*
+ * Allocate space for output array.
+ */
+  if(type_fi == NCL_double) {
+    fo      = (void*)calloc(size_fo,sizeof(double));
+    tmp_fo  = &((double*)fo)[0];
+    type_fo = NCL_double;
+    missing_fo.doubleval = missing_dfi.doubleval;
+  }
+  else {
+    fo      = (void*)calloc(size_fo,sizeof(float));
+    tmp_fo  = (double*)calloc(size_fo,sizeof(double));
+    type_fo = NCL_float;
+    missing_fo.floatval = missing_rfi.floatval;
+    if(tmp_fo == NULL) {
+      NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2points: Unable to allocate memory for temporary array");
+      return(NhlFATAL);
+    }
+  }
+  ndims_fo  = ndims_fi-1;
+  dsizes_fo = (ng_size_t*)calloc(ndims_fo,sizeof(ng_size_t));
+  if(fo == NULL || dsizes_fo == NULL) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2points: Unable to allocate memory for output array");
+    return(NhlFATAL);
+  }
+  for(i = 0; i < ndims_fi-2; i++) dsizes_fo[i] = dsizes_fi[i];
+  dsizes_fo[ndims_fi-2] = nlat1d;
+
+/*
+ * Coerce input arrays to double if necessary.
+ */
+  tmp_lat2d = coerce_input_double(lat2d,type_lat2d,nfi,0,NULL,NULL);
+  tmp_lon2d = coerce_input_double(lon2d,type_lon2d,nfi,0,NULL,NULL);
+  tmp_lat1d = coerce_input_double(lat1d,type_lat1d,nlat1d,0,NULL,NULL);
+  tmp_lon1d = coerce_input_double(lon1d,type_lon1d,nlat1d,0,NULL,NULL);
+  tmp_fi    = coerce_input_double(fi,type_fi,size_fi,has_missing_fi,
+                                  &missing_fi,&missing_dfi);
+
+  if(tmp_lat2d == NULL || tmp_lon2d == NULL ||
+     tmp_lat1d == NULL || tmp_lon1d == NULL || tmp_fi == NULL) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"rcm2points: Unable to coerce input lat/lon arrays to double precision");
+    return(NhlFATAL);
+  }
+
+/*
+ * Force ncrit to 1, since it is not used yet.
+ */
+  tmp_ncrit = 1;
+
+/* 
+ * Check if any attributes have been attached to opt.
+ */
+  set_search_width = False;
+  stack_entry = _NclGetArg(5, 6, DONT_CARE);
+  switch (stack_entry.kind) {;;
+  case NclStk_VAR:
+    if (stack_entry.u.data_var->var.att_id != -1) {;;
+      attr_obj = (NclAtt) _NclGetObj(stack_entry.u.data_var->var.att_id);
+      if (attr_obj == NULL) {;
+	break;
+      };
+    }
+    else {
+/*
+ * att_id == -1 ==> no optional args given.
+ */
+      break;
+    }
+/* 
+ * Get optional arguments.
+ */
+    if (attr_obj->att.n_atts > 0) {
+/*
+ * Get list of attributes.
+ */
+      attr_list = attr_obj->att.att_list;
+/*
+ * Loop through attributes and check them. The current ones recognized are:
+ *
+ *   "search_width"
+ */
+      while (attr_list != NULL) {
+	if (!strcmp(attr_list->attname, "search_width")) {
+	  if(attr_list->attvalue->multidval.data_type != NCL_int) {
+	    NhlPError(NhlWARNING,NhlEUNKNOWN,"rcm2points: The 'search_width' attribute must be an integer, defaulting to 1.");
+	    search_width = 1;
+	  }
+	  else {
+	    search_width = *(int*) attr_list->attvalue->multidval.val;
+	    if(search_width <= 0) {
+	      NhlPError(NhlWARNING,NhlEUNKNOWN,"rcm2points: The 'search_width' attribute is < 0. Defaulting to 1.");
+	      search_width = 1;
+	    }
+	    else {
+	      set_search_width = True;
+	    }
+	  }
+	}
+	attr_list = attr_list->next;
+      }
+    }
+  default:
+    break;
+  }
+
+/*
+ * If user didn't set search_width, then set it here.
+ */
+  if(!set_search_width) search_width = 1;
+
+  NGCALLF(drcm2points,DRCM2POINTS)(&ingrid,&inlat2d,&inlon2d,tmp_lat2d,
+                                   tmp_lon2d,tmp_fi,&inlat1d,tmp_lat1d,
+                                   tmp_lon1d,tmp_fo,&missing_dfi.doubleval,
+                                   opt,&tmp_ncrit,&search_width,&ier);
+  if(ier) {
+    if(ier == 1) {
+      NhlPError(NhlWARNING,NhlEUNKNOWN,"rcm2points: not enough points in input/output array");
+    }
+    if(2 <= ier && ier <= 5) {
+      NhlPError(NhlWARNING,NhlEUNKNOWN,"rcm2points: lat2d, lon2d, lat1d, lon1d must be monotonically increasing");
+    }
+    set_subset_output_missing(fo,0,type_fo,size_fo,missing_dfi.doubleval);
+  }
+  else {
+    if(type_fo != NCL_double) {
+      coerce_output_float_only(fo,tmp_fo,size_fo,0);
+    }
+  }
+/*
+ * Free temp arrays.
+ */
+  if(type_lat2d != NCL_double) NclFree(tmp_lat2d);
+  if(type_lon2d != NCL_double) NclFree(tmp_lon2d);
+  if(type_lat1d != NCL_double) NclFree(tmp_lat1d);
+  if(type_lon1d != NCL_double) NclFree(tmp_lon1d);
+  if(type_fi    != NCL_double) NclFree(tmp_fi);
+  if(type_fo    != NCL_double) NclFree(tmp_fo);
+
+/*
+ * Return.
+ */
+  ret = NclReturnValue(fo,ndims_fo,dsizes_fo,&missing_fo,type_fo,0);
+  NclFree(dsizes_fo);
+  return(ret);
+}

wrf_open/var/ncl_reference/rip_cape.f

@@ -0,0 +1,612 @@
+c======================================================================
+c
+c !IROUTINE: capecalc3d -- Calculate CAPE and CIN
+c
+c !DESCRIPTION:
+c
+c   If i3dflag=1, this routine calculates CAPE and CIN (in m**2/s**2,
+c   or J/kg) for every grid point in the entire 3D domain (treating
+c   each grid point as a parcel).  If i3dflag=0, then it
+c   calculates CAPE and CIN only for the parcel with max theta-e in
+c   the column, (i.e. something akin to Colman's MCAPE).  By "parcel",
+c   we mean a 500-m deep parcel, with actual temperature and moisture
+c   averaged over that depth.
+c
+c   In the case of i3dflag=0,
+c   CAPE and CIN are 2D fields that are placed in the k=mkzh slabs of
+c   the cape and cin arrays.  Also, if i3dflag=0, LCL and LFC heights
+c   are put in the k=mkzh-1 and k=mkzh-2 slabs of the cin array.
+c
+c ASSUMPTIONS:
+c
+c !REVISION HISTORY:
+c     2005-May-15 - Mark T. Stoelinga - oringinal version from RIP4
+c     2005-Nov-28 - J. Schramm - modified to run outside of RIP4 with
+c     2012-Jul-18 - M. Haley - modified to change/add missing value.
+c                                NCL
+c
+c !INTERFACE:
+c ------------------------------------------------------------------
+C NCLFORTSTART
+      SUBROUTINE DCAPECALC3D(PRS,TMK,QVP,GHT,TER,SFP,CAPE,CIN,CMSG,
+     +                       MIY,MJX,MKZH,I3DFLAG,TER_FOLLOW,PSAFILE)
+c
+      IMPLICIT NONE
+      INTEGER MIY,MJX,MKZH,I3DFLAG,TER_FOLLOW
+      DOUBLE PRECISION PRS(MIY,MJX,MKZH)
+      DOUBLE PRECISION TMK(MIY,MJX,MKZH)
+      DOUBLE PRECISION QVP(MIY,MJX,MKZH)
+      DOUBLE PRECISION GHT(MIY,MJX,MKZH)
+      DOUBLE PRECISION TER(MIY,MJX)
+      DOUBLE PRECISION SFP(MIY,MJX)
+      DOUBLE PRECISION CAPE(MIY,MJX,MKZH)
+      DOUBLE PRECISION CIN(MIY,MJX,MKZH)
+      DOUBLE PRECISION CMSG
+      CHARACTER*(*) PSAFILE
+C NCLEND
+c Local variables
+      INTEGER I,J,K,ILCL,IUP,KEL,KK,KLCL,KLEV,KLFC,KMAX,KPAR,KPAR1,KPAR2
+      DOUBLE PRECISION DAVG,ETHMAX,Q,T,P,E,ETH,TLCL,ZLCL
+      DOUBLE PRECISION CP,EPS,GAMMA,GAMMAMD,RGAS,RGASMD,TLCLC1,TLCLC2,
+     +                 TLCLC3,TLCLC4
+      DOUBLE PRECISION CPMD,THTECON1,THTECON2,THTECON3
+      DOUBLE PRECISION CELKEL,EZERO,ESLCON1,ESLCON2,GRAV
+      DOUBLE PRECISION PAVG,VIRTUAL,P1,P2,PP1,PP2,TH,TOTTHE,TOTQVP,
+     +                 TOTPRS
+      DOUBLE PRECISION CPM,DELTAP,ETHPARI,GAMMAM,GHTPARI,QVPPARI,
+     +                 PRSPARI,TMKPARI
+      DOUBLE PRECISION FACDEN,FAC1,FAC2,QVPLIFT,TMKLIFT,TVENV,TVLIFT,
+     +                 GHTLIFT
+      DOUBLE PRECISION ESLIFT,TMKENV,QVPENV,TONPSADIABAT
+      DOUBLE PRECISION BENAMIN,DZ,PUP,PDN
+      DOUBLE PRECISION BUOY(150),ZREL(150),BENACCUM(150),
+     +                 PRSF(MIY,MJX,MKZH)
+      DOUBLE PRECISION PSADITHTE(150),PSADIPRS(150),PSADITMK(150,150)
+c
+C The comments were taken from a Mark Stoelinga email, 23 Apr 2007,
+C in response to a user getting the "Outside of lookup table bounds"
+C error message. 
+C
+C TMKPARI  - Initial temperature of parcel, K
+C    Values of 300 okay. (Not sure how much from this you can stray.)
+C
+C PRSPARI - Initial pressure of parcel, hPa
+C    Values of 980 okay. (Not sure how much from this you can stray.)
+C
+C THTECON1, THTECON2, THTECON3
+C     These are all constants, the first in K and the other two have
+C     no units.  Values of 3376, 2.54, and 0.81 were stated as being
+C     okay.
+C
+C TLCL - The temperature at the parcel's lifted condensation level, K
+C        should be a reasonable atmospheric temperature around 250-300 K
+C        (398 is "way too high")
+C
+C QVPPARI - The initial water vapor mixing ratio of the parcel,
+C           kg/kg (should range from 0.000 to 0.025)
+C
+
+c Constants
+      IUP = 6
+      CELKEL = 273.15D0
+      GRAV = 9.81D0
+C hPa
+      EZERO = 6.112D0
+      ESLCON1 = 17.67D0
+      ESLCON2 = 29.65D0
+      EPS = 0.622D0
+C J/K/kg
+      RGAS = 287.04D0
+C  J/K/kg  Note: not using Bolton's value of 1005.7
+      CP = 1004.D0
+      GAMMA = RGAS/CP
+C  cp_moist=cp*(1.+cpmd*qvp)
+      CPMD = .887D0
+C  rgas_moist=rgas*(1.+rgasmd*qvp)
+      RGASMD = .608D0
+C  gamma_moist=gamma*(1.+gammamd*qvp)
+      GAMMAMD = RGASMD - CPMD
+      TLCLC1 = 2840.D0
+      TLCLC2 = 3.5D0
+      TLCLC3 = 4.805D0
+      TLCLC4 = 55.D0
+C  K
+      THTECON1 = 3376.D0
+      THTECON2 = 2.54D0
+      THTECON3 = .81D0
+c
+c  Calculated the pressure at full sigma levels (a set of pressure
+c  levels that bound the layers represented by the vertical grid points)
+
+      CALL DPFCALC(PRS,SFP,PRSF,MIY,MJX,MKZH,TER_FOLLOW)
+c
+c  Before looping, set lookup table for getting temperature on
+c  a pseudoadiabat.
+c
+      CALL DLOOKUP_TABLE(PSADITHTE,PSADIPRS,PSADITMK,PSAFILE)
+c
+C   do j=1,mjx-1
+      DO J = 1,MJX
+C   do i=1,miy-1
+          DO I = 1,MIY
+              CAPE(I,J,1) = 0.D0
+              CIN(I,J,1) = 0.D0
+c
+              IF (I3DFLAG.EQ.1) THEN
+                  KPAR1 = 2
+                  KPAR2 = MKZH
+              ELSE
+c
+c      Find parcel with max theta-e in lowest 3 km AGL.
+c
+                  ETHMAX = -1.D0
+                  DO K = MKZH,1,-1
+                      IF (GHT(I,J,K)-TER(I,J).LT.3000.D0) THEN
+                          Q = MAX(QVP(I,J,K),1.D-15)
+                          T = TMK(I,J,K)
+                          P = PRS(I,J,K)
+                          E = Q*P/ (EPS+Q)
+                          TLCL = TLCLC1/ (LOG(T**TLCLC2/E)-TLCLC3) +
+     +                           TLCLC4
+                          ETH = T* (1000.D0/P)**
+     +                          (GAMMA* (1.D0+GAMMAMD*Q))*
+     +                          EXP((THTECON1/TLCL-THTECON2)*Q*
+     +                          (1.D0+THTECON3*Q))
+                          IF (ETH.GT.ETHMAX) THEN
+                              KLEV = K
+                              ETHMAX = ETH
+                          END IF
+                      END IF
+                  END DO
+                  KPAR1 = KLEV
+                  KPAR2 = KLEV
+c
+c      Establish average properties of that parcel
+c         (over depth of approximately davg meters)
+c
+c         davg=.1
+                  DAVG = 500.D0
+                  PAVG = DAVG*PRS(I,J,KPAR1)*GRAV/
+     +                   (RGAS*VIRTUAL(TMK(I,J,KPAR1),QVP(I,J,KPAR1)))
+                  P2 = MIN(PRS(I,J,KPAR1)+.5D0*PAVG,PRSF(I,J,MKZH))
+                  P1 = P2 - PAVG
+                  TOTTHE = 0.D0
+                  TOTQVP = 0.D0
+                  TOTPRS = 0.D0
+                  DO K = MKZH,2,-1
+                      IF (PRSF(I,J,K).LE.P1) GO TO 35
+                      IF (PRSF(I,J,K-1).GE.P2) GO TO 34
+                      P = PRS(I,J,K)
+                      PUP = PRSF(I,J,K)
+                      PDN = PRSF(I,J,K-1)
+                      Q = MAX(QVP(I,J,K),1.D-15)
+                      TH = TMK(I,J,K)* (1000.D0/P)**
+     +                     (GAMMA* (1.D0+GAMMAMD*Q))
+                      PP1 = MAX(P1,PDN)
+                      PP2 = MIN(P2,PUP)
+                      IF (PP2.GT.PP1) THEN
+                          DELTAP = PP2 - PP1
+                          TOTQVP = TOTQVP + Q*DELTAP
+                          TOTTHE = TOTTHE + TH*DELTAP
+                          TOTPRS = TOTPRS + DELTAP
+                      END IF
+   34                 CONTINUE
+                  END DO
+   35             CONTINUE
+                  QVPPARI = TOTQVP/TOTPRS
+                  TMKPARI = (TOTTHE/TOTPRS)*
+     +                      (PRS(I,J,KPAR1)/1000.D0)** (GAMMA*
+     +                      (1.D0+GAMMAMD*QVP(I,J,KPAR1)))
+              END IF
+c
+              DO KPAR = KPAR1,KPAR2
+c
+c   Calculate temperature and moisture properties of parcel
+c     (Note, qvppari and tmkpari already calculated above for 2D case.)
+c
+                  IF (I3DFLAG.EQ.1) THEN
+                      QVPPARI = QVP(I,J,KPAR)
+                      TMKPARI = TMK(I,J,KPAR)
+                  END IF
+                  PRSPARI = PRS(I,J,KPAR)
+                  GHTPARI = GHT(I,J,KPAR)
+                  GAMMAM = GAMMA* (1.D0+GAMMAMD*QVPPARI)
+                  CPM = CP* (1.D0+CPMD*QVPPARI)
+c
+                  E = MAX(1.D-20,QVPPARI*PRSPARI/ (EPS+QVPPARI))
+                  TLCL = TLCLC1/ (LOG(TMKPARI**TLCLC2/E)-TLCLC3) +
+     +                   TLCLC4
+                  ETHPARI = TMKPARI* (1000.D0/PRSPARI)**
+     +                      (GAMMA* (1.D0+GAMMAMD*QVPPARI))*
+     +                      EXP((THTECON1/TLCL-THTECON2)*QVPPARI*
+     +                      (1.D0+THTECON3*QVPPARI))
+                  ZLCL = GHTPARI + (TMKPARI-TLCL)/ (GRAV/CPM)
+c
+c   Calculate buoyancy and relative height of lifted parcel at
+c   all levels, and store in bottom up arrays.  Add a level at the LCL,
+c   and at all points where buoyancy is zero.
+c
+C  for arrays that go bottom to top
+                  KK = 0
+                  ILCL = 0
+                  IF (GHTPARI.GE.ZLCL) THEN
+c
+c      initial parcel already saturated or supersaturated.
+c
+                      ILCL = 2
+                      KLCL = 1
+                  END IF
+                  DO K = KPAR,1,-1
+C  for arrays that go bottom to top
+   33                 KK = KK + 1
+C  model level is below LCL
+                      IF (GHT(I,J,K).LT.ZLCL) THEN
+                          QVPLIFT = QVPPARI
+                          TMKLIFT = TMKPARI - GRAV/CPM*
+     +                              (GHT(I,J,K)-GHTPARI)
+                          TVENV = VIRTUAL(TMK(I,J,K),QVP(I,J,K))
+                          TVLIFT = VIRTUAL(TMKLIFT,QVPLIFT)
+                          GHTLIFT = GHT(I,J,K)
+                      ELSE IF (GHT(I,J,K).GE.ZLCL .AND. ILCL.EQ.0) THEN
+c
+c     This model level and previous model level straddle the LCL,
+c     so first create a new level in the bottom-up array, at the LCL.
+c
+                          TMKLIFT = TLCL
+                          QVPLIFT = QVPPARI
+                          FACDEN = GHT(I,J,K) - GHT(I,J,K+1)
+                          FAC1 = (ZLCL-GHT(I,J,K+1))/FACDEN
+                          FAC2 = (GHT(I,J,K)-ZLCL)/FACDEN
+                          TMKENV = TMK(I,J,K+1)*FAC2 + TMK(I,J,K)*FAC1
+                          QVPENV = QVP(I,J,K+1)*FAC2 + QVP(I,J,K)*FAC1
+                          TVENV = VIRTUAL(TMKENV,QVPENV)
+                          TVLIFT = VIRTUAL(TMKLIFT,QVPLIFT)
+                          GHTLIFT = ZLCL
+                          ILCL = 1
+                      ELSE
+                          TMKLIFT = TONPSADIABAT(ETHPARI,PRS(I,J,K),
+     +                              PSADITHTE,PSADIPRS,PSADITMK,GAMMA)
+                          ESLIFT = EZERO*EXP(ESLCON1* (TMKLIFT-CELKEL)/
+     +                             (TMKLIFT-ESLCON2))
+                          QVPLIFT = EPS*ESLIFT/ (PRS(I,J,K)-ESLIFT)
+                          TVENV = VIRTUAL(TMK(I,J,K),QVP(I,J,K))
+                          TVLIFT = VIRTUAL(TMKLIFT,QVPLIFT)
+                          GHTLIFT = GHT(I,J,K)
+                      END IF
+C  buoyancy
+                      BUOY(KK) = GRAV* (TVLIFT-TVENV)/TVENV
+                      ZREL(KK) = GHTLIFT - GHTPARI
+                      IF ((KK.GT.1).AND.
+     +                    (BUOY(KK)*BUOY(KK-1).LT.0.0D0)) THEN
+c
+c   Parcel ascent curve crosses sounding curve, so create a new level
+c   in the bottom-up array at the crossing.
+c
+                          KK = KK + 1
+                          BUOY(KK) = BUOY(KK-1)
+                          ZREL(KK) = ZREL(KK-1)
+                          BUOY(KK-1) = 0.D0
+                          ZREL(KK-1) = ZREL(KK-2) +
+     +                                 BUOY(KK-2)/ (BUOY(KK-2)-
+     +                                 BUOY(KK))* (ZREL(KK)-ZREL(KK-2))
+                      END IF
+                      IF (ILCL.EQ.1) THEN
+                          KLCL = KK
+                          ILCL = 2
+                          GO TO 33
+                      END IF
+                  END DO
+                  KMAX = KK
+                  IF (KMAX.GT.150) THEN
+                      print *,
+     +                  'capecalc3d: kmax got too big. kmax=',KMAX
+                      STOP
+                  END IF
+c
+c   If no LCL was found, set klcl to kmax.  It is probably not really
+c   at kmax, but this will make the rest of the routine behave
+c   properly.
+c
+                  IF (ILCL.EQ.0) KLCL=KMAX
+c
+c   Get the accumulated buoyant energy from the parcel's starting
+c   point, at all levels up to the top level.
+c
+                  BENACCUM(1) = 0.0D0
+                  BENAMIN = 9D9
+                  DO K = 2,KMAX
+                      DZ = ZREL(K) - ZREL(K-1)
+                      BENACCUM(K) = BENACCUM(K-1) +
+     +                              .5D0*DZ* (BUOY(K-1)+BUOY(K))
+                      IF (BENACCUM(K).LT.BENAMIN) THEN
+                          BENAMIN = BENACCUM(K)
+                      END IF
+                  END DO
+c
+c     Determine equilibrium level (EL), which we define as the highest
+c     level of non-negative buoyancy above the LCL. Note, this may be
+c     the top level if the parcel is still buoyant there.
+c
+                  DO K = KMAX,KLCL,-1
+                      IF (BUOY(K).GE.0.D0) THEN
+C  k of equilibrium level
+                          KEL = K
+                          GO TO 50
+                      END IF
+                  END DO
+c
+c   If we got through that loop, then there is no non-negative
+c   buoyancy above the LCL in the sounding.  In these situations,
+c   both CAPE and CIN will be set to -0.1 J/kg. (See below about
+c   missing values in V6.1.0). Also, where CAPE is
+c   non-zero, CAPE and CIN will be set to a minimum of +0.1 J/kg, so
+c   that the zero contour in either the CIN or CAPE fields will
+c   circumscribe regions of non-zero CAPE.
+c
+c   In V6.1.0 of NCL, we added a _FillValue attribute to the return
+c   value of this function. At that time we decided to change -0.1 
+c   to a more appropriate missing value, which is passed into this 
+c   routine as CMSG.
+c
+c                 CAPE(I,J,KPAR) = -0.1D0
+c                 CIN(I,J,KPAR) = -0.1D0
+                  CAPE(I,J,KPAR) = CMSG
+                  CIN(I,J,KPAR)  = CMSG
+                  KLFC = KMAX
+c
+                  GO TO 102
+c
+   50             CONTINUE
+c
+c   If there is an equilibrium level, then CAPE is positive.  We'll
+c   define the level of free convection (LFC) as the point below the
+c   EL, but at or above the LCL, where accumulated buoyant energy is a
+c   minimum.  The net positive area (accumulated buoyant energy) from
+c   the LFC up to the EL will be defined as the CAPE, and the net
+c   negative area (negative of accumulated buoyant energy) from the
+c   parcel starting point to the LFC will be defined as the convective
+c   inhibition (CIN).
+c
+c   First get the LFC according to the above definition.
+c
+                  BENAMIN = 9D9
+                  KLFC = KMAX
+                  DO K = KLCL,KEL
+                      IF (BENACCUM(K).LT.BENAMIN) THEN
+                          BENAMIN = BENACCUM(K)
+                          KLFC = K
+                      END IF
+                  END DO
+c
+c   Now we can assign values to cape and cin
+c
+                  CAPE(I,J,KPAR) = MAX(BENACCUM(KEL)-BENAMIN,0.1D0)
+                  CIN(I,J,KPAR) = MAX(-BENAMIN,0.1D0)
+c
+c   CIN is uninteresting when CAPE is small (< 100 J/kg), so set
+c   CIN to -0.1 (see note about missing values in V6.1.0) in 
+c   that case.
+c
+c   In V6.1.0 of NCL, we added a _FillValue attribute to the return
+c   value of this function. At that time we decided to change -0.1 
+c   to a more appropriate missing value, which is passed into this 
+c   routine as CMSG.
+c
+C                 IF (CAPE(I,J,KPAR).LT.100.D0) CIN(I,J,KPAR) = -0.1D0
+                  IF (CAPE(I,J,KPAR).LT.100.D0) CIN(I,J,KPAR) = CMSG
+  102             CONTINUE
+c
+              END DO
+c
+              IF (I3DFLAG.EQ.0) THEN
+                  CAPE(I,J,MKZH) = CAPE(I,J,KPAR1)
+                  CIN(I,J,MKZH) = CIN(I,J,KPAR1)
+C  meters AGL
+                  CIN(I,J,MKZH-1) = ZREL(KLCL) + GHTPARI - TER(I,J)
+C  meters AGL
+                  CIN(I,J,MKZH-2) = ZREL(KLFC) + GHTPARI - TER(I,J)
+              END IF
+c
+          END DO
+      END DO
+c
+      RETURN
+      END
+c                                                                     c
+c*********************************************************************c
+c                                                                     c
+C NCLFORTSTART
+      DOUBLE PRECISION FUNCTION TONPSADIABAT(THTE,PRS,PSADITHTE,
+     &                                       PSADIPRS,PSADITMK,GAMMA)
+      IMPLICIT NONE
+      DOUBLE PRECISION THTE
+      DOUBLE PRECISION PRS
+      DOUBLE PRECISION PSADITHTE
+      DOUBLE PRECISION PSADIPRS
+      DOUBLE PRECISION PSADITMK
+      DOUBLE PRECISION GAMMA
+C NCLEND
+      DOUBLE PRECISION FRACJT
+      DOUBLE PRECISION FRACJT2
+      DOUBLE PRECISION FRACIP
+      DOUBLE PRECISION FRACIP2
+      DIMENSION PSADITHTE(150),PSADIPRS(150),PSADITMK(150,150)
+      INTEGER IP, IPCH, JT, JTCH
+c                                                                     c
+c   This function gives the temperature (in K) on a moist adiabat
+c   (specified by thte in K) given pressure in hPa.  It uses a
+c   lookup table, with data that was generated by the Bolton (1980)
+c   formula for theta_e.
+c
+c     First check if pressure is less than min pressure in lookup table.
+c     If it is, assume parcel is so dry that the given theta-e value can
+c     be interpretted as theta, and get temperature from the simple dry
+c     theta formula.
+c
+      IF (PRS.LE.PSADIPRS(150)) THEN
+          TONPSADIABAT = THTE* (PRS/1000.D0)**GAMMA
+          RETURN
+      END IF
+c
+c   Otherwise, look for the given thte/prs point in the lookup table.
+c
+      DO JTCH = 1,150 - 1
+          IF (THTE.GE.PSADITHTE(JTCH) .AND.
+     +        THTE.LT.PSADITHTE(JTCH+1)) THEN
+              JT = JTCH
+              GO TO 213
+          END IF
+      END DO
+      JT = -1
+  213 CONTINUE
+      DO IPCH = 1,150 - 1
+          IF (PRS.LE.PSADIPRS(IPCH) .AND. PRS.GT.PSADIPRS(IPCH+1)) THEN
+              IP = IPCH
+              GO TO 215
+          END IF
+      END DO
+      IP = -1
+  215 CONTINUE
+      IF (JT.EQ.-1 .OR. IP.EQ.-1) THEN
+         print *,'capecalc3d: ',
+     +           'Outside of lookup table bounds. prs,thte=',
+     +      PRS,THTE
+          STOP
+      END IF
+      FRACJT = (THTE-PSADITHTE(JT))/ (PSADITHTE(JT+1)-PSADITHTE(JT))
+      FRACJT2 = 1.D0 - FRACJT
+      FRACIP = (PSADIPRS(IP)-PRS)/ (PSADIPRS(IP)-PSADIPRS(IP+1))
+      FRACIP2 = 1.D0 - FRACIP
+      IF (PSADITMK(IP,JT).GT.1D9 .OR. PSADITMK(IP+1,JT).GT.1D9 .OR.
+     +    PSADITMK(IP,JT+1).GT.1D9 .OR. PSADITMK(IP+1,JT+1).GT.1D9) THEN
+          print *,'capecalc3d: ',
+     +      'Tried to access missing temperature in lookup table.',
+     +      'Prs and Thte probably unreasonable. prs,thte=',PRS,THTE
+          STOP
+      END IF
+      TONPSADIABAT = FRACIP2*FRACJT2*PSADITMK(IP,JT) +
+     +               FRACIP*FRACJT2*PSADITMK(IP+1,JT) +
+     +               FRACIP2*FRACJT*PSADITMK(IP,JT+1) +
+     +               FRACIP*FRACJT*PSADITMK(IP+1,JT+1)
+c
+      RETURN
+      END
+c                                                                     c
+c*********************************************************************c
+      SUBROUTINE DLOOKUP_TABLE(PSADITHTE,PSADIPRS,PSADITMK,FNAME)
+      DOUBLE PRECISION PSADITHTE
+      DOUBLE PRECISION PSADIPRS
+      DOUBLE PRECISION PSADITMK
+c   Set up lookup table for getting temperature on a pseudoadiabat.
+c   (Borrow the unit number for the stationlist, just for the moment.)
+c
+C      CHARACTER*15 FNAME
+      CHARACTER*(*) FNAME
+      DIMENSION PSADITHTE(150),PSADIPRS(150),PSADITMK(150,150)
+
+C      FNAME = 'psadilookup.dat'
+      IUSTNLIST = 33
+      OPEN (UNIT=IUSTNLIST,FILE=FNAME,FORM='formatted',STATUS='old')
+      DO I = 1,14
+          READ (IUSTNLIST,FMT=*)
+      END DO
+      READ (IUSTNLIST,FMT=*) NTHTE,NPRS
+      IF (NTHTE.NE.150 .OR. NPRS.NE.150) THEN
+          WRITE (IUP,FMT=*)
+     +      'Number of pressure or theta_e levels in lookup table'
+          WRITE (IUP,FMT=*) 'file not = 150.  Check lookup table file.'
+          STOP
+      END IF
+      READ (IUSTNLIST,FMT=173) (PSADITHTE(JT),JT=1,NTHTE)
+      READ (IUSTNLIST,FMT=173) (PSADIPRS(IP),IP=1,NPRS)
+      READ (IUSTNLIST,FMT=173) ((PSADITMK(IP,JT),IP=1,NPRS),JT=1,NTHTE)
+  173 FORMAT (5D15.7)
+      CLOSE (IUSTNLIST)
+
+      RETURN
+      END
+c                                                                     c
+c*********************************************************************c
+c                                                                     c
+      SUBROUTINE DPFCALC(PRS,SFP,PF,MIY,MJX,MKZH,TER_FOLLOW)
+      DOUBLE PRECISION PRS
+      DOUBLE PRECISION SFP
+      DOUBLE PRECISION PF
+c
+c     Historically, this routine calculated the pressure at full sigma
+c     levels when RIP was specifically designed for MM4/MM5 output.
+c     With the new generalized RIP (Feb '02), this routine is still
+c     intended to calculate a set of pressure levels that bound the
+c     layers represented by the vertical grid points, although no such
+c     layer boundaries are assumed to be defined.  The routine simply
+c     uses the midpoint between the pressures of the vertical grid
+c     points as the bounding levels.  The array only contains mkzh
+c     levels, so the pressure of the top of the uppermost layer is
+c     actually excluded.  The kth value of pf is the lower bounding
+c     pressure for the layer represented by kth data level.  At the
+c     lower bounding level of the lowest model layer, it uses the
+c     surface pressure, unless the data set is pressure-level data, in
+c     which case it assumes the lower bounding pressure level is as far
+c     below the lowest vertical level as the upper bounding pressure
+c     level is above.
+c
+      DIMENSION PRS(MIY,MJX,MKZH),SFP(MIY,MJX),PF(MIY,MJX,MKZH)
+      INTEGER TER_FOLLOW
+c
+C  do j=1,mjx-1  Artifact of MM5
+      DO J = 1,MJX
+C  do i=1,miy-1  staggered grid
+          DO I = 1,MIY
+              DO K = 1,MKZH
+                  IF (K.EQ.MKZH) THEN
+C  terrain-following data
+                      IF (TER_FOLLOW.EQ.1) THEN
+                          PF(I,J,K) = SFP(I,J)
+C  pressure-level data
+                      ELSE
+                          PF(I,J,K) = .5D0* (3.D0*PRS(I,J,K)-
+     +                                PRS(I,J,K-1))
+                      END IF
+                  ELSE
+                      PF(I,J,K) = .5D0* (PRS(I,J,K+1)+PRS(I,J,K))
+                  END IF
+              END DO
+          END DO
+      END DO
+c
+      RETURN
+      END
+c======================================================================
+c
+c !IROUTINE: VIRTUAL -- Calculate virtual temperature (K)
+c
+c !DESCRIPTION:
+c
+c   This function returns a single value of virtual temperature in
+c   K, given temperature in K and mixing ratio in kg/kg.  For an
+c   array of virtual temperatures, use subroutine VIRTUAL_TEMP.
+c
+c !INPUT:
+c    RATMIX - water vapor mixing ratio (kg/kg)
+c    TEMP   - temperature (K)
+c
+c !OUTPUT:
+c    TV     - Virtual temperature (K)
+c
+c !ASSUMPTIONS:
+c
+c !REVISION HISTORY:
+c     2009-March  - Mark T. Stoelinga - from RIP4.5
+c     2010-August - J. Schramm - modified to run with NCL and ARW wrf output
+c
+c ------------------------------------------------------------------
+C NCLFORTSTART
+      DOUBLE PRECISION FUNCTION VIRTUAL(TEMP,RATMIX)
+      IMPLICIT NONE
+      DOUBLE PRECISION TEMP,RATMIX
+C NCLEND
+      DOUBLE PRECISION EPS
+      EPS = 0.622D0
+      VIRTUAL = TEMP* (EPS+RATMIX)/ (EPS* (1.D0+RATMIX))
+      RETURN
+      END

wrf_open/var/ncl_reference/wrf_bint3d.f

@@ -0,0 +1,402 @@
+C
+C premaptform.f and maptform.f copied from RIP/src
+C By So-Young Ha on Sep 29, 2005.
+C
+C
+C NCLFORTSTART
+      SUBROUTINE DMAPTFORM(DSKMC,MIYCORS,MJXCORS,NPROJ,XLATC,XLONC,
+     +                     TRUE1,TRUE2,RIY,RJX,RLAT,RLON,IDIR)
+C
+C Input vars:        DSKMC, MIYCORS, MJXCORS, NPROJ, XLATC, XLONC,
+C                    NPROJ, IDIR
+C Input/output vars: RIY, RIX, RLAT
+C Output vars:       TRUE1, TRUE2, RLON 
+C 
+C
+C Possible NCL interface:
+C
+C   wrf_maptform(dskmc, miycors, mjxcors, nproj, xlatc, xlonc, riy, rjx,
+C                idir, rlat, rlon, opts)
+C
+C where opts could contain the TRUE1 and TRUE2 information in some fashion.
+C
+      DOUBLE PRECISION PI_MPTF
+      DOUBLE PRECISION RPD_MPTF
+      DOUBLE PRECISION REARTH_MPTF
+      DOUBLE PRECISION DSKMC_MPTF
+      DOUBLE PRECISION XLONC_MPTF
+      DOUBLE PRECISION CIY_MPTF
+      DOUBLE PRECISION CJX_MPTF
+      DOUBLE PRECISION CONE_MPTF
+      DOUBLE PRECISION CONEI_MPTF
+      DOUBLE PRECISION C1_MPTF
+      DOUBLE PRECISION C2_MPTF
+      DOUBLE PRECISION YC_MPTF
+      DOUBLE PRECISION COTRUE1
+      DOUBLE PRECISION YPOINT
+      DOUBLE PRECISION XPOINT
+      DOUBLE PRECISION DLON
+C
+c   This routine converts a coarse domain dot grid point, <riy,rjx>,
+c   into a lat/lon point <rlat,rlon> if idir=1, or vice versa if
+c   idir=-1. It works for Lambert Conformal (LC,1),
+c   Polar Stereographic (ST,2), or Mercator (ME,3) projections,
+c   with any true latitide(s).
+c   It is assumed that premaptform has been called prior to this so
+c   that the proper constants have been placed in the common block
+c   called mptf, which should be declared in (and only in) the
+c   main program and routines maptform (this routine) and premaptform.
+c
+
+C Input, Output Args
+      INTEGER MIYCORS,MJXCORS,NPROJ
+      DOUBLE PRECISION DSKMC,XLATC,XLONC,TRUE1,TRUE2
+      INTEGER IDIR
+C Latitude (-90->90 deg N)
+      DOUBLE PRECISION RLAT
+C Longitude (-180->180 E)
+      DOUBLE PRECISION RLON
+C Cartesian X coordinate
+      DOUBLE PRECISION RIY
+C Cartesian Y coordinate
+      DOUBLE PRECISION RJX
+C NCLEND
+
+
+c ===========
+c premaptform
+c ===========
+C 3.1415...
+      PI_MPTF = 4.D0*ATAN(1.D0)
+C radians per degree
+      RPD_MPTF = PI_MPTF/180.D0
+C radius of planet, in km
+      REARTH_MPTF = 6370.949D0
+      DSKMC_MPTF = DSKMC
+      XLONC_MPTF = XLONC
+      NPROJ_MPTF = NPROJ
+      CIY_MPTF = .5D0* (1.D0+MIYCORS)
+      CJX_MPTF = .5D0* (1.D0+MJXCORS)
+c
+C Mercator
+      IF (NPROJ_MPTF.EQ.3) THEN
+c
+          TRUE1 = 0.D0
+          TRUE2 = 0.D0
+          IHM_MPTF = 1
+          CONE_MPTF = 1.D0
+          CONEI_MPTF = 1.D0
+          C1_MPTF = 1.D0
+          C2_MPTF = 1.D0
+          YC_MPTF = REARTH_MPTF*LOG((1.D0+SIN(RPD_MPTF*XLATC))/
+     +              COS(RPD_MPTF*XLATC))
+c
+C Lambert Comformal or Polar Stereographic
+      ELSE
+c
+c   Make sure xlatc, true1, and true2 are all in same hemisphere,
+c      and calculate ihm_mptf.
+c
+          IF (XLATC.GT.0.D0 .AND. TRUE1.GT.0.D0 .AND.
+     +        TRUE2.GT.0.D0) THEN
+              IHM_MPTF = 1
+          ELSE IF (XLATC.LT.0.D0 .AND. TRUE1.LT.0.D0 .AND.
+     +             TRUE2.LT.0.D0) THEN
+              IHM_MPTF = -1
+          ELSE
+              WRITE (*,FMT=*) 'Invalid latitude parameters for map.'
+              STOP
+          END IF
+c
+c   Calculate cone factor
+c
+          IF (NPROJ_MPTF.EQ.1) THEN
+              IF (TRUE1.NE.TRUE2) THEN
+                  CONE_MPTF = LOG10(COS(RPD_MPTF*TRUE1)/
+     +                        COS(RPD_MPTF*TRUE2))/
+     +                        LOG10(TAN(.25D0*PI_MPTF-
+     +                        IHM_MPTF*.5D0*RPD_MPTF*TRUE1)/
+     +                        TAN(.25D0*PI_MPTF-IHM_MPTF*.5D0*RPD_MPTF*
+     +                        TRUE2))
+              ELSE
+                  CONE_MPTF = COS(RPD_MPTF* (90.D0-IHM_MPTF*TRUE1))
+              END IF
+          ELSE IF (NPROJ_MPTF.EQ.2) THEN
+              CONE_MPTF = 1.D0
+          END IF
+c
+c   Calculate other constants
+c
+          CONEI_MPTF = 1.D0/CONE_MPTF
+          COTRUE1 = IHM_MPTF*90.D0 - TRUE1
+          IF (NPROJ_MPTF.EQ.1) THEN
+              C1_MPTF = REARTH_MPTF*SIN(RPD_MPTF*COTRUE1)/
+     +                  (CONE_MPTF* (IHM_MPTF*TAN(.5D0*RPD_MPTF*
+     +                  COTRUE1))**CONE_MPTF)
+              C2_MPTF = TAN(.5D0*RPD_MPTF*COTRUE1)*
+     +                  (CONE_MPTF/ (IHM_MPTF*REARTH_MPTF*SIN(RPD_MPTF*
+     +                  COTRUE1)))**CONEI_MPTF
+              YC_MPTF = -C1_MPTF* (IHM_MPTF*
+     +                  TAN(.25D0* (IHM_MPTF*PI_MPTF-
+     +                  2.D0*RPD_MPTF*XLATC)))**CONE_MPTF
+          ELSE IF (NPROJ_MPTF.EQ.2) THEN
+              C1_MPTF = 1.D0 + COS(RPD_MPTF*COTRUE1)
+              C2_MPTF = 1.D0
+              YC_MPTF = -REARTH_MPTF*SIN(.5D0*IHM_MPTF*PI_MPTF-
+     +                  RPD_MPTF*XLATC)*C1_MPTF/
+     +                  (1.D0+COS(.5D0*IHM_MPTF*PI_MPTF-RPD_MPTF*XLATC))
+          END IF
+c
+      END IF
+
+c ========
+c maptform
+c ========
+
+      IF (RLAT.EQ.-90.D0) PRINT *,'maptform:',RIY,RJX,RLAT,RLON,IDIR
+
+C First, deal with idir=1
+      IF (IDIR.EQ.1) THEN
+c
+          YPOINT = (RIY-CIY_MPTF)*DSKMC_MPTF + YC_MPTF
+          XPOINT = (RJX-CJX_MPTF)*DSKMC_MPTF
+c
+          IF (NPROJ_MPTF.EQ.3) THEN
+              RLAT = (2.D0*ATAN(EXP(YPOINT/REARTH_MPTF))-.5D0*PI_MPTF)/
+     +               RPD_MPTF
+              RLON = XLONC_MPTF + (XPOINT/REARTH_MPTF)/RPD_MPTF
+          ELSE IF (NPROJ_MPTF.EQ.1) THEN
+              RLAT = (.5D0*IHM_MPTF*PI_MPTF-
+     +               2.D0*ATAN(C2_MPTF* (SQRT(XPOINT**2+
+     +               YPOINT**2))**CONEI_MPTF))/RPD_MPTF
+              RLON = XLONC_MPTF + (CONEI_MPTF*
+     +               ATAN2(XPOINT,-IHM_MPTF*YPOINT))/RPD_MPTF
+          ELSE IF (NPROJ_MPTF.EQ.2) THEN
+              RLAT = (.5D0*IHM_MPTF*PI_MPTF-
+     +               IHM_MPTF*2.D0*ATAN(SQRT(XPOINT**2+
+     +               YPOINT**2)/ (REARTH_MPTF*C1_MPTF)))/RPD_MPTF
+              IF (XPOINT.EQ.0.D0 .AND. YPOINT.EQ.0.D0) THEN
+                  RLON = XLONC_MPTF
+              ELSE
+                  RLON = XLONC_MPTF + (ATAN2(XPOINT,-IHM_MPTF*YPOINT))/
+     +                   RPD_MPTF
+              END IF
+          END IF
+          RLON = MOD(RLON+900.D0,360.D0) - 180.D0
+c
+C Otherwise, deal with idir=-1
+      ELSE
+c
+          DLON = RLON - XLONC_MPTF
+          IF (DLON.LT.-180.D0) DLON = DLON + 360
+          IF (DLON.GT.180.D0) DLON = DLON - 360
+          IF (NPROJ_MPTF.EQ.3) THEN
+              YPOINT = REARTH_MPTF*LOG((1.D0+SIN(RPD_MPTF*RLAT))/
+     +                 COS(RPD_MPTF*RLAT))
+              XPOINT = DLON*RPD_MPTF*REARTH_MPTF
+          ELSE IF (NPROJ_MPTF.EQ.1) THEN
+              YPOINT = -C1_MPTF* (IHM_MPTF*
+     +                 TAN(.25D0* (IHM_MPTF*PI_MPTF-2.D0*RPD_MPTF*
+     +                 RLAT)))**CONE_MPTF*COS(CONE_MPTF*RPD_MPTF*DLON)
+              XPOINT = IHM_MPTF*C1_MPTF* (IHM_MPTF*
+     +                 TAN(.25D0* (IHM_MPTF*PI_MPTF-
+     +                 2.D0*RPD_MPTF*RLAT)))**CONE_MPTF*
+     +                 SIN(CONE_MPTF*RPD_MPTF*DLON)
+          ELSE IF (NPROJ_MPTF.EQ.2) THEN
+              YPOINT = -REARTH_MPTF*SIN(.5D0*IHM_MPTF*PI_MPTF-
+     +                 RPD_MPTF*RLAT)*C1_MPTF/ (1.D0+
+     +                 COS(.5D0*IHM_MPTF*PI_MPTF-RPD_MPTF*RLAT))*
+     +                 COS(RPD_MPTF*DLON)
+              XPOINT = IHM_MPTF*REARTH_MPTF*
+     +                 SIN(.5D0*IHM_MPTF*PI_MPTF-RPD_MPTF*RLAT)*C1_MPTF/
+     +                 (1.D0+COS(.5D0*IHM_MPTF*PI_MPTF-RPD_MPTF*RLAT))*
+     +                 SIN(RPD_MPTF*DLON)
+          END IF
+          RIY = (YPOINT-YC_MPTF)/DSKMC_MPTF + CIY_MPTF
+          RJX = XPOINT/DSKMC_MPTF + CJX_MPTF
+c
+      END IF
+
+      RETURN
+      END
+
+C********************************************************
+C NCLFORTSTART
+      SUBROUTINE DBINT3D(DATA_OUT,OBSII,OBSJJ,DATA_IN,NX,NY,NZ,NOBSICRS,
+     +                   NOBSJCRS,ICRS,JCRS)
+C
+C Possible NCL interface:
+C
+C    data_out = wrf_bint3d(data_in,obsii,obsjj,icrs,jcrs)
+C
+C     !!! 1_based_array (cols x rows) in fortran <=> 0_based_array
+C      (rows x cols) in NCL !!!
+C     !!! Include K-index to make a 3-D array !!!
+C
+C     INPUT VARIABLES
+C     ---------------
+      INTEGER ICRS,JCRS,NX,NY,NZ
+      INTEGER NOBSJCRS,NOBSICRS
+      DOUBLE PRECISION OBSII(NOBSICRS,NOBSJCRS)
+      DOUBLE PRECISION OBSJJ(NOBSICRS,NOBSJCRS)
+      DOUBLE PRECISION DATA_IN(NX,NY,NZ)
+
+C     OUTPUT
+C     ---------------
+      DOUBLE PRECISION DATA_OUT(NOBSICRS,NOBSJCRS,NZ)
+C NCLEND
+
+C     LOCAL
+      DOUBLE PRECISION OBSI,OBSJ
+      DOUBLE PRECISION DATA_OBS
+C
+
+      DO K = 1,NZ
+          DO J = 1,NOBSJCRS
+              DO I = 1,NOBSICRS
+C grid index in lon
+                  OBSI = OBSII(I,J)
+C grid index in lat
+                  OBSJ = OBSJJ(I,J)
+                  DATA_OBS = 0.0D0
+                  CALL DBINT(DATA_OBS,OBSI,OBSJ,DATA_IN(1,1,K),NX,NY,
+     +                       ICRS,JCRS)
+                  DATA_OUT(I,J,K) = DATA_OBS
+              END DO
+          END DO
+      END DO
+
+      RETURN
+      END
+
+
+      SUBROUTINE DBINT(PP,XX,YY,LIST,III,JJJ,ICRS,JCRS)
+      DOUBLE PRECISION PP
+      DOUBLE PRECISION X
+      DOUBLE PRECISION Y
+      DOUBLE PRECISION A
+      DOUBLE PRECISION B
+      DOUBLE PRECISION C
+      DOUBLE PRECISION D
+      DOUBLE PRECISION E
+      DOUBLE PRECISION F
+      DOUBLE PRECISION G
+      DOUBLE PRECISION H
+      DOUBLE PRECISION QQ
+C
+C --- BI-LINEAR INTERPOLATION AMONG FOUR GRID VALUES
+C
+C     INPUT : LIST, XX, YY
+C     OUTPUT: PP
+C
+      INTEGER ICRS,JCRS,III,JJJ
+      DOUBLE PRECISION XX,YY
+      DOUBLE PRECISION LIST(III,JJJ),STL(4,4)
+
+C MASS GRID IN WRF (I-> west-east, J-> south-north)
+C
+      IB = III - ICRS
+      JB = JJJ - JCRS
+      PP = 0.0D0
+      N = 0
+      I = INT(XX+0.00001D0)
+      J = INT(YY+0.00001D0)
+      X = XX - I
+      Y = YY - J
+      IF ((ABS(X).GT.0.00001D0) .OR. (ABS(Y).GT.0.00001D0)) THEN
+C
+          DO 2 K = 1,4
+              KK = I + K
+              DO 2 L = 1,4
+                  STL(K,L) = 0.D0
+                  LL = J + L
+                  IF ((KK.GE.1) .AND. (KK.LE.IB) .AND. (LL.LE.JB) .AND.
+     +                (LL.GE.1)) THEN
+                      STL(K,L) = LIST(KK,LL)
+                      N = N + 1
+C .. a zero value inside the domain being set to 1.E-12:
+                      IF (STL(K,L).EQ.0.D0) STL(K,L) = 1.D-12
+                  END IF
+    2     CONTINUE
+C
+          CALL DONED(A,X,STL(1,1),STL(2,1),STL(3,1),STL(4,1))
+          CALL DONED(B,X,STL(1,2),STL(2,2),STL(3,2),STL(4,2))
+          CALL DONED(C,X,STL(1,3),STL(2,3),STL(3,3),STL(4,3))
+          CALL DONED(D,X,STL(1,4),STL(2,4),STL(3,4),STL(4,4))
+C
+C .. CHECK TANGENT LINEAR OF ONED, SAVE BASIC STATE:
+C      WRITE(20) XX,YY,Y,A,B,C,D
+C
+          CALL DONED(PP,Y,A,B,C,D)
+          IF (N.NE.16) THEN
+              CALL DONED(E,Y,STL(1,1),STL(1,2),STL(1,3),STL(1,4))
+              CALL DONED(F,Y,STL(2,1),STL(2,2),STL(2,3),STL(2,4))
+              CALL DONED(G,Y,STL(3,1),STL(3,2),STL(3,3),STL(3,4))
+              CALL DONED(H,Y,STL(4,1),STL(4,2),STL(4,3),STL(4,4))
+C .. CHECK TANGENT LINEAR OF ONED, SAVE BASIC STATE:
+C      WRITE(20) XX,YY,X,E,F,G,H
+C
+              CALL DONED(QQ,X,E,F,G,H)
+              PP = (PP+QQ)*0.5D0
+          END IF
+C
+      ELSE
+C
+          PP = LIST(I,J)
+      END IF
+C
+      RETURN
+      END
+
+
+
+      SUBROUTINE DONED(Y,X,A,B,C,D)
+      DOUBLE PRECISION Y
+      DOUBLE PRECISION X
+      DOUBLE PRECISION A
+      DOUBLE PRECISION B
+      DOUBLE PRECISION C
+      DOUBLE PRECISION D
+      DOUBLE PRECISION ONE
+C
+C ..  Input : X, A, B, C, D
+C     Output: Y
+C       1, 2, 3, and 4 points interpolation:
+C       In this subroutine, the zero value of A, B, C, D means that
+C       point outside the domain.
+C
+C .. 1-point:
+C .. take the value at the second point:
+      IF (X.EQ.0.D0) THEN
+          ONE = B
+C .. take the value at the third point:
+      ELSE IF (X.EQ.1.D0) THEN
+          ONE = C
+C .. the point X outside the range:
+      ELSE IF (B*C.EQ.0.D0) THEN
+          ONE = 0.D0
+      ELSE
+          IF (A*D.EQ.0.D0) THEN
+C .. 3-point interpolation:
+              IF (A.NE.0.D0) THEN
+                  ONE = B + X* (0.5D0* (C-A)+X* (0.5D0* (C+A)-B))
+              ELSE IF (D.NE.0.D0) THEN
+                  ONE = C + (1.0D0-X)* (0.5D0* (B-D)+
+     +                  (1.0D0-X)* (0.5D0* (B+D)-C))
+              ELSE
+C .. 2-point interpolation:
+                  ONE = B* (1.0D0-X) + C*X
+              END IF
+          ELSE
+C .. 4-point interpolation:
+              ONE = (1.0D0-X)* (B+X* (0.5D0* (C-A)+X* (0.5D0* (C+A)-B)))
+     +              + X* (C+ (1.0D0-X)* (0.5D0* (B-D)+ (1.0D0-
+     +              X)* (0.5D0* (B+D)-C)))
+          END IF
+      END IF
+C
+      Y = ONE
+C
+      RETURN
+
+      END

wrf_open/var/ncl_reference/wrf_cloud_topW.c

@@ -0,0 +1,763 @@
+#include <stdio.h>
+#include "wrapper.h"
+
+extern void NGCALLF(wrfcttcalc,WRFCTTCALC)(double *, double *, double *, 
+                                           double *, double *, double *, 
+                                           double *, double *, int *, 
+                                           int *, int *, int *);
+
+extern NclDimRec *get_wrf_dim_info(int,int,int,ng_size_t*);
+
+
+NhlErrorTypes wrf_ctt_W( void )
+{
+
+/*
+ * Input variables
+ */
+/*
+ * Argument # 0
+ */
+  void *pres;
+  double *tmp_pres;
+  int       ndims_pres;
+  ng_size_t dsizes_pres[NCL_MAX_DIMENSIONS];
+  NclBasicDataTypes type_pres;
+
+/*
+ * Argument # 1
+ */
+  void *tk;
+  double *tmp_tk;
+  int       ndims_tk;
+  ng_size_t dsizes_tk[NCL_MAX_DIMENSIONS];
+  NclBasicDataTypes type_tk;
+
+/*
+ * Argument # 2
+ */
+  void *qci;
+  double *tmp_qci;
+  int       ndims_qci;
+  ng_size_t dsizes_qci[NCL_MAX_DIMENSIONS];
+  NclBasicDataTypes type_qci;
+
+/*
+ * Argument # 3
+ */
+  void *qcw;
+  double *tmp_qcw;
+  int       ndims_qcw;
+  ng_size_t dsizes_qcw[NCL_MAX_DIMENSIONS];
+  NclBasicDataTypes type_qcw;
+
+/*
+ * Argument # 4
+ */
+  void *qvp;
+  double *tmp_qvp;
+  int       ndims_qvp;
+  ng_size_t dsizes_qvp[NCL_MAX_DIMENSIONS];
+  NclBasicDataTypes type_qvp;
+
+/*
+ * Argument # 5
+ */
+  void *ght;
+  double *tmp_ght;
+  int       ndims_ght;
+  ng_size_t dsizes_ght[NCL_MAX_DIMENSIONS];
+  NclBasicDataTypes type_ght;
+
+/*
+ * Argument # 6
+ */
+  void *ter;
+  double *tmp_ter;
+  int       ndims_ter;
+  ng_size_t dsizes_ter[NCL_MAX_DIMENSIONS];
+  NclBasicDataTypes type_ter;
+
+/*
+ * Arguments # 7
+ */
+  int *haveqci;
+
+/*
+ * Variable for getting/setting dimension name info.
+ */
+  NclDimRec *dim_info      = NULL;
+  NclDimRec *dim_info_ght = NULL;
+
+/*
+ * Return variable and attributes
+ */
+  void *ctt;
+  NclQuark *description, *units;
+  char *cdescription, *cunits;
+  double *tmp_ctt;
+  int       ndims_ctt;
+  ng_size_t *dsizes_ctt;
+  NclBasicDataTypes type_ctt;
+  NclObjClass type_obj_ctt;
+  
+/*
+ * Various
+ */
+  ng_size_t nlev, nlat, nlon, nlevlatlon, nlatlon;
+  ng_size_t index_pres, index_ter, index_ctt;
+  ng_size_t i, size_leftmost, size_output;
+  int inlev, inlat, inlon;
+
+/*
+ * Variables for returning the output array with attributes attached.
+ */
+  int att_id;
+  ng_size_t dsizes[1];
+  NclMultiDValData att_md, return_md;
+  NclVar tmp_var;
+  NclStackEntry return_data;
+
+/*
+ * Retrieve parameters.
+ *
+ * Note any of the pointer parameters can be set to NULL, which
+ * implies you don't care about its value.
+ */
+/*
+ * Get argument # 0
+ */
+
+/*
+ * Get argument # 1
+ */
+  pres = (void*)NclGetArgValue(
+           0,
+           8,
+           &ndims_pres,
+           dsizes_pres,
+           NULL,
+           NULL,
+           &type_pres,
+           DONT_CARE);
+
+  if(ndims_pres < 3 || ndims_pres > 4) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: The pres array must be 3D or 4D");
+    return(NhlFATAL);
+  }
+
+  nlev = dsizes_pres[ndims_pres-3];
+  nlat = dsizes_pres[ndims_pres-2];
+  nlon = dsizes_pres[ndims_pres-1];
+
+/*
+ * Test dimension sizes.
+ */
+  if(nlev > INT_MAX || nlat > INT_MAX || nlon > INT_MAX) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: one of bottom_top, south_north, or west_east is greater than INT_MAX");
+    return(NhlFATAL);
+  }
+  inlev = (int) nlev;
+  inlat = (int) nlat;
+  inlon = (int) nlon;
+
+/*
+ * Get argument # 1
+ */
+  tk = (void*)NclGetArgValue(
+           1,
+           8,
+           &ndims_tk,
+           dsizes_tk,
+           NULL,
+           NULL,
+           &type_tk,
+           DONT_CARE);
+
+/*
+ * Check dimension sizes.
+ */
+  if(ndims_tk != ndims_pres) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: The tk and pres arrays must have the same dimensionality");
+    return(NhlFATAL);
+  }
+  else {
+    for(i = 0; i < ndims_pres; i++) {
+      if(dsizes_tk[i] != dsizes_pres[i]) {
+        NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: The tk and pres arrays must have the same dimensionality");
+        return(NhlFATAL);
+      }
+    }
+  }
+
+
+/*
+ * Get argument # 2
+ */
+  qci = (void*)NclGetArgValue(
+           2,
+           8,
+           &ndims_qci,
+           dsizes_qci,
+           NULL,
+           NULL,
+           &type_qci,
+           DONT_CARE);
+
+/*
+ * Check dimension sizes.
+ */
+  if(ndims_qci != ndims_pres) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: The qci and pres arrays must have the same dimensionality");
+    return(NhlFATAL);
+  }
+  else {
+    for(i = 0; i < ndims_pres; i++) {
+      if(dsizes_qci[i] != dsizes_pres[i]) {
+        NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: The qci and pres arrays must have the same dimensionality");
+        return(NhlFATAL);
+      }
+    }
+  }
+
+/*
+ * Get argument # 3
+ */
+  qcw = (void*)NclGetArgValue(
+           3,
+           8,
+           &ndims_qcw,
+           dsizes_qcw,
+           NULL,
+           NULL,
+           &type_qcw,
+           DONT_CARE);
+
+/*
+ * Check dimension sizes.
+ */
+  if(ndims_qcw != ndims_pres) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: The qcw and pres arrays must have the same dimensionality");
+    return(NhlFATAL);
+  }
+  else {
+    for(i = 0; i < ndims_pres; i++) {
+      if(dsizes_qcw[i] != dsizes_pres[i]) {
+        NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: The qcw and pres arrays must have the same dimensionality");
+        return(NhlFATAL);
+      }
+    }
+  }
+
+/*
+ * Get argument # 4
+ */
+  qvp = (void*)NclGetArgValue(
+           4,
+           8,
+           &ndims_qvp,
+           dsizes_qvp,
+           NULL,
+           NULL,
+           &type_qvp,
+           DONT_CARE);
+
+/*
+ * Check dimension sizes.
+ */
+  if(ndims_qvp != ndims_pres) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: The qvp and pres arrays must have the same dimensionality");
+    return(NhlFATAL);
+  }
+  else {
+    for(i = 0; i < ndims_pres; i++) {
+      if(dsizes_qvp[i] != dsizes_pres[i]) {
+        NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: The qvp and pres arrays must have the same dimensionality");
+        return(NhlFATAL);
+      }
+    }
+  }
+
+/*
+ * Get argument # 5
+ */
+  ght = (void*)NclGetArgValue(
+           5,
+           8,
+           &ndims_ght,
+           dsizes_ght,
+           NULL,
+           NULL,
+           &type_ght,
+           DONT_CARE);
+
+/*
+ * Check dimension sizes.
+ */
+  if(ndims_ght != ndims_pres) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: The ght and pres arrays must have the same dimensionality");
+    return(NhlFATAL);
+  }
+  else {
+    for(i = 0; i < ndims_pres; i++) {
+      if(dsizes_ght[i] != dsizes_pres[i]) {
+        NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: The ght and pres arrays must have the same dimensionality");
+        return(NhlFATAL);
+      }
+    }
+  }
+
+/*
+ * Get argument # 6
+ */
+  ter = (void*)NclGetArgValue(
+           6,
+           8,
+           &ndims_ter,
+           dsizes_ter,
+           NULL,
+           NULL,
+           &type_ter,
+           DONT_CARE);
+
+/*
+ * Check dimension sizes for ter.  It can either be 2D, or one fewer
+ * dimensions than pres.
+ */
+  if(ndims_ter != 2 && ndims_ter != (ndims_pres-1)) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: ter must either be a 2D array dimensioned south_north x west_east or it must have the same dimensionality as the pres array, minus the level dimension");
+    return(NhlFATAL);
+  }
+
+  if(ndims_ter == 2) {
+    if(dsizes_ter[0] != nlat || dsizes_ter[1] != nlon) {
+      NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: The dimensions of ter must be south_north x west_east");
+      return(NhlFATAL);
+    }
+  }
+  else {
+    for(i = 0; i < ndims_pres-3; i++) {
+      if(dsizes_ter[i] != dsizes_pres[i]) {
+        NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: ter must either be a 2D array dimensioned south_north x west_east or it must have the same dimensionality as the pres array, minus the level dimension");
+        return(NhlFATAL);
+      }
+    }
+  }
+
+
+/*
+ * Get argument # 7
+ */
+  haveqci = (int*)NclGetArgValue(
+           7,
+           8,
+           NULL,
+           NULL,
+           NULL,
+           NULL,
+           NULL,
+           DONT_CARE);
+
+/*
+ * Calculate size of leftmost dimensions.
+ */
+  size_leftmost  = 1;
+  for(i = 0; i < ndims_pres-3; i++) size_leftmost *= dsizes_pres[i];
+
+/* 
+ * Allocate space for coercing input arrays.  If any of the input
+ * is already double, then we don't need to allocate space for
+ * temporary arrays, because we'll just change the pointer into
+ * the void array appropriately.
+ */
+/*
+ * Allocate space for tmp_pres.
+ */
+  nlatlon    = nlat * nlon;
+  nlevlatlon = nlev * nlatlon;
+
+  if(type_pres != NCL_double) {
+    tmp_pres = (double *)calloc(nlevlatlon,sizeof(double));
+    if(tmp_pres == NULL) {
+      NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: Unable to allocate memory for coercing pressure array to double");
+      return(NhlFATAL);
+    }
+  }
+
+/*
+ * Allocate space for tmp_tk.
+ */
+  if(type_tk != NCL_double) {
+    tmp_tk = (double *)calloc(nlevlatlon,sizeof(double));
+    if(tmp_tk == NULL) {
+      NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: Unable to allocate memory for coercing tk array to double");
+      return(NhlFATAL);
+    }
+  }
+
+/*
+ * Allocate space for tmp_qci.
+ */
+  if(type_qci != NCL_double) {
+    tmp_qci = (double *)calloc(nlevlatlon,sizeof(double));
+    if(tmp_qci == NULL) {
+      NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: Unable to allocate memory for coercing qci array to double");
+      return(NhlFATAL);
+    }
+  }
+
+/*
+ * Allocate space for tmp_qcw.
+ */
+  if(type_qcw != NCL_double) {
+    tmp_qcw = (double *)calloc(nlevlatlon,sizeof(double));
+    if(tmp_qcw == NULL) {
+      NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: Unable to allocate memory for coercing qcw array to double");
+      return(NhlFATAL);
+    }
+  }
+
+/*
+ * Allocate space for tmp_qvp.
+ */
+  if(type_qvp != NCL_double) {
+    tmp_qvp = (double *)calloc(nlevlatlon,sizeof(double));
+    if(tmp_qvp == NULL) {
+      NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: Unable to allocate memory for coercing qvp array to double");
+      return(NhlFATAL);
+    }
+  }
+
+/*
+ * Allocate space for tmp_ght.
+ */
+  if(type_ght != NCL_double) {
+    tmp_ght = (double *)calloc(nlevlatlon,sizeof(double));
+    if(tmp_ght == NULL) {
+      NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: Unable to allocate memory for coercing ght array to double");
+      return(NhlFATAL);
+    }
+  }
+
+/*
+ * Coerce ter to double, if necessary.
+ */
+  if(ndims_ter == 2) {
+    tmp_ter = coerce_input_double(ter,type_ter,nlatlon,0,NULL,NULL);
+    if(tmp_ter == NULL) {
+      NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: Unable to allocate memory for coercing ter array to double");
+      return(NhlFATAL);
+    }
+  }
+  else {
+/*
+ * Allocate space for tmp_ter.
+ */
+    if(type_ter != NCL_double) {
+      tmp_ter = (double *)calloc(nlatlon,sizeof(double));
+      if(tmp_ter == NULL) {
+        NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: Unable to allocate memory for coercing ter array to double");
+        return(NhlFATAL);
+      }
+    }
+  }
+
+
+/*
+ * The output type defaults to float, unless one or more input 
+ * arrays are double.
+ */
+  if(type_pres == NCL_double || type_tk  == NCL_double || 
+     type_qci  == NCL_double || type_qcw == NCL_double || 
+     type_qvp  == NCL_double || type_ght == NCL_double || 
+     type_ter  == NCL_double) {
+    type_ctt     = NCL_double;
+    type_obj_ctt = nclTypedoubleClass;
+  }
+  else {
+    type_ctt     = NCL_float;
+    type_obj_ctt = nclTypefloatClass;
+  }
+
+/* 
+ * Allocate space for output array.
+ */
+  size_output = size_leftmost * nlatlon;
+  if(type_ctt != NCL_double) {
+    ctt = (void *)calloc(size_output, sizeof(float));
+    tmp_ctt = (double *)calloc(nlatlon,sizeof(double));
+    if(ctt == NULL || tmp_ctt == NULL) {
+      NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: Unable to allocate memory for temporary output array");
+      return(NhlFATAL);
+    }
+  }
+  else {
+    ctt = (void *)calloc(size_output, sizeof(double));
+    if(ctt == NULL) {
+      NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: Unable to allocate memory for output array");
+      return(NhlFATAL);
+    }
+  }
+
+/* 
+ * Allocate space for output dimension sizes and set them.
+ */
+  ndims_ctt  = ndims_pres-1;
+  dsizes_ctt = (ng_size_t*)calloc(ndims_ctt,sizeof(ng_size_t));  
+  if( dsizes_ctt == NULL ) {
+    NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: Unable to allocate memory for holding dimension sizes");
+    return(NhlFATAL);
+  }
+  for(i = 0; i < ndims_ctt-2; i++) dsizes_ctt[i] = dsizes_pres[i];
+  dsizes_ctt[ndims_ctt-2] = nlat;
+  dsizes_ctt[ndims_ctt-1] = nlon;
+
+/*
+ * Get dimension info to see if we have named dimensions.
+ * Using "ght" here, because it is more likely than "pres"
+ * to have metadata attached to it. 
+ * 
+ * This will be used for return variable.
+ */
+  dim_info_ght = get_wrf_dim_info(5,8,ndims_ght,dsizes_ght);
+  if(dim_info_ght != NULL) {
+    dim_info = malloc(sizeof(NclDimRec)*ndims_ctt);
+    if(dim_info == NULL) {
+      NhlPError(NhlFATAL,NhlEUNKNOWN,"wrf_ctt: Unable to allocate memory for holding dimension information");
+      return(NhlFATAL);
+    }
+    for(i = 0; i < ndims_ght-3; i++) {
+      dim_info[i] = dim_info_ght[i];
+    }
+    dim_info[ndims_ctt-1] = dim_info_ght[ndims_ght-1];
+    dim_info[ndims_ctt-2] = dim_info_ght[ndims_ght-2];
+  }
+
+/*
+ * Loop across leftmost dimensions and call the Fortran routine for each
+ * subsection of the input arrays.
+ */
+  index_pres = index_ter = index_ctt = 0;
+
+  for(i = 0; i < size_leftmost; i++) {
+/*
+ * Coerce subsection of pres (tmp_pres) to double if necessary.
+ */
+    if(type_pres != NCL_double) {
+      coerce_subset_input_double(pres,tmp_pres,index_pres,
+                                 type_pres,nlevlatlon,0,NULL,NULL);
+    }
+    else {
+      tmp_pres = &((double*)pres)[index_pres];
+    }
+
+/*
+ * Coerce subsection of tk (tmp_tk) to double if necessary.
+ */
+    if(type_tk != NCL_double) {
+      coerce_subset_input_double(tk,tmp_tk,index_pres,type_tk,
+                                 nlevlatlon,0,NULL,NULL);
+    }
+    else {
+      tmp_tk = &((double*)tk)[index_pres];
+    }
+
+/*
+ * Coerce subsection of qci (tmp_qci) to double if necessary.
+ */
+    if(type_qci != NCL_double) {
+      coerce_subset_input_double(qci,tmp_qci,index_pres,type_qci,
+                                 nlevlatlon,0,NULL,NULL);
+    }
+    else {
+      tmp_qci = &((double*)qci)[index_pres];
+    }
+
+/*
+ * Coerce subsection of qcw (tmp_qcw) to double if necessary.
+ */
+    if(type_qcw != NCL_double) {
+      coerce_subset_input_double(qcw,tmp_qcw,index_pres,type_qcw,
+                                 nlevlatlon,0,NULL,NULL);
+    }
+    else {
+      tmp_qcw = &((double*)qcw)[index_pres];
+    }
+
+/*
+ * Coerce subsection of qvp (tmp_qvp) to double if necessary.
+ */
+    if(type_qvp != NCL_double) {
+      coerce_subset_input_double(qvp,tmp_qvp,index_pres,type_qvp,
+                                 nlevlatlon,0,NULL,NULL);
+    }
+    else {
+      tmp_qvp = &((double*)qvp)[index_pres];
+    }
+
+/*
+ * Coerce subsection of ght (tmp_ght) to double if necessary.
+ */
+    if(type_ght != NCL_double) {
+      coerce_subset_input_double(ght,tmp_ght,index_pres,type_ght,
+                                 nlevlatlon,0,NULL,NULL);
+    }
+    else {
+      tmp_ght = &((double*)ght)[index_pres];
+    }
+
+/*
+ * Coerce subsection of ter (tmp_ter) to double if necessary.
+ */
+    if(ndims_ter != 2) {
+      if(type_ter != NCL_double) {
+        coerce_subset_input_double(ter,tmp_ter,index_ter,type_ter,
+                                   nlatlon,0,NULL,NULL);
+      }
+      else {
+        tmp_ter = &((double*)ter)[index_ter];
+      }
+    }
+
+/*
+ * Point temporary output array to void output array if appropriate.
+ */
+    if(type_ctt == NCL_double) {
+      tmp_ctt = &((double*)ctt)[index_ctt];
+    }
+    
+/*
+ * Call the Fortran routine.
+ */
+    NGCALLF(wrfcttcalc,WRFCTTCALC)(tmp_pres, tmp_tk, tmp_qci, tmp_qcw,
+                                   tmp_qvp, tmp_ght, tmp_ter, tmp_ctt,
+                                   haveqci,&inlev, &inlat, &inlon);
+
+/*
+ * Coerce output back to float if necessary.
+ */
+    if(type_ctt == NCL_float) {
+      coerce_output_float_only(ctt,tmp_ctt,nlatlon,
+                               index_ctt);
+    }
+    index_pres  += nlevlatlon;
+    index_ctt  += nlatlon;
+    if(ndims_ter != 2) { 
+      index_ter += nlatlon;
+    }
+  }
+
+/*
+ * Free unneeded memory.
+ */
+  if(type_pres != NCL_double) NclFree(tmp_pres);
+  if(type_tk   != NCL_double) NclFree(tmp_tk);
+  if(type_qci  != NCL_double) NclFree(tmp_qci);
+  if(type_qcw  != NCL_double) NclFree(tmp_qcw);
+  if(type_qvp  != NCL_double) NclFree(tmp_qvp);
+  if(type_ght  != NCL_double) NclFree(tmp_ght);
+  if(type_ter  != NCL_double) NclFree(tmp_ter);
+  if(type_ctt  != NCL_double) NclFree(tmp_ctt);
+
+/*
+ * Set up some attributes ("description" and "units") to return.
+ */
+  cdescription = (char *)calloc(22,sizeof(char));
+  cunits       = (char *)calloc(2,sizeof(char));
+  strcpy(cdescription,"Cloud Top Temperature");
+  strcpy(cunits,"K");
+  description = (NclQuark*)NclMalloc(sizeof(NclQuark));
+  units       = (NclQuark*)NclMalloc(sizeof(NclQuark));
+  *description = NrmStringToQuark(cdescription);
+  *units       = NrmStringToQuark(cunits);
+  free(cdescription);
+  free(cunits);
+
+/*
+ * Set up return value.
+ */
+  return_md = _NclCreateVal(
+                            NULL,
+                            NULL,
+                            Ncl_MultiDValData,
+                            0,
+                            (void*)ctt,
+                            NULL,
+                            ndims_ctt,
+                            dsizes_ctt,
+                            TEMPORARY,
+                            NULL,
+                            type_obj_ctt
+                            );
+/*
+ * Set up attributes to return.
+ */
+  att_id = _NclAttCreate(NULL,NULL,Ncl_Att,0,NULL);
+
+  dsizes[0] = 1;
+  att_md = _NclCreateVal(
+                         NULL,
+                         NULL,
+                         Ncl_MultiDValData,
+                         0,
+                         (void*)description,
+                         NULL,
+                         1,
+                         dsizes,
+                         TEMPORARY,
+                         NULL,
+                         (NclObjClass)nclTypestringClass
+                         );
+  _NclAddAtt(
+             att_id,
+             "description",
+             att_md,
+             NULL
+             );
+    
+  att_md = _NclCreateVal(
+                         NULL,
+                         NULL,
+                         Ncl_MultiDValData,
+                         0,
+                         (void*)units,
+                         NULL,
+                         1,
+                         dsizes,
+                         TEMPORARY,
+                         NULL,
+                         (NclObjClass)nclTypestringClass
+                         );
+  _NclAddAtt(
+             att_id,
+             "units",
+             att_md,
+             NULL
+             );
+    
+  tmp_var = _NclVarCreate(
+                          NULL,
+                          NULL,
+                          Ncl_Var,
+                          0,
+                          NULL,
+                          return_md,
+                          dim_info,
+                          att_id,
+                          NULL,
+                          RETURNVAR,
+                          NULL,
+                          TEMPORARY
+                          );
+
+  if(dim_info != NULL) NclFree(dim_info);
+  NclFree(dim_info_ght);
+
+/*
+ * Return output grid and attributes to NCL.
+ */
+  return_data.kind = NclStk_VAR;
+  return_data.u.data_var = tmp_var;
+  _NclPlaceReturn(return_data);
+  return(NhlNOERROR);
+}

wrf_open/var/ncl_reference/wrf_fctt.f

@@ -0,0 +1,117 @@
+C NCLFORTSTART                                                        
+      subroutine wrfcttcalc(prs,tk,qci,qcw,qvp,ght,ter,ctt,
+     &                      haveqci,nz,ns,ew)
+
+      implicit none
+      integer nz,ns,ew,haveqci 
+      double precision    ght(ew,ns,nz)
+      double precision    prs(ew,ns,nz),tk(ew,ns,nz)
+      double precision    qci(ew,ns,nz),qcw(ew,ns,nz)
+      double precision    qvp(ew,ns,nz)
+      double precision    ctt(ew,ns),ter(ew,ns)
+c      double precision    znfac(nz)
+C NCLEND
+c
+c
+      integer i,j,k,mjx,miy,mkzh,ripk,wrfout
+      double precision    vt,rgas,grav,opdepthu,opdepthd,dp
+      double precision    ratmix,eps,arg1,arg2,agl_hgt,ussalr
+      double precision    abscoefi,abscoef,fac,prsctt,celkel
+c      double precision    ght(ew,ns,nz),stuff(ew,ns)
+      double precision    pf(ns,ew,nz),p1,p2
+c
+c
+       mjx      =   ew 
+       miy      =   ns 
+       mkzh     =   nz 
+       eps      = 0.622d0
+       ussalr   = .0065d0      ! deg C per m
+       rgas     = 287.04d0     !J/K/kg
+       grav     = 9.81d0
+       abscoefi = .272d0  ! cloud ice absorption coefficient in m^2/g
+       abscoef  =.145d0   ! cloud water absorption coefficient in m^2/g
+       celkel   = 273.15d0 
+       wrfout = 1
+
+
+cCalculate the surface pressure 
+       do j=1,ew
+       do i=1,ns
+           ratmix     = .001d0*qvp(j,i,1)
+           arg1       = eps + ratmix
+           arg2       = eps*(1.+ratmix)
+           vt         =  tk(j,i,1) * arg1/arg2 !Virtual temperature
+           agl_hgt    = ght(j,i,nz) - ter(j,i)
+           arg1       = -grav/(rgas*ussalr)
+           pf(i,j,nz) = prs(j,i,1)*
+     &                        (vt/(vt+ussalr*(agl_hgt)))**(arg1)
+       enddo
+       enddo
+
+
+c
+       do j=1,ew
+       do i=1,ns
+          do k=1,nz-1
+            ripk = nz-k+1
+            pf(i,j,k)=.5d0*(prs(j,i,ripk)+prs(j,i,ripk-1))
+          enddo
+      enddo
+      enddo
+
+      do 190 j=1,ew
+      do 190 i=1,ns
+         opdepthd=0.d0
+         k=0
+
+c
+c      Integrate downward from model top, calculating path at full
+c      model vertical levels.
+c
+   20    opdepthu=opdepthd
+         k=k+1
+         ripk = nz-k+1
+
+         if (k.eq.1) then
+            dp=200.d0*(pf(i,j,1)-prs(j,i,nz))  ! should be in Pa
+         else
+            dp=100.d0*(pf(i,j,k)-pf(i,j,k-1))  ! should be in Pa
+         endif 
+         if (haveqci .eq. 0) then
+            if (tk(i,j,k).lt.celkel) then
+c             Note: abscoefi is m**2/g, qcw is g/kg,
+c                   so no convrsion needed
+               opdepthd=opdepthu+abscoefi*qcw(j,i,k)*dp/grav
+            else
+               opdepthd=opdepthu+abscoef*qcw(j,i,k)*dp/grav
+            endif
+         else
+            opdepthd=opdepthd+(abscoef*qcw(j,i,ripk)+
+     &                         abscoefi*qci(j,i,ripk))*dp/grav
+         endif
+         
+          if (opdepthd.lt.1..and.k.lt.nz) then
+            goto 20
+         elseif (opdepthd.lt.1..and.k.eq.nz) then
+            prsctt=prs(j,i,1)
+         else
+            fac=(1.-opdepthu)/(opdepthd-opdepthu)
+            prsctt=pf(i,j,k-1)+fac*(pf(i,j,k)-pf(i,j,k-1))
+            prsctt=min(prs(j,i,1),max(prs(j,i,nz),prsctt))
+         endif
+
+         do 30 k=2,nz
+            ripk = nz-k+1
+            p1   = prs(j,i,ripk+1)
+            p2   = prs(j,i,ripk)
+            if (prsctt .ge. p1 .and. prsctt .le .p2) then
+               fac=(prsctt-p1)/(p2-p1)
+               arg1 = fac*(tk(j,i,ripk)-tk(j,i,ripk+1))-celkel
+               ctt(j,i) = tk(j,i,ripk+1)+ arg1
+               goto 40
+            endif
+   30    continue 
+   40    continue
+ 190  continue
+      return
+      end

wrf_open/var/ncl_reference/wrf_pvo.f

@@ -0,0 +1,109 @@
+c--------------------------------------------------------
+C NCLFORTSTART
+      SUBROUTINE DCOMPUTEPV(PV,U,V,THETA,PRS,MSFU,MSFV,MSFT,COR,DX,DY,
+     +                      NX,NY,NZ,NXP1,NYP1)
+
+      IMPLICIT NONE
+      INTEGER NX,NY,NZ,NXP1,NYP1
+      DOUBLE PRECISION U(NXP1,NY,NZ),V(NX,NYP1,NZ),PRS(NX,NY,NZ)
+      DOUBLE PRECISION THETA(NX,NY,NZ),PV(NX,NY,NZ)
+      DOUBLE PRECISION MSFU(NXP1,NY),MSFV(NX,NYP1),MSFT(NX,NY)
+      DOUBLE PRECISION COR(NX,NY)
+      DOUBLE PRECISION DX,DY
+C NCLEND
+      INTEGER KP1,KM1,JP1,JM1,IP1,IM1,I,J,K
+      DOUBLE PRECISION DSY,DSX,DP,DUDY,DVDX,DUDP,DVDP,DTHDP,AVORT
+      DOUBLE PRECISION DTHDX,DTHDY,MM
+
+c          print*,'nx,ny,nz,nxp1,nyp1'
+c          print*,nx,ny,nz,nxp1,nyp1
+      DO K = 1,NZ
+          KP1 = MIN(K+1,NZ)
+          KM1 = MAX(K-1,1)
+          DO J = 1,NY
+              JP1 = MIN(J+1,NY)
+              JM1 = MAX(J-1,1)
+              DO I = 1,NX
+                  IP1 = MIN(I+1,NX)
+                  IM1 = MAX(I-1,1)
+c         print *,jp1,jm1,ip1,im1
+                  DSX = (IP1-IM1)*DX
+                  DSY = (JP1-JM1)*DY
+                  MM = MSFT(I,J)*MSFT(I,J)
+c         print *,j,i,u(i,jp1,k),msfu(i,jp1),u(i,jp1,k)/msfu(i,jp1)
+                  DUDY = 0.5D0* (U(I,JP1,K)/MSFU(I,JP1)+
+     +                   U(I+1,JP1,K)/MSFU(I+1,JP1)-
+     +                   U(I,JM1,K)/MSFU(I,JM1)-
+     +                   U(I+1,JM1,K)/MSFU(I+1,JM1))/DSY*MM
+                  DVDX = 0.5D0* (V(IP1,J,K)/MSFV(IP1,J)+
+     +                   V(IP1,J+1,K)/MSFV(IP1,J+1)-
+     +                   V(IM1,J,K)/MSFV(IM1,J)-
+     +                   V(IM1,J+1,K)/MSFV(IM1,J+1))/DSX*MM
+                  AVORT = DVDX - DUDY + COR(I,J)
+                  DP = PRS(I,J,KP1) - PRS(I,J,KM1)
+                  DUDP = 0.5D0* (U(I,J,KP1)+U(I+1,J,KP1)-U(I,J,KM1)-
+     +                   U(I+1,J,KM1))/DP
+                  DVDP = 0.5D0* (V(I,J,KP1)+V(I,J+1,KP1)-V(I,J,KM1)-
+     +                   V(I,J+1,KM1))/DP
+                  DTHDP = (THETA(I,J,KP1)-THETA(I,J,KM1))/DP
+                  DTHDX = (THETA(IP1,J,K)-THETA(IM1,J,K))/DSX*MSFT(I,J)
+                  DTHDY = (THETA(I,JP1,K)-THETA(I,JM1,K))/DSY*MSFT(I,J)
+                  PV(I,J,K) = -9.81D0* (DTHDP*AVORT-DVDP*DTHDX+
+     +                        DUDP*DTHDY)*10000.D0
+c               if(i.eq.300 .and. j.eq.300) then
+c                 print*,'avort,dudp,dvdp,dthdp,dthdx,dthdy,pv'
+c                 print*,avort,dudp,dvdp,dthdp,dthdx,dthdy,pv(i,j,k)
+c               endif
+                  PV(I,J,K) = PV(I,J,K)*1.D2
+              END DO
+          END DO
+      END DO
+      RETURN
+      END
+
+c--------------------------------------------------------
+C NCLFORTSTART
+      SUBROUTINE DCOMPUTEABSVORT(AV,U,V,MSFU,MSFV,MSFT,COR,DX,DY,NX,NY,
+     +                           NZ,NXP1,NYP1)
+
+      IMPLICIT NONE
+      INTEGER NX,NY,NZ,NXP1,NYP1
+      DOUBLE PRECISION U(NXP1,NY,NZ),V(NX,NYP1,NZ)
+      DOUBLE PRECISION AV(NX,NY,NZ)
+      DOUBLE PRECISION MSFU(NXP1,NY),MSFV(NX,NYP1),MSFT(NX,NY)
+      DOUBLE PRECISION COR(NX,NY)
+      DOUBLE PRECISION DX,DY
+C NCLEND
+      INTEGER KP1,KM1,JP1,JM1,IP1,IM1,I,J,K
+      DOUBLE PRECISION DSY,DSX,DP,DUDY,DVDX,DUDP,DVDP,DTHDP,AVORT
+      DOUBLE PRECISION DTHDX,DTHDY,MM
+
+c          print*,'nx,ny,nz,nxp1,nyp1'
+c          print*,nx,ny,nz,nxp1,nyp1
+      DO K = 1,NZ
+          DO J = 1,NY
+              JP1 = MIN(J+1,NY)
+              JM1 = MAX(J-1,1)
+              DO I = 1,NX
+                  IP1 = MIN(I+1,NX)
+                  IM1 = MAX(I-1,1)
+c         print *,jp1,jm1,ip1,im1
+                  DSX = (IP1-IM1)*DX
+                  DSY = (JP1-JM1)*DY
+                  MM = MSFT(I,J)*MSFT(I,J)
+c         print *,j,i,u(i,jp1,k),msfu(i,jp1),u(i,jp1,k)/msfu(i,jp1)
+                  DUDY = 0.5D0* (U(I,JP1,K)/MSFU(I,JP1)+
+     +                   U(I+1,JP1,K)/MSFU(I+1,JP1)-
+     +                   U(I,JM1,K)/MSFU(I,JM1)-
+     +                   U(I+1,JM1,K)/MSFU(I+1,JM1))/DSY*MM
+                  DVDX = 0.5D0* (V(IP1,J,K)/MSFV(IP1,J)+
+     +                   V(IP1,J+1,K)/MSFV(IP1,J+1)-
+     +                   V(IM1,J,K)/MSFV(IM1,J)-
+     +                   V(IM1,J+1,K)/MSFV(IM1,J+1))/DSX*MM
+                  AVORT = DVDX - DUDY + COR(I,J)
+                  AV(I,J,K) = AVORT*1.D5
+              END DO
+          END DO
+      END DO
+      RETURN
+      END

wrf_open/var/ncl_reference/wrf_relhl.f

@@ -0,0 +1,100 @@
+
+C   ***************************************************************
+C   * Storm Relative Helicity (SRH) is a measure of the           *
+C   * streamwise vorticity within the inflow environment of a     *
+C   * convective storm. It is calculated by multiplying the       *
+C   * storm-relative inflow velocity vector (Vh-C) by the         *
+C   * streamwise vorticity (Zh) and integrating this quantity     *
+C   * over the inflow depth (lowest 1-3 km layers above ground    *
+C   * level). It describes the extent to which corkscrew-like     *
+C   * motion occurs (similar to the spiraling motion of an        *
+C   * American football). SRH corresponds to the transfer of      *
+C   * vorticity from the environment to an air parcel in          *
+C   * convective motion and is used to predict the potential      *
+C   * for tornadic development (cyclonic updraft rotation) in     *
+C   * right-moving supercells.                                    *
+C   *                                                             *
+C   * There is no clear threshold value for SRH when forecasting  *
+C   * supercells, since the formation of supercells appears to be *
+C   * related more strongly to the deeper layer vertical shear.   *
+C   * Larger values of 0-3-km SRH (greater than 250 m**2/s**2)    *
+C   * and 0-1-km SRH (greater than 100 m**2/s**2), suggest an     *
+C   * increased threat of tornadoes with supercells. For SRH,     *
+C   * larger values are generally better, but there are no clear  *
+C   * "boundaries" between non-tornadic and significant tornadic  *
+C   * supercells.                                                 *
+C   *                                                             *
+C   * SRH < 100 (lowest 1 km): cutoff value                       *
+C   * SRH = 150-299: supercells possible with weak tornadoes      *
+C   * SRH = 300-499: very favorable to supercell development and  *
+C   *                strong tornadoes                             *
+C   * SRH > 450    : violent tornadoes                            *
+C   ***************************************************************
+C NCLFORTSTART
+      subroutine dcalrelhl(u, v, ght, ter, top, sreh, miy, mjx, mkzh)
+      implicit none
+      integer miy, mjx, mkzh
+      double precision u(miy,mjx,mkzh), v(miy,mjx,mkzh), 
+     &                 ght(miy,mjx,mkzh),top,ter(miy,mjx),
+     &                 sreh(miy,mjx)
+C NCLEND
+C
+C This helicity code was provided by Dr. Craig Mattocks, and
+C verified by Cindy Bruyere to produce results equivalent to
+C those generated by RIP4. (The code came from RIP4?)
+C
+      double precision pi, dtr, dpr
+      double precision dh, sdh, su, sv, ua, va, asp, adr, bsp, bdr
+      double precision cu, cv, x, sum
+      integer i, j, k, k10, k3, ktop
+      parameter (pi=3.14159265d0, dtr=pi/180.d0, dpr=180.d0/pi)
+     
+      do 15 j = 1, mjx-1
+	do 15 i = 1, miy-1
+	  sdh = 0.d0
+	  su = 0.d0
+	  sv = 0.d0
+	  k3 = 0
+	  k10 = 0
+	  ktop = 0
+	  do 6 k = mkzh, 2, -1
+	    if (((ght(i,j,k) - ter(i,j)) .gt. 10000.d0) .and.
+     &             (k10 .eq. 0)) then
+	      k10 = k
+	      go to 8
+	    endif
+	    if (((ght(i,j,k) - ter(i,j)) .gt. top) .and.
+     &           (ktop .eq. 0)) ktop = k
+	    if (((ght(i,j,k) - ter(i,j)) .gt. 3000.d0) .and.
+     &           (k3 .eq. 0)) k3 = k
+    6     continue
+    8     continue
+	  if (k10 .eq. 0) k10=2
+	  do k = k3, k10, -1
+	    dh = ght(i,j,k-1) - ght(i,j,k)
+	    sdh = sdh + dh
+	    su = su + 0.5d0*dh*(u(i,j,k-1)+u(i,j,k))
+	    sv = sv + 0.5d0*dh*(v(i,j,k-1)+v(i,j,k))
+	  enddo
+	  ua = su / sdh
+	  va = sv / sdh
+	  asp = sqrt(ua*ua + va*va)
+	  if (ua .eq. 0.d0 .and. va .eq. 0.d0) then
+	    adr = 0.d0
+	  else
+	    adr = dpr * (pi + atan2(ua,va))
+	  endif
+	  bsp = 0.75d0 * asp
+	  bdr = adr + 30.d0
+	  if (bdr .gt. 360.d0) bdr = bdr-360.d0
+	  cu = -bsp * sin(bdr*dtr)
+	  cv = -bsp * cos(bdr*dtr)
+          sum = 0.d0
+          do 12 k = mkzh-1, ktop, -1
+            x = ((u(i,j,k)-cu) * (v(i,j,k)-v(i,j,k+1))) -
+     &          ((v(i,j,k)-cv) * (u(i,j,k)-u(i,j,k+1)))
+            sum = sum + x
+   12     continue
+          sreh(i,j) = -sum
+   15 continue
+      end

wrf_open/var/ncl_reference/wrf_rip_phys_routines.f

@@ -0,0 +1,264 @@
+c======================================================================
+c
+c !IROUTINE: WETBULBCALC -- Calculate wet bulb temperature (C)
+c
+c !DESCRIPTION:
+c
+c   Calculates wet bulb temperature in C, given pressure in 
+c      temperature in K and mixing ratio in kg/kg.
+c
+c !INPUT:
+c    nx     - index for x dimension
+c    ny     - index for y dimension
+c    nz     - index for z dimension
+c    prs    - pressure (mb)
+c    tmk    - temperature (K)
+c    qvp    - water vapor mixing ratio (kg/kg)
+c
+c !OUTPUT:
+c    twb    - Wet bulb temperature (C)
+c
+c !ASSUMPTIONS:
+c
+c !REVISION HISTORY:
+c     2009-March  - Mark T. Stoelinga - from RIP4.5
+c     2010-August - J. Schramm
+c     2014-March - A. Jaye - modified to run with NCL and ARW wrf output
+c
+c !INTERFACE:
+c ------------------------------------------------------------------
+C NCLFORTSTART
+      subroutine wetbulbcalc(prs,tmk,qvp,twb,nx,ny,nz,psafile)
+      implicit none
+      integer nx, ny, nz
+      double precision prs(nz,ny,nx)
+      double precision tmk(nz,ny,nx)
+      double precision qvp(nz,ny,nx)
+      double precision twb(nz,ny,nx)
+      character*(*) psafile
+C NCLEND
+      integer i,j,k
+      integer jtch,jt,ipch,ip
+      double precision q, t, p, e, tlcl, eth
+      double precision fracip,fracip2,fracjt,fracjt2
+      double precision PSADITHTE(150),PSADIPRS(150),PSADITMK(150,150)
+      double precision tonpsadiabat
+      double precision eps,tlclc1,tlclc2,tlclc3,tlclc4,gamma
+      double precision gammamd,thtecon1,thtecon2,thtecon3,celkel
+      double precision rgas,rgasmd,cp,cpmd
+
+c
+c  Before looping, set lookup table for getting temperature on
+c  a pseudoadiabat.
+c
+      CALL DLOOKUP_TABLE(PSADITHTE,PSADIPRS,PSADITMK,psafile)
+
+c  Define constants
+
+      rgas=287.04  !J/K/kg
+      rgasmd=.608   ! rgas_moist=rgas*(1.+rgasmd*qvp)
+      cp=1004.     ! J/K/kg  Note: not using Bolton's value of 1005.7
+      cpmd=.887   ! cp_moist=cp*(1.+cpmd*qvp)
+      eps=0.622
+      tlclc1=2840.
+      tlclc2=3.5
+      tlclc3=4.805
+      tlclc4=55.
+      gamma=rgas/cp
+      gammamd=rgasmd-cpmd  ! gamma_moist=gamma*(1.+gammamd*qvp)
+      thtecon1=3376. ! K
+      thtecon2=2.54
+      thtecon3=.81
+      celkel=273.15
+
+      DO k=1,nx
+        DO j=1,ny
+          DO i=1,nz
+            q=dmax1(qvp(i,j,k),1.d-15)
+            t=tmk(i,j,k)
+            p=prs(i,j,k)/100.
+            e=q*p/(eps+q)
+            tlcl=tlclc1/(dlog(t**tlclc2/e)-tlclc3)+tlclc4
+            eth=t*(1000./p)**(gamma*(1.+gammamd*q))*
+     &         exp((thtecon1/tlcl-thtecon2)*q*(1.+thtecon3*q))
+
+
+c
+c   Now we need to find the temperature (in K) on a moist adiabat
+c   (specified by eth in K) given pressure in hPa.  It uses a
+c   lookup table, with data that was generated by the Bolton (1980)
+c   formula for theta_e.
+c
+c     First check if pressure is less than min pressure in lookup table.
+c     If it is, assume parcel is so dry that the given theta-e value can
+c     be interpretted as theta, and get temperature from the simple dry
+c     theta formula.
+c
+
+            if (p.le.psadiprs(150)) then
+              tonpsadiabat=eth*(p/1000.)**gamma
+            else   
+c
+c   Otherwise, look for the given thte/prs point in the lookup table.
+c
+            do jtch=1,150-1
+              if (eth.ge.psadithte(jtch).and.eth.lt.
+     &              psadithte(jtch+1)) then
+                 jt=jtch
+                 goto 213
+              endif
+            enddo
+            jt=-1
+ 213        continue
+            do ipch=1,150-1
+              if (p.le.psadiprs(ipch).and.p.gt.psadiprs(ipch+1)) then
+                 ip=ipch
+                 goto 215
+              endif
+            enddo
+            ip=-1
+ 215        continue
+            if (jt.eq.-1.or.ip.eq.-1) then
+               print*,
+     &           'Outside of lookup table bounds. prs,thte=',p,eth
+              stop
+            endif
+            fracjt=(eth-psadithte(jt))/(psadithte(jt+1)-psadithte(jt))
+            fracjt2=1.-fracjt
+            fracip=(psadiprs(ip)-p)/(psadiprs(ip)-psadiprs(ip+1))
+            fracip2=1.-fracip
+            if (psaditmk(ip,jt).gt.1e9.or.psaditmk(ip+1,jt).gt.1e9.or.
+     &          psaditmk(ip,jt+1).gt.1e9.or.
+     &          psaditmk(ip+1,jt+1).gt.1e9) then
+                print*,
+     &            'Tried to access missing tmperature in lookup table.'
+                print*,
+     &            'Prs and Thte probably unreasonable. prs,thte='
+     &                   ,p,eth
+               stop
+            endif
+            tonpsadiabat=fracip2*fracjt2*psaditmk(ip  ,jt  )+
+     &             fracip *fracjt2*psaditmk(ip+1,jt  )+
+     &             fracip2*fracjt *psaditmk(ip  ,jt+1)+
+     &             fracip *fracjt *psaditmk(ip+1,jt+1)
+            endif
+
+            twb(i,j,k)=tonpsadiabat
+
+          ENDDO
+        ENDDO
+      ENDDO
+
+c
+      return
+      end
+c======================================================================
+c
+c !IROUTINE: omgcalc -- Calculate omega (dp/dt)
+c
+c !DESCRIPTION:
+c
+c   Calculate approximate omega, based on vertical velocity w (dz/dt).
+c   It is approximate because it cannot take into account the vertical
+c   motion of pressure surfaces.
+c
+c !INPUT:
+c    mx - index for x dimension
+c    my - index for y dimension
+c    mx -  index for vertical dimension
+c    qvp - water vapor mixing ratio (kg/kg)
+c    tmk - temperature (K)
+c    www - vertical velocity (m/s)
+c    prs -  pressure (Pa)
+c
+c !OUTPUT:
+c    omg - omega (Pa/sec)
+c
+c !ASSUMPTIONS:
+c
+c !REVISION HISTORY:
+c     2009-March  - Mark T. Stoelinga - from RIP4.5
+c     2010-August - J. Schramm
+c     2014-March - A. Jaye - modified to run with NCL and ARW wrf output
+c
+c ------------------------------------------------------------------
+c NCLFORTSTART
+      subroutine omgcalc(qvp,tmk,www,prs,omg,mx,my,mz)
+      implicit none
+      integer mx, my, mz
+      double precision qvp(mz,my,mx)
+      double precision tmk(mz,my,mx)
+      double precision www(mz,my,mx)
+      double precision prs(mz,my,mx) 
+      double precision omg(mz,my,mx)
+c NCLEND
+c Local variables
+      integer i, j, k
+      double precision grav,rgas,eps 
+c
+c Constants
+c
+      grav=9.81           ! m/s**2
+      rgas=287.04  !J/K/kg
+      eps=0.622
+
+      do k=1,mx
+        do j=1,my
+          do i=1,mz
+            omg(i,j,k)=-grav*prs(i,j,k)/
+     &        (rgas*((tmk(i,j,k)*(eps+qvp(i,j,k)))/
+     &        (eps*(1.+qvp(i,j,k)))))*www(i,j,k)
+          enddo
+        enddo
+      enddo
+c
+      return
+      end
+c======================================================================
+c
+c !IROUTINE: VIRTUAL_TEMP -- Calculate virtual temperature (K)
+c
+c !DESCRIPTION:
+c
+c   Calculates virtual temperature in K, given temperature
+c      in K and mixing ratio in kg/kg.
+c
+c !INPUT:
+c    NX     - index for x dimension
+c    NY     - index for y dimension
+c    NZ     - index for z dimension
+c    RATMIX - water vapor mixing ratio (kg/kg)
+c    TEMP   - temperature (K)
+c
+c !OUTPUT:
+c    TV     - Virtual temperature (K)
+c
+c !ASSUMPTIONS:
+c
+c !REVISION HISTORY:
+c     2009-March  - Mark T. Stoelinga - from RIP4.5
+c     2010-August - J. Schramm
+c     2014-March - A. Jaye - modified to run with NCL and ARW wrf output
+c
+c ------------------------------------------------------------------
+C NCLFORTSTART
+      SUBROUTINE VIRTUAL_TEMP(TEMP,RATMIX,TV,NX,NY,NZ)
+      IMPLICIT NONE
+      INTEGER NX,NY,NZ
+      DOUBLE PRECISION TEMP(NZ,NY,NX)
+      DOUBLE PRECISION RATMIX(NZ,NY,NX)
+      DOUBLE PRECISION TV(NZ,NY,NX)
+C NCLEND
+      INTEGER I,J,K
+      DOUBLE PRECISION EPS
+      EPS = 0.622D0
+      DO K=1,NX
+        DO J=1,NY
+          DO I=1,NZ
+            TV(I,J,K) = TEMP(I,J,K)* (EPS+RATMIX(I,J,K))/ 
+     &                     (EPS* (1.D0+RATMIX(I,J,K)))
+          ENDDO
+        ENDDO
+      ENDDO
+      RETURN
+      END

wrf_open/var/ncl_reference/wrf_user.f

@@ -0,0 +1,771 @@
+C NCLFORTSTART
+      SUBROUTINE DCOMPUTEPI(PI,PRESSURE,NX,NY,NZ)
+      IMPLICIT NONE
+      INTEGER NX,NY,NZ
+      DOUBLE PRECISION PI(NX,NY,NZ)
+      DOUBLE PRECISION PRESSURE(NX,NY,NZ)
+C NCLEND
+
+      INTEGER I,J,K
+      DOUBLE PRECISION P1000MB,R_D,CP
+      PARAMETER (P1000MB=100000.D0,R_D=287.D0,CP=7.D0*R_D/2.D0)
+
+      DO K = 1,NZ
+          DO J = 1,NY
+              DO I = 1,NX
+                  PI(I,J,K) = (PRESSURE(I,J,K)/P1000MB)** (R_D/CP)
+              END DO
+          END DO
+      END DO
+
+      END
+
+C NCLFORTSTART
+      SUBROUTINE DCOMPUTETK(TK,PRESSURE,THETA,NX)
+      IMPLICIT NONE
+      INTEGER NX
+      DOUBLE PRECISION PI
+      DOUBLE PRECISION PRESSURE(NX)
+      DOUBLE PRECISION THETA(NX)
+      DOUBLE PRECISION TK(NX)
+C NCLEND
+
+      INTEGER I
+      DOUBLE PRECISION P1000MB,R_D,CP
+      PARAMETER (P1000MB=100000.D0,R_D=287.D0,CP=7.D0*R_D/2.D0)
+
+      DO I = 1,NX
+         PI = (PRESSURE(I)/P1000MB)** (R_D/CP)
+         TK(I) = PI*THETA(I)
+      END DO
+
+      END
+
+C NCLFORTSTART
+      SUBROUTINE DINTERP3DZ(V3D,V2D,Z,LOC,NX,NY,NZ,VMSG)
+      IMPLICIT NONE
+      INTEGER NX,NY,NZ
+      DOUBLE PRECISION V3D(NX,NY,NZ),V2D(NX,NY)
+      DOUBLE PRECISION Z(NX,NY,NZ)
+      DOUBLE PRECISION LOC
+      DOUBLE PRECISION VMSG
+C NCLEND
+
+      INTEGER I,J,KP,IP,IM
+      LOGICAL INTERP
+      DOUBLE PRECISION HEIGHT,W1,W2
+
+      HEIGHT = LOC
+
+c does vertical coordinate increase or decrease with increasing k?
+c set offset appropriately
+
+      IP = 0
+      IM = 1
+      IF (Z(1,1,1).GT.Z(1,1,NZ)) THEN
+          IP = 1
+          IM = 0
+      END IF
+
+      DO I = 1,NX
+          DO J = 1,NY
+C Initialize to missing.  Was initially hard-coded to -999999.
+              V2D(I,J) = VMSG
+              INTERP = .false.
+              KP = NZ
+
+              DO WHILE ((.NOT.INTERP) .AND. (KP.GE.2))
+
+                  IF (((Z(I,J,KP-IM).LE.HEIGHT).AND. (Z(I,J,
+     +                KP-IP).GT.HEIGHT))) THEN
+                      W2 = (HEIGHT-Z(I,J,KP-IM))/
+     +                     (Z(I,J,KP-IP)-Z(I,J,KP-IM))
+                      W1 = 1.D0 - W2
+                      V2D(I,J) = W1*V3D(I,J,KP-IM) + W2*V3D(I,J,KP-IP)
+                      INTERP = .true.
+                  END IF
+                  KP = KP - 1
+
+              END DO
+
+          END DO
+      END DO
+
+      RETURN
+      END
+
+C NCLFORTSTART
+      SUBROUTINE DZSTAG(ZNEW,NX,NY,NZ,Z,NXZ,NYZ,NZZ,TERRAIN)
+      IMPLICIT NONE
+      INTEGER NX,NY,NZ,NXZ,NYZ,NZZ
+      DOUBLE PRECISION ZNEW(NX,NY,NZ),Z(NXZ,NYZ,NZZ)
+      DOUBLE PRECISION TERRAIN(NXZ,NYZ)
+C NCLEND
+
+      INTEGER I,J,K,II,IM1,JJ,JM1
+
+c check for u, v, or w (x,y,or z) staggering
+c
+c for x and y stag, avg z to x, y, point
+c
+      IF (NX.GT.NXZ) THEN
+
+          DO K = 1,NZ
+              DO J = 1,NY
+                  DO I = 1,NX
+                      II = MIN0(I,NXZ)
+                      IM1 = MAX0(I-1,1)
+                      ZNEW(I,J,K) = 0.5D0* (Z(II,J,K)+Z(IM1,J,K))
+                  END DO
+              END DO
+          END DO
+
+      ELSE IF (NY.GT.NYZ) THEN
+
+          DO K = 1,NZ
+              DO J = 1,NY
+                  JJ = MIN0(J,NYZ)
+                  JM1 = MAX0(J-1,1)
+                  DO I = 1,NX
+                      ZNEW(I,J,K) = 0.5D0* (Z(I,JJ,K)+Z(I,JM1,K))
+                  END DO
+              END DO
+          END DO
+c
+c w (z) staggering
+c
+      ELSE IF (NZ.GT.NZZ) THEN
+
+          DO J = 1,NY
+              DO I = 1,NX
+                  ZNEW(I,J,1) = TERRAIN(I,J)
+              END DO
+          END DO
+
+          DO K = 2,NZ
+              DO J = 1,NY
+                  DO I = 1,NX
+                      ZNEW(I,J,K) = ZNEW(I,J,K-1) +
+     +                              2.D0* (Z(I,J,K-1)-ZNEW(I,J,K-1))
+                  END DO
+              END DO
+          END DO
+
+      END IF
+
+      RETURN
+      END
+
+C NCLFORTSTART
+      SUBROUTINE DINTERP2DXY(V3D,V2D,XY,NX,NY,NZ,NXY)
+      IMPLICIT NONE
+      INTEGER NX,NY,NZ,NXY
+      DOUBLE PRECISION V3D(NX,NY,NZ),V2D(NXY,NZ)
+      DOUBLE PRECISION XY(2,NXY)
+C NCLEND
+
+      INTEGER I,J,K,IJ
+      DOUBLE PRECISION W11,W12,W21,W22,WX,WY
+
+      DO IJ = 1,NXY
+
+          I = MAX0(1,MIN0(NX-1,INT(XY(1,IJ)+1)))
+          J = MAX0(1,MIN0(NY-1,INT(XY(2,IJ)+1)))
+          WX = DBLE(I+1) - (XY(1,IJ)+1)
+          WY = DBLE(J+1) - (XY(2,IJ)+1)
+          W11 = WX*WY
+          W21 = (1.D0-WX)*WY
+          W12 = WX* (1.D0-WY)
+          W22 = (1.D0-WX)* (1.D0-WY)
+          DO K = 1,NZ
+              V2D(IJ,K) = W11*V3D(I,J,K) + W21*V3D(I+1,J,K) +
+     +                    W12*V3D(I,J+1,K) + W22*V3D(I+1,J+1,K)
+          END DO
+      END DO
+
+      RETURN
+      END
+
+C NCLFORTSTART
+      SUBROUTINE DINTERP1D(V_IN,V_OUT,Z_IN,Z_OUT,NZ_IN,NZ_OUT,VMSG)
+      IMPLICIT NONE
+      INTEGER NZ_IN,NZ_OUT
+      DOUBLE PRECISION V_IN(NZ_IN),Z_IN(NZ_IN)
+      DOUBLE PRECISION V_OUT(NZ_OUT),Z_OUT(NZ_OUT)
+      DOUBLE PRECISION VMSG
+C NCLEND
+
+      INTEGER KP,K,IM,IP
+      LOGICAL INTERP
+      DOUBLE PRECISION HEIGHT,W1,W2
+
+c does vertical coordinate increase of decrease with increasing k?
+c set offset appropriately
+
+      IP = 0
+      IM = 1
+      IF (Z_IN(1).GT.Z_IN(NZ_IN)) THEN
+          IP = 1
+          IM = 0
+      END IF
+
+      DO K = 1,NZ_OUT
+          V_OUT(K) = VMSG
+
+          INTERP = .false.
+          KP = NZ_IN
+          HEIGHT = Z_OUT(K)
+
+          DO WHILE ((.NOT.INTERP) .AND. (KP.GE.2))
+
+              IF (((Z_IN(KP-IM).LE.HEIGHT).AND.
+     +            (Z_IN(KP-IP).GT.HEIGHT))) THEN
+                  W2 = (HEIGHT-Z_IN(KP-IM))/ (Z_IN(KP-IP)-Z_IN(KP-IM))
+                  W1 = 1.D0 - W2
+                  V_OUT(K) = W1*V_IN(KP-IM) + W2*V_IN(KP-IP)
+                  INTERP = .true.
+              END IF
+              KP = KP - 1
+
+          END DO
+
+      END DO
+
+      RETURN
+      END
+
+c---------------------------------------------
+
+c Bill,
+c This routine assumes
+c    index order is (i,j,k)
+c    wrf staggering
+C
+c    units: pressure (Pa), temperature(K), height (m), mixing ratio
+c     (kg kg{-1}) availability of 3d p, t, and qv; 2d terrain; 1d 
+c half-level zeta string
+c    output units of SLP are Pa, but you should divide that by 100 for the
+c          weather weenies.
+c    virtual effects are included
+c
+
+C NCLFORTSTART
+      SUBROUTINE DCOMPUTESEAPRS(NX,NY,NZ,Z,T,P,Q,SEA_LEVEL_PRESSURE,
+     +                          T_SEA_LEVEL,T_SURF,LEVEL)
+      IMPLICIT NONE
+c     Estimate sea level pressure.
+      INTEGER NX,NY,NZ
+      DOUBLE PRECISION Z(NX,NY,NZ)
+      DOUBLE PRECISION T(NX,NY,NZ),P(NX,NY,NZ),Q(NX,NY,NZ)
+c     The output is the 2d sea level pressure.
+      DOUBLE PRECISION SEA_LEVEL_PRESSURE(NX,NY)
+      INTEGER LEVEL(NX,NY)
+      DOUBLE PRECISION T_SURF(NX,NY),T_SEA_LEVEL(NX,NY)
+C NCLEND
+c     Some required physical constants:
+
+      DOUBLE PRECISION R,G,GAMMA
+      PARAMETER (R=287.04D0,G=9.81D0,GAMMA=0.0065D0)
+
+c     Specific constants for assumptions made in this routine:
+
+      DOUBLE PRECISION TC,PCONST
+      PARAMETER (TC=273.16D0+17.5D0,PCONST=10000)
+      LOGICAL RIDICULOUS_MM5_TEST
+      PARAMETER (RIDICULOUS_MM5_TEST=.TRUE.)
+c      PARAMETER (ridiculous_mm5_test = .false.)
+
+c     Local variables:
+
+      INTEGER I,J,K
+      INTEGER KLO,KHI
+
+
+      DOUBLE PRECISION PLO,PHI,TLO,THI,ZLO,ZHI
+      DOUBLE PRECISION P_AT_PCONST,T_AT_PCONST,Z_AT_PCONST
+      DOUBLE PRECISION Z_HALF_LOWEST
+
+      LOGICAL L1,L2,L3,FOUND
+
+C
+c  Find least zeta level that is PCONST Pa above the surface.  We
+c  later use this level to extrapolate a surface pressure and 
+c  temperature, which is supposed to reduce the effect of the diurnal
+c  heating cycle in the pressure field.
+
+      DO J = 1,NY
+          DO I = 1,NX
+              LEVEL(I,J) = -1
+
+              K = 1
+              FOUND = .false.
+              DO WHILE ((.NOT.FOUND) .AND. (K.LE.NZ))
+                  IF (P(I,J,K).LT.P(I,J,1)-PCONST) THEN
+                      LEVEL(I,J) = K
+                      FOUND = .true.
+                  END IF
+                  K = K + 1
+              END DO
+
+              IF (LEVEL(I,J).EQ.-1) THEN
+                  PRINT '(A,I4,A)','Troubles finding level ',
+     +              NINT(PCONST)/100,' above ground.'
+                  PRINT '(A,I4,A,I4,A)','Problems first occur at (',I,
+     +              ',',J,')'
+                  PRINT '(A,F6.1,A)','Surface pressure = ',P(I,J,1)/100,
+     +              ' hPa.'
+                  STOP 'Error_in_finding_100_hPa_up'
+              END IF
+
+
+          END DO
+      END DO
+
+c     Get temperature PCONST Pa above surface.  Use this to extrapolate
+c     the temperature at the surface and down to sea level.
+
+      DO J = 1,NY
+          DO I = 1,NX
+
+              KLO = MAX(LEVEL(I,J)-1,1)
+              KHI = MIN(KLO+1,NZ-1)
+
+              IF (KLO.EQ.KHI) THEN
+                  PRINT '(A)','Trapping levels are weird.'
+                  PRINT '(A,I3,A,I3,A)','klo = ',KLO,', khi = ',KHI,
+     +              ': and they should not be equal.'
+                  STOP 'Error_trapping_levels'
+              END IF
+
+              PLO = P(I,J,KLO)
+              PHI = P(I,J,KHI)
+              TLO = T(I,J,KLO)* (1.D0+0.608D0*Q(I,J,KLO))
+              THI = T(I,J,KHI)* (1.D0+0.608D0*Q(I,J,KHI))
+c         zlo = zetahalf(klo)/ztop*(ztop-terrain(i,j))+terrain(i,j)
+c         zhi = zetahalf(khi)/ztop*(ztop-terrain(i,j))+terrain(i,j)
+              ZLO = Z(I,J,KLO)
+              ZHI = Z(I,J,KHI)
+
+              P_AT_PCONST = P(I,J,1) - PCONST
+              T_AT_PCONST = THI - (THI-TLO)*LOG(P_AT_PCONST/PHI)*
+     +                      LOG(PLO/PHI)
+              Z_AT_PCONST = ZHI - (ZHI-ZLO)*LOG(P_AT_PCONST/PHI)*
+     +                      LOG(PLO/PHI)
+
+              T_SURF(I,J) = T_AT_PCONST* (P(I,J,1)/P_AT_PCONST)**
+     +                      (GAMMA*R/G)
+              T_SEA_LEVEL(I,J) = T_AT_PCONST + GAMMA*Z_AT_PCONST
+
+          END DO
+      END DO
+
+C
+c If we follow a traditional computation, there is a correction to the
+c sea level temperature if both the surface and sea level 
+c temperatures are *too* hot.
+
+      IF (RIDICULOUS_MM5_TEST) THEN
+          DO J = 1,NY
+              DO I = 1,NX
+                  L1 = T_SEA_LEVEL(I,J) .LT. TC
+                  L2 = T_SURF(I,J) .LE. TC
+                  L3 = .NOT. L1
+                  IF (L2 .AND. L3) THEN
+                      T_SEA_LEVEL(I,J) = TC
+                  ELSE
+                      T_SEA_LEVEL(I,J) = TC -
+     +                                   0.005D0* (T_SURF(I,J)-TC)**2
+                  END IF
+              END DO
+          END DO
+      END IF
+
+c     The grand finale: ta da!
+
+      DO J = 1,NY
+          DO I = 1,NX
+c   z_half_lowest=zetahalf(1)/ztop*(ztop-terrain(i,j))+terrain(i,j)
+              Z_HALF_LOWEST = Z(I,J,1)
+
+C Convert to hPa in this step, by multiplying by 0.01. The original
+C Fortran routine didn't do this, but the NCL script that called it
+C did, so we moved it here.
+              SEA_LEVEL_PRESSURE(I,J) = 0.01 * (P(I,J,1)*
+     +                                  EXP((2.D0*G*Z_HALF_LOWEST)/
+     +                                  (R* (T_SEA_LEVEL(I,J)+T_SURF(I,
+     +                                  J)))))
+          END DO
+      END DO
+
+c     print *,'sea pres input at weird location i=20,j=1,k=1'
+c     print *,'t=',t(20,1,1),t(20,2,1),t(20,3,1)
+c     print *,'z=',z(20,1,1),z(20,2,1),z(20,3,1)
+c     print *,'p=',p(20,1,1),p(20,2,1),p(20,3,1)
+c     print *,'slp=',sea_level_pressure(20,1),
+c    *         sea_level_pressure(20,2),sea_level_pressure(20,3)
+
+      END
+
+
+c---------------------------------------------------
+
+C
+C Double precision version. If you make a change here, you
+C must make the same change below to filter2d.
+C
+C NCLFORTSTART
+      SUBROUTINE DFILTER2D(A,B,NX,NY,IT,MISSING)
+      IMPLICIT NONE
+c     Estimate sea level pressure.
+      INTEGER NX,NY,IT
+      DOUBLE PRECISION A(NX,NY),B(NX,NY),MISSING
+C NCLEND
+
+      DOUBLE PRECISION COEF
+      PARAMETER (COEF=0.25D0)
+      INTEGER I,J,ITER
+
+      DO ITER = 1,IT
+          DO J = 1,NY
+              DO I = 1,NX
+                  B(I,J) = A(I,J)
+              END DO
+          END DO
+          DO J = 2,NY - 1
+             DO I = 1,NX
+                IF ( B(I,J-1).EQ.MISSING .OR. B(I,J).EQ.MISSING .OR.
+     +               B(I,J+1).EQ.MISSING ) THEN
+                   A(I,J) = A(I,J)
+                ELSE
+                   A(I,J) = A(I,J) + COEF* (B(I,J-1)-2*B(I,J)+B(I,J+1))
+                END IF
+             END DO
+          END DO
+          DO J = 1,NY
+             DO I = 2,NX - 1
+                IF ( B(I-1,J).EQ.MISSING .OR. B(I,J).EQ.MISSING .OR.
+     +               B(I+1,J).EQ.MISSING ) THEN
+                   A(I,J) = A(I,J)
+                ELSE
+                   A(I,J) = A(I,J) + COEF* (B(I-1,J)-2*B(I,J)+B(I+1,J))
+                END IF
+             END DO
+          END DO
+c        do j=1,ny
+c        do i=1,nx
+c          b(i,j) = a(i,j)
+c        enddo
+c        enddo
+c        do j=2,ny-1
+c        do i=1,nx
+c          a(i,j) = a(i,j) - .99*coef*(b(i,j-1)-2*b(i,j)+b(i,j+1))
+c        enddo
+c        enddo
+c        do j=1,ny
+c        do i=2,nx-1
+c          a(i,j) = a(i,j) - .99*coef*(b(i-1,j)-2*b(i,j)+b(i+1,j))
+c        enddo
+c        enddo
+      END DO
+      RETURN
+      END
+
+C
+C Single precision version. If you make a change here, you
+C must make the same change above to dfilter2d.
+C
+C NCLFORTSTART
+      SUBROUTINE filter2d( a, b, nx , ny , it, missing)
+      IMPLICIT NONE
+c     Estimate sea level pressure.
+      INTEGER nx , ny, it
+      REAL    a(nx,ny),b(nx,ny), missing
+C NCLEND
+
+      REAL coef
+      parameter( coef = 0.25)
+      INTEGER i,j,iter
+
+      do iter=1, it
+        do j=1,ny
+        do i=1,nx
+          b(i,j) = a(i,j)
+        enddo
+        enddo
+        do j=2,ny-1
+        do i=1,nx
+          if ( b(i,j-1).eq.missing .or. b(i,j).eq.missing .or.
+     +         b(i,j+1).eq.missing ) then
+             a(i,j) = a(i,j)
+          else
+             a(i,j) = a(i,j) + coef*(b(i,j-1)-2*b(i,j)+b(i,j+1))
+          end if
+        enddo
+        enddo
+        do j=1,ny
+        do i=2,nx-1
+           if ( b(i-1,j).eq.missing .or. b(i,j).eq.missing .or.
+     +          b(i+1,j).eq.missing ) then
+              a(i,j) = a(i,j)
+           else
+              a(i,j) = a(i,j) + coef*(b(i-1,j)-2*b(i,j)+b(i+1,j))
+           end if
+        enddo
+        enddo
+c        do j=1,ny
+c        do i=1,nx
+c          b(i,j) = a(i,j)
+c        enddo
+c        enddo
+c        do j=2,ny-1
+c        do i=1,nx
+c          a(i,j) = a(i,j) - .99*coef*(b(i,j-1)-2*b(i,j)+b(i,j+1))
+c        enddo
+c        enddo
+c        do j=1,ny
+c        do i=2,nx-1
+c          a(i,j) = a(i,j) - .99*coef*(b(i-1,j)-2*b(i,j)+b(i+1,j))
+c        enddo
+c        enddo
+      enddo
+      return
+      end
+c---------------------------------------------------------
+
+C NCLFORTSTART
+      SUBROUTINE DCOMPUTERH(QV,P,T,RH,NX)
+
+      IMPLICIT NONE
+      INTEGER NX
+      DOUBLE PRECISION QV(NX),P(NX),T(NX),RH(NX)
+C NCLEND
+      DOUBLE PRECISION SVP1,SVP2,SVP3,SVPT0
+      PARAMETER (SVP1=0.6112D0,SVP2=17.67D0,SVP3=29.65D0,SVPT0=273.15D0)
+      INTEGER I
+      DOUBLE PRECISION QVS,ES,PRESSURE,TEMPERATURE
+      DOUBLE PRECISION EP_2,R_D,R_V
+      PARAMETER (R_D=287.D0,R_V=461.6D0,EP_2=R_D/R_V)
+      DOUBLE PRECISION EP_3
+      PARAMETER (EP_3=0.622D0)
+
+      DO I = 1,NX
+         PRESSURE = P(I)
+         TEMPERATURE = T(I)
+c       es  = 1000.*svp1*
+         ES = 10.D0*SVP1*EXP(SVP2* (TEMPERATURE-SVPT0)/
+     +        (TEMPERATURE-SVP3))
+c       qvs = ep_2*es/(pressure-es)
+         QVS = EP_3*ES/ (0.01D0*PRESSURE- (1.D0-EP_3)*ES)
+c        rh = 100*amax1(1., qv(i)/qvs)
+c       rh(i) = 100.*qv(i)/qvs
+         RH(I) = 100.D0*DMAX1(DMIN1(QV(I)/QVS,1.0D0),0.0D0)
+      END DO
+
+      RETURN
+      END
+
+c----------------------------------------------
+
+C NCLFORTSTART
+      SUBROUTINE DGETIJLATLONG(LAT_ARRAY,LONG_ARRAY,LAT,LONGITUDE,
+     +                         II,JJ,NX,NY,IMSG)
+      IMPLICIT NONE
+      INTEGER NX,NY,II,JJ,IMSG
+      DOUBLE PRECISION LAT_ARRAY(NX,NY),LONG_ARRAY(NX,NY)
+      DOUBLE PRECISION LAT,LONGITUDE
+C NCLEND
+      DOUBLE PRECISION LONGD,LATD
+      INTEGER I,J
+      DOUBLE PRECISION IR,JR
+      DOUBLE PRECISION DIST_MIN,DIST
+
+C Init to missing. Was hard-coded to -999 initially.
+      IR = IMSG
+      JR = IMSG
+
+      DIST_MIN = 1.D+20
+      DO J = 1,NY
+          DO I = 1,NX
+              LATD = (LAT_ARRAY(I,J)-LAT)**2
+              LONGD = (LONG_ARRAY(I,J)-LONGITUDE)**2
+C             LONGD = DMIN1((LONG_ARRAY(I,J)-LONGITUDE)**2,
+C    +                (LONG_ARRAY(I,J)+LONGITUDE)**2)
+              DIST = SQRT(LATD+LONGD)
+              IF (DIST_MIN.GT.DIST) THEN
+                  DIST_MIN = DIST
+                  IR = DBLE(I)
+                  JR = DBLE(J)
+              END IF
+          END DO
+      END DO
+C
+C The original version of this routine returned IR and JR. But, then
+C the NCL script that called this routine was converting IR and JR
+C to integer, so why not just return II and JJ?
+C
+C Also, I'm subtracing 1 here, because it will be returned to NCL
+C script which has 0-based indexing.
+C 
+      IF(IR.ne.IMSG.and.JR.ne.IMSG) then
+        II = NINT(IR)-1
+        JJ = NINT(JR)-1
+      ELSE
+        II = IMSG
+        JJ = IMSG
+      END IF
+
+c we will just return the nearest point at present
+
+      RETURN
+      END
+
+C NCLFORTSTART
+      SUBROUTINE DCOMPUTEUVMET(U,V,UVMET,LONGCA,LONGCB,FLONG,FLAT,
+     +                         CEN_LONG,CONE,RPD,NX,NY,NXP1,NYP1,
+     +                         ISTAG,IS_MSG_VAL,UMSG,VMSG,UVMETMSG)
+      IMPLICIT NONE
+
+C ISTAG should be 0 if the U,V grids are not staggered.
+C That is, NY = NYP1 and NX = NXP1.
+
+      INTEGER NX,NY,NXP1,NYP1,ISTAG
+      LOGICAL IS_MSG_VAL
+      DOUBLE PRECISION U(NXP1,NY),V(NX,NYP1)
+      DOUBLE PRECISION UVMET(NX,NY,2)
+      DOUBLE PRECISION FLONG(NX,NY),FLAT(NX,NY)
+      DOUBLE PRECISION LONGCB(NX,NY),LONGCA(NX,NY)
+      DOUBLE PRECISION CEN_LONG,CONE,RPD
+      DOUBLE PRECISION UMSG,VMSG,UVMETMSG
+C NCLEND
+
+      INTEGER I,J
+      DOUBLE PRECISION UK,VK
+
+
+c      WRITE (6,FMT=*) ' in compute_uvmet ',NX,NY,NXP1,NYP1,ISTAG
+
+      DO J = 1,NY
+          DO I = 1,NX
+
+              LONGCA(I,J) = FLONG(I,J) - CEN_LONG
+              IF (LONGCA(I,J).GT.180.D0) THEN
+                  LONGCA(I,J) = LONGCA(I,J) - 360.D0
+              END IF
+              IF (LONGCA(I,J).LT.-180.D0) THEN
+                  LONGCA(I,J) = LONGCA(I,J) + 360.D0
+              END IF
+              IF (FLAT(I,J).LT.0.D0) THEN
+                  LONGCB(I,J) = -LONGCA(I,J)*CONE*RPD
+              ELSE
+                  LONGCB(I,J) = LONGCA(I,J)*CONE*RPD
+              END IF
+
+              LONGCA(I,J) = COS(LONGCB(I,J))
+              LONGCB(I,J) = SIN(LONGCB(I,J))
+
+          END DO
+      END DO
+
+c      WRITE (6,FMT=*) ' computing velocities '
+
+      DO J = 1,NY
+         DO I = 1,NX
+            IF (ISTAG.EQ.1) THEN
+               IF (IS_MSG_VAL.AND.(U(I,J).EQ.UMSG.OR.
+     +                             V(I,J).EQ.VMSG.OR.
+     +                             U(I+1,J).EQ.UMSG.OR.
+     +                             V(I,J+1).EQ.VMSG)) THEN
+                  UVMET(I,J,1) = UVMETMSG
+                  UVMET(I,J,2) = UVMETMSG
+               ELSE
+                  UK = 0.5D0* (U(I,J)+U(I+1,J))
+                  VK = 0.5D0* (V(I,J)+V(I,J+1))
+                  UVMET(I,J,1) = VK*LONGCB(I,J) + UK*LONGCA(I,J)
+                  UVMET(I,J,2) = VK*LONGCA(I,J) - UK*LONGCB(I,J)
+               END IF
+            ELSE
+               IF (IS_MSG_VAL.AND.(U(I,J).EQ.UMSG.OR.
+     +                             V(I,J).EQ.VMSG)) THEN
+                  UVMET(I,J,1) = UVMETMSG
+                  UVMET(I,J,2) = UVMETMSG
+               ELSE
+                  UK = U(I,J)
+                  VK = V(I,J)
+                  UVMET(I,J,1) = VK*LONGCB(I,J) + UK*LONGCA(I,J)
+                  UVMET(I,J,2) = VK*LONGCA(I,J) - UK*LONGCB(I,J)
+               END IF
+            END IF
+         END DO
+      END DO
+
+      RETURN
+      END
+
+C NCLFORTSTART
+C
+C This was originally a routine that took 2D input arrays. Since
+C the NCL C wrapper routine can handle multiple dimensions, it's
+C not necessary to have anything bigger than 1D here.
+C
+      SUBROUTINE DCOMPUTETD(TD,PRESSURE,QV_IN,NX)
+      IMPLICIT NONE
+      INTEGER NX
+      DOUBLE PRECISION PRESSURE(NX)
+      DOUBLE PRECISION QV_IN(NX)
+      DOUBLE PRECISION TD(NX)
+C NCLEND
+      DOUBLE PRECISION QV,TDC
+
+      INTEGER I
+
+      DO I = 1,NX
+          QV = DMAX1(QV_IN(I),0.D0)
+c vapor pressure
+          TDC = QV*PRESSURE(I)/ (.622D0+QV)
+
+c avoid problems near zero
+          TDC = DMAX1(TDC,0.001D0)
+          TD(I) = (243.5D0*LOG(TDC)-440.8D0)/ (19.48D0-LOG(TDC))
+      END DO
+
+      RETURN
+      END
+
+C NCLFORTSTART
+      SUBROUTINE DCOMPUTEICLW(ICLW,PRESSURE,QC_IN,NX,NY,NZ)
+      IMPLICIT NONE
+      INTEGER NX,NY,NZ
+      DOUBLE PRECISION PRESSURE(NX,NY,NZ)
+      DOUBLE PRECISION QC_IN(NX,NY,NZ)
+      DOUBLE PRECISION ICLW(NX,NY)
+      DOUBLE PRECISION QCLW,DP,GG
+C NCLEND
+
+      INTEGER I,J,K
+
+      GG = 1000.D0/9.8D0
+
+      DO J = 1,NY
+          DO I = 1,NX
+              ICLW(I,J) = 0.D0
+          END DO
+      END DO
+
+      DO J = 3,NY - 2
+          DO I = 3,NX - 2
+              DO K = 1,NZ
+                  QCLW = DMAX1(QC_IN(I,J,K),0.D0)
+                  IF (K.EQ.1) THEN
+                      DP = (PRESSURE(I,J,K-1)-PRESSURE(I,J,K))
+                  ELSE IF (K.EQ.NZ) THEN
+                      DP = (PRESSURE(I,J,K)-PRESSURE(I,J,K+1))
+                  ELSE
+                      DP = (PRESSURE(I,J,K-1)-PRESSURE(I,J,K+1))/2.D0
+                  END IF
+                  ICLW(I,J) = ICLW(I,J) + QCLW*DP*GG
+              END DO
+          END DO
+      END DO
+
+      RETURN
+      END

wrf_open/var/ncl_reference/wrf_user_dbz.f

@@ -0,0 +1,209 @@
+C NCLFORTSTART
+      SUBROUTINE CALCDBZ(DBZ,PRS,TMK,QVP,QRA,QSN,QGR,WEDIM,SNDIM,BTDIM,
+     +                   SN0,IVARINT,ILIQSKIN)
+c
+c     This routine computes equivalent reflectivity factor (in dBZ) at
+c     each model grid point.  In calculating Ze, the RIP algorithm makes
+c     assumptions consistent with those made in an early version
+c     (ca. 1996) of the bulk mixed-phase microphysical scheme in the MM5
+c     model (i.e., the scheme known as "Resiner-2").  For each species:
+c
+c     1. Particles are assumed to be spheres of constant density.  The
+c     densities of rain drops, snow particles, and graupel particles are
+c     taken to be rho_r = rho_l = 1000 kg m^-3, rho_s = 100 kg m^-3, and
+c     rho_g = 400 kg m^-3, respectively. (l refers to the density of
+c     liquid water.)
+c
+c     2. The size distribution (in terms of the actual diameter of the
+c     particles, rather than the melted diameter or the equivalent solid
+c     ice sphere diameter) is assumed to follow an exponential
+c     distribution of the form N(D) = N_0 * exp( lambda*D ).
+c
+c     3. If ivarint=0, the intercept parameters are assumed constant
+c     (as in early Reisner-2), with values of 8x10^6, 2x10^7, 
+c    and 4x10^6 m^-4, for rain, snow, and graupel, respectively.
+c    If ivarint=1, variable intercept parameters are used, as 
+c    calculated in Thompson, Rasmussen, and Manning (2004, Monthly
+c    Weather Review, Vol. 132, No. 2, pp. 519-542.)
+c
+c     4. If iliqskin=1, frozen particles that are at a temperature above
+c     freezing are assumed to scatter as a liquid particle.
+c
+c     More information on the derivation of simulated reflectivity in
+c     RIP can be found in Stoelinga (2005, unpublished write-up).
+c     Contact Mark Stoelinga (stoeling@atmos.washington.edu) for a copy.
+c
+
+c   Arguments
+      INTEGER WEDIM,SNDIM,BTDIM
+      INTEGER SN0,IVARINT,ILIQSKIN
+      DOUBLE PRECISION DBZ(WEDIM,SNDIM,BTDIM)
+      DOUBLE PRECISION PRS(WEDIM,SNDIM,BTDIM)
+      DOUBLE PRECISION TMK(WEDIM,SNDIM,BTDIM)
+      DOUBLE PRECISION QVP(WEDIM,SNDIM,BTDIM)
+      DOUBLE PRECISION QRA(WEDIM,SNDIM,BTDIM)
+      DOUBLE PRECISION QSN(WEDIM,SNDIM,BTDIM)
+      DOUBLE PRECISION QGR(WEDIM,SNDIM,BTDIM)
+
+C NCLEND
+
+c   Local Variables
+      INTEGER I,J,K
+      DOUBLE PRECISION TEMP_C,VIRTUAL_T
+      DOUBLE PRECISION GONV,RONV,SONV
+      DOUBLE PRECISION FACTOR_G,FACTOR_R,FACTOR_S
+      DOUBLE PRECISION FACTORB_G,FACTORB_R,FACTORB_S
+      DOUBLE PRECISION RHOAIR,Z_E
+
+c   Constants used to calculate variable intercepts
+      DOUBLE PRECISION R1,RON,RON2,SON,GON
+      DOUBLE PRECISION RON_MIN,RON_QR0,RON_DELQR0
+      DOUBLE PRECISION RON_CONST1R,RON_CONST2R
+c   Constant intercepts
+      DOUBLE PRECISION RN0_R,RN0_S,RN0_G
+c   Other constants
+      DOUBLE PRECISION RHO_R,RHO_S,RHO_G
+      DOUBLE PRECISION GAMMA_SEVEN,ALPHA
+      DOUBLE PRECISION RHOWAT,CELKEL,PI,RD
+
+
+c   Constants used to calculate variable intercepts
+      R1 = 1.D-15
+      RON = 8.D6
+      RON2 = 1.D10
+      SON = 2.D7
+      GON = 5.D7
+      RON_MIN = 8.D6
+      RON_QR0 = 0.00010D0
+      RON_DELQR0 = 0.25D0*RON_QR0
+      RON_CONST1R = (RON2-RON_MIN)*0.5D0
+      RON_CONST2R = (RON2+RON_MIN)*0.5D0
+
+c   Constant intercepts
+      RN0_R = 8.D6
+      RN0_S = 2.D7
+      RN0_G = 4.D6
+
+c   Other constants
+      GAMMA_SEVEN = 720.D0
+      RHOWAT = 1000.D0
+      RHO_R = RHOWAT
+      RHO_S = 100.D0
+      RHO_G = 400.D0
+      ALPHA = 0.224D0
+      CELKEL = 273.15D0
+      PI = 3.141592653589793D0
+      RD = 287.04D0
+
+c   Force all Q arrays to be 0.0 or greater.
+      DO K = 1,BTDIM
+         DO J = 1,SNDIM
+            DO I = 1,WEDIM
+               IF (QVP(I,J,K).LT.0.0) THEN
+                  QVP(I,J,K) = 0.0
+               END IF
+               IF (QRA(I,J,K).LT.0.0) THEN
+                  QRA(I,J,K) = 0.0
+               END IF
+               IF (QSN(I,J,K).LT.0.0) THEN
+                  QSN(I,J,K) = 0.0
+               END IF
+               IF (QGR(I,J,K).LT.0.0) THEN
+                  QGR(I,J,K) = 0.0
+               END IF
+            END DO
+         END DO
+      END DO
+
+c   Input pressure is Pa, but we need hPa in calculations
+
+      IF (SN0.EQ.0) THEN
+          DO K = 1,BTDIM
+              DO J = 1,SNDIM
+                  DO I = 1,WEDIM
+                      IF (TMK(I,J,K).LT.CELKEL) THEN
+                          QSN(I,J,K) = QRA(I,J,K)
+                          QRA(I,J,K) = 0.D0
+                      END IF
+                  END DO
+              END DO
+          END DO
+      END IF
+
+
+      FACTOR_R = GAMMA_SEVEN*1.D18* (1.D0/ (PI*RHO_R))**1.75D0
+      FACTOR_S = GAMMA_SEVEN*1.D18* (1.D0/ (PI*RHO_S))**1.75D0*
+     +           (RHO_S/RHOWAT)**2*ALPHA
+      FACTOR_G = GAMMA_SEVEN*1.D18* (1.D0/ (PI*RHO_G))**1.75D0*
+     +           (RHO_G/RHOWAT)**2*ALPHA
+
+
+      DO K = 1,BTDIM
+          DO J = 1,SNDIM
+              DO I = 1,WEDIM
+
+                  VIRTUAL_T = TMK(I,J,K)* (0.622D0+QVP(I,J,K))/
+     +                        (0.622D0* (1.D0+QVP(I,J,K)))
+                  RHOAIR = PRS(I,J,K) / (RD*VIRTUAL_T)
+
+c      Adjust factor for brightband, where snow or graupel particle
+c      scatters like liquid water (alpha=1.0) because it is assumed to
+c      have a liquid skin.
+
+                  IF (ILIQSKIN.EQ.1 .AND. TMK(I,J,K).GT.CELKEL) THEN
+                      FACTORB_S = FACTOR_S/ALPHA
+                      FACTORB_G = FACTOR_G/ALPHA
+                  ELSE
+                      FACTORB_S = FACTOR_S
+                      FACTORB_G = FACTOR_G
+                  END IF
+
+c      Calculate variable intercept parameters
+
+                  IF (IVARINT.EQ.1) THEN
+
+                      TEMP_C = DMIN1(-0.001D0,TMK(I,J,K)-CELKEL)
+                      SONV = DMIN1(2.0D8,2.0D6*EXP(-0.12D0*TEMP_C))
+
+                      GONV = GON
+                      IF (QGR(I,J,K).GT.R1) THEN
+                          GONV = 2.38D0* (PI*RHO_G/
+     +                           (RHOAIR*QGR(I,J,K)))**0.92D0
+                          GONV = MAX(1.D4,MIN(GONV,GON))
+                      END IF
+
+                      RONV = RON2
+                      IF (QRA(I,J,K).GT.R1) THEN
+                          RONV = RON_CONST1R*TANH((RON_QR0-QRA(I,J,K))/
+     +                           RON_DELQR0) + RON_CONST2R
+                      END IF
+
+                  ELSE
+
+                      RONV = RN0_R
+                      SONV = RN0_S
+                      GONV = RN0_G
+
+                  END IF
+
+c      Total equivalent reflectivity factor (z_e, in mm^6 m^-3) is
+c      the sum of z_e for each hydrometeor species:
+
+                  Z_E = FACTOR_R* (RHOAIR*QRA(I,J,K))**1.75D0/
+     +                  RONV**.75D0 + FACTORB_S*
+     +                  (RHOAIR*QSN(I,J,K))**1.75D0/SONV**.75D0 +
+     +                  FACTORB_G* (RHOAIR*QGR(I,J,K))**1.75D0/
+     +                  GONV**.75D0
+
+c      Adjust small values of Z_e so that dBZ is no lower than -30
+                  Z_E = MAX(Z_E,.001D0)
+
+c      Convert to dBZ
+                  DBZ(I,J,K) = 10.D0*LOG10(Z_E)
+
+              END DO
+          END DO
+      END DO
+
+      RETURN
+      END

wrf_open/var/ncl_reference/wrf_user_latlon_routines.f

@@ -0,0 +1,511 @@
+C NCLFORTSTART
+      SUBROUTINE DLLTOIJ(MAP_PROJ,TRUELAT1,TRUELAT2,STDLON,LAT1,LON1,
+     +                   POLE_LAT,POLE_LON,KNOWNI,KNOWNJ,DX,DY,LATINC,
+     +                   LONINC,LAT,LON,LOC)
+      DOUBLE PRECISION DELTALON1
+      DOUBLE PRECISION TL1R
+
+
+ccc       Converts input lat/lon values to the cartesian (i,j) value
+ccc       for the given projection.
+
+      INTEGER MAP_PROJ
+      DOUBLE PRECISION TRUELAT1,TRUELAT2,STDLON
+      DOUBLE PRECISION LAT1,LON1,POLE_LAT,POLE_LON,KNOWNI,KNOWNJ
+      DOUBLE PRECISION DX,DY,LATINC,LONINC,LAT,LON,LOC(2)
+C NCLEND
+
+      DOUBLE PRECISION CLAIN,DLON,RSW,DELTALON,DELTALAT
+      DOUBLE PRECISION REFLON,SCALE_TOP,ALA1,ALO1,ALA,ALO,RM,POLEI,POLEJ
+c Earth radius divided by dx
+      DOUBLE PRECISION REBYDX
+      DOUBLE PRECISION DELTALON1TL1R,CTL1R,ARG,CONE,HEMI
+      DOUBLE PRECISION I,J
+      DOUBLE PRECISION LAT1N,LON1N,OLAT,OLON
+
+      DOUBLE PRECISION PI,RAD_PER_DEG,DEG_PER_RAD,RE_M
+
+ccc      lat1     ! SW latitude (1,1) in degrees (-90->90N)
+ccc      lon1     ! SW longitude (1,1) in degrees (-180->180E)
+ccc      dx       ! Grid spacing in meters at truelats
+ccc      dlat     ! Lat increment for lat/lon grids
+ccc      dlon     ! Lon increment for lat/lon grids
+ccc      stdlon   ! Longitude parallel to y-axis (-180->180E)
+ccc      truelat1 ! First true latitude (all projections)
+ccc      truelat2 ! Second true lat (LC only)
+ccc      hemi     ! 1 for NH, -1 for SH
+ccc      cone     ! Cone factor for LC projections
+ccc      polei    ! Computed i-location of pole point
+ccc      polej    ! Computed j-location of pole point
+ccc      rsw      ! Computed radius to SW corner
+ccc      knowni   ! X-location of known lat/lon
+ccc      knownj   ! Y-location of known lat/lon
+ccc      RE_M     ! Radius of spherical earth, meters
+ccc      REbydx   ! Earth radius divided by dx
+
+      PI = 3.141592653589793D0
+      RAD_PER_DEG = PI/180.D0
+      DEG_PER_RAD = 180.D0/PI
+c Radius of spherical earth, meters
+      RE_M = 6370000.D0
+      REBYDX = RE_M/DX
+
+      HEMI = 1.0D0
+      IF (TRUELAT1.LT.0.0D0) THEN
+          HEMI = -1.0D0
+      END IF
+
+
+ccc      !MERCATOR
+      IF (MAP_PROJ.EQ.3) THEN
+
+ccc         !  Preliminary variables
+          CLAIN = COS(RAD_PER_DEG*TRUELAT1)
+          DLON = DX/ (RE_M*CLAIN)
+
+ccc         ! Compute distance from equator to origin, and store in 
+ccc         ! the rsw tag.
+          RSW = 0.D0
+          IF (LAT1.NE.0.D0) THEN
+              RSW = (DLOG(TAN(0.5D0* ((LAT1+90.D0)*RAD_PER_DEG))))/DLON
+          END IF
+
+          DELTALON = LON - LON1
+          IF (DELTALON.LT.-180.D0) DELTALON = DELTALON + 360.D0
+          IF (DELTALON.GT.180.D0) DELTALON = DELTALON - 360.D0
+          I = KNOWNI + (DELTALON/ (DLON*DEG_PER_RAD))
+          J = KNOWNJ + (DLOG(TAN(0.5D0* ((LAT+90.D0)*RAD_PER_DEG))))/
+     +        DLON - RSW
+
+ccc      !PS
+      ELSE IF (MAP_PROJ.EQ.2) THEN
+
+          REFLON = STDLON + 90.D0
+
+ccc         ! Compute numerator term of map scale factor
+          SCALE_TOP = 1.D0 + HEMI*SIN(TRUELAT1*RAD_PER_DEG)
+
+ccc         ! Compute radius to lower-left (SW) corner
+          ALA1 = LAT1*RAD_PER_DEG
+          RSW = REBYDX*COS(ALA1)*SCALE_TOP/ (1.D0+HEMI*SIN(ALA1))
+
+ccc         ! Find the pole point
+          ALO1 = (LON1-REFLON)*RAD_PER_DEG
+          POLEI = KNOWNI - RSW*COS(ALO1)
+          POLEJ = KNOWNJ - HEMI*RSW*SIN(ALO1)
+
+ccc         ! Find radius to desired point
+          ALA = LAT*RAD_PER_DEG
+          RM = REBYDX*COS(ALA)*SCALE_TOP/ (1.D0+HEMI*SIN(ALA))
+          ALO = (LON-REFLON)*RAD_PER_DEG
+          I = POLEI + RM*COS(ALO)
+          J = POLEJ + HEMI*RM*SIN(ALO)
+
+ccc      !LAMBERT
+      ELSE IF (MAP_PROJ.EQ.1) THEN
+
+          IF (ABS(TRUELAT2).GT.90.D0) THEN
+              TRUELAT2 = TRUELAT1
+          END IF
+
+          IF (ABS(TRUELAT1-TRUELAT2).GT.0.1D0) THEN
+              CONE = (DLOG(COS(TRUELAT1*RAD_PER_DEG))-
+     +               DLOG(COS(TRUELAT2*RAD_PER_DEG)))/
+     +               (DLOG(TAN((90.D0-ABS(TRUELAT1))*RAD_PER_DEG*
+     +               0.5D0))-DLOG(TAN((90.D0-ABS(TRUELAT2))*RAD_PER_DEG*
+     +               0.5D0)))
+          ELSE
+              CONE = SIN(ABS(TRUELAT1)*RAD_PER_DEG)
+          END IF
+
+ccc         ! Compute longitude differences and ensure we stay
+ccc         ! out of the forbidden "cut zone"
+          DELTALON1 = LON1 - STDLON
+          IF (DELTALON1.GT.+180.D0) DELTALON1 = DELTALON1 - 360.D0
+          IF (DELTALON1.LT.-180.D0) DELTALON1 = DELTALON1 + 360.D0
+
+ccc         ! Convert truelat1 to radian and compute COS for later use
+          TL1R = TRUELAT1*RAD_PER_DEG
+          CTL1R = COS(TL1R)
+
+ccc         ! Compute the radius to our known lower-left (SW) corner
+          RSW = REBYDX*CTL1R/CONE* (TAN((90.D0*HEMI-
+     +          LAT1)*RAD_PER_DEG/2.D0)/TAN((90.D0*HEMI-
+     +          TRUELAT1)*RAD_PER_DEG/2.D0))**CONE
+
+ccc         ! Find pole point
+          ARG = CONE* (DELTALON1*RAD_PER_DEG)
+          POLEI = HEMI*KNOWNI - HEMI*RSW*SIN(ARG)
+          POLEJ = HEMI*KNOWNJ + RSW*COS(ARG)
+
+ccc         ! Compute deltalon between known longitude and standard
+ccc         ! lon and ensure it is not in the cut zone
+          DELTALON = LON - STDLON
+          IF (DELTALON.GT.+180.D0) DELTALON = DELTALON - 360.D0
+          IF (DELTALON.LT.-180.D0) DELTALON = DELTALON + 360.D0
+
+ccc         ! Radius to desired point
+          RM = REBYDX*CTL1R/CONE* (TAN((90.D0*HEMI-
+     +         LAT)*RAD_PER_DEG/2.D0)/TAN((90.D0*HEMI-
+     +         TRUELAT1)*RAD_PER_DEG/2.D0))**CONE
+
+          ARG = CONE* (DELTALON*RAD_PER_DEG)
+          I = POLEI + HEMI*RM*SIN(ARG)
+          J = POLEJ - RM*COS(ARG)
+
+ccc         ! Finally, if we are in the southern hemisphere, flip the
+ccc         ! i/j values to a coordinate system where (1,1) is the SW
+ccc         ! corner (what we assume) which is different than the
+ccc         ! original NCEP algorithms which used the NE corner as
+ccc         ! the origin in the southern hemisphere (left-hand vs.
+ccc         ! right-hand coordinate?)
+          I = HEMI*I
+          J = HEMI*J
+
+
+ccc     !lat-lon
+      ELSE IF (MAP_PROJ.EQ.6) THEN
+
+          IF (POLE_LAT.NE.90.D0) THEN
+              CALL ROTATECOORDS(LAT,LON,OLAT,OLON,POLE_LAT,POLE_LON,
+     +                          STDLON,-1)
+              LAT = OLAT
+              LON = OLON + STDLON
+          END IF
+
+c         ! make sure center lat/lon is good
+          IF (POLE_LAT.NE.90.D0) THEN
+              CALL ROTATECOORDS(LAT1,LON1,OLAT,OLON,POLE_LAT,POLE_LON,
+     +                          STDLON,-1)
+              LAT1N = OLAT
+              LON1N = OLON + STDLON
+              DELTALAT = LAT - LAT1N
+              DELTALON = LON - LON1N
+          ELSE
+              DELTALAT = LAT - LAT1
+              DELTALON = LON - LON1
+          END IF
+
+c         ! Compute i/j
+          I = DELTALON/LONINC
+          J = DELTALAT/LATINC
+
+          I = I + KNOWNI
+          J = J + KNOWNJ
+
+      ELSE
+
+          PRINT *,'ERROR: Do not know map projection ',MAP_PROJ
+
+      END IF
+
+      LOC(1) = J
+      LOC(2) = I
+
+      RETURN
+      END
+
+
+C NCLFORTSTART
+      SUBROUTINE DIJTOLL(MAP_PROJ,TRUELAT1,TRUELAT2,STDLON,LAT1,LON1,
+     +                   POLE_LAT,POLE_LON,KNOWNI,KNOWNJ,DX,DY,LATINC,
+     +                   LONINC,AI,AJ,LOC)
+      DOUBLE PRECISION GI2
+      DOUBLE PRECISION ARCCOS
+      DOUBLE PRECISION DELTALON1
+      DOUBLE PRECISION TL1R
+
+ccc     ! Converts input lat/lon values to the cartesian (i,j) value
+ccc     ! for the given projection.
+
+      INTEGER MAP_PROJ
+      DOUBLE PRECISION TRUELAT1,TRUELAT2,STDLON
+      DOUBLE PRECISION LAT1,LON1,POLE_LAT,POLE_LON,KNOWNI,KNOWNJ
+      DOUBLE PRECISION DX,DY,LATINC,LONINC,AI,AJ,LOC(2)
+C NCLEND
+
+      DOUBLE PRECISION CLAIN,DLON,RSW,DELTALON,DELTALAT
+      DOUBLE PRECISION REFLON,SCALE_TOP,ALA1,ALO1,ALA,ALO,RM,POLEI,POLEJ
+c Earth radius divided by dx
+      DOUBLE PRECISION REBYDX
+      DOUBLE PRECISION DELTALON1TL1R,CTL1R,ARG,CONE,HEMI
+
+      DOUBLE PRECISION PI,RAD_PER_DEG,DEG_PER_RAD,RE_M
+
+      DOUBLE PRECISION INEW,JNEW,R,R2
+      DOUBLE PRECISION CHI,CHI1,CHI2
+      DOUBLE PRECISION XX,YY,LAT,LON
+
+      DOUBLE PRECISION RLAT,RLON,OLAT,OLON,LAT1N,LON1N
+      DOUBLE PRECISION PHI_NP,LAM_NP,LAM_0,DLAM
+      DOUBLE PRECISION SINPHI,COSPHI,COSLAM,SINLAM
+
+
+ccc     lat1     ! SW latitude (1,1) in degrees (-90->90N)
+ccc     lon1     ! SW longitude (1,1) in degrees (-180->180E)
+ccc     dx       ! Grid spacing in meters at truelats
+ccc     dlat     ! Lat increment for lat/lon grids
+ccc     dlon     ! Lon increment for lat/lon grids
+ccc     stdlon   ! Longitude parallel to y-axis (-180->180E)
+ccc     truelat1 ! First true latitude (all projections)
+ccc     truelat2 ! Second true lat (LC only)
+ccc     hemi     ! 1 for NH, -1 for SH
+ccc     cone     ! Cone factor for LC projections
+ccc     polei    ! Computed i-location of pole point
+ccc     polej    ! Computed j-location of pole point
+ccc     rsw      ! Computed radius to SW corner
+ccc     knowni   ! X-location of known lat/lon
+ccc     knownj   ! Y-location of known lat/lon
+ccc     RE_M     ! Radius of spherical earth, meters
+ccc     REbydx   ! Earth radius divided by dx
+
+      PI = 3.141592653589793D0
+      RAD_PER_DEG = PI/180.D0
+      DEG_PER_RAD = 180.D0/PI
+c Radius of spherical earth, meters
+      RE_M = 6370000.D0
+      REBYDX = RE_M/DX
+
+      HEMI = 1.0D0
+      IF (TRUELAT1.LT.0.0D0) THEN
+          HEMI = -1.0D0
+      END IF
+
+
+ccc     !MERCATOR
+      IF (MAP_PROJ.EQ.3) THEN
+
+ccc       !  Preliminary variables
+          CLAIN = COS(RAD_PER_DEG*TRUELAT1)
+          DLON = DX/ (RE_M*CLAIN)
+
+ccc       ! Compute distance from equator to origin, and store in 
+ccc       ! the rsw tag.
+          RSW = 0.D0
+          IF (LAT1.NE.0.D0) THEN
+              RSW = (DLOG(TAN(0.5D0* ((LAT1+90.D0)*RAD_PER_DEG))))/DLON
+          END IF
+
+          LAT = 2.0D0*ATAN(EXP(DLON* (RSW+AJ-KNOWNJ)))*DEG_PER_RAD -
+     +          90.D0
+          LON = (AI-KNOWNI)*DLON*DEG_PER_RAD + LON1
+          IF (LON.GT.180.D0) LON = LON - 360.D0
+          IF (LON.LT.-180.D0) LON = LON + 360.D0
+
+
+ccc     !PS
+      ELSE IF (MAP_PROJ.EQ.2) THEN
+
+ccc       ! Compute the reference longitude by rotating 90 degrees to
+ccc       ! the east to find the longitude line parallel to the 
+ccc       ! positive x-axis.
+          REFLON = STDLON + 90.D0
+
+ccc       ! Compute numerator term of map scale factor
+          SCALE_TOP = 1.D0 + HEMI*SIN(TRUELAT1*RAD_PER_DEG)
+
+ccc       ! Compute radius to known point
+          ALA1 = LAT1*RAD_PER_DEG
+          RSW = REBYDX*COS(ALA1)*SCALE_TOP/ (1.D0+HEMI*SIN(ALA1))
+
+ccc       ! Find the pole point
+          ALO1 = (LON1-REFLON)*RAD_PER_DEG
+          POLEI = KNOWNI - RSW*COS(ALO1)
+          POLEJ = KNOWNJ - HEMI*RSW*SIN(ALO1)
+
+ccc       ! Compute radius to point of interest
+          XX = AI - POLEI
+          YY = (AJ-POLEJ)*HEMI
+          R2 = XX**2 + YY**2
+
+ccc       ! Now the magic code
+          IF (R2.EQ.0.D0) THEN
+              LAT = HEMI*90.D0
+              LON = REFLON
+          ELSE
+              GI2 = (REBYDX*SCALE_TOP)**2.D0
+              LAT = DEG_PER_RAD*HEMI*ASIN((GI2-R2)/ (GI2+R2))
+              ARCCOS = ACOS(XX/SQRT(R2))
+              IF (YY.GT.0) THEN
+                  LON = REFLON + DEG_PER_RAD*ARCCOS
+              ELSE
+                  LON = REFLON - DEG_PER_RAD*ARCCOS
+              END IF
+          END IF
+
+ccc       ! Convert to a -180 -> 180 East convention
+          IF (LON.GT.180.D0) LON = LON - 360.D0
+          IF (LON.LT.-180.D0) LON = LON + 360.D0
+
+ccc     !LAMBERT
+      ELSE IF (MAP_PROJ.EQ.1) THEN
+
+          IF (ABS(TRUELAT2).GT.90.D0) THEN
+              TRUELAT2 = TRUELAT1
+          END IF
+
+          IF (ABS(TRUELAT1-TRUELAT2).GT.0.1D0) THEN
+              CONE = (DLOG(COS(TRUELAT1*RAD_PER_DEG))-
+     +               DLOG(COS(TRUELAT2*RAD_PER_DEG)))/
+     +               (DLOG(TAN((90.D0-ABS(TRUELAT1))*RAD_PER_DEG*
+     +               0.5D0))-DLOG(TAN((90.D0-ABS(TRUELAT2))*RAD_PER_DEG*
+     +               0.5D0)))
+          ELSE
+              CONE = SIN(ABS(TRUELAT1)*RAD_PER_DEG)
+          END IF
+
+ccc       ! Compute longitude differences and ensure we stay out of the
+ccc       ! forbidden "cut zone"
+          DELTALON1 = LON1 - STDLON
+          IF (DELTALON1.GT.+180.D0) DELTALON1 = DELTALON1 - 360.D0
+          IF (DELTALON1.LT.-180.D0) DELTALON1 = DELTALON1 + 360.D0
+
+ccc       ! Convert truelat1 to radian and compute COS for later use
+          TL1R = TRUELAT1*RAD_PER_DEG
+          CTL1R = COS(TL1R)
+
+ccc       ! Compute the radius to our known point
+          RSW = REBYDX*CTL1R/CONE* (TAN((90.D0*HEMI-
+     +          LAT1)*RAD_PER_DEG/2.D0)/TAN((90.D0*HEMI-
+     +          TRUELAT1)*RAD_PER_DEG/2.D0))**CONE
+
+ccc       ! Find pole point
+          ALO1 = CONE* (DELTALON1*RAD_PER_DEG)
+          POLEI = HEMI*KNOWNI - HEMI*RSW*SIN(ALO1)
+          POLEJ = HEMI*KNOWNJ + RSW*COS(ALO1)
+
+          CHI1 = (90.D0-HEMI*TRUELAT1)*RAD_PER_DEG
+          CHI2 = (90.D0-HEMI*TRUELAT2)*RAD_PER_DEG
+
+ccc       ! See if we are in the southern hemispere and flip the 
+ccc       ! indices if we are.
+          INEW = HEMI*AI
+          JNEW = HEMI*AJ
+
+ccc       ! Compute radius**2 to i/j location
+          REFLON = STDLON + 90.D0
+          XX = INEW - POLEI
+          YY = POLEJ - JNEW
+          R2 = (XX*XX+YY*YY)
+          R = SQRT(R2)/REBYDX
+
+ccc       ! Convert to lat/lon
+          IF (R2.EQ.0.D0) THEN
+              LAT = HEMI*90.D0
+              LON = STDLON
+          ELSE
+              LON = STDLON + DEG_PER_RAD*ATAN2(HEMI*XX,YY)/CONE
+              LON = DMOD(LON+360.D0,360.D0)
+              IF (CHI1.EQ.CHI2) THEN
+                  CHI = 2.0D0*ATAN((R/TAN(CHI1))** (1.D0/CONE)*
+     +                  TAN(CHI1*0.5D0))
+              ELSE
+                  CHI = 2.0D0*ATAN((R*CONE/SIN(CHI1))** (1.D0/CONE)*
+     +                  TAN(CHI1*0.5D0))
+              END IF
+              LAT = (90.0D0-CHI*DEG_PER_RAD)*HEMI
+          END IF
+
+          IF (LON.GT.+180.D0) LON = LON - 360.D0
+          IF (LON.LT.-180.D0) LON = LON + 360.D0
+
+
+ccc     !lat-lon
+      ELSE IF (MAP_PROJ.EQ.6) THEN
+
+          INEW = AI - KNOWNI
+          JNEW = AJ - KNOWNJ
+
+          IF (INEW.LT.0.D0) INEW = INEW + 360.D0/LONINC
+          IF (INEW.GE.360.D0/DX) INEW = INEW - 360.D0/LONINC
+c
+ccc       ! Compute deltalat and deltalon
+          DELTALAT = JNEW*LATINC
+          DELTALON = INEW*LONINC
+
+          IF (POLE_LAT.NE.90.D0) THEN
+              CALL ROTATECOORDS(LAT1,LON1,OLAT,OLON,POLE_LAT,POLE_LON,
+     +                          STDLON,-1)
+              LAT1N = OLAT
+              LON1N = OLON + STDLON
+              LAT = DELTALAT + LAT1N
+              LON = DELTALON + LON1N
+          ELSE
+              LAT = DELTALAT + LAT1
+              LON = DELTALON + LON1
+          END IF
+
+
+          IF (POLE_LAT.NE.90.D0) THEN
+              LON = LON - STDLON
+              CALL ROTATECOORDS(LAT,LON,OLAT,OLON,POLE_LAT,POLE_LON,
+     +                          STDLON,1)
+              LAT = OLAT
+              LON = OLON
+          END IF
+
+          IF (LON.LT.-180.D0) LON = LON + 360.D0
+          IF (LON.GT.180.D0) LON = LON - 360.D0
+
+      ELSE
+
+          PRINT *,'ERROR: Do not know map projection ',MAP_PROJ
+
+      END IF
+
+      LOC(1) = LAT
+      LOC(2) = LON
+      RETURN
+
+      END
+
+
+C NCLFORTSTART
+      SUBROUTINE ROTATECOORDS(ILAT,ILON,OLAT,OLON,LAT_NP,LON_NP,LON_0,
+     +                        DIRECTION)
+      DOUBLE PRECISION ILAT,ILON
+      DOUBLE PRECISION OLAT,OLON
+      DOUBLE PRECISION LAT_NP,LON_NP,LON_0
+      INTEGER DIRECTION
+C NCLEND
+
+c       ! >=0, default : computational -> geographical
+c       ! < 0          : geographical  -> computational
+
+      DOUBLE PRECISION RLAT,RLON
+      DOUBLE PRECISION PHI_NP,LAM_NP,LAM_0,DLAM
+      DOUBLE PRECISION SINPHI,COSPHI,COSLAM,SINLAM
+      DOUBLE PRECISION PI,RAD_PER_DEG,DEG_PER_RAD
+
+      PI = 3.141592653589793D0
+      RAD_PER_DEG = PI/180.D0
+      DEG_PER_RAD = 180.D0/PI
+
+c       ! Convert all angles to radians
+      PHI_NP = LAT_NP*RAD_PER_DEG
+      LAM_NP = LON_NP*RAD_PER_DEG
+      LAM_0 = LON_0*RAD_PER_DEG
+      RLAT = ILAT*RAD_PER_DEG
+      RLON = ILON*RAD_PER_DEG
+
+      IF (DIRECTION.LT.0) THEN
+c          ! The equations are exactly the same except for one
+c          ! small difference with respect to longitude ...
+          DLAM = PI - LAM_0
+      ELSE
+          DLAM = LAM_NP
+      END IF
+      SINPHI = COS(PHI_NP)*COS(RLAT)*COS(RLON-DLAM) +
+     +         SIN(PHI_NP)*SIN(RLAT)
+      COSPHI = SQRT(1.D0-SINPHI*SINPHI)
+      COSLAM = SIN(PHI_NP)*COS(RLAT)*COS(RLON-DLAM) -
+     +         COS(PHI_NP)*SIN(RLAT)
+      SINLAM = COS(RLAT)*SIN(RLON-DLAM)
+      IF (COSPHI.NE.0.D0) THEN
+          COSLAM = COSLAM/COSPHI
+          SINLAM = SINLAM/COSPHI
+      END IF
+      OLAT = DEG_PER_RAD*ASIN(SINPHI)
+      OLON = DEG_PER_RAD* (ATAN2(SINLAM,COSLAM)-DLAM-LAM_0+LAM_NP)
+
+      END

wrf_open/var/script/plot2d

@@ -0,0 +1,291 @@
+#!/usr/bin/env python
+
+import traceback
+import sys
+import sqlite3
+from datetime import datetime as dt
+
+import numpy as n
+import matplotlib
+matplotlib.use('agg')
+import matplotlib.pyplot as plt
+
+#from wrf.core import Constants
+#from wrf.var.temp import calc_temp
+#from wrf.plot.matplotlib.defaults import (get_basemap, get_default_map_opts,
+#                                          get_null_opts)
+                            
+#from wrf.plot.matplotlib.helper import (add_plot_info_text, plot_map, 
+#                                        plot_contourf)
+
+#__all__ = ["plot_2d"]
+
+
+
+
+def get_basemap(wrfnc):
+    #TODO:  handle multiple projections
+    lat2d = wrfnc.variables["XLAT"][0,:,:]
+    lon2d = wrfnc.variables["XLONG"][0,:,:]
+    
+    ny = len(wrfnc.dimensions["south_north"])
+    nx = len(wrfnc.dimensions["west_east"])
+    nz = len(wrfnc.dimensions["bottom_top"])
+    
+    dx = wrfnc.DX
+    dy = wrfnc.DY
+    center_lat = wrfnc.CEN_LAT
+    center_lon = wrfnc.CEN_LON
+    true_lat1 = wrfnc.TRUELAT1
+    true_lat2 = wrfnc.TRUELAT2
+    
+    basemap = Basemap(projection="lcc", 
+                      lat_0=center_lat,
+                      lon_0=center_lon,
+                      lat_1=true_lat1,
+                      lat_2=true_lat2,
+                      llcrnrlon=lon2d[0,0], 
+                      llcrnrlat=lat2d[0,0], 
+                      urcrnrlon=lon2d[ny-1, nx-1], 
+                      urcrnrlat=lat2d[ny-1, nx-1],
+                      resolution='i')
+    
+    return basemap
+
+def get_default_map_opts():
+    landcolor = (204/255.0, 204/255.0, 153/255.0)
+    oceancolor = (102/255.0, 204/255.0, 255/255.0)
+    return MapOptions(
+                 coastargs = {"linewidth":1.0, "linestyle":'solid', "color":'k'},
+                 countryargs = {"linewidth":0.5, "linestyle":'solid', "color":'k'},
+                 stateargs = {"linewidth":0.5, "linestyle":'solid', "color":'k'},
+                 mapboundaryargs = {"color":'k', "linewidth":1.0, 
+                                    "fill_color":oceancolor},
+                 continentfillargs = {"color":landcolor, "lake_color":oceancolor,
+                                      "zorder":0})
+
+
+def get_null_opts():
+     return FilledContourOptions(fcontourargs={}, 
+                                 colorbarargs={"location" : "bottom", 
+                                               "size" : "5%", "pad" : "2%",
+                                               "extend" : "both"})
+
+def add_plot_info_text(ax,
+                       top_left_text="", top_right_text="",
+                       bot_left_text="", bot_right_text=""):
+    
+    plt.ioff()
+    if top_left_text != "":
+        plt.text(0.005,.995,top_left_text, 
+                 bbox=dict(facecolor="white"),
+                 horizontalalignment="left",
+                 verticalalignment="top",
+                 transform = ax.transAxes,
+                 fontsize=10)
+        
+    if top_right_text != "":  
+        plt.text(.995,.995,top_right_text, 
+                 bbox=dict(facecolor="white"),
+                 horizontalalignment="right",
+                 verticalalignment="top",
+                 transform = ax.transAxes,
+                 fontsize=10)
+    
+    if bot_left_text != "":  
+        plt.text(0.005,0.005,bot_left_text, 
+                 bbox=dict(facecolor="white"),
+                 horizontalalignment="left",
+                 verticalalignment="bottom",
+                 transform = ax.transAxes,
+                 fontsize=10)
+        
+    if bot_right_text != "":  
+        plt.text(.995,0.005,bot_right_text, 
+                 bbox=dict(facecolor="white"),
+                 horizontalalignment="right",
+                 verticalalignment="bottom",
+                 transform = ax.transAxes,
+                 fontsize=10)
+
+def plot_map(basemap, mapoptions):
+    plt.ioff()
+    if mapoptions.mapboundaryargs is not None:
+            basemap.drawmapboundary(**mapoptions.mapboundaryargs)
+            
+    if mapoptions.continentfillargs is not None:
+        basemap.fillcontinents(**mapoptions.continentfillargs)
+    
+    if mapoptions.coastargs is not None:
+        basemap.drawcoastlines(**mapoptions.coastargs)
+        
+    if mapoptions.countryargs is not None:
+        basemap.drawcountries(**mapoptions.countryargs)
+        
+    if mapoptions.stateargs is not None:
+        basemap.drawstates(**mapoptions.stateargs)
+        
+    if mapoptions.countyargs is not None:
+        basemap.drawcounties(**mapoptions.countyargs)
+        
+    if mapoptions.riverargs is not None:
+        basemap.drawrivers(**mapoptions.riverargs)
+
+def plot_contourf(x,y,data,basemap, contourfoptions):
+    plt.ioff()
+    cs1 = None
+    if contourfoptions.contourargs is not None:
+        cs1 = basemap.contour(x,y,data,**contourfoptions.contourargs)
+    
+    cs2 = None
+    if contourfoptions.fcontourargs is not None:
+        cs2 = basemap.contourf(x,y,data,**contourfoptions.fcontourargs)
+    
+    cb = None
+    if contourfoptions.colorbarargs is not None:
+        cb = basemap.colorbar(cs2, **contourfoptions.colorbarargs)
+        
+    if contourfoptions.labelargs is not None:
+        plt.clabel(cs1, **contourfoptions.labelargs)
+        
+    return cs1, cs2, cb
+    
+def get_null_opts():
+     return FilledContourOptions(fcontourargs={}, 
+                                 colorbarargs={"location" : "bottom", 
+                                               "size" : "5%", "pad" : "2%",
+                                               "extend" : "both"})
+
+class MapOptions(object):
+    def __init__(self, 
+                 coastargs = None,
+                 countyargs = None,
+                 countryargs = None,
+                 riverargs = None,
+                 stateargs = None,
+                 mapboundaryargs = None,
+                 continentfillargs = None):
+        self.coastargs = coastargs
+        self.countyargs = countyargs
+        self.countryargs = countryargs
+        self.riverargs = riverargs
+        self.stateargs = stateargs
+        self.mapboundaryargs = mapboundaryargs
+        self.continentfillargs = continentfillargs
+        
+def plot_2d(wrfnc, varname=None, outfile=None, title=None, 
+             map_opts=None, plot_opts=None,
+             top_left_info="", top_right_info="", 
+             bot_left_info="", bot_right_info="",
+             wks_type="png", var=None,
+             time_in=0):
+    
+    try:
+        plt.ioff()
+        print "generating %s.%s" % (outfile, wks_type)
+        if var is not None:
+            field = var
+        elif varname is not None:
+            field = wrfnc.variables[varname][time_in,:,:]
+        
+        lat2d = wrfnc.variables["XLAT"][time_in,:,:]
+        lon2d = wrfnc.variables["XLONG"][time_in,:,:]
+        times = wrfnc.variables["Times"][time_in,:]
+        model_time = "".join(times)
+        start_date = dt.strptime(model_time, "%Y-%m-%d_%H:%M:%S")
+        
+        ny = len(wrfnc.dimensions["south_north"])
+        nx = len(wrfnc.dimensions["west_east"])
+        nz = len(wrfnc.dimensions["bottom_top"])
+        
+        fig = plt.figure(figsize=(8,8), dpi=200)
+        ax = fig.add_axes([0.1,0.1,0.8,0.8])
+        
+        bm = get_basemap(wrfnc)
+        if map_opts is None:
+            map_opts = get_default_map_opts()
+        if plot_opts is None:
+            plot_opts = get_null_opts()
+        
+        x,y = bm(lon2d, lat2d)
+        
+        plot_map(bm,map_opts)
+        
+        plt.xticks(rotation=70)
+        tplot = plot_contourf(x,y,field,bm,plot_opts)
+        
+        
+        add_plot_info_text(ax, 
+                           top_left_info, top_right_info,
+                           bot_left_info, bot_right_info)
+        
+        ax.set_title(title,fontdict={"fontsize" : 20})
+        
+        plt.savefig("%s.%s" % (outfile, wks_type))
+        
+        plt.clf()
+        plt.close(fig)
+    except:
+        # print the stack trace since it will be lost when used in a 
+        # multiprocessing worker.
+        print traceback.format_exc()
+        raise
+    finally:
+        sys.stdout.flush()
+        
+def main():
+    parser = argparse.ArgumentParser(description="Generate meteorological "
+                                     "plots for a specific data file")
+    parser.add_argument("-v", "--var", required=True, 
+                        help="variable name")
+    parser.add_argument("-f", "--filename", required=True, 
+                        help="WRF file to plot")
+    parser.add_argument("-o", "--outdir", default=".", required=False,
+                        help="output directory for images")
+    parser.add_argument("-l", "--levels", required=False, type=float,
+                        nargs="+",
+                        default=None,
+                        help=("the start, end, and increment for contour levels"
+                              " as a list of items with spaces between them"
+                              "example: 1 10 2 "))
+    parser.add_argument("-c", "--customlevels", required=False, type=float,
+                        nargs="+",
+                        default=None,
+                        help=("a list of space delimited contour levels"
+                              "example: 1 2 3 4 5 19 28 200 "))
+    
+    args = parser.parse_args()
+    
+    if not os.path.exists(args.filename):
+        raise RuntimeError ("%s not found" % args.filename)
+    
+    if not os.path.exists(args.outdir):
+        os.makedirs(args.outdir)
+    
+    basename = os.path.basename(args.filename)
+    wrfnc = NetCDF(args.filename, mode='r')
+    
+    outfile = os.path.join(args.outdir, domain, args.var, "%s.%s" % (basename,args.var))
+    if not os.path.exists(os.path.dirname(outfile)):
+        os.makedirs(os.path.dirname(outfile))
+    
+    if args.levels is not None or args.customlevels is not None:
+        plot_opts = get_null_opts()
+        if args.levels is not None:
+            if len(args.levels) < 2 or len(args.levels) > 3:
+                raise RuntimeError("levels argument is invalid")
+            plot_opts.fcontourargs["levels"] = [x for x in n.arange(args.levels[0], 
+                                                                  args.levels[1], 
+                                                                  args.levels[2])]
+            plot_opts.fcontourargs["extend"] = "both"
+        elif args.customlevels is not None:
+            plot_opts.fcontourargs["levels"] = args.customlevels
+            plot_opts.fcontourargs["extend"] = "both"
+    else:
+        plot_opts = None
+    
+    plot_2d(wrfnc, args.var, outfile, "%s"%args.var,
+            plot_opts = plot_opts)
+    
+if __name__ == "__main__":
+    main()

wrf_open/var/script/somplot

@@ -0,0 +1,32 @@
+#!/usr/bin/env python
+import os
+import argparse
+
+import Ngl
+
+from wrf.system import SOMMemberPlotSystem
+
+if __name__ == "__main__":
+    
+    parser = argparse.ArgumentParser(description="Generate meteorological "
+                                     "plots for SOM members")
+    parser.add_argument("-c", "--casename", required=True, 
+                        help="the case name (e.g. 'site1-october')")
+    parser.add_argument("-s", "--somid", required=True,
+                        help="the SOM ID to use (e.g. 'SOM001')")
+    parser.add_argument("-p", "--caseparent", required=False,
+                       default="/projectw/reanalyses/1.2",
+                       help=("the case parent directory "
+                             "[default: /projectw/reanalyses/1.2]"))
+    args = parser.parse_args()
+    
+    parentdir = os.path.expanduser(os.path.expandvars(args.caseparent))
+    casename = args.casename
+    somid = args.somid
+    
+    sys = SOMMemberPlotSystem(parentdir, casename, somid)
+    
+    try:
+        sys.run()
+    finally:
+        Ngl.end()

wrf_open/var/script/wrftest.py

@@ -0,0 +1,143 @@
+
+import wrf.var as w
+import numpy as n
+
+from netCDF4 import Dataset as NetCDF 
+
+def main():
+    wrfnc = NetCDF("/Users/bladwig/wrfout_d03_2003-05-07_09:00:00")
+    
+    # Cape NO RESULTS FOR LCL OR LFC
+    cape, cin, lcl, lfc = w.getvar(wrfnc, "cape2d")
+    #cape, cin = w.getvar(wrfnc, "cape3d")
+    print n.amax(cape)
+    print n.amax(cin)
+    print n.amax(lcl)
+    print n.amax(lfc)
+    
+    
+    # DBZ 
+    dbz = w.getvar(wrfnc, "dbz")
+    print n.amax(dbz)
+    
+    # DP
+    dp = w.getvar(wrfnc, "dp", units="f")
+    print n.amax(dp)
+    
+    dp2 = w.getvar(wrfnc, "dp2m", units="f")
+    print n.amax(dp2)
+    
+    # Height
+    ht = w.getvar(wrfnc, "height", msl=False, units="m")
+    print n.amax(ht)
+    
+    geopt = w.getvar(wrfnc, "geopt")
+    print n.amax(geopt)
+    
+    # Helicity
+    srh = w.getvar(wrfnc, "srh")
+    print n.amax(srh)
+    
+    uhel = w.getvar(wrfnc, "uhel")
+    print n.amax(uhel)
+    
+    # Omega (Not sure if this is correct, and units aren't C)
+    omega = w.getvar(wrfnc, "omega")
+    print n.amax(omega)
+    
+    # Precip Water (NOT SURE)
+    pw = w.getvar(wrfnc, "pw")
+    print n.amax(pw)
+    
+    # RH
+    rh = w.getvar(wrfnc, "rh")
+    print n.amax(rh)
+    
+    rh2 = w.getvar(wrfnc, "rh2m")
+    print n.amax(rh2)
+    
+    # SLP
+    slp = w.getvar(wrfnc, "slp", units="hpa")
+    print n.amax(slp)
+    
+    # TEMP
+    t = w.getvar(wrfnc, "temp", units="f")
+    print n.amax(t)
+    
+    # ETH VALUES SEEM HIGH....
+    eth = w.getvar(wrfnc, "theta_e", units="k")
+    print n.amax(eth)
+    
+    tv = w.getvar(wrfnc, "tv", units="k")
+    print n.amax(tv)
+    
+    # Note: NCL says this is in 'C', but appears to be 'K'
+    tw = w.getvar(wrfnc, "tw", units="f")
+    print n.amax(tw)
+    
+    # WIND
+    umet,vmet = w.getvar(wrfnc, "uvmet", units="kts")
+    print n.amax(umet)
+    print n.amax(vmet)
+    
+    umet10,vmet10 = w.getvar(wrfnc, "uvmet10", units="kts")
+    print n.amax(umet10)
+    print n.amax(vmet10)
+    
+    
+    
+    # TERRAIN
+    ter = w.getvar(wrfnc, "terrain", units="dm")
+    print n.amax(ter)
+    
+    # VORTICITY
+    avo = w.getvar(wrfnc, "avo")
+    print n.amax(avo)
+    
+    pvo = w.getvar(wrfnc, "pvo")
+    print n.amax(pvo)
+    
+    # LAT/LON
+    lat = w.getvar(wrfnc, "lat")
+    print n.amax(lat)
+    print n.amin(lat)
+    
+    lon = w.getvar(wrfnc, "lon")
+    print n.amax(lon)
+    print n.amin(lon)
+    
+    i,j = w.get_ij(wrfnc, -97.516540, 35.467787)
+    print i,j
+    
+    lon, lat = w.get_ll(wrfnc, 33.5, 33.5)
+    print lon, lat
+    
+    #ETA -- Result somewhat different than geopt
+    z = w.convert_eta(wrfnc, msl=False, units="m")
+    print n.amax(z)
+    
+    diff = n.abs(z - ht)/ht * 100.0
+    print n.amin(diff), n.amax(diff)
+    
+    
+    
+    
+    
+    
+    
+    
+    
+    
+    
+    
+    
+    
+    
+    
+    
+    
+    
+    
+
+if __name__ == "__main__":
+    main()

wrf_open/var/setup.py

@@ -0,0 +1,23 @@
+import setuptools
+import numpy.distutils.core
+ 
+ext1 = numpy.distutils.core.Extension(
+    name = "wrf.var._wrfext",
+    sources = ["src/python/wrf/var/wrfext.f90",
+               "src/python/wrf/var/wrfext.pyf"]
+    )
+
+ext2 = numpy.distutils.core.Extension(
+    name = "wrf.var._wrfcape",
+    sources = ["src/python/wrf/var/wrfcape.f90",
+               "src/python/wrf/var/wrfcape.pyf"]
+    )
+
+numpy.distutils.core.setup( 
+    name = "wrf.var",
+    version = "0.0.1",        
+    packages = setuptools.find_packages("src/python"),   
+    ext_modules = [ext1,ext2],
+    package_dir={"":"src/python"},
+    scripts=[],
+)  

wrf_open/var/src/python/wrf/__init__.py

@@ -0,0 +1,7 @@
+try:
+    import pkg_resources
+    pkg_resources.declare_namespace(__name__)
+except ImportError:
+    import pkgutil
+    __path__ = pkgutil.extend_path(__path__, __name__)
+

wrf_open/var/src/python/wrf/var/__init__.py

@@ -0,0 +1,214 @@
+import warnings
+
+from extension import *
+import extension
+from cape import *
+import cape
+from constants import *
+import constants
+from ctt import *
+import ctt
+from dbz import *
+import dbz
+from destagger import *
+import destagger
+from dewpoint import *
+import dewpoint
+from etaconv import *
+import etaconv
+from geoht import *
+import geoht
+from helicity import *
+import helicity
+from interp import *
+import interp
+from latlon import *
+import latlon
+from omega import *
+import omega
+from precip import *
+import precip
+from pressure import *
+import pressure
+from psadlookup import *
+import psadlookup
+from pw import *
+import pw
+from rh import *
+import rh
+from slp import *
+import slp
+from temp import *
+import temp
+from terrain import *
+import terrain
+from uvmet import *
+import uvmet
+from vorticity import *
+import vorticity
+from wind import *
+import wind
+from times import *
+import times
+from units import *
+import units
+
+__all__ = ["getvar"]
+__all__ += extension.__all__
+__all__ += cape.__all__
+__all__ += constants.__all__
+__all__ += ctt.__all__
+__all__ += dbz.__all__
+__all__ += destagger.__all__
+__all__ += dewpoint.__all__
+__all__ += etaconv.__all__
+__all__ += geoht.__all__
+__all__ += helicity.__all__
+__all__ += interp.__all__
+__all__ += latlon.__all__
+__all__ += omega.__all__
+__all__ += precip.__all__
+__all__ += psadlookup.__all__
+__all__ += pw.__all__
+__all__ += rh.__all__
+__all__ += slp.__all__
+__all__ += temp.__all__
+__all__ += terrain.__all__
+__all__ += uvmet.__all__
+__all__ += vorticity.__all__
+__all__ += wind.__all__
+__all__ += times.__all__
+__all__ += pressure.__all__
+__all__ += units.__all__
+
+# func is the function to call.  kargs are required arguments that should 
+# not be altered by the user
+_FUNC_MAP = {"cape2d" : get_2dcape,
+             "cape3d" : get_3dcape,
+             "dbz" : get_dbz,
+             "maxdbz" : get_max_dbz,
+             "dp" : get_dp,
+             "dp2m" : get_dp_2m, 
+             "height" : get_height,
+             "geopt" : get_geopt,
+             "srh" : get_srh,
+             "uhel" : get_uh,
+             "omega" : get_omega,
+             "pw" : get_pw,
+             "rh" : get_rh, 
+             "rh2m" : get_rh_2m, 
+             "slp" : get_slp, 
+             "theta" : get_theta,
+             "temp" : get_temp, 
+             "theta_e" : get_eth, 
+             "tv" : get_tv, 
+             "twb" : get_tw, 
+             "terrain" : get_terrain,
+             "times" : get_times, 
+             "uvmet" : get_uvmet, 
+             "uvmet10" : get_uvmet10,
+             "avo" : get_avo,
+             "pvo" : get_pvo,
+             "ua" : get_u_destag, 
+             "va" : get_v_destag,
+             "wa" : get_w_destag,
+             "lat" : get_lat,
+             "lon" : get_lon,
+             "pressure" : get_pressure,
+             "wspddir" : get_destag_wspd_wdir,
+             "wspddir_uvmet" : get_uvmet_wspd_wdir,
+             "wspddir_uvmet10" : get_uvmet10_wspd_wdir,
+             "ctt" : get_ctt
+             }
+
+_VALID_ARGS = {"cape2d" : ["missing", "timeidx"],
+             "cape3d" : ["missing", "timeidx"],
+             "dbz" : ["do_variant", "do_liqskin", "timeidx"],
+             "maxdbz" : ["do_variant", "do_liqskin", "timeidx"],
+             "dp" : ["timeidx", "units"],
+             "dp2m" : ["timeidx", "units"], 
+             "height" : ["msl", "units", "timeidx"],
+             "geopt" : ["timeidx"],
+             "srh" : ["top", "timeidx"],
+             "uhel" : ["bottom", "top", "timeidx"],
+             "omega" : ["timeidx"],
+             "pw" : ["timeidx"],
+             "rh" : ["timeidx"], 
+             "rh2m" : ["timeidx"], 
+             "slp" : ["units", "timeidx"], 
+             "temp" : ["units", "timeidx"], 
+             "theta" : ["units", "timeidx"],
+             "theta_e" : ["timeidx", "units"], 
+             "tv" : ["units", "timeidx"], 
+             "twb" : ["units", "timeidx"], 
+             "terrain" : ["units", "timeidx"],
+             "times" : ["timeidx"], 
+             "uvmet" : ["units", "timeidx"], 
+             "uvmet10" : ["units", "timeidx"],
+             "avo" : ["timeidx"],
+             "pvo" : ["timeidx"],
+             "ua" : ["units", "timeidx"], 
+             "va" : ["units", "timeidx"],
+             "wa" : ["units", "timeidx"],
+             "lat" : ["timeidx"],
+             "lon" : ["timeidx"],
+             "pressure" : ["units", "timeidx"],
+             "wspddir" : ["units", "timeidx"],
+             "wspddir_uvmet" : ["units", "timeidx"],
+             "wspddir_uvmet10" : ["units", "timeidx"],  
+             "ctt" : ["timeidx"]
+            }
+
+_ALIASES = {"cape_2d" : "cape2d",
+            "cape_3d" : "cape3d",
+            "eth" : "theta_e",
+            "mdbz" : "maxdbz",
+            "geopotential" : "geopt",
+            "helicity" : "srh",
+            "latitude" : "lat",
+            "longitude" : "lon",
+            "omg" : "omega",
+            "pres" : "pressure",
+            "p" : "pressure",
+            "rh2" : "rh2m",
+            "z": "height",
+            "ter" : "terrain",
+            "updraft_helicity" : "uhel",
+            "td" : "dp",
+            "td2" : "dp2m"
+            }
+
+class ArgumentError(Exception):
+    def __init__(self, msg):
+        self.msg = msg
+        
+    def __str__(self):
+        return self.msg
+
+def _undo_alias(alias):
+    actual = _ALIASES.get(alias, None)
+    if actual is None:
+        return alias
+    else:
+        return actual
+
+def _check_kargs(var, kargs):
+    for arg, val in kargs.iteritems():
+        if arg not in _VALID_ARGS[var]:
+            raise ArgumentError("'%s' is an invalid keyword "
+                          "argument for '%s" % (arg, var))
+            
+
+def getvar(wrfnc, var, **kargs):
+    actual_var = _undo_alias(var)
+    if actual_var not in _VALID_ARGS:
+        raise ArgumentError("'%s' is not a valid variable name" % (var))
+    
+    _check_kargs(actual_var, kargs)
+    return _FUNC_MAP[actual_var](wrfnc,**kargs)
+    
+
+    
+    
+    
+    

wrf_open/var/src/python/wrf/var/cape.py

@@ -0,0 +1,84 @@
+import numpy.ma as ma
+
+from wrf.var.extension import computetk,computecape
+from wrf.var.destagger import destagger
+from wrf.var.constants import Constants, ConversionFactors
+
+__all__ = ["get_2dcape", "get_3dcape"]
+
+def get_2dcape(wrfnc, missing=-999999.0, timeidx=0):
+    """Return the 2d fields of cape, cin, lcl, and lfc"""
+    t = wrfnc.variables["T"][timeidx,:,:,:]
+    p = wrfnc.variables["P"][timeidx,:,:,:]
+    pb = wrfnc.variables["PB"][timeidx,:,:,:]
+    qv = wrfnc.variables["QVAPOR"][timeidx,:,:,:]
+    ph = wrfnc.variables["PH"][timeidx,:,:,:]
+    phb = wrfnc.variables["PHB"][timeidx,:,:,:]
+    ter = wrfnc.variables["HGT"][timeidx,:,:]
+    psfc = wrfnc.variables["PSFC"][timeidx,:,:]
+    
+    full_t = t + Constants.T_BASE
+    full_p = p + pb
+    tk = computetk(full_p, full_t)
+    
+    geopt = ph + phb
+    geopt_unstag = destagger(geopt, 0)
+    z = geopt_unstag/Constants.G
+    
+    # Convert pressure to hPa
+    p_hpa = ConversionFactors.PA_TO_HPA * full_p
+    psfc_hpa = ConversionFactors.PA_TO_HPA * psfc # This may be the bug in NCL, as they pass this in 
+                          # has Pa, but other pressure is hPa.  Converting to 
+                          # hPa here.
+    
+    i3dflag = 0
+    ter_follow = 1
+    
+    cape_res,cin_res = computecape(p_hpa,tk,qv,z,ter,psfc_hpa,
+                                   missing,i3dflag,ter_follow)
+    
+    cape = cape_res[0,:,:]
+    cin = cin_res[0,:,:]
+    lcl = cin_res[1,:,:]
+    lfc = cin_res[2,:,:]
+    
+    return (ma.masked_values(cape,missing), 
+            ma.masked_values(cin,missing), 
+            ma.masked_values(lcl,missing), 
+            ma.masked_values(lfc,missing))
+
+def get_3dcape(wrfnc, missing=-999999.0, timeidx=0):
+    """Return the 3d fields of cape and cin"""
+    t = wrfnc.variables["T"][timeidx,:,:,:]
+    p = wrfnc.variables["P"][timeidx,:,:,:]
+    pb = wrfnc.variables["PB"][timeidx,:,:,:]
+    qv = wrfnc.variables["QVAPOR"][timeidx,:,:,:]
+    ph = wrfnc.variables["PH"][timeidx,:,:,:]
+    phb = wrfnc.variables["PHB"][timeidx,:,:,:]
+    ter = wrfnc.variables["HGT"][timeidx,:,:]
+    psfc = wrfnc.variables["PSFC"][timeidx,:,:]
+    
+    full_t = t + Constants.T_BASE
+    full_p = p + pb
+    tk = computetk(full_p, full_t)
+    
+    geopt = ph + phb
+    geopt_unstag = destagger(geopt, 0)
+    z = geopt_unstag/Constants.G
+    
+    # Convert pressure to hPa
+    p_hpa = ConversionFactors.PA_TO_HPA * full_p
+    psfc_hpa = ConversionFactors.PA_TO_HPA * psfc # This may be the bug in NCL, as they pass this in 
+                          # has Pa, but other pressure is hPa.  Converting to 
+                          # hPa here.
+    
+    i3dflag = 1
+    ter_follow = 1
+    
+    cape,cin = computecape(p_hpa,tk,qv,z,ter,psfc_hpa,
+                           missing,i3dflag,ter_follow)
+    return (ma.masked_values(cape, missing), 
+            ma.masked_values(cin, missing))
+    
+    
+    

wrf_open/var/src/python/wrf/var/constants.py

@@ -0,0 +1,27 @@
+
+__all__ = ["Constants", "ConversionFactors"]
+
+class Constants(object):
+    R = 287.06
+    CP = 1005.0
+    G = 9.81
+    TCK0 = 273.15
+    T_BASE = 300.0 # In WRF the base temperature is always 300 (not var T00)
+    PI = 3.14159265
+
+
+class ConversionFactors(object):
+    PA_TO_HPA = .01
+    PA_TO_TORR = 760.0/101325.0
+    PA_TO_MMHG = PA_TO_TORR * 1.000000142466321
+    PA_TO_ATM = 1.0 / 1.01325E5
+    MPS_TO_KTS = 1.94384
+    MPS_TO_KMPH = 3.60
+    MPS_TO_MPH = 2.23694
+    MPS_TO_FPS = 3.28084
+    M_TO_KM = 1.0/1000.0
+    M_TO_DM = 1.0/10.0
+    M_TO_FT = 3.28084
+    M_TO_MILES = .000621371
+    
+    

wrf_open/var/src/python/wrf/var/ctt.py

@@ -0,0 +1,47 @@
+
+import numpy as n
+
+from wrf.var.extension import computectt, computetk
+from wrf.var.constants import Constants, ConversionFactors
+from wrf.var.destagger import destagger
+from wrf.var.decorators import convert_units
+
+__all__ = ["get_ctt"]
+
+@convert_units("temp", "c")
+def get_ctt(wrfnc, units="c", timeidx=0):
+    """Return the cloud top temperature.
+    
+    """
+    t = wrfnc.variables["T"][timeidx,:,:,:]
+    p = wrfnc.variables["P"][timeidx,:,:,:]
+    pb = wrfnc.variables["PB"][timeidx,:,:,:]
+    ph = wrfnc.variables["PH"][timeidx,:,:,:]
+    phb = wrfnc.variables["PHB"][timeidx,:,:,:]
+    ter = wrfnc.variables["HGT"][timeidx,:,:]
+    qv = wrfnc.variables["QVAPOR"][timeidx,:,:,:] * 1000.0 # g/kg
+    
+    haveqci = 1
+    if "QICE" in wrfnc.variables:
+        qice = wrfnc.variables["QICE"][timeidx,:,:,:] * 1000.0 #g/kg
+    else:
+        qice = n.zeros(qv.shape, qv.dtype)
+        haveqci = 0
+        
+    if "QCLOUD" in wrfnc.variables:
+        qcld = wrfnc.variables["QCLOUD"][timeidx,:,:,:] * 1000.0 #g/kg
+    else:
+        raise RuntimeError("'QCLOUD' not found in NetCDF file")
+    
+    full_p = p + pb
+    p_hpa = full_p * ConversionFactors.PA_TO_HPA
+    full_t = t + Constants.T_BASE
+    tk = computetk(full_p, full_t)
+    
+    geopt = ph + phb
+    geopt_unstag = destagger(geopt, 0)
+    ght = geopt_unstag / Constants.G
+    
+    ctt = computectt(p_hpa,tk,qice,qcld,qv,ght,ter,haveqci)
+    
+    return ctt

wrf_open/var/src/python/wrf/var/dbz.py

@@ -0,0 +1,58 @@
+import numpy as n
+
+from wrf.var.extension import computedbz,computetk
+from wrf.var.constants import Constants
+
+__all__ = ["get_dbz", "get_max_dbz"]
+
+def get_dbz(wrfnc, do_varint=False, do_liqskin=False, timeidx=0):
+    """ Return the dbz
+    
+    do_varint - do variable intercept (if False, constants are used.  Otherwise, 
+    intercepts are calculated using a technique from Thompson, Rasmussen, 
+    and Manning (2004, Monthly Weather Review, Vol. 132, No. 2, pp. 519-542.)
+    
+    do_liqskin - do liquid skin for snow (frozen particles above freezing scatter
+    as liquid)
+    
+    """
+    t = wrfnc.variables["T"][timeidx,:,:,:]
+    p = wrfnc.variables["P"][timeidx,:,:,:]
+    pb = wrfnc.variables["PB"][timeidx,:,:,:]
+    
+    qv = wrfnc.variables["QVAPOR"][timeidx,:,:,:]
+    qr = wrfnc.variables["QRAIN"][timeidx,:,:,:]
+    
+    if "QSNOW" in wrfnc.variables:
+        qs = wrfnc.variables["QSNOW"][timeidx,:,:,:]
+    else:
+        qs = n.zeros((qv.shape[0], qv.shape[1], qv.shape[2]), "float")
+        
+    if "QGRAUP" in wrfnc.variables:
+        qg = wrfnc.variables["QGRAUP"][timeidx,:,:,:]
+    else:
+        qg = n.zeros((qv.shape[0], qv.shape[1], qv.shape[2]), "float")
+    
+    # If qsnow is all 0, set sn0 to 1
+    sn0 = 0
+    if (n.any(qs != 0)):
+        sn0 = 1
+    
+    full_t = t + Constants.T_BASE
+    full_p = p + pb
+    tk = computetk(full_p, full_t)
+    
+    ivarint = 0
+    if do_varint:
+        ivarint = 1
+        
+    iliqskin = 0
+    if do_liqskin:
+        iliqskin = 1
+    
+    return computedbz(full_p,tk,qv,qr,qs,qg,sn0,ivarint,iliqskin)
+
+def get_max_dbz(wrfnc, do_varint=False, do_liqskin=False, timeidx=0):
+    return n.amax(get_dbz(wrfnc, do_varint, do_liqskin, timeidx), 
+                  axis=0)
+

wrf_open/var/src/python/wrf/var/decorators.py

@@ -0,0 +1,44 @@
+from functools import wraps
+from inspect import getargspec
+
+from wrf.var.units import do_conversion, check_units
+
+__all__ = ["convert_units"]
+
+def convert_units(unit_type, alg_unit):
+    def convert_decorator(func):
+        @wraps(func)
+        def func_wrapper(*args, **kargs):
+            # If units are provided to the method call, use them.  
+            # Otherwise, need to parse the argspec to find what the default 
+            # value is.
+            if ("units" in kargs):
+                desired_units = kargs["units"]
+            else:
+                argspec = getargspec(func)
+                print argspec
+                arg_idx_from_right = len(argspec.args) - argspec.args.index("units")
+                desired_units = argspec.defaults[-arg_idx_from_right]
+                
+                #print desired_idx
+                #desired_units = argspec.defaults[desired_idx]
+                print desired_units
+                
+            check_units(desired_units, unit_type)
+            
+            # Unit conversion done here
+            return do_conversion(func(*args, **kargs), unit_type, 
+                                 alg_unit, desired_units)
+        return func_wrapper
+    
+    return convert_decorator
+
+def combine_list_and_times(alg_out_dim):
+    def combine_decorator(func):
+        @wraps(func)
+        def func_wrapper(*args, **kargs):
+            argspec = getargspec(func)
+            
+        return func_wrapper
+    
+    return combine_decorator

wrf_open/var/src/python/wrf/var/destagger.py

@@ -0,0 +1,59 @@
+
+import numpy as n
+
+__all__ = ["destagger", "destagger_windcomp", "destagger_winds"]
+
+def destagger(var, stagger_dim):
+    """ De-stagger the variable.  
+    
+    Arguments:
+        - var is a numpy array for the variable 
+        - stagger_dim is the dimension of the numpy array to de-stagger 
+        (e.g. 0, 1, 2)
+    
+    """
+    var_shape = var.shape
+    num_dims = len(var_shape)
+    stagger_dim_size = var_shape[stagger_dim]
+    
+    # Dynamically building the range slices to create the appropriate 
+    # number of ':'s in the array accessor lists.
+    # For example, for a 3D array, the calculation would be 
+    # result = .5 * (var[:,:,0:stagger_dim_size-2] + var[:,:,1:stagger_dim_size-1])
+    # for stagger_dim=2.  So, full slices would be used for dims 0 and 1, but 
+    # dim 2 needs the special slice.  
+    full_slice = slice(None, None, None)
+    slice1 = slice(0, stagger_dim_size - 1, 1)
+    slice2 = slice(1, stagger_dim_size, 1)
+    
+    # default to full slices
+    dim_ranges_1 = [full_slice for x in xrange(num_dims)]
+    dim_ranges_2 = [full_slice for x in xrange(num_dims)]
+    
+    # for the stagger dim, insert the appropriate slice range
+    dim_ranges_1[stagger_dim] = slice1
+    dim_ranges_2[stagger_dim] = slice2
+    
+    result = .5*(var[dim_ranges_1] + var[dim_ranges_2])
+    
+    return result
+
+def destagger_windcomp(wrfnc, comp, timeidx=0):
+    if comp.lower() == "u":
+        wrfvar = "U"
+        stagdim = 2
+    elif comp.lower() == "v":
+        wrfvar = "V"
+        stagdim = 1
+    elif comp.lower() == "w":
+        wrfvar = "W"
+        stagdim = 0
+        
+    wind_data = wrfnc.variables[wrfvar][timeidx,:,:,:]
+    return destagger(wind_data, stagdim)
+
+def destagger_winds(wrfnc, timeidx=0):
+    return (destagger_windcomp(wrfnc, "u", timeidx),
+            destagger_windcomp(wrfnc, "v", timeidx),
+            destagger_windcomp(wrfnc, "w", timeidx))
+    

wrf_open/var/src/python/wrf/var/dewpoint.py

@@ -0,0 +1,31 @@
+from wrf.var.extension import computetd
+from wrf.var.decorators import convert_units
+
+__all__ = ["get_dp", "get_dp_2m"]
+
+@convert_units("temp", "c")
+def get_dp(wrfnc, units="c", timeidx=0):
+    
+    p = wrfnc.variables["P"][timeidx,:,:,:]
+    pb = wrfnc.variables["PB"][timeidx,:,:,:]
+    qvapor = wrfnc.variables["QVAPOR"][timeidx,:,:,:]
+    
+    # Algorithm requires hPa
+    full_p = .01*(p + pb)
+    qvapor[qvapor < 0] = 0
+    
+    td = computetd(full_p, qvapor)
+    return td
+    
+@convert_units("temp", "c")
+def get_dp_2m(wrfnc, units="c", timeidx=0):
+
+    # Algorithm requires hPa
+    psfc = .01*(wrfnc.variables["PSFC"][timeidx,:,:])
+    q2 = wrfnc.variables["Q2"][timeidx,:,:]
+    q2[q2 < 0] = 0
+    
+    td = computetd(psfc, q2)
+    
+    return td
+

wrf_open/var/src/python/wrf/var/etaconv.py

@@ -0,0 +1,81 @@
+import numpy as n
+
+from wrf.var.extension import computeeta
+from wrf.var.constants import Constants
+from wrf.var.decorators import convert_units
+
+#__all__ = ["convert_eta"]
+__all__ = []
+# A useful utility, but should probably just use geopotential height when 
+# plotting for AGL levels
+
+# Eta definition (nu):
+# nu = (P - Ptop) / (Psfc - Ptop)
+
+# def convert_eta(wrfnc, p_or_z="ht", timeidx=0):
+#     if (p_or_z.lower() == "height" or p_or_z.lower() == "ht" 
+#             or p_or_z.lower() == "h"):
+#         return_z = True
+#     elif (p_or_z.lower() == "p" or p_or_z.lower() == "pres" 
+#           or p_or_z.lower() == "pressure"):
+#         return_z = False
+#     
+#     R = Constants.R
+#     G = Constants.G
+#     CP = Constants.CP
+#     
+#     # Keeping the slice notation to show the dimensions
+#     # Note: Not sure if T00 should be used (290) or the usual hard-coded 300 for base
+#     # theta
+#     height_data = wrfnc.variables["HGT"][timeidx,:,:]
+#     znu_data = wrfnc.variables["ZNU"][timeidx,:]
+#     #t00_data = wrfnc.variables["T00"][timeidx]
+#     psfc_data = wrfnc.variables["PSFC"][timeidx,:,:]
+#     ptop_data = wrfnc.variables["P_TOP"][timeidx]
+#     pth_data = wrfnc.variables["T"][timeidx,:,:,:] # Pert potential temp
+#     
+#     pcalc_data = n.zeros(pth_data.shape, dtype=n.float32)
+#     mean_t_data = n.zeros(pth_data.shape, dtype=n.float32)
+#     temp_data = n.zeros(pth_data.shape, dtype=n.float32)
+#     z_data = n.zeros(pth_data.shape, dtype=n.float32)
+#     
+#     #theta_data = pth_data + t00_data
+#     theta_data = pth_data + Constants.T_BASE
+#     
+#     for k in xrange(znu_data.shape[0]):
+#         pcalc_data[k,:,:] = znu_data[k]*(psfc_data[:,:] - (ptop_data)) + (ptop_data)
+#          
+#     # Potential temperature:
+#     # theta = T * (Po/P)^(R/CP)
+#     #
+#     # Hypsometric equation:
+#     # h = z2-z1 = R*Tbar/G * ln(p1/p2)
+#     # where z1, p1 are the surface
+#     if return_z:
+#         for k in xrange(znu_data.shape[0]):
+#             temp_data[k,:,:] = (theta_data[k,:,:]) / ((100000.0 / (pcalc_data[k,:,:]))**(R/CP))      
+#             mean_t_data[k,:,:] = n.mean(temp_data[0:k+1,:,:], axis=0)
+#             z_data[k,:,:] = ((R*mean_t_data[k,:,:]/G) * n.log(psfc_data[:,:]/pcalc_data[k,:,:]))
+#         
+#         return z_data
+#     else:
+#         return pcalc_data * .01
+
+# def convert_eta(wrfnc, units="m", msl=False, timeidx=0):
+#     check_units(units, "height")
+#     hgt = wrfnc.variables["HGT"][timeidx,:,:]
+#     znu = wrfnc.variables["ZNU"][timeidx,:]
+#     psfc = wrfnc.variables["PSFC"][timeidx,:,:]
+#     ptop = wrfnc.variables["P_TOP"][timeidx]
+#     t = wrfnc.variables["T"][timeidx,:,:,:]
+#     
+#     full_theta = t + Constants.T_BASE
+#     
+#     z = computeeta(full_theta, znu, psfc, ptop)
+#     
+#     if not msl:
+#         return convert_units(z, "height", "m", units)
+#     else:
+#         return convert_units(z + hgt, "height", "m", units)
+
+

wrf_open/var/src/python/wrf/var/extension.py

@@ -0,0 +1,323 @@
+import numpy as n
+import numpy.ma as ma
+
+from wrf.var.constants import Constants
+from wrf.var.psadlookup import get_lookup_tables
+from wrf.var._wrfext import (f_interpz3d, f_interp2dxy,f_interp1d,
+                     f_computeslp, f_computetk, f_computetd, f_computerh, 
+                     f_computeabsvort,f_computepvo, f_computeeth, 
+                     f_computeuvmet, 
+                     f_computeomega, f_computetv, f_computewetbulb,
+                     f_computesrh, f_computeuh, f_computepw, f_computedbz,
+                     f_lltoij, f_ijtoll, f_converteta, f_computectt)
+from wrf.var._wrfcape import f_computecape
+
+__all__ = ["FortranException", "computeslp", "computetk", "computetd", 
+           "computerh", "computeavo", "computepvo", "computeeth", 
+           "computeuvmet","computeomega", "computetv", "computesrh", 
+           "computeuh", "computepw","computedbz","computecape", 
+           "computeij", "computell", "computeeta", "computectt"]
+
+class FortranException(Exception):
+    def __call__(self, message):
+        raise self.__class__(message)
+
+def interpz3d(data3d,zdata,desiredloc,missingval):
+    res = f_interpz3d(data3d.astype("float64").T, 
+                      zdata.astype("float64").T, 
+                      desiredloc, 
+                      missingval)
+    return res.astype("float32").T
+
+def interpz2d(data3d,xy):
+    res = f_interp2dxy(data3d.astype("float64").T,
+                       xy.astype("float64").T)
+    # Note: Fortran routine does not support missing values, so no masking
+    return res.astype("float32").T
+
+def interp1d(v_in,z_in,z_out,missingval):
+    res = f_interp1d(v_in.astype("float64"),
+                     z_in.astype("float64"),
+                     z_out.astype("float64"),
+                     missingval)
+    
+    return res.astype("float32")
+
+def computeslp(z,t,p,q):
+    t_surf = n.zeros((z.shape[1], z.shape[2]), "float64")
+    t_sea_level = n.zeros((z.shape[1], z.shape[2]), "float64")
+    level = n.zeros((z.shape[1], z.shape[2]), "int32")
+    
+    res = f_computeslp(z.astype("float64").T, 
+                       t.astype("float64").T, 
+                       p.astype("float64").T, 
+                       q.astype("float64").T,
+                       t_sea_level.T, 
+                       t_surf.T, 
+                       level.T,
+                       FortranException())
+    
+    return res.astype("float32").T
+
+def computetk(pres, theta):
+    # No need to transpose here since operations on 1D array
+    shape = pres.shape
+    res = f_computetk(pres.astype("float64").flatten("A"), 
+                      theta.astype("float64").flatten("A"))
+    res = n.reshape(res, shape, "A")
+    return res.astype("float32")
+
+def computetd(pressure,qv_in):
+    shape = pressure.shape
+    res = f_computetd(pressure.astype("float64").flatten("A"), qv_in.astype("float64").flatten("A"))
+    res = n.reshape(res, shape, "A")
+    return res.astype("float32")
+
+def computerh(qv,q,t):
+    shape = qv.shape
+    res = f_computerh(qv.astype("float64").flatten("A"),
+                      q.astype("float64").flatten("A"),
+                      t.astype("float64").flatten("A"))
+    res = n.reshape(res, shape, "A")
+    return res.astype("float32")
+
+def computeavo(u,v,msfu,msfv,msfm,cor,dx,dy):
+    res = f_computeabsvort(u.astype("float64").T,
+                           v.astype("float64").T,
+                           msfu.astype("float64").T,
+                           msfv.astype("float64").T,
+                           msfm.astype("float64").T,
+                           cor.astype("float64").T,
+                           dx,
+                           dy)
+    
+    return res.astype("float32").T
+
+def computepvo(u,v,theta,prs,msfu,msfv,msfm,cor,dx,dy):
+    
+    res = f_computepvo(u.astype("float64").T,
+                       v.astype("float64").T,
+                       theta.astype("float64").T,
+                       prs.astype("float64").T,
+                       msfu.astype("float64").T,
+                       msfv.astype("float64").T,
+                       msfm.astype("float64").T,
+                       cor.astype("float64").T,
+                       dx,
+                       dy)
+    
+    return res.astype("float32").T
+    
+def computeeth(qv, tk, p):
+    
+    res = f_computeeth(qv.astype("float64").T,
+                       tk.astype("float64").T,
+                       p.astype("float64").T)
+    
+    return res.astype("float32").T
+
+def computeuvmet(u,v,lat,lon,cen_long,cone):
+    longca = n.zeros((lat.shape[0], lat.shape[1]), "float64")
+    longcb = n.zeros((lon.shape[0], lon.shape[1]), "float64")
+    rpd = Constants.PI/180.
+    
+    
+    # Make the 2D array a 3D array with 1 dimension
+    if u.ndim != 3:
+        u = u.reshape((1,u.shape[0], u.shape[1]))
+        v = v.reshape((1,v.shape[0], v.shape[1]))
+
+    # istag will always be false since winds are destaggered already
+    # Missing values don't appear to be used, so setting to 0
+    res = f_computeuvmet(u.astype("float64").T,
+               v.astype("float64").T,
+               longca.T,
+               longcb.T,
+               lon.astype("float64").T,
+               lat.astype("float64").T,
+               cen_long,
+               cone,
+               rpd,
+               0,
+               False,
+               0,
+               0,
+               0)
+
+    
+    return res.astype("float32").T
+
+def computeomega(qv, tk, w, p):
+    
+    res = f_computeomega(qv.astype("float64").T,
+                    tk.astype("float64").T,
+                    w.astype("float64").T,
+                    p.astype("float64").T)
+    
+    #return res.T
+    return res.astype("float32").T
+
+def computetv(tk,qv):
+    res = f_computetv(tk.astype("float64").T,
+                      qv.astype("float64").T)
+    
+    return res.astype("float32").T
+
+def computewetbulb(p,tk,qv):
+    PSADITHTE, PSADIPRS, PSADITMK = get_lookup_tables()
+    
+    res = f_computewetbulb(p.astype("float64").T,
+                     tk.astype("float64").T,
+                     qv.astype("float64").T,
+                     PSADITHTE,
+                     PSADIPRS,
+                     PSADITMK.T,
+                     FortranException())
+    
+    return res.astype("float32").T
+
+def computesrh(u, v, z, ter, top):
+    
+    res = f_computesrh(u.astype("float64").T, 
+                       v.astype("float64").T, 
+                       z.astype("float64").T, 
+                       ter.astype("float64").T, 
+                       top)
+    
+    return res.astype("float32").T
+
+def computeuh(zp, mapfct, u, v, wstag, dx, dy, bottom, top):
+    
+    tem1 = n.zeros((u.shape[0],u.shape[1],u.shape[2]), "float64")
+    tem2 = n.zeros((u.shape[0],u.shape[1],u.shape[2]), "float64")
+    
+    res = f_computeuh(zp.astype("float64").T,
+                      mapfct.astype("float64").T,
+                      dx,
+                      dy,
+                      bottom,
+                      top,
+                      u.astype("float64").T,
+                      v.astype("float64").T,
+                      wstag.astype("float64").T,
+                      tem1.T,
+                      tem2.T)
+    
+    return res.astype("float32").T
+
+def computepw(p,tv,qv,ht):
+    # Note, dim 0 is height, we only want y and x
+    zdiff = n.zeros((p.shape[1], p.shape[2]), "float64")
+    res = f_computepw(p.astype("float64").T,
+                      tv.astype("float64").T,
+                      qv.astype("float64").T,
+                      ht.astype("float64").T,
+                      zdiff.T)
+    
+    return res.astype("float32").T
+
+def computedbz(p,tk,qv,qr,qs,qg,sn0,ivarint,iliqskin):
+    
+    res = f_computedbz(p.astype("float64").T,
+                       tk.astype("float64").T,
+                       qv.astype("float64").T,
+                       qr.astype("float64").T,
+                       qs.astype("float64").T,
+                       qg.astype("float64").T,
+                       sn0,
+                       ivarint,
+                       iliqskin)
+    
+    return res.astype("float32").T
+
+def computecape(p_hpa,tk,qv,ht,ter,sfp,missing,i3dflag,ter_follow):
+    flip_cape = n.zeros((p_hpa.shape[0],p_hpa.shape[1],p_hpa.shape[2]), "float64")
+    flip_cin = n.zeros((p_hpa.shape[0],p_hpa.shape[1],p_hpa.shape[2]), "float64")
+    PSADITHTE, PSADIPRS, PSADITMK = get_lookup_tables()
+    
+    # The fortran routine needs pressure to be ascending in z-direction, 
+    # along with tk,qv,and ht.
+    flip_p = p_hpa[::-1,:,:]
+    flip_tk = tk[::-1,:,:]
+    flip_qv = qv[::-1,:,:]
+    flip_ht = ht[::-1,:,:]
+    
+    f_computecape(flip_p.astype("float64").T,
+                  flip_tk.astype("float64").T,
+                  flip_qv.astype("float64").T,
+                  flip_ht.astype("float64").T,
+                  ter.astype("float64").T,
+                  sfp.astype("float64").T,
+                  flip_cape.T,
+                  flip_cin.T,
+                  PSADITHTE,
+                  PSADIPRS,
+                  PSADITMK.T,
+                  missing,
+                  i3dflag,
+                  ter_follow,
+                  FortranException())
+    
+    # Don't need to transpose since we only passed a view to fortran
+    cape = flip_cape.astype("float32")
+    cin = flip_cin.astype("float32")
+    # Remember to flip cape and cin back to descending p coordinates
+    return (cape[::-1,:,:],cin[::-1,:,:])
+
+
+def computeij(map_proj,truelat1,truelat2,stdlon,
+               lat1,lon1,pole_lat,pole_lon,
+               knowni,knownj,dx,latinc,loninc,lat,lon):
+    
+    res = f_lltoij(map_proj,truelat1,truelat2,stdlon,
+                   lat1,lon1,pole_lat,pole_lon,
+                   knowni,knownj,dx,latinc,loninc,lat,lon,
+                   FortranException())
+    
+    return res[0],res[1]
+
+def computell(map_proj,truelat1,truelat2,stdlon,lat1,lon1,
+             pole_lat,pole_lon,knowni,knownj,dx,latinc,
+             loninc,i,j):
+    
+    res = f_ijtoll(map_proj,truelat1,truelat2,stdlon,lat1,lon1,
+                   pole_lat,pole_lon,knowni,knownj,dx,latinc,
+                   loninc,i,j,FortranException())
+    
+    # Want lon,lat
+    return res[1],res[0]
+
+def computeeta(full_t, znu, psfc, ptop):
+    pcalc = n.zeros(full_t.shape, "float64")
+    mean_t = n.zeros(full_t.shape, "float64")
+    temp_t = n.zeros(full_t.shape, "float64")
+    
+    res = f_converteta(full_t.astype("float64").T, 
+                       znu.astype("float64"), 
+                       psfc.astype("float64").T, 
+                       ptop, 
+                       pcalc.T, 
+                       mean_t.T, 
+                       temp_t.T)
+    
+    return res.astype("float32").T
+
+def computectt(p_hpa,tk,qice,qcld,qv,ght,ter,haveqci):
+    res = f_computectt(p_hpa.astype("float64").T,
+                    tk.astype("float64").T,
+                    qice.astype("float64").T,
+                    qcld.astype("float64").T,
+                    qv.astype("float64").T,
+                    ght.astype("float64").T,
+                    ter.astype("float64").T,
+                    haveqci)
+    
+    return res.astype("float32").T
+
+    
+    
+    
+    
+    
+    
+

wrf_open/var/src/python/wrf/var/geoht.py

@@ -0,0 +1,40 @@
+from wrf.var.constants import Constants
+from wrf.var.destagger import destagger
+from wrf.var.decorators import convert_units
+
+__all__ = ["get_geopt", "get_height"]
+
+def _get_geoht(wrfnc, height=True, msl=True, timeidx=0):
+    """Return the geopotential in units of m2 s-2 if height is False,
+    otherwise return the geopotential height in meters.  If height is True,
+    then if msl is True the result will be in MSL, otherwise AGL (the terrain
+    height is subtracted).
+    
+    """
+
+    if "PH" in wrfnc.variables:
+        ph = wrfnc.variables["PH"][timeidx,:,:,:]
+        phb = wrfnc.variables["PHB"][timeidx,:,:,:]
+        hgt = wrfnc.variables["HGT"][timeidx,:,:]
+        geopt = ph + phb
+        geopt_unstag = destagger(geopt, 0)
+    elif "GHT" in wrfnc.variables: # met_em files
+        geopt_unstag = wrfnc.variables["GHT"][timeidx,:,:,:] * Constants.G
+        hgt = destagger(wrfnc.variables["HGT_U"][timidx,:,:], 1)
+    
+    if height:
+        if msl:
+            return geopt_unstag / Constants.G
+        else:
+            return (geopt_unstag / Constants.G) - hgt
+    else:
+        return geopt_unstag
+
+def get_geopt(wrfnc, timeidx=0):
+    return _get_geoht(wrfnc, False, timeidx=timeidx)
+
+@convert_units("height", "m")
+def get_height(wrfnc, msl=True, units="m", timeidx=0):
+    z = _get_geoht(wrfnc, True, msl, timeidx)
+    return z
+

wrf_open/var/src/python/wrf/var/helicity.py

@@ -0,0 +1,68 @@
+from wrf.var.constants import Constants
+
+from wrf.var.extension import computesrh, computeuh
+from wrf.var.destagger import destagger
+
+__all__ = ["get_srh", "get_uh"]
+
+def get_srh(wrfnc, top=3000.0, timeidx=0):
+    # Top can either be 3000 or 1000 (for 0-1 srh or 0-3 srh)
+    
+    if "U" in wrfnc.variables:
+        u = destagger(wrfnc.variables["U"][timeidx,:,:,:], 2)
+    elif "UU" in wrfnc.variables:
+        u = destagger(wrfnc.variables["UU"][timeidx,:,:,:], 2) # support met_em files
+        
+    if "V" in wrfnc.variables:
+        v = destagger(wrfnc.variables["V"][timeidx,:,:,:], 1)
+    elif "VV" in wrfnc.variables:
+        v = destagger(wrfnc.variables["VV"][timeidx,:,:,:], 1) 
+    
+    ter = wrfnc.variables["HGT"][timeidx,:,:]
+    ph = wrfnc.variables["PH"][timeidx,:,:,:]
+    phb = wrfnc.variables["PHB"][timeidx,:,:,:]
+    
+    geopt = ph + phb
+    geopt_unstag = destagger(geopt, 0)
+    
+    z = geopt_unstag / Constants.G
+    
+    # Re-ordering from high to low
+    u1 = u[::-1,:,:]
+    v1 = v[::-1,:,:]
+    z1 = z[::-1,:,:]
+    
+    srh = computesrh(u1, v1, z1, ter, top)
+    
+    return srh
+
+def get_uh(wrfnc, bottom=2000.0, top=5000.0, timeidx=0):
+    
+    if "U" in wrfnc.variables:
+            u = destagger(wrfnc.variables["U"][timeidx,:,:,:], 2)
+    elif "UU" in wrfnc.variables:
+        u = destagger(wrfnc.variables["UU"][timeidx,:,:,:], 2) # support met_em files
+        
+    if "V" in wrfnc.variables:
+        v = destagger(wrfnc.variables["V"][timeidx,:,:,:], 1)
+    elif "VV" in wrfnc.variables:
+        v = destagger(wrfnc.variables["VV"][timeidx,:,:,:], 1) 
+    
+    wstag = wrfnc.variables["W"][timeidx,:,:,:]
+    ph = wrfnc.variables["PH"][timeidx,:,:,:]
+    phb = wrfnc.variables["PHB"][timeidx,:,:,:]
+    zp = ph + phb
+    
+    mapfct = wrfnc.variables["MAPFAC_M"][timeidx,:,:]
+    dx = wrfnc.getncattr("DX")
+    dy = wrfnc.getncattr("DY")
+       
+       
+    uh = computeuh(zp, mapfct, u, v, wstag, dx, dy, bottom, top)
+    
+    return uh
+
+    
+    
+    
+    

wrf_open/var/src/python/wrf/var/interp.py

@@ -0,0 +1,178 @@
+from math import floor, ceil
+
+import numpy as n
+import numpy.ma as ma
+
+from wrf.var.extension import interpz3d,interpz2d,interp1d
+
+__all__ = ["get_interplevel", "get_vertcross"]
+
+def get_interplevel(data3d,zdata,desiredloc,missingval=-99999):
+    """Return the horizontally interpolated data at the provided level
+    
+    data3d - the 3D field to interpolate
+    zdata - the vertical values (height or pressure)
+    desiredloc - the vertical level to interpolate at (must be same units as
+    zdata)
+    missingval - the missing data value (which will be masked on return)
+    
+    """
+    r1 = interpz3d(data3d, zdata, desiredloc, missingval)
+    masked_r1 = ma.masked_values (r1, missingval)
+    return masked_r1
+
+def _get_xy(xdim, ydim, pivot_point=None, angle=None, 
+           start_point=None, end_point=None):
+    """Returns the x,y points for the horizontal cross section line.
+    
+    xdim - maximum x-dimension
+    ydim - maximum y-dimension
+    pivot_point - a pivot point of (x,y) (must be used with angle)
+    angle - the angle through the pivot point in degrees
+    start_point - a start_point tuple of (x,y)
+    end_point - an end point tuple of (x,y)
+    
+    """ 
+    
+    # Have a pivot point with an angle to find cross section
+    if pivot is not None and angle is not None:
+        xp = pivot_point[0]
+        yp = pivot_point[1]
+        
+        if (angle > 315.0 or angle < 45.0 
+            or ((angle > 135.0) and (angle < 225.0))):
+            
+            #x = y*slope + intercept
+            slope = -(360.-angle)/45.
+            if( angle < 45. ):
+                slope = angle/45.
+            if( angle > 135.):
+                slope = (angle-180.)/45.
+            
+            intercept = xp - yp*slope
+            
+            # find intersections with domain boundaries
+            y0 = 0.
+            x0 = y0*slope + intercept
+            
+            if( x0 < 0.):  # intersect outside of left boundary
+                x0 = 0.
+                y0 =  (x0 - intercept)/slope
+            if( x0 > xdim-1):  #intersect outside of right boundary
+                x0 = xdim-1
+                y0 =  (x0 - intercept)/slope
+            y1 = ydim-1.  #need to make sure this will be a float?
+            x1 = y1*slope + intercept
+            
+            if( x1 < 0.):  # intersect outside of left boundary
+                x1 = 0.
+                y1 =  (x1 - intercept)/slope
+            
+            if( x1 > xdim-1):  # intersect outside of right boundary
+                x1 = xdim-1
+                y1 =  (x1 - intercept)/slope
+        else:
+            #  y = x*slope + intercept
+            slope = (90.-angle)/45.
+            if( angle > 225. ):
+                slope = (270.-angle)/45.
+            intercept = yp - xp*slope
+
+            #find intersections with domain boundaries
+            x0 = 0.
+            y0 = x0*slope + intercept
+            
+            if( y0 < 0.):  # intersect outside of bottom boundary
+                y0 = 0.
+                x0 =  (y0 - intercept)/slope
+            
+            if( y0 > ydim-1):  # intersect outside of top boundary
+                y0 = ydim-1
+                x0 =  (y0 - intercept)/slope
+            
+            x1 = xdim-1.  #  need to make sure this will be a float?
+            y1 = x1*slope + intercept
+            
+            if( y1 < 0.):  # intersect outside of bottom boundary
+                y1 = 0.
+                x1 =  (y1 - intercept)/slope
+            
+            if( y1 > ydim-1):# intersect outside of top boundary
+                y1 = ydim1
+                x1 =  (y1 - intercept)/slope
+    elif start_point is not None and end_point is not None:
+        x0 = start_point[0]
+        y0 = start_point[1]
+        x1 = end_point[0]
+        y1 = end_point[1]
+        if ( x1 > xdim-1 ): 
+            x1 = xdim
+        if ( y1 > ydim-1): 
+            y1 = ydim
+    else:
+        raise ValueError("invalid combination of None arguments")
+    
+    dx = x1 - x0
+    dy = y1 - y0
+    distance = (dx*dx + dy*dy)**0.5
+    npts = int(distance)
+    dxy = distance/npts
+    
+    xz = n.zeros((npts,2), "float")
+
+    dx = dx/npts
+    dy = dy/npts
+    
+    for i in xrange(npts):
+        xy[i,0] = x0 + i*dx
+        xy[i,1] = y0 + i*dy
+        
+    return xy
+
+
+# TODO:  Add flag to use lat/lon points by doing conversion
+def get_vertcross(data3d, z, missingval=-99999, 
+                  pivot=None,angle=None,start_point=None,end_point=None):
+    
+    xdim = z.shape[2]
+    ydim = z.shape[1]
+    
+    xy = _get_xy(xdim, ydim, pivot_point, angle, start_point, end_point)
+    
+    # Interp z
+    var2dz   = interpz2d(z, xy)
+    
+    #  interp to constant z grid
+    if(var2dz[0,0] > var2dz[1,0]):  # monotonically decreasing coordinate
+        z_max = floor(n.amax(z)/10)*10     # bottom value
+        z_min = ceil(n.amin(z)/10)*10      # top value
+        dz = 10
+        nlevels = int( (z_max-z_min)/dz)
+        z_var2d = n.zeros((nlevels), dtype=z.dtype)
+        z_var2d[0] = z_max
+        dz = -dz
+    else:
+        z_max = n.amax(z)
+        z_min = 0.
+        dz = 0.01 * z_max
+        nlevels = int( z_max/dz )
+        z_var2d = n.zeros((nlevels), dtype=z.dtype)
+        z_var2d[0] = z_min
+    
+    for i in xrange(1,nlevels):
+        z_var2d[i] = z_var2d[0] + i*dz
+        
+    #interp the variable
+    
+    var2d = n.zeros((nlevels, xy.shape[0]),dtype=var2dz.dtype)
+    var2dtmp = interpz2d(data3d, xy)
+    
+    for i in xrange(xy.shape[0]):
+        var2d[:,i] = interp1d(var2dtmp[:,i], var2dz[:,i], z_var2d, missingval)
+        
+    return ma.masked_values(var2d, missingval)
+        
+    
+    
+    
+    

wrf_open/var/src/python/wrf/var/latlon.py

@@ -0,0 +1,104 @@
+from wrf.var.extension import computeij, computell
+
+__all__ = ["get_lat", "get_lon", "get_ij", "get_ll"]
+
+def get_lat(wrfnc, timeidx=0):
+    if "XLAT" in wrfnc.variables:
+        xlat = wrfnc.variables["XLAT"][timeidx,:,:]
+    elif "XLAT_M" in wrfnc.variables:
+        xlat = wrfnc.variables["XLAT_M"][timeidx,:,:]
+    
+    return xlat
+        
+def get_lon(wrfnc, timeidx=0):
+    if "XLONG" in wrfnc.variables:
+        xlon = wrfnc.variables["XLONG"][timeidx,:,:]
+    elif "XLONG_M" in wrfnc.variables:
+        xlon = wrfnc.variables["XLONG_M"][timeidx,:,:]
+        
+    return xlon
+
+def get_ij(wrfnc, longitude, latitude, timeidx=0):
+    map_proj = wrfnc.getncattr("MAP_PROJ")
+    truelat1 = wrfnc.getncattr("TRUELAT1")
+    truelat2 = wrfnc.getncattr("TRUELAT2")
+    stdlon = wrfnc.getncattr("STAND_LON")
+    dx = wrfnc.getncattr("DX")
+    dy = wrfnc.getncattr("DY")
+    stdlon = wrfnc.getncattr("STAND_LON")
+    
+    if map_proj == 6:
+        pole_lat = wrfnc.getncattr("POLE_LAT")
+        pole_lon = wrfnc.getncattr("POLE_LON")
+        latinc = (dy*360.0)/2.0/3.141592653589793/6370000.
+        loninc = (dx*360.0)/2.0/3.141592653589793/6370000.
+    else:
+        pole_lat = 90.0
+        pole_lon = 0.0
+        latinc = 0.0
+        loninc = 0.0
+    
+    if "XLAT" in wrfnc.variables:
+        xlat = wrfnc.variables["XLAT"][timeidx,:,:]
+    elif "XLAT_M" in wrfnc.variables:
+        xlat = wrfnc.variables["XLAT_M"][timeidx,:,:]
+        
+    if "XLONG" in wrfnc.variables:
+        xlon = wrfnc.variables["XLONG"][timeidx,:,:]
+    elif "XLONG_M" in wrfnc.variables:
+        xlon = wrfnc.variables["XLONG_M"][timeidx,:,:]
+    
+    ref_lat = xlat[0,0]
+    ref_lon = xlon[0,0]
+    
+    known_i = 1.0
+    known_j = 1.0
+    
+    return computeij(map_proj,truelat1,truelat2,stdlon,
+               ref_lat,ref_lon,pole_lat,pole_lon,
+               known_i,known_j,dx,latinc,loninc,latitude,longitude)
+    
+
+def get_ll(wrfnc, i, j, timeidx=0):
+    
+    map_proj = wrfnc.getncattr("MAP_PROJ")
+    truelat1 = wrfnc.getncattr("TRUELAT1")
+    truelat2 = wrfnc.getncattr("TRUELAT2")
+    stdlon = wrfnc.getncattr("STAND_LON")
+    dx = wrfnc.getncattr("DX")
+    dy = wrfnc.getncattr("DY")
+    stdlon = wrfnc.getncattr("STAND_LON")
+    
+    if map_proj == 6:
+        pole_lat = wrfnc.getncattr("POLE_LAT")
+        pole_lon = wrfnc.getncattr("POLE_LON")
+        latinc = (dy*360.0)/2.0/3.141592653589793/6370000.
+        loninc = (dx*360.0)/2.0/3.141592653589793/6370000.
+    else:
+        pole_lat = 90.0
+        pole_lon = 0.0
+        latinc = 0.0
+        loninc = 0.0
+    
+    if "XLAT" in wrfnc.variables:
+        xlat = wrfnc.variables["XLAT"][timeidx,:,:]
+    elif "XLAT_M" in wrfnc.variables:
+        xlat = wrfnc.variables["XLAT_M"][timeidx,:,:]
+        
+    if "XLONG" in wrfnc.variables:
+        xlon = wrfnc.variables["XLONG"][timeidx,:,:]
+    elif "XLONG_M" in wrfnc.variables:
+        xlon = wrfnc.variables["XLONG_M"][timeidx,:,:]
+    
+    ref_lat = xlat[0,0]
+    ref_lon = xlon[0,0]
+    
+    known_i = 1.0
+    known_j = 1.0
+    
+    return computell(map_proj,truelat1,truelat2,stdlon,ref_lat,ref_lon,
+             pole_lat,pole_lon,known_i,known_j,dx,latinc,
+             loninc,i,j)
+    
+    
+    

wrf_open/var/src/python/wrf/var/omega.py

@@ -0,0 +1,23 @@
+
+from wrf.var.constants import Constants
+from wrf.var.destagger import destagger
+from wrf.var.extension import computeomega,computetk
+
+__all__ = ["get_omega"]
+
+def get_omega(wrfnc, timeidx=0):
+    t = wrfnc.variables["T"][timeidx,:,:,:]
+    p = wrfnc.variables["P"][timeidx,:,:,:]
+    w = wrfnc.variables["W"][timeidx,:,:,:]
+    pb = wrfnc.variables["PB"][timeidx,:,:,:]
+    qv = wrfnc.variables["QVAPOR"][timeidx,:,:,:]
+    
+    wa = destagger(w, 0)
+    full_t = t + Constants.T_BASE
+    full_p = p + pb
+    tk = computetk(full_p, full_t)
+    
+    omega = computeomega(qv,tk,wa,full_p)
+    
+    return omega
+    

wrf_open/var/src/python/wrf/var/precip.py

@@ -0,0 +1,26 @@
+
+import numpy as n
+
+__all__ = ["get_accum_precip", "get_precip_diff"]
+
+def get_accum_precip(wrfnc, timeidx=0):
+    rainc = wrfnc.variables["RAINC"][timeidx,:,:]
+    rainnc = wrfnc.variables["RAINNC"][timeidx,:,:]
+    
+    rainsum = rainc + rainnc
+    
+    return rainsum
+
+def get_precip_diff(wrfnc1, wrfnc2, timeidx=0):
+    rainc1 = wrfnc1.variables["RAINC"][timeidx,:,:]
+    rainnc1 = wrfnc1.variables["RAINNC"][timeidx,:,:]
+    
+    rainc2 = wrfnc2.variables["RAINC"][timeidx,:,:]
+    rainnc2 = wrfnc2.variables["RAINNC"][timeidx,:,:]
+    
+    rainsum1 = rainc1 + rainnc1
+    rainsum2 = rainc2 + rainnc2
+    
+    return (rainsum1 - rainsum2)
+
+# TODO:  Handle bucket flipping

wrf_open/var/src/python/wrf/var/pressure.py

@@ -0,0 +1,20 @@
+
+from wrf.var.constants import Constants
+from wrf.var.decorators import convert_units
+
+__all__ = ["get_pressure"]
+
+@convert_units("pressure", "pa")
+def get_pressure(wrfnc, units="hpa", timeidx=0):
+
+    if "P" in wrfnc.variables:
+        p = wrfnc.variables["P"][timeidx,:,:,:]
+        pb = wrfnc.variables["PB"][timeidx,:,:,:]
+        pres = p + pb
+    elif "PRES" in wrfnc.variables:
+        pres = wrfnc.variables["PRES"][timeidx,:,:,:]
+    
+    return pres
+
+    
+    

wrf_open/var/src/python/wrf/var/pw.py

@@ -0,0 +1,28 @@
+
+from wrf.var.extension import computepw,computetv,computetk
+from wrf.var.constants import Constants
+
+__all__ = ["get_pw"]
+
+def get_pw(wrfnc, timeidx=0):
+    
+    t = wrfnc.variables["T"][timeidx,:,:,:]
+    p = wrfnc.variables["P"][timeidx,:,:,:]
+    pb = wrfnc.variables["PB"][timeidx,:,:,:]
+    ph = wrfnc.variables["PH"][timeidx,:,:,:]
+    phb = wrfnc.variables["PHB"][timeidx,:,:,:]
+    qv = wrfnc.variables["QVAPOR"][timeidx,:,:,:]
+    
+    # Change this to use real virtual temperature!
+    full_p   =  p + pb
+    ht = (ph + phb)/Constants.G
+    full_t  =  t + Constants.T_BASE
+    
+    tk = computetk(full_p, full_t)
+    tv = computetv(tk,qv)
+    
+    return computepw(full_p,tv,qv,ht)
+    
+    
+    
+    

wrf_open/var/src/python/wrf/var/rh.py

@@ -0,0 +1,31 @@
+
+from wrf.var.constants import Constants   
+from wrf.var.extension import computerh, computetk
+
+__all__ = ["get_rh", "get_rh_2m"]
+
+def get_rh(wrfnc, timeidx=0):
+    t = wrfnc.variables["T"][timeidx,:,:,:]
+    #t00 = wrfnc.variables["T00"][timeidx]
+    p = wrfnc.variables["P"][timeidx,:,:,:]
+    pb = wrfnc.variables["PB"][timeidx,:,:,:]
+    qvapor = wrfnc.variables["QVAPOR"][timeidx,:,:,:]
+    
+    full_t = t + Constants.T_BASE
+    full_p = p + pb
+    qvapor[qvapor < 0] = 0
+    tk = computetk(full_p, full_t)
+    rh = computerh(qvapor, full_p, tk)
+    
+    return rh
+
+def get_rh_2m(wrfnc, timeidx=0):
+    t2 = wrfnc.variables["T2"][timeidx,:,:]
+    psfc = wrfnc.variables["PSFC"][timeidx,:,:]
+    q2 = wrfnc.variables["Q2"][timeidx,:,:]
+    
+    q2[q2 < 0] = 0
+    rh = computerh(q2, psfc, t2)
+    
+    return rh
+

wrf_open/var/src/python/wrf/var/slp.py

@@ -0,0 +1,29 @@
+from wrf.var.extension import computeslp, computetk
+from wrf.var.constants import Constants
+from wrf.var.destagger import destagger
+from wrf.var.decorators import convert_units
+
+__all__ = ["get_slp"]
+
+@convert_units("pressure", "pa")
+def get_slp(wrfnc, units="hpa", timeidx=0):
+
+    t = wrfnc.variables["T"][timeidx,:,:,:]
+    p = wrfnc.variables["P"][timeidx,:,:,:]
+    pb = wrfnc.variables["PB"][timeidx,:,:,:]
+    qvapor = wrfnc.variables["QVAPOR"][timeidx,:,:,:]
+    ph = wrfnc.variables["PH"][timeidx,:,:,:]
+    phb = wrfnc.variables["PHB"][timeidx,:,:,:]
+    
+    full_t = t + Constants.T_BASE
+    full_p = p + pb
+    qvapor[qvapor < 0] = 0.
+    full_ph = (ph + phb) / Constants.G
+    
+    destag_ph = destagger(full_ph, 0)
+    
+    tk = computetk(full_p, full_t)
+    slp = computeslp(destag_ph, tk, full_p, qvapor)
+    
+    return slp
+

wrf_open/var/src/python/wrf/var/temp.py

@@ -0,0 +1,82 @@
+
+from wrf.var.constants import Constants
+from wrf.var.extension import computetk, computeeth, computetv, computewetbulb
+from wrf.var.decorators import convert_units
+
+__all__ = ["get_theta", "get_temp", "get_eth", "get_tv", "get_tw"]
+
+@convert_units("temp", "k")
+def get_theta(wrfnc, units="k", timeidx=0):
+    t = wrfnc.variables["T"][timeidx,:,:,:]
+    full_t = t + Constants.T_BASE
+
+    return full_t
+
+@convert_units("temp", "k")
+def get_temp(wrfnc, units="k", timeidx=0):
+    """Return the temperature in Kelvin or Celsius"""
+    
+    t = wrfnc.variables["T"][timeidx,:,:,:]
+    p = wrfnc.variables["P"][timeidx,:,:,:]
+    pb = wrfnc.variables["PB"][timeidx,:,:,:]
+    
+    full_t = t + Constants.T_BASE
+    full_p = p + pb
+    tk = computetk(full_p, full_t)
+    
+    return tk
+
+@convert_units("temp", "k")
+def get_eth(wrfnc, units="k", timeidx=0):
+    "Return equivalent potential temperature (Theta-e) in Kelvin"
+    
+    t = wrfnc.variables["T"][timeidx,:,:,:]
+    p = wrfnc.variables["P"][timeidx,:,:,:]
+    pb = wrfnc.variables["PB"][timeidx,:,:,:]
+    qv = wrfnc.variables["QVAPOR"][timeidx,:,:,:]
+    
+    full_t = t + Constants.T_BASE
+    full_p = p + pb
+    tk = computetk(full_p, full_t)
+    
+    eth = computeeth ( qv, tk, full_p )
+    
+    return eth
+    
+@convert_units("temp", "k")
+def get_tv(wrfnc, units="k", timeidx=0):
+    "Return the virtual temperature (tv) in Kelvin or Celsius"
+    
+    t = wrfnc.variables["T"][timeidx,:,:,:]
+    p = wrfnc.variables["P"][timeidx,:,:,:]
+    pb = wrfnc.variables["PB"][timeidx,:,:,:]
+    qv = wrfnc.variables["QVAPOR"][timeidx,:,:,:]
+    
+    full_t = t + Constants.T_BASE
+    full_p = p + pb
+    tk = computetk(full_p, full_t)
+    
+    tv = computetv(tk,qv)
+    
+    return tv
+    
+
+@convert_units("temp", "k")
+def get_tw(wrfnc, units="k", timeidx=0):
+    "Return the wetbulb temperature (tw)"
+
+    t = wrfnc.variables["T"][timeidx,:,:,:]
+    p = wrfnc.variables["P"][timeidx,:,:,:]
+    pb = wrfnc.variables["PB"][timeidx,:,:,:]
+    qv = wrfnc.variables["QVAPOR"][timeidx,:,:,:]
+    
+    full_t = t + Constants.T_BASE
+    full_p = p + pb
+    
+    tk = computetk(full_p, full_t)
+    tw = computewetbulb(full_p,tk,qv)
+    
+    return tw
+    
+    
+

wrf_open/var/src/python/wrf/var/terrain.py

@@ -0,0 +1,16 @@
+
+from wrf.var.decorators import convert_units
+
+__all__ = ["get_terrain"]
+
+@convert_units("height", "m")
+def get_terrain(wrfnc, units="m", timeidx=0):
+
+    if "HGT" in wrfnc.variables:
+        hgt = wrfnc.variables["HGT"][timeidx,:,:]
+    elif "HGT_M":
+        hgt = wrfnc.variables["HGT_M"][timeidx,:,:] 
+    
+    return hgt
+    
+        

wrf_open/var/src/python/wrf/var/times.py

@@ -0,0 +1,13 @@
+
+import datetime as dt
+
+__all__ = ["get_times"]
+
+def _make_time(timearr):
+    return dt.strptime("".join(timearr[:]), "%Y-%m-%d_%H:%M:%S")
+
+def get_times(wrfnc):
+    times = wrfnc.variables["Times"][:,:]
+    return [_make_time(times[i,:]) for i in xrange(times.shape[0])]    
+
+ 

wrf_open/var/src/python/wrf/var/units.py

@@ -0,0 +1,126 @@
+
+from wrf.var.constants import Constants, ConversionFactors
+
+__all__ = ["check_units", "do_conversion", "convert_units"]
+
+# Handles unit conversions that only differ by multiplication factors
+def _apply_conv_fact(var, vartype, var_unit, dest_unit):
+    if var_unit == dest_unit:
+        return var
+    
+    # Note, case where var_unit and dest_unit are base unit, should be 
+    # handled above
+    if var_unit == _BASE_UNITS[vartype]:
+        return var * _CONV_FACTORS[vartype]["to_dest"][dest_unit]
+    else:
+        if dest_unit == _BASE_UNITS[vartype]:
+            return var*(_CONV_FACTORS[vartype]["to_base"][var_unit])
+        else:
+            return var*(_CONV_FACTORS[vartype]["to_base"][var_unit] * 
+                    _CONV_FACTORS[vartype]["to_dest"][dest_unit])
+
+def _to_celsius(var, var_unit):
+    if var_unit == "k":
+        return var - Constants.TCK0
+    elif var_unit == "f":
+        return (var - 32.0) * (5.0/9.0)
+    
+def _c_to_k(var):
+    return var + Constants.TCK0
+
+def _c_to_f(var):
+    return ((9.0/5.0)*var) + 32.0
+
+# Temperature is a more complicated operation so requres functions
+def _apply_temp_conv(var, var_unit, dest_unit):
+    if dest_unit == var_unit:
+        return var
+    
+    if var_unit != _BASE_UNITS["temp"]:
+        tc = _to_celsius(var, var_unit)
+        if dest_unit == _BASE_UNITS["temp"]:
+            return tc
+        else:
+            return (_TEMP_CONV_METHODS[dest_unit])(tc)
+    else:
+        return (_TEMP_CONV_METHODS[dest_unit])(var)
+
+_VALID_UNITS = {"wind" : ["mps", "kts", "mph", "kmph", "fps"],
+          "pressure" : ["pa", "hpa", "mb", "torr", "mmhg", "atm"],
+          "temp" : ["k", "f", "c"],
+          "height" : ["m", "km", "dm", "ft", "miles"]
+          }
+
+_WIND_BASE_FACTORS = {"kts" : ConversionFactors.MPS_TO_KTS,
+                "kmph" : ConversionFactors.MPS_TO_KMPH,
+                "mph" : ConversionFactors.MPS_TO_MPH,
+                "fps" : ConversionFactors.MPS_TO_FPS
+            }
+
+_WIND_TOBASE_FACTORS = {"kts" : 1.0/ConversionFactors.MPS_TO_KTS,
+                        "kmph" : 1.0/ConversionFactors.MPS_TO_KMPH,
+                        "mph" : 1.0/ConversionFactors.MPS_TO_MPH,
+                        "fps" : 1.0/ConversionFactors.MPS_TO_FPS
+                        }
+
+_PRES_BASE_FACTORS = {"hpa" : ConversionFactors.PA_TO_HPA,
+                      "mb" : ConversionFactors.PA_TO_HPA,
+                      "torr" : ConversionFactors.PA_TO_TORR,
+                      "mmhg" : ConversionFactors.PA_TO_MMHG,
+                      "atm" : ConversionFactors.PA_TO_ATM
+                      }
+
+_PRES_TOBASE_FACTORS = {"hpa" : 1.0/ConversionFactors.PA_TO_HPA,
+                        "mb" : 1.0/ConversionFactors.PA_TO_HPA,
+                        "torr" : 1.0/ConversionFactors.PA_TO_TORR,
+                        "mmhg" : 1.0/ConversionFactors.PA_TO_MMHG,
+                        "atm" : 1.0/ConversionFactors.PA_TO_ATM
+                        }
+
+_HEIGHT_BASE_FACTORS = {"km" : ConversionFactors.M_TO_KM,
+                        "dm" : ConversionFactors.M_TO_DM,
+                        "ft" : ConversionFactors.M_TO_FT,
+                        "miles" : ConversionFactors.M_TO_MILES
+                        }
+
+_HEIGHT_TOBASE_FACTORS = {"km" : 1.0/ConversionFactors.M_TO_KM,
+                        "dm" : 1.0/ConversionFactors.M_TO_DM,
+                        "ft" : 1.0/ConversionFactors.M_TO_FT,
+                        "miles" : 1.0/ConversionFactors.M_TO_MILES
+                        
+                        }
+
+_BASE_UNITS = {"wind" : "mps",
+               "pressure" : "pa",
+               "temp" : "c",
+               "height" : "m"
+               }
+
+_CONV_FACTORS = {"wind" : {"to_dest" : _WIND_BASE_FACTORS,
+                           "to_base" : _WIND_TOBASE_FACTORS},
+                 "pressure" : {"to_dest" : _PRES_BASE_FACTORS,
+                               "to_base" : _PRES_TOBASE_FACTORS},
+                 "height" : {"to_dest" : _HEIGHT_BASE_FACTORS,
+                             "to_base" : _HEIGHT_TOBASE_FACTORS}            
+                 }
+
+_TEMP_CONV_METHODS = {"k" : _c_to_k,
+                      "f" : _c_to_f
+                      }
+
+def check_units(unit, type):
+    unitl = unit.lower()
+    if unitl not in _VALID_UNITS[type]:
+        raise ValueError("invalid unit type '%s'" % unit)
+
+def do_conversion(var, vartype, var_unit, dest_unit):
+    if vartype != "temp":
+        return _apply_conv_fact(var, vartype, var_unit, dest_unit)
+    else:
+        return _apply_temp_conv(var, var_unit, dest_unit)
+    
+convert_units = do_conversion
+
+
+    
+    

wrf_open/var/src/python/wrf/var/uvmet.py

@@ -0,0 +1,105 @@
+from math import fabs, log, tan, sin, cos
+
+from wrf.var.extension import computeuvmet
+from wrf.var.destagger import destagger
+from wrf.var.constants import Constants
+from wrf.var.wind import _calc_wspd_wdir
+from wrf.var.decorators import convert_units
+
+__all__=["get_uvmet", "get_uvmet10", "get_uvmet_wspd_wdir", 
+         "get_uvmet10_wspd_wdir"]
+
+@convert_units("wind", "mps")
+def get_uvmet(wrfnc, ten_m=False, units ="mps", timeidx=0):
+    """ Return a tuple of u,v with the winds rotated in to earth space"""
+    
+    if not ten_m:
+        if "U" in wrfnc.variables:
+            u = destagger(wrfnc.variables["U"][timeidx,:,:,:],  2)
+        elif "UU" in wrfnc.variables:
+            u = destagger(wrfnc.variables["UU"][timeidx,:,:,:], 2) # support met_em files
+            
+        if "V" in wrfnc.variables:
+            v = destagger(wrfnc.variables["V"][timeidx,:,:,:], 1)
+        elif "VV" in wrfnc.variables:
+            v = destagger(wrfnc.variables["VV"][timeidx,:,:,:], 1) 
+    else:
+        if "U10" in wrfnc.variables:
+            u = wrfnc.variables["U10"][timeidx,:,:]
+        elif "UU" in wrfnc.variables:
+            u = destagger(wrfnc.variables["UU"][timeidx,0,:,:], 1) # support met_em files
+        
+        if "V10" in wrfnc.variables:
+            v = wrfnc.variables["V10"][timeidx,:,:]
+        elif "VV" in wrfnc.variables:
+            v = destagger(wrfnc.variables["VV"][timeidx,0,:,:], 0) # support met_em files
+        
+    map_proj = wrfnc.getncattr("MAP_PROJ")
+    
+    # 1 - Lambert
+    # 2 - Polar Stereographic
+    # 3 - Mercator
+    # 6 - Lat/Lon
+    # Note:  NCL has no code to handle other projections (0,4,5) as they 
+    # don't appear to be supported any longer
+    
+    if map_proj in (0,3,6):
+        # No rotation needed for Mercator and Lat/Lon
+        return u,v
+    elif map_proj in (1,2):
+        radians_per_degree = Constants.PI/180.0
+        # Rotation needed for Lambert and Polar Stereographic
+        cen_lat  = wrfnc.getncattr("CEN_LAT")
+        if "STAND_LON" in wrfnc.ncattrs():
+            cen_lon = wrfnc.getncattr("STAND_LON")
+        else:
+            cen_lon = wrfnc.getncattr("CEN_LON")
+            
+        true_lat1 = wrfnc.getncattr("TRUELAT1")
+        true_lat2 = wrfnc.getncattr("TRUELAT2")
+        
+        if "XLAT_M" in wrfnc.variables:
+            lat = wrfnc.variables["XLAT_M"][timeidx,:,:]
+        else:
+            lat = wrfnc.variables["XLAT"][timeidx,:,:]
+            
+        if "XLONG_M" in wrfnc.variables:
+            lon = wrfnc.variables["XLONG_M"][timeidx,:,:]
+        else:
+            lon = wrfnc.variables["XLONG"][timeidx,:,:]
+            
+        if map_proj == 1:
+            if((fabs(true_lat1 - true_lat2) > 0.1) and
+                    (fabs(true_lat2 - 90.) > 0.1)): 
+                cone = (log(cos(true_lat1*radians_per_degree)) 
+                        - log(cos(true_lat2*radians_per_degree)))
+                cone = cone / (log(tan((45.-fabs(true_lat1/2.))*radians_per_degree)) 
+                        - log(tan((45.-fabs(true_lat2/2.))*radians_per_degree))) 
+            else:
+                cone = sin(fabs(true_lat1)*radians_per_degree)
+        else:
+            cone = 1
+        
+        res = computeuvmet(u,v,lat,lon,cen_lon,cone)
+        
+        if u.ndim == 3:
+            return res
+        else:
+            return res[:,0,:,:]
+            
+    
+def get_uvmet10(wrfnc, units="mps", timeidx=0):
+    return get_uvmet(wrfnc, True, units, timeidx)
+
+def get_uvmet_wspd_wdir(wrfnc, units="mps", timeidx=0):
+    u,v = get_uvmet(wrfnc, False, units, timeidx)
+    return _calc_wspd_wdir(u, v, units)
+
+def get_uvmet10_wspd_wdir(wrfnc, units="mps", timeidx=0):
+    u,v = get_uvmet10(wrfnc, units="mps", timeidx=0)
+    return _calc_wspd_wdir(u, v, units)
+
+            
+        
+            
+            

wrf_open/var/src/python/wrf/var/vorticity.py

@@ -0,0 +1,35 @@
+from wrf.var.extension import computeavo, computepvo
+
+__all__ = ["get_avo", "get_pvo"]
+
+def get_avo(wrfnc, timeidx=0):
+    u = wrfnc.variables["U"][timeidx,:,:,:]
+    v = wrfnc.variables["V"][timeidx,:,:,:]
+    msfu = wrfnc.variables["MAPFAC_U"][timeidx,:,:]
+    msfv = wrfnc.variables["MAPFAC_V"][timeidx,:,:]
+    msfm = wrfnc.variables["MAPFAC_M"][timeidx,:,:]
+    cor = wrfnc.variables["F"][timeidx,:,:]
+    dx = wrfnc.getncattr("DX")
+    dy = wrfnc.getncattr("DY")
+    
+    return computeavo(u,v,msfu,msfv,msfm,cor,dx,dy)
+
+
+def get_pvo(wrfnc, timeidx=0):
+    u = wrfnc.variables["U"][timeidx,:,:,:]
+    v = wrfnc.variables["V"][timeidx,:,:,:]
+    t = wrfnc.variables["T"][timeidx,:,:,:]
+    p = wrfnc.variables["P"][timeidx,:,:,:]
+    pb = wrfnc.variables["PB"][timeidx,:,:,:]
+    msfu = wrfnc.variables["MAPFAC_U"][timeidx,:,:]
+    msfv = wrfnc.variables["MAPFAC_V"][timeidx,:,:]
+    msfm = wrfnc.variables["MAPFAC_M"][timeidx,:,:]
+    cor = wrfnc.variables["F"][timeidx,:,:]
+    dx = wrfnc.getncattr("DX")
+    dy = wrfnc.getncattr("DY")
+    
+    full_t = t + 300
+    full_p = p + pb
+    
+    return computepvo(u,v,full_t,full_p,msfu,msfv,msfm,cor,dx,dy)
+    

wrf_open/var/src/python/wrf/var/wind.py

@@ -0,0 +1,43 @@
+
+import numpy as n
+
+from wrf.var.constants import Constants
+from wrf.var.destagger import destagger_windcomp
+from wrf.var.decorators import convert_units
+
+__all__ = ["get_u_destag", "get_v_destag", "get_w_destag",
+           "get_destag_wspd_wdir"]
+
+def _calc_wspd(u, v):
+    return n.sqrt(u**2 + v**2)
+
+def _calc_wdir(u, v):
+    wdir = 270.0 - n.arctan2(v,u) * (180.0/Constants.PI)
+    return n.remainder(wdir, 360.0)
+
+@convert_units("wind", "mps")
+def _calc_wspd_wdir(u, v, units="mps"):
+    check_units(units, "wind")
+    return (_calc_wspd(u,v), _calc_wdir(u,v))
+
+@convert_units("wind", "mps")
+def get_u_destag(wrfnc, units="mps", timeidx=0):
+    u = destagger_windcomp(wrfnc,"u", timeidx)
+    return u
+
+@convert_units("wind", "mps")
+def get_v_destag(wrfnc, units="mps", timeidx=0):
+    v = destagger_windcomp(wrfnc,"v", timeidx)
+    return v
+
+@convert_units("wind", "mps")
+def get_w_destag(wrfnc, units="mps", timeidx=0):
+    w = destagger_windcomp(wrfnc,"w", timeidx)
+    return w
+
+def get_destag_wspd_wdir(wrfnc, units="mps", timeidx=0):
+    u = destagger_windcomp(wrfnc,"u", timeidx)
+    v = destagger_windcomp(wrfnc,"v", timeidx)
+    
+    return _calc_wspd_wdir(u,v,units)
+

wrf_open/var/src/python/wrf/var/wrfcape.f90

@@ -0,0 +1,556 @@
+! The kind of code only a scientist could love.
+! TODO: The cape routine needs work to remove the GOTOs
+
+!======================================================================
+!
+! !IROUTINE: TVIRTUAL -- Calculate virtual temperature (K)
+!
+! !DESCRIPTION:
+!
+!   This function returns a single value of virtual temperature in
+!   K, given temperature in K and mixing ratio in kg/kg.  For an
+!   array of virtual temperatures, use subroutine VIRTUAL_TEMP.
+!
+! !INPUT:
+!    RATMIX - water vapor mixing ratio (kg/kg)
+!    TEMP   - temperature (K)
+!
+! !OUTPUT:
+!    TV     - Virtual temperature (K)
+!
+
+REAL(KIND=8) FUNCTION tvirtual(temp,ratmix)
+    IMPLICIT NONE
+    REAL(KIND=8),INTENT(IN) :: temp,ratmix
+    REAL(KIND=8),PARAMETER :: EPS = .622D0
+
+    tvirtual = temp*(EPS+ratmix)/(EPS*(1.D0+ratmix))
+    RETURN
+END FUNCTION tvirtual
+
+REAL(KIND=8) FUNCTION tonpsadiabat(thte,prs,PSADITHTE,PSADIPRS,PSADITMK,GAMMA,&
+                                    throw_exception)
+    IMPLICIT NONE
+    EXTERNAL throw_exception
+    REAL(KIND=8),INTENT(IN) :: thte
+    REAL(KIND=8),INTENT(IN) :: prs
+    REAL(KIND=8),DIMENSION(150),INTENT(IN) :: PSADITHTE
+    REAL(KIND=8),DIMENSION(150),INTENT(IN) :: PSADIPRS
+    REAL(KIND=8),DIMENSION(150,150),INTENT(IN) :: PSADITMK
+    REAL(KIND=8),INTENT(IN) :: GAMMA
+
+    REAL(KIND=8) :: fracjt
+    REAL(KIND=8) :: fracjt2
+    REAL(KIND=8) :: fracip
+    REAL(KIND=8) :: fracip2
+
+    INTEGER :: ip, ipch, jt, jtch
+
+    !   This function gives the temperature (in K) on a moist adiabat
+    !   (specified by thte in K) given pressure in hPa.  It uses a
+    !   lookup table, with data that was generated by the Bolton (1980)
+    !   formula for theta_e.
+
+    !     First check if pressure is less than min pressure in lookup table.
+    !     If it is, assume parcel is so dry that the given theta-e value can
+    !     be interpretted as theta, and get temperature from the simple dry
+    !     theta formula.
+
+    IF (prs.LE.PSADIPRS(150)) THEN
+      tonpsadiabat = thte * (prs/1000.D0)**GAMMA
+      RETURN
+    END IF
+
+    !   Otherwise, look for the given thte/prs point in the lookup table.
+
+    jt = -1
+    DO jtch = 1,150 - 1
+      IF (thte.GE.PSADITHTE(jtch) .AND. thte.LT.PSADITHTE(jtch+1)) THEN
+          jt = jtch
+          EXIT
+          !GO TO 213
+      END IF
+    END DO
+
+!    JT = -1
+!213 CONTINUE
+    ip = -1
+    DO ipch = 1,150 - 1
+      IF (prs.LE.PSADIPRS(ipch) .AND. prs.GT.PSADIPRS(ipch+1)) THEN
+          ip = ipch
+          EXIT
+          !GO TO 215
+      END IF
+    END DO
+
+!    IP = -1
+!215 CONTINUE
+    IF (jt.EQ.-1 .OR. ip.EQ.-1) THEN
+        ! Need an exception here
+        CALL throw_exception('capecalc3d: ','Outside of lookup table bounds. prs,thte=',prs,thte)
+        !STOP
+    END IF
+    fracjt = (thte-PSADITHTE(jt)) / (PSADITHTE(jt+1)-PSADITHTE(jt))
+    fracjt2 = 1.D0 - fracjt
+    fracip = (PSADIPRS(ip)-prs) / (PSADIPRS(ip)-PSADIPRS(ip+1))
+    fracip2 = 1.D0 - fracip
+    IF (PSADITMK(ip,jt).GT.1D9 .OR. PSADITMK(ip+1,jt).GT.1D9 .OR. &
+        PSADITMK(ip,jt+1).GT.1D9 .OR. PSADITMK(ip+1,jt+1).GT.1D9) THEN
+        CALL throw_exception('capecalc3d: ','Tried to access missing temperature in lookup table.',&
+        'Prs and Thte probably unreasonable. prs,thte=',prs,thte)
+      !STOP
+    END IF
+    tonpsadiabat = fracip2*fracjt2*PSADITMK(ip,jt)+fracip*fracjt2*PSADITMK(ip+1,jt)+&
+            fracip2*fracjt*PSADITMK(ip,jt+1)+fracip*fracjt*PSADITMK(ip+1,jt+1)
+
+    RETURN
+END FUNCTION tonpsadiabat
+
+
+!     Historically, this routine calculated the pressure at full sigma
+!     levels when RIP was specifically designed for MM4/MM5 output.
+!     With the new generalized RIP (Feb '02), this routine is still
+!     intended to calculate a set of pressure levels that bound the
+!     layers represented by the vertical grid points, although no such
+!     layer boundaries are assumed to be defined.  The routine simply
+!     uses the midpoint between the pressures of the vertical grid
+!     points as the bounding levels.  The array only contains mkzh
+!     levels, so the pressure of the top of the uppermost layer is
+!     actually excluded.  The kth value of pf is the lower bounding
+!     pressure for the layer represented by kth data level.  At the
+!     lower bounding level of the lowest model layer, it uses the
+!     surface pressure, unless the data set is pressure-level data, in
+!     which case it assumes the lower bounding pressure level is as far
+!     below the lowest vertical level as the upper bounding pressure
+!     level is above.
+SUBROUTINE dpfcalc(prs,sfp,pf,miy,mjx,mkzh,ter_follow)
+
+    REAL(KIND=8),DIMENSION(miy,mjx,mkzh),INTENT(IN) :: prs
+    REAL(KIND=8),DIMENSION(miy,mjx),INTENT(IN) :: sfp
+    REAL(KIND=8),DIMENSION(miy,mjx,mkzh),INTENT(OUT) :: pf
+    INTEGER,INTENT(IN) :: ter_follow,miy,mjx,mkzh
+
+    INTEGER :: i,j,k
+
+    !  do j=1,mjx-1  Artifact of MM5
+    DO j = 1,mjx
+    !  do i=1,miy-1  staggered grid
+      DO i = 1,miy
+          DO k = 1,mkzh
+              IF (k.EQ.mkzh) THEN
+    !  terrain-following data
+                  IF (ter_follow.EQ.1) THEN
+                      pf(i,j,k) = sfp(i,j)
+    !  pressure-level data
+                  ELSE
+                      pf(i,j,k) = .5D0 * (3.D0*prs(i,j,k)-prs(i,j,k-1))
+                  END IF
+              ELSE
+                  pf(i,j,k) = .5D0* (prs(i,j,k+1)+prs(i,j,k))
+              END IF
+          END DO
+      END DO
+    END DO
+
+    RETURN
+END SUBROUTINE dpfcalc
+
+!======================================================================
+!
+! !IROUTINE: capecalc3d -- Calculate CAPE and CIN
+!
+! !DESCRIPTION:
+!
+!   If i3dflag=1, this routine calculates CAPE and CIN (in m**2/s**2,
+!   or J/kg) for every grid point in the entire 3D domain (treating
+!   each grid point as a parcel).  If i3dflag=0, then it
+!   calculates CAPE and CIN only for the parcel with max theta-e in
+!   the column, (i.e. something akin to Colman's MCAPE).  By "parcel",
+!   we mean a 500-m deep parcel, with actual temperature and moisture
+!   averaged over that depth.
+!
+!   In the case of i3dflag=0,
+!   CAPE and CIN are 2D fields that are placed in the k=mkzh slabs of
+!   the cape and cin arrays.  Also, if i3dflag=0, LCL and LFC heights
+!   are put in the k=mkzh-1 and k=mkzh-2 slabs of the cin array.
+!
+
+
+! Important!  The z-indexes must be arranged so that mkzh (max z-index) is the
+! surface pressure.  So, pressure must be ordered in ascending order before
+! calling this routine.  Other variables must be ordered the same (p,tk,q,z).
+
+! Also, be advised that missing data values are not checked during the computation.
+! Also also, Pressure must be hPa
+!
+SUBROUTINE f_computecape(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
+            PSADITHTE,PSADIPRS,PSADITMK,cmsg,i3dflag,ter_follow,&
+            throw_exception,miy,mjx,mkzh)
+
+    IMPLICIT NONE
+    EXTERNAL throw_exception
+    INTEGER,INTENT(IN) :: miy,mjx,mkzh,i3dflag,ter_follow
+    REAL(KIND=8),DIMENSION(miy,mjx,mkzh),INTENT(IN) :: prs
+    REAL(KIND=8),DIMENSION(miy,mjx,mkzh),INTENT(IN) :: tmk
+    REAL(KIND=8),DIMENSION(miy,mjx,mkzh),INTENT(IN) :: qvp
+    REAL(KIND=8),DIMENSION(miy,mjx,mkzh),INTENT(IN) :: ght
+    REAL(KIND=8),DIMENSION(miy,mjx),INTENT(IN) :: ter
+    REAL(KIND=8),DIMENSION(miy,mjx),INTENT(IN) ::sfp
+    REAL(KIND=8),DIMENSION(miy,mjx,mkzh),INTENT(INOUT) :: cape
+    REAL(KIND=8),DIMENSION(miy,mjx,mkzh),INTENT(INOUT) :: cin
+    REAL(KIND=8),DIMENSION(150),INTENT(IN) :: PSADITHTE,PSADIPRS
+    REAL(KIND=8),DIMENSION(150,150),INTENT(IN) :: PSADITMK
+    REAL(KIND=8),INTENT(IN) :: cmsg
+
+    ! local variables
+    INTEGER :: i,j,k,ilcl,kel,kk,klcl,klev,klfc,kmax,kpar,kpar1,kpar2
+    REAL(KIND=8) :: davg,ethmax,q,t,p,e,eth,tlcl,zlcl
+    REAL(KIND=8) :: pavg,tvirtual,p1,p2,pp1,pp2,th,totthe,totqvp,totprs
+    REAL(KIND=8) :: cpm,deltap,ethpari,gammam,ghtpari,qvppari,prspari,tmkpari
+    REAL(KIND=8) :: facden,fac1,fac2,qvplift,tmklift,tvenv,tvlift,ghtlift
+    REAL(KIND=8) :: eslift,tmkenv,qvpenv,tonpsadiabat
+    REAL(KIND=8) :: benamin,dz,pup,pdn
+    REAL(KIND=8),DIMENSION(150) :: buoy,zrel,benaccum
+    REAL(KIND=8),DIMENSION(miy,mjx,mkzh) :: prsf
+
+    ! constants
+    INTEGER,PARAMETER :: IUP = 6
+    REAL(KIND=8),PARAMETER :: CELKEL = 273.15d0
+    REAL(KIND=8),PARAMETER :: GRAV = 9.81d0
+    ! hpa
+    REAL(KIND=8),PARAMETER :: EZERO = 6.112d0
+    REAL(KIND=8),PARAMETER :: ESLCON1 = 17.67d0
+    REAL(KIND=8),PARAMETER :: ESLCON2 = 29.65d0
+    REAL(KIND=8),PARAMETER :: EPS = 0.622d0
+    ! j/k/kg
+    REAL(KIND=8),PARAMETER :: RGAS = 287.04d0
+    !  j/k/kg  note: not using bolton's value of 1005.7
+    REAL(KIND=8),PARAMETER :: CP = 1004.d0
+    REAL(KIND=8),PARAMETER :: GAMMA = RGAS/CP
+    !  cp_moist=cp*(1.+cpmd*qvp)
+    REAL(KIND=8),PARAMETER :: CPMD = .887d0
+    !  rgas_moist=rgas*(1.+rgasmd*qvp)
+    REAL(KIND=8),PARAMETER :: RGASMD = .608d0
+    !  gamma_moist=gamma*(1.+gammamd*qvp)
+    REAL(KIND=8),PARAMETER :: GAMMAMD = RGASMD - CPMD
+    REAL(KIND=8),PARAMETER :: TLCLC1 = 2840.d0
+    REAL(KIND=8),PARAMETER :: TLCLC2 = 3.5d0
+    REAL(KIND=8),PARAMETER :: TLCLC3 = 4.805d0
+    REAL(KIND=8),PARAMETER :: TLCLC4 = 55.d0
+    !  k
+    REAL(KIND=8),PARAMETER :: THTECON1 = 3376.d0
+    REAL(KIND=8),PARAMETER :: THTECON2 = 2.54d0
+    REAL(KIND=8),PARAMETER :: THTECON3 = .81d0
+
+    ! To get rid of compiler warnings
+    tmkpari = 0
+    qvppari = 0
+    klev = 0
+    klcl = 0
+
+    ! the comments were taken from a mark stoelinga email, 23 apr 2007,
+    ! in response to a user getting the "outside of lookup table bounds"
+    ! error message.
+
+    ! tmkpari  - initial temperature of parcel, k
+    !    values of 300 okay. (not sure how much from this you can stray.)
+
+    ! prspari - initial pressure of parcel, hpa
+    !    values of 980 okay. (not sure how much from this you can stray.)
+
+    ! thtecon1, thtecon2, thtecon3
+    !     these are all constants, the first in k and the other two have
+    !     no units.  values of 3376, 2.54, and 0.81 were stated as being
+    !     okay.
+
+    ! tlcl - the temperature at the parcel's lifted condensation level, k
+    !        should be a reasonable atmospheric temperature around 250-300 k
+    !        (398 is "way too high")
+
+    ! qvppari - the initial water vapor mixing ratio of the parcel,
+    !           kg/kg (should range from 0.000 to 0.025)
+    !
+
+    !  calculated the pressure at full sigma levels (a set of pressure
+    !  levels that bound the layers represented by the vertical grid points)
+
+    CALL dpfcalc(prs,sfp,prsf,miy,mjx,mkzh,ter_follow)
+
+    !  before looping, set lookup table for getting temperature on
+    !  a pseudoadiabat.
+
+    !call dlookup_table(psadithte,psadiprs,psaditmk,psafile)
+
+    !   do j=1,mjx-1
+    DO j = 1,mjx
+    !   do i=1,miy-1
+      DO i = 1,miy
+          cape(i,j,1) = 0.d0
+          cin(i,j,1) = 0.d0
+
+          IF (i3dflag.eq.1) THEN
+              kpar1 = 2
+              kpar2 = mkzh
+          ELSE
+
+    !      find parcel with max theta-e in lowest 3 km agl.
+
+              ethmax = -1.d0
+              DO k = mkzh,1,-1
+                  IF (ght(i,j,k)-ter(i,j).lt.3000.d0) then
+                      q = MAX(qvp(i,j,k),1.d-15)
+                      t = tmk(i,j,k)
+                      p = prs(i,j,k)
+                      e = q*p/ (EPS+q)
+                      tlcl = TLCLC1/ (log(t**TLCLC2/e)-TLCLC3) + TLCLC4
+                      eth = t* (1000.d0/p)**(GAMMA* (1.d0+GAMMAMD*q))*&
+                              EXP((THTECON1/tlcl-THTECON2)*q*(1.d0+THTECON3*q))
+                      IF (eth.gt.ethmax) then
+                          klev = k
+                          ethmax = eth
+                      END IF
+                  END IF
+              END DO
+              kpar1 = klev
+              kpar2 = klev
+
+    !      establish average properties of that parcel
+    !         (over depth of approximately davg meters)
+
+    !         davg=.1
+              davg = 500.d0
+              pavg = davg*prs(i,j,kpar1)*&
+                  GRAV/(RGAS*tvirtual(tmk(i,j,kpar1),qvp(i,j,kpar1)))
+              p2 = MIN(prs(i,j,kpar1)+.5d0*pavg,prsf(i,j,mkzh))
+              p1 = p2 - pavg
+              totthe = 0.d0
+              totqvp = 0.d0
+              totprs = 0.d0
+              DO k = mkzh,2,-1
+                  IF (prsf(i,j,k).le.p1) GOTO 35
+                  IF (prsf(i,j,k-1).ge.p2) GOTO 34
+                  p = prs(i,j,k)
+                  pup = prsf(i,j,k)
+                  pdn = prsf(i,j,k-1)
+                  q = MAX(qvp(i,j,k),1.d-15)
+                  th = tmk(i,j,k)* (1000.d0/p)**(GAMMA* (1.d0+GAMMAMD*q))
+                  pp1 = MAX(p1,pdn)
+                  pp2 = MIN(p2,pup)
+                  IF (pp2.gt.pp1) then
+                      deltap = pp2 - pp1
+                      totqvp = totqvp + q*deltap
+                      totthe = totthe + th*deltap
+                      totprs = totprs + deltap
+                  END IF
+    34        CONTINUE
+              END DO
+    35        CONTINUE
+              qvppari = totqvp/totprs
+              tmkpari = (totthe/totprs)*&
+                  (prs(i,j,kpar1)/1000.d0)**(GAMMA*(1.d0+GAMMAMD*qvp(i,j,kpar1)))
+          END IF
+
+          DO kpar = kpar1,kpar2
+
+    !   calculate temperature and moisture properties of parcel
+    !     (note, qvppari and tmkpari already calculated above for 2d case.)
+
+              IF (i3dflag.eq.1) then
+                  qvppari = qvp(i,j,kpar)
+                  tmkpari = tmk(i,j,kpar)
+              END IF
+              prspari = prs(i,j,kpar)
+              ghtpari = ght(i,j,kpar)
+              gammam = GAMMA* (1.d0+GAMMAMD*qvppari)
+              cpm = CP* (1.d0+CPMD*qvppari)
+
+              e = MAX(1.d-20,qvppari*prspari/ (EPS+qvppari))
+              tlcl = TLCLC1/ (LOG(tmkpari**TLCLC2/e)-TLCLC3) +TLCLC4
+              ethpari = tmkpari* (1000.d0/prspari)**(GAMMA*(1.d0+GAMMAMD*qvppari))*&
+                  EXP((THTECON1/tlcl-THTECON2)*qvppari*(1.d0+THTECON3*qvppari))
+              zlcl = ghtpari + (tmkpari-tlcl)/ (GRAV/cpm)
+
+    !   calculate buoyancy and relative height of lifted parcel at
+    !   all levels, and store in bottom up arrays.  add a level at the lcl,
+    !   and at all points where buoyancy is zero.
+    !
+    !  for arrays that go bottom to top
+              kk = 0
+              ilcl = 0
+              IF (ghtpari.ge.zlcl) THEN
+
+    !      initial parcel already saturated or supersaturated.
+
+                  ilcl = 2
+                  klcl = 1
+              END IF
+              DO k = kpar,1,-1
+    !  for arrays that go bottom to top
+    33                 kk = kk + 1
+    !  model level is below lcl
+                  IF (ght(i,j,k).lt.zlcl) THEN
+                      qvplift = qvppari
+                      tmklift = tmkpari - GRAV/cpm*(ght(i,j,k)-ghtpari)
+                      tvenv = tvirtual(tmk(i,j,k),qvp(i,j,k))
+                      tvlift = tvirtual(tmklift,qvplift)
+                      ghtlift = ght(i,j,k)
+                  ELSE IF (ght(i,j,k).ge.zlcl .and. ilcl.eq.0) THEN
+
+    !     this model level and previous model level straddle the lcl,
+    !     so first create a new level in the bottom-up array, at the lcl.
+
+                      tmklift = tlcl
+                      qvplift = qvppari
+                      facden = ght(i,j,k) - ght(i,j,k+1)
+                      fac1 = (zlcl-ght(i,j,k+1))/facden
+                      fac2 = (ght(i,j,k)-zlcl)/facden
+                      tmkenv = tmk(i,j,k+1)*fac2 + tmk(i,j,k)*fac1
+                      qvpenv = qvp(i,j,k+1)*fac2 + qvp(i,j,k)*fac1
+                      tvenv = tvirtual(tmkenv,qvpenv)
+                      tvlift = tvirtual(tmklift,qvplift)
+                      ghtlift = zlcl
+                      ilcl = 1
+                  ELSE
+                      tmklift = tonpsadiabat(ethpari,prs(i,j,k),PSADITHTE,PSADIPRS,PSADITMK,GAMMA,throw_exception)
+                      eslift = EZERO*exp(ESLCON1* (tmklift-CELKEL)/(tmklift-ESLCON2))
+                      qvplift = EPS*eslift/ (prs(i,j,k)-eslift)
+                      tvenv = tvirtual(tmk(i,j,k),qvp(i,j,k))
+                      tvlift = tvirtual(tmklift,qvplift)
+                      ghtlift = ght(i,j,k)
+                  END IF
+    !  buoyancy
+                  buoy(kk) = GRAV* (tvlift-tvenv)/tvenv
+                  zrel(kk) = ghtlift - ghtpari
+                  IF ((kk.gt.1).and.(buoy(kk)*buoy(kk-1).lt.0.0d0)) THEN
+
+    !   parcel ascent curve crosses sounding curve, so create a new level
+    !   in the bottom-up array at the crossing.
+
+                      kk = kk + 1
+                      buoy(kk) = buoy(kk-1)
+                      zrel(kk) = zrel(kk-1)
+                      buoy(kk-1) = 0.d0
+                      zrel(kk-1) = zrel(kk-2) +buoy(kk-2)/&
+                          (buoy(kk-2)-buoy(kk))*(zrel(kk)-zrel(kk-2))
+                  END IF
+                  IF (ilcl.eq.1) THEN
+                      klcl = kk
+                      ilcl = 2
+                      GOTO 33
+                  END IF
+              END DO
+              kmax = kk
+              IF (kmax.gt.150) THEN
+                  ! Need an exception here
+                  CALL throw_exception('capecalc3d: kmax got too big. kmax=',kmax)
+                  !STOP
+              END IF
+
+    !   if no lcl was found, set klcl to kmax.  it is probably not really
+    !   at kmax, but this will make the rest of the routine behave
+    !   properly.
+
+              IF (ilcl.eq.0) klcl=kmax
+
+    !   get the accumulated buoyant energy from the parcel's starting
+    !   point, at all levels up to the top level.
+
+              benaccum(1) = 0.0d0
+              benamin = 9d9
+              DO k = 2,kmax
+                  dz = zrel(k) - zrel(k-1)
+                  benaccum(k) = benaccum(k-1) +.5d0*dz* (buoy(k-1)+buoy(k))
+                  IF (benaccum(k).lt.benamin) then
+                      benamin = benaccum(k)
+                  END IF
+              END DO
+
+    !     determine equilibrium level (el), which we define as the highest
+    !     level of non-negative buoyancy above the lcl. note, this may be
+    !     the top level if the parcel is still buoyant there.
+
+              DO k = kmax,klcl,-1
+                  IF (buoy(k).ge.0.d0) THEN
+    !  k of equilibrium level
+                      kel = k
+                      GOTO 50
+                  END IF
+              END DO
+
+    !   if we got through that loop, then there is no non-negative
+    !   buoyancy above the lcl in the sounding.  in these situations,
+    !   both cape and cin will be set to -0.1 j/kg. (see below about
+    !   missing values in v6.1.0). also, where cape is
+    !   non-zero, cape and cin will be set to a minimum of +0.1 j/kg, so
+    !   that the zero contour in either the cin or cape fields will
+    !   circumscribe regions of non-zero cape.
+
+    !   in v6.1.0 of ncl, we added a _fillvalue attribute to the return
+    !   value of this function. at that time we decided to change -0.1
+    !   to a more appropriate missing value, which is passed into this
+    !   routine as cmsg.
+
+    !                 cape(i,j,kpar) = -0.1d0
+    !                 cin(i,j,kpar) = -0.1d0
+              cape(i,j,kpar) = cmsg
+              cin(i,j,kpar)  = cmsg
+              klfc = kmax
+
+              GOTO 102
+
+    50        CONTINUE
+
+    !   if there is an equilibrium level, then cape is positive.  we'll
+    !   define the level of free convection (lfc) as the point below the
+    !   el, but at or above the lcl, where accumulated buoyant energy is a
+    !   minimum.  the net positive area (accumulated buoyant energy) from
+    !   the lfc up to the el will be defined as the cape, and the net
+    !   negative area (negative of accumulated buoyant energy) from the
+    !   parcel starting point to the lfc will be defined as the convective
+    !   inhibition (cin).
+
+    !   first get the lfc according to the above definition.
+
+              benamin = 9d9
+              klfc = kmax
+              DO k = klcl,kel
+                  IF (benaccum(k).lt.benamin) THEN
+                      benamin = benaccum(k)
+                      klfc = k
+                  END IF
+              END DO
+
+    !   now we can assign values to cape and cin
+
+              cape(i,j,kpar) = MAX(benaccum(kel)-benamin,0.1d0)
+              cin(i,j,kpar) = MAX(-benamin,0.1d0)
+
+    !   cin is uninteresting when cape is small (< 100 j/kg), so set
+    !   cin to -0.1 (see note about missing values in v6.1.0) in
+    !   that case.
+
+    !   in v6.1.0 of ncl, we added a _fillvalue attribute to the return
+    !   value of this function. at that time we decided to change -0.1
+    !   to a more appropriate missing value, which is passed into this
+    !   routine as cmsg.
+
+    !                 IF (cape(i,j,kpar).lt.100.d0) cin(i,j,kpar) = -0.1d0
+              IF (cape(i,j,kpar).lt.100.d0) cin(i,j,kpar) = cmsg
+    102   CONTINUE
+
+          END DO
+
+          IF (i3dflag.eq.0) THEN
+              cape(i,j,mkzh) = cape(i,j,kpar1)
+              cin(i,j,mkzh) = cin(i,j,kpar1)
+    !  meters agl
+              cin(i,j,mkzh-1) = zrel(klcl) + ghtpari - ter(i,j)
+    !  meters agl
+              cin(i,j,mkzh-2) = zrel(klfc) + ghtpari - ter(i,j)
+          ENDIF
+
+      END DO
+    END DO
+
+    RETURN
+END SUBROUTINE f_computecape

wrf_open/var/src/python/wrf/var/wrfcape.pyf

@@ -0,0 +1,74 @@
+!    -*- f90 -*-
+! Note: the context of this file is case sensitive.
+
+python module tonpsadiabat__user__routines 
+    interface tonpsadiabat_user_interface 
+        subroutine throw_exception(e__capecalc3d___err,e__outside_of_lookup_table_bounds__prs_thte__err,prs,thte) ! in :_wrfcape:wrfcape.f90:tonpsadiabat:unknown_interface
+            character*(*) :: e__capecalc3d___err
+            character*(*) :: e__outside_of_lookup_table_bounds__prs_thte__err
+            real(kind=8) intent(in) :: prs
+            real(kind=8) intent(in) :: thte
+        end subroutine throw_exception
+    end interface tonpsadiabat_user_interface
+end python module tonpsadiabat__user__routines
+python module f_computecape__user__routines 
+    interface f_computecape_user_interface 
+        subroutine throw_exception(e__capecalc3d__kmax_got_too_big__kmax__err,kmax) ! in :_wrfcape:wrfcape.f90:f_computecape:unknown_interface
+            character*(*) :: e__capecalc3d__kmax_got_too_big__kmax__err
+            integer :: kmax
+        end subroutine throw_exception
+    end interface f_computecape_user_interface
+end python module f_computecape__user__routines
+python module _wrfcape ! in 
+    interface  ! in :_wrfcape
+        function tvirtual(temp,ratmix) ! in :_wrfcape:wrfcape.f90
+            real(kind=8) intent(in) :: temp
+            real(kind=8) intent(in) :: ratmix
+            real(kind=8) :: tvirtual
+        end function tvirtual
+        function tonpsadiabat(thte,prs,psadithte,psadiprs,psaditmk,gamma,throw_exception) ! in :_wrfcape:wrfcape.f90
+            use tonpsadiabat__user__routines
+            real(kind=8) intent(in) :: thte
+            real(kind=8) intent(in) :: prs
+            real(kind=8) dimension(150),intent(in) :: psadithte
+            real(kind=8) dimension(150),intent(in) :: psadiprs
+            real(kind=8) dimension(150,150),intent(in) :: psaditmk
+            real(kind=8) intent(in) :: gamma
+            external throw_exception
+            real(kind=8) :: tonpsadiabat
+        end function tonpsadiabat
+        subroutine dpfcalc(prs,sfp,pf,miy,mjx,mkzh,ter_follow) ! in :_wrfcape:wrfcape.f90
+            real(kind=8) dimension(miy,mjx,mkzh),intent(in) :: prs
+            real(kind=8) dimension(miy,mjx),intent(in),depend(miy,mjx) :: sfp
+            real(kind=8) dimension(miy,mjx,mkzh),intent(out),depend(miy,mjx,mkzh) :: pf
+            integer, optional,intent(in),check(shape(prs,0)==miy),depend(prs) :: miy=shape(prs,0)
+            integer, optional,intent(in),check(shape(prs,1)==mjx),depend(prs) :: mjx=shape(prs,1)
+            integer, optional,intent(in),check(shape(prs,2)==mkzh),depend(prs) :: mkzh=shape(prs,2)
+            integer intent(in) :: ter_follow
+        end subroutine dpfcalc
+        subroutine f_computecape(prs,tmk,qvp,ght,ter,sfp,cape,cin,psadithte,psadiprs,psaditmk,cmsg,i3dflag,ter_follow,throw_exception,miy,mjx,mkzh) ! in :_wrfcape:wrfcape.f90
+            use f_computecape__user__routines
+            real(kind=8) dimension(miy,mjx,mkzh),intent(in) :: prs
+            real(kind=8) dimension(miy,mjx,mkzh),intent(in),depend(miy,mjx,mkzh) :: tmk
+            real(kind=8) dimension(miy,mjx,mkzh),intent(in),depend(miy,mjx,mkzh) :: qvp
+            real(kind=8) dimension(miy,mjx,mkzh),intent(in),depend(miy,mjx,mkzh) :: ght
+            real(kind=8) dimension(miy,mjx),intent(in),depend(miy,mjx) :: ter
+            real(kind=8) dimension(miy,mjx),intent(in),depend(miy,mjx) :: sfp
+            real(kind=8) dimension(miy,mjx,mkzh),intent(inout),depend(miy,mjx,mkzh) :: cape
+            real(kind=8) dimension(miy,mjx,mkzh),intent(inout),depend(miy,mjx,mkzh) :: cin
+            real(kind=8) dimension(150),intent(in) :: psadithte
+            real(kind=8) dimension(150),intent(in) :: psadiprs
+            real(kind=8) dimension(150,150),intent(in) :: psaditmk
+            real(kind=8) intent(in) :: cmsg
+            integer intent(in) :: i3dflag
+            integer intent(in) :: ter_follow
+            external throw_exception
+            integer, optional,intent(in),check(shape(prs,0)==miy),depend(prs) :: miy=shape(prs,0)
+            integer, optional,intent(in),check(shape(prs,1)==mjx),depend(prs) :: mjx=shape(prs,1)
+            integer, optional,intent(in),check(shape(prs,2)==mkzh),depend(prs) :: mkzh=shape(prs,2)
+        end subroutine f_computecape
+    end interface 
+end python module _wrfcape
+
+! This file was auto-generated with f2py (version:2).
+! See http://cens.ioc.ee/projects/f2py2e/

wrf_open/var/src/python/wrf/var/wrfext.pyf

@@ -0,0 +1,334 @@
+!    -*- f90 -*-
+! Note: the context of this file is case sensitive.
+
+python module f_computeslp__user__routines 
+    interface f_computeslp_user_interface 
+        subroutine throw_exception(e__error_in_finding_100_hpa_up_err) ! in :_wrfext:wrfext.f90:f_computeslp:unknown_interface
+            character*(*) :: e__error_in_finding_100_hpa_up_err
+        end subroutine throw_exception
+    end interface f_computeslp_user_interface
+end python module f_computeslp__user__routines
+python module f_computewetbulb__user__routines 
+    interface f_computewetbulb_user_interface 
+        subroutine throw_exception(e__outside_of_lookup_table_bounds__prs_thte__err,p,eth) ! in :_wrfext:wrfext.f90:f_computewetbulb:unknown_interface
+            character*(*) :: e__outside_of_lookup_table_bounds__prs_thte__err
+            real(kind=8) :: p
+            real(kind=8) :: eth
+        end subroutine throw_exception
+    end interface f_computewetbulb_user_interface
+end python module f_computewetbulb__user__routines
+python module f_lltoij__user__routines 
+    interface f_lltoij_user_interface 
+        subroutine throw_exception(e__do_not_know_map_projection__err,map_proj) ! in :_wrfext:wrfext.f90:f_lltoij:unknown_interface
+            character*(*) :: e__do_not_know_map_projection__err
+            integer intent(in) :: map_proj
+        end subroutine throw_exception
+    end interface f_lltoij_user_interface
+end python module f_lltoij__user__routines
+python module f_ijtoll__user__routines 
+    interface f_ijtoll_user_interface 
+        subroutine throw_exception(e__do_not_know_map_projection__err,map_proj) ! in :_wrfext:wrfext.f90:f_ijtoll:unknown_interface
+            character*(*) :: e__do_not_know_map_projection__err
+            integer intent(in) :: map_proj
+        end subroutine throw_exception
+    end interface f_ijtoll_user_interface
+end python module f_ijtoll__user__routines
+python module _wrfext ! in 
+    interface  ! in :_wrfext
+        subroutine f_interpz3d(data3d,zdata,desiredloc,missingval,out2d,nx,ny,nz) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(nx,ny,nz),intent(in) :: data3d
+            real(kind=8) dimension(nx,ny,nz),intent(in),depend(nx,ny,nz) :: zdata
+            real(kind=8) intent(in) :: desiredloc
+            real(kind=8) intent(in) :: missingval
+            real(kind=8) dimension(nx,ny),intent(out),depend(nx,ny) :: out2d
+            integer, optional,intent(in),check(shape(data3d,0)==nx),depend(data3d) :: nx=shape(data3d,0)
+            integer, optional,intent(in),check(shape(data3d,1)==ny),depend(data3d) :: ny=shape(data3d,1)
+            integer, optional,intent(in),check(shape(data3d,2)==nz),depend(data3d) :: nz=shape(data3d,2)
+        end subroutine f_interpz3d
+        subroutine f_interp2dxy(v3d,xy,v2d,nx,ny,nz,nxy) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(nx,ny,nz),intent(in) :: v3d
+            real(kind=8) dimension(2,nxy),intent(in) :: xy
+            real(kind=8) dimension(nxy,nz),intent(out),depend(nxy,nz) :: v2d
+            integer, optional,intent(in),check(shape(v3d,0)==nx),depend(v3d) :: nx=shape(v3d,0)
+            integer, optional,intent(in),check(shape(v3d,1)==ny),depend(v3d) :: ny=shape(v3d,1)
+            integer, optional,intent(in),check(shape(v3d,2)==nz),depend(v3d) :: nz=shape(v3d,2)
+            integer, optional,intent(in),check(shape(xy,1)==nxy),depend(xy) :: nxy=shape(xy,1)
+        end subroutine f_interp2dxy
+        subroutine f_interp1d(v_in,z_in,z_out,vmsg,v_out,nz_in,nz_out) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(nz_in),intent(in) :: v_in
+            real(kind=8) dimension(nz_in),intent(in),depend(nz_in) :: z_in
+            real(kind=8) dimension(nz_out),intent(in) :: z_out
+            real(kind=8) intent(in) :: vmsg
+            real(kind=8) dimension(nz_out),intent(out),depend(nz_out) :: v_out
+            integer, optional,intent(in),check(len(v_in)>=nz_in),depend(v_in) :: nz_in=len(v_in)
+            integer, optional,intent(in),check(len(z_out)>=nz_out),depend(z_out) :: nz_out=len(z_out)
+        end subroutine f_interp1d
+        subroutine f_computeslp(z,t,p,q,t_sea_level,t_surf,level,throw_exception,sea_level_pressure,nx,ny,nz) ! in :_wrfext:wrfext.f90
+            use f_computeslp__user__routines
+            real(kind=8) dimension(nx,ny,nz),intent(in) :: z
+            real(kind=8) dimension(nx,ny,nz),intent(in),depend(nx,ny,nz) :: t
+            real(kind=8) dimension(nx,ny,nz),intent(in),depend(nx,ny,nz) :: p
+            real(kind=8) dimension(nx,ny,nz),intent(in),depend(nx,ny,nz) :: q
+            real(kind=8) dimension(nx,ny),intent(inout),depend(nx,ny) :: t_sea_level
+            real(kind=8) dimension(nx,ny),intent(inout),depend(nx,ny) :: t_surf
+            integer dimension(nx,ny),intent(inout),depend(nx,ny) :: level
+            external throw_exception
+            real(kind=8) dimension(nx,ny),intent(out),depend(nx,ny) :: sea_level_pressure
+            integer, optional,intent(in),check(shape(z,0)==nx),depend(z) :: nx=shape(z,0)
+            integer, optional,intent(in),check(shape(z,1)==ny),depend(z) :: ny=shape(z,1)
+            integer, optional,intent(in),check(shape(z,2)==nz),depend(z) :: nz=shape(z,2)
+        end subroutine f_computeslp
+        subroutine f_computetk(pressure,theta,tk,nx) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(nx),intent(in) :: pressure
+            real(kind=8) dimension(nx),intent(in),depend(nx) :: theta
+            real(kind=8) dimension(nx),intent(out),depend(nx) :: tk
+            integer, optional,intent(in),check(len(pressure)>=nx),depend(pressure) :: nx=len(pressure)
+        end subroutine f_computetk
+        subroutine f_computetd(pressure,qv_in,td,nx) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(nx),intent(in) :: pressure
+            real(kind=8) dimension(nx),intent(in),depend(nx) :: qv_in
+            real(kind=8) dimension(nx),intent(out),depend(nx) :: td
+            integer, optional,intent(in),check(len(pressure)>=nx),depend(pressure) :: nx=len(pressure)
+        end subroutine f_computetd
+        subroutine f_computerh(qv,p,t,rh,nx) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(nx),intent(in) :: qv
+            real(kind=8) dimension(nx),intent(in),depend(nx) :: p
+            real(kind=8) dimension(nx),intent(in),depend(nx) :: t
+            real(kind=8) dimension(nx),intent(out),depend(nx) :: rh
+            integer, optional,intent(in),check(len(qv)>=nx),depend(qv) :: nx=len(qv)
+        end subroutine f_computerh
+        subroutine f_computeabsvort(u,v,msfu,msfv,msft,cor,dx,dy,av,nx,ny,nz,nxp1,nyp1) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(nxp1,ny,nz),intent(in) :: u
+            real(kind=8) dimension(nx,nyp1,nz),intent(in),depend(nz) :: v
+            real(kind=8) dimension(nxp1,ny),intent(in),depend(nxp1,ny) :: msfu
+            real(kind=8) dimension(nx,nyp1),intent(in),depend(nx,nyp1) :: msfv
+            real(kind=8) dimension(nx,ny),intent(in),depend(nx,ny) :: msft
+            real(kind=8) dimension(nx,ny),intent(in),depend(nx,ny) :: cor
+            real(kind=8) :: dx
+            real(kind=8) :: dy
+            real(kind=8) dimension(nx,ny,nz),intent(out),depend(nx,ny,nz) :: av
+            integer, optional,intent(in),check(shape(v,0)==nx),depend(v) :: nx=shape(v,0)
+            integer, optional,intent(in),check(shape(u,1)==ny),depend(u) :: ny=shape(u,1)
+            integer, optional,intent(in),check(shape(u,2)==nz),depend(u) :: nz=shape(u,2)
+            integer, optional,intent(in),check(shape(u,0)==nxp1),depend(u) :: nxp1=shape(u,0)
+            integer, optional,intent(in),check(shape(v,1)==nyp1),depend(v) :: nyp1=shape(v,1)
+        end subroutine f_computeabsvort
+        subroutine f_computepvo(u,v,theta,prs,msfu,msfv,msft,cor,dx,dy,pv,nx,ny,nz,nxp1,nyp1) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(nxp1,ny,nz),intent(in) :: u
+            real(kind=8) dimension(nx,nyp1,nz),intent(in),depend(nz) :: v
+            real(kind=8) dimension(nx,ny,nz),intent(in),depend(nx,ny,nz) :: theta
+            real(kind=8) dimension(nx,ny,nz),intent(in),depend(nx,ny,nz) :: prs
+            real(kind=8) dimension(nxp1,ny),intent(in),depend(nxp1,ny) :: msfu
+            real(kind=8) dimension(nx,nyp1),intent(in),depend(nx,nyp1) :: msfv
+            real(kind=8) dimension(nx,ny),intent(in),depend(nx,ny) :: msft
+            real(kind=8) dimension(nx,ny),intent(in),depend(nx,ny) :: cor
+            real(kind=8) :: dx
+            real(kind=8) :: dy
+            real(kind=8) dimension(nx,ny,nz),intent(out),depend(nx,ny,nz) :: pv
+            integer, optional,intent(in),check(shape(v,0)==nx),depend(v) :: nx=shape(v,0)
+            integer, optional,intent(in),check(shape(u,1)==ny),depend(u) :: ny=shape(u,1)
+            integer, optional,intent(in),check(shape(u,2)==nz),depend(u) :: nz=shape(u,2)
+            integer, optional,intent(in),check(shape(u,0)==nxp1),depend(u) :: nxp1=shape(u,0)
+            integer, optional,intent(in),check(shape(v,1)==nyp1),depend(v) :: nyp1=shape(v,1)
+        end subroutine f_computepvo
+        subroutine f_computeeth(qvp,tmk,prs,eth,miy,mjx,mkzh) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(miy,mjx,mkzh),intent(in) :: qvp
+            real(kind=8) dimension(miy,mjx,mkzh),intent(in),depend(miy,mjx,mkzh) :: tmk
+            real(kind=8) dimension(miy,mjx,mkzh),intent(in),depend(miy,mjx,mkzh) :: prs
+            real(kind=8) dimension(miy,mjx,mkzh),intent(out),depend(miy,mjx,mkzh) :: eth
+            integer, optional,intent(in),check(shape(qvp,0)==miy),depend(qvp) :: miy=shape(qvp,0)
+            integer, optional,intent(in),check(shape(qvp,1)==mjx),depend(qvp) :: mjx=shape(qvp,1)
+            integer, optional,intent(in),check(shape(qvp,2)==mkzh),depend(qvp) :: mkzh=shape(qvp,2)
+        end subroutine f_computeeth
+        subroutine f_computeuvmet(u,v,longca,longcb,flong,flat,cen_long,cone,rpd,istag,is_msg_val,umsg,vmsg,uvmetmsg,uvmet,nx,ny,nxp1,nyp1,nz) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(nxp1,ny,nz),intent(in) :: u
+            real(kind=8) dimension(nx,nyp1,nz),intent(in),depend(nz) :: v
+            real(kind=8) dimension(nx,ny),intent(inout),depend(nx,ny) :: longca
+            real(kind=8) dimension(nx,ny),intent(inout),depend(nx,ny) :: longcb
+            real(kind=8) dimension(nx,ny),intent(in),depend(nx,ny) :: flong
+            real(kind=8) dimension(nx,ny),intent(in),depend(nx,ny) :: flat
+            real(kind=8) intent(in) :: cen_long
+            real(kind=8) intent(in) :: cone
+            real(kind=8) intent(in) :: rpd
+            integer intent(in) :: istag
+            logical intent(in) :: is_msg_val
+            real(kind=8) intent(in) :: umsg
+            real(kind=8) intent(in) :: vmsg
+            real(kind=8) intent(in) :: uvmetmsg
+            real(kind=8) dimension(nx,ny,nz,2),intent(out),depend(nx,ny,nz) :: uvmet
+            integer, optional,intent(in),check(shape(v,0)==nx),depend(v) :: nx=shape(v,0)
+            integer, optional,intent(in),check(shape(u,1)==ny),depend(u) :: ny=shape(u,1)
+            integer, optional,intent(in),check(shape(u,0)==nxp1),depend(u) :: nxp1=shape(u,0)
+            integer, optional,intent(in),check(shape(v,1)==nyp1),depend(v) :: nyp1=shape(v,1)
+            integer, optional,intent(in),check(shape(u,2)==nz),depend(u) :: nz=shape(u,2)
+        end subroutine f_computeuvmet
+        subroutine f_computeomega(qvp,tmk,www,prs,omg,mx,my,mz) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(mx,my,mz),intent(in) :: qvp
+            real(kind=8) dimension(mx,my,mz),intent(in),depend(mx,my,mz) :: tmk
+            real(kind=8) dimension(mx,my,mz),intent(in),depend(mx,my,mz) :: www
+            real(kind=8) dimension(mx,my,mz),intent(in),depend(mx,my,mz) :: prs
+            real(kind=8) dimension(mx,my,mz),intent(out),depend(mx,my,mz) :: omg
+            integer, optional,intent(in),check(shape(qvp,0)==mx),depend(qvp) :: mx=shape(qvp,0)
+            integer, optional,intent(in),check(shape(qvp,1)==my),depend(qvp) :: my=shape(qvp,1)
+            integer, optional,intent(in),check(shape(qvp,2)==mz),depend(qvp) :: mz=shape(qvp,2)
+        end subroutine f_computeomega
+        subroutine f_computetv(temp,qv,tv,nx,ny,nz) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(nx,ny,nz),intent(in) :: temp
+            real(kind=8) dimension(nx,ny,nz),intent(in),depend(nx,ny,nz) :: qv
+            real(kind=8) dimension(nx,ny,nz),intent(out),depend(nx,ny,nz) :: tv
+            integer, optional,intent(in),check(shape(temp,0)==nx),depend(temp) :: nx=shape(temp,0)
+            integer, optional,intent(in),check(shape(temp,1)==ny),depend(temp) :: ny=shape(temp,1)
+            integer, optional,intent(in),check(shape(temp,2)==nz),depend(temp) :: nz=shape(temp,2)
+        end subroutine f_computetv
+        subroutine f_computewetbulb(prs,tmk,qvp,psadithte,psadiprs,psaditmk,throw_exception,twb,nx,ny,nz) ! in :_wrfext:wrfext.f90
+            use f_computewetbulb__user__routines
+            real(kind=8) dimension(nx,ny,nz),intent(in) :: prs
+            real(kind=8) dimension(nx,ny,nz),intent(in),depend(nx,ny,nz) :: tmk
+            real(kind=8) dimension(nx,ny,nz),intent(in),depend(nx,ny,nz) :: qvp
+            real(kind=8) dimension(150),intent(in) :: psadithte
+            real(kind=8) dimension(150),intent(in) :: psadiprs
+            real(kind=8) dimension(150,150),intent(in) :: psaditmk
+            external throw_exception
+            real(kind=8) dimension(nx,ny,nz),intent(out),depend(nx,ny,nz) :: twb
+            integer, optional,intent(in),check(shape(prs,0)==nx),depend(prs) :: nx=shape(prs,0)
+            integer, optional,intent(in),check(shape(prs,1)==ny),depend(prs) :: ny=shape(prs,1)
+            integer, optional,intent(in),check(shape(prs,2)==nz),depend(prs) :: nz=shape(prs,2)
+        end subroutine f_computewetbulb
+        subroutine f_computesrh(u,v,ght,ter,top,sreh,miy,mjx,mkzh) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(miy,mjx,mkzh),intent(in) :: u
+            real(kind=8) dimension(miy,mjx,mkzh),intent(in),depend(miy,mjx,mkzh) :: v
+            real(kind=8) dimension(miy,mjx,mkzh),intent(in),depend(miy,mjx,mkzh) :: ght
+            real(kind=8) dimension(miy,mjx),intent(in),depend(miy,mjx) :: ter
+            real(kind=8) intent(in) :: top
+            real(kind=8) dimension(miy,mjx),intent(out),depend(miy,mjx) :: sreh
+            integer, optional,intent(in),check(shape(u,0)==miy),depend(u) :: miy=shape(u,0)
+            integer, optional,intent(in),check(shape(u,1)==mjx),depend(u) :: mjx=shape(u,1)
+            integer, optional,intent(in),check(shape(u,2)==mkzh),depend(u) :: mkzh=shape(u,2)
+        end subroutine f_computesrh
+        subroutine f_computeuh(zp,mapfct,dx,dy,uhmnhgt,uhmxhgt,us,vs,w,tem1,tem2,uh,nx,ny,nz,nzp1) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(nx,ny,nzp1),intent(in) :: zp
+            real(kind=8) dimension(nx,ny),intent(in),depend(nx,ny) :: mapfct
+            real(kind=8) intent(in) :: dx
+            real(kind=8) intent(in) :: dy
+            real(kind=8) intent(in) :: uhmnhgt
+            real(kind=8) intent(in) :: uhmxhgt
+            real(kind=8) dimension(nx,ny,nz),intent(in),depend(nx,ny) :: us
+            real(kind=8) dimension(nx,ny,nz),intent(in),depend(nx,ny,nz) :: vs
+            real(kind=8) dimension(nx,ny,nzp1),intent(in),depend(nx,ny,nzp1) :: w
+            real(kind=8) dimension(nx,ny,nz),intent(inout),depend(nx,ny,nz) :: tem1
+            real(kind=8) dimension(nx,ny,nz),intent(inout),depend(nx,ny,nz) :: tem2
+            real(kind=8) dimension(nx,ny),intent(out),depend(nx,ny) :: uh
+            integer, optional,intent(in),check(shape(zp,0)==nx),depend(zp) :: nx=shape(zp,0)
+            integer, optional,intent(in),check(shape(zp,1)==ny),depend(zp) :: ny=shape(zp,1)
+            integer, optional,intent(in),check(shape(us,2)==nz),depend(us) :: nz=shape(us,2)
+            integer, optional,intent(in),check(shape(zp,2)==nzp1),depend(zp) :: nzp1=shape(zp,2)
+        end subroutine f_computeuh
+        subroutine f_computepw(p,tv,qv,ht,zdiff,pw,nx,ny,nz,nzh) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(nx,ny,nz),intent(in) :: p
+            real(kind=8) dimension(nx,ny,nz),intent(in),depend(nx,ny,nz) :: tv
+            real(kind=8) dimension(nx,ny,nz),intent(in),depend(nx,ny,nz) :: qv
+            real(kind=8) dimension(nx,ny,nzh),intent(in),depend(nx,ny) :: ht
+            real(kind=8) dimension(nx,ny),intent(inout),depend(nx,ny) :: zdiff
+            real(kind=8) dimension(nx,ny),intent(out),depend(nx,ny) :: pw
+            integer, optional,intent(in),check(shape(p,0)==nx),depend(p) :: nx=shape(p,0)
+            integer, optional,intent(in),check(shape(p,1)==ny),depend(p) :: ny=shape(p,1)
+            integer, optional,intent(in),check(shape(p,2)==nz),depend(p) :: nz=shape(p,2)
+            integer, optional,intent(in),check(shape(ht,2)==nzh),depend(ht) :: nzh=shape(ht,2)
+        end subroutine f_computepw
+        subroutine f_computedbz(prs,tmk,qvp,qra,qsn,qgr,sn0,ivarint,iliqskin,dbz,nx,ny,nz) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(nx,ny,nz),intent(in) :: prs
+            real(kind=8) dimension(nx,ny,nz),intent(in),depend(nx,ny,nz) :: tmk
+            real(kind=8) dimension(nx,ny,nz),intent(inout),depend(nx,ny,nz) :: qvp
+            real(kind=8) dimension(nx,ny,nz),intent(inout),depend(nx,ny,nz) :: qra
+            real(kind=8) dimension(nx,ny,nz),intent(inout),depend(nx,ny,nz) :: qsn
+            real(kind=8) dimension(nx,ny,nz),intent(inout),depend(nx,ny,nz) :: qgr
+            integer intent(in) :: sn0
+            integer intent(in) :: ivarint
+            integer intent(in) :: iliqskin
+            real(kind=8) dimension(nx,ny,nz),intent(out),depend(nx,ny,nz) :: dbz
+            integer, optional,intent(in),check(shape(prs,0)==nx),depend(prs) :: nx=shape(prs,0)
+            integer, optional,intent(in),check(shape(prs,1)==ny),depend(prs) :: ny=shape(prs,1)
+            integer, optional,intent(in),check(shape(prs,2)==nz),depend(prs) :: nz=shape(prs,2)
+        end subroutine f_computedbz
+        subroutine rotatecoords(ilat,ilon,olat,olon,lat_np,lon_np,lon_0,direction) ! in :_wrfext:wrfext.f90
+            real(kind=8) intent(in) :: ilat
+            real(kind=8) intent(in) :: ilon
+            real(kind=8) intent(out) :: olat
+            real(kind=8) intent(out) :: olon
+            real(kind=8) intent(in) :: lat_np
+            real(kind=8) intent(in) :: lon_np
+            real(kind=8) intent(in) :: lon_0
+            integer intent(in) :: direction
+        end subroutine rotatecoords
+        subroutine f_lltoij(map_proj,truelat1,truelat2,stdlon,lat1,lon1,pole_lat,pole_lon,knowni,knownj,dx,latinc,loninc,lat,lon,throw_exception,loc) ! in :_wrfext:wrfext.f90
+            use f_lltoij__user__routines
+            integer intent(in) :: map_proj
+            real(kind=8) intent(inout) :: truelat1
+            real(kind=8) intent(inout) :: truelat2
+            real(kind=8) intent(in) :: stdlon
+            real(kind=8) intent(in) :: lat1
+            real(kind=8) intent(in) :: lon1
+            real(kind=8) intent(in) :: pole_lat
+            real(kind=8) intent(in) :: pole_lon
+            real(kind=8) intent(in) :: knowni
+            real(kind=8) intent(in) :: knownj
+            real(kind=8) intent(in) :: dx
+            real(kind=8) intent(in) :: latinc
+            real(kind=8) intent(in) :: loninc
+            real(kind=8) intent(inout) :: lat
+            real(kind=8) intent(inout) :: lon
+            external throw_exception
+            real(kind=8) dimension(2),intent(out) :: loc
+        end subroutine f_lltoij
+        subroutine f_ijtoll(map_proj,truelat1,truelat2,stdlon,lat1,lon1,pole_lat,pole_lon,knowni,knownj,dx,latinc,loninc,ai,aj,throw_exception,loc) ! in :_wrfext:wrfext.f90
+            use f_ijtoll__user__routines
+            integer intent(in) :: map_proj
+            real(kind=8) intent(inout) :: truelat1
+            real(kind=8) intent(inout) :: truelat2
+            real(kind=8) intent(in) :: stdlon
+            real(kind=8) intent(in) :: lat1
+            real(kind=8) intent(in) :: lon1
+            real(kind=8) intent(in) :: pole_lat
+            real(kind=8) intent(in) :: pole_lon
+            real(kind=8) intent(in) :: knowni
+            real(kind=8) intent(in) :: knownj
+            real(kind=8) intent(in) :: dx
+            real(kind=8) intent(in) :: latinc
+            real(kind=8) intent(in) :: loninc
+            real(kind=8) intent(in) :: ai
+            real(kind=8) intent(in) :: aj
+            external throw_exception
+            real(kind=8) dimension(2),intent(out) :: loc
+        end subroutine f_ijtoll
+        subroutine f_converteta(full_t,znu,psfc,ptop,pcalc,mean_t,temp_t,z,nx,ny,nz) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(nx,ny,nz),intent(in) :: full_t
+            real(kind=8) dimension(nz),intent(in),depend(nz) :: znu
+            real(kind=8) dimension(nx,ny),intent(in),depend(nx,ny) :: psfc
+            real(kind=8) intent(in) :: ptop
+            real(kind=8) dimension(nx,ny,nz),intent(inout),depend(nx,ny,nz) :: pcalc
+            real(kind=8) dimension(nx,ny,nz),intent(inout),depend(nx,ny,nz) :: mean_t
+            real(kind=8) dimension(nx,ny,nz),intent(inout),depend(nx,ny,nz) :: temp_t
+            real(kind=8) dimension(nx,ny,nz),intent(out),depend(nx,ny,nz) :: z
+            integer, optional,intent(in),check(shape(full_t,0)==nx),depend(full_t) :: nx=shape(full_t,0)
+            integer, optional,intent(in),check(shape(full_t,1)==ny),depend(full_t) :: ny=shape(full_t,1)
+            integer, optional,intent(in),check(shape(full_t,2)==nz),depend(full_t) :: nz=shape(full_t,2)
+        end subroutine f_converteta
+        subroutine f_computectt(prs,tk,qci,qcw,qvp,ght,ter,haveqci,ctt,ew,ns,nz) ! in :_wrfext:wrfext.f90
+            real(kind=8) dimension(ew,ns,nz),intent(in) :: prs
+            real(kind=8) dimension(ew,ns,nz),intent(in),depend(ew,ns,nz) :: tk
+            real(kind=8) dimension(ew,ns,nz),intent(in),depend(ew,ns,nz) :: qci
+            real(kind=8) dimension(ew,ns,nz),intent(in),depend(ew,ns,nz) :: qcw
+            real(kind=8) dimension(ew,ns,nz),intent(in),depend(ew,ns,nz) :: qvp
+            real(kind=8) dimension(ew,ns,nz),intent(in),depend(ew,ns,nz) :: ght
+            real(kind=8) dimension(ew,ns),intent(in),depend(ew,ns) :: ter
+            integer intent(in) :: haveqci
+            real(kind=8) dimension(ew,ns),intent(out),depend(ew,ns) :: ctt
+            integer, optional,intent(in),check(shape(prs,0)==ew),depend(prs) :: ew=shape(prs,0)
+            integer, optional,intent(in),check(shape(prs,1)==ns),depend(prs) :: ns=shape(prs,1)
+            integer, optional,intent(in),check(shape(prs,2)==nz),depend(prs) :: nz=shape(prs,2)
+        end subroutine f_computectt
+    end interface 
+end python module _wrfext
+
+! This file was auto-generated with f2py (version:2).
+! See http://cens.ioc.ee/projects/f2py2e/

wrf_open/var/test/listBug.ncl

@@ -0,0 +1,6 @@
+l = NewList("fifo")
+name = "foo"
+ListAppend(l, (/name/))
+print(l)
+print(l[0])
+name = "bar"

wrf_open/var/test/ncl_get_var.ncl

@@ -0,0 +1,136 @@
+    load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+    load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+    load "$NCARG_ROOT/lib/ncarg/nclscripts/wrf/WRFUserARW.ncl"
+    
+    ;system("printenv")
+    
+    if (.not. isvar("in_file")) then
+        in_file = "/Users/ladwig/Documents/wrf_files/wrfout_d02_2010-06-13_21:00:00.nc"
+    end if 
+    
+    if (.not. isvar("out_file")) then
+        out_file = "/tmp/wrftest.nc"
+    end if
+    input_file = addfile(in_file,"r")
+    
+    system("/bin/rm -f " + out_file) ; remove if exists
+    fout = addfile(out_file, "c")
+    
+    time = 0
+    
+    wrf_vars = [/"avo", "eth", "cape_2d", "cape_3d", "ctt", "dbz", "mdbz", \
+                "geopt", "helicity", "lat", "lon", "omg", "p", "pressure", \
+                "pvo", "pw", "rh2", "rh", "slp", "ter", "td2", "td", "tc", \
+                "theta", "tk", "tv", "twb", "updraft_helicity", "ua", "va", \
+                "wa", "uvmet10", "uvmet", "z"/]
+    
+    unique_dimname_list = NewList("fifo")
+    unique_dimsize_list = NewList("fifo")
+    full_vardimname_list = NewList("fifo") ; Workaround for issue where NCL
+                                           ; is dropping the dim names from
+                                           ; the array stored in a list
+    vardata_list = NewList("fifo")
+    
+    ; NCL lists need unique variable names to be inserted, so using these
+    ; variables to create unique named attributes
+    vardata = True
+    vardimnamedata = True
+    
+    ; Note:  The list type seems to only work correctly when inserting
+    ; variables with unique names.  This is the reason for all of the 
+    ; name attribute stuff below.     
+    do i = 0, ListCount(wrf_vars) - 1
+       
+       print("working on: " + wrf_vars[i])
+       v := wrf_user_getvar(input_file, wrf_vars[i], time)
+       
+       ;if (wrf_vars[i] .eq. "avo") then
+       ;    print(v)
+       ;end if
+       
+       ; pw is written in pure NCL and does not contain dimension names
+       ; so manually creating the dimension names here
+       if (wrf_vars[i] .eq. "pw") then
+           dim_names := (/"south_north", "west_east"/)
+           dim_sizes := dimsizes(v)
+       else
+           dim_names := getvardims(v)
+           dim_sizes := dimsizes(v)
+       end if 
+       
+       vardata@$wrf_vars[i]$ := v
+       vardimnamedata@$wrf_vars[i]$ := dim_names
+       ListAppend(vardata_list,vardata@$wrf_vars[i]$) 
+       ListAppend(full_vardimname_list, vardimnamedata@$wrf_vars[i]$)
+       ;print(vardata_list)
+       
+       dimname=True
+       dimsize=True
+       
+       ; Determine the unique dimensions names, which will be used when 
+       ; creating the output NetCDF file
+       do j=0, dimsizes(dim_sizes)-1
+           ;print(dim_names)
+           ;print(dim_names(j))
+           
+           name_id = sprintf("dimname_%i",i*j)
+           size_id = sprintf("dimsize_%i",i*j)
+           
+           dimname@$name_id$ = dim_names(j) 
+           dimsize@$size_id$ = dim_sizes(j)
+           
+           has_name = False
+           do k=0, ListCount(unique_dimname_list)-1
+               if ((/unique_dimname_list[k]/) .eq. (/dimname@$name_id$/)) then
+                   has_name = True
+               end if
+           end do
+
+           if (.not. has_name) then 
+               ;print("inserting: " + dimname@$name_id$)
+               ListAppend(unique_dimname_list, dimname@$name_id$)
+               ListAppend(unique_dimsize_list, dimsize@$size_id$)
+           end if
+           
+       end do
+    end do 
+    
+    setfileoption(fout,"DefineMode",True)
+    
+    ; Set global attributes
+    f_att               = True            ; assign file attributes
+    f_att@title         = "NCL generated netCDF file"
+    f_att@Conventions   = "None"
+    fileattdef(fout, f_att)      ; copy file attributes
+    
+    ; Set up the NetCDF dimensions
+    d_names = new(ListCount(unique_dimname_list), string)
+    d_sizes = new(ListCount(unique_dimname_list), integer)
+    d_unlim  = new(ListCount(unique_dimname_list), logical)
+    
+    ; Note: Need to do this copy since NCL can't coerce the list data to 
+    ; array data
+    do i=0, ListCount(unique_dimname_list) - 1
+        d_names(i) = unique_dimname_list[i]
+        d_sizes(i) = unique_dimsize_list[i]
+        d_unlim(i) = False
+    end do
+    
+    filedimdef(fout, d_names, d_sizes, d_unlim)
+    
+    ; Save the variables to the NetCDF file
+    do i=0, ListCount(vardata_list)-1       
+       d := vardata_list[i]
+       filevardef(fout, wrf_vars[i], typeof(d), full_vardimname_list[i])
+       filevarattdef(fout,wrf_vars[i], d)
+       fout->$wrf_vars[i]$ = (/d/)
+    end do
+    
+    delete(fout)
+
+
+
+
+
+
+

wrf_open/var/test/utests.py

@@ -0,0 +1,152 @@
+import unittest as ut
+import numpy.testing as nt 
+import numpy as n
+import os, sys
+import subprocess
+
+import Ngl, Nio
+from wrf.var import getvar
+
+# This should work with Nio
+from netCDF4 import Dataset as NetCDF
+from boto.ec2.instancestatus import Status
+
+NCL_EXE = "/Users/ladwig/nclbuild/6.3.0/bin/ncl"
+TEST_FILE = "/Users/ladwig/Documents/wrf_files/wrfout_d01_2010-06-13_21:00:00"
+OUT_NC_FILE = "/tmp/wrftest.nc"
+
+def setUpModule():
+    ncarg_root = os.environ.get("NCARG_ROOT", None)
+    if ncarg_root is None:
+        raise RuntimeError("$NCARG_ROOT environment variable not set")
+        
+    
+    this_path = os.path.realpath(__file__)
+    ncl_script = os.path.join(os.path.dirname(this_path),
+                              "ncl_get_var.ncl")
+    ncfile = TEST_FILE + ".nc" # NCL requires extension
+    
+    # This needs to be set when PyNIO is installed, since PyNIOs data does
+    # not contain the dat file for the CAPE calcluations
+    os.environ["NCARG_NCARG"] = os.path.join(os.environ["NCARG_ROOT"],
+                                             "lib", "ncarg")
+    cmd = "%s %s 'in_file=\"%s\"' 'out_file=\"%s\"'" % (NCL_EXE,
+                                                        ncl_script,
+                                                        ncfile,
+                                                        OUT_NC_FILE)
+    
+    #print cmd
+    
+    if not os.path.exists(OUT_NC_FILE):
+        status = subprocess.call(cmd, shell=True)
+        if (status != 0):
+            raise RuntimeError("NCL script failed.  Could not set up test.")
+
+# Using helpful information at: 
+# http://eli.thegreenplace.net/2014/04/02/dynamically-generating-python-test-cases
+def make_test(varname, wrf_in, referent):
+    def test(self):
+        in_wrfnc = NetCDF(wrf_in)
+        refnc = NetCDF(referent)
+        
+        ref_vals = refnc.variables[varname][...]
+        
+        if (varname == "tc"):
+            my_vals = getvar(in_wrfnc, "temp", units="c")
+            tol = 0
+            atol = .1
+            nt.assert_allclose(my_vals, ref_vals, tol, atol)
+        elif (varname == "tk"):
+            my_vals = getvar(in_wrfnc, "temp", units="k")
+            tol = 0
+            atol = .1
+            nt.assert_allclose(my_vals, ref_vals, tol, atol)
+        elif (varname == "td"):
+            my_vals = getvar(in_wrfnc, "td", units="c")
+            tol = 0
+            atol = .1
+            nt.assert_allclose(my_vals, ref_vals, tol, atol)
+        elif (varname == "pressure"):
+            my_vals = getvar(in_wrfnc, varname, units="hpa")
+            tol = 1/100.
+            atol = 0
+            nt.assert_allclose(my_vals, ref_vals, tol, atol)
+        elif (varname == "p"):
+            my_vals = getvar(in_wrfnc, varname, units="pa")
+            tol = 1/100.
+            atol = 0
+            nt.assert_allclose(my_vals, ref_vals, tol, atol)
+        elif (varname == "slp"):
+            my_vals = getvar(in_wrfnc, varname, units="hpa")
+            tol = 2/100.
+            atol = 0
+            nt.assert_allclose(my_vals, ref_vals, tol, atol)
+            
+        elif (varname == "uvmet"):
+            my_vals = getvar(in_wrfnc, varname)
+            tol = 1/100.
+            atol = .5
+            nt.assert_allclose(my_vals, ref_vals, tol, atol)
+        elif (varname == "uvmet10"):
+            my_vals = getvar(in_wrfnc, varname)
+            tol = 1/100.
+            atol = .5
+            nt.assert_allclose(my_vals, ref_vals, tol, atol)
+            
+        elif (varname == "omg"):
+            my_vals = getvar(in_wrfnc, varname)
+            tol = 2/100.
+            atol = 0
+            nt.assert_allclose(my_vals, ref_vals, tol, atol)
+        elif (varname == "ctt"):
+            my_vals = getvar(in_wrfnc, varname)
+            tol = 1/100.
+            atol = 0
+            nt.assert_allclose(my_vals, ref_vals, tol, atol)
+        elif (varname == "cape_2d"):
+            mcape, mcin, lcl, lfc = getvar(in_wrfnc, varname)
+            tol = 1/100.
+            atol = 0
+            nt.assert_allclose(mcape, ref_vals[0,:,:], tol, atol)
+            nt.assert_allclose(mcin, ref_vals[1,:,:], tol, atol)
+            nt.assert_allclose(lcl, ref_vals[2,:,:], tol, atol)
+            nt.assert_allclose(lfc, ref_vals[3,:,:], tol, atol)
+        elif (varname == "cape_3d"):
+            cape, cin = getvar(in_wrfnc, varname)
+            tol = 1/100.
+            atol = 0
+            nt.assert_allclose(cape, ref_vals[0,:,:], tol, atol)
+            nt.assert_allclose(cin, ref_vals[1,:,:], tol, atol)
+            
+            
+        else:
+            my_vals = getvar(in_wrfnc, varname)
+            tol = 1/100.
+            atol = 0
+            nt.assert_allclose(my_vals, ref_vals, tol, atol)
+    
+    
+    return test
+
+class WRFVarsTest(ut.TestCase):
+    longMessage = True
+        
+
+if __name__ == "__main__":
+    ignore_vars = []  # Not testable yet
+    wrf_vars = ["avo", "eth", "cape_2d", "cape_3d", "ctt", "dbz", "mdbz", 
+                "geopt", "helicity", "lat", "lon", "omg", "p", "pressure", 
+                "pvo", "pw", "rh2", "rh", "slp", "ter", "td2", "td", "tc", 
+                "theta", "tk", "tv", "twb", "updraft_helicity", "ua", "va", 
+                "wa", "uvmet10", "uvmet", "z", "ctt", "cape_2d", "cape_3d"]
+    
+    for var in wrf_vars:
+        if var in ignore_vars:
+            continue
+        
+        test_func = make_test(var, TEST_FILE, OUT_NC_FILE)
+        setattr(WRFVarsTest, 'test_{0}'.format(var), test_func)
+    
+    
+    ut.main()
+