110 lines
3.7 KiB
Fortran
110 lines
3.7 KiB
Fortran
!$Id: lump_adj.f,v 1.1 2009/08/17 03:59:52 daven Exp $
|
|
|
|
SUBROUTINE LUMP_ADJ( NTRACER, XNUMOL, STT_ADJ )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine LUMP_ADJ takes adjoints of tracerst (STT_ADJ) and partitions them
|
|
! into adjoints of individual chemical species (CSPEC_ADJ). Based on
|
|
! ADJ_LUMP from the GCv6 adjoint (dkh, 07/31/09).
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) NTRACER (INTEGER) : Number of tracers
|
|
! (2 ) XNUMOL (REAL*8 ) : Array of molecules tracer / kg tracer
|
|
! (3 ) STT_ADJ (REAL*8 ) : Adjoint Tracer concentrations
|
|
!
|
|
! Arguments as Output:
|
|
! ============================================================================
|
|
! (1 ) STT_ADJ (REAL*8 ) : Tracer concentrations [kg/box]
|
|
!
|
|
! Module variables included via USE as Input / Output:
|
|
! ============================================================================
|
|
! (1 ) CSPEC_ADJ (REAL*8) : Adjoint species concentrations
|
|
!
|
|
! NOTES:
|
|
! (1 ) Disable OMP parallel loops, which were leading to small erros in
|
|
! the 7th digit. (dkh, 10/08/06)
|
|
! (2 ) Update for GCv8 (dkh, 07/31/09)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE COMODE_MOD, ONLY : CSPEC, JLOP, VOLUME, CSPEC_ADJ
|
|
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(NNPAR)
|
|
REAL*8, INTENT(INOUT) :: STT_ADJ(IIPAR,JJPAR,LLPAR,NTRACER)
|
|
! make this an allocatable array in comode_mod
|
|
!REAL*8, INTENT(INOUT) :: CSPEC_ADJ(ITLOOP,IGAS) ?
|
|
|
|
! Local variables
|
|
INTEGER :: I, J, L, N, JLOOP, KK, JJ, NN
|
|
REAL*8 :: ADCONCTMP
|
|
|
|
!=================================================================
|
|
! LUMP_ADJ begins here!
|
|
!=================================================================
|
|
! note: CSPEC_ADJ is initialized to zero when it is allocated.
|
|
! After the first call to PARTITION_ADJ it will no longer be zero
|
|
! before this routine.
|
|
|
|
!!$OMP PARALLEL DO
|
|
!!$OMP+DEFAULT( SHARED )
|
|
!!$OMP+PRIVATE( I, J, L, N, JLOOP, ADCONCTMP, KK, JJ, NN )
|
|
!!$OMP+SCHEDULE( DYNAMIC )
|
|
DO N = 1, NTRACER
|
|
|
|
! Get index of adj species array from index of fwd species array.
|
|
!NN = ADJ2STT(N)
|
|
NN = N
|
|
|
|
! Skip if not a valid tracer.
|
|
! IDTRMB for the fwd tracer (is this BCPI, etc?), NN for the adjoint tracer.
|
|
IF ( IDTRMB(N,1) == 0 .OR. NN == 0 ) CYCLE
|
|
|
|
DO L = 1, NPVERT
|
|
DO J = 1, NLAT
|
|
DO I = 1, NLONG
|
|
|
|
! Initialize
|
|
ADCONCTMP = 0.D0
|
|
|
|
! Get vector index from 3-D array indicies
|
|
JLOOP = JLOP(I,J,L)
|
|
IF ( JLOOP == 0 ) CYCLE
|
|
|
|
! Adjoint of unit conversion ( molec/cm3/box to kg/box )
|
|
STT_ADJ(I,J,L,NN) = STT_ADJ(I,J,L,NN) * VOLUME(JLOOP)
|
|
& / XNUMOL(N)
|
|
|
|
ADCONCTMP = ADCONCTMP + STT_ADJ(I,J,L,NN)
|
|
|
|
! Reset STT_ADJ to zero. This way it won't intefere in ADJ_PARTITION
|
|
STT_ADJ(I,J,L,NN) = 0.d0
|
|
|
|
! Lump adjoint values together according to families.
|
|
DO KK = 1, NMEMBER(N)
|
|
JJ = IDTRMB(N,KK)
|
|
CSPEC_ADJ(JLOOP,JJ) = CSPEC_ADJ(JLOOP,JJ)
|
|
& + ADCONCTMP * ( 1 + CTRMB(N,KK) )
|
|
|
|
ENDDO
|
|
|
|
ADCONCTMP = 0.D0
|
|
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!!$OMP END PARALLEL DO
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE LUMP_ADJ
|
|
|