! $Id: time_mod.f,v 1.6 2012/03/01 22:00:27 daven Exp $ MODULE TIME_MOD ! !****************************************************************************** ! TIME_MOD contains GEOS-CHEM date and time variables and timesteps, and ! routines for accessing them. (bmy, 6/21/00, 2/2/07) ! ! Module Variables: ! ============================================================================ ! (1 ) NYMDb (INTEGER) : YYYYMMDD at beginning of GEOS-CHEM run ! (2 ) NHMSb (INTEGER) : HHMMSS at beginning of GEOS-CHEM run ! (3 ) NYMDe (INTEGER) : YYYYMMDD at end of GEOS-CHEM run ! (4 ) NHMSe (INTEGER) : HHMMSS at end of GEOS-CHEM run ! (5 ) NYMD (INTEGER) : YYYYMMDD at current timestep ! (6 ) NHMS (INTEGER) : HHMMSS at current timestep ! (7 ) MONTH (INTEGER) : Current month value (1-12) ! (8 ) DAY (INTEGER) : Current day of the month (1-31) ! (9 ) YEAR (INTEGER) : Current year (YYYY format) ! (10) HOUR (INTEGER) : Current hour of the day (0-23) ! (11) MINUTE (INTEGER) : Current minute of the hour (0-59) ! (12) SECOND (INTEGER) : Current second of the minute (0-59) ! (13) NSEASON (INTEGER) : Season flag (1=DJF, 2=MAM, 3=JJA, 4=SON) ! (14) DAY_OF_YEAR (INTEGER) : Current day of year (0-365 or 0-366) ! (15) ELAPSED_MIN (INTEGER) : Elapsed minutes since the end of the run ! (16) TAU (REAL*8 ) : Current TAU value (hours since 0 GMT 1/1/1985) ! (17) TAUb (REAL*8 ) : TAU value at beginning of GEOS-CHEM run ! (18) TAUe (REAL*8 ) : TAU value at end of GEOS-CHEM run ! (19) DIAGb (REAL*8 ) : TAU value at beginning of diagnostic interval ! (20) DIAGe (REAL*8 ) : TAU value at end of diagnostic interval ! (21) GMT (REAL*8 ) : Current Greenwich Mean Time (0.0 - 23.999 hrs) ! (22) TS_CHEM (INTEGER) : Chemistry timestep in minutes ! (23) TS_CONV (INTEGER) : Convection timestep in minutes ! (24) TS_DIAG (INTEGER) : Diagnostic timestep in minutes ! (25) TS_DYN (INTEGER) : Dynamic timestep in minutes ! (26) TS_EMIS (INTEGER) : Emission timestep in minutes ! (27) TS_UNIT (INTEGER) : Unit conversion timestep in minutes ! (28) CT_CHEM (INTEGER) : Number of chemistry timesteps executed so far ! (29) CT_CONV (INTEGER) : Number of convection timesteps executed so far ! (30) CT_DYN (INTEGER) : Number of dynamic timesteps executed so far ! (31) CT_EMIS (INTEGER) : Number of emission timesteps executed so far ! (32) JD85 (REAL*8 ) : Astronomical Julian Day at 0 GMT 1/1/1985 ! (33) NDIAGTIME (INTEGER) : Time of day (HHMMSS) to write bpch file ! ! Module Routines: ! ============================================================================ ! (1 ) SET_CURRENT_TIME : Updates time variables for current timestep ! (2 ) SET_BEGIN_TIME : Initializes NYMDb, NHMSb, TAUb variables ! (3 ) SET_END_TIME : Initializes NYMDe, NHMSe, TAUe variables ! (4 ) SET_NDIAGTIME : Initializes NDIAGTIME (time to write bpch file) ! (5 ) SET_DIAGb : Updates DIAGb and DIAGe diagnostic interval times ! (6 ) SET_DIAGe : Updates DIAGb and DIAGe diagnostic interval times ! (7 ) SET_TIMESTEPS : Updates the elapsed minutes since the start of run ! (8 ) SET_CT_CHEM : Increments/resets the chemistry timestep counter ! (9 ) SET_CT_CONV : Increments/resets the convection timestep counter ! (10) SET_CT_DYN : Increments/resets the dynamic timestep counter ! (11) SET_CT_EMIS : Increments/resets the emissions timestep counter ! (12) SET_CT_A3 : Increments/resets the A-3 fields timestep counter ! (13) SET_CT_A6 : Increments/resets the A-6 fields timestep counte ! (14) SET_CT_I6 : Increments/resets the I-6 fields timestep counter ! (15) SET_CT_XTRA : Increments/resets the I-6 fields timestep counter ! (16) SET_ELAPSED_MIN : Updates the elapsed minutes since the start of run ! (17) GET_JD : Returns Astronomical Julian Date for NYMD, NHMS ! (18) GET_ELAPSED_MIN : Returns the elapsed minutes since the start of run ! (19) GET_ELAPSED_SEC : Returns the elapsed seconds since the start of run ! (20) GET_NYMDb : Returns the YYYYMMDD at the beginning of the run ! (21) GET_NHMSb : Returns the HHMMSS at the beginning of the run ! (22) GET_NYMDe : Returns the YYYYMMDD at the end of the run ! (23) GET_NHMSe : Returns the HHMMSS at the end of the run ! (24) GET_NYMD : Returns the YYYYMMDD at the current time ! (25) GET_NHMS : Returns the HHMMSS at the current time ! (26) GET_NDIAGTIME : Returns NDIAGTIME (time of day to write bpch file) ! (27) GET_TIME_AHEAD : Returns the YYYYMMDD, HHMMSS for N_MINS from now ! (28) GET_MONTH : Returns the current month (1-12) ! (29) GET_DAY : Returns the current day of month (1-31) ! (30) GET_YEAR : Returns the current year (YYYY) ! (31) GET_HOUR : Returns the current hour (0-23) ! (32) GET_MINUTE : Returns the current minute (0-59) ! (33) GET_SECOND : Returns the current second (0-59) ! (34) GET_DAY_OF_YEAR : Returns the current day of the year (0-366) ! (35) GET_DAY_OF_WEEK : Returns the current day of the week (0-6) ! (36) GET_GMT : Returns the current GMT (0.0 - 23.999) ! (37) GET_TAU : Returns the current TAU value (hrs since 1/1/1985) ! (38) GET_TAUb : Returns TAU value at beginning of GEOS-CHEM run ! (39) GET_TAUe : Returns TAU value at end of GEOS-CHEM run ! (40) GET_DIAGb : Returns TAU value at start of diagnostic interval ! (41) GET_DIAGe : Returns TAU value at end of diagnostic interval ! (42) GET_LOCALTIME : Returns local time for a grid box (0.0 - 23.999) ! (43) GET_SEASON : Returns season flag (1=DJF, 2=MAM, 3=JJA, 4=SON) ! (44) GET_TS_CHEM : Returns chemistry timestep in minutes ! (45) GET_TS_CONV : Returns convection timestep in minutes ! (46) GET_TS_DIAG : Returns diagnostic timestep in minutes ! (47) GET_TS_DYN : Returns dynamic timestep in minutes ! (48) GET_TS_EMIS : Returns emissions timestep in minutes ! (49) GET_TS_UNIT : Returns unit conversion timestep in minutes ! (50) GET_CT_CHEM : Returns # of chemistry timesteps already executed ! (51) GET_CT_CONV : Returns # of convection timesteps already executed ! (52) GET_CT_DYN : Returns # of dynamic timesteps already executed ! (53) GET_CT_EMIS : Returns # of emission timesteps already executed ! (54) GET_CT_A3 : Returns # of times A-3 fields have been read in ! (55) GET_CT_A6 : Returns # of times A-6 fields have been read in ! (56) GET_CT_I6 : Returns # of times I-6 fields have been read in ! (57) GET_CT_XTRA : Returns # of times I-6 fields have been read in ! (58) GET_A3_TIME : Returns YYYYMMDD and HHMMSS for the A-3 fields ! (59) GET_A6_TIME : Returns YYYYMMDD and HHMMSS for the A-6 fields ! (60) GET_I6_TIME : Returns YYYYMMDD and HHMMSS for the I-6 fields ! (61) GET_FIRST_A3_TIME : Returns YYYYMMDD and HHMMSS for the first A-3 read ! (62) GET_FIRST_A3_TIME : Returns YYYYMMDD and HHMMSS for the first A-6 read ! (63) ITS_TIME_FOR_CHEM : Returns TRUE if it is time to do chemistry ! (64) ITS_TIME_FOR_CONV : Returns TRUE if it is time to do convection ! (65) ITS_TIME_FOR_DYN : Returns TRUE if it is time to do dynamics ! (66) ITS_TIME_FOR_EMIS : Returns TRUE if it is time to do emissions ! (67) ITS_TIME_FOR_UNIT : Returns TRUE if it is time to do unit conversions ! (68) ITS_TIME_FOR_DIAG : Returns TRUE if it is time to write diagnostics ! (69) ITS_TIME_FOR_A3 : Returns TRUE if it is time to read in A-3 fields ! (71) ITS_TIME_FOR_A6 : Returns TRUE if it is time to read in A-6 fields ! (72) ITS_TIME_FOR_I6 : Returns TRUE if it is time to read in I-6 fields ! (73) ITS_TIME_FOR_UNZIP: Returns TRUE if it is the end of the run ! (74) ITS_TIME_FOR_DEL : Returns TRUE if it is time to delete temp files ! (75) ITS_TIME_FOR_EXIT : Returns TRUE if it is the end of the run ! (76) ITS_TIME_FOR_BPCH : Returns TRUE if it's time to write bpch output ! (77) ITS_A_LEAPYEAR : Returns TRUE if the current year is a leapyear ! (78) ITS_A_NEW_YEAR : Returns TRUE if it's a new year ! (79) ITS_A_NEW_MONTH : Returns TRUE if it's a new month ! (80) ITS_MIDMONTH : Returns TRUE if it's 0 GMT on the 16th of the month ! (81) ITS_A_NEW_DAY : Returns TRUE if it's a new day ! (82) ITS_A_NEW_SEASON : Returns TRUE if it's a new season ! (83) TIMESTAMP_STRING : Returns a string "YYYY/MM/DD HH:MM:SS" ! (84) PRINT_CURRENT_TIME: Prints date time in YYYY/MM/DD, HH:MM:SS format ! (85) YMD_EXTRACT : Extracts YYYY, MM, DD from a YYYYMMDD format number ! (86) EXPAND_DATE : Replaces date/time tokens w/ actual values ! (87) SYSTEM_DATE_TIME : Returns the system date and time ! (88) SYSTEM_TIMESTAMP : Returns a string with the system date and time ! (89) CALC_RUN_DAYS : Returns the number of days of the run ! adj_group: add the following routines (dkh, 01/23/10) ! (90) ITS_TIME_FOR_EXIT_ADJ ! (91) ITS_A_NEW_DAY_ADJ ! (92) ITS_TIME_FOR_I6_ADJ ! (93) GET_I6_TIME_ADJ ! (94) ITS_TIME_FOR_A6_ADJ ! (95) GET_A6_TIME_ADJ ! (96) ITS_TIME_FOR_A3_ADJ ! (97) GET_A3_TIME_ADJ ! (98) GET_TIME_BEHIND_ADJ ! (99) ITS_TIME_TO_CHK_T_15_AVG ! (100) ITS_TIME_TO_GET_T_15_AVG ! (101) ITS_TIME_TO_GET_T_DAY ! ! GEOS-CHEM modules referenced by time_mod.f ! ============================================================================ ! (1 ) charpak_mod.f : Module containing string handling routines ! (2 ) error_mod.f : Module containing NaN and other error check routines ! (3 ) grid_mod.f : Module containing horizontal grid information ! (4 ) julday_mod.f : Module containing astronomical Julian date routines ! ! NOTES: ! (1 ) Updated comments (bmy, 9/4/01) ! (2 ) Added routine YMD_EXTRACT. Also rewrote TIMECHECK using astronomical ! Julian day routines from "julday_mod.f". (bmy, 11/21/01) ! (3 ) Eliminated obsolete code (bmy, 2/27/02) ! (4 ) Updated comments (bmy, 5/28/02) ! (5 ) Added routine "expand_date". Also now reference "charpak_mod.f". ! (bmy, 6/27/02) ! (6 ) Now references "error_mod.f". Also added function GET_SEASON, which ! returns the current season number. (bmy, 10/22/02) ! (7 ) Now added module variables and various GET_ and SET_ routines to ! access them. Now minutes are the smallest timing unit. (bmy, 3/21/03) ! (8 ) Bug fix in DATE_STRING (bmy, 5/15/03) ! (9 ) Added GET_FIRST_A3_TIME and GET_FIRST_A6_TIME. Also added changes for ! reading fvDAS fields. (bmy, 6/26/03) ! (10) Now allow ITS_A_LEAPYEAR to take an optional argument. Bug fix for ! Linux: must use ENCODE to convert numbers to strings (bmy, 9/29/03) ! (11) Bug fix in EXPAND_DATE. Also add optional arguments to function ! TIMESTAMP_STRNIG. (bmy, 10/28/03) ! (12) Changed the name of some cpp switches in "define.h" (bmy, 12/2/03) ! (13) Modified ITS_TIME_FOR_A6 and GET_FIRST_A6_TIME for both GEOS-4 ! "a_llk_03" and "a_llk_04" data versions. (bmy, 3/22/04) ! (14) Added routines ITS_A_NEW_MONTH, ITS_A_NEW_YEAR, ITS_A_NEW_DAY. ! (bmy, 4/1/04) ! (15) Added routines ITS_A_NEW_SEASON, GET_NDIAGTIME, SET_NDIAGTIME, and ! variable NDIAGTIME. (bmy, 7/20/04) ! (17) Added routine GET_DAY_OF_WEEK (bmy, 11/5/04) ! (18) Removed obsolete FIRST variable in GET_A3_TIME (bmy, 12/10/04) ! (19) Added routines SYSTEM_DATE_TIME and SYSTEM_TIMESTAMP. Also modified ! for GCAP and GEOS-5 met fields. (swu, bmy, 5/3/05) ! (20) GCAP/GISS met fields don't have leap years (swu, bmy, 8/29/05) ! (21) Added counter variable & routines for XTRA fields (tmf, bmy, 10/20/05) ! (22) Bug fix in ITS_A_NEW_YEAR (bmy, 11/1/05) ! (23) Added function ITS_MIDMONTH. Also removed obsolete functions ! NYMD_Y2K, NYMD6_2_NYMD8, NYMD_STRING, DATE_STRING. ! (sas, cdh, bmy, 12/15/05) ! (24) GCAP bug fix: There are no leapyears, so transition from 2/28 to 3/1, ! skipping 2/29 for all years. (swu, bmy, 4/24/06) ! (25) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06) ! (26) Further bug fix to skip over Feb 29th in GCAP (phs, bmy, 10/3/06) ! (27) Moved ITS_TIME_FOR_BPCH here from "main.f" (bmy, 2/2/07) ! (28) Added CALC_RUN_DAYS for adjoint purposes (mak, 6/07/09) !****************************************************************************** ! IMPLICIT NONE !================================================================= ! MODULE PRIVATE DECLARATIONS -- keep certain internal variables ! and routines from being seen outside "time_mod.f" !================================================================= ! Make everything PUBLIC ... PUBLIC ! ... except these variables ! comment out for calculation of NSPAN (fp) !PRIVATE :: NYMDb, NHMSb !PRIVATE :: NYMDe, NHMSe PRIVATE :: NYMD, NHMS PRIVATE :: MONTH, DAY, YEAR PRIVATE :: HOUR, MINUTE, SECOND PRIVATE :: NSEASON, DAY_OF_YEAR, ELAPSED_MIN PRIVATE :: TAU, TAUb, TAUe PRIVATE :: DIAGb, DIAGe, GMT PRIVATE :: TS_CHEM, TS_CONV, TS_DIAG PRIVATE :: TS_DYN, TS_EMIS, TS_UNIT PRIVATE :: CT_CHEM, CT_CONV, CT_DYN PRIVATE :: CT_EMIS, CT_A3, CT_A6 PRIVATE :: CT_I6, CT_XTRA, JD85 PRIVATE :: NDIAGTIME, DAY_OF_WEEK ! geos_fp (lzh, 04/10/2014) PRIVATE :: CT_A1, CT_I3 ! adj_group PRIVATE :: DIRECTION !================================================================= ! MODULE VARIABLES !================================================================= ! Date and time variables INTEGER :: NYMDb, NHMSb, NYMDe INTEGER :: NHMSe, NYMD, NHMS INTEGER :: MONTH, DAY, YEAR INTEGER :: HOUR, MINUTE, SECOND INTEGER :: NSEASON, DAY_OF_YEAR, ELAPSED_MIN INTEGER :: DAY_OF_WEEK ! Day of week (0=Sun,1=Mon,.., 6=Sat) INTEGER :: NDIAGTIME REAL*8 :: TAU, TAUb, TAUe REAL*8 :: GMT, DIAGb, DIAGe ! Timesteps INTEGER :: TS_CHEM, TS_CONV, TS_DIAG INTEGER :: TS_DYN, TS_EMIS, TS_UNIT ! Timestep counters INTEGER :: CT_CHEM, CT_CONV, CT_DYN INTEGER :: CT_EMIS, CT_A3, CT_A6 INTEGER :: CT_I6, CT_XTRA ! geos_fp (lzh, 04/10/2014) INTEGER :: CT_A1, CT_I3 ! Astronomical Julian Date at 0 GMT, 1 Jan 1985 REAL*8, PARAMETER :: JD85 = 2446066.5d0 ! adj_group INTEGER :: DIRECTION !================================================================= ! MODULE ROUTINES -- follow below the "CONTAINS" statement !================================================================= CONTAINS !------------------------------------------------------------------------------ SUBROUTINE SET_CURRENT_TIME ! !****************************************************************************** ! Subroutine SET_CURRENT_TIME takes in the elapsed time in minutes since the ! start of a GEOS-CHEM simulation and sets the GEOS-CHEM time variables ! accordingly. (bmy, 2/5/03, 10/3/06) ! ! NOTES: ! (1 ) GCAP/GISS fields don't have leap years, so if JULDAY says it's ! Feb 29th, reset MONTH, DAY, JD1 to Mar 1st. (swu, bmy, 8/29/05) ! (2 ) Now references "define.h". Now add special handling to skip from ! Feb 28th to Mar 1st for GCAP model. (swu, bmy, 4/24/06) ! (3 ) Fix bug in case of GCAP fields for runs that start during leap year ! and after February 29 (phs, 9/27/06) !****************************************************************************** ! ! References to F90 modules USE JULDAY_MOD, ONLY : JULDAY, CALDATE # include "define.h" ! Local variables LOGICAL :: IS_LEAPYEAR REAL*4 :: TMP REAL*8 :: JD0, JD1, JD_JAN_1 !================================================================= ! SET_CURRENT_TIME begins here! !================================================================= ! JD0: Astronomical Julian Date at start of GEOS-CHEM run JD0 = GET_JD( NYMDb, NHMSb ) ! JD1: Astronomical Julian Date at current time JD1 = JD0 + ( DBLE( ELAPSED_MIN ) / 1440d0 ) ! Call CALDATE to compute the current YYYYMMDD and HHMMSS CALL CALDATE( JD1, NYMD, NHMS ) ! Extract current year, month, day from NYMD CALL YMD_EXTRACT( NYMD, YEAR, MONTH, DAY ) #if defined( GCAP ) !------------------------------- ! GCAP met fields: no leapyears !------------------------------- ! Special handling for leap years IF ( ITS_A_LEAPYEAR( YEAR, FORCE=.TRUE. ) ) THEN ! Get Astronomical Julian Date on Jan 0th of this year JD_JAN_1 = GET_JD( YEAR*10000 + 0101, 000000 ) ! Skip directly from Feb 28 to Mar 1st IF ( ( JD1 - JD_JAN_1 >= 59d0 ) .and. & ( JD0 - JD_JAN_1 <= 59d0 ) ) THEN JD1 = JD1 + 1d0 ENDIF ! Call CALDATE to recompute YYYYMMDD and HHMMSS CALL CALDATE( JD1, NYMD, NHMS ) ! Extract current year, month, day from NYMD CALL YMD_EXTRACT( NYMD, YEAR, MONTH, DAY ) ENDIF #endif ! Extract current hour, minute, second from NHMS CALL YMD_EXTRACT( NHMS, HOUR, MINUTE, SECOND ) ! Fix minutes & seconds for display purposes (esp. for 1x1) IF ( SECOND == 59 ) SECOND = 0 IF ( MOD( MINUTE+1, 10 ) == 0 ) MINUTE = MINUTE + 1 !================================================================= ! Compute other GEOS-CHEM timing variables !================================================================= ! Current Greenwich Mean Time GMT = ( DBLE( HOUR ) ) + & ( DBLE( MINUTE ) / 60d0 ) + & ( DBLE( SECOND ) / 3600d0 ) ! Days elapsed in this year (0-366) DAY_OF_YEAR = JD1 - JULDAY( YEAR, 1, 0d0 ) ! TAU value (# of hours since 1 Jan 1985) ! NOTE: TMP is REAL*4 to prevent precision problems TMP = ( JD1 - JD85 ) * 24e0 TAU = DBLE( TMP ) ! Season index (1=DJF, 2=MAM, 3=JJA, 4=SON) SELECT CASE ( MONTH ) CASE ( 12, 1, 2 ) NSEASON = 1 CASE ( 3, 4, 5 ) NSEASON = 2 CASE ( 6, 7, 8 ) NSEASON = 3 CASE ( 9, 10, 11 ) NSEASON = 4 END SELECT ! Return to calling program END SUBROUTINE SET_CURRENT_TIME !------------------------------------------------------------------------------ SUBROUTINE SET_BEGIN_TIME( THISNYMDb, THISNHMSb ) ! !****************************************************************************** ! Subroutine SET_BEGIN_TIME initializes NYMDb, NHMSb, and TAUb, which are the ! YYYYMMDD, HHMMSS, and hours since 1/1/1985 corresponding to the beginning ! date and time of a GEOS-CHEM run. (bmy, 2/5/03, 7/20/04) ! ! Arguments as Input: ! ============================================================================ ! (1 ) THISNYMDb (INTEGER) : YYYYMMDD at beginning of GEOS-CHEM run ! (2 ) THISNHMSb (INTEGER) : HHMMSS at beginning of GEOS-CHEM run ! ! NOTES: ! (1 ) Added error check for THISNHMSb (bmy, 7/20/04) !****************************************************************************** ! ! References to F90 modules USE ERROR_MOD, ONLY : ERROR_STOP ! Arguments INTEGER, INTENT(IN) :: THISNYMDb, THISNHMSb ! Local variables REAL*4 :: TMP !================================================================= ! SET_BEGIN_TIME begins here! !================================================================= ! Make sure NHMSb is valid IF ( THISNHMSb > 235959 ) THEN CALL ERROR_STOP( 'NHMSb cannot be greater than 23:59:59!', & 'SET_BEGIN_TIME (time_mod.f)' ) ENDIF ! Make sure THISNYMDb uses 4 digits for the year ! and is not less than 1985/01/01 IF ( THISNYMDb < 19850101 ) THEN CALL ERROR_STOP( 'NYMDb must be in the format YYYYMMDD!', & 'SET_BEGIN_TIME (time_mod.f)' ) ENDIF ! Initialize NYMDb, NHMSb NYMDb = THISNYMDb NHMSb = THISNHMSb ! TAUb value (TMP is REAL*4 to prevent precision problems) TMP = ( GET_JD( NYMDb, NHMSb ) - JD85 ) * 24e0 TAUb = DBLE( TMP ) ! Also initialize ELAPSED_MIN ELAPSED_MIN = 0 ! Return to calling program END SUBROUTINE SET_BEGIN_TIME !------------------------------------------------------------------------------ SUBROUTINE SET_END_TIME( THISNYMDe, THISNHMSe ) ! !****************************************************************************** ! Subroutine SET_END_TIME initializes NYMDe, NHMSe, and TAUe, which are the ! YYYYMMDD, HHMMSS, and hours since 1/1/1985 corresponding to the ending ! date and time of a GEOS-CHEM run. (bmy, 2/5/03, 7/20/04) ! ! Arguments as Input: ! ============================================================================ ! (1 ) THISNYMDe (INTEGER) : YYYYMMDD at end of GEOS-CHEM run ! (2 ) THISNHMSe (INTEGER) : HHMMSS at end of GEOS-CHEM run ! ! NOTES: ! (1 ) Added error check for THISNHMSb (bmy, 7/20/04) !****************************************************************************** ! ! References to F90 modules USE ERROR_MOD, ONLY : ERROR_STOP ! Arguments INTEGER, INTENT(IN) :: THISNYMDe, THISNHMSe ! Local variables REAL*4 :: TMP !================================================================= ! SET_END_TIME begins here! !================================================================= ! Error check to make sure IF ( THISNHMSe > 235959 ) THEN CALL ERROR_STOP( 'NHMSe cannot be greater than 23:59:59!', & 'SET_END_TIME (time_mod.f)' ) ENDIF ! Make sure THISNYMDb uses 4 digits for the year ! and is not less than 1985/01/01 IF ( THISNYMDe < 19850101 ) THEN CALL ERROR_STOP( 'NYMDe must be in the format YYYYMMDD!', & 'SET_END_TIME (time_mod.f)' ) ENDIF ! Initialize NYMDe, NHMSe NYMDe = THISNYMDe NHMSe = THISNHMSe ! TAUe value (TMP is REAL*4 to prevent precision problems) TMP = ( GET_JD( NYMDe, NHMSe ) - JD85 ) * 24e0 TAUe = DBLE( TMP ) ! Return to calling program END SUBROUTINE SET_END_TIME !------------------------------------------------------------------------------ SUBROUTINE SET_NDIAGTIME( THIS_NDIAGTIME ) ! !****************************************************************************** ! Subroutine SET_NDIAGTIME initializes NDIAGTIME, the time of day at which ! the binary punch file will be written out to disk. (bmy, 7/20/04) ! ! NOTES: !****************************************************************************** ! ! Arguments INTEGER, INTENT(IN) :: THIS_NDIAGTIME !================================================================= ! SET_NDIAGTIME begins here! !================================================================= NDIAGTIME = THIS_NDIAGTIME ! Return to calling program END SUBROUTINE SET_NDIAGTIME !------------------------------------------------------------------------------ SUBROUTINE SET_DIAGb( THISDIAGb ) ! !****************************************************************************** ! Subroutine SET_DIAGb initializes DIAGb, the TAU value at the beginning ! of the diagnostic averaging interval. (bmy, 3/21/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) THISDIAGb (INTEGER) : TAU value at beginning of diagnostic interval ! ! NOTES: !****************************************************************************** ! ! Arguments REAL*8, INTENT(IN) :: THISDIAGb !================================================================= ! SET_DIAGb begins here! !================================================================= DIAGb = THISDIAGb ! Return to calling program END SUBROUTINE SET_DIAGb !------------------------------------------------------------------------------ SUBROUTINE SET_DIAGe( THISDIAGe ) ! !****************************************************************************** ! Subroutine SET_DIAGe initializes DIAGe, the TAU value at the end ! of the diagnostic averaging interval. (bmy, 3/21/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) THISDIAGe (INTEGER) : TAU value at end of diagnostic interval ! ! NOTES: !****************************************************************************** ! ! Arguments REAL*8, INTENT(IN) :: THISDIAGe !================================================================= ! SET_DIAGe begins here! !================================================================= DIAGe = THISDIAGe ! Return to calling program END SUBROUTINE SET_DIAGe !------------------------------------------------------------------------------ SUBROUTINE SET_TIMESTEPS( CHEMISTRY, CONVECTION, & DYNAMICS, EMISSION, UNIT_CONV ) ! !****************************************************************************** ! Subroutine SET_TIMESTEPS initializes the timesteps for dynamics, convection, ! chemistry, and emissions. Counters are also zeroed. (bmy, 3/21/03,10/20/05) ! ! Arguments as Input: ! ============================================================================ ! (1 ) CHEMISTRY (INTEGER) : Chemistry timestep [minutes] ! (2 ) CONVECTION (INTEGER) : Convective timestep [minutes] ! (3 ) DYNAMICS (INTEGER) : Dynamic timestep [minutes] ! (4 ) EMISSION (INTEGER) : Emissions timestep [minutes] ! (4 ) UNIT_CONV (INTEGER) : Unit conversion timestep [minutes] ! ! NOTES: ! (1 ) Suppress some output lines (bmy, 7/20/04) ! (2 ) Also zero CT_XTRA (tmf, bmy, 10/20/05) !****************************************************************************** ! ! Arguments INTEGER, INTENT(IN) :: CHEMISTRY, CONVECTION, DYNAMICS INTEGER, INTENT(IN) :: EMISSION, UNIT_CONV !================================================================= ! SET_TIMESTEPS begins here! !================================================================= ! Initialize timesteps TS_CHEM = CHEMISTRY TS_CONV = CONVECTION TS_DYN = DYNAMICS TS_EMIS = EMISSION TS_UNIT = UNIT_CONV ! Zero timestep counters CT_CHEM = 0 CT_CONV = 0 CT_DYN = 0 CT_EMIS = 0 CT_A3 = 0 CT_A6 = 0 CT_I6 = 0 CT_XTRA = 0 ! (lzh, 04/10/2014) CT_A1 = 0 CT_I3 = 0 ! Echo to stdout WRITE( 6, '(/,a)' ) 'SET_TIMESTEPS: setting GEOS-CHEM timesteps!' WRITE( 6, '( a)' ) '-------------------------------------------' WRITE( 6, '(''Chemistry Timestep [min] : '', i4 )' ) TS_CHEM WRITE( 6, '(''Convection Timestep [min] : '', i4 )' ) TS_CONV WRITE( 6, '(''Dynamics Timestep [min] : '', i4 )' ) TS_DYN WRITE( 6, '(''Emission Timestep [min] : '', i4 )' ) TS_EMIS WRITE( 6, '(''Unit Conv Timestep [min] : '', i4 )' ) TS_UNIT ! Return to calling program END SUBROUTINE SET_TIMESTEPS !------------------------------------------------------------------------------ SUBROUTINE SET_CT_CHEM( INCREMENT, RESET ) ! !****************************************************************************** ! Subroutine SET_CT_CHEM increments CT_CHEM, the counter of chemistry ! timesteps executed thus far. (bmy, 3/21/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) INCREMENT (LOGICAL) : If specified, then will increment counter ! (2 ) RESET (LOGICAL) : If specified, then will reset counter to zero ! ! NOTES: !****************************************************************************** ! ! Arguments LOGICAL, INTENT(IN), OPTIONAL :: INCREMENT, RESET !================================================================= ! SET_CT_CHEM begins here! !================================================================= IF ( PRESENT( INCREMENT ) ) THEN CT_CHEM = CT_CHEM + 1 ELSE IF ( PRESENT( RESET ) ) THEN CT_CHEM = 0 ENDIF ! Return to calling program END SUBROUTINE SET_CT_CHEM !------------------------------------------------------------------------------ SUBROUTINE SET_CT_CONV( INCREMENT, RESET ) ! !****************************************************************************** ! Subroutine SET_CT_CONV increments CT_CONV, the counter of convection ! timesteps executed thus far. (bmy, 3/21/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) INCREMENT (LOGICAL) : If T, then will increment counter ! (2 ) RESET (LOGICAL) : If T, then will reset counter to zero! ! ! NOTES: !****************************************************************************** ! ! Arguments LOGICAL, INTENT(IN), OPTIONAL :: INCREMENT, RESET !================================================================= ! SET_CT_CONV begins here! !================================================================= IF ( PRESENT( INCREMENT ) ) THEN CT_CONV = CT_CONV + 1 ELSE IF ( PRESENT( RESET ) ) THEN CT_CONV = 0 ENDIF ! Return to calling program END SUBROUTINE SET_CT_CONV !------------------------------------------------------------------------------ SUBROUTINE SET_CT_DYN( INCREMENT, RESET ) ! !****************************************************************************** ! Subroutine SET_CT_DYN increments CT_DYN, the counter of dynamic ! timesteps executed thus far. (bmy, 3/21/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) INCREMENT (LOGICAL) : If T, then will increment counter ! (2 ) RESET (LOGICAL) : If T, then will reset counter to zero! ! ! NOTES: !****************************************************************************** ! ! Arguments LOGICAL, INTENT(IN), OPTIONAL :: INCREMENT, RESET !================================================================= ! SET_CT_DYN begins here! !================================================================= IF ( PRESENT( INCREMENT ) ) THEN CT_DYN = CT_DYN + 1 ELSE IF ( PRESENT( RESET ) ) THEN CT_DYN = 0 ENDIF ! Return to calling program END SUBROUTINE SET_CT_DYN !------------------------------------------------------------------------------ SUBROUTINE SET_CT_EMIS( INCREMENT, RESET ) ! !****************************************************************************** ! Subroutine SET_CT_EMIS increments CT_EMIS, the counter of emission ! timesteps executed thus far. (bmy, 3/21/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) INCREMENT (LOGICAL) : If T, then will increment counter ! (2 ) RESET (LOGICAL) : If T, then will reset counter to zero! ! ! NOTES: !****************************************************************************** ! ! Arguments LOGICAL, INTENT(IN), OPTIONAL :: INCREMENT, RESET !================================================================= ! SET_CT_EMIS begins here! !================================================================= IF ( PRESENT( INCREMENT ) ) THEN CT_EMIS = CT_EMIS + 1 ELSE IF ( PRESENT( RESET ) ) THEN CT_EMIS = 0 ENDIF ! Return to calling program END SUBROUTINE SET_CT_EMIS !------------------------------------------------------------------------------ SUBROUTINE SET_CT_A3( INCREMENT, RESET ) ! !****************************************************************************** ! Subroutine SET_CT_A3 increments CT_A3, the counter of the number of times ! we have read in A-3 fields. (bmy, 3/21/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) INCREMENT (LOGICAL) : If T, then will increment counter ! (2 ) RESET (LOGICAL) : If T, then will reset counter to zero! ! ! NOTES: !****************************************************************************** ! ! Arguments LOGICAL, INTENT(IN), OPTIONAL :: INCREMENT, RESET !================================================================= ! SET_CT_A3 begins here! !================================================================= IF ( PRESENT( INCREMENT ) ) THEN CT_A3 = CT_A3 + 1 ELSE IF ( PRESENT( RESET ) ) THEN CT_A3 = 0 ENDIF ! Return to calling program END SUBROUTINE SET_CT_A3 !------------------------------------------------------------------------------ SUBROUTINE SET_CT_A6( INCREMENT, RESET ) ! !****************************************************************************** ! Subroutine SET_CT_A6 increments CT_A6, the counter of the number of times ! we have read in A-6 fields. (bmy, 3/21/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) INCREMENT (LOGICAL) : If T, then will increment counter ! (2 ) RESET (LOGICAL) : If T, then will reset counter to zero! ! ! NOTES: !****************************************************************************** ! ! Arguments LOGICAL, INTENT(IN), OPTIONAL :: INCREMENT, RESET !================================================================= ! SET_CT_A3 begins here! !================================================================= IF ( PRESENT( INCREMENT ) ) THEN CT_A6 = CT_A6 + 1 ELSE IF ( PRESENT( RESET ) ) THEN CT_A6 = 0 ENDIF ! Return to calling program END SUBROUTINE SET_CT_A6 !!! (lzh, 04/10/2014) !------------------------------------------------------------------------------ SUBROUTINE SET_CT_A1( INCREMENT, RESET ) ! !****************************************************************************** ! Subroutine SET_CT_A3 increments CT_A3, the counter of the number of times ! we have read in A-3 fields. (bmy, 3/21/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) INCREMENT (LOGICAL) : If T, then will increment counter ! (2 ) RESET (LOGICAL) : If T, then will reset counter to zero! ! ! NOTES: !****************************************************************************** ! ! Arguments LOGICAL, INTENT(IN), OPTIONAL :: INCREMENT, RESET !================================================================= ! SET_CT_A3 begins here! !================================================================= IF ( PRESENT( INCREMENT ) ) THEN CT_A1 = CT_A1 + 1 ELSE IF ( PRESENT( RESET ) ) THEN CT_A1 = 0 ENDIF ! Return to calling program END SUBROUTINE SET_CT_A1 !------------------------------------------------------------------------------ SUBROUTINE SET_CT_I3( INCREMENT, RESET ) ! !****************************************************************************** ! Subroutine SET_CT_A3 increments CT_A3, the counter of the number of times ! we have read in A-3 fields. (bmy, 3/21/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) INCREMENT (LOGICAL) : If T, then will increment counter ! (2 ) RESET (LOGICAL) : If T, then will reset counter to zero! ! ! NOTES: !****************************************************************************** ! ! Arguments LOGICAL, INTENT(IN), OPTIONAL :: INCREMENT, RESET !================================================================= ! SET_CT_A3 begins here! !================================================================= IF ( PRESENT( INCREMENT ) ) THEN CT_I3 = CT_I3 + 1 ELSE IF ( PRESENT( RESET ) ) THEN CT_I3 = 0 ENDIF ! Return to calling program END SUBROUTINE SET_CT_I3 !------------------------------------------------------------------------------ SUBROUTINE SET_CT_I6( INCREMENT, RESET ) ! !****************************************************************************** ! Subroutine SET_CT_I6 increments CT_I6, the counter of the number of times ! we have read in I-6 fields. (bmy, 3/21/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) INCREMENT (LOGICAL) : If T, then will increment counter ! (2 ) RESET (LOGICAL) : If T, then will reset counter to zero! ! ! NOTES: !****************************************************************************** ! ! Arguments LOGICAL, INTENT(IN), OPTIONAL :: INCREMENT, RESET !================================================================= ! SET_CT_I6 begins here! !================================================================= IF ( PRESENT( INCREMENT ) ) THEN CT_I6 = CT_I6 + 1 ELSE IF ( PRESENT( RESET ) ) THEN CT_I6 = 0 ENDIF ! Return to calling program END SUBROUTINE SET_CT_I6 !------------------------------------------------------------------------------ SUBROUTINE SET_CT_XTRA( INCREMENT, RESET ) ! !****************************************************************************** ! Subroutine SET_CT_XTRA increments CT_XTRA, the counter of the number of ! times we have read in GEOS-3 XTRA fields. (tmf, bmy, 10/20/05) ! ! Arguments as Input: ! ============================================================================ ! (1 ) INCREMENT (LOGICAL) : If T, then will increment counter ! (2 ) RESET (LOGICAL) : If T, then will reset counter to zero! ! ! NOTES: !****************************************************************************** ! ! Arguments LOGICAL, INTENT(IN), OPTIONAL :: INCREMENT, RESET !================================================================= ! SET_CT_I6 begins here! !================================================================= IF ( PRESENT( INCREMENT ) ) THEN CT_XTRA = CT_XTRA + 1 ELSE IF ( PRESENT( RESET ) ) THEN CT_XTRA = 0 ENDIF ! Return to calling program END SUBROUTINE SET_CT_XTRA !------------------------------------------------------------------------------ SUBROUTINE SET_ELAPSED_MIN ! !****************************************************************************** ! Subroutine SET_ELAPSED_MIN increments the number of elapsed minutes by ! the dynamic timestep TS_DYN. (bmy, 3/21/03) !****************************************************************************** ! !================================================================= ! SET_ELAPSED_MIN begins here! !================================================================= ELAPSED_MIN = ELAPSED_MIN + TS_DYN ! Return to calling program END SUBROUTINE SET_ELAPSED_MIN !------------------------------------------------------------------------------ FUNCTION GET_JD( THISNYMD, THISNHMS ) RESULT( THISJD ) ! !****************************************************************************** ! Function GET_JD is a wrapper for the JULDAY routine. Given the current ! NYMD and NHMS values, GET_JD will return the current astronomical Julian ! date. (bmy, 3/21/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) THISNYMD (INTEGER) : YYYYMMDD value ! (2 ) THISNHMS (INTEGER) : HHMMSS value ! ! NOTES: !****************************************************************************** ! ! References to F90 m odules USE JULDAY_MOD, ONLY : JULDAY ! Arguments INTEGER, INTENT(IN) :: THISNYMD, THISNHMS ! Local variables INTEGER :: Y, M, D, H, MI, S REAL*8 :: DAY ! Function variable REAL*8 :: THISJD !================================================================= ! GET_JD begins here! !================================================================= ! Extract year, month, day from NYMDb CALL YMD_EXTRACT( THISNYMD, Y, M, D ) ! Extract hour, minute, second from NHMSb CALL YMD_EXTRACT( THISNHMS, H, MI, S ) ! Decimal day (including fractional part) DAY = DBLE( D ) + ( DBLE( H ) / 24d0 ) + & ( DBLE( MI ) / 1440d0 ) + & ( DBLE( S ) / 86400d0 ) ! Compute astronomical Julian day at start of run THISJD = JULDAY( Y, M, DAY ) ! Return to the calling program END FUNCTION GET_JD !------------------------------------------------------------------------------ FUNCTION GET_ELAPSED_MIN() RESULT( THIS_ELAPSED_MIN ) ! !****************************************************************************** ! Function GET_ELAPSED_MIN returns the elapsed minutes since the start of ! a GEOS_CHEM run to the calling program (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_ELAPSED_MIN !================================================================= ! GET_ELAPSED_MIN begins here! !================================================================= THIS_ELAPSED_MIN = ELAPSED_MIN ! Return to calling program END FUNCTION GET_ELAPSED_MIN !------------------------------------------------------------------------------ FUNCTION GET_ELAPSED_SEC() RESULT( THIS_ELAPSED_SEC ) ! !****************************************************************************** ! Function GET_ELAPSED_SEC returns the elapsed minutss since the start of ! a GEOS_CHEM run to the calling program (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_ELAPSED_SEC !================================================================= ! GET_ELAPSED_SEC begins here! !================================================================= THIS_ELAPSED_SEC = ELAPSED_MIN * 60 ! Return to calling program END FUNCTION GET_ELAPSED_SEC !------------------------------------------------------------------------------ FUNCTION GET_NYMDb() RESULT( THISNYMDb ) ! !****************************************************************************** ! Function GET_NYMDb returns the NYMDb value (YYYYMMDD at the beginning of ! the run) to the calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THISNYMDb !================================================================= ! GET_NYMDb begins here! !================================================================= THISNYMDb = NYMDb ! Return to calling program END FUNCTION GET_NYMDb !------------------------------------------------------------------------------ FUNCTION GET_NHMSb() RESULT( THISNHMSb ) ! !****************************************************************************** ! Function GET_NHMSb returns the NHMSb value (HHMMSS at the beginning ! of the run) to the calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THISNHMSb !================================================================= ! GET_NHMSb begins here! !================================================================= THISNHMSb = NHMSb ! Return to calling program END FUNCTION GET_NHMSb !------------------------------------------------------------------------------ FUNCTION GET_NYMDe() RESULT( THISNYMDe ) ! !****************************************************************************** ! Function GET_NYMDe returns the NYMDe value (YYYYMMDD at the end of ! the run) to the calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THISNYMDe !================================================================= ! GET_NYMDe begins here! !================================================================= THISNYMDe = NYMDe ! Return to calling program END FUNCTION GET_NYMDe !------------------------------------------------------------------------------ FUNCTION GET_NHMSe() RESULT( THISNHMSe ) ! !****************************************************************************** ! Function GET_NHMSe returns the NHMSe value (HHMMSS at the end ! of the run) to the calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THISNHMSe !================================================================= ! GET_NHMSe begins here! !================================================================= THISNHMSe = NHMSe ! Return to calling program END FUNCTION GET_NHMSe !------------------------------------------------------------------------------ FUNCTION GET_NYMD() RESULT( THISNYMD ) ! !****************************************************************************** ! Function GET_NYMD returns the current NYMD value (YYYYMMDD) to the ! calling program. (bmy, 2/5/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THISNYMD !================================================================= ! GET_NYMD begins here! !================================================================= THISNYMD = NYMD ! Return to calling program END FUNCTION GET_NYMD !------------------------------------------------------------------------------ FUNCTION GET_NHMS() RESULT( THISNHMS ) ! !****************************************************************************** ! Function GET_NHMS returns the current NHMS value (HHMMSS) to the ! calling program. (bmy, 2/5/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THISNHMS !================================================================= ! GET_NHMS begins here! !================================================================= THISNHMS = NHMS ! Return to calling program END FUNCTION GET_NHMS !------------------------------------------------------------------------------ FUNCTION GET_NDIAGTIME() RESULT( THIS_NDIAGTIME ) ! !****************************************************************************** ! Subroutine GET_NDIAGTIME returns to the calling program NDIAGTIME, the ! time of day at which the binary punch file will be written out to disk. ! (bmy, 7/20/04) ! ! NOTES: !****************************************************************************** ! ! Local variables INTEGER :: THIS_NDIAGTIME !================================================================= ! GET_NDIAGTIME begins here! !================================================================= THIS_NDIAGTIME = NDIAGTIME ! Return to calling program END FUNCTION GET_NDIAGTIME !------------------------------------------------------------------------------ FUNCTION GET_TIME_AHEAD( N_MINS ) RESULT( DATE ) ! !****************************************************************************** ! Function GET_3h_AHEAD returns to the calling program a 2-element vector ! containing the YYYYMMDD and HHMMSS values at the current time plus N_MINS ! minutes. (bmy, 3/21/03, 12/8/06) ! ! Arguments as Input: ! ============================================================================ ! (1 ) N_MINS (INTEGER) : Minutes ahead of time to compute YYYYMMDD,HHMMSS ! ! NOTES: ! (1 ) Bug fix for GCAP leap year case (phs, bmy, 12/8/06) !****************************************************************************** ! ! References to F90 modules USE JULDAY_MOD, ONLY : CALDATE # include "define.h" ! C-preprocessor flags ! Arguments INTEGER, INTENT(IN) :: N_MINS ! Local variables INTEGER :: DATE(2), THISYEAR, THISMONTH, THISDAY REAL*8 :: JD !================================================================= ! GET_TIME_AHEAD begins here! !================================================================= ! Astronomical Julian Date at current time + N_MINS JD = GET_JD( NYMD, NHMS ) + ( N_MINS / 1440d0 ) ! Call CALDATE to compute the current YYYYMMDD and HHMMSS CALL CALDATE( JD, DATE(1), DATE(2) ) #if defined( GCAP ) !------------------------------- ! GCAP met fields: no leapyears !------------------------------- ! Extract current year, month, day from DATE(1) CALL YMD_EXTRACT( DATE(1), THISYEAR, THISMONTH, THISDAY ) ! Special handling for leap years IF ( ITS_A_LEAPYEAR( THISYEAR, FORCE=.TRUE. ) .AND. & THISMONTH == 2 .AND. & THISDAY == 29 ) THEN DATE(1) = ( THISYEAR * 10000 ) + 0301 ENDIF #endif ! Return to calling program END FUNCTION GET_TIME_AHEAD !------------------------------------------------------------------------------ FUNCTION GET_MONTH() RESULT( THISMONTH ) ! !****************************************************************************** ! Function GET_MONTH returns the current month to the calling program. ! (bmy, 2/5/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THISMONTH !================================================================= ! GET_MONTH begins here! !================================================================= THISMONTH = MONTH ! Return to calling program END FUNCTION GET_MONTH !------------------------------------------------------------------------------ FUNCTION GET_DAY() RESULT( THISDAY ) ! !****************************************************************************** ! Function GET_DAY returns the current day to the calling program. ! (bmy, 2/5/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THISDAY !================================================================= ! GET_DAY begins here! !================================================================= THISDAY = DAY ! Return to calling program END FUNCTION GET_DAY !------------------------------------------------------------------------------ FUNCTION GET_YEAR() RESULT( THISYEAR ) ! !****************************************************************************** ! Function GET_YEAR returns the current year to the calling program. ! (bmy, 2/5/03) !****************************************************************************** ! ! Function value INTEGER :: THISYEAR !================================================================= ! GET_YEAR begins here! !================================================================= THISYEAR = YEAR ! Return to calling program END FUNCTION GET_YEAR !------------------------------------------------------------------------------ FUNCTION GET_HOUR() RESULT( THISHOUR ) ! !****************************************************************************** ! Function GET_HOUR returns the current hour to the calling program. ! (bmy, 2/5/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THISHOUR !================================================================= ! GET_HOUR begins here! !================================================================= THISHOUR = HOUR ! Return to calling program END FUNCTION GET_HOUR !------------------------------------------------------------------------------ FUNCTION GET_MINUTE() RESULT( THISMINUTE ) ! !****************************************************************************** ! Function GET_MINUTE returns the current minute to the calling program ! (bmy, 2/5/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THISMINUTE !================================================================= ! GET_MINUTE begins here! !================================================================= THISMINUTE = MINUTE ! Return to calling program END FUNCTION GET_MINUTE !------------------------------------------------------------------------------ FUNCTION GET_SECOND() RESULT( THISSECOND ) ! !****************************************************************************** ! Function GET_SECOND returns the current seconds to the calling program. ! (bmy, 2/5/03) !****************************************************************************** ! ! Function value INTEGER :: THISSECOND !================================================================= ! GET_SECOND begins here! !================================================================= THISSECOND = SECOND ! Return to calling program END FUNCTION GET_SECOND !------------------------------------------------------------------------------ FUNCTION GET_DAY_OF_YEAR() RESULT( THISDAYOFYEAR ) ! !****************************************************************************** ! Function GET_DAY_OF_YEAR returns the current day of the year (0-365 or ! 0-366 for leap years) to the calling program. (bmy, 2/5/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THISDAYOFYEAR !================================================================= ! GET_DAY_OF_YEAR begins here! !================================================================= THISDAYOFYEAR = DAY_OF_YEAR ! Return to calling program END FUNCTION GET_DAY_OF_YEAR !------------------------------------------------------------------------------ FUNCTION GET_DAY_OF_WEEK() RESULT( DAY_NUM ) ! !****************************************************************************** ! Function GET_DAY_OF_WEEK returns the day of the week as a number: ! Sun=0, Mon=1, Tue=2, Wed=3, Thu=4, Fri=5, Sat=6. (bmy, 11/5/04) ! ! Reference: ! ============================================================================ ! "Practical Astronomy with Your Calculator", 3rd Ed. Peter Duffett-Smith, ! Cambridge UP, 1992, p9. ! ! NOTES: !****************************************************************************** ! ! References to F90 modules USE JULDAY_MOD, ONLY : JULDAY ! Return value INTEGER :: DAY_NUM ! Local variables REAL*8 :: A, B, JD, THISDAY !================================================================= ! GET_DAY_OF_WEEK begins here! !================================================================= ! Get fractional day THISDAY = DAY + ( HOUR / 24d0 ) + & ( MINUTE / 1440d0 ) + ( SECOND / 86400d0 ) ! Get current Julian date JD = JULDAY( YEAR, MONTH, THISDAY ) ! Add 1.5 to JD and divide by 7 A = ( JD + 1.5d0 ) / 7d0 ! Take fractional part and multiply by 7 B = ( A - INT( A ) ) * 7d0 ! Round to nearest integer -- this is the day number! DAY_NUM = INT( B + 0.5d0 ) ! Return to calling program END FUNCTION GET_DAY_OF_WEEK !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: get_day_of_week_lt ! ! !DESCRIPTION: Function GET\_DAY\_OF\_WEEK\_LT returns the day of the week ! (with repect to the SOLAR LOCAL TIME AT GRID BOX [I,J,L]) as a number: ! Sun=0, Mon=1, Tue=2, Wed=3, Thu=4, Fri=5, Sat=6. !\\ !\\ ! !INTERFACE: ! FUNCTION GET_DAY_OF_WEEK_LT( I, J, L ) RESULT( DAY_NUM ) ! ! !USES: ! USE GRID_MOD, ONLY : GET_XMID ! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: I ! Grid box lon index INTEGER, INTENT(IN) :: J ! Grid box lat index INTEGER, INTENT(IN) :: L ! Grid box level index ! ! !RETURN VALUE: ! INTEGER :: DAY_NUM ! Day of week, w/r/t local time ! ! !REMARKS: ! This routine is used by various emissions routines, in order to determine ! whether weekday or weekend emissions need to be applied. ! ! !REVISION HISTORY: ! 13 Jun 2013 - R. Yantosca - Initial version !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! REAL*8 :: DOW_LOCAL, LOCAL_TIME !================================================================= ! GET_DAY_OF_WEEK begins here! !================================================================= ! Get the local time [hrs] at grid box (I,J,L), ! but do not force it into the range of [0..24] hours. LOCAL_TIME = GMT + ( GET_XMID( I ) / 15d0 ) ! Add the local fraction of day elapsed to the day of week ! obtained w/r/t the GREENWICH MEAN TIME. This accounts for ! the distance of grid box (I,J,L) from the Greenwich meridian. DOW_LOCAL = DBLE( DAY_OF_WEEK ) + ( LOCAL_TIME / 24d0 ) ! If DOW_LOCAL is negative, then we need to add 7. ! This means that the day of week w/r/t GMT is Sunday ! but that it is still Saturday at grid box (I,J,L). IF ( DOW_LOCAL < 0d0 ) THEN DOW_LOCAL = DOW_LOCAL + 7d0 ENDIF ! Force the day of week w/r/t LOCAL TIME to fall ! within the range 0 (Sunday) thru 6 (Saturday). DOW_LOCAL = MOD( DOW_LOCAL, 7d0 ) ! Cast to integer and return result DAY_NUM = INT( DOW_LOCAL ) END FUNCTION GET_DAY_OF_WEEK_LT !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: get_gmt ! ! !DESCRIPTION: Function GET\_GMT returns the current Greenwich Mean Time ! to the calling program. !\\ !\\ ! !INTERFACE: ! FUNCTION GET_GMT() RESULT( THISGMT ) ! ! !RETURN VALUE: ! REAL*8 :: THISGMT ! Greenwich mean time [hrs] ! ! !REVISION HISTORY: ! 05 Feb 2003 - R. Yantosca - Initial Version ! 15 Jan 2010 - R. Yantosca - Added ProTeX headers !EOP !------------------------------------------------------------------------------ !BOC ! THISGMT = GMT END FUNCTION GET_GMT !EOC FUNCTION GET_TAU() RESULT( THISTAU ) ! !****************************************************************************** ! Function GET_TAU returns the current TAU (# of hours since 1 Jan 1985) ! value to the calling program. (bmy, 2/5/03) ! ! NOTES: !****************************************************************************** ! ! Function value REAL*8 :: THISTAU !================================================================= ! GET_TAUb begins here! !================================================================= THISTAU = TAU ! Return to calling program END FUNCTION GET_TAU !------------------------------------------------------------------------------ FUNCTION GET_TAUb() RESULT( THISTAUb ) ! !****************************************************************************** ! Function GET_TAUb returns TAUb (# of hours since 1 Jan 1985 at the ! start of a GEOS-CHEM run) to the calling program. (bmy, 2/5/03) ! ! NOTES: !****************************************************************************** ! ! Function value REAL*8 :: THISTAUb !================================================================= ! GET_TAUb begins here! !================================================================= THISTAUb = TAUb ! Return to calling program END FUNCTION GET_TAUb !------------------------------------------------------------------------------ FUNCTION GET_TAUe() RESULT( THISTAUe ) ! !****************************************************************************** ! Function GET_TAUe returns TAUe (# of hours since 1 Jan 1985 at the ! end of a GEOS-CHEM run) to the calling program. (bmy, 2/5/03) ! ! NOTES: !****************************************************************************** ! ! Function value REAL*8 :: THISTAUe !================================================================= ! GET_TAUe begins here! !================================================================= THISTAUe = TAUe ! Return to calling program END FUNCTION GET_TAUe !------------------------------------------------------------------------------ FUNCTION GET_DIAGb() RESULT( THISDIAGb ) ! !****************************************************************************** ! Function GET_DIAGb returns DIAGb (# of hours since 1 Jan 1985 at the ! start of a diagnostic interval) to the calling program. (bmy, 2/5/03) ! ! NOTES: !****************************************************************************** ! ! Function value REAL*8 :: THISDIAGb !================================================================= ! GET_DIAGb begins here! !================================================================= THISDIAGb = DIAGb ! Return to calling program END FUNCTION GET_DIAGb !------------------------------------------------------------------------------ FUNCTION GET_DIAGe() RESULT( THISDIAGe ) ! !****************************************************************************** ! Function GET_DIAGb returns DIAGe (# of hours since 1 Jan 1985 at the ! end of a diagnostic interval) to the calling program. (bmy, 2/5/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THISDIAGe !================================================================= ! GET_DIAGe begins here! !================================================================= THISDIAGe = DIAGe ! Return to calling program END FUNCTION GET_DIAGe !------------------------------------------------------------------------------ FUNCTION GET_LOCALTIME( I ) RESULT( THISLOCALTIME ) ! !****************************************************************************** ! Function GET_LOCALTIME returns the local time of a grid box to the ! calling program. (bmy, 2/5/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) I (INTEGER) : Grid box longitude index ! ! NOTES: !****************************************************************************** ! ! References to F90 modules USE GRID_MOD, ONLY : GET_XMID ! Arguments INTEGER, INTENT(IN) :: I ! Function value REAL*8 :: THISLOCALTIME !================================================================= ! GET_LOCALTIME begins here! !================================================================= ! Local Time = GMT + ( longitude / 15 ) since each hour of time ! corresponds to 15 degrees of longitude on the globe THISLOCALTIME = GET_GMT() + ( GET_XMID( I ) / 15d0 ) ! Make sure that THISLOCALTIME is in the range 0-24 hours IF ( THISLOCALTIME > 24 ) THISLOCALTIME = THISLOCALTIME - 24d0 IF ( THISLOCALTIME < 0 ) THISLOCALTIME = THISLOCALTIME + 24d0 ! Return to calling program END FUNCTION GET_LOCALTIME !------------------------------------------------------------------------------ FUNCTION GET_SEASON() RESULT( THISSEASON ) ! !****************************************************************************** ! Function GET_SEASON returns the climatological season number ! (1=DJF, 2=MAM, 3=JJA, 4=SON) to the calling program. (bmy, 3/21/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) THISMONTH (INTEGER) : Current month (1-12) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THISSEASON !================================================================= ! GET_SEASON begins here! !================================================================= THISSEASON = NSEASON ! Return to calling program END FUNCTION GET_SEASON !------------------------------------------------------------------------------ FUNCTION GET_TS_CHEM() RESULT( THIS_TS_CHEM ) ! !****************************************************************************** ! Function GET_TS_CHEM returns the chemistry timestep in minutes to the ! calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_TS_CHEM !================================================================= ! GET_TS_CHEM begins here! !================================================================= THIS_TS_CHEM = TS_CHEM ! Return to calling program END FUNCTION GET_TS_CHEM !------------------------------------------------------------------------------ FUNCTION GET_TS_CONV() RESULT( THIS_TS_CONV ) ! !****************************************************************************** ! Function GET_TS_CONV returns the convection timestep in minutes to the ! calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_TS_CONV !================================================================= ! GET_TS_CONV begins here! !================================================================= THIS_TS_CONV = TS_CONV ! Return to calling program END FUNCTION GET_TS_CONV !------------------------------------------------------------------------------ FUNCTION GET_TS_DIAG() RESULT( THIS_TS_DIAG ) ! !****************************************************************************** ! Function GET_TS_DIAG returns the diagnostic timestep in minutes to the ! calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_TS_DIAG !================================================================= ! GET_TS_DIAG begins here! !================================================================= THIS_TS_DIAG = TS_DIAG ! Return to calling program END FUNCTION GET_TS_DIAG !------------------------------------------------------------------------------ FUNCTION GET_TS_DYN() RESULT( THIS_TS_DYN ) ! !****************************************************************************** ! Function GET_TS_DIAG returns the diagnostic timestep in minutes to the ! calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_TS_DYN !================================================================= ! GET_TS_DYN begins here! !================================================================= THIS_TS_DYN = TS_DYN ! Return to calling program END FUNCTION GET_TS_DYN !------------------------------------------------------------------------------ FUNCTION GET_TS_EMIS() RESULT( THIS_TS_EMIS ) ! !****************************************************************************** ! Function GET_TS_EMIS returns the emission timestep in minutes to the ! calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_TS_EMIS !================================================================= ! GET_TS_EMIS begins here! !================================================================= THIS_TS_EMIS = TS_EMIS ! Return to calling program END FUNCTION GET_TS_EMIS !------------------------------------------------------------------------------ FUNCTION GET_TS_UNIT() RESULT( THIS_TS_UNIT ) ! !****************************************************************************** ! Function GET_TS_EMIS returns the emission timestep in minutes to the ! calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_TS_UNIT !================================================================= ! GET_TS_UNIT begins here! !================================================================= THIS_TS_UNIT = TS_UNIT ! Return to calling program END FUNCTION GET_TS_UNIT !------------------------------------------------------------------------------ FUNCTION GET_CT_CHEM() RESULT( THIS_CT_CHEM ) ! !****************************************************************************** ! Function GET_CT_CHEM returns the chemistry timestep counter to the ! calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_CT_CHEM !================================================================= ! GET_CT_CHEM begins here! !================================================================= THIS_CT_CHEM = CT_CHEM ! Return to calling program END FUNCTION GET_CT_CHEM !------------------------------------------------------------------------------ FUNCTION GET_CT_CONV() RESULT( THIS_CT_CONV ) ! !****************************************************************************** ! Function GET_CT_CONV returns the convection timestep counter to the ! calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_CT_CONV !================================================================= ! GET_CT_CONV begins here! !================================================================= THIS_CT_CONV = CT_CONV ! Return to calling program END FUNCTION GET_CT_CONV !------------------------------------------------------------------------------ FUNCTION GET_CT_DYN() RESULT( THIS_CT_DYN ) ! !****************************************************************************** ! Function GET_CT_CHEM returns the dynamic timestep counter to the ! calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_CT_DYN !================================================================= ! GET_CT_DYN begins here! !================================================================= THIS_CT_DYN = CT_DYN ! Return to calling program END FUNCTION GET_CT_DYN !------------------------------------------------------------------------------ FUNCTION GET_CT_EMIS() RESULT( THIS_CT_EMIS ) ! !****************************************************************************** ! Function GET_CT_CHEM returns the emission timestep counter to the ! calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_CT_EMIS !================================================================= ! GET_CT_EMIS begins here! !================================================================= THIS_CT_EMIS = CT_EMIS ! Return to calling program END FUNCTION GET_CT_EMIS !------------------------------------------------------------------------------ FUNCTION GET_CT_A3() RESULT( THIS_CT_A3 ) ! !****************************************************************************** ! Function GET_CT_CHEM returns the A-3 fields timestep counter to the ! calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_CT_A3 !================================================================= ! GET_CT_A3 begins here! !================================================================= THIS_CT_A3 = CT_A3 ! Return to calling program END FUNCTION GET_CT_A3 !------------------------------------------------------------------------------ FUNCTION GET_CT_A6() RESULT( THIS_CT_A6 ) ! !****************************************************************************** ! Function GET_CT_A6 returns the A-6 fields timestep counter to the ! calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_CT_A6 !================================================================= ! GET_CT_A6 begins here! !================================================================= THIS_CT_A6 = CT_A6 ! Return to calling program END FUNCTION GET_CT_A6 !------------------------------------------------------------------------------ FUNCTION GET_CT_I6() RESULT( THIS_CT_I6 ) ! !****************************************************************************** ! Function GET_CT_I6 returns the I-6 fields timestep counter to the ! calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_CT_I6 !================================================================= ! GET_CT_I6 begins here! !================================================================= THIS_CT_I6 = CT_I6 ! Return to calling program END FUNCTION GET_CT_I6 !!! (lzh, 04/10/2014) !------------------------------------------------------------------------------ FUNCTION GET_CT_A1() RESULT( THIS_CT_A1 ) ! !****************************************************************************** ! Function GET_CT_CHEM returns the A-3 fields timestep counter to the ! calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_CT_A1 !================================================================= ! GET_CT_A3 begins here! !================================================================= THIS_CT_A1 = CT_A1 ! Return to calling program END FUNCTION GET_CT_A1 !------------------------------------------------------------------------------ FUNCTION GET_CT_I3() RESULT( THIS_CT_I3 ) ! !****************************************************************************** ! Function GET_CT_CHEM returns the A-3 fields timestep counter to the ! calling program. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_CT_I3 !================================================================= ! GET_CT_A3 begins here! !================================================================= THIS_CT_I3 = CT_I3 ! Return to calling program END FUNCTION GET_CT_I3 !------------------------------------------------------------------------------ FUNCTION GET_CT_XTRA() RESULT( THIS_CT_XTRA ) ! !****************************************************************************** ! Function GET_CT_XTRA returns the XTRA fields timestep counter to the ! calling program. (tmf, bmy, 10/20/05) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: THIS_CT_XTRA !================================================================= ! GET_CT_I6 begins here! !================================================================= THIS_CT_XTRA = CT_XTRA ! Return to calling program END FUNCTION GET_CT_XTRA !------------------------------------------------------------------------------ FUNCTION GET_A1_TIME() RESULT( DATE ) ! !****************************************************************************** ! (lzh, 04/09/2014) !****************************************************************************** ! # include "define.h" ! Function value INTEGER :: DATE(2) !================================================================= ! GET_A3_TIME begins here! !================================================================= #if defined( GEOS_FP ) ! For GEOS-1, GEOS-STRAT, GEOS-3, the A-3 fields are timestamped ! by ending time. Therefore, the difference between the actual time ! when the fields are read and the A-3 timestamp time is 180 minutes. DATE = GET_TIME_AHEAD( 30 ) #else ! For GEOS-4, GEOS-5, or GCAP data: The A-3 fields are timestamped ! by center time. Therefore, the difference between the actual time ! when the fields are read and the A-3 timestamp time is 90 minutes. DATE = GET_TIME_AHEAD( 0 ) #endif ! Return to calling program END FUNCTION GET_A1_TIME !------------------------------------------------------------------------------ FUNCTION GET_A3_TIME() RESULT( DATE ) ! !****************************************************************************** ! Function GET_A3_TIME returns the correct YYYYMMDD and HHMMSS values ! that are needed to read in the next average 3-hour (A-3) fields. ! (bmy, 3/21/03, 8/4/06) ! ! NOTES: ! (1 ) Now return proper time for GEOS-4/fvDAS fields (bmy, 6/19/03) ! (2 ) Remove reference to FIRST variable (bmy, 12/10/04) ! (3 ) Now modified for GCAP and GEOS-5 met fields (swu, bmy, 5/24/05) ! (4 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06) !****************************************************************************** ! # include "define.h" ! Function value INTEGER :: DATE(2) !================================================================= ! GET_A3_TIME begins here! !================================================================= #if defined( GEOS_3 ) ! For GEOS-1, GEOS-STRAT, GEOS-3, the A-3 fields are timestamped ! by ending time. Therefore, the difference between the actual time ! when the fields are read and the A-3 timestamp time is 180 minutes. DATE = GET_TIME_AHEAD( 180 ) #else ! For GEOS-4, GEOS-5, or GCAP data: The A-3 fields are timestamped ! by center time. Therefore, the difference between the actual time ! when the fields are read and the A-3 timestamp time is 90 minutes. DATE = GET_TIME_AHEAD( 90 ) #endif ! Return to calling program END FUNCTION GET_A3_TIME !------------------------------------------------------------------------------ FUNCTION GET_A6_TIME() RESULT( DATE ) ! !****************************************************************************** ! Function GET_A6_TIME returns the correct YYYYMMDD and HHMMSS values ! that are needed to read in the next average 6-hour (A-6) fields. ! (bmy, 3/21/03, 6/26/03) ! ! NOTES: ! (1 ) Updated comments (bmy, 6/26/03) !****************************************************************************** ! ! Function value INTEGER :: DATE(2) !================================================================= ! GET_A6_TIME begins here! !================================================================= ! Return the time 3h (180m) from now, since there is a 3-hour ! offset between the actual time when the A-6 fields are read ! and the time that the A-6 fields are stamped with. DATE = GET_TIME_AHEAD( 180 ) ! Return to calling program END FUNCTION GET_A6_TIME !------------------------------------------------------------------------------ FUNCTION GET_I3_TIME() RESULT( DATE ) ! !****************************************************************************** ! (lzh, 04/09/2014) !****************************************************************************** ! # include "define.h" ! Function value INTEGER :: DATE(2) !================================================================= ! GET_A3_TIME begins here! !================================================================= LOGICAL, SAVE :: FIRST = .TRUE. INTEGER :: HH, MM, SS, MINS, OFFSET !================================================================= ! ALL MET FIELDS: !================================================================= IF ( FIRST ) THEN !-------------------------------------------------------------- ! FIRST-TIME ONLY! Get the proper # of hours until the next ! I6 time. Also works for start times other than 0 GMT. !-------------------------------------------------------------- ! Split NHMS into hours, mins, seconds CALL YMD_EXTRACT( NHMS, HH, MM, SS ) ! Compute minutes elapsed in the 6-hour interval MINS = MOD( HH, 3 )*60 + MM ! Compute offset to next I-3 time OFFSET = 180 - MINS ! Get YYYY/MM/DD and hh:mm:ss to next I-6 time DATE = GET_TIME_AHEAD( OFFSET ) ! Reset first-time flag FIRST = .FALSE. ELSE !-------------------------------------------------------------- ! Other than the 1st time: Search 360 mins ahead !-------------------------------------------------------------- ! We need to read in the I-6 fields 6h (180 mins) ahead of time DATE = GET_TIME_AHEAD( 180 ) ENDIF ! Return to calling program END FUNCTION GET_I3_TIME !------------------------------------------------------------------------------ FUNCTION GET_I6_TIME() RESULT( DATE ) ! !****************************************************************************** ! Function GET_I6_TIME returns the correct YYYYMMDD and HHMMSS values ! that are needed to read in the next instantaneous 6-hour (I-6) fields. ! (bmy, 3/21/03, 4/24/06) ! ! NOTES: ! (1 ) Bug fix for GCAP: skip over Feb 29th (no leapyears). (bmy, 4/24/06) !****************************************************************************** ! ! Arguments INTEGER :: DATE(2) !================================================================= ! GET_I6_TIME begins here! !================================================================= #if defined( GCAP ) !------------------------------- ! GCAP met fields: no leapyears !------------------------------- ! If 18 GMT on Feb 28th, the next I-6 time is 0 GMT on Mar 1st IF ( MONTH == 2 .and. DAY == 28 .and. HOUR == 18 ) THEN DATE = (/ ( YEAR * 10000 ) + 0301, 000000 /) RETURN ENDIF #endif !------------------------------- ! GEOS met fields: w/ leapyears !------------------------------- ! We need to read in the I-6 fields 6h (360 mins) ahead of time DATE = GET_TIME_AHEAD( 360 ) ! Return to calling program END FUNCTION GET_I6_TIME !------------------------------------------------------------------------------ FUNCTION GET_FIRST_A1_TIME() RESULT( DATE ) ! !****************************************************************************** ! (lzh, 04/09/2014) !****************************************************************************** ! # include "define.h" ! Arguments INTEGER :: DATE(2) !================================================================= ! GET_FIRST_A1_TIME begins here! !================================================================= DATE = GET_A1_TIME() ! Return to calling program END FUNCTION GET_FIRST_A1_TIME !------------------------------------------------------------------------------ FUNCTION GET_FIRST_A3_TIME() RESULT( DATE ) ! !****************************************************************************** ! Function GET_FIRST_A3_TIME returns the correct YYYYMMDD and HHMMSS ! values the first time that A-3 fields are read in from disk. ! (bmy, 6/26/03, 8/4/06) ! ! NOTES: ! (1 ) Now modified for GCAP and GEOS-5 data (swu, bmy, 5/24/05) ! (2 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06) !****************************************************************************** ! # include "define.h" ! Arguments INTEGER :: DATE(2) !================================================================= ! GET_FIRST_A3_TIME begins here! !================================================================= #if defined( GEOS_3 ) ! For GEOS-1, GEOS-STRAT, GEOS-3: Return the current date/time DATE = (/ NYMD, NHMS /) #else ! For GEOS-4, GEOS-5, and GCAP: Call GET_A3_TIME to return ! the date/time under which the A-3 fields are timestamped DATE = GET_A3_TIME() #endif ! Return to calling program END FUNCTION GET_FIRST_A3_TIME !------------------------------------------------------------------------------ FUNCTION GET_FIRST_A6_TIME() RESULT( DATE ) ! !****************************************************************************** ! Function GET_FIRST_A6_TIME returns the correct YYYYMMDD & HHMMSS values the ! first time that A-6 fields are read in from disk. (bmy, 6/26/03, 5/24/05) ! ! NOTES: ! (1 ) Now modified for GEOS-4 "a_llk_03" and "a_llk_04" fields (bmy, 3/22/04) ! (2 ) Modified for GCAP and GEOS-5 met fields (swu, bmy, 5/24/05) !****************************************************************************** ! # include "define.h" ! Arguments INTEGER :: DATE(2) !================================================================= ! GET_FIRST_A6_TIME begins here! !================================================================= #if defined( GCAP ) ! For GCAP data: Call GET_A6_TIME to return date/time ! under which the A-6 fields are timestamped DATE = GET_A6_TIME() #else ! For GEOS data: Return the current date/time DATE = (/ NYMD, NHMS /) #endif ! Return to calling program END FUNCTION GET_FIRST_A6_TIME !------------------------------------------------------------------------------ FUNCTION GET_FIRST_I3_TIME() RESULT( DATE ) ! !!! (lzh, 04/10/2014) !****************************************************************************** ! Function GET_FIRST_A6_TIME returns the correct YYYYMMDD & HHMMSS values the ! first time that A-6 fields are read in from disk. (bmy, 6/26/03, 5/24/05) ! ! NOTES: ! (1 ) Now modified for GEOS-4 "a_llk_03" and "a_llk_04" fields (bmy, 3/22/04) ! (2 ) Modified for GCAP and GEOS-5 met fields (swu, bmy, 5/24/05) !****************************************************************************** ! # include "define.h" ! Arguments INTEGER :: DATE(2) !================================================================= ! GET_FIRST_A6_TIME begins here! !================================================================= ! !LOCAL VARIABLES: ! INTEGER :: HH, MM, SS, MINS, OFFSET !================================================================== ! Compute first I-6 time for all met field types !================================================================== ! Split NYMS into hours, mins, seconds CALL YMD_EXTRACT( NHMS, HH, MM, SS ) ! Compute minutes elapsed in the 3-hour interval MINS = MOD( HH, 3 )*60 + MM ! Compute offset to nearest I-6 time OFFSET = -MINS ! Get YYYY/MM/DD and hh:mm:ss to nearest I-6 time DATE = GET_TIME_AHEAD( OFFSET ) ! Return to calling program END FUNCTION GET_FIRST_I3_TIME !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_CHEM() RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_CHEM returns TRUE if it is time to do chemistry ! and false otherwise. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value LOGICAL :: FLAG !================================================================= ! ITS_TIME_FOR_CHEM begins here! !================================================================= FLAG = ( MOD( ELAPSED_MIN, TS_CHEM ) == 0 ) ! Return to calling program END FUNCTION ITS_TIME_FOR_CHEM !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_CONV() RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_CONV returns TRUE if it is time to do chemistry ! and false otherwise. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value LOGICAL :: FLAG !================================================================= ! ITS_TIME_FOR_CONV begins here! !================================================================= FLAG = ( MOD( ELAPSED_MIN, TS_CONV ) == 0 ) ! Return to calling program END FUNCTION ITS_TIME_FOR_CONV !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_DYN() RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_DYN returns TRUE if it is time to do chemistry ! and false otherwise. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value LOGICAL :: FLAG !================================================================= ! ITS_TIME_FOR_DYN begins here! !================================================================= FLAG = ( MOD( ELAPSED_MIN, TS_DYN ) == 0 ) ! Return to calling program END FUNCTION ITS_TIME_FOR_DYN !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_EMIS() RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_EMIS returns TRUE if it is time to do emissions ! and false otherwise. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value LOGICAL :: FLAG !================================================================= ! ITS_TIME_FOR_EMIS begins here! !================================================================= FLAG = ( MOD( ELAPSED_MIN, TS_EMIS ) == 0 ) ! Return to calling program END FUNCTION ITS_TIME_FOR_EMIS !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_UNIT() RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_UNIT returns TRUE if it is time to do unit conversion ! and false otherwise. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value LOGICAL :: FLAG !================================================================= ! ITS_TIME_FOR_UNIT begins here! !================================================================= FLAG = ( MOD( ELAPSED_MIN, TS_DYN ) == 0 ) ! Return to calling program END FUNCTION ITS_TIME_FOR_UNIT !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_DIAG() RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_DIAG returns TRUE if it is time to archive ! certain diagnostics false otherwise. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value LOGICAL :: FLAG !================================================================= ! ITS_TIME_FOR_DIAG begins here! !================================================================= FLAG = ( MOD( ELAPSED_MIN, 60 ) == 0 ) ! Return to calling program END FUNCTION ITS_TIME_FOR_DIAG !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_A1() RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_A3 returns TRUE if it is time to read in A-3 ! (average 3-h fields) and FALSE otherwise. (bmy, 3/21/03) ! ! NOTES: !!! for geos-fp (lzh, 04/10/2014) !****************************************************************************** ! ! Function value LOGICAL :: FLAG !================================================================= ! ITS_TIME_FOR_A3 begins here! !================================================================= ! We read A-3 fields every 3 hours FLAG = ( MOD( NHMS, 010000 ) == 0 ) ! Return to calling program END FUNCTION ITS_TIME_FOR_A1 !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_A3() RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_A3 returns TRUE if it is time to read in A-3 ! (average 3-h fields) and FALSE otherwise. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value LOGICAL :: FLAG !================================================================= ! ITS_TIME_FOR_A3 begins here! !================================================================= ! We read A-3 fields every 3 hours FLAG = ( MOD( NHMS, 030000 ) == 0 ) ! Return to calling program END FUNCTION ITS_TIME_FOR_A3 !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_A6() RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_A6 returns TRUE if it is time to read in A-6 ! (average 6-h fields) and FALSE otherwise. (bmy, 3/21/03, 5/24/05) ! ! NOTES: ! (1 ) Now compute when it's time to read in GEOS-4 A-6 fields. (bmy, 6/26/03) ! (2 ) Now modified for GEOS-4 "a_llk_03" and "a_llk_04" fields (bmy, 3/22/04) ! (3 ) Now modified for GCAP and GEOS-5 met fields (swu, bmy, 5/24/05) !****************************************************************************** ! # include "define.h" ! Local variables INTEGER :: DATE(2) ! Function value LOGICAL :: FLAG !================================================================= ! ITS_TIME_FOR_A6 begins here! !================================================================= #if defined( GCAP ) ! For GCAP data: We need to read A-6 fields when it 00, 06, ! 12, 18 GMT. DATE is the current time -- test below. DATE = GET_TIME_AHEAD( 0 ) #else ! For all GEOS data: We need to read A-6 fields when it is 03, ! 09, 15, 21 GMT. DATE is the time 3 hours from now -- test below. DATE = GET_TIME_AHEAD( 180 ) #endif ! Test if DATE corresponds to 00, 06, 12, 18 GMT. ! If so, then it is time to read A-6 fields from disk. FLAG = ( MOD( DATE(2), 060000 ) == 0 ) ! Return to calling program END FUNCTION ITS_TIME_FOR_A6 !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_I3() RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_I6 returns TRUE if it is time to read in I-6 ! (instantaneous 6-h fields) and FALSE otherwise. (bmy, 3/21/03) ! ! NOTES: !!! for geos-fp (lzh, 04/10/2014) !****************************************************************************** ! ! Function value LOGICAL :: FLAG !================================================================= ! ITS_TIME_FOR_I6 begins here! !================================================================= LOGICAL, SAVE :: FIRST = .TRUE. ! We read in I-6 fields at 00, 03, 06, 09, 12, 15, 18, 21 GMT FLAG = ( ( MOD( NHMS, 030000 ) == 0 ) .or. FIRST ) FIRST = .FALSE. ! Return to calling program END FUNCTION ITS_TIME_FOR_I3 !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_I6() RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_I6 returns TRUE if it is time to read in I-6 ! (instantaneous 6-h fields) and FALSE otherwise. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value LOGICAL :: FLAG !================================================================= ! ITS_TIME_FOR_I6 begins here! !================================================================= ! We read in I-6 fields at 00, 06, 12, 18 GMT FLAG = ( MOD( NHMS, 060000 ) == 0 ) ! Return to calling program END FUNCTION ITS_TIME_FOR_I6 !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_UNZIP() RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_UNZIP Treturns TRUE if it is time to unzip ! the next day's met field files (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Local variables INTEGER :: DATE(2) ! Function value LOGICAL :: FLAG !================================================================= ! ITS_TIME_FOR_UNZIP begins here! !================================================================= ! Get YYYYMMDD and HHMMSS 12 hours (720 mins) from now DATE = GET_TIME_AHEAD( 720 ) ! If HHMMSS = 0 then it's time to unzip! FLAG = ( DATE(2) == 000000 ) ! Return to calling program END FUNCTION ITS_TIME_FOR_UNZIP !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_DEL() RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_DEL returns TRUE if it is time to delete the previous ! day's met field files in the temporary directory. (bmy, 3/21/03, 6/19/03) ! ! NOTES: ! (1 ) Now delete files at 23 GMT each day, since the last fvDAS A-3 field is ! 22:30 GMT and the last fvDAS A-6 field is 21 GMT. (bmy, 6/19/03) !****************************************************************************** ! ! Local variables INTEGER :: DATE(2) ! Function value LOGICAL :: FLAG !================================================================= ! ITS_TIME_FOR_DEL begins here! !================================================================= ! Delete files when it's 23 GMT FLAG = ( NHMS == 230000 ) ! Return to calling program END FUNCTION ITS_TIME_FOR_DEL !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_EXIT() RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_EXIT returns TRUE if it is the end of the run ! (i.e. TAU >= TAUe) and false otherwise. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Function value LOGICAL :: FLAG !================================================================= ! ITS_FOR_EXIT begins here! !================================================================= FLAG = ( TAU >= TAUe ) ! Return to calling program END FUNCTION ITS_TIME_FOR_EXIT !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_BPCH() RESULT( DO_BPCH ) ! !****************************************************************************** ! Function ITS_TIME_FOR_BPCH returns true if it's time to write output ! to the bpch file. (bmy, 2/2/07) ! ! NOTES: !****************************************************************************** ! # include "CMN_SIZE" ! Size parameters # include "CMN_DIAG" ! NJDAY ! Local variables INTEGER :: DOY, THIS_NJDAY LOGICAL :: DO_BPCH !================================================================= ! ITS_TIME_FOR_BPCH begins here! !================================================================= ! Return FALSE if it's the first timestep IF ( TAU == TAUb ) THEN DO_BPCH = .FALSE. RETURN ENDIF ! Day of year (0..365 or 0..366 leapyears) DOY = DAY_OF_YEAR ! Look up appropriate value of NJDAY array. We may need to add a ! day to skip past the Feb 29 element of NJDAY for non-leap-years. IF ( .not. ITS_A_LEAPYEAR( FORCE=.TRUE. ) .and. DOY > 59 ) THEN THIS_NJDAY = NJDAY( DOY + 1 ) ELSE THIS_NJDAY = NJDAY( DOY ) ENDIF ! Test if this is the day & time to write to the BPCH file! IF ( ( THIS_NJDAY > 0 ) .and. NHMS == NDIAGTIME ) THEN DO_BPCH = .TRUE. ELSE DO_BPCH = .FALSE. ENDIF ! Return to calling program END FUNCTION ITS_TIME_FOR_BPCH !------------------------------------------------------------------------------ FUNCTION ITS_A_LEAPYEAR( YEAR_IN, FORCE ) RESULT( IS_LEAPYEAR ) ! !****************************************************************************** ! Function ITS_A_LEAPYEAR tests to see if a year is really a leapyear. ! (bmy, 3/17/99, 4/24/06) ! ! Arguments as Input: ! ============================================================================ ! (1 ) YEAR_IN (INTEGER) : (OPTIONAL) Specify a year to test for leapyear ! (2 ) FORCE (LOGICAL) : (OPTIONAL) Do not exit if using GCAP met fields ! ! NOTES: ! (1 ) Now remove YEAR from ARG list; use the module variable (bmy, 3/21/03) ! (2 ) Now add YEAR_IN as an optional argument. If YEAR_IN is not passed, ! then test if the current year is a leapyear (bmy, 9/25/03) ! (3 ) Now always return FALSE for GCAP (swu, bmy, 8/29/05) ! (4 ) Now add FORCE argument to force ITS_A_LEAPYEAR to return a value ! instead of just returning with FALSE for the GCAP met fields. ! (swu, bmy, 4/24/06) !****************************************************************************** ! ! Arguments INTEGER, INTENT(IN), OPTIONAL :: YEAR_IN LOGICAL, INTENT(IN), OPTIONAL :: FORCE ! Local variables INTEGER :: THISYEAR LOGICAL :: THISFORCE ! Function value LOGICAL :: IS_LEAPYEAR !================================================================= ! LEAPYEAR begins here! !================================================================= ! If YEAR_IN is passed, use that value; otherwise use the value ! of the current year as stored in module variable YEAR. IF ( PRESENT( YEAR_IN ) ) THEN THISYEAR = YEAR_IN ELSE THISYEAR = YEAR ENDIF ! If FORCE is passed, use that value, otherwise default to .FALSE. IF ( PRESENT( FORCE ) ) THEN THISFORCE = FORCE ELSE THISFORCE = .FALSE. ENDIF !================================================================= ! A leap year is: ! (1) evenly divisible by 4 (if not a century year) ! (2) evenly divisible by 4, 100, and 400 (if a century year) ! ! EXAMPLES: ! (a) 1992 is a leap year since it is evenly divisible by 4, ! and is not a century year (i.e. it doesn't end in '00'). ! ! (b) 1900 is NOT a leap year, since while being evenly divisible ! by 4 and 100, it is NOT divisible by 400. ! ! (c) 2000 is a leap year, since it is divisible by ! 4, 100, and 400. !================================================================= IS_LEAPYEAR = .FALSE. #if defined( GCAP ) ! For GCAP met fields, there are no leap years. However, sometimes ! we need to test to see if it would be a leap year so that we can ! tell the GEOS-Chem timing functions to skip past Feb 29th. If ! argument FORCE=T, then return the value of IS_LEAPYEAR to the ! calling program (bmy, 4/24/06) IF ( .not. THISFORCE ) RETURN #endif IF ( MOD( THISYEAR, 4 ) == 0 ) THEN IF ( MOD( THISYEAR, 100 ) == 0 ) THEN IF ( MOD( THISYEAR, 400 ) == 0 ) THEN IS_LEAPYEAR = .TRUE. ENDIF ELSE IS_LEAPYEAR = .TRUE. ENDIF ENDIF ! Return to calling program END FUNCTION ITS_A_LEAPYEAR !------------------------------------------------------------------------------ !****************************************************************************** FUNCTION ITS_A_NEW_HOUR( ) RESULT( IS_NEW_HOUR ) ! ! !RETURN VALUE: ! LOGICAL :: IS_NEW_HOUR ! ! !REVISION HISTORY: ! 19 Feb 2013 - K. Travis - Initial version !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! INTEGER, SAVE :: LAST_HOUR = -1 IF ( HOUR /= LAST_HOUR ) THEN IS_NEW_HOUR = .TRUE. LAST_HOUR = HOUR ELSE IS_NEW_HOUR = .FALSE. ENDIF END FUNCTION ITS_A_NEW_HOUR !****************************************************************************** FUNCTION ITS_A_NEW_YEAR() RESULT( IS_NEW_YEAR ) ! !****************************************************************************** ! Function ITS_A_NEW_YEAR returns TRUE if it's the first of a new month ! (it also returns TRUE on the first timestep of the run). This is useful ! for setting flags for reading in data. (bmy, 4/1/04) ! ! NOTES: ! (1 ) Bug fix: Need month & day to be 1 (bmy, 11/1/05) ! (2 ) adj_group: update for adjoint (dkh, 04/28/10) ! (3 ) Updated to work better with CO assimilation (zj, dkh, 01/08/12, adj32_017) !****************************************************************************** ! ! Function value) LOGICAL :: IS_NEW_YEAR ! adj_group: local variables INTEGER :: DATE_FWD(2), YY_FWD, MM_FWD, DD_FWD ! (zj, dkh, 01/08/12, adj32_017) INTEGER :: YY_END, MM_END, DD_END !================================================================= ! ITS_A_NEW_YEAR begins here! !================================================================= IF ( MONTH == 1 .and. DAY == 1 .and. NHMS == 000000 ) THEN ! A new year is Jan 1 at 0 GMT IS_NEW_YEAR = .TRUE. ELSE IF ( NYMD == NYMDb .and. NHMS == NHMSb ) THEN ! Also return TRUE if it's the start of the run ! (since files will need to be read in from disk) IS_NEW_YEAR = .TRUE. ELSE ! Otherwise, it's not a new year IS_NEW_YEAR = .FALSE. ENDIF ! adj_group: during reverse integration, return true when it ! is the last hour of a month IF ( DIRECTION < 0 ) THEN ! check if we are in the last hour of a day IF ( NHMS >= 230000 ) THEN ! get the year of the time 60 minutes in the future DATE_FWD = GET_TIME_AHEAD( 60 ) CALL YMD_EXTRACT( DATE_FWD(1), YY_FWD, MM_FWD, DD_FWD ) !---------------------------------------------------------- ! BUG FIX: (dkh, 01/08/12, adj32_017) ! OLD CODE: !! if future year not the same as present... !IF ( YY_FWD /= YEAR ) THEN ! ! then we must be in the last hour of a month ! IS_NEW_YEAR = .TRUE. ! !ENDIF ! NEW CODE: CALL YMD_EXTRACT( NYMDe, YY_END, MM_END, DD_END ) ! if future year not the same as present... IF ( YY_FWD /= YEAR .OR.( DD_FWD .EQ. DD_END .and. & MM_FWD == MM_END ) ) THEN ! then we must be in the last hour of a month IS_NEW_YEAR = .TRUE. ENDIF !---------------------------------------------------------- ENDIF ENDIF ! Return to calling program END FUNCTION ITS_A_NEW_YEAR !------------------------------------------------------------------------------ FUNCTION ITS_A_NEW_MONTH() RESULT( IS_NEW_MONTH ) ! !****************************************************************************** ! Function ITS_A_NEW_MONTH returns TRUE if it's the first of a new month ! (it also returns TRUE on the first timestep of the run). This is useful ! for setting flags for reading in data. (bmy, 4/1/04) ! ! NOTES: ! (1 ) adj_group: Updated to run in adjoint (dkh, 04/28/10) ! (2 ) make sure ITS_A_NEW_MONTH is true only once per month during adjoint ! (dbm, dkh, 02/10/11) ! (3 ) update to work better with CO assimilation (zj, dkh, 01/08/12, adj32_017) !****************************************************************************** ! ! Function value LOGICAL :: IS_NEW_MONTH ! adj_group: local variables INTEGER :: DATE_FWD(2), YY_FWD, MM_FWD, DD_FWD ! (zj, dkh, 01/08/12, ad33_009) INTEGER :: YY_END, MM_END, DD_END !================================================================= ! ITS_A_NEW_MONTH begins here! !================================================================= IF ( DAY == 1 .and. NHMS == 000000 ) THEN ! Test for the 1st of the month at 0 GMT IS_NEW_MONTH = .TRUE. ELSE IF ( NYMD == NYMDb .and. NHMS == NHMSb ) THEN ! Also return TRUE if it's the start of the run ! (since files will need to be read in from disk) IS_NEW_MONTH = .TRUE. ELSE ! Otherwise, it's not a new year IS_NEW_MONTH = .FALSE. ENDIF ! adj_group: during reverse integration, return true when it ! is the last hour of a month IF ( DIRECTION < 0 ) THEN IF ( (GET_NYMDe() - GET_NYMD()) < 31 ) THEN IS_NEW_MONTH = .FALSE. RETURN ENDIF ! check if we are in the last hour of a day IF ( NHMS >= 230000 ) THEN ! get the month of the time 60 minutes in the future DATE_FWD = GET_TIME_AHEAD( 60 ) CALL YMD_EXTRACT( DATE_FWD(1), YY_FWD, MM_FWD, DD_FWD ) ! if future month not the same as present... !---------------------------------------------------------- ! BUG_FIX: (zj, dkh, 01/08/12, adj32_017) ! OLD CODE: !IF ( MM_FWD /= MONTH ) THEN ! ! then we must be in the last hour of a month ! IS_NEW_MONTH = .TRUE. ! NEW CODE: CALL YMD_EXTRACT( NYMDe, YY_END, MM_END, DD_END ) IF ( MM_FWD /= MONTH .OR. ( DD_FWD .EQ. DD_END .and. & MM_FWD == MM_END ) ) THEN ! then we must be in the last hour of a month IS_NEW_MONTH = .TRUE. !---------------------------------------------------------- ! Make sure to set it to FALSE here (dbm, dkh, 02/10/11) ELSE IS_NEW_MONTH = .FALSE. ENDIF ELSE ! Make sure to set it to FALSE here (dbm, dkh, 02/10/11) IS_NEW_MONTH = .FALSE. ENDIF ENDIF ! Return to calling program END FUNCTION ITS_A_NEW_MONTH !------------------------------------------------------------------------------ FUNCTION ITS_MIDMONTH() RESULT( IS_MIDMONTH ) ! !****************************************************************************** ! Function ITS_MIDMONTH returns TRUE if it's the middle of a month ! -sas 10/10/05 ! ! NOTES: !****************************************************************************** ! ! Function value LOGICAL :: IS_MIDMONTH !================================================================= ! ITS_MIDMONTH begins here! !================================================================= ! Test for the 16th of the month at 0 GMT IS_MIDMONTH = ( DAY == 16 .and. NHMS == 000000 ) ! Return to calling program END FUNCTION ITS_MIDMONTH !------------------------------------------------------------------------------ FUNCTION ITS_A_NEW_DAY( ) RESULT( IS_NEW_DAY ) ! !****************************************************************************** ! Function ITS_A_NEW_DAY returns TRUE if it's the first timestep of a new ! day (it also returns TRUE on the first timestep of the run). This is ! useful for setting flags for reading in data. (bmy, 4/1/04) ! ! NOTES: !****************************************************************************** ! ! Arguments LOGICAL :: IS_NEW_DAY !================================================================= ! ITS_A_NEW_DAY begins here! !================================================================= IF ( DIRECTION > 0 ) THEN IF ( NHMS == 000000 ) THEN ! Test if it's 0 GMT IS_NEW_DAY = .TRUE. ELSE IF ( NYMD == NYMDb .and. NHMS == NHMSb ) THEN ! Also return TRUE if it's the start of the run ! (since files will need to be read in from disk) IS_NEW_DAY = .TRUE. ELSE ! Otherwise, it's not a new year IS_NEW_DAY = .FALSE. ENDIF ! add support for adjoint (adj_group, 10/31/12) ELSE IF ( NHMS == ( 236000 - GET_TS_EMIS() * 100 ) ) THEN ! Test if it's the first emission time step starting a new day ! during the adjoint calculation IS_NEW_DAY = .TRUE. ELSE ! Otherwise, it's not a new year IS_NEW_DAY = .FALSE. ENDIF ENDIF ! Return to calling program END FUNCTION ITS_A_NEW_DAY !------------------------------------------------------------------------------ FUNCTION ITS_A_NEW_SEASON( ) RESULT( IS_NEW_SEASON ) ! !****************************************************************************** ! Function ITS_A_NEW_SEASON returns TRUE if it's a new season or FALSE ! if it's not a new season. Seasons are (1=DJF, 2=MAM, 3=JJA, 4=SON). ! (bmy, 7/20/04) ! ! NOTES: !****************************************************************************** ! ! Function value LOGICAL :: IS_NEW_SEASON ! Local variables INTEGER, SAVE :: LAST_SEASON = -1 !================================================================= ! ITS_A_NEW_SEASON begins here! !================================================================= IF ( NSEASON /= LAST_SEASON ) THEN IS_NEW_SEASON = .TRUE. LAST_SEASON = NSEASON ELSE IS_NEW_SEASON = .FALSE. ENDIF ! Return to calling program END FUNCTION ITS_A_NEW_SEASON !------------------------------------------------------------------------------ SUBROUTINE PRINT_CURRENT_TIME ! !****************************************************************************** ! Subroutine PRINT_CURRENT_TIME prints the date, GMT time, and elapsed ! hours of a GEOS-CHEM simulation. (bmy, 3/21/03) ! ! NOTES: !****************************************************************************** ! ! Local variables REAL*4 :: E_HOURS !================================================================= ! PRINT_CURRENT_TIME begins here! !================================================================= ! Hours since start of run E_HOURS = REAL( ELAPSED_MIN ) / 60e0 ! Write quantities WRITE( 6, 100 ) YEAR, MONTH, DAY, HOUR, MINUTE, E_HOURS ! Format string 100 FORMAT( '---> DATE: ', i4.4, '/', i2.2, '/', i2.2, & ' GMT: ', i2.2, ':', i2.2, ' X-HRS: ', f11.3 ) ! Return to calling program END SUBROUTINE PRINT_CURRENT_TIME !------------------------------------------------------------------------------ FUNCTION TIMESTAMP_STRING( YYYYMMDD, HHMMSS ) RESULT( TIME_STR ) ! !****************************************************************************** ! TIMESTAMP_STRING returns a formatted string "YYYY/MM/DD HH:MM" for the a ! date and time specified by YYYYMMDD and HHMMSS. If YYYYMMDD and HHMMSS are ! omitted, then TIMESTAMP_STRING will create a formatted string for the ! current date and time. (bmy, 3/21/03, 12/2/03) ! ! NOTES: ! (1 ) Now use ENCODE statement for PGI/F90 on Linux (bmy, 9/29/03) ! (2 ) Now add optional arguments YYYYMMDD and HHMMSS (bmy, 10/27/03) ! (3 ) Renamed LINUX to LINUX_PGI (bmy, 12/2/03) !****************************************************************************** ! # include "define.h" ! Arguments INTEGER, INTENT(IN), OPTIONAL :: YYYYMMDD, HHMMSS ! Local variables INTEGER :: THISYEAR, THISMONTH, THISDAY INTEGER :: THISHOUR, THISMINUTE, THISSECOND ! Function value CHARACTER(LEN=16) :: TIME_STR !================================================================= ! TIMESTAMP_STRING begins here! !================================================================= ! If YYYYMMDD is passed, then use that date. Otherwise use the ! current date stored in global variables YEAR, MONTH, DAY. IF ( PRESENT( YYYYMMDD ) ) THEN CALL YMD_EXTRACT( YYYYMMDD, THISYEAR, THISMONTH, THISDAY ) ELSE THISYEAR = YEAR THISMONTH = MONTH THISDAY = DAY ENDIF ! If HHMMSS is passed, then use that time. Otherwise use the ! current time stored in global variables HOUR and MINUTE. IF ( PRESENT( HHMMSS ) ) THEN CALL YMD_EXTRACT( HHMMSS, THISHOUR, THISMINUTE, THISSECOND ) ELSE THISHOUR = HOUR THISMINUTE = MINUTE ENDIF #if defined( LINUX_PGI ) ! For PGI/F90 Linux, we must use the ENCODE command ! to convert from numeric to string format (bmy, 9/29/03) ENCODE( 16, 100, TIME_STR ) THISYEAR, THISMONTH, & THISDAY, THISHOUR, THISMINUTE #else ! For other platforms, we can just use a FORTRAN internal write WRITE( TIME_STR, 100 ) THISYEAR, THISMONTH, & THISDAY, THISHOUR, THISMINUTE #endif ! Format statement 100 FORMAT( i4.4, '/', i2.2, '/', i2.2, ' ', i2.2, ':', i2.2 ) ! Return to calling program END FUNCTION TIMESTAMP_STRING !------------------------------------------------------------------------------ SUBROUTINE YMD_EXTRACT( NYMD, Y, M, D ) ! !****************************************************************************** ! Subroutine YMD_EXTRACT extracts the year, month, and date from an integer ! variable in YYYYMMDD format. It can also extract the hours, minutes, and ! seconds from a variable in HHMMSS format. (bmy, 11/21/01) ! ! Arguments as Input: ! ============================================================================ ! (1 ) NYMD (INTEGER) : Variable in YYYYMMDD (or HHMMSS) format ! ! Arguments as Output: ! ============================================================================ ! (2 ) Y (INTEGER) : Variable that returns YYYY (or HH - hours ) ! (3 ) M (INTEGER) : Variable that returns MM (or MM - minutes) ! (4 ) D (INTEGER) : Variable that returns DD (or SS - seconds) ! ! NOTES: !****************************************************************************** ! ! Arguments INTEGER, INTENT(IN) :: NYMD INTEGER, INTENT(OUT) :: Y, M, D ! Local variables REAL*8 :: REM !================================================================= ! YMD_EXTRACT begins here! !================================================================= ! Extract YYYY from YYYYMMDD Y = INT( DBLE( NYMD ) / 1d4 ) ! Extract MM from YYYYMMDD REM = DBLE( NYMD ) - ( DBLE( Y ) * 1d4 ) M = INT( REM / 1d2 ) ! Extract DD from YYYYMMDD REM = REM - ( DBLE( M ) * 1d2 ) D = INT( REM ) ! Return to calling program END SUBROUTINE YMD_EXTRACT !------------------------------------------------------------------------------ SUBROUTINE EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS ) ! !****************************************************************************** ! Subroutine EXPAND_DATE replaces "YYYYMMDD" and "hhmmss" tokens within ! a filename string with the actual values. (bmy, 6/27/02, 7/20/04) ! ! Arguments as Input: ! ============================================================================ ! (1 ) FILENAME (CHARACTER) : Filename with tokens to replace ! (2 ) YYYYMMDD (INTEGER ) : Current Year-Month-Day (must have 8 digits!) ! (3 ) HHMMSS (INTEGER ) : Current Hour-Minute-Seconds ! ! ! Arguments as Output: ! ============================================================================ ! (1 ) FILENAME (CHARACTER) : Modified filename ! ! NOTES: ! (1 ) Bug fix for Linux: use ENCODE statement to convert number to string ! instead of F90 internal read. (bmy, 9/29/03) ! (2 ) Now replace 2 and 4 digit year strings for all models (bmy, 10/23/03) ! (3 ) Renamed LINUX to LINUX_PGI (bmy, 12/2/03) ! (4 ) Now do not replace "ss" with seconds, as the smallest GEOS-CHEM ! timestep is in minutes. (bmy, 7/20/04) !****************************************************************************** ! ! References to F90 modules USE CHARPAK_MOD, ONLY : STRREPL # include "define.h" ! Arguments CHARACTER(LEN=*), INTENT(INOUT) :: FILENAME INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS ! Local variables INTEGER :: YYYY, YY, MM, DD, HH, II, SS CHARACTER(LEN=2) :: MM_STR, DD_STR CHARACTER(LEN=2) :: HH_STR, II_STR, SS_STR CHARACTER(LEN=2) :: YY_STR CHARACTER(LEN=4) :: YYYY_STR !================================================================= ! EXPAND_DATE begins here! !================================================================= ! Extract today's date into year, month, and day sections CALL YMD_EXTRACT( YYYYMMDD, YYYY, MM, DD ) ! Extract today's time into HH, MM, and SS sections ! (rename minutes to II so as not to overwrite MM) CALL YMD_EXTRACT( HHMMSS, HH, II, SS ) ! 2-digit year number (e.g. "97" instead of "1997") YY = YYYY - 1900 IF ( YY >= 100 ) YY = YY - 100 #if defined( LINUX_PGI ) ! Use ENCODE statement for PGI/Linux (bmy, 9/29/03) ENCODE( 4, '(i4.4)', YYYY_STR ) YYYY ENCODE( 2, '(i2.2)', YY_STR ) YY ENCODE( 2, '(i2.2)', MM_STR ) MM ENCODE( 2, '(i2.2)', DD_STR ) DD ENCODE( 2, '(i2.2)', HH_STR ) HH ENCODE( 2, '(i2.2)', II_STR ) II #else ! For other platforms, use an F90 internal write (bmy, 9/29/03) WRITE( YYYY_STR, '(i4.4)' ) YYYY WRITE( YY_STR, '(i2.2)' ) YY WRITE( MM_STR, '(i2.2)' ) MM WRITE( DD_STR, '(i2.2)' ) DD WRITE( HH_STR, '(i2.2)' ) HH WRITE( II_STR, '(i2.2)' ) II #endif ! Replace YYYY, MM, DD, HH tokens w/ actual values CALL STRREPL( FILENAME, 'YYYY', YYYY_STR ) CALL STRREPL( FILENAME, 'YY', YY_STR ) CALL STRREPL( FILENAME, 'MM', MM_STR ) CALL STRREPL( FILENAME, 'DD', DD_STR ) CALL STRREPL( FILENAME, 'hh', HH_STR ) CALL STRREPL( FILENAME, 'mm', II_STR ) ! Return to calling program END SUBROUTINE EXPAND_DATE !------------------------------------------------------------------------------ SUBROUTINE SYSTEM_DATE_TIME( SYS_NYMD, SYS_NHMS ) ! !****************************************************************************** ! Subroutine SYSTEM_DATE_TIME returns the actual local date and time ! (as opposed to the model date and time). (bmy, 5/2/05) ! ! Arguments as Output: ! ============================================================================ ! (1 ) SYS_NYMD (INTEGER) : System date (local time) in YYYYMMDD format ! (2 ) SYS_NHMS (INTEGER) : System time (local time) in HHMMSS format ! ! NOTES: !****************************************************************************** ! ! Arguments INTEGER, INTENT(OUT) :: SYS_NYMD INTEGER, INTENT(OUT) :: SYS_NHMS ! Local variables INTEGER :: V(8) CHARACTER(LEN=8) :: D CHARACTER(LEN=10) :: T !================================================================= ! SYSTEM_DATE_TIME begins here! !================================================================= ! Initialize D = 'ccyymmdd' T = 'hhmmss.sss' ! Call the F90 intrinsic routine DATE_AND_TIME ! Return values are (/YYYY, MM, DD, GMT_MIN, HH, MM, SS, MSEC/) CALL DATE_AND_TIME( DATE=D, TIME=T, VALUES=V ) ! Save to YYYYMMDD and HHMMSS format SYS_NYMD = ( V(1) * 10000 ) + ( V(2) * 100 ) + V(3) SYS_NHMS = ( V(5) * 10000 ) + ( V(6) * 100 ) + V(7) ! Return to calling program END SUBROUTINE SYSTEM_DATE_TIME !------------------------------------------------------------------------------ FUNCTION SYSTEM_TIMESTAMP() RESULT( STAMP ) ! !****************************************************************************** ! Function SYSTEM_TIMESTAMP returns a 16 character string with the system ! date and time in YYYY/MM/DD HH:MM format. (bmy, 5/3/05) ! ! NOTES: !****************************************************************************** ! ! Local variables INTEGER :: SYS_NYMD, SYS_NHMS CHARACTER(LEN=16) :: STAMP !================================================================= ! SYSTEM_TIMESTAMP begins here! !================================================================= ! Get system date and time CALL SYSTEM_DATE_TIME( SYS_NYMD, SYS_NHMS ) ! Create a string w/ system date & time STAMP = TIMESTAMP_STRING( SYS_NYMD, SYS_NHMS ) ! Return to calling program END FUNCTION SYSTEM_TIMESTAMP !------------------------------------------------------------------------------ FUNCTION CALC_RUN_DAYS() RESULT( DAYS ) !****************************************************************************** ! Function CALC_RUN_DAYS computes the number of days in the simulation. ! This is useful as some arrays in the adjoint code (eg. EMS_orig) are ! allocated according to the number of days/time steps. To compute this ! we convert the start and end date from input.geos into julian time, and ! subtract. Casted to an integer, variable DAYS is output, (mak, 3/16/06) ! (1 ) NYMDb (INTEGER) : YYYYMMDD at beginning of GEOS-CHEM run ! (3 ) NYMDe (INTEGER) : YYYYMMDD at end of GEOS-CHEM run ! ! Notes: ! (1 ) Force DAYS to be at least 1 to allow simulations shorter tha ! one day (dkh, 02/22/11) !****************************************************************************** INTEGER DAYS REAL*8 :: JD0, JD1 ! JD0: Astronomical Julian Date at start of GEOS-CHEM run JD0 = GET_JD( NYMDb, NHMSb ) ! JD1: Astronomical Julian Date at the end of GEOS-CHEM run JD1 = GET_JD( NYMDe, NHMSe ) ! BUG FIX: (dkh, 02/22/11) !IF ( DAYS < 1 ) DAYS = 1 DAYS = JD1 - JD0 PRINT*, 'Number of days in the simulation is:', DAYS END FUNCTION CALC_RUN_DAYS !------------------------------------------------------------------------------ !=============----------------=====================--------------------=========== ! ***************************ADJOINT SUBROUTINES**************************** !=============----------------=====================--------------------=========== SUBROUTINE SET_ELAPSED_MIN_ADJ ! !****************************************************************************** ! Subroutine SET_ELAPSED_MIN_ADJ decrements the number of elapsed minutes by ! the dynamic timestep TS_DYN. (Kumaresh, 01/24/08) !****************************************************************************** ! !================================================================= ! SET_ELAPSED_MIN begins here! !================================================================= ELAPSED_MIN = ELAPSED_MIN - TS_DYN ! Return to calling program END SUBROUTINE SET_ELAPSED_MIN_ADJ !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_EXIT_ADJ() RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_EXIT_ADJ returns TRUE if it is the end of the adjoint ! run (i.e. Elapsed time <= 0) and false otherwise. (Kumaresh, 01/24/08) ! ! NOTES: !****************************************************************************** ! ! Function value LOGICAL :: FLAG !================================================================= ! ITS_FOR_EXIT begins here! !================================================================= FLAG = ( ELAPSED_MIN <= 0 ) ! Return to calling program END FUNCTION ITS_TIME_FOR_EXIT_ADJ !------------------------------------------------------------------------------ FUNCTION ITS_A_NEW_DAY_ADJ( ) RESULT( IS_NEW_DAY ) ! !****************************************************************************** ! Function ITS_A_NEW_DAY returns TRUE if it's the first timestep of a new ! day (it also returns TRUE on the first timestep of the run). (dkh, 01/23/10) ! ! NOTES: !****************************************************************************** ! ! Arguments LOGICAL :: IS_NEW_DAY ! Local variables LOGICAL, SAVE :: FIRST = .TRUE. !================================================================= ! ITS_A_NEW_DAY_ADJ begins here! !================================================================= IS_NEW_DAY = .FALSE. ! adjoint equivalent of ITS_A_NEW_DAY IF ( ( GET_NHMS() == 236000 - ( GET_TS_DYN() * 100d0 ) ) & .AND. ( .not. FIRST ) ) THEN IS_NEW_DAY = .TRUE. ENDIF ! Reset first-time flag IF ( FIRST ) FIRST = .FALSE. ! Return to calling program END FUNCTION ITS_A_NEW_DAY_ADJ !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_I6_ADJ( ) RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_I6_ADJ returns TRUE if it is time to read in I-6 ! (instantaneous 6-h fields) and FALSE otherwise. This happens when TIME_ADJ is ! at a 6h interval, which is equivalent to when ELAPSED_TIME+TS_DYN is at a ! 6h interval. (dkh, 8/25/04) ! ! NOTES: ! (1 ) Don't read in i6 fields when we are still within the last 6 h interval ! from the forward simulation, in which case just use the i6 fields that ! are already loaded. (dkh, 9/30/04) ! (2 ) FIXED BUG: Use EXTRA so that NHMS + (TS_DYN) is divisible by 6 h ! (3 ) Now always read in files if it's time. (dkh, 01/25/10) !****************************************************************************** ! ! Reference to f90 modules USE ERROR_MOD, ONLY : ERROR_STOP ! Function value LOGICAL :: FLAG ! Local variable INTEGER :: EXTRA !================================================================= ! ITS_TIME_FOR_I6_ADJ begins here! !================================================================= !----------------------------------------------------------------------- ! OLD CODE: now always read in files, it's just simpler (dkh, 01/25/10) ! IF ( GET_ELAPSED_SEC() >= NSECb ) THEN ! ! ! We can use I6 fields still loaded from forward run ! FLAG = .FALSE. ! ! ! Echo this fact to the screen ! WRITE(6,*) ' -- USE I6 FIELDS FROM FORWARD RUN ' ! ! ELSE !----------------------------------------------------------------------- ! EXTRA set so that current NHMS + 1 dynamic time step is ! divisible by 060000 ! Original, hardwired to 30 min dynamic time step !EXTRA = 7000 ! Qinbin's formula, assumes TS_DYN <= 60 min EXTRA = 4000 + GET_TS_DYN()*100 IF ( GET_TS_DYN() > 60 ) CALL ERROR_STOP( 'Invalid EXTRA!', & 'ITS_TIME_FOR_I6_ADJ (adjoint.f)' ) ! We read in I-6 fields at 00, 06, 12, 18 GMT FLAG = ( MOD( GET_NHMS() + EXTRA, 060000 ) == 0 ) ! ENDIF ! Return to calling program END FUNCTION ITS_TIME_FOR_I6_ADJ !------------------------------------------------------------------------------ FUNCTION GET_I6_TIME_ADJ( ) RESULT( BEHIND_DATE ) ! !****************************************************************************** ! Function GET_I6_TIME_ADJ returns the correct YYYYMMDD and HHMMSS values ! that are needed to read in the previous instantaneous 6-hour (I-6) fields. ! (dkh, 8/25/04) ! ! NOTES: ! This is only called if ITS_TIME_FOR_I6_ADJ is true !****************************************************************************** ! ! Arguments INTEGER :: BEHIND_DATE(2) !================================================================= ! GET_I6_TIME_ADJ begins here! !================================================================= ! We need to read in the I-6 fields 6h (360 mins) behind of TIME_ADJ ! which is the same as 360 - TS_DYN behind ELAPSED_TIME BEHIND_DATE = GET_TIME_BEHIND_ADJ( 360 - GET_TS_DYN() ) ! Return to calling program END FUNCTION GET_I6_TIME_ADJ !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_I3_ADJ( ) RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_I6_ADJ returns TRUE if it is time to read in I-6 ! (instantaneous 6-h fields) and FALSE otherwise. This happens when TIME_ADJ is ! at a 6h interval, which is equivalent to when ELAPSED_TIME+TS_DYN is at a ! 6h interval. (dkh, 8/25/04) ! ! NOTES: ! (1 ) Don't read in i6 fields when we are still within the last 6 h interval ! from the forward simulation, in which case just use the i6 fields that ! are already loaded. (dkh, 9/30/04) ! (2 ) FIXED BUG: Use EXTRA so that NHMS + (TS_DYN) is divisible by 6 h ! (3 ) Now always read in files if it's time. (dkh, 01/25/10) !****************************************************************************** !!! geos-fp (lzh, 04/10/2014) ! ! Reference to f90 modules USE ERROR_MOD, ONLY : ERROR_STOP ! Function value LOGICAL :: FLAG ! Local variable INTEGER :: EXTRA !================================================================= ! ITS_TIME_FOR_I6_ADJ begins here! !================================================================= !----------------------------------------------------------------------- ! OLD CODE: now always read in files, it's just simpler (dkh, 01/25/10) ! IF ( GET_ELAPSED_SEC() >= NSECb ) THEN ! ! ! We can use I6 fields still loaded from forward run ! FLAG = .FALSE. ! ! ! Echo this fact to the screen ! WRITE(6,*) ' -- USE I6 FIELDS FROM FORWARD RUN ' ! ! ELSE !----------------------------------------------------------------------- ! EXTRA set so that current NHMS + 1 dynamic time step is ! divisible by 060000 ! Original, hardwired to 30 min dynamic time step !EXTRA = 7000 ! Qinbin's formula, assumes TS_DYN <= 60 min EXTRA = 4000 + GET_TS_DYN()*100 IF ( GET_TS_DYN() > 60 ) CALL ERROR_STOP( 'Invalid EXTRA!', & 'ITS_TIME_FOR_I3_ADJ (adjoint.f)' ) ! We read in I-6 fields at 00, 06, 12, 18 GMT FLAG = ( MOD( GET_NHMS() + EXTRA, 030000 ) == 0 ) ! ENDIF ! Return to calling program END FUNCTION ITS_TIME_FOR_I3_ADJ !------------------------------------------------------------------------------ FUNCTION GET_I3_TIME_ADJ( ) RESULT( BEHIND_DATE ) ! !****************************************************************************** ! Function GET_I6_TIME_ADJ returns the correct YYYYMMDD and HHMMSS values ! that are needed to read in the previous instantaneous 6-hour (I-6) fields. ! (dkh, 8/25/04) ! ! NOTES: ! This is only called if ITS_TIME_FOR_I6_ADJ is true !****************************************************************************** ! ! Arguments INTEGER :: BEHIND_DATE(2) !================================================================= ! GET_I6_TIME_ADJ begins here! !================================================================= ! We need to read in the I-6 fields 6h (360 mins) behind of TIME_ADJ ! which is the same as 360 - TS_DYN behind ELAPSED_TIME BEHIND_DATE = GET_TIME_BEHIND_ADJ( 180 - GET_TS_DYN() ) ! Return to calling program END FUNCTION GET_I3_TIME_ADJ !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_A6_ADJ( ) RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_A6_ADJ returns TRUE if it is time to read in I-A ! (average 6-h fields) and FALSE otherwise. This happens when TIME_ADJ is ! at a 6h interval (03, 09, 15,21), which is equivalent to when ! ELAPSED_TIME+TS_DYN is at a 6h interval. (dkh, 03/04/05) ! ! NOTES: ! (1 ) Don't read in A6 fields when we are still within the last 6 h interval ! from the forward simulation, in which case just use the A6 fields that ! are already loaded. NSECb is the total elapsed seconds at the last fwd ! I6 interval, so if we are more than 3 hr past this, can use A6 fields ! from forward run. (dkh, 03/04/05) ! (2 ) Now always read in files if it's time. (dkh, 01/25/10) ! !****************************************************************************** ! ! Reference to f90 modules USE ERROR_MOD, ONLY : ERROR_STOP ! Function value LOGICAL :: FLAG ! Local variable INTEGER :: EXTRA INTEGER :: DATE(2) !================================================================= ! ITS_TIME_FOR_A6_ADJ begins here! !================================================================= !------------------------------------------------------------------------- ! OLD CODE: now we read them every time, it's just simpler (dkh, 01/25/10) ! IF ( GET_ELAPSED_SEC() >= NSECb + 3 * 3600 ) THEN ! ! ! We can use A6 fields still loaded from forward run ! FLAG = .FALSE. ! ! ! Echo this fact to the screen ! WRITE(6,*) ' -- USE A6 FIELDS FROM FORWARD RUN ' ! ! ELSE !------------------------------------------------------------------------- #if defined( GEOS_4 ) && defined( A_LLK_03 ) || defined ( GCAP ) ! For GEOS-4 "a_llk_03" data, we need to read A-6 fields when it ! is 00, 06, 12, 18 GMT. DATE is the current time -- test below. DATE = GET_TIME_AHEAD( 0 ) #else ! For GEOS-1, GEOS-S, GEOS-3, and GEOS-4 "a_llk_04" data, ! we need to read A-6 fields when it is 03, 09, 15, 21 GMT. ! DATE is the time 3 before now -- test below. DATE = GET_TIME_BEHIND_ADJ( 180 ) #endif ! EXTRA set so that current NHMS + 1 dynamic time step is ! divisible by 060000 ! Original formula, assumes dynamic time step is 30 min ! EXTRA = 7000 ! Qinbin's formula, assumes dynamic time step <= 60 EXTRA = 4000 + GET_TS_DYN() * 100 IF ( GET_TS_DYN() > 60 ) CALL ERROR_STOP( 'Invalid EXTRA!', & 'ITS_TIME_FOR_A6_ADJ (adjoint.f)' ) ! We read in A-6 fields at 03, 09, 15, 21 GMT FLAG = ( MOD( DATE(2) + EXTRA, 060000 ) == 0 ) ! ENDIF ! Return to calling program END FUNCTION ITS_TIME_FOR_A6_ADJ !------------------------------------------------------------------------------ FUNCTION GET_A6_TIME_ADJ( ) RESULT( BEHIND_DATE ) ! !****************************************************************************** ! Function GET_A6_TIME_ADJ returns the correct YYYYMMDD and HHMMSS values ! that are needed to read in the previous average 6-hour (A-6) fields. ! (dkh, 03/04/05) ! ! NOTES: ! (1 ) This is only called if ITS_TIME_FOR_A6_ADJ is true ! !****************************************************************************** ! ! Arguments INTEGER :: BEHIND_DATE(2) !================================================================= ! GET_A6_TIME_ADJ begins here! !================================================================= ! Return the time 3h (180m) before now, since there is a 3-hour ! offset between the actual time when the A-6 fields are read ! and the time that the A-6 fields are stamped with. Also apply ! offset of TS_DYN. BEHIND_DATE = GET_TIME_BEHIND_ADJ( 180 - GET_TS_DYN() ) ! Return to calling program END FUNCTION GET_A6_TIME_ADJ !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_A3_ADJ( ) RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_A3_ADJ returns TRUE if it is time to read in A-3 ! (average 3-h fields) and FALSE otherwise. This happens when TIME_ADJ is ! at a 3h interval, which is equivalent to when ! ELAPSED_TIME+TS_DYN is at a 3h interval. (dkh, 03/04/05) ! ! NOTES: ! (1 ) Don't read in 3 fields when we are still within the last 3 h interval ! from the forward simulation, in which case just use the A3 fields that ! are already loaded. NSECb is the total elapsed seconds at the last fwd ! I6 interval, so if we are more than 3 hr past this, can use A3 fields ! from forward run. (dkh, 03/04/05) ! (2 ) Now always read in files if it's time. (dkh, 01/25/10) !****************************************************************************** ! ! Reference to f90 modules USE ERROR_MOD, ONLY : ERROR_STOP ! Function value LOGICAL :: FLAG ! Local variable INTEGER :: EXTRA !================================================================= ! ITS_TIME_FOR_A3_ADJ begins here! !================================================================= !------------------------------------------------------------------------- ! OLD CODE: now skip this option just to make this simpler (dkh, 01/25/10) ! IF ( GET_ELAPSED_SEC() >= NSECb + 3 * 3600 ) THEN ! !IF ( GET_ELAPSED_SEC() >= NSECb + 3 * 3600 + 30*60 ) THEN ! ! ! We can use A3 fields still loaded from forward run ! FLAG = .FALSE. ! ! ! Echo this fact to the screen ! WRITE(6,*) ' -- USE A3 FIELDS FROM FORWARD RUN ' ! ! ELSE !------------------------------------------------------------------------- ! EXTRA set so that current NHMS + 1 dynamic time step is ! divisible by 030000 ! Original formula, assumes dynamic time step is 30 min !EXTRA = 7000 ! Qinbin's formula, assumes dynamic time step <= 60 min EXTRA = 4000 + GET_TS_DYN() * 100 IF ( GET_TS_DYN() > 30 ) CALL ERROR_STOP( 'Invalid EXTRA!', & 'ITS_TIME_FOR_A3_ADJ (adjoint.f)' ) ! We read in A-3 every 3 hours FLAG = ( MOD( GET_NHMS() + EXTRA, 030000 ) == 0 ) ! ENDIF ! Return to calling program END FUNCTION ITS_TIME_FOR_A3_ADJ !------------------------------------------------------------------------------ FUNCTION GET_A3_TIME_ADJ( ) RESULT( BEHIND_DATE ) ! !****************************************************************************** ! Function GET_A3_TIME_ADJ returns the correct YYYYMMDD and HHMMSS values ! that are needed to read in the previous average 3-hour (A-3) fields. ! (dkh, 03/04/05) ! ! NOTES: ! (1 ) This is only called if ITS_TIME_FOR_A3_ADJ is true ! !****************************************************************************** ! ! Arguments INTEGER :: BEHIND_DATE(2) !================================================================= ! GET_A3_TIME_ADJ begins here! !================================================================= !#if defined( GEOS_4 ) #if defined( GEOS_4 ) || defined ( GEOS_5 ) || defined( GEOS_FP ) ! For GEOS-4/fvDAS, the A-3 fields are timestamped by center time. ! Therefore, the difference between the actual time when the fields ! are read and the A-3 timestamp time is 90 minutes. BEHIND_DATE = GET_TIME_BEHIND_ADJ( 90 - GET_TS_DYN() ) #else ! For GEOS-1, GEOS-STRAT, GEOS-3, the A-3 fields are timestamped ! by ending time. Therefore, the difference between the actual time ! when the fields are read and the A-3 timestamp time is 180 minutes. !BEHIND_DATE = GET_TIME_BEHIND_ADJ( 180 - TS_DYN ) BEHIND_DATE = GET_TIME_BEHIND_ADJ( - GET_TS_DYN() ) #endif ! Return to calling program END FUNCTION GET_A3_TIME_ADJ !------------------------------------------------------------------------------ FUNCTION ITS_TIME_FOR_A1_ADJ( ) RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_FOR_A3_ADJ returns TRUE if it is time to read in A-3 ! (average 3-h fields) and FALSE otherwise. This happens when TIME_ADJ is ! at a 3h interval, which is equivalent to when ! ELAPSED_TIME+TS_DYN is at a 3h interval. (dkh, 03/04/05) ! ! NOTES: ! (1 ) Don't read in 3 fields when we are still within the last 3 h interval ! from the forward simulation, in which case just use the A3 fields that ! are already loaded. NSECb is the total elapsed seconds at the last fwd ! I6 interval, so if we are more than 3 hr past this, can use A3 fields ! from forward run. (dkh, 03/04/05) ! (2 ) Now always read in files if it's time. (dkh, 01/25/10) !****************************************************************************** !!! geos-fp (lzh, 04/10/2014) ! ! Reference to f90 modules USE ERROR_MOD, ONLY : ERROR_STOP ! Function value LOGICAL :: FLAG ! Local variable INTEGER :: EXTRA !================================================================= ! ITS_TIME_FOR_A3_ADJ begins here! !================================================================= ! EXTRA set so that current NHMS + 1 dynamic time step is ! divisible by 030000 ! Original formula, assumes dynamic time step is 30 min !EXTRA = 7000 ! Qinbin's formula, assumes dynamic time step <= 60 min EXTRA = 4000 + GET_TS_DYN() * 100 IF ( GET_TS_DYN() > 30 ) CALL ERROR_STOP( 'Invalid EXTRA!', & 'ITS_TIME_FOR_A1_ADJ (adjoint.f)' ) ! We read in A-3 every 1 hours FLAG = ( MOD( GET_NHMS() + EXTRA, 010000 ) == 0 ) ! Return to calling program END FUNCTION ITS_TIME_FOR_A1_ADJ !------------------------------------------------------------------------------ FUNCTION GET_A1_TIME_ADJ( ) RESULT( BEHIND_DATE ) ! !****************************************************************************** ! Function GET_A3_TIME_ADJ returns the correct YYYYMMDD and HHMMSS values ! that are needed to read in the previous average 3-hour (A-3) fields. ! (dkh, 03/04/05) ! ! NOTES: ! (1 ) This is only called if ITS_TIME_FOR_A3_ADJ is true ! !****************************************************************************** ! ! Arguments INTEGER :: BEHIND_DATE(2) !================================================================= ! GET_A3_TIME_ADJ begins here! !================================================================= #if defined( GEOS_4 ) || defined ( GEOS_5 ) || defined( GEOS_FP ) ! For GEOS-4/fvDAS, the A-3 fields are timestamped by center time. ! Therefore, the difference between the actual time when the fields ! are read and the A-3 timestamp time is 90 minutes. BEHIND_DATE = GET_TIME_BEHIND_ADJ( 30 - GET_TS_DYN() ) #else ! For GEOS-1, GEOS-STRAT, GEOS-3, the A-3 fields are timestamped ! by ending time. Therefore, the difference between the actual time ! when the fields are read and the A-3 timestamp time is 180 minutes. !BEHIND_DATE = GET_TIME_BEHIND_ADJ( 180 - TS_DYN ) BEHIND_DATE = GET_TIME_BEHIND_ADJ( - GET_TS_DYN() ) #endif ! Return to calling program END FUNCTION GET_A1_TIME_ADJ !------------------------------------------------------------------------------ FUNCTION GET_TIME_BEHIND_ADJ( N_MINS ) RESULT( DATE ) ! !****************************************************************************** ! Function GET_TIME_BEHIND_ADJ returns to the calling program a 2-element vector ! containing the YYYYMMDD and HHMMSS values at the current time minus N_MINS ! minutes. (dkh, 8/25/04) ! ! Arguments as Input: ! ============================================================================ ! (1 ) N_MINS (INTEGER) : Minutes ahead of time to compute YYYYMMDD,HHMMSS ! ! NOTES: ! !****************************************************************************** ! ! References to F90 modules USE JULDAY_MOD, ONLY : CALDATE ! Arguments INTEGER, INTENT(IN) :: N_MINS ! Local variables INTEGER :: DATE(2) REAL*8 :: JD !================================================================= ! GET_TIME_BEHIND_ADJ begins here! !================================================================= ! Astronomical Julian Date at current time - N_MINS JD = GET_JD( GET_NYMD(), GET_NHMS() ) - ( N_MINS / 1440d0 ) ! Call CALDATE to compute the current YYYYMMDD and HHMMSS CALL CALDATE( JD, DATE(1), DATE(2) ) ! Return to calling program END FUNCTION GET_TIME_BEHIND_ADJ !------------------------------------------------------------------------------ FUNCTION ITS_TIME_TO_CHK_T_15_AVG( ) RESULT( IS_TIME ) ! !****************************************************************************** ! Function ITS_TIME_TO_CHK_T_15_AVG returns TRUE if it's the last timestep ! of the day. (dkh, 01/23/10) ! ! NOTES: !****************************************************************************** ! ! Arguments LOGICAL :: IS_TIME !================================================================= ! ITS_TIME_TO_CHK_T_15_AVG begins here! !================================================================= IS_TIME = .FALSE. ! adjoint equivalent of ITS_A_NEW_DAY IF ( GET_NHMS() == ( 236000 - ( GET_TS_DYN() * 100d0 ) ) ) THEN IS_TIME = .TRUE. ENDIF ! Return to calling program END FUNCTION ITS_TIME_TO_CHK_T_15_AVG !------------------------------------------------------------------------------ FUNCTION ITS_TIME_TO_GET_T_15_AVG( ) RESULT( IS_TIME ) ! !****************************************************************************** ! Function ITS_TIME_TO_GET_T_15_AVG returns TRUE if it's the last timestep ! of the day. (dkh, 01/23/10) ! ! NOTES: !****************************************************************************** ! ! Arguments LOGICAL :: IS_TIME !================================================================= ! ITS_TIME_TO_GET_T_15_AVG begins here! !================================================================= IS_TIME = .FALSE. ! adjoint equivalent of ITS_A_NEW_DAY IF ( GET_NHMS() == ( 236000 - ( GET_TS_DYN() * 100d0 ) ) ) THEN IS_TIME = .TRUE. ENDIF ! Return to calling program END FUNCTION ITS_TIME_TO_GET_T_15_AVG !------------------------------------------------------------------------------ FUNCTION ITS_TIME_TO_GET_T_DAY( ) RESULT( FLAG ) ! !****************************************************************************** ! Function ITS_TIME_TO_GET_T_DAY returns TRUE if it is time to read in ! checkpointed values of T_DAY. (dkh, 01/23/10) ! ! NOTES: ! (1 ) Based on ITS_TIME_FOR_A3_ADJ. !****************************************************************************** ! ! Reference to f90 modules USE ERROR_MOD, ONLY : ERROR_STOP ! Function value LOGICAL :: FLAG ! Local variable INTEGER :: EXTRA LOGICAL, SAVE :: FIRST = .TRUE. !================================================================= ! ITS_TIME_TO_GET_T_DAY begins here! !================================================================= ! EXTRA set so that current NHMS + 1 dynamic time step is ! divisible by 030000 ! Original formula, assumes dynamic time step is 30 min !EXTRA = 7000 ! Qinbin's formula, assumes dynamic time step <= 60 min EXTRA = 4000 + GET_TS_DYN() * 100 IF ( GET_TS_DYN() > 30 ) CALL ERROR_STOP( 'Invalid EXTRA!', & 'ITS_TIME_FOR_A3_ADJ (adjoint.f)' ) ! We read in A-3 every 3 hours FLAG = ( MOD( GET_NHMS() + EXTRA, 030000 ) == 0 ) ! Return to calling program END FUNCTION ITS_TIME_TO_GET_T_DAY !------------------------------------------------------------------------------ FUNCTION GET_DIRECTION( ) RESULT ( D ) ! !****************************************************************************** ! Function GET_DIRECTION returns the value of DIRECTION (dkh, 11/08/09) ! ! Output: ! ============================================================================ ! (1 ) D (INTEGER) : 1 = forward, -1 = adjoint ! ! NOTES: ! !****************************************************************************** ! ! Function value INTEGER :: D !================================================================= ! GET_DIRECTION begins here! !================================================================= D = DIRECTION ! Return to calling program END FUNCTION GET_DIRECTION !----------------------------------------------------------------------------- SUBROUTINE SET_DIRECTION( D ) ! !****************************************************************************** ! Subroutine SET_DIRECTION is used to set the value of DIRECTION (dkh, 11/08/09) ! ! Input: ! ============================================================================ ! (1 ) D (INTEGER) : 1 = forward, -1 = adjoint ! ! NOTES: ! !****************************************************************************** ! ! Function value INTEGER :: D !================================================================= ! SET_DIRECTION begins here! !================================================================= DIRECTION = D ! Return to calling program END SUBROUTINE SET_DIRECTION !----------------------------------------------------------------------------- END MODULE TIME_MOD