Add files via upload
This commit is contained in:
382
code/modified/partition.f
Normal file
382
code/modified/partition.f
Normal file
@ -0,0 +1,382 @@
|
||||
! $Id: partition.f,v 1.2 2012/03/01 22:00:27 daven Exp $
|
||||
SUBROUTINE PARTITION( NTRACER, STT, XNUMOL )
|
||||
!
|
||||
!******************************************************************************
|
||||
! Subroutine PARTITION separates GEOS-CHEM tracers into its individual
|
||||
! constituent chemistry species before each SMVGEAR chemistry timestep.
|
||||
! (bdf, bmy, 4/1/03, 1/7/09)
|
||||
!
|
||||
! Arguments as Input:
|
||||
! ============================================================================
|
||||
! (1 ) NTRACER (INTEGER) : Number of tracers
|
||||
! (2 ) STT (REAL*8 ) : Tracer concentrations [kg/box]
|
||||
! (3 ) XNUMOL (REAL*8 ) : Array of molecules tracer / kg tracer
|
||||
!
|
||||
! Arguments as Output:
|
||||
! ============================================================================
|
||||
! (1 ) STT (REAL*8 ) : Updated tracer concentrations [molec/cm3/box]
|
||||
!
|
||||
! NOTES:
|
||||
! (1 ) Now make CSAVE a local dynamic array. Updated comments, cosmetic
|
||||
! changes (bmy, 4/24/03)
|
||||
! (2 ) Add OpenMP parallelization commands (bmy, 8/1/03)
|
||||
! (3 ) Now dimension args XNUMOL, STT w/ NTRACER and not NNPAR (bmy, 7/20/04)
|
||||
! (4 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
|
||||
! (5 ) Resize CSAVE to save local memory, for SUN compiler. (bmy, 7/14/06)
|
||||
! (6 ) Now do safe division to eliminate FP errors (phs, bmy, 2/26/08)
|
||||
! (7 ) Now change error stop 30000 into a warning (phs, ccc, bmy, 1/7/09)
|
||||
! (8 ) Add support for adjoint calculation. Save partitioning decision in
|
||||
! PART_CASE:
|
||||
! = 1 ... partitioned NOX first
|
||||
! = 2 ... partitioned OX first
|
||||
! (dkh, 07/22/05, dkh, 07/31/09)
|
||||
!
|
||||
!******************************************************************************
|
||||
!
|
||||
! References to F90 modules
|
||||
USE COMODE_MOD, ONLY : CSPEC, JLOP, VOLUME
|
||||
USE ERROR_MOD, ONLY : ALLOC_ERR, ERROR_STOP, SAFE_DIV
|
||||
USE TRACERID_MOD, ONLY : IDTOX, IDTNOX, IDTRMB
|
||||
USE TRACERID_MOD, ONLY : IDO3, IDNO, IDHNO2
|
||||
USE TRACERID_MOD, ONLY : CTRMB, NMEMBER
|
||||
! adj_group
|
||||
USE CHECKPT_MOD, ONLY : PART_CASE
|
||||
USE LOGICAL_ADJ_MOD, ONLY : LADJ
|
||||
! dkh debug
|
||||
USE ADJ_ARRAYS_MOD, ONLY : IFD, JFD, LFD
|
||||
USE LOGICAL_ADJ_MOD, ONLY : LPRINTFD
|
||||
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
# include "CMN_SIZE"
|
||||
# include "comode.h"
|
||||
|
||||
! Arguments
|
||||
INTEGER, INTENT(IN) :: NTRACER
|
||||
REAL*8, INTENT(INOUT) :: STT(IIPAR,JJPAR,LLPAR,NTRACER)
|
||||
REAL*8, INTENT(IN) :: XNUMOL(NTRACER)
|
||||
|
||||
! Local variables
|
||||
INTEGER :: I, J, L, N, JLOOP, IPL, JJ, KK
|
||||
INTEGER :: CSAVEID(IGAS)
|
||||
INTEGER :: CSAVEID_JJ(IGAS)
|
||||
INTEGER :: CS, IDNUM, AS
|
||||
REAL*8 :: CONCTMP, CONCNOX, SUM, SUM1
|
||||
REAL*8 :: CSAVE( ITLOOP, NTRACER )
|
||||
REAL*8 :: QTEMP
|
||||
|
||||
!=================================================================
|
||||
! PARTITION begins here!
|
||||
!
|
||||
! Copy values of CSPEC that need to be saved (bdf, 3/30/99)
|
||||
!=================================================================
|
||||
|
||||
! Initialize
|
||||
IDNUM = 0
|
||||
CSAVEID(:) = 0
|
||||
CSAVEID_JJ(:) = 0
|
||||
|
||||
! Loop over tracers
|
||||
DO N = 1, NTRACER
|
||||
|
||||
! Skip if this is not a valid tracer
|
||||
IF ( IDTRMB(N,1) == 0 ) CYCLE
|
||||
|
||||
! Handle all other tracers except Ox
|
||||
IF ( N /= IDTOX ) THEN
|
||||
DO KK = 1, NMEMBER(N)
|
||||
IDNUM = IDNUM + 1
|
||||
JJ = IDTRMB(N,KK)
|
||||
CSAVEID(JJ) = IDNUM
|
||||
CSAVEID_JJ(IDNUM) = JJ
|
||||
ENDDO
|
||||
|
||||
! Handle Ox
|
||||
ELSE IF ( IDTOX /= 0 ) THEN
|
||||
JJ = IDTRMB(N,1)
|
||||
IDNUM = IDNUM + 1
|
||||
CSAVEID(JJ) = IDNUM
|
||||
CSAVEID_JJ(IDNUM) = JJ
|
||||
ENDIF
|
||||
ENDDO
|
||||
|
||||
! Loop over tracer members and boxes
|
||||
!$OMP PARALLEL DO
|
||||
!$OMP+DEFAULT( SHARED )
|
||||
!$OMP+PRIVATE( I, J, L, N, JLOOP )
|
||||
!$OMP+SCHEDULE( DYNAMIC )
|
||||
DO N = 1, IDNUM
|
||||
DO L = 1, NPVERT
|
||||
DO J = 1, NLAT
|
||||
DO I = 1, NLONG
|
||||
|
||||
! 1-D SMVGEAR grid box index
|
||||
JLOOP = JLOP(I,J,L)
|
||||
IF ( JLOOP == 0 ) CYCLE
|
||||
|
||||
! Store into CSAVE
|
||||
CSAVE(JLOOP,N) = CSPEC(JLOOP,CSAVEID_JJ(N))
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
! dkh debug
|
||||
!IF ( LPRINTFD ) THEN
|
||||
IF ( LPRINTFD .and. JLOP(IFD,JFD,LFD) > 0 ) THEN
|
||||
print*, ' CSPEC in partition = ', CSPEC(JLOP(IFD,JFD,LFD),:)
|
||||
print*, ' STT in partition = ', STT(IFD,JFD,LFD,:)
|
||||
print*, ' JLOP in partition = ', JLOP(IFD,JFD,LFD)
|
||||
ENDIF
|
||||
|
||||
!=================================================================
|
||||
! Split each tracer up into its components (if any)
|
||||
! Family tracers are partitioned among members according to
|
||||
! initial ratios. In tracer sequence, OX must be after NOX,
|
||||
! otherwise, adjust the code
|
||||
!=================================================================
|
||||
DO N = 1, NTRACER
|
||||
|
||||
! Skip if it's not a valid tracer
|
||||
IF ( IDTRMB(N,1) == 0 ) CYCLE
|
||||
|
||||
!### Debug
|
||||
!WRITE(6,*) 'IN PARTITION N= ', N
|
||||
|
||||
! Loop over grid boxes
|
||||
!$OMP PARALLEL DO
|
||||
!$OMP+DEFAULT( SHARED )
|
||||
!$OMP+PRIVATE( I, J, L, JLOOP, CONCTMP, SUM, KK, JJ, SUM1, CONCNOX )
|
||||
!$OMP+PRIVATE( QTEMP )
|
||||
!$OMP+SCHEDULE( DYNAMIC )
|
||||
DO L = 1, NPVERT
|
||||
DO J = 1, NLAT
|
||||
DO I = 1, NLONG
|
||||
|
||||
! 1-D SMVGEAR grid box index
|
||||
JLOOP = JLOP(I,J,L)
|
||||
IF ( JLOOP == 0 ) CYCLE
|
||||
|
||||
! Convert tracer concentration from [kg/box] to [molec/cm3/box]
|
||||
STT(I,J,L,N) = STT(I,J,L,N) / VOLUME(JLOOP) * XNUMOL(N)
|
||||
|
||||
! Store concentration of tracer N at grid box (I,J,L) in CONCTMP
|
||||
CONCTMP = STT(I,J,L,N)
|
||||
|
||||
!===========================================================
|
||||
! First, find sum of starting concentrations
|
||||
!===========================================================
|
||||
|
||||
!------------------------
|
||||
! All tracers except Ox
|
||||
!------------------------
|
||||
IF ( N /= IDTOX ) THEN
|
||||
SUM = 0.d0
|
||||
|
||||
DO KK = 1, NMEMBER(N)
|
||||
JJ = IDTRMB(N, KK)
|
||||
|
||||
! Error check
|
||||
IF ( JJ == 0 ) THEN
|
||||
!$OMP CRITICAL
|
||||
PRINT *,JJ,JLOOP,N,KK,IDTRMB(N, KK)
|
||||
!$OMP END CRITICAL
|
||||
ENDIF
|
||||
|
||||
SUM = SUM + CSAVE(JLOOP,CSAVEID(JJ)) * (CTRMB(N,KK)+1)
|
||||
ENDDO
|
||||
|
||||
!------------------------
|
||||
! Ox
|
||||
!------------------------
|
||||
ELSE IF ( IDTOX /= 0 ) THEN
|
||||
JJ = IDTRMB(N,1)
|
||||
SUM = CSAVE(JLOOP,CSAVEID(JJ)) * (CTRMB(N,1)+1)
|
||||
SUM1 = 0.d0
|
||||
|
||||
|
||||
! SUM = sum of starting values for all Ox species (incl. O3)
|
||||
! SUM1 = sum of new values for all Ox species except O3,
|
||||
! based on NOx partitioning
|
||||
DO KK = 2, NMEMBER(N)
|
||||
JJ = IDTRMB(N,KK)
|
||||
SUM = SUM + CSAVE(JLOOP,CSAVEID(JJ))*(CTRMB(N,KK)+1)
|
||||
SUM1 = SUM1+ CSPEC(JLOOP,JJ) * (CTRMB(N,KK)+1)
|
||||
ENDDO
|
||||
|
||||
ENDIF
|
||||
|
||||
!===========================================================
|
||||
! Now perform the partitioning
|
||||
!===========================================================
|
||||
|
||||
!----------------------------------------
|
||||
! All tracers except Ox
|
||||
!----------------------------------------
|
||||
IF ( N /= IDTOX ) THEN
|
||||
|
||||
! Loop over # of member species in this tracer
|
||||
DO KK = 1, NMEMBER(N)
|
||||
|
||||
! Index of member species for CSPEC
|
||||
JJ = IDTRMB(N, KK)
|
||||
|
||||
! QTEMP is the fraction of the given member species KK
|
||||
! in the tracer N. The value QTEMP*CONCTMP is the
|
||||
! concentration of the member species itself, and that
|
||||
! needs to be saved into CSPEC.
|
||||
!
|
||||
! In the partitioning, now be sure to perform a safe
|
||||
! floating point division of CSAVE/SUM. Return the value
|
||||
! 1/NMEMBER(N) if the division can't be done, i.e. do a
|
||||
! uniform paritioning among all member species of the
|
||||
! given tracer. (phs, bmy, 2/26/08)
|
||||
QTEMP = SAFE_DIV( CSAVE(JLOOP,CSAVEID(JJ)),
|
||||
& SUM, 1d0/NMEMBER(N) )
|
||||
|
||||
! Store the concentration of member species KK
|
||||
! into the CSPEC array. Do not allow underflow!
|
||||
CSPEC(JLOOP,JJ) = MAX( QTEMP*CONCTMP, SMAL2 )
|
||||
ENDDO
|
||||
|
||||
!----------------------------------------
|
||||
! For Ox, take O3 = Ox - SUM(NO2+NO3*2)
|
||||
!----------------------------------------
|
||||
ELSE IF ( IDTOX /= 0 .AND. IDTNOX /= 0 ) THEN
|
||||
|
||||
! Find Ox in CSPEC
|
||||
JJ = IDO3
|
||||
CSPEC(JLOOP,JJ) = CONCTMP - SUM1
|
||||
|
||||
! If Ox partitioning is OK, then skip to next tracer
|
||||
! Old code:
|
||||
!----------------------------------------
|
||||
!IF ( CSPEC(JLOOP,JJ) > 0.0d0 ) GOTO 220
|
||||
!----------------------------------------
|
||||
! New code: Now store PART_CASE for checkpointing. (dkh, 07/22/05)
|
||||
! adj_group: add this to GCv8 (dkh, 07/31/09)
|
||||
IF ( CSPEC(JLOOP,JJ) > 0.0d0 ) THEN
|
||||
IF ( LADJ ) PART_CASE(JLOOP) = 1
|
||||
GOTO 220
|
||||
ELSE
|
||||
IF ( LADJ ) PART_CASE(JLOOP) = 2
|
||||
ENDIF
|
||||
!----------------------------------------
|
||||
|
||||
!---------------------------------------------------------
|
||||
! Ox partitioning failed, we are getting a negative ozone
|
||||
! concentration. Instead, try partitioning Ox before NOx
|
||||
!---------------------------------------------------------
|
||||
|
||||
! Loop over member species in Ox
|
||||
DO KK = 1, NMEMBER(N)
|
||||
|
||||
! Index of member species for CSPEC array
|
||||
JJ = IDTRMB(N, KK)
|
||||
|
||||
! QTEMP is the fraction of the given member species in the
|
||||
! Ox tracer. The value QTEMP*CONCTMP is the concentration
|
||||
! of the member species itself, and that needs to be
|
||||
! saved into CSPEC.
|
||||
!
|
||||
! In the partitioning, now be sure to perform a safe
|
||||
! floating point division of CSAVE/SUM. Return the value
|
||||
! 1/NMEMBER(N) if the division can't be done, i.e. do a
|
||||
! uniform paritioning among all member species of the
|
||||
! given tracer. (phs, bmy, 2/26/08)
|
||||
QTEMP = SAFE_DIV( CSAVE(JLOOP,CSAVEID(JJ)),
|
||||
& SUM, 1d0/NMEMBER(N) )
|
||||
|
||||
! Store the concentration of member species KK
|
||||
! into the CSPEC array. Do not allow underflow!
|
||||
CSPEC(JLOOP,JJ) = MAX( QTEMP*CONCTMP, SMAL2 )
|
||||
ENDDO
|
||||
|
||||
!---------------------------------------------------------
|
||||
! then partition NO+HNO2
|
||||
! (the only NOx species not contained in Ox)
|
||||
! SUM = sum of starting values for NO and HNO2
|
||||
! SUM1 = sum of new values for all NOx species except
|
||||
! NO and HNO2, based on Ox partitioning
|
||||
!---------------------------------------------------------
|
||||
SUM = 0.d0
|
||||
SUM1 = 0.d0
|
||||
|
||||
! Loop over member species of NOx
|
||||
DO KK = 1, NMEMBER(IDTNOX)
|
||||
JJ = IDTRMB(IDTNOX, KK)
|
||||
|
||||
IF ( JJ == IDNO .OR. JJ == IDHNO2 ) THEN
|
||||
SUM = SUM + CSAVE(JLOOP,CSAVEID(JJ)) *
|
||||
& (CTRMB(IDTNOX,KK)+1)
|
||||
ELSE
|
||||
SUM1 = SUM1 + CSPEC(JLOOP,JJ)*(CTRMB(IDTNOX,KK)+1)
|
||||
ENDIF
|
||||
ENDDO
|
||||
|
||||
! Get NOx concentration from STT
|
||||
CONCNOX = STT(I,J,L,IDTNOX)
|
||||
|
||||
! Error test
|
||||
IF ( CONCNOX - SUM1 < 0.d0 ) THEN
|
||||
!------------------------------------------------------
|
||||
! Prior to 1/7/09
|
||||
! Don't stop w/ error, but just print warning msg.
|
||||
! Sometimes the new TPCORE can cause this error to
|
||||
! trap if there CONCNOX = 0, but that can be purely
|
||||
! a numerical condition and not really an error.
|
||||
! (phs, ccc, bmy, 1/7/09)
|
||||
!CALL ERROR_STOP( 'STOP 30000', 'partition.f' )
|
||||
!------------------------------------------------------
|
||||
!$OMP CRITICAL
|
||||
PRINT*, '### In partition.f: CONCNOX - SUM1 < 0'
|
||||
PRINT*, '### If CONCNOX = 0 and SUM1 ~ 1e-99 it is OK'
|
||||
PRINT*, '### I, J, L : ', I, J, L
|
||||
PRINT*, '### CONCNOX : ', CONCNOX
|
||||
PRINT*, '### SUM1 : ', SUM1
|
||||
!$OMP END CRITICAL
|
||||
ENDIF
|
||||
|
||||
! Loop over member species in NOx
|
||||
DO KK = 1, NMEMBER(IDTNOX)
|
||||
|
||||
! Index of member species for CSPEC
|
||||
JJ = IDTRMB(IDTNOX,KK)
|
||||
|
||||
! For species NO and NO2 ...
|
||||
IF ( JJ == IDNO .OR. JJ == IDHNO2 ) THEN
|
||||
|
||||
! QTEMP is the fraction of the given member species in
|
||||
! the Ox tracer. The value QTEMP*CONCTMP is the
|
||||
! concentration of the member species itself, and that
|
||||
! needs to be saved into CSPEC.
|
||||
!
|
||||
! In the partitioning, now be sure to perform a safe
|
||||
! floating point division of CSAVE/SUM. Return the value
|
||||
! 1/NMEMBER(N) if the division can't be done, i.e. do a
|
||||
! uniform paritioning among all member species of the
|
||||
! given tracer. (phs, bmy, 2/26/08)
|
||||
QTEMP = SAFE_DIV( CSAVE(JLOOP,CSAVEID(JJ)),
|
||||
& SUM, 1d0/NMEMBER(IDTNOX) )
|
||||
|
||||
! Store the concentration of member species NO or HNO2
|
||||
! into the CSPEC array. Do not allow underflow!
|
||||
CSPEC(JLOOP,JJ) = MAX(QTEMP*(CONCNOX-SUM1), SMAL2)
|
||||
ENDIF
|
||||
ENDDO
|
||||
|
||||
!========================================================
|
||||
! Ox partitioning is OK
|
||||
!========================================================
|
||||
220 CONTINUE
|
||||
ENDIF
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
!$OMP END PARALLEL DO
|
||||
ENDDO
|
||||
|
||||
! Return to calling program
|
||||
END SUBROUTINE PARTITION
|
Reference in New Issue
Block a user