module convert_netcdf_mod
use abstract_convert_netcdf_mod
type, extends(abstract_convert_netcdf_class) :: convert_netcdf_class
contains
procedure, pass(this) :: convert_netcdf_mass => convert_netcdf_mass_wrf
procedure, pass(this) :: convert_netcdf_nmm => convert_netcdf_nmm_wrf
procedure, pass(this) :: update_netcdf_mass => update_netcdf_mass_wrf
procedure, pass(this) :: update_netcdf_nmm => update_netcdf_nmm_wrf
end type convert_netcdf_class
contains
subroutine convert_netcdf_mass_wrf(this)
!$$$ subprogram documentation block
! . . . .
! subprogram: convert_netcdf_mass read wrf mass netcdf restart
! prgmmr: parrish org: np22 date: 2003-09-05
!
! abstract: using wrf library routines, read a wrf mass core netcdf
! format restart file. write the result to temporary netcdf
! file expected by read_wrf_mass_guess.
!
! program history log:
! 2004-09-10 parrish
! 2004-11-05 treadon - add return code 74 for error stop
! 2004-12-15 treadon - remove get_lun, read guess from file "wrf_inout"
! 2005-07-06 parrish - add read of pint byte address
! 2005-12-09 middlecoff - initialize character variable staggering
! 2006-09-15 treadon - use nhr_assimilation to build local guess filename
! 2010-03-29 Hu - add code to read 5 cloud/hydrometeor variables for cloud analysis
! 2010-03-29 Hu - bug fix: replace XICE with SEAICE
! 2010-10-20 hclin - added 15 wrfchem/gocart fields for aod
! 2011-11-14 tong - add loop to read upto 7 wrf mass netcdf restart file and
! write to temporary netcdf files (extend FGAT capability for
! wrf mass netcdf format)
! 2012-11-26 Hu - add code to read surface variables for GSD soil nudging
! 2014-03-12 hu - add code to read ges_q2 (2m Q),
! Qnr(rain number concentration),
! and nsoil (number of soil levels)
! 2015-01-13 ladwig - add code for Qni and Qnc (cloud ice and water number
! concentration)
! 2017-03-23 Hu - add code to read hybrid vertical coodinate in WRF MASS
! core
!
! 2016-02-14 Johnson, Y. Wang, X. Wang - add code to read vertical velocity (W) and
! Reflectivity (REFL_10CM) for radar
! DA, POC: xuguang.wang@ou.edu
!
! input argument list:
!
! output argument list:
!
! NOTES: this is beginning of allowing direct connection of gsi to wrf files
! without seperate external interface. it is very inefficient, and
! later versions will be made to reduce the total i/o involved.
!
! attributes:
! language: f90
! machine: ibm RS/6000 SP
!
!$$$
use kinds, only: r_single,i_kind
use constants, only: h300
use gsi_4dvar, only: nhr_assimilation
use rapidrefresh_cldsurf_mod, only: l_hydrometeor_bkio,l_gsd_soilTQ_nudge
use rapidrefresh_cldsurf_mod, only: i_use_2mt4b,i_use_2mq4b
use gsi_metguess_mod, only: gsi_metguess_get
use chemmod, only: laeroana_gocart, ppmv_conv,wrf_pm2_5
use gsi_chemguess_mod, only: gsi_chemguess_get
use gridmod, only: wrf_mass_hybridcord
use netcdf_mod, only: nc_check
use control_vectors, only : w_exist, dbz_exist
use constants, only: zero
use obsmod, only : if_model_dbz
use gsi_io, only: verbose
implicit none
! Declare local parameters
class(convert_netcdf_class), intent(inout) :: this
real(r_single),parameter:: one_single = 1.0_r_single
real(r_single),parameter:: r45 = 45.0_r_single
character(len=120) :: flnm1
character(len=19) :: DateStr1
character(len=6) :: filename
integer(i_kind) :: dh1
integer(i_kind) :: iunit
integer(i_kind) :: i,j,k
integer(i_kind) :: ndim1
integer(i_kind) :: WrfType
integer(i_kind), dimension(4) :: start_index, end_index
character (len= 4) :: staggering=' N/A'
character (len= 3) :: ordering
character (len=80), dimension(3) :: dimnames
character (len=80) :: SysDepInfo
integer(i_kind) :: n_actual_clouds, ierr, Status, Status_next_time, n
integer(i_kind) :: iv, n_gocart_var, ier
! binary stuff
! rmse stuff
character (len=31) :: rmse_var
integer(i_kind) iyear,imonth,iday,ihour,iminute,isecond
integer(i_kind) nlon_regional,nlat_regional,nsig_regional,nsig_soil_regional
real(r_single) pt_regional
real(r_single) rdx,rdy
real(r_single),allocatable::field3(:,:,:),field2(:,:),field1(:),field2b(:,:),field2c(:,:)
real(r_single),allocatable::field3u(:,:,:),field3v(:,:,:),field1a(:)
real(r_single),allocatable::field3w(:,:,:)
integer(i_kind),allocatable::ifield2(:,:)
real(r_single) rad2deg_single
integer(i_kind) wrf_real
data iunit / 15 /
logical print_verbose
associate( this => this ) ! eliminates warning for unused dummy argument needed for binding
end associate
print_verbose=.false.
if(verbose) print_verbose=.true.
wrf_real=104
end_index=0
start_index=0
! Inquire about cloud guess fields
call gsi_metguess_get('clouds::3d',n_actual_clouds,ierr)
! transfer code from diffwrf for converting netcdf wrf nmm restart file
! to temporary binary format
call ext_ncd_ioinit(sysdepinfo,status)
call set_wrf_debug_level ( 5 )
n_loop: do n=1,9 ! loop over forecast hours in assim interval
if(n==nhr_assimilation)then
flnm1 = 'wrf_inout'
else
write(flnm1,'("wrf_inou",i1.1)')n
endif
call ext_ncd_open_for_read( trim(flnm1), 0, 0, "", dh1, Status)
if(n==nhr_assimilation)then
if ( Status /= 0 )then
write(6,*)'CONVERT_NETCDF_MASS: problem with flnm1 = ',&
trim(flnm1),', Status = ', Status
call stop2(74)
endif
else
if ( Status /= 0 )then
write(6,*)'CONVERT_NETCDF_MASS: problem with flnm1 = ',&
trim(flnm1),', Status = ', Status
cycle n_loop
endif
endif
write(filename,'("sigf",i2.2)') n
open(iunit,file=filename,form='unformatted')
if(print_verbose)write(6,*)' convert ',trim(flnm1),' to ', trim(filename)
!------------- get date info
call ext_ncd_get_next_time(dh1, DateStr1, Status_next_time)
read(DateStr1,'(i4,1x,i2,1x,i2,1x,i2,1x,i2,1x,i2)') iyear,imonth,iday,ihour,iminute,isecond
write(6,*)' iy,m,d,h,m,s=',iyear,imonth,iday,ihour,iminute,isecond
! write(6,*)' dh1 = ',dh1 !DEDE
!------------- get grid info
rmse_var='SMOIS'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr ) !DEDE
if(print_verbose)then
write(6,*)' dh1 = ',dh1 !DEDE
write(6,*)'rmse_var = ',trim(rmse_var)
write(6,*)'ndim1 = ',ndim1
write(6,*)'ordering = ',trim(ordering)
write(6,*)'staggering = ',trim(staggering)
write(6,*)'start_index = ',start_index
write(6,*)'end_index = ',end_index
write(6,*)'WrfType = ',WrfType
write(6,*)'ierr = ',ierr !DEDE
end if
nlon_regional=end_index(1)
nlat_regional=end_index(2)
nsig_soil_regional=end_index(3)
rmse_var='T'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr ) !DEDE
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1 = ',ndim1,' dh1 = ',dh1
write(6,*)' WrfType = ',WrfType,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
nlon_regional=end_index(1)
nlat_regional=end_index(2)
nsig_regional=end_index(3)
if(print_verbose)write(6,*)' nlon,lat,sig_regional=',nlon_regional,nlat_regional,nsig_regional
allocate(field2(nlon_regional,nlat_regional),field3(nlon_regional,nlat_regional,nsig_regional+1))
allocate(field3u(nlon_regional+1,nlat_regional,nsig_regional))
allocate(field3v(nlon_regional,nlat_regional+1,nsig_regional))
allocate(field2b(nlon_regional,nlat_regional),field2c(nlon_regional,nlat_regional))
allocate(ifield2(nlon_regional,nlat_regional))
allocate(field1(max(nlon_regional,nlat_regional,nsig_regional)))
allocate(field1a(max(nlon_regional,nlat_regional,nsig_regional)))
if(w_exist) then
allocate(field3w(nlon_regional,nlat_regional,nsig_regional+1))
end if
rmse_var='P_TOP'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
pt_regional,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)write(6,*)' p_top=',pt_regional
write(iunit) iyear,imonth,iday,ihour,iminute,isecond, &
nlon_regional,nlat_regional,nsig_regional,pt_regional,nsig_soil_regional
if(wrf_mass_hybridcord) then
rmse_var='C3H'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field1,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)then
do k=1,nsig_regional
write(6,*)' k,c3h(k)=',k,field1(k)
end do
end if
rmse_var='C4H'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field1a,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)then
do k=1,nsig_regional
write(6,*)' k,c4h(k)=',k,field1a(k)
end do
end if
write(iunit)field1(1:nsig_regional),field1a(1:nsig_regional) ! c3h,c4h
rmse_var='C3F'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field1,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)then
do k=1,nsig_regional+1
write(6,*)' k,c3f(k)=',k,field1(k)
end do
end if
rmse_var='C4F'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field1a,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)then
do k=1,nsig_regional+1
write(6,*)' k,c4f(k)=',k,field1a(k)
end do
end if
write(iunit)field1(1:nsig_regional+1),field1a(1:nsig_regional+1) ! c3f,c4f
else
rmse_var='ZNU'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field1,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)then
do k=1,nsig_regional
write(6,*)' k,znu(k)=',k,field1(k)
end do
end if
field1a=0.0_r_single
write(iunit)field1(1:nsig_regional),field1a(1:nsig_regional) ! ZNU
rmse_var='ZNW'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field1,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)then
do k=1,nsig_regional+1
write(6,*)' k,znw(k)=',k,field1(k)
end do
end if
field1a=0.0_r_single
write(iunit)field1(1:nsig_regional+1),field1a(1:nsig_regional+1) ! ZNW
endif
rmse_var='RDX'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
rdx,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)write(6,*)' 1/rdx=',one_single/rdx
rmse_var='RDY'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
rdy,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)write(6,*)' 1/rdy=',one_single/rdy
rmse_var='MAPFAC_M'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)then
write(6,*)' max,min mapfac_m=',maxval(field2),minval(field2)
write(6,*)' max,min MAPFAC_M(:,1)=',maxval(field2(:,1)),minval(field2(:,1))
write(6,*)' max,min MAPFAC_M(1,:)=',maxval(field2(1,:)),minval(field2(1,:))
write(6,*)' mapfac_m(1,1),mapfac_m(nlon,1)=',field2(1,1),field2(nlon_regional,1)
write(6,*)' mapfac_m(1,nlat),mapfac_m(nlon,nlat)=', &
field2(1,nlat_regional),field2(nlon_regional,nlat_regional)
end if
field2b=one_single/(field2*rdx) !DX_MC
field2c=one_single/(field2*rdy) !DY_MC
rad2deg_single=r45/atan(one_single)
rmse_var='XLAT'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)then
write(6,*)' max,min XLAT(:,1)=',maxval(field2(:,1)),minval(field2(:,1))
write(6,*)' max,min XLAT(1,:)=',maxval(field2(1,:)),minval(field2(1,:))
write(6,*)' xlat(1,1),xlat(nlon,1)=',field2(1,1),field2(nlon_regional,1)
write(6,*)' xlat(1,nlat),xlat(nlon,nlat)=', &
field2(1,nlat_regional),field2(nlon_regional,nlat_regional)
end if
field2=field2/rad2deg_single
write(iunit)field2,field2b !XLAT,DX_MC
rmse_var='XLONG'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)then
write(6,*)' max,min XLONG(:,1)=',maxval(field2(:,1)),minval(field2(:,1))
write(6,*)' max,min XLONG(1,:)=',maxval(field2(1,:)),minval(field2(1,:))
write(6,*)' xlong(1,1),xlong(nlon,1)=',field2(1,1),field2(nlon_regional,1)
write(6,*)' xlong(1,nlat),xlong(nlon,nlat)=', &
field2(1,nlat_regional),field2(nlon_regional,nlat_regional)
end if
field2=field2/rad2deg_single
write(iunit)field2,field2c !XLONG,DY_MC
rmse_var='MUB'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)write(6,*)' max,min MUB=',maxval(field2),minval(field2)
rmse_var='MU'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2b,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose) &
write(6,*)' max,min MU=',maxval(field2b),minval(field2b)
field2=field2b+field2+pt_regional
if(print_verbose) &
write(6,*)' max,min psfc0=',maxval(field2),minval(field2)
write(iunit)field2 ! psfc0
rmse_var='PHB'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
k=1
if(print_verbose) &
write(6,*)' k,max,min,mid PHB=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! PHB (zsfc*g)
rmse_var='T'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
field3=field3+h300
do k=1,nsig_regional
if(print_verbose) &
write(6,*)' k,max,min,mid T=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! POT TEMP (sensible??)
end do
rmse_var='QVAPOR'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
do k=1,nsig_regional
if(print_verbose) &
write(6,*)' k,max,min,mid Q=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Q
end do
rmse_var='U'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3u,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
do k=1,nsig_regional
if(print_verbose) &
write(6,*)' k,max,min,mid U=',k,maxval(field3u(:,:,k)),minval(field3u(:,:,k)), &
field3u(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3u(i,j,k),i=1,nlon_regional+1),j=1,nlat_regional) ! U
end do
rmse_var='V'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3v,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
do k=1,nsig_regional
if(print_verbose) &
write(6,*)' k,max,min,mid V=',k,maxval(field3v(:,:,k)),minval(field3v(:,:,k)), &
field3v(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3v(i,j,k),i=1,nlon_regional),j=1,nlat_regional+1) ! V
end do
if(w_exist) then
rmse_var='W'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index=',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3w,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
do k=1,nsig_regional+1
if(print_verbose)then
write(6,*)' k,max,min,mid W=',k,maxval(field3w(:,:,k)),minval(field3w(:,:,k)), &
field3w(nlon_regional/2,nlat_regional/2,k)
end if
write(iunit)((field3w(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! w
end do
end if
! rmse_var='LANDMASK'
rmse_var='XLAND'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)then
write(6,*)' max,min sm=',maxval(field2),minval(field2)
write(6,*)' landmask(1,1),landmask(nlon,1)=',field2(1,1),field2(nlon_regional,1)
write(6,*)' landmask(1,nlat),landmask(nlon,nlat)=', &
field2(1,nlat_regional),field2(nlon_regional,nlat_regional)
end if
DO j=1,nlat_regional
DO i=1,nlon_regional
if(abs(field2(i,j)-2.0)<0.01) field2(i,j)=0.0 !for XLAND 2=water 1=land
ENDDO
ENDDO
write(iunit)field2 !LANDMASK (1=land, 0=water)
rmse_var='SEAICE'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)write(6,*)' max,min SEAICE=',maxval(field2),minval(field2)
write(iunit)field2 ! SEAICE
rmse_var='SST'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)write(6,*)' max,min SST=',maxval(field2),minval(field2)
write(iunit)field2 !SST
rmse_var='IVGTYP'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
ifield2,WrfType,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)write(6,*)' max,min IVGTYP=',maxval(ifield2),minval(ifield2)
write(iunit)ifield2 !IVGTYP
rmse_var='ISLTYP'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
ifield2,WrfType,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)write(6,*)' max,min ISLTYP=',maxval(ifield2),minval(ifield2)
write(iunit)ifield2 !ISLTYP
rmse_var='VEGFRA'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)write(6,*)' max,min VEGFRA=',maxval(field2),minval(field2)
write(iunit)field2 !VEGFRA
rmse_var='SNOW' !
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)write(6,*)' max,min SNOW=',maxval(field2),minval(field2)
write(iunit)field2 !SNOW
rmse_var='U10'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)write(6,*)' max,min U10=',maxval(field2),minval(field2)
write(iunit)field2 !U10
rmse_var='V10'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)write(6,*)' max,min V10=',maxval(field2),minval(field2)
write(iunit)field2 !V10
rmse_var='SMOIS'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
k=1
if(l_gsd_soilTQ_nudge) then
do k=1,nsig_soil_regional
if(print_verbose) &
write(6,*)' k,max,min,mid SMOIS=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! SMOIS
enddo
else
if(print_verbose) &
write(6,*)' k,max,min,mid SMOIS=',k,maxval(field3(:,:,1)),minval(field3(:,:,1)), &
field3(nlon_regional/2,nlat_regional/2,1)
write(iunit)((field3(i,j,1),i=1,nlon_regional),j=1,nlat_regional) ! SMOIS
endif
rmse_var='TSLB'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
k=1
if(l_gsd_soilTQ_nudge) then
do k=1,nsig_soil_regional
if(print_verbose) &
write(6,*)' k,max,min,mid TSLB=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! TSLB
enddo
else
if(print_verbose) &
write(6,*)' k,max,min,mid TSLB=',k,maxval(field3(:,:,1)),minval(field3(:,:,1)), &
field3(nlon_regional/2,nlat_regional/2,1)
write(iunit)((field3(i,j,1),i=1,nlon_regional),j=1,nlat_regional) ! TSLB
endif
rmse_var='TSK'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)write(6,*)' max,min TSK=',maxval(field2),minval(field2)
write(iunit)field2 !TSK
if(i_use_2mt4b >0 .or. i_use_2mq4b >0 ) then
rmse_var='Q2'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)write(6,*)' max,min Q2=',maxval(field2),minval(field2)
write(iunit)field2 !Q2
endif
if(l_gsd_soilTQ_nudge) then
rmse_var='SOILT1'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index=',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)write(6,*)' max,min SOILT1=',maxval(field2),minval(field2)
write(iunit)field2 !SOILT1
endif
if(i_use_2mt4b >0) then
rmse_var='TH2'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index=',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if(print_verbose)write(6,*)' max,min TH2=',maxval(field2),minval(field2)
write(iunit)field2 !TH2
endif
if(l_hydrometeor_bkio .and. n_actual_clouds>0) then
rmse_var='QCLOUD'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
do k=1,nsig_regional
if(print_verbose)write(6,*)' k,max,min,mid Qc=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Qc
end do
rmse_var='QRAIN'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
do k=1,nsig_regional
if(print_verbose)write(6,*)' k,max,min,mid Qr=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Qr
end do
rmse_var='QSNOW'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
do k=1,nsig_regional
if(print_verbose)write(6,*)' k,max,min,mid Qs=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Qs
end do
rmse_var='QICE'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
do k=1,nsig_regional
if(print_verbose)write(6,*)' k,max,min,mid Qi=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Qi
end do
rmse_var='QGRAUP'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
do k=1,nsig_regional
if(print_verbose) &
write(6,*)' k,max,min,mid Qg=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Qg
end do
rmse_var='QNRAIN'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
do k=1,nsig_regional
if(print_verbose) &
write(6,*)' k,max,min,mid Qnr=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Qnr
end do
rmse_var='QNICE'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
do k=1,nsig_regional
if(print_verbose) &
write(6,*)' k,max,min,mid Qni=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Qni
end do
rmse_var='QNCLOUD'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
do k=1,nsig_regional
if(print_verbose) &
write(6,*)' k,max,min,mid Qnc=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Qnc
end do
if( dbz_exist .and. if_model_dbz ) then
rmse_var='REFL_10CM'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering,&
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
do k=1,nsig_regional
! notes: the negative reflectivity is valid value in real observation.
if(print_verbose)then
write(6,*)' k,max,min,mid Dbz=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end if
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) !dBZ
end do
end if
rmse_var='RAD_TTEN_DFI'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var = ',trim(rmse_var),' ndim1=',ndim1
write(6,*)' WrfType = ',WrfType,' WRF_REAL=',WRF_REAL,'ierr = ',ierr !DEDE
write(6,*)' ordering = ',trim(ordering),' staggering = ',trim(staggering)
write(6,*)' start_index = ',start_index,' end_index = ',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
do k=1,nsig_regional
if(print_verbose) &
write(6,*)' k,max,min,mid TTEN=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! TTEN
end do
endif ! l_hydrometeor_bkio
if(laeroana_gocart) then
call gsi_chemguess_get('aerosols::3d', n_gocart_var, ier)
do iv = 1, n_gocart_var
select case ( iv )
case ( 1 )
rmse_var='sulf'
case ( 2 )
rmse_var='BC1'
case ( 3 )
rmse_var='BC2'
case ( 4 )
rmse_var='OC1'
case ( 5 )
rmse_var='OC2'
case ( 6 )
rmse_var='DUST_1'
case ( 7 )
rmse_var='DUST_2'
case ( 8 )
rmse_var='DUST_3'
case ( 9 )
rmse_var='DUST_4'
case ( 10 )
rmse_var='DUST_5'
case ( 11 )
rmse_var='SEAS_1'
case ( 12 )
rmse_var='SEAS_2'
case ( 13 )
rmse_var='SEAS_3'
case ( 14 )
rmse_var='SEAS_4'
case ( 15 )
rmse_var='P25'
end select
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index=',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
if ( trim(rmse_var) == 'sulf' ) then
field3 = field3*ppmv_conv ! ppmv to ug/kg
end if
do k=1,nsig_regional
if(print_verbose) &
write(6,*)' k,max,min,mid var=',rmse_var,k, &
maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional)
end do
end do ! n_gocart_var loop
endif ! laeroana_gocart
if (wrf_pm2_5) then
rmse_var='PM2_5_DRY'
CALL ext_ncd_get_var_info (dh1,TRIM(rmse_var),ndim1,ordering,staggering, &
start_index,end_index, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',TRIM(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index=',end_index
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index, & !dom
start_index,end_index, & !mem
start_index,end_index, & !pat
ierr )
do k=1,nsig_regional
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional)
end do
endif
deallocate(field1,field1a,field2,field2b,field2c,ifield2,field3,field3u,field3v)
if(w_exist) deallocate(field3w)
close(iunit)
call ext_ncd_ioclose(dh1, Status)
enddo n_loop
end subroutine convert_netcdf_mass_wrf
subroutine convert_netcdf_nmm_wrf(this,update_pint,ctph0,stph0,tlm0,guess)
!$$$ subprogram documentation block
! . . . .
! subprogram: convert_netcdf_nmm read wrf nmm netcdf restart
! prgmmr: parrish org: np22 date: 2003-09-05
!
! abstract: using wrf library routines, read a wrf nmm netcdf
! format restart file. write the result to temporary netcdf
! file expected by read_wrf_nmm_guess.
!
! program history log:
! 2004-09-10 parrish
! 2004-11-05 treadon - add return code 74 for error stop
! 2004-12-15 treadon - remove get_lun, read guess from file "wrf_inout"
! 2005-07-06 parrish - add read of pint byte address
! 2005-10-17 parrish - add ctph0,stph0,tlm0
! 2005-12-09 middlecoff - initialize character variable staggering
! 2006-09-15 treadon - use nhr_assimilation to build local guess filename
! 2011-11-14 tong - add loop to read upto 7 wrf nmm netcdf restart file and
! write to temporary netcdf files (extend FGAT capability for
! wrf nmm netcdf format)
! 2012-01-13 zhu - add cloud hydrometeors
! 2012-10-11 eliu - modify to add the use of use_gfs_stratosphere
! 2013-02-15 parrish - change dimension of eta1_new,eta2_new from nsig_max to nsig_max+1.
! 2014-10-28 tong - modify to read wrf nmm ensemble forecast
!
! input argument list:
! update_pint: false on input
! guess: true read guess otherwise read wrf nmm ensemble forecast
!
! output argument list:
! update_pint: true on output if field pint (non-hydrostatic pressure in nmm model)
! is available, in which case pint gets updated by analysis increment of pd,
! the nmm hydrostatic pressure thickness variable.
! ctph0,stph0: cos and sin thp0, earth lat of center of nmm grid (0 deg lat in rotated nmm coordinate)
! (used by calctends routines)
! tlm0
!
! NOTES: this is beginning of allowing direct connection of gsi to wrf files
! without seperate external interface. it is very inefficient, and
! later versions will be made to reduce the total i/o involved.
!
! attributes:
! language: f90
! machine: ibm RS/6000 SP
!
!$$$
! create internal binary file from netcdf format wrf restart file
use kinds, only: r_single,i_kind,r_kind
use gsi_4dvar, only: nhr_assimilation
use constants, only: half,rad2deg,zero
use gsi_metguess_mod, only: gsi_metguess_get
use gfs_stratosphere, only: mix_gfs_nmmb_vcoords,use_gfs_stratosphere,nsig_max,nsig_save
use gridmod, only: half_grid,filled_grid,fill_nmm_grid2a3,half_nmm_grid2a
use hybrid_ensemble_parameters, only: n_ens,merge_two_grid_ensperts
use gsi_io, only: verbose
! use wrf_data
implicit none
! include 'wrf_status_codes.h'
! include 'netcdf.inc'
class(convert_netcdf_class), intent(inout) :: this
logical ,intent(in ) :: guess
logical ,intent(inout) :: update_pint
real(r_kind),intent( out) :: ctph0,stph0,tlm0
character(len=120) :: flnm1
character(len=19) :: DateStr1
character(len=24) :: filename
integer(i_kind) :: dh1
integer(i_kind) :: iunit
integer(i_kind) :: i,j,k
integer(i_kind) :: ndim1
integer(i_kind) :: WrfType
integer(i_kind), dimension(4) :: start_index, end_index1
character (len= 4) :: staggering=' N/A'
character (len= 3) :: ordering
character (len=80), dimension(3) :: dimnames
character (len=80) :: SysDepInfo
integer(i_kind) :: n_actual_clouds, ierr, Status, Status_next_time, n
integer(i_kind) :: nlp
! binary stuff
! rmse stuff
character (len=31) :: rmse_var
integer(i_kind) iyear,imonth,iday,ihour,iminute,isecond
integer(i_kind) nlon_regional,nlat_regional,nsig_regional,nlon,nlat
integer(i_kind) nsig_regional_new,nsig_read
real(r_single) pt_regional,pdtop_regional,dy_nmm
real(r_single) dlmd_regional,dphd_regional
real(r_single),allocatable::aeta1(:),deta1(:),eta1(:)
real(r_single),allocatable::aeta2(:),deta2(:),eta2(:)
real(r_single),allocatable::aeta1_new(:),deta1_new(:),eta1_new(:)
real(r_single),allocatable::aeta2_new(:),deta2_new(:),eta2_new(:)
real(r_single),allocatable::field3(:,:,:),field2(:,:),field1(:),field2b(:,:)
integer(i_kind),allocatable::ifield2(:,:)
real(r_single),allocatable:: glat(:,:),glon(:,:)
real(r_kind),allocatable:: glat8(:,:),glon8(:,:)
real(r_kind),allocatable::glat_an(:,:),glon_an(:,:)
real(r_kind),allocatable::gxtemp(:,:),gytemp(:,:)
real(r_kind),allocatable::gxtemp_an(:,:),gytemp_an(:,:)
real(r_kind),allocatable::region_lat(:,:),region_lon(:,:)
integer(i_kind) :: i0,j0
integer(i_kind) wrf_real
logical :: print_verbose
data iunit / 15 /
associate( this => this ) ! eliminates warning for unused dummy argument needed for binding
end associate
wrf_real=104
end_index1=0
print_verbose=.false.
if(verbose)print_verbose=.true.
! Inquire about cloud guess fields
call gsi_metguess_get('clouds::3d',n_actual_clouds,ierr)
! transfer code from diffwrf for converting netcdf wrf nmm restart file
! to temporary binary format
call ext_ncd_ioinit(sysdepinfo,status)
call set_wrf_debug_level ( 1 )
if(guess) then
nlp=9
else
if(.not. merge_two_grid_ensperts) then
nlp=n_ens
else
nlp=2*n_ens
endif
endif
n_loop: do n=1,nlp ! loop over forecast hours in assim interval
if(guess)then
if(n==nhr_assimilation)then
flnm1 = 'wrf_inout'
else
write(flnm1,'("wrf_inou",i1.1)')n
endif
write(filename,'("sigf",i2.2)') n
else
if(.not. merge_two_grid_ensperts)then
write(flnm1,'("wrf_en",i3.3)')n
write(filename,'("sigf06_ens_mem",i3.3)')n
else
if(n <= n_ens)then
write(flnm1,'("d01_en",i3.3)')n
write(filename,'("sigf06_ens_mem",i3.3)')n
else
write(flnm1,'("d02_en",i3.3)')n-n_ens
write(filename,'("sigf06_d02_ens_mem",i3.3)')n-n_ens
endif
endif
end if
call ext_ncd_open_for_read( trim(flnm1), 0, 0, "", dh1, Status)
if(guess)then
if(n==nhr_assimilation)then
if ( Status /= 0 )then
write(6,*)'CONVERT_NETCDF_NMM: problem with flnm1 = ',&
trim(flnm1),', Status = ', Status
call stop2(74)
endif
else
if ( Status /= 0 )then
write(6,*)'CONVERT_NETCDF_NMM: problem with flnm1 = ',&
trim(flnm1),', Status = ', Status
cycle
endif
end if
else
if ( Status /= 0 )then
write(6,*)'CONVERT_NETCDF_NMM: problem with wrfens = ',&
trim(flnm1),', Status = ', Status
call stop2(74)
endif
endif
open(iunit,file=filename,form='unformatted')
if(guess)write(6,*)'CONVERT_NETCDF_NMM: output file = ', filename
!------------- get date info
call ext_ncd_get_next_time(dh1, DateStr1, Status_next_time)
read(DateStr1,'(i4,1x,i2,1x,i2,1x,i2,1x,i2,1x,i2)') iyear,imonth,iday,ihour,iminute,isecond
if(guess .and. print_verbose)write(6,*)' iy,m,d,h,m,s=',iyear,imonth,iday,ihour,iminute,isecond
!------------- get grid info
rmse_var='T'
call ext_ncd_get_var_info (dh1,rmse_var,ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
nlon_regional=end_index1(1)
nlat_regional=end_index1(2)
nsig_regional=end_index1(3)
! these will hold original vertical structure for regional
allocate(deta1(nsig_regional),aeta1(nsig_regional),eta1(nsig_regional+1))
allocate(deta2(nsig_regional),aeta2(nsig_regional),eta2(nsig_regional+1))
write(6,*)'CONVERT_NETCDF_NMM: nlon_regional,nlat_regional,nsig_regional,nsig_max=', &
nlon_regional,nlat_regional,nsig_regional,nsig_max
allocate(field2(nlon_regional,nlat_regional),field3(nlon_regional,nlat_regional,nsig_regional+1))
allocate(field2b(nlon_regional,nlat_regional),ifield2(nlon_regional,nlat_regional))
allocate(field1(max(nlon_regional,nlat_regional,nsig_regional+1)))
rmse_var='SMC' ! soil moisture volume fraction
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
! Read in east-west angular distance (degrees) H-to-V points
rmse_var='DLMD'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
dlmd_regional,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)write(6,*)' dlmd=',dlmd_regional
rmse_var='DPHD' ! north-south angular distance (degrees) H-to-V points
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
dphd_regional,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)write(6,*)' dphd=',dphd_regional
rmse_var='PT' ! pressure (Pa) at top of domain
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
pt_regional,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)write(6,*)' pt=',pt_regional
rmse_var='PDTOP' ! mass (pa) at model top in pressure domain
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
pdtop_regional,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)write(6,*)' pdtop=',pdtop_regional
rmse_var='DETA1' ! delta sigma in pressure domain
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field1,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
deta1(k)=field1(k)
end do
if(guess .and. print_verbose .and. n==nhr_assimilation)then
write(6,*)'CONVERT_NETCDF_NMM:'
do k=1,nsig_regional
write(6,*)' k,deta1(k)=',k,field1(k)
end do
end if
! write(iunit)field1(1:nsig_regional) ! DETA1
! Read in midlayer sigma value in pressure domain
rmse_var='AETA1'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field1,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
aeta1(k)=field1(k)
end do
if(guess .and. print_verbose .and. n==nhr_assimilation)then
write(6,*)'CONVERT_NETCDF_NMM:'
do k=1,nsig_regional
write(6,*)' k,aeta1(k)=',k,field1(k)
end do
end if
! write(iunit)field1(1:nsig_regional) ! AETA1
rmse_var='ETA1' ! interface sigma value in pressure domain
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field1,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional+1
eta1(k)=field1(k)
end do
if(guess .and. print_verbose .and. n==nhr_assimilation) then
write(6,*)'CONVERT_NETCDF_NMM:'
do k=1,nsig_regional+1
write(6,*)' k, eta1(k)=',k,field1(k)
end do
end if
! write(iunit)field1(1:nsig_regional+1) ! ETA1
rmse_var='DETA2' ! delta sigma in pressure domain
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field1,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
deta2(k)=field1(k)
end do
if(guess .and. print_verbose .and. n==nhr_assimilation) then
write(6,*)'CONVERT_NETCDF_NMM:'
do k=1,nsig_regional
write(6,*)' k,deta2(k)=',k,field1(k)
end do
end if
! write(iunit)field1(1:nsig_regional) ! DETA2
rmse_var='AETA2' ! midlayer sigma value in pressure domain
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field1,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
aeta2(k)=field1(k)
end do
if(guess .and. print_verbose .and. n==nhr_assimilation)then
write(6,*)'CONVERT_NETCDF_NMM:'
do k=1,nsig_regional
write(6,*)' k,aeta2(k)=',k,field1(k)
end do
end if
! write(iunit)field1(1:nsig_regional) ! AETA2
rmse_var='ETA2' ! interface sigma value in pressure domain
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field1,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional+1
eta2(k)=field1(k)
end do
if(guess .and. print_verbose .and. n==nhr_assimilation)then
write(6,*)'CONVERT_NETCDF_NMM:'
do k=1,nsig_regional+1
write(6,*)' k,eta2(k)=',k,field1(k)
end do
end if
! write(iunit)field1(1:nsig_regional+1) ! ETA2
! Create new vertical coordinate structure if use_gfs_stratosphere is true
! Blend and extend vertical coordinate with GFS
! This will create updated values for: deta1, aeat1, eta1
! deta2, aeat2, eta2
! nsig_regional
nsig_read=nsig_regional ! hold the original nsig_regional
if(use_gfs_stratosphere) then ! get new vertical coordinate
allocate(deta1_new(nsig_max),aeta1_new(nsig_max),eta1_new(nsig_max+1))
allocate(deta2_new(nsig_max),aeta2_new(nsig_max),eta2_new(nsig_max+1))
call mix_gfs_nmmb_vcoords(deta1,aeta1,eta1,deta2,aeta2,eta2, &
pdtop_regional,pt_regional,nsig_regional, &
deta1_new,aeta1_new,eta1_new,deta2_new,aeta2_new,eta2_new,nsig_regional_new)
nsig_read=nsig_save
write(6,*)' in convert_netcdf_nmm, compute new vertical coordinate which is merged with gfs'
write(6,*)' previous nsig_regional=',nsig_regional
nsig_regional=nsig_regional_new ! new nsig
write(6,*)' new nsig_regional=',nsig_regional
write(6,*)' nsig_read=',nsig_read
deallocate(deta1,aeta1,eta1)
deallocate(deta2,aeta2,eta2)
allocate(deta1(nsig_regional),aeta1(nsig_regional),eta1(nsig_regional+1))
allocate(deta2(nsig_regional),aeta2(nsig_regional),eta2(nsig_regional+1))
do k=1,nsig_regional
deta1(k)=deta1_new(k)
aeta1(k)=aeta1_new(k)
deta2(k)=deta2_new(k)
aeta2(k)=aeta2_new(k)
end do
do k=1,nsig_regional+1
eta1(k)=eta1_new(k)
eta2(k)=eta2_new(k)
end do
deallocate(deta1_new,aeta1_new,eta1_new)
deallocate(deta2_new,aeta2_new,eta2_new)
end if ! use_gfs_stratosphere
! write out header and new vertical coordinate structure
if(guess)then
write(iunit) iyear,imonth,iday,ihour,iminute,isecond, &
nlon_regional,nlat_regional,nsig_regional, &
dlmd_regional,dphd_regional,pt_regional,pdtop_regional
else
write(iunit) nlon_regional,nlat_regional,nsig_regional, &
dlmd_regional,dphd_regional,pt_regional,pdtop_regional
end if
if(guess)write(iunit)deta1(1:nsig_regional) ! DETA1
write(iunit)aeta1(1:nsig_regional) ! AETA1
if(guess)write(iunit) eta1(1:nsig_regional+1) ! ETA1
if(guess)write(iunit)deta2(1:nsig_regional) ! DETA2
write(iunit)aeta2(1:nsig_regional) ! AETA2
if(guess)write(iunit) eta2(1:nsig_regional+1) ! ETA2
deallocate(deta1,aeta1,eta1,deta2,aeta2,eta2)
rmse_var='GLAT' ! geographic latitude (radians)
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)then
write(6,*)' max,min GLAT=',rad2deg*maxval(field2),rad2deg*minval(field2)
write(6,*)' glat(1,1),glat(nlon,1)=',rad2deg*field2(1,1),rad2deg*field2(nlon_regional,1)
write(6,*)' glat(1,nlat),glat(nlon,nlat)=', &
rad2deg*field2(1,nlat_regional),rad2deg*field2(nlon_regional,nlat_regional)
write(6,*)' my guess at tph0d = ',rad2deg*field2(1+(nlon_regional-1)/2,1+(nlat_regional-1)/2)
end if
ctph0=cos(real(field2(1+(nlon_regional-1)/2,1+(nlat_regional-1)/2),r_kind))
stph0=sin(real(field2(1+(nlon_regional-1)/2,1+(nlat_regional-1)/2),r_kind))
if(guess)then
rmse_var='DX_NMM' ! east-west distance (m) H-to-V points
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2b,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(print_verbose)then
write(6,*)' max,min DX_NMM=',maxval(field2b),minval(field2b)
write(6,*)' dx_nmm(1,1),dx_nmm(nlon,1)=',field2b(1,1),field2b(nlon_regional,1)
write(6,*)' dx_nmm(1,nlat),dx_nmm(nlon,nlat)=', &
field2b(1,nlat_regional),field2b(nlon_regional,nlat_regional)
end if
end if
if(guess)then
write(iunit)field2,field2b !GLAT,DX_NMM
else
allocate(glat(nlon_regional,nlat_regional))
glat=field2
end if
rmse_var='GLON' ! geographic longitude (radians)
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)then
write(6,*)' max,min GLON=',rad2deg*maxval(field2),rad2deg*minval(field2)
write(6,*)' glon(1,1),glon(nlon,1)=',rad2deg*field2(1,1),rad2deg*field2(nlon_regional,1)
write(6,*)' glon(1,nlat),glon(nlon,nlat)=', &
rad2deg*field2(1,nlat_regional),rad2deg*field2(nlon_regional,nlat_regional)
write(6,*)' my guess at tlm0d = ',rad2deg*field2(1+(nlon_regional-1)/2,1+(nlat_regional-1)/2)
end if
tlm0=half*real((field2(1+(nlon_regional-1)/2,1+(nlat_regional-1)/2)+ &
field2(2+(nlon_regional-1)/2,1+(nlat_regional-1)/2)),r_kind)
if(guess)then
rmse_var='DY_NMM' ! north-south distance (m) H-to-V points
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
dy_nmm,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(print_verbose)write(6,*)' dy_nmm=',dy_nmm
field2b=dy_nmm
end if
if(guess)then
write(iunit)field2,field2b !GLON,DY_NMM
else
allocate(glon(nlon_regional,nlat_regional))
glon=field2 !GLON
end if
if(.not. guess)then
if(filled_grid) then
nlon=2*nlon_regional-1
nlat=nlat_regional
end if
if(half_grid) then
nlon=nlon_regional
nlat=1+nlat_regional/2
end if
allocate(glat_an(nlon,nlat),glon_an(nlon,nlat))
allocate(region_lat(nlat,nlon),region_lon(nlat,nlon))
if(half_grid) then
call half_nmm_grid2a(glon,nlon_regional,nlat_regional,glon_an,1)
call half_nmm_grid2a(glat,nlon_regional,nlat_regional,glat_an,1)
end if
if(filled_grid) then
allocate(gxtemp(nlon_regional,nlat_regional))
allocate(gytemp(nlon_regional,nlat_regional))
allocate(glon8(nlon_regional,nlat_regional))
allocate(glat8(nlon_regional,nlat_regional))
glon8=glon
glat8=glat
i0=nlon_regional/2
j0=nlat_regional/2
call ll2rpolar(glat8,glon8,nlon_regional*nlat_regional, &
gxtemp,gytemp,glat8(i0,j0),glon8(i0,j0),zero)
allocate(gxtemp_an(nlon,nlat))
allocate(gytemp_an(nlon,nlat))
call fill_nmm_grid2a3(gxtemp,nlon_regional,nlat_regional,gxtemp_an)
call fill_nmm_grid2a3(gytemp,nlon_regional,nlat_regional,gytemp_an)
call rpolar2ll(gxtemp_an,gytemp_an,nlon*nlat, &
glat_an,glon_an,glat8(i0,j0),glon8(i0,j0),zero)
deallocate(gxtemp,gytemp,gxtemp_an,gytemp_an,glon8,glat8)
end if
do k=1,nlon
do i=1,nlat
region_lat(i,k)=glat_an(k,i)
region_lon(i,k)=glon_an(k,i)
end do
end do
write(iunit)region_lat
write(iunit)region_lon
deallocate(glat,glon,glat_an,glon_an,region_lat,region_lon)
end if
rmse_var='PD' ! mass (Pa) at grid point (I,J) in sigma domain
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)write(6,*)' max,min pd=',maxval(field2),minval(field2)
write(iunit)field2 !PD
if(guess)then
rmse_var='FIS' ! surface geopotential (m2s-2)
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(print_verbose)write(6,*)' max,min FIS=',maxval(field2),minval(field2)
write(iunit)field2 ! FIS
update_pint=.false. ! model layer interface pressure (Pa)
rmse_var='PINT'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(ierr==0) then
update_pint=.true.
if(print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_read+1
if(print_verbose)write(6,*)' k,max,min,mid PINT=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! PINT
end do
if(print_verbose)then
do k=1,nsig_read+1
write(6,'(i6,a6,3(2x,f15.6))') &
k,'PINT',field3(1,1,k), &
field3(nlon_regional/2,nlat_regional/2,k), &
field3(nlon_regional,nlat_regional,k)
enddo
end if
end if
end if
rmse_var='T' ! sensible temperature (K)
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' ierr,rmse_var=',ierr,trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_read
if(guess .and. print_verbose)write(6,*)' k,max,min,mid T=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! T
end do
if(guess)then
do k=1,nsig_read
if(print_verbose)write(6,'(i6,a6,3(2x,f15.6))') &
k,'T',field3(1,1,k), &
field3(nlon_regional/2,nlat_regional/2,k), &
field3(nlon_regional,nlat_regional,k)
enddo
end if
rmse_var='Q' ! Read in specific humidity (Kg/Kg)
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)then
do k=1,nsig_read
write(6,*)' k,max,min,mid Q=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
end if
do k=1,nsig_read
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Q
end do
if(guess .and. print_verbose)then
do k=1,nsig_read
write(6,'(i6,a6,3(2x,f15.12))') &
k,'Q',field3(1,1,k), &
field3(nlon_regional/2,nlat_regional/2,k), &
field3(nlon_regional,nlat_regional,k)
enddo
end if
rmse_var='U' ! U component of wind (m/s)
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_read
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! U
end do
if(guess .and. print_verbose)then
do k=1,nsig_read
write(6,*)' k,max,min,mid U=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
do k=1,nsig_read
write(6,'(i6,a6,3(2x,f15.6))') &
k,'U',field3(1,1,k), &
field3(nlon_regional/2,nlat_regional/2,k), &
field3(nlon_regional,nlat_regional,k)
enddo
end if
rmse_var='V' ! V component of wind (m/s)
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_read
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! V
end do
if(guess .and. print_verbose)then
do k=1,nsig_read
write(6,*)' k,max,min,mid V=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
do k=1,nsig_read
write(6,'(i6,a6,3(2x,f15.6))') &
k,'V',field3(1,1,k), &
field3(nlon_regional/2,nlat_regional/2,k), &
field3(nlon_regional,nlat_regional,k)
enddo
end if
if(guess)then
rmse_var='SM' ! land-sea mask (sea=1 land=0)
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(print_verbose)then
write(6,*)' max,min sm=',maxval(field2),minval(field2)
write(6,*)' sm(1,1),sm(nlon,1)=',field2(1,1),field2(nlon_regional,1)
write(6,*)' sm(1,nlat),sm(nlon,nlat)=', &
field2(1,nlat_regional),field2(nlon_regional,nlat_regional)
end if
write(iunit)field2 !SM
rmse_var='SICE' ! sea ice mask (1=sea ice 0=no sea ice)
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(print_verbose)write(6,*)' max,min SICE=',maxval(field2),minval(field2)
write(iunit)field2 !SICE
rmse_var='SST' ! sea surface temperature (K)
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)write(6,*)' max,min SST=',maxval(field2),minval(field2)
write(iunit)field2 !SST
rmse_var='IVGTYP' ! vegetation type
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
ifield2,WrfType,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)write(6,*)' max,min IVGTYP=',maxval(ifield2),minval(ifield2)
write(iunit)ifield2 !IVGTYP
rmse_var='ISLTYP' ! soil type
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
ifield2,WrfType,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)write(6,*)' max,min ISLTYP=',maxval(ifield2),minval(ifield2)
write(iunit)ifield2 !ISLTYP
rmse_var='VEGFRC' ! vegetation fraction
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)write(6,*)' max,min VEGFRC=',maxval(field2),minval(field2)
write(iunit)field2 !VEGFRC
rmse_var='SNO' ! liquid water equivalent of snow on ground (kg/m2)
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)write(6,*)' max,min SNO=',maxval(field2),minval(field2)
write(iunit)field2 !SNO
rmse_var='U10' ! U at 10 meter (m/s)
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)write(6,*)' max,min U10=',maxval(field2),minval(field2)
write(iunit)field2 !U10
rmse_var='V10' ! V at 10 meter (m/s)
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)write(6,*)' max,min V10=',maxval(field2),minval(field2)
write(iunit)field2 !V10
rmse_var='SMC' ! soil moisture volume fraction
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
k=1
if(guess .and. print_verbose)write(6,*)' k,max,min,mid SMC=',k,maxval(field3(:,:,1)),minval(field3(:,:,1)), &
field3(nlon_regional/2,nlat_regional/2,1)
write(iunit)((field3(i,j,1),i=1,nlon_regional),j=1,nlat_regional) ! SMC
rmse_var='STC' ! soil temperature
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
k=1
if(guess .and. print_verbose)write(6,*)' k,max,min,mid STC=',k,maxval(field3(:,:,1)),minval(field3(:,:,1)), &
field3(nlon_regional/2,nlat_regional/2,1)
write(iunit)((field3(i,j,1),i=1,nlon_regional),j=1,nlat_regional) ! STC
rmse_var='TSK' ! skin temperature (K)
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' rmse_var=',trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)write(6,*)' max,min TSK=',maxval(field2),minval(field2)
write(iunit)field2 !TSK
end if
if (n_actual_clouds>0) then! Read in cloud related fields
rmse_var='CWM' ! cloud water mixing ratio
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' ierr,rmse_var=',ierr,trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)then
do k=1,nsig_read
write(6,*)' k,max,min,mid CWM=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
end if
do k=1,nsig_read
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! CWM
end do
rmse_var='F_ICE' ! fraction of ice cloud in grid box
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' ierr,rmse_var=',ierr,trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_read
if(guess .and. print_verbose)write(6,*)' k,max,min,mid F_ICE=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! F_ICE
end do
rmse_var='F_RAIN' ! fraction of rain in grid box
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' ierr,rmse_var=',ierr,trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(print_verbose .and. guess)then
do k=1,nsig_read
write(6,*)' k,max,min,mid F_RAIN=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
end if
do k=1,nsig_read
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! F_RAIN
end do
rmse_var='F_RIMEF' ! ?
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(guess .and. print_verbose)write(6,*)' ierr,rmse_var=',ierr,trim(rmse_var)
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(guess .and. print_verbose)then
do k=1,nsig_read
write(6,*)' k,max,min,mid F_RIMEF=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
end if
do k=1,nsig_read
write(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! F_RIMEF
end do
end if ! end of n_actual_clouds>0
deallocate(field1,field2,field2b,ifield2,field3)
close(iunit)
call ext_ncd_ioclose(dh1, Status)
enddo n_loop
end subroutine convert_netcdf_nmm_wrf
subroutine update_netcdf_mass_wrf(this)
!$$$ subprogram documentation block
! . . . .
! subprogram: update_netcdf_mass create netcdf format wrf restart file from internal binary file.
! prgmmr:
!
! abstract: create netcdf format wrf restart file from internal binary file
!
! program history log:
! 2004-11-05 treadon - add return code 75 for error stop
! 2004-12-15 treadon - remove get_lun, read guess from file "wrf_inout"
! 2005-12-09 middlecoff - initialize character variable staggering and removed staggering1,staggering2
! 2006-04-06 middlecoff - added read of SM and SICE to match the writes in wrwrfmass.F90
! and read in the rest of the fields to match the writes in wrwrfmass.F90
! 2006-06-09 liu - bug fix: replace SM and SICE with SMOIS and XICE
! 2008-03-29 Hu - bug fix: replace XICE with SEAICE and
! comment out update for SMOIS (the actually
! variable is Landmask there).
! 2009-08-14 lueken - update documentation
! 2010-03-29 Hu - add code to update 5 cloud/hydrometeor variables for cloud analysis
! 2010-10-20 hclin - added 15 wrfchem/gocart fields for aod
! 2012-01-09 Hu - add code to update START_TIME to analysis time
! 2012-04-13 Whitaker - clip positive definite quantities to tiny_single
! 2014-03-12 hu - add code to read ges_q2 (2m Q),
! Qnr(rain number concentration),
! and nsoil (number of soil levels)
! 2015-01-13 ladwig - add code for Qni and Qnc (cloud ice and water number
! concentration)
!
! input argument list:
!
! output argument list:
!
! attributes:
! language: f90
! machine:
!
!$$$ end documentation block
use netcdf, only: nf90_open,nf90_close,nf90_put_att
use netcdf, only: nf90_write,nf90_global
use kinds, only: r_single,i_kind,r_kind
use constants, only: h300,tiny_single
use rapidrefresh_cldsurf_mod, only: l_hydrometeor_bkio,l_gsd_soilTQ_nudge
use rapidrefresh_cldsurf_mod, only: i_gsdcldanal_type
use gsi_metguess_mod, only: gsi_metguess_get,GSI_MetGuess_Bundle
use rapidrefresh_cldsurf_mod, only: i_use_2mt4b,i_use_2mq4b
use gsi_bundlemod, only: GSI_BundleGetPointer
use guess_grids, only: ntguessig
use chemmod, only: laeroana_gocart, ppmv_conv,wrf_pm2_5
use gsi_chemguess_mod, only: gsi_chemguess_get
use netcdf_mod, only: nc_check
use control_vectors, only : w_exist, dbz_exist
use obsmod, only : if_model_dbz
use gsi_io, only: verbose
implicit none
class(convert_netcdf_class), intent(inout) :: this
include 'netcdf.inc'
! Declare local parameters
character(len=120) :: flnm1,flnm2
character(len=19) :: DateStr1
integer(i_kind) :: dh1,iw3jdn
integer(i_kind) :: iunit
integer(i_kind) :: iv, n_gocart_var, ier
integer(i_kind) :: i,j,k
integer(i_kind) :: ndim1
integer(i_kind) :: WrfType
integer(i_kind), dimension(4) :: start_index, end_index1
character (len= 4) :: staggering=' N/A'
character (len= 3) :: ordering
character (len=80), dimension(3) :: dimnames
character (len=80) :: SysDepInfo
character(len=24),parameter :: myname_ = 'update_netcdf_mass'
integer(i_kind) :: it, n_actual_clouds, ierr, istatus, Status, Status_next_time
real(r_kind), pointer :: ges_qc(:,:,:)=>NULL()
real(r_kind), pointer :: ges_qi(:,:,:)=>NULL()
real(r_kind), pointer :: ges_qr(:,:,:)=>NULL()
real(r_kind), pointer :: ges_qs(:,:,:)=>NULL()
real(r_kind), pointer :: ges_qg(:,:,:)=>NULL()
real(r_kind), pointer :: ges_qnr(:,:,:)=>NULL()
real(r_kind), pointer :: ges_qni(:,:,:)=>NULL()
real(r_kind), pointer :: ges_qnc(:,:,:)=>NULL()
real(r_kind), pointer :: ges_dbz(:,:,:)=>NULL()
! binary stuff
logical print_verbose
! rmse stuff
character (len=31) :: rmse_var
integer(i_kind) iyear,imonth,iday,ihour,iminute,isecond
integer(i_kind) nlon_regional,nlat_regional,nsig_regional,nsig_soil_regional
real(r_single) pt_regional
real(r_single),allocatable::field3(:,:,:),field2(:,:),field1(:),field2b(:,:)
real(r_single),allocatable::field3u(:,:,:),field3v(:,:,:),field3w(:,:,:)
integer(i_kind),allocatable::ifield2(:,:)
integer(i_kind) wrf_real
data iunit / 15 /
associate( this => this ) ! eliminates warning for unused dummy argument needed for binding
end associate
print_verbose=.false.
if(verbose) print_verbose=.true.
! binary stuff
wrf_real=104
end_index1=0
! Inquire about guess fields
call gsi_metguess_get('clouds::3d',n_actual_clouds,ierr)
if (n_actual_clouds>0) then
! get pointer to relevant instance of cloud-related backgroud
it=ntguessig
ierr=0
call GSI_BundleGetPointer ( GSI_MetGuess_Bundle(it), 'ql', ges_qc, istatus );ierr=ierr+istatus
call GSI_BundleGetPointer ( GSI_MetGuess_Bundle(it), 'qi', ges_qi, istatus );ierr=ierr+istatus
call GSI_BundleGetPointer ( GSI_MetGuess_Bundle(it), 'qr', ges_qr, istatus );ierr=ierr+istatus
call GSI_BundleGetPointer ( GSI_MetGuess_Bundle(it), 'qs', ges_qs, istatus );ierr=ierr+istatus
call GSI_BundleGetPointer ( GSI_MetGuess_Bundle(it), 'qg', ges_qg, istatus );ierr=ierr+istatus
call GSI_BundleGetPointer ( GSI_MetGuess_Bundle(it), 'qnr',ges_qnr,istatus );ierr=ierr+istatus
call GSI_BundleGetPointer ( GSI_MetGuess_Bundle(it), 'qni',ges_qni,istatus );ierr=ierr+istatus
call GSI_BundleGetPointer ( GSI_MetGuess_Bundle(it), 'qnc',ges_qnc,istatus );ierr=ierr+istatus
if(dbz_exist) call GSI_BundleGetPointer ( GSI_MetGuess_Bundle(it),'dbz',ges_dbz,istatus );ierr=ierr+istatus
if (ierr/=0) n_actual_clouds=0
end if
! transfer code from diffwrf for converting netcdf wrf nmm restart file
! to temporary binary format
if( i_gsdcldanal_type==6 .or. i_gsdcldanal_type==3 .or. i_gsdcldanal_type==7) call ext_ncd_ioinit(sysdepinfo,status)
!
! update mass core netcdf file with analysis variables from 3dvar
!
flnm1='wrf_inout'
call ext_ncd_open_for_update( trim(flnm1), 0, 0, "", dh1, Status)
if ( Status /= 0 )then
write(6,*)'UPDATE_NETCDF_MASS: problem with flnm1 = ',&
trim(flnm1),', Status = ', Status
call stop2(75)
endif
close(51)
flnm2='siganl'
open(iunit,file=flnm2,form='unformatted')
!------------- get date info
call ext_ncd_get_next_time(dh1, DateStr1, Status_next_time)
read(DateStr1,'(i4,1x,i2,1x,i2,1x,i2,1x,i2,1x,i2)') iyear,imonth,iday,ihour,iminute,isecond
write(6,*)' iy,m,d,h,m,s=',iyear,imonth,iday,ihour,iminute,isecond
!------------- get grid info
rmse_var='SMOIS'
call ext_ncd_get_var_info (dh1,rmse_var,ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
nlon_regional=end_index1(1)
nlat_regional=end_index1(2)
nsig_soil_regional=end_index1(3)
rmse_var='T'
call ext_ncd_get_var_info (dh1,rmse_var,ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
nlon_regional=end_index1(1)
nlat_regional=end_index1(2)
nsig_regional=end_index1(3)
if(print_verbose)write(6,*)' nlon,lat,sig_regional=',nlon_regional,nlat_regional,nsig_regional
allocate(field2(nlon_regional,nlat_regional),field3(nlon_regional,nlat_regional,nsig_regional))
allocate(field3u(nlon_regional+1,nlat_regional,nsig_regional))
allocate(field3v(nlon_regional,nlat_regional+1,nsig_regional))
allocate(field3w(nlon_regional,nlat_regional,nsig_regional+1))
allocate(field2b(nlon_regional,nlat_regional))
allocate(ifield2(nlon_regional,nlat_regional))
allocate(field1(max(nlon_regional,nlat_regional,nsig_regional)))
rmse_var='P_TOP'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
pt_regional,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(print_verbose)write(6,*)' p_top=',pt_regional
read(iunit) ! iyear,imonth,iday,ihour,iminute,isecond, &
! nlon_regional,nlat_regional,nsig_regional,pt_regional
read(iunit) ! field1(1:nsig_regional) ! AETA1 (ZNU)
read(iunit) ! field1(1:nsig_regional+1) ! ETA1 (ZNW)
read(iunit) ! field2 !XLAT,DX_MC
read(iunit) ! field2 !XLONG,DY_MC
rmse_var='MUB'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_read_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(print_verbose)write(6,*)' max,min MUB=',maxval(field2),minval(field2)
read(iunit) field2b !psfc
if(print_verbose)write(6,*)' max,min psfc=',maxval(field2b),minval(field2b)
field2b=field2b-field2-pt_regional
if(print_verbose)write(6,*)' max,min MU=',maxval(field2b),minval(field2b)
rmse_var='MU'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field2b,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
read(iunit) ! field2 ! PHB (FIS)
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! T
if(print_verbose) &
write(6,*)' k,max,min,mid T=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
field3=field3-h300
rmse_var='T'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Q
if(print_verbose) &
write(6,*)' k,max,min,mid Q=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='QVAPOR'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
where (field3 < tiny_single) field3 = tiny_single
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
read(iunit)((field3u(i,j,k),i=1,nlon_regional+1),j=1,nlat_regional) ! U
if(print_verbose) &
write(6,*)' k,max,min,mid U=',k,maxval(field3u(:,:,k)),minval(field3u(:,:,k)), &
field3u(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='U'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3u,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
read(iunit)((field3v(i,j,k),i=1,nlon_regional),j=1,nlat_regional+1) ! V
if(print_verbose) &
write(6,*)' k,max,min,mid V=',k,maxval(field3v(:,:,k)),minval(field3v(:,:,k)), &
field3v(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='V'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3v,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(w_exist)then
do k=1,nsig_regional+1
read(iunit)((field3w(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! V
write(6,*)' k,max,min,mid W=',k,maxval(field3w(:,:,k)),minval(field3w(:,:,k)), &
field3w(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='W'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3w,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
end if
read(iunit) field2 ! LANDMASK
if(print_verbose)write(6,*)'max,min LANDMASK=',maxval(field2),minval(field2)
read(iunit) field2 ! SEAICE
if(print_verbose)write(6,*)'max,min SEAICE=',maxval(field2),minval(field2)
rmse_var='SEAICE'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
read(iunit) field2 !SST
if(print_verbose)write(6,*)' max,min SST=',maxval(field2),minval(field2)
rmse_var='SST'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
! Read in the rest of the fields
if(l_gsd_soilTQ_nudge) then
do k=4,9
read(iunit) field2 !Rest of the fields
if(print_verbose) &
write(6,*)'read max,min REST',k,maxval(field2),minval(field2)
end do
do k=1,nsig_soil_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! smois
if(print_verbose) &
write(6,*)' k,max,min,mid SMOIS=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='SMOIS'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_soil_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! tslb
if(print_verbose) &
write(6,*)' k,max,min,mid TSLB=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='TSLB'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
else
do k=4,11 ! corrected according to Ming Hu's finding
read(iunit) field2 !Rest of the fields
if(print_verbose) &
write(6,*)'read max,min REST',k,maxval(field2),minval(field2)
end do
endif
read(iunit) field2 !TSK
if(print_verbose)write(6,*)' max,min TSK=',maxval(field2),minval(field2)
rmse_var='TSK'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if(i_use_2mt4b >0 .or. i_use_2mq4b >0 ) then
read(iunit) field2 !Q2
if(print_verbose)write(6,*)' max,min Q2=',maxval(field2),minval(field2)
rmse_var='Q2'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
endif
if(l_gsd_soilTQ_nudge) then
read(iunit) field2 !SOILT1
if(print_verbose) &
write(6,*)' max,min SOILT1 d=',maxval(field2),minval(field2)
rmse_var='SOILT1'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
endif
if(i_use_2mt4b >0) then
read(iunit) field2 !TH2
if(print_verbose)write(6,*)' max,min TH2 d=',maxval(field2),minval(field2)
rmse_var='TH2'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
endif
if (l_hydrometeor_bkio .and. n_actual_clouds>0) then
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Qc
if(print_verbose) &
write(6,*)' k,max,min,mid Qc=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='QCLOUD'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
where (field3 < tiny_single) field3 = tiny_single
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Qr
if(print_verbose) &
write(6,*)' k,max,min,mid Qr=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='QRAIN'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
where (field3 < tiny_single) field3 = tiny_single
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Qs
if(print_verbose) &
write(6,*)' k,max,min,mid Qs=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='QSNOW'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
where (field3 < tiny_single) field3 = tiny_single
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Qi
if(print_verbose) &
write(6,*)' k,max,min,mid Qi=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='QICE'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
where (field3 < tiny_single) field3 = tiny_single
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Qg
if(print_verbose) &
write(6,*)' k,max,min,mid Qg=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='QGRAUP'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
where (field3 < tiny_single) field3 = tiny_single
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Qnr
if(print_verbose) &
write(6,*)' k,max,min,mid Qnr=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='QNRAIN'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
where (field3 < tiny_single) field3 = tiny_single
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Qni
if(print_verbose) &
write(6,*)' k,max,min,mid Qni=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='QNICE'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
where (field3 < tiny_single) field3 = tiny_single
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Qnc
if(print_verbose) &
write(6,*)' k,max,min,mid Qnc=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='QNCLOUD'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
where (field3 < tiny_single) field3 = tiny_single
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
end if ! l_hydrometeor_bkio
if(dbz_exist .and. if_model_dbz)then
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! V
if(print_verbose) write(6,*)' k,max,min,mid dbz=',k,maxval(field3v(:,:,k)),minval(field3v(:,:,k)), &
field3v(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='REFL_10CM'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
end if
if( l_hydrometeor_bkio )then
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! TTEN
if(print_verbose) &
write(6,*)' k,max,min,mid TTEN=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='RAD_TTEN_DFI'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose) then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
end if ! l_hydrometeor_bkio
if(laeroana_gocart) then
call gsi_chemguess_get('aerosols::3d', n_gocart_var, ier)
do iv = 1, n_gocart_var
select case ( iv )
case ( 1 )
rmse_var='sulf'
case ( 2 )
rmse_var='BC1'
case ( 3 )
rmse_var='BC2'
case ( 4 )
rmse_var='OC1'
case ( 5 )
rmse_var='OC2'
case ( 6 )
rmse_var='DUST_1'
case ( 7 )
rmse_var='DUST_2'
case ( 8 )
rmse_var='DUST_3'
case ( 9 )
rmse_var='DUST_4'
case ( 10 )
rmse_var='DUST_5'
case ( 11 )
rmse_var='SEAS_1'
case ( 12 )
rmse_var='SEAS_2'
case ( 13 )
rmse_var='SEAS_3'
case ( 14 )
rmse_var='SEAS_4'
case ( 15 )
rmse_var='P25'
end select
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional)
if(print_verbose) &
write(6,*)' k,max,min,mid var=',rmse_var,k, &
maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose) then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index=',end_index1
end if
if ( trim(rmse_var) == 'sulf' ) then
field3 = field3/ppmv_conv ! ug/kg to ppmv
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
end do ! n_gocart_var loop
endif ! laeroana_gocart
if (wrf_pm2_5) then
rmse_var='PM2_5_DRY'
do k=1,nsig_regional
READ(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional)
if(print_verbose) &
write(6,*)' k,max,min,mid var=',rmse_var,k, &
maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
endif
deallocate(field1,field2,field2b,ifield2,field3,field3u,field3v,field3w)
call ext_ncd_ioclose(dh1, Status)
close(iunit)
!
! reopen, update global attributes.
!
call nc_check( nf90_open(trim(adjustl(flnm1)),nf90_write,dh1),&
myname_,'open: '//trim(flnm1) )
call nc_check( nf90_put_att(dh1,nf90_global,'START_DATE',trim(DateStr1)),&
myname_,'put_att: START_DATE '//trim(flnm1) )
call nc_check( nf90_put_att(dh1,nf90_global,'SIMULATION_START_DATE',trim(DateStr1)),&
myname_,'put_att: SIMULATION_START_DATE '//trim(flnm1) )
call nc_check( nf90_put_att(dh1,nf90_global,'GMT',float(ihour)),&
myname_,'put_att: GMT '//trim(flnm1) )
call nc_check( nf90_put_att(dh1,nf90_global,'JULYR',iyear),&
myname_,'put_att: JULYR'//trim(flnm1) )
call nc_check( nf90_put_att(dh1,nf90_global,'JULDAY',iw3jdn(iyear,imonth,iday)-iw3jdn(iyear,1,1)+1),&
myname_,'put_att: JULDAY'//trim(flnm1) )
call nc_check( nf90_close(dh1),&
myname_,'close: '//trim(flnm1) )
end subroutine update_netcdf_mass_wrf
subroutine update_netcdf_nmm_wrf(this)
!$$$ subprogram documentation block
! . . . .
! subprogram: update_netcdf_nmm create netcdf format wrf restart from internal binary file.
! pgrmmr:
!
! abstract: create netcdf format wrf restart from internal binary file.
!
! program history log:
! 2004-11-05 treadon - add return code 75 for error stop
! 2004-12-15 treadon - remove get_lun, read guess from file "wrf_inout"
! 2005-12-09 middlecoff - read in pint if update_pint=.true.
! 2005-12-09 middlecoff - initialize character variable staggering and removed staggering1,staggering2
! 2009-08-14 lueken - update documentation
! 2012-01-14 zhu - add cloud hydrometeors
! 2012-04-20 Whitaker - update NSTART_HOUR variable in HWRF restart file.
!
! input argument list:
!
! output argument list:
!
! attributes:
! language: f90
! machine:
!
!$$$ end documentation block
use netcdf, only: nf90_open,nf90_close,nf90_put_att
use netcdf, only: nf90_write,nf90_global
use kinds, only: r_single,i_kind,r_kind
use constants, only: tiny_single
use wrf_params_mod, only: update_pint
use gsi_metguess_mod, only: gsi_metguess_get,gsi_metguess_bundle
use gsi_bundlemod, only: gsi_bundlegetpointer
use mpeu_util, only: die,getindex
use control_vectors, only: cvars3d
use guess_grids, only: ntguessig
use netcdf_mod, only: nc_check
use gsi_io, only: verbose
! use wrf_data
implicit none
include 'netcdf.inc'
class(convert_netcdf_class), intent(inout) :: this
! include 'wrf_status_codes.h'
character(len=120) :: flnm1,flnm2
character(len=19) :: DateStr1
integer(i_kind) :: dh1
integer(i_kind) :: iunit
integer(i_kind) :: i,j,k
integer(i_kind) :: ndim1
integer(i_kind) :: WrfType
integer(i_kind), dimension(4) :: start_index, end_index1
character (len= 4) :: staggering=' N/A'
character (len= 3) :: ordering
character (len=80), dimension(3) :: dimnames
character(len=24),parameter :: myname_ = 'update_netcdf_nmm'
integer(i_kind) :: it, n_actual_clouds, ier, iret, ierr, Status, Status_next_time
integer(i_kind) icw4crtm,iqtotal
real(r_kind),pointer,dimension(:,:,:):: ges_ql=>NULL()
real(r_kind),pointer,dimension(:,:,:):: ges_qi=>NULL()
real(r_kind),pointer,dimension(:,:,:):: ges_qr=>NULL()
real(r_kind),pointer,dimension(:,:,:):: ges_qs=>NULL()
real(r_kind),pointer,dimension(:,:,:):: ges_qg=>NULL()
real(r_kind),pointer,dimension(:,:,:):: ges_qh=>NULL()
! binary stuff
! rmse stuff
character (len=31) :: rmse_var
integer(i_kind) :: nallo
integer(i_kind) iyear,imonth,iday,ihour,iminute,isecond,iw3jdn
integer(i_kind) nlon_regional,nlat_regional,nsig_regional,istatus
! real(r_single) pt_regional
real(r_single),allocatable::field3(:,:,:),field2(:,:),field1(:)
integer(i_kind),allocatable::ifield2(:,:)
integer(i_kind),allocatable::ifield1(:)
integer(i_kind) wrf_real
data iunit / 15 /
logical print_verbose
associate( this => this ) ! eliminates warning for unused dummy argument needed for binding
end associate
print_verbose=.false.
if(verbose)print_verbose=.true.
wrf_real=104
start_index=0
end_index1=0
! Inquire about cloud guess fields
call gsi_metguess_get('clouds::3d',n_actual_clouds,istatus)
if (n_actual_clouds>0) then
it=ntguessig
! Get pointer to cloud water mixing ratio
call gsi_bundlegetpointer (gsi_metguess_bundle(it),'ql',ges_ql,iret); ier=iret
call gsi_bundlegetpointer (gsi_metguess_bundle(it),'qi',ges_qi,iret); ier=ier+iret
call gsi_bundlegetpointer (gsi_metguess_bundle(it),'qr',ges_qr,iret); ier=ier+iret
call gsi_bundlegetpointer (gsi_metguess_bundle(it),'qs',ges_qs,iret); ier=ier+iret
call gsi_bundlegetpointer (gsi_metguess_bundle(it),'qg',ges_qg,iret); ier=ier+iret
call gsi_bundlegetpointer (gsi_metguess_bundle(it),'qh',ges_qh,iret); ier=ier+iret
! Determine whether or not cloud-condensate is the control variable
icw4crtm=getindex(cvars3d,'cw')
! Determine whether total moisture (water vapor+total cloud condensate) is the control variable
iqtotal=getindex(cvars3d,'qt')
if (ier/=0 .or. (icw4crtm<=0 .and. iqtotal<=0)) n_actual_clouds=0
end if
! transfer code from diffwrf for converting netcdf wrf nmm restart file
! to temporary binary format
!
! update nmm netcdf file with analysis variables from 3dvar
!
flnm1='wrf_inout'
call ext_ncd_open_for_update( trim(flnm1), 0, 0, "", dh1, Status)
if ( Status /= 0 )then
write(6,*)'UPDATE_NETCDF_NMM: problem with flnm1 = ',&
trim(flnm1),', Status = ', Status
call stop2(75)
endif
close(51)
flnm2='siganl'
open(iunit,file=flnm2,form='unformatted')
!------------- get date info
call ext_ncd_get_next_time(dh1, DateStr1, Status_next_time)
read(DateStr1,'(i4,1x,i2,1x,i2,1x,i2,1x,i2,1x,i2)') iyear,imonth,iday,ihour,iminute,isecond
write(6,*)' iy,m,d,h,m,s=',iyear,imonth,iday,ihour,iminute,isecond
!------------- get grid info
rmse_var='T'
call ext_ncd_get_var_info (dh1,rmse_var,ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
nlon_regional=end_index1(1)
nlat_regional=end_index1(2)
nsig_regional=end_index1(3)
nallo = nsig_regional
if(update_pint) nallo = nallo+1 ! add contribution of PINT
! write(6,*)' nlon,lat,sig_regional=',nlon_regional,nlat_regional,nsig_regional
write(6,*)' update_netcdf_nmm: nlon,lat,sig_regional=',nlon_regional,nlat_regional,nsig_regional
allocate(field2(nlon_regional,nlat_regional))
allocate(field3(nlon_regional,nlat_regional,nallo))
allocate(ifield2(nlon_regional,nlat_regional))
allocate(field1(max(nlon_regional,nlat_regional,nsig_regional)))
allocate(ifield1(max(nlon_regional,nlat_regional,nsig_regional)))
read(iunit) ! iyear,imonth,iday,ihour,iminute,isecond, &
! nlon_regional,nlat_regional,nsig_regional, &
! dlmd_regional,dphd_regional,pt_regional,pdtop_regional
read(iunit) ! field1(1:nsig_regional) ! DETA1
read(iunit) ! field1(1:nsig_regional) ! AETA1
read(iunit) ! field1(1:nsig_regional+1) ! ETA1
read(iunit) ! field1(1:nsig_regional) ! DETA2
read(iunit) ! field1(1:nsig_regional) ! AETA2
read(iunit) ! field1(1:nsig_regional+1) ! ETA2
read(iunit) ! field2 !GLAT,DX_NMM
read(iunit) ! field2 !GLON,DY_NMM
read(iunit) field2 !PD
if(print_verbose)write(6,*)' max,min pd=',maxval(field2),minval(field2)
rmse_var='PD'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field2,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
read(iunit) ! field2 ! FIS
if(update_pint) then
do k=1,nsig_regional+1
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! PINT
if(print_verbose) &
write(6,*)' k,max,min,mid PINT=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='PINT'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose) then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
endif
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! T
if(print_verbose) &
write(6,*)' k,max,min,mid T=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='T'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose) then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! Q
if(print_verbose) &
write(6,*)' k,max,min,mid Q=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='Q'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
where (field3 < tiny_single) field3 = tiny_single
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! U
if(print_verbose) &
write(6,*)' k,max,min,mid U=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='U'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! V
if(print_verbose) &
write(6,*)' k,max,min,mid V=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='V'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose) then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,12
read(iunit) field2
if(print_verbose)write(6,*)'read max,min REST',k,maxval(field2),minval(field2)
end do
if (n_actual_clouds>0) then
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! CWM
if(print_verbose) &
write(6,*)' k,max,min,mid CWM=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='CWM'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
where (field3 < tiny_single) field3 = tiny_single
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! F_ICE
if(print_verbose) &
write(6,*)' k,max,min,mid F_ICE=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='F_ICE'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
where (field3 < tiny_single) field3 = tiny_single
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! F_RAIN
if(print_verbose) &
write(6,*)' k,max,min,mid F_RAIN=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='F_RAIN'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose) then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
where (field3 < tiny_single) field3 = tiny_single
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
do k=1,nsig_regional
read(iunit)((field3(i,j,k),i=1,nlon_regional),j=1,nlat_regional) ! F_RIMEF
if(print_verbose) &
write(6,*)' k,max,min,mid F_RIMEF=',k,maxval(field3(:,:,k)),minval(field3(:,:,k)), &
field3(nlon_regional/2,nlat_regional/2,k)
end do
rmse_var='F_RIMEF'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose)then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType,WRF_REAL=',WrfType,WRF_REAL
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
where (field3 < tiny_single) field3 = tiny_single
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
field3,WRF_REAL,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
end if
close(iunit)
rmse_var='NSTART_HOUR'
call ext_ncd_get_var_info (dh1,trim(rmse_var),ndim1,ordering,staggering, &
start_index,end_index1, WrfType, ierr )
if(print_verbose) then
write(6,*)' rmse_var=',trim(rmse_var)
write(6,*)' ordering=',ordering
write(6,*)' WrfType=',WrfType
write(6,*)' ndim1=',ndim1
write(6,*)' staggering=',staggering
write(6,*)' start_index=',start_index
write(6,*)' end_index1=',end_index1
end if
ifield1(1) = ihour
call ext_ncd_write_field(dh1,DateStr1,TRIM(rmse_var), &
ifield1,WrfType,0,0,0,ordering, &
staggering, dimnames , &
start_index,end_index1, & !dom
start_index,end_index1, & !mem
start_index,end_index1, & !pat
ierr )
if (ierr .ne. 0) then
write(6,*) '**error updating NSTART_HOUR (only needed for HWRF restart file)**'
endif
deallocate(field1,field2,ifield1,ifield2,field3)
call ext_ncd_ioclose(dh1, Status)
!
! reopen, update global attributes.
!
call nc_check( nf90_open(trim(adjustl(flnm1)),nf90_write,dh1),&
myname_,'open: '//trim(adjustl(flnm1)) )
call nc_check( nf90_put_att(dh1,nf90_global,'START_DATE',trim(DateStr1)),&
myname_,'put_att: START_DATE '//trim(adjustl(flnm1)) )
call nc_check( nf90_put_att(dh1,nf90_global,'SIMULATION_START_DATE',trim(DateStr1)),&
myname_,'put_att: SIMULATION_START_DATE '//trim(adjustl(flnm1)) )
call nc_check( nf90_put_att(dh1,nf90_global,'GMT',float(ihour)),&
myname_,'put_att: GMT '//trim(adjustl(flnm1)) )
call nc_check( nf90_put_att(dh1,nf90_global,'JULYR',iyear),&
myname_,'put_att: JULYR'//trim(adjustl(flnm1)) )
call nc_check( nf90_put_att(dh1,nf90_global,'JULDAY',iw3jdn(iyear,imonth,iday)-iw3jdn(iyear,1,1)+1),&
myname_,'put_att: JULDAY'//trim(adjustl(flnm1)) )
call nc_check( nf90_close(dh1),&
myname_,'close: '//trim(adjustl(flnm1)) )
end subroutine update_netcdf_nmm_wrf
end module convert_netcdf_mod