SUBROUTINE MPI_FIRST
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
!   SUBROUTINE:  MPI_FIRST   INTIALIZES MPI STUFF
!   PRGRMMR: TUCCILLO        ORG:  IBM       DATE: 00-01-20

! ABSTRACT:   INTIALIZES MPI STUFF

! PROGRAM HISTORY LOG:
!   00-01-20  TUCCILLO - ORIGINATOR

! USAGE:  CALL MPI_FIRST

!   INPUT ARGUMENT LIST:

!   OUTPUT ARGUMENT LIST:

!   INPUT FILES:  NONE

!   OUTPUT FILES:  NONE

!   SUBPROGRAMS CALLED:
!     UNIQUE:
!            MPI_INIT
!            MPI_COMM_SIZE
!            MPI_COMM_RANK
!            PARA_RANGE

!   EXIT STATES:
!     COND =   0 - NORMAL EXIT

! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM SP

!$$$

    include "parmeta.f90"
    include "COMM_PARA.f90"
    include 'mpif.h'
    include "mpp.h"


    integer :: ierr
    LNIP = IM/INPES
    LNJP=JM/JNPES

!***
!***  NUM_PROCS IS THE NUMBER OF TASKS DOING THE QUILTING
!***  IN THIS SERVER GROUP
!***
    call mpi_comm_size(mpi_comm_comp,num_procs, ierr )
    call mpi_comm_rank(mpi_comm_comp,me, ierr )

!     if ( me .eq. 0 ) then
    print *, ' num_procs = ',num_procs
!     end if

    if ( num_procs > JNPES ) then
        print *, ' too many MPI tasks, max is ',JNPES, ', stopping'
        call MPI_ABORT(MPI_COMM_WORLD,1,ierr)
    end if

    if ( num_procs > 2800 ) then
        print *, ' too many MPI tasks, max is 1024, stopping'
        call MPI_ABORT(MPI_COMM_WORLD,1,ierr)
    end if

!***
!***  JS_X AND JS_Y ARE THE STARTING AND ENDING ROWS OF TASKS
!***  IN THE MODEL FORECAST DECOMPOSITION THAT WILL BE SENDING
!***  TO EACH QUILT TASK
!***
!***  JSTA IS THE FIRST FORECAST TASK AND JEND IS THE LAST
!***  FORECAST TASK IN THE ENTIRE RANGE OF FORECAST TASKS
!***  THAT WILL BE SENDING TO EACH QUILT TASK.  REMEMBER
!***  THAT AN INTEGER NUMBER OF FORECAST TASK ROWS IS
!***  SENT TO EACH QUILT TASK.
!***
    do i = 0, num_procs - 1
        call para_range(0,JNPES-1,num_procs,i,js_x,je_x)
        jsta(i) = js_x * INPES
        jend(i) = jsta(i) + (je_x-js_x+1)*INPES -1
        if ( me == 0 ) then
            print *, ' task id, jsta, end = ',i,jsta(i),jend(i)
        end if
    end do

!     locations

!***  PARAMETER LNIP (LNJP) IS SMALLEST THAT THE I (J) EXTENT
!***  OF EACH SUBDOMAIN CAN BE.
!***  IRMND (JRMND) IS THE NUMBER OF "REMAINDER" I (J) POINTS
!***  THAT WILL BE GIVEN TO THE LEFTMOST (LOWERMOST) PEs.

    IRMND=MOD(IM,INPES)
    JRMND=MOD(JM,JNPES)

    DO IPE = 0, NPES - 1
    
        IPOSN=MOD(IPE,INPES)+1
        JPOSN=IPE/INPES+1
    
    !***  GLOBAL LIMITS OF THIS PEs SUBDOMAIN
    
        MY_IS_GLB_A(IPE)=(IPOSN-1)*LNIP+MIN(IRMND,IPOSN-1)+1
        MY_IE_GLB_A(IPE)=MY_IS_GLB_A(IPE)+LNIP-1
        IF(IPOSN <= IRMND)MY_IE_GLB_A(IPE)=MY_IE_GLB_A(IPE)+1
    
        MY_JS_GLB_A(IPE)=(JPOSN-1)*LNJP+MIN(JRMND,JPOSN-1)+1
        MY_JE_GLB_A(IPE)=MY_JS_GLB_A(IPE)+LNJP-1
        IF(JPOSN <= JRMND)MY_JE_GLB_A(IPE)=MY_JE_GLB_A(IPE)+1
    
        if ( me == 0 ) then
        !        print *, ' ipe,  MY_IS_GLB,MY_IE_GLB,MY_JS_GLB, MY_JE_GLB =',
        !    * ipe, MY_IS_GLB_A(IPE),MY_IE_GLB_A(IPE),
        !    * MY_JS_GLB_A(IPE),MY_JE_GLB_A(IPE)
        end if
    END DO

!     dimensioning information

    MY_ISD = 1
    MY_IED = IM
    MY_JSD = MY_JS_GLB_A(jsta(me)) -2
    MY_JED = MY_JE_GLB_A(jend(me)) +2
    IF ( MY_JSD < 1 ) MY_JSD = 1
    IF ( MY_JED > JM ) MY_JED = JM

    print *, ' ME, MY_ISD,MY_IED,MY_JSD,MY_JED = ', &
    me, MY_ISD,MY_IED,MY_JSD,MY_JED

    jsta_i = MY_JS_GLB_A(jsta(me))
    jend_i = MY_JE_GLB_A(jend(me))
    jsta_im  = jsta_i
    jsta_im2 = jsta_i
    jend_im  = jend_i
    jend_im2 = jend_i
    if ( me == 0 ) then
        jsta_im  = 2
        jsta_im2 = 3
    end if
    if ( me == num_procs - 1 ) then
        jend_im  = jm - 1
        jend_im2 = jm - 2
    end if

    print *, ' jsta_i,jend_i,jsta_im,jend_im,jsta_im2,jend_im2= ', &
    jsta_i,jend_i,jsta_im,jend_im,jsta_im2,jend_im2
!     neighbors

    iup = me + 1
    idn = me - 1
    if ( me == 0 ) then
        idn = MPI_PROC_NULL
    end if
    if ( me == num_procs - 1 ) then
        iup = MPI_PROC_NULL
    end if

!     print *, ' ME, NUM_PROCS = ',me,num_procs


    END SUBROUTINE MPI_FIRST