
      PROGRAM GEN_AFDUST_TFRAC

C***********************************************************************
C
C  DESCRIPTION: Takes gridded SMOKE emissions file and applies
C               a user-supplied factor for each individual species
C               and applies it for a certain geographical region
C               obtained from input mask file..
C               The resulting emissions are output to a netCDF file.
C
C  PRECONDITIONS REQUIRED:
C
C  SUBROUTINES AND FUNCTIONS CALLED:
C
C  REVISION  HISTORY:
C             10/00 : Prototype by JMV
C
C***********************************************************************
C
C Project Title: Sparse Matrix Operator Kernel Emissions (SMOKE) Modeling
C                System
C File: @(#)$Id: geofac.f,v 1.10 2007/07/11 19:18:32 bbaek Exp $
C
C COPYRIGHT (C) 2004, Environmental Modeling for Policy Development
C All Rights Reserved
C 
C Carolina Environmental Program
C University of North Carolina at Chapel Hill
C 137 E. Franklin St., CB# 6116
C Chapel Hill, NC 27599-6116
C 
C smoke@unc.edu
C
C Pathname: $Source: /nas01/depts/ie/cempd/apps/SMOKE_archive/smoke_archive/smoke/smoke/src/emutil/geofac.f,v $
C Last updated: $Date: 2007/07/11 19:18:32 $ 
C
C*************************************************************************

      USE MODFILESET

      IMPLICIT NONE

C...........   INCLUDES:

        INCLUDE 'IODECL3.EXT'     ! I/O API function declarations
        INCLUDE 'EMCNST3.EXT'     ! Emissions constants
        INCLUDE 'SETDECL.EXT'   !  FileSetAPI function declarations

C...........   EXTERNAL FUNCTIONS and their descriptions:

        INTEGER         GETFLINE
        INTEGER         PROMPTFFILE
        CHARACTER(16)   PROMPTMFILE
        INTEGER         TRIMLEN
        LOGICAL         ENVYN
        EXTERNAL  ENVYN, GETFLINE, PROMPTFFILE, PROMPTMFILE,
     &            TRIMLEN
           
C...........   PARAMETERS and their descriptions:

        CHARACTER(50), PARAMETER ::
     &  CVSW = '$Name SMOKEv4.5_Apr2017$'  ! CVS release tag

        INTEGER, PARAMETER :: NCLASS = 6

C...........  LOCAL VARIABLES

        REAL  TMPFRAC  
        REAL, ALLOCATABLE :: EMIS( :, : )        ! emissions 
        REAL, ALLOCATABLE :: TSUM( :, :, : )         ! species factors
        REAL, ALLOCATABLE :: CFRAC( : )         ! species factors
        REAL, ALLOCATABLE :: TFRAC( :, : )        ! emissions

        CHARACTER*16, ALLOCATABLE :: B4VAR( : )      ! emissions
        CHARACTER*16, ALLOCATABLE :: CAPVAR( : )    ! species factors
        CHARACTER*16, ALLOCATABLE :: CCVAR( : )    ! species factors

        INTEGER  TSTEP                           ! time step
        INTEGER  I, J, K , L, M, N                  ! counters
        INTEGER  LDEV                            ! log file unit number
        INTEGER  RDEV, CDEV                      ! species factors unit number
        INTEGER  IFOUND, ICLASS
        INTEGER  NSPECS                          ! number of species
        INTEGER  HR                              ! hour loop counter
        INTEGER  NLINES, MLINES              ! number of species factors 
        INTEGER  NSTEPS                          ! number of time steps
        INTEGER  IOS                             ! iostat
        INTEGER  SDATE                           ! start date
        INTEGER  STIME                           ! start time
        LOGICAL  LU_PCT_YN
 
        CHARACTER(16)  ENAME         ! logical name for gridded emis input file
        CHARACTER(16)  ONAME         ! logical name for output file
        CHARACTER(300) MESG                        ! message buffer for M3EXIT()

        CHARACTER(16) :: PROGNAME = 'GEN_AFDUST_TFRAC'   !  program name

C***********************************************************************
C   begin body of program

        LDEV = INIT3()

C.........  Write out copyright, version, web address, header info, and prompt
C           to continue running the program.

        CALL INITEM( LDEV, CVSW, PROGNAME )

C.........  Prompt for name of NetCDF input file

        ENAME = PROMPTSET(
     &       'Enter logical name for BELD4 file',
     &        FSREAD3, 'BELD4', PROGNAME )

        IF ( .NOT. DESC3( ENAME ) ) THEN

            MESG = 'Could not get description of file "' //
     &             TRIM( ENAME ) // '"'
            CALL M3EXIT( PROGNAME , 0, 0, MESG, 2 )

        END IF

        LU_PCT_YN = ENVYN ( 'LU_PCT_YN', MESG, .TRUE., IOS )

        RDEV = PROMPTFFILE(
     &           'Enter logical name for BELD4 to capture class file',
     &           .TRUE., .TRUE., 'BELD4TOCAPTURE', PROGNAME )

        NLINES = GETFLINE( RDEV, 'BELD4TOCAPTURE file' )
        WRITE( 6, * ) 'Number of lines BELD4TOCAPTURE = ',NLINES

        ALLOCATE( B4VAR( NLINES-1 ), STAT=IOS )
        CALL CHECKMEM( IOS, 'B4VAR', PROGNAME )

        ALLOCATE( CAPVAR( NLINES-1 ), STAT=IOS )
        CALL CHECKMEM( IOS, 'CAPVAR', PROGNAME )

        READ( RDEV, * )

        DO N = 1, NLINES-1
          READ( RDEV, * )B4VAR( N ), CAPVAR( N ) 
          write( 6, * ) n, B4VAR( N ), CAPVAR( N )

        ENDDO

        CDEV = PROMPTFFILE(
     &           'Enter logical name for capture class fractions file',
     &           .TRUE., .TRUE., 'CAPFRACS', PROGNAME )

        MLINES = GETFLINE( CDEV, 'CAPFRACS file' )
        WRITE( 6, * ) 'Number of lines CAPFRACS = ',MLINES

        ALLOCATE( CCVAR( MLINES-1 ), STAT=IOS )
        CALL CHECKMEM( IOS, 'CCVAR', PROGNAME )

        ALLOCATE( CFRAC( MLINES-1 ), STAT=IOS )
        CALL CHECKMEM( IOS, 'CFRAC', PROGNAME )

        READ( CDEV, * )

        DO N = 1, MLINES-1
          READ( CDEV, * )CCVAR( N ), CFRAC( N )
          write( 6, * ) n, ccvar( N ), cfrac( N )

        ENDDO

C.........  Assign local variables

        TSTEP  = TSTEP3D
        SDATE  = SDATE3D
        STIME  = STIME3D
        NSPECS = NVARS3D
        NSTEPS = MXREC3D

C.........  Allocate memory for emissions

        ALLOCATE( EMIS( NCOLS3D, NROWS3D ), STAT=IOS )
        CALL CHECKMEM( IOS, 'EMIS', PROGNAME )

        ALLOCATE( TFRAC( NCOLS3D, NROWS3D ), STAT=IOS )
        CALL CHECKMEM( IOS, 'TFRAC', PROGNAME )

        ALLOCATE( TSUM( NCOLS3D, NROWS3D, MLINES-1 ), STAT=IOS )
        CALL CHECKMEM( IOS, 'TSUM', PROGNAME )

        TSUM  = 0.0000 ! array
        TFRAC = 0.0000 ! array
        
C.............  Write to screen because WRITE3 only writes to LDEV

          DO  L = 1, NSPECS

            EMIS = 0.0   !  array

C.....................  Read input file for time and species of interest

            IF( .NOT. READ3( ENAME, VNAME3D( L ), 1,
     &                           SDATE, STIME, EMIS ) ) THEN
                    MESG = 'Could not read variable ' //
     &                     TRIM( VNAME3D( L ) ) // ' from file ' //
     &                     TRIM( ENAME )
                    CALL M3EXIT( PROGNAME, SDATE, STIME, MESG, 2 )
            END IF

            IFOUND = -9 
            DO N = 1, NLINES-1 
              IF ( VNAME3D( L ) .EQ. B4VAR( N ) ) THEN
               write( 6, * ) VNAME3D( L )," CLASS FOUND ",CAPVAR( N )
               IFOUND = L
               DO M = 1, MLINES-1
                 IF ( CAPVAR( N ) .EQ. CCVAR( M ) ) THEN
                  ICLASS = M
                 ENDIF
               ENDDO

              ENDIF
            ENDDO

            IF ( IFOUND .LT. 0 ) THEN
              write( 67, * ) VNAME3D( L )," ACK CLASS NOT FOUND " 
            ELSE

             DO I = 1, NCOLS3D
              DO J = 1, NROWS3D
                TSUM( I, J, ICLASS ) = TSUM( I,J, ICLASS ) + EMIS( I, J )
                IF ( LU_PCT_YN ) THEN
                  TMPFRAC = EMIS( I, J ) * 0.01 * CFRAC( ICLASS )
                ELSE
                  TMPFRAC = EMIS( I, J ) * CFRAC( ICLASS )
                ENDIF
                TFRAC( I, J ) = TFRAC( I, J ) + TMPFRAC
              ENDDO
             ENDDO

            ENDIF

           ENDDO

C.........  Open output file

        NVARS3D = MLINES
        DO M = 1, MLINES - 1
         VNAME3D( M ) = CCVAR( M ) 
        ENDDO

        VNAME3D( MLINES ) = 'xportfrac'

        MESG  = 'Output file'
        ONAME = 'OUTFILE'
        ONAME = PROMPTMFILE( MESG, FSUNKN3, ONAME, PROGNAME )

        DO M = 1, MLINES - 1

        IF( .NOT. WRITE3( ONAME, VNAME3D( M ),
     &                    SDATE, STIME, TSUM(:,:,M)) ) THEN

                    MESG = 'Could not write variable ' //
     &                     TRIM( VNAME3D( M ) ) // ' to file ' //
     &                     TRIM( ONAME )
                    CALL M3EXIT( PROGNAME, SDATE, STIME, MESG, 2 )

        END IF

        ENDDO

        IF( .NOT. WRITE3( ONAME, VNAME3D( MLINES ),
     &                    SDATE, STIME, TFRAC ) ) THEN

                    MESG = 'Could not write variable ' //
     &                     TRIM( VNAME3D( MLINES ) ) // ' to file ' //
     &                     TRIM( ONAME )
                    CALL M3EXIT( PROGNAME, SDATE, STIME, MESG, 2 )

        END IF


C.........   End of program:

        CALL M3EXIT( PROGNAME, 0, 0, ' ', 0 )

C******************  FORMAT  STATEMENTS   ******************************

C...........   Error and warning message formats..... 91xxx

C...........   Informational (LOG) message formats... 92xxx

C...........   Formatted file I/O formats............ 93xxx

93000   FORMAT( A, F10.5 ) 

C...........   Internal buffering formats............ 94xxx

        END PROGRAM  GEN_AFDUST_TFRAC
