85 lines
2.8 KiB
Fortran
85 lines
2.8 KiB
Fortran
! $Id: lump.f,v 1.1 2009/06/09 21:51:52 daven Exp $
|
|
SUBROUTINE LUMP( NTRACER, XNUMOL, STT )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine LUMP takes individual chemistry species and "lumps" them back
|
|
! into tracers after each SMVGEAR chemistry timestep. (bmy, 4/1/03, 7/20/04)
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) NTRACER (INTEGER) : Number of tracers
|
|
! (2 ) XNUMOL (REAL*8 ) : Array of molecules tracer / kg tracer
|
|
! (3 ) STT (REAL*8 ) : Tracer concentrations [molec/cm3/box]
|
|
!
|
|
! Arguments as Output:
|
|
! ============================================================================
|
|
! (3 ) STT (REAL*8 ) : Tracer concentrations [kg/box]
|
|
!
|
|
! NOTES:
|
|
! (1 ) Updated comments, cosmetic changes (bmy, 4/1/03)
|
|
! (2 ) Added OpenMP parallelization commands (bmy, 8/1/03)
|
|
! (3 ) Now dimension args XNUMOL, STT w/ NTRACER and not NNPAR (bmy, 7/20/04)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE COMODE_MOD, ONLY : CSPEC, JLOP, VOLUME
|
|
USE TRACERID_MOD, ONLY : IDTRMB, NMEMBER, CTRMB
|
|
|
|
IMPLICIT NONE
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "comode.h" ! SMVGEAR II arrays
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: NTRACER
|
|
REAL*8, INTENT(IN) :: XNUMOL(NTRACER)
|
|
REAL*8, INTENT(INOUT) :: STT(IIPAR,JJPAR,LLPAR,NTRACER)
|
|
|
|
! Local variables
|
|
INTEGER :: I, J, L, N, JLOOP, KK, JJ
|
|
REAL*8 :: CONCTMP
|
|
|
|
!=================================================================
|
|
! LUMP begins here!
|
|
!=================================================================
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, L, N, JLOOP, CONCTMP, KK, JJ )
|
|
!$OMP+SCHEDULE( DYNAMIC )
|
|
DO N = 1, NTRACER
|
|
|
|
! Skip if not a valid tracer
|
|
IF ( IDTRMB(N,1) == 0 ) CYCLE
|
|
|
|
! Loop over grid boxes
|
|
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
|
|
|
|
! Compute tracer concentration [molec/cm3/box] by
|
|
! looping over all species belonging to this tracer
|
|
CONCTMP = 0.d0
|
|
DO KK = 1, NMEMBER(N)
|
|
JJ = IDTRMB(N, KK)
|
|
CONCTMP = CONCTMP + ( 1d0+CTRMB(N,KK) ) * CSPEC(JLOOP,JJ)
|
|
ENDDO
|
|
|
|
! Save tracer concentrations back to STT
|
|
STT(I,J,L,N) = CONCTMP
|
|
|
|
! Change STT from [molec/cm3/box] back to [kg/box]
|
|
STT(I,J,L,N) = STT(I,J,L,N) * VOLUME(JLOOP) / XNUMOL(N)
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE LUMP
|
|
|