1 : C EVOL22 SOURCE CHAT 05/01/12 23:47:08 5004 2 : SUBROUTINE EVOL22(IBOO,ILEX,IBOBAS,ILEN1,ILEN2) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C ILEX CONTIENT LA SUITE DES CHPOINTS DESCONTRIBUTIONS MODALES. 7 : CPOUR LES COUPLES POINTS COMPOSANTES CONTENUS DANS NUMOO, 8 : C ON RECOMBINE LES MODES CONTENUS DANS 9 : C UNE TABLE RESULTAT DE TRADUIRE 10 : C RESULTAT DANS LE(S) LISTREEL KLIST. 11 : C APPELE PAR EVRECO 12 : C APPELLE : ERREUR(61,243,18) IANUL PROSC1 13 : C CREATION:12/10/89 14 : C PROGRAMMEUR:LENA 15 : C======================================================================= 16 : C 17 : -INC CCOPTIO 18 : -INC SMCHPOI 19 : -INC SMLREEL 20 : -INC SMLENTI 21 : -INC SMELEME 22 : -INC SMTABLE 23 : -INC SMCOORD 24 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 25 : SEGMENT ICPR1(XCOOR(/1)/(IDIM+1)) 26 : SEGMENT/ITRAV1/(TRAV(LDEPL,N)*D) 27 : SEGMENT/ITRAV2/(TRAVV(LDEPL)*D) 28 : SEGMENT/ITRAV3/(ICC(N),ISS(N),IPP(N),NBB(N)) 29 : SEGMENT IPOS(NSOUP1) 30 : SEGMENT ITRAV(2,LDEPL) 31 : SEGMENT NUMOO 32 : INTEGER NUMO(N),KLIST(N) 33 : CHARACTER*4 NUDDL(N) 34 : ENDSEGMENT 35 : DIMENSION IMEL(2) 36 : CHARACTER*4 NUJ 37 : CHARACTER*8 IBASMO 38 : DATA IBASMO/'BASE-MOD'/ 39 : C 40 : LDEPL=0 41 : NUMOO=IBOO 42 : SEGACT NUMOO*MOD 43 : N=NUMO(/1) 44 : C MLENT1=LISTE DES P.DEFMODALES,MLENT2 = LISTE DES P.POINTS REPERES 45 : MLENT1=ILEN1 46 : MLENT2=ILEN2 47 : SEGACT MLENT1,MLENT2 48 : MTAB1=IBOBAS 49 : SEGACT MTAB1 50 : ITOTO=1 51 : IMEL(1)=0 52 : IMEL(1)=MLENT2.LECT(1) 53 : LDEPL=MLENT1.LECT(/1) 54 : SEGDES MTAB1 55 : LICPR=XCOOR(/1)/(IDIM+1) 56 : SEGINI ICPR,ICPR1 57 : C 58 : JJJ=0 59 : SEGINI ITRAV1 60 : SEGINI ITRAV3 61 : KK=0 62 : DO 61 I=1,N 63 : KK=KK+1 64 : C ICC(KK)=IC 65 : IPP(KK)=I 66 : 61 CONTINUE 67 : 68 : C ***** ON REPART SUR LES MODES 69 : LDEP=MLENT1.LECT(/1) 70 : DO 40 I=1,LDEP 71 : JJJ=JJJ+1 72 : NUMPP=MLENT2.LECT(I) 73 : C ICPR1(NUM(1,I))=JJJ 74 : ICPR1(NUMPP)=JJJ 75 : 76 : C **** FABRICATION DU TABLEAU TRAV(LDEPL,N) DES MODES REDUITS AUX 77 : C **** POINTS DE SORTIE (BOUCLE 40) 78 : 79 : ichp=MLENT1.LECT(I) 80 : DO 41 IP=1,N 81 : mpoint=numo(ip) 82 : NUJ=NUDDL(IP) 82 : call EXTRA9(ICHP,MPOINT,nuj,KERRE,XFLOT) 83 : TRAV(JJJ,IPP(IP))=xflot 84 : 41 continue 85 : 86 : 40 CONTINUE 87 : SEGSUP ITRAV3 88 : SEGSUP ICPR 89 : C 90 : C **** FABRICATION DEITRAV(2,LDEPL),ET DE IPOS(NSOUP+1) 91 : C 92 : MLENTI=ILEX 93 : SEGACT MLENTI 94 : MCHPOI=LECT(1) 95 : SEGACT MCHPOI 96 : NSOUP=IPCHP(/1) 97 : NSOUP1=NSOUP+1 98 : SEGINI IPOS 99 : SEGINI ITRAV 100 : KK=0 101 : IPOS(1)=0 102 : DO 1 ISOU=1,NSOUP 103 : MSOUPO=IPCHP(ISOU) 104 : SEGACT MSOUPO 105 : MELEME=IGEOC 106 : SEGACT MELEME 107 : DO 2 I=1,NUM(/2) 108 : J=ICPR1(NUM(1,I)) 109 : IF (J.NE.0) THEN 110 : KK=KK+1 111 : ITRAV(1,KK)=I 112 : ITRAV(2,KK)=J 113 : ENDIF 114 : 2 CONTINUE 115 : SEGDES MELEME,MSOUPO 116 : IPOS(ISOU+1)=KK 117 : 1 CONTINUE 118 : SEGSUP ICPR1 119 : C 120 : C **** BOUCLE SUR LES INSTANTS DE LA TABLE 121 : C 122 : MLENTI=ILEX 123 : SEGACT MLENTI 124 : LTEM=LECT(/1) 125 : JG=LTEM 126 : DO 99 JJ=1,N 127 : SEGINI MLREEL 128 : KLIST(JJ)=MLREEL 129 : 99 CONTINUE 130 : C 131 : SEGINIITRAV2 132 : DO 90 L=1,LTEM 133 : MCHPOI=LECT(L) 134 : SEGACT MCHPOI 135 : DO 70 I=1,NSOUP 136 : IF (IPOS(I+1).NE.IPOS(I)) THEN 137 : MSOUPO=IPCHP(I) 138 : SEGACT MSOUPO 139 : MPOVAL=IPOVAL 140 : SEGACT MPOVAL 141 : DO 160 NB=IPOS(I)+1,IPOS(I+1) 142 : TRAVV(ITRAV(2,NB))=VPOCHA(ITRAV(1,NB),1) 143 : 160 CONTINUE 144 : SEGDESMPOVAL,MSOUPO 145 : ENDIF 146 : 70 CONTINUE 147 : SEGDES MCHPOI 148 : DO 162 IP=1,N 148 : CALL PROSC1(TRAVV,TRAV(1,IP),RET,LDEPL) 149 : MLREEL=KLIST(IP) 150 : PROG(L)=RET 151 : 162 CONTINUE 152 : 90 CONTINUE 153 : C 154 : SEGSUP ITRAV 155 : SEGSUP IPOS 156 : SEGSUP ITRAV1,ITRAV2 157 : DO 98 JJ=1,N 158 : MLREEL=KLIST(JJ) 159 : SEGDES MLREEL 160 : 98 CONTINUE 161 : C 162 : SEGDES MLENTI 163 : 5000 CONTINUE 164 : RETURN 165 : END 166 : 167 : 168 : 169 : 170 :
© Cast3M 2003 - All rights reserved.
Disclaimer