SUBROUTINE SUJBWAVTRANS

!**** *SUJBWAVTRANS*  - Initialize the multi-resolution spherical transforms
!*                      for the Wavelet Jb

!     Purpose.
!     --------
!           Initialize multi-resolution spherical transforms for Wavelet Jb
!**   Interface.
!     ----------
!        *CALL* *SUJBWAVTRANS*

!        Explicit arguments :
!        --------------------

!        Implicit arguments :
!        --------------------

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

!     Externals.
!     ----------

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        Mike Fisher   *ECMWF*

!     Modifications.
!     --------------
!        Original : 2001-08-16
!        Modified : 
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        G.Mozdzynski  25-Jul-2006 Use linear grid for wavelet grid (was full grid)
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NSMAX, NPROMA
USE YOMLUN   , ONLY : NULOUT, NULTMP
USE YOMMP    , ONLY : LSPLIT, MY_REGION_NS, MY_REGION_EW, MYPROC
USE YOMCT0   , ONLY : NPROC, N_REGIONS_NS, N_REGIONS_EW
USE YOMTAG,     ONLY : MTAGFCE
USE YOMCST , ONLY : RPI
USE YOMWAVELET,ONLY : N_WAVELET_CUTOFFS,  N_WAVELET_SCALES, NMAX_RESOL, &
 & GRID_DEFINITION, NSMIN_WAVELET  
USE MPL_MODULE, ONLY : MPL_ALLREDUCE, MPL_BROADCAST

IMPLICIT NONE

REAL(KIND=JPRB), ALLOCATABLE :: ZMU(:)

INTEGER(KIND=JPIM) :: JSCALE, IDGL, ISMAX, IGPTOT, IOMASTER, ITAG, IFIL
!     LOCAL ARRAY FOR THE PURPOSE OF READING NAMRGRI (WAVELET GRID)
INTEGER(KIND=JPIM) :: NRGRI(JPMXGL)
CHARACTER (LEN = 32) ::   CLRTABLEFIL
LOGICAL :: LL_EXIST
REAL(KIND=JPRB)    :: ZLON, ZLAT
REAL(KIND=JPRB) :: ZHOOK_HANDLE

INTERFACE
#include "setup_trans.h"
#include "trans_inq.h"
END INTERFACE

#include "abor1.intfb.h"
#include "posnam.intfb.h"
#include "namrgri.h"

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

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

IOMASTER=1
ITAG=MTAGFCE+100

IF (N_WAVELET_SCALES > NMAX_RESOL) THEN
  WRITE (NULOUT,*) 'SUJBWAVTRANS: The number of wavelet scales exceeds the'
  WRITE (NULOUT,*) 'maximum number of spherical transform resolutions.'
  WRITE (NULOUT,*) 'NMAX_RESOL=',NMAX_RESOL
  WRITE (NULOUT,*) 'N_WAVELET_SCALES=',N_WAVELET_SCALES
  WRITE (NULOUT,*) 'Increase NMAX_RESOL (in NAMTRANS) and rerun'
  CALL ABOR1 ('SUJBWAVTRANS: N_WAVELET_SCALES > NMAX_RESOL')
ENDIF

ALLOCATE (GRID_DEFINITION(N_WAVELET_SCALES+1))

!     Loop over scales defining the grids and calling SETUP_TRANS to
!     initialize the transform package.

SETUP_LOOP: DO JSCALE=1,N_WAVELET_SCALES+1

!     The transform package cannot distribute fields if the resolution is
!     too low. So, insist that transforms have truncation >= MIN(NSMIN_WAVELET,NSMAX).

  IF (JSCALE==1) THEN
    ISMAX=NSMAX
  ELSE
    ISMAX = MAX (N_WAVELET_CUTOFFS(JSCALE-1), MIN(NSMIN_WAVELET,NSMAX))
  ENDIF

  IF( MYPROC == IOMASTER )THEN
    IF( ISMAX < 1000 )THEN
      WRITE(CLRTABLEFIL,'("rtablel_2",I3.3)')ISMAX
    ELSE
      WRITE(CLRTABLEFIL,'("rtablel_2",I4.4)')ISMAX
    ENDIF
    IFIL=LEN_TRIM(CLRTABLEFIL)
    CLRTABLEFIL=CLRTABLEFIL(1:IFIL)
    INQUIRE(FILE=CLRTABLEFIL,EXIST=LL_EXIST)
    IF( .NOT.LL_EXIST )THEN
      ! no linear grid, try reduced grid
      IF( ISMAX < 1000 )THEN
        WRITE(CLRTABLEFIL,'("rtable_2",I3.3)')ISMAX
      ELSE
        WRITE(CLRTABLEFIL,'("rtable_2",I4.4)')ISMAX
      ENDIF
      IFIL=LEN_TRIM(CLRTABLEFIL)
      CLRTABLEFIL=CLRTABLEFIL(1:IFIL)
      INQUIRE(FILE=CLRTABLEFIL,EXIST=LL_EXIST)
      IF( ISMAX == 213 ) LL_EXIST=.FALSE.
      IF( .NOT.LL_EXIST )THEN
        IF( JSCALE > 1 )THEN
          ! linear grid definition does not exist, use preceding scale
          ISMAX = GRID_DEFINITION(MAX(1,JSCALE-1))%NSMAX
        ELSE
          CALL ABOR1('SUBJBWAVTRANS: Cannot locate linear or reduced grid for JSCALE=1 grid')
        ENDIF
      ENDIF
    ENDIF
  ENDIF
  IF( NPROC > 1 )THEN
    CALL MPL_BROADCAST (ISMAX,ITAG,IOMASTER,CDSTRING='SUJBWAVTRANS:')
  ENDIF

  GRID_DEFINITION(JSCALE)%NSMAX = ISMAX

!     If this resolution has already been defined, copy its GRID_DEFINITION
!     NB: Pointer-equivalencing of arrays -- beware!!

  IF (JSCALE>1 .AND. ISMAX == GRID_DEFINITION(MAX(1,JSCALE-1))%NSMAX) THEN
    WRITE (NULOUT,*) 'Wavelet scale ',JSCALE,&
     & ' uses the same transforms as the preceding scale'  

    GRID_DEFINITION(JSCALE)%NSMAX       = GRID_DEFINITION(JSCALE-1)%NSMAX
    GRID_DEFINITION(JSCALE)%NRESOL_ID   = GRID_DEFINITION(JSCALE-1)%NRESOL_ID
    GRID_DEFINITION(JSCALE)%NDGLG       = GRID_DEFINITION(JSCALE-1)%NDGLG
    GRID_DEFINITION(JSCALE)%NSPEC2      = GRID_DEFINITION(JSCALE-1)%NSPEC2
    GRID_DEFINITION(JSCALE)%NGPTOT      = GRID_DEFINITION(JSCALE-1)%NGPTOT
    GRID_DEFINITION(JSCALE)%NGPTOTG     = GRID_DEFINITION(JSCALE-1)%NGPTOTG
    GRID_DEFINITION(JSCALE)%NGPTOTL    => GRID_DEFINITION(JSCALE-1)%NGPTOTL
    GRID_DEFINITION(JSCALE)%NGPTOTMX    = GRID_DEFINITION(JSCALE-1)%NGPTOTMX
    GRID_DEFINITION(JSCALE)%NPTRFLOFF   = GRID_DEFINITION(JSCALE-1)%NPTRFLOFF
    GRID_DEFINITION(JSCALE)%NUMP        = GRID_DEFINITION(JSCALE-1)%NUMP 
    GRID_DEFINITION(JSCALE)%NBLOCKSL    = GRID_DEFINITION(JSCALE-1)%NBLOCKSL
    GRID_DEFINITION(JSCALE)%NBLOCKSG    = GRID_DEFINITION(JSCALE-1)%NBLOCKSG
    GRID_DEFINITION(JSCALE)%NLOENG     => GRID_DEFINITION(JSCALE-1)%NLOENG
    GRID_DEFINITION(JSCALE)%GELAM      => GRID_DEFINITION(JSCALE-1)%GELAM
    GRID_DEFINITION(JSCALE)%GELAT      => GRID_DEFINITION(JSCALE-1)%GELAT
    GRID_DEFINITION(JSCALE)%GW         => GRID_DEFINITION(JSCALE-1)%GW
    GRID_DEFINITION(JSCALE)%NSTA       => GRID_DEFINITION(JSCALE-1)%NSTA
    GRID_DEFINITION(JSCALE)%NONL       => GRID_DEFINITION(JSCALE-1)%NONL
    GRID_DEFINITION(JSCALE)%NPTRFRSTLAT=> GRID_DEFINITION(JSCALE-1)%NPTRFRSTLAT
    GRID_DEFINITION(JSCALE)%NFRSTLAT   => GRID_DEFINITION(JSCALE-1)%NFRSTLAT
    GRID_DEFINITION(JSCALE)%NLSTLAT    => GRID_DEFINITION(JSCALE-1)%NLSTLAT
    GRID_DEFINITION(JSCALE)%MYMS       => GRID_DEFINITION(JSCALE-1)%MYMS
    GRID_DEFINITION(JSCALE)%NASM0      => GRID_DEFINITION(JSCALE-1)%NASM0

  ELSE

!     Define the number of latitude rows and the number of gridpoints on
!     the equator-most rows. The grids are linear and not reduced.
!     The transform package insists that NDLON=2*NDGLG, so choose IDGL to be
!     factorizable into products of 2's, 3's and 5's to suit the FFTs.

    IF( MYPROC == IOMASTER )THEN
      OPEN(NULTMP,FILE=CLRTABLEFIL,ACTION="READ")
      NRGRI(:)=0
      CALL POSNAM(NULTMP,'NAMRGRI')
      READ (NULTMP,NAMRGRI) 
      CLOSE(NULTMP)
      IDGL=1
      DO WHILE( NRGRI(IDGL)>0 )
        IDGL=IDGL+1
      ENDDO
      IDGL=IDGL-1
    ENDIF
    IF( NPROC > 1 )THEN
      CALL MPL_BROADCAST (IDGL,ITAG,IOMASTER,CDSTRING='SUJBWAVTRANS:')
    ENDIF
    GRID_DEFINITION(JSCALE)%NDGLG = IDGL
    ALLOCATE (GRID_DEFINITION(JSCALE)%NLOENG(IDGL))
    IF( MYPROC == IOMASTER )THEN
      GRID_DEFINITION(JSCALE)%NLOENG(1:IDGL)=NRGRI(1:IDGL)
    ENDIF
    IF( NPROC > 1 )THEN
      CALL MPL_BROADCAST (GRID_DEFINITION(JSCALE)%NLOENG(:),ITAG,IOMASTER,CDSTRING='SUJBWAVTRANS:')
    ENDIF

!       Setup the transform package

    CALL SETUP_TRANS (KSMAX=ISMAX, KDGL=IDGL, &
     & KLOEN=GRID_DEFINITION(JSCALE)%NLOENG(:), &
     & LDSPLIT=LSPLIT, &
     & KRESOL=GRID_DEFINITION(JSCALE)%NRESOL_ID)

    WRITE(NULOUT,*) 'Defined an additional spectral resolution: id=', &
     & GRID_DEFINITION(JSCALE)%NRESOL_ID, ' truncation=',ISMAX, &
     & ' number of gaussian latitudes=',IDGL  
    WRITE(NULOUT,*) 'Number of points on each row=',GRID_DEFINITION(JSCALE)%NLOENG(:)

!       Interrogate the transform package to determine the data layout

    ALLOCATE(GRID_DEFINITION(JSCALE)%NPTRFRSTLAT(N_REGIONS_NS))
    ALLOCATE(GRID_DEFINITION(JSCALE)%NFRSTLAT(N_REGIONS_NS))
    ALLOCATE(GRID_DEFINITION(JSCALE)%NLSTLAT(N_REGIONS_NS))
    ALLOCATE(GRID_DEFINITION(JSCALE)%NSTA(IDGL+N_REGIONS_NS-1,N_REGIONS_EW))
    ALLOCATE(GRID_DEFINITION(JSCALE)%NONL(IDGL+N_REGIONS_NS-1,N_REGIONS_EW))
    ALLOCATE(GRID_DEFINITION(JSCALE)%NGPTOTL(N_REGIONS_NS,N_REGIONS_EW))
    ALLOCATE(GRID_DEFINITION(JSCALE)%NASM0(0:ISMAX))
    ALLOCATE(GRID_DEFINITION(JSCALE)%GW(IDGL))
    ALLOCATE(ZMU(IDGL))

    CALL TRANS_INQ (KRESOL=      GRID_DEFINITION(JSCALE)%NRESOL_ID, &
     & KSPEC2=      GRID_DEFINITION(JSCALE)%NSPEC2, &
     & KGPTOT=      GRID_DEFINITION(JSCALE)%NGPTOT, &
     & KGPTOTG=     GRID_DEFINITION(JSCALE)%NGPTOTG, &
     & KGPTOTL=     GRID_DEFINITION(JSCALE)%NGPTOTL, &
     & KGPTOTMX=    GRID_DEFINITION(JSCALE)%NGPTOTMX, &
     & KPTRFRSTLAT= GRID_DEFINITION(JSCALE)%NPTRFRSTLAT, &
     & KFRSTLAT=    GRID_DEFINITION(JSCALE)%NFRSTLAT, &
     & KLSTLAT=     GRID_DEFINITION(JSCALE)%NLSTLAT, &
     & KSTA=        GRID_DEFINITION(JSCALE)%NSTA, &
     & KONL=        GRID_DEFINITION(JSCALE)%NONL, &
     & KPTRFLOFF=   GRID_DEFINITION(JSCALE)%NPTRFLOFF, &
     & KNUMP=       GRID_DEFINITION(JSCALE)%NUMP, &
     & KASM0=       GRID_DEFINITION(JSCALE)%NASM0, &
     & PGW=         GRID_DEFINITION(JSCALE)%GW, &
     & PMU=         ZMU)  

    ALLOCATE(GRID_DEFINITION(JSCALE)%MYMS(GRID_DEFINITION(JSCALE)%NUMP))
    CALL TRANS_INQ (KRESOL=GRID_DEFINITION(JSCALE)%NRESOL_ID, &
     & KMYMS= GRID_DEFINITION(JSCALE)%MYMS)  

!       Calculate the latitudes and longitudes of the grid points

    IGPTOT = GRID_DEFINITION(JSCALE)%NGPTOT
    GRID_DEFINITION(JSCALE)%NBLOCKSL = (IGPTOT+NPROMA-1)/NPROMA

    GRID_DEFINITION(JSCALE)%NBLOCKSG = GRID_DEFINITION(JSCALE)%NBLOCKSL
    IF (NPROC>1) THEN
      CALL MPL_ALLREDUCE (KSENDBUF=GRID_DEFINITION(JSCALE)%NBLOCKSG, &
                        & CDOPER='SUM',CDSTRING='SUJBWAVTRANS')  
    ENDIF

    ALLOCATE(GRID_DEFINITION(JSCALE)%GELAM(IGPTOT))
    ALLOCATE(GRID_DEFINITION(JSCALE)%GELAT(IGPTOT))

    CALL CALC_GELAM_GELAT (JSCALE,ZMU,GRID_DEFINITION(JSCALE)%GELAM,&
     & GRID_DEFINITION(JSCALE)%GELAT)  

    DEALLOCATE(ZMU)
  ENDIF

ENDDO SETUP_LOOP

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

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

CONTAINS
SUBROUTINE CALC_GELAM_GELAT (KSCALE,PMU,PELAM,PELAT)
!      -----------------------------------------------------------------
!      Calculate latitudes and longitudes of gridpoints.
!      -----------------------------------------------------------------

INTEGER(KIND=JPIM), INTENT(IN)  :: KSCALE
REAL(KIND=JPRB),    INTENT(IN)  :: PMU(:)
REAL(KIND=JPRB),    INTENT(OUT) :: PELAM(:), PELAT(:)
INTEGER(KIND=JPIM) :: JLON, JGLAT, IOFF, ISTLON, IENDLON, ILAT
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('SUJBWAVTRANS:CALC_GELAM_GELAT',0,ZHOOK_HANDLE)
IOFF=0
ILAT=GRID_DEFINITION(KSCALE)%NPTRFLOFF

DO JGLAT=GRID_DEFINITION(KSCALE)%NFRSTLAT(MY_REGION_NS), &
   & GRID_DEFINITION(KSCALE)%NLSTLAT(MY_REGION_NS)  
  ZLAT=ASIN(PMU(JGLAT))
  ILAT=ILAT+1
  ISTLON  = GRID_DEFINITION(KSCALE)%NSTA(ILAT,MY_REGION_EW)
  IENDLON = ISTLON-1 + GRID_DEFINITION(KSCALE)%NONL(ILAT,MY_REGION_EW)

  DO JLON=ISTLON,IENDLON
    ZLON=  REAL(JLON-1,JPRB)*2.0_JPRB*RPI &
     & /REAL(GRID_DEFINITION(KSCALE)%NLOENG(JGLAT),JPRB)  
    IOFF=IOFF+1
    PELAM(IOFF) = ZLON
    PELAT(IOFF) = ZLAT
  ENDDO
ENDDO
IF (LHOOK) CALL DR_HOOK('SUJBWAVTRANS:CALC_GELAM_GELAT',1,ZHOOK_HANDLE)

END SUBROUTINE CALC_GELAM_GELAT

END SUBROUTINE SUJBWAVTRANS
