Sources Esope | Cast3M

mkmpos
C MKMPOS    SOURCE    CHAT      05/01/13    01:46:19     5004
      SUBROUTINE MKMPOS(NBINC,NPOMEL,NTOGPO,NTOTPO,NTOTIN,
     $     KRINC,MELEME,KRSPGT,
     $     MPOS,
     $     IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : MKMPOS
C PROJET      : Noyau linéaire NLIN
C DESCRIPTION : On complète un tableau de correspondance (point support,
C               nom d'inconnue scalaire) &lt;-> (numéro de ddl)
C
C               On complète le tableau de repérage des inconnues KMINCT
C               (segment de type MPOS dans le programme appelant) avec
C               les informations données en entrée :
C               KRINC : indices des composantes ds le tableau des
C                       composantes.
C               MELEME : liste des numéros globaux de points sur
C                        lesquels il y a des inconnues.
C               KRSPGT : repérage des points ds le tableau des points.
C
C
C LANGAGE     : FORTRAN 77 (sauf E/S)
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELE PAR       : PRASEM
C***********************************************************************
C ENTREES            : NBINC, NPOMEL, NTOGPO,NTOTPO,NTOTIN
C                      KRINC, MELEME, KRSPGT
C ENTREES/SORTIES    : MPOS
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 05/10/99, version initiale
C HISTORIQUE : v1, 05/10/99, 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
      INTEGER NBINC,NPOMEL,NTOGPO,NTOTPO,NTOTIN
      INTEGER KRINC(NBINC)
      INTEGER MELEME(NPOMEL)
      INTEGER KRSPGT(NTOGPO)
      INTEGER MPOS(NTOTPO,NTOTIN+1)
*
      INTEGER IMPR,IRET
*
      LOGICAL LEXIST
      INTEGER IPOMEL,IINC
      INTEGER IPOMCT,IINCCT
      INTEGER NPOINC
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkmpos'
      DO 1 IPOMEL=1,NPOMEL
         IPOMCT=KRSPGT(MELEME(IPOMEL))
         IF (IPOMCT.EQ.0) THEN
            WRITE(IOIMP,*)
     $           'Un point de KSPGP ou KSPGD n''existe pas '
     $           ,'dans KSPGT...'
         ENDIF
* On cherche si l'inconnue n'existe pas déjà dans MPOS
         DO 12 IINC=1,NBINC
            IINCCT=KRINC(IINC)
            LEXIST=(MPOS(IPOMCT,IINCCT).NE.0)
* Sinon, on la rajoute...
            IF (.NOT.LEXIST) THEN
               NPOINC=MPOS(IPOMCT,NTOTIN+1)+1
               MPOS(IPOMCT,NTOTIN+1)=NPOINC
               MPOS(IPOMCT,IINCCT) =NPOINC
            ENDIF
 12      CONTINUE
 1    CONTINUE
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine mkmpos'
      RETURN
*
* End of subroutine MKMPOS
*
      END