SUBROUTINE SUMDDH
!****
!     ------------------------------------------------------------------

!     SUMDDH * LOGIQUES DES MASQUES UTILISATEURS ET INTERNE
!     DIAGNOSTICS PAR DOMAINES HORIZONTAUX
!     ------------------------------------

!       -------------------------------------------------------
!     BUT
!     ---
!       CONSTRUCTION DU MASQUE INTERNE FINAL ET DES TABLEAUX DE
!      DISTRIBUTION DES DOMAINES UTILISATEUR EN DOMAINES INTERNES
!       LES DIFFERENTES ETAPES SONT
!       - MISE AU FORMAT DES INFORMATIONS SUR LES DOMAINES UTILISATEUR
!         PASSAGE EN RADIANS ET MU, VERIFICATION DES CONTRAINTES
!       - PRE-INITIALISATION DES MASQUES
!       - MASQUE BANDES DE LATITUDE
!       - MASQUES DOMAINES LIMITES SUIVI DES POINTS
!       - DEDUCTION DU MASQUE INTERNE ET DES TABLEAUX DE LECTURE
!       - CALCULS DES POIDS D INTERPOLATION, POIDS DE CHAQUE POINT
!         ET POIDS DE CHAQUE DOMAINE UTILISATEUR

!       DANS L INTERPRETATION DES DEMANDES DE L UTILISATEUR, UNE
!      DOUBLE LOGIQUE EST EN PLACE : TOUTE ERREUR EST, DANS CETTE
!      VERSION, CONSIDEREE COMME FATALE ET PROVOQUE UN STOP. MAIS
!      EN MEME TEMPS, UN RECOMPTAGE DES 'BONS' DOMAINES EST EFFECTUE
!      ET PERMETTRAIT DE CONTINUER SUR CEUX-LA SEULS

!     ARGUMENTS D ENTREE
!     ------------------

!     ARGUMENTS IMPLICITES
!     --------------------
!       UNITE NULOUT
!       INDICATEURS LOGIQUES, COMMON /YOMLDDH/
!         DANS LE COMDECK * YOMMDDH * POUR LES MASQUES
!       DIMENSIONS PROPRES AUX MASQUES DIAGNOSTIQUES DDH, COMMON /DDHDIM/
!       POINTEURS PROPRES AUX MASQUES DIAGNOSTIQUES DDH, COMMON /POMMDDH/
!       DECLARATION DES MASQUES ET LEURS AUXILLIAIRES EN FONCTION DES
!       LOGIQUES

!       DECLARATION DES DOMAINES BDEDDH
!       RPI
!       COORDONNEES GEOGRAPHIQUES LONGITUDES GELAM(0:NDLSM,NG2C,NDGSAG:NDGENG)
!                                 SINUS LATITUDES GEMU(0:NDLSM,NG2C,NDGSAG:NDGENG)
!                                 DEFINIS SUR (1:NDLON,-,1,NDGLG)
!         NOTE : PAS DE DIAGNOSTICS DDH SUR LES LATITUDES SUPPLEMENTAIRES
!                --------------------------------------------------------
!       POIDS DE GAUSS RW(NDGLG)
!       NOMBRE DE LONGITUDE PAR LATITUDE NLOEN(NDGSAG:NDGENG)
!       Mapping factor GM(0:NDLSM,1,NDGLG)

!     AUTRES ENTREES
!     --------------

!     SORTIES
!     -------
!       ETIQUETAGE STANDARD DES DOMAINES : FNODDH
!       SUIVANT LES LOGIQUES, A CHAQUE POINT DE LA GRILLE DE CALCUL
!       SONT ASSOCIES
!       - UN INDICE DE BANDE DE LATITUDE NDDHLA
!       - UN INDICE DE DOMAINE UTILISATEUR PAR PLAN MEMOIRE OU MASQUE
!         NDDHPU
!         L INDICE 0 DESIGNE LE COMPLEMENTAIRE DE TOUS LES DOMAINES
!         EXPLICITE, ET EST UTILE POUR LES MOYENNES GLOBALES
!          CES DEUX ENSEMBLES NE SONT UTILES QUE POUR DEFINIR
!       - UN INDICE GENERALISE ET UNIQUE DE PARTITION DE LA GRILLE
!         EN DOMAINES INTERNES : CHAQUE INTERSECTION DES DOMAINES
!         CI-DESSUS DONNE UN DOMAINE INTERNE
!       - A CHAQUE DOMAINE DE L UTILISATEUR (BANDE LATITUDE, DOMAINE LIMITE,
!         POINT) EST ASSOCIE UNE SUITE D INDICES DE DOMAINES INTERNES
!         DONT LA REUNION FORME LE DOMAINE UTILISATEUR EN QUESTION
!          NDDHI ET NLRDDH, NURDDH
!         LE NOMBRE D ELEMENTS DE CHAQUE SUITE EST AUSSI CONSIGNE
!          NLXDDH ET NUXDDH
!       - A CHAQUE DOMAINE DE L UTILISATEUR EST ASSOCIE SON POIDS
!         MOYEN OU SURFACE REELLE, AINSI QU A CHAQUE POINT DE
!         DE LA GRILLE DE CALCUL. UN DOMAINE PARTICULIER EST LE GLOBE
!         ENTIER
!          HDSFLA ET HDSFDU, HDSF, HDSFGL

!     ORIGINAL
!     --------
!     90-04-20, Alain Joly.

!     MODIFICATIONS
!     -------------
!     92-05-05, J.M. Piriou: partition des points en bandes de latitude.
!     94-01-21, J.M. Piriou: allegement des contraintes d'intervalle
!                            sur les valeurs de longitude fournies
!                            via namelist.
!     94-06-01, J.M. Piriou:
!                      - distance de deux points sur la sphere
!                        estimee par la distance orthodromique
!                        et non plus par une distance euclidienne
!                        en (lamda/pi) et mu.
!                      - lors de l'introduction de points isoles,
!                        controle de leur existence prealable
!                        afin d'eviter la redondance.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

!      Modified 95-03-01 by M.Hamrud (F90 re-write)
!      Modified 97-03-07 by P. Marquet (rm bug for serial in section 3.)
!    Modified 2000-05-19 by J.M. Piriou(rm bug for SM in section 1).
!      R. El Khatib : 01-08-07 Pruning options
!     2005-07-13, M. Jerczynski: ddh for Aladin restored; improvements expected
!      D.Salmond      22-Nov-2005 Mods for coarser/finer physics
!     2008-12-15, J.M. Piriou: rm bug when defining a DDH domain from integer indices (ITYPE=1).
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NDGSAG   ,NDGENG   ,NDGENL   ,NDLON ,&
                  &NDGSAL      ,NDGUXL   ,NDLUXG
USE YOMCT0   , ONLY : N_REGIONS,N_REGIONS_NS,N_REGIONS_EW,NPRINTLEV,LELAM
USE YOMCST   , ONLY : RPI      ,RD
USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMGC    , ONLY : GEMU     ,GELAM    ,GM       ,GAW
USE YOMGEM   , ONLY : NSTAGP   ,NGPTOT   ,NTSTAGP  ,NGPTOT_CAP
USE YOM_PHYS_GRID ,ONLY : PHYS_GRID
USE YOMCOAPHY , ONLY : NPHYINT
USE YOMLEG   , ONLY : RW
USE YOMLDDH  , ONLY : LSDDH    ,LHDGLB   ,LHDZON   ,LHDDOP   ,LHDLIST
USE YOMMDDH  , ONLY : JPDHNOX  ,JPDHXPU  ,NDHKD    ,NDHNPU   ,NDHBPU   ,&
 & NDHBPX   ,NDHNOM   ,NDHDDX   ,NDHIDH   ,FNODDH   ,BDEDDH   ,&
 & HDSFGL   ,NDDHLA   ,NDDHPU   ,NDDHI    ,NLRDDH   ,NURDDH   ,&
 & NLXDDH   ,NUXDDH   ,HDSFLA   ,HDSFDU   ,HDSF  
USE YOMMP    , ONLY : MY_REGION_NS   ,MY_REGION_EW   ,NSTA     ,NONL     ,&
 & NPTRFRSTLAT,NPTRLSTLAT,NFRSTLAT ,NLSTLAT  ,LSPLITLAT,&
 & MYLATS   ,NPTRFLOFF  

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

IMPLICIT NONE

INTEGER(KIND=JPIM) :: INDB(JPDHXPU), IDOM(JPDHXPU), IINX(JPDHXPU)
INTEGER(KIND=JPIM),ALLOCATABLE :: ILOEN(:)
INTEGER(KIND=JPIM),ALLOCATABLE :: ILOEX(:)
INTEGER(KIND=JPIM) :: IPUMASK(NDHNOM),IHLALIST(NDHKD+1)
CHARACTER :: CLTIT*(80)
LOGICAL :: LLOCUP
LOGICAL :: LLFLAG(NDHNOM)
REAL(KIND=JPRB) :: ZCOMM(7)
INTEGER(KIND=JPIM) :: IBOX(NDHNPU,NDHNOM)
INTEGER(KIND=JPIM) :: IGLOB(2,NDHNOM)
INTEGER(KIND=JPIM) :: IPTRFRSTLAT(N_REGIONS_NS),IFRSTLAT(N_REGIONS_NS),ILSTLAT(N_REGIONS_NS)
INTEGER(KIND=JPIM),ALLOCATABLE :: IONL(:,:)
INTEGER(KIND=JPIM),ALLOCATABLE :: ISTAGP(:)
INTEGER(KIND=JPIM),ALLOCATABLE :: ISTA(:,:)
REAL(KIND=JPRB),ALLOCATABLE :: ZGELAM(:),ZGEMU(:)
LOGICAL,ALLOCATABLE :: LLTMPMASK(:)

INTEGER(KIND=JPIM) :: IA, IADD, IB, ICOUNT, IDBM, IDHNOM, &
 & IENDLAT, IGL, IGL0, IGL1, IGL2, IGLOFF, IGLOFFM, &
 & IGUN, IGUX, IIGL, IJBLAT, ILAT, ILATG, ILOLA, &
 & ILON, ILONG, ILUN, ILUX, IMASK, INCIDE, INORBO, &
 & INPT, INPTT, IROF, ISTALAT, ITYPE, &
 & J1, J2, JB, JBOX, JDOM, JGL, JGLLOC, &
 & JKD, JLON, JMASK, JNUM, I_KPE, I_NHLAMAX, &
 & I_NHLAMIN , IDGENL, IPTRFLOFF , JIPRB

LOGICAL :: LLDEJS, LLFIRST

REAL(KIND=JPRB) :: PX, PY, Z2PI, ZA1, ZA2, ZCONRD, ZDIST, ZDISTN,&
 & ZL1, ZL2, ZL3, ZL4, ZLG, ZLP2, ZLP4, ZM1, &
 & ZM2, ZM3, ZM4, ZMG, ZMP1, ZMP3  

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "distddh.intfb.h"
#include "dladdh.intfb.h"
#include "dmaddh.intfb.h"
#include "gl2ll.intfb.h"
#include "primddh.intfb.h"

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

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

!     ------------------------------------------------------------------
!**   0. INITIALISATION DES DIMENSIONS AFIN DE RENDRE
!        LES POIDS UTILISES DANS LES DDH COMPATIBLES
!        TANT AVEC ARPEGE QU'AVEC ALADIN.

IF (NPRINTLEV >= 1) THEN
  WRITE (NULOUT,*) ' * DDH * LOGIQUE DES DOMAINES HORIZONTAUX'
ENDIF

IGUN=1
ILUN=1
IF(NPHYINT == 0) THEN
  IDGENL=NDGENL
  IPTRFRSTLAT(:)=NPTRFRSTLAT(:)
  IGLOFF=IPTRFRSTLAT(MY_REGION_NS)
  IFRSTLAT(:)=NFRSTLAT(:)
  IGL1=IFRSTLAT(MY_REGION_NS)
  ILSTLAT(:)=NLSTLAT(:)
  IGL2=ILSTLAT(MY_REGION_NS)
  IPTRFLOFF=NPTRFLOFF
  ALLOCATE(ILOEN(NDGSAG:NDGENG))
  ALLOCATE(IONL(NDGSAG:NDGENG+N_REGIONS_NS-1,N_REGIONS_EW))
  IONL(:,:)=NONL(:,:)
  ILOEN(1:1+IGL2-IGL1)=IONL(IGLOFF:IGLOFF+IGL2-IGL1,MY_REGION_EW)
  ALLOCATE(ZGELAM(NGPTOT))
  ZGELAM(:)=GELAM(:)
  ALLOCATE(ZGEMU(NGPTOT))
  ZGEMU(:)=GEMU(:)
  ALLOCATE(ISTAGP(NDGSAL:NDGENL))
  ALLOCATE(ISTA(NDGSAG:NDGENG+N_REGIONS_NS-1,N_REGIONS_EW))
  ISTA(:,:)=NSTA(:,:)
  IF (LELAM) THEN
    ALLOCATE(LLTMPMASK(NGPTOT_CAP))
    ISTAGP(:)=NTSTAGP(:)
    IGUX=NDGUXL
    ! * allocate and compute ILOEX (needed for LELAM only):
    ALLOCATE(ILOEX(NDGSAG:NDGENG))
    IIGL=0
    DO JGL=IGL1,IGL2
      IGL=IGLOFF+JGL-IGL1
      IIGL=IIGL+1
      ILOEX(IIGL) = 0
      DO JIPRB=1,MY_REGION_EW-1
        ILOEX(IIGL) = ILOEX(IIGL) + IONL(IGL,JIPRB)
      ENDDO
      IF ( ILOEX(IIGL) >= NDLUXG ) THEN
        ILOEX(IIGL) = 0
      ELSE
        ILOEX(IIGL) = MIN(NDLUXG,ILOEX(IIGL)+IONL(IGL,MY_REGION_EW)) - ILOEX(IIGL)
      ENDIF
    ENDDO
  ELSE
    ALLOCATE(LLTMPMASK(NGPTOT))
    ISTAGP(:)=NSTAGP(:)
    IGUX=IDGENL
  ENDIF
ELSE
  IF (LELAM) CALL ABOR1(' SUMDDH: LELAM not coded for NPHYINT>0')
  IDGENL=PHYS_GRID%NDGENL
  IPTRFRSTLAT(:)=PHYS_GRID%NPTRFRSTLAT(:)
  IGLOFF=IPTRFRSTLAT(MY_REGION_NS)
  IFRSTLAT(:)=PHYS_GRID%NFRSTLAT(:)
  IGL1=IFRSTLAT(MY_REGION_NS)
  ILSTLAT(:)=PHYS_GRID%NLSTLAT(:)
  IGL2=ILSTLAT(MY_REGION_NS)
  IPTRFLOFF=PHYS_GRID%NPTRFLOFF
  ALLOCATE(ILOEN(PHYS_GRID%NDGSAG:PHYS_GRID%NDGENG))
  ALLOCATE(ILOEX(PHYS_GRID%NDGSAG:PHYS_GRID%NDGENG))
  ALLOCATE(LLTMPMASK(PHYS_GRID%NGPTOT))
  ALLOCATE(IONL(PHYS_GRID%NDGSAG:PHYS_GRID%NDGENG+N_REGIONS_NS-1,N_REGIONS_EW))
  IONL(:,:)=PHYS_GRID%NONL(:,:)
  ILOEN(1:1+IGL2-IGL1)=IONL(IGLOFF:IGLOFF+IGL2-IGL1,MY_REGION_EW)
  ALLOCATE(ZGELAM(NGPTOT))
  ZGELAM(:)=GELAM(:)
  ALLOCATE(ZGEMU(NGPTOT))
  ZGEMU(:)=GEMU(:)
  ALLOCATE(ISTAGP(PHYS_GRID%NDGSAL:PHYS_GRID%NDGENL))
  ISTAGP(:)=PHYS_GRID%NSTAGP(:)
  ALLOCATE(ISTA(PHYS_GRID%NDGSAG:PHYS_GRID%NDGENG+N_REGIONS_NS-1,N_REGIONS_EW))
  ISTA(:,:)=PHYS_GRID%NSTA(:,:)
  IGUX=IDGENL
ENDIF

LLFLAG(:) = .FALSE.
IBOX(:,:)=0
IGLOB(:,:)=0
Z2PI = 2.0_JPRB*RPI
ZCONRD = RPI/180._JPRB
DO J2 = 1, JPDHNOX
  DO J1 = 1, 11
    FNODDH(J1,J2) = 0.0_JPRB
  ENDDO
ENDDO
IDHNOM = 1

!     ------------------------------------------------------------------
!**   1. MISE EN FORME DES DOMAINES UTILISATEUR
IF ( LHDDOP ) THEN

!     INDICATEUR D INCIDENT
  INCIDE = 0

  DO JBOX = 1, NDHNOM
    ITYPE = NINT( BDEDDH(1,JBOX) )
    IMASK = NINT( BDEDDH(2,JBOX) )

!     LE DOMAINE EST UN POINT DEFINI PAR SES INDICES SUR LA GRILLE DE
!     CALCUL (JLON,JGL)
!     ------------------------------------------------------------------
    IF ( ITYPE == 1 ) THEN
      LLFLAG(JBOX)=.TRUE.
      ILONG = NINT ( BDEDDH(3,JBOX) )
      ILATG = NINT ( BDEDDH(4,JBOX) )
!fw
!fw
!fw   !!!!!!   conversion from global ilon,ilat necessary
!fw
      CALL GL2LL(ILATG,ILONG,I_KPE,ILAT,ILON)
!fw

!     LE POINT EST-IL BIEN DANS LA GRILLE ?
!fw
!fw  !!!!!!     hier muss evtl communiziert werden wenn der
!fw               Punkt zum wertebereich des procs gehoert
!fw
      IF ( ILAT < IGUN .OR. ILAT > IGUX ) THEN
        WRITE (NULOUT,*) ' ERREUR DDH DOMAINE POINT ',JBOX,&
         & ' MAUVAIS INDICE LATITUDE ',ILAT  
        WRITE (NULOUT,*) ' LIMITES ',IGUN,' A ',IGUX
        INCIDE = INCIDE + 1
        GO TO 100
      ENDIF

      IF ( LELAM ) THEN
        ILUX = ILOEX(ILAT)
      ELSE
        ILUX = ILOEN(ILAT)
      ENDIF
      IF ( ILON < ILUN .OR. ILON > ILUX ) THEN
        WRITE (NULOUT,*) ' ERREUR DDH DOMAINE POINT ',JBOX,&
         & ' MAUVAIS INDICE LONGITUDE ',ILON  
        WRITE (NULOUT,*) ' LIMITES ',ILUN,' A ',ILUX
        INCIDE = INCIDE + 1
        GO TO 100
      ENDIF

!     LE POINT EST ACCEPTE

!     A-T-IL ETE DEJA SAISI DANS LES PROPOSITIONS PRECEDENTES?

      LLDEJS=.FALSE.

      IF(.NOT.LLDEJS) THEN

!           LE POINT EST ACCEPTE.

        IF (NPRINTLEV >= 1) THEN
          WRITE (NULOUT,*) ' '
          WRITE (NULOUT,*) ' DOMAINE ',JBOX,' FINAL ',IDHNOM,&
           & ' MASQUE = ',IMASK  
          WRITE (NULOUT,*) ' POINT JLON = ',ILON,' JGL = ',ILAT
        ENDIF
!fw
        
        IF (NPRINTLEV >= 1) THEN
          WRITE (NULOUT,*) ' GELAM = ',ZGELAM(ILON+ISTAGP(ILAT)-1)
          WRITE (NULOUT,*) ' GEMU = ',ZGEMU(ILON+ISTAGP(ILAT)-1)
          WRITE (NULOUT,*) ' LONGITUDE GEO1 (DEGRES) : ',&
           & ZGELAM(ILON+ISTAGP(ILAT)-1)/ZCONRD  
          WRITE (NULOUT,*) ' LATITUDE GEO (DEGRES) : ',&
           & ASIN( ZGEMU(ILON+ISTAGP(ILAT)-1) )/ZCONRD  
        ENDIF
        IGLOB(1,IDHNOM)=ILONG
        IGLOB(2,IDHNOM)=ILATG

        FNODDH(1,IDHNOM) = REAL(IMASK,JPRB)
        FNODDH(3,IDHNOM) = ZGELAM(ILON+ISTAGP(ILAT))
        FNODDH(4,IDHNOM) = ZGEMU(ILON+ISTAGP(ILAT))
        FNODDH(5,IDHNOM) = REAL(ILON,JPRB)
        FNODDH(6,IDHNOM) = REAL(ILAT,JPRB)
        FNODDH(11,IDHNOM) = REAL(ITYPE,JPRB)
        IDHNOM = IDHNOM + 1
      ELSE

!           LE POINT EST REFUSE CAR REDONDANT.

        IF (NPRINTLEV >= 1) THEN
          WRITE (NULOUT,*) ' '
          WRITE (NULOUT,*) ' DOMAINE ',JBOX,' MASQUE = ',IMASK
          WRITE (NULOUT,*) ' POINT JLON = ',ILON,' JGL = ',ILAT
          WRITE (NULOUT,*) ' GELAM = ',ZGELAM(ILON+ISTAGP(ILAT)-1)
          WRITE (NULOUT,*) ' GEMU = ',ZGEMU(ILON+ISTAGP(ILAT)-1)
          WRITE (NULOUT,*) ' LONGITUDE GEO2 (DEGRES) : ',&
           & ZGELAM(ILON+ISTAGP(ILAT)-1)/ZCONRD  
          WRITE (NULOUT,*) ' LATITUDE GEO (DEGRES) : ',&
           & ASIN( ZGEMU(ILON+ISTAGP(ILAT)-1) )/ZCONRD  
          WRITE (NULOUT,*) ' CE POINT EST REDONDANT ET N''A'&
           & ,' DE FAIT PAS ETE SAISI.'  
        ENDIF
      ENDIF

    ENDIF
!fw   !!!!!   end conversion necessary
!     ------------------------------------------------------------------

!     LE DOMAINE EST LIMITE, DEFINI PAR SES QUATRES COINS
!     SOUS FORME DE COUPLES LONGITUDE,LATITUDE EN DEGRES
!     ------------------------------------------------------------------
    IF ( ITYPE == 2 ) THEN
      ZL1 = BDEDDH(3,JBOX)*ZCONRD
      ZM1 = SIN( BDEDDH(4,JBOX)*ZCONRD )
      ZL2 = BDEDDH(5,JBOX)*ZCONRD
      ZM2 = SIN( BDEDDH(6,JBOX)*ZCONRD )
      ZL3 = BDEDDH(7,JBOX)*ZCONRD
      ZM3 = SIN( BDEDDH(8,JBOX)*ZCONRD )
      ZL4 = BDEDDH(9,JBOX)*ZCONRD
      ZM4 = SIN( BDEDDH(10,JBOX)*ZCONRD )

!     VERIFICATION DES CONTRAINTES
!     DANS CETTE DEFINITION, LES ZM. SONT BIEN COMPRIS ENTRE -1. ET 1.

      IF ( ZL1 < 0.0_JPRB .OR. ZL1 > 4._JPRB*RPI ) GO TO 110
      IF ( ZL2 < 0.0_JPRB .OR. ZL2 > 4._JPRB*RPI ) GO TO 110
      IF ( ZL3 < 0.0_JPRB .OR. ZL3 > 4._JPRB*RPI ) GO TO 110
      IF ( ZL4 < 0.0_JPRB .OR. ZL4 > 4._JPRB*RPI ) GO TO 110

      IF ( ZL2 <= ZL1 ) GO TO 110
      IF ( ZM3 >= ZM2 ) GO TO 110
      IF ( ZL3 <= ZL4 ) GO TO 110
      IF ( ZM1 <= ZM4 ) GO TO 110

!     QUAND TOUT VA BIEN ...
      GO TO 112
!     QUAND QUELQUE CHOSE N EST PAS CONFORME
      110 CONTINUE
      WRITE (NULOUT,*) ' ERREUR DDH DEFINITION DOMAINE 4 COINS',&
       & ' NON CONFORME '  
      WRITE (NULOUT,*) ' DEFINITION BRUTE VOIR LIGNE ',JBOX,' DE BDEDDH '
      WRITE (NULOUT,*) ' COUPLES EN COORD. LON(RD), MU '
      WRITE (NULOUT,*) ' L1 = ',ZL1,' M1 = ',ZM1
      WRITE (NULOUT,*) ' L2 = ',ZL2,' M2 = ',ZM2
      WRITE (NULOUT,*) ' L3 = ',ZL3,' M3 = ',ZM3
      WRITE (NULOUT,*) ' L4 = ',ZL4,' M4 = ',ZM4
      WRITE (NULOUT,*) ' REPORTEZ VOUS A LA DOCUMENTATION '
      INCIDE = INCIDE + 100
      GO TO 100

!     LE DOMAINE EST ACCEPTE
      112 CONTINUE
      IF (NPRINTLEV >= 1) THEN
        WRITE (NULOUT,*) ' '
        WRITE (NULOUT,*) ' DOMAINE ',JBOX,' FINAL ',IDHNOM,' MASQUE = ',IMASK
        WRITE (NULOUT,*) ' COUPLES EN COORD. LON(RD), MU '
        WRITE (NULOUT,*) ' L1 = ',ZL1,' M1 = ',ZM1
        WRITE (NULOUT,*) ' L2 = ',ZL2,' M2 = ',ZM2
        WRITE (NULOUT,*) ' L3 = ',ZL3,' M3 = ',ZM3
        WRITE (NULOUT,*) ' L4 = ',ZL4,' M4 = ',ZM4
        WRITE (NULOUT,*) ' DEFINITION EN DEGRES VOIR LIGNE ',&
         & JBOX,' DE BDEDDH '  
      ENDIF

      FNODDH(1,IDHNOM) = REAL(IMASK,JPRB)
      FNODDH(3,IDHNOM) = ZL1
      FNODDH(4,IDHNOM) = ZM1
      FNODDH(5,IDHNOM) = ZL2
      FNODDH(6,IDHNOM) = ZM2
      FNODDH(7,IDHNOM) = ZL3
      FNODDH(8,IDHNOM) = ZM3
      FNODDH(9,IDHNOM) = ZL4
      FNODDH(10,IDHNOM) = ZM4
      FNODDH(11,IDHNOM) = REAL(ITYPE,JPRB)
      IDHNOM = IDHNOM + 1

    ENDIF
!     ------------------------------------------------------------------

!     LE DOMAINE EST LIMITE, DEFINI PAR DEUX COINS OPPOSES
!     SOUS FORME DE COUPLES (LONGITUDE,LATITUDE) EN DEGRES
!     ------------------------------------------------------------------
    IF ( ITYPE == 3 ) THEN
      ZL1 = BDEDDH(3,JBOX)*ZCONRD
      ZM1 = SIN( BDEDDH(4,JBOX)*ZCONRD )
      ZL2 = BDEDDH(5,JBOX)*ZCONRD
      ZM2 = ZM1
      ZL3 = ZL2
      ZM3 = SIN( BDEDDH(6,JBOX)*ZCONRD )
      ZL4 = ZL1
      ZM4 = ZM3

!     VERIFICATION DES CONTRAINTES
!     DANS CETTE DEFINITION, LES ZM. SONT BIEN COMPRIS ENTRE -1. ET 1.

      IF ( ZL1 < 0.0_JPRB .OR. ZL1 > 4._JPRB*RPI ) GO TO 114
      IF ( ZL2 < 0.0_JPRB .OR. ZL2 > 4._JPRB*RPI ) GO TO 114
      IF ( ZL3 < 0.0_JPRB .OR. ZL3 > 4._JPRB*RPI ) GO TO 114
      IF ( ZL4 < 0.0_JPRB .OR. ZL4 > 4._JPRB*RPI ) GO TO 114

      IF ( ZL2 <= ZL1 ) GO TO 114
      IF ( ZM3 >= ZM2 ) GO TO 114
      IF ( ZL3 <= ZL4 ) GO TO 114
      IF ( ZM1 <= ZM4 ) GO TO 114

!     QUAND TOUT VA BIEN ...
      GO TO 116
!     QUAND QUELQUE CHOSE N EST PAS CONFORME
      114 CONTINUE
      WRITE (NULOUT,*) ' ERREUR DDH DEFINITION DOMAINE 2 COINS',&
       & ' NON CONFORME '  
      WRITE (NULOUT,*) ' DEFINITION BRUTE VOIR LIGNE ',JBOX,' DE BDEDDH '
      WRITE (NULOUT,*) ' COUPLES EN COORD. LON(RD), MU '
      WRITE (NULOUT,*) ' L1 = ',ZL1,' M1 = ',ZM1
      WRITE (NULOUT,*) ' L2 = ',ZL2,' M2 = ',ZM2
      WRITE (NULOUT,*) ' L3 = ',ZL3,' M3 = ',ZM3
      WRITE (NULOUT,*) ' L4 = ',ZL4,' M4 = ',ZM4
      WRITE (NULOUT,*) ' REPORTEZ VOUS A LA DOCUMENTATION '
      INCIDE = INCIDE + 1000
      GO TO 100

!     LE DOMAINE EST ACCEPTE
      116 CONTINUE
      IF (NPRINTLEV >= 1) THEN
        WRITE (NULOUT,*) ' '
        WRITE (NULOUT,*) ' DOMAINE ',JBOX,' FINAL ',IDHNOM,' MASQUE = ',IMASK
        WRITE (NULOUT,*) ' COUPLES EN COORD. LON(RD), MU '
        WRITE (NULOUT,*) ' L1 = ',ZL1,' M1 = ',ZM1
        WRITE (NULOUT,*) ' L2 = ',ZL2,' M2 = ',ZM2
        WRITE (NULOUT,*) ' L3 = ',ZL3,' M3 = ',ZM3
        WRITE (NULOUT,*) ' L4 = ',ZL4,' M4 = ',ZM4
        WRITE (NULOUT,*) ' DEFINITION EN DEGRES VOIR LIGNE ',&
         & JBOX,' DE BDEDDH '  
      ENDIF

      FNODDH(1,IDHNOM) = REAL(IMASK,JPRB)
      FNODDH(3,IDHNOM) = ZL1
      FNODDH(4,IDHNOM) = ZM1
      FNODDH(5,IDHNOM) = ZL2
      FNODDH(6,IDHNOM) = ZM2
      FNODDH(7,IDHNOM) = ZL3
      FNODDH(8,IDHNOM) = ZM3
      FNODDH(9,IDHNOM) = ZL4
      FNODDH(10,IDHNOM) = ZM4
      FNODDH(11,IDHNOM) = REAL(ITYPE,JPRB)
      IDHNOM = IDHNOM + 1

    ENDIF
!     ------------------------------------------------------------------

!     LE DOMAINE EST UN POINT DEFINI PAR SES LONGITUDE ET LATITUDE
!     EN DEGRES; IL DEVIENT LE POINT DE LA GRILLE LE PLUS PROCHE
!     ------------------------------------------------------------------
    IF ( ITYPE == 4 ) THEN
      ZL1 = BDEDDH(3,JBOX)*ZCONRD
      ZA1 = BDEDDH(4,JBOX)*ZCONRD
      ZM1 = SIN( ZA1 )
!     RECHERCHE DU POINT LE PLUS PROCHE
!     AU SENS DE LA DISTANCE ORTHODROMIQUE SUR LA SPHERE.
!     LA GRANDEUR ZDIST CALCULEE CI-DESSOUS EST LE COSINUS
!     DE L'ANGLE AU CENTRE DES DEUX POINTS CONSIDERES;
!     ELLE EST D'AUTANT PLUS GRANDE QUE LES POINTS SONT PROCHES.
      ILON = 1
      ILAT = 1
!fw
!fw   for lmessp zdistn incresed since you need to find a point
!fw
      ZDISTN = -99._JPRB

      DO JGL = IGUN, IGUX
        IF ( LELAM ) THEN
          ILUX = ILOEX(JGL)
        ELSE
          ILUX = ILOEN(JGL)
        ENDIF
        DO JLON = ILUN, ILUX
          ZL2=ZGELAM(JLON+ISTAGP(JGL) -1)
          ZA2=ASIN(ZGEMU(JLON+ISTAGP(JGL) -1))
          ZDIST = COS(ZA1)*COS(ZA2)*COS(ZL1-ZL2)+ SIN(ZA1)*SIN(ZA2)
          IF ( ZDIST > ZDISTN ) THEN
            ZDISTN = ZDIST
            ILON = JLON
            ILAT = JGL
          ENDIF
        ENDDO
      ENDDO

!     LE POINT ILON ILAT REALISE LA DISTANCE MINIMALE.
!     A-T-IL ETE DEJA SAISI DANS LES PROPOSITIONS PRECEDENTES?

      LLDEJS=.FALSE.

!fw
!fw      communication of distances and maximum
!fw
      ZCOMM(1)=ZDISTN
      ZCOMM(2)=ILON
      ZCOMM(3)=ILAT
      ZCOMM(4)=ZGELAM(ILON+ISTAGP(ILAT)-1)
      ZCOMM(5)=ZGEMU(ILON+ISTAGP(ILAT)-1)
      ZCOMM(6)=MY_REGION_NS
      ZCOMM(7)=MY_REGION_EW
      CALL DISTDDH(ZCOMM,LLFLAG(JBOX))
      ZDISTN=ZCOMM(1)
      ILON=ZCOMM(2)
      ILAT=ZCOMM(3)
      IA  =ZCOMM(6)
      IB  =ZCOMM(7)

!     Determine Global LON LAT and store in IGLOB

      ILATG=ILAT+IFRSTLAT(IA)-1
      ILONG=ILON
      IGLOFF = IPTRFRSTLAT(IA)

!        Is this latitude split over A-sets

      IF( LSPLITLAT(ILATG) )THEN

!          Split latitude, determine whether we are on western or
!          eastern side of split

        IF( ISTA(ILAT+IGLOFF-1,1) == 1 )THEN

!            Western side of split, 
!            add previous B-set nonl's for this latitude

          DO JB=1,IB-1
            ILONG=ILONG+IONL(ILAT+IGLOFF-1,JB)
          ENDDO
        ELSE

!            Eastern side of split, (ILAT can only be 1)
!            add all B-set nonl's from previous A-set for this latitude,
!            and previous B-set nonl's for this latitude/A-set

          IF( IA <= 1 )THEN
            WRITE(NULERR,'("SUMDDH:INTERNAL ERROR, IA <= 1 IS ",&
             & I3,&
             & " IB=",I3," ILON=",I4," ILAT=",I4," ILATG=",I4)')&
             & IA,IB,ILON,ILAT,ILATG  
            CALL ABOR1("SUMDDH: INTERNAL ERROR, IA <= 1")
          ENDIF
          IF( ILAT /= 1 )THEN
            WRITE(NULERR,'("SUMDDH: INTERNAL ERROR, ILAT=",I4,&
             & " ILATG=",I4," IA=",I3," IB=",I3)')&
             & ILAT,ILATG,IA,IB  
            CALL ABOR1("SUMDDH: INTERNAL ERROR, ILAT /= 1")
          ENDIF
          IGLOFFM = NPTRLSTLAT(IA-1)
          DO JB=1,N_REGIONS(IA)
            ILONG=ILONG+IONL(IGLOFFM,JB)
          ENDDO
          DO JB=1,IB-1
            ILONG=ILONG+IONL(IGLOFF,JB)
          ENDDO
        ENDIF
      ELSE

!          Latitude is not split

        DO JB=1,IB-1
          ILONG=ILONG+IONL(ILAT+IGLOFF-1,JB)
        ENDDO
      ENDIF
      IGLOB(1,IDHNOM)=ILONG
      IGLOB(2,IDHNOM)=ILATG
!fw
      IF(.NOT.LLDEJS) THEN

!           LE POINT EST ACCEPTE.

        IF (NPRINTLEV >= 1) THEN
          WRITE (NULOUT,*) ' '
          WRITE (NULOUT,*) ' DOMAINE ',JBOX,' FINAL ',IDHNOM,&
           & ' MASQUE = ',IMASK  
          WRITE (NULOUT,*) ' POINT JLON = ',ILON,' JGL = ',ILAT
          WRITE (NULOUT,*) ' LONGITUDE GEO3 (DEGRES) : ',&
           & ZCOMM(4)/ZCONRD,' POUR ',ZL1/ZCONRD  
          WRITE (NULOUT,*) ' LATITUDE GEO (DEGRES) : ',&
           & ASIN( ZCOMM(5) )/ZCONRD,' POUR ',&
           & ZA1/ZCONRD  
        ENDIF
        FNODDH(1,IDHNOM) = REAL(IMASK,JPRB)
        FNODDH(3,IDHNOM) = ZCOMM(4)
        FNODDH(4,IDHNOM) = ZCOMM(5)
        FNODDH(5,IDHNOM) = REAL(ILON,JPRB)
        FNODDH(6,IDHNOM) = REAL(ILAT,JPRB)
        FNODDH(7,IDHNOM) = ZL1
        FNODDH(8,IDHNOM) = ZM1
        FNODDH(11,IDHNOM) = REAL(ITYPE,JPRB)
        IDHNOM = IDHNOM + 1
      ELSE

!           LE POINT EST REFUSE CAR REDONDANT.

        WRITE (NULOUT,*) ' '
        WRITE (NULOUT,*) ' DOMAINE ',JBOX,' MASQUE = ',IMASK
        WRITE (NULOUT,*) ' POINT JLON = ',ILON,' JGL = ',ILAT
        WRITE (NULOUT,*) ' LONGITUDE GEO4 (DEGRES) : ',&
         & ZGELAM(ILON+ISTAGP(ILAT)-1)/ZCONRD,' POUR ',ZL1/ZCONRD  
        WRITE (NULOUT,*) ' LATITUDE GEO (DEGRES) : ',&
         & ASIN( ZGEMU(ILON+ISTAGP(ILAT)-1) )/ZCONRD,' POUR ',&
         & ZA1/ZCONRD  
        WRITE (NULOUT,*) ' CE POINT EST REDONDANT ET N''A'&
         & ,' DE FAIT PAS ETE SAISI.'  
      ENDIF

    ENDIF

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

!     FIN DU BALAYAGE DES PROPOSITIONS BRUTES
    100 continue
  ENDDO

!     COMPARAISON DOMAINES OK ET DEMANDE INITIALE
  INORBO = IDHNOM - 1
  IF ( INORBO /= NDHNOM ) THEN
    WRITE (NULOUT,*) ' ERREUR DDH * NB DE DOMAINES EFFECTIF',&
     & ' DIVERGENT NDHNOM = ',NDHNOM,' APRES CONTROLE = ',INORBO  
    WRITE (NULOUT,*) ' NDHNOM CHANGE '
    NDHNOM = INORBO
  ENDIF

  DO JMASK = 1, NDHNPU
    IDBM = 0
    DO JBOX = 1, NDHNOM
      IMASK = NINT( FNODDH(1,JBOX) )
      IF ( IMASK == JMASK ) THEN
        IDBM = IDBM + 1
      ENDIF
    ENDDO
    IF ( IDBM == 0 ) THEN
      WRITE (NULOUT,*) ' ERREUR DDH PLAN VIDE ',JMASK
      WRITE (NULOUT,*) ' DDH * CE PLAN EST GARDE POUR RIEN'
    ENDIF
  ENDDO

!     DECISION D ARRET EN PRESENCE D INCIDENTS
!     ----------------------------------------
  IF ( INCIDE == 0 ) GO TO 190
  WRITE (NULERR,*) ' ERREUR DDH ***   *** '
  WRITE (NULERR,*) ' INCIDE = ',INCIDE
  WRITE (NULERR,*) ' DDH CONSIDERE UNE AU MOINS DES ERREURS',&
   & ' PRECEDENTES COMME TERMINALE '  
  CALL ABOR1('SUMDDH:DDH CONSIDERE UNE AU MOINS DES ERREURS')

  190 CONTINUE
!     FIN DE 1.
ENDIF

!     ------------------------------------------------------------------
!**   2. PRE-INITIALISATION DES PLANS MEMOIRE OU MASQUES

IF ( LSDDH ) THEN
!fw

  ISTALAT=1
  IF ( LELAM ) THEN
    IENDLAT=NDGUXL
  ELSE
    IENDLAT=IDGENL
  ENDIF
  IROF=0
  DO JGLLOC = ISTALAT,IENDLAT
    IROF=ISTAGP(JGLLOC)-1
    DO JLON = ISTA(IPTRFLOFF+JGLLOC,MY_REGION_EW),&
       & ISTA(IPTRFLOFF+JGLLOC,MY_REGION_EW)+&
       & IONL(IPTRFLOFF+JGLLOC,MY_REGION_EW)-1  
      IROF=IROF+1
      NDDHI(IROF) = 0
    ENDDO
  ENDDO
!FW
ENDIF
IF ( LHDZON ) THEN
!fw
  ISTALAT=1
  IF ( LELAM ) THEN
    IENDLAT=NDGUXL
  ELSE
    IENDLAT=IDGENL
  ENDIF
  IROF=0
  DO JGLLOC = ISTALAT,IENDLAT
    IROF=ISTAGP(JGLLOC)-1
    DO JLON = ISTA(IPTRFLOFF+JGLLOC,MY_REGION_EW),&
       & ISTA(IPTRFLOFF+JGLLOC,MY_REGION_EW)+&
       & IONL(IPTRFLOFF+JGLLOC,MY_REGION_EW)-1  
      IROF=IROF+1
      NDDHLA(IROF) = 0
    ENDDO
  ENDDO
!fw
  DO JGL = 1, NDHKD
    NLXDDH(JGL) = 1
  ENDDO
ENDIF
IF ( LHDDOP ) THEN
!fw
  NDDHPU(:,:) = 0
!FW
  DO JMASK = 1, NDHNPU
    DO JBOX = 0, NDHBPX
      NUXDDH(JBOX,JMASK) = 1
    ENDDO
  ENDDO
ENDIF

!     ------------------------------------------------------------------
!**   3. PARTITION DES POINTS EN BANDES DE LATITUDES
IF ( LHDZON ) THEN
  IF (NPRINTLEV >= 1) THEN
    WRITE (NULOUT,*) ' '
    WRITE (NULOUT,*) ' DDH * CREATION PLAN LATITUDES '
    WRITE (NULOUT,*) ' '
  ENDIF
!fw
  I_NHLAMAX=-999
  I_NHLAMIN=999
  ICOUNT=0
!fw

  DO JGL = IGUN, IGUX
    DO JLON = ILUN, ILOEN(JGL)
!fw
!fw        setup tables (IHLALIST) of latitude bands on this 
!fw        processor
!fw

      NDDHLA(JLON+ISTAGP(JGL)-1)=&
       & NINT((1.0_JPRB-ZGEMU(JLON+ISTAGP(JGL)-1))&
       & *REAL(NDHKD,JPRB)*0.5_JPRB+0.5_JPRB)  
      IF (NDDHLA(JLON+ISTAGP(JGL)-1) > I_NHLAMAX) THEN
        ICOUNT=ICOUNT+1
        IHLALIST(ICOUNT+1)=NDDHLA(JLON+ISTAGP(JGL)-1)
        I_NHLAMAX=NDDHLA(JLON+ISTAGP(JGL)-1)
        IF(I_NHLAMIN == 999) I_NHLAMIN=I_NHLAMAX
      ELSEIF (NDDHLA(JLON+ISTAGP(JGL)-1) < I_NHLAMIN) THEN
        ICOUNT=ICOUNT+1
        IHLALIST(ICOUNT+1)=NDDHLA(JLON+ISTAGP(JGL)-1)
        I_NHLAMIN=NDDHLA(JLON+ISTAGP(JGL)-1)
        IF(I_NHLAMAX == -999) I_NHLAMAX=I_NHLAMIN
      ELSE
!fw
!fw    not really an error, only the fact that the band is already
!fw    in the list
!fw               print*,' ERROR SUMDDH :: NDDHLA '
      ENDIF
!fw

    ENDDO
  ENDDO
!fw
!fw
!fw     send table IHLALIST  
!fw
!fw         if master receive table
!fw
  IHLALIST(1)=ICOUNT
  CALL DLADDH(IHLALIST)
!fw
ENDIF

!     ------------------------------------------------------------------
!**   4. INITIALISATION DES PLANS MEMOIRES - DOMAINES LIMITES
DO JMASK = 1, JPDHXPU
  INDB(JMASK) = 0
ENDDO

IF ( LHDDOP ) THEN

  IF (NPRINTLEV >= 1) THEN
    WRITE (NULOUT,*) ' '
    WRITE (NULOUT,*) ' DDH * CREATION PLANS DOMAINES LIMITES'
    WRITE (NULOUT,*) ' '
  ENDIF

  DO JBOX = 1, NDHNOM

!     LE TYPE DOMAINE LIMITE EST ISOLE
    ITYPE = NINT( FNODDH(11,JBOX) )
    IF ( ITYPE /= 2.AND. ITYPE /= 3 ) GO TO 410

    JMASK = NINT( FNODDH(1,JBOX) )
    ZL1 = FNODDH(3,JBOX)
    ZM1 = FNODDH(4,JBOX)
    ZL2 = FNODDH(5,JBOX)
    ZM2 = FNODDH(6,JBOX)
    ZL3 = FNODDH(7,JBOX)
    ZM3 = FNODDH(8,JBOX)
    ZL4 = FNODDH(9,JBOX)
    ZM4 = FNODDH(10,JBOX)

!     L INDICE DU DOMAINE LIMITE EST FIXE
!     IL EST ENREGISTRE ET PUBLIE
    INDB(JMASK) = INDB(JMASK) + 1
    IBOX(JMASK,INDB(JMASK))=JBOX
    FNODDH(2,JBOX) = REAL( INDB(JMASK) ,JPRB)
    IF (NPRINTLEV >= 1) THEN
      WRITE (NULOUT,*) ' '
      WRITE (NULOUT,*) ' LE DOMAINE ',JBOX,&
       & ' EST LE DOMAINE INDICE ',INDB(JMASK),&
       & ' DU PLAN ',JMASK  
      WRITE (NULOUT,*) ' '
    ENDIF

!     AFFECTATION DES POINTS : CHAQUE POINT DE LA GRILLE DE CALCUL
!     EST TESTE : EST-IL A L INTERSECTION DES QUATRES DEMI-PLANS QUI
!     DEFINISSENT LE DOMAINE ?

    DO JGL = IGUN, IGUX
      IF ( LELAM ) THEN
        ILUX = ILOEX(JGL)
      ELSE
        ILUX = ILOEN(JGL)
      ENDIF
      DO JLON = ILUN, ILUX
!FW
        ZLG = ZGELAM(JLON+ISTAGP(JGL)-1)
        ZMG = ZGEMU(JLON+ISTAGP(JGL)-1)
!FW

!     MODIFICATION DE LA LONGITUDE EFFECTIVE POUR LES DOMAINES
!     A CHEVAL SUR 0. (GREENWICH ?)
        IF ( ZL2 >= Z2PI .OR. ZL3 >= Z2PI ) THEN
          IF ( ZLG <= MAX( ZL3-Z2PI,ZL2-Z2PI ) )ZLG = ZLG + Z2PI
        ENDIF

        ZMP1 = ((ZM2-ZM1)*ZLG + (ZM1*ZL2-ZM2*ZL1))/(ZL2-ZL1)
        IF ( ZMG > ZMP1 ) GO TO 412

        ZLP2 = ((ZL3-ZL2)*ZMG + (ZM3*ZL2-ZM2*ZL3))/(ZM3-ZM2)
        IF ( ZLG > ZLP2 ) GO TO 412

        ZMP3 = ((ZM4-ZM3)*ZLG + (ZM3*ZL4-ZM4*ZL3))/(ZL4-ZL3)
        IF ( ZMG < ZMP3 ) GO TO 412

        ZLP4 = ((ZL1-ZL4)*ZMG + (ZM1*ZL4-ZM4*ZL1))/(ZM1-ZM4)
        IF ( ZLG < ZLP4 ) GO TO 412

!     LE POINT EST DANS L INTERSECTION DES DEMI-PLANS
        NDDHPU(JLON+ISTAGP(JGL)-1,JMASK) = INDB(JMASK)
        412 continue
      ENDDO
    ENDDO

    410 continue
  ENDDO

ENDIF

!     ------------------------------------------------------------------
!**   5. INITIALISATION DES PLANS MEMOIRE - POINTS
IF ( LHDDOP ) THEN

  IF (NPRINTLEV >= 1) THEN
    WRITE (NULOUT,*) ' '
    WRITE (NULOUT,*) ' DDH * POINTS '
    WRITE (NULOUT,*) ' '
  ENDIF

  DO JBOX = 1, NDHNOM

    ITYPE = NINT( FNODDH(11,JBOX) )

    IF ( ITYPE /= 1.AND. ITYPE /= 4 ) GO TO 500

    JMASK = NINT( FNODDH(1,JBOX) )
!fw  !!!!!   ilon,ilat is global values needs to be translated in local
!fw  !!!!!    should be ok later since these values would be communicated
!fw  !!!!!    earlier 
    ILON = NINT( FNODDH(5,JBOX) )
    ILAT = NINT( FNODDH(6,JBOX) )

!     L INDICE DU POINT EST FIXE
!     IL EST ENREGISTRE ET PUBLIE
    INDB(JMASK) = INDB(JMASK) + 1
    IBOX(JMASK,INDB(JMASK))=JBOX
    FNODDH(2,JBOX) = REAL( INDB(JMASK) ,JPRB)
    IF (NPRINTLEV >= 1) THEN
      WRITE (NULOUT,*) ' '
      WRITE (NULOUT,*) ' LE POINT ',JBOX,&
       & ' EST LE DOMAINE INDICE ',INDB(JMASK),&
       & ' DU PLAN ',JMASK  
      WRITE (NULOUT,*) ' '
    ENDIF

    IF(LLFLAG(JBOX)) THEN
      IF(NDDHPU(ILON+ISTAGP(ILAT)-1,JMASK) == 0) THEN
        NDDHPU(ILON+ISTAGP(ILAT)-1,JMASK) = INDB(JMASK)
      ELSE
        WRITE (NULOUT,*) ' WARNING: DOMAIN ',INDB(JMASK), &
         & ' LEFT EMPTY. GRID POINT IDENTICAL TO DOMAIN', &
         & NDDHPU(ILON+ISTAGP(ILAT)-1,JMASK)  
      ENDIF
    ENDIF
    500 continue
  ENDDO
!fw
!fw
ENDIF

!*    CONTROLE FINAL DU NOMBRE MAXI DE DOMAINES PAR PLANS
IF ( LHDDOP ) THEN
  DO JMASK = 1, NDHNPU
    IF ( INDB(JMASK) /= NDHBPU(JMASK) ) THEN
      WRITE (NULOUT,*) ' ERREUR DDH * PLAN ',JMASK,&
       & ' PREVU AVEC ',NDHBPU(JMASK),' DOMAINES CONTIENT ',&
       & INDB(JMASK),' DOMAINES '  
      WRITE (NULOUT,*) ' CORRECTION AUTO DDH '
      NDHBPU(JMASK) = INDB(JMASK)
    ENDIF
  ENDDO
ENDIF

IF (NPRINTLEV >= 1) THEN
  WRITE (NULOUT,*) ' '
  WRITE (NULOUT,*) ' -------------------------------- DDH '
  WRITE (NULOUT,*) ' DOMAINES LIMITES * NOMENCLATURE '
  WRITE (NULOUT,*) '      NDHNOM = ',NDHNOM
  WRITE (NULOUT,*) ' '
  DO JBOX = 1, JPDHNOX
    WRITE (NULOUT,553) (FNODDH(JNUM,JBOX),JNUM=1,11)
    553 FORMAT ( T5,11(F7.3,1X) )
  ENDDO
  WRITE (NULOUT,*) ' ------------------------------- DDH'
  WRITE (NULOUT,*) ' '
ENDIF

!*    CALCUL DU NOMBRE DE POINTS A PLACER

ILOLA = 0
DO JGL = IGUN, IGUX
  ILOLA = ILOLA + ILOEN(JGL)
ENDDO

!     ------------------------------------------------------------------
!**   6. DETERMINATION DES DOMAINES INTERNES
NDHIDH = 0
IF (NPRINTLEV >= 1) THEN
  WRITE (NULOUT,*) ' '
  WRITE (NULOUT,*) ' * DDH * DECOUPAGE EN DOMAINES INTERNES '
  WRITE (NULOUT,*) ' '
ENDIF

!*    6.1 - MOYENNES ZONALES ET DOMAINES LIMITES COEXISTENT
!     ------------------------------------------------------------------
!           LES MOYENNES GLOBALES SONT AUTOMATIQUEMENT POSSIBLES
IF ( LHDZON .AND. LHDDOP ) THEN

!*    TOUTES LES COMBINAISONS D INDICES DE DOMAINES SONT EXPLOREES
!     TOUR A TOUR. DES QU AU MOINS UN POINT EST TROUVE DANS UNE TELLE
!     COMBINAISON, UN DOMAINE INTERNE EST DECLARE. LES DIFFERENTS TABLEAUX
!     LIES A CETTE COMBINAISON SONT RENSEIGNES, EN PARTICULIER LE RESTE
!     DES POINTS DE GRILLE SONT EXPLORES POUR METTRE A JOUR LE MASQUE
!     INTERNE

  INPTT = 0
  DO JKD = 1, NDHKD
    IJBLAT = 1

!     COMBINAISON DE BASE DES DOMAINES LIMITES
    DO JMASK = 1, NDHNPU
      IDOM(JMASK) = 0
    ENDDO

!     ----------------------       610           -------------------
    610 CONTINUE

!     ON RECUPERE LA POSITION COURANTE DE RANGEMENT DANS LES
!     TABLEAUX DE DISTRIBUTION DES DOMAINES UTILISATEUR DANS LES
!     DOMAINES INTERNES
    DO JMASK = 1, NDHNPU
      IINX(JMASK) = NUXDDH( IDOM(JMASK),JMASK )
    ENDDO

!     CHERCHE UN POINT DANS LA COMBINAISON COURANTE
    INPT = 0
    DO JGL = IGUN, IGUX
      DO JLON = ILUN, ILOEN(JGL)
        LLOCUP = ( NDDHLA(JLON+ISTAGP(JGL)-1) == JKD )
        DO JMASK = 1, NDHNPU
          LLOCUP = LLOCUP .AND.&
           & ( NDDHPU(JLON+ISTAGP(JGL)-1,JMASK) == IDOM(JMASK) )  
        ENDDO
!     UN POINT EST TROUVE
        IF ( LLOCUP ) GO TO 620
      ENDDO
    ENDDO
!     AUCUN POINT N EXISTE DANS CETTE COMBINAISON
    GO TO 630
!                           ---------
!*    NOUVEAU DOMAINE INTERNE
!     -----------------------
    620 CONTINUE
    NDHIDH = NDHIDH + 1
    NLRDDH(IJBLAT,JKD) = NDHIDH
    IJBLAT = IJBLAT + 1
    DO JMASK = 1, NDHNPU
      NURDDH(IINX(JMASK),IDOM(JMASK),JMASK) = NDHIDH
      IINX(JMASK) = IINX(JMASK) + 1
    ENDDO
!     ETIQUETAGE DES POINTS DE CE DOMAINE
    IGL0 = JGL
    DO JGL = IGL0, IGUX
      DO JLON = ILUN, ILOEN(JGL)
        LLOCUP = ( NDDHLA(JLON+ISTAGP(JGL)-1) == JKD )
        DO JMASK = 1, NDHNPU
          LLOCUP = LLOCUP .AND.&
           & ( NDDHPU(JLON+ISTAGP(JGL)-1,JMASK) == IDOM(JMASK) )  
        ENDDO
!     UN POINT EST TROUVE
        IF ( LLOCUP ) NDDHI(JLON+ISTAGP(JGL)-1) = NDHIDH
        IF ( LLOCUP ) INPT = INPT + 1
      ENDDO
    ENDDO

!*    UNE COMBINAISON EST EPUISEE

    630 CONTINUE
! ------------------
    NLXDDH(JKD) = IJBLAT
    DO JMASK = 1, NDHNPU
      NUXDDH( IDOM(JMASK),JMASK ) = IINX(JMASK)
    ENDDO
    IF ( LHDLIST ) THEN
      WRITE (NULOUT,*) ' DDH COMBINAISON ',JKD,&
       & (IDOM(JMASK),JMASK=1,NDHNPU),' A ',INPT,' POINTS ',&
       & ' * DOMAINE NDHIDH = ',NDHIDH  
    ENDIF
    INPTT = INPTT + INPT

!*    LOGIQUE DE CHANGEMENT DE COMBINAISON, DOMAINES LIMITES
!                             -------------------
    DO JMASK = NDHNPU, 1, -1
      IDOM(JMASK) = IDOM(JMASK) + 1
      IF ( IDOM(JMASK) <= NDHBPU(JMASK) ) GO TO 610
!                                          --------------------------------
      IDOM(JMASK) = 0
    ENDDO

!*    FIN DE BOUCLE SUR LES CERCLES DE LATITUDE

  ENDDO

!*    FINITION DES TABLEAUX DE DISTRIBUTION

  DO JKD = 1, NDHKD
    NLXDDH(JKD) = NLXDDH(JKD) - 1
    DO JBOX = NLXDDH(JKD)+1, NDHIDH
      NLRDDH(JBOX,JKD) = 0
    ENDDO
  ENDDO
  DO JMASK = 1, NDHNPU
    DO JDOM = 0, NDHBPX
      NUXDDH(JDOM,JMASK) = NUXDDH(JDOM,JMASK) - 1
      DO JBOX = NUXDDH(JDOM,JMASK)+1, NDHIDH
        NURDDH(JBOX,JDOM,JMASK) = 0
      ENDDO
    ENDDO
  ENDDO

  IF (NPRINTLEV >= 1) THEN
    WRITE (NULOUT,*) ' '
    WRITE (NULOUT,*) ' DDH * FIN DE PARTITION * '
    WRITE (NULOUT,*) ' '
    WRITE (NULOUT,*) ' NB DE POINTS DISTRIBUES = ',INPTT
    WRITE (NULOUT,*) ' NB DE POINTS SUM(ILOEN) = ',ILOLA
    WRITE (NULOUT,*) ' '
  ENDIF

ENDIF

!*    6.2 - DOMAINES LIMITES ET EVENTUELLES MOYENNES GLOBALES
!     ------------------------------------------------------------------
IF ( .NOT.LHDZON .AND. LHDDOP ) THEN

!*    REPRISE DE L ALGORITHME PRECEDENT SANS LA BOUCLE SUR LES
!     BANDES DE LATITUDES

  INPTT = 0
!     COMBINAISON DE BASE DES DOMAINES LIMITES
  DO JMASK = 1, NDHNPU
    IDOM(JMASK) = 0
  ENDDO

!     ----------------------       710           -------------------
  710 CONTINUE

!     ON RECUPERE LA POSITION COURANTE DE RANGEMENT DANS LES
!     TABLEAUX DE DISTRIBUTION DES DOMAINES UTILISATEUR DANS LES
!     DOMAINES INTERNES
  DO JMASK = 1, NDHNPU
    IINX(JMASK) = NUXDDH( IDOM(JMASK),JMASK )
  ENDDO

!     CHERCHE UN POINT DANS LA COMBINAISON COURANTE
  INPT = 0
  LLTMPMASK(:)=.TRUE.
  DO JGL = IGUN, IGUX
    IADD=ISTAGP(JGL)-1
    DO JMASK = 1, NDHNPU
      DO JLON = ILUN, ILOEN(JGL)
        LLTMPMASK(JLON+IADD)=(LLTMPMASK(JLON+IADD).AND.&
         & (NDDHPU(JLON+IADD,JMASK) == IDOM(JMASK)))  
      ENDDO
    ENDDO
  ENDDO
!                           ---------
!*    NOUVEAU DOMAINE INTERNE
!     -----------------------
  720 CONTINUE
!     ETIQUETAGE DES POINTS DE CE DOMAINE
  LLFIRST=.TRUE.
  DO JGL = IGUN, IGUX
    IADD=ISTAGP(JGL)-1
    DO JLON = ILUN, ILOEN(JGL)
      LLOCUP = LLTMPMASK(JLON+IADD)
!     UN POINT EST TROUVE
      IF ( LLOCUP ) THEN
        IF ( LLFIRST ) THEN
          NDHIDH = NDHIDH + 1
          DO JMASK = 1, NDHNPU
            NURDDH(IINX(JMASK),IDOM(JMASK),JMASK) = NDHIDH
            IINX(JMASK) = IINX(JMASK) + 1
          ENDDO
          LLFIRST=.FALSE.
        ENDIF
        NDDHI(JLON+IADD) = NDHIDH
        INPT = INPT + 1
      ENDIF
    ENDDO
  ENDDO

!*    UNE COMBINAISON EST EPUISEE

  730 CONTINUE
! ------------------
  DO JMASK = 1, NDHNPU
    NUXDDH( IDOM(JMASK),JMASK ) = IINX(JMASK)
  ENDDO
  IF ( LHDLIST ) THEN
    WRITE (NULOUT,*) ' DDH COMBINAISON ',&
     & (IDOM(JMASK),JMASK=1,NDHNPU),' A ',INPT,' POINTS ',&
     & ' * DOMAINE NDHIDH = ',NDHIDH  
  ENDIF
  INPTT = INPTT + INPT

!*    LOGIQUE DE CHANGEMENT DE COMBINAISON, DOMAINES LIMITES
!                             -------------------
  DO JMASK = NDHNPU, 1, -1
    IDOM(JMASK) = IDOM(JMASK) + 1
    IF ( IDOM(JMASK) <= NDHBPU(JMASK) ) GO TO 710
!                                          --------------------------------
    IDOM(JMASK) = 0
  ENDDO

!*    FINITION DES TABLEAUX DE DISTRIBUTION
  DO JMASK = 1, NDHNPU
    DO JDOM = 0, NDHBPX
      NUXDDH(JDOM,JMASK) = NUXDDH(JDOM,JMASK) - 1
      DO JBOX = NUXDDH(JDOM,JMASK)+1, NDHIDH
        NURDDH(JBOX,JDOM,JMASK) = 0
      ENDDO
    ENDDO
  ENDDO

  IF (NPRINTLEV >= 1) THEN
    WRITE (NULOUT,*) ' '
    WRITE (NULOUT,*) ' DDH * FIN DE PARTITION * '
    WRITE (NULOUT,*) ' '
    WRITE (NULOUT,*) ' NB DE POINTS DISTRIBUES = ',INPTT
    WRITE (NULOUT,*) ' NB DE POINTS SUM(ILOEN) = ',ILOLA
    WRITE (NULOUT,*) ' '
  ENDIF

ENDIF

!*    6.3 - MOYENNES ZONALES ET EVENTUELLEMENT GLOBALES
!     ------------------------------------------------------------------
IF ( LHDZON .AND. .NOT.LHDDOP ) THEN
  NDHIDH = NDHKD
  DO JGL = IGUN, IGUX
    DO JLON = ILUN, ILOEN(JGL)
      NDDHI(JLON+ISTAGP(JGL)-1) = NDDHLA(JLON+ISTAGP(JGL)-1)
    ENDDO
  ENDDO
  DO JKD = 1, NDHKD
    NLRDDH( NLXDDH(JKD),JKD ) = JKD
  ENDDO

  IF (NPRINTLEV >= 1) THEN
    WRITE (NULOUT,*) ' '
    WRITE (NULOUT,*) ' LES DOMAINES INTERNES SONT LES LATITUDES'
    WRITE (NULOUT,*) ' '
  ENDIF

ENDIF

!*    6.4 - MOYENNES GLOBALES SEULES
!     ------------------------------
IF ( LHDGLB .AND. .NOT.LHDZON .AND. .NOT.LHDDOP ) THEN
  NDHIDH = 1
  DO JGL = IGUN, IGUX
    DO JLON = ILUN, ILOEN(JGL)
      NDDHI(JLON+ISTAGP(JGL)-1) = 1
    ENDDO
  ENDDO

  IF (NPRINTLEV >= 1) THEN
    WRITE (NULOUT,*) ' '
    WRITE (NULOUT,*) ' SEUL DOMAINE: ENSEMBLE DE LA GRILLE'
    WRITE (NULOUT,*) ' '
  ENDIF

ENDIF

IF (NPRINTLEV >= 1) THEN
  WRITE (NULOUT,*) ' '
  WRITE (NULOUT,*) ' DDH * SUMDDH * NEW RELEASE 1 '
  WRITE (NULOUT,*) ' ---   NOMBRE DE DOMAINES INTERNES = ',NDHIDH
  WRITE (NULOUT,*) ' '
ENDIF

!*    6.5 - IMPRESSIONS EVENTUELLES
!     ------------------------------
IF ( LHDLIST ) THEN
  IF ( LHDZON ) THEN
    CALL PRIMDDH (NDDHLA,NDLON,1,NDLON,IGUX,&
     & ' NDDHLA * BANDES DE LATITUDE ',NULOUT)  
  ENDIF

  IF ( LHDDOP ) THEN
    DO JMASK = 1, NDHNPU
      WRITE (CLTIT,'(T5,'' NDDHPU PLAN '',I2,'' * DOMAINES &
       & LIMITES '')'&
       & ) JMASK  
      CALL PRIMDDH (NDDHPU(1,JMASK),NDLON,1,NDLON,IGUX,CLTIT,NULOUT)
    ENDDO
  ENDIF

  CALL PRIMDDH (NDDHI,NDLON,1,NDLON,IGUX,&
   & ' NDDHI * DOMAINES INTERNES  ',NULOUT)  

!     EDITION DES INDICES EXTREMES
  IF ( LHDZON ) THEN
    CLTIT = ' NLXDDH * INDICES LIMITES, BANDES DE LATITUDES '
    CALL PRIMDDH (NLXDDH,NDHKD,1,NDHKD,1,CLTIT,NULOUT)
  ENDIF

  IF ( LHDDOP ) THEN
    DO JMASK = 1, NDHNPU
      WRITE (CLTIT,'(T5,'' NUXDDH PLAN '',I2,'' * '',&
       & ''INDICES LIMITES DOMAINES LIMITES '')') JMASK  
      CALL PRIMDDH (NUXDDH(0,JMASK),NDHBPX+1,1,NDHBPX+1,1,CLTIT,NULOUT)
    ENDDO
  ENDIF

  IF ( LHDZON ) THEN
    CLTIT = ' NLRDDH * DISTRIBUTION DES LATITUDES '
    CALL PRIMDDH (NLRDDH,NDHDDX,1,NDHIDH,NDHKD,CLTIT,NULOUT )
  ENDIF

  IF ( LHDDOP ) THEN
    DO JMASK = 1, NDHNPU
      WRITE (CLTIT,'(T5,'' NURDDH PLAN '',I2,'' * '',&
       & ''DISTRIBUTION DOMAINES LIMITES '')') JMASK  
      CALL PRIMDDH (NURDDH(1,0,JMASK),NDHDDX,1,NDHIDH,NDHBPX+1,CLTIT,NULOUT )
    ENDDO
  ENDIF
ENDIF

!     ------------------------------------------------------------------
!**   7. DETERMINATION DES POIDS D INTERPOLATION

IF (NPRINTLEV >= 1) THEN
  WRITE (NULOUT,*) ' '
  WRITE (NULOUT,*) ' * DDH * POIDS D INTERPOLATION '
  WRITE (NULOUT,*) ' '
ENDIF

!*    7.1 - POIDS SUR GRILLE DE GAUSS, POIDS GLOBAL
!     ------------------------------------------------------------------
IF ( LSDDH ) THEN
  HDSFGL = 0._JPRB
  HDSF(:) = GAW(:)
  DO JGL = IGUN, IGUX
    DO JLON = ILUN, ILOEN(JGL)
      IGL=MYLATS(JGL)
!             HDSF(JLON+ISTAGP(JGL)-1) = RW(JGL)/( REAL(NLOENG(IGL))*
!     W        GM(JLON+ISTAGP(JGL)-1)**2 )

      HDSFGL = HDSFGL + HDSF(JLON+ISTAGP(JGL)-1)
    ENDDO
  ENDDO
  ILAT = IGUX/2
  ILON = ILOEN(ILAT)/2
  IF (NPRINTLEV >= 1) THEN
    WRITE (NULOUT,*) ' '
    WRITE (NULOUT,*) ' DDH * POIDS POINT MILIEU '
    WRITE (NULOUT,*) ' JGL = ',ILAT,' JLON = ',ILON
    WRITE (NULOUT,*) ' RW = ',RW(ILAT),' ILOEN = ',ILOEN(ILAT)

    WRITE (NULOUT,*) ' GM    = ',GM(ILON+ISTAGP(ILAT)-1)
    WRITE (NULOUT,*) ' HDSF = ',HDSF(ILON+ISTAGP(ILAT)-1)
    WRITE (NULOUT,*) ' '
    WRITE (NULOUT,*) ' POIDS GLOBAL HDSFGL = ',HDSFGL
    WRITE (NULOUT,*) ' '
  ENDIF
ENDIF

!*    7.2 - POIDS DES CERCLES DE LATITUDE
!     -----------------------------------
IF ( LHDZON ) THEN
  DO JKD = 1, NDHKD
    HDSFLA(JKD) = 0.0_JPRB
  ENDDO
  DO JGL = IGUN, IGUX
    DO JLON = ILUN, ILOEN(JGL)
      HDSFLA(NDDHLA(JLON+ISTAGP(JGL)-1))=&
       & HDSFLA(NDDHLA(JLON+ISTAGP(JGL)-1))+&
       & HDSF(JLON+ISTAGP(JGL)-1)  
    ENDDO
  ENDDO

  IF ( LHDLIST ) THEN
    WRITE (NULOUT,*) ' POIDS LATITUDES '
    DO JKD = 1, NDHKD
      WRITE (NULOUT,*) ' JKD = ',JKD,' HDSFLA = ',HDSFLA(JKD)
    ENDDO
    WRITE (NULOUT,*) ' '
  ENDIF
ENDIF

!*    7.3 - POIDS DES DOMAINES USAGER
!     -------------------------------
IPUMASK(:)=0
IF ( LHDDOP ) THEN
  DO JMASK = 1, NDHNPU
    DO JBOX = 0, NDHBPX
      HDSFDU(JBOX,JMASK) = 0.0_JPRB
    ENDDO
  ENDDO
  DO JMASK = 1, NDHNPU
    DO JGL = IGUN, IGUX
      DO JLON = ILUN, ILOEN(JGL)

        HDSFDU( NDDHPU(JLON+ISTAGP(JGL)-1,JMASK),JMASK ) =&
         & HDSFDU( NDDHPU(JLON+ISTAGP(JGL)-1,JMASK),JMASK ) +&
         & HDSF(JLON+ISTAGP(JGL)-1)  
!GM
        IF( NDDHPU(JLON+ISTAGP(JGL)-1,JMASK) > 0 )THEN
          IPUMASK(IBOX(JMASK,NDDHPU(JLON+ISTAGP(JGL)-1,JMASK)))=1
        ENDIF
!GM

      ENDDO
    ENDDO
  ENDDO

  CALL DMADDH(IPUMASK)

  IF ( LHDLIST ) THEN
    WRITE (NULOUT,*) ' POIDS DOMAINES USAGER '
    WRITE (NULOUT,*) ' '
    DO JMASK = 1, NDHNPU
      WRITE (NULOUT,*) ' PLAN MEMOIRE ',JMASK
      WRITE (NULOUT,*) ' -------------------- '
      DO JBOX = 0, NDHBPU(JMASK)
        WRITE (NULOUT,*) ' DOMAINE ',JBOX,' HDSFDU = ',HDSFDU(JBOX,JMASK)
      ENDDO
    ENDDO
    WRITE (NULOUT,*) ' '
  ENDIF
ENDIF
!GM************
IF ( LHDDOP ) THEN
  DO JBOX=1,NDHNOM
    ITYPE = NINT( FNODDH(11,JBOX) )
    IF( ITYPE == 1.OR.ITYPE == 4 )THEN
      IF (NPRINTLEV >= 1) THEN
        WRITE(NULOUT,'("SUMDDHX:",2(2x,F5.1),2(2x,I6))')&
         & FNODDH(5,JBOX),FNODDH(6,JBOX),&
         & IGLOB(1,JBOX),IGLOB(2,JBOX)  
      ENDIF
      FNODDH(5,JBOX)=IGLOB(1,JBOX)
      FNODDH(6,JBOX)=IGLOB(2,JBOX)
    ENDIF
  ENDDO
ENDIF
!GM************

IF (NPRINTLEV >= 1) THEN
  WRITE (NULOUT,*) ' '
  WRITE (NULOUT,*) ' --------------------------------- DDH -'
ENDIF

DEALLOCATE(ILOEN)
DEALLOCATE(LLTMPMASK)
DEALLOCATE(IONL)
DEALLOCATE(ZGELAM)
DEALLOCATE(ZGEMU)
DEALLOCATE(ISTAGP)
DEALLOCATE(ISTA)

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

IF (LHOOK) CALL DR_HOOK('SUMDDH',1,ZHOOK_HANDLE)
END SUBROUTINE SUMDDH
