
SUBROUTINE COUPLO4_GRG_STATS(LDFIRST)

!***** CUOPL04_GRG_STATS 

!**   PURPOSE.
!     --------
!     Calculate total integral of GRG tracers from CTM, IFS and Tendencies for
!     monitoring mass conversation 

!**   INTERFACE.
!     ----------
!              *COUPLO4_GRG_STATS(LDFIRST) !

!        Explicit arguments :
!        --------------------
!              LDFIRST          :  FIRST call 

!     AUTHOR.
!     -------
!     2006-05-24  J. Flemming

!     MODIFICATIONS.
!     --------------

 
  USE PARKIND1  ,ONLY : JPIM     ,JPRB

  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

  USE YOMLUN   , ONLY : NULERR, NULOUT

  USE YOMGEM   , ONLY : NGPTOT, VAH, VBH     

  USE YOM_YGFL , ONLY : YGFL, YGFLC, YGRG_NL, NGRG_CPLO4

  USE YOMDIM   , ONLY : NFLEVG  ,NPROMA, NGPBLKS 

  USE YOMGFL   , ONLY : GFL

  USE YOMGMV   , ONLY : GMVS, YT0

  USE YOMMP    , ONLY : MYPROC
 
  USE SURFACE_FIELDS_MIX, ONLY : SD_XA, SD_X2, YSD_X2D, YSD_XAD

  USE YOMGC, ONLY : GAW

  USE MPL_MODULE, ONLY : MPL_ALLREDUCE

  IMPLICIT NONE

!-----------------------------------------------------------------------

  LOGICAL, INTENT(IN)       :: LDFIRST
 
  INTEGER(KIND=JPIM):: IERROR, IGRG, IGRG1, I, IGFL, JGFL, JSTGLO
  INTEGER(KIND=JPIM):: ICEND, ISTC, IBL, JLEV, J, INDEX, ICASE, IEXTRA

  REAL (KIND=JPRB), ALLOCATABLE ::  ZPRESH(:,:,:)  ! (NPROMA,NFLEVG+1,IBLK) 
  REAL (KIND=JPRB), ALLOCATABLE ::  ZPRESF(:,:,:)  ! (NPROMA,NFLEVG,IBLK)  
  REAL (KIND=JPRB), ALLOCATABLE ::  ZDELP(:,:,:)  ! (NPROMA,NFLEVG+1,IBLK) 
  REAL (KIND=JPRB), ALLOCATABLE ::  ZTC(:,:)  ! (NPROMA,IBLK) 

  REAL(KIND=JPRB),  ALLOCATABLE ::  ZLOCGP(:,:,:)  ! (NPROMA,NFLEVG, NGPBLKS2) 
  REAL(KIND=JPRB) :: ZGAW     
  REAL(KIND=JPRB) :: ZHOOK_HANDLE

  CHARACTER(LEN=5), DIMENSION(6) :: CLCASE 
  REAL(KIND=JPRB), DIMENSION(6)  :: ZTM
  REAL(KIND=JPRB),  DIMENSION(6), SAVE         :: ZTENDACC,ZFLUXACC  

#include "gppre.intfb.h"
#include "gptco3.intfb.h"


!################  subroutine start ################

IF (LHOOK) CALL DR_HOOK('COUPLO4_GRG_STATS',0,ZHOOK_HANDLE)

! allocate work array
  IF(.NOT.(ALLOCATED(ZLOCGP)))ALLOCATE(ZLOCGP(NPROMA,NFLEVG,NGPBLKS),STAT=IERROR)

! allocate half and full level pressures for convertions
  IF(.NOT.(ALLOCATED(ZPRESH)))ALLOCATE(ZPRESH(NPROMA,0:NFLEVG,NGPBLKS),STAT=IERROR)
  IF(.NOT.(ALLOCATED(ZPRESF)))ALLOCATE(ZPRESF(NPROMA,1:NFLEVG,NGPBLKS),STAT=IERROR)
  IF(.NOT.(ALLOCATED(ZDELP)))ALLOCATE(ZDELP(NPROMA,0:NFLEVG+1,NGPBLKS),STAT=IERROR)

 CLCASE=(/'pchem','lchem','ctm_c','ifs_c','tmass','ifs_n'/)
! total column
  ALLOCATE( ZTC(NPROMA,NGPBLKS), STAT=IERROR )

 IF (LDFIRST) THEN    
  WRITE(NULERR,'(8a10)') ' TOTAL INT ',' NAME ',CLCASE 
 ENDIF

! calculate p and delta p
   DO JSTGLO=1,NGPTOT,NPROMA
       ICEND=MIN(NPROMA,NGPTOT-JSTGLO+1)
       ISTC=1
       IBL=(JSTGLO-1)/NPROMA+1
       ZPRESH(:,NFLEVG,IBL)  =  EXP(GMVS(:, YT0%MSP,IBL)) 
       CALL GPPRE(NPROMA,ISTC,ICEND, NFLEVG, VAH, VBH,  ZPRESH(:,:,IBL), ZPRESF(:,:,IBL))
       DO I=1, NFLEVG
         ZDELP(:,I,IBL)=  ZPRESH(:,I,IBL) -  ZPRESH(:,I-1,IBL)
       ENDDO
   ENDDO

IGRG=0

! loop over coupled species
DO IGRG1=1,NGRG_CPLO4

 IF (LDFIRST) THEN
   ZTENDACC=0.0_JPRB
   ZFLUXACC=0.0_JPRB
 ENDIF

! Find species within GFL range 
 IGFL=0 
 DO JGFL=1,YGFL%NUMFLDS
   IF(YGFLC(JGFL)%IGRBCODE == YGRG_NL(IGRG1)%IGRBCODE .AND. YGRG_NL(IGRG1)%NCOUPLO4 > 0) IGFL=JGFL
 ENDDO
   
 IF ( IGFL == 0 ) CYCLE 
  IGRG = IGRG + 1

! loop over cases IFS_GRG, CTM-conc, CTM-pchem, CTM-lchem, 
 DO ICASE=1,6

 ZLOCGP(:,:,:) = 0.0_JPRB

! Put CTM input in GRG auxilliary arrays 
  IEXTRA=-1 

  SELECT CASE ( CLCASE(ICASE) )

   CASE('pchem' ) 

     IEXTRA = 2*NGRG_CPLO4 + IGRG
!     ZLOCGP(:,:,:) = QPROGRG(:,:,IGRG,:) 
      IF (YSD_XAD%NDIM >= IEXTRA)  ZLOCGP(:,:,:) = SD_XA(:,:,IEXTRA, :)

   CASE('lchem' )

     IEXTRA = NGRG_CPLO4 + IGRG
      IF (YSD_XAD%NDIM >= IEXTRA)  ZLOCGP(:,:,:) = SD_XA(:,:,IEXTRA, :)

   CASE ('ctm_c') 
     IEXTRA = IGRG
      IF (YSD_XAD%NDIM >= IEXTRA)  ZLOCGP(:,:,:) = SD_XA(:,:,IEXTRA, :)

   CASE ('ifs_c') 
       DO JSTGLO=1,NGPTOT,NPROMA
        ICEND=MIN(NPROMA,NGPTOT-JSTGLO+1)
        ISTC=1
        IBL=(JSTGLO-1)/NPROMA+1
          DO JLEV=1,NFLEVG
           DO J=ISTC,ICEND
              ZLOCGP(J,JLEV,IBL) = GFL(J,JLEV,YGFLC(IGFL)%MP, IBL)   
           ENDDO
         ENDDO
       ENDDO
   CASE('tmass' )

     ZLOCGP(:,:,:) = 1.0

   CASE ('ifs_n')

       DO JSTGLO=1,NGPTOT,NPROMA
        ICEND=MIN(NPROMA,NGPTOT-JSTGLO+1)
        ISTC=1
        IBL=(JSTGLO-1)/NPROMA+1
        DO JLEV=1,NFLEVG
           DO J=ISTC,ICEND
            IF ( GFL(J,JLEV,YGFLC(IGFL)%MP, IBL) < 0.0_JPRB) ZLOCGP(J,JLEV,IBL) = GFL(J,JLEV,YGFLC(IGFL)%MP, IBL)   
           ENDDO
        ENDDO
       ENDDO

   END SELECT      

     ZTC=0.0
! caluclate total col
       DO JSTGLO=1,NGPTOT,NPROMA
        ICEND=MIN(NPROMA,NGPTOT-JSTGLO+1)
        ISTC=1
        IBL=(JSTGLO-1)/NPROMA+1
         CALL GPTCO3(NPROMA,ISTC,ICEND, NFLEVG,ZDELP(:,:,IBL), & 
           & ZLOCGP(:,:,IBL),ZTC(:,IBL))
       ENDDO
!    write(NULERR,*) 'SUM LOCAL TC', SUM(ZTC)/FLOAT(NGPTOT),CLCASE(ICASE), YGRG_NL(IGRG)%IGRBCODE
! weight by area average 

! calulate total column in extra 2s field 
 IF  (YSD_X2D%NDIM >= IEXTRA .AND. IEXTRA > 0 ) THEN
   SD_X2(:,IEXTRA, :)   =  ZTC(:,:)
 ENDIF

  ZGAW=0.0
         DO JSTGLO=1,NGPTOT,NPROMA
             ICEND=MIN(NPROMA,NGPTOT-JSTGLO+1)
               ISTC=1
               IBL=(JSTGLO-1)/NPROMA+1
                DO J=ISTC,ICEND
                  INDEX=(IBL-1)*NPROMA+J   
                  ZTC(J,IBL)=ZTC(J,IBL)*GAW(INDEX)
                ENDDO
         ENDDO

! calculate statistics of ctm and ifs

    ZTM(ICASE)  =  SUM (RESHAPE(ZTC(:,:),(/NGPTOT/)))
!    ZGAW =  SUM (GAW)
!    CALL mpl_allreduce( ZGAW ,'sum',LDREPROD=.FALSE.,CDSTRING='COUPLO4_GRG_STATS ')

    write(NULERR,*) 'ZTM SUM LOCAL', ZTM(ICASE),ICASE
    CALL MPL_ALLREDUCE(ZTM(ICASE) ,'sum',LDREPROD=.FALSE.,CDSTRING='COUPLO4_GRG_STATS ')

   ENDDO 

   IF (MYPROC == 1) THEN  
!      WRITE(NULERR,*) ' TOTAL INT ',YGRG_NL(IGRG)%CNAME, ZFLUXACC(IGRG), ZTENDACC(IGRG), ZTM(3:6)
!      WRITE(NULOUT,*) ' TOTAL INT ',YGRG_NL(IGRG)%CNAME, ZFLUXACC(IGRG), ZTENDACC(IGRG), ZTM(3:6)
      WRITE(NULERR,*) ' TOTAL INT ',YGRG_NL(IGRG)%CNAME,  ZTM(1:6)
      WRITE(NULOUT,*) ' TOTAL INT ',YGRG_NL(IGRG)%CNAME,  ZTM(1:6)
   ENDIF  

 ENDDO  


 IF (ALLOCATED(ZDELP)  ) DEALLOCATE (ZDELP)
 IF (ALLOCATED(ZPRESH) ) DEALLOCATE (ZPRESH)
 IF (ALLOCATED(ZPRESF) ) DEALLOCATE (ZPRESF)
 IF (ALLOCATED(ZLOCGP) ) DEALLOCATE (ZLOCGP)
 IF (ALLOCATED(ZTC) )   DEALLOCATE (ZTC)

IF (LHOOK) CALL DR_HOOK('COUPLO4_GRG_STATS',1,ZHOOK_HANDLE)

END SUBROUTINE COUPLO4_GRG_STATS
