subroutine ncf_rdpthdr_sa(igroup,idxfile,begtim,begdate,endtim,enddate) use filunit use ptemiss use chmstry use tracer implicit none c c----CAMx v7Beta6 190902 c c----------------------------------------------------------------------- c Description: c----------------------------------------------------------------------- c c NCF_RDPTHDR reads the header information from the global section c of the NetCDF point source file and checks for consistency with c model simulation. c c Copyright 1996 - 2018 c Ramboll c c Argument description: c Inputs: c igroup I group number for this file c idxfile I index for this file in arrays c begtim R model begin time c begdat I model begin date (YYJJJ) c endtim R model end time c enddate I model end date (YYJJJ) c Outputs: 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 'netcdf.inc' c c----------------------------------------------------------------------- c Argument declarations: c----------------------------------------------------------------------- c integer igroup integer idxfile real begtim integer begdate real endtim integer enddate c c----------------------------------------------------------------------- c External functions: c----------------------------------------------------------------------- c integer istrln integer fnd_point c c----------------------------------------------------------------------- c Local variables: c----------------------------------------------------------------------- c character*200 action, fname character*10 pntfil, name_in, this_var integer this_dimid, this_varid, ierr, tmpmap(MXSPEC), numpts integer ipt, iounit, idxpt_base logical lpigsa_flag c real, allocatable, dimension(:) :: xlocin real, allocatable, dimension(:) :: ylocin real, allocatable, dimension(:) :: hstkin real, allocatable, dimension(:) :: dstkin real, allocatable, dimension(:) :: tstkin real, allocatable, dimension(:) :: vstkin real, allocatable, dimension(:) :: iarray logical, allocatable, dimension(:) :: source_is_in_SA c c----------------------------------------------------------------------- c Data statments: c----------------------------------------------------------------------- c data pntfil /'PTSOURCE '/ c c----------------------------------------------------------------------- c Entry point: c----------------------------------------------------------------------- c c --- loop over number of files --- c iounit = iortpt(igroup,idxfile) if( .NOT. is_netcdf_iortpt(igroup,idxfile) ) goto 9999 write(action,'(2A,I3)') 'Reading NetCDF SA point source file.', & ' Group: ',igroup fname = tptfil(igroup,idxfile) c c --- get the type of file to make sure it is a point source file --- c this_var = 'NAME' ierr = nf_get_att_text(iounit, NF_GLOBAL, this_var, name_in) if( ierr .NE. NF_NOERR ) goto 7000 if( name_in(:istrln(name_in)) .NE. pntfil(:istrln(pntfil)) ) goto 7001 c c --- call routine to make sure grid defintion is consistent --- c call ncf_chk_griddef(iounit,action,1,.FALSE.,.FALSE.) c c --- call routine to make sure file spans the episode --- c call ncf_chk_tstep(iounit,action,begdate,begtim, & enddate,endtim,le1day) c c --- call routine to setup species mappping array --- c call ncf_set_emiss_mapping(iounit,action) c c --- get the number of points (used as dimension for columns) --- c ierr = nf_inq_dimid(iounit, "COL", this_dimid ) if( ierr .NE. NF_NOERR ) goto 7002 ierr = nf_inq_dimlen(iounit,this_dimid,numpts) if( ierr .NE. NF_NOERR ) goto 7002 c c --- allocate the local arrays --- c allocate( xlocin(numpts) ) allocate( ylocin(numpts) ) allocate( hstkin(numpts) ) allocate( dstkin(numpts) ) allocate( tstkin(numpts) ) allocate( vstkin(numpts) ) allocate( iarray(numpts) ) allocate( source_is_in_SA(nptsrc) ) c source_is_in_SA = .FALSE. c this_var = "xcoord" ierr = nf_inq_varid(iounit,this_var,this_varid) if( ierr .NE. NF_NOERR ) goto 7005 ierr = nf_get_var_real(iounit,this_varid,xlocin) if( ierr .NE. NF_NOERR ) goto 7006 c this_var = "ycoord" ierr = nf_inq_varid(iounit,this_var,this_varid) if( ierr .NE. NF_NOERR ) goto 7005 ierr = nf_get_var_real(iounit,this_varid,ylocin) if( ierr .NE. NF_NOERR ) goto 7006 c c --- get pig flag --- c this_var = "pigflag" ierr = nf_inq_varid(iounit,this_var,this_varid) if( ierr .NE. NF_NOERR ) goto 7005 ierr = nf_get_var_int(iounit,this_varid,iarray) if( ierr .NE. NF_NOERR ) goto 7006 c this_var = "stkheight" ierr = nf_inq_varid(iounit,this_var,this_varid) if( ierr .NE. NF_NOERR ) goto 7005 ierr = nf_get_var_real(iounit,this_varid,hstkin) if( ierr .NE. NF_NOERR ) goto 7006 c this_var = "stkdiam" ierr = nf_inq_varid(iounit,this_var,this_varid) if( ierr .NE. NF_NOERR ) goto 7005 ierr = nf_get_var_real(iounit,this_varid,dstkin) if( ierr .NE. NF_NOERR ) goto 7006 c this_var = "stktemp" ierr = nf_inq_varid(iounit,this_var,this_varid) if( ierr .NE. NF_NOERR ) goto 7005 ierr = nf_get_var_real(iounit,this_varid,tstkin) if( ierr .NE. NF_NOERR ) goto 7006 c this_var = "stkspeed" ierr = nf_inq_varid(iounit,this_var,this_varid) if( ierr .NE. NF_NOERR ) goto 7005 ierr = nf_get_var_real(iounit,this_varid,vstkin) if( ierr .NE. NF_NOERR ) goto 7006 c c --- make sure this source is in the base inventory and flag it --- c do ipt=1,numpts if( igroup .GT. 0 ) then idxpt_base = fnd_point(xlocin(ipt),ylocin(ipt),hstkin(ipt), & dstkin(ipt),tstkin(ipt),source_is_in_SA) if(idxpt_base .LE. 0 ) then goto 7004 else source_is_in_SA(idxpt_base) = .TRUE. idx_point_in_list(igroup,idxfile,ipt) = idxpt_base endif else idxpt_base = ipt + idx_start_pts(idxfile) idx_point_in_list(igroup,idxfile,ipt) = idxpt_base endif lpigsa_flag = .FALSE. if( iarray(ipt) .GT. 0 ) lpigsa_flag = .TRUE. if( lpigsa_flag .NEQV. lpiglet(ipt) ) goto 7008 enddo c c --- deallocate the local arrays --- c deallocate( xlocin ) deallocate( ylocin ) deallocate( hstkin ) deallocate( dstkin ) deallocate( tstkin ) deallocate( vstkin ) deallocate( iarray ) deallocate( source_is_in_SA ) goto 9999 c c----------------------------------------------------------------------- c Error messages: c----------------------------------------------------------------------- c 7000 continue write(iout,'(//,a)') 'ERROR in NCF_RDPTHDR_SA:' write(iout,'(A)') action(:istrln(action)) write(iout,'(2A)') 'Cannot get necessary global attribute: ', & this_var(:istrln(this_var)) write(iout,'(1X,2A)') 'File: ',fname(:istrln(fname)) call camxerr() c 7001 continue write(iout,'(//,a)') 'ERROR in NCF_RDPTHDR_SA:' write(iout,'(A)') action(:istrln(action)) write(iout,'(A)') 'Input file is not the correct type.' write(iout,'(2A)') 'Looking for type: ',pntfil(:istrln(pntfil)) write(iout,'(2A)') 'Found in file : ',name_in(:istrln(name_in)) write(iout,'(1X,2A)') 'File: ',fname(:istrln(fname)) call camxerr() c 7002 continue write(iout,'(//,a)') 'ERROR in NCF_RDPTHDR_SA:' write(iout,'(A)') action(:istrln(action)) write(iout,'(A)') 'Cannot find the dimension id for number ', & 'of point sources (NCOL)' write(iout,'(1X,2A)') 'File: ',fname(:istrln(fname)) call camxerr() c 7003 continue write(iout,'(//,a)') 'ERROR in NCF_RDPTHDR_SA:' write(iout,'(A)') action(:istrln(action)) write(iout,'(A)') 'Cannot find the dimension value for number ', & 'of point sources (NCOL)' write(iout,'(1X,2A)') 'File: ',fname(:istrln(fname)) call camxerr() c 7004 continue write(iout,'(//,a)') 'ERROR in NCF_RDPTHDR_SA:' write(iout,'(A)') action(:istrln(action)) write(iout,'(/,1X,3A)') 'List of points: ', & ' is not consistent with regular emissions in file.' write(iout,'(1X,2A)') 'File: ',fname(:istrln(fname)) call camxerr() c 7005 continue write(iout,'(//,a)') 'ERROR in NCF_RDPTHDR_SA:' write(iout,'(A)') action(:istrln(action)) write(iout,'(2A)') 'Cannot find variable id for: ', & this_var(:istrln(this_var)) write(iout,'(1X,2A)') 'File: ',fname(:istrln(fname)) call camxerr() c 7006 continue write(iout,'(//,a)') 'ERROR in NCF_RDPTHDR_SA:' write(iout,'(A)') action(:istrln(action)) write(iout,'(2A)') 'Cannot read data for variable: ', & this_var(:istrln(this_var)) write(iout,'(1X,2A)') 'File: ',fname(:istrln(fname)) call camxerr() c 7007 continue write(iout,'(//,a)') 'ERROR in NCF_RDPTHDR_SA:' write(iout,'(A)') action(:istrln(action)) write(iout,'(2A)') 'List of point sources does not match the ', & 'regular model file.' write(iout,'(A,I10,A)') 'Location of point source: ',ipt, & ' does not match.' write(iout,'(1X,2A)') 'File: ',fname(:istrln(fname)) call camxerr() c 7008 continue write(iout,'(//,a)') 'ERROR in NCF_RDPTHDR_SA:' write(iout,'(A)') action(:istrln(action)) write(iout,'(2A)') 'PiG flag for sources in file is ', & 'inconsistent with regular model file.' write(iout,'(A,I10,A)') 'Flag for point source: ',ipt, & ' does not match.' write(iout,'(1X,2A)') 'File: ',fname(:istrln(fname)) call camxerr() c c----------------------------------------------------------------------- c Return point: c----------------------------------------------------------------------- c 9999 continue return end