405 lines
14 KiB
Fortran
405 lines
14 KiB
Fortran
!$Id: population_mod.f,v 1.1 2012/03/01 22:00:27 daven Exp $
|
|
MODULE POPULATION_MOD
|
|
!
|
|
!******************************************************************************
|
|
! Module POPULATION_MOD contains code for incorporating population weighting
|
|
! into cost functions / exposure metrics. Population data taken from:
|
|
!
|
|
! Center for International Earth Science Information Network (CIESIN),
|
|
! Columbia University; and Centro Internacional de Agricultura Tropical
|
|
! (CIAT). 2005. Gridded Population of the World, Version 3 (GPWv3):
|
|
! Population Count Grid. Palisades, NY: Socioeconomic Data and Applications
|
|
! Center (SEDAC), Columbia University.
|
|
! Available at http://sedac.ciesin.columbia.edu/gpw. 2/11/2012.
|
|
!
|
|
! Steven Vogel, jk, dkh, 02/04/2012, adj32_024
|
|
!
|
|
! Module Variables:
|
|
! ============================================================================
|
|
! (1 ) POP_REDUCED (REAL*8) : Array of census population
|
|
!
|
|
! Module Routines:
|
|
! ===========================================================================
|
|
! (1 ) POP_WEIGHT_COST : Computes population weighted cost function
|
|
! (2 ) READ_IN_POPULATION : Reads in gridded population data file
|
|
! (3 ) INIT_POPULATOIN_MOD : Allocates & zeroes module arrays
|
|
! (4 ) CLEANUP_POPULATION_MOD : Deallocates module arrays
|
|
!
|
|
! NOTES:
|
|
!
|
|
!*****************************************************************************
|
|
IMPLICIT NONE
|
|
|
|
PUBLIC
|
|
|
|
!=================================================================
|
|
! MODULE VARIABLES
|
|
!=================================================================
|
|
REAL*8, ALLOCATABLE :: POP_REDUCED(:,:)
|
|
|
|
!=================================================================
|
|
! MODULE ROUTINES -- follow below the "CONTAINS" statement
|
|
!=================================================================
|
|
CONTAINS
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE POP_WEIGHT_COST
|
|
!
|
|
!******************************************************************************
|
|
! This subroutine based on CALC_ADJ_FORCE_FOR_SENSE in geos_chem_adj_mod.f
|
|
! Calculates population weighted cost function when called in
|
|
! geos_chem_adj_mod.f
|
|
!
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE ADJ_ARRAYS_MOD, ONLY : N_CALC, COST_FUNC
|
|
USE ADJ_ARRAYS_MOD, ONLY : STT_ADJ
|
|
USE ADJ_ARRAYS_MOD, ONLY : GET_CF_REGION
|
|
USE ADJ_ARRAYS_MOD, ONLY : NSPAN
|
|
USE ADJ_ARRAYS_MOD, ONLY : OBS_THIS_TRACER
|
|
USE ADJ_ARRAYS_MOD, ONLY : NOBS
|
|
USE ADJ_ARRAYS_MOD, ONLY : TRACER_IND
|
|
USE CHECKPT_MOD, ONLY : CHK_STT
|
|
USE DAO_MOD, ONLY : AIRVOL, AD
|
|
USE LOGICAL_MOD, ONLY : LPRT
|
|
USE TRACER_MOD, ONLY : N_TRACERS
|
|
USE GRID_MOD, ONLY : GET_XMID, GET_YMID
|
|
|
|
! Header files
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
! Local variables
|
|
REAL*8 :: ADJ_FORCE(IIPAR,JJPAR,LLPAR,N_TRACERS)
|
|
INTEGER :: I, J, N, NN
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
|
|
REAL*8, DIMENSION(IIPAR,JJPAR,NOBS) :: COST_NUMM
|
|
REAL*8, DIMENSION(IIPAR,JJPAR) :: DENOMM_POP
|
|
REAL*8, DIMENSION(IIPAR,JJPAR) :: DENOMM_VOL
|
|
REAL*4, DIMENSION(IIPAR,JJPAR) :: N_INCLUDE
|
|
REAL*8 :: NEW_COST_SCALAR
|
|
REAL*8 :: POP_TOT
|
|
REAL*8 :: VOL_TOT
|
|
REAL*8 :: N_TOT
|
|
REAL*8 :: FACTORR
|
|
|
|
!=================================================================
|
|
! POP_WEIGHT_COST begins here!
|
|
!=================================================================
|
|
|
|
! Get population data
|
|
IF ( FIRST ) THEN
|
|
|
|
CALL INIT_POPULATION_MOD
|
|
CALL READ_IN_POPULATION
|
|
|
|
! replace NOBS2STT with TRACER_IND
|
|
|
|
FIRST = .FALSE.
|
|
|
|
ENDIF
|
|
|
|
IF ( LPRT ) THEN
|
|
print*, 'SEV DEBUG = ', maxval(POP_REDUCED)
|
|
print*, 'SEV DEBUG = ', minval(POP_REDUCED)
|
|
ENDIF
|
|
|
|
! Initialze cost fnc variables
|
|
NEW_COST_SCALAR = 0d0
|
|
COST_NUMM = 0d0
|
|
DENOMM_POP = 0d0
|
|
DENOMM_VOL = 0d0
|
|
N_INCLUDE = 0e0
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, N, NN )
|
|
DO N = 1, NOBS
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
NN = TRACER_IND(N)
|
|
|
|
! Determine the contribution to the cost function in each grid cell
|
|
! from each species
|
|
COST_NUMM(I,J,N) = GET_CF_REGION(I,J,1)
|
|
& * CHK_STT(I,J,1,NN)
|
|
& * POP_REDUCED(I,J)
|
|
|
|
! Set denominator population and volume
|
|
IF ( N == 1 .and. GET_CF_REGION(I,J,1) > 0d0
|
|
& .and. POP_REDUCED(I,J) > 0d0 ) THEN
|
|
|
|
DENOMM_POP(I,J) =
|
|
& POP_REDUCED(I,J) * GET_CF_REGION(I,J,1)
|
|
|
|
DENOMM_VOL(I,J) =
|
|
& AIRVOL(I,J,1) * GET_CF_REGION(I,J,1)
|
|
|
|
N_INCLUDE(I,J) = 1e0
|
|
|
|
! For debugging:
|
|
! WRITE(55,100) I, J, GET_XMID(I), GET_YMID(J), POP_REDUCED(I,J),
|
|
! & AIRVOL(I,J,1), CHK_STT(I,J,1,27),
|
|
! & CHK_STT(I,J,1,31), CHK_STT(I,J,1,32), CHK_STT(I,J,1,34:37)
|
|
! 100 FORMAT(1X,I6,1X,I6,1X,F16.8,1X,F16.8,1X,E16.8,1X,E16.8,1X,F16.8,1X,
|
|
! & F16.8,1X, F16.8,1X, F16.8,1X,F16.8,1X,F16.8,1X,F16.8)
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
POP_TOT = SUM(DENOMM_POP)
|
|
VOL_TOT = SUM(DENOMM_VOL)
|
|
N_TOT = SUM(N_INCLUDE)
|
|
|
|
print*, 'SEV DEBUG TOTAL VOLUME = ', VOL_TOT
|
|
print*, 'SEV DEBUG TOTAL POP = ', POP_TOT
|
|
print*, 'SEV DEBUG TOTAL N = ', N_TOT
|
|
#if defined ( GRID2x25 )
|
|
print*, 'SEV DEBUG DENOM POP= ', DENOMM_POP(117,64)
|
|
#endif
|
|
|
|
FACTORR = 1d9 / ( POP_TOT * VOL_TOT * NSPAN ) * N_TOT
|
|
|
|
NEW_COST_SCALAR = SUM(COST_NUMM(:,:,:)) * FACTORR
|
|
|
|
! Update cost function
|
|
COST_FUNC = COST_FUNC + NEW_COST_SCALAR
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, N, NN )
|
|
DO N = 1, NOBS
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
NN = TRACER_IND(N)
|
|
|
|
! Force the adjoint variables x with dJ/dx=1
|
|
ADJ_FORCE(I,J,1,NN) = GET_CF_REGION(I,J,1)
|
|
& * POP_REDUCED(I,J)
|
|
& * FACTORR
|
|
|
|
STT_ADJ(I,J,1,NN) = STT_ADJ(I,J,1,NN) + ADJ_FORCE(I,J,1,NN)
|
|
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE POP_WEIGHT_COST
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE READ_IN_POPULATION
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine READ_IN_POPULATION reads in gridded population data.
|
|
! by Steven Vogel, based on code from Jamin Koo (dkh, 02/13/12, adj32_024)
|
|
!
|
|
! NOTES:
|
|
!
|
|
!******************************************************************************
|
|
!
|
|
|
|
! References to F90 modules
|
|
USE BPCH2_MOD, ONLY : GET_RES_EXT
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR
|
|
USE LOGICAL_MOD, ONLY : LPRT
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
! Local variables
|
|
CHARACTER(LEN=255) :: FNAME
|
|
INTEGER :: IOS, IOS2
|
|
|
|
!=================================================================
|
|
! READ_IN_POPULATION begins here!
|
|
!=================================================================
|
|
|
|
! Generate population data filename
|
|
FNAME = TRIM( DATA_DIR ) // 'population_201202/' //
|
|
& 'world_population.' // GET_RES_EXT()
|
|
|
|
! Read the population from ascii file.
|
|
WRITE( 6, '(a)' ) ' Reading in population from ', FNAME
|
|
|
|
OPEN( UNIT=11, FILE=FNAME, STATUS='OLD', IOSTAT=IOS)
|
|
|
|
IF ( IOS /= 0 ) THEN
|
|
CALL ERROR_STOP('ERROR opening weight' ,
|
|
& 'READ_IN_POPULATION, population_mod.f')
|
|
ELSE
|
|
READ( UNIT=11, FMT=*, IOSTAT=IOS2 ) POP_REDUCED
|
|
IF ( IOS2 < 0 ) THEN
|
|
CALL ERROR_STOP( 'Unexpected End of File encountered',
|
|
& 'READ_IN_POPULATION, population_mod.f')
|
|
ELSE IF ( IOS > 0 ) THEN
|
|
CALL ERROR_STOP( 'Error occurred reading pop data!',
|
|
& 'READ_IN_POPULATION, population_mod.f')
|
|
ENDIF
|
|
ENDIF
|
|
|
|
CLOSE( UNIT=10 )
|
|
|
|
IF ( LPRT ) THEN
|
|
PRINT *, 'sum of population', sum(POP_REDUCED)
|
|
PRINT *, 'Population Grid Test Max', maxval(POP_REDUCED)
|
|
PRINT *, 'Population Grid Test Min', minval(POP_REDUCED)
|
|
PRINT *, 'Population Grid Test Size', size(POP_REDUCED)
|
|
ENDIF
|
|
|
|
!CALL MAKE_POP_FILE()
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE READ_IN_POPULATION
|
|
|
|
!------------------------------------------------------------------------------
|
|
SUBROUTINE MAKE_POP_FILE( )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine MAKE_POP_FILE creates binary world population file.
|
|
! (dkh, 9/01/04)
|
|
!
|
|
!******************************************************************************
|
|
! References to F90 modules
|
|
USE BPCH2_MOD
|
|
USE ERROR_MOD, ONLY : DEBUG_MSG
|
|
USE FILE_MOD, ONLY : IU_RST, IOERROR
|
|
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
|
|
USE LOGICAL_MOD, ONLY : LPRT
|
|
USE TIME_MOD, ONLY : GET_TAU
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
! Local Variables
|
|
INTEGER :: I, I0, IOS, J, J0, L, N
|
|
INTEGER :: YYYY, MM, DD, HH, SS
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
! For binary punch file, version 2.0
|
|
REAL*4 :: LONRES, LATRES
|
|
INTEGER, PARAMETER :: HALFPOLAR = 1
|
|
INTEGER, PARAMETER :: CENTER180 = 1
|
|
|
|
CHARACTER(LEN=20) :: MODELNAME
|
|
CHARACTER(LEN=40) :: CATEGORY
|
|
CHARACTER(LEN=40) :: UNIT
|
|
CHARACTER(LEN=40) :: RESERVED = ''
|
|
CHARACTER(LEN=80) :: TITLE
|
|
|
|
|
|
!=================================================================
|
|
! MAKE_POP_FILE begins here!
|
|
!=================================================================
|
|
|
|
! Define variables for BINARY PUNCH FILE OUTPUT
|
|
TITLE = 'GEOS-CHEM OBS File: ' //
|
|
& 'Observation Concentrations (kg/box)'
|
|
UNIT = 'people'
|
|
CATEGORY = 'IJ-POP-$'
|
|
LONRES = DISIZE
|
|
LATRES = DJSIZE
|
|
|
|
! Call GET_MODELNAME to return the proper model name for
|
|
! the given met data being used (bmy, 6/22/00)
|
|
MODELNAME = GET_MODELNAME()
|
|
|
|
! Get the nested-grid offsets
|
|
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
|
|
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
|
|
|
|
!=================================================================
|
|
! Open the observation file for output -- binary punch format
|
|
!=================================================================
|
|
|
|
! Copy the output observation file name into a local variable
|
|
FILENAME = TRIM( 'pop.bpch' )
|
|
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - MAKE_POP_FILE: Writing ', a )
|
|
|
|
! Open checkpoint file for output
|
|
CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
|
|
|
|
!=================================================================
|
|
! Write pop
|
|
!=================================================================
|
|
|
|
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
|
|
& HALFPOLAR, CENTER180, CATEGORY, 1,
|
|
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
|
|
& IIPAR, JJPAR, 1, I0+1,
|
|
& J0+1, 1, REAL(POP_REDUCED,4) )
|
|
|
|
|
|
! Close file
|
|
CLOSE( IU_RST )
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### MAKE_POP_FILE: wrote file' )
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE MAKE_POP_FILE
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE INIT_POPULATION_MOD
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine INIT_POPULATION_MOD initializes and zeros all allocatable arrays
|
|
! declared in "population_mod.f"
|
|
!
|
|
! NOTES:
|
|
!
|
|
!******************************************************************************
|
|
!
|
|
! Reference to f90 modules
|
|
USE ADJ_ARRAYS_MOD, ONLY : NOBS
|
|
USE ERROR_MOD, ONLY : ALLOC_ERR
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
! local variables
|
|
INTEGER :: AS
|
|
|
|
!=================================================================
|
|
! INIT_POPULATION_MOD
|
|
!=================================================================
|
|
|
|
ALLOCATE( POP_REDUCED(IIPAR,JJPAR) , STAT = AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'POP_REDUCED' )
|
|
POP_REDUCED = 0d0
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE INIT_POPULATION_MOD
|
|
|
|
!-----------------------------------------------------------------------------
|
|
SUBROUTINE CLEANUP_POPULATION_MOD
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine CLEANUP_POPULATION_MOD deallocates all previously allocated arrays
|
|
!
|
|
! NOTES:
|
|
!
|
|
!******************************************************************************
|
|
!
|
|
!=================================================================
|
|
! CLEANUP_POPULATION_MOD begins here!
|
|
!=================================================================
|
|
IF ( ALLOCATED( POP_REDUCED ) ) DEALLOCATE( POP_REDUCED )
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE CLEANUP_POPULATION_MOD
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
END MODULE POPULATION_MOD
|