Sola/GEOS-Chem-adjoint-v35-note
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
2c4f14fcdccb393528776a57521bb429a865485a
GEOS-Chem-adjoint-v35-note/code/adjoint/checkpt_mod.f
Xuesong (Steve) f842cc9639 Add files via upload
2018-08-28 00:33:48 -04:00

7680 lines
261 KiB
Fortran
Raw Blame History

! $Id: checkpt_mod.f,v 1.23 2012/04/25 22:46:23 nicolas Exp $
MODULE CHECKPT_MOD
!
!******************************************************************************
! Module CHECKPT_MOD contains variables and routines which are used to read
! and write GEOS-CHEM checkpoint files, which contain tracer concentrations
! in [v/v] mixing ratio, humidities, temperatures and exit values from rpmares
! (dkh, 8/27/04, adj_group 6/09/09)
!
! Module Variables:
! ============================================================================
! (1 ) INPUT_CHECKPT_FILE : Full path name of the checkpt file to be read
! (2 ) OUTPUT_CHECKPT_FILE : Full path name (w/ tokens!) of output file
! (3 ) INPUT_OBS_FILE : Full path name of the obs file to be read
! (4 ) OUTPUT_OBS_FILE : Full path hname (w/tokens!) of obs file
!
! Module Routines:
! ============================================================================
! (1 ) MAKE_CHECKPT_FILE : Writes checkpoint file to disk
! (2 ) READ_CHECKPT_FILE : Reads checkpoint file from disk
! (3 ) READ_OBS_FILE : Read obs file from disk (include this here
! as the observation file is currently the same
! as the checkpt file)
!
! GEOS-CHEM modules referenced by restart_mod.f
! ============================================================================
! (1 ) bpch2_mod.f : Module containing routines for binary punch file I/O
! (2 ) error_mod.f : Module containing NaN and other error check routines
! (3 ) file_mod.f : Module containing file unit numbers and error checks
! (4 ) grid_mod.f : Module containing horizontal grid information
! (5 ) time_mod.f : Module containing routines for computing time & date
! (6 ) restart_mod.f : Module containing CHECK_DIMENSIONS
!
! NOTES:
! Pretty much like a stripped down version of RESTART_MOD (dkh,8/30/04)
! (2 ) Swtich from OBS and RP_OUT to using OBS_STT and CHK_STT
! (3 ) Add CHK_PSC. (dkh, 03/16/05)
! (4 ) Added support for full chemistry. Add module varialbe PART_CASE.
! Added subroutine CHECK_DIMENSIONS_2. Modified READ / WRITE CHK
! routines and INIT / CLEAN to support full chem..
! Add SMVGARRAY.
! (dkh, 07/22/05)
! (5 ) Add support for sulfate chemistry -- add SO2_CHK and H2O2_CHK.
! (dkh, 10/12/05)
! add WETD_CHK_H2O2s_CHEMT, WETD_CHK_H2O2s_DYNT, etc. (dkh, 10/23/05)
! (6 ) Add WETD_CHK_SO2_CHEMT and WETD_CHK_SO2_DYNT. (dkh, 10/31/05)
! (7 ) Add CONV_CHK_H2O2s_CHEMT and CONV_CHK_SO2s_DYNT. (dkh, 11/22/05)
! (8 ) Add routines MAKE_SAVE_FILE and EXPAND_NAME. (dkh, 07/19/06)
! (9 ) Add SOILNOX_CHK. (dkh, 02/06/07)
! (10) Add CHK_STT_CON(:,:,:) array for checkpointing STT before convection.
! (mak, 8/2/07)
! (11) Add MAKE_CHK_DYN_FILE and READ_CHK_DYN_FILE, move checkpointing of
! variables that change at dynamic time steps to these routines. (dkh, 02/02/09)
! (12) Update to v8, delete obsolete arrays (like CHK_STT) or ones that are somewhere else
! now (adj_group, 6/09/09)
! (13) Add support for LADJ_STRAT (hml, dkh, 02/14/12, adj32_025)
! (14) Add ANISORROPIA for aerosol thermo (slc, 3/9/13, ***)
!******************************************************************************
!
IMPLICIT NONE
!=================================================================
! MODULE VARIABLES
!=================================================================
CHARACTER(LEN=255) :: INPUT_CHECKPT_FILE
CHARACTER(LEN=255) :: OUTPUT_CHECKPT_FILE
CHARACTER(LEN=255) :: INPUT_OBS_FILE
CHARACTER(LEN=255) :: OUTPUT_OBS_FILE
! Allocatable checkpoint variables
REAL*4, ALLOCATABLE :: RP_IN(:,:,:,:)
REAL*4, ALLOCATABLE :: RP_OUT(:,:,:,:)
REAL*4, ALLOCATABLE :: CHK_STT_CON(:,:,:,:)
REAL*4, ALLOCATABLE :: CHK_STT(:,:,:,:)
! move to adj_arrays_mod.f (mak, 6/14/09)
!REAL*4, ALLOCATABLE :: OBS_STT(:,:,:,:)
REAL*8, ALLOCATABLE :: CHK_PSC(:,:,:)
REAL*4, ALLOCATABLE :: gamaan_fwd(:,:,:,:)
REAL*4, ALLOCATABLE :: gamold_fwd(:,:,:,:)
REAL*4, ALLOCATABLE :: wh2o_fwd(:,:,:,:)
REAL*4, ALLOCATABLE :: ynh4_fwd(:,:,:,:)
REAL*4, ALLOCATABLE :: eror_fwd(:,:,:,:)
INTEGER, ALLOCATABLE :: exit_fwd(:,:,:,:)
REAL*4, ALLOCATABLE :: gamana_fwd(:,:,:,:)
REAL*4, ALLOCATABLE :: gamas1_fwd(:,:,:,:)
REAL*4, ALLOCATABLE :: gamas2_fwd(:,:,:,:)
INTEGER, ALLOCATABLE :: nitr_max(:,:,:)
REAL*8, ALLOCATABLE :: ORIG_STT(:,:,:,:)
INTEGER, ALLOCATABLE :: PART_CASE(:)
REAL*8, ALLOCATABLE :: CHK_STT_BEFCHEM(:,:,:,:)
REAL*4, ALLOCATABLE :: CHK_HSAVE(:,:,:)
REAL*4, ALLOCATABLE :: SO2_CHK(:,:,:)
REAL*4, ALLOCATABLE :: H2O2_CHK(:,:,:)
REAL*4, ALLOCATABLE :: WETD_CHK_H2O2s(:,:,:)
REAL*4, ALLOCATABLE :: WETD_CHK_SO2s(:,:,:)
REAL*4, ALLOCATABLE :: WETD_CHK_SO4(:,:,:)
REAL*4, ALLOCATABLE :: WETD_CHK_SO2(:,:,:)
REAL*4, ALLOCATABLE :: CONV_CHK_H2O2s(:,:,:)
REAL*4, ALLOCATABLE :: CONV_CHK_SO2s(:,:,:)
REAL*4, ALLOCATABLE :: SOILNOX_CHK(:,:)
!REAL*4, ALLOCATABLE :: CHK_STT_TD(:,:,:,:)
REAL*4, ALLOCATABLE :: CHK_STT_TC(:,:,:,:)
!>>>
! Now include adjoint of F (dkh, 10/03/08)
REAL*4, ALLOCATABLE :: QC_SO2_CHK(:,:,:,:)
!<<<
! adj_group: add for checkpointing lightning NOx emissions
REAL*8, ALLOCATABLE :: SLBASE_CHK(:,:,:)
! slc: add ANISORROPIA input checkpointing
REAL*8, ALLOCATABLE :: ANISO_IN(:,:,:,:)
INTEGER, PARAMETER :: NRPIN = 7
INTEGER, PARAMETER :: NRPOUT = 9
INTEGER, PARAMETER :: NNNMAX = 50
INTEGER, PARAMETER :: NANISOIN = 15
!=================================================================
! MODULE ROUTINES -- follow below the "CONTAINS" statement
!=================================================================
CONTAINS
!------------------------------------------------------------------------------
SUBROUTINE MAKE_CHECKPT_FILE( YYYYMMDD, HHMMSS )
!
!******************************************************************************
! Subroutine MAKE_CHECKPT_FILE creates GEOS-CHEM checkpt files of tracer
! mixing ratios (v/v), temp, rh and exit values in binary punch file format.
! (dkh, 8/27/04)!
! Arguments as Input:
! ============================================================================
! (1 ) YYYYMMDD : Year-Month-Date
! (2 ) HHMMSS : and Hour-Min-Sec for which to create a checkpoint file
!
! Passed via CMN:
! ============================================================================
! (1 ) TAU : TAU value (elapsed hours) at start of diagnostic interval
!
! Passed via ???:
! ============================================================================
! (1 ) CHECKPT : Array of quantities to be checkpointed
! dim=(IIPAR,JJPAR,LLPAR,NCHECKPT)
!
! NOTES:
! Just like MAKE_RESTART_FILE except
! - only include quantities used as input to RPMARES
! - include hhmmss in file name
! - writes files to ADJ_DIR and can zip them
! dkh, 9/30/04
! (2 ) Zip *.chk.* files one day at a time in a parallel loop. Add access
! to GET_TS_CHEM. (dkh, 11/22/04)
! (3 ) Add support for L_RECOMP option to recompute (rather than checkpoint)
! variables RP_OUT etc. (dkh, 02/09/05)
! (4 ) Now write values from CHK_STT. (dkh, 03/03/05)
! (5 ) Add CHK_PSC. (03/16/05)
! (6 ) Added support for full chemistry. Add references to NVAR, CSPEC, IXSAVE,
! IYSAVE, IZSAVE, NTLOOP_FORKPP, NSRCX
! Add variables PART_CASE, JLOOP. Disable L_RECOMP = FALSE option for now.
! Added SMVGARRAY.
! (dkh, 07/22/05)
! (7 ) Add SO2_CHK and H2O2_CHK. (dkh, 10/12/05)
! (8 ) Add WETD_CHK_H2O2s_CHEMT, WETD_CHK_H2O2s_DYNT, etc. (dkh, 10/23/05)
! (9 ) Add WETD_CHK_SO2_CHEMT, WETD_CHK_SO2_DYNT. (dkh, 10/31/05)
! (10) Add SOILNOX_CHK. (dkh, 02/06/07)
! (11) Now completely split dynamic from chemical time step checkpoints (dkh, 02/01/09)
! (12) Remove obsolete options (L_DEL_CHECKPT, L_ZIP_CHECKPT, L_RECOMP),
! check for aeroosl simulation (LSULF) and update names to v8 (dkh, 06/11/09)
! (13) Now checkpoint XYLAI (dkh, 10/14/09)
! (14) BUG FIX: LVARTROP treated correctly (dkh, 01/26/11)
! (15) Add support for CH4 simulation (kjw, dkh, 02/12/12, adj32_023)
! (16) Add ANISORROPIA for aerosol thermo (slc, 3/9/13, ***)
!******************************************************************************
!
! References to F90 modules
USE BPCH2_MOD
USE DIRECTORY_ADJ_MOD, ONLY : ADJTMP_DIR
USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP
USE FILE_MOD, ONLY : IU_RST, IOERROR
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
USE TIME_MOD, ONLY : EXPAND_DATE, GET_TAU
USE TRACER_MOD, ONLY : N_TRACERS
USE LOGICAL_MOD, ONLY : LCHEM, LSULF, LSSALT
USE LOGICAL_MOD, ONLY : LSOILNOX, LLIGHTNOX
USE LOGICAL_MOD, ONLY : LPRT
USE LOGICAL_ADJ_MOD, ONLY : LAERO_THERM
USE LOGICAL_ADJ_MOD, ONLY : LISO
USE TRACER_MOD, ONLY : ITS_A_FULLCHEM_SIM
USE TRACER_MOD, ONLY : ITS_AN_AEROSOL_SIM
USE TRACER_MOD, ONLY : N_TRACERS
USE COMODE_MOD, ONLY : CSPEC_PRIOR , JLOP
USE GCKPP_ADJ_GLOBAL, ONLY : NTT
USE TRACER_MOD, ONLY : ITS_A_CH4_SIM, STT
! LVARTROP support for adj (dkh, 01/26/11)
USE COMODE_MOD, ONLY : CSPEC_FULL_PRIOR
USE LOGICAL_MOD, ONLY : LVARTROP
USE COMODE_MOD, ONLY : ISAVE_PRIOR
USE COMODE_MOD, ONLY : NTLOOP_PRIOR
# include "CMN_SIZE" ! Size parameters
# include "comode.h" ! NTLOOP, IGAS
# include "CMN_VEL" ! XYLAI
! Arguments
INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS
! Local Variables
INTEGER :: I, I0, IOS, J, J0, L, N, JLOOP
INTEGER :: YYYY, MM, DD, HH, SS, ZIP_HH
INTEGER :: IJLOOP
CHARACTER(LEN=255) :: FILENAME
!>>>
! Now include adjoint of F (dkh, 10/03/08)
INTEGER :: NS
!<<<
! Temporary storage arrays for checkpointed variables
REAL*4 :: CHECK_RP_IN(IIPAR,JJPAR,LLPAR)
REAL*4 :: CHECK_FINAL(IIPAR,JJPAR,LLPAR)
REAL*4 :: CHECK_RP_OUT(IIPAR,JJPAR,LLPAR)
REAL*8 :: CHECK_ANISO_IN(IIPAR,JJPAR,LLPAR)
! Always recompute, so these don't need to be checkponted (dkh, 06/11/09)
! REAL*4 :: CHECK1(IIPAR,JJPAR,LLPAR)
! REAL*4 :: CHECK2(IIPAR,JJPAR,LLPAR)
! REAL*4 :: CHECK3(IIPAR,JJPAR,LLPAR)
! REAL*4 :: CHECK4(IIPAR,JJPAR,LLPAR)
! REAL*4 :: CHECK5(IIPAR,JJPAR,LLPAR)
! REAL*4 :: CHECK6(IIPAR,JJPAR,LLPAR)
! REAL*4 :: CHECK7(IIPAR,JJPAR,LLPAR)
! REAL*4 :: CHECK8(IIPAR,JJPAR,LLPAR)
! REAL*4 :: CHECK9(IIPAR,JJPAR,LLPAR)
! Now use NTLOOP because we want everything incase LVARTROP (dkh, 08/04/09)
!REAL*4 :: SMVGARRAY(NTT,IGAS)
REAL*4 :: SMVGARRAY(NTLOOP,IGAS)
! For binary punch file, version 2.0
REAL*4 :: LONRES, LATRES
INTEGER, PARAMETER :: HALFPOLAR = 1
INTEGER, PARAMETER :: CENTER180 = 1
INTEGER :: MAX_nitr_max
INTEGER :: NSOFAR, NTHERMO
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED = ''
CHARACTER(LEN=80) :: TITLE
!=================================================================
! MAKE_CHECKPT_FILE begins here!
!=================================================================
! Hardwire output file for now
OUTPUT_CHECKPT_FILE = 'gctm.chk.YYYYMMDD.hhmm'
! Clear some arrays
CHECK_RP_IN(:,:,:) = 0e0
CHECK_FINAL(:,:,:) = 0e0
CHECK_RP_OUT(:,:,:) = 0e0
CHECK_ANISO_IN(:,:,:) = 0e0
! Always recompute, so these don't need to be checkponted (dkh, 06/11/09)
! CHECK1(:,:,:) = 0e0
! CHECK2(:,:,:) = 0e0
! CHECK3(:,:,:) = 0e0
! CHECK4(:,:,:) = 0e0
! CHECK5(:,:,:) = 0e0
! CHECK6(:,:,:) = 0e0
! CHECK7(:,:,:) = 0e0
! CHECK8(:,:,:) = 0e0
! CHECK9(:,:,:) = 0e0
SMVGARRAY(:,:) = 0e0
! Define variables for BINARY PUNCH FILE OUTPUT
TITLE = 'GEOS-CHEM Checkpoint File: ' //
& 'Instantaneous Tracer Concentrations (v/v)'
CATEGORY = 'IJ-CHK-$'
LONRES = DISIZE
LATRES = DJSIZE
! Call GET_MODELNAME to return the proper model name for
! the given met data being used (bmy, 6/22/00)
MODELNAME = GET_MODELNAME()
! Get the nested-grid offsets
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
!=================================================================
! Open the checkpoint file for output -- binary punch format
!=================================================================
! Copy the output checkpoint file name into a local variable
FILENAME = TRIM( OUTPUT_CHECKPT_FILE )
! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
! Add ADJ_DIR prefix to filename
FILENAME = TRIM( ADJTMP_DIR ) // TRIM( FILENAME )
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - MAKE_CHECKPT_FILE: Writing ', a )
! Open checkpoint file for output
CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
!=================================================================
! Write each checkpointed quantity to the checkpoint file
!=================================================================
IF ( LSULF .and. LAERO_THERM ) THEN
IF ( LISO ) THEN
! ISOROPIA II takes Na+, Cl- into account
! First write the input to ISORROPIA
NTHERMO = NANISOIN ! Determine initial index in the BPCH
DO N = 1, NANISOIN
! Set UNIT
IF ( N == 9 .OR. N > 10 ) THEN
! RH
UNIT = 'unitless'
ELSEIF ( N == 10 ) THEN
! Temp
UNIT = 'K'
ELSE
! Some concentration
UNIT = 'mole/m3'
ENDIF
! Temporarily store data in CHECK_ANISO_IN
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
CHECK_ANISO_IN(I,J,L) = ANISO_IN(I,J,L,N)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
CALL BPCH3( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, N,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLPAR, I0+1,
& J0+1, 1, CHECK_ANISO_IN )
ENDDO
ELSE ! Call checkpointing for RPMARES
NTHERMO = NRPIN ! Determine initial index in the BPCH
! First write the input to RPMARES
DO N = 1, NRPIN
! Set UNIT
IF ( N == 6 ) THEN
! RH
UNIT = '%'
ELSEIF ( N == 7 ) THEN
! Temp
UNIT = 'K'
ELSE
! Some concentration
UNIT = 'ug/m3'
ENDIF
! Temporarily store data in CHECK_RP_IN
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
CHECK_RP_IN(I,J,L) = RP_IN(I,J,L,N)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, N,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLPAR, I0+1,
& J0+1, 1, CHECK_RP_IN )
ENDDO
ENDIF ! LSSALT
ENDIF ! LSULF
! Support for CH4 (kjw, dkh, 02/12/12, adj32_023)
IF ( .not. ITS_A_CH4_SIM() ) THEN
! Write the final concetration values as saved at the end of geos_mod.f
UNIT = 'kg/box'
! Change to N_TRACERS (dkh, 06/11/09)
!DO N = 1, NOBS
DO N = 1, N_TRACERS
! Temporarily store data in CHECK_FINAL
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
CHECK_FINAL(I,J,L) = CHK_STT(I,J,L,N)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, N + NTHERMO,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLPAR, I0+1,
& J0+1, 1, CHECK_FINAL )
ENDDO
! It is a CH4 simulation
ELSE
! Write the final concetration values as saved at the end of geos_mod.f
UNIT = 'kg/box'
DO N = 1, N_TRACERS
! Temporarily store data in CHECK_FINAL
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
CHECK_FINAL(I,J,L) = STT(I,J,L,N)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
print*,'READ_CHECKPT: stt(14,14,14,1) =',
& stt(14,14,14,1)
print*,'READ_CHECKPT: check_final(14,14,14,1) =',
& CHECK_FINAL(14,14,14)
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 1,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLPAR, I0+1,
& J0+1, 1, CHECK_FINAL )
ENDDO
ENDIF ! ITS_A_CH4_SIM
! Checkpt additional values for full chem simulation
! Replace NSRCX (dkh, 06/11/09)
!IF ( NSRCX == 3 .AND. LCHEM ) THEN
IF ( ITS_A_FULLCHEM_SIM() .AND. LCHEM ) THEN
! Write the final species concetrations after full chemistry
UNIT = 'molec/cm3/box'
! Transfer to temp array so that we only checkpt NTLOOP values,
! not ITLOOP.
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( JLOOP, N )
DO N = 1, IGAS
!DO JLOOP = 1, NTT
DO JLOOP = 1, NTLOOP
SMVGARRAY(JLOOP,N) = CSPEC_PRIOR(JLOOP,N)
ENDDO
ENDDO
!$OMP END PARALLEL DO
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 1 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& NTLOOP, IGAS, 1, I0+1,
& J0+1, 1, SMVGARRAY )
! Set NSOFAR
NSOFAR = NSOFAR + 1
! Transfer to temp array so that we only checkpt NTLOOP values,
! not ITLOOP.
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( JLOOP )
DO JLOOP = 1, NTT
SMVGARRAY(JLOOP,1) = REAL( PART_CASE(JLOOP) )
ENDDO
!$OMP END PARALLEL DO
! Checkpoint PART_CASE
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 1 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& NTT, 1, 1, I0+1,
& J0+1, 1, SMVGARRAY )
! Set NSOFAR
NSOFAR = NSOFAR + 1
! Write the tracer concetrations before chemisty
UNIT = 'kg/box'
DO N = 1, N_TRACERS
! Temporarily store data in CHECK_FINAL
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
CHECK_FINAL(I,J,L) = CHK_STT_BEFCHEM(I,J,L,N)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, N + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLPAR, I0+1,
& J0+1, 1, CHECK_FINAL )
ENDDO
! Set NSOFAR
NSOFAR = NSOFAR + N_TRACERS
! LVARTROP support for adj (dkh, 01/26/11)
! Write CSPEC_FULL_PRIOR
IF ( LVARTROP ) THEN
UNIT = 'molec/cm3'
DO N = 1, IGAS
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, N + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& ILONG, ILAT, IPVERT, I0+1,
& J0+1, 1,
& REAL(CSPEC_FULL_PRIOR(1:ILONG,1:ILAT,1:IPVERT,N),4))
ENDDO
! Set NSOFAR
NSOFAR = NSOFAR + IGAS
! Write the 3-D to 1-D mappings
UNIT = 'none'
CATEGORY = 'isave'
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 1 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& NTLOOP_PRIOR, 3, 1, I0+1,
& J0+1, 1,
& REAL(ISAVE_PRIOR(1:NTLOOP_PRIOR,:),4) )
! Set NSOFAR
NSOFAR = NSOFAR + 1
! reset CATEGORY
CATEGORY = 'IJ-CHK-$'
ENDIF
! Write last internal time step used by Rosenbrock Solver
! (dkh, 09/06/05)
UNIT = 's'
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 1 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLTROP, I0+1,
& J0+1, 1, CHK_HSAVE )
! Set NSOFAR
NSOFAR = NSOFAR + 1
ENDIF
IF ( LSULF .AND. LCHEM ) THEN
! Write the concentrations of SO2 and H2O2 used by CHEM_SO2
! (dkh, 10/12/05)
UNIT = 'v/v'
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 1 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLTROP, I0+1,
& J0+1, 1, SO2_CHK )
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 2 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLTROP, I0+1,
& J0+1, 1, H2O2_CHK )
! Set NSOFAR
NSOFAR = NSOFAR + 2
ENDIF
! SOILNOX
IF ( LSOILNOX ) THEN
UNIT = 'molec/cm2/s'
! Temporarily store data in CHECK_FINAL
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
CHECK_FINAL(I,J,1) = SOILNOX_CHK(I,J)
ENDDO
ENDDO
!$OMP END PARALLEL DO
! write to file
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 1 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, 1, I0+1,
& J0+1, 1, CHECK_FINAL(:,:,1) )
! Update NSOFAR
NSOFAR = NSOFAR + 1
ENDIF
! Only do this for fullchem (mak, dkh, 01/06/10)
IF ( LCHEM .and. ITS_A_FULLCHEM_SIM() ) THEN
! Now checkpoint XYLAI as well, as it is difficult to recalc
DO N = 1, NTYPE
! This mapping is clunky, but copied directly from rdlai.f
IJLOOP = 0
DO J = 1, JJPAR
DO I = 1, IIPAR
IJLOOP = IJLOOP + 1
SMVGARRAY(IJLOOP,1) = REAL( XYLAI(IJLOOP,N) )
END DO
END DO
! Checkpoint XYLAI
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 1 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& NTT, 1, 1, I0+1,
& J0+1, 1, SMVGARRAY )
! Set NSOFAR
NSOFAR = NSOFAR + 1
ENDDO
ENDIF
! SLBASE
IF ( LLIGHTNOX ) THEN
UNIT = 'molec/6h/box'
! Temporarily store data in CHECK_FINAL
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO l = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
CHECK_FINAL(I,J,L) = SLBASE_CHK(I,J,L)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
! write to file
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 1 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLPAR, I0+1,
& J0+1, 1, CHECK_FINAL(:,:,:) )
! Update NSOFAR
NSOFAR = NSOFAR + 1
ENDIF
! Remove this, it wasn't a noticable improvement (dkh, 06/11/09)
! IF ( LADJ_TRAN ) THEN
! UNIT = 'v/v'
!
! ! CHK_STT_TD
! DO N = 1, NTRACE
! ! Temporarily store data in CHECK_FINAL
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, L )
! DO l = 1, LLPAR
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! CHECK_FINAL(I,J,L) = CHK_STT_TD(I,J,L,N)
! ENDDO
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ! write to file
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 1 + NSOFAR,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, LLPAR, I0+1,
! & J0+1, 1, CHECK_FINAL(:,:,:) )
!
! ! Update NSOFAR
! NSOFAR = NSOFAR + 1
! ENDDO
! ! CHK_STT_TC
! DO N = 1, NTRACE
! ! Temporarily store data in CHECK_FINAL
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, L )
! DO l = 1, LLPAR
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! CHECK_FINAL(I,J,L) = CHK_STT_TC(I,J,L,N)
! ENDDO
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ! write to file
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 1 + NSOFAR,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, LLPAR, I0+1,
! & J0+1, 1, CHECK_FINAL(:,:,:) )
!
! ! Update NSOFAR
! NSOFAR = NSOFAR + 1
! ENDDO
! ENDIF
! Remove this obsolete option (which was always T) (dkh, 06/11/09)
! ! Check for recomputation -- if so, go ahead and finish up.
! IF (L_RECOMP) GOTO 444
!
! ! It's been awhile since I've tried L_RECOMP = .FALSE. Some things
! ! need to be update (NSOFAR, anything else?) dkh, 07/22/05
! CALL ERROR_STOP( 'L_RECOMP = F not supported',
! & 'MAKE_CHECKPT_FILE' )
!
!
! ! Write the output from RPMARES
! DO N = 1, NRPOUT
!
! ! Set UNIT
! IF ( N == 9 ) THEN
!
! ! EXIT value
! UNIT = 'unitless'
!
! ELSE
!
! ! Some concentration
! UNIT = 'ug/m3'
!
! ENDIF
!
! ! Temporarily store data in CHECK_RPOUT
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, L )
! DO L = 1, LLPAR
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! CHECK_RP_OUT(I,J,L) = RP_OUT(I,J,L,N)
! ENDDO
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, N + NSOFAR,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, LLPAR, I0+1,
! & J0+1, 1, CHECK_RP_OUT )
!
! ENDDO
!
! NSOFAR = NSOFAR + NRPOUT
!
! ! Write the values of nitr_max
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, N + NSOFAR,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, LLPAR, I0+1,
! & J0+1, 1, REAL( nitr_max ) )
!
! ! Calculate max of nitr_max
! MAX_nitr_max = MAXVAL( nitr_max(:,:,:) )
!
! ! Check to see that nitr_max is in the right range
! IF ( MAX_nitr_max > NNNMAX )
! & CALL ERROR_STOP( 'nitr_max > NNNMAX', 'MAKE_CHECKPT_FILE' )
! IF ( MAX_nitr_max == 0 )
! & CALL ERROR_STOP( 'MAXVAL (nitr_max) = 0', 'MAKE_CHECKPT_FILE' )
!
! ! Now write the intermediate values necessary for adjoint computation
! DO N = 1, MAX_nitr_max
!
! ! Update tracer number
! NSOFAR = NRPIN + NOBS + 1 + NRPOUT + 1 + 9 * (N-1)
! !Temporarily store quantities in the TRACER array
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, L )
! DO L = 1, LLPAR
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! IF ( N <= nitr_max(I,J,L) ) THEN
! CHECK1(I,J,L) = gamaan_fwd (I,J,L,N)
! CHECK2(I,J,L) = gamold_fwd (I,J,L,N)
! CHECK3(I,J,L) = wh2o_fwd (I,J,L,N)
! CHECK4(I,J,L) = ynh4_fwd (I,J,L,N)
! CHECK5(I,J,L) = eror_fwd (I,J,L,N)
! CHECK6(I,J,L) = REAL ( exit_fwd (I,J,L,N) )
! CHECK7(I,J,L) = gamana_fwd (I,J,L,N)
! CHECK8(I,J,L) = gamas1_fwd (I,J,L,N)
! CHECK9(I,J,L) = gamas2_fwd (I,J,L,N)
! ENDIF
! ENDDO
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 1 + NSOFAR,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, LLPAR, I0+1,
! & J0+1, 1, CHECK1 )
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 2 + NSOFAR,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, LLPAR, I0+1,
! & J0+1, 1, CHECK2 )
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 3 + NSOFAR,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, LLPAR, I0+1,
! & J0+1, 1, CHECK3 )
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 4 + NSOFAR,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, LLPAR, I0+1,
! & J0+1, 1, CHECK4 )
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 5 + NSOFAR,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, LLPAR, I0+1,
! & J0+1, 1, CHECK5 )
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 6 + NSOFAR,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, LLPAR, I0+1,
! & J0+1, 1, CHECK6 )
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 7 + NSOFAR,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, LLPAR, I0+1,
! & J0+1, 1, CHECK7 )
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 8 + NSOFAR,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, LLPAR, I0+1,
! & J0+1, 1, CHECK8 )
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 9 + NSOFAR,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, LLPAR, I0+1,
! & J0+1, 1, CHECK9 )
! ENDDO
!
444 CONTINUE
! Close file
CLOSE( IU_RST )
! Remove obsolete option (dkh, 06/11/09)
! ! Zip files
! IF ( L_ZIP_CHECKPT ) CALL BATCH_ZIP( YYYYMMDD, HHMMSS, 'chk', 1 )
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### MAKE_CHECKPT_FILE: wrote file' )
! Return to calling program
END SUBROUTINE MAKE_CHECKPT_FILE
!------------------------------------------------------------------------------
SUBROUTINE READ_CHECKPT_FILE( YYYYMMDD, HHMMSS )
!
!******************************************************************************
! Subroutine READ_CHECKPT_FILE initializes GEOS-CHEM tracer concentrations
! from a checkpoint file (binary punch file format)
! (dkh, 8/30/04)
!
! Arguments as input:
! ============================================================================
! (1 ) YYYYMMDD : Year-Month-Day
! (2 ) HHMMSS : and Hour-Min-Sec for which to read restart file
!
! Passed via CMN:
! ============================================================================
! (1 ) TAU : TAU value (elapsed hours) at start of diagnostic interval
!
! Notes
! (1 ) Just like READ_RESTART_FILE except
! - load the variables from TRACER directly back into the CHECKPT array
! - file name now includes hhmmss
! - reads files from ADJ_DIR (and can unzip them if L_ZIP_CHECKPT)
! - removes .chk. files after reading (if L_DEL_CHECKPT)
! dkh, 9/30/04
! (2 ) Add DATE(2) and reference GET_NHMDe and GET_NHMSe to enable BATCH_ZIP
! (dkh, 11/22/04)
! (3 ) Add support for L_RECOMP option to recompute (rather than checkpoint)
! variables RP_OUT etc. (dkh, 02/09/05)
! (4 ) Now read in values to CHK_STT (dkh, 03/03/05)
! (5 ) Add CHK_PSC. (dkh, 03/16/05)
! (6 ) Added support for full chemistry. Add references to NVAR, CSPEC, JLOP,
! NTLOOP_FORKPP.
! Add variables PART_CASE, JLOOP. Disable L_RECOMP = FALSE option for now.
! Add SMVGARRAY
! (dkh, 07/22/05)
! (7 ) Add SO2_CHK and H2O2_CHK. (dkh, 10/12/05)
! (8 ) Add WETD_CHK_H2O2s_CHEMT, WETD_CHK_H2O2s_DYNT, etc. (dkh, 10/23/05)
! (9 ) Add WETD_CHK_SO2CHEMT, WETD_CHK_SO2_DYNT. (dkh, 10/31/05)
! (10) Add CONV_CHK_H2O2s_CHEMT, CONV_CHK_SO2s_CHEMT, etc. (dkh, 11/22/05)
! (11) Add SOILNOX. (dkh, 02/06/07)
! (12) Move dynamic checkpointing to READ_CHK_DYN_FILE. (dkh, 02/01/09)
! (13) Remove obsolete options (L_DEL_CHECKPT, L_ZIP_CHECKPT, L_RECOMP),
! check for aeroosl simulation (LSULF) and update names to v8 (dkh, 06/11/09)
! (14) Add XYLAI (dkh, 10/14/09)
! (15) BUG FIX: LVARTROP treated correctly (dkh, 01/26/11)
! (16) BUF FIX: Fill CSPEC with SMAL2 to prevent underflow later (dkh, 02/18/11)
! (17) Add ANISORROPIA for aerosol thermo (slc, 3/9/13, ***)
!******************************************************************************
!
! References to F90 modules
USE BPCH2_MOD, ONLY : OPEN_BPCH2_FOR_READ
USE COMODE_MOD, ONLY : CHK_CSPEC, JLOP
USE DIRECTORY_ADJ_MOD, ONLY : ADJTMP_DIR
USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP
USE FILE_MOD, ONLY : IU_RST, IOERROR
USE GCKPP_ADJ_GLOBAL, ONLY : NTT
USE LOGICAL_MOD, ONLY : LCHEM , LSULF, LSSALT
USE LOGICAL_MOD, ONLY : LSOILNOX, LLIGHTNOX
USE LOGICAL_MOD, ONLY : LPRT
USE LOGICAL_ADJ_MOD, ONLY : LAERO_THERM
USE LOGICAL_ADJ_MOD, ONLY : LDEL_CHKPT
USE LOGICAL_ADJ_MOD, ONLY : LISO
USE RESTART_MOD, ONLY : CHECK_DIMENSIONS
USE TIME_MOD, ONLY : EXPAND_DATE
USE TRACER_MOD, ONLY : ITS_A_FULLCHEM_SIM
USE TRACER_MOD, ONLY : ITS_AN_AEROSOL_SIM
USE TRACER_MOD, ONLY : N_TRACERS
USE UNIX_CMDS_MOD, ONLY : REMOVE_CMD
! LVARTROP support for adj (dkh, 01/26/11)
USE COMODE_MOD, ONLY : CSPEC_FULL
USE LOGICAL_MOD, ONLY : LVARTROP
USE COMODE_MOD, ONLY : ISAVE_PRIOR
# include "CMN_SIZE" ! Size parameters
# include "comode.h" ! ITLOOP, IGAS
# include "CMN_VEL" ! XYLAI
! Arguments
INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS
! Local Variables
INTEGER :: I, IOS, J, L, N, JLOOP, NN, NTL
INTEGER :: NCOUNT(NNPAR)
REAL*4 :: TRACER(IIPAR,JJPAR,LLPAR)
REAL*8 :: TRACERANISO(IIPAR,JJPAR,LLPAR)
! Remove these since we always recompute instead
! of checkpointing (dkh, 06/11/09)
! REAL*4 :: CHECK1(IIPAR,JJPAR,LLPAR)
! REAL*4 :: CHECK2(IIPAR,JJPAR,LLPAR)
! REAL*4 :: CHECK3(IIPAR,JJPAR,LLPAR)
! REAL*4 :: CHECK4(IIPAR,JJPAR,LLPAR)
! REAL*4 :: CHECK5(IIPAR,JJPAR,LLPAR)
! REAL*4 :: CHECK6(IIPAR,JJPAR,LLPAR)
! REAL*4 :: CHECK7(IIPAR,JJPAR,LLPAR)
! REAL*4 :: CHECK8(IIPAR,JJPAR,LLPAR)
! REAL*4 :: CHECK9(IIPAR,JJPAR,LLPAR)
REAL*4 :: SMVGARRAY(ITLOOP,IGAS)
!>>>
! Now include adjoint of F (dkh, 10/03/08)
INTEGER :: NS
!<<<
REAL*8 :: SUMTC
CHARACTER(LEN=255) :: FILENAME
CHARACTER(LEN=255) :: UNZIP_FILE_CMD
CHARACTER(LEN=255) :: REMOVE_CHK_FILE_CMD
! For binary punch file, version 2.0
INTEGER :: NI, NJ, NL, NV
INTEGER :: IJLOOP
INTEGER :: IFIRST, JFIRST, LFIRST
INTEGER :: NTRACER, NSKIP
INTEGER :: HALFPOLAR, CENTER180
REAL*4 :: LONRES, LATRES
REAL*8 :: ZTAU0, ZTAU1
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED
!=================================================================
! READ_CHECKPT_FILE begins here!
!=================================================================
! Hardwire output file for now
INPUT_CHECKPT_FILE = 'gctm.chk.YYYYMMDD.hhmm'
! Initialize some variables
NCOUNT(:) = 0
TRACER(:,:,:) = 0e0
TRACERANISO(:,:,:) = 0e0
! Remove these since we always recompute instead
! of checkpointing (dkh, 06/11/09)
! CHECK1(:,:,:) = 0e0
! CHECK2(:,:,:) = 0e0
! CHECK3(:,:,:) = 0e0
! CHECK4(:,:,:) = 0e0
! CHECK5(:,:,:) = 0e0
! CHECK6(:,:,:) = 0e0
! CHECK7(:,:,:) = 0e0
! CHECK8(:,:,:) = 0e0
! CHECK9(:,:,:) = 0e0
SMVGARRAY(:,:) = 0e0
!=================================================================
! Open checkpoint file and read top-of-file header
!=================================================================
! Copy input file name to a local variable
FILENAME = TRIM( INPUT_CHECKPT_FILE )
! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
! Add ADJ_DIR prefix to name
FILENAME = TRIM( ADJTMP_DIR ) // TRIM( FILENAME )
! Echo some input to the screen
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
WRITE( 6, '(a,/)' ) 'C H E C K P T F I L E I N P U T'
! Obsolete (dkh, 06/11/09)
! ! Unzip checkpt file
! IF ( L_ZIP_CHECKPT ) THEN
! UNZIP_FILE_CMD = TRIM( GUNZIP_CMD ) // ' ' //
! & TRIM( FILENAME ) // ZIP_SUFFIX
! CALL SYSTEM( TRIM( UNZIP_FILE_CMD ) )
! WRITE( 6, 99 ) TRIM( UNZIP_FILE_CMD )
! 99 FORMAT( ' - READ_CHECKPT_FILE: Executing: ',a )
! ENDIF
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - READ_CHECKPT_FILE: Reading ', a )
! Open the binary punch file for input
CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!=================================================================
! Read checkpointed variables
!=================================================================
! First read the input to thermo - ISORROPIA or RPMARES
! Add check for full chem with aerosols (dkh, 06/11/09)
IF ( LSULF .and. LAERO_THERM ) THEN
IF ( LISO ) THEN
! ISOROPIA II takes Na+, Cl- into account
DO N = 1, NANISOIN
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) EXIT
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:4' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:5')
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACERANISO(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL)
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:6')
!===========================================================
! Assign data from the TRACER array to the STT array.
!===========================================================
! Only process checkpoint data (i.e. mixing ratio)
IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN !???!
! Make sure array dimensions are of global size
! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
CALL CHECK_DIMENSIONS( NI, NJ, NL )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
ANISO_IN(I,J,L,N) = TRACERANISO(I,J,L)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
ENDDO
ELSE
! RPMARES checkpointing
DO N = 1, NRPIN
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) EXIT
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:4' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:5')
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:6')
!==============================================================
! Assign data from the TRACER array to the STT array.
!==============================================================
! Only process checkpoint data (i.e. mixing ratio)
IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
! Make sure array dimensions are of global size
! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
CALL CHECK_DIMENSIONS( NI, NJ, NL )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
RP_IN(I,J,L,N) = TRACER(I,J,L)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
ENDDO
ENDIF ! ISORROPIA or RPMARES
ENDIF
! Read the values of CHK_STT
! Change to N_TRACES (dkh, 06/11/09)
!DO N = 1, NOBS
DO N = 1, N_TRACERS
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) EXIT
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:7' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:8' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:9' )
!==============================================================
! Assign data from the TRACER array to the STT array.
!==============================================================
! Only process checkpoint data (i.e. mixing ratio)
IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
! Make sure array dimensions are of global size
! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
CALL CHECK_DIMENSIONS( NI, NJ, NL )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
CHK_STT(I,J,L,N) = TRACER(I,J,L)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
ENDDO
! Replace NSRCX (dkh, 06/11/09)
!IF ( NSRCX == 3 .AND. LCHEM ) THEN
IF ( ITS_A_FULLCHEM_SIM() .AND. LCHEM ) THEN
! Read the values of CHK_CSPEC
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 555
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:13' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NTL, NN, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:14' )
READ( IU_RST, IOSTAT=IOS )
& ( ( SMVGARRAY(JLOOP,N), JLOOP=1,NTL ), N=1,NN )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:16' )
!==============================================================
! Assign data from the SMVGARRAY array to CHK_CSPEC
!==============================================================
! Only process checkpoint data
IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
! Check to make sure data is NTLOOPxNVAR
!Can't do this because RURALBOX hasn't been called for this
!time step yet, so we don't know NTT yet (dkh, 07/31/09
!CALL CHECK_DIMENSIONS_2( NTL, NN, NL,
! NTT, IGAS, 1 )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( JLOOP, N )
DO N = 1, NN
DO JLOOP = 1, NTLOOP
! BUG FIX: fill with 1d-99 to prevent underflow later (dkh, 02/18/11)
!CHK_CSPEC(JLOOP,N) = SMVGARRAY(JLOOP,N)
CHK_CSPEC(JLOOP,N) = MAX(SMVGARRAY(JLOOP,N),SMAL2)
ENDDO
ENDDO
!$OMP END PARALLEL DO
! dkh debug
! print*, ' In reac_checkpt: chk_cspec(FD) = ',
! & CHK_CSPEC(JLOP(IFD,JFD,LFD),:)
! print*, ' In reac_checkpt: smvgarray(FD) = ',
! & SMVGARRAY(JLOP(IFD,JFD,LFD),:)
ELSE
CALL ERROR_STOP(' Category is not correct ',
& ' reading CHK_CSPEC, checkpt_mod')
ENDIF
! Read in partition case PART_CASE
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 555
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:17' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NTL, NN, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:18' )
READ( IU_RST, IOSTAT=IOS )
& ( ( SMVGARRAY(JLOOP,N), JLOOP=1,NTL ), N=1,NN )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:20' )
! Convert from SMVGARRAY (REAL) to PART_CASE (INT)
! ! Check to make sure data is NTLOOPx1
! CALL CHECK_DIMENSIONS_2( NTL, NN, NL,
! & NTT 1, 1 )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( JLOOP )
DO JLOOP = 1, NTL
PART_CASE(JLOOP) = INT( SMVGARRAY(JLOOP,NN) )
ENDDO
!$OMP END PARALLEL DO
! Read the values of CHK_STT_BEFCHEM
DO N = 1, N_TRACERS
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) EXIT
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:21' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:22' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:23' )
!==============================================================
! Assign data from the TRACER array to the STT array.
!==============================================================
! Only process checkpoint data (i.e. mixing ratio)
IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
! Make sure array dimensions are of global size
! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
CALL CHECK_DIMENSIONS( NI, NJ, NL )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
CHK_STT_BEFCHEM(I,J,L,N) = TRACER(I,J,L)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
ENDDO
! LVARTROP support for adj (dkh, 01/26/11)
IF ( LVARTROP ) THEN
! Read the values of CSPEC_FULL
DO N = 1, IGAS
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) EXIT
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:210' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:220' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:230' )
!==============================================================
! Assign data from the TRACER array to the CSPEC_FULL array.
!==============================================================
! Only process checkpoint data (i.e. mixing ratio)
IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
! Make sure array dimensions are of global size
! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
!CALL CHECK_DIMENSIONS( NI, NJ, NL )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, IPVERT
DO J = 1, ILAT
DO I = 1, ILONG
! BUG FIX: fill with 1d-99 to prevent underflow later (dkh, 02/18/11)
!CSPEC_FULL(I,J,L,N) = TRACER(I,J,L)
CSPEC_FULL(I,J,L,N) = MAX(TRACER(I,J,L),SMAL2)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
ENDDO
! Read the values of ISAVE_PRIOR
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 555
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:13' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NTL, NN, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:14' )
READ( IU_RST, IOSTAT=IOS )
& ( ( SMVGARRAY(JLOOP,N), JLOOP=1,NTL ), N=1,NN )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:16' )
!==============================================================
! Assign data from the SMVGARRAY array to CHK_CSPEC
!==============================================================
! Only process checkpoint data
IF ( CATEGORY(1:8) == 'isave' ) THEN
! Check to make sure data is NTLOOPxNVAR
!Can't do this because RURALBOX hasn't been called for this
!time step yet, so we don't know NTT yet (dkh, 07/31/09
!CALL CHECK_DIMENSIONS_2( NTL, NN, NL,
! NTT, IGAS, 1 )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( JLOOP, N )
DO N = 1, 3
DO JLOOP = 1, NTL
ISAVE_PRIOR(JLOOP,N) = INT(SMVGARRAY(JLOOP,N))
ENDDO
ENDDO
!$OMP END PARALLEL DO
ELSE
CALL ERROR_STOP(' Category is not correct ',
& ' reading CHK_CSPEC, checkpt_mod')
ENDIF
ENDIF ! LVARTROP
! Read the values of CHK_HSAVE
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 555
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:24' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:25' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( CHK_HSAVE(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:26' )
ENDIF
IF ( LSULF .and. LCHEM ) THEN
! Read the values of SO2_CHK
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 555
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:27' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:28' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( SO2_CHK(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:29' )
! Read the values of H2O2_CHK
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 555
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:30' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:31' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( H2O2_CHK(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:32' )
ENDIF ! LCHEM
! SOILNOX
IF ( LSOILNOX ) THEN
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 555
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:63' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:64' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ),
& L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:59' )
SOILNOX_CHK(:,:) = TRACER(:,:,1)
ENDIF
! Only do this for fullchem (mak, dkh, 01/06/10)
IF ( LCHEM .and. ITS_A_FULLCHEM_SIM() ) THEN
! Read in partition case XYLAI (dkh, 10/14/09)
DO NV = 1 , NTYPE
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 555
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:17' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NTL, NN, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:18' )
READ( IU_RST, IOSTAT=IOS )
& ( ( SMVGARRAY(JLOOP,N), JLOOP=1,NTL ), N=1,NN )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:20' )
! This mapping is clunky, but copied directly from rdlai.f
IJLOOP = 0
DO J = 1, JJPAR
DO I = 1, IIPAR
IJLOOP = IJLOOP + 1
XYLAI(IJLOOP,NV) = SMVGARRAY(IJLOOP,1)
END DO
END DO
ENDDO
ENDIF
! SLBASE
IF ( LLIGHTNOX ) THEN
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 555
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:63' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:64' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ),
& L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:59' )
SLBASE_CHK(:,:,:) = TRACER(:,:,:)
ENDIF
! Take this part out, it didn't help much (dkh, 06/11/09)
! IF ( LADJ_TRAN ) THEN
! ! Read the values of CHK_STT_TD
! DO N = 1, NTRACE
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so exit
! IF ( IOS < 0 ) EXIT
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 )
! & CALL IOERROR( IOS,IU_RST,'read_checkpt_file:121' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 )
! & CALL IOERROR(IOS,IU_RST,'read_checkpt_file:122' )
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 )
! & CALL IOERROR( IOS,IU_RST,'read_checkpt_file:123' )
!
! !==============================================================
! ! Assign data from the TRACER array to the STT array.
! !==============================================================
!
! ! Only process checkpoint data (i.e. mixing ratio)
! IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
!
! ! Make sure array dimensions are of global size
! ! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
! CALL CHECK_DIMENSIONS( NI, NJ, NL )
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, L )
! DO L = 1, LLPAR
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! CHK_STT_TD(I,J,L,N) = TRACER(I,J,L)
! ENDDO
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ENDIF
! ENDDO
!
! ! Read the values of CHK_STT_TC
! DO N = 1, NTRACE
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so exit
! IF ( IOS < 0 ) EXIT
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 )
! & CALL IOERROR( IOS,IU_RST,'read_checkpt_file:221' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 )
! & CALL IOERROR(IOS,IU_RST,'read_checkpt_file:222' )
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 )
! & CALL IOERROR( IOS,IU_RST,'read_checkpt_file:223' )
!
! !==============================================================
! ! Assign data from the TRACER array to the STT array.
! !==============================================================
!
! ! Only process checkpoint data (i.e. mixing ratio)
! IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
!
! ! Make sure array dimensions are of global size
! ! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
! CALL CHECK_DIMENSIONS( NI, NJ, NL )
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, L )
! DO L = 1, LLPAR
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! CHK_STT_TC(I,J,L,N) = TRACER(I,J,L)
! ENDDO
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ENDIF
! ENDDO
!
! ENDIF ! LADJ_TRAN
! Take this out as I always had L_RECOMP = T
! ! Check for recomputation -- if so, go ahead and finish up
! IF ( L_RECOMP ) GOTO 555
!
! ! Read output from RPMARES
! DO N = 1, NRPOUT
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so exit
! IF ( IOS < 0 ) EXIT
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:4' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:5')
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:6')
!
! !==============================================================
! ! Assign data from the TRACER array to the STT array.
! !==============================================================
!
! ! Only process checkpoint data (i.e. mixing ratio)
! IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
!
! ! Make sure array dimensions are of global size
! ! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
! CALL CHECK_DIMENSIONS( NI, NJ, NL )
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, L )
! DO L = 1, LLPAR
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! RP_OUT(I,J,L,N) = TRACER(I,J,L)
! ENDDO
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ENDIF
! ENDDO
!
! ! Read nitr_max
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so return
! IF ( IOS < 0 ) RETURN
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:4' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:5')
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:6')
!
! !==============================================================
! ! Assign data from the TRACER array to the STT array.
! !==============================================================
!
! ! Only process checkpoint data (i.e. mixing ratio)
! IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
!
! ! Make sure array dimensions are of global size
! ! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
! CALL CHECK_DIMENSIONS( NI, NJ, NL )
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, L )
! DO L = 1, LLPAR
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! nitr_max(I,J,L) = INT( TRACER(I,J,L) )
! ENDDO
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ENDIF
!
! ! Read the variables checkpointed for the adjoint calculation
! ! CHECK1
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so return
! IF ( IOS < 0 ) RETURN
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:4' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:5')
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( CHECK1(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:6')
!
!
! ! CHECK2
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so return
! IF ( IOS < 0 ) RETURN
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:4' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:5')
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( CHECK2(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:6')
!
!
! ! CHECK3
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so return
! IF ( IOS < 0 ) RETURN
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:4' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:5')
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( CHECK3(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:6')
!
!
! ! CHECK4
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so return
! IF ( IOS < 0 ) RETURN
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:4' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:5')
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( CHECK4(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:6')
!
!
! ! CHECK5
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so return
! IF ( IOS < 0 ) RETURN
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:4' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:5')
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( CHECK5(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:6')
!
!
! ! CHECK6
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so return
! IF ( IOS < 0 ) RETURN
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:4' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:5')
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( CHECK6(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:6')
!
!
! ! CHECK7
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so return
! IF ( IOS < 0 ) RETURN
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:4' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:5')
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( CHECK7(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:6')
!
!
! ! CHECK7
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so return
! IF ( IOS < 0 ) RETURN
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:4' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:5')
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( CHECK7(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:6')
!
!
! ! CHECK8
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so return
! IF ( IOS < 0 ) RETURN
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:4' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:5')
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( CHECK8(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:6')
!
!
! ! CHECK9
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so return
! IF ( IOS < 0 ) RETURN
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:4' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:5')
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( CHECK9(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_checkpt_file:6')
!
!
! ! Write check arrays to the appropriate adjoint variables
! DO N = 1, MAXVAL ( nitr_max(:,:,:) )
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, L )
! DO L = 1, LLPAR
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! gamaan_fwd (I,J,L,N) = CHECK1(I,J,L)
! gamold_fwd (I,J,L,N) = CHECK2(I,J,L)
! wh2o_fwd (I,J,L,N) = CHECK3(I,J,L)
! ynh4_fwd (I,J,L,N) = CHECK4(I,J,L)
! eror_fwd (I,J,L,N) = CHECK5(I,J,L)
! exit_fwd (I,J,L,N) = INT( CHECK6(I,J,L) )
! gamana_fwd (I,J,L,N) = CHECK7(I,J,L)
! gamas1_fwd (I,J,L,N) = CHECK8(I,J,L)
! gamas2_fwd (I,J,L,N) = CHECK9(I,J,L)
! ENDDO
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ENDDO
!
555 CONTINUE
! Close file
CLOSE( IU_RST )
! Remove files if L_CHK_DEL = TRUE
IF ( LDEL_CHKPT ) THEN
REMOVE_CHK_FILE_CMD = TRIM ( REMOVE_CMD ) // ' ' //
& TRIM ( FILENAME )
CALL SYSTEM( TRIM( REMOVE_CHK_FILE_CMD ) )
WRITE( 6, 102 ) TRIM( REMOVE_CHK_FILE_CMD )
102 FORMAT( ' - READ_CHECKPT_FILE: Executing: ',a )
ENDIF
! ! Zip the .chk. file if it hasn't been deleted and zipping
! ! is requested
! IF ( L_ZIP_CHECKPT .AND. (.NOT. L_DEL_CHECKPT) ) THEN
! CALL BATCH_ZIP( YYYYMMDD, HHMMSS, 'chk', -1 )
! ENDIF
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### READ_CHECKPT_FILE: read file' )
! Return to calling program
END SUBROUTINE READ_CHECKPT_FILE
!------------------------------------------------------------------------------
SUBROUTINE MAKE_OBS_FILE( YYYYMMDD, HHMMSS )
!
!******************************************************************************
! Subroutine MAKE_OBS_FILE creates GEOS-CHEM observation files of tracer
! mixing ratios (v/v) in binary punch file format.
! (dkh, 9/01/04)
! Arguments as Input:
! ============================================================================
! (1 ) YYYYMMDD : Year-Month-Date
! (2 ) HHMMSS : and Hour-Min-Sec for which to create a checkpoint file
!
! Passed via CMN:
! ============================================================================
! (1 ) TAU : TAU value (elapsed hours) at start of diagnostic interval
!
! Passed via CMN_ADJ
! ============================================================================
! (1 ) CHECKPT : Array of quantities to be checkpointed
! dim=(IIPAR,JJPAR,LLPAR,NCHECKPT)
!
! NOTES:
! (1 ) Just like MAKE_CHK_FILE except
! - write to .obs. file
! - only write output from rpmares,
! (2 ) Switch to using OBS_STT rather than OBS
! (3 ) Update to v8 format, remove obsolete options (dkh, 06/11/09)
! (18) OBS_STT now in adj_arrays_mod.f instead of checkpt_mod.f (mak, 6/14/09)
!******************************************************************************
!
! References to F90 modules
USE BPCH2_MOD
USE DIRECTORY_ADJ_MOD, ONLY : ADJTMP_DIR
USE ERROR_MOD, ONLY : DEBUG_MSG
USE FILE_MOD, ONLY : IU_RST, IOERROR
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
USE LOGICAL_MOD, ONLY : LPRT
USE TIME_MOD, ONLY : EXPAND_DATE, GET_TAU
USE TRACER_MOD, ONLY : N_TRACERS
USE ADJ_ARRAYS_MOD, ONLY : OBS_STT
USE DIRECTORY_ADJ_MOD, ONLY : ADJTMP_DIR
# include "CMN_SIZE" ! Size parameters
! Arguments
INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS
! Local Variables
INTEGER :: I, I0, IOS, J, J0, L, N
INTEGER :: YYYY, MM, DD, HH, SS
REAL*4 :: TRACER(IIPAR,JJPAR,LLPAR)
CHARACTER(LEN=255) :: FILENAME
! For binary punch file, version 2.0
REAL*4 :: LONRES, LATRES
INTEGER, PARAMETER :: HALFPOLAR = 1
INTEGER, PARAMETER :: CENTER180 = 1
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED = ''
CHARACTER(LEN=80) :: TITLE
!=================================================================
! MAKE_OBS_FILE begins here!
!=================================================================
! Hardwire output file for now
OUTPUT_OBS_FILE = 'gctm.obs.YYYYMMDD.hhmm'
! Define variables for BINARY PUNCH FILE OUTPUT
TITLE = 'GEOS-CHEM OBS File: ' //
& 'Observation Concentrations (kg/box)'
UNIT = 'kg/box'
CATEGORY = 'IJ-OBS-$'
LONRES = DISIZE
LATRES = DJSIZE
! Call GET_MODELNAME to return the proper model name for
! the given met data being used (bmy, 6/22/00)
MODELNAME = GET_MODELNAME()
! Get the nested-grid offsets
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
!=================================================================
! Open the observation file for output -- binary punch format
!=================================================================
! Copy the output observation file name into a local variable
FILENAME = TRIM( OUTPUT_OBS_FILE )
! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
! Add ADJ_DIR prefix to FILENAME
FILENAME = TRIM( ADJTMP_DIR ) // TRIM( FILENAME )
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - MAKE_OBS_FILE: Writing ', a )
! Open checkpoint file for output
CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
!=================================================================
! Write each observed quantity to the observation file
!=================================================================
!DO N = 1, NOBS
DO N = 1, N_TRACERS
!Temporarily store quantities in the TRACER array
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
TRACER(I,J,L) = OBS_STT(I,J,L,N)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, N,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLPAR, I0+1,
& J0+1, 1, TRACER )
ENDDO
! Close file
CLOSE( IU_RST )
! Obsolete (dkh, 06/11/09)
! ! Zip the obs file
! IF ( L_ZIP_OBS ) THEN
!
! CALL BATCH_ZIP( YYYYMMDD, HHMMSS, 'obs', 1 )
!
! ENDIF
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### MAKE_OBS_FILE: wrote file' )
! Return to calling program
END SUBROUTINE MAKE_OBS_FILE
!------------------------------------------------------------------------------
SUBROUTINE READ_OBS_FILE( YYYYMMDD, HHMMSS )
!
!******************************************************************************
! Subroutine READ_OBS_FILE reads the output of the reference run from an
! observation file (binary punch file format)
! (dkh, 9/01/04)
!
! Arguments as input:
! ============================================================================
! (1 ) YYYYMMDD : Year-Month-Day
! (2 ) HHMMSS : and Hour-Min-Sec for which to read restart file
!
! Passed via CMN:
! ============================================================================
! (1 ) TAU : TAU value (elapsed hours) at start of diagnostic interval
!
! Notes
! (1 ) Just like READ_CHECKPT_FILE except
! - read NOBS variables into OBS array
! (2 ) Switch to using OBS_STT rather than OBS (dkh 03/03/05)
! (3 ) Update to v8 format, remove obsolete options (dkh, 06/11/09)
! (4 ) OBS_STT now in adj_arrays_mod.f instead of checkpt_mod.f (mak, 6/14/09)
!******************************************************************************
!
! References to F90 modules
USE RESTART_MOD, ONLY : CHECK_DIMENSIONS
USE BPCH2_MOD, ONLY : OPEN_BPCH2_FOR_READ
USE DIRECTORY_ADJ_MOD, ONLY : ADJTMP_DIR
USE ERROR_MOD, ONLY : DEBUG_MSG
USE FILE_MOD, ONLY : IU_RST, IOERROR
USE LOGICAL_MOD, ONLY : LPRT
USE TIME_MOD, ONLY : EXPAND_DATE
USE TRACER_MOD, ONLY : N_TRACERS
USE ADJ_ARRAYS_MOD, ONLY : OBS_STT
# include "CMN_SIZE" ! Size parameters
! Arguments
INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS
! Local Variables
INTEGER :: I, IOS, J, L, N
INTEGER :: NCOUNT(NNPAR)
REAL*4 :: TRACER(IIPAR,JJPAR,LLPAR)
REAL*8 :: SUMTC
CHARACTER(LEN=255) :: FILENAME
CHARACTER(LEN=255) :: UNZIP_FILE_CMD
CHARACTER(LEN=255) :: ZIP_FILE_CMD
! For binary punch file, version 2.0
INTEGER :: NI, NJ, NL
INTEGER :: IFIRST, JFIRST, LFIRST
INTEGER :: NTRACER, NSKIP
INTEGER :: HALFPOLAR, CENTER180
REAL*4 :: LONRES, LATRES
REAL*8 :: ZTAU0, ZTAU1
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED
!=================================================================
! READ_OBS_FILE begins here!
!=================================================================
! Hardwire output file for now
INPUT_OBS_FILE = 'gctm.obs.YYYYMMDD.hhmm'
! Initialize some variables
NCOUNT(:) = 0
TRACER(:,:,:) = 0e0
!=================================================================
! Open observation file and read top-of-file header
!=================================================================
! Copy input file name to a local variable
FILENAME = TRIM( INPUT_OBS_FILE )
! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
! Add ADJ_DIR prefix to FILENAME
!FILENAME = TRIM( ADJ_DIR ) // TRIM( FILENAME )
FILENAME = TRIM( ADJTMP_DIR ) // TRIM( FILENAME )
! Echo some input to the screen
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
WRITE( 6, '(a,/)' ) 'O B S F I L E I N P U T'
! Remove obsolete options (dkh, 06/11/09)
! ! Unzip obs file
! IF ( L_ZIP_OBS ) THEN
! UNZIP_FILE_CMD = TRIM( GUNZIP_CMD ) // ' ' //
! & TRIM( FILENAME ) // ZIP_SUFFIX
! CALL SYSTEM( TRIM( UNZIP_FILE_CMD ) )
! WRITE( 6, 99 ) TRIM( UNZIP_FILE_CMD )
! 99 FORMAT( ' - READ_OBS_FILE: Executing: ',a )
! ENDIF
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - READ_OBS_FILE: Reading ', a )
! Open the binary punch file for input
CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!=================================================================
! Read concentrations -- store in the TRACER array
!=================================================================
!DO N = 1, NOBS
DO N = 1, N_TRACERS
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) EXIT
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'read_obs_file:4' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_obs_file:5')
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_obs_file:6')
!==============================================================
! Assign data from the TRACER array to the STT array.
!==============================================================
! Only process observation data (i.e. aerosol and precursors)
IF ( CATEGORY(1:8) == 'IJ-OBS-$' ) THEN
! Make sure array dimensions are of global size
! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
CALL CHECK_DIMENSIONS( NI, NJ, NL )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
OBS_STT(I,J,L,N) = TRACER(I,J,L)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
ENDDO
! Close file
CLOSE( IU_RST )
! Remove obsolete options (dkh, 06/11/09)
! ! Zip the obs file
! IF ( L_ZIP_OBS ) THEN
!
! CALL BATCH_ZIP( YYYYMMDD, HHMMSS, 'obs', -1 )
!
! ENDIF
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### READ_OBS_FILE: read file' )
! Return to calling program
END SUBROUTINE READ_OBS_FILE
!-----------------------------------------------------------------------
! Remove obsolete subroutines (dkh, 06/11/09)
! SUBROUTINE BATCH_ZIP( YYYYMMDD, HHMMSS, FID, MODE )
!!
!!**********************************************************************
!! Subroutine BATCH_ZIP zips a days worth of *.obs.*, *.adj.*,
!! and *.chk.* files using multiple processors. Only works for
!! TS_CHEM = 60 (min) and simulations that begin at HHMMSS = 000000.
!! Simulation ending at times other than HHMMSS = 000000 are allowed.
!! The argument MODE indicates whether the batch of files to be zipped
!! begins (-1) or ends (+1) at HHMMSS, and adjustments are then made so
!! that DATE(2) always indicates the time stamp of the latest file to be
!! zipped. (dkh, 11/22/04)
!!
!! NOTES
!!
!!**********************************************************************
! ! Reference to f90 modules
! USE TIME_MOD, ONLY : GET_NYMDe, GET_NHMSe, EXPAND_DATE,
! & GET_TS_CHEM, GET_TIME_AHEAD, GET_NHMSb
! USE ERROR_MOD, ONLY : ERROR_STOP
!
!# include "CMN_SIZE" ! Size parameters
!# include "CMN_ADJ" ! OBS_FREQ, GZIP_CMD
!
!
! ! Arguments
! INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS
! CHARACTER(LEN=3) :: FID
! INTEGER :: MODE ! +1 for fwd, -1 for backwd
!
! ! Local variables
! INTEGER :: HH, ZIP_INTERVAL, HH_MAX, ZHHMMSS
! INTEGER :: NHMSe, NYMDe
! INTEGER :: DATE(2)
! INTEGER :: OBS_FREQ_HH = OBS_FREQ / 6 * 1000
! CHARACTER(LEN=255) :: ZIP_FILE_CMD
! CHARACTER(LEN=255) :: ZIP_FILENAME
! CHARACTER(LEN=255) :: TO_ZIP_FILENAME
!
! !------------------------------------------------------------
! ! BATCH_ZIP begins here!
! !------------------------------------------------------------
!
! ! Check to make sure that TS_CHEM is actually 60 min
! ! and that the simulation began at the beginning of a day
! IF ( GET_TS_CHEM() /= 60 .OR. GET_NHMSb() /= 000000 ) THEN
! WRITE(6,*) ' -- Timeing inappropriate for batch zip'
! RETURN
! ENDIF
!
! ! Get HHMMSS at end of run
! NHMSe = GET_NHMSe()
! NYMDe = GET_NYMDe()
!
! ! Adjust the arguments YYYYMMDD and HHMMSS if we are operating
! ! in reverse mode (i.e. zipping after reading)
! IF ( MODE == -1 ) THEN
!
! ! Get YYYYMMDD and HHMMSS for 23 hours ahead
! DATE = GET_TIME_AHEAD( 60 * 23 )
!
! ! Adjust for case when is the zeroeth hour of final day
! IF ( YYYYMMDD == NYMDe .AND. HHMMSS == 000000 ) THEN
!
! ! Set DATE(2) so that the final day's files get zipped
! DATE(2) = NHMSe - 10000
!
! ENDIF
!
! ELSE
!
! DATE(1) = YYYYMMDD
! DATE(2) = HHMMSS
!
! ENDIF
!
! ! Determine range of batch of files to zip
! IF ( NHMSe == 000000 ) THEN
!
! ! Batches will always span a full day
! HH_MAX = 230000
!
! ELSE
!
! ! Batch range depends upon the day
! IF ( YYYYMMDD == NYMDe ) THEN
!
! ! The batch for the last day is shorter
! HH_MAX = NHMSe - 10000
!
! ELSE
!
! ! Not the last day yet, so batch still spans a full day
! HH_MAX = 230000
!
! ENDIF
!
! ENDIF
!
! IF ( FID == 'obs' ) THEN
! IF ( YYYYMMDD == NYMDe .AND.
! & ( DATE(2) + OBS_FREQ_HH) > ( NHMSe - 10000 ) ) THEN
! HH_MAX = DATE(2)
! ELSEIF ( ( DATE(2) + OBS_FREQ_HH ) > (230000) ) THEN
! HH_MAX = DATE(2)
! ENDIF
! ENDIF
!
! ! Only zip the batch of files at the end of the day (or partial day).
! IF ( DATE(2) /= HH_MAX ) RETURN
!
! ! Determine the number of files in the batch
! IF ( FID == 'chk' .OR. FID == 'adj' ) THEN
!
! ! There is (at least) one file for every hour
! ZIP_INTERVAL = 10000
!
! ELSEIF ( FID == 'obs' ) THEN
!
! ! Convert the obseration interval (min) into the right units
! ZIP_INTERVAL = OBS_FREQ_HH
!
! ELSE
!
! CALL ERROR_STOP('File type not defined!',
! & 'BATCH_ZIP (checkpt_mod.f)' )
!
! ENDIF
!
! ! Create generic file name
!#if defined( GEOS_1 ) || defined( GEOS_STRAT )
! TO_ZIP_FILENAME = 'gctm.' // FID // '.YYYYMMDD.hhmmss'
!#else
! TO_ZIP_FILENAME = 'gctm.' // FID // '.YYYYMMDD.hhmmss'
!#endif
!
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( ZIP_FILENAME, HH )
!!$OMP+PRIVATE( ZIP_FILE_CMD, ZHHMMSS )
! DO HH = 000000, HH_MAX , ZIP_INTERVAL
!
! ! Set the HHMMSS of the file to be zipped
! ZHHMMSS = HH
!
! ! Reconstruct name of file to be zipped
! ZIP_FILENAME = TRIM(TO_ZIP_FILENAME)
!
! ! Replace YYYY, MM, DD, HH tokens in ZIP_FILENAME w/actual values
! CALL EXPAND_DATE( ZIP_FILENAME, DATE(1), ZHHMMSS )
!
! ! Add ADJ_DIR prefix to filename
! ZIP_FILENAME = TRIM( ADJ_DIR ) // TRIM( ZIP_FILENAME )
!
! ! Create zip command
! ZIP_FILE_CMD = TRIM( GZIP_CMD ) // ' ' //
! & TRIM( ZIP_FILENAME )
! CALL SYSTEM( TRIM ( ZIP_FILE_CMD ) )
! WRITE( 6, 101 ) TRIM( ZIP_FILE_CMD )
! 101 FORMAT( ' - BATCH_ZIP: Executing: ',a )
!
! ENDDO
!!$OMP END PARALLEL DO
!
! ! Only continue when dealing with *.adj.* files
! IF (FID /= 'adj' ) RETURN
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( ZIP_FILENAME, HH )
!!$OMP+PRIVATE( ZIP_FILE_CMD, ZHHMMSS )
! DO HH = 003000, HH_MAX + 3000, ZIP_INTERVAL
!
! ! Set the HHMMSS of the file to be zipped
! ZHHMMSS = HH
!
! ! Replace YYYY, MM, DD, HH tokens in ZIP_FILENAME w/actual values
! CALL EXPAND_DATE( ZIP_FILENAME, DATE(1), ZHHMMSS )
!
! ! Add ADJ_DIR prefix to filename
! ZIP_FILENAME = TRIM( ADJ_DIR ) // TRIM( ZIP_FILENAME )
!
! ! Create zip command
! ZIP_FILE_CMD = TRIM( GZIP_CMD ) // ' ' //
! & TRIM( ZIP_FILENAME )
! CALL SYSTEM( TRIM ( ZIP_FILE_CMD ) )
! WRITE( 6, 101 ) TRIM( ZIP_FILE_CMD )
!
! ENDDO
!!$OMP END PARALLEL DO
!
!
! END SUBROUTINE BATCH_ZIP
!
!!----------------------------------------------------------------------
SUBROUTINE CHECK_DIMENSIONS_2( XPASS, YPASS, ZPASS,
& XTRUE, YTRUE, ZTRUE )
!
!******************************************************************************
! Subroutine CHECK_DIMENSIONS_2makes sure that the dimensions of the
! data for block that was checkpointed are correct. XPASS should equal XTRUE,
! etc.
! (dkh, 07/22/05)
!
! NOTES:
!
!******************************************************************************
!
! References to F90 modules
USE ERROR_MOD, ONLY : GEOS_CHEM_STOP
! Arguments
INTEGER, INTENT(IN) :: XPASS, YPASS, ZPASS
INTEGER, INTENT(IN) :: XTRUE, YTRUE, ZTRUE
!=================================================================
! CHECK_DIMENSIONS_2 begins here!
!=================================================================
! Error check longitude dimension: NI must equal IIPAR
IF ( XPASS /= XTRUE .OR.
& YPASS /= YTRUE .OR.
& ZPASS /= ZTRUE ) THEN
print*, XPASS, XTRUE
print*, YPASS, YTRUE
print*, ZPASS, ZTRUE
WRITE( 6, '(a)' ) 'ERROR reading in checkpt file!'
WRITE( 6, '(a)' ) 'Wrong number of grid cells encountered!'
WRITE( 6, '(a)' ) 'STOP in CHECK_DIMENSIONS_2 (checkpt_mod.f)'
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
CALL GEOS_CHEM_STOP
ENDIF
! Return to calling program
END SUBROUTINE CHECK_DIMENSIONS_2
!----------------------------------------------------------------------
!
! SUBROUTINE MAKE_SAVE_FILE( YYYYMMDD, HHMMSS, N_CALC )
!!
!!******************************************************************************
!! Subroutine MAKE_SAVE_FILE creates GEOS-CHEM checkpt files of tracer
!! concentrations [kg/box].
!! For use in checking chemistry adjoints. (dkh, 07/19/06)
!!
!! Arguments as Input:
!! ============================================================================
!! (1 ) YYYYMMDD : Year-Month-Date
!! (2 ) HHMMSS : and Hour-Min-Sec for which to create a checkpoint file
!! (3 ) N_CALC : Current iteration
!!
!! Passed via CMN:
!! ============================================================================
!! (1 ) TAU : TAU value (elapsed hours) at start of diagnostic interval
!!
!! Passed via ???:
!! ============================================================================
!! (1 ) CHECKPT : Array of quantities to be checkpointed
!! dim=(IIPAR,JJPAR,LLPAR,NCHECKPT)
!!
!! NOTES:
!! Just like MAKE_CHECKPT_FILE except:
!!
!!******************************************************************************
!!
! ! References to F90 modules
! USE BPCH2_MOD
! USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP
! USE FILE_MOD, ONLY : IU_RST, IOERROR
! USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
! USE TIME_MOD, ONLY : EXPAND_DATE, GET_TAU
! USE COMODE_MOD, ONLY : CSPEC_PRIOR , JLOP
!! USE GCKPP_PARAMETERS, ONLY : NVAR
! USE GCKPP_ADJ_GLOBAL, ONLY : NTLOOP_FORKPP_ADJ
!
!# include "CMN_SIZE" ! Size parameters
!# include "CMN" ! TAU , NSRCX
!# include "CMN_ADJ" ! NRPIN, NRPOUT, L_ZIP_CHECKPT, GZIP_CMD, ADJ_DIR, NOBS
!# include "CMN_SETUP" ! LWETD
!# include "comode.h" ! IGAS
!
! ! Arguments
! INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS, N_CALC
!
! ! Local Variables
! INTEGER :: I, I0, IOS, J, J0, L, N, JLOOP
! INTEGER :: YYYY, MM, DD, HH, SS, ZIP_HH
! CHARACTER(LEN=255) :: FILENAME
!
! ! Temporary storage arrays for checkpointed variables
! REAL*4 :: CHECK_FINAL(IIPAR,JJPAR,LLPAR)
!
! ! For binary punch file, version 2.0
! REAL*4 :: LONRES, LATRES
! INTEGER, PARAMETER :: HALFPOLAR = 1
! INTEGER, PARAMETER :: CENTER180 = 1
!
! CHARACTER(LEN=20) :: MODELNAME
! CHARACTER(LEN=40) :: CATEGORY
! CHARACTER(LEN=40) :: UNIT
! CHARACTER(LEN=40) :: RESERVED = ''
! CHARACTER(LEN=80) :: TITLE
!
!
! !=================================================================
! ! MAKE_SAVE_FILE begins here!
! !=================================================================
!
! ! Hardwire output file for now
!#if defined( GEOS_1 ) || defined( GEOS_STRAT )
! OUTPUT_CHECKPT_FILE = 'gctm.save.YYMMDD.hhmmss.NN'
!#else
! OUTPUT_CHECKPT_FILE = 'gctm.save.YYYYMMDD.hhmmss.NN'
!#endif
!
! ! Clear some arrays
! CHECK_FINAL(:,:,:) = 0e0
!
! ! Define variables for BINARY PUNCH FILE OUTPUT
! TITLE = 'GEOS-CHEM Checkpoint File: ' //
! & 'Instantaneous Tracer Concentrations (v/v)'
! CATEGORY = 'IJ-CHK-$'
! LONRES = DISIZE
! LATRES = DJSIZE
!
! ! Call GET_MODELNAME to return the proper model name for
! ! the given met data being used (bmy, 6/22/00)
! MODELNAME = GET_MODELNAME()
!
! ! Get the nested-grid offsets
! I0 = GET_XOFFSET( GLOBAL=.TRUE. )
! J0 = GET_YOFFSET( GLOBAL=.TRUE. )
!
! !=================================================================
! ! Open the save file for output -- binary punch format
! !=================================================================
!
! ! Copy the output checkpoint file name into a local variable
! FILENAME = TRIM( OUTPUT_CHECKPT_FILE )
!
! ! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
! CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
!
! ! Append the iteration number suffix to the file name
! CALL EXPAND_NAME( FILENAME, N_CALC )
!
! ! Add ADJ_DIR prefix to filename
! FILENAME = TRIM( ADJ_DIR ) // TRIM( FILENAME )
!
! WRITE( 6, 100 ) TRIM( FILENAME )
! 100 FORMAT( ' - MAKE_SAVE_FILE: Writing ', a )
!
! ! Open checkpoint file for output
! CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
!
! !=================================================================
! ! Write each checkpointed quantity to the checkpoint file
! !=================================================================
!
! ! Write the final concetration values as saved at the end of geos_mod.f
! UNIT = 'kg/box'
! DO N = 1, NOBS
!
! ! Temporarily store data in CHECK_FINAL
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, L )
! DO L = 1, LLPAR
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! CHECK_FINAL(I,J,L) = CHK_STT(I,J,L,N)
! ENDDO
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, N,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, LLPAR, I0+1,
! & J0+1, 1, CHECK_FINAL )
! ENDDO
!
! ! Close file
! CLOSE( IU_RST )
!
! ! Zip files
! IF ( L_ZIP_CHECKPT ) CALL BATCH_ZIP( YYYYMMDD, HHMMSS, 'save', 1 )
!
! !### Debug
! IF ( LPRT ) CALL DEBUG_MSG( '### MAKE_SAVE_FILE: wrote file' )
!
! ! Return to calling program
! END SUBROUTINE MAKE_SAVE_FILE
!!-----------------------------------------------------------------------
!
! SUBROUTINE MAKE_SAVE_FILE_2( YYYYMMDD, HHMMSS, N_CALC )
!!
!!******************************************************************************
!! Subroutine MAKE_SAVE_FILE_2 creates GEOS-CHEM checkpt files of tracer
!! concentrations [kg/box]. Like MAKE_SAVE_FILE, except calculate the finite
!! difference sensitivities directly. Save these, the adjoint sensitivities,
!! and the ratio adj / fd. Save first and 2nd order finite difference
!! sensitivities. Requires running to XSTOP = 3.
!! For use in checking process specific adjoints. (dkh, 01/23/07)
!!
!! Arguments as Input:
!! ============================================================================
!! (1 ) YYYYMMDD : Year-Month-Date
!! (2 ) HHMMSS : and Hour-Min-Sec for which to create a checkpoint file
!! (3 ) N_CALC : Current iteration
!!
!! Passed via CMN:
!! ============================================================================
!! (1 ) TAU : TAU value (elapsed hours) at start of diagnostic interval
!!
!! Passed via ???:
!! ============================================================================
!! (1 ) CHECKPT : Array of quantities to be checkpointed
!! dim=(IIPAR,JJPAR,LLPAR,NCHECKPT)
!!
!! NOTES:
!! Just like MAKE_CHECKPT_FILE except:
!! (1 ) Now write out both sets of 1st order FD gradients, and define a new
!! category (FD-TEST) for viewing in gamap. (dkh, 10/10/08)
!!******************************************************************************
!!
! ! References to F90 modules
! USE BPCH2_MOD
! USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP
! USE FILE_MOD, ONLY : IU_RST, IOERROR
! USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
! USE TIME_MOD, ONLY : EXPAND_DATE, GET_TAU
! USE COMODE_MOD, ONLY : CSPEC_PRIOR , JLOP
!! USE GCKPP_PARAMETERS, ONLY : NVAR
! USE GCKPP_ADJ_GLOBAL, ONLY : NTLOOP_FORKPP_ADJ
!
!# include "CMN_SIZE" ! Size parameters
!# include "CMN" ! TAU , NSRCX
!# include "CMN_ADJ" ! NRPIN, NRPOUT, L_ZIP_CHECKPT, GZIP_CMD, ADJ_DIR, NOBS
!# include "CMN_SETUP" ! LWETD
!# include "comode.h" ! IGAS
!
! ! Arguments
! INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS, N_CALC
!
! ! Local Variables
! INTEGER :: I, I0, IOS, J, J0, L, N, JLOOP
! INTEGER :: YYYY, MM, DD, HH, SS, ZIP_HH
! CHARACTER(LEN=255) :: FILENAME
! !CHARACTER(LEN=255) :: INPUT_CHECKPT_FILE
! CHARACTER(LEN=255) :: INPUT_GDT_FILE
! INTEGER :: N_OFF(IIPAR,JJPAR)
! REAL*8, PARAMETER :: FILTER = 1d0
!
! ! Temporary storage arrays for checkpointed variables
! REAL*8 :: CHK_STT_1(IIPAR,JJPAR,LLPAR,NOBS)
! REAL*8 :: CHK_STT_2(IIPAR,JJPAR,LLPAR,NOBS)
! REAL*8 :: CHK_STT_3(IIPAR,JJPAR,LLPAR,NOBS)
! REAL*4 :: TRACER(IIPAR,JJPAR,LLPAR)
! REAL*4 :: EMS_3D(IIPAR,JJPAR,MMSCL)
! REAL*8 :: ADJ(IIPAR,JJPAR,1)
! REAL*4 :: TRACER_2D(IIPAR,JJPAR,1)
!
! ! For binary punch file, version 2.0
! REAL*4 :: LONRES, LATRES
! INTEGER :: HALFPOLAR
! INTEGER :: CENTER180
!
! CHARACTER(LEN=20) :: MODELNAME
! CHARACTER(LEN=40) :: CATEGORY
! CHARACTER(LEN=40) :: UNIT
! CHARACTER(LEN=40) :: RESERVED = ''
! CHARACTER(LEN=80) :: TITLE
!
! INTEGER :: NI, NJ, NL
! INTEGER :: IFIRST, JFIRST, LFIRST
! INTEGER :: NTRACER, NSKIP
! REAL*8 :: ZTAU0, ZTAU1
!
!
! !=================================================================
! ! MAKE_SAVE_FILE_2 begins here!
! !=================================================================
!
!
! ! Clear some arrays
! CHK_STT_1(:,:,:,:) = 0e0
! CHK_STT_2(:,:,:,:) = 0e0
! CHK_STT_3(:,:,:,:) = 0e0
! EMS_3D(:,:,:) = 0d0
! ADJ(:,:,:) = 0e0
! TRACER(:,:,:) = 0e0
! TRACER_2D(:,:,:) = 0e0
! N_OFF(:,:) = 0d0
!
! !========================================
! ! Read *.save* file from unperturbed run
! !========================================
! INPUT_CHECKPT_FILE = 'gctm.save.YYYYMMDD.hhmmss.NN'
!
! ! Copy input file name to a local variable
! FILENAME = TRIM( INPUT_CHECKPT_FILE )
!
! ! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
! CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
!
! ! Append the iteration number suffix to the file name
! CALL EXPAND_NAME( FILENAME, 1 )
!
! ! Add ADJ_DIR prefix to name
! FILENAME = TRIM( ADJ_DIR ) // TRIM( FILENAME )
!
! ! Echo some input to the screen
! WRITE( 6, '(a)' ) REPEAT( '=', 79 )
! WRITE( 6, '(a,/)' ) 'C H E C K P T F I L E I N P U T'
!
!
! WRITE( 6, 400 ) TRIM( FILENAME )
! 400 FORMAT( ' - READ_CHECKPT_FILE: Reading ', a )
!
! ! Open the binary punch file for input
! CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!
! !=================================================================
! ! Read checkpointed variables
! !=================================================================
! ! Read the values of CHK_STT
! DO N = 1, NOBS
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so exit
! IF ( IOS < 0 ) EXIT
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 )
! & CALL IOERROR( IOS,IU_RST,'read_checkpt_file:7' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 )
! & CALL IOERROR(IOS,IU_RST,'read_checkpt_file:8' )
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 )
! & CALL IOERROR( IOS,IU_RST,'read_checkpt_file:9' )
!
! !==============================================================
! ! Assign data from the TRACER array to the STT array.
! !==============================================================
!
! ! Only process checkpoint data (i.e. mixing ratio)
! IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
!
! ! Make sure array dimensions are of global size
! ! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
! !CALL CHECK_DIMENSIONS( NI, NJ, NL )
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, L )
! DO L = 1, LLPAR
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! CHK_STT_1(I,J,L,N) = TRACER(I,J,L)
! ENDDO
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ENDIF
! ENDDO
! ! Close file
! CLOSE( IU_RST )
!
!
! !========================================
! ! Read *.save* file from perturbed run
! !========================================
! INPUT_CHECKPT_FILE = 'gctm.save.YYYYMMDD.hhmmss.NN'
!
! ! Copy input file name to a local variable
! FILENAME = TRIM( INPUT_CHECKPT_FILE )
!
! ! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
! CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
!
! ! Append the iteration number suffix to the file name
! CALL EXPAND_NAME( FILENAME, 2 )
!
! ! Add ADJ_DIR prefix to name
! FILENAME = TRIM( ADJ_DIR ) // TRIM( FILENAME )
!
! ! Echo some input to the screen
! WRITE( 6, '(a)' ) REPEAT( '=', 79 )
! WRITE( 6, '(a,/)' ) 'C H E C K P T F I L E I N P U T'
!
!
! WRITE( 6, 100 ) TRIM( FILENAME )
! 100 FORMAT( ' - READ_CHECKPT_FILE: Reading ', a )
!
! ! Open the binary punch file for input
! CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!
! !=================================================================
! ! Read checkpointed variables
! !=================================================================
! ! Read the values of CHK_STT
! DO N = 1, NOBS
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so exit
! IF ( IOS < 0 ) EXIT
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 )
! & CALL IOERROR( IOS,IU_RST,'read_checkpt_file:7' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 )
! & CALL IOERROR(IOS,IU_RST,'read_checkpt_file:8' )
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 )
! & CALL IOERROR( IOS,IU_RST,'read_checkpt_file:9' )
!
! !==============================================================
! ! Assign data from the TRACER array to the STT array.
! !==============================================================
!
! ! Only process checkpoint data (i.e. mixing ratio)
! IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
!
! ! Make sure array dimensions are of global size
! ! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
! !CALL CHECK_DIMENSIONS( NI, NJ, NL )
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, L )
! DO L = 1, LLPAR
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! CHK_STT_2(I,J,L,N) = TRACER(I,J,L)
! ENDDO
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ENDIF
! ENDDO
! ! Close file
! CLOSE( IU_RST )
!
! !========================================
! ! Read *.save* file from 2nd perturbed run
! !========================================
! INPUT_CHECKPT_FILE = 'gctm.save.YYYYMMDD.hhmmss.NN'
!
! ! Copy input file name to a local variable
! FILENAME = TRIM( INPUT_CHECKPT_FILE )
!
! ! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
! CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
!
! ! Append the iteration number suffix to the file name
! CALL EXPAND_NAME( FILENAME, 3 )
!
! ! Add ADJ_DIR prefix to name
! FILENAME = TRIM( ADJ_DIR ) // TRIM( FILENAME )
!
! ! Echo some input to the screen
! WRITE( 6, '(a)' ) REPEAT( '=', 79 )
! WRITE( 6, '(a,/)' ) 'C H E C K P T F I L E I N P U T'
!
!
! WRITE( 6, 888 ) TRIM( FILENAME )
! 888 FORMAT( ' - READ_CHECKPT_FILE: Reading ', a )
!
! ! Open the binary punch file for input
! CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!
! !=================================================================
! ! Read checkpointed variables
! !=================================================================
! ! Read the values of CHK_STT
! DO N = 1, NOBS
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so exit
! IF ( IOS < 0 ) EXIT
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 )
! & CALL IOERROR( IOS,IU_RST,'read_checkpt_file:7' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 )
! & CALL IOERROR(IOS,IU_RST,'read_checkpt_file:8' )
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 )
! & CALL IOERROR( IOS,IU_RST,'read_checkpt_file:9' )
!
! !==============================================================
! ! Assign data from the TRACER array to the STT array.
! !==============================================================
!
! ! Only process checkpoint data (i.e. mixing ratio)
! IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
!
! ! Make sure array dimensions are of global size
! ! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
! !CALL CHECK_DIMENSIONS( NI, NJ, NL )
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, L )
! DO L = 1, LLPAR
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! CHK_STT_3(I,J,L,N) = TRACER(I,J,L)
! ENDDO
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ENDIF
! ENDDO
! ! Close file
! CLOSE( IU_RST )
!
! !========================================
! ! Read *.gdt.* file from unperturbed run
! !========================================
! ! Hardwire output file for now
! INPUT_GDT_FILE = 'gctm.gdt.01'
!
! ! Initialize some variables
! TRACER(:,:,:) = 0e0
!
! !=================================================================
! ! Open gradient file and read top-of-file header
! !=================================================================
!
! ! Copy input file name to a local variable
! FILENAME = TRIM( INPUT_GDT_FILE )
!
! ! Add OPT_DATA_DIR prefix to FILENAME
! FILENAME = TRIM( OPT_DATA_DIR ) // TRIM( FILENAME )
!
! ! Echo some input to the screen
! WRITE( 6, '(a)' ) REPEAT( '=', 79 )
! WRITE( 6, '(a,/)' ) 'G D T F I L E I N P U T'
! WRITE( 6, 101 ) TRIM( FILENAME )
! 101 FORMAT( 'READ_GDT_FILE: Reading ', a )
!
! ! Open the binary punch file for input
! CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!
! !=================================================================
! ! Read adjoints -- store in the TRACER array
! !=================================================================
! DO N = 1, NNEMS
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so exit
! IF ( IOS < 0 ) EXIT
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'read_gdt_file:5' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_gdt_file:5')
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( EMS_3D(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_gdt_file:7')
!
! !==============================================================
! ! Assign data from the TRACER array to the ADJ_STT array.
! !==============================================================
!
! ! Only process observation data (i.e. aerosol and precursors)
! IF ( CATEGORY(1:8) == 'IJ-GDE-$' .and. N == EMSFD
! & .and. MMSCL == 1 ) THEN
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! ADJ(I,J,1) = EMS_3D(I,J,1)
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ENDIF
! ENDDO
! ! Close file
! CLOSE( IU_RST )
!
!
! !========================================
! ! Write 2nd order FD gradient
! !========================================
! L = LFD
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
!
! TRACER_2D(I,J,1) =(CHK_STT_2(I,J,L,NFD) - CHK_STT_3(I,J,L,NFD))
! & / (2 * FD_DIFF )
!
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ! Hardwire output file for now
! OUTPUT_CHECKPT_FILE = 'gctm.save2.YYYYMMDD.hhmmss'
!
! ! Define variables for BINARY PUNCH FILE OUTPUT
! TITLE = 'GEOS-CHEM Checkpoint File: ' //
! & 'Instantaneous Tracer Concentrations (v/v)'
! CATEGORY = 'FD-TEST'
! LONRES = DISIZE
! LATRES = DJSIZE
!
! ! Call GET_MODELNAME to return the proper model name for
! ! the given met data being used (bmy, 6/22/00)
! MODELNAME = GET_MODELNAME()
!
! ! Get the nested-grid offsets
! I0 = GET_XOFFSET( GLOBAL=.TRUE. )
! J0 = GET_YOFFSET( GLOBAL=.TRUE. )
!
! !=================================================================
! ! Open the save file for output -- binary punch format
! !=================================================================
!
! ! Copy the output checkpoint file name into a local variable
! FILENAME = TRIM( OUTPUT_CHECKPT_FILE )
!
! ! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
! CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
!
! ! Add ADJ_DIR prefix to filename
! FILENAME = TRIM( ADJ_DIR ) // TRIM( FILENAME )
!
! WRITE( 6, 102 ) TRIM( FILENAME )
! 102 FORMAT( ' - MAKE_SAVE_FILE: Writing ', a )
!
! ! Open checkpoint file for output
! CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
!
! UNIT = 'kg/box'
!
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 1,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, 1, I0+1,
! & J0+1, 1, TRACER_2D )
!
! !========================================
! ! Write ADJ gradient
! !========================================
! UNIT = 'kg/box'
!
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 2,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, 1, I0+1,
! & J0+1, 1, REAL(ADJ) )
!
! !========================================
! ! Write ADJ / FD ratio
! !========================================
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
!
! IF ( ABS(TRACER_2D(I,J,1)) .gt. FILTER ) THEN
!
! TRACER_2D(I,J,1) = REAL(ADJ(I,J,1)) / TRACER_2D(I,J,1)
!
! ELSE
!
! TRACER_2D(I,J,1) = 1d0
!
! ENDIF
!
! ! Keep track of number of points that are off
! IF ( ( TRACER_2D(I,J,1) > 1d0 + FD_DIFF ) .OR.
! & ( TRACER_2D(I,J,1) < 1D0 - FD_DIFF ) ) THEN
! N_OFF(I,J) = 1
! ENDIF
!
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! UNIT = 'none'
!
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 3,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, 1, I0+1,
! & J0+1, 1, TRACER_2D )
!
! ! print out statistics of the ADJ / FD ratio
! WRITE(6,*) '===================================================='
! WRITE(6,*) ' Global validation test for values > ', FILTER
! WRITE(6,*) ' MAX of global 2nd order ADJ / FD = ',
! & MAXVAL(TRACER_2D(:,:,1))
! WRITE(6,*) ' MIN of global 2nd order ADJ / FD = ',
! & MINVAL(TRACER_2D(:,:,1))
! WRITE(6,*) ' Number of places where ratio off by ',FD_DIFF,' = ',
! & SUM(N_OFF(:,:))
! WRITE(6,*) '===================================================='
!
! !========================================
! ! Write 1st order FD gradient
! !========================================
! UNIT = 'kg/box'
! L = LFD
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
!
! TRACER_2D(I,J,1) =(CHK_STT_2(I,J,L,NFD) - CHK_STT_1(I,J,L,NFD))
! & / FD_DIFF
!
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 4,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, 1, I0+1,
! & J0+1, 1, TRACER_2D )
!
! !========================================
! ! Write chekpt values
! !========================================
! UNIT = 'kg/box'
! L = LFD
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
!
! TRACER_2D(I,J,1) = CHK_STT_1(I,J,L,NFD)
!
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 5,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, 1, I0+1,
! & J0+1, 1, TRACER_2D )
!
! !========================================
! ! Write the other 1st order FD gradient. (dkh, 10/10/08)
! !========================================
! UNIT = 'kg/box'
! L = LFD
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
!
! TRACER_2D(I,J,1) =(CHK_STT_3(I,J,L,NFD) - CHK_STT_1(I,J,L,NFD))
! & / ( - FD_DIFF )
!
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 6,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, 1, I0+1,
! & J0+1, 1, TRACER_2D )
!
! ! Close file
! CLOSE( IU_RST )
!
! ! Zip files
! IF ( L_ZIP_CHECKPT ) CALL BATCH_ZIP( YYYYMMDD, HHMMSS, 'save', 1 )
!
! !### Debug
! IF ( LPRT ) CALL DEBUG_MSG( '### MAKE_SAVE_FILE_2: wrote file' )
!
!
! ! Return to calling program
! END SUBROUTINE MAKE_SAVE_FILE_2
!!----------------------------------------------------------------------
!
! SUBROUTINE MAKE_SAVE_FILE_3( YYYYMMDD, N_CALC )
!!
!!******************************************************************************
!! Subroutine MAKE_SAVE_FILE_3 creates GEOS-CHEM checkpt files of radiative
!! forcing [kg/box]. Like MAKE_SAVE_FILE_2, it saves these, the adjoint
!! sensitivities, and the ratio adj / fd. Requires running to XSTOP = 3.
!! For use in checking process specific adjoints. (dkh, 07/09/08)
!!
!! Arguments as Input:
!! ============================================================================
!! (1 ) YYYYMMDD : Year-Month-Date
!! (2 ) N_CALC : Current iteration
!!
!! Passed via CMN:
!! ============================================================================
!! (1 ) TAU : TAU value (elapsed hours) at start of diagnostic interval
!!
!! Passed via ???:
!! ============================================================================
!! (1 ) CHECKPT : Array of quantities to be checkpointed
!! dim=(IIPAR,JJPAR,LLPAR,NCHECKPT)
!!
!! NOTES:
!! Just like MAKE_CHECKPT_FILE except:
!!
!!******************************************************************************
!!
! ! References to F90 modules
! USE BPCH2_MOD
! USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP
! USE FILE_MOD, ONLY : IU_RST, IOERROR
! USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
! USE TIME_MOD, ONLY : EXPAND_DATE, GET_TAU
! USE COMODE_MOD, ONLY : CSPEC_PRIOR , JLOP
!! USE GCKPP_PARAMETERS, ONLY : NVAR
! USE GCKPP_ADJ_GLOBAL, ONLY : NTLOOP_FORKPP_ADJ
!
!# include "CMN_SIZE" ! Size parameters
!# include "CMN" ! TAU , NSRCX
!# include "CMN_ADJ" ! NRPIN, NRPOUT, L_ZIP_CHECKPT, GZIP_CMD, ADJ_DIR, NOBS
!# include "CMN_SETUP" ! LWETD
!# include "comode.h" ! IGAS
!
! ! Arguments
! INTEGER, INTENT(IN) :: YYYYMMDD, N_CALC
!
! ! Local Variables
! INTEGER :: I, I0, IOS, J, J0, L, N, W, JLOOP
! INTEGER :: YYYY, MM, DD, HH, SS, ZIP_HH
! INTEGER :: HHMMSS_dum
! CHARACTER(LEN=255) :: FILENAME
! CHARACTER(LEN=255) :: INPUT_GDT_FILE
! CHARACTER(LEN=255) :: INPUT_AOD_FILE
! INTEGER :: N_OFF(IIPAR,JJPAR)
! REAL*8, PARAMETER :: FILTER = 1d-10
!
! ! Temporary storage arrays for checkpointed variables
! REAL*8 :: CHK_RAD_1(IIPAR,JJPAR)
! REAL*8 :: CHK_RAD_2(IIPAR,JJPAR)
! REAL*8 :: CHK_RAD_3(IIPAR,JJPAR)
! REAL*4 :: TRACER(IIPAR,JJPAR,LLPAR)
! REAL*4 :: EMS_3D(IIPAR,JJPAR,MMSCL)
! REAL*8 :: ADJ(IIPAR,JJPAR,1)
! REAL*4 :: TRACER_2D(IIPAR,JJPAR,1)
!
! ! For binary punch file, version 2.0
! REAL*4 :: LONRES, LATRES
! INTEGER :: HALFPOLAR
! INTEGER :: CENTER180
!
! CHARACTER(LEN=20) :: MODELNAME
! CHARACTER(LEN=40) :: CATEGORY
! CHARACTER(LEN=40) :: UNIT
! CHARACTER(LEN=40) :: RESERVED = ''
! CHARACTER(LEN=80) :: TITLE
!
! INTEGER :: NI, NJ, NL
! INTEGER :: IFIRST, JFIRST, LFIRST
! INTEGER :: NTRACER, NSKIP
! REAL*8 :: ZTAU0, ZTAU1
!
! INTEGER, PARAMETER :: NWL_MAX = 5
!
! !=================================================================
! ! MAKE_SAVE_FILE_3 begins here!
! !=================================================================
!
!
! ! Clear some arrays
! CHK_RAD_1(:,:) = 0e0
! CHK_RAD_2(:,:) = 0e0
! CHK_RAD_3(:,:) = 0e0
! EMS_3D(:,:,:) = 0d0
! ADJ(:,:,:) = 0e0
! TRACER(:,:,:) = 0e0
! TRACER_2D(:,:,:) = 0e0
! N_OFF(:,:) = 0d0
!
! !========================================
! ! Read *.save* file from unperturbed run
! !========================================
! !INPUT_CHECKPT_FILE = 'gctm.save.YYYYMMDD.hhmmss.NN'
! INPUT_AOD_FILE = 'aod.YYYYMMDD.NN'
!
! ! Copy input file name to a local variable
! FILENAME = TRIM( INPUT_AOD_FILE )
!
! ! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
! CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS_dum )
!
! ! Append the iteration number suffix to the file name
! CALL EXPAND_NAME( FILENAME, 1 )
!
! ! Add ADJ_DIR prefix to name
! FILENAME = TRIM( ADJ_DIR ) // TRIM( FILENAME )
!
! ! Echo some input to the screen
! WRITE( 6, '(a)' ) REPEAT( '=', 79 )
! WRITE( 6, '(a,/)' ) 'A O D F I L E I N P U T'
!
!
! WRITE( 6, 401 ) TRIM( FILENAME )
! 401 FORMAT( ' - MAKE_SAVE_FILE_3: Reading ', a )
!
! ! Open the binary punch file for input
! CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!
! !=================================================================
! ! Read checkpointed variables
! !=================================================================
! ! Read the values of CHK_STT
! DO W = 1, NWL_MAX * 3 + 1
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so exit
! IF ( IOS < 0 ) EXIT
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 )
! & CALL IOERROR( IOS,IU_RST,'read_checkpt_file:7' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 )
! & CALL IOERROR(IOS,IU_RST,'read_checkpt_file:8' )
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 )
! & CALL IOERROR( IOS,IU_RST,'read_checkpt_file:9' )
!
! !==============================================================
! ! Assign data from the TRACER array to the STT array.
! !==============================================================
!
! ! Only process checkpoint data (i.e. mixing ratio)
! IF ( CATEGORY(1:8) == 'IJ-AOD-$' .and.
! & W == NWL_MAX * 3 + 1 ) THEN
!
! ! Make sure array dimensions are of global size
! ! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
! !CALL CHECK_DIMENSIONS( NI, NJ, NL )
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! CHK_RAD_1(I,J) = TRACER(I,J,1)
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ENDIF
! ENDDO
! ! Close file
! CLOSE( IU_RST )
!
!
! !========================================
! ! Read *.save* file from perturbed run
! !========================================
! !INPUT_CHECKPT_FILE = 'gctm.save.YYYYMMDD.hhmmss.NN'
! INPUT_AOD_FILE = 'aod.YYYYMMDD.NN'
!
! ! Copy input file name to a local variable
! FILENAME = TRIM( INPUT_AOD_FILE )
!
! ! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
! CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS_dum )
!
! ! Append the iteration number suffix to the file name
! CALL EXPAND_NAME( FILENAME, 2 )
!
! ! Add ADJ_DIR prefix to name
! FILENAME = TRIM( ADJ_DIR ) // TRIM( FILENAME )
!
! ! Echo some input to the screen
! WRITE( 6, '(a)' ) REPEAT( '=', 79 )
! WRITE( 6, '(a,/)' ) 'A O D F I L E I N P U T'
!
!
! WRITE( 6, 101 ) TRIM( FILENAME )
! 101 FORMAT( ' - MAKE_SAVE_FILE_3: Reading ', a )
!
! ! Open the binary punch file for input
! CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!
! !=================================================================
! ! Read checkpointed variables
! !=================================================================
! ! Read the values of CHK_STT
! DO W = 1, NWL_MAX*3 + 1
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so exit
! IF ( IOS < 0 ) EXIT
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 )
! & CALL IOERROR( IOS,IU_RST,'read_checkpt_file:7' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 )
! & CALL IOERROR(IOS,IU_RST,'read_checkpt_file:8' )
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 )
! & CALL IOERROR( IOS,IU_RST,'read_checkpt_file:9' )
!
! !==============================================================
! ! Assign data from the TRACER array to the STT array.
! !==============================================================
!
! ! Only process checkpoint data (i.e. mixing ratio)
! IF ( CATEGORY(1:8) == 'IJ-AOD-$' .and.
! & W == NWL_MAX * 3 + 1 ) THEN
!
! ! Make sure array dimensions are of global size
! ! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
! !CALL CHECK_DIMENSIONS( NI, NJ, NL )
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! CHK_RAD_2(I,J) = TRACER(I,J,1)
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ENDIF
! ENDDO
! ! Close file
! CLOSE( IU_RST )
!
! !========================================
! ! Read *.save* file from 2nd perturbed run
! !========================================
! !INPUT_CHECKPT_FILE = 'gctm.save.YYYYMMDD.hhmmss.NN'
! INPUT_AOD_FILE = 'aod.YYYYMMDD.NN'
!
! ! Copy input file name to a local variable
! FILENAME = TRIM( INPUT_AOD_FILE )
!
! ! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
! CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS_dum )
!
! ! Append the iteration number suffix to the file name
! CALL EXPAND_NAME( FILENAME, 3 )
!
! ! Add ADJ_DIR prefix to name
! FILENAME = TRIM( ADJ_DIR ) // TRIM( FILENAME )
!
! ! Echo some input to the screen
! WRITE( 6, '(a)' ) REPEAT( '=', 79 )
! WRITE( 6, '(a,/)' ) 'A O D F I L E I N P U T'
!
!
! WRITE( 6, 889 ) TRIM( FILENAME )
! 889 FORMAT( ' - MAKE_SAVE_FILE_3: Reading ', a )
!
! ! Open the binary punch file for input
! CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!
! !=================================================================
! ! Read checkpointed variables
! !=================================================================
! ! Read the values of CHK_STT
! DO W = 1, NWL_MAX * 3 + 1
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so exit
! IF ( IOS < 0 ) EXIT
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 )
! & CALL IOERROR( IOS,IU_RST,'read_checkpt_file:7' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 )
! & CALL IOERROR(IOS,IU_RST,'read_checkpt_file:8' )
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 )
! & CALL IOERROR( IOS,IU_RST,'read_checkpt_file:9' )
!
! !==============================================================
! ! Assign data from the TRACER array to the STT array.
! !==============================================================
!
! ! Only process checkpoint data (i.e. mixing ratio)
! IF ( CATEGORY(1:8) == 'IJ-AOD-$' .and.
! & W == NWL_MAX * 3 + 1 ) THEN
!
! ! Make sure array dimensions are of global size
! ! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
! !CALL CHECK_DIMENSIONS( NI, NJ, NL )
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! CHK_RAD_3(I,J) = TRACER(I,J,1)
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ENDIF
! ENDDO
! ! Close file
! CLOSE( IU_RST )
!
! !========================================
! ! Read *.gdt.* file from unperturbed run
! !========================================
! ! Hardwire output file for now
! INPUT_GDT_FILE = 'gctm.gdt.01'
!
! ! Initialize some variables
! TRACER(:,:,:) = 0e0
!
! !=================================================================
! ! Open gradient file and read top-of-file header
! !=================================================================
!
! ! Copy input file name to a local variable
! FILENAME = TRIM( INPUT_GDT_FILE )
!
! ! Add OPT_DATA_DIR prefix to FILENAME
! FILENAME = TRIM( OPT_DATA_DIR ) // TRIM( FILENAME )
!
! ! Echo some input to the screen
! WRITE( 6, '(a)' ) REPEAT( '=', 79 )
! WRITE( 6, '(a,/)' ) 'G D T F I L E I N P U T'
! WRITE( 6, 109 ) TRIM( FILENAME )
! 109 FORMAT( 'READ_GDT_FILE: Reading ', a )
!
! ! Open the binary punch file for input
! CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!
! !=================================================================
! ! Read adjoints -- store in the TRACER array
! !=================================================================
! DO N = 1, NNEMS
! READ( IU_RST, IOSTAT=IOS )
! & MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!
! ! IOS < 0 is end-of-file, so exit
! IF ( IOS < 0 ) EXIT
!
! ! IOS > 0 is a real I/O error -- print error message
! IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'read_gdt_file:5' )
!
! READ( IU_RST, IOSTAT=IOS )
! & CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
! & NI, NJ, NL, IFIRST, JFIRST, LFIRST,
! & NSKIP
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_gdt_file:5')
!
! READ( IU_RST, IOSTAT=IOS )
! & ( ( ( EMS_3D(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
!
! IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'read_gdt_file:7')
!
! !==============================================================
! ! Assign data from the TRACER array to the ADJ_STT array.
! !==============================================================
!
! ! Only process observation data (i.e. aerosol and precursors)
! IF ( CATEGORY(1:8) == 'IJ-GDE-$' .and. N == EMSFD
! & .and. MMSCL == 1 ) THEN
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
! ADJ(I,J,1) = EMS_3D(I,J,1)
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ENDIF
! ENDDO
! ! Close file
! CLOSE( IU_RST )
!
!
! !========================================
! ! Write 2nd order FD gradient
! !========================================
! !L = LFD
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
!
! TRACER_2D(I,J,1) =(CHK_RAD_2(I,J) - CHK_RAD_3(I,J))
! & / (2 * FD_DIFF )
!
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ! Hardwire output file for now
! OUTPUT_CHECKPT_FILE = 'gctm.save2.YYYYMMDD'
!
! ! Define variables for BINARY PUNCH FILE OUTPUT
! TITLE = 'GEOS-CHEM Checkpoint File: ' //
! & 'Instantaneous Tracer Concentrations (v/v)'
! CATEGORY = 'IJ-CHK-$'
! LONRES = DISIZE
! LATRES = DJSIZE
!
! ! Call GET_MODELNAME to return the proper model name for
! ! the given met data being used (bmy, 6/22/00)
! MODELNAME = GET_MODELNAME()
!
! ! Get the nested-grid offsets
! I0 = GET_XOFFSET( GLOBAL=.TRUE. )
! J0 = GET_YOFFSET( GLOBAL=.TRUE. )
!
! !=================================================================
! ! Open the save file for output -- binary punch format
! !=================================================================
!
! ! Copy the output checkpoint file name into a local variable
! FILENAME = TRIM( OUTPUT_CHECKPT_FILE )
!
! ! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
! CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS_dum )
!
! ! Add ADJ_DIR prefix to filename
! FILENAME = TRIM( ADJ_DIR ) // TRIM( FILENAME )
!
! WRITE( 6, 102 ) TRIM( FILENAME )
! 102 FORMAT( ' - MAKE_SAVE_FILE: Writing ', a )
!
! ! Open checkpoint file for output
! CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
!
! UNIT = 'kg/box'
!
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 1,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, 1, I0+1,
! & J0+1, 1, TRACER_2D )
!
! !========================================
! ! Write ADJ gradient
! !========================================
! UNIT = 'kg/box'
!
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 2,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, 1, I0+1,
! & J0+1, 1, REAL(ADJ) )
!
! print*, 'MAKE_SAVE_FILE_3 : RAD 1 = ', CHK_RAD_1(IFD,JFD)
! print*, 'MAKE_SAVE_FILE_3 : RAD 2 = ', CHK_RAD_2(IFD,JFD)
! print*, 'MAKE_SAVE_FILE_3 : RAD 3 = ', CHK_RAD_3(IFD,JFD)
! print*, 'MAKE_SAVE_FILE_3 : 2ord FD = ', TRACER_2D(IFD,JFD,1)
! print*, 'MAKE_SAVE_FILE_3 : ADJ = ', ADJ(IFD,JFD,1)
!
! !========================================
! ! Write ADJ / FD ratio
! !========================================
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
!
! IF ( ABS(TRACER_2D(I,J,1)) .gt. FILTER ) THEN
!
! TRACER_2D(I,J,1) = REAL(ADJ(I,J,1)) / TRACER_2D(I,J,1)
!
! ELSE
!
! TRACER_2D(I,J,1) = 1d0
!
! ENDIF
!
! ! Keep track of number of points that are off
! IF ( ( TRACER_2D(I,J,1) > 1d0 + FD_DIFF ) .OR.
! & ( TRACER_2D(I,J,1) < 1D0 - FD_DIFF ) ) THEN
! N_OFF(I,J) = 1
! ENDIF
!
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! UNIT = 'none'
!
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 3,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, 1, I0+1,
! & J0+1, 1, TRACER_2D )
!
! ! print out statistics of the ADJ / FD ratio
! WRITE(6,*) '===================================================='
! WRITE(6,*) ' Global validation test for values > ', FILTER
! WRITE(6,*) ' MAX of global 2nd order ADJ / FD = ',
! & MAXVAL(TRACER_2D(:,:,1))
! WRITE(6,*) ' MIN of global 2nd order ADJ / FD = ',
! & MINVAL(TRACER_2D(:,:,1))
! WRITE(6,*) ' Number of places where ratio off by ',FD_DIFF,' = ',
! & SUM(N_OFF(:,:))
! WRITE(6,*) '===================================================='
!
! !========================================
! ! Write 1st order FD gradient
! !========================================
! UNIT = 'kg/box'
! !L = LFD
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
!
! TRACER_2D(I,J,1) =(CHK_RAD_2(I,J) - CHK_RAD_1(I,J))
! & / FD_DIFF
!
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 4,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, 1, I0+1,
! & J0+1, 1, TRACER_2D )
!
! !========================================
! ! Write chekpt values
! !========================================
! UNIT = 'kg/box'
! !L = LFD
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
!
! TRACER_2D(I,J,1) = CHK_RAD_1(I,J)
!
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
! & HALFPOLAR, CENTER180, CATEGORY, 5,
! & UNIT, GET_TAU(), GET_TAU(), RESERVED,
! & IIPAR, JJPAR, 1, I0+1,
! & J0+1, 1, TRACER_2D )
! ! Close file
! CLOSE( IU_RST )
!
! !### Debug
! IF ( LPRT ) CALL DEBUG_MSG( '### MAKE_SAVE_FILE_3: wrote file' )
!
!
! ! Return to calling program
! END SUBROUTINE MAKE_SAVE_FILE_3
!!----------------------------------------------------------------------
SUBROUTINE MAKE_FD_FILE( YYYYMMDD, HHMMSS )
!
!******************************************************************************
! Subroutine MAKE_FD_FILE creates GEOS-CHEM checkpt files of tracer
! concentrations [kg/box].
! For use in checking chemistry adjoints. (dkh, 07/19/06)
!
! Arguments as Input:
! ============================================================================
! (1 ) YYYYMMDD : Year-Month-Date
! (2 ) HHMMSS : and Hour-Min-Sec for which to create a checkpoint file
!
! NOTES:
! (1 ) Updated from MAKE_SAVE_FILE to v8, rename, replace CMN_ADJ, etc
! (dkh, ks, mak, cs, 06/09/09)
!
!******************************************************************************
!
! References to F90 modules
USE ADJ_ARRAYS_MOD, ONLY : N_CALC
USE ADJ_ARRAYS_MOD, ONLY : NFD
USE ADJ_ARRAYS_MOD, ONLY : LFD
USE ADJ_ARRAYS_MOD, ONLY : NSPAN
USE ADJ_ARRAYS_MOD, ONLY : NTR2NOBS
USE ADJ_ARRAYS_MOD, ONLY : DDEP_TRACER
USE ADJ_ARRAYS_MOD, ONLY : DDEP_CSPEC
USE ADJ_ARRAYS_MOD, ONLY : NOBS2NWDEP
USE ADJ_ARRAYS_MOD, ONLY : WDEP_CV, WDEP_LS
! USE ADJ_ARRAYS_MOD, ONLY : IDCSPEC_ADJ
USE BPCH2_MOD
USE DIAG_MOD, ONLY : AD38
USE DIAG_MOD, ONLY : AD39
USE DIAG_MOD, ONLY : AD44
USE DIRECTORY_ADJ_MOD, ONLY : DIAGADJ_DIR
! USE DRYDEP_MOD, ONLY : NTRAIND
! USE DRYDEP_MOD, ONLY : NUMDEP
USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP
USE FILE_MOD, ONLY : IU_RST, IOERROR
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
USE LOGICAL_MOD, ONLY : LPRT
USE LOGICAL_ADJ_MOD, ONLY : LADJ_DDEP_TRACER
USE LOGICAL_ADJ_MOD, ONLY : LADJ_DDEP_CSPEC
USE LOGICAL_ADJ_MOD, ONLY : LADJ_FDEP
USE LOGICAL_ADJ_MOD, ONLY : LADJ_WDEP_LS
USE LOGICAL_ADJ_MOD, ONLY : LADJ_WDEP_CV
USE TIME_MOD, ONLY : EXPAND_DATE, GET_TAU
USE TIME_MOD, ONLY : GET_TS_DYN
USE TIME_MOD, ONLY : GET_TS_CHEM
USE TRACER_MOD, ONLY : N_TRACERS
USE TRACER_MOD, ONLY : STT
USE TRACERID_MOD, ONLY : IDTRMB
! USE WETSCAV_MOD, ONLY : GET_WETDEP_IDWETD
! USE WETSCAV_MOD, ONLY : NSOL
# include "CMN_SIZE" ! Size parameters
# include "comode.h" ! CSPEC
! Arguments
INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS
! Local Variables
INTEGER :: I, I0, IOS, J, J0, L, N
INTEGER :: YYYY, MM, DD, HH, SS
CHARACTER(LEN=255) :: FILENAME
CHARACTER(LEN=255) :: OUTPUT_FD_FILE
INTEGER :: NFD_DEP
! Temporary storage arrays for checkpointed variables
REAL*4 :: TEMP(IIPAR,JJPAR,LLPAR)
! For binary punch file, version 2.0
REAL*4 :: LONRES, LATRES
INTEGER, PARAMETER :: HALFPOLAR = 1
INTEGER, PARAMETER :: CENTER180 = 1
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED = ''
CHARACTER(LEN=80) :: TITLE
!=================================================================
! MAKE_FD_FILE begins here!
!=================================================================
! Hardwire output file for now
OUTPUT_FD_FILE = 'gctm.fd.YYYYMMDD.hhmm.NN'
! Clear some arrays
TEMP(:,:,:) = 0e0
! Define variables for BINARY PUNCH FILE OUTPUT
TITLE = 'GEOS-CHEM Checkpoint File: ' //
& 'Instantaneous Tracer Concentrations (v/v)'
CATEGORY = 'IJ-CHK-$'
LONRES = DISIZE
LATRES = DJSIZE
! Call GET_MODELNAME to return the proper model name for
! the given met data being used (bmy, 6/22/00)
MODELNAME = GET_MODELNAME()
! Get the nested-grid offsets
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
!=================================================================
! Open the save file for output -- binary punch format
!=================================================================
! Copy the output checkpoint file name into a local variable
FILENAME = TRIM( OUTPUT_FD_FILE )
! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
! Append the iteration number suffix to the file name
CALL EXPAND_NAME( FILENAME, N_CALC )
! Add ADJ_DIR prefix to filename
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - MAKE_FD_FILE: Writing ', a )
! Open checkpoint file for output
CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
!=================================================================
! Write each checkpointed quantity to the checkpoint file
!=================================================================
! concentration based cost function
IF ( .not. LADJ_FDEP ) THEN
! Write the final concetration values as saved at the end of geos_mod.f
UNIT = 'kg/box'
! Temporarily store data in CHECK_FINAL
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
!TEMP(I,J,L) = CHK_STT(I,J,L,N)
TEMP(I,J,L) = STT(I,J,L,NFD)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
! aerosol dry dep
ELSEIF ( LADJ_DDEP_TRACER ) THEN
! Write the final concetration values as saved at the end of geos_mod.f
UNIT = 'molec/cm2/s'
NFD_DEP = NTR2NOBS(NFD)
! Temporarily store data in TEMP
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
TEMP(I,J,LFD) = DDEP_TRACER(I,J,NFD_DEP)
ENDDO
ENDDO
!$OMP END PARALLEL DO
! gas phase dry dep
ELSEIF ( LADJ_DDEP_CSPEC ) THEN
! Write the final concetration values as saved at the end of geos_mod.f
UNIT = 'molec/cm2/s'
! No conversion of NFD to NFD_DEP necessary, since NFD directly refers
! to element of NOBS_CSPEC when FD testing of CSPEC species
! Temporarily store data in TEMP
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
TEMP(I,J,LFD) = DDEP_CSPEC(I,J,NFD)
ENDDO
ENDDO
!$OMP END PARALLEL DO
! wetdep LS
ELSEIF ( LADJ_WDEP_LS ) THEN
! Write the final concetration values as saved at the end of geos_mod.f
UNIT = 'kg/s'
! Map NFD_DEP from NFD
NFD_DEP = NTR2NOBS(NFD)
! Temporarily store data in TEMP
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
TEMP(I,J,LFD) = WDEP_LS(I,J,NFD_DEP)
ENDDO
ENDDO
!$OMP END PARALLEL DO
! wetdep CV
ELSEIF ( LADJ_WDEP_CV ) THEN
! Write the final concetration values as saved at the end of geos_mod.f
UNIT = 'kg/s'
! Map NFD_DEP from NFD
NFD_DEP = NTR2NOBS(NFD)
! Temporarily store data in TEMP
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
TEMP(I,J,LFD) = WDEP_CV(I,J,NFD_DEP)
ENDDO
ENDDO
!OMP END PARALLEL DO
ENDIF
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 1,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLPAR, I0+1,
& J0+1, 1, TEMP )
! Close file
CLOSE( IU_RST )
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### MAKE_FD_FILE: wrote file' )
! Return to calling program
END SUBROUTINE MAKE_FD_FILE
!-----------------------------------------------------------------------
SUBROUTINE MAKE_FDGLOB_FILE( YYYYMMDD, HHMMSS )
!
!******************************************************************************
! Subroutine MAKE_FDGLOB_FILE creates GEOS-CHEM checkpt files of tracer
! concentrations [kg/box]. Like MAKE_FD_FILE, except calculate the finite
! difference sensitivities directly. Save these, the adjoint sensitivities,
! and the ratio adj / fd. Save first and 2nd order finite difference
! sensitivities. Requires running to XSTOP = 3.
! For use in checking process specific adjoints. (dkh, 01/23/07)
!
! Arguments as Input:
! ============================================================================
! (1 ) YYYYMMDD : Year-Month-Date
! (2 ) HHMMSS : and Hour-Min-Sec for which to create a checkpoint file
!
! NOTES:
! (1 ) Now write out both sets of 1st order FD gradients, and define a new
! category (FD-TEST) for viewing in gamap. (dkh, 10/10/08)
! (2 ) Updated from MAKE_SAVE_FILE to v8, rename, replace CMN_ADJ, etc
! (dkh, ks, mak, cs, 06/09/09)
! (3 ) NNEMS Now in tracerid_adj_mod.f (mak, 6/14/09)
! (4 ) Updated to include LADJ_STRAT (hml, dkh, 02/14/12, adj32_025)
!******************************************************************************
!
! References to F90 modules
USE ADJ_ARRAYS_MOD, ONLY : N_CALC
USE ADJ_ARRAYS_MOD, ONLY : NFD, EMSFD, MFD, LFD, MMSCL
USE ADJ_ARRAYS_MOD, ONLY : FD_DIFF, NNEMS
USE ADJ_ARRAYS_MOD, ONLY : ICSFD
USE ADJ_ARRAYS_MOD, ONLY : IFD, JFD
USE ADJ_ARRAYS_MOD, ONLY : STRFD
USE ADJ_ARRAYS_MOD, ONLY : NSTPL
USE ADJ_ARRAYS_MOD, ONLY : RATFD, NRRATES
USE BPCH2_MOD
USE DIRECTORY_ADJ_MOD, ONLY : DIAGADJ_DIR
USE DIRECTORY_ADJ_MOD, ONLY : OPTDATA_DIR
USE DIRECTORY_ADJ_MOD, ONLY : ADJTMP_DIR
USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP
USE FILE_MOD, ONLY : IU_RST, IOERROR
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
USE LOGICAL_MOD, ONLY : LPRT
USE LOGICAL_ADJ_MOD, ONLY : LADJ_EMS, LICS
USE LOGICAL_ADJ_MOD, ONLY : LADJ_STRAT, LADJ_RRATE
USE LOGICAL_ADJ_MOD, ONLY : LADJ_DDEP_TRACER
USE LOGICAL_ADJ_MOD, ONLY : LADJ_WDEP_LS
USE TIME_MOD, ONLY : EXPAND_DATE, GET_TAU
USE TRACER_MOD, ONLY : N_TRACERS
# include "CMN_SIZE" ! Size parameters
! Arguments
INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS
! Local Variables
INTEGER :: I, I0, IOS, J, J0, L, N
INTEGER :: YYYY, MM, DD, HH, SS
CHARACTER(LEN=255) :: FILENAME
CHARACTER(LEN=255) :: INPUT_GDT_FILE
CHARACTER(LEN=255) :: INPUT_FD_FILE
CHARACTER(LEN=255) :: OUTPUT_FDGLOB_FILE
INTEGER :: N_OFF(IIPAR,JJPAR)
REAL*8, PARAMETER :: FILTER = 1d0
! Temporary storage arrays for checkpointed variables
REAL*8 :: TEMP1(IIPAR,JJPAR,LLPAR)
REAL*8 :: TEMP2(IIPAR,JJPAR,LLPAR)
REAL*8 :: TEMP3(IIPAR,JJPAR,LLPAR)
REAL*4 :: TRACER(IIPAR,JJPAR,LLPAR)
REAL*4 :: EMS_3D(IIPAR,JJPAR,MMSCL)
REAL*4 :: ADJ_2D(IIPAR,JJPAR,1)
REAL*4 :: TRACER_2D(IIPAR,JJPAR,1)
! For strat prod and loss (hml, 09/01/11, adj32_025)
REAL*4 :: PROD_3D(IIPAR,JJPAR,MMSCL)
REAL*4 :: LOSS_3D(IIPAR,JJPAR,MMSCL)
REAL*4 :: EMS_N_3D(IIPAR,JJPAR,MMSCL)
! For binary punch file, version 2.0
REAL*4 :: LONRES, LATRES
INTEGER :: HALFPOLAR
INTEGER :: CENTER180
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED = ''
CHARACTER(LEN=80) :: TITLE
INTEGER :: NI, NJ, NL
INTEGER :: IFIRST, JFIRST, LFIRST
INTEGER :: NTRACER, NSKIP
REAL*8 :: ZTAU0, ZTAU1
!=================================================================
! MAKE_FDGLOB_FILE begins here!
!=================================================================
! Clear some arrays
TEMP1(:,:,:) = 0e0
TEMP2(:,:,:) = 0e0
TEMP3(:,:,:) = 0e0
EMS_3D(:,:,:) = 0d0
ADJ_2D(:,:,:) = 0e0
TRACER(:,:,:) = 0e0
TRACER_2D(:,:,:) = 0e0
N_OFF(:,:) = 0d0
! strat prod and loss (hml)
PROD_3D(:,:,:) = 0d0
LOSS_3D(:,:,:) = 0d0
EMS_N_3D(:,:,:) = 0d0
!========================================
! Read *.fd.* file from unperturbed run
!========================================
INPUT_FD_FILE = 'gctm.fd.YYYYMMDD.hhmm.NN'
! Copy input file name to a local variable
FILENAME = TRIM( INPUT_FD_FILE )
! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
! Append the iteration number suffix to the file name
CALL EXPAND_NAME( FILENAME, 1 )
! Add ADJ_DIR prefix to name
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
! Echo some input to the screen
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
WRITE( 6, '(a,/)' ) 'F D F I L E I N P U T: base '
WRITE( 6, 400 ) TRIM( FILENAME )
400 FORMAT( ' - READ_FDGLOB_FILE: Reading ', a )
! Open the binary punch file for input
CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!=================================================================
! Read checkpointed variables
!=================================================================
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!! IOS < 0 is end-of-file, so exit
!IF ( IOS < 0 ) EXIT
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_fdglob_file:1' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_fdglob_file:2' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_fdglob_file:3' )
!==============================================================
! Assign data from the TRACER array to the STT array.
!==============================================================
! Only process checkpoint data (i.e. mixing ratio)
IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
! Make sure array dimensions are of global size
! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
!CALL CHECK_DIMENSIONS( NI, NJ, NL )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
TEMP1(I,J,L) = TRACER(I,J,L)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
! Close file
CLOSE( IU_RST )
!========================================
! Read *.fd* file from perturbed run
!========================================
INPUT_FD_FILE = 'gctm.fd.YYYYMMDD.hhmm.NN'
! Copy input file name to a local variable
FILENAME = TRIM( INPUT_FD_FILE )
! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
! Append the iteration number suffix to the file name
CALL EXPAND_NAME( FILENAME, 2 )
! Add ADJ_DIR prefix to name
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
! Echo some input to the screen
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
WRITE( 6, '(a,/)' ) 'F D F I L E I N P U T: +pert '
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - READ_FDGLOB_FILE: Reading ', a )
! Open the binary punch file for input
CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!=================================================================
! Read checkpointed variables
!=================================================================
! Read the values of STT
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!! IOS < 0 is end-of-file, so exit
!IF ( IOS < 0 ) EXIT
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_fdglob_file:4' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_fdglob_file:5' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_fdglob_file:6' )
!==============================================================
! Assign data from the TRACER array to the STT array.
!==============================================================
! Only process checkpoint data (i.e. mixing ratio)
IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
! Make sure array dimensions are of global size
! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
!CALL CHECK_DIMENSIONS( NI, NJ, NL )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
TEMP2(I,J,L) = TRACER(I,J,L)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
! Close file
CLOSE( IU_RST )
!========================================
! Read *.fd.* file from 2nd perturbed run
!========================================
INPUT_FD_FILE = 'gctm.fd.YYYYMMDD.hhmm.NN'
! Copy input file name to a local variable
FILENAME = TRIM( INPUT_FD_FILE )
! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
! Append the iteration number suffix to the file name
CALL EXPAND_NAME( FILENAME, 3 )
! Add ADJ_DIR prefix to name
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
! Echo some input to the screen
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
WRITE( 6, '(a,/)' ) 'F D F I L E I N P U T: -pert '
WRITE( 6, 888 ) TRIM( FILENAME )
888 FORMAT( ' - READ_FDGLOB_FILE: Reading ', a )
! Open the binary punch file for input
CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!=================================================================
! Read checkpointed variables
!=================================================================
! Read the values of CHK_STT
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
!! IOS < 0 is end-of-file, so exit
!IF ( IOS < 0 ) EXIT
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_fdglob_file:7' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_fdglob_file:8' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_fdglob_file:9' )
!==============================================================
! Assign data from the TRACER array to the STT array.
!==============================================================
! Only process checkpoint data (i.e. mixing ratio)
IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
! Make sure array dimensions are of global size
! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
!CALL CHECK_DIMENSIONS( NI, NJ, NL )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
TEMP3(I,J,L) = TRACER(I,J,L)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
! Close file
CLOSE( IU_RST )
!========================================
! Read *.gdt.* file from unperturbed run
!========================================
INPUT_GDT_FILE = 'gctm.gdt.01'
! Initialize some variables
TRACER(:,:,:) = 0e0
!=================================================================
! Open gradient file and read top-of-file header
!=================================================================
! Copy input file name to a local variable
FILENAME = TRIM( INPUT_GDT_FILE )
! Add OPT_DATA_DIR prefix to FILENAME
FILENAME = TRIM( OPTDATA_DIR ) // TRIM( FILENAME )
! Echo some input to the screen
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
WRITE( 6, '(a,/)' ) 'G D T F I L E I N P U T'
WRITE( 6, 101 ) TRIM( FILENAME )
101 FORMAT( 'READ_GDT_FILE: Reading ', a )
! Open the binary punch file for input
CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!=================================================================
! Read adjoints -- store in the TRACER array
!=================================================================
IF ( LADJ_EMS ) THEN
DO N = 1, NNEMS
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) EXIT
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'fdglob_file:10' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'fdglob_file:11')
READ( IU_RST, IOSTAT=IOS )
& ( ( ( EMS_3D(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'fdglob_file:12')
! Don't write if LADJ_STRAT (hml, 10/31/11, adj32_025)
! IF ( .NOT. LADJ_STRAT ) THEN
! Don't write if LADJ_STRAT (hml, 10/31/11, adj32_025)
! Same for reaction rates (tww, 05/15/12)
IF ( .NOT. LADJ_STRAT .AND. .NOT. LADJ_RRATE ) THEN
!==============================================================
! Assign data from the TRACER array to the ADJ_STT array.
!==============================================================
! Save the gradients selected by EMSFD and MFD
IF ( CATEGORY(1:8) == 'IJ-GDE-$' .and. N == EMSFD ) THEN
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
ADJ_2D(I,J,1) = EMS_3D(I,J,MFD)
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
ENDIF
ENDDO
! Read GDEN (hml, 09/11/11, adj32_025)
DO N = 1, NNEMS
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) EXIT
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'fdglob_file:10-b' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'fdglob_file:11-b')
READ( IU_RST, IOSTAT=IOS )
& ( ( ( EMS_N_3D(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'fdglob_file:12-b')
ENDDO
! For strat prod and loss (hml, 08/30/11, adj32_025)
IF ( LADJ_STRAT ) THEN
! Strat production
DO N = 1, NSTPL
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) EXIT
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 ) CALL IOERROR(IOS,IU_RST,'fdglob_file:13')
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 ) CALL IOERROR(IOS,IU_RST,'fdglob_file:14')
READ( IU_RST, IOSTAT=IOS )
& ( ( ( PROD_3D(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 ) CALL IOERROR(IOS,IU_RST,'fdglob_file:15')
ENDDO
! Strat loss
DO N = 1, NSTPL
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) EXIT
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 ) CALL IOERROR(IOS,IU_RST,'fdglob_file:16')
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 ) CALL IOERROR(IOS,IU_RST,'fdglob_file:17')
READ( IU_RST, IOSTAT=IOS )
& ( ( ( LOSS_3D(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 ) CALL IOERROR(IOS,IU_RST,'fdglob_file:18')
!========================================================
! Assign data from the LOSS_3D array to the ADJ_STT array.
!========================================================
! Save the gradients selected by EMSFD and MFD
IF ( CATEGORY(1:8) == 'IJ-GDL-$' .and. N == STRFD ) THEN
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
ADJ_2D(I,J,1) = LOSS_3D(I,J,MFD)
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
ENDDO
ENDIF
! For reaction rates (tww, 05/15/12)
IF ( LADJ_RRATE ) THEN
DO N = 1, NRRATES
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) EXIT
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 ) CALL IOERROR(IOS,IU_RST,'fdglob_file:13')
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 ) CALL IOERROR(IOS,IU_RST,'fdglob_file:14')
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 ) CALL IOERROR(IOS,IU_RST,'fdglob_file:15')
!========================================================
! Assign data from the TRACER array to the ADJ_STT array.
!========================================================
! Save the gradients selected by EMSFD and MFD
IF ( CATEGORY(1:8) == 'IJ-RATE$' .and. N == RATFD ) THEN
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
ADJ_2D(I,J,1) = TRACER(I,J,LFD)
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
ENDDO
ENDIF
ELSEIF ( LICS ) THEN
TRACER(:,:,:) = 0d0
DO N = 1, N_TRACERS
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) EXIT
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 ) CALL IOERROR( IOS,IU_RST,'fdglob_file:13' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'fdglob_file:14')
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 ) CALL IOERROR( IOS,IU_RST,'fdglob_file:15')
!==============================================================
! Assign data from the TRACER array to the ADJ_STT array.
!==============================================================
! Save the gradients selected by EMSFD and MFD
IF ( CATEGORY(1:8) == 'IJ-GDT-$' .and. N == ICSFD ) THEN
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
ADJ_2D(I,J,1) = TRACER(I,J,LFD)
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
ENDDO
ENDIF
! Close file
CLOSE( IU_RST )
!========================================
! Write 2nd order FD gradient
!========================================
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
TRACER_2D(I,J,1) =(TEMP2(I,J,LFD) - TEMP3(I,J,LFD))
& / ( 2d0 * FD_DIFF )
ENDDO
ENDDO
!$OMP END PARALLEL DO
! Hardwire output file for now
OUTPUT_FDGLOB_FILE = 'gctm.fdglob.YYYYMMDD.hhmm'
! Define variables for BINARY PUNCH FILE OUTPUT
TITLE = 'GEOS-CHEM Checkpoint File: ' //
& 'Instantaneous Tracer Concentrations (v/v)'
CATEGORY = 'FD-TEST'
LONRES = DISIZE
LATRES = DJSIZE
! Call GET_MODELNAME to return the proper model name for
! the given met data being used (bmy, 6/22/00)
MODELNAME = GET_MODELNAME()
! Get the nested-grid offsets
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
!=================================================================
! Open the save file for output -- binary punch format
!=================================================================
! Copy the output checkpoint file name into a local variable
FILENAME = TRIM( OUTPUT_FDGLOB_FILE )
! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
! Add ADJ_DIR prefix to filename
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
WRITE( 6, 102 ) TRIM( FILENAME )
102 FORMAT( ' - MAKE_FDGLOB_FILE: Writing ', a )
! Open checkpoint file for output
CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
UNIT = 'kg/box'
IF ( LADJ_DDEP_TRACER ) UNIT = 'molec/cm2/s'
IF ( LADJ_WDEP_LS ) UNIT = 'kg/s'
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 1,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, 1, I0+1,
& J0+1, 1, TRACER_2D )
!========================================
! Write ADJ gradient
!========================================
UNIT = 'kg/box'
IF ( LADJ_DDEP_TRACER ) UNIT = 'molec/cm2/s'
IF ( LADJ_WDEP_LS ) UNIT = 'kg/s'
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 2,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, 1, I0+1,
& J0+1, 1, ADJ_2D )
!========================================
! Write ADJ / FD ratio
!========================================
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
IF ( ABS(TRACER_2D(I,J,1)) .gt. FILTER ) THEN
TRACER_2D(I,J,1) = ADJ_2D(I,J,1) / TRACER_2D(I,J,1)
ELSE
TRACER_2D(I,J,1) = 1d0
ENDIF
! Keep track of number of points that are off
IF ( ( TRACER_2D(I,J,1) > 1d0 + FD_DIFF ) .OR.
& ( TRACER_2D(I,J,1) < 1D0 - FD_DIFF ) ) THEN
N_OFF(I,J) = 1
ENDIF
ENDDO
ENDDO
!$OMP END PARALLEL DO
UNIT = 'none'
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 3,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, 1, I0+1,
& J0+1, 1, TRACER_2D )
! print out statistics of the ADJ / FD ratio
WRITE(6,*) '===================================================='
WRITE(6,*) ' Global validation test for values > ', FILTER
WRITE(6,*) ' MAX of global 2nd order ADJ / FD = ',
& MAXVAL(TRACER_2D(:,:,1)), MAXLOC(TRACER_2D(:,:,1))
WRITE(6,*) ' MIN of global 2nd order ADJ / FD = ',
& MINVAL(TRACER_2D(:,:,1)), MINLOC(TRACER_2D(:,:,1))
WRITE(6,*) ' Number of places where ratio off by ',FD_DIFF,' = ',
& SUM(N_OFF(:,:))
WRITE(6,*) '===================================================='
print*, ' FD2 ' , (TEMP2(IFD,JFD,LFD) - TEMP3(IFD,JFD,LFD))
& / ( 2d0 * FD_DIFF )
print*, ' FD2 from ', TEMP2(IFD,JFD,LFD) , TEMP3(IFD,JFD,LFD)
print*, ' ADJ ' , ADJ_2D(IFD,JFD,1)
!========================================
! Write 1st order FD gradient
!========================================
UNIT = 'kg/box'
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
TRACER_2D(I,J,1) =( TEMP2(I,J,LFD) - TEMP1(I,J,LFD) )
& / FD_DIFF
ENDDO
ENDDO
!$OMP END PARALLEL DO
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 4,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, 1, I0+1,
& J0+1, 1, TRACER_2D )
!========================================
! Write chekpt values
!========================================
UNIT = 'kg/box'
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
TRACER(I,J,1) = TEMP1(I,J,LFD)
TRACER(I,J,2) = TEMP2(I,J,LFD)
TRACER(I,J,3) = TEMP3(I,J,LFD)
ENDDO
ENDDO
!$OMP END PARALLEL DO
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 5,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, 3, I0+1,
& J0+1, 1, REAL(TRACER(:,:,1:3),4) )
!========================================
! Write the other 1st order FD gradient. (dkh, 10/10/08)
!========================================
UNIT = 'kg/box'
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
TRACER_2D(I,J,1) =( TEMP3(I,J,LFD) - TEMP1(I,J,LFD) )
& / ( - FD_DIFF )
ENDDO
ENDDO
!$OMP END PARALLEL DO
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 6,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, 1, I0+1,
& J0+1, 1, TRACER_2D )
! Close file
CLOSE( IU_RST )
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### MAKE_FDGLOB_FILE: wrote file' )
! Return to calling program
END SUBROUTINE MAKE_FDGLOB_FILE
!----------------------------------------------------------------------
SUBROUTINE MAKE_CHK_CON_FILE( YYYYMMDD, HHMMSS )
!
!******************************************************************************
! Subroutine MAKE_CHK_CON_FILE creates GEOS-CHEM checkpt files of tracer
! mixing ratios (v/v), and exit values in binary punch file format.
! (mak, 8/2/07)
! Arguments as Input:
! ============================================================================
! (1 ) YYYYMMDD : Year-Month-Date
! (2 ) HHMMSS : and Hour-Min-Sec for which to create a checkpoint file
!
! Passed via CMN:
! ============================================================================
! (1 ) TAU : TAU value (elapsed hours) at start of diagnostic interval
!
! Passed via ???:
! ============================================================================
! (1 ) CHECKPT : Array of quantities to be checkpointed
! dim=(IIPAR,JJPAR,LLPAR,NCHECKPT)
!
! NOTES:
! Just like MAKE_RESTART_FILE except
! - only include quantities used as input to RPMARES
! - include hhmmss in file name
! - writes files to ADJ_DIR and can zip them
! dkh, 9/30/04
! (2 ) Zip *.chk.* files one day at a time in a parallel loop. Add access
! to GET_TS_CHEM. (dkh, 11/22/04)
! (3 ) Add support for L_RECOMP option to recompute (rather than checkpoint)
! variables RP_OUT etc. (dkh, 02/09/05)
! (4 ) Now write values from CHK_STT_CON. (mak, 8/2/07)
! (5 ) Change file names to *.chk.con.* so they get cleaned out by shell scripts
! that purge *.chk.* files. (dkh, 10/10/08)
! (6 ) Update to v8 adj (dkh, 06/11/09)
!******************************************************************************
!
! References to F90 modules
USE BPCH2_MOD
USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP, ALLOC_ERR
USE DIRECTORY_ADJ_MOD, ONLY : ADJTMP_DIR
USE FILE_MOD, ONLY : IU_RST, IOERROR
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
USE LOGICAL_MOD, ONLY : LPRT
USE TIME_MOD, ONLY : EXPAND_DATE, GET_TAU
USE TRACER_MOD, ONLY : ITS_A_TAGCO_SIM
USE TRACER_MOD, ONLY : N_TRACERS
# include "CMN_SIZE" ! Size parameters
# include "comode.h" ! IGAS
! Arguments
INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS
! Local Variables
INTEGER :: I, I0, IOS, J, J0, L, N, JLOOP
INTEGER :: YYYY, MM, DD, HH, SS, ZIP_HH, AS
CHARACTER(LEN=255) :: FILENAME
! For binary punch file, version 2.0
REAL*4 :: LONRES, LATRES
REAL*4 :: CHECK_FINAL(IIPAR,JJPAR,LLPAR)
INTEGER, PARAMETER :: HALFPOLAR = 1
INTEGER, PARAMETER :: CENTER180 = 1
INTEGER :: MAX_nitr_max
INTEGER :: NSOFAR
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED = ''
CHARACTER(LEN=80) :: TITLE
REAL*4 :: nitr_max_real(IIPAR, JJPAR, LLPAR)
!=================================================================
! MAKE_CHK_CON_FILE begins here!
!=================================================================
! NEW: rename them *.chk.con.* (dkh, 10/10/08)
OUTPUT_CHECKPT_FILE = 'gctm.chk.con.YYYYMMDD.hhmm'
! Define variables for BINARY PUNCH FILE OUTPUT
TITLE = 'GEOS-CHEM Convection Checkpoint File: ' //
& 'Instantaneous Tracer Concentrations (v/v)'
CATEGORY = 'IJ-CHK-$'
LONRES = DISIZE
LATRES = DJSIZE
! Call GET_MODELNAME to return the proper model name for
! the given met data being used (bmy, 6/22/00)
MODELNAME = GET_MODELNAME()
! Get the nested-grid offsets
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
!=================================================================
! Open the checkpoint file for output -- binary punch format
!=================================================================
! Copy the output checkpoint file name into a local variable
FILENAME = TRIM( OUTPUT_CHECKPT_FILE )
! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
! Add ADJ_DIR prefix to filename
FILENAME = TRIM( ADJTMP_DIR ) // TRIM( FILENAME )
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - MAKE_CHECKPT_FILE: Writing ', a )
! Open checkpoint file for output
CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
!=================================================================
! Write each checkpointed quantity to the checkpoint file
!=================================================================
IF ( ITS_A_TAGCO_SIM() )THEN
UNIT = 'v/v'
ENDIF
DO N = 1, N_TRACERS
! Temporarily store data in CHECK_FINAL
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
CHECK_FINAL(I,J,L) = CHK_STT_CON(I,J,L,N)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, N,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLPAR, I0+1,
& J0+1, 1, CHECK_FINAL )
ENDDO
! Close file
CLOSE( IU_RST )
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### MAKE_CHK_CON_FILE: wrote file' )
! Return to calling program
END SUBROUTINE MAKE_CHK_CON_FILE
!------------------------------------------------------------------------------
SUBROUTINE READ_CHK_CON_FILE( YYYYMMDD, HHMMSS )
!
!******************************************************************************
! Subroutine READ_CHK_CON_FILE initializes GEOS-CHEM tracer concentrations
! from a checkpoint file (binary punch file format) from before convection
! (dkh, 8/30/04, mak, 8/2/07)
!
! Arguments as input:
! ============================================================================
! (1 ) YYYYMMDD : Year-Month-Day
! (2 ) HHMMSS : and Hour-Min-Sec for which to read restart file
!
! Passed via CMN:
! ============================================================================
! (1 ) TAU : TAU value (elapsed hours) at start of diagnostic interval
!
! Notes
! (1 ) Just like READ_RESTART_FILE except
! - load the variables from TRACER directly back into the CHECKPT array
! - file name now includes hhmmss
! - reads files from ADJ_DIR (and can unzip them if L_ZIP_CHECKPT)
! - removes .chk. files after reading (if L_DEL_CHECKPT)
! dkh, 9/30/04
! (2 ) Add DATE(2) and reference GET_NHMDe and GET_NHMSe to enable BATCH_ZIP
! (dkh, 11/22/04)
! (3 ) Read in CHK_STT_CON (mak, 8/2/07)
! (4 ) Rename from *.chkcon.* to *.chk.con.* (dkh, 10/10/08)
! (5 ) Delete files after they've been used. (dkh, 10/10/08)
! (6 ) Remove the IF ( N == 1 ) line. (dkh, 10/10/08)
! (7 ) Remove obsolete options (L_DEL_CHECKPT, L_ZIP_CHECKPT, L_RECOMP),
! check for aeroosl simulation (LSULF) and update names to v8 (dkh, 06/11/09)
! (8 ) Update to v8 adj (dkh, 06/11/09)
!******************************************************************************
!
! References to F90 modules
USE BPCH2_MOD, ONLY : OPEN_BPCH2_FOR_READ
USE DIRECTORY_ADJ_MOD, ONLY : ADJTMP_DIR
USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP, ALLOC_ERR
USE FILE_MOD, ONLY : IU_RST, IOERROR
USE LOGICAL_MOD, ONLY : LPRT
USE LOGICAL_ADJ_MOD, ONLY : LDEL_CHKPT
USE RESTART_MOD, ONLY : CHECK_DIMENSIONS
USE TIME_MOD, ONLY : EXPAND_DATE
USE TRACER_MOD, ONLY : N_TRACERS
USE UNIX_CMDS_MOD, ONLY : REMOVE_CMD
# include "CMN_SIZE" ! Size parameters
# include "comode.h" ! ITLOOP, IGAS
! Arguments
INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS
! Local Variables
INTEGER :: I, IOS, J, L, N, JLOOP, NN, NTL, AS
INTEGER :: NCOUNT(NNPAR)
REAL*4 :: TRACER(IIPAR,JJPAR,LLPAR)
REAL*8 :: SUMTC
CHARACTER(LEN=255) :: FILENAME
CHARACTER(LEN=255) :: REMOVE_CHK_FILE_CMD
! For binary punch file, version 2.0
INTEGER :: NI, NJ, NL
INTEGER :: IFIRST, JFIRST, LFIRST
INTEGER :: NTRACER, NSKIP
INTEGER :: HALFPOLAR, CENTER180
REAL*4 :: LONRES, LATRES
REAL*8 :: ZTAU0, ZTAU1
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED
!=================================================================
! READ_CHECKPT_FILE begins here!
!=================================================================
INPUT_CHECKPT_FILE = 'gctm.chk.con.YYYYMMDD.hhmm'
! Initialize some variables
NCOUNT(:) = 0
TRACER(:,:,:) = 0e0
!=================================================================
! Open checkpoint file and read top-of-file header
!=================================================================
! Copy input file name to a local variable
FILENAME = TRIM( INPUT_CHECKPT_FILE )
! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
! Add ADJ_DIR prefix to name
FILENAME = TRIM( ADJTMP_DIR ) // TRIM( FILENAME )
! Echo some input to the screen
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
WRITE( 6, '(a,/)' ) 'C H E C K P T F I L E I N P U T'
! Remove obsolete option
! ! Unzip checkpt file
! IF ( L_ZIP_CHECKPT ) THEN
! UNZIP_FILE_CMD = TRIM( GUNZIP_CMD ) // ' ' //
! & TRIM( FILENAME ) // ZIP_SUFFIX
! CALL SYSTEM( TRIM( UNZIP_FILE_CMD ) )
! WRITE( 6, 99 ) TRIM( UNZIP_FILE_CMD )
! 99 FORMAT( ' - READ_CHECKPT_FILE: Executing: ',a )
! ENDIF
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - READ_CHECKPT_FILE: Reading ', a )
! Open the binary punch file for input
CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!=================================================================
! Read checkpointed variables
!=================================================================
! Read the values of CHK_STT_CON
!DO N = 1, NOBS!+1
DO N = 1, N_TRACERS
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) EXIT
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:7' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:8' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:9' )
!==============================================================
! Assign data from the TRACER array to the STT array.
!==============================================================
! Only process checkpoint data (i.e. mixing ratio)
IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
! Make sure array dimensions are of global size
! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
!print*, 'before check_dimensions ni, nj, nl are', ni, nj, nl
CALL CHECK_DIMENSIONS( NI, NJ, NL )
! Remove (dkh, 10/10/08)
! IF ( N == 1) THEN
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
CHK_STT_CON(I,J,L,N) = TRACER(I,J,L)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
!ENDIF
ENDIF !category is checkpoint
ENDDO
! Close file
CLOSE( IU_RST )
555 CONTINUE
! Remove files if L_CHK_DEL = TRUE
IF ( LDEL_CHKPT ) THEN
REMOVE_CHK_FILE_CMD = TRIM ( REMOVE_CMD ) // ' ' //
& TRIM ( FILENAME )
CALL SYSTEM( TRIM( REMOVE_CHK_FILE_CMD ) )
WRITE( 6, 102 ) TRIM( REMOVE_CHK_FILE_CMD )
102 FORMAT( ' - READ_CHECKPT_FILE: Executing: ',a )
ENDIF
! Remove obsolete (dkh, 06/11/09)
! ! Zip the .chk. file if it hasn't been deleted and zipping
! ! is requested
! IF ( L_ZIP_CHECKPT .AND. (.NOT. L_DEL_CHECKPT) ) THEN
! CALL BATCH_ZIP( YYYYMMDD, HHMMSS, 'chk', -1 )
! ENDIF
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### READ_CHK_CON_FILE: read file' )
! Return to calling program
END SUBROUTINE READ_CHK_CON_FILE
!-----------------------------------------------------------------------
SUBROUTINE MAKE_CHK_DYN_FILE( YYYYMMDD, HHMMSS )
!
!******************************************************************************
! Subroutine MAKE_CHK_DYN_FILE creates GEOS-CHEM checkpt files
! at the dynamic time step. (dkh, 02/01/09)
!
! Arguments as Input:
! ============================================================================
! (1 ) YYYYMMDD : Year-Month-Date
! (2 ) HHMMSS : and Hour-Min-Sec for which to create a checkpoint file
!
! Passed via CMN:
! ============================================================================
! (1 ) TAU : TAU value (elapsed hours) at start of diagnostic interval
!
! Passed via module variables
! ============================================================================
! (1 ) to add....
!
!
! NOTES:
! Just like MAKE_CHK_FILE except
!
! (1 ) Now checkpoint T_DAY, T_15_AVG (dkh, 01/23/10)
!******************************************************************************
!
! References to F90 modules
USE BPCH2_MOD, ONLY : BPCH3, GET_MODELNAME
USE BPCH2_MOD, ONLY : BPCH2, OPEN_BPCH2_FOR_WRITE
USE DIRECTORY_ADJ_MOD, ONLY : ADJTMP_DIR
USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP, ALLOC_ERR
USE FILE_MOD, ONLY : IU_RST, IOERROR
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
USE MEGAN_MOD, ONLY : GET_T_DAY
USE MEGAN_MOD, ONLY : GET_T_15_AVG
USE MEGAN_MOD, ONLY : DAY_DIM
USE MEGAN_MOD, ONLY : CHK_T_15_AVG
USE MEGAN_MOD, ONLY : CHK_T_DAY
USE TIME_MOD, ONLY : EXPAND_DATE, GET_TAU
USE TIME_MOD, ONLY : GET_TS_CONV
USE TIME_MOD, ONLY : ITS_TIME_FOR_A3_ADJ
USE TIME_MOD, ONLY : ITS_TIME_TO_CHK_T_15_AVG
USE LOGICAL_MOD, ONLY : LWETD, LCONV
USE LOGICAL_MOD, ONLY : LPRT
USE LOGICAL_MOD, ONLY : LMEGAN
USE LOGICAL_ADJ_MOD, ONLY : LAERO_THERM
USE TRACER_MOD, ONLY : ITS_A_FULLCHEM_SIM
USE TRACER_MOD, ONLY : ITS_AN_AEROSOL_SIM
# include "CMN_SIZE" ! Size parameters
# include "comode.h" ! IGAS
! Arguments
INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS
! Local Variables
INTEGER :: I, I0, IOS, J, J0, L, N, JLOOP
INTEGER :: YYYY, MM, DD, HH, SS, ZIP_HH, AS
CHARACTER(LEN=255) :: FILENAME
! For binary punch file, version 2.0
REAL*4 :: LONRES, LATRES
REAL*4 :: CHECK_FINAL(IIPAR,JJPAR,LLPAR)
INTEGER, PARAMETER :: HALFPOLAR = 1
INTEGER, PARAMETER :: CENTER180 = 1
INTEGER :: MAX_nitr_max
INTEGER :: NSOFAR
INTEGER :: NS
INTEGER :: NSTEP
INTEGER :: CONVDT
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED = ''
CHARACTER(LEN=80) :: TITLE
REAL*4 :: nitr_max_real(IIPAR, JJPAR, LLPAR)
!=================================================================
! MAKE_CHK_DYN_FILE begins here!
!=================================================================
OUTPUT_CHECKPT_FILE = 'gctm.chk.dyn.YYYYMMDD.hhmm'
! Define variables for BINARY PUNCH FILE OUTPUT
TITLE = 'GEOS-CHEM Convection Checkpoint File'
CATEGORY = 'IJ-CHKD$'
LONRES = DISIZE
LATRES = DJSIZE
! Call GET_MODELNAME to return the proper model name for
! the given met data being used (bmy, 6/22/00)
MODELNAME = GET_MODELNAME()
! Get the nested-grid offsets
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
!=================================================================
! Open the checkpoint file for output -- binary punch format
!=================================================================
! Copy the output checkpoint file name into a local variable
FILENAME = TRIM( OUTPUT_CHECKPT_FILE )
! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
! Add ADJ_DIR prefix to filename
FILENAME = TRIM( ADJTMP_DIR ) // TRIM( FILENAME )
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - MAKE_CHK_DYN_FILE: Writing ', a )
! Open checkpoint file for output
CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
! Initialize NSOFAR
NSOFAR = 0
!=================================================================
! Write each checkpointed quantity to the checkpoint file
!=================================================================
Unit = 'hPa'
! Write the surface pressures before and after transport (IIPAR,JJPAR,2)
CALL BPCH3( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, NSOFAR + 1,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, 2, I0+1,
& J0+1, 1, CHK_PSC)
! Set NSOFAR
NSOFAR = NSOFAR + 1
IF ( LWETD .and.
& ( ITS_AN_AEROSOL_SIM() .or. ITS_A_FULLCHEM_SIM() ) ) THEN
! H2O2s
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 1 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLTROP, I0+1,
& J0+1, 1, WETD_CHK_H2O2s )
! SO2s
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 2 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLTROP, I0+1,
& J0+1, 1, WETD_CHK_SO2s )
! SO4
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 3 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLTROP, I0+1,
& J0+1, 1, WETD_CHK_SO4 )
! SO2
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 4 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLTROP, I0+1,
& J0+1, 1, WETD_CHK_SO2 )
NSOFAR = NSOFAR + 4
ENDIF ! LWETD
! Write the concentrations used in convection
IF ( LCONV .AND.
& ( ITS_AN_AEROSOL_SIM() .or. ITS_A_FULLCHEM_SIM() ) ) THEN
UNIT = 'kg'
! H2O2s
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 1 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLTROP, I0+1,
& J0+1, 1, CONV_CHK_H2O2s )
! SO2s
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 2 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLTROP, I0+1,
& J0+1, 1, CONV_CHK_SO2s )
! Update NSOFAR
NSOFAR = NSOFAR + 2
!>>>
! Now include adjoint of F (dkh, 10/03/08)
! Calculate NS (See DO_CONVECTION, NSTEP or NFCLDMX, NS
CONVDT = GET_TS_CONV() * 60d0
NSTEP = CONVDT / 300
NSTEP = MAX( NSTEP, 1 )
DO NS = 1, NSTEP
! QS_SO2 in NFCLDMX
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLPAR, I0+1,
& J0+1, 1, QC_SO2_CHK(:,:,:,NS) )
! Update NSOFAR
NSOFAR = NSOFAR + 1
ENDDO
! need this? i don't think so...
! Update NSOFAR
!NSOFAR = NSOFAR + 1
!<<<
ENDIF ! LCONV
! Now checkpoint T_15_AVG and T_DAY so that we can use MEGAN emissions (dkh, 01/22/10)
IF ( LMEGAN ) THEN
! Only need to do this if it's a new day
IF ( ITS_TIME_TO_CHK_T_15_AVG() ) THEN
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO J = 1, JJPAR
DO I = 1, IIPAR
! Get the values from megan_mod
CHK_T_15_AVG(I,J,1) = REAL(GET_T_15_AVG(I,J),4)
ENDDO
ENDDO
!$OMP END PARALLEL DO
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 1 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, 1, I0+1,
& J0+1, 1, CHK_T_15_AVG )
! Set NSOFAR
NSOFAR = NSOFAR + 1
ENDIF
! Only need to do this if it's time for more A3
IF ( ITS_TIME_FOR_A3_ADJ( ) ) THEN
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, DAY_DIM
DO J = 1, JJPAR
DO I = 1, IIPAR
! Get the values from megan_mod
CHK_T_DAY(I,J,L) = REAL(GET_T_DAY(I,J,L),4)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 1 + NSOFAR,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, DAY_DIM, I0+1,
& J0+1, 1, CHK_T_DAY )
! Set NSOFAR
NSOFAR = NSOFAR + 1
ENDIF
ENDIF
! Close file
CLOSE( IU_RST )
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### MAKE_CHK_DYN_FILE: wrote file' )
! Return to calling program
END SUBROUTINE MAKE_CHK_DYN_FILE
!------------------------------------------------------------------------------
SUBROUTINE READ_CHK_DYN_FILE( YYYYMMDD, HHMMSS )
!
!******************************************************************************
! Subroutine READ_CHK_DYN_FILE reads values checkpointed at the dynamic time
! step (dkh, 02/01/09)
!
! Arguments as input:
! ============================================================================
! (1 ) YYYYMMDD : Year-Month-Day
! (2 ) HHMMSS : and Hour-Min-Sec for which to read restart file
!
! Passed via CMN:
! ============================================================================
! (1 ) TAU : TAU value (elapsed hours) at start of diagnostic interval
!
! Notes
! (1 ) Just like READ_CHK_DYN_FILE
! (2 ) Add T_DAY and T_15_AVG (dkh, 01/23/10)
!
!******************************************************************************
!
! References to F90 modules
USE BPCH2_MOD, ONLY : OPEN_BPCH2_FOR_READ
USE DIRECTORY_ADJ_MOD, ONLY : ADJTMP_DIR
USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP, ALLOC_ERR
USE FILE_MOD, ONLY : IU_RST, IOERROR
USE LOGICAL_MOD, ONLY : LWETD, LCONV
USE LOGICAL_MOD, ONLY : LPRT
USE LOGICAL_MOD, ONLY : LMEGAN
USE LOGICAL_ADJ_MOD, ONLY : LAERO_THERM
USE LOGICAL_ADJ_MOD, ONLY : LDEL_CHKPT
USE MEGAN_MOD, ONLY : CHK_T_15_AVG
USE MEGAN_MOD, ONLY : CHK_T_DAY
USE RESTART_MOD, ONLY : CHECK_DIMENSIONS
USE TIME_MOD, ONLY : EXPAND_DATE
USE TIME_MOD, ONLY : GET_TS_CONV
USE TIME_MOD, ONLY : ITS_TIME_TO_GET_T_15_AVG
USE TIME_MOD, ONLY : ITS_TIME_TO_GET_T_DAY
USE TRACER_MOD, ONLY : ITS_A_FULLCHEM_SIM
USE TRACER_MOD, ONLY : ITS_AN_AEROSOL_SIM
USE UNIX_CMDS_MOD, ONLY : REMOVE_CMD
# include "CMN_SIZE" ! Size parameters
# include "comode.h" ! ITLOOP, IGAS
! Arguments
INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS
! Local Variables
INTEGER :: I, IOS, J, L, N, JLOOP, NN, NTL, AS
INTEGER :: NCOUNT(NNPAR)
REAL*4 :: TRACER(IIPAR,JJPAR,LLPAR)
REAL*8 :: SUMTC
CHARACTER(LEN=255) :: FILENAME
CHARACTER(LEN=255) :: UNZIP_FILE_CMD
CHARACTER(LEN=255) :: REMOVE_CHK_FILE_CMD
! For binary punch file, version 2.0
INTEGER :: NI, NJ, NL
INTEGER :: NS
INTEGER :: NSTEP
INTEGER :: CONVDT
INTEGER :: IFIRST, JFIRST, LFIRST
INTEGER :: NTRACER, NSKIP
INTEGER :: HALFPOLAR, CENTER180
REAL*4 :: LONRES, LATRES
REAL*8 :: ZTAU0, ZTAU1
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED
!=================================================================
! READ_CHECKPT_FILE begins here!
!=================================================================
INPUT_CHECKPT_FILE = 'gctm.chk.dyn.YYYYMMDD.hhmm'
! Initialize some variables
NCOUNT(:) = 0
TRACER(:,:,:) = 0e0
!=================================================================
! Open checkpoint file and read top-of-file header
!=================================================================
! Copy input file name to a local variable
FILENAME = TRIM( INPUT_CHECKPT_FILE )
! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
! Add ADJ_DIR prefix to name
FILENAME = TRIM( ADJTMP_DIR ) // TRIM( FILENAME )
! Echo some input to the screen
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
WRITE( 6, '(a,/)' ) 'C H E C K P T F I L E I N P U T'
! Remove obsolete options (dkh, 06/11/09)
! ! Unzip checkpt file
! IF ( L_ZIP_CHECKPT ) THEN
! UNZIP_FILE_CMD = TRIM( GUNZIP_CMD ) // ' ' //
! & TRIM( FILENAME ) // ZIP_SUFFIX
! CALL SYSTEM( TRIM( UNZIP_FILE_CMD ) )
! WRITE( 6, 99 ) TRIM( UNZIP_FILE_CMD )
! 99 FORMAT( ' - READ_CHK_DYN_FILE: Executing: ',a )
! ENDIF
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - READ_CHK_DYN_FILE: Reading ', a )
! Open the binary punch file for input
CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!=================================================================
! Read checkpointed variables
!=================================================================
! Read in surface pressures
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 556
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:10d' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:11d' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( CHK_PSC(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:12d' )
! Read the values for WETDEP
IF ( LWETD .and.
& ( ITS_AN_AEROSOL_SIM() .or. ITS_A_FULLCHEM_SIM() ) ) THEN
! Read the values of WETD_CHK_H2O2s
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 556
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:33d' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:34d' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( WETD_CHK_H2O2s(I,J,L), I=1,NI ), J=1,NJ ),
& L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:35d' )
! Read the values of WETD_CHK_SO2s
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 556
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:36d' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:37d' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( WETD_CHK_SO2s(I,J,L), I=1,NI ), J=1,NJ ),
& L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:38d' )
! Read the values of WETD_CHK_SO4
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 556
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:39d' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:40d' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( WETD_CHK_SO4(I,J,L), I=1,NI ), J=1,NJ ),
& L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:41d' )
! Read the values of WETD_CHK_SO2
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 556
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:42d' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:43d' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( WETD_CHK_SO2(I,J,L), I=1,NI ), J=1,NJ ),
& L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:44d' )
ENDIF ! LWETD
! Read the values for CONVECTION
! Replace NSRCX (dkh, 06/11/09)
!IF ( LCONV .AND. ( NSRCX == 3 .or. NSRCX == 10 ) ) THEN
IF ( LCONV .AND.
& ( ITS_AN_AEROSOL_SIM() .or. ITS_A_FULLCHEM_SIM() ) ) THEN
! Read the values of CONV_CHK_H2O2s
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 556
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:51d' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:52d' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( CONV_CHK_H2O2s(I,J,L), I=1,NI ), J=1,NJ ),
& L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:53d' )
! Read the values of CONV_CHK
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 556
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:54d' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:55d' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( CONV_CHK_SO2s(I,J,L), I=1,NI ), J=1,NJ ),
& L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:56d' )
!>>>
! Now include adjoint of F (dkh, 10/03/08)
! Calculate NS (See DO_CONVECTION, NSTEP or NFCLDMX, NS
CONVDT = GET_TS_CONV() * 60d0
NSTEP = CONVDT / 300
NSTEP = MAX( NSTEP, 1 )
DO NS = 1, NSTEP
! Read the values of QC_SO2_CHK
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 556
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:63d' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:64d' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( QC_SO2_CHK(I,J,L,NS), I=1,NI ), J=1,NJ ),
& L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:65d' )
ENDDO ! NS
!<<<
ENDIF ! LCONV
IF ( LMEGAN ) THEN
! adjoint equivalent of ITS_TIME_TO_CHK_T_15_AVG
IF ( ITS_TIME_TO_GET_T_15_AVG() ) THEN
! read in T_15_AVG
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 556
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:63' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:64' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ),
& L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:59' )
CHK_T_15_AVG(:,:,1) = TRACER(:,:,1)
ENDIF
IF ( ITS_TIME_TO_GET_T_DAY( ) ) THEN
! read in T_DAY
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so exit
IF ( IOS < 0 ) GOTO 556
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:63' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_checkpt_file:64' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ),
& L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_checkpt_file:59' )
CHK_T_DAY(:,:,:) = TRACER(:,:,:)
ENDIF
ENDIF
556 CONTINUE
IF ( LDEL_CHKPT ) THEN
REMOVE_CHK_FILE_CMD = TRIM ( REMOVE_CMD ) // ' ' //
& TRIM ( FILENAME )
CALL SYSTEM( TRIM( REMOVE_CHK_FILE_CMD ) )
WRITE( 6, 102 ) TRIM( REMOVE_CHK_FILE_CMD )
102 FORMAT( ' - READ_CHK_DYN_FILE: Executing: ',a )
ENDIF
! Remove obsolete (dkh, 06/11/09)
! ! Zip the .chk. file if it hasn't been deleted and zipping
! ! is requested
! IF ( L_ZIP_CHECKPT .AND. (.NOT. L_DEL_CHECKPT) ) THEN
! CALL BATCH_ZIP( YYYYMMDD, HHMMSS, 'chk', -1 )
! ENDIF
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### READ_CHK_DYN_FILE: read file' )
! Return to calling program
END SUBROUTINE READ_CHK_DYN_FILE
!-----------------------------------------------------------------------
SUBROUTINE MAKE_ADJ_FILE( YYYYMMDD, HHMMSS )
!
!******************************************************************************
! Subroutine MAKE_ADJ_FILE creates a binary file of STT_ADJ
! (dkh, 10/03/04)
!
! Arguments as Input:
! ============================================================================
! (1 ) YYYYMMDD : Year-Month-Date
! (2 ) HHMMSS : and Hour-Min-Sec for which to create an adjoint file
!
! Passed via CMN_ADJ
! ============================================================================
! (1 ) ADJ_STT : Array of quantities to be checkpointed
! dim=(IIPAR,JJPAR,LLPAR,NADJ)
!
! NOTES:
! (1 ) Now write out adjoint of concentration scaling factors instead of
! adjoint of concentrations. This requires multiplying by STT. This
! routine is now called before chemistry and transport so that
! we can resale by the STT that was checkpointed after chemistry
! and transport in the forward run. STT is in [kg/box] at this point.
! Also, only write out LLADJKEEP levels and NNADJKEEP species
! (dkh, 11/22/06)
! (2 ) Update for GCv8 (dkh, 02/15/10)
!******************************************************************************
!
! References to F90 modules
USE ADJ_ARRAYS_MOD, ONLY : STT_ADJ
USE BPCH2_MOD
USE DIRECTORY_ADJ_MOD, ONLY : DIAGADJ_DIR
USE ERROR_MOD, ONLY : DEBUG_MSG
USE FILE_MOD, ONLY : IU_RST, IOERROR
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
USE LOGICAL_MOD, ONLY : LPRT
USE LOGICAL_ADJ_MOD, ONLY : LTRAJ_SCALE
USE TIME_MOD, ONLY : EXPAND_DATE, GET_TAU
USE TRACER_MOD, ONLY : N_TRACERS
USE TRACER_MOD, ONLY : STT
# include "CMN_SIZE" ! Size parameters
! Arguments
INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS
! Local Variables
INTEGER :: I, I0, IOS, J, J0, L, N
INTEGER :: YYYY, MM, DD, HH, SS
REAL*4 :: TRACER(IIPAR,JJPAR,LLPAR)
CHARACTER(LEN=255) :: FILENAME
! For binary punch file, version 2.0
REAL*4 :: LONRES, LATRES
INTEGER, PARAMETER :: HALFPOLAR = 1
INTEGER, PARAMETER :: CENTER180 = 1
CHARACTER(LEN=40) :: OUTPUT_ADJ_FILE
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED = ''
CHARACTER(LEN=80) :: TITLE
! Should make these user defined in input.gcadj
!! Parameter
INTEGER, PARAMETER :: LLADJKEEP = LLPAR
!INTEGER, PARAMETER :: NNADJKEEP = N_TRACERS
! Now specify this input.gcadj
!LOGICAL, PARAMETER :: LTRAJ_SCALE = .TRUE.
!=================================================================
! MAKE_ADJ_FILE begins here!
!=================================================================
! Hardwire output file for now
OUTPUT_ADJ_FILE = 'gctm.adj.YYYYMMDD.hhmm'
! Define variables for BINARY PUNCH FILE OUTPUT
TITLE = 'GEOS-CHEM ADJ File: ' //
& 'Instantaneous Adjoint Concentrations '
CATEGORY = 'IJ-ADJ-$'
LONRES = DISIZE
LATRES = DJSIZE
! Call GET_MODELNAME to return the proper model name for
! the given met data being used (bmy, 6/22/00)
MODELNAME = GET_MODELNAME()
! Get the nested-grid offsets
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
!=================================================================
! Open the adjoint file for output -- binary punch format
!=================================================================
! Copy the output observation file name into a local variable
FILENAME = TRIM( OUTPUT_ADJ_FILE )
! Append the iteration number suffix to the file name
CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
! Add the ADJ_DIR prefix to the file name
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - MAKE_ADJ_FILE: Writing ', a )
! Open checkpoint file for output
CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
!=================================================================
! Write each observed quantity to the observation file
!=================================================================
DO N = 1, N_TRACERS
! For saving out semilog sensitivities dJ/dSTT * STT = dJ/dln(STT)
IF ( LTRAJ_SCALE ) THEN
UNIT = 'J'
!Temporarily store quantities in the TRACER array
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLADJKEEP
DO J = 1, JJPAR
DO I = 1, IIPAR
! Now multiply by concentrations so that we write
! the adjoint of concentration scaling factors
! BUG FIX: it's better to use CHK_STT (dkh, 07/30/10)
!TRACER(I,J,L) = STT_ADJ (I,J,L,N) * STT(I,J,L,N)
TRACER(I,J,L) = STT_ADJ (I,J,L,N) * CHK_STT(I,J,L,N)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
! For saving out sensitivities dJ/dSTT
ELSE
UNIT = 'J/STT'
!Temporarily store quantities in the TRACER array
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLADJKEEP
DO J = 1, JJPAR
DO I = 1, IIPAR
! Now multiply by concentrations so that we write
! the adjoint of concentration scaling factors
TRACER(I,J,L) = STT_ADJ (I,J,L,N)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, N,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLADJKEEP, I0+1,
& J0+1, 1, TRACER(:,:,1:LLADJKEEP) )
ENDDO
! Close file
CLOSE( IU_RST )
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### MAKE_ADJ_FILE: wrote file' )
! Return to calling program
END SUBROUTINE MAKE_ADJ_FILE
!------------------------------------------------------------------------------
SUBROUTINE MAKE_EMS_ADJ_FILE( )
!
!******************************************************************************
! Subroutine MAKE_EMS_ADJ_FILE creates a binary file of EMS_ADJ (dkh, 02/17/11)
!
! Module Variable as Input:
! ============================================================================
! (1 ) N_CALC : Current iteration number
! (2 ) EMS_ADJ : Array of adjoint gradients to be written
!
! NOTES:
! (1 ) Based on MAKE_GDT_FILE
!
!******************************************************************************
!
! References to F90 modules
USE ADJ_ARRAYS_MOD, ONLY : EMS_ADJ
USE ADJ_ARRAYS_MOD, ONLY : NNEMS, MMSCL
USE ADJ_ARRAYS_MOD, ONLY : N_CALC
USE ADJ_ARRAYS_MOD, ONLY : EXPAND_NAME
USE ADJ_ARRAYS_MOD, ONLY : COST_FUNC
USE BPCH2_MOD
USE DIRECTORY_ADJ_MOD, ONLY : DIAGADJ_DIR
USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP
USE FILE_MOD, ONLY : IU_RST, IOERROR
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
USE LOGICAL_ADJ_MOD, ONLY : LICS, LADJ_EMS
USE LOGICAL_MOD, ONLY : LPRT
USE TIME_MOD, ONLY : EXPAND_DATE, GET_TAU
USE TIME_MOD, ONLY : GET_CT_EMIS
# include "CMN_SIZE" ! Size parameters
# include "comode.h" ! NEMIS(NCS)
! Local Variables
INTEGER :: I, I0, IOS, J, J0, L, M, N
INTEGER :: YYYY, MM, DD, HH, SS
CHARACTER(LEN=255) :: FILENAME
! For binary punch file, version 2.0
REAL*4 :: LONRES, LATRES
INTEGER, PARAMETER :: HALFPOLAR = 1
INTEGER, PARAMETER :: CENTER180 = 1
CHARACTER(LEN=20) :: OUTPUT_FILE
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED = ''
CHARACTER(LEN=80) :: TITLE
!=================================================================
! MAKE_EMS_ADJ_FILE begins here!
!=================================================================
! Hardwire output file for now
OUTPUT_FILE = 'ems.adj.NN'
! Define variables for BINARY PUNCH FILE OUTPUT
TITLE = 'GEOS-CHEM ADJ File: ' //
& 'Emissions adjoints '
LONRES = DISIZE
LATRES = DJSIZE
! Call GET_MODELNAME to return the proper model name for
! the given met data being used (bmy, 6/22/00)
MODELNAME = GET_MODELNAME()
! Get the nested-grid offsets
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
!=================================================================
! Open the adjoint file for output -- binary punch format
!=================================================================
! Copy the output observation file name into a local variable
FILENAME = TRIM( OUTPUT_FILE )
! Append the iteration number suffix to the file name
CALL EXPAND_NAME( FILENAME, N_CALC )
! Add the DIAGADJ_DIR prefix to the file name
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - MAKE_EMS_ADJ_FILE: Writing ', a )
! Open checkpoint file for output
CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
! Set CATEGORY and UNIT
CATEGORY = 'dJ_dEMS'
UNIT = 'J/kg'
! dkh debug
!print*, ' CT_EMIS = ', GET_CT_EMIS()
! Convert units from J / (kg / box / timestep) to J / (kg / box)
EMS_ADJ(:,:,:,:) = EMS_ADJ(:,:,:,:) / GET_CT_EMIS()
!=================================================================
! Write each observed quantity to the observation file
!=================================================================
DO N = 1, NNEMS
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, N,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, MMSCL, I0+1,
& J0+1, 1, REAL(EMS_ADJ(:,:,:,N),4) )
ENDDO
! Close file
CLOSE( IU_RST )
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### MAKE_EMS_ADJ_FILE: wrote file' )
! Return to calling program
END SUBROUTINE MAKE_EMS_ADJ_FILE
!------------------------------------------------------------------------------
SUBROUTINE MAKE_PROD_GDT_FILE( )
!
!******************************************************************************
! Subroutine MAKE_PROD_GDT_FILE (GDT=SF_ADJ) creates a binary file of
! PROD_SF_ADJ (hml, 07/26/11, adj32_025)
!
! Module Variable as Input:
! ============================================================================
! (1 ) N_CALC : Current iteration number
! (2 ) PROD_ADJ : Array of adjoint gradients to be written
!
! NOTES:
! (1 ) Based on MAKE_EMS_ADJ_FILE & MAKE_ADJ_FILE
!
!******************************************************************************
!
! References to F90 modules
USE ADJ_ARRAYS_MOD, ONLY : PROD_SF_ADJ
USE ADJ_ARRAYS_MOD, ONLY : NSTPL, MMSCL
USE ADJ_ARRAYS_MOD, ONLY : N_CALC
USE ADJ_ARRAYS_MOD, ONLY : EXPAND_NAME
USE ADJ_ARRAYS_MOD, ONLY : COST_FUNC
USE BPCH2_MOD
USE DIRECTORY_ADJ_MOD, ONLY : DIAGADJ_DIR
USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP
USE FILE_MOD, ONLY : IU_RST, IOERROR
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
USE LOGICAL_MOD, ONLY : LPRT
USE TIME_MOD, ONLY : EXPAND_DATE, GET_TAU
# include "CMN_SIZE" ! Size parameters
# include "comode.h" ! NEMIS(NCS)
! Local Variables
INTEGER :: I, I0, IOS, J, J0, L, M, N
INTEGER :: YYYY, MM, DD, HH, SS
CHARACTER(LEN=255) :: FILENAME
! For binary punch file, version 2.0
REAL*4 :: LONRES, LATRES
INTEGER, PARAMETER :: HALFPOLAR = 1
INTEGER, PARAMETER :: CENTER180 = 1
CHARACTER(LEN=40) :: OUTPUT_FILE
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED = ''
CHARACTER(LEN=80) :: TITLE
!=================================================================
! MAKE_PROD_ADJ_FILE begins here!
!=================================================================
! Hardwire output file for now
OUTPUT_FILE = 'prod.sf.adj.NN'
! Define variables for BINARY PUNCH FILE OUTPUT
TITLE = 'GEOS-CHEM ADJ File: ' //
& 'Stratospheric Production Scaling Factor Adjoints '
UNIT = 'J'
!CATEGORY = 'dJ_dPRSF'
CATEGORY = 'IJ-GDP-$'
LONRES = DISIZE
LATRES = DJSIZE
! Call GET_MODELNAME to return the proper model name for
! the given met data being used (bmy, 6/22/00)
MODELNAME = GET_MODELNAME()
! Get the nested-grid offsets
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
!=================================================================
! Open the adjoint file for output -- binary punch format
!=================================================================
! Copy the output observation file name into a local variable
FILENAME = TRIM( OUTPUT_FILE )
! Append the iteration number suffix to the file name
CALL EXPAND_NAME( FILENAME, N_CALC )
! Add the DIAGADJ_DIR prefix to the file name
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - MAKE_PROD_GDT_FILE: Writing ', a )
! Open checkpoint file for output
CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
!=================================================================
! Write each observed quantity to the observation file
!=================================================================
DO N = 1, NSTPL
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, N,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, MMSCL, I0+1,
& J0+1, 1, REAL(PROD_SF_ADJ(:,:,1,N),4))
ENDDO
! Close file
CLOSE( IU_RST )
!### Debug
IF ( LPRT ) CALL DEBUG_MSG(
& '### MAKE_PROD_GDT_FILE: wrote file' )
! Return to calling program
END SUBROUTINE MAKE_PROD_GDT_FILE
!------------------------------------------------------------------------------
!
SUBROUTINE MAKE_LOSS_GDT_FILE( )
!
!******************************************************************************
! Subroutine MAKE_LOSS_GDT_FILE (GDT = SF_ADJ) creates a binary file of
! LOSS_SF_ADJ: stratospheric loss rate scaling factor adjoint
! (hml, 07/26/11, adj32_025)
!
! Module Variable as Input:
! ============================================================================
! (1 ) N_CALC : Current iteration number
! (2 ) LOSS_ADJ : Array of adjoint gradients to be written
!
!
! NOTES:
! (1 ) Based on MAKE_EMS_ADJ_FILE & MAKE_ADJ_FILE
!
!******************************************************************************
!
! References to F90 modules
USE ADJ_ARRAYS_MOD, ONLY : LOSS_SF_ADJ
USE ADJ_ARRAYS_MOD, ONLY : NSTPL, MMSCL
USE ADJ_ARRAYS_MOD, ONLY : N_CALC
USE ADJ_ARRAYS_MOD, ONLY : EXPAND_NAME
USE ADJ_ARRAYS_MOD, ONLY : COST_FUNC
USE BPCH2_MOD
USE DIRECTORY_ADJ_MOD, ONLY : DIAGADJ_DIR
USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP
USE FILE_MOD, ONLY : IU_RST, IOERROR
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
USE LOGICAL_MOD, ONLY : LPRT
USE TIME_MOD, ONLY : EXPAND_DATE, GET_TAU
# include "CMN_SIZE" ! Size parameters
# include "comode.h" ! NEMIS(NCS)
! Local Variables
INTEGER :: I, I0, IOS, J, J0, L, M, N
INTEGER :: YYYY, MM, DD, HH, SS
CHARACTER(LEN=255) :: FILENAME
! For binary punch file, version 2.0
REAL*4 :: LONRES, LATRES
INTEGER, PARAMETER :: HALFPOLAR = 1
INTEGER, PARAMETER :: CENTER180 = 1
CHARACTER(LEN=40) :: OUTPUT_FILE
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED = ''
CHARACTER(LEN=80) :: TITLE
!=================================================================
! MAKE_LOSS_SF_ADJ_FILE begins here!
!=================================================================
! Hardwire output file for now
OUTPUT_FILE = 'loss.sf.adj.NN'
! Define variables for BINARY PUNCH FILE OUTPUT
TITLE = 'GEOS-CHEM ADJ File: ' //
& 'Stratospheric Loss Scaling Factor Adjoints '
!CATEGORY = 'dJ_dLSSF'
CATEGORY = 'IJ-GDL-$'
UNIT = 'J'
LONRES = DISIZE
LATRES = DJSIZE
! Call GET_MODELNAME to return the proper model name for
! the given met data being used (bmy, 6/22/00)
MODELNAME = GET_MODELNAME()
! Get the nested-grid offsets
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
!=================================================================
! Open the adjoint file for output -- binary punch format
!=================================================================
! Copy the output observation file name into a local variable
FILENAME = TRIM( OUTPUT_FILE )
! Append the iteration number suffix to the file name
CALL EXPAND_NAME( FILENAME, N_CALC )
! Add the DIAGADJ_DIR prefix to the file name
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - MAKE_LOSS_GDT_FILE: Writing ', a )
! Open checkpoint file for output
CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
!=================================================================
! Write each observed quantity to the observation file
!=================================================================
DO N = 1, NSTPL
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, N,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, MMSCL, I0+1,
& J0+1, 1, REAL(LOSS_SF_ADJ(:,:,1,N),4))
ENDDO
! Close file
CLOSE( IU_RST )
!### Debug
IF ( LPRT ) CALL DEBUG_MSG(
& '### MAKE_LOSS_GDT_FILE: wrote file' )
! Return to calling program
END SUBROUTINE MAKE_LOSS_GDT_FILE
!------------------------------------------------------------------------------
SUBROUTINE MAKE_SO2ac_FILE( ESO2_ac, MONTH )
!
!******************************************************************************
! Subroutine MAKE_SO2ac_FILE creates GEOS-CHEM checkpt files of SO2
! emissions from aircraft.
!
! Arguments as Input:
! ============================================================================
! (1 ) ESO2_ac : Current monthly aircraft SO2 emissions [kg SO2/box/s]
! (2 ) MONTH : Current month
!
! NOTES:
!
!******************************************************************************
!
! References to F90 modules
USE BPCH2_MOD
USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP, ALLOC_ERR
USE DIRECTORY_ADJ_MOD, ONLY : ADJTMP_DIR
USE FILE_MOD, ONLY : IU_RST, IOERROR
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
USE LOGICAL_MOD, ONLY : LPRT
USE TIME_MOD, ONLY : EXPAND_DATE, GET_TAU
USE TIME_MOD, ONLY : GET_NYMD, GET_NHMS
# include "CMN_SIZE" ! Size parameters
! Arguments
CHARACTER(LEN=3), INTENT(IN) :: MONTH
REAL*8, INTENT(IN) :: ESO2_ac(IIPAR,JJPAR,LLPAR)
! Local Variables
INTEGER :: I, I0, IOS, J, J0, L
INTEGER :: YYYY, MM, DD, HH, SS, ZIP_HH, AS
CHARACTER(LEN=255) :: FILENAME
! For binary punch file, version 2.0
REAL*4 :: LONRES, LATRES
INTEGER, PARAMETER :: HALFPOLAR = 1
INTEGER, PARAMETER :: CENTER180 = 1
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED = ''
CHARACTER(LEN=80) :: TITLE
!=================================================================
! MAKE_SO2ac_FILE begins here!
!=================================================================
! NEW: rename them *.chk.con.* (dkh, 10/10/08)
OUTPUT_CHECKPT_FILE = 'gctm.chk.SO2ac.YYYY.' // TRIM( MONTH )
! Define variables for BINARY PUNCH FILE OUTPUT
TITLE = 'GEOS-CHEM SO2 ac Checkpoint File '
CATEGORY = 'IJ-CHK-$'
LONRES = DISIZE
LATRES = DJSIZE
! Call GET_MODELNAME to return the proper model name for
! the given met data being used (bmy, 6/22/00)
MODELNAME = GET_MODELNAME()
! Get the nested-grid offsets
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
!=================================================================
! Open the checkpoint file for output -- binary punch format
!=================================================================
! Copy the output checkpoint file name into a local variable
FILENAME = TRIM( OUTPUT_CHECKPT_FILE )
! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
CALL EXPAND_DATE( FILENAME, GET_NYMD(), GET_NHMS() )
! Add ADJ_DIR prefix to filename
FILENAME = TRIM( ADJTMP_DIR ) // TRIM( FILENAME )
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - MAKE_SO2ac_FILE: Writing ', a )
! Open checkpoint file for output
CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
!=================================================================
! Write each checkpointed quantity to the checkpoint file
!=================================================================
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, 1,
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
& IIPAR, JJPAR, LLPAR, I0+1,
& J0+1, 1, REAL(ESO2_ac,4) )
! Close file
CLOSE( IU_RST )
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### MAKE_SO2ac_FILE: wrote file' )
! Return to calling program
END SUBROUTINE MAKE_SO2ac_FILE
!------------------------------------------------------------------------------
SUBROUTINE READ_SO2ac_FILE( ESO2_ac, MONTH )
!
!******************************************************************************
! Subroutine READ_SO2ac_FILE initializes GEOS-CHEM tracer concentrations
! from a checkpoint file (binary punch file format) from before convection
! (dkh, 8/30/04, mak, 8/2/07)
!
! Arguments as input:
! ============================================================================
! (1 ) MONTH : Current month
!
! Arguments as output:
! ============================================================================
! (1 ) ESO2_ac : Current monthly aircraft SO2 emissions [kg SO2/box/s]
!
! Notes
!
!******************************************************************************
!
! References to F90 modules
USE BPCH2_MOD, ONLY : OPEN_BPCH2_FOR_READ
USE DIRECTORY_ADJ_MOD, ONLY : ADJTMP_DIR
USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP, ALLOC_ERR
USE FILE_MOD, ONLY : IU_RST, IOERROR
USE LOGICAL_MOD, ONLY : LPRT
USE LOGICAL_ADJ_MOD, ONLY : LDEL_CHKPT
USE RESTART_MOD, ONLY : CHECK_DIMENSIONS
USE TIME_MOD, ONLY : EXPAND_DATE
USE TIME_MOD, ONLY : GET_NYMD
USE TIME_MOD, ONLY : GET_NHMS
USE UNIX_CMDS_MOD, ONLY : REMOVE_CMD
# include "CMN_SIZE" ! Size parameters
! Arguments
CHARACTER(LEN=3), INTENT(IN) :: MONTH
REAL*8, INTENT(OUT) :: ESO2_ac(IIPAR,JJPAR,LLPAR)
! Local Variables
INTEGER :: I, IOS, J, L, N, JLOOP, NN, NTL, AS
REAL*4 :: TRACER(IIPAR,JJPAR,LLPAR)
REAL*8 :: SUMTC
CHARACTER(LEN=255) :: FILENAME
CHARACTER(LEN=255) :: REMOVE_CHK_FILE_CMD
! For binary punch file, version 2.0
INTEGER :: NI, NJ, NL
INTEGER :: IFIRST, JFIRST, LFIRST
INTEGER :: NTRACER, NSKIP
INTEGER :: HALFPOLAR, CENTER180
REAL*4 :: LONRES, LATRES
REAL*8 :: ZTAU0, ZTAU1
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED
!=================================================================
! READ_SO2ac_FILE begins here!
!=================================================================
INPUT_CHECKPT_FILE = 'gctm.chk.SO2ac.YYYY.' // TRIM( MONTH )
! Initialize some variables
TRACER(:,:,:) = 0e0
!=================================================================
! Open checkpoint file and read top-of-file header
!=================================================================
! Copy input file name to a local variable
FILENAME = TRIM( INPUT_CHECKPT_FILE )
! Replace YYYY, MM, DD, HH tokens in FILENAME w/ actual values
CALL EXPAND_DATE( FILENAME, GET_NYMD(), GET_NHMS() )
! Add ADJ_DIR prefix to name
FILENAME = TRIM( ADJTMP_DIR ) // TRIM( FILENAME )
! Echo some input to the screen
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
WRITE( 6, '(a,/)' ) 'C H E C K P T F I L E I N P U T'
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - READ_SO2ac: Reading ', a )
! Open the binary punch file for input
CALL OPEN_BPCH2_FOR_READ( IU_RST, FILENAME )
!=================================================================
! Read checkpointed variables
!=================================================================
READ( IU_RST, IOSTAT=IOS )
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
! IOS < 0 is end-of-file, so print error message
IF ( IOS < 0 )
& CALL IOERROR( IOS,IU_RST,'read_so2ac_file:6' )
! IOS > 0 is a real I/O error -- print error message
IF ( IOS > 0 )
& CALL IOERROR( IOS,IU_RST,'read_so2ac_file:7' )
READ( IU_RST, IOSTAT=IOS )
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
& NSKIP
IF ( IOS /= 0 )
& CALL IOERROR(IOS,IU_RST,'read_so2ac_file:8' )
READ( IU_RST, IOSTAT=IOS )
& ( ( ( TRACER(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
IF ( IOS /= 0 )
& CALL IOERROR( IOS,IU_RST,'read_so2ac_file:9' )
!==============================================================
! Assign data from the TRACER array to the STT array.
!==============================================================
! Only process checkpoint data (i.e. mixing ratio)
IF ( CATEGORY(1:8) == 'IJ-CHK-$' ) THEN
! Make sure array dimensions are of global size
! (NI=IIPAR; NJ=JJPAR, NL=LLPAR), or stop the run
!print*, 'before check_dimensions ni, nj, nl are', ni, nj, nl
CALL CHECK_DIMENSIONS( NI, NJ, NL )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
ESO2_ac(I,J,L) = TRACER(I,J,L)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF !category is checkpoint
! Close file
CLOSE( IU_RST )
555 CONTINUE
! Remove files if L_CHK_DEL = TRUE
IF ( LDEL_CHKPT ) THEN
REMOVE_CHK_FILE_CMD = TRIM ( REMOVE_CMD ) // ' ' //
& TRIM ( FILENAME )
CALL SYSTEM( TRIM( REMOVE_CHK_FILE_CMD ) )
WRITE( 6, 102 ) TRIM( REMOVE_CHK_FILE_CMD )
102 FORMAT( ' - READ_SO2ac_FILE: Executing: ',a )
ENDIF
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### READ_SO2ac_FILE: read file' )
! Return to calling program
END SUBROUTINE READ_SO2ac_FILE
!-----------------------------------------------------------------------
SUBROUTINE EXPAND_NAME( FILENAME, N_ITRN )
!
!******************************************************************************
! Subroutine EXPAND_DATE replaces "NN" token within
! a filename string with the actual values. (bmy, 6/27/02, 12/2/03)
! (dkh, 9/22/04)
!
! Arguments as Input:
! ============================================================================
! (1 ) FILENAME (CHARACTER) : Filename with tokens to replace
! (2 ) N_ITRN (INTEGER ) : Current iteration number
!
!
! Arguments as Output:
! ============================================================================
! (1 ) FILENAME (CHARACTER) : Modified filename
!
! NOTES:
! (1 ) Based on EXPAND_DATE
!
!******************************************************************************
!
! References to F90 modules
USE CHARPAK_MOD, ONLY : STRREPL
USE ERROR_MOD, ONLY : ERROR_STOP
# include "define.h"
! Arguments
CHARACTER(LEN=*), INTENT(INOUT) :: FILENAME
INTEGER, INTENT(IN) :: N_ITRN
! Local variables
CHARACTER(LEN=2) :: NN_STR
!=================================================================
! EXPAND_NAME begins here!
!=================================================================
#if defined( LINUX_PGI )
! Use ENCODE statement for PGI/Linux (bmy, 9/29/03)
ENCODE( 2, '(i2.2)', NN_STR ) N_ITRN
#else
! For other platforms, use an F90 internal write (bmy, 9/29/03)
WRITE( NN_STR, '(i2.2)' ) N_ITRN
#endif
! Replace NN token w/ actual value
CALL STRREPL( FILENAME, 'NN', NN_STR )
! Return to calling program
END SUBROUTINE EXPAND_NAME
!-----------------------------------------------------------------------
SUBROUTINE INIT_CHECKPT
!
!*****************************************************************************
! Subroutine INIT_CHECKPT initializes all module arrays (dkh, 9/10/04)
!
! NOTES:
! (1 ) Add CHK_PSC. (dkh, 03/16/05)
! (2 ) Add ORIG_STT. (dkh, 06/14/05)
! (3 ) Add PART_CASE. (dkh, 07/22/05)
! (4 ) Add CHK_STT_BEFCHEM. (dkh, 08/08/05)
! (5 ) Add SO2_CHK, H2O2_CHK. (dkh, 10/23/05)
! (6 ) Add WETD_CHK_H2O2s_CHEMT, WETD_CHK_H2O2s_DYNT, etc. (dkh, 10/23/05)
! (7 ) Add WETD_CHK_SO2_CHEMT, WETD_CHK_SO2_DYNT. (dkh, 10/31/05)
! (8 ) Add CONV_CHK... (dkh, 11/22/05)
! (9 ) Add SOILNOX_CHK (dkh, 02/06/07)
! (10) Change to checkpointing WETD and CONV stuff at every dynamic ts (dkh, 02/02/09)
! (11) Update to v8, (adj_group, 6/09/09)
! (12) Add CHK_T_DAY and CHK_T_15_DAY for MEGAN emissions (dkh, 01/23/10)
!******************************************************************************
!
! F90 modules
USE ERROR_MOD, ONLY : ALLOC_ERR
USE TIME_MOD, ONLY : GET_TS_CONV
!USE ADJ_ARRAYS_MOD, ONLY : NOBS
USE TRACER_MOD, ONLY : N_TRACERS
USE TRACER_MOD, ONLY : ITS_A_FULLCHEM_SIM
USE TRACER_MOD, ONLY : ITS_AN_AEROSOL_SIM
USE LOGICAL_MOD, ONLY : LSOILNOX
USE LOGICAL_MOD, ONLY : LSULF
USE LOGICAL_MOD, ONLY : LCHEM
USE LOGICAL_MOD, ONLY : LWETD, LCONV
USE LOGICAL_MOD, ONLY : LMEGAN
USE LOGICAL_MOD, ONLY : LLIGHTNOX
USE LOGICAL_MOD, ONLY : LWETD
USE LOGICAL_ADJ_MOD, ONLY : LAERO_THERM
USE MEGAN_MOD, ONLY : DAY_DIM
# include "CMN_SIZE" ! IIPAR, JJPAR, LLPAR
# include "comode.h" ! ITLOOP
! Local variables
INTEGER :: AS
INTEGER :: NSTEP
INTEGER :: CONVDT
!=================================================================
! INIT_CHECKPT begins here
!=================================================================
IF ( LSULF .and. LAERO_THERM ) THEN
ALLOCATE( ANISO_IN( IIPAR, JJPAR, LLPAR, NANISOIN ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'ANISO_IN' )
ALLOCATE( RP_IN( IIPAR, JJPAR, LLPAR, NRPIN ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RP_IN' )
ALLOCATE( RP_OUT( IIPAR, JJPAR, LLPAR, NRPOUT ) , STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RP_OUT' )
ALLOCATE( nitr_max( IIPAR, JJPAR, LLPAR ) , STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'nitr_max' )
ALLOCATE( gamaan_fwd( IIPAR, JJPAR, LLPAR, NNNMAX ) , STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'gamaan_fwd' )
ALLOCATE( gamold_fwd( IIPAR, JJPAR, LLPAR, NNNMAX ) , STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'gamold_fwd' )
ALLOCATE( wh2o_fwd( IIPAR, JJPAR, LLPAR, NNNMAX ) , STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'wh2o_fwd' )
ALLOCATE( ynh4_fwd( IIPAR, JJPAR, LLPAR, NNNMAX ) , STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'ynh4_fwd' )
ALLOCATE( eror_fwd( IIPAR, JJPAR, LLPAR, NNNMAX ) , STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'error_fwd' )
ALLOCATE( exit_fwd( IIPAR, JJPAR, LLPAR, NNNMAX ) , STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'exit_fwd' )
ALLOCATE( gamana_fwd( IIPAR, JJPAR, LLPAR, NNNMAX ) , STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'gaman_fwd' )
ALLOCATE( gamas1_fwd( IIPAR, JJPAR, LLPAR, NNNMAX ) , STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'gamas1_fwd' )
ALLOCATE( gamas2_fwd( IIPAR, JJPAR, LLPAR, NNNMAX ) , STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'gamas2_fwd' )
ENDIF
IF ( LSULF .and. LCHEM ) THEN
ALLOCATE( SO2_CHK( IIPAR, JJPAR, LLPAR ),
& STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'SO2_CHK' )
SO2_CHK = 0.d0
ALLOCATE( H2O2_CHK( IIPAR, JJPAR, LLPAR ),
& STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'H2O2_CHK' )
H2O2_CHK = 0.d0
ENDIF
ALLOCATE( CHK_STT( IIPAR, JJPAR, LLPAR, N_TRACERS ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'CHK_STT' )
! mak
ALLOCATE( CHK_STT_CON( IIPAR, JJPAR, LLPAR, N_TRACERS ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'CHK_STT_CON' )
! OBS_STT now in adj_arrays_mod.f instead of checkpt_mod.f (mak, 6/14/09)
!ALLOCATE( OBS_STT( IIPAR, JJPAR, LLPAR, N_TRACERS ) , STAT=AS )
!IF ( AS /= 0 ) CALL ALLOC_ERR( 'OBS' )
ALLOCATE( CHK_PSC( IIPAR, JJPAR, 2 ) , STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'CHK_PSC' )
ALLOCATE( ORIG_STT( IIPAR, JJPAR, LLPAR, N_TRACERS ) , STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'ORIG_STT' )
IF ( ITS_A_FULLCHEM_SIM() .and.
& ( LCHEM .or. LWETD ) ) THEN
ALLOCATE( PART_CASE( ITLOOP ) , STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'PART_CASE' )
ALLOCATE( CHK_STT_BEFCHEM( IIPAR, JJPAR, LLPAR, N_TRACERS ),
& STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'CHK_STT_BEFCHEM' )
ALLOCATE( CHK_HSAVE( IIPAR, JJPAR, LLTROP ),
& STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'CHK_HSAVE' )
CHK_HSAVE = 0.d0
ENDIF
IF ( LWETD .and.
& ( ITS_AN_AEROSOL_SIM() .or. ITS_A_FULLCHEM_SIM() ) ) THEN
ALLOCATE( WETD_CHK_H2O2s( IIPAR, JJPAR, LLPAR ),
& STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'H2O2s' )
WETD_CHK_H2O2s = 0.d0
ALLOCATE( WETD_CHK_SO2s( IIPAR, JJPAR, LLPAR ),
& STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'SO2s' )
WETD_CHK_SO2s = 0.d0
ALLOCATE( WETD_CHK_SO4( IIPAR, JJPAR, LLPAR ),
& STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'SO4' )
WETD_CHK_SO4 = 0.d0
ALLOCATE( WETD_CHK_SO2( IIPAR, JJPAR, LLPAR ),
& STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'SO2' )
WETD_CHK_SO2 = 0.d0
ENDIF ! LWETD
IF ( LCONV .AND.
& ( ITS_AN_AEROSOL_SIM() .or. ITS_A_FULLCHEM_SIM() ) ) THEN
ALLOCATE( CONV_CHK_H2O2s( IIPAR, JJPAR, LLPAR ),
& STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'CONV_H2O2s' )
CONV_CHK_H2O2s = 0.d0
ALLOCATE( CONV_CHK_SO2s( IIPAR, JJPAR, LLPAR ),
& STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'CONV_SO2s' )
CONV_CHK_SO2s = 0.d0
!>>>
! Now include adjoint of F (dkh, 10/03/08)
! Calculate NS (See DO_CONVECTION, NSTEP or NFCLDMX, NS
CONVDT = GET_TS_CONV() * 60d0
NSTEP = CONVDT / 300
NSTEP = MAX( NSTEP, 1 )
ALLOCATE( QC_SO2_CHK( IIPAR, JJPAR, LLPAR, NSTEP),
& STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'QC_SO2_CHK' )
QC_SO2_CHK = 0.d0
!<<<
ENDIF ! LCONV
IF ( LSOILNOX ) THEN
ALLOCATE( SOILNOX_CHK( IIPAR, JJPAR ),
& STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'SOILNOX_CHK' )
SOILNOX_CHK = 0.d0
ENDIF
! Adding this didn't really help (dkh, 06/11/09)
!IF ( LADJ_TRAN ) THEN
!
! ALLOCATE( CHK_STT_TD( IIPAR, JJPAR, LLPAR, N_TRACERS ), STAT=AS )
! IF ( AS /= 0 ) CALL ALLOC_ERR( 'CHK_STT_TD' )
! CHK_STT_TD = 0.d0
!
! ALLOCATE( CHK_STT_TC( IIPAR, JJPAR, LLPAR, N_TRACERS ), STAT=AS )
! IF ( AS /= 0 ) CALL ALLOC_ERR( 'CHK_STT_TC' )
! CHK_STT_TC = 0.d0
!
!ENDIF
! adj_group: add for checkpointing lightning NOx emissions
IF ( LLIGHTNOX ) THEN
ALLOCATE( SLBASE_CHK( IIPAR, JJPAR, LLPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'SLBASE_CHK' )
SLBASE_CHK = 0d0
ENDIF
END SUBROUTINE INIT_CHECKPT
!-----------------------------------------------------------------------
SUBROUTINE CLEANUP_CHECKPT
!
!*****************************************************************************
! Subroutine CLEANUP_CHECKPT deallocates all module arrays (dkh, 9/10/04)
!
! NOTES:
! (1 ) Add CHK_PSC. (dkh, 03/16/05)
! (2 ) Add ORIG_STT. (dkh, 06/14/05)
! (3 ) Add PART_CASE. (dkh, 07/22/05)
! (4 ) Add CHK_STT_BEFCHEM. (dkh, 08/08/05)
! (5 ) Add SO2_CHK, H2O2_CHK. (dkh, 10/23/05)
! (6 ) Add WETD_CHK_H2O2s_CHEMT, WETD_CHK_H2O2s_DYNT, etc. (dkh, 10/23/05)
! (7 ) Add WETD_CHK_SO2_CHEMT, WETD_CHK_SO2_DYNT. (dkh, 10/31/05)
! (8 ) Add CONV_CHK_xxx etc. (dkh, 11/22/05)
! (9 ) Add SOILNOX_CHK. (dkh, 02/06/07)
! (10) Change to checkpointing WETD and CONV stuff at every dynamic ts (dkh, 02/02/09)
! (11) Add ANISORROPIA for aerosol thermo (slc, 3/9/13, ***)
!******************************************************************************
!
IF ( ALLOCATED( RP_IN ) ) DEALLOCATE( RP_IN )
IF ( ALLOCATED( RP_OUT) ) DEALLOCATE( RP_OUT )
IF ( ALLOCATED( ANISO_IN ) ) DEALLOCATE( ANISO_IN )
!OBS_STT now in adj_arrays_mod.f instead of checkpt_mod.f (mak, 6/14/09)
!IF ( ALLOCATED( OBS_STT ) ) DEALLOCATE( OBS_STT )
IF ( ALLOCATED( CHK_STT ) ) DEALLOCATE( CHK_STT )
IF ( ALLOCATED( CHK_PSC ) ) DEALLOCATE( CHK_PSC )
IF ( ALLOCATED( nitr_max ) ) DEALLOCATE( nitr_max )
IF ( ALLOCATED( gamaan_fwd ) ) DEALLOCATE( gamaan_fwd )
IF ( ALLOCATED( gamold_fwd ) ) DEALLOCATE( gamold_fwd )
IF ( ALLOCATED( wh2o_fwd ) ) DEALLOCATE( wh2o_fwd )
IF ( ALLOCATED( ynh4_fwd ) ) DEALLOCATE( ynh4_fwd )
IF ( ALLOCATED( eror_fwd ) ) DEALLOCATE( eror_fwd )
IF ( ALLOCATED( exit_fwd ) ) DEALLOCATE( exit_fwd )
IF ( ALLOCATED( gamana_fwd ) ) DEALLOCATE( gamana_fwd )
IF ( ALLOCATED( gamas1_fwd ) ) DEALLOCATE( gamas1_fwd )
IF ( ALLOCATED( gamas2_fwd ) ) DEALLOCATE( gamas2_fwd )
IF ( ALLOCATED( ORIG_STT ) ) DEALLOCATE( ORIG_STT )
IF ( ALLOCATED( CHK_STT_BEFCHEM ) ) DEALLOCATE( CHK_STT_BEFCHEM )
IF ( ALLOCATED( PART_CASE ) ) DEALLOCATE( PART_CASE )
IF ( ALLOCATED( CHK_HSAVE ) ) DEALLOCATE( CHK_HSAVE )
IF ( ALLOCATED( SO2_CHK ) ) DEALLOCATE( SO2_CHK )
IF ( ALLOCATED( H2O2_CHK ) ) DEALLOCATE( H2O2_CHK )
IF ( ALLOCATED( WETD_CHK_H2O2s ) )
& DEALLOCATE( WETD_CHK_H2O2s )
IF ( ALLOCATED( WETD_CHK_SO2s ) )
& DEALLOCATE( WETD_CHK_SO2s )
IF ( ALLOCATED( WETD_CHK_SO4 ) )
& DEALLOCATE( WETD_CHK_SO4 )
IF ( ALLOCATED( WETD_CHK_SO2 ) )
& DEALLOCATE( WETD_CHK_SO2 )
IF ( ALLOCATED( CONV_CHK_H2O2s ) )
& DEALLOCATE( CONV_CHK_H2O2s )
IF ( ALLOCATED( CONV_CHK_SO2s ) )
& DEALLOCATE( CONV_CHK_SO2s )
IF ( ALLOCATED( SOILNOX_CHK ) )
& DEALLOCATE( SOILNOX_CHK )
IF ( ALLOCATED( CHK_STT_CON ) )DEALLOCATE( CHK_STT_CON )
!IF ( ALLOCATED( CHK_STT_TD ) )DEALLOCATE( CHK_STT_TD )
!IF ( ALLOCATED( CHK_STT_TC ) )DEALLOCATE( CHK_STT_TC )
!>>>
! Now include adjoint of F (dkh, 10/03/08)
IF ( ALLOCATED( QC_SO2_CHK) )
& DEALLOCATE( QC_SO2_CHK )
!<<<
IF ( ALLOCATED( SLBASE_CHK ) ) DEALLOCATE( SLBASE_CHK )
! Return to calling program
END SUBROUTINE CLEANUP_CHECKPT
!------------------------------------------------------------------------------
END MODULE CHECKPT_MOD
Reference in New Issue View Git Blame Copy Permalink