Esope source files

   1 : C SUPOUE    SOURCE    GOUNAND   05/12/21    21:36:55     5281           
   2 :       SUBROUTINE SUPOUE(TABGEO,TABVDC,TABMAT,IMPR,IRET)
   3 :       IMPLICIT REAL*8 (A-H,O-Z)
   4 :       IMPLICIT INTEGER (I-N)
   5 : C***********************************************************************
   6 : C NOM         : SUPOUE
   7 : C DESCRIPTION : Supprimme les objets de l'include SMPOUET
   8 : C     
   9 : C     
  10 : C     
  11 : C LANGAGE     : ESOPE
  12 : C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  13 : C               mél : gounand@semt2.smts.cea.fr
  14 : C***********************************************************************
  15 : C APPELES          :
  16 : C APPELES (E/S)    :
  17 : C APPELES (BLAS)   :
  18 : C APPELES (CALCUL) :
  19 : C APPELE PAR       :
  20 : C***********************************************************************
  21 : C SYNTAXE GIBIANE    :
  22 : C ENTREES            :
  23 : C ENTREES/SORTIES    :
  24 : C SORTIES            :
  25 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  26 : C***********************************************************************
  27 : C VERSION    : v2, 22/09/03, refonte complète (modif SMPOUET)
  28 : C VERSION    : v1, 19/12/2002, version initiale
  29 : C HISTORIQUE : v1, 19/12/2002, création
  30 : C HISTORIQUE : v1, 22/08/2003, modif suite chgt SMPOUET(nls9)
  31 : C HISTORIQUE :
  32 : C HISTORIQUE :
  33 : C***********************************************************************
  34 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  35 : C en cas de modification de ce sous-programme afin de faciliter
  36 : C la maintenance !
  37 : C***********************************************************************
  38 : -INC CCOPTIO
  39 : * Segments à moi
  40 : CBEGININCLUDE SMPOUET
  41 :       SEGMENT TABGEO
  42 :       CHARACTER*4 DISGEO
  43 :       POINTEUR IGEO.MCHAEL
  44 :       ENDSEGMENT
  45 :       SEGMENT TABVDC
  46 :       INTEGER VVARPR(NUMVPR)
  47 :       INTEGER VVARDU(NUMVDU)
  48 :       INTEGER VDATPR(NUMDPR)
  49 :       INTEGER VDATDU(NUMDDU)
  50 :       INTEGER VCOFPR(NUMCPR)
  51 :       INTEGER VCOFDU(NUMCDU)
  52 :       INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR)
  53 :       INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU)
  54 :       POINTEUR VLCOF(JLCOF).MLENTI
  55 :       POINTEUR VCOMP(JGCOF).COMP
  56 :       POINTEUR VLDAT(JGCOF).MLENTI
  57 :       INTEGER  DJSVD(JGVD)
  58 :       POINTEUR NOMVD(JGVD).MLMOTS
  59 :       POINTEUR MVD(JGVD).MCHPOI
  60 :       REAL*8 XVD(JGVD)
  61 :       CHARACTER*4 DISVD(KGVD)
  62 :       ENDSEGMENT
  63 :       SEGMENT TATRAV
  64 :       POINTEUR VVCOF(JLCOF).MCHEVA
  65 :       POINTEUR VCOF(JGCOF).MCHEVA
  66 :       POINTEUR IVD(JGVD).MCHAEL
  67 :       POINTEUR VD(JGVD).MCHEVA
  68 :       POINTEUR DVD(JGVD).MCHEVA
  69 :       POINTEUR FFVD(KGVD).MCHEVA
  70 :       POINTEUR DFFVD(KGVD).MCHEVA
  71 :       LOGICAL LVCOF(JGCOF)
  72 :       LOGICAL LVD(JGVD)
  73 :       LOGICAL LDVD(JGVD)
  74 :       LOGICAL LFFVD(KGVD)
  75 :       LOGICAL LDFFVD(KGVD)
  76 :       ENDSEGMENT
  77 :       SEGMENT TABMAT
  78 :       POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL
  79 :       ENDSEGMENT
  80 : CENDINCLUDE SMPOUET
  81 : CBEGININCLUDE SMCHAEL
  82 :       SEGMENT MCHAEL
  83 :       POINTEUR IMACHE(N1).MELEME
  84 :       POINTEUR ICHEVA(N1).MCHEVA
  85 :       ENDSEGMENT
  86 :       SEGMENT MCHEVA
  87 :       REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  88 :       ENDSEGMENT
  89 :       SEGMENT LCHEVA
  90 :       POINTEUR LISCHE(NBCHE).MCHEVA
  91 :       ENDSEGMENT
  92 : CENDINCLUDE SMCHAEL
  93 :       POINTEUR MYMCHA.MCHAEL
  94 : -INC SMLENTI
  95 : *     
  96 :       INTEGER IMPR,IRET
  97 : *     
  98 :       INTEGER IJVC,JVARPR,JVARDU
  99 : *     
 100 : * Executable statements
 101 : *     
 102 :       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans supoue.eso' 
 103 : * Destruction de TABGEO
 104 :       IF (TABGEO.NE.0) THEN
 105 :          SEGACT TABGEO*MOD
 106 :          MYMCHA=TABGEO.IGEO
 106 :          CALL SUCAEL(MYMCHA,IMPR,IRET)
 107 :          IF (IRET.NE.0) GOTO 9999
 108 :          SEGSUP TABGEO
 109 :       ENDIF
 110 : * Destruction de TABVDC
 111 :       IF (TABVDC.NE.0) THEN
 112 :          SEGACT TABVDC*MOD
 113 :          JLCOF=TABVDC.VLCOF(/1)
 114 :          DO ILCOF=1,JLCOF
 115 :             MLENTI=TABVDC.VLCOF(ILCOF)
 116 : *     SEGACT MLENTI*MOD
 117 :             SEGSUP MLENTI
 118 :          ENDDO
 119 :          JGCOF=TABVDC.VLDAT(/1)
 120 :          DO IGCOF=1,JGCOF
 121 :             MLENTI=TABVDC.VLDAT(IGCOF)
 122 : *     SEGACT MLENTI*MOD
 123 :             SEGSUP MLENTI
 124 :          ENDDO
 125 : C         JGVD=TABVDC.DJSVD(/1)
 126 : C         DO IJVD=1,JGVD
 127 : C            MYMCHA=TABVDC.IVD(IJVD)
 127 : C            CALL SUCAEL(MYMCHA,IMPR,IRET)
 128 : C            IF (IRET.NE.0) GOTO 9999
 129 : C         ENDDO
 130 :          SEGSUP TABVDC
 131 :       ENDIF
 132 : * Destruction de TABMAT
 133 :       IF (TABMAT.NE.0) THEN
 134 :          SEGACT TABMAT*MOD
 135 :          DO JVARPR=1,TABMAT.VMAT(/2)
 136 :             DO JVARDU=1,TABMAT.VMAT(/1)
 137 :                MYMCHA=TABMAT.VMAT(JVARDU,JVARPR)
 137 :                CALL SUCAEL(MYMCHA,IMPR,IRET)
 138 :                IF (IRET.NE.0) GOTO 9999
 139 :             ENDDO
 140 :          ENDDO
 141 :          SEGSUP TABMAT
 142 :       ENDIF
 143 : *     
 144 : * Normal termination
 145 : *     
 146 :       IRET=0
 147 :       RETURN
 148 : *     
 149 : * Format handling
 150 : *     
 151 : *     
 152 : * Error handling
 153 : *     
 154 :  9999 CONTINUE
 155 :       IRET=1
 156 :       WRITE(IOIMP,*) 'An error was detected in subroutine supoue'
 157 :       RETURN
 158 : *     
 159 : * End of subroutine SUPOUE
 160 : *     
 161 :       END
 162 : 
 163 :