C AJMTK     SOURCE    PV        20/09/26    21:15:04     10724          
      SUBROUTINE AJMTK(GMS,MK,IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : AJMTK
C DESCRIPTION : Ajoute à un objet matrice de type MATRIK, un objet
C               matrice simplifiée de type GMATSI (voir définition du
C               segment ci-dessous).
C
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : -
C APPELES (UTIL)   : RSETI : copie d'un tableau d'entiers.
C APPELE PAR       : YLAP1{B,C,D,E}
C***********************************************************************
C ENTREES            : MS (type MATSIM) : objet matrice à ajouter.
C ENTREES/SORTIES    : MK (type MATRIK) : en sortie, est égal à :
C                                         MK (en entrée) + MS
C SORTIES            : -
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 03/08/2001, version initiale
C HISTORIQUE : v1, 03/08/2001, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************

-INC PPARAM
-INC CCOPTIO
-INC SMMATRIK
      INTEGER NRIGE,NMATRI,NKID,NKMT
      INTEGER NBSOUS,NBME
      INTEGER NBEL,NP,MP
      POINTEUR MK.MATRIK
      POINTEUR IK.IMATRI
      POINTEUR JK.IZAFM
-INC SMELEME
      INTEGER NBNN,NBELEM,NBREF
      POINTEUR MAIPRI.MELEME
      POINTEUR MAIDUA.MELEME
*
* Objet matrice élémentaire simplifié
*
      SEGMENT GMATSI
      INTEGER POIPR1(NPP1,NEL1)
      INTEGER POIDU1(1,NEL1)
      INTEGER POIPR2(NPP2,NEL2)
      INTEGER POIDU2(2,NEL2)
      POINTEUR LMATSI(0).MATSIM
      ENDSEGMENT
      POINTEUR GMS.GMATSI
      SEGMENT MATSIM
      CHARACTER*8 NOMPRI,NOMDUA
      REAL*8 VALMA1(1,NPP1,NEL1)
      REAL*8 VALMA2(2,NPP2,NEL2)
      ENDSEGMENT
      POINTEUR MS.MATSIM
*
      INTEGER IMPR,IRET
*
      INTEGER IPOPR1,IPOPR2,IMAT,IELEM1,IELEM2
      INTEGER NPOPR1,NPOPR2,NMAT,NELEM1,NELEM2
*
* Executable statements
*
      IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans ajmtk.eso'
      SEGACT GMS
      NPOPR1=GMS.POIPR1(/1)
      NPOPR2=GMS.POIPR2(/1)
      NELEM1=GMS.POIPR1(/2)
      NELEM2=GMS.POIPR2(/2)
      IF (NELEM1.GT.0) THEN
*
* Création du premier MATRIK
*
* Création de MAIPRI
         NBNN=NPOPR1
         NBELEM=NELEM1
         NBSOUS=0
         NBREF=0
         SEGINI,MAIPRI
C     ITYPEL=32 -> 'POLY'
         MAIPRI.ITYPEL=32
         CALL RSETI(MAIPRI.NUM,GMS.POIPR1,NPOPR1*NELEM1)
         SEGDES MAIPRI
* Création de MAIDUA
         NBNN=1
         NBELEM=NELEM1
         NBSOUS=0
         NBREF=0
         SEGINI,MAIDUA
C     ITYPEL=32 -> 'POLY'
         MAIDUA.ITYPEL=32
         CALL RSETI(MAIDUA.NUM,GMS.POIDU1,NELEM1)
         SEGDES MAIDUA
* Création de IK (noms d'inconnues+pointeurs sur valeurs des matrices
*                 élémentaires)
         NMAT=GMS.LMATSI(/1)
         NBME=NMAT
         NBSOUS=1
         SEGINI IK
         DO 1 IMAT=1,NMAT
            MS=GMS.LMATSI(IMAT)
            SEGACT MS
* Création de JK (matrice élémentaire)
            NBEL=NELEM1
            NP=NPOPR1
            MP=1
            SEGINI JK
            DO 12 IELEM1=1,NELEM1
               DO 122 IPOPR1=1,NPOPR1
                  JK.AM(IELEM1,IPOPR1,1)=MS.VALMA1(1,IPOPR1,IELEM1)
 122           CONTINUE
 12         CONTINUE
            SEGDES JK
            IK.LISPRI(IMAT)=MS.NOMPRI
            IK.LISDUA(IMAT)=MS.NOMDUA
            IK.LIZAFM(1,IMAT)=JK
            SEGDES MS
 1       CONTINUE
         SEGDES IK
* Mise à jour de MK (pointeurs sur les matrices élémentaires)
         SEGACT MK*MOD
         NMATRI=MK.IRIGEL(/2)+1
         NRIGE=MK.IRIGEL(/1)
         NKID=MK.KIDMAT(/1)
         NKMT=MK.KKMMT(/1)
         SEGADJ,MK
         MK.IRIGEL(1,NMATRI)=MAIPRI
         MK.IRIGEL(2,NMATRI)=MAIDUA
         MK.IRIGEL(4,NMATRI)=IK
*     Matrice rectangulaire
         MK.IRIGEL(7,NMATRI)=3
         SEGDES MK
      ENDIF
      IF (NELEM2.GT.0) THEN
*
* Création du deuxième MATRIK
*
* Création de MAIPRI
         NBNN=NPOPR2
         NBELEM=NELEM2
         NBSOUS=0
         NBREF=0
         SEGINI,MAIPRI
C     ITYPEL=32 -> 'POLY'
         MAIPRI.ITYPEL=32
         CALL RSETI(MAIPRI.NUM,GMS.POIPR2,NPOPR2*NELEM2)
         SEGDES MAIPRI
* Création de MAIDUA
         NBNN=2
         NBELEM=NELEM2
         NBSOUS=0
         NBREF=0
         SEGINI,MAIDUA
C     ITYPEL=32 -> 'POLY'
         MAIDUA.ITYPEL=32
         CALL RSETI(MAIDUA.NUM,GMS.POIDU2,2*NELEM2)
         SEGDES MAIDUA
* Création de IK (noms d'inconnues+pointeurs sur valeurs des matrices
*                 élémentaires)
         NMAT=GMS.LMATSI(/1)
         NBME=NMAT
         NBSOUS=1
         SEGINI IK
         DO 3 IMAT=1,NMAT
            MS=GMS.LMATSI(IMAT)
            SEGACT MS
* Création de JK (matrice élémentaire)
            NBEL=NELEM2
            NP=NPOPR2
            MP=2
            SEGINI JK
            DO 32 IELEM2=1,NELEM2
               DO 322 IPOPR2=1,NPOPR2
                  JK.AM(IELEM2,IPOPR2,1)=MS.VALMA2(1,IPOPR2,IELEM2)
                  JK.AM(IELEM2,IPOPR2,2)=MS.VALMA2(2,IPOPR2,IELEM2)
 322           CONTINUE
 32         CONTINUE
            SEGDES JK
            IK.LISPRI(IMAT)=MS.NOMPRI
            IK.LISDUA(IMAT)=MS.NOMDUA
            IK.LIZAFM(1,IMAT)=JK
            SEGDES MS
 3       CONTINUE
         SEGDES IK
         SEGDES GMS
* Mise à jour de MK (pointeurs sur les matrices élémentaires)
         SEGACT MK*MOD
         NMATRI=MK.IRIGEL(/2)+1
         NRIGE=MK.IRIGEL(/1)
         NKID=MK.KIDMAT(/1)
         NKMT=MK.KKMMT(/1)
         SEGADJ,MK
         MK.IRIGEL(1,NMATRI)=MAIPRI
         MK.IRIGEL(2,NMATRI)=MAIDUA
         MK.IRIGEL(4,NMATRI)=IK
*     Matrice rectangulaire
         MK.IRIGEL(7,NMATRI)=3
         SEGDES MK
      ENDIF
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine ajmtk'
      RETURN
*
* End of subroutine AJMTK
*
      END