; --------------------------------------------------------------------------- ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Program Name: topo_adj.ncl ; ; ; ; National Water Model (NWM) WRF-hydro forcing engine is developed by ; ; National Center for Atmospheric Research (NCAR), under the sponsorship ; ; of National Water Center (NWC). ; ; ; ; Team Members: ; ; NCAR Staff: Linlin Pan, Wei Yu, and David Gochis ; ; NWC/OWP Staff: Brian Cosgrove, Zhengtao Cui, Cham Pham, and James Taft ; ; ; ; This is a ncl program to perform height adjustment. ; ; ; ; Input: topo file, to be adjusted file ; ; ; ; Output: topo adjusted file ; ; ; ; For non-fatal errors output is witten to $DATA/logs ; ; ; ; Author(s)/Contact(s): Linlin Pan, lpan@ucar.edu ; ; Origination June, 2015 ; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;------------------------ ; external TOPO_ADJF90 "$SYSHOME/exec/topo_adjf90.so" external NWM_FORCING_TOPO_ADJ "$LIBnwm/nwm_forcing_topo_adj.so" 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/csm/contributed.ncl" load "$NCARG_ROOT/lib/ncarg/nclscripts/wrf/WRF_contributed.ncl" ;==============================================================================; ; 0. Define function ;==============================================================================; ;------------------------------------------------------------- ; 0.0 Load useful ncl scripts ;------------------------------------------------------------- load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl" load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl" ; load "/opt/ncl_ncarg-5.1.1-pgi/lib/ncarg/nclscripts/csm/contributed.ncl" ; load "$CSH_ARCHIVE/ncl/WRFUserARW.ncl" load "$NCARG_ROOT/lib/ncarg/nclscripts/wrf/WRFUserARW.ncl" function sub_string_double(s:string,i:integer,j:integer) begin s_char = stringtochar(s) sub_str = s_char(i:j) return (stringtodouble(chartostring(sub_str))) end function sub_string_float(s:string,i:integer,j:integer) begin s_char = stringtochar(s) sub_str = s_char(i:j) return (stringtofloat(chartostring(sub_str))) end load "$USHnwm/scale/set_scale_factor.ncl" ; filename1="$USHnwm/scale/set_scale_factor.ncl" ; if(isfilepresent(filename1)) then ; loadscript(filename1) ; else ; print("Error: scale factor file doesn't exist. Can't continue.") ; exit ; end if begin ; ; Calculate three values of a quadratic equation ; ; input files inputGeo = getenv("inputGeo") outFile = getenv("outFile") inFile = getenv("inFile") f1 = addfile(inputGeo,"r") ; out files fout = addfile(outFile,"w") fin = addfile(inFile,"r") hgt = f1->HGT_M(0,:,:) xlat = f1->XLAT_M(0,:,:) xlong = f1->XLONG_M(0,:,:) ndim=dimsizes(dimsizes(fin->SWDOWN)) if(ndim.eq.2) then swdown_in=fin->SWDOWN(:,:) else swdown_in=fin->SWDOWN(0,:,:) end if temp=fout->T2D esri_pe_string=temp@esri_pe_string delete(temp) dx = f1@DX dy = f1@DY nsizes=dimsizes(hgt) print(nsizes) printVarSummary(hgt) nx=nsizes(1) ny=nsizes(0) cosa = f1->COSALPHA(0,:,:) sina = f1->SINALPHA(0,:,:) swdown_out=swdown_in*0. ss=outFile yyyy=floattointeger(sub_string_float(ss,0,3)) mon=floattointeger(sub_string_float(ss,4,5)) dd=floattointeger(sub_string_float(ss,6,7)) hh=floattointeger(sub_string_float(ss,8,9)) xtime = hh*60. yyyy@calendar = "julian" julian = day_of_year(yyyy,mon,dd) print(julian) print(xtime) ; TOPO_ADJF90:: topo_adj(hgt,xlat,xlong,dx,dy,nx,ny,cosa, sina, xtime, julian,swdown_in, swdown_out) NWM_FORCING_TOPO_ADJ:: topo_adj(hgt,xlat,xlong,dx,dy,nx,ny,cosa, sina, xtime, julian,swdown_in, swdown_out) delete(hgt) delete(xlat) delete(xlong) delete(cosa) delete(sina) swdown_out = where(ismissing(swdown_in),swdown_in,swdown_out) ;yw if(fileexists("cfs_radiation.nc"))then if(stringtointeger(getenv("CFS_FILESTATUS")) .eq. 1)then f_reg=addfile("cfs_radiation.nc","r") reg=f_reg->reg(hh) if(reg.gt.1) then max_s=max(max(swdown_out)) if(max_s.gt.500) then print(max_s) value = max_s/reg swdown_out=where(swdown_out.lt.value,swdown_out*reg,max_s+swdown_out/20.) else swdown_out=swdown_out*reg end if else swdown_out=swdown_out*reg end if end if ddim = dimsizes(swdown_out) print("dim="+ddim) dimlat = ddim(0) dimlon = ddim(1) swdown_out0 = new((/1,dimlat,dimlon/),typeof(swdown_out)) swdown_out1 = new((/1,dimlat,dimlon/),integer) swdown_out0(0,:,:) = where(ismissing(swdown_out),swdown_in,swdown_out) delete(swdown_out) delete(swdown_in) swdown_out0 = where(swdown_out0.lt.0,0,swdown_out0) swdown_out1=floattointeger(getDataScaled(swdown_out0,swdown_scale_f,swdown_offset)) swdown_out1@_FillValue=floattointeger(swdown_missing) swdown_out1@units="W m-2" swdown_out1@long_name="Surface downward short-wave radiation flux" swdown_out1@standard_name = "surface_downward_shortwave_flux" ; swdown_out1@scale_factor = swdown_scale_fd; swdown_out1@add_offset = swdown_offsetd ; swdown_out1@valid_range = swdown_valid_range ; swdown_out1@missing_value = floattointeger(swdown_missing) ; swdown_out1@proj4=proj4 swdown_out1@grid_mapping=grid_mapping swdown_out1@esri_pe_string=esri_pe_string swdown_out1@remap=remap ; swdown_out1@cell_methods=cell_methods swdown_out1!0="time" swdown_out1!1="y" swdown_out1!2="x" filevardef(fout, "SWDOWN" ,typeof(swdown_out1) ,getvardims(swdown_out1)) filevarattdef(fout,"SWDOWN" ,swdown_out1) fout->SWDOWN=(/swdown_out1/) exit ; EX01::cquad(-1., 2., 3., nump, x, qval) ; Call the NCL version of ; your Fortran subroutine. end status_exit(1)