SUBROUTINE SUSTA_CONV_PRHS(PSPD,PSP,PRDLR,PIF,PIH,PSIMF,PSIMH)

!* SUSTA_CONV_PRHS 
!  - cf. option FILE to MODEL of GNH_CONV_PRHS, but for standard atmosphere.

! Purpose
! -------
!   Converts:
!    log(standard prehyds) -> log(standard presims)
!    standard (pre-prehyd) -> standard (pre-presim)

!   Remark:
!    The output arrays (PIF,PIH) are not equal to (STPRE,STPREH),
!     excepted at the top and bottom,
!     because GPPREH+GPXYB+GPPREF is valid on "presim", not on "prehyd".
!     (STPRE,STPREF) are the values obtained if one uses GPPREH+GPXYB+GPPREF
!     on "prehyd".
!     (PIF,PIH) are the values of standard hydrostatic pressures obtained
!     if one uses GPPREH+GPXYB+GPPREF on "presim", then convert "presim"
!     into "prehyd" by using d(presim)/d(prehyd)=(r**2/a**2)*(G/g).

! Interface
! ---------
!  * INPUT-OUTPUT:
!     PSPD   : NH pressure departure variable "spd"
!     PSP    : log(prehyd)

!  * OUTPUT:
!     PRDLR  : array containing "r/a" and "a/r"
!     PIF    : prehyd at full levels
!     PIH    : prehyd at half levels
!     PSIMF  : presim at full levels
!     PSIMH  : presim at half levels

! Externals
! ---------

! Method
! ------
!   See documentation

! Reference
! ---------
!        ECMWF Research Department documentation of the IFS
!        ARPEGE documentation (IDEUL)
!        Wood and Staniforth, 2003 (in QJRMS)

! Author
! ------
!   March-2008 K. Yessad (METEO-FRANCE/CNRM/GMAP)

! Modifications
! -------------
!  K. Yessad (March 2009): fix a bug for LRWSDLG=T
! End Modifications
!------------------------------------------------------------------------------

USE PARKIND1 , ONLY : JPIM     ,JPRB
USE YOMHOOK  , ONLY : LHOOK    ,DR_HOOK
USE YOMLUN   , ONLY : NULOUT
USE YOMDIM   , ONLY : NFLEVG
USE YOMDYNA  , ONLY : LRWSDLR  ,LRWSDLG
USE YOMDYN   , ONLY : NITPRHS
USE YOMSTA   , ONLY : STTEM
USE PAR_RDLR , ONLY : JP_ASRF  ,JP_RSAF  ,JP_ASRH  ,JP_RSAH  ,JP_DIMR

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

IMPLICIT NONE

REAL(KIND=JPRB),INTENT(INOUT) :: PSPD(1,NFLEVG)
REAL(KIND=JPRB),INTENT(INOUT) :: PSP(1)
REAL(KIND=JPRB),INTENT(OUT)   :: PRDLR(1,0:NFLEVG,JP_DIMR)
REAL(KIND=JPRB),INTENT(OUT)   :: PIF(1,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT)   :: PIH(1,0:NFLEVG)
REAL(KIND=JPRB),INTENT(OUT)   :: PSIMF(1,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT)   :: PSIMH(1,0:NFLEVG)

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

INTEGER(KIND=JPIM) :: JLEV,JITER

REAL(KIND=JPRB) :: ZERO(1,NFLEVG)
REAL(KIND=JPRB) :: ZOROG(1)

REAL(KIND=JPRB) :: ZPREH(1,0:NFLEVG)
REAL(KIND=JPRB) :: ZPREHYDH(1,0:NFLEVG)
REAL(KIND=JPRB) :: ZPREF(1,NFLEVG)
REAL(KIND=JPRB) :: ZPREF_OLD(1,NFLEVG)
REAL(KIND=JPRB) :: ZPREHYDF(1,NFLEVG)
REAL(KIND=JPRB) :: ZPREHYDS_ORIG(1),ZSPD_ORIG(1,NFLEVG)
REAL(KIND=JPRB) :: ZRDLR(1,0:NFLEVG,JP_DIMR)
REAL(KIND=JPRB) :: ZRSA_OLD(1,NFLEVG),ZRSA_NEW(1,NFLEVG)
REAL(KIND=JPRB) :: ZRSA_DIF(1,NFLEVG)
REAL(KIND=JPRB) :: ZZRSA2,ZZASR2,ZZRSA4,ZZASR4,ZPRT

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"
#include "gnhdlra.intfb.h"

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

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

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

!* 1. GRID POINT COMPUTATIONS
!     -----------------------

IF (.NOT.LRWSDLR) &
 & CALL ABOR1(' SUSTA_CONV_PRHS should not be called if LRWSDLR=F!')

ZERO(1,1:NFLEVG)=0.0_JPRB
ZOROG(1)=0.0_JPRB

!* 1.1 Save input "PSPD" and surface hydrostatic pressure. 

ZSPD_ORIG(1,1:NFLEVG)=PSPD(1,1:NFLEVG)
ZPREHYDS_ORIG(1)=EXP(PSP(1))

!* 1.2 ITERATION 0: COMPUTE FIRST GUESS FOR "r/a". 

DO JITER=0,0

  ! 1.2.A: Compute "r(i=0)/a"
  CALL GNHDLRA(1,1,1,1,0,.TRUE.,.TRUE., &
   & ZOROG,PSP(1),STTEM(:),PSPD(1,:),ZRDLR(1,:,:), &
   & PQ=ZERO,PL=ZERO,PI=ZERO,PR=ZERO,PS=ZERO,PG=ZERO, &
   & PIF=ZPREHYDF(1,:),PIH=ZPREHYDH(1,:))

  ! 1.2.B: Compute presim(i=0).
  ZPREH(1,0)=ZPREHYDH(1,0)
  IF (LRWSDLG) THEN
    DO JLEV=1,NFLEVG
      ZZRSA4=ZRDLR(1,JLEV,JP_RSAF)**4
      ZPREH(1,JLEV)=ZPREH(1,JLEV-1)+ZZRSA4*(ZPREHYDH(1,JLEV)-ZPREHYDH(1,JLEV-1))
      ZPREF(1,JLEV)=ZPREH(1,JLEV)+ZZRSA4*(ZPREHYDF(1,JLEV)-ZPREHYDH(1,JLEV))
    ENDDO
  ELSE
    DO JLEV=1,NFLEVG
      ZZRSA2=ZRDLR(1,JLEV,JP_RSAF)*ZRDLR(1,JLEV,JP_RSAF)
      ZPREH(1,JLEV)=ZPREH(1,JLEV-1)+ZZRSA2*(ZPREHYDH(1,JLEV)-ZPREHYDH(1,JLEV-1))
      ZPREF(1,JLEV)=ZPREH(1,JLEV)+ZZRSA2*(ZPREHYDF(1,JLEV)-ZPREHYDH(1,JLEV))
    ENDDO
  ENDIF

  ! 1.2.C: Update "PSPD" with "pre - presim(i=0)"
  !        PSPD(i=1)=PSPD(i=0)+(prehyd(i=0)-presim(i=0))
  DO JLEV=1,NFLEVG
    PSPD(1,JLEV)=ZSPD_ORIG(1,JLEV)+ZPREHYDF(1,JLEV)-ZPREF(1,JLEV)
  ENDDO

  ! 1.2.D: Compute log(presims(i=1)), update "PSP"
  PSP(1)=LOG(ZPREH(1,NFLEVG))
  ZPREF_OLD(1,1:NFLEVG)=ZPREF(1,1:NFLEVG)

ENDDO

!* 1.3 ITERATIONS 1 TO NITPRHS. 

DO JITER=1,NITPRHS

  ! 1.3.A: Compute "r(i=jiter)/a" and "presim(i=jiter)".
  ZRSA_OLD(1,1:NFLEVG)=ZRDLR(1,1:NFLEVG,JP_RSAF)
  CALL GNHDLRA(1,1,1,1,0,.TRUE.,.FALSE., &
   & ZOROG,PSP(1),STTEM(:),PSPD(1,:),ZRDLR(1,:,:), &
   & PIIF=ZPREF_OLD(1,:), &
   & PQ=ZERO,PL=ZERO,PI=ZERO,PR=ZERO,PS=ZERO,PG=ZERO, &
   & PIF=ZPREF(1,:),PIH=ZPREH(1,:))
  ZRSA_NEW(1,1:NFLEVG)=ZRDLR(1,1:NFLEVG,JP_RSAF)

  ! 1.3.B: Use presim(i=jiter) to have a new estimation of "prehyd":
  !        provides prehyd(i=jiter).
  ZPREHYDH(1,0)=ZPREH(1,0)
  IF (LRWSDLG) THEN
    DO JLEV=1,NFLEVG
      ZZASR4=ZRDLR(1,JLEV,JP_ASRF)**4
      ZPREHYDH(1,JLEV)=ZPREHYDH(1,JLEV-1)+ZZASR4*(ZPREH(1,JLEV)-ZPREH(1,JLEV-1))
      ZPREHYDF(1,JLEV)=ZPREHYDH(1,JLEV)+ZZASR4*(ZPREF(1,JLEV)-ZPREH(1,JLEV))
    ENDDO
  ELSE
    DO JLEV=1,NFLEVG
      ZZASR2=ZRDLR(1,JLEV,JP_ASRF)*ZRDLR(1,JLEV,JP_ASRF)
      ZPREHYDH(1,JLEV)=ZPREHYDH(1,JLEV-1)+ZZASR2*(ZPREH(1,JLEV)-ZPREH(1,JLEV-1))
      ZPREHYDF(1,JLEV)=ZPREHYDH(1,JLEV)+ZZASR2*(ZPREF(1,JLEV)-ZPREH(1,JLEV))
    ENDDO
  ENDIF

  ! 1.3.C: Update "PSPD" with "pre - presim(i=jiter)"
  !        PSPD(i=jiter+1)=PSPD(i=0)+(prehyd(i=jiter)-presim(i=jiter))
  DO JLEV=1,NFLEVG
    PSPD(1,JLEV)=ZSPD_ORIG(1,JLEV)+ZPREHYDF(1,JLEV)-ZPREF(1,JLEV)
  ENDDO

  ! 1.3.D: "prehyds(i=jiter)" may be different from the original
  !        "prehyds", so we apply a correction to "presims":
  !        presims(i=jiter+1)=presims(i=jiter)
  !         +(prehyds_orig-prehyds(i=jiter)) 
  !        Compute log(presims(i=jiter+1)), update "PSP"
  PSP(1)=LOG(ZPREH(1,NFLEVG)+ZPREHYDS_ORIG(1)-ZPREHYDH(1,NFLEVG))
  ZPREF_OLD(1,1:NFLEVG)=ZPREF(1,1:NFLEVG)

ENDDO ! JITER

IF (NITPRHS > 0) THEN
  DO JLEV=1,NFLEVG
    ZRSA_DIF(1,JLEV)=ABS(ZRSA_NEW(1,JLEV)-ZRSA_OLD(1,JLEV))
  ENDDO
  ZPRT=MAXVAL(ZRSA_DIF(1,1:NFLEVG))
  WRITE (NULOUT,*)
  WRITE (NULOUT,*) ' TEST OF CONVERGENCE IN SUSTA_CONV_PRHS: ZPRT=',ZPRT
ENDIF

!* 1.4 FINAL SAVINGS.

PRDLR(1,1:NFLEVG,JP_RSAF)=ZRDLR(1,1:NFLEVG,JP_RSAF)
PRDLR(1,1:NFLEVG,JP_ASRF)=ZRDLR(1,1:NFLEVG,JP_ASRF)
PRDLR(1,0:NFLEVG,JP_RSAH)=ZRDLR(1,0:NFLEVG,JP_RSAH)
PRDLR(1,0:NFLEVG,JP_ASRH)=ZRDLR(1,0:NFLEVG,JP_ASRH)
PIF(1,1:NFLEVG)=ZPREHYDF(1,1:NFLEVG)
PIH(1,0:NFLEVG)=ZPREHYDH(1,0:NFLEVG)
PSIMF(1,1:NFLEVG)=ZPREF(1,1:NFLEVG)
PSIMH(1,0:NFLEVG)=ZPREH(1,0:NFLEVG)

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

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

END SUBROUTINE SUSTA_CONV_PRHS

