	PROGRAM MASTER_PVM
!
!=================================================================================
!=================================================================================
! CRIHAN     11/2000
! Guy Moebs   Guy.Moebs@crihan.fr
!
! Utilisation de la bibliotheque d'echange de messages PVM
! (www.epm.ornl.gov/pvm/pvm_home.html)
!
! Programme MPMD (maitre/esclave) : code du maitre
!
! Calcul du vecteur R = ( U*(tU) + LAMBDA*V*(tV) )  *  ( U + V )
!
!              i.e. RESULT = MAT * VECT
!
! 1.  Initialisation du vecteur par tous les processus
! 2.  Initialisation distribuee des ligne de la matrice par chaque processus
! 3.  Calcul du produit partiel par chaque processus :
!          lignes matrice * vecteur
! 4.  Tous les processus se redistribuent les produits partiels pour avoir
!     le resultat complet
!
!
!=================================================================================
!=================================================================================
!
!     DECLARATIONS
!
!=================================================================================
!=================================================================================
!
! MODULE(S) NECESSAIRE(S)
!
      use modscal
!
      IMPLICIT NONE
!
! COMMON(S) NECESSAIRE(S)
!
      INCLUDE 'fpvm3.h'
!
! DECLARATION DES CONSTANTES
!
      INTEGER      ITYPE_REAL
!
! DECLARATION DES VARIABLES
!
      REAL(rp),  ALLOCATABLE,  DIMENSION(:,:)  ::  MAT
      REAL(rp),  ALLOCATABLE,  DIMENSION(:)    ::  VECT
      REAL(rp),  ALLOCATABLE,  DIMENSION(:)    ::  RESULT
!
      INTEGER,   ALLOCATABLE,  DIMENSION(:)    ::  ITIDS
      INTEGER,   ALLOCATABLE,  DIMENSION(:)    ::  IPROC
!
      INTEGER    ::  NPROC, MYTID, INFO
      INTEGER    ::  MSGTYPE, NUM, NUMTID
      INTEGER    ::  INTERV, NVAL, IDEBUT
      INTEGER    ::  N, I, IERR = 0
!
      CHARACTER*80 NODENAME
      CHARACTER*80 home
!
!
!=================================================================================
!=================================================================================
!
!     DEBUT DU PROGRAMME
!
!=================================================================================
!=================================================================================
!
!
!----Type de donnees
!
      IF ( rp == dp ) THEN
         ITYPE_REAL = REAL8
      ELSE
         ITYPE_REAL = REAL4
      END IF
!
!----Identificateur du Processus
!
      CALL PVMFMYTID (MYTID)
!
!
!----Saisie du nombre de slaves
!
      OPEN ( 19, FILE = 'pvm.dat', STATUS = 'OLD' )
      READ (19, *) N
      READ (19, *) NPROC
      CLOSE (19)
!
!----Creer NPROC processus avec l'executable NODENAME
!
      CALL GETENV ('PWD', home)
!
      write (6,*) '*', home, '*'
      I = index(home,' ') - 1
!
      NODENAME = home(1:I)//'/prod_slv.exe'
!
      ALLOCATE ( MAT(N,N), RESULT(N), VECT(N), ITIDS (NPROC),  
     &           IPROC (0:NPROC-1), STAT = IERR )
      IF (ierr /= 0) THEN
!
         WRITE (6,'(A)') ' Probleme allocation MAT, RESULT, VECT'
         WRITE (6,1020) ' IERR = ', IERR
         STOP
!
      END IF
!
      CALL PVMFSPAWN (NODENAME, PVMTASKDEFAULT, '*', NPROC, ITIDS, INFO)
      WRITE (6,1020) 'MYTID = ', MYTID, ' CREATION DE ', NPROC, ' FILS'
 1020 FORMAT ( (A, I8), 2(A, I4) )
!
!
!----Envoi du nombre NPROC a tous les slaves
!
      MSGTYPE = 0
      CALL PVMFINITSEND (PVMDATADEFAULT, info)
      CALL PVMFPACK (INTEGER4, NPROC, 1, 1, info)
      CALL PVMFPACK (INTEGER4, N,     1, 1, info)
      CALL PVMFMCAST (NPROC, ITIDS, MSGTYPE, info)
      WRITE (6,1020) ' info = ', info
!
!
!-----Reception du numero de chaque slave dans le groupe 'SLAVE'
!
      MSGTYPE = 1
      DO I = 0, NPROC - 1
         CALL PVMFRECV (-1, MSGTYPE, info)
         CALL PVMFUNPACK (INTEGER4, NUM, 1, 1, info)
         CALL PVMFUNPACK (INTEGER4, NUMTID, 1, 1, info)
         IPROC (NUM) = NUMTID
         WRITE (6,1020) 'NUMERO DU TID = ', NUMTID,  
     &                  ' RANG DANS LE GROUPE = ', NUM
      ENDDO
!
!
!-----Initialisation des matrices
!
      CALL INIT_MAT_VECT (MAT, VECT, N)
!
!
!-----Envoi du vecteur et de la matrice
!
      MSGTYPE = 2
      DO NUM = 0, NPROC - 1
        CALL PVMFINITSEND (PVMDATADEFAULT, info)
        CALL PVMFPACK (ITYPE_REAL, VECT, N, 1, info)
        CALL PVMFPACK (ITYPE_REAL, MAT, N*N, 1, info)
        CALL PVMFSEND (IPROC (NUM), MSGTYPE, info)
      ENDDO
!
!
!-----Rassemblement des resultats
!
      INTERV = N / NPROC
      MSGTYPE = 3
      DO I = 1, NPROC
         CALL PVMFRECV (-1, MSGTYPE, INFO)
         CALL PVMFUNPACK (INTEGER4, NUM, 1, 1, INFO)
         CALL PVMFUNPACK (INTEGER4, NVAL, 1, 1, INFO)
         IDEBUT = NUM * INTERV + 1
         CALL PVMFUNPACK (ITYPE_REAL, RESULT (IDEBUT), NVAL, 1, INFO)
         WRITE(6,1020) 'RANG ', NUM, ' : ', NVAL,  
     &                 ' DONNEES A PARTIR DE ', IDEBUT
         WRITE (6,1030) 'RESULT : ', RESULT (1), RESULT (IDEBUT),  
     &                   RESULT (IDEBUT+NVAL-1)
 1030	 FORMAT ( A, 4(E12.4) )
      END DO
!
!-----Liberation de la memoire
!
      DEALLOCATE ( MAT, VECT, RESULT, ITIDS, IPROC )
!
!-----Quitter PVM
!
      CALL PVMFEXIT (INFO)
!
!
!=================================================================================
!=================================================================================
!
!     FIN DU PROGRAMME
!
!=================================================================================
!=================================================================================
!
      STOP 
      END PROGRAM MASTER_PVM 
!
!
!
!
!===============================================================
!
!     SUBROUTINE INIT_MAT_VECT : initialisation matrice vecteur
!
!     MAT       (R ,ES) Matrice  du produit matriciel
!     VECT      (R ,ES) Vecteur  du produit matriciel
!     INDMIN    (I ,E ) Indice initial des lignes distribuees
!     INDMAX    (I ,E ) Indice final   des lignes distribuees
!
!===============================================================
!
      SUBROUTINE INIT_MAT_VECT (MAT, VECT, N)
!
! MODULE(S) NECESSAIRE(S)
!
      use modscal
!
      IMPLICIT NONE
!
! DECLARATION DES ARGUMENTS
!
      INTEGER, INTENT (IN)  ::  N
!
      REAL(rp),  DIMENSION(N,N), INTENT (OUT)  ::  MAT
      REAL(rp),  DIMENSION(N),   INTENT (OUT)  ::  VECT
!
! DECLARATION DES VARIABLES LOCALES
!
      REAL(rp),  DIMENSION(N)    ::  U
      REAL(rp),  DIMENSION(N)    ::  V
!
      REAL(rp)   ::  LAMBDA
!
      INTEGER    ::  I, J
!
      REAL(rp)   ::  scal
!
! DEBUT DE LA SUBROUTINE
!
!
!----Initialisation des vecteurs U et V
!
      scal = 5.0_rp / 12.0_rp
      U (1:N) = scal
!
      DO I = 1, N
         V (I) = 0.2_rp + REAL (I, rp)
      END DO
!
!
!-----Calcul de LAMBDA
!
      LAMBDA = zero
!
      DO I = 1, N
         LAMBDA = LAMBDA + U (I) * V (I)
      END DO
!
!
!------Calcul de la matrice MAT = (tU)*U + LAMDA*(tV)*V
!
      DO J = 1, N
         DO I = 1, N
            MAT (I,J) = U (I) * U (J) + LAMBDA * V (I) * V (J)
         END DO
      END DO
!
!
!------Calcul du vecteur VECT = V + U
!
      VECT (1:N) = U (1:N) + V (1:N)
!
! FIN DE LA SUBROUTINE
!
      RETURN
      END SUBROUTINE INIT_MAT_VECT

