Sola/GEOS-Chem-adjoint-v35-note
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add files via upload

Browse Source
This commit is contained in:
Xuesong (Steve)
2018-08-28 00:37:54 -04:00
committed by GitHub
parent d7c2334c5f
commit cffebb9cd6
55 changed files with 105491 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

750
code/modified/gwet_read_mod.f Normal file
View File

@ -0,0 +1,750 @@
! $Id: gwet_read_mod.f,v 1.1 2009/06/17 07:39:04 daven Exp $
MODULE GWET_READ_MOD
!
!******************************************************************************
! Module GWET_READ_MOD contains routines that unzip, open, and
! read the GEOS-CHEM GWET (avg 3-hour) met fields from disk.
! (tdf, bmy, 3/30/04, 8/4/06)
!
! NOTE: GWET fields are included in GEOS-4 met data, so we only need this
! module to read GWET data from the GEOS-3 data sets. (bmy, 3/30/04)
!
! Module Routines:
! =========================================================================
! (1 ) UNZIP_GWET_FIELDS : Unzips & copies met field files to a temp dir
! (2 ) DO_OPEN_GWET : Returns TRUE if it's time to read GWET fields
! (3 ) OPEN_GWET_FIELDS : Opens met field files residing in the temp dir
! (4 ) GET_GWET_FIELDS : Wrapper for routine READ_GWET
! (5 ) CHECK_TIME : Tests if GWET met field times equal current time
! (6 ) READ_GWET : Reads GWET fields from disk
! (7 ) GWET_CHECK : Checks if we have found all of the GWET fields
!
! GEOS-CHEM modules referenced by gwet_read_mod.f
! ============================================================================
! (1 ) bpch2_mod.f : Module containing routines for binary punch file I/O
! (2 ) dao_mod.f : Module containing arrays for DAO met fields
! (3 ) diag_mod.f : Module containing GEOS-CHEM diagnostic arrays
! (4 ) directory_mod.f : Module containing GEOS-CHEM data & met field dirs
! (5 ) error_mod.f : Module containing NaN and other error check routines
! (6 ) logical_mod.f : Module containing GEOS-CHEM logical switches
! (7 ) file_mod.f : Module containing file unit #'s and error checks
! (8 ) time_mod.f : Module containing routines for computing time & date
! (9 ) transfer_mod.f : Module containing routines to cast & resize arrays
! (10) unix_cmds_mod.f : Module containing Unix commands for unzipping files
!
! NOTES:
! (1 ) Adapted from "a3_read_mod.f" (tdf, rjp, 6/30/04)
! (2 ) Now references "directory_mod.f", "logical_mod.f", and
! "unix_cmds_mod.f" (bmy, 7/20/04)
! (3 ) Now references FILE_EXISTS from "file_mod.f" (bmy, 3/23/05)
! (4 ) Updated comments (bmy, 10/24/05)
! (5 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
!******************************************************************************
!
IMPLICIT NONE
!=================================================================
! MODULE PRIVATE DECLARATIONS -- keep certain internal variables
! and routines from being seen outside "gwet_read_mod.f"
!=================================================================
! PRIVATE module routines
PRIVATE :: GWET_CHECK, CHECK_TIME, DO_OPEN_GWET, READ_GWET
!=================================================================
! MODULE ROUTINES -- follow below the "CONTAINS" statement
!=================================================================
CONTAINS
!------------------------------------------------------------------------------
SUBROUTINE UNZIP_GWET_FIELDS( OPTION, NYMD )
!
!******************************************************************************
! Subroutine UNZIP_GWET_FIELDS invokes a FORTRAN system call to uncompress
! GEOS-CHEM GWET 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. (tdf, bmy, 3/30/04, 8/4/06)
!
! Arguments as input:
! ============================================================================
! (1 ) OPTION (CHAR*(*)) : Option
! (2 ) NYMD (INTEGER ) : YYYYMMDD of GWET file to be unzipped (optional)
!
! NOTES:
! (1 ) Adapted from "a3_read_mod.f" (tdf, bmy, 3/30/04)
! (2 ) Now reference "directory_mod.f" and "unix_cmds_mod.f". Also remove
! reference to CMN_SETUP. (bmy, 7/20/04)
! (3 ) Now reference "directory_mod.f" and "unix_cmds_mod.f". Now prevent
! EXPAND_DATE from overwriting directory paths with Y/M/D tokens in
! them (bmy, 7/20/04)
! (4 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
!******************************************************************************
!
! 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" ! Size parameters
! Arguments
CHARACTER(LEN=*), INTENT(IN) :: OPTION
INTEGER, OPTIONAL, INTENT(IN) :: NYMD
! Local variables
CHARACTER(LEN=255) :: GEOS_DIR, GWET_STR
CHARACTER(LEN=255) :: GWET_FILE_GZ, GWET_FILE
CHARACTER(LEN=255) :: UNZIP_BG, UNZIP_FG
CHARACTER(LEN=255) :: REMOVE_ALL, REMOVE_DATE
!=================================================================
! UNZIP_GWET_FIELDS begins here!
!=================================================================
IF ( PRESENT( NYMD ) ) THEN
! String w/ date & resolution
GEOS_DIR = TRIM( GEOS_3_DIR )
GWET_STR = 'YYYYMMDD.gwet.' // GET_RES_EXT()
! Replace date tokens
CALL EXPAND_DATE( GEOS_DIR, NYMD, 000000 )
CALL EXPAND_DATE( GWET_STR, NYMD, 000000 )
! Location of zipped GWET file in data dir
GWET_FILE_GZ = TRIM( DATA_DIR ) // TRIM( GEOS_DIR ) //
& TRIM( GWET_STR ) // TRIM( ZIP_SUFFIX )
! Location of unzipped GWET file in temp dir
GWET_FILE = TRIM( TEMP_DIR ) // TRIM( GWET_STR )
! Remove GWET files for this date from temp dir
REMOVE_DATE = TRIM( REMOVE_CMD ) // ' ' //
& TRIM( TEMP_DIR ) // TRIM( GWET_STR )
!==============================================================
! Define the foreground and background UNZIP commands
!==============================================================
! Foreground unzip
UNZIP_FG = TRIM( UNZIP_CMD ) // ' ' // TRIM( GWET_FILE_GZ ) //
& TRIM( REDIRECT ) // ' ' // TRIM( GWET_FILE )
! Background unzip
UNZIP_BG = TRIM( UNZIP_FG ) // TRIM( BACKGROUND )
ENDIF
!=================================================================
! Define command to remove all GWET files from the TEMP dir
!=================================================================
REMOVE_ALL = TRIM( REMOVE_CMD ) // ' ' // TRIM( TEMP_DIR ) //
& TRIM( WILD_CARD ) // '.gwet.' // TRIM( WILD_CARD )
!=================================================================
! Perform an F90 system call to do the desired operation
!=================================================================
SELECT CASE ( TRIM( OPTION ) )
! Unzip GWET fields in the Unix foreground
CASE ( 'unzip foreground' )
WRITE( 6, 100 ) TRIM( GWET_FILE_GZ )
CALL SYSTEM( TRIM( UNZIP_FG ) )
! Unzip A-3 fields in the Unix background
CASE ( 'unzip background' )
WRITE( 6, 100 ) TRIM( GWET_FILE_GZ )
CALL SYSTEM( TRIM( UNZIP_BG ) )
! Remove A-3 field for this date in temp dir
CASE ( 'remove date' )
WRITE( 6, 110 ) TRIM( GWET_FILE )
CALL SYSTEM( TRIM( REMOVE_DATE ) )
! Remove all A-3 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_GWET_FIELDS (gwet_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_GWET_FIELDS
!------------------------------------------------------------------------------
FUNCTION DO_OPEN_GWET( NYMD, NHMS ) RESULT( DO_OPEN )
!
!******************************************************************************
! Function DO_OPEN_GWET returns TRUE if is time to open the GWET met field
! file or FALSE otherwise. This prevents us from opening a file which has
! already been opened. (tdf, bmy, 3/30/04)
!
! Arguments as Input:
! ============================================================================
! (1 ) NYMD (INTEGER) : YYYYMMDD
! (2 ) NHMS (INTEGER) : and HHMMSS to be tested for GWET 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_GWET 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 GWET 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_GWET
!------------------------------------------------------------------------------
SUBROUTINE OPEN_GWET_FIELDS( NYMD, NHMS )
!
!******************************************************************************
! Subroutine OPEN_gwet_FIELDS opens the A-3 met fields file for date NYMD
! and time NHMS. (tdf, bmy, 3/30/04, 8/4/06)
!
! Arguments as Input:
! ===========================================================================
! (1 ) NYMD (INTEGER) : YYYYMMDD
! (2 ) NHMS (INTEGER) : and HHMMSS timestamps for A-3 file
!
! NOTES:
! (1 ) Adapted from "a3_read_mod.f" (tdf, bmy, 3/30/04)
! (2 ) Now references "directory_mod.f" instead of CMN_SETUP. Also now
! references LUNZIP from "logical_mod.f". Also now prevents EXPAND_DATE
! from overwriting Y/M/D tokens in directory paths. (bmy, 7/20/04)
! (3 ) Now use FILE_EXISTS from "file_mod.f" to determine if file unit
! IU_GWET refers to a valid file on disk (bmy, 3/23/05)
! (4 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
!******************************************************************************
!
! 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_GWET, 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) :: GEOS_DIR
CHARACTER(LEN=255) :: GWET_FILE
CHARACTER(LEN=255) :: PATH
!=================================================================
! OPEN_GWET_FIELDS begins here!
!=================================================================
! Open A-3 fields at the proper time, or on the first call
IF ( DO_OPEN_GWET( NYMD, NHMS ) ) THEN
! String w/ date and resolution
GEOS_DIR = TRIM( GEOS_3_DIR )
GWET_FILE = 'YYYYMMDD.gwet.' // GET_RES_EXT()
! Replace date tokens
CALL EXPAND_DATE( GEOS_DIR, NYMD, NHMS )
CALL EXPAND_DATE( GWET_FILE, NYMD, NHMS )
! If unzipping, open GEOS-1 file in TEMP dir
! If not unzipping, open GEOS-1 file in DATA dir
IF ( LUNZIP ) THEN
PATH = TRIM( TEMP_DIR ) // TRIM( GWET_FILE )
ELSE
PATH = TRIM( DATA_DIR ) //
& TRIM( GEOS_DIR ) // TRIM( GWET_FILE )
ENDIF
! Close previously opened GWET file
CLOSE( IU_GWET )
! Make sure file unit is valid before we open the file
IF ( .not. FILE_EXISTS( IU_GWET ) ) THEN
CALL ERROR_STOP( 'Could not find file!',
& 'OPEN_GWET_FIELDS (gwet_read_mod.f)' )
ENDIF
! Open the file
OPEN( UNIT = IU_GWET, FILE = TRIM( PATH ),
& STATUS = 'OLD', ACCESS = 'SEQUENTIAL',
& FORM = 'UNFORMATTED', IOSTAT = IOS )
IF ( IOS /= 0 ) THEN
CALL IOERROR( IOS, IU_GWET, 'open_gwet_fields:1' )
ENDIF
! Echo info
WRITE( 6, 100 ) TRIM( PATH )
100 FORMAT( ' - Opening: ', a )
ENDIF
! Return to calling program
END SUBROUTINE OPEN_GWET_FIELDS
!------------------------------------------------------------------------------
FUNCTION DO_OPEN_GWET_ADJ( NYMD, NHMS ) RESULT( DO_OPEN )
!
!******************************************************************************
! Function DO_OPEN_GWET_ADJ returns TRUE if is time to open the GWET met field
! file or FALSE otherwise. This prevents us from opening a file which has
! already been opened. (tdf, bmy, 3/30/04)
!
! adj_group: Modified for adjoint (dkh, ks, mak, cs 06/17/09)
!
! Arguments as Input:
! ============================================================================
! (1 ) NYMD (INTEGER) : YYYYMMDD
! (2 ) NHMS (INTEGER) : and HHMMSS to be tested for GWET 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_GWET_ADJ begins here!
!=================================================================
! Initialize
!DO_OPEN = .FALSE.
! adj_group: always open a new for backwd integration (dkh, ks, mak, cs 06/17/09)
DO_OPEN = .TRUE.
RETURN
! Return if we have already opened the file
IF ( NYMD == LASTNYMD .and. NHMS == LASTNHMS ) THEN
DO_OPEN = .FALSE.
GOTO 999
ENDIF
! Open GWET 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_GWET_ADJ
!------------------------------------------------------------------------------
SUBROUTINE OPEN_GWET_FIELDS_ADJ( NYMD, NHMS )
!
!******************************************************************************
! Subroutine OPEN_gwet_FIELDS_ADJ opens the A-3 met fields file for date NYMD
! and time NHMS. (tdf, bmy, 3/30/04, 8/4/06)
!
! adj_group: modified for backwd integration (dkh, ks, mak, cs 06/17/09)
!
! Arguments as Input:
! ===========================================================================
! (1 ) NYMD (INTEGER) : YYYYMMDD
! (2 ) NHMS (INTEGER) : and HHMMSS timestamps for A-3 file
!
! NOTES:
! (1 ) Adapted from "a3_read_mod.f" (tdf, bmy, 3/30/04)
! (2 ) Now references "directory_mod.f" instead of CMN_SETUP. Also now
! references LUNZIP from "logical_mod.f". Also now prevents EXPAND_DATE
! from overwriting Y/M/D tokens in directory paths. (bmy, 7/20/04)
! (3 ) Now use FILE_EXISTS from "file_mod.f" to determine if file unit
! IU_GWET refers to a valid file on disk (bmy, 3/23/05)
! (4 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
!******************************************************************************
!
! 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_GWET, 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) :: GEOS_DIR
CHARACTER(LEN=255) :: GWET_FILE
CHARACTER(LEN=255) :: PATH
!=================================================================
! OPEN_GWET_FIELDS_ADJ begins here!
!=================================================================
! Open A-3 fields at the proper time, or on the first call
IF ( DO_OPEN_GWET_ADJ( NYMD, NHMS ) ) THEN
! String w/ date and resolution
GEOS_DIR = TRIM( GEOS_3_DIR )
GWET_FILE = 'YYYYMMDD.gwet.' // GET_RES_EXT()
! Replace date tokens
CALL EXPAND_DATE( GEOS_DIR, NYMD, NHMS )
CALL EXPAND_DATE( GWET_FILE, NYMD, NHMS )
! If unzipping, open GEOS-1 file in TEMP dir
! If not unzipping, open GEOS-1 file in DATA dir
IF ( LUNZIP ) THEN
PATH = TRIM( TEMP_DIR ) // TRIM( GWET_FILE )
ELSE
PATH = TRIM( DATA_DIR ) //
& TRIM( GEOS_DIR ) // TRIM( GWET_FILE )
ENDIF
! Close previously opened GWET file
CLOSE( IU_GWET )
! Make sure file unit is valid before we open the file
IF ( .not. FILE_EXISTS( IU_GWET ) ) THEN
CALL ERROR_STOP( 'Could not find file!',
& 'OPEN_GWET_FIELDS_ADJ (gwet_read_mod.f)' )
ENDIF
! Open the file
OPEN( UNIT = IU_GWET, FILE = TRIM( PATH ),
& STATUS = 'OLD', ACCESS = 'SEQUENTIAL',
& FORM = 'UNFORMATTED', IOSTAT = IOS )
IF ( IOS /= 0 ) THEN
CALL IOERROR( IOS, IU_GWET, 'open_gwet_fields_adj:1' )
ENDIF
! Echo info
WRITE( 6, 100 ) TRIM( PATH )
100 FORMAT( ' - Opening: ', a )
ENDIF
! Return to calling program
END SUBROUTINE OPEN_GWET_FIELDS_ADJ
!------------------------------------------------------------------------------
SUBROUTINE GET_GWET_FIELDS( NYMD, NHMS )
!
!******************************************************************************
! Subroutine GET_GWET_FIELDS is a wrapper for routine READ_GWET.
! GET_GWET_FIELDS calls READ_GWET properly for reading GEOS-1,
! GEOS-STRAT, GEOS-3, or GEOS-4 met data sets. (tdf, bmy, 3/30/04)
!
! Arguments as Input:
! ============================================================================
! (1 ) NYMD (INTEGER) : YYYYMMDD
! (2 ) NHMS (INTEGER) : and HHMMSS of A-3 fields to be read from disk
!
! NOTES:
! (1 ) Adapted from "a3_read_mod.f" (bmy, 3/30/04)
!******************************************************************************
!
! References to F90 modules
USE DAO_MOD, ONLY : GWETTOP
# include "CMN_SIZE" ! Size parameters
! Arguments
INTEGER, INTENT(IN) :: NYMD, NHMS
! Local variables
INTEGER, SAVE :: LASTNYMD = -1, LASTNHMS = -1
!=================================================================
! GET_GWET_FIELDS begins here!
!=================================================================
! Skip over previously-read GWET fields
IF ( NYMD == LASTNYMD .and. NHMS == LASTNHMS ) THEN
WRITE( 6, 100 ) NYMD, NHMS
100 FORMAT( ' - GWET met fields for NYMD, NHMS = ',
& i8.8, 1x, i6.6, ' have been read already' )
RETURN
ENDIF
!=================================================================
! Read the GWET data!
!=================================================================
CALL READ_GWET( NYMD=NYMD, NHMS=NHMS, GWET=GWETTOP )
! Save NYMD, NHMS for next call
LASTNYMD = NYMD
LASTNHMS = NHMS
! Return to MAIN program
END SUBROUTINE GET_GWET_FIELDS
!------------------------------------------------------------------------------
FUNCTION CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) RESULT( ITS_TIME )
!
!******************************************************************************
! Function CHECK_TIME checks to see if the timestamp of the GWET field just
! read from disk matches the current time. If so, then it's time to return
! the GWET field to the calling program. (tdf, bmy, 3/30/04, 8/4/06)
!
! Arguments as Input:
! ============================================================================
! (1 ) XYMD (INTEGER) : YYYYMMDD timestamp for A-3 field in file
! (2 ) XHMS (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:
! (1 ) Adapted from "a3_read_mod.f" (bmy, 3/30/04)
! (2 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
!******************************************************************************
!
# include "CMN_SIZE"
! Arguments
INTEGER, INTENT(IN) :: XYMD, XHMS, NYMD, NHMS
! Function value
LOGICAL :: ITS_TIME
!=================================================================
! CHECK_TIME begins here!
!=================================================================
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_GWET( NYMD, NHMS, GWET )
!
!******************************************************************************
! Subroutine READ_GWET reads GEOS GWET (3-hr avg) fields from disk.
! (tdf, bmy, 3/30/04, 8/4/06)
!
! Arguments as input:
! ============================================================================
! (1 ) NYMD : YYYYMMDD
! (2 ) NHMS : and HHMMSS of A-3 met fields to be accessed
!
! Arguments as Output:
! ============================================================================
! (1 ) GWET : (2-D) GMAO topsoil wetness [unitless]
!
! NOTES:
! (1 ) Adapted from "a3_read_mod.f" (tdf, bmy, 3/30/04)
! (2 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
!******************************************************************************
!
! References to F90 modules
USE DIAG_MOD, ONLY : AD67
USE FILE_MOD, ONLY : IOERROR, IU_GWET
USE TIME_MOD, ONLY : 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 :: GWET(IIPAR,JJPAR)
! Local Variables
INTEGER, PARAMETER :: N_GWET=1
INTEGER :: I, IJLOOP, IOS, J, NFOUND
REAL*4 :: Q2(IGLOB,JGLOB)
CHARACTER(LEN=8) :: NAME
CHARACTER(LEN=16) :: STAMP
INTEGER :: XYMD, XHMS
!=================================================================
! READ_gwet begins here!
!=================================================================
! Zero the number of A-3 fields that we have found
NFOUND = 0
!=================================================================
! Read the GWET fields from disk
!=================================================================
DO
! Read the GWET field name
READ( IU_GWET, IOSTAT=IOS ) NAME
! End of file test -- make sure we have found all fields
IF ( IOS < 0 ) THEN
CALL GWET_CHECK( NFOUND, N_GWET )
EXIT
ENDIF
! IOS > 0: True I/O error; stop w/ err msg
IF ( IOS > 0 ) CALL IOERROR( IOS, IU_GWET, 'read_gwet:1' )
! CASE statement for GWET fields
SELECT CASE ( TRIM( NAME ) )
!--------------------------------
! GWET: Ground wetness (0-1)
!--------------------------------
CASE ( 'GWET', 'GWETTOP' )
READ( IU_GWET, IOSTAT=IOS ) XYMD, XHMS, Q2
IF ( IOS /= 0 )
& CALL IOERROR( IOS, IU_GWET, 'read_gwet:14' )
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
IF ( PRESENT( GWET ) ) CALL TRANSFER_2D( Q2, GWET )
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_GWET ) THEN
STAMP = TIMESTAMP_STRING( NYMD, NHMS )
WRITE( 6, 210 ) NFOUND, STAMP
210 FORMAT( ' - Found all ', i3, ' GWET met fields for ', a)
EXIT
ENDIF
ENDDO
!=================================================================
! ND67 diagnostic: A-3 surface fields:
!
! (22) GWET : Top soil wetness [unitless]
!=================================================================
IF ( ND67 > 0 ) THEN
IF ( PRESENT( GWET ) ) AD67(:,:,22) = AD67(:,:,22) + GWET
ENDIF
! Return to calling program
END SUBROUTINE READ_GWET
!------------------------------------------------------------------------------
SUBROUTINE GWET_CHECK( NFOUND, N_GWET )
!
!******************************************************************************
! Subroutine GWET_CHECK prints an error message if not all of the GWET met
! fields are found. The run is also terminated. (tdf, bmy, 3/30/04)
!
! Arguments as Input:
! ============================================================================
! (1 ) NFOUND (INTEGER) : # of GWET met fields read from disk
! (2 ) N_GWET (INTEGER) : # of GWET met fields expected to be read from disk
!
! NOTES
! (1 ) Adapted from "a3_read_mod.f" (bmy, 3/30/04)
!******************************************************************************
!
! References to F90 modules
USE ERROR_MOD, ONLY : GEOS_CHEM_STOP
! Arguments
INTEGER, INTENT(IN) :: NFOUND, N_GWET
!=================================================================
! GWET_CHECK begins here!
!=================================================================
IF ( NFOUND /= N_GWET ) THEN
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
WRITE( 6, '(a)' ) 'ERROR -- not enough A-3 fields found!'
WRITE( 6, 120 ) N_GWET, NFOUND
120 FORMAT( 'There are ', i2, ' fields but only ', i2 ,
& ' were found!' )
WRITE( 6, '(a)' ) '### STOP in GWET_CHECK (dao_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 GWET_CHECK
!------------------------------------------------------------------------------
! End of module
END MODULE GWET_READ_MOD