Files
GEOS-Chem-adjoint-v35-note/code/uvalbedo_mod.f
2018-08-28 00:47:55 -04:00

176 lines
7.3 KiB
Fortran

! $Id: uvalbedo_mod.f,v 1.1 2009/06/09 21:51:51 daven Exp $
MODULE UVALBEDO_MOD
!
!******************************************************************************
! Module UVALBEDO_MOD contains variables and routines for reading the UV
! Albedo data from disk (for use w/ the FAST-J photolysis routines).
! (bmy, 4/19/02, 10/3/05)
!
! Module Variables:
! ============================================================================
! (1 ) UVALBEDO (REAL*8) : Array to hold UV Albedo data from disk
!
! Module Routines:
! ============================================================================
! (1 ) READ_UVALBEDO : Routine to allocate UVALBEDO array and read data
! (2 ) CLEANUP_UVALBEDO : Routine to deallocate UVALBEDO array
!
! GEOS-CHEM modules referenced by biomass_mod.f
! ============================================================================
! (1 ) bpch2_mod.f : Module containing routines for binary punch file I/O
! (2 ) directory_mod.f : Module containing GEOS-CHEM data & met field dirs
! (3 ) error_mod.f : Module containing NaN and other error check routines
! (4 ) transfer_mod.f : Module containing routines to cast & resize arrays
!
! NOTES:
! (1 ) Now read uvalbedo file directly from DATA_DIR/uvalbedo_200111
! subdirectory. (bmy, 4/2/02)
! (2 ) Now divide module header into MODULE PRIVATE, MODULE VARIABLES, and
! MODULE ROUTINES sections. (bmy, 5/28/02)
! (3 ) Now references "error_mod.f" (bmy, 10/15/02)
! (4 ) Minor modification in READ_UVALBEDO (bmy, 3/14/03)
! (5 ) Now references "directory_mod.f" (bmy, 7/20/04)
! (6 ) Bug fix for GCAP grid in READ_UVALBEDO (bmy, 8/16/05)
! (7 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
!******************************************************************************
!
IMPLICIT NONE
!=================================================================
! MODULE VARIABLES
!=================================================================
! Array for UV albedo data
REAL*8, ALLOCATABLE :: UVALBEDO(:,:)
!=================================================================
! MODULE ROUTINES -- follow below the "CONTAINS" statement
!=================================================================
CONTAINS
!------------------------------------------------------------------------------
SUBROUTINE READ_UVALBEDO( MONTH )
!
!******************************************************************************
! Subroutine READ_UVALBEDO reads in UV albedo data from a binary punch
! file for the given grid, model, and month. (bmy, 2/2/00, 10/3/05)
!
! Arguments as Input:
! ==========================================================================
! (1 ) MONTH (INTEGER) : Current month (1-12)
! (2 ) UVALBEDO (REAL*8 ) : Array with UV albedo data
!
! Reference:
! ==========================================================================
! Herman, J.R and Celarier, E.A., "Earth surface reflectivity climatology
! at 340-380 nm from TOMS data", JGR, Vol. 102, D23, pp. 28003-28011,
! Dec 20, 1997.
!
! NOTES:
! (1 ) Call READ_BPCH2 to read in the UV albedo data from the binary punch
! file. (bmy, 2/2/00)
! (2 ) Cosmetic changes (bmy, 3/17/00)
! (3 ) Reference F90 module "bpch2_mod" which contains routine "read_bpch2"
! for reading data from binary punch files (bmy, 6/28/00)
! (4 ) Remove IOS variable -- it wasn't used (bmy, 9/13/00)
! (5 ) Now use GET_TAU0 to return the TAU0 values for 1985. Also use
! TRANSFER_2D from "transfer_mod.f" to copy data from an array of
! size (IGLOB,JGLOB) to an array of size (IIPAR,JJPAR). ARRAY needs
! to be of size (IGLOB,JGLOB). Also updated comments and made
! cosmetic changes. (bmy, 9/26/01)
! (6 ) Removed obsolete code from 9/01 (bmy, 10/24/01)
! (7 ) Now echo FILENAME to the std output (bmy, 11/15/01)
! (8 ) Bundled into "uvalbedo_mod.f" (bmy, 1/15/02)
! (9 ) Now read uvalbedo file directly from DATA_DIR/uvalbedo_200111
! subdirectory. (bmy, 4/2/02)
! (10) Now references ALLOC_ERR from "error_mod.f". Also eliminated obsolete
! code from 4/02. Updated comments, cosmetic changes. (bmy, 10/15/02)
! (11) Now call READ_BPCH2 with QUIET=.TRUE. to suppress printing of extra
! info to stdout. Also made cosmetic changes. (bmy, 3/14/03)
! (12) Now references DATA_DIR from "directory_mod.f" (bmy, 7/20/04)
! (13) Read proper filename for GCAP or GEOS grids (swu, bmy, 8/15/05)
! (14) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
!******************************************************************************
!
! References to F90 modules
USE BPCH2_MOD, ONLY : GET_NAME_EXT_2D, GET_RES_EXT
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
USE DIRECTORY_MOD, ONLY : DATA_DIR
USE ERROR_MOD, ONLY : ALLOC_ERR
USE TRANSFER_MOD, ONLY : TRANSFER_2D
# include "CMN_SIZE" ! Size parameters
! Arguments
INTEGER, INTENT(IN) :: MONTH
! Local Variables
LOGICAL :: FIRST = .TRUE.
INTEGER :: AS
REAL*4 :: ARRAY(IGLOB,JGLOB,1)
REAL*8 :: XTAU
CHARACTER(LEN=255) :: FILENAME
!=================================================================
! READ_UVALBEDO begins here!
!
! Allocate UVALBEDO array on the first call
!=================================================================
IF ( FIRST ) THEN
! Allocate UVALBEDO
ALLOCATE( UVALBEDO( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'UVALBEDO' )
! Zero UVALBEDO
UVALBEDO(:,:) = 0d0
! Reset FIRST flag
FIRST = .FALSE.
ENDIF
!=================================================================
! Read UVALBEDO data from disk
!=================================================================
! Create filename
FILENAME = TRIM( DATA_DIR ) //
& 'uvalbedo_200111/uvalbedo.' // GET_NAME_EXT_2D() //
& '.' // GET_RES_EXT()
! Echo filename
WRITE( 6, 110 ) TRIM( FILENAME )
110 FORMAT( ' - READ_UVALBEDO: Reading ', a )
! Get TAU0 value for first day of the MONTH -- use generic year 1985
XTAU = GET_TAU0( MONTH, 1, 1985 )
! Read data: UV albedos are tracer #1, category name "UVALBEDO"
CALL READ_BPCH2( FILENAME, 'UVALBEDO', 1,
& XTAU, IGLOB, JGLOB,
& 1, ARRAY, QUIET=.TRUE. )
! Transfer data from REAL*4 to REAL*8 and to size (IIPAR,JJPAR)
CALL TRANSFER_2D( ARRAY(:,:,1), UVALBEDO )
! Return to calling program
END SUBROUTINE READ_UVALBEDO
!------------------------------------------------------------------------------
SUBROUTINE CLEANUP_UVALBEDO
!
!******************************************************************************
! Subroutine CLEANUP_UVALBEDO deallocates the UVALBEDO array (bmy, 1/15/02)
!******************************************************************************
!
IF ( ALLOCATED( UVALBEDO ) ) DEALLOCATE( UVALBEDO )
! Return to calling program
END SUBROUTINE CLEANUP_UVALBEDO
!------------------------------------------------------------------------------
END MODULE UVALBEDO_MOD