463 lines
18 KiB
Fortran
463 lines
18 KiB
Fortran
! $Id: file_mod.f,v 1.2 2012/03/01 22:00:26 daven Exp $
|
|
MODULE FILE_MOD
|
|
!
|
|
!******************************************************************************
|
|
! Module FILE_MOD contains file unit numbers, as well as file I/O routines
|
|
! for GEOS-CHEM. FILE_MOD keeps all of the I/O unit numbers in a single
|
|
! location for convenient access. (bmy, 7/1/02, 8/4/06)
|
|
!
|
|
! Module Variables:
|
|
! ============================================================================
|
|
! (1 ) IU_RST : Unit # for file "gctm.trc.YYYYMMDD"
|
|
! (3 ) IU_CHEMDAT : Unit # for file "chem.dat"
|
|
! (4 ) IU_FASTJ : Unit # for file "ratj.d", "jv_atms.dat", "jv_spec.dat"
|
|
! (6 ) IU_GEOS : Unit # for file "input.geos"
|
|
! (7 ) IU_TS : Unit # for file "ctm.ts"
|
|
! (8 ) IU_BPCH : Unit # for file "ctm.bpch"
|
|
! (9 ) IU_ND20 : Unit # for file "rate.YYYYMMDD"
|
|
! (10) IU_ND49 : Unit # for file "tsYYYYMMDD.bpch"
|
|
! (11) IU_ND50 : Unit # for file "ts24h.bpch"
|
|
! (12) IU_ND51 : Unit # for file "ts10_12am.bpch" or "ts1_4pm.bpch"
|
|
! (13) IU_PLANE : Unit # for plane flight diagnostic output file
|
|
! (14) IU_FILE : Unit # for files opened & closed in same routine
|
|
! (15) IU_PH : Unit # for GEOS-CHEM PHIS met field file
|
|
! (16) IU_I6 : Unit # for GEOS-CHEM I-6 met field file
|
|
! (17) IU_A6 : Unit # for GEOS-CHEM A-6 met field file
|
|
! (18) IU_A3 : Unit # for GEOS-CHEM A-3 met field file
|
|
! (19) IU_KZZ : Unit # for GEOS-CHEM KZZ met field file
|
|
! (20) IU_GWET : Unit # for GEOS-CHEM GWET met field file
|
|
! (21) IU_SMV2LOG : Unit # for "smv2.log" file -- SMVGEAR II rxns & species
|
|
! (22) IU_DEBUG : Unit # left for debugging purposes
|
|
!
|
|
! Module Routines
|
|
! ============================================================================
|
|
! (1 ) IOERROR : Stops w/ error msg output if I/O errors are detected
|
|
! (2 ) FILE_EX_C : Tests if a directory or file is valid
|
|
! (3 ) FILE_EX_I : Tests if a file unit refers to a valid file
|
|
! (4 ) CLOSE_FILES : Closes all files at the end of a GEOS-CHEM run
|
|
!
|
|
! GEOS-CHEM modules referenced by file_mod.f
|
|
! ============================================================================
|
|
! (1 ) error_mod.f : Module containing NaN and other error check routines
|
|
!
|
|
! NOTES:
|
|
! (1 ) Moved "ioerror.f" into this module. (bmy, 7/1/02)
|
|
! (2 ) Now references "error_mod.f" (bmy, 10/15/02)
|
|
! (3 ) Renamed cpp switch from DEC_COMPAQ to COMPAQ. Also added code to
|
|
! trap I/O errors on SUN/Sparc platform. (bmy, 3/23/03)
|
|
! (4 ) Now added IU_BC for nested boundary conditions as unit 18
|
|
! (bmy, 3/27/03)
|
|
! (5 ) Renamed IU_CTMCHEM to IU_SMV2LOG (bmy, 4/21/03)
|
|
! (6 ) Now print out I/O errors for IBM and INTEL_FC compilers (bmy, 11/6/03)
|
|
! (7 ) Changed the name of some cpp switches in "define.h" (bmy, 12/2/03)
|
|
! (8 ) Renumbered the order of the files. Also removed IU_INPTR and
|
|
! IU_INPUT since they are now obsolete. (bmy, 7/20/04)
|
|
! (9 ) Added overloaded routines FILE_EX_C and FILE_EX_I (bmy, 3/23/05)
|
|
! (10) Added LINUX_IFORT switch for Intel v8 & v9 compilers (bmy, 10/18/05)
|
|
! (11) Added IU_XT for GEOS3 XTRA met fields files for MEGAN (tmf, 10/20/05)
|
|
! (12) Extra modification for Intel v9 compiler (bmy, 11/2/05)
|
|
! (13) Now print IFORT error messages (bmy, 11/30/05)
|
|
! (14) Remove support for LINUX_IFC & LINUX_EFC compilers (bmy, 8/4/06)
|
|
!******************************************************************************
|
|
!
|
|
IMPLICIT NONE
|
|
|
|
!=================================================================
|
|
! MODULE PRIVATE DECLARATIONS -- keep certain internal variables
|
|
! and routines from being seen outside "file_mod.f"
|
|
!=================================================================
|
|
|
|
! PRIVATE routines
|
|
PRIVATE :: FILE_EX_C
|
|
PRIVATE :: FILE_EX_I
|
|
|
|
!=================================================================
|
|
! MODULE VARIABLES
|
|
!=================================================================
|
|
INTEGER, PARAMETER :: IU_RST = 1
|
|
INTEGER, PARAMETER :: IU_CHEMDAT = 7
|
|
INTEGER, PARAMETER :: IU_FASTJ = 8
|
|
INTEGER, PARAMETER :: IU_GEOS = 10
|
|
INTEGER, PARAMETER :: IU_BPCH = 11
|
|
INTEGER, PARAMETER :: IU_ND20 = 12
|
|
INTEGER, PARAMETER :: IU_ND48 = 13
|
|
INTEGER, PARAMETER :: IU_ND49 = 14
|
|
INTEGER, PARAMETER :: IU_ND50 = 15
|
|
INTEGER, PARAMETER :: IU_ND51 = 16
|
|
INTEGER, PARAMETER :: IU_ND52 = 17
|
|
INTEGER, PARAMETER :: IU_PLANE = 18
|
|
INTEGER, PARAMETER :: IU_BC = 19
|
|
INTEGER, PARAMETER :: IU_BC_NA = 20 !(lzh,02/01/2015)add nested domain
|
|
INTEGER, PARAMETER :: IU_BC_EU = 21
|
|
INTEGER, PARAMETER :: IU_BC_CH = 22
|
|
INTEGER, PARAMETER :: IU_BC_05x06= 23
|
|
INTEGER, PARAMETER :: IU_FILE = 65
|
|
INTEGER, PARAMETER :: IU_TP = 69
|
|
INTEGER, PARAMETER :: IU_PH = 70
|
|
INTEGER, PARAMETER :: IU_I6 = 71
|
|
INTEGER, PARAMETER :: IU_A6 = 72
|
|
INTEGER, PARAMETER :: IU_A3 = 73
|
|
INTEGER, PARAMETER :: IU_KZZ = 74
|
|
INTEGER, PARAMETER :: IU_GWET = 75
|
|
INTEGER, PARAMETER :: IU_XT = 76
|
|
INTEGER, PARAMETER :: IU_SMV2LOG = 93
|
|
INTEGER, PARAMETER :: IU_DEBUG = 98
|
|
INTEGER, PARAMETER :: IU_STR = 54 !(hml, 04/03/13)
|
|
INTEGER, PARAMETER :: IU_RXN = 55 !(hml, 04/03/13)
|
|
|
|
!=================================================================
|
|
! MODULE INTERFACES -- "bind" two or more routines with different
|
|
! argument types or # of arguments under one unique name
|
|
!=================================================================
|
|
INTERFACE FILE_EXISTS
|
|
MODULE PROCEDURE FILE_EX_C, FILE_EX_I
|
|
END INTERFACE
|
|
|
|
!=================================================================
|
|
! MODULE ROUTINES -- follow below the "CONTAINS" statement
|
|
!=================================================================
|
|
CONTAINS
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE IOERROR( ERROR_NUM, UNIT, LOCATION )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine IOERRROR prints out I/O error messages. The error number,
|
|
! file unit, location, and a brief description will be printed, and
|
|
! program execution will be halted. (bmy, 5/28/99, 8/4/06)
|
|
!
|
|
! Arguments as input:
|
|
! ===========================================================================
|
|
! (1 ) ERROR_NUM : I/O error number (output from the IOSTAT flag)
|
|
! (2 ) UNIT : Unit # of the file where the I/O error occurred
|
|
! (3 ) LOCATION : Name of the routine in which the error occurred
|
|
!
|
|
! NOTES:
|
|
! (1 ) Now flush the standard output buffer before stopping.
|
|
! Also updated comments. (bmy, 2/7/00)
|
|
! (2 ) Changed ROUTINE_NAME to LOCATION. Now also use C-library routines
|
|
! gerror and strerror() to get the error string corresponding to
|
|
! ERROR_NUM. For SGI platform, also print the command string that
|
|
! will call the SGI "explain" command, which will yield additional
|
|
! information about the error. Updated comments, cosmetic changes.
|
|
! Now also reference "define.h". (bmy, 3/21/02)
|
|
! (3 ) Moved into "file_mod.f". Now reference GEOS_CHEM_STOP from module
|
|
! "error_mod.f". Updated comments, cosmetic changes. (bmy, 10/15/02)
|
|
! (4 ) Renamed cpp switch from DEC_COMPAQ to COMPAQ. Also added code to
|
|
! display I/O errors on SUN platform. (bmy, 3/23/03)
|
|
! (5 ) Now call GERROR for IBM and INTEL_FC compilers (bmy, 11/6/03)
|
|
! (6 ) Renamed SGI to SGI_MIPS, LINUX to LINUX_PGI, INTEL_FC to INTEL_IFC,
|
|
! and added LINUX_EFC. (bmy, 12/2/03)
|
|
! (7 ) Now don't flush the buffer for LINUX_EFC (bmy, 4/23/04)
|
|
! (8 ) Modifications for Linux/IFORT Intel v9 compiler (bmy, 11/2/05)
|
|
! (9 ) Now call IFORT_ERRMSG to get the IFORT error messages (bmy, 11/30/05)
|
|
! (10) Remove support for LINUX_IFC & LINUX_EFC compilers (bmy, 8/4/06)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE ERROR_MOD, ONLY : GEOS_CHEM_STOP
|
|
|
|
IMPLICIT NONE
|
|
|
|
# include "define.h" ! C-preprocessor switches
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: ERROR_NUM, UNIT
|
|
CHARACTER(LEN=*), INTENT(IN) :: LOCATION
|
|
|
|
! Local variables
|
|
CHARACTER(LEN=10) :: ERROR_NUMSTR
|
|
CHARACTER(LEN=255) :: ERROR_MSG
|
|
CHARACTER(LEN=255) :: EXPLAIN_CMD
|
|
|
|
! External functions
|
|
CHARACTER(LEN=255), EXTERNAL :: GERROR, IFORT_ERRMSG
|
|
|
|
!=================================================================
|
|
! IOERROR begins here!
|
|
!=================================================================
|
|
|
|
! Fancy output
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
|
|
! Write error number, unit, location
|
|
WRITE( 6, 110 ) ERROR_NUM, UNIT, TRIM( LOCATION )
|
|
110 FORMAT( 'GEOS-CHEM I/O ERROR ', i5, ' in file unit ', i5, /,
|
|
& 'Encountered at routine:location ', a )
|
|
|
|
#if defined( SGI_MIPS )
|
|
|
|
!=================================================================
|
|
! For SGI: print error msg and construct explain command string
|
|
!=================================================================
|
|
IF ( ERROR_NUM == 2 ) THEN
|
|
|
|
! Error 2 is "file not found", so handle that separately.
|
|
! You can't use the explain command w/ error 2.
|
|
WRITE( 6, '(/,a)' ) 'Error: No such file or directory'
|
|
|
|
ELSE
|
|
|
|
! Call SGI strerror routine to convert ERROR_NUM to ERROR_MSG
|
|
ERROR_MSG = GERROR()
|
|
|
|
! Print error message to std output
|
|
WRITE( 6, 120 ) TRIM( ERROR_MSG )
|
|
120 FORMAT( /, 'Error: ', a )
|
|
|
|
! Convert ERROR_NUM to string format
|
|
WRITE( ERROR_NUMSTR, '(i10)' ) ERROR_NUM
|
|
|
|
! Construct argument for SGI explain command
|
|
IF ( ERROR_NUM >= 1000 .and. ERROR_NUM < 4000 ) THEN
|
|
EXPLAIN_CMD = 'explain cf90-' //
|
|
& TRIM( ADJUSTL( ERROR_NUMSTR ))
|
|
|
|
ELSE IF ( ERROR_NUM >= 4000 ) THEN
|
|
EXPLAIN_CMD = 'explain lib-' //
|
|
& TRIM( ADJUSTL( ERROR_NUMSTR ))
|
|
ENDIF
|
|
|
|
! Print command string for the SGI explain command
|
|
WRITE( 6, 130 ) TRIM( EXPLAIN_CMD )
|
|
130 FORMAT( /, 'Type "', a, '" at the Unix prompt for an ',
|
|
& 'explanation of the error.' )
|
|
ENDIF
|
|
|
|
#elif defined( COMPAQ )
|
|
|
|
!=================================================================
|
|
! For COMPAQ/Alpha: call gerror() to get the I/O error msg
|
|
!=================================================================
|
|
|
|
! GERROR returns ERROR_MSG corresponding to ERROR_NUM
|
|
ERROR_MSG = GERROR()
|
|
|
|
! Print error message to std output
|
|
WRITE( 6, 120 ) TRIM( ERROR_MSG )
|
|
120 FORMAT( /, 'Error: ', a )
|
|
|
|
#elif defined( LINUX_PGI )
|
|
|
|
!=================================================================
|
|
! For LINUX platform w/ PGI compiler
|
|
! Call gerror() to get the I/O error msg
|
|
!=================================================================
|
|
|
|
! GERROR returns ERROR_MSG corresponding to ERROR_NUM
|
|
ERROR_MSG = GERROR()
|
|
|
|
! Print error message to std output
|
|
WRITE( 6, 120 ) TRIM( ERROR_MSG )
|
|
120 FORMAT( /, 'Error: ', a )
|
|
|
|
#elif defined( LINUX_IFORT )
|
|
|
|
!=================================================================
|
|
! For LINUX platform w/ IFORT v8/v9 compiler:
|
|
! Call IFORT_ERRMSG to get the error number and message
|
|
!=================================================================
|
|
|
|
! Get an error msg corresponding to this error number
|
|
ERROR_MSG = IFORT_ERRMSG( ERROR_NUM )
|
|
|
|
! Print error message to std output
|
|
WRITE( 6, 120 ) ERROR_NUM, TRIM( ERROR_MSG )
|
|
120 FORMAT( /, 'Error ', i4, ': ', a )
|
|
|
|
#elif defined( SPARC )
|
|
|
|
!=================================================================
|
|
! For SUN/Sparc platform: call gerror() to get the I/O error msg
|
|
!=================================================================
|
|
|
|
! GERROR returns ERROR_MSG corresponding to ERROR_NUM
|
|
ERROR_MSG = GERROR()
|
|
|
|
! Print error message to std output
|
|
WRITE( 6, 120 ) TRIM( ERROR_MSG )
|
|
120 FORMAT( /, 'Error: ', a )
|
|
|
|
#elif defined( IBM_AIX )
|
|
|
|
!=================================================================
|
|
! For IBM/AIX platform: call gerror() to get the I/O error msg
|
|
!=================================================================
|
|
|
|
! GERROR returns ERROR_MSG corresponding to ERROR_NUM
|
|
ERROR_MSG = GERROR()
|
|
|
|
! Print error message to std output
|
|
WRITE( 6, 120 ) TRIM( ERROR_MSG )
|
|
120 FORMAT( /, 'Error: ', a )
|
|
|
|
#endif
|
|
|
|
! Fancy output
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
|
|
#if !defined( LINUX_EFC )
|
|
CALL FLUSH( 6 )
|
|
#endif
|
|
|
|
! Deallocate arrays and stop safely
|
|
CALL GEOS_CHEM_STOP
|
|
|
|
! End of program
|
|
END SUBROUTINE IOERROR
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
FUNCTION FILE_EX_C( FILENAME ) RESULT( IT_EXISTS )
|
|
!
|
|
!******************************************************************************
|
|
! Function FILE_EX_C returns TRUE if FILENAME exists or FALSE otherwise.
|
|
! This is handled in a platform-independent way. The argument is of
|
|
! CHARACTER type. (bmy, 3/23/05, 11/2/05)
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) FILENAME (CHARACTER) : Name of file or directory to test
|
|
!
|
|
! NOTES:
|
|
! (1 ) Updated for LINUX/IFORT Intel v9 compiler (bmy, 11/2/05)
|
|
!******************************************************************************
|
|
!
|
|
# include "define.h"
|
|
|
|
! Arguments
|
|
CHARACTER(LEN=*), INTENT(IN) :: FILENAME
|
|
|
|
! Function value
|
|
LOGICAL :: IT_EXISTS
|
|
|
|
!=================================================================
|
|
! FILE_EX_C begins here!
|
|
!=================================================================
|
|
|
|
#if defined( COMPAQ )
|
|
|
|
!------------------
|
|
! COMPAQ compiler
|
|
!------------------
|
|
|
|
! Reference external library function
|
|
INTEGER*4, EXTERNAL :: ACCESS
|
|
|
|
! Test whether directory exists for COMPAQ
|
|
IT_EXISTS = ( ACCESS( TRIM( FILENAME ), ' ' ) == 0 )
|
|
|
|
#else
|
|
|
|
!------------------
|
|
! Other compilers
|
|
!------------------
|
|
|
|
! Test whether directory exists w/ F90 INQUIRE function
|
|
INQUIRE( FILE=TRIM( FILENAME ), EXIST=IT_EXISTS )
|
|
|
|
#if defined( LINUX_IFORT )
|
|
|
|
! Intel IFORT v9 compiler requires use of the DIRECTORY keyword to
|
|
! INQUIRE for checking existence of directories. (bmy, 11/2/05)
|
|
IF ( .not. IT_EXISTS ) THEN
|
|
INQUIRE( DIRECTORY=TRIM( FILENAME ), EXIST=IT_EXISTS )
|
|
ENDIF
|
|
|
|
#endif
|
|
|
|
#endif
|
|
|
|
! Return to calling program
|
|
END FUNCTION FILE_EX_C
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
FUNCTION FILE_EX_I( IUNIT ) RESULT( IT_EXISTS )
|
|
!
|
|
!******************************************************************************
|
|
! Function FILE_EX_I returns TRUE if FILENAME exists or FALSE otherwise.
|
|
! This is handled in a platform-independent way. The argument is of
|
|
! INTEGER type. (bmy, 3/23/05)
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) FILENAME (INTEGER) : Name of file unit to test
|
|
!
|
|
! NOTES:
|
|
!******************************************************************************
|
|
!
|
|
# include "define.h"
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: IUNIT
|
|
|
|
! Function value
|
|
LOGICAL :: IT_EXISTS
|
|
|
|
!=================================================================
|
|
! FILE_EX_I begins here!
|
|
!=================================================================
|
|
|
|
! Test whether file unit exists w/ F90 INQUIRE function
|
|
INQUIRE( IUNIT, EXIST=IT_EXISTS )
|
|
|
|
! Return to calling program
|
|
END FUNCTION FILE_EX_I
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE CLOSE_FILES
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine CLOSE_FILES closes files used by GEOS-CHEM. This should be
|
|
! called only from the end of the "main.f" program. (bmy, 3/4/98, 10/20/05)
|
|
!
|
|
! NOTES:
|
|
! (1 ) Moved into "file_mod.f" (bmy, 6/27/02)
|
|
! (2 ) Also close IU_BC (bmy, 3/27/03)
|
|
! (3 ) Removed IU_INPUT and IU_INPTR, these are obsolete. Also renamed
|
|
! IU_TS to IU_ND48 (bmy, 7/20/04)
|
|
! (4 ) Also close IU_XT (tmf, bmy, 10/20/05)
|
|
!******************************************************************************
|
|
!
|
|
!=================================================================
|
|
! CLOSE_FILES begins here!
|
|
!=================================================================
|
|
CLOSE( IU_RST )
|
|
CLOSE( IU_CHEMDAT )
|
|
CLOSE( IU_FASTJ )
|
|
CLOSE( IU_GEOS )
|
|
CLOSE( IU_BPCH )
|
|
CLOSE( IU_ND20 )
|
|
CLOSE( IU_ND48 )
|
|
CLOSE( IU_ND49 )
|
|
CLOSE( IU_ND50 )
|
|
CLOSE( IU_ND51 )
|
|
CLOSE( IU_ND52 )
|
|
CLOSE( IU_PLANE )
|
|
CLOSE( IU_BC )
|
|
CLOSE( IU_BC_05x06)
|
|
CLOSE( IU_FILE )
|
|
CLOSE( IU_PH )
|
|
CLOSE( IU_TP )
|
|
CLOSE( IU_I6 )
|
|
CLOSE( IU_A6 )
|
|
CLOSE( IU_A3 )
|
|
CLOSE( IU_KZZ )
|
|
CLOSE( IU_GWET )
|
|
CLOSE( IU_XT )
|
|
CLOSE( IU_SMV2LOG )
|
|
CLOSE( IU_DEBUG )
|
|
CLOSE( IU_STR )
|
|
CLOSE( IU_RXN )
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE CLOSE_FILES
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
! End of module
|
|
END MODULE FILE_MOD
|