Esope source files

   1 : C MKMPOS    SOURCE    CHAT      05/01/13    01:46:19     5004           
   2 :       SUBROUTINE MKMPOS(NBINC,NPOMEL,NTOGPO,NTOTPO,NTOTIN,
   3 :      $     KRINC,MELEME,KRSPGT,
   4 :      $     MPOS,
   5 :      $     IMPR,IRET)
   6 :       IMPLICIT INTEGER(I-N)
   7 :       IMPLICIT REAL*8 (A-H,O-Z)
   8 : C***********************************************************************
   9 : C NOM         : MKMPOS
  10 : C PROJET      : Noyau linéaire NLIN
  11 : C DESCRIPTION : On complète un tableau de correspondance (point support,
  12 : C               nom d'inconnue scalaire) <-> (numéro de ddl)
  13 : C
  14 : C               On complète le tableau de repérage des inconnues KMINCT
  15 : C               (segment de type MPOS dans le programme appelant) avec
  16 : C               les informations données en entrée :
  17 : C               KRINC : indices des composantes ds le tableau des
  18 : C                       composantes.
  19 : C               MELEME : liste des numéros globaux de points sur
  20 : C                        lesquels il y a des inconnues.
  21 : C               KRSPGT : repérage des points ds le tableau des points.
  22 : C
  23 : C
  24 : C LANGAGE     : FORTRAN 77 (sauf E/S)
  25 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  26 : C               mél : gounand@semt2.smts.cea.fr
  27 : C***********************************************************************
  28 : C APPELE PAR       : PRASEM
  29 : C***********************************************************************
  30 : C ENTREES            : NBINC, NPOMEL, NTOGPO,NTOTPO,NTOTIN
  31 : C                      KRINC, MELEME, KRSPGT
  32 : C ENTREES/SORTIES    : MPOS
  33 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  34 : C***********************************************************************
  35 : C VERSION    : v1, 05/10/99, version initiale
  36 : C HISTORIQUE : v1, 05/10/99, création
  37 : C HISTORIQUE :
  38 : C HISTORIQUE :
  39 : C***********************************************************************
  40 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  41 : C en cas de modification de ce sous-programme afin de faciliter
  42 : C la maintenance !
  43 : C***********************************************************************
  44 : -INC CCOPTIO
  45 :       INTEGER NBINC,NPOMEL,NTOGPO,NTOTPO,NTOTIN
  46 :       INTEGER KRINC(NBINC)
  47 :       INTEGER MELEME(NPOMEL)
  48 :       INTEGER KRSPGT(NTOGPO)
  49 :       INTEGER MPOS(NTOTPO,NTOTIN+1)
  50 : *
  51 :       INTEGER IMPR,IRET
  52 : *
  53 :       LOGICAL LEXIST
  54 :       INTEGER IPOMEL,IINC
  55 :       INTEGER IPOMCT,IINCCT
  56 :       INTEGER NPOINC
  57 : *
  58 : * Executable statements
  59 : *
  60 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkmpos'
  61 :       DO 1 IPOMEL=1,NPOMEL
  62 :          IPOMCT=KRSPGT(MELEME(IPOMEL))
  63 :          IF (IPOMCT.EQ.0) THEN
  64 :             WRITE(IOIMP,*)
  65 :      $           'Un point de KSPGP ou KSPGD n''existe pas '
  66 :      $           ,'dans KSPGT...'
  67 :          ENDIF
  68 : * On cherche si l'inconnue n'existe pas déjà dans MPOS
  69 :          DO 12 IINC=1,NBINC
  70 :             IINCCT=KRINC(IINC)
  71 :             LEXIST=(MPOS(IPOMCT,IINCCT).NE.0)
  72 : * Sinon, on la rajoute...
  73 :             IF (.NOT.LEXIST) THEN
  74 :                NPOINC=MPOS(IPOMCT,NTOTIN+1)+1
  75 :                MPOS(IPOMCT,NTOTIN+1)=NPOINC
  76 :                MPOS(IPOMCT,IINCCT) =NPOINC
  77 :             ENDIF
  78 :  12      CONTINUE
  79 :  1    CONTINUE
  80 : *
  81 : * Normal termination
  82 : *
  83 :       IRET=0
  84 :       RETURN
  85 : *
  86 : * Format handling
  87 : *
  88 : *
  89 : * Error handling
  90 : *
  91 :  9999 CONTINUE
  92 :       IRET=1
  93 :       WRITE(IOIMP,*) 'An error was detected in subroutine mkmpos'
  94 :       RETURN
  95 : *
  96 : * End of subroutine MKMPOS
  97 : *
  98 :       END
  99 : 
 100 :  
 101 :