Esope source files

   1 : C RESMAK    SOURCE    CHAT      05/01/13    02:52:14     5004           
   2 :       SUBROUTINE RESMAK (ICOLAC,ITLACC,IMAX1,IDEB)
   3 : 
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 : C***********************************************************************
   7 : C NOM         : RESMAK
   8 : C DESCRIPTION : Restauration des pointeurs dans les objets
   9 : C               de type MATRAK.
  10 : C               (appelé par restpi.eso)
  11 : C
  12 : C LANGAGE     : ESOPE
  13 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  14 : C               mél : gounand@semt2.smts.cea.fr
  15 : C***********************************************************************
  16 : C SYNTAXE GIBIANE    : -
  17 : C ENTREES            : ICOLAC, chapeau sur les piles ITLACC
  18 : C                      (une pour chaque type d'objets)
  19 : C                      IDEB, IMAX1, indice de début et de fin
  20 : C                      sur la pile d'objets MATRAK
  21 : C ENTREES/SORTIES    : ITLACC, la pile des objets MATRAK sur
  22 : C                      lesquels on va restaurer des pointeurs
  23 : C***********************************************************************
  24 : C VERSION    : v1, 15/07/98, version initiale
  25 : C HISTORIQUE : v1, 15/07/98, création
  26 : C HISTORIQUE :
  27 : C HISTORIQUE :
  28 : C***********************************************************************
  29 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30 : C en cas de modification de ce sous-programme afin de faciliter
  31 : C la maintenance !
  32 : C***********************************************************************
  33 : -INC CCOPTIO
  34 : C-INC SMMATRAKANC
  35 : C*************************************************************************
  36 : C
  37 : C    REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES  puis assemblees
  38 : C
  39 : 
  40 : * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange
  41 : * (points CENTRE ) pour chaque operateur de contrainte
  42 : * KGEOC SPG pour la totalite des points CENTRE.
  43 : * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse)
  44 : * KLEMC Connectivites de l'ensemble des contraintes
  45 : * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones
  46 : 
  47 :       SEGMENT MATRAK
  48 :       INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP)
  49 :       INTEGER LIZAFM(NBSOUS)
  50 :       INTEGER IKAM0 (NBSOUS)
  51 :       INTEGER IMEM  (NBELC)
  52 :       INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC
  53 :       ENDSEGMENT
  54 : 
  55 :       SEGMENT IZAFM
  56 :       REAL*8  AM(NNELP,NP,IESP),RPGI(NELAX)
  57 :       ENDSEGMENT
  58 : C*************************************************************************
  59 : -INC TMCOLAC
  60 : C
  61 : C     ************************* MATRAK ********************************
  62 : C Pile des MELEME
  63 :       ITLAC1=KCOLA(1)
  64 : C Pile des CHPOINT
  65 :       ITLAC2=KCOLA(2)
  66 :       DO 1 IEL=IDEB,IMAX1
  67 :          MATRAK=ITLAC(IEL)
  68 :          IF (MATRAK.EQ.0) THEN
  69 :             WRITE(IOIMP,*) 'Failing to save a nil pointer'
  70 :             WRITE(IOIMP,*) 'MATRAK type object...'
  71 :             GOTO 9999
  72 :          ENDIF
  73 :          SEGACT MATRAK*MOD
  74 :          NBOP=LGEOC(/1)
  75 :          IF (NBOP.NE.0)THEN
  76 :             DO 605 I=1,NBOP
  77 :                IVA=ABS(LGEOC(I))
  78 :                IF (IVA.NE.0) LGEOC(I)=ITLAC1.ITLAC(IVA)
  79 :  605        CONTINUE
  80 :          ENDIF
  81 :          IVA=ABS(KLEMC)
  82 :          IF (IVA.NE.0) KLEMC=ITLAC1.ITLAC(IVA)
  83 :          IVA=ABS(KGEOS)
  84 :          IF (IVA.NE.0) KGEOS=ITLAC1.ITLAC(IVA)
  85 :          IVA=ABS(KGEOC)
  86 :          IF (IVA.NE.0) KGEOC=ITLAC1.ITLAC(IVA)
  87 :          IVA=ABS(KDIAG)
  88 :          IF (IVA.NE.0) KDIAG=ITLAC2.ITLAC(IVA)
  89 :          SEGDES MATRAK
  90 :  1    CONTINUE
  91 : *
  92 : * Normal termination
  93 : *
  94 :       RETURN
  95 : *
  96 : * Format handling
  97 : *
  98 : *
  99 : * Error handling
 100 : *
 101 :  9999 CONTINUE
 102 :       WRITE(IOIMP,*) 'An error was detected in subroutine resmak'
 103 :       RETURN
 104 : *
 105 : * End of subroutine RESMAK
 106 : *
 107 :       END
 108 : 
 109 : 
 110 : 
 111 : 
 112 : 
 113 : 
 114 : 
 115 :  
 116 :  
 117 :  
 118 :  
 119 :