C**** NCF_READPT c subroutine ncf_readpt(ifile,iunit,numpts,numspcs,pntems) use chmstry use camxcom use filunit use ptemiss implicit none c c----CAMx v7Beta6 190902 c c----------------------------------------------------------------------- c Description: c----------------------------------------------------------------------- c c NCF_READPT reads the NetCDF pint source emissions file c loads the data into global arrays for emissions injection. c c Copyright 1996 - 2018 c Ramboll c c Input arguments: c ifile index of file in list for this grid c iunit file unit for area emissions file c numpnts total number of point sources c numspcs number of emissions species c c Output arguments: c pntems point source emissions rate (mole/s) c c c----------------------------------------------------------------------- c LOG: c----------------------------------------------------------------------- c c 02/20/17 --gwilson-- Original development c c----------------------------------------------------------------------- c Include files: c----------------------------------------------------------------------- c include 'camx.prm' include 'flags.inc' include 'vbs.inc' include 'netcdf.inc' c c----------------------------------------------------------------------- c Argument declarations: c----------------------------------------------------------------------- c integer ifile integer iunit integer numpts integer numspcs real pntems(numpts,numspcs) c c----------------------------------------------------------------------- c External functions: c----------------------------------------------------------------------- c integer istrln integer ncf_get_tstep c c----------------------------------------------------------------------- c Local variables: c----------------------------------------------------------------------- c character*200 action character*10 this_var integer this_tstep, ierr, ispc, ipt integer idx_start, this_time_tflag, this_time_etflag integer this_varid, data_start(2), data_count(2) real pi c real, allocatable, dimension(:) :: emispts c c----------------------------------------------------------------------- c Data statements: c----------------------------------------------------------------------- c data pi /3.1415927/ c c----------------------------------------------------------------------- c Entry point: c----------------------------------------------------------------------- c if( .NOT. is_netcdf_iptem(ifile) ) goto 9999 write(action,'(2A,I3)') 'Reading the NetCDF point source', & ' emissions file. File: ',ifile idx_start = idx_start_pts(ifile) c c ---- allocate the temporary array --- c allocate( emispts(nptsrc_files(ifile)) ) c c ---- get the index for timestep containing this time ---- c this_tstep = ncf_get_tstep(iunit,action,date,time, & this_time_tflag,this_time_etflag,le1day,.TRUE.) c c --- set the indexes for what to read --- c data_start(1) = 1 data_count(1) = nptsrc_files(ifile) data_start(2) = this_tstep data_count(2) = 1 c c ---- flow rate --- c this_var = 'flowrate' ierr = nf_inq_varid(iunit, this_var, this_varid) if( ierr .NE. NF_NOERR) goto 7000 ierr = nf_get_vara_real(iunit,this_varid,data_start, & data_count,emispts) if( ierr .NE. NF_NOERR) goto 7001 c c --- Put the data into the global array, c and convert flow rate to new exit velocity in m/s --- c do ipt=1,nptsrc_files(ifile) flowrat(ipt+idx_start) = emispts(ipt) if( flowrat(ipt+idx_start) .GT. 0. .AND. & dstk(ipt+idx_start) .NE. 0. ) vstk(ipt+idx_start) = & flowrat(ipt+idx_start)/(3600.*pi*(ABS(dstk(ipt+idx_start))/2)**2) enddo c c ---- plumerise --- c this_var = 'plumerise' ierr = nf_inq_varid(iunit, this_var, this_varid) if( ierr .NE. NF_NOERR) goto 7000 ierr = nf_get_vara_real(iunit,this_varid,data_start, & data_count,emispts) if( ierr .NE. NF_NOERR) goto 7001 c c --- Put the data into the global array ---- c do ipt=1,nptsrc_files(ifile) effph(ipt+idx_start) = emispts(ipt) enddo c c --- check that data id valid --- c do ipt=idx_start+1,idx_start+nptsrc_files(ifile) if(flowrat(ipt) .LT. 0. .AND. effph(ipt) .LT. 0. ) then if( ABS(effph(ipt)) .LT. ABS(flowrat(ipt)) ) then write(iout,'(//,a)')'ERROR in NCF_READPT:' write(iout,*) 'Invalid values found for flow rate and plume height.' write(iout,*) 'The plume distribution override is triggered. But the ' write(iout,*) 'value for flow rate (base) is larger than value for ', & 'plume height (top).' call camxerr() endif endif enddo c c ---- loop over the list of emissions spcies --- c do ispc=1,nspec if( lemmap(ispc) .LE. 0 ) cycle c c --- load data into temporary arrray --- c this_var = emspcname(lemmap(ispc)) ierr = nf_inq_varid(iunit, this_var, this_varid) if( ierr .NE. NF_NOERR) cycle ierr = nf_get_vara_real(iunit,this_varid,data_start, & data_count,emispts) if( ierr .NE. NF_NOERR) goto 7001 c c-----Put the data into the global array ---- c do ipt=1,nptsrc_files(ifile) pntems(idx_start+ipt,lemmap(ispc)) = emispts(ipt)/(60.*dtems) enddo c c ---- next species --- c enddo c cgwilson if(lvbs .and. LVBSPREPROC) then cgwilson if( lemmap(kpap_c(0)) .EQ. ispc ) then ! POA_OP in VBS emiss cgwilson poa_op_em(:) = emispts(:) cgwilson goto 50 cgwilson endif cgwilson if( lemmap(kpap_c(1)) .EQ. ispc ) then ! POA_GV in VBS emiss cgwilson poa_gv_em(:) = emispts(:) cgwilson goto 50 cgwilson endif cgwilson if( lemmap(kpap_c(2)) .EQ. ispc ) then ! POA_DV in VBS emiss cgwilson poa_dv_em(:) = emispts(:) cgwilson goto 50 cgwilson endif cgwilson if( lemmap(kpcp_c(0)) .EQ. ispc ) then ! POA_MC in VBS emiss cgwilson poa_mc_em(:) = emispts(:) cgwilson goto 50 cgwilson endif cgwilson if( lemmap(kpfp_c(0)) .EQ. ispc ) then ! POA_BB in VBS emiss cgwilson poa_bb_em(:) = emispts(:) cgwilson goto 50 cgwilson endif cgwilson endif c cgwilson 50 continue cgwilson iF (LVBS .and. LVBSPREPROC) then cgwilson do l = 0, NVOLBIN cgwilson pntems(:,:,kpap_c(l)) = poa_op_em(:,:) * poa_op_ef(l) cgwilson & + poa_gv_em(:,:) * poa_gv_ef(l) cgwilson & + poa_dv_em(:,:) * poa_dv_ef(l) cgwilson pntems(:,:,kpcp_c(l)) = poa_mc_em(:,:) * poa_mc_ef(l) cgwilson pntems(:,:,kpfp_c(l)) = poa_bb_em(:,:) * poa_bb_ef(l) cgwilson enddo cgwilson endif c c ---- deallocate the temporary array --- c deallocate( emispts ) c goto 9999 c c----------------------------------------------------------------------- c Error messages: c----------------------------------------------------------------------- c 7000 continue write(iout,'(//,a)') 'ERROR in NCF_READPT: ' write(iout,'(A)') action(:istrln(action)) write(iout,'(2A)') 'Cannot find variable id for: ', & this_var(:istrln(this_var)) call camxerr() c 7001 continue write(iout,'(//,a)') 'ERROR in NCF_READPT:' write(iout,'(A)') action(:istrln(action)) write(iout,'(2A)') 'Cannot read data for variable: ', & this_var(:istrln(this_var)) call camxerr() c 9999 continue return end