SUBROUTINE CORMASSDRY(PGP,KDIM3,KRET,KSTEP,LDGRID)

!**** *CORMASSDRY*  Cheap mass corrector 'MASCOR'.
!                   - ROUTINE FOR CALCULATING GLOBAL MASS
!                     IF REQUIRED SUBTRACT WATER VAPOUR TOTAL MASS

!     PURPOSE.
!     --------

!**   INTERFACE.
!     ----------

!        *CALL* *CORMASSDRY(...)*

!        INPUT:

!        KRET      - field number whose norm is to be computed
!        PGP       - Input GFL array

!     METHOD.
!     -------

!     EXTERNALS.
!     ----------

!     REFERENCE.
!     ----------

!        ECMWF Research Department documentation of the IFS

!     AUTHOR.
!     -------

!        Nils Wedi + Mats Hamrud *ECMWF*

!     MODIFICATIONS.
!     --------------
!       Original : 08-02-2008
!       K. Yessad (Sep 2008): use array VFE_RDETAH.
!     -----------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMDIM   , ONLY : NPROMA, NFLEVG, NGPBLKS
USE YOMGEM   , ONLY : NGPTOT, VBH, VAH, VC, VDELB, VFE_RDETAH
USE YOMSP    , ONLY : SPSP
USE YOMCVER  , ONLY : LVERTFE
USE YOMGC    , ONLY : GM
USE YOMMASS  , ONLY : LMASDRY, GMASSI, GMASS0, GMASSINC

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KDIM3 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGP(:,:,:,:) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KRET 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTEP
LOGICAL, OPTIONAL, INTENT(IN)    :: LDGRID

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

REAL(KIND=JPRB) :: ZWORK(NGPTOT)
REAL(KIND=JPRB) :: ZWORK1(NPROMA,1,NGPBLKS)
REAL(KIND=JPRB) :: ZIN(NPROMA,NFLEVG+1)
REAL(KIND=JPRB) :: ZOUT(NPROMA,NFLEVG+1)
REAL(KIND=JPRB) :: ZNORMS(3,1)

REAL(KIND=JPRB) ::    ZPRESH(NPROMA,0:NFLEVG)
REAL(KIND=JPRB) ::    ZDELP (NPROMA,NFLEVG), ZRDELP(NPROMA,NFLEVG)
REAL(KIND=JPRB) ::    ZLNPR (NPROMA,NFLEVG), ZRPRE (NPROMA,NFLEVG)
REAL(KIND=JPRB) ::    ZRPP  (NPROMA,NFLEVG), ZALPH (NPROMA,NFLEVG)
REAL(KIND=JPRB) ::    ZRTGR (NPROMA,NFLEVG)

INTEGER(KIND=JPIM) :: IST, IEND, JF, JROF, JKGLO, IBL, ISTGLO, ITYPE
LOGICAL :: LLADJUST
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"
#include "gpnorm1.intfb.h"
#include "speree.intfb.h"
#include "reespe.intfb.h"
#include "gppreh.intfb.h"
#include "gpxyb.intfb.h"
#include "verint.intfb.h"

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

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

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

!--- LOOP OVER NPROMA PACKETS

IF(KRET > KDIM3) THEN
  CALL ABOR1(' KRET > KDIM3 in CORMASSDRY')
ENDIF

LLADJUST=.FALSE.
IF( PRESENT(LDGRID) ) THEN
  LLADJUST = LDGRID
ENDIF

! convert surface pressure to gridpoint, store in zwork
CALL SPEREE(1,1,SPSP,ZWORK)

CALL GSTATS(1223,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) &
!$OMP& PRIVATE(JKGLO,IST,IEND,JF,JROF,IBL) &
!$OMP& PRIVATE(ZPRESH,ZDELP,ZRDELP,ZLNPR,ZALPH,ZRTGR,ZRPRE,ZRPP) &
!$OMP& PRIVATE(ZIN,ZOUT)
DO JKGLO=1,NGPTOT,NPROMA
  IST=1
  IEND=MIN(NPROMA,NGPTOT-JKGLO+1)
  IBL=(JKGLO-1)/NPROMA+1
  
  DO JROF = IST , IEND
    ZPRESH(JROF,NFLEVG) = EXP(ZWORK(JKGLO-1+JROF))
  ENDDO
  
  IF( LMASDRY ) THEN
      
    ! calculate delta p
    CALL GPPREH (NPROMA,IST,IEND,NFLEVG,VAH,VBH,ZPRESH)
    CALL GPXYB (NPROMA,IST,IEND,NFLEVG,VDELB,VC,ZPRESH,&
     & ZDELP,ZRDELP,ZLNPR,ZALPH,ZRTGR,ZRPRE,ZRPP)
    
    ! integrate total water vapour mass at each point
    IF(LVERTFE) THEN
      DO JF=1,NFLEVG
        DO JROF = IST,IEND
          ZIN(JROF,JF) = PGP(JROF,JF,KRET,IBL) &
           & *ZDELP(JROF,JF)*VFE_RDETAH(JF)
        ENDDO
      ENDDO
      CALL VERINT(NPROMA,IST,IEND,NFLEVG,ZIN,ZOUT,0)
    ELSE
      ZOUT(IST:IEND,1)=0.0_JPRB
      DO JF=2,NFLEVG+1
        DO JROF = IST,IEND
          ZOUT(JROF,JF)=ZOUT(JROF,JF-1) & 
           & +PGP(JROF,JF-1,KRET,IBL)*ZDELP(JROF,JF-1)
        ENDDO
      ENDDO
    ENDIF    
    ! store current dry mass in zwork (apply map factor if necessary)
    DO JROF=IST,IEND
      ZWORK1(JROF,1,IBL) = (ZPRESH(JROF,NFLEVG) - ZOUT(JROF,NFLEVG+1))/GM(JKGLO-1+JROF)**2
    ENDDO

  ELSE    
    ! Note Mats Hamrud + Nils Wedi:
    ! Since the exp(integral ln(ps) domega) <> integral(ps domega)
    ! the exact mean conservation of ps does not allow 
    ! (at least without incurring a small error) to simply 
    ! maintain the mean ln(ps) as extracted from the 0-component in spectral space
    DO JROF=IST,IEND
      ZWORK1(JROF,1,IBL) = ZPRESH(JROF,NFLEVG)/GM(JKGLO-1+JROF)**2
    ENDDO
  ENDIF
  
ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1223,1)
  
!--- Now we have all the points in an NGPTOT data structure form
!    and we can calculate grid point norms

ISTGLO=1
ITYPE=1
CALL GPNORM1(ZWORK1,1,.FALSE.,PNORMS=ZNORMS)
GMASS0=ZNORMS(1,1)
IF( KSTEP == 0 .AND. GMASSI == 0.0_JPRB ) THEN
  GMASSI = GMASS0
ENDIF
GMASSINC=LOG(GMASS0/GMASSI)  

! (instead of cormass2, need to disable spcmascor correction)
! This is not used with LECMWF=.T.
! but possibly spmascor correction is also correct for stretched grid
! so this option is not necessary at all, Nils
IF( LMASDRY.AND.LLADJUST ) THEN
  DO JROF=1,NGPTOT
    ZWORK(JROF)=LOG(ZPRESH(JROF,NFLEVG)-(GMASS0-GMASSI))
  ENDDO
  CALL REESPE(1,1,SPSP,ZWORK)
ENDIF

!     -----------------------------------------------------------------
  
IF (LHOOK) CALL DR_HOOK('CORMASSDRY',1,ZHOOK_HANDLE)
END SUBROUTINE CORMASSDRY
