C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
                          SUBROUTINE MPPINIT      
C     ******************************************************************
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .
C SUBPROGRAM:    RADTN       THE OUTER RADIATION DRIVER
C   PRGRMMR: BLACK           ORG: W/NP22     DATE: 98-10-28
C
C ABSTRACT:
C     MPPINIT DETERMINES ALL RELEVANT VALUES FOR DIMENSIONS OF THE
C     DISTRIBUTED SUBDOMAINS AND THEIR HALOES.
C
C PROGRAM HISTORY LOG:
C   97-??-??  MEYS       - ORIGINATOR
C   97-??-??  BLACK      - CHANGES MADE FOR CLARITY
C   98-10-29  BLACK      - REWRITTEN FOR CLARITY
C
C USAGE: CALL RADTN FROM MAIN PROGRAM EBU
C   INPUT ARGUMENT LIST:
C     NONE
C
C   OUTPUT ARGUMENT LIST:
C     NONE
C
C   OUTPUT FILES:
C     NONE
C
C   SUBPROGRAMS CALLED:
C
C     UNIQUE:
C        NONE
C
C     LIBRARY:
C        NONE
C
C   COMMON BLOCKS: MPPCOM
C                  GLB_TABLE
C                  TEMPCOM
C                  TOPO
C                  MAPPINGS
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE : IBM SP
C$$$
C-----------------------------------------------------------------------
       INCLUDE "parmeta"
       INCLUDE "mpp.h"
       INCLUDE "mpif.h"
#include "sp.h"
C-----------------------------------------------------------------------
       INTEGER ISTAT(MPI_STATUS_SIZE)
C-----------------------------------------------------------------------
C***********************************************************************
C-----------------------------------------------------------------------
C***
C***  INPES AND JNPES ARE THE NUMBER OF PEs REQUESTED IN X AND Y.
C***  ICHUNK AND JCHUNK ARE THE FIRST GUESS OF THE NUMBER
C***  OF I's AND J's IN EACH SUBDOMAIN OBTAINED BY SIMPLY 
C***  DIVIDING THE GLOBAL DIMENSIONS BY THE NUMBER OF PEs 
C***  REQUESTED IN EACH DIRECTION.
C***  
      ICHUNK=IM/INPES
      JCHUNK=JM/JNPES
      IICHUNK=ICHUNK+1
C***
C***  COMPUTE THE GLOBAL START AND END INDEX VALUES
C***  FOR I (MY_IS_GLB,MY_IE_GLB) AND J (MY_JS_GLB,MY_JE_GLB)
C***  ON EACH PE.
C***  IN GENERAL, THE NUMBER OF POINTS IN EACH DIRECTION
C***  WILL NOT DIVIDE EVENLY WITH INPES AND JNPES.  THE
C***  LOGIC BELOW GIVES ONE EXTRA POINT TO AS MANY OF THE
C***  EARLIEST PEs IN EACH DIRECTION AS IT TAKES TO USE
C***  UP THE REMAINDER POINTS (ITAIL AND JTAIL, WHICH ARE
C***  COMPUTED IN parmeta).
C***
      IPE=0
      MY_JS_CALC=1
      JNCHUNKS=0
C
      DO J=1,JNPES
        JCHUNK_CALC=JCHUNK
        IF(J.LE.JTAIL)JCHUNK_CALC=JCHUNK+1
        JNCHUNKS=JNCHUNKS+JCHUNK_CALC
        MY_JE_CALC=JNCHUNKS
        MY_IS_CALC=1
        NCHUNKS=0
C
        DO I=1,INPES
          ICHUNK_CALC=ICHUNK
          IF(I.LE.ITAIL)ICHUNK_CALC=ICHUNK+1
          NCHUNKS=NCHUNKS+ICHUNK_CALC
          MY_IE_CALC=NCHUNKS 
          IF(MYPE.EQ.IPE)THEN
            MY_IS_GLB=MY_IS_CALC
            MY_IE_GLB=MY_IE_CALC
            MY_JS_GLB=MY_JS_CALC
            MY_JE_GLB=MY_JE_CALC
          ENDIF
          MY_IS_CALC=MY_IE_CALC+1 
          IPE=IPE+1
        ENDDO
C
        MY_JS_CALC=MY_JE_CALC+1
      ENDDO
C----------------------------------------------------------------------
C***
C***  ILPADx IS THE INCREMENT INTO THE LEFT HALO OF A SUBDOMAIN.
C***  IRPADx IS THE INCREMENT INTO THE RIGHT HALO OF A SUBDOMAIN.
C***  ILPADx IS ALWAYS 0 FOR SUBDOMAINS ALONG THE WEST GLOBAL BOUNDARY.
C***  IRPADx IS ALWAYS 0 FOR SUBDOMAINS ALONG THE EAST GLOBAL BOUNDARY.
C***
C***  ILCOL IS A FLAG TELLING WHETHER OR NOT A SUBDOMAIN IS ON THE
C***  WEST (LEFT) GLOBAL BOUNDARY.
C***
C***  IS_INCx_BND AND IE_INCx_BND ARE INCREMENTS FROM THE LOCAL 
C***  STARTING OR ENDING I VALUE AWAY FROM THE LOCAL BOUNDARY INTO THE
C***  SURBDOMAIN.  THEY ARE NONZERO ONLY FOR SUBDOMAINS ON THE WESTERN
C***  AND EASTERN GLOBAL BOUNDARIES.
C***
      ILPAD1=1
      ILPAD2=2
      ILPAD3=3
      ILPAD4=4
      ILPAD5=5
      IRPAD1=1
      IRPAD2=2
      IRPAD3=3
      IRPAD4=4
      IRPAD5=5
C
      ILCOL=0
      IRCOL=0
C
      IS_INC1_BND=0
      IS_INC2_BND=0
      IE_INC1_BND=0
      IE_INC2_BND=0
C
      IF(MOD(MYPE,INPES).EQ.0)THEN             !WESTERNMOST SUBDOMAINS
        ILPAD1=0
        ILPAD2=0
        ILPAD3=0
        ILPAD4=0
        ILPAD5=0
        ILCOL=1
        IS_INC1_BND=1
        IS_INC2_BND=2
      ENDIF
C
      IF(MOD(MYPE,INPES).EQ.INPES-1)THEN       !EASTERNMOST SUBDOMAINS
        IRPAD1=0
        IRPAD2=0
        IRPAD3=0
        IRPAD4=0
        IRPAD5=0
        IRCOL=1
        IE_INC1_BND=1
        IE_INC2_BND=2
        MY_IE_GLB=IM
      ENDIF
C----------------------------------------------------------------------
C***
C***  NOW DO THE SAME FOR THE J DIRECTION
C***
      JBPAD1=1
      JBPAD2=2
      JBPAD3=3
      JBPAD4=4
      JBPAD5=5
      JTPAD1=1
      JTPAD2=2
      JTPAD3=3
      JTPAD4=4
      JTPAD5=5
C
      IBROW=0
      ITROW=0
C
      JS_INC1_BND=0
      JS_INC2_BND=0
      JS_INC3_BND=0
      JS_INC4_BND=0
      JS_INC5_BND=0
      JE_INC1_BND=0
      JE_INC2_BND=0
      JE_INC3_BND=0
      JE_INC4_BND=0
      JE_INC5_BND=0
C
      IF(MYPE/INPES.EQ.0)THEN              !SOUTHERNMOST SUBDOMAINS
        JBPAD1=0
        JBPAD2=0
        JBPAD3=0
        JBPAD4=0
        JBPAD5=0
        IBROW=1
        JS_INC1_BND=1
        JS_INC2_BND=2
        JS_INC3_BND=3
        JS_INC4_BND=4
        JS_INC5_BND=5
      ENDIF
C
      IF(MYPE/INPES.EQ.JNPES-1)THEN        !NORTHERNMOST SUBDOMAINS
        JTPAD1=0
        JTPAD2=0
        JTPAD3=0
        JTPAD4=0
        JTPAD5=0
        ITROW=1
        JE_INC1_BND=1
        JE_INC2_BND=2
        JE_INC3_BND=3
        JE_INC4_BND=4
        JE_INC5_BND=5
        MY_JE_GLB=JM
      ENDIF
C----------------------------------------------------------------------
C***
C***  THE FOLLOWING ARE THE LOCAL LIMITS OF I AND J IN EACH SUBDOMAIN
C***
      MY_IS_LOC=1
      MY_IE_LOC=MY_IE_GLB-MY_IS_GLB+1
      MY_JS_LOC=1
      MY_JE_LOC=MY_JE_GLB-MY_JS_GLB+1
C----------------------------------------------------------------------
C***
C***  EACH PE WILL NOW FILL ITS OWN SECTIONS OF THE GLOBAL-TO-LOCAL
C***  TRANSLATION ARRAYS (DIMENSIONED GLOBALLY) AND LOCAL-TO-GLOBAL
C***  TRANSLATION ARRAYS (DIMENSIONED LOCALLY)
C***
      ILOC=0
      DO I=MY_IS_GLB-1,MY_IE_GLB+1
        G2LI(I)=ILOC
        L2GI(ILOC)=I
        ILOC=ILOC+1
      ENDDO
C
      JLOC=0
      DO J=MY_JS_GLB-1,MY_JE_GLB+1
        G2LJ(J)=JLOC
        L2GJ(JLOC)=J
        JLOC=JLOC+1
      ENDDO
C----------------------------------------------------------------------
C***
C***  EACH PE WILL NOW FILL THE ARRAY CALLED MY_NEB WHICH HOLDS THE
C***  NUMBER OF THE 8 PEs THAT ARE ITS NEIGHBORS: NORTH(1), EAST(2),
C***  SOUTH(3), WEST(4), NORTHEAST(5), SOUTHEAST(6), SOUTHWEST(7),
C***  AND NORTHWEST(8).  THE VALUE IN THE ARRAY WILL BE -1 FOR THOSE
C***  NEIGHBORS THAT DO NOT EXIST BECAUSE THEY ARE BEYOND THE
C***  GLOBAL DOMAIN BOUNDARY.
C***
      IPE=0
      DO J=1,JNPES
      DO I=1,INPES
        ITEMP(I,J)=IPE
        IF(IPE.EQ.MYPE) THEN
          MYI=I
          MYJ=J
        ENDIF
        IPE=IPE+1
        ENDDO
      ENDDO
C
      MY_N=-1
      IF(MYJ+1.LE.JNPES)MY_N=ITEMP(MYI,MYJ+1)
C
      MY_E=-1
      IF(MYI+1.LE.INPES)MY_E=ITEMP(MYI+1,MYJ)
C
      MY_S=-1
      IF(MYJ-1.GE.1)MY_S=ITEMP(MYI,MYJ-1)
C
      MY_W=-1
      IF(MYI-1.GE.1)MY_W=ITEMP(MYI-1,MYJ)
C
      MY_NE=-1
      IF((MYI+1.LE.INPES).AND.(MYJ+1.LE.JNPES))
     1    MY_NE=ITEMP(MYI+1,MYJ+1)
C
      MY_SE=-1
      IF((MYI+1.LE.INPES).AND.(MYJ-1.GE.1))
     1    MY_SE=ITEMP(MYI+1,MYJ-1)
C
      MY_SW=-1
      IF((MYI-1.GE.1).AND.(MYJ-1.GE.1))
     1    MY_SW=ITEMP(MYI-1,MYJ-1)
C
      MY_NW=-1
      IF((MYI-1.GE.1).AND.(MYJ+1.LE.JNPES))
     1    MY_NW=ITEMP(MYI-1,MYJ+1)
C
      MY_NEB(1)=MY_N
      MY_NEB(2)=MY_E
      MY_NEB(3)=MY_S
      MY_NEB(4)=MY_W
      MY_NEB(5)=MY_NE
      MY_NEB(6)=MY_SE
      MY_NEB(7)=MY_SW
      MY_NEB(8)=MY_NW
C----------------------------------------------------------------------
C*** 
C***  GENERATE THE TABLES (DIMENSIONED INPES*JNPES) THAT HOLD THE
C***  STARTING AND ENDING VALUES OF I AND J FOR EACH PE IN TERMS
C***  OF BOTH THE GLOBAL AND THE LOCAL DOMAINS.
C***
      CALL INDTABLE
C----------------------------------------------------------------------
C***
C***  CREATE ABBREVIATED NAMES FOR LOOP LIMITS.
C***
      MYIS    =MY_IS_LOC
      MYIS_P1 =MY_IS_LOC-ILPAD1
      MYIS_P2 =MY_IS_LOC-ILPAD2
      MYIS_P3 =MY_IS_LOC-ILPAD3
      MYIS_P4 =MY_IS_LOC-ILPAD4
      MYIS_P5 =MY_IS_LOC-ILPAD5
C
      MYIS1   =MY_IS_LOC+IS_INC1_BND
      MYIS1_P1=MY_IS_LOC+IS_INC1_BND-ILPAD1
      MYIS1_P2=MY_IS_LOC+IS_INC1_BND-ILPAD2
      MYIS1_P3=MY_IS_LOC+IS_INC1_BND-ILPAD3
      MYIS1_P4=MY_IS_LOC+IS_INC1_BND-ILPAD4
C
      MYIS2   =MY_IS_LOC+IS_INC2_BND
C***
      MYIE    =MY_IE_LOC 
      MYIE_P1 =MY_IE_LOC+IRPAD1
      MYIE_P2 =MY_IE_LOC+IRPAD2
      MYIE_P3 =MY_IE_LOC+IRPAD3
      MYIE_P4 =MY_IE_LOC+IRPAD4
      MYIE_P5 =MY_IE_LOC+IRPAD5
C
      MYIE1   =MY_IE_LOC-IE_INC1_BND          !The size of these increments
      MYIE1_P1=MY_IE_LOC-IE_INC1_BND+IRPAD1   !is zero unless the subdomain
      MYIE1_P2=MY_IE_LOC-IE_INC1_BND+IRPAD2   !lies along a global boundary
      MYIE1_P3=MY_IE_LOC-IE_INC1_BND+IRPAD3   !in which case the increment
      MYIE1_P4=MY_IE_LOC-IE_INC1_BND+IRPAD4   !is indicated by the number
C                                             !following 'INC'.
      MYIE2   =MY_IE_LOC-IE_INC2_BND          
      MYIE2_P1=MY_IE_LOC-IE_INC2_BND+IRPAD1
C***
C***
      MYJS    =MY_JS_LOC
      MYJS_P1 =MY_JS_LOC-JBPAD1
      MYJS_P2 =MY_JS_LOC-JBPAD2
      MYJS_P3 =MY_JS_LOC-JBPAD3
      MYJS_P4 =MY_JS_LOC-JBPAD4
      MYJS_P5 =MY_JS_LOC-JBPAD5
C
      MYJS1   =MY_JS_LOC+JS_INC1_BND
      MYJS1_P1=MY_JS_LOC+JS_INC1_BND-JBPAD1
      MYJS1_P2=MY_JS_LOC+JS_INC1_BND-JBPAD2
      MYJS1_P3=MY_JS_LOC+JS_INC1_BND-JBPAD3
      MYJS1_P4=MY_JS_LOC+JS_INC1_BND-JBPAD4
      MYJS1_P5=MY_JS_LOC+JS_INC1_BND-JBPAD5
C
      MYJS2   =MY_JS_LOC+JS_INC2_BND
      MYJS2_P1=MY_JS_LOC+JS_INC2_BND-JBPAD1
      MYJS2_P2=MY_JS_LOC+JS_INC2_BND-JBPAD2
      MYJS2_P3=MY_JS_LOC+JS_INC2_BND-JBPAD3
      MYJS2_P4=MY_JS_LOC+JS_INC2_BND-JBPAD4
      MYJS2_P5=MY_JS_LOC+JS_INC2_BND-JBPAD5
C
      MYJS3   =MY_JS_LOC+JS_INC3_BND
      MYJS3_P1=MY_JS_LOC+JS_INC3_BND-JBPAD1
      MYJS3_P4=MY_JS_LOC+JS_INC3_BND-JBPAD4
C
      MYJS4   =MY_JS_LOC+JS_INC4_BND
      MYJS4_P1=MY_JS_LOC+JS_INC4_BND-JBPAD1
      MYJS4_P4=MY_JS_LOC+JS_INC4_BND-JBPAD4
C
      MYJS5   =MY_JS_LOC+JS_INC5_BND
      MYJS5_P1=MY_JS_LOC+JS_INC5_BND-JBPAD1
      MYJS5_P2=MY_JS_LOC+JS_INC5_BND-JBPAD2
C***
      MYJE    =MY_JE_LOC
      MYJE_P1 =MY_JE_LOC+JTPAD1
      MYJE_P2 =MY_JE_LOC+JTPAD2
      MYJE_P3 =MY_JE_LOC+JTPAD3
      MYJE_P4 =MY_JE_LOC+JTPAD4
      MYJE_P5 =MY_JE_LOC+JTPAD5
C
      MYJE1   =MY_JE_LOC-JE_INC1_BND
      MYJE1_P1=MY_JE_LOC-JE_INC1_BND+JTPAD1
      MYJE1_P2=MY_JE_LOC-JE_INC1_BND+JTPAD2
      MYJE1_P3=MY_JE_LOC-JE_INC1_BND+JTPAD3
      MYJE1_P4=MY_JE_LOC-JE_INC1_BND+JTPAD4
      MYJE1_P5=MY_JE_LOC-JE_INC1_BND+JTPAD5
C
      MYJE2   =MY_JE_LOC-JE_INC2_BND
      MYJE2_P1=MY_JE_LOC-JE_INC2_BND+JTPAD1
      MYJE2_P2=MY_JE_LOC-JE_INC2_BND+JTPAD2
      MYJE2_P3=MY_JE_LOC-JE_INC2_BND+JTPAD3
      MYJE2_P4=MY_JE_LOC-JE_INC2_BND+JTPAD4
      MYJE2_P5=MY_JE_LOC-JE_INC2_BND+JTPAD5
C
      MYJE3   =MY_JE_LOC-JE_INC3_BND 
      MYJE3_P1=MY_JE_LOC-JE_INC3_BND+JTPAD1
      MYJE3_P4=MY_JE_LOC-JE_INC3_BND+JTPAD4
      MYJE3_P5=MY_JE_LOC-JE_INC3_BND+JTPAD5
C
      MYJE4   =MY_JE_LOC-JE_INC4_BND
      MYJE4_P1=MY_JE_LOC-JE_INC4_BND+JTPAD1
      MYJE4_P4=MY_JE_LOC-JE_INC4_BND+JTPAD4
      MYJE4_P5=MY_JE_LOC-JE_INC4_BND+JTPAD5
C
      MYJE5   =MY_JE_LOC-JE_INC5_BND
      MYJE5_P1=MY_JE_LOC-JE_INC5_BND+JTPAD1
      MYJE5_P2=MY_JE_LOC-JE_INC5_BND+JTPAD2
C
C-----------------------------------------------------------------
C*****************************************************************
      RETURN
      END
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
C-----------------------------------------------------------------
                      SUBROUTINE INDTABLE 
C-----------------------------------------------------------------
C***
C***  THIS ROUTINE GENERATES THE TABLES THAT WILL GIVE THE 
C***  STARTING AND ENDING VALUES OF I AND J FOR EACH PE ON
C***  THE GLOBAL AND LOCAL DOMAINS.  EACH PE WILL HAVE A COPY
C***  OF THE FULL TABLES.  THE ARGUMENT USED IS SIMPLY THE
C***  NUMBER OF THE PE FOR WHICH THESE VALUES ARE DESIRED.
C***
C-----------------------------------------------------------------
      INCLUDE "parmeta"
      INCLUDE "mpif.h"
      INCLUDE "mpp.h"
C-----------------------------------------------------------------
C
      IS_LOC_TABLE(MYPE)=MY_IS_LOC
      JS_LOC_TABLE(MYPE)=MY_JS_LOC
      IE_LOC_TABLE(MYPE)=MY_IE_LOC
      JE_LOC_TABLE(MYPE)=MY_JE_LOC
C
      IS_GLB_TABLE(MYPE)=MY_IS_GLB
      IE_GLB_TABLE(MYPE)=MY_IE_GLB
      JS_GLB_TABLE(MYPE)=MY_JS_GLB
      JE_GLB_TABLE(MYPE)=MY_JE_GLB
C
      DO IPE=0,NPES-1
        CALL MPI_BCAST(IS_LOC_TABLE(IPE),1,MPI_INTEGER,IPE,
     1                 MPI_COMM_COMP,IRTN)
        CALL MPI_BCAST(JS_LOC_TABLE(IPE),1,MPI_INTEGER,IPE,
     1                 MPI_COMM_COMP,IRTN)
        CALL MPI_BCAST(IE_LOC_TABLE(IPE),1,MPI_INTEGER,IPE,
     1                 MPI_COMM_COMP,IRTN)
        CALL MPI_BCAST(JE_LOC_TABLE(IPE),1,MPI_INTEGER,IPE,
     1                 MPI_COMM_COMP,IRTN)
C
        CALL MPI_BCAST(IS_GLB_TABLE(IPE),1,MPI_INTEGER,IPE,
     1                 MPI_COMM_COMP,IRTN)
        CALL MPI_BCAST(JS_GLB_TABLE(IPE),1,MPI_INTEGER,IPE,
     1                 MPI_COMM_COMP,IRTN)
        CALL MPI_BCAST(IE_GLB_TABLE(IPE),1,MPI_INTEGER,IPE,
     1                 MPI_COMM_COMP,IRTN)
        CALL MPI_BCAST(JE_GLB_TABLE(IPE),1,MPI_INTEGER,IPE,
     1                 MPI_COMM_COMP,IRTN)
      ENDDO
C
      CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
C------------------------------------------------------------------
C***
C***  ALL OF THE PEs CAN NOW GENERATE A COMPLETE TABLE OF THE 
C***  NUMBER OF GRID POINTS IN THE I DIRECTION THAT ARE ON
C***  ALL OTHER PEs.  THIS WILL BE USED IN THE MESINGER MSLP
C***  REDUCTION AS WELL AS IN THE BROADCAST BELOW.
C***
      DO IPE=0,NPES-1
        ICHUNKTAB(IPE)=IE_LOC_TABLE(IPE)-IS_LOC_TABLE(IPE)+1
      ENDDO
C***
C***  SET UP A MAP OF THE GLOBAL DOMAIN THAT GIVES THE PE THAT
C***  OWNS EACH POINT.
C***  (THIS APPEARS TO BE VESTIGIAL)
C***
C
C***  FIRST EACH PE FILLS IN ITS SECTION OF THE ARRAY
C
      DO JGLB=JS_GLB_TABLE(MYPE),JE_GLB_TABLE(MYPE)
      DO IGLB=IS_GLB_TABLE(MYPE),IE_GLB_TABLE(MYPE)
        ITEMP(IGLB,JGLB)=MYPE
      ENDDO
      ENDDO
C
C***  NEXT, ALL PEs EXCHANGE THEIR SECTIONS SO EVERYONE HAS 
C***  A FULL MAP
C
      DO IPE=0,NPES-1
      DO JGLB=JS_GLB_TABLE(IPE),JE_GLB_TABLE(IPE)
        CALL MPI_BCAST(ITEMP(IS_GLB_TABLE(IPE),JGLB),ICHUNKTAB(IPE)
     1,                MPI_INTEGER,IPE,MPI_COMM_COMP,IRECV)
      ENDDO
      ENDDO
C
      CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
C********************************************************************
       RETURN
       END

