Add files via upload
This commit is contained in:
Xuesong (Steve)
664
code/xtra_read_mod.f
Normal file
664
code/xtra_read_mod.f
Normal file
@ -0,0 +1,664 @@
|
||||
! $ Id: xtra_read_mod.f v2.2 2005/4/20 21:17:00 tmf Exp $
|
||||
MODULE XTRA_READ_MOD
|
||||
!
|
||||
!******************************************************************************
|
||||
! Module XTRA_READ_MOD contains routines that unzip, open, and read the
|
||||
! GEOS-CHEM XTRA (avg 3-hour) met fields from disk. (dsa, tmf, bmy, 10/20/05)
|
||||
!
|
||||
! Module Routines:
|
||||
! =========================================================================
|
||||
! (1 ) UNZIP_XTRA_FIELDS : Unzips & copies met field files to a temp dir
|
||||
! (2 ) DO_OPEN_XTRA : Returns TRUE if it's time to read XTRA fields
|
||||
! (3 ) OPEN_XTRA_FIELDS : Opens met field files residing in the temp dir
|
||||
! (4 ) GET_XTRA_FIELDS : Wrapper for routine READ_XTRA
|
||||
! (5 ) GET_N_XTRA : Returns # of XTRA fields for each DAO data set
|
||||
! (6 ) CHECK_TIME : Tests if XTRA met field timestamps = current time
|
||||
! (7 ) READ_XTRA : Reads XTRA fields from disk
|
||||
! (8 ) XTRA_CHECK : Checks if we have found all of the XTRA fields
|
||||
!
|
||||
! GEOS-CHEM modules referenced by xtra_read_mod.f
|
||||
! ============================================================================
|
||||
! (1 ) bpch2_mod.f : Module w/ routines for binary punch file I/O
|
||||
! (2 ) dao_mod.f : Module w/ arrays for DAO met fields
|
||||
! (3 ) diag_mod.f : Module w/ GEOS-CHEM diagnostic arrays
|
||||
! (4 ) directory_mod.f : Module w/ GEOS-CHEM data & met field dirs
|
||||
! (5 ) error_mod.f : Module w/ NaN and other error check routines
|
||||
! (6 ) logical_mod.f : Module w/ GEOS-CHEM logical switches
|
||||
! (7 ) file_mod.f : Module w/ file unit #'s and error checks
|
||||
! (8 ) time_mod.f : Module w/ routines for computing time & date
|
||||
! (9 ) transfer_mod.f : Module w/ routines to cast & resize arrays
|
||||
! (10) unix_cmds_mod.f : Module w/ Unix commands for unzipping etc.
|
||||
!
|
||||
! NOTES:
|
||||
!******************************************************************************
|
||||
!
|
||||
IMPLICIT NONE
|
||||
|
||||
!=================================================================
|
||||
! MODULE PRIVATE DECLARATIONS -- keep certain internal variables
|
||||
! and routines from being seen outside "xtra_read_mod.f"
|
||||
!=================================================================
|
||||
|
||||
! Make everything PRIVATE ...
|
||||
PRIVATE
|
||||
|
||||
! ... except these routines
|
||||
PUBLIC :: GET_XTRA_FIELDS
|
||||
PUBLIC :: OPEN_XTRA_FIELDS
|
||||
PUBLIC :: UNZIP_XTRA_FIELDS
|
||||
|
||||
!=================================================================
|
||||
! MODULE ROUTINES -- follow below the "CONTAINS" statement
|
||||
!=================================================================
|
||||
CONTAINS
|
||||
|
||||
!------------------------------------------------------------------------------
|
||||
|
||||
SUBROUTINE UNZIP_XTRA_FIELDS( OPTION, NYMD )
|
||||
!
|
||||
!*****************************************************************************
|
||||
! Subroutine UNZIP_XTRA_FIELDS invokes a FORTRAN system call to uncompress
|
||||
! GEOS-CHEM GEOS-3 XTRA met field files and store the uncompressed data in a
|
||||
! temporary directory, where GEOS-CHEM can read them. The original data
|
||||
! files are not disturbed. (dsa, tmf, bmy, 10/20/05)
|
||||
!
|
||||
! Arguments as input:
|
||||
! ===========================================================================
|
||||
! (1 ) OPTION (CHAR*(*)) : Option
|
||||
! (2 ) NYMD (INTEGER ) : YYYYMMDD of XTRA file to be unzipped (optional)
|
||||
!
|
||||
! NOTES:
|
||||
!*****************************************************************************
|
||||
!
|
||||
! References to F90 modules
|
||||
USE BPCH2_MOD, ONLY : GET_RES_EXT
|
||||
USE DIRECTORY_MOD, ONLY : DATA_DIR, GEOS_3_DIR, TEMP_DIR
|
||||
USE ERROR_MOD, ONLY : ERROR_STOP
|
||||
USE TIME_MOD, ONLY : EXPAND_DATE
|
||||
USE UNIX_CMDS_MOD, ONLY : BACKGROUND, REDIRECT, REMOVE_CMD
|
||||
USE UNIX_CMDS_MOD, ONLY : UNZIP_CMD, WILD_CARD, ZIP_SUFFIX
|
||||
|
||||
# include "CMN_SIZE"
|
||||
|
||||
! Arguments
|
||||
CHARACTER(LEN=*), INTENT(IN) :: OPTION
|
||||
INTEGER, OPTIONAL, INTENT(IN) :: NYMD
|
||||
|
||||
! Local variables
|
||||
CHARACTER(LEN=255) :: XTRA_STR, GEOS_DIR
|
||||
CHARACTER(LEN=255) :: XTRA_FILE_GZ, XTRA_FILE
|
||||
CHARACTER(LEN=255) :: UNZIP_BG, UNZIP_FG
|
||||
CHARACTER(LEN=255) :: REMOVE_ALL, REMOVE_DATE
|
||||
|
||||
!=================================================================
|
||||
! UNZIP_XTRA_FIELDS begins here!
|
||||
!=================================================================
|
||||
IF ( PRESENT( NYMD ) ) THEN
|
||||
|
||||
! Strings for directory & filename
|
||||
GEOS_DIR = TRIM( GEOS_3_DIR )
|
||||
XTRA_STR = 'YYYYMMDD.xtra.' // GET_RES_EXT()
|
||||
|
||||
! Replace date tokens
|
||||
CALL EXPAND_DATE( GEOS_DIR, NYMD, 000000 )
|
||||
CALL EXPAND_DATE( XTRA_STR, NYMD, 000000 )
|
||||
|
||||
! Location of zipped XTRA file in data dir
|
||||
XTRA_FILE_GZ = TRIM( DATA_DIR ) // TRIM( GEOS_DIR ) //
|
||||
& TRIM( XTRA_STR ) // TRIM( ZIP_SUFFIX )
|
||||
|
||||
! Location of unzipped XTRA file in temp dir
|
||||
XTRA_FILE = TRIM( TEMP_DIR ) // TRIM( XTRA_STR )
|
||||
|
||||
! Remove XTRA files for this date from temp dir
|
||||
REMOVE_DATE = TRIM( REMOVE_CMD ) // ' ' //
|
||||
& TRIM( TEMP_DIR ) // TRIM( XTRA_STR )
|
||||
|
||||
!==============================================================
|
||||
! Define the foreground and background UNZIP commands
|
||||
!==============================================================
|
||||
|
||||
! Foreground unzip
|
||||
UNZIP_FG = TRIM( UNZIP_CMD ) // ' ' // TRIM( XTRA_FILE_GZ ) //
|
||||
& TRIM( REDIRECT ) // ' ' // TRIM( XTRA_FILE )
|
||||
|
||||
! Background unzip
|
||||
UNZIP_BG = TRIM( UNZIP_FG ) // TRIM( BACKGROUND )
|
||||
ENDIF
|
||||
|
||||
!=================================================================
|
||||
! Define command to remove all XTRA files from the TEMP dir
|
||||
!=================================================================
|
||||
REMOVE_ALL = TRIM( REMOVE_CMD ) // ' ' // TRIM( TEMP_DIR ) //
|
||||
& TRIM( WILD_CARD ) // '.xtra.' // TRIM( WILD_CARD )
|
||||
|
||||
!=================================================================
|
||||
! Perform an F90 system call to do the desired operation
|
||||
!=================================================================
|
||||
SELECT CASE ( TRIM( OPTION ) )
|
||||
|
||||
! Unzip XTRA fields in the Unix foreground
|
||||
CASE ( 'unzip foreground' )
|
||||
WRITE( 6, 100 ) TRIM( XTRA_FILE_GZ )
|
||||
CALL SYSTEM( TRIM( UNZIP_FG ) )
|
||||
|
||||
! Unzip XTRA fields in the Unix background
|
||||
CASE ( 'unzip background' )
|
||||
WRITE( 6, 100 ) TRIM( XTRA_FILE_GZ )
|
||||
CALL SYSTEM( TRIM( UNZIP_BG ) )
|
||||
|
||||
! Remove XTRA field for this date in temp dir
|
||||
CASE ( 'remove date' )
|
||||
WRITE( 6, 110 ) TRIM( XTRA_FILE )
|
||||
CALL SYSTEM( TRIM( REMOVE_DATE ) )
|
||||
|
||||
! Remove all XTRA fields in temp dir
|
||||
CASE ( 'remove all' )
|
||||
WRITE( 6, 120 ) TRIM( REMOVE_ALL )
|
||||
CALL SYSTEM( TRIM( REMOVE_ALL ) )
|
||||
|
||||
! Error -- bad option!
|
||||
CASE DEFAULT
|
||||
CALL ERROR_STOP( 'Invalid value for OPTION!',
|
||||
& 'UNZIP_XTRA_FIELDS (xtra_read_mod.f)' )
|
||||
|
||||
END SELECT
|
||||
|
||||
! FORMAT strings
|
||||
100 FORMAT( ' - Unzipping: ', a )
|
||||
110 FORMAT( ' - Removing: ', a )
|
||||
120 FORMAT( ' - About to execute command: ', a )
|
||||
|
||||
! Return to calling program
|
||||
END SUBROUTINE UNZIP_XTRA_FIELDS
|
||||
|
||||
!------------------------------------------------------------------------------
|
||||
|
||||
FUNCTION DO_OPEN_XTRA( NYMD, NHMS ) RESULT( DO_OPEN )
|
||||
!
|
||||
!******************************************************************************
|
||||
! Function DO_OPEN_XTRA returns TRUE if is time to open the XTRA met field
|
||||
! file or FALSE otherwise. This prevents us from opening a file which has
|
||||
! already been opened. (dsa, tmf, bmy, 10/20/05)
|
||||
!
|
||||
! Arguments as Input:
|
||||
! ============================================================================
|
||||
! (1 ) NYMD (INTEGER) : YYYYMMDD
|
||||
! (2 ) NHMS (INTEGER) : and HHMMSS to be tested for A-3 file open
|
||||
!
|
||||
! NOTES:
|
||||
!******************************************************************************
|
||||
!
|
||||
! Arguments
|
||||
INTEGER, INTENT(IN) :: NYMD, NHMS
|
||||
|
||||
! Local variables
|
||||
LOGICAL :: DO_OPEN
|
||||
LOGICAL, SAVE :: FIRST = .TRUE.
|
||||
INTEGER, SAVE :: LASTNYMD = -1
|
||||
INTEGER, SAVE :: LASTNHMS = -1
|
||||
|
||||
!=================================================================
|
||||
! DO_OPEN_XTRA begins here!
|
||||
!=================================================================
|
||||
|
||||
! Initialize
|
||||
DO_OPEN = .FALSE.
|
||||
|
||||
! Return if we have already opened the file
|
||||
IF ( NYMD == LASTNYMD .and. NHMS == LASTNHMS ) THEN
|
||||
DO_OPEN = .FALSE.
|
||||
GOTO 999
|
||||
ENDIF
|
||||
|
||||
! Open XTRA file if it's 00:00 GMT, or on the first call
|
||||
IF ( NHMS == 000000 .or. FIRST ) THEN
|
||||
DO_OPEN = .TRUE.
|
||||
GOTO 999
|
||||
ENDIF
|
||||
|
||||
!=================================================================
|
||||
! Reset quantities for next call
|
||||
!=================================================================
|
||||
999 CONTINUE
|
||||
LASTNYMD = NYMD
|
||||
LASTNHMS = NHMS
|
||||
FIRST = .FALSE.
|
||||
|
||||
! Return to calling program
|
||||
END FUNCTION DO_OPEN_XTRA
|
||||
|
||||
!------------------------------------------------------------------------------
|
||||
|
||||
SUBROUTINE OPEN_XTRA_FIELDS( NYMD, NHMS )
|
||||
!
|
||||
!******************************************************************************
|
||||
! Subroutine OPEN_XTRA_FIELDS opens the XTRA met fields file for date NYMD
|
||||
! and time NHMS. (dsa, tmf, bmy, 10/20/05)
|
||||
!
|
||||
! Arguments as input:
|
||||
! ===========================================================================
|
||||
! (1 ) NYMD (INTEGER) : YYYYMMDD
|
||||
! (2 ) NHMS (INTEGER) : and HHMMSS timestamps for XTRA file
|
||||
!
|
||||
! NOTES:
|
||||
!******************************************************************************
|
||||
!
|
||||
! References to F90 modules
|
||||
USE BPCH2_MOD, ONLY : GET_RES_EXT
|
||||
USE DIRECTORY_MOD, ONLY : DATA_DIR, GEOS_3_DIR, TEMP_DIR
|
||||
USE ERROR_MOD, ONLY : ERROR_STOP
|
||||
USE LOGICAL_MOD, ONLY : LUNZIP
|
||||
USE FILE_MOD, ONLY : IU_XT, IOERROR, FILE_EXISTS
|
||||
USE TIME_MOD, ONLY : EXPAND_DATE
|
||||
|
||||
# include "CMN_SIZE" ! Size parameters
|
||||
|
||||
! Arguments
|
||||
INTEGER, INTENT(IN) :: NYMD, NHMS
|
||||
|
||||
! Local variables
|
||||
LOGICAL :: DO_OPEN
|
||||
LOGICAL :: IT_EXISTS
|
||||
INTEGER :: IOS
|
||||
CHARACTER(LEN=8) :: IDENT
|
||||
CHARACTER(LEN=255) :: XTRA_FILE
|
||||
CHARACTER(LEN=255) :: GEOS_DIR
|
||||
CHARACTER(LEN=255) :: PATH
|
||||
|
||||
!=================================================================
|
||||
! OPEN_XTRA_FIELDS begins here!
|
||||
!=================================================================
|
||||
|
||||
! Open XTRA fields at the proper time, or on the first call
|
||||
IF ( DO_OPEN_XTRA( NYMD, NHMS ) ) THEN
|
||||
|
||||
! Strings for directory & filename
|
||||
GEOS_DIR = TRIM( GEOS_3_DIR )
|
||||
XTRA_FILE = 'YYYYMMDD.xtra.' // GET_RES_EXT()
|
||||
|
||||
! Replace date tokens
|
||||
CALL EXPAND_DATE( XTRA_FILE, NYMD, NHMS )
|
||||
CALL EXPAND_DATE( GEOS_DIR, NYMD, NHMS )
|
||||
|
||||
! If unzipping, open GEOS-4 file in TEMP dir
|
||||
! If not unzipping, open GEOS-4 file in DATA dir
|
||||
IF ( LUNZIP ) THEN
|
||||
PATH = TRIM( TEMP_DIR ) // TRIM( XTRA_FILE )
|
||||
ELSE
|
||||
PATH = TRIM( DATA_DIR ) //
|
||||
& TRIM( GEOS_DIR ) // TRIM( XTRA_FILE )
|
||||
ENDIF
|
||||
|
||||
! Close previously opened XTRA file
|
||||
CLOSE( IU_XT )
|
||||
|
||||
! Make sure the file unit is valid before we open the file
|
||||
IF ( .not. FILE_EXISTS( IU_XT ) ) THEN
|
||||
CALL ERROR_STOP( 'Could not find file!',
|
||||
& 'OPEN_XTRA_FIELDS (xtra_read_mod.f)' )
|
||||
ENDIF
|
||||
|
||||
! Open the file
|
||||
OPEN( UNIT = IU_XT, FILE = TRIM( PATH ),
|
||||
& STATUS = 'OLD', ACCESS = 'SEQUENTIAL',
|
||||
& FORM = 'UNFORMATTED', IOSTAT = IOS )
|
||||
|
||||
IF ( IOS /= 0 ) THEN
|
||||
CALL IOERROR( IOS, IU_XT, 'open_xtra_fields:1' )
|
||||
ENDIF
|
||||
|
||||
! Echo info
|
||||
WRITE( 6, 100 ) TRIM( PATH )
|
||||
100 FORMAT( ' - Opening: ', a )
|
||||
|
||||
ENDIF
|
||||
|
||||
! Return to calling program
|
||||
END SUBROUTINE OPEN_XTRA_FIELDS
|
||||
|
||||
!------------------------------------------------------------------------------
|
||||
|
||||
SUBROUTINE GET_XTRA_FIELDS( NYMD, NHMS )
|
||||
!
|
||||
!******************************************************************************
|
||||
! Subroutine GET_XTRA_FIELDS is a wrapper for routine READ_XTRA.
|
||||
! GET_XTRA_FIELDS calls READ_XTRA properly for reading the GEOS-3 met data
|
||||
! set. (dsa, tmf, bmy, 10/20/05)
|
||||
!
|
||||
! Arguments as Input:
|
||||
! ============================================================================
|
||||
! (1 ) NYMD (INTEGER) : YYYYMMDD
|
||||
! (2 ) NHMS (INTEGER) : and HHMMSS of XTRA fields to be read from disk
|
||||
!
|
||||
! NOTES:
|
||||
! (1 ) Now extract only PARDR, PARDF for MEGAN biogenics inventory and SNOW
|
||||
! for dust emissions from GEOS3. (tmf, 6/23/05)
|
||||
!******************************************************************************
|
||||
!
|
||||
! References to F90 modules
|
||||
USE DAO_MOD, ONLY : PARDR, PARDF, SNOW
|
||||
USE FILE_MOD, ONLY : IU_XT
|
||||
|
||||
# include "CMN_SIZE" ! Size parameters
|
||||
|
||||
! Arguments
|
||||
INTEGER, INTENT(IN) :: NYMD, NHMS
|
||||
|
||||
! Local variables
|
||||
INTEGER, SAVE :: LASTNYMD = -1, LASTNHMS = -1
|
||||
|
||||
!=================================================================
|
||||
! GET_XTRA_FIELDS begins here!
|
||||
!=================================================================
|
||||
|
||||
! Skip over previously-read XTRA fields
|
||||
IF ( NYMD == LASTNYMD .and. NHMS == LASTNHMS ) THEN
|
||||
WRITE( 6, 100 ) NYMD, NHMS
|
||||
100 FORMAT( ' - XTRA met fields for NYMD, NHMS = ',
|
||||
& i8.8, 1x, i6.6, ' have been read already' )
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
! Read PARDR, PARDF fields
|
||||
CALL READ_XTRA( NYMD=NYMD, NHMS=NHMS,
|
||||
& PARDR=PARDR, PARDF=PARDF, SNOW=SNOW )
|
||||
|
||||
! Save NYMD, NHMS for next call
|
||||
LASTNYMD = NYMD
|
||||
LASTNHMS = NHMS
|
||||
|
||||
! Return to MAIN program
|
||||
END SUBROUTINE GET_XTRA_FIELDS
|
||||
|
||||
!---------------------------------------------------------------------------
|
||||
|
||||
FUNCTION CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) RESULT( ITS_TIME )
|
||||
!
|
||||
!******************************************************************************
|
||||
! Function CHECK_TIME checks to see if the timestamp of the XTRA field just
|
||||
! read from disk matches the current time. If so, then it's time to return
|
||||
! the XTRA field to the calling program. (dsa, tmf, bmy, 10/20/05)
|
||||
!
|
||||
! Arguments as Input:
|
||||
! ============================================================================
|
||||
! (1 ) XYMD (REAL*4 or INTEGER) : (YY)YYMMDD timestamp for A-3 field in file
|
||||
! (2 ) XHMS (REAL*4 or INTEGER) : HHMMSS timestamp for A-3 field in file
|
||||
! (3 ) NYMD (INTEGER ) : YYYYMMDD at which A-3 field is to be read
|
||||
! (4 ) NHMS (INTEGER ) : HHMMSS at which A-3 field is to be read
|
||||
!
|
||||
! NOTES:
|
||||
!******************************************************************************
|
||||
!
|
||||
# include "CMN_SIZE"
|
||||
|
||||
! Arguments
|
||||
INTEGER, INTENT(IN) :: XYMD, XHMS, NYMD, NHMS
|
||||
|
||||
! Function value
|
||||
LOGICAL :: ITS_TIME
|
||||
|
||||
!=================================================================
|
||||
! GEOS-3, GEOS-4: XYMD and XHMS are integers
|
||||
!=================================================================
|
||||
IF ( XYMD == NYMD .AND. XHMS == NHMS ) THEN
|
||||
ITS_TIME = .TRUE.
|
||||
ELSE
|
||||
ITS_TIME = .FALSE.
|
||||
ENDIF
|
||||
|
||||
! Return to calling program
|
||||
END FUNCTION CHECK_TIME
|
||||
|
||||
!-----------------------------------------------------------------------------
|
||||
|
||||
SUBROUTINE READ_XTRA( NYMD, NHMS,
|
||||
& PARDR, PARDF, TSKIN, LAI,
|
||||
& EVAP, RADLWG, SNOW )
|
||||
!
|
||||
!******************************************************************************
|
||||
! Subroutine READ_XTRA reads GEOS-3 XTRA (3-hr avg) fields from disk.
|
||||
! (dsa, tmf, bmy, 10/20/05)
|
||||
!
|
||||
! Arguments as input:
|
||||
! ============================================================================
|
||||
! (1 ) NYMD : YYYYMMDD
|
||||
! (2 ) NHMS : and HHMMSS of XTRA met fields to be accessed
|
||||
!
|
||||
! XTRA Met Fields as Output:
|
||||
! ============================================================================
|
||||
! (1 ) PARDF : (2-D) GMAO Photosyn active diffuse radiation [W/m2]
|
||||
! (2 ) PARDR : (2-D) GMAO Photosyn active direct radiation [W/m2]
|
||||
! (3 ) TSKIN : (2-D) GMAO Surface ground/sea surface temp [K]
|
||||
! (4 ) LAI : (2-D) GMAO Leaf area indices [unitless]
|
||||
! (5 ) EVAP : (2-D) GMAO Evaporation [mm/day]
|
||||
! (6 ) RADLWG : (2-D) GMAO Net upward LW rad at the ground [W/m2]
|
||||
! (7 ) SNOW : (2-D) GMAO Snow cover (H2O equivalent) [mm H2O]
|
||||
!
|
||||
! NOTES:
|
||||
!******************************************************************************
|
||||
!
|
||||
! References to F90 modules
|
||||
USE DIAG_MOD, ONLY : AD67
|
||||
USE FILE_MOD, ONLY : IOERROR, IU_XT
|
||||
USE TIME_MOD, ONLY : SET_CT_XTRA, TIMESTAMP_STRING
|
||||
USE TRANSFER_MOD, ONLY : TRANSFER_2D, TRANSFER_TO_1D
|
||||
|
||||
# include "CMN_SIZE" ! Size parameters
|
||||
# include "CMN_DIAG" ! ND67
|
||||
|
||||
! Arguments
|
||||
INTEGER, INTENT(IN) :: NYMD, NHMS
|
||||
REAL*8, INTENT(OUT), OPTIONAL :: PARDR (IIPAR,JJPAR)
|
||||
REAL*8, INTENT(OUT), OPTIONAL :: PARDF (IIPAR,JJPAR)
|
||||
REAL*8, INTENT(OUT), OPTIONAL :: TSKIN (IIPAR,JJPAR)
|
||||
REAL*8, INTENT(OUT), OPTIONAL :: LAI (IIPAR,JJPAR)
|
||||
REAL*8, INTENT(OUT), OPTIONAL :: EVAP (IIPAR,JJPAR)
|
||||
REAL*8, INTENT(OUT), OPTIONAL :: RADLWG(IIPAR,JJPAR)
|
||||
REAL*8, INTENT(OUT), OPTIONAL :: SNOW (IIPAR,JJPAR)
|
||||
|
||||
! Local Variables
|
||||
INTEGER :: I, IJLOOP, IOS, J
|
||||
INTEGER :: N_XTRA, NFOUND
|
||||
INTEGER :: XYMD, XHMS
|
||||
REAL*4 :: Q2(IGLOB,JGLOB)
|
||||
CHARACTER(LEN=8) :: NAME
|
||||
CHARACTER(LEN=16) :: STAMP
|
||||
|
||||
!=================================================================
|
||||
! READ_XTRA begins here!
|
||||
!=================================================================
|
||||
|
||||
! Get the number of XTRA fields stored in this data set
|
||||
N_XTRA = 7
|
||||
|
||||
! Zero the number of A-3 fields that we have found
|
||||
NFOUND = 0
|
||||
|
||||
!=================================================================
|
||||
! Read the XTRA fields from disk
|
||||
!=================================================================
|
||||
DO
|
||||
|
||||
! Read the XTRA field name
|
||||
READ( IU_XT, IOSTAT=IOS ) NAME
|
||||
|
||||
! End of file test -- make sure we have found all fields
|
||||
IF ( IOS < 0 ) THEN
|
||||
CALL XTRA_CHECK( NFOUND, N_XTRA )
|
||||
EXIT
|
||||
ENDIF
|
||||
|
||||
! IOS > 0: True I/O error; stop w/ err msg
|
||||
IF ( IOS > 0 ) CALL IOERROR( IOS, IU_XT, 'read_xtra:1' )
|
||||
|
||||
! CASE statement for XTRA fields
|
||||
SELECT CASE ( TRIM( NAME ) )
|
||||
|
||||
!--------------------------------
|
||||
! PARDR: Photosyn active direct radiation
|
||||
!--------------------------------
|
||||
CASE ( 'PARDR' )
|
||||
READ( IU_XT, IOSTAT=IOS ) XYMD, XHMS, Q2
|
||||
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_XT, 'read_xtra:2' )
|
||||
|
||||
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
||||
IF ( PRESENT( PARDR ) ) CALL TRANSFER_2D( Q2, PARDR )
|
||||
NFOUND = NFOUND + 1
|
||||
ENDIF
|
||||
|
||||
!--------------------------------
|
||||
! PARDF: Photosyn active diffuse radiation
|
||||
!--------------------------------
|
||||
CASE ( 'PARDF' )
|
||||
READ( IU_XT, IOSTAT=IOS ) XYMD, XHMS, Q2
|
||||
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_XT, 'read_xtra:3' )
|
||||
|
||||
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
||||
IF ( PRESENT( PARDF ) ) CALL TRANSFER_2D( Q2, PARDF )
|
||||
NFOUND = NFOUND + 1
|
||||
ENDIF
|
||||
|
||||
!--------------------------------
|
||||
! TSKIN, TGROUND: Surface ground/sea surface temp
|
||||
!--------------------------------
|
||||
CASE ( 'TSKIN', 'TGROUND' )
|
||||
READ( IU_XT, IOSTAT=IOS ) XYMD, XHMS, Q2
|
||||
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_XT, 'read_xtra:4' )
|
||||
|
||||
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
||||
IF ( PRESENT( TSKIN ) ) CALL TRANSFER_2D( Q2, TSKIN )
|
||||
NFOUND = NFOUND + 1
|
||||
ENDIF
|
||||
|
||||
!--------------------------------
|
||||
! EVAP: Evaporation
|
||||
!--------------------------------
|
||||
CASE ( 'EVAP' )
|
||||
READ( IU_XT, IOSTAT=IOS ) XYMD, XHMS, Q2
|
||||
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_XT, 'read_xtra:5' )
|
||||
|
||||
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
||||
IF ( PRESENT( EVAP ) ) CALL TRANSFER_2D( Q2, EVAP )
|
||||
NFOUND = NFOUND + 1
|
||||
ENDIF
|
||||
|
||||
!--------------------------------
|
||||
! LAI: Leaf area indices
|
||||
!--------------------------------
|
||||
CASE ( 'LAI' )
|
||||
READ( IU_XT, IOSTAT=IOS ) XYMD, XHMS, Q2
|
||||
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_XT, 'read_xtra:6' )
|
||||
|
||||
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
||||
IF ( PRESENT( LAI ) ) CALL TRANSFER_2D( Q2, LAI )
|
||||
NFOUND = NFOUND + 1
|
||||
ENDIF
|
||||
|
||||
!--------------------------------
|
||||
! SNOW: Snow cover (H2O equivalent)
|
||||
!--------------------------------
|
||||
CASE ( 'SNOW' )
|
||||
READ( IU_XT, IOSTAT=IOS ) XYMD, XHMS, Q2
|
||||
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_XT, 'read_xtra:7' )
|
||||
|
||||
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
||||
IF ( PRESENT( SNOW ) ) CALL TRANSFER_2D( Q2, SNOW )
|
||||
NFOUND = NFOUND + 1
|
||||
ENDIF
|
||||
|
||||
!--------------------------------
|
||||
! RADLWG: Net upward LW rad at the ground
|
||||
!--------------------------------
|
||||
CASE ( 'RADLWG' )
|
||||
READ( IU_XT, IOSTAT=IOS ) XYMD, XHMS, Q2
|
||||
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_XT, 'read_xtra:8' )
|
||||
|
||||
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
||||
IF ( PRESENT( RADLWG ) )
|
||||
& CALL TRANSFER_2D( Q2, RADLWG )
|
||||
NFOUND = NFOUND + 1
|
||||
ENDIF
|
||||
|
||||
END SELECT
|
||||
|
||||
!==============================================================
|
||||
! If we have found all the fields for this time, then exit
|
||||
! the loop. Otherwise, go on to the next iteration.
|
||||
!==============================================================
|
||||
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) .and.
|
||||
& NFOUND == N_XTRA ) THEN
|
||||
STAMP = TIMESTAMP_STRING( NYMD, NHMS )
|
||||
WRITE( 6, 210 ) NFOUND, STAMP
|
||||
210 FORMAT( ' - Found all ', i3,
|
||||
& ' XTRA met fields for ', a )
|
||||
EXIT
|
||||
ENDIF
|
||||
ENDDO
|
||||
|
||||
!=================================================================
|
||||
! ND67 diagnostic: A-3 surface fields:
|
||||
!
|
||||
! (19) TSKIN : Ground/sea surface temp. [hPa]
|
||||
! (20) PARDF : Photosyn active diffuse radiation [W/m2]
|
||||
! (21) PARDR : Photosyn active direct radiation [W/m2]
|
||||
!=================================================================
|
||||
IF ( ND67 > 0 ) THEN
|
||||
IF ( PRESENT( TSKIN ) ) AD67(:,:,19) = AD67(:,:,19) + TSKIN
|
||||
IF ( PRESENT( PARDF ) ) AD67(:,:,20) = AD67(:,:,20) + PARDF
|
||||
IF ( PRESENT( PARDR ) ) AD67(:,:,21) = AD67(:,:,21) + PARDR
|
||||
ENDIF
|
||||
|
||||
! Increment # of times READ_XTRA is called
|
||||
CALL SET_CT_XTRA( INCREMENT=.TRUE. )
|
||||
|
||||
! Return to calling program
|
||||
END SUBROUTINE READ_XTRA
|
||||
|
||||
!------------------------------------------------------------------------------
|
||||
|
||||
SUBROUTINE XTRA_CHECK( NFOUND, N_XTRA )
|
||||
!
|
||||
!******************************************************************************
|
||||
! Subroutine XTRA_CHECK prints an error message if not all of the XTRA met
|
||||
! fields are found. The run is also terminated. (bmy, 10/27/00, 6/23/03)
|
||||
!
|
||||
! Arguments as Input:
|
||||
! ============================================================================
|
||||
! (1 ) NFOUND (INTEGER) : # of XTRA met fields read from disk
|
||||
! (2 ) N_XTRA (INTEGER) : # of XTRA met fields expected to be read from disk
|
||||
!
|
||||
! NOTES
|
||||
! (1 ) Adapted from DAO_CHECK from "dao_read_mod.f" (bmy, 6/23/03)
|
||||
!******************************************************************************
|
||||
!
|
||||
! References to F90 modules
|
||||
USE ERROR_MOD, ONLY : GEOS_CHEM_STOP
|
||||
|
||||
! Arguments
|
||||
INTEGER, INTENT(IN) :: NFOUND, N_XTRA
|
||||
|
||||
!=================================================================
|
||||
! XTRA_CHECK begins here!
|
||||
!=================================================================
|
||||
IF ( NFOUND /= N_XTRA ) THEN
|
||||
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
||||
WRITE( 6, '(a)' ) 'ERROR -- not enough XTRA fields found!'
|
||||
|
||||
WRITE( 6, 120 ) N_XTRA, NFOUND
|
||||
120 FORMAT( 'There are ', i2, ' fields but only ', i2 ,
|
||||
& ' were found!' )
|
||||
|
||||
WRITE( 6, '(a)' ) '### STOP in XTRA_CHECK (xtra_read_mod.f)'
|
||||
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
||||
|
||||
! Deallocate arrays and stop (bmy, 10/15/02)
|
||||
CALL GEOS_CHEM_STOP
|
||||
ENDIF
|
||||
|
||||
! Return to calling program
|
||||
END SUBROUTINE XTRA_CHECK
|
||||
|
||||
!------------------------------------------------------------------------------
|
||||
|
||||
END MODULE XTRA_READ_MOD
|
||||
Reference in New Issue
Block a user