1903 lines
74 KiB
Fortran
1903 lines
74 KiB
Fortran
! $Id: a6_read_mod.f,v 1.2 2012/03/01 22:00:26 daven Exp $
|
|
MODULE A6_READ_MOD
|
|
!
|
|
!******************************************************************************
|
|
! Module A6_READ_MOD contains subroutines that unzip, open, and read
|
|
! GEOS-CHEM A-6 (avg 6-hour) met fields from disk. (bmy, 6/19/03, 10/15/09)
|
|
!
|
|
! Module Routines:
|
|
! ============================================================================
|
|
! (1 ) UNZIP_A6_FIELDS : Unzips & copies met field files to a temp dir
|
|
! (2 ) DO_OPEN_A6 : Returns TRUE if it's time to open A-6 fields
|
|
! (3 ) OPEN_A6_FIELDS : Opens met field files residing in the temp dir
|
|
! (4 ) GET_A6_FIELDS : Wrapper for routine READ_A6
|
|
! (5 ) MAKE_GCAP_CLDFRC: Computes CLDFRC from 3-D CLDF field for GCAP
|
|
! (6 ) GET_N_A6 : Returns # of A-6 fields for each DAO data set
|
|
! (7 ) CHECK_TIME : Tests if A-6 et field timestamps equal current time
|
|
! (8 ) READ_A6 : Reads A-6 fields from disk
|
|
! (9 ) A6_CHECK : Checks if we have found all of the A-6 fields
|
|
!
|
|
! GEOS-CHEM modules referenced by a6_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 ) pressure_mod.f : Module w/ routines to compute P(I,J,L)
|
|
! (9 ) time_mod.f : Module w/ routines for computing time & date
|
|
! (10) transfer_mod.f : Module w/ routines to cast & resize arrays
|
|
! (11) unix_cmds_mod.f : Module w/ Unix commands for unzipping etc.
|
|
!
|
|
! NOTES:
|
|
! (1 ) Adapted from "dao_read_mod.f" (bmy, 6/19/03)
|
|
! (2 ) Now use TIMESTAMP_STRING for formatted output (bmy, 10/28/03)
|
|
! (3 ) CLDFRC is now a 2-D array in MAKE_CLDFRC< GET_A6_FIELDS. Also now
|
|
! read from either zipped or unzipped files. (bmy, 12/9/03)
|
|
! (4 ) Now skips past the GEOS-4 ident string (bmy, 12/12/03)
|
|
! (5 ) Bug fix: need to determine CLDTOPS for GEOS-4. (bmy, 3/4/04)
|
|
! (6 ) Now modified for GEOS-4 "a_llk_03" and "a_llk_04" data (bmy, 3/4/04)
|
|
! (7 ) Now references "unix_cmds_mod.f", "directory_mod.f" and
|
|
! "logical_mod.f" (bmy, 7/20/04)
|
|
! (8 ) Now references FILE_EXISTS from "file_mod.f" (bmy, 3/23/05)
|
|
! (9 ) Now modified for GEOS-5 and GCAP met fields. Added MAKE_GCAP_CLDFRC
|
|
! routine. (swu, bmy, 5/25/05)
|
|
! (10) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
|
|
! (11) Bug fix in ND66 diagnostic for ZMMU (bmy, 2/1/06)
|
|
! (12) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
|
|
! (13) Now set negative Q (i.e. SPHU)to a small positive # (bmy, 9/8/06)
|
|
! (14) Now read extra fields for GEOS-5. Bug fix: we must convert RH from
|
|
! unitless to % to be compatible w/ present drydep etc. algorithms.
|
|
! (phs, bmy, 3/28/08)
|
|
! (15) Now get the # of A-6 fields from the file ident string (bmy, 10/7/08)
|
|
! (16) Remove references to IN_CLOUD_OD (bmy, 10/15/09)
|
|
!******************************************************************************
|
|
!
|
|
IMPLICIT NONE
|
|
|
|
!=================================================================
|
|
! MODULE PRIVATE DECLARATIONS -- keep certain internal variables
|
|
! and routines from being seen outside "a6_read_mod.f"
|
|
!=================================================================
|
|
|
|
! Make everything PRIVATE ...
|
|
PRIVATE
|
|
|
|
! ... except these routines
|
|
PUBLIC :: GET_A6_FIELDS
|
|
PUBLIC :: OPEN_A6_FIELDS
|
|
PUBLIC :: UNZIP_A6_FIELDS
|
|
! adj_group (dkh, ks, mak, cs 06/12/09)
|
|
PUBLIC :: OPEN_A6_FIELDS_ADJ
|
|
|
|
!=================================================================
|
|
! MODULE VARIABLES
|
|
!=================================================================
|
|
|
|
! Number of A6 fields in the file
|
|
INTEGER :: N_A6_FIELDS
|
|
|
|
!=================================================================
|
|
! MODULE ROUTINES -- follow below the "CONTAINS" statement
|
|
!=================================================================
|
|
CONTAINS
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE UNZIP_A6_FIELDS( OPTION, NYMD )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine UNZIP_A6_FIELDS invokes a FORTRAN system call to uncompress
|
|
! GEOS-CHEM A-6 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. (bmy, bdf, 6/15/98, 8/4/06)
|
|
!
|
|
! Arguments as input:
|
|
! ============================================================================
|
|
! (1 ) OPTION (CHAR*(*)) : Option
|
|
! (2 ) NYMD (INTEGER ) : YYYYMMDD of A-6 file to be unzipped (optional)
|
|
!
|
|
! NOTES:
|
|
! (1 ) Adapted from UNZIP_MET_FIELDS of "dao_read_mod.f" (bmy, 6/19/03)
|
|
! (2 ) Directory information YYYY/MM or YYYYMM is now contained w/in
|
|
! GEOS_1_DIR, GEOS_S_DIR, GEOS_3_DIR, GEOS_4_DIR (bmy, 12/11/03)
|
|
! (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 ) Removed code for GEOS-4 a_llk_03 data. Also modified for GEOS-5
|
|
! and GCAP met fields. (bmy, 5/25/05)
|
|
! (5 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
|
|
! (6 ) 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, GCAP_DIR, GEOS_3_DIR
|
|
USE DIRECTORY_MOD, ONLY : GEOS_4_DIR, GEOS_5_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) :: GEOS_DIR, A6_STR
|
|
CHARACTER(LEN=255) :: A6_FILE_GZ, A6_FILE
|
|
CHARACTER(LEN=255) :: UNZIP_BG, UNZIP_FG
|
|
CHARACTER(LEN=255) :: REMOVE_ALL, REMOVE_DATE
|
|
|
|
!=================================================================
|
|
! UNZIP_A6_FIELDS begins here!
|
|
!=================================================================
|
|
IF ( PRESENT( NYMD ) ) THEN
|
|
|
|
#if defined( GEOS_3 )
|
|
|
|
! Strings for directory & filename
|
|
GEOS_DIR = TRIM( GEOS_3_DIR )
|
|
A6_STR = 'YYYYMMDD.a6.' // GET_RES_EXT()
|
|
|
|
#elif defined( GEOS_4 )
|
|
|
|
! Strings for directory & filename
|
|
GEOS_DIR = TRIM( GEOS_4_DIR )
|
|
A6_STR = 'YYYYMMDD.a6.' // GET_RES_EXT()
|
|
|
|
#elif defined( GEOS_5 )
|
|
|
|
! Strings for directory & filename
|
|
GEOS_DIR = TRIM( GEOS_5_DIR )
|
|
A6_STR = 'YYYYMMDD.a6.' // GET_RES_EXT()
|
|
|
|
#elif defined( GCAP )
|
|
|
|
! Strings for directory & filename
|
|
GEOS_DIR = TRIM( GCAP_DIR )
|
|
A6_STR = 'YYYYMMDD.a6.' // GET_RES_EXT()
|
|
|
|
#endif
|
|
|
|
! Replace date tokens
|
|
CALL EXPAND_DATE( GEOS_DIR, NYMD, 000000 )
|
|
CALL EXPAND_DATE( A6_STR, NYMD, 000000 )
|
|
|
|
! Location of zipped A-3 file in data dir
|
|
A6_FILE_GZ = TRIM( DATA_DIR ) // TRIM( GEOS_DIR ) //
|
|
& TRIM( A6_STR ) // TRIM( ZIP_SUFFIX )
|
|
|
|
! Location of unzipped A-3 file in temp dir
|
|
A6_FILE = TRIM( TEMP_DIR ) // TRIM( A6_STR )
|
|
|
|
! Remove A-3 files for this date from temp dir
|
|
REMOVE_DATE = TRIM( REMOVE_CMD ) // ' ' //
|
|
& TRIM( TEMP_DIR ) // TRIM( A6_STR )
|
|
|
|
!==============================================================
|
|
! Define the foreground and background UNZIP commands
|
|
!==============================================================
|
|
|
|
! Foreground unzip
|
|
UNZIP_FG = TRIM( UNZIP_CMD ) // ' ' // TRIM( A6_FILE_GZ ) //
|
|
& TRIM( REDIRECT ) // ' ' // TRIM( A6_FILE )
|
|
|
|
! Background unzip
|
|
UNZIP_BG = TRIM( UNZIP_FG ) // TRIM( BACKGROUND )
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Define command to remove all A-6 files from the TEMP dir
|
|
!=================================================================
|
|
REMOVE_ALL = TRIM( REMOVE_CMD ) // ' ' // TRIM( TEMP_DIR ) //
|
|
& TRIM( WILD_CARD ) // '.a6.' // TRIM( WILD_CARD )
|
|
|
|
!=================================================================
|
|
! Perform an F90 system call to do the desired operation
|
|
!=================================================================
|
|
SELECT CASE ( TRIM( OPTION ) )
|
|
|
|
! Unzip A-3 fields in the Unix foreground
|
|
CASE ( 'unzip foreground' )
|
|
WRITE( 6, 100 ) TRIM( A6_FILE_GZ )
|
|
CALL SYSTEM( TRIM( UNZIP_FG ) )
|
|
|
|
! Unzip A-3 fields in the Unix background
|
|
CASE ( 'unzip background' )
|
|
WRITE( 6, 100 ) TRIM( A6_FILE_GZ )
|
|
CALL SYSTEM( TRIM( UNZIP_BG ) )
|
|
|
|
! Remove A-3 field for this date in temp dir
|
|
CASE ( 'remove date' )
|
|
WRITE( 6, 110 ) TRIM( A6_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_A6_FIELDS (a6_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_A6_FIELDS
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
FUNCTION DO_OPEN_A6( NYMD, NHMS ) RESULT( DO_OPEN )
|
|
!
|
|
!******************************************************************************
|
|
! Function DO_OPEN_A6 returns TRUE if is time to open the A-6 met field file
|
|
! or FALSE otherwise. This prevents us from opening a file which has already
|
|
! been opened. (bmy, 6/19/03, 5/25/05)
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) NYMD (INTEGER) : YYYYMMDD
|
|
! (2 ) NHMS (INTEGER) : and HHMMSS to be tested for A-3 file open
|
|
!
|
|
! NOTES:
|
|
! (1 ) Now modified for GEOS-4 "a_llk_03" or "a_llk_04" data (bmy, 3/22/04)
|
|
! (2 ) Remove code for obsolete GEOS-4 a_llk_03 data. Also modified for
|
|
! GEOS-5 and GCAP met fields. (swu, bmy, 5/25/05)
|
|
!******************************************************************************
|
|
!
|
|
! 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_A6 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
|
|
|
|
#if defined( GCAP )
|
|
|
|
! Open file if it's 03 GMT or first call (GCAP only)
|
|
IF ( NHMS == 030000 .or. FIRST ) THEN
|
|
DO_OPEN = .TRUE.
|
|
GOTO 999
|
|
ENDIF
|
|
|
|
#else
|
|
|
|
! Open file if it's 00:00 GMT or first call (all GEOS data)
|
|
IF ( NHMS == 000000 .or. FIRST ) THEN
|
|
DO_OPEN = .TRUE.
|
|
GOTO 999
|
|
ENDIF
|
|
|
|
#endif
|
|
|
|
!=================================================================
|
|
! Reset quantities for next call
|
|
!=================================================================
|
|
999 CONTINUE
|
|
LASTNYMD = NYMD
|
|
LASTNHMS = NHMS
|
|
FIRST = .FALSE.
|
|
|
|
! Return to calling program
|
|
END FUNCTION DO_OPEN_A6
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE OPEN_A6_FIELDS( NYMD, NHMS )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine OPEN_A6_FIELDS opens the A-6 met fields file for date NYMD and
|
|
! time NHMS. (bmy, bdf, 6/15/98, 10/15/09)
|
|
!
|
|
! Arguments as input:
|
|
! ===========================================================================
|
|
! (1 ) NYMD (INTEGER) : Current value of YYYYMMDD
|
|
! (2 ) NHMS (INTEGER) : Current value of HHMMSS
|
|
!
|
|
! NOTES:
|
|
! (1 ) Adapted from OPEN_MET_FIELDS of "dao_read_mod.f" (bmy, 6/19/03)
|
|
! (2 ) Now opens either zipped or unzipped files (bmy, 12/11/03)
|
|
! (3 ) Now skips past the GEOS-4 ident string (bmy, 12/12/03)
|
|
! (4 ) 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)
|
|
! (5 ) Now use FILE_EXISTS from "file_mod.f" to determine if file unit IU_A6
|
|
! refers to a valid file on disk (bmy, 3/23/05)
|
|
! (6 ) Now modified for GEOS-5 and GCAP met fields (swu, bmy, 5/25/05)
|
|
! (7 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
|
|
! (8 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
|
|
! (9 ) Now get the # of A-3 fields from the file ident string (bmy, 10/7/08)
|
|
! (10) Set N_A6_FIELDS=21 for GEOS-5 and IN_CLOUD_OD (jmao, bmy, 2/12/09)
|
|
! (11) Remove references to IN_CLOUD_OD (bmy, 10/15/09)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE BPCH2_MOD, ONLY : GET_RES_EXT
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR, GCAP_DIR, GEOS_3_DIR
|
|
USE DIRECTORY_MOD, ONLY : GEOS_4_DIR, GEOS_5_DIR, TEMP_DIR
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
USE LOGICAL_MOD, ONLY : LUNZIP
|
|
USE FILE_MOD, ONLY : IU_A6, IOERROR, FILE_EXISTS
|
|
USE TIME_MOD, ONLY : EXPAND_DATE
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: NYMD, NHMS
|
|
|
|
! Local variables
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
LOGICAL :: IT_EXISTS
|
|
INTEGER :: IOS, IUNIT
|
|
CHARACTER(LEN=8) :: IDENT
|
|
CHARACTER(LEN=255) :: A6_FILE
|
|
CHARACTER(LEN=255) :: GEOS_DIR
|
|
CHARACTER(LEN=255) :: PATH
|
|
|
|
!=================================================================
|
|
! OPEN_A6_FIELDS begins here!
|
|
!=================================================================
|
|
|
|
! Open A-6 file at the proper time, or on the first call
|
|
IF ( DO_OPEN_A6( NYMD, NHMS ) ) THEN
|
|
|
|
#if defined( GEOS_3 )
|
|
|
|
! Strings for directory & filename
|
|
GEOS_DIR = TRIM( GEOS_3_DIR )
|
|
A6_FILE = 'YYYYMMDD.a6.' // GET_RES_EXT()
|
|
|
|
#elif defined( GEOS_4 )
|
|
|
|
! Strings for directory & filename
|
|
GEOS_DIR = TRIM( GEOS_4_DIR )
|
|
A6_FILE = 'YYYYMMDD.a6.' // GET_RES_EXT()
|
|
|
|
#elif defined( GEOS_5 )
|
|
|
|
! Strings for directory & filename
|
|
GEOS_DIR = TRIM( GEOS_5_DIR )
|
|
A6_FILE = 'YYYYMMDD.a6.' // GET_RES_EXT()
|
|
|
|
#elif defined( GCAP )
|
|
|
|
! Strings for directory & filename
|
|
GEOS_DIR = TRIM( GCAP_DIR )
|
|
A6_FILE = 'YYYYMMDD.a6.' // GET_RES_EXT()
|
|
|
|
#endif
|
|
|
|
! Replace date tokens
|
|
CALL EXPAND_DATE( GEOS_DIR, NYMD, NHMS )
|
|
CALL EXPAND_DATE( A6_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( A6_FILE )
|
|
ELSE
|
|
PATH = TRIM( DATA_DIR ) //
|
|
& TRIM( GEOS_DIR ) // TRIM( A6_FILE )
|
|
ENDIF
|
|
|
|
! Close previously opened A-3 file
|
|
CLOSE( IU_A6 )
|
|
|
|
! Make sure the file unit is valid before we open the file
|
|
IF ( .not. FILE_EXISTS( IU_A6 ) ) THEN
|
|
CALL ERROR_STOP( 'Could not find file!',
|
|
& 'OPEN_A6_FIELDS (a6_read_mod.f)' )
|
|
ENDIF
|
|
|
|
! Open the file
|
|
OPEN( UNIT = IU_A6, FILE = TRIM( PATH ),
|
|
& STATUS = 'OLD', ACCESS = 'SEQUENTIAL',
|
|
& FORM = 'UNFORMATTED', IOSTAT = IOS )
|
|
|
|
IF ( IOS /= 0 ) THEN
|
|
CALL IOERROR( IOS, IU_A6, 'open_a6_fields:1' )
|
|
ENDIF
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( PATH )
|
|
100 FORMAT( ' - Opening: ', a )
|
|
|
|
#if !defined( GEOS_3 )
|
|
|
|
! Skip past the ident string
|
|
READ( IU_A6, IOSTAT=IOS ) IDENT
|
|
|
|
IF ( IOS /= 0 ) THEN
|
|
CALL IOERROR( IOS, IU_A6, 'open_a6_fields:2' )
|
|
ENDIF
|
|
|
|
! The last 2 digits of the ident string
|
|
! is the # of fields contained in the file
|
|
READ( IDENT(7:8), '(i2.2)' ) N_A6_FIELDS
|
|
|
|
#if defined( GEOS_5 )
|
|
!%%% KLUDGE: set N_A6_FIELDS=21 when using the reprocessed
|
|
!%%% GEOS-5 met. This accounts for CMFMC (which doesn't seem
|
|
!%%% to get counted) as well as for MOISTQ, which is an extra
|
|
!%%% derived field. (jmao, bmy, 2/12/09)
|
|
N_A6_FIELDS = 21
|
|
#endif
|
|
|
|
#endif
|
|
|
|
ENDIF
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE OPEN_A6_FIELDS
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
FUNCTION DO_OPEN_A6_ADJ( NYMD, NHMS ) RESULT( DO_OPEN )
|
|
!
|
|
!******************************************************************************
|
|
! Function DO_OPEN_A6_ADJ returns TRUE if is time to open the A-6 met field file
|
|
! or FALSE otherwise. This prevents us from opening a file which has already
|
|
! been opened. (bmy, 6/19/03, 5/25/05)
|
|
!
|
|
! Based on DO_OPEN_A6, the difference is that in adjoint mode
|
|
! we only open if we're reading the last block of the file, rather than the first.
|
|
! (dkh, 03/05/05)
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) NYMD (INTEGER) : YYYYMMDD
|
|
! (2 ) NHMS (INTEGER) : and HHMMSS to be tested for A-3 file open
|
|
!
|
|
! NOTES:
|
|
! (1 ) Always return TRUE, as the blocks need to be read in reverse order, so have
|
|
! to start from the top of the file each time. (dkh, 03/07/09)
|
|
! (2 ) Updated for v8 (dkh, ks, mak, cs 06/12/09)
|
|
!
|
|
!******************************************************************************
|
|
!
|
|
! 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_A6_ADJ begins here!
|
|
!=================================================================
|
|
|
|
! Initialize
|
|
DO_OPEN = .TRUE.
|
|
|
|
! Return to calling program
|
|
END FUNCTION DO_OPEN_A6_ADJ
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE OPEN_A6_FIELDS_ADJ( NYMD, NHMS )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine OPEN_A6_FIELDS opens the A-6 met fields file for date NYMD and
|
|
! time NHMS. (bmy, bdf, 6/15/98, 2/12/09)
|
|
!
|
|
! Calls ADJ_DO_OPEN_A6 (dkh, 03/05/05)
|
|
!
|
|
! Arguments as input:
|
|
! ===========================================================================
|
|
! (1 ) NYMD (INTEGER) : Current value of YYYYMMDD
|
|
! (2 ) NHMS (INTEGER) : Current value of HHMMSS
|
|
!
|
|
! NOTES:
|
|
! (1 ) Adapted from OPEN_A6_FIELDS
|
|
! (2 ) Updated for v8 (dkh, ks, mak, cs 06/12/09)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE BPCH2_MOD, ONLY : GET_RES_EXT
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR, GCAP_DIR, GEOS_3_DIR
|
|
USE DIRECTORY_MOD, ONLY : GEOS_4_DIR, GEOS_5_DIR, TEMP_DIR
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
USE LOGICAL_MOD, ONLY : LUNZIP
|
|
USE FILE_MOD, ONLY : IU_A6, IOERROR, FILE_EXISTS
|
|
USE TIME_MOD, ONLY : EXPAND_DATE
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: NYMD, NHMS
|
|
|
|
! Local variables
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
LOGICAL :: IT_EXISTS
|
|
INTEGER :: IOS, IUNIT
|
|
CHARACTER(LEN=8) :: IDENT
|
|
CHARACTER(LEN=255) :: A6_FILE
|
|
CHARACTER(LEN=255) :: GEOS_DIR
|
|
CHARACTER(LEN=255) :: PATH
|
|
|
|
!=================================================================
|
|
! OPEN_A6_FIELDS_ADJ begins here!
|
|
!=================================================================
|
|
|
|
! Open A-6 file at the proper time, or on the first call
|
|
IF ( DO_OPEN_A6_ADJ( NYMD, NHMS ) ) THEN
|
|
|
|
#if defined( GEOS_3 )
|
|
|
|
! Strings for directory & filename
|
|
GEOS_DIR = TRIM( GEOS_3_DIR )
|
|
A6_FILE = 'YYYYMMDD.a6.' // GET_RES_EXT()
|
|
|
|
#elif defined( GEOS_4 )
|
|
|
|
! Strings for directory & filename
|
|
GEOS_DIR = TRIM( GEOS_4_DIR )
|
|
A6_FILE = 'YYYYMMDD.a6.' // GET_RES_EXT()
|
|
|
|
#elif defined( GEOS_5 )
|
|
|
|
! Strings for directory & filename
|
|
GEOS_DIR = TRIM( GEOS_5_DIR )
|
|
A6_FILE = 'YYYYMMDD.a6.' // GET_RES_EXT()
|
|
|
|
#elif defined( GCAP )
|
|
|
|
! Strings for directory & filename
|
|
GEOS_DIR = TRIM( GCAP_DIR )
|
|
A6_FILE = 'YYYYMMDD.a6.' // GET_RES_EXT()
|
|
|
|
#endif
|
|
|
|
! Replace date tokens
|
|
CALL EXPAND_DATE( GEOS_DIR, NYMD, NHMS )
|
|
CALL EXPAND_DATE( A6_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( A6_FILE )
|
|
ELSE
|
|
PATH = TRIM( DATA_DIR ) //
|
|
& TRIM( GEOS_DIR ) // TRIM( A6_FILE )
|
|
ENDIF
|
|
|
|
! Close previously opened A-3 file
|
|
CLOSE( IU_A6 )
|
|
|
|
! Make sure the file unit is valid before we open the file
|
|
IF ( .not. FILE_EXISTS( IU_A6 ) ) THEN
|
|
CALL ERROR_STOP( 'Could not find file!',
|
|
& 'OPEN_A6_FIELDS_ADJ (a6_read_mod.f)' )
|
|
ENDIF
|
|
|
|
! Open the file
|
|
OPEN( UNIT = IU_A6, FILE = TRIM( PATH ),
|
|
& STATUS = 'OLD', ACCESS = 'SEQUENTIAL',
|
|
& FORM = 'UNFORMATTED', IOSTAT = IOS )
|
|
|
|
IF ( IOS /= 0 ) THEN
|
|
CALL IOERROR( IOS, IU_A6, 'open_a6_fields_adj:1' )
|
|
ENDIF
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( PATH )
|
|
100 FORMAT( ' - Opening: ', a )
|
|
|
|
#if !defined( GEOS_3 )
|
|
|
|
! Skip past the ident string
|
|
READ( IU_A6, IOSTAT=IOS ) IDENT
|
|
|
|
IF ( IOS /= 0 ) THEN
|
|
CALL IOERROR( IOS, IU_A6, 'open_a6_fields_adj:2' )
|
|
ENDIF
|
|
|
|
! The last 2 digits of the ident string
|
|
! is the # of fields contained in the file
|
|
READ( IDENT(7:8), '(i2.2)' ) N_A6_FIELDS
|
|
|
|
#if defined( GEOS_5 ) && defined( IN_CLOUD_OD )
|
|
!%%% KLUDGE: set N_A6_FIELDS=21 when using the reprocessed
|
|
!%%% GEOS-5 met. This accounts for CMFMC (which doesn't seem
|
|
!%%% to get counted) as well as for MOISTQ, which is an extra
|
|
!%%% derived field. (jmao, bmy, 2/12/09)
|
|
N_A6_FIELDS = 21
|
|
#endif
|
|
|
|
#endif
|
|
|
|
ENDIF
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE OPEN_A6_FIELDS_ADJ
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE GET_A6_FIELDS( NYMD, NHMS )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine GET_A6_FIELDS is a wrapper for routine READ_A6. GET_A6_FIELDS
|
|
! calls READ_A6 properly for reading A-6 fields from GEOS-1, GEOS-STRAT,
|
|
! GEOS-3, GEO b S-4, GEOS-5, or GCAP met data sets. (bmy, 6/19/03, 10/30/07)
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) NYMD (INTEGER) : YYYYMMDD
|
|
! (2 ) NHMS (INTEGER) : and HHMMSS of A-6 fields to be read from disk
|
|
!
|
|
! NOTES:
|
|
! (1 ) CFRAC has been removed from CMN_DEP. Now use CLDFRC(I,J) from
|
|
! "dao_mod.f" (bmy, 12/9/03)
|
|
! (2 ) Now pass CLDTOPS to READ_A6 for GEOS-4 (bmy, 3/4/04)
|
|
! (3 ) Now modified for GEOS-5 and GCAP met fields (swu, bmy, 5/25/05)
|
|
! (4 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
|
|
! (5 ) Now read CMFMC, DQIDTMST, DQLDTMST, DQRCON, DQRLSC, DQVDTMST, MFXC,
|
|
! MFYC, MFZ, PV, QI, QL, RH, TAUCLI, TAUCLW for GEOS-5
|
|
! (bmy, 10/30/07)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE DAO_MOD, ONLY : CLDF, CLDFRC, CLDMAS, CLDTOPS
|
|
USE DAO_MOD, ONLY : CMFMC, DETRAINE, DETRAINN, DNDE
|
|
USE DAO_MOD, ONLY : DNDN, DQIDTMST, DQLDTMST, DQRCON
|
|
USE DAO_MOD, ONLY : DQRLSC, DQVDTMST, DTRAIN, ENTRAIN
|
|
USE DAO_MOD, ONLY : HKBETA, HKETA, MFXC, MFYC
|
|
USE DAO_MOD, ONLY : MFZ, MOISTQ, OPTDEP, PV
|
|
USE DAO_MOD, ONLY : QI, QL, RH, SPHU
|
|
USE DAO_MOD, ONLY : T, TAUCLI, TAUCLW, UPDE
|
|
USE DAO_MOD, ONLY : UPDN, UWND, VWND, ZMEU
|
|
USE DAO_MOD, ONLY : ZMMD, ZMMU
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: NYMD, NHMS
|
|
|
|
! Local variables
|
|
INTEGER, SAVE :: LASTNYMD = -1, LASTNHMS = -1
|
|
|
|
!=================================================================
|
|
! GET_A6_FIELDS begins here!
|
|
!=================================================================
|
|
|
|
! Skip over previously-read A-6 fields
|
|
IF ( NYMD == LASTNYMD .and. NHMS == LASTNHMS ) THEN
|
|
WRITE( 6, 100 ) NYMD, NHMS
|
|
100 FORMAT( ' - A-6 met fields for NYMD, NHMS = ',
|
|
& i8.8, 1x, i6.6, ' have been read already' )
|
|
RETURN
|
|
ENDIF
|
|
|
|
#if defined( GEOS_3 )
|
|
|
|
!=================================================================
|
|
! GEOS-3: get CLDF, CLDMAS, CLDTOPS, DTRAIN, MOISTQ, OPTDEP
|
|
!=================================================================
|
|
CALL READ_A6( NYMD=NYMD, NHMS=NHMS,
|
|
& CLDF=CLDF, CLDMAS=CLDMAS, CLDTOPS=CLDTOPS,
|
|
& DTRAIN=DTRAIN, MOISTQ=MOISTQ, OPTDEPTH=OPTDEP )
|
|
|
|
#elif defined( GEOS_4 )
|
|
|
|
!=================================================================
|
|
! GEOS-4: get CLDF, CLDTOPS, HKBETA, HKETA, MOISTQ, OPTDEP, SPHU
|
|
! TMPU, UWND, VWND, ZMEU, ZMMD, ZMMU
|
|
!=================================================================
|
|
CALL READ_A6( NYMD=NYMD, NHMS=NHMS, CLDTOPS=CLDTOPS,
|
|
& CLDF=CLDF, HKBETA=HKBETA, HKETA=HKETA,
|
|
& MOISTQ=MOISTQ, OPTDEPTH=OPTDEP, Q=SPHU,
|
|
& T=T, U=UWND, V=VWND,
|
|
& ZMEU=ZMEU, ZMMD=ZMMD, ZMMU=ZMMU )
|
|
|
|
#elif defined( GEOS_5 )
|
|
|
|
!=================================================================
|
|
! GEOS-5: get CLDF, CLDTOPS, CMFMC, DQIDTMST, DQLDTMST,
|
|
! DQRCON, DQRLSC, DQVDTMST, MFXC, MFYC,
|
|
! MFZ, MOISTQ, OPTDEPTH, PLE, PV,
|
|
! RH, QV, T, TAUCLI, TAUCLW,
|
|
! U, V fields
|
|
!=================================================================
|
|
CALL READ_A6( NYMD=NYMD, NHMS=NHMS,
|
|
& CLDF=CLDF, CLDTOPS=CLDTOPS,
|
|
& CMFMC=CMFMC, DQIDTMST=DQIDTMST,
|
|
& DQLDTMST=DQLDTMST, DQRCON=DQRCON,
|
|
& DQRLSC=DQRLSC, DQVDTMST=DQVDTMST,
|
|
& DTRAIN=DTRAIN, !-------------------------------------
|
|
!--------------------------------------+ MFXC=MFXC, Activate these
|
|
! & MFYC=MFYC, MFZ=MFZ later (bmy, 1/17/07)
|
|
!----------------------------------------------------------------------------
|
|
& MOISTQ=MOISTQ, OPTDEPTH=OPTDEP,
|
|
& PV=PV, RH=RH,
|
|
& Q=SPHU, QL=QL,
|
|
& QI=QI, T=T,
|
|
& TAUCLI=TAUCLI, TAUCLW=TAUCLW,
|
|
& U=UWND, V=VWND )
|
|
|
|
|
|
#elif defined( GCAP )
|
|
|
|
!=================================================================
|
|
! GCAP: read CLDF, DETRAINE, DETRAIN, DNDE, DNDN, ENTRAIN,
|
|
! MOISTQ, OPTDEPTH, SPHU, T=T, UWND, UPDE,
|
|
! UPDN, VWND, and compute CLDTOPS & CLDFRC
|
|
!=================================================================
|
|
CALL READ_A6( NYMD=NYMD, NHMS=NHMS,
|
|
& CLDF=CLDF, CLDTOPS=CLDTOPS,
|
|
& DETRAINE=DETRAINE, DETRAINN=DETRAINN,
|
|
& DNDE=DNDE, DNDN=DNDN,
|
|
& ENTRAIN=ENTRAIN, MOISTQ=MOISTQ,
|
|
& OPTDEPTH=OPTDEP, Q=SPHU,
|
|
& T=T, U=UWND,
|
|
& UPDE=UPDE, UPDN=UPDN,
|
|
& V=VWND )
|
|
|
|
! Create 2-D CLDFRC field from 3-D CLDF field
|
|
CALL MAKE_GCAP_CLDFRC( CLDF, CLDFRC )
|
|
|
|
#endif
|
|
|
|
! Save NYMD and NHMS for next call
|
|
LASTNYMD = NYMD
|
|
LASTNHMS = NHMS
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE GET_A6_FIELDS
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE MAKE_GCAP_CLDFRC( CLDF, CLDFRC )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine MAKE_CLDFRC constructs the GCAP CLDFRC field from the 3-D
|
|
! cloud fraction field. (swu, bmy, 5/25/05)
|
|
!
|
|
! Arguments as Input:
|
|
! ===========================================================================
|
|
! (1 ) CLDF (REAL*8) : GCAP 3-D cloud fraction field [unitless]
|
|
!
|
|
! Arguments as Output:
|
|
! ===========================================================================
|
|
! (2 ) CLDFRC (REAL*8) : GCAP column cloud fraction field [unitless]
|
|
!
|
|
! NOTES:
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE DIAG_MOD, ONLY : AD67
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_DIAG" ! ND67
|
|
|
|
! Arguments
|
|
REAL*8, INTENT(IN) :: CLDF(LLPAR,IIPAR,JJPAR)
|
|
REAL*8, INTENT(OUT) :: CLDFRC(IIPAR,JJPAR)
|
|
|
|
! Local variables
|
|
LOGICAL :: IS_ND67
|
|
INTEGER :: I, J
|
|
|
|
!=================================================================
|
|
! MAKE_GCAP_CLDFRC begins here!
|
|
!=================================================================
|
|
|
|
! Is the ND67 diagnostic turned on?
|
|
IS_ND67 = ( ND67 > 0 )
|
|
|
|
! Make 2-D cloud fraction
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J )
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
! Take max value
|
|
CLDFRC(I,J) = MAXVAL( CLDF(:,I,J) )
|
|
|
|
! Store in ND67 diagnostic if necessary
|
|
IF ( IS_ND67 ) AD67(I,J,10) = AD67(I,J,10) + CLDFRC(I,J)
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE MAKE_GCAP_CLDFRC
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
FUNCTION GET_N_A6() RESULT( N_A6 )
|
|
!
|
|
!******************************************************************************
|
|
! Function GET_N_A6 returns the number of A-6 fields per met data set
|
|
! (GEOS-3, GEOS-4, GEOS-5, or GCAP). (bmy, 6/19/03, 5/15/07)
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) NYMD (INTEGER) : YYYYMMDD for which to read in A-6 fields
|
|
!
|
|
! NOTES:
|
|
! (1 ) Now modified for GCAP and GEOS-5 met fields (swu, bmy, 5/25/05)
|
|
! (2 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
|
|
! (3 ) Increase number of A-6 fields for GEOS-5 to 21 (bmy, 5/15/07)
|
|
!******************************************************************************
|
|
!
|
|
# include "CMN_SIZE"
|
|
|
|
! Function value
|
|
INTEGER :: N_A6
|
|
|
|
!=================================================================
|
|
! GET_N_A6 begins here!
|
|
!=================================================================
|
|
#if defined( GEOS_3 )
|
|
|
|
! GEOS-3 has 6 A-6 fields
|
|
N_A6 = 6
|
|
|
|
#elif defined( GEOS_4 )
|
|
|
|
! GEOS-4 has 12 A-6 fields
|
|
N_A6 = 12
|
|
|
|
#elif defined( GEOS_5 )
|
|
|
|
! GEOS-5 has 19 A-6 fields
|
|
N_A6 = 21
|
|
|
|
#elif defined( GCAP )
|
|
|
|
! GCAP has 14 A-6 fields
|
|
N_A6 = 14
|
|
|
|
#endif
|
|
|
|
! Return to calling program
|
|
END FUNCTION GET_N_A6
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
FUNCTION CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) RESULT( ITS_TIME )
|
|
!
|
|
!******************************************************************************
|
|
! Function CHECK_TIME checks to see if the timestamp of the A-3 field just
|
|
! read from disk matches the current time. If so, then it's time to return
|
|
! the A-3 field to the calling program. (bmy, 6/19/03, 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 ) 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_A6( NYMD, NHMS,
|
|
& CLDF, CLDMAS, CLDTOPS, CMFMC,
|
|
& DETRAINE, DETRAINN, DNDE, DNDN,
|
|
& DQIDTMST, DQLDTMST, DQRCON, DQRLSC,
|
|
& DQVDTMST, DTRAIN, ENTRAIN, HKBETA,
|
|
& HKETA, MFXC, MFYC, MFZ,
|
|
& MOISTQ, OPTDEPTH, PLE, PV,
|
|
& Q, QI, QL, RH,
|
|
& T, TAUCLI, TAUCLW, U,
|
|
& UPDE, UPDN, V, ZMEU,
|
|
& ZMMD, ZMMU )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine READ_A6 reads A-6 (avg 6-hr) met fields from disk.
|
|
! (bmy, 6/5/98, 10/15/09)
|
|
!
|
|
! Arguments as input:
|
|
! ===========================================================================
|
|
! (1 ) NYMD : YYYYMMDD
|
|
! (2 ) NHMS : and HHMMSS of A-6 met fields to be accessed
|
|
!
|
|
! A-6 Met Fields as Output (Optional Arguments):
|
|
! ============================================================================
|
|
! (3 ) CLDF : (3-D) Total cloud fractions [unitless]
|
|
! (4 ) CLDMAS : (3-D) Cloud mass flux field [kg/m2/600s]
|
|
! (5 ) CLDTOPS : (2-D) CTM Level in which cloud top occurs [unitless]
|
|
! (6 ) CMFMC : (3-D) GEOS-5 cloud mass flux [kg/m2/s]
|
|
! (7 ) DETRAINE : (3-D) GCAP detrainment (entraining plume) [kg/m2/s]
|
|
! (8 ) DETRAINN : (3-D) GCAP detrainment (non-entr'n plume)
|
|
! (9 ) DNDE : (3-D) GCAP downdraft (entraining plume)
|
|
! (10) DNDN : (3-D) GCAP downdraft (non-entr'n plume)
|
|
! (11) DQIDTMST : (3-D) GEOS-5 ice tendency in moist proc [kg/kg/s]
|
|
! (12) DQLDTMST : (3-D) GEOS-5 liquid tendency in moist proc [kg/kg/s]
|
|
! (13) DQRCON : (3-D) GEOS-5 precip formation rate / conv
|
|
! (14) DQRLSC : (3-D) GEOS-5 precip formation rate / lg scl
|
|
! (15) DQVDTMST : (3-D) GEOS-5 vapor tendency in moist proc [kg/kg/s]
|
|
! (16) DTRAIN : (3-D) Detrainment field [kg/m2/s]
|
|
! (17) ENTRAIN : (3-D) GCAP entrainment
|
|
! (18) HKBETA : (3-D) Hack overshoot parameter [unitless]
|
|
! (19) HKETA : (3-D) Hack convective mass flux [kg/m2/s]
|
|
! (20) MFXC : (3-D) GEOS-5 E-W mass flux [Pa*m2/s]
|
|
! (21) MFYC : (3-D) GEOS-5 N-S mass flux [Pa*m2/s]
|
|
! (22) MFZ : (3-D) GEOS-5 up/down mass flux [kg/m2/s]
|
|
! (23) MOISTQ : (3-D) DAO water vapor tendency d [g/kg/day]
|
|
! (24) OPTDEPTH : (3-D) GEOS grid box optical depth [unitless]
|
|
! (25) PLE : (3-D) GEOS-5 pressure edges [hPa]
|
|
! (26) PV : (3-D) GEOS-5 potential vorticity [kg*m2/kg/s]
|
|
! (27) Q : (3-D) Specific humidity [g H2O/kg air]
|
|
! (28) T : (3-D) Temperature [K]
|
|
! (29) TAUCLI : (3-D) GEOS ice path optical depth [unitless]
|
|
! (30) TAUCLW : (3-D) GEOS water path optical depth [unitless]
|
|
! (31) U : (3-D) Zonal winds [m/s]
|
|
! (32) UPDE : (3-D) GCAP updraft (entraining plume)
|
|
! (33) UPDN : (3-D) GCAP updraft (non-entr'n plume)
|
|
! (34) V : (3-D) Meridional winds [m/s]
|
|
! (35) ZMEU : (3-D) Zhang/McFarlane updraft entrainment [Pa/s]
|
|
! (36) ZMMD : (3-D) Zhang/McFarlane downdraft mass flux [Pa/s]
|
|
! (37) ZMMU : (3-D) Zhang/McFarlane updraft mass flux [Pa/s]
|
|
!
|
|
! NOTES:
|
|
! (1 ) Adapted from READ_A6 of "dao_read_mod.f" (bmy, 6/19/03)
|
|
! (2 ) Now use function TIMESTAMP_STRING from "time_mod.f" for formatted
|
|
! date/time output. (bmy, 10/28/03)
|
|
! (3 ) Now compute CLDTOPS using ZMMU for GEOS-4 (bmy, 3/4/04)
|
|
! (4 ) Now modified for GEOS-5 and GCAP fields. Added DETRAINE,
|
|
! DETRAINN, DNDE, DNDN, ENTRAIN, UPDE, UPDN as optional arguments.
|
|
! Now references "CMN_DIAG". (swu, bmy, 5/25/05)
|
|
! (5 ) Bug fix in ND66 diagnostic for GEOS-4 (bmy, 2/1/06)
|
|
! (6 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
|
|
! (7 ) Now set negative SPHU to a small positive # (1d-32) instead of zero,
|
|
! so as not to blow up logarithms (bmy, 9/8/06)
|
|
! (8 ) Add CMFMC, DQIDTMST, DQLDTMST, DQRCON, DQRLSC, DQVDTMST, MFXC, MFYC,
|
|
! MFZ, PLE, PV, RH, TAUCLI, and TAUCLW as optional arguments. Also
|
|
! update the CASE statement accordingly for GEOS-5 met fields.
|
|
! Now reference TRANSFER_3D_Lp1 from "transfer_mod.f". Now convert
|
|
! GEOS-5 specific humidity from [kg/kg] to [g/kg] for compatibility
|
|
! with existing routines. Also recognize EPV, which is an alternate
|
|
! name for PV. Bug fix: convert GEOS-5 RH from unitless to %.
|
|
! (phs, bmy, 3/28/08)
|
|
! (8 ) Now get the # of A-6 fields from the file ident string (bmy, 10/7/08)
|
|
! (9 ) Remove references to IN_CLOUD_OD (bmy, 10/15/09)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE DIAG_MOD, ONLY : AD66, AD67
|
|
USE FILE_MOD, ONLY : IOERROR, IU_A6
|
|
USE TIME_MOD, ONLY : SET_CT_A6, TIMESTAMP_STRING
|
|
USE TRANSFER_MOD, ONLY : TRANSFER_A6, TRANSFER_3D_Lp1
|
|
USE TRANSFER_MOD, ONLY : TRANSFER_3D, TRANSFER_G5_PLE
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_DIAG" ! ND66, ND67
|
|
# include "CMN_GCTM" ! g0
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: NYMD, NHMS
|
|
INTEGER, INTENT(OUT), OPTIONAL :: CLDTOPS(IIPAR,JJPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: CLDF(LLPAR,IIPAR,JJPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: CLDMAS(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: CMFMC(IIPAR,JJPAR,LLPAR+1)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: DETRAINE(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: DETRAINN(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: DNDE(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: DNDN(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: DQIDTMST(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: DQLDTMST(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: DQRCON(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: DQRLSC(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: DQVDTMST(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: DTRAIN(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: ENTRAIN(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: HKBETA(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: HKETA(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: MFXC(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: MFYC(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: MFZ(IIPAR,JJPAR,LLPAR+1)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: MOISTQ(LLPAR,IIPAR,JJPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: OPTDEPTH(LLPAR,IIPAR,JJPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: PLE(IIPAR,JJPAR,LLPAR+1)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: PV(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: Q(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: QI(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: QL(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: RH(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: T(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: TAUCLI(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: TAUCLW(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: U(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: UPDE(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: UPDN(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: V(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: ZMEU(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: ZMMD(IIPAR,JJPAR,LLPAR)
|
|
REAL*8, INTENT(OUT), OPTIONAL :: ZMMU(IIPAR,JJPAR,LLPAR)
|
|
|
|
! Local variables
|
|
INTEGER :: I, IJLOOP, J, K, L
|
|
INTEGER :: IOS, NFOUND, N_A6
|
|
REAL*4 :: D(IGLOB,JGLOB,LGLOB)
|
|
REAL*4 :: D1(IGLOB,JGLOB,LGLOB+1)
|
|
REAL*8 :: C1, C2
|
|
REAL*8 :: TAUCLD(LLPAR,IIPAR,JJPAR)
|
|
REAL*8 :: CLDTOT(LLPAR,IIPAR,JJPAR)
|
|
CHARACTER(LEN=8) :: NAME
|
|
CHARACTER(LEN=16) :: STAMP
|
|
INTEGER :: XYMD, XHMS
|
|
|
|
!=================================================================
|
|
! READ_A6 begins here!
|
|
!=================================================================
|
|
|
|
! Get number of A-6 fields
|
|
#if defined( GEOS_5 )
|
|
N_A6 = N_A6_FIELDS
|
|
#else
|
|
N_A6 = GET_N_A6()
|
|
#endif
|
|
|
|
! Zero number of fields that we have found
|
|
NFOUND = 0
|
|
|
|
!=================================================================
|
|
! Read the A-6 fields from disk
|
|
!=================================================================
|
|
DO
|
|
|
|
! A-6 field name
|
|
READ( IU_A6, IOSTAT=IOS ) NAME
|
|
|
|
! IOS < 0: End-of-file; make sure we've found
|
|
! all the A-6 fields before exiting this loop
|
|
IF ( IOS < 0 ) THEN
|
|
CALL A6_CHECK( NFOUND, N_A6 )
|
|
EXIT
|
|
ENDIF
|
|
|
|
! IOS > 0: True I/O Error, stop w/ error msg
|
|
IF ( IOS > 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:1' )
|
|
|
|
! CASE statement for A-6 fields
|
|
SELECT CASE ( TRIM( NAME ) )
|
|
|
|
!--------------------------------------
|
|
! CLDMAS: GEOS-3 cloud mass flux
|
|
!--------------------------------------
|
|
CASE ( 'CLDMAS' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:2' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( CLDMAS ) ) CALL TRANSFER_3D( D, CLDMAS )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! CLDF : GEOS-3 3-D total cloud frac
|
|
! CLDTOT: GEOS-4 3-D total cloud frac
|
|
! CLOUD : GEOS-5 3-D total cloud frac
|
|
!--------------------------------------
|
|
CASE ( 'CLDTOT', 'CLDF', 'CLOUD' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:3' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
CALL TRANSFER_A6( D, CLDTOT )
|
|
NFOUND = NFOUND +1
|
|
ENDIF
|
|
|
|
!------------------------------------
|
|
! CMFMC: GEOS-5 cloud mass flux
|
|
!------------------------------------
|
|
CASE ( 'CMFMC' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D1
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:4' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( CMFMC ) ) THEN
|
|
CALL TRANSFER_3D_Lp1( D1, CMFMC )
|
|
ENDIF
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! DETRAINE: GCAP Detrainment (ent pl)
|
|
!--------------------------------------
|
|
CASE ( 'DETRAINE' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:5' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( DETRAINE ) ) THEN
|
|
CALL TRANSFER_3D( D, DETRAINE )
|
|
ENDIF
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! DETRAINN: GCAP Detrainment (non-ent)
|
|
!--------------------------------------
|
|
CASE ( 'DETRAINN' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:6' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( DETRAINN ) ) THEN
|
|
CALL TRANSFER_3D( D, DETRAINN )
|
|
ENDIF
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! DNDE: GCAP Downdraft (ent plume)
|
|
!--------------------------------------
|
|
CASE ( 'DNDE' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:7' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( DNDE ) ) CALL TRANSFER_3D( D, DNDE )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! DNDN: GCAP Downdraft (non-ent plume)
|
|
!--------------------------------------
|
|
CASE ( 'DNDN' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:8' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( DNDN ) ) CALL TRANSFER_3D( D, DNDN )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! DQIDTMST: GEOS-5 ice tend in moist p
|
|
!--------------------------------------
|
|
CASE ( 'DQIDTMST' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:9' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( DQIDTMST ) ) THEN
|
|
CALL TRANSFER_3D( D, DQIDTMST )
|
|
ENDIF
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! DQLDTMST: GEOS-5 liq tend in moist p
|
|
!--------------------------------------
|
|
CASE ( 'DQLDTMST' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:10' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( DQLDTMST ) ) THEN
|
|
CALL TRANSFER_3D( D, DQLDTMST )
|
|
ENDIF
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! DQRCON: GEOS-5 conv rain prod rate
|
|
!--------------------------------------
|
|
CASE ( 'DQRCON' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:11' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( DQRCON ) ) THEN
|
|
CALL TRANSFER_3D( D, DQRCON )
|
|
ENDIF
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! DQRLSC: GEOS-5 lg scl rain prod rate
|
|
!--------------------------------------
|
|
CASE ( 'DQRLSC' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:12' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( DQRLSC ) ) THEN
|
|
CALL TRANSFER_3D( D, DQRLSC )
|
|
ENDIF
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! DQVDTMST: GEOS-5 vap tend in moist p
|
|
!--------------------------------------
|
|
CASE ( 'DQVDTMST' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:13' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( DQVDTMST ) ) THEN
|
|
CALL TRANSFER_3D( D, DQVDTMST )
|
|
ENDIF
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! DTRAIN: GEOS-3 & GEOS-5 detrainment
|
|
!--------------------------------------
|
|
CASE ( 'DTRAIN' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:14' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( DTRAIN ) ) CALL TRANSFER_3D( D, DTRAIN )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! ENTRAIN: GCAP Entrainment
|
|
!--------------------------------------
|
|
CASE ( 'ENTRAIN' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:15' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( ENTRAIN ) ) THEN
|
|
CALL TRANSFER_3D( D, ENTRAIN )
|
|
ENDIF
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! HKBETA: GEOS-4 Hack overshoot param.
|
|
!--------------------------------------
|
|
CASE ( 'HKBETA' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:16' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( HKBETA ) ) CALL TRANSFER_3D( D, HKBETA )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! HKETA: GEOS-4 Hack conv mass flux
|
|
!--------------------------------------
|
|
CASE ( 'HKETA' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:17' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( HKETA ) ) CALL TRANSFER_3D( D, HKETA )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! MFXC: GEOS-5 E-W mass flux (C-grid)
|
|
!--------------------------------------
|
|
CASE ( 'MFXC' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:18' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( MFXC ) ) CALL TRANSFER_3D( D, MFXC )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! MFYC: GEOS-5 N-S mass flux (C-grid)
|
|
!--------------------------------------
|
|
CASE ( 'MFYC' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:19' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( MFYC ) ) CALL TRANSFER_3D( D, MFYC )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! MFZ: GEOS-5 vert mass flux (C-grid)
|
|
!--------------------------------------
|
|
CASE ( 'MFZ' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D1
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:20' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( MFZ ) ) CALL TRANSFER_3D_Lp1( D1, MFZ )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! MOISTQ: tendency of SPHU
|
|
!--------------------------------------
|
|
CASE ( 'MOISTQ' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:21' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( MOISTQ ) ) CALL TRANSFER_A6( D, MOISTQ )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! OPTDEPTH: grid box optical depth
|
|
!--------------------------------------
|
|
CASE ( 'OPTDEPTH' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:22' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( OPTDEPTH ) ) THEN
|
|
CALL TRANSFER_A6( D, OPTDEPTH )
|
|
ENDIF
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! PLE: GEOS-5 pressure edges
|
|
!--------------------------------------
|
|
CASE ( 'PLE' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D1
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:23' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( PLE ) ) CALL TRANSFER_G5_PLE( D1, PLE )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! PV: GEOS-5 Ertel potential vorticity
|
|
!--------------------------------------
|
|
CASE ( 'PV', 'EPV' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:24' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( PV ) ) CALL TRANSFER_3D( D, PV )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! Q: GEOS-4 specific humidity [g/kg]
|
|
! QV: GEOS-5 specific humidity [kg/kg]
|
|
!--------------------------------------
|
|
CASE ( 'Q', 'QV' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:25' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( Q ) ) CALL TRANSFER_3D( D, Q )
|
|
NFOUND = NFOUND + 1
|
|
|
|
! NOTE: Now set negative Q to a small positive #
|
|
! instead of zero, so as not to blow up logarithms
|
|
! (bmy, 9/8/06)
|
|
WHERE ( Q < 0d0 ) Q = 1d-32
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! QI: GEOS-5 ice mixing ratio [kg/kg]
|
|
!--------------------------------------
|
|
CASE ( 'QI' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:26' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( QI ) ) CALL TRANSFER_3D( D, QI )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! QL: GEOS-5 water mix ratio [kg/kg]
|
|
!--------------------------------------
|
|
CASE ( 'QL' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:27' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( QL ) ) CALL TRANSFER_3D( D, QL )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! RH: GEOS-5 relative humidity [%]
|
|
!--------------------------------------
|
|
CASE ( 'RH' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:28' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( RH ) ) CALL TRANSFER_3D( D, RH )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! T: 3-D temperature
|
|
!--------------------------------------
|
|
CASE ( 'T' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:29' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( T ) ) CALL TRANSFER_3D( D, T )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! TAUCLI: GEOS-5 ice path opt depth
|
|
!--------------------------------------
|
|
CASE ( 'TAUCLI' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:30' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( TAUCLI ) ) CALL TRANSFER_3D( D, TAUCLI )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! TAUCLW: GEOS-5 water path opt depth
|
|
!--------------------------------------
|
|
CASE ( 'TAUCLW' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:31' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( TAUCLW ) ) CALL TRANSFER_3D( D, TAUCLW )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! U: GEOS-4 & GEOS-5 zonal wind
|
|
!--------------------------------------
|
|
CASE ( 'U' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:32' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( U ) ) CALL TRANSFER_3D( D, U )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! UPDE: GCAP Downdraft (ent plume)
|
|
!--------------------------------------
|
|
CASE ( 'UPDE' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:33' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( UPDE ) ) CALL TRANSFER_3D( D, UPDE )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! UPDN: Downdraft (non-ent plume)
|
|
!--------------------------------------
|
|
CASE ( 'UPDN' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:34' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( UPDN ) ) CALL TRANSFER_3D( D, UPDN )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! V: GEOS-4 & GEOS-5 meridional wind
|
|
!--------------------------------------
|
|
CASE ( 'V' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:35' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( V ) ) CALL TRANSFER_3D( D, V )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! ZMEU: GEOS-4 Z&M updraft entrainment
|
|
!--------------------------------------
|
|
CASE ( 'ZMEU' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:36' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( ZMEU ) ) CALL TRANSFER_3D( D, ZMEU )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! ZMMD: GEOS-4 Z&M downdraft mass flux
|
|
!--------------------------------------
|
|
CASE ( 'ZMMD' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:37' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( ZMMD ) ) CALL TRANSFER_3D( D, ZMMD )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! ZMMU: GEOS-4 Z&M updraft mass flux
|
|
!--------------------------------------
|
|
CASE ( 'ZMMU' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:38' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
IF ( PRESENT( ZMMU ) ) CALL TRANSFER_3D( D, ZMMU )
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! TAUCLD: in-cloud optical depth
|
|
! Just skip over this
|
|
!--------------------------------------
|
|
CASE ( 'TAUCLD' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:39' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! KH: Just skip over this
|
|
!--------------------------------------
|
|
CASE ( 'KH' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:40' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
!--------------------------------------
|
|
! Extra GEOS-5 fields
|
|
! Skip over these now; add later
|
|
!--------------------------------------
|
|
CASE ( 'OMEGA' )
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:40' )
|
|
|
|
IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
NFOUND = NFOUND + 1
|
|
ENDIF
|
|
|
|
! Field not found -- skip over
|
|
CASE DEFAULT
|
|
WRITE ( 6, '(a)' ) 'Searching for next A-6 field!'
|
|
READ( IU_A6, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6, 'read_a6:41' )
|
|
|
|
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_A6 ) THEN
|
|
STAMP = TIMESTAMP_STRING( NYMD, NHMS )
|
|
WRITE( 6, 210 ) NFOUND, STAMP
|
|
210 FORMAT( ' - Found all ', i3, ' A-6 met fields for ', a )
|
|
EXIT
|
|
ENDIF
|
|
ENDDO
|
|
|
|
!=================================================================
|
|
! CLDTOPS(I,J) = level of convective cloud top at (I,J).
|
|
! GEOS-CHEM cloud top at (I,J) is at top of first level where
|
|
! cloud mass flux goes from being nonzero to zero.
|
|
!
|
|
! For GEOS-3 : mass flux is "CLDMAS" field
|
|
! For GEOS-4 : mass flux is "ZMMU" field
|
|
! For GEOS-5 : mass flux is "CMFMC" field
|
|
! For GCAP : mass flux is "UPDN" field
|
|
!=================================================================
|
|
#if defined( GCAP )
|
|
|
|
!------------------------------
|
|
! Special handling for GCAP
|
|
!------------------------------
|
|
|
|
! CLDTOPS is highest location of ZMMU in the column (I,J)
|
|
IF ( PRESENT( CLDTOPS ) .and. PRESENT( UPDN ) ) THEN
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
CLDTOPS(I,J) = 1
|
|
DO L = LLPAR, 1, -1
|
|
IF ( UPDN(I,J,L) > 0d0 ) THEN
|
|
CLDTOPS(I,J) = L + 1
|
|
EXIT
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
ENDIF
|
|
|
|
#elif defined( GEOS_3 )
|
|
|
|
!------------------------------
|
|
! Special handling for GEOS-3
|
|
!------------------------------
|
|
|
|
! Due to an error in the DAO archiving process, the CLDMAS and
|
|
! DTRAIN fields have units of [kg/m2/600s]. Divide here by 600
|
|
! to convert CLDMAS and DTRAIN into units of [kg/m2/s].
|
|
IF ( PRESENT( CLDMAS ) ) CLDMAS = CLDMAS / 600d0
|
|
IF ( PRESENT( DTRAIN ) ) DTRAIN = DTRAIN / 600d0
|
|
|
|
! CLDTOPS highest location of CLDMAS in the column (I,J)
|
|
IF ( PRESENT( CLDTOPS ) .and. PRESENT( CLDMAS ) ) THEN
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
CLDTOPS(I,J) = 1
|
|
DO L = LLPAR, 1, -1
|
|
IF ( CLDMAS(I,J,L) > 0d0 ) THEN
|
|
CLDTOPS(I,J) = L + 1
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
ENDIF
|
|
|
|
! For 1998 GEOS-3 fields only, create OPTDEPTH = TAUCLD * CLDTOT
|
|
! The 1998 fields only store TAUCLD, which is the in-cloud
|
|
! optical depth. The actual grid box optical depth is
|
|
! TAUCLD * CLDTOT, which is what FAST-J needs. (bmy, 10/11/01)
|
|
IF ( PRESENT( OPTDEPTH ) .and. ( NYMD / 10000 ) == 1998 ) THEN
|
|
OPTDEPTH = TAUCLD * CLDTOT
|
|
ENDIF
|
|
|
|
#elif defined( GEOS_4 )
|
|
|
|
!------------------------------
|
|
! Special handling for GEOS-4
|
|
!------------------------------
|
|
|
|
! CLDTOPS is highest location of ZMMU in the column (I,J)
|
|
IF ( PRESENT( CLDTOPS ) .and. PRESENT( ZMMU ) ) THEN
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
CLDTOPS(I,J) = 1
|
|
DO L = LLPAR, 1, -1
|
|
IF ( ZMMU(I,J,L) > 0d0 ) THEN
|
|
CLDTOPS(I,J) = L + 1
|
|
EXIT
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
ENDIF
|
|
|
|
#elif defined( GEOS_5 )
|
|
|
|
!------------------------------
|
|
! Special handling for GEOS-5
|
|
!------------------------------
|
|
|
|
! Convert RH from unitless to percent (phs, bmy, 3/28/08)
|
|
! %%% NOTE: GEOS-5 file spec says units of RH are % but that's wrong!
|
|
! Temporary fix: force RH to be positive (phs, 5/1/08)
|
|
IF ( PRESENT( RH ) ) THEN
|
|
RH = RH * 100d0
|
|
RH = MAX(RH, 0D0)
|
|
ENDIF
|
|
|
|
! Convert GEOS-5 specific humidity from [kg/kg] to [g/kg]
|
|
IF ( PRESENT( Q ) ) Q = Q * 1000d0
|
|
|
|
! CLDTOPS highest location of CMFMC in the column (I,J)
|
|
IF ( PRESENT( CLDTOPS ) .and. PRESENT( CMFMC ) ) THEN
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
CLDTOPS(I,J) = 1
|
|
DO L = LLPAR, 1, -1
|
|
IF ( CMFMC(I,J,L) > 0d0 ) THEN
|
|
CLDTOPS(I,J) = L + 1
|
|
EXIT
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
ENDIF
|
|
|
|
#endif
|
|
|
|
! CLDF is read directly from disk CLDTOT met field
|
|
IF ( PRESENT( CLDF ) ) THEN
|
|
CLDF = CLDTOT
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! MOISTQ < 0 denotes precipitation. Convert negative values to
|
|
! positives, and then divide by 8.64d7 to convert to units of
|
|
! [kg H2O/kg air/s]. (bmy, 4/5/99)
|
|
!=================================================================
|
|
IF ( PRESENT( MOISTQ ) ) THEN
|
|
|
|
! First replace any NaN values with zeroes. Most NaN's in MOISTQ
|
|
! have been shown to occur near the tropopause, where there are
|
|
! no clouds, and no cloud or ice precip. (bmy, 11/7/13)
|
|
WHERE( MOISTQ .ne. MOISTQ )
|
|
MOISTQ = 0d0
|
|
ENDWHERE
|
|
|
|
! Then convert to [kg H2O/kg air/s]
|
|
MOISTQ = -MOISTQ / 8.64d7
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! ND66 diagnostic: A-6 fields
|
|
!
|
|
! (1 ) UWND : 6-h average U-winds [m/s]
|
|
! (2 ) VWND : 6=h average V-winds [m/s]
|
|
! (3 ) TMPU : 6-h average Temperature [K]
|
|
! (4 ) SPHU : 6-h average Specific humidity [g H20/kg air]
|
|
! (5 ) CLDMAS : Convective Mass Flux [kg/m2/s]
|
|
! (6 ) DTRAIN : Detrainment mass flux [kg/m2/s]
|
|
!=================================================================
|
|
IF ( ND66 > 0 ) THEN
|
|
IF ( PRESENT( U ) ) THEN
|
|
AD66(:,:,1:LD66,1) = AD66(:,:,1:LD66,1) + U(:,:,1:LD66)
|
|
ENDIF
|
|
|
|
IF ( PRESENT( V ) ) THEN
|
|
AD66(:,:,1:LD66,2) = AD66(:,:,1:LD66,2) + V(:,:,1:LD66)
|
|
ENDIF
|
|
|
|
IF ( PRESENT( T ) ) THEN
|
|
AD66(:,:,1:LD66,3) = AD66(:,:,1:LD66,3) + T(:,:,1:LD66)
|
|
ENDIF
|
|
|
|
IF ( PRESENT( Q ) ) THEN
|
|
AD66(:,:,1:LD66,4) = AD66(:,:,1:LD66,4) + Q(:,:,1:LD66)
|
|
ENDIF
|
|
|
|
! GEOS-3 cloud mass flux
|
|
IF ( PRESENT( CLDMAS ) ) THEN
|
|
AD66(:,:,1:LD66,5) = AD66(:,:,1:LD66,5) + CLDMAS(:,:,1:LD66)
|
|
ENDIF
|
|
|
|
! GEOS-4 cloud mass flux
|
|
IF ( PRESENT( ZMMU ) ) THEN
|
|
AD66(:,:,1:LD66,5) = AD66(:,:,1:LD66,5) + ZMMU(:,:,1:LD66)
|
|
ENDIF
|
|
|
|
! GEOS-5 cloud mass flux
|
|
IF ( PRESENT( CMFMC ) ) THEN
|
|
AD66(:,:,1:LD66,5) = AD66(:,:,1:LD66,5) + CMFMC(:,:,1:LD66)
|
|
ENDIF
|
|
|
|
! GCAP cloud mass flux
|
|
IF ( PRESENT( UPDE ) ) THEN
|
|
AD66(:,:,1:LD66,5) = AD66(:,:,1:LD66,5) +UPDE(:,:,1:LD66)/g0
|
|
ENDIF
|
|
|
|
! GCAP cloud mass flux
|
|
IF ( PRESENT( UPDN ) ) THEN
|
|
AD66(:,:,1:LD66,5) = AD66(:,:,1:LD66,5) +UPDN(:,:,1:LD66)/g0
|
|
ENDIF
|
|
|
|
! GEOS-3 & GEOS-5 detrainment
|
|
IF ( PRESENT( DTRAIN ) ) THEN
|
|
AD66(:,:,1:LD66,6) = AD66(:,:,1:LD66,6) + DTRAIN(:,:,1:LD66)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! ND67 diagnostic: Accumulating DAO surface fields
|
|
! Field # 16 is the cloud top heights
|
|
!=================================================================
|
|
IF ( ND67 > 0 ) THEN
|
|
IF ( PRESENT( CLDTOPS ) ) AD67(:,:,16) = AD67(:,:,16) + CLDTOPS
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Update A-6 fields diagnostic counter
|
|
!=================================================================
|
|
CALL SET_CT_A6( INCREMENT=.TRUE. )
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE READ_A6
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE A6_CHECK( NFOUND, N_A6 )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine A6_CHECK prints an error message if not all of the A-6 met
|
|
! fields are found. The run is also terminated. (bmy, 10/27/00, 6/19/03)
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) NFOUND (INTEGER) : # of A-6 met fields read from disk
|
|
! (2 ) N_A6 (INTEGER) : # of A-6 met fields expected to be read from disk
|
|
!
|
|
! NOTES
|
|
! (1 ) Adapted from DAO_CHECK from "dao_read_mod.f" (bmy, 6/19/03)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE ERROR_MOD, ONLY : GEOS_CHEM_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: NFOUND, N_A6
|
|
|
|
!=================================================================
|
|
! A6_CHECK begins here!
|
|
!=================================================================
|
|
IF ( NFOUND /= N_A6 ) THEN
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
WRITE( 6, '(a)' ) 'ERROR -- not enough A-6 fields found!'
|
|
|
|
WRITE( 6, 120 ) N_A6, NFOUND
|
|
120 FORMAT( 'There are ', i2, ' fields but only ', i2 ,
|
|
& ' were found!' )
|
|
|
|
WRITE( 6, '(a)' ) '### STOP in A6_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 A6_CHECK
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
! End of module
|
|
END MODULE A6_READ_MOD
|